Page MenuHomeHEPForge
Files F3529861

No OneTemporary
Actions

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
Index: trunk/tests/functional_tests/pack_1.sh
===================================================================
--- trunk/tests/functional_tests/pack_1.sh (revision 0)
+++ trunk/tests/functional_tests/pack_1.sh (revision 8158)
@@ -0,0 +1,51 @@
+#!/bin/sh
+### Check WHIZARD unpack/pack feature
+echo "Running script $0"
+
+if test -f GZIP_FLAG; then
+ script=`basename @script@`
+ tar_create="tar -czf"
+ tar_list="tar -tzf"
+
+ rm -rf $script.1 $script.2 $script.3 $script.4
+ rm -rf $script.1.tgz $script.2.tgz $script.3.tgz $script.4.tgz
+
+ mkdir $script.1
+ touch $script.1/foo
+ $tar_create $script.1.tgz $script.1
+ rm -rf $script.1
+
+ mkdir $script.2
+ touch $script.2/bar
+ $tar_create $script.2.tgz $script.2
+ rm -rf $script.2
+
+ mkdir $script.3
+ touch $script.3/foo
+
+ mkdir $script.4
+ touch $script.4/bar
+
+ ./run_whizard.sh @script@ --no-model --no-logging --no-library \
+ --unpack $script.1.tgz --pack $script.3 \
+ --unpack $script.2.tgz --pack $script.4
+
+ echo "Contents of directory $script.1:" > $script.log
+ ls $script.1 >> $script.log
+
+ echo "Contents of directory $script.2:" >> $script.log
+ ls $script.2 >> $script.log
+
+ echo "Contents of file $script.3.tgz:" >> $script.log
+ $tar_list $script.3.tgz >> $script.log
+
+ echo "Contents of file $script.4.tgz:" >> $script.log
+ $tar_list $script.4.tgz >> $script.log
+
+ diff ref-output/$script.ref $script.log
+else
+ echo "|=============================================================================|"
+ echo "gzip unavailable, test skipped"
+ exit 77
+fi
+
Index: trunk/tests/functional_tests/show_5.sh
===================================================================
--- trunk/tests/functional_tests/show_5.sh (revision 0)
+++ trunk/tests/functional_tests/show_5.sh (revision 8158)
@@ -0,0 +1,15 @@
+#!/bin/sh
+### Check WHIZARD for a simple test process
+echo "Running script $0"
+if test -f OCAML_FLAG; then
+ ./run_whizard.sh @script@ --no-logging --no-model
+ script=`basename @script@`
+ echo "Contents of file $script.results.dat:" >> $script.log
+ cat $script.results.dat >> $script.log
+ diff ref-output/$script.ref $script.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 8157)
+++ trunk/tests/functional_tests/Makefile.am (revision 8158)
@@ -1,728 +1,739 @@
## Makefile.am -- Makefile for executable WHIZARD test scripts
##
## Process this file with automake to produce Makefile.in
##
########################################################################
#
# Copyright (C) 1999-2018 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 \
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 \
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
+ job_id_1.run \
+ pack_1.run
XFAIL_TESTS_DEFAULT =
TESTS_REQ_FASTJET = \
analyze_4.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_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 \
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 \
reweight_1.run \
reweight_2.run \
reweight_3.run \
reweight_4.run \
reweight_5.run \
reweight_6.run \
reweight_7.run \
reweight_8.run \
analyze_1.run \
analyze_2.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 \
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 \
mssmtest_1.run \
mssmtest_2.run \
mssmtest_3.run \
sm_cms_1.run \
ufo_1.run \
ufo_2.run \
ufo_3.run \
nlo_1.run \
nlo_2.run \
nlo_3.run \
nlo_4.run \
nlo_5.run \
nlo_6.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 \
recola_1.run \
recola_2.run \
recola_3.run \
recola_4.run \
recola_5.run \
recola_6.run \
recola_7.run \
recola_8.run \
powheg_1.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 \
epa_1.run \
epa_2.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_cuts.run \
user_prc_threshold_1.run \
cascades2_phs_1.run \
user_prc_threshold_2.run
XFAIL_TESTS_REQ_OCAML = \
colors_hgg.run \
hadronize_1.run \
user_cuts.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
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 \
isr_5.run \
mlm_pythia6_isr.run \
mlm_matching_isr.run
XFAIL_TESTS_REQ_PYTHIA6 =
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_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 $@
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
user_cuts.run: user_cuts.f90
user_cuts.f90: $(top_builddir)/share/tests/functional_tests/user_cuts.f90
cp $< $@
model_test.run: tdefs.$(FC_MODULE_EXT) tglue.$(FC_MODULE_EXT) \
threeshl.$(FC_MODULE_EXT) tscript.$(FC_MODULE_EXT)
tdefs.mod: $(top_builddir)/src/models/threeshl_bundle/tdefs.$(FC_MODULE_EXT)
cp $< $@
tglue.mod: $(top_builddir)/src/models/threeshl_bundle/tglue.$(FC_MODULE_EXT)
cp $< $@
tscript.mod: $(top_builddir)/src/models/threeshl_bundle/tscript.$(FC_MODULE_EXT)
cp $< $@
threeshl.mod: $(top_builddir)/src/models/threeshl_bundle/threeshl.$(FC_MODULE_EXT)
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_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_MODELPATH)/SM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/SM/$(UFO_TAG_FILE)
$(MAKE) -C $(UFO_MODELPATH)/SM 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 += 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
endif
if HEPMC_AVAILABLE
TESTS_SRC += $(hepmc_6_rd_SOURCES)
noinst_PROGRAMS += hepmc_6_rd
if HEPMC_IS_VERSION3
hepmc_6_rd_SOURCES = hepmc_6_v3_rd.cpp
else
hepmc_6_rd_SOURCES = hepmc_6_v2_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
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
stdhep_rd: $(top_builddir)/src/xdr/stdhep_rd
cp $< $@
susyhit.in: $(top_builddir)/share/tests/functional_tests/susyhit.in
cp $< $@
BUILT_SOURCES = \
TESTFLAG \
HEPMC_FLAG \
LCIO_FLAG \
FASTJET_FLAG \
LHAPDF5_FLAG \
LHAPDF6_FLAG \
GAMELAN_FLAG \
MPI_FLAG \
EVENT_ANALYSIS_FLAG \
OCAML_FLAG \
PYTHIA6_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
HEPMC_FLAG:
if HEPMC_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
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 HEPMC_FLAG LCIO_FLAG
rm -f EVENT_ANALYSIS_FLAG PYTHIA6_FLAG LHAPDF5_FLAG
- rm -f LHAPDF6_FLAG STATIC_FLAG static_1.exe static_2.exe
+ rm -f LHAPDF6_FLAG
+ rm -f GZIP_FLAG STATIC_FLAG static_1.exe static_2.exe
rm -f *.run *.log slha_test.out
rm -f core* stdhep_rd
rm -f *.f90 *.f90.in *.c *.$(FC_MODULE_EXT) *.o *.la
rm -f *_count.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 *.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
rm -f ufo_1_SM.ufo.mdl ufo_2_SM.ufo.mdl ufo_3_SM.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
Index: trunk/tests/functional_tests/job_id_4.sh
===================================================================
--- trunk/tests/functional_tests/job_id_4.sh (revision 8157)
+++ trunk/tests/functional_tests/job_id_4.sh (revision 8158)
@@ -1,18 +1,18 @@
#!/bin/sh
### Check WHIZARD for a simple test process
echo "Running script $0"
if test -f OCAML_FLAG; then
script=`basename @script@`
rm -rf ${script}_x*
./run_whizard.sh @script@ --no-logging --no-model -J "8001"
echo "* Files created by integrate:" >> $script.log
ls ${script}_x.*.1.* >> $script.log
- echo "* Files created in grid directory:" >> $script.log
+ echo "* Files created in integrate workspace:" >> $script.log
ls ${script}_x.*/* >> $script.log
diff ref-output/$script.ref $script.log
else
echo "|=============================================================================|"
echo "No O'Mega matrix elements available, test skipped"
exit 77
fi
Index: trunk/share/tests/Makefile.am
===================================================================
--- trunk/share/tests/Makefile.am (revision 8157)
+++ trunk/share/tests/Makefile.am (revision 8158)
@@ -1,1323 +1,1328 @@
## Makefile.am -- Makefile for WHIZARD tests
##
## Process this file with automake to produce Makefile.in
##
########################################################################
#
# Copyright (C) 1999-2018 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_lexer_1.fds \
cascades2_1.fds \
cascades2_2.fds \
functional_tests/structure_2_inc.sin functional_tests/testproc_3.phs \
functional_tests/user_cuts.f90 \
functional_tests/susyhit.in nmssm.slha
TESTSUITE_MACROS = testsuite.m4
TESTSUITE_TOOLS = \
check-debug-output.py \
check-hepmc-weights.py \
compare-integrals.py \
compare-histograms.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/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/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/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/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/polarization_1.ref \
unit_tests/ref-output/polarization_2.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/md5_1.ref \
unit_tests/ref-output/cputime_1.ref \
unit_tests/ref-output/cputime_2.ref \
unit_tests/ref-output/lexer_1.ref \
unit_tests/ref-output/parse_1.ref \
unit_tests/ref-output/color_1.ref \
unit_tests/ref-output/color_2.ref \
unit_tests/ref-output/os_interface_1.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/format_1.ref \
unit_tests/ref-output/sorting_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/solver_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/interaction_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 \
unit_tests/ref-output/sm_qcd_1.ref \
unit_tests/ref-output/sm_physics_1.ref \
unit_tests/ref-output/sm_physics_2.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/auto_components_1.ref \
unit_tests/ref-output/auto_components_2.ref \
unit_tests/ref-output/auto_components_3.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/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/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/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_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_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_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/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_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_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_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_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_gaussian_1.ref \
unit_tests/ref-output/sf_gaussian_2.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_escan_1.ref \
unit_tests/ref-output/sf_escan_2.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_none_1.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/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/phs_tree_1.ref \
unit_tests/ref-output/phs_tree_2.ref \
unit_tests/ref-output/phs_forest_1.ref \
unit_tests/ref-output/phs_forest_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/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/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/real_subtraction_1.ref \
unit_tests/ref-output/prc_recola_1.ref \
unit_tests/ref-output/prc_recola_2.ref \
unit_tests/ref-output/rng_base_1.ref \
unit_tests/ref-output/rng_base_2.ref \
unit_tests/ref-output/rng_tao_1.ref \
unit_tests/ref-output/rng_tao_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/selectors_1.ref \
unit_tests/ref-output/selectors_2.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/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/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_none_1.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_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/mci_vamp2_1.ref \
unit_tests/ref-output/mci_vamp2_2.ref \
unit_tests/ref-output/mci_vamp2_3.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/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/particle_specifiers_1.ref \
unit_tests/ref-output/particle_specifiers_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/prclib_stacks_1.ref \
unit_tests/ref-output/prclib_stacks_2.ref \
unit_tests/ref-output/slha_1.ref \
unit_tests/ref-output/slha_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/prc_template_me_1.ref \
unit_tests/ref-output/prc_template_me_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/parton_states_1.ref \
unit_tests/ref-output/subevt_expr_1.ref \
unit_tests/ref-output/subevt_expr_2.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/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/cascades_1.ref \
unit_tests/ref-output/cascades_2.ref \
unit_tests/ref-output/cascades2_lexer_1.ref \
unit_tests/ref-output/cascades2_1.ref \
unit_tests/ref-output/cascades2_2.ref \
unit_tests/ref-output/event_transforms_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/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/isr_handler_1.ref \
unit_tests/ref-output/isr_handler_2.ref \
unit_tests/ref-output/isr_handler_3.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/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/shower_1.ref \
unit_tests/ref-output/shower_2.ref \
unit_tests/ref-output/shower_base_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/hep_events_1.ref \
unit_tests/ref-output/eio_data_1.ref \
unit_tests/ref-output/eio_data_2.ref \
unit_tests/ref-output/eio_base_1.ref \
unit_tests/ref-output/eio_direct_1.ref \
unit_tests/ref-output/eio_raw_1.ref \
unit_tests/ref-output/eio_raw_2.ref \
unit_tests/ref-output/eio_checkpoints_1.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_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_hepmc_1.ref \
unit_tests/ref-output/eio_hepmc_2.ref \
unit_tests/ref-output/eio_lcio_1.ref \
unit_tests/ref-output/eio_lcio_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_weights_1.ref \
unit_tests/ref-output/eio_weights_2.ref \
unit_tests/ref-output/eio_weights_3.ref \
unit_tests/ref-output/eio_dump_1.ref \
unit_tests/ref-output/iterations_1.ref \
unit_tests/ref-output/iterations_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/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_rng_1.ref \
unit_tests/ref-output/dispatch_phs_1.ref \
unit_tests/ref-output/dispatch_phs_2.ref \
unit_tests/ref-output/dispatch_mci_1.ref \
unit_tests/ref-output/dispatch_transforms_1.ref \
unit_tests/ref-output/dispatch_transforms_2.ref \
unit_tests/ref-output/process_configurations_1.ref \
unit_tests/ref-output/process_configurations_2.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/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/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/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/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/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/jets_1.ref \
unit_tests/ref-output/hepmc_interface_1.ref \
unit_tests/ref-output/lcio_interface_1.ref \
unit_tests/ref-output/ttv_formfactors_1.ref \
unit_tests/ref-output/ttv_formfactors_2.ref \
unit_tests/ref-output/blha_1.ref \
unit_tests/ref-output/blha_2.ref \
unit_tests/ref-output/blha_3.ref \
+ functional_tests/ref-output/pack_1.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/vars.ref \
functional_tests/ref-output/extpar.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/template_me_1.ref \
functional_tests/ref-output/template_me_2.ref \
functional_tests/ref-output/susyhit.ref \
functional_tests/ref-output/restrictions.ref \
functional_tests/ref-output/process_log.ref \
functional_tests/ref-output/static_1.ref \
functional_tests/ref-output/static_2.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/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/rebuild_2.ref \
functional_tests/ref-output/rebuild_3.ref \
functional_tests/ref-output/rebuild_4.ref \
functional_tests/ref-output/fatal.ref \
functional_tests/ref-output/model_change_1.ref \
functional_tests/ref-output/model_change_2.ref \
functional_tests/ref-output/model_scheme_1.ref \
functional_tests/ref-output/model_test.ref \
functional_tests/ref-output/cuts.ref \
functional_tests/ref-output/user_cuts.ref \
functional_tests/ref-output/user_prc_threshold_1.ref \
functional_tests/ref-output/user_prc_threshold_2.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/qcdtest_4.ref \
functional_tests/ref-output/qcdtest_5.ref \
functional_tests/ref-output/qcdtest_6.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/observables_1.ref \
functional_tests/ref-output/event_weights_1.ref \
functional_tests/ref-output/event_weights_2.ref \
functional_tests/ref-output/event_eff_1.ref \
functional_tests/ref-output/event_eff_2.ref \
functional_tests/ref-output/event_dump_1.ref \
functional_tests/ref-output/event_dump_2.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/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/colors.ref \
functional_tests/ref-output/colors_hgg.ref \
functional_tests/ref-output/alphas.ref \
functional_tests/ref-output/jets_xsec.ref \
functional_tests/ref-output/shower_err_1.ref \
functional_tests/ref-output/parton_shower_1.ref \
functional_tests/ref-output/pythia6_1.ref \
functional_tests/ref-output/pythia6_2.ref \
functional_tests/ref-output/hadronize_1.ref \
functional_tests/ref-output/mlm_matching_fsr.ref \
functional_tests/ref-output/mlm_pythia6_isr.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/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/select_1.ref \
functional_tests/ref-output/select_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/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/fatal_beam_decay.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/sm_cms_1.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/ufo_1.ref \
functional_tests/ref-output/ufo_2.ref \
functional_tests/ref-output/ufo_3.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/real_partition_1.ref \
functional_tests/ref-output/fks_res_2.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/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/nlo_decay_1.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/spincor_1.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/method_ovm_1.ref \
functional_tests/ref-output/multi_comp_4.ref \
functional_tests/ref-output/flvsum_1.ref \
functional_tests/ref-output/br_redef_1.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/polarized_1.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/isr_1.ref \
functional_tests/ref-output/epa_1.ref \
functional_tests/ref-output/epa_2.ref \
functional_tests/ref-output/isr_epa_1.ref \
functional_tests/ref-output/ep_3.ref \
functional_tests/ref-output/ewa_4.ref \
functional_tests/ref-output/gaussian_1.ref \
functional_tests/ref-output/gaussian_2.ref \
functional_tests/ref-output/beam_events_1.ref \
functional_tests/ref-output/beam_events_4.ref \
functional_tests/ref-output/energy_scan_1.ref \
functional_tests/ref-output/cascades2_phs_1.ref
# Reference files that depend on the numerical precision
REF_OUTPUT_FILES_DOUBLE = \
functional_tests/ref-output-double/qedtest_3.ref \
functional_tests/ref-output-double/qedtest_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/smtest_2.ref \
functional_tests/ref-output-double/smtest_8.ref \
functional_tests/ref-output-double/observables_2.ref \
functional_tests/ref-output-double/colors_2.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/beam_setup_5.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/fks_res_1.ref \
functional_tests/ref-output-double/fks_res_3.ref \
functional_tests/ref-output-double/openloops_3.ref \
functional_tests/ref-output-double/powheg_1.ref \
functional_tests/ref-output-double/defaultcuts.ref \
functional_tests/ref-output-double/parton_shower_2.ref \
functional_tests/ref-output-double/helicity.ref \
functional_tests/ref-output-double/lhef_7.ref \
functional_tests/ref-output-double/hepmc_8.ref \
functional_tests/ref-output-double/lcio_2.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/pdf_builtin.ref \
functional_tests/ref-output-double/lhapdf5.ref \
functional_tests/ref-output-double/lhapdf6.ref \
functional_tests/ref-output-double/ep_1.ref \
functional_tests/ref-output-double/ep_2.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/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/pythia6_3.ref \
functional_tests/ref-output-double/pythia6_4.ref \
functional_tests/ref-output-double/tauola_1.ref \
functional_tests/ref-output-double/tauola_2.ref \
functional_tests/ref-output-double/mlm_matching_isr.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/ilc.ref \
functional_tests/ref-output-double/beam_events_2.ref \
functional_tests/ref-output-double/beam_events_3.ref
REF_OUTPUT_FILES_PREC = \
functional_tests/ref-output-prec/qedtest_3.ref \
functional_tests/ref-output-prec/qedtest_4.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/smtest_2.ref \
functional_tests/ref-output-prec/smtest_8.ref \
functional_tests/ref-output-prec/colors_2.ref \
functional_tests/ref-output-prec/beam_setup_5.ref \
functional_tests/ref-output-prec/nlo_3.ref \
functional_tests/ref-output-prec/nlo_4.ref \
functional_tests/ref-output-prec/fks_res_1.ref \
functional_tests/ref-output-prec/fks_res_3.ref \
functional_tests/ref-output-prec/openloops_3.ref \
functional_tests/ref-output-prec/defaultcuts.ref \
functional_tests/ref-output-prec/parton_shower_2.ref \
functional_tests/ref-output-prec/helicity.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/pdf_builtin.ref \
functional_tests/ref-output-prec/lhapdf5.ref \
functional_tests/ref-output-prec/lhapdf6.ref \
functional_tests/ref-output-prec/ep_1.ref \
functional_tests/ref-output-prec/ep_2.ref \
functional_tests/ref-output-prec/ilc.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/ewa_1.ref
REF_OUTPUT_FILES_EXT = \
functional_tests/ref-output-ext/observables_2.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/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/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/nlo_5.ref \
functional_tests/ref-output-ext/powheg_1.ref \
functional_tests/ref-output-ext/pythia6_3.ref \
functional_tests/ref-output-ext/pythia6_4.ref \
functional_tests/ref-output-ext/tauola_1.ref \
functional_tests/ref-output-ext/tauola_2.ref \
functional_tests/ref-output-ext/ewa_2.ref \
functional_tests/ref-output-ext/ewa_3.ref \
functional_tests/ref-output-ext/beam_events_2.ref \
functional_tests/ref-output-ext/beam_events_3.ref \
functional_tests/ref-output-ext/mlm_matching_isr.ref \
functional_tests/ref-output-ext/hepmc_8.ref \
functional_tests/ref-output-ext/lcio_2.ref
REF_OUTPUT_FILES_QUAD = \
functional_tests/ref-output-quad/observables_2.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/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/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/nlo_5.ref \
functional_tests/ref-output-quad/powheg_1.ref \
functional_tests/ref-output-quad/pythia6_3.ref \
functional_tests/ref-output-quad/pythia6_4.ref \
functional_tests/ref-output-quad/tauola_1.ref \
functional_tests/ref-output-quad/tauola_2.ref \
functional_tests/ref-output-quad/ewa_2.ref \
functional_tests/ref-output-quad/ewa_3.ref \
functional_tests/ref-output-quad/beam_events_2.ref \
functional_tests/ref-output-quad/beam_events_3.ref \
functional_tests/ref-output-quad/mlm_matching_isr.ref \
functional_tests/ref-output-quad/hepmc_8.ref \
functional_tests/ref-output-quad/lcio_2.ref
TESTSUITES_M4 = \
$(MISC_TESTS_M4) \
$(EXT_MSSM_M4) \
$(EXT_NMSSM_M4)
TESTSUITES_SIN = \
$(MISC_TESTS_SIN) \
$(EXT_MSSM_SIN) \
$(EXT_NMSSM_SIN) \
$(EXT_SHOWER_SIN) \
$(EXT_NLO_SIN)
MISC_TESTS_M4 =
MISC_TESTS_SIN = \
functional_tests/empty.sin \
functional_tests/fatal.sin \
+ functional_tests/pack_1.sin \
functional_tests/defaultcuts.sin \
functional_tests/cuts.sin \
functional_tests/model_change_1.sin \
functional_tests/model_change_2.sin \
functional_tests/model_scheme_1.sin \
functional_tests/model_test.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/vars.sin \
functional_tests/extpar.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/template_me_1.sin \
functional_tests/template_me_2.sin \
functional_tests/libraries_1.sin \
functional_tests/libraries_2.sin \
functional_tests/libraries_3.sin \
functional_tests/libraries_4.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/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/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/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/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/observables_1.sin \
functional_tests/observables_2.sin \
functional_tests/event_weights_1.sin \
functional_tests/event_weights_2.sin \
functional_tests/event_eff_1.sin \
functional_tests/event_eff_2.sin \
functional_tests/event_dump_1.sin \
functional_tests/event_dump_2.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/analyze_1.sin \
functional_tests/analyze_2.sin \
functional_tests/analyze_3.sin \
functional_tests/analyze_4.sin \
functional_tests/colors.sin \
functional_tests/colors_2.sin \
functional_tests/colors_hgg.sin \
functional_tests/alphas.sin \
functional_tests/jets_xsec.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/select_1.sin \
functional_tests/select_2.sin \
functional_tests/shower_err_1.sin \
functional_tests/parton_shower_1.sin \
functional_tests/parton_shower_2.sin \
functional_tests/pythia6_1.sin \
functional_tests/pythia6_2.sin \
functional_tests/pythia6_3.sin \
functional_tests/pythia6_4.sin \
functional_tests/hadronize_1.sin \
functional_tests/tauola_1.sin \
functional_tests/tauola_2.sin \
functional_tests/mlm_matching_fsr.sin \
functional_tests/mlm_matching_isr.sin \
functional_tests/mlm_pythia6_isr.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/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/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/fatal_beam_decay.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/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/sm_cms_1.sin \
functional_tests/ufo_1.sin \
functional_tests/ufo_2.sin \
functional_tests/ufo_3.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_decay_1.sin \
functional_tests/real_partition_1.sin \
functional_tests/fks_res_1.sin \
functional_tests/fks_res_2.sin \
functional_tests/fks_res_3.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/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/powheg_1.sin \
functional_tests/mssmtest_1.sin \
functional_tests/mssmtest_2.sin \
functional_tests/mssmtest_3.sin \
functional_tests/spincor_1.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/method_ovm_1.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/flvsum_1.sin \
functional_tests/br_redef_1.sin \
functional_tests/decay_err_1.sin \
functional_tests/decay_err_2.sin \
functional_tests/decay_err_3.sin \
functional_tests/polarized_1.sin \
functional_tests/pdf_builtin.sin \
functional_tests/lhapdf5.sin \
functional_tests/lhapdf6.sin \
functional_tests/ep_1.sin \
functional_tests/ep_2.sin \
functional_tests/ep_3.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_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/circe1_errors_1.sin \
functional_tests/circe2_1.sin \
functional_tests/circe2_2.sin \
functional_tests/circe2_3.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/epa_1.sin \
functional_tests/epa_2.sin \
functional_tests/isr_epa_1.sin \
functional_tests/ewa_1.sin \
functional_tests/ewa_2.sin \
functional_tests/ewa_3.sin \
functional_tests/ewa_4.sin \
functional_tests/ilc.sin \
functional_tests/gaussian_1.sin \
functional_tests/gaussian_2.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/energy_scan_1.sin \
functional_tests/susyhit.sin \
functional_tests/restrictions.sin \
functional_tests/helicity.sin \
functional_tests/process_log.sin \
functional_tests/static_1.sin \
functional_tests/static_1.exe.sin \
functional_tests/static_2.sin \
functional_tests/static_2.exe.sin \
functional_tests/user_cuts.sin \
functional_tests/user_prc_threshold_1.sin \
functional_tests/cascades2_phs_1.sin \
functional_tests/user_prc_threshold_2.sin \
ilc_ext.sin
EXT_MSSM_M4 = \
mssm_ext-ee.m4 mssm_ext-ee2.m4 \
mssm_ext-en.m4 mssm_ext-tn.m4 \
mssm_ext-uu.m4 mssm_ext-uu2.m4 mssm_ext-uuckm.m4 \
mssm_ext-dd.m4 mssm_ext-dd2.m4 mssm_ext-ddckm.m4 \
mssm_ext-bb.m4 mssm_ext-bt.m4 mssm_ext-tt.m4 \
mssm_ext-ug.m4 mssm_ext-dg.m4 \
mssm_ext-aa.m4 mssm_ext-wa.m4 mssm_ext-za.m4 \
mssm_ext-ww.m4 mssm_ext-wz.m4 mssm_ext-zz.m4 \
mssm_ext-gg.m4 mssm_ext-ga.m4 mssm_ext-gw.m4 mssm_ext-gz.m4
EXT_NMSSM_M4 = \
nmssm_ext-aa.m4 nmssm_ext-bb1.m4 nmssm_ext-bb2.m4 \
nmssm_ext-bt.m4 nmssm_ext-dd1.m4 \
nmssm_ext-dd2.m4 nmssm_ext-ee1.m4 \
nmssm_ext-ee2.m4 nmssm_ext-en.m4 \
nmssm_ext-ga.m4 nmssm_ext-gg.m4 \
nmssm_ext-gw.m4 nmssm_ext-gz.m4 \
nmssm_ext-qg.m4 nmssm_ext-tn.m4 \
nmssm_ext-tt1.m4 nmssm_ext-tt2.m4 \
nmssm_ext-uu1.m4 nmssm_ext-uu2.m4 \
nmssm_ext-wa.m4 nmssm_ext-ww1.m4 nmssm_ext-ww2.m4 \
nmssm_ext-wz.m4 nmssm_ext-za.m4 \
nmssm_ext-zz1.m4 nmssm_ext-zz2.m4
EXT_MSSM_SIN = $(EXT_MSSM_M4:.m4=.sin)
EXT_NMSSM_SIN = $(EXT_NMSSM_M4:.m4=.sin)
EXT_SHOWER_SIN = \
shower_1_norad.sin \
shower_2_aall.sin \
shower_3_bb.sin \
shower_3_jj.sin \
shower_3_qqqq.sin \
shower_3_tt.sin \
shower_3_z.sin \
shower_3_z_nu.sin \
shower_3_z_tau.sin \
shower_4_ee.sin \
shower_5.sin \
shower_6.sin
EXT_NLO_SIN = \
nlo_decay_tbw.sin \
nlo_tt.sin \
nlo_tt_powheg.sin \
nlo_tt_powheg_sudakov.sin \
nlo_uu.sin \
nlo_uu_powheg.sin \
nlo_qq_powheg.sin \
nlo_threshold.sin \
nlo_threshold_factorized.sin \
nlo_methods_gosam.sin \
nlo_jets.sin \
nlo_settings.sin \
nlo_eejj.sin \
nlo_eejjj.sin \
nlo_ee4j.sin \
nlo_ee5j.sin \
nlo_eebb.sin \
nlo_eebbj.sin \
nlo_eebbjj.sin \
nlo_ee4b.sin \
nlo_eett.sin \
nlo_eettj.sin \
nlo_eettjj.sin \
nlo_eettjjj.sin \
nlo_eettbb.sin \
nlo_eetta.sin \
nlo_eettaa.sin \
nlo_eettaj.sin \
nlo_eettajj.sin \
nlo_eettaz.sin \
nlo_eettah.sin \
nlo_eettz.sin \
nlo_eettzj.sin \
nlo_eettzjj.sin \
nlo_eettzz.sin \
nlo_eettww.sin \
nlo_eettwmjj.sin \
nlo_eettwpjj.sin \
nlo_eetth.sin \
nlo_eetthj.sin \
nlo_eetthjj.sin \
nlo_eetthh.sin \
nlo_eetthz.sin \
nlo_ee4t.sin \
nlo_ee4tj.sin
all-local: $(TESTSUITES_SIN)
if M4_AVAILABLE
SUFFIXES = .m4 .sin
.m4.sin:
$(M4) $(srcdir)/$(TESTSUITE_MACROS) $< > $@
endif M4_AVAILABLE
Index: trunk/share/tests/functional_tests/ref-output/smtest_13.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/smtest_13.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/smtest_13.ref (revision 8158)
@@ -1,156 +1,156 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
?pacify = true
seed = 0
phs_off_shell = 1
phs_t_channel = 2
SM.me => 0.00000E+00
SM.mmu => 0.00000E+00
| Process library 'smtest_13_lib': recorded process 'smtest_13_1'
| Process library 'smtest_13_lib': recorded process 'smtest_13_2'
| Process library 'smtest_13_lib': recorded process 'smtest_13_3'
sqrts = 5.00000E+02
openmp_num_threads = 1
| Integrate: current process library needs compilation
| Process library 'smtest_13_lib': compiling ...
| Process library 'smtest_13_lib': writing makefile
| Process library 'smtest_13_lib': removing old files
| Process library 'smtest_13_lib': writing driver
| Process library 'smtest_13_lib': creating source code
| Process library 'smtest_13_lib': compiling sources
| Process library 'smtest_13_lib': linking
| Process library 'smtest_13_lib': loading
| Process library 'smtest_13_lib': ... success.
| Integrate: compilation done
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Initializing integration for process smtest_13_1:
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 0.0000000E+00 GeV)
| e+ (mass = 0.0000000E+00 GeV)
| sqrts = 5.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'smtest_13_1.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'smtest_13_1'
| Library name = 'smtest_13_lib'
| Process index = 1
| Process components:
| 1: 'smtest_13_1_i1': e-, e+ => mu-, mu+ [omega]
| ------------------------------------------------------------------------
| Phase space: 2 channels, 2 dimensions
| Phase space: found 2 channels, collected in 2 groves.
| Phase space: Using 2 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'smtest_13_1'
| Integrate: iterations not specified, using default
| Integrate: iterations = 3:1000:"gw", 3:10000:""
| Integrator: 2 chains, 2 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 1000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 784 4.284E+02 7.48E-01 0.17 0.05 40.6
2 784 4.274E+02 5.88E-01 0.14 0.04 71.6
3 784 4.290E+02 5.58E-01 0.13 0.04 54.3
|-----------------------------------------------------------------------------|
3 2352 4.283E+02 3.56E-01 0.08 0.04 54.3 2.14 3
|-----------------------------------------------------------------------------|
4 9936 4.283E+02 5.63E-02 0.01 0.01 54.1
5 9936 4.283E+02 5.58E-02 0.01 0.01 54.1
6 9936 4.283E+02 5.61E-02 0.01 0.01 54.1
|-----------------------------------------------------------------------------|
6 29808 4.283E+02 3.24E-02 0.01 0.01 54.1 0.04 3
|=============================================================================|
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 1
| Initializing integration for process smtest_13_2:
| Process component 'smtest_13_2_i1': matrix element vanishes
Warning: Process 'smtest_13_2': matrix element vanishes
| ------------------------------------------------------------------------
| Process [scattering]: 'smtest_13_2'
| Library name = 'smtest_13_lib'
| Process index = 2
| Process components: [none]
| ------------------------------------------------------------------------
Warning: No cuts have been defined.
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 0 0.0000000E+00 0.00E+00 0.00 0.00* 0.00
|=============================================================================|
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 2
| Initializing integration for process smtest_13_3:
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 0.0000000E+00 GeV)
| e+ (mass = 0.0000000E+00 GeV)
| sqrts = 5.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'smtest_13_3.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'smtest_13_3'
| Library name = 'smtest_13_lib'
| Process index = 3
| Process components:
| 1: 'smtest_13_3_i1': e-, e+ => tau-, tau+ [omega]
| ------------------------------------------------------------------------
| Phase space: 2 channels, 2 dimensions
| Phase space: found 2 channels, collected in 2 groves.
| Phase space: Using 2 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'smtest_13_3'
| Integrate: iterations not specified, using default
| Integrate: iterations = 3:1000:"gw", 3:10000:""
| Integrator: 2 chains, 2 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 1000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 784 4.280E+02 7.94E-01 0.19 0.05 40.7
2 784 4.292E+02 5.39E-01 0.13 0.04 72.8
3 784 4.281E+02 6.61E-01 0.15 0.04 67.3
|-----------------------------------------------------------------------------|
3 2352 4.286E+02 3.70E-01 0.09 0.04 67.3 1.20 3
|-----------------------------------------------------------------------------|
4 9936 4.283E+02 6.82E-02 0.02 0.02 69.2
5 9936 4.284E+02 6.79E-02 0.02 0.02 69.1
6 9936 4.282E+02 6.84E-02 0.02 0.02 69.1
|-----------------------------------------------------------------------------|
6 29808 4.283E+02 3.93E-02 0.01 0.02 69.1 1.40 3
|=============================================================================|
-smtest_13_3:
- 4.2831114E+02 +- 3.93E-02 fb
-smtest_13_2:
- 0.0000000E+00 +- 0.00E+00 fb
smtest_13_1:
- 4.2829887E+02 +- 3.24E-02 fb
+ 4.2829887E+02 +- 3.24E-02 fb ( 0.008 %)
+smtest_13_2:
+ 0.0000000E+00 +- 0.00E+00 fb ( 0. %)
+smtest_13_3:
+ 4.2831114E+02 +- 3.93E-02 fb ( 0.009 %)
n_events = 10
| Starting simulation for processes 'smtest_13_1' etc.
| Simulate: using integration grids from file 'smtest_13_1.m1.vg'
| Simulate: using integration grids from file 'smtest_13_3.m1.vg'
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 3
Warning: Process 'smtest_13_2': matrix element vanishes, no events can be generated.
| Simulation: requested number of events = 10
| corr. to luminosity [fb-1] = 1.1674E-02
| Events: writing to raw file 'smtest_13_1.evx'
| Events: generating 10 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
| Events: actual unweighting efficiency = 90.91 %
| Events: closing raw file 'smtest_13_1.evx'
| There were no errors and 5 warning(s).
| WHIZARD run finished.
|=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/show_4.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/show_4.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/show_4.ref (revision 8158)
@@ -1,1137 +1,1137 @@
?openmp_logging = false
[user variable] foo = PDG(11, 13, 15)
[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
#####################################################
QED.ee => 3.028600000000E-01
QED.me => 5.110000000000E-04
QED.mmu => 1.057000000000E-01
QED.mtau => 1.777000000000E+00
[undefined] sqrts = [unknown real]
luminosity = 0.000000000000E+00
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
[undefined] circe1_sqrts = [unknown real]
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
lambda_qcd = 2.000000000000E-01
helicity_selection_threshold = 1.000000000000E+10
safety_factor = 1.000000000000E+00
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
tolerance = 0.000000000000E+00
real_epsilon* = <real_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
ps_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_fixed_alphas = 0.000000000000E+00
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
powheg_pt_min = 1.000000000000E+00
powheg_lambda = 2.000000000000E-01
blha_top_yukawa = -1.000000000000E+00
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 1.000000000000E-07
fks_y_max = 1.000000000000E+00
fks_xi_cut = 1.000000000000E+00
fks_delta_zero = 2.000000000000E+00
fks_delta_i = 2.000000000000E+00
mult_call_real = 1.000000000000E+00
mult_call_virt = 1.000000000000E+00
mult_call_dglap = 1.000000000000E+00
real_partition_scale = 1.000000000000E+01
#####################################################
QED.charged* = PDG(11, 13, 15, -11, -13, -15)
#####################################################
[user variable] foo = PDG(11, 13, 15)
#####################################################
[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
#####################################################
$sf_trace_file = ""
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
$pdf_builtin_set = "CTEQ6L"
$isr_handler_mode = "trivial"
$epa_handler_mode = "trivial"
$circe1_acc = "SBAND"
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
[undefined] $beam_events_file = [unknown string]
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
$model_name = "QED"
$method = "omega"
$restrictions = ""
$omega_flags = ""
$library_name = "show_4_lib"
$rng_method = "tao"
$event_file_version = ""
$polarization_mode = "helicity"
$out_file = ""
$integration_method = "vamp"
$run_id = ""
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$phs_method = "default"
$phs_file = ""
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
$sample = ""
$sample_normalization = "auto"
$rescan_input_format = "raw"
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
$dump_extension = "pset.dat"
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
$extension_lha = "lha"
$extension_hepmc = "hepmc"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
$shower_method = "WHIZARD"
$ps_PYTHIA_PYGIVE = ""
$hadronization_method = "PYTHIA6"
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
$select_alpha_regions = ""
$virtual_selection = "Full"
$blha_ew_scheme = "alpha_qed"
$openloops_extra_cmd = ""
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
$gosam_fc = ""
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
$fc => Fortran-compiler
$fcflags => Fortran-flags
#####################################################
?sf_trace = false
?sf_allow_s_mapping = true
?hoppet_b_matching = false
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
?circe1_generate = true
?circe1_map = true
?circe1_with_radiation = false
?circe2_polarized = true
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => true
?report_progress = true
[user variable] ?me_verbose = false
?omega_write_phs_output = false
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
?fatal_beam_decay = true
?helicity_selection_active = true
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
?unweighted = true
?negative_weights = false
?resonance_history = false
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
?polarized_events = false
?pacify = false
?out_advance = true
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
?integration_timer = true
?check_grid_file = true
?vis_channels = false
?check_phs_file = true
?phs_only = false
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
?normalize_bins = false
?y_log = false
?x_log = false
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
?analysis_file_only = false
?keep_flavors_when_clustering = false
?sample_pacify = false
?sample_select = true
?read_raw = true
?write_raw = true
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
?hepmc_output_cross_section = false
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
?shower_verbose = false
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
?ps_tauola_pol_vector = false
?mlm_matching = false
?powheg_matching = false
?powheg_use_singular_jacobian = false
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active* = false
?openmp_logging = false
?mpi_logging = false
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
?virtual_collinear_resonance_aware = true
?openloops_use_cms = true
?openloops_switch_off_muon_yukawa = false
?openloops_use_collier = true
?disable_subtraction = false
?vis_fks_regions = false
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
?nlo_use_born_scale = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?powheg_rebuild_grids = true
?rebuild_events = true
#####################################################
[undefined] sqrts = [unknown real]
luminosity = 0.000000000000E+00
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => true
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "QED"
[undefined] process_num_id = [unknown integer]
$method = "omega"
?report_progress = true
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "show_4_lib"
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
alphas_order = 0
alphas_nf = 5
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
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
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
?keep_flavors_when_clustering = false
$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
$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_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_grid_sampling_points = 500000
powheg_pt_min = 1.000000000000E+00
powheg_lambda = 2.000000000000E-01
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = false
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_qed"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
?openloops_use_collier = true
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 1.000000000000E-07
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_zero = 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 = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
real_partition_scale = 1.000000000000E+01
$fc => Fortran-compiler
$fcflags => Fortran-flags
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?powheg_rebuild_grids = true
?rebuild_events = true
#####################################################
QED.ee => 3.028600000000E-01
QED.me => 5.110000000000E-04
QED.mmu => 1.057000000000E-01
QED.mtau => 1.777000000000E+00
QED.particle* = PDG(0)
QED.E_LEPTON* = PDG(11)
QED.e-* = PDG(11)
QED.e1* = PDG(11)
QED.e+* = PDG(-11)
QED.E1* = PDG(-11)
QED.MU_LEPTON* = PDG(13)
QED.m-* = PDG(13)
QED.e2* = PDG(13)
QED.mu-* = PDG(13)
QED.m+* = PDG(-13)
QED.E2* = PDG(-13)
QED.mu+* = PDG(-13)
QED.TAU_LEPTON* = PDG(15)
QED.t-* = PDG(15)
QED.e3* = PDG(15)
QED.ta-* = PDG(15)
QED.tau-* = PDG(15)
QED.t+* = PDG(-15)
QED.E3* = PDG(-15)
QED.ta+* = PDG(-15)
QED.tau+* = PDG(-15)
QED.PHOTON* = PDG(22)
QED.A* = PDG(22)
QED.gamma* = PDG(22)
QED.photon* = PDG(22)
QED.charged* = PDG(11, 13, 15, -11, -13, -15)
QED.neutral* = PDG(22)
QED.colored* = PDG()
[undefined] sqrts = [unknown real]
luminosity = 0.000000000000E+00
?sf_trace = false
$sf_trace_file = ""
?sf_allow_s_mapping = true
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
lhapdf_member = 0
lhapdf_photon_scheme = 0
$pdf_builtin_set = "CTEQ6L"
?hoppet_b_matching = false
isr_alpha = 0.000000000000E+00
isr_q_max = 0.000000000000E+00
isr_mass = 0.000000000000E+00
isr_order = 3
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => true
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "QED"
[undefined] process_num_id = [unknown integer]
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "show_4_lib"
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
alphas_order = 0
alphas_nf = 5
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
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
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
?keep_flavors_when_clustering = false
$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
$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_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_grid_sampling_points = 500000
powheg_pt_min = 1.000000000000E+00
powheg_lambda = 2.000000000000E-01
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = false
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_qed"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
?openloops_use_collier = true
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 1.000000000000E-07
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_zero = 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 = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
real_partition_scale = 1.000000000000E+01
$fc => Fortran-compiler
$fcflags => Fortran-flags
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?powheg_rebuild_grids = true
?rebuild_events = true
[user variable] foo = PDG(11, 13, 15)
[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
| WHIZARD run finished.
|=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/mlm_matching_fsr.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/mlm_matching_fsr.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/mlm_matching_fsr.ref (revision 8158)
@@ -1,261 +1,261 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
?pacify = true
| Switching to model 'SM', scheme 'default'
| Process library 'mlm_matching_fsr_lib': recorded process 'mlm_matching_fsr_eeuu'
[user variable] j = PDG(2, 1, -2, -1, 21)
| Process library 'mlm_matching_fsr_lib': compiling ...
| Process library 'mlm_matching_fsr_lib': writing makefile
| Process library 'mlm_matching_fsr_lib': removing old files
| Process library 'mlm_matching_fsr_lib': writing driver
| Process library 'mlm_matching_fsr_lib': creating source code
| Process library 'mlm_matching_fsr_lib': compiling sources
| Process library 'mlm_matching_fsr_lib': linking
| Process library 'mlm_matching_fsr_lib': loading
| Process library 'mlm_matching_fsr_lib': ... success.
seed = 0
SM.me => 1.00000E+00
sqrts = 9.10000E+01
?allow_shower = true
?ps_fsr_active = true
$shower_method = "WHIZARD"
ps_max_n_flavors = 5
ps_mass_cutoff = 1.00000E+00
ps_fsr_lambda = 2.90000E-01
?mlm_matching = false
openmp_num_threads = 1
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Initializing integration for process mlm_matching_fsr_eeuu:
| Beam structure: e-, e+
| Beam data (collision):
| e- (mass = 1.0000000E+00 GeV)
| e+ (mass = 1.0000000E+00 GeV)
| sqrts = 9.100000000000E+01 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'mlm_matching_fsr_eeuu.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'mlm_matching_fsr_eeuu'
| Library name = 'mlm_matching_fsr_lib'
| Process index = 1
| Process components:
| 1: 'mlm_matching_fsr_eeuu_i1': e-, e+ => u, ubar [omega]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
| Applying user-defined cuts.
| Starting integration for process 'mlm_matching_fsr_eeuu'
| Integrate: iterations = 2:5000
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 5000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 4608 7.017E+06 1.09E+03 0.02 0.01 58.5
2 4608 7.017E+06 1.09E+03 0.02 0.01 58.5
|-----------------------------------------------------------------------------|
2 9216 7.017E+06 7.72E+02 0.01 0.01 58.5 0.07 2
|=============================================================================|
n_events = 1
?rebuild_events = true
$sample = "mlm_matching_fsr_1"
?sample_pacify = true
| Starting simulation for process 'mlm_matching_fsr_eeuu'
| Simulate: using integration grids from file 'mlm_matching_fsr_eeuu.m1.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| 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] = 1.4251E-07
| Events: writing to ASCII file 'mlm_matching_fsr_1.evt'
| Events: writing to raw file 'mlm_matching_fsr_1.evx'
| Events: generating 1 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
| Events: actual unweighting efficiency = 33.33 %
| Events: closing ASCII file 'mlm_matching_fsr_1.evt'
| Events: closing raw file 'mlm_matching_fsr_1.evx'
mlm_matching_fsr_eeuu:
- 7.0170233E+06 +- 7.72E+02 fb
+ 7.0170233E+06 +- 7.72E+02 fb ( 0.011 %)
SM.ms => 0.00000E+00
SM.mc => 0.00000E+00
sqrts = 9.10000E+01
?ps_fsr_active = true
$shower_method = "WHIZARD"
ps_max_n_flavors = 5
ps_mass_cutoff = 1.00000E+00
ps_fsr_lambda = 2.90000E-01
?mlm_matching = true
mlm_nmaxMEjets = 2
mlm_Rmin = 1.00000E+00
mlm_ETclusminE = 1.00000E+01
[user variable] ycut = 1.00000E+02
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 2
| Initializing integration for process mlm_matching_fsr_eeuu:
| Beam structure: e-, e+
| Beam data (collision):
| e- (mass = 1.0000000E+00 GeV)
| e+ (mass = 1.0000000E+00 GeV)
| sqrts = 9.100000000000E+01 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'mlm_matching_fsr_eeuu.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'mlm_matching_fsr_eeuu'
| Library name = 'mlm_matching_fsr_lib'
| Process index = 1
| Process components:
| 1: 'mlm_matching_fsr_eeuu_i1': e-, e+ => u, ubar [omega]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
| Applying user-defined cuts.
| Starting integration for process 'mlm_matching_fsr_eeuu'
| Integrate: iterations = 2:5000
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 5000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 4608 7.019E+06 1.09E+03 0.02 0.01 58.5
2 4608 7.019E+06 1.10E+03 0.02 0.01 58.5
|-----------------------------------------------------------------------------|
2 9216 7.019E+06 7.75E+02 0.01 0.01 58.5 0.00 2
|=============================================================================|
n_events = 1
?rebuild_events = true
$sample = "mlm_matching_fsr_2"
?sample_pacify = true
| Starting simulation for process 'mlm_matching_fsr_eeuu'
| Simulate: using integration grids from file 'mlm_matching_fsr_eeuu.m1.vg'
| Simulate: activating parton shower
| Shower: Using WHIZARD internal shower
| Simulate: applying MLM matching
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 3
| Simulation: requested number of events = 1
| corr. to luminosity [fb-1] = 1.4247E-07
| Events: writing to ASCII file 'mlm_matching_fsr_2.evt'
| Events: writing to raw file 'mlm_matching_fsr_2.evx'
| Events: generating 1 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
| Events: actual unweighting efficiency = 33.33 %
| Events: closing ASCII file 'mlm_matching_fsr_2.evt'
| Events: closing raw file 'mlm_matching_fsr_2.evx'
mlm_matching_fsr_eeuu:
- 7.0190407E+06 +- 7.75E+02 fb
+ 7.0170233E+06 +- 7.72E+02 fb ( 0.011 %)
mlm_matching_fsr_eeuu:
- 7.0170233E+06 +- 7.72E+02 fb
+ 7.0190407E+06 +- 7.75E+02 fb ( 0.011 %)
| WHIZARD run finished.
|=============================================================================|
Contents of mlm_matching_fsr_1.evt:
========================================================================
Event #1
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 1.08242E+01
Squared matrix el. (prc) = 1.08242E+01
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
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 9.10000E+01
sqrts_hat* => 9.10000E+01
n_in* => 2
n_out* => 7
n_tot* => 9
$process_id* => "mlm_matching_fsr_eeuu"
process_num_id* => [unknown integer]
sqme* => 1.08242E+01
sqme_ref* => 1.08242E+01
event_index* => 1
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:11|-4.5500000E+01; 0.0000000E+00, 0.0000000E+00,-4.5489010E+01| 1.0000000E+00| 1)
2 prt(i:-11|-4.5500000E+01; 0.0000000E+00, 0.0000000E+00, 4.5489010E+01| 1.0000000E+00| 2)
3 prt(o:21| 1.8056612E+00; 3.4453969E-01, 5.6989506E-02, 1.7715690E+00| 0.0000000E+00| 3)
4 prt(o:21| 1.8120243E+00;-2.3578156E-01,-7.9712024E-01,-1.6101051E+00| 0.0000000E+00| 4)
5 prt(o:2| 2.7378091E+01; 1.4747446E+01,-2.1603230E+00, 2.2965315E+01| 0.0000000E+00| 5)
6 prt(o:21| 1.6164794E+01; 9.9092692E+00, 1.0626025E-01, 1.2770892E+01| 0.0000000E+00| 6)
7 prt(o:21| 3.4526381E+00;-2.4978462E+00, 4.8453846E-01,-2.3338159E+00| 0.0000000E+00| 7)
8 prt(o:-2| 1.6719170E+01;-8.6306964E+00, 4.0927565E-01,-1.4313428E+01| 0.0000000E+00| 8)
9 prt(o:21| 2.3667621E+01;-1.3636931E+01, 1.9003793E+00,-1.9250427E+01| 0.0000000E+00| 9)
========================================================================
Contents of mlm_matching_fsr_2.evt:
========================================================================
Event #1
------------------------------------------------------------------------
Unweighted = T
Normalization = '1'
Helicity handling = drop
Keep correlations = F
------------------------------------------------------------------------
Squared matrix el. (ref) = 5.51668E+00
Squared matrix el. (prc) = 5.51668E+00
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
========================================================================
Local variables:
------------------------------------------------------------------------
sqrts* = 9.10000E+01
sqrts_hat* => 9.10000E+01
n_in* => 2
n_out* => 7
n_tot* => 9
$process_id* => "mlm_matching_fsr_eeuu"
process_num_id* => [unknown integer]
sqme* => 5.51668E+00
sqme_ref* => 5.51668E+00
event_index* => 1
event_weight* => 1.00000E+00
event_weight_ref* => 1.00000E+00
event_excess* => 0.00000E+00
------------------------------------------------------------------------
subevent:
1 prt(i:11|-4.5500000E+01; 0.0000000E+00, 0.0000000E+00,-4.5489010E+01| 1.0000000E+00| 1)
2 prt(i:-11|-4.5500000E+01; 0.0000000E+00, 0.0000000E+00, 4.5489010E+01| 1.0000000E+00| 2)
3 prt(o:21| 3.1066812E+00; 8.3836114E-01,-2.9908553E+00,-5.8339034E-02| 0.0000000E+00| 3)
4 prt(o:2| 2.3635479E+01; 8.4414315E+00,-2.1730553E+01,-3.8937360E+00| 0.0000000E+00| 4)
5 prt(o:21| 1.7933795E+01; 7.5713435E+00,-1.5993165E+01,-2.9179503E+00| 0.0000000E+00| 5)
6 prt(o:-2| 1.3327948E+01;-6.3597978E+00, 1.1106990E+01, 3.7177870E+00| 0.0000000E+00| 6)
7 prt(o:21| 1.0213311E+01;-3.6573815E+00, 8.0918817E+00, 5.0454662E+00| 0.0000000E+00| 7)
8 prt(o:21| 1.0943828E+01;-2.8920991E+00, 1.0552631E+01, 2.1242013E-01| 0.0000000E+00| 8)
9 prt(o:21| 1.1838958E+01;-3.9418576E+00, 1.0963071E+01,-2.1056480E+00| 0.0000000E+00| 9)
========================================================================
Index: trunk/share/tests/functional_tests/ref-output/restrictions.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/restrictions.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/restrictions.ref (revision 8158)
@@ -1,97 +1,97 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
seed = 0
| Process library 'restrictions_lib': recorded process 'restrictions_sm_eemm'
$restrictions = "1+2 ~ Z"
| Process library 'restrictions_lib': recorded process 'restrictions_sm_eemm_z'
| Process library 'restrictions_lib': compiling ...
| Process library 'restrictions_lib': writing makefile
| Process library 'restrictions_lib': removing old files
| Process library 'restrictions_lib': writing driver
| Process library 'restrictions_lib': creating source code
| Process library 'restrictions_lib': compiling sources
| Process library 'restrictions_lib': linking
| Process library 'restrictions_lib': loading
| Process library 'restrictions_lib': ... success.
sqrts = 2.000000000000E+02
openmp_num_threads = 1
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Initializing integration for process restrictions_sm_eemm:
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 5.1099700E-04 GeV)
| e+ (mass = 5.1099700E-04 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'restrictions_sm_eemm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'restrictions_sm_eemm'
| Library name = 'restrictions_lib'
| Process index = 1
| Process components:
| 1: 'restrictions_sm_eemm_i1': e-, e+ => mu-, mu+ [omega]
| ------------------------------------------------------------------------
| Phase space: 2 channels, 2 dimensions
| Phase space: found 2 channels, collected in 2 groves.
| Phase space: Using 2 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'restrictions_sm_eemm'
| Integrate: iterations = 1:1000
| Integrator: 2 chains, 2 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 1000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 784 2.8454055E+03 5.43E+00 0.19 0.05* 38.35
|-----------------------------------------------------------------------------|
1 784 2.8454055E+03 5.43E+00 0.19 0.05 38.35
|=============================================================================|
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 1
| Initializing integration for process restrictions_sm_eemm_z:
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 5.1099700E-04 GeV)
| e+ (mass = 5.1099700E-04 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'restrictions_sm_eemm_z.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'restrictions_sm_eemm_z'
| Library name = 'restrictions_lib'
| Process index = 2
| Process components:
| 1: 'restrictions_sm_eemm_z_i1': e-, e+ => mu-, mu+ [omega]
| ------------------------------------------------------------------------
| Phase space: 2 channels, 2 dimensions
| Phase space: found 2 channels, collected in 2 groves.
| Phase space: Using 2 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'restrictions_sm_eemm_z'
| Integrate: iterations = 1:1000
| Integrator: 2 chains, 2 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 1000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 784 4.9554542E+02 6.17E-01 0.12 0.03* 63.78
|-----------------------------------------------------------------------------|
1 784 4.9554542E+02 6.17E-01 0.12 0.03 63.78
|=============================================================================|
-restrictions_sm_eemm_z:
- 4.9554542E+02 +- 6.17E-01 fb
restrictions_sm_eemm:
- 2.8454055E+03 +- 5.43E+00 fb
+ 2.8454055E+03 +- 5.43E+00 fb ( 0.19 %)
+restrictions_sm_eemm_z:
+ 4.9554542E+02 +- 6.17E-01 fb ( 0.12 %)
| There were no errors and 2 warning(s).
| WHIZARD run finished.
|=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/model_test.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/model_test.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/model_test.ref (revision 8158)
@@ -1,1810 +1,1810 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
seed = 0
| Switching to model 'THDM'
| Process library 'model_test_1_lib': recorded process 'models_ccww_thdm'
| Switching to model 'THDM_CKM'
| Process library 'model_test_1_lib': recorded process 'models_ccww_thdm_ckm'
| Switching to model 'GravTest'
GravTest.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_grav_test'
| Switching to model 'HSExt'
HSExt.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_hsext'
| Switching to model 'Littlest'
Littlest.st => 1.000000000000E-01
Littlest.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_littlest'
| Switching to model 'Littlest_Eta'
Littlest_Eta.st => 5.000000000000E-01
Littlest_Eta.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_littlest_eta'
| Switching to model 'Littlest_Tpar'
Littlest_Tpar.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_littlest_tpar'
| Switching to model 'MSSM'
| Reading SLHA input file 'sps1ap_decays.slha'
| SLHA: Initializing model 'MSSM'
| SLHA: SUSY spectrum program info:
| SLHA: SPheno
| SLHA: 2.2.3
| Process library 'model_test_1_lib': recorded process 'models_ccww_mssm'
| Switching to model 'MSSM_CKM'
| Reading SLHA input file 'sps1ap_decays.slha'
| SLHA: Initializing model 'MSSM_CKM'
| SLHA: SUSY spectrum program info:
| SLHA: SPheno
| SLHA: 2.2.3
| Process library 'model_test_1_lib': recorded process 'models_ccww_mssm_ckm'
| Switching to model 'MSSM_Grav'
| Reading SLHA input file 'sps1ap_decays.slha'
| SLHA: Initializing model 'MSSM_Grav'
| SLHA: SUSY spectrum program info:
| SLHA: SPheno
| SLHA: 2.2.3
| Process library 'model_test_1_lib': recorded process 'models_ccww_mssm_grav'
| Switching to model 'MSSM_Hgg'
| Reading SLHA input file 'sps1ap_decays.slha'
| SLHA: Initializing model 'MSSM_Hgg'
| SLHA: SUSY spectrum program info:
| SLHA: SPheno
| SLHA: 2.2.3
| Process library 'model_test_1_lib': recorded process 'models_ccww_mssm_hgg'
| Switching to model 'NMSSM'
| Reading SLHA input file 'nmssm.slha'
| SLHA: Initializing model 'NMSSM'
| SLHA: SUSY spectrum program info:
| SLHA: NMSSMTools
| SLHA: 2
| Process library 'model_test_1_lib': recorded process 'models_ccww_nmssm'
| Switching to model 'NMSSM_CKM'
| Reading SLHA input file 'nmssm.slha'
| SLHA: Initializing model 'NMSSM_CKM'
| SLHA: SUSY spectrum program info:
| SLHA: NMSSMTools
| SLHA: 2
| Process library 'model_test_1_lib': recorded process 'models_ccww_nmssm_ckm'
| Switching to model 'NMSSM_Hgg'
| Reading SLHA input file 'nmssm.slha'
| SLHA: Initializing model 'NMSSM_Hgg'
| SLHA: SUSY spectrum program info:
| SLHA: NMSSMTools
| SLHA: 2
| Process library 'model_test_1_lib': recorded process 'models_ccww_nmssm_hgg'
| Switching to model 'PSSSM'
| Process library 'model_test_1_lib': recorded process 'models_ccww_psssm'
| Switching to model 'QCD', scheme 'default'
| Process library 'model_test_1_lib': recorded process 'models_uudd_qcd'
| Switching to model 'QED'
| Process library 'model_test_1_lib': recorded process 'models_eemm_qed'
| Switching to model 'SM', scheme 'default'
SM.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm'
| Switching to model 'SM_CKM'
SM_CKM.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_ckm'
| Switching to model 'SM_ac'
SM_ac.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_ac'
| Switching to model 'SM_ac_CKM'
SM_ac_CKM.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_ac_ckm'
| Switching to model 'SM_dim6'
SM_dim6.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_dim6'
| Switching to model 'SM_rx'
SM_rx.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_wwww_sm_rx'
| Switching to model 'SM_ul'
SM_ul.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_wwww_sm_ul'
| Switching to model 'NoH_rx'
| Process library 'model_test_1_lib': recorded process 'models_wwww_noh_rx'
| Switching to model 'SM_top'
SM_top.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_top'
| Switching to model 'SM_top_anom'
SM_top_anom.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_top_anom'
| Switching to model 'SM_Higgs'
SM_Higgs.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_higgs'
| Switching to model 'SM_Higgs_CKM'
SM_Higgs_CKM.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_higgs_ckm'
| Switching to model 'SM_tt_threshold'
SM_tt_threshold.mH => 1.250000000000E+02
SM_tt_threshold.test => 4.200000000000E+01
| Process library 'model_test_1_lib': recorded process 'models_ccww_sm_tt_thresh'
| Switching to model 'Simplest'
Simplest.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_simplest'
| Switching to model 'Simplest_univ'
Simplest_univ.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_simplest_univ'
| Switching to model 'Template'
Template.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_template'
| Switching to model 'Threeshl'
| Process library 'model_test_1_lib': recorded process 'models_ccww_threeshl'
| Switching to model 'Threeshl_nohf'
| Process library 'model_test_1_lib': recorded process 'models_ccww_threeshl_nohf'
| Switching to model 'UED'
UED.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_ued'
| Switching to model 'SSC'
SSC.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_wwww_ssc'
| Switching to model 'SSC_2'
SSC_2.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_wwww_ssc_2'
| Switching to model 'SSC_AltT'
SSC_AltT.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_wwww_ssc_altt'
| Switching to model 'AltH'
| Process library 'model_test_1_lib': recorded process 'models_wwww_alth'
| Switching to model 'Xdim'
Xdim.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_xdim'
| Switching to model 'WZW'
WZW.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_wzw'
| Switching to model 'Zprime'
Zprime.mH => 1.250000000000E+02
| Process library 'model_test_1_lib': recorded process 'models_ccww_zprime'
| Process library 'model_test_lib': compiling ...
| Process library 'model_test_lib': ... success.
| Process library 'model_test_1_lib': compiling ...
| Process library 'model_test_1_lib': writing makefile
| Process library 'model_test_1_lib': removing old files
| Process library 'model_test_1_lib': writing driver
| Process library 'model_test_1_lib': creating source code
| Process library 'model_test_1_lib': compiling sources
| Process library 'model_test_1_lib': linking
| Process library 'model_test_1_lib': loading
| Process library 'model_test_1_lib': ... success.
sqrts = 2.000000000000E+02
openmp_num_threads = 1
seed = 0
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Initializing integration for process models_ccww_thdm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_thdm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_thdm'
| Library name = 'model_test_1_lib'
| Process index = 1
| Process components:
| 1: 'models_ccww_thdm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_thdm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 7.5144851E+03 6.76E+02 8.99 0.89* 40.19
|-----------------------------------------------------------------------------|
1 99 7.5144851E+03 6.76E+02 8.99 0.89 40.19
|=============================================================================|
seed = 1
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 1
| Initializing integration for process models_ccww_thdm_ckm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_thdm_ckm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_thdm_ckm'
| Library name = 'model_test_1_lib'
| Process index = 2
| Process components:
| 1: 'models_ccww_thdm_ckm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_thdm_ckm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 7.3770184E+03 6.73E+02 9.12 0.91* 39.73
|-----------------------------------------------------------------------------|
1 99 7.3770184E+03 6.73E+02 9.12 0.91 39.73
|=============================================================================|
seed = 2
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 2
| Initializing integration for process models_ccww_grav_test:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_grav_test.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_grav_test'
| Library name = 'model_test_1_lib'
| Process index = 3
| Process components:
| 1: 'models_ccww_grav_test_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_grav_test'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.5673184E+03 5.70E+02 10.24 1.02* 29.75
|-----------------------------------------------------------------------------|
1 99 5.5673184E+03 5.70E+02 10.24 1.02 29.75
|=============================================================================|
seed = 3
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 3
| Initializing integration for process models_ccww_hsext:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_hsext.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_hsext'
| Library name = 'model_test_1_lib'
| Process index = 4
| Process components:
| 1: 'models_ccww_hsext_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_hsext'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 8.3080339E+05 5.36E+04 6.46 0.64* 47.18
|-----------------------------------------------------------------------------|
1 99 8.3080339E+05 5.36E+04 6.46 0.64 47.18
|=============================================================================|
seed = 4
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 4
| Initializing integration for process models_ccww_littlest:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_littlest.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_littlest'
| Library name = 'model_test_1_lib'
| Process index = 5
| Process components:
| 1: 'models_ccww_littlest_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_littlest'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.7081379E+03 5.93E+02 8.84 0.88* 35.88
|-----------------------------------------------------------------------------|
1 99 6.7081379E+03 5.93E+02 8.84 0.88 35.88
|=============================================================================|
seed = 5
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 5
| Initializing integration for process models_ccww_littlest_eta:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_littlest_eta.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_littlest_eta'
| Library name = 'model_test_1_lib'
| Process index = 6
| Process components:
| 1: 'models_ccww_littlest_eta_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_littlest_eta'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.9060694E+03 5.73E+02 9.70 0.96* 31.86
|-----------------------------------------------------------------------------|
1 99 5.9060694E+03 5.73E+02 9.70 0.96 31.86
|=============================================================================|
seed = 6
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 6
| Initializing integration for process models_ccww_littlest_tpar:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_littlest_tpar.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_littlest_tpar'
| Library name = 'model_test_1_lib'
| Process index = 7
| Process components:
| 1: 'models_ccww_littlest_tpar_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_littlest_tpar'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.2761051E+03 5.73E+02 9.13 0.91* 35.11
|-----------------------------------------------------------------------------|
1 99 6.2761051E+03 5.73E+02 9.13 0.91 35.11
|=============================================================================|
seed = 7
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 7
| Initializing integration for process models_ccww_mssm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_mssm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_mssm'
| Library name = 'model_test_1_lib'
| Process index = 8
| Process components:
| 1: 'models_ccww_mssm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_mssm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.9494213E+03 6.28E+02 10.55 1.05* 31.92
|-----------------------------------------------------------------------------|
1 99 5.9494213E+03 6.28E+02 10.55 1.05 31.92
|=============================================================================|
seed = 8
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 8
| Initializing integration for process models_ccww_mssm_ckm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_mssm_ckm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_mssm_ckm'
| Library name = 'model_test_1_lib'
| Process index = 9
| Process components:
| 1: 'models_ccww_mssm_ckm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_mssm_ckm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.9673584E+03 6.29E+02 9.03 0.90* 37.22
|-----------------------------------------------------------------------------|
1 99 6.9673584E+03 6.29E+02 9.03 0.90 37.22
|=============================================================================|
seed = 9
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 9
| Initializing integration for process models_ccww_mssm_grav:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_mssm_grav.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_mssm_grav'
| Library name = 'model_test_1_lib'
| Process index = 10
| Process components:
| 1: 'models_ccww_mssm_grav_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_mssm_grav'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 7.0900237E+03 6.59E+02 9.29 0.92* 38.09
|-----------------------------------------------------------------------------|
1 99 7.0900237E+03 6.59E+02 9.29 0.92 38.09
|=============================================================================|
seed = 10
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 10
| Initializing integration for process models_ccww_nmssm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_nmssm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_nmssm'
| Library name = 'model_test_1_lib'
| Process index = 12
| Process components:
| 1: 'models_ccww_nmssm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_nmssm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.3772942E+03 5.41E+02 10.06 1.00* 29.82
|-----------------------------------------------------------------------------|
1 99 5.3772942E+03 5.41E+02 10.06 1.00 29.82
|=============================================================================|
seed = 11
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 11
| Initializing integration for process models_ccww_nmssm_ckm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_nmssm_ckm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_nmssm_ckm'
| Library name = 'model_test_1_lib'
| Process index = 13
| Process components:
| 1: 'models_ccww_nmssm_ckm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_nmssm_ckm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.6207771E+03 5.42E+02 9.64 0.96* 31.18
|-----------------------------------------------------------------------------|
1 99 5.6207771E+03 5.42E+02 9.64 0.96 31.18
|=============================================================================|
seed = 12
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 12
| Initializing integration for process models_ccww_nmssm_hgg:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_nmssm_hgg.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_nmssm_hgg'
| Library name = 'model_test_1_lib'
| Process index = 14
| Process components:
| 1: 'models_ccww_nmssm_hgg_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_nmssm_hgg'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.8020707E+03 5.14E+02 8.86 0.88* 32.08
|-----------------------------------------------------------------------------|
1 99 5.8020707E+03 5.14E+02 8.86 0.88 32.08
|=============================================================================|
seed = 13
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 13
| Initializing integration for process models_ccww_psssm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_psssm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_psssm'
| Library name = 'model_test_1_lib'
| Process index = 15
| Process components:
| 1: 'models_ccww_psssm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_psssm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.4182194E+08 5.96E+07 9.28 0.92* 34.08
|-----------------------------------------------------------------------------|
1 99 6.4182194E+08 5.96E+07 9.28 0.92 34.08
|=============================================================================|
seed = 14
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 14
| Initializing integration for process models_uudd_qcd:
| Beam structure: [any particles]
| Beam data (collision):
| u (mass = 0.0000000E+00 GeV)
| ubar (mass = 0.0000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_uudd_qcd.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_uudd_qcd'
| Library name = 'model_test_1_lib'
| Process index = 16
| Process components:
| 1: 'models_uudd_qcd_i1': u, ubar => d, dbar [omega]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_uudd_qcd'
| Integrate: iterations = 1:100
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 1.2587507E+05 2.94E+03 2.34 0.23* 67.96
|-----------------------------------------------------------------------------|
1 100 1.2587507E+05 2.94E+03 2.34 0.23 67.96
|=============================================================================|
seed = 15
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 15
| Initializing integration for process models_eemm_qed:
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 5.1100000E-04 GeV)
| e+ (mass = 5.1100000E-04 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_eemm_qed.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_eemm_qed'
| Library name = 'model_test_1_lib'
| Process index = 17
| Process components:
| 1: 'models_eemm_qed_i1': e-, e+ => m-, m+ [omega]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_eemm_qed'
| Integrate: iterations = 1:100
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 2.1772937E+03 4.57E+01 2.10 0.21* 66.89
|-----------------------------------------------------------------------------|
1 100 2.1772937E+03 4.57E+01 2.10 0.21 66.89
|=============================================================================|
seed = 16
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 16
| Initializing integration for process models_ccww_sm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm'
| Library name = 'model_test_1_lib'
| Process index = 18
| Process components:
| 1: 'models_ccww_sm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.4136006E+03 5.84E+02 10.79 1.07* 29.81
|-----------------------------------------------------------------------------|
1 99 5.4136006E+03 5.84E+02 10.79 1.07 29.81
|=============================================================================|
seed = 17
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 17
| Initializing integration for process models_ccww_sm_ckm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_ckm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_ckm'
| Library name = 'model_test_1_lib'
| Process index = 19
| Process components:
| 1: 'models_ccww_sm_ckm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_ckm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.8798557E+03 5.74E+02 9.76 0.97* 33.05
|-----------------------------------------------------------------------------|
1 99 5.8798557E+03 5.74E+02 9.76 0.97 33.05
|=============================================================================|
seed = 18
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 18
| Initializing integration for process models_ccww_sm_ac:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_ac.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_ac'
| Library name = 'model_test_1_lib'
| Process index = 20
| Process components:
| 1: 'models_ccww_sm_ac_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_ac'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.7751152E+03 5.94E+02 10.28 1.02* 31.38
|-----------------------------------------------------------------------------|
1 99 5.7751152E+03 5.94E+02 10.28 1.02 31.38
|=============================================================================|
seed = 19
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 19
| Initializing integration for process models_ccww_sm_ac_ckm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_ac_ckm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_ac_ckm'
| Library name = 'model_test_1_lib'
| Process index = 21
| Process components:
| 1: 'models_ccww_sm_ac_ckm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_ac_ckm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.6718111E+03 6.23E+02 10.98 1.09* 31.58
|-----------------------------------------------------------------------------|
1 99 5.6718111E+03 6.23E+02 10.98 1.09 31.58
|=============================================================================|
seed = 20
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 20
| Initializing integration for process models_ccww_sm_dim6:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_dim6.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_dim6'
| Library name = 'model_test_1_lib'
| Process index = 22
| Process components:
| 1: 'models_ccww_sm_dim6_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_dim6'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.3233409E+03 5.61E+02 8.87 0.88* 34.07
|-----------------------------------------------------------------------------|
1 99 6.3233409E+03 5.61E+02 8.87 0.88 34.07
|=============================================================================|
seed = 21
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 21
| Initializing integration for process models_wwww_sm_rx:
| Beam structure: [any particles]
| Beam data (collision):
| W+ (mass = 8.0419000E+01 GeV)
| W- (mass = 8.0419000E+01 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_wwww_sm_rx.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_wwww_sm_rx'
| Library name = 'model_test_1_lib'
| Process index = 23
| Process components:
| 1: 'models_wwww_sm_rx_i1': W+, W- => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 4 channels, 2 dimensions
| Phase space: found 4 channels, collected in 2 groves.
| Phase space: Using 4 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_wwww_sm_rx'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 4 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 3.0227479E+07 9.65E+06 31.94 3.19* 10.86
|-----------------------------------------------------------------------------|
1 100 3.0227479E+07 9.65E+06 31.94 3.19 10.86
|=============================================================================|
seed = 22
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 22
| Initializing integration for process models_wwww_sm_ul:
| Beam structure: [any particles]
| Beam data (collision):
| W+ (mass = 8.0419000E+01 GeV)
| W- (mass = 8.0419000E+01 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_wwww_sm_ul.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_wwww_sm_ul'
| Library name = 'model_test_1_lib'
| Process index = 24
| Process components:
| 1: 'models_wwww_sm_ul_i1': W+, W- => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 4 channels, 2 dimensions
| Phase space: found 4 channels, collected in 2 groves.
| Phase space: Using 4 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_wwww_sm_ul'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 4 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| 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.7080025E+08 7.49E+08 77.19 7.72* 4.95
|-----------------------------------------------------------------------------|
1 100 9.7080025E+08 7.49E+08 77.19 7.72 4.95
|=============================================================================|
seed = 23
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 23
| Initializing integration for process models_wwww_noh_rx:
| Beam structure: [any particles]
| Beam data (collision):
| W+ (mass = 8.0419000E+01 GeV)
| W- (mass = 8.0419000E+01 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_wwww_noh_rx.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_wwww_noh_rx'
| Library name = 'model_test_1_lib'
| Process index = 25
| Process components:
| 1: 'models_wwww_noh_rx_i1': W+, W- => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 2 channels, 2 dimensions
| Phase space: found 2 channels, collected in 1 grove.
| Phase space: Using 2 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_wwww_noh_rx'
| Integrate: iterations = 1:100
| Integrator: 1 chains, 2 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 2.1032248E+10 1.99E+10 94.76 9.48* 2.06
|-----------------------------------------------------------------------------|
1 100 2.1032248E+10 1.99E+10 94.76 9.48 2.06
|=============================================================================|
seed = 24
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 24
| Initializing integration for process models_ccww_sm_top:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_top.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_top'
| Library name = 'model_test_1_lib'
| Process index = 26
| Process components:
| 1: 'models_ccww_sm_top_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_top'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.7123251E+03 6.25E+02 9.30 0.93* 37.02
|-----------------------------------------------------------------------------|
1 99 6.7123251E+03 6.25E+02 9.30 0.93 37.02
|=============================================================================|
seed = 25
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 25
| Initializing integration for process models_ccww_sm_top_anom:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_top_anom.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_top_anom'
| Library name = 'model_test_1_lib'
| Process index = 27
| Process components:
| 1: 'models_ccww_sm_top_anom_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_top_anom'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.0274506E+03 5.41E+02 10.76 1.07* 28.07
|-----------------------------------------------------------------------------|
1 99 5.0274506E+03 5.41E+02 10.76 1.07 28.07
|=============================================================================|
seed = 26
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 26
| Initializing integration for process models_ccww_sm_higgs:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_higgs.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_higgs'
| Library name = 'model_test_1_lib'
| Process index = 28
| Process components:
| 1: 'models_ccww_sm_higgs_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_higgs'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.1901689E+03 5.99E+02 9.68 0.96* 33.39
|-----------------------------------------------------------------------------|
1 99 6.1901689E+03 5.99E+02 9.68 0.96 33.39
|=============================================================================|
seed = 27
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 27
| Initializing integration for process models_ccww_sm_higgs_ckm:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_higgs_ckm.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_higgs_ckm'
| Library name = 'model_test_1_lib'
| Process index = 29
| Process components:
| 1: 'models_ccww_sm_higgs_ckm_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_higgs_ckm'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 7.2866110E+03 6.44E+02 8.84 0.88* 39.17
|-----------------------------------------------------------------------------|
1 99 7.2866110E+03 6.44E+02 8.84 0.88 39.17
|=============================================================================|
seed = 28
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 28
| Initializing integration for process models_ccww_sm_tt_thresh:
| TESTING ONLY: Skip threshold initialization and use tree-level SM.
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_sm_tt_thresh.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_sm_tt_thresh'
| Library name = 'model_test_1_lib'
| Process index = 30
| Process components:
| 1: 'models_ccww_sm_tt_thresh_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_sm_tt_thresh'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 7.1165240E+03 6.76E+02 9.51 0.95* 35.25
|-----------------------------------------------------------------------------|
1 99 7.1165240E+03 6.76E+02 9.51 0.95 35.25
|=============================================================================|
seed = 29
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 29
| Initializing integration for process models_ccww_simplest:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_simplest.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_simplest'
| Library name = 'model_test_1_lib'
| Process index = 31
| Process components:
| 1: 'models_ccww_simplest_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_simplest'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 7.7043505E+03 6.46E+02 8.38 0.83* 41.45
|-----------------------------------------------------------------------------|
1 99 7.7043505E+03 6.46E+02 8.38 0.83 41.45
|=============================================================================|
seed = 30
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 30
| Initializing integration for process models_ccww_simplest_univ:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_simplest_univ.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_simplest_univ'
| Library name = 'model_test_1_lib'
| Process index = 32
| Process components:
| 1: 'models_ccww_simplest_univ_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_simplest_univ'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.4988268E+03 6.33E+02 9.74 0.97* 34.99
|-----------------------------------------------------------------------------|
1 99 6.4988268E+03 6.33E+02 9.74 0.97 34.99
|=============================================================================|
seed = 31
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 31
| Initializing integration for process models_ccww_template:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_template.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_template'
| Library name = 'model_test_1_lib'
| Process index = 33
| Process components:
| 1: 'models_ccww_template_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_template'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.2092827E+03 5.58E+02 10.72 1.07* 28.03
|-----------------------------------------------------------------------------|
1 99 5.2092827E+03 5.58E+02 10.72 1.07 28.03
|=============================================================================|
seed = 32
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 32
| Initializing integration for process models_ccww_threeshl:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_threeshl.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_threeshl'
| Library name = 'model_test_1_lib'
| Process index = 34
| Process components:
| 1: 'models_ccww_threeshl_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 5 channels, 2 dimensions
| Phase space: found 5 channels, collected in 3 groves.
| Phase space: Using 5 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_threeshl'
| Integrate: iterations = 1:100
| Integrator: 3 chains, 5 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 8.1746005E+03 6.73E+02 8.23 0.82* 42.96
|-----------------------------------------------------------------------------|
1 100 8.1746005E+03 6.73E+02 8.23 0.82 42.96
|=============================================================================|
seed = 33
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 33
| Initializing integration for process models_ccww_threeshl_nohf:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_threeshl_nohf.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_threeshl_nohf'
| Library name = 'model_test_1_lib'
| Process index = 35
| Process components:
| 1: 'models_ccww_threeshl_nohf_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_threeshl_nohf'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.5389875E+03 6.31E+02 9.65 0.96* 32.66
|-----------------------------------------------------------------------------|
1 99 6.5389875E+03 6.31E+02 9.65 0.96 32.66
|=============================================================================|
seed = 34
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 34
| Initializing integration for process models_ccww_ued:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2500000E+00 GeV)
| cbar (mass = 1.2500000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_ued.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_ued'
| Library name = 'model_test_1_lib'
| Process index = 36
| Process components:
| 1: 'models_ccww_ued_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_ued'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.9392959E+08 3.86E+07 6.50 0.65* 41.63
|-----------------------------------------------------------------------------|
1 99 5.9392959E+08 3.86E+07 6.50 0.65 41.63
|=============================================================================|
seed = 35
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 35
| Initializing integration for process models_wwww_ssc:
| Beam structure: [any particles]
| Beam data (collision):
| W+ (mass = 8.0419000E+01 GeV)
| W- (mass = 8.0419000E+01 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_wwww_ssc.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_wwww_ssc'
| Library name = 'model_test_1_lib'
| Process index = 37
| Process components:
| 1: 'models_wwww_ssc_i1': W+, W- => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 6 channels, 2 dimensions
| Phase space: found 6 channels, collected in 2 groves.
| Phase space: Using 10 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_wwww_ssc'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 6 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 96 1.7800933E+08 1.31E+08 73.83 7.23* 7.03
|-----------------------------------------------------------------------------|
1 96 1.7800933E+08 1.31E+08 73.83 7.23 7.03
|=============================================================================|
seed = 36
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 36
| Initializing integration for process models_wwww_ssc_2:
| Beam structure: [any particles]
| Beam data (collision):
| W+ (mass = 8.0419000E+01 GeV)
| W- (mass = 8.0419000E+01 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_wwww_ssc_2.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_wwww_ssc_2'
| Library name = 'model_test_1_lib'
| Process index = 38
| Process components:
| 1: 'models_wwww_ssc_2_i1': W+, W- => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 6 channels, 2 dimensions
| Phase space: found 6 channels, collected in 2 groves.
| Phase space: Using 10 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_wwww_ssc_2'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 6 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 96 8.7439298E+06 4.17E+06 47.71 4.68* 10.61
|-----------------------------------------------------------------------------|
1 96 8.7439298E+06 4.17E+06 47.71 4.68 10.61
|=============================================================================|
seed = 37
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 37
| Initializing integration for process models_wwww_ssc_altt:
| Beam structure: [any particles]
| Beam data (collision):
| W+ (mass = 8.0419000E+01 GeV)
| W- (mass = 8.0419000E+01 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_wwww_ssc_altt.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_wwww_ssc_altt'
| Library name = 'model_test_1_lib'
| Process index = 39
| Process components:
| 1: 'models_wwww_ssc_altt_i1': W+, W- => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 6 channels, 2 dimensions
| Phase space: found 6 channels, collected in 2 groves.
| Phase space: Using 10 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_wwww_ssc_altt'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 6 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 96 9.7035892E+08 6.17E+08 63.60 6.23* 6.93
|-----------------------------------------------------------------------------|
1 96 9.7035892E+08 6.17E+08 63.60 6.23 6.93
|=============================================================================|
seed = 38
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 38
| Initializing integration for process models_wwww_alth:
| Beam structure: [any particles]
| Beam data (collision):
| W+ (mass = 8.0419000E+01 GeV)
| W- (mass = 8.0419000E+01 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_wwww_alth.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_wwww_alth'
| Library name = 'model_test_1_lib'
| Process index = 40
| Process components:
| 1: 'models_wwww_alth_i1': W+, W- => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 6 channels, 2 dimensions
| Phase space: found 6 channels, collected in 2 groves.
| Phase space: Using 10 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_wwww_alth'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 6 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 96 2.3538217E+08 2.26E+08 96.08 9.41* 6.39
|-----------------------------------------------------------------------------|
1 96 2.3538217E+08 2.26E+08 96.08 9.41 6.39
|=============================================================================|
seed = 39
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 39
| Initializing integration for process models_ccww_xdim:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_xdim.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_xdim'
| Library name = 'model_test_1_lib'
| Process index = 41
| Process components:
| 1: 'models_ccww_xdim_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_xdim'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 6.5751622E+08 4.44E+07 6.75 0.67* 43.94
|-----------------------------------------------------------------------------|
1 99 6.5751622E+08 4.44E+07 6.75 0.67 43.94
|=============================================================================|
seed = 40
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 40
| Initializing integration for process models_ccww_wzw:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_wzw.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_wzw'
| Library name = 'model_test_1_lib'
| Process index = 42
| Process components:
| 1: 'models_ccww_wzw_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_wzw'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.9222102E+03 6.23E+02 10.52 1.05* 31.63
|-----------------------------------------------------------------------------|
1 99 5.9222102E+03 6.23E+02 10.52 1.05 31.63
|=============================================================================|
seed = 41
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 41
| Initializing integration for process models_ccww_zprime:
| Beam structure: [any particles]
| Beam data (collision):
| c (mass = 1.2000000E+00 GeV)
| cbar (mass = 1.2000000E+00 GeV)
| sqrts = 2.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'models_ccww_zprime.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'models_ccww_zprime'
| Library name = 'model_test_1_lib'
| Process index = 43
| Process components:
| 1: 'models_ccww_zprime_i1': c, cbar => W+, W- [omega]
| ------------------------------------------------------------------------
| Phase space: 3 channels, 2 dimensions
| Phase space: found 3 channels, collected in 2 groves.
| Phase space: Using 3 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'models_ccww_zprime'
| Integrate: iterations = 1:100
| Integrator: 2 chains, 3 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 99 5.6983638E+03 6.02E+02 10.57 1.05* 30.61
|-----------------------------------------------------------------------------|
1 99 5.6983638E+03 6.02E+02 10.57 1.05 30.61
|=============================================================================|
-models_ccww_zprime:
- 5.6983638E+03 +- 6.02E+02 fb
-models_ccww_wzw:
- 5.9222102E+03 +- 6.23E+02 fb
-models_ccww_xdim:
- 6.5751622E+08 +- 4.44E+07 fb
-models_wwww_alth:
- 2.3538217E+08 +- 2.26E+08 fb
-models_wwww_ssc_altt:
- 9.7035892E+08 +- 6.17E+08 fb
-models_wwww_ssc_2:
- 8.7439298E+06 +- 4.17E+06 fb
-models_wwww_ssc:
- 1.7800933E+08 +- 1.31E+08 fb
-models_ccww_ued:
- 5.9392959E+08 +- 3.86E+07 fb
-models_ccww_threeshl_nohf:
- 6.5389875E+03 +- 6.31E+02 fb
-models_ccww_threeshl:
- 8.1746005E+03 +- 6.73E+02 fb
-models_ccww_template:
- 5.2092827E+03 +- 5.58E+02 fb
-models_ccww_simplest_univ:
- 6.4988268E+03 +- 6.33E+02 fb
-models_ccww_simplest:
- 7.7043505E+03 +- 6.46E+02 fb
-models_ccww_sm_tt_thresh:
- 7.1165240E+03 +- 6.76E+02 fb
-models_ccww_sm_higgs_ckm:
- 7.2866110E+03 +- 6.44E+02 fb
-models_ccww_sm_higgs:
- 6.1901689E+03 +- 5.99E+02 fb
-models_ccww_sm_top_anom:
- 5.0274506E+03 +- 5.41E+02 fb
-models_ccww_sm_top:
- 6.7123251E+03 +- 6.25E+02 fb
-models_wwww_noh_rx:
- 2.1032248E+10 +- 1.99E+10 fb
-models_wwww_sm_ul:
- 9.7080025E+08 +- 7.49E+08 fb
-models_wwww_sm_rx:
- 3.0227479E+07 +- 9.65E+06 fb
-models_ccww_sm_dim6:
- 6.3233409E+03 +- 5.61E+02 fb
-models_ccww_sm_ac_ckm:
- 5.6718111E+03 +- 6.23E+02 fb
-models_ccww_sm_ac:
- 5.7751152E+03 +- 5.94E+02 fb
-models_ccww_sm_ckm:
- 5.8798557E+03 +- 5.74E+02 fb
-models_ccww_sm:
- 5.4136006E+03 +- 5.84E+02 fb
-models_eemm_qed:
- 2.1772937E+03 +- 4.57E+01 fb
-models_uudd_qcd:
- 1.2587507E+05 +- 2.94E+03 fb
-models_ccww_psssm:
- 6.4182194E+08 +- 5.96E+07 fb
-models_ccww_nmssm_hgg:
- 5.8020707E+03 +- 5.14E+02 fb
-models_ccww_nmssm_ckm:
- 5.6207771E+03 +- 5.42E+02 fb
-models_ccww_nmssm:
- 5.3772942E+03 +- 5.41E+02 fb
-models_ccww_mssm_grav:
- 7.0900237E+03 +- 6.59E+02 fb
-models_ccww_mssm_ckm:
- 6.9673584E+03 +- 6.29E+02 fb
-models_ccww_mssm:
- 5.9494213E+03 +- 6.28E+02 fb
-models_ccww_littlest_tpar:
- 6.2761051E+03 +- 5.73E+02 fb
-models_ccww_littlest_eta:
- 5.9060694E+03 +- 5.73E+02 fb
-models_ccww_littlest:
- 6.7081379E+03 +- 5.93E+02 fb
-models_ccww_hsext:
- 8.3080339E+05 +- 5.36E+04 fb
-models_ccww_grav_test:
- 5.5673184E+03 +- 5.70E+02 fb
-models_ccww_thdm_ckm:
- 7.3770184E+03 +- 6.73E+02 fb
models_ccww_thdm:
- 7.5144851E+03 +- 6.76E+02 fb
+ 7.5144851E+03 +- 6.76E+02 fb ( 9.0 %)
+models_ccww_thdm_ckm:
+ 7.3770184E+03 +- 6.73E+02 fb ( 9.1 %)
+models_ccww_grav_test:
+ 5.5673184E+03 +- 5.70E+02 fb ( 10. %)
+models_ccww_hsext:
+ 8.3080339E+05 +- 5.36E+04 fb ( 6.5 %)
+models_ccww_littlest:
+ 6.7081379E+03 +- 5.93E+02 fb ( 8.8 %)
+models_ccww_littlest_eta:
+ 5.9060694E+03 +- 5.73E+02 fb ( 9.7 %)
+models_ccww_littlest_tpar:
+ 6.2761051E+03 +- 5.73E+02 fb ( 9.1 %)
+models_ccww_mssm:
+ 5.9494213E+03 +- 6.28E+02 fb ( 11. %)
+models_ccww_mssm_ckm:
+ 6.9673584E+03 +- 6.29E+02 fb ( 9.0 %)
+models_ccww_mssm_grav:
+ 7.0900237E+03 +- 6.59E+02 fb ( 9.3 %)
+models_ccww_nmssm:
+ 5.3772942E+03 +- 5.41E+02 fb ( 10. %)
+models_ccww_nmssm_ckm:
+ 5.6207771E+03 +- 5.42E+02 fb ( 9.6 %)
+models_ccww_nmssm_hgg:
+ 5.8020707E+03 +- 5.14E+02 fb ( 8.9 %)
+models_ccww_psssm:
+ 6.4182194E+08 +- 5.96E+07 fb ( 9.3 %)
+models_uudd_qcd:
+ 1.2587507E+05 +- 2.94E+03 fb ( 2.3 %)
+models_eemm_qed:
+ 2.1772937E+03 +- 4.57E+01 fb ( 2.1 %)
+models_ccww_sm:
+ 5.4136006E+03 +- 5.84E+02 fb ( 11. %)
+models_ccww_sm_ckm:
+ 5.8798557E+03 +- 5.74E+02 fb ( 9.8 %)
+models_ccww_sm_ac:
+ 5.7751152E+03 +- 5.94E+02 fb ( 10. %)
+models_ccww_sm_ac_ckm:
+ 5.6718111E+03 +- 6.23E+02 fb ( 11. %)
+models_ccww_sm_dim6:
+ 6.3233409E+03 +- 5.61E+02 fb ( 8.9 %)
+models_wwww_sm_rx:
+ 3.0227479E+07 +- 9.65E+06 fb ( 32. %)
+models_wwww_sm_ul:
+ 9.7080025E+08 +- 7.49E+08 fb ( 77. %)
+models_wwww_noh_rx:
+ 2.1032248E+10 +- 1.99E+10 fb ( 95. %)
+models_ccww_sm_top:
+ 6.7123251E+03 +- 6.25E+02 fb ( 9.3 %)
+models_ccww_sm_top_anom:
+ 5.0274506E+03 +- 5.41E+02 fb ( 11. %)
+models_ccww_sm_higgs:
+ 6.1901689E+03 +- 5.99E+02 fb ( 9.7 %)
+models_ccww_sm_higgs_ckm:
+ 7.2866110E+03 +- 6.44E+02 fb ( 8.8 %)
+models_ccww_sm_tt_thresh:
+ 7.1165240E+03 +- 6.76E+02 fb ( 9.5 %)
+models_ccww_simplest:
+ 7.7043505E+03 +- 6.46E+02 fb ( 8.4 %)
+models_ccww_simplest_univ:
+ 6.4988268E+03 +- 6.33E+02 fb ( 9.7 %)
+models_ccww_template:
+ 5.2092827E+03 +- 5.58E+02 fb ( 11. %)
+models_ccww_threeshl:
+ 8.1746005E+03 +- 6.73E+02 fb ( 8.2 %)
+models_ccww_threeshl_nohf:
+ 6.5389875E+03 +- 6.31E+02 fb ( 9.6 %)
+models_ccww_ued:
+ 5.9392959E+08 +- 3.86E+07 fb ( 6.5 %)
+models_wwww_ssc:
+ 1.7800933E+08 +- 1.31E+08 fb ( 74. %)
+models_wwww_ssc_2:
+ 8.7439298E+06 +- 4.17E+06 fb ( 48. %)
+models_wwww_ssc_altt:
+ 9.7035892E+08 +- 6.17E+08 fb ( 64. %)
+models_wwww_alth:
+ 2.3538217E+08 +- 2.26E+08 fb ( 96. %)
+models_ccww_xdim:
+ 6.5751622E+08 +- 4.44E+07 fb ( 6.7 %)
+models_ccww_wzw:
+ 5.9222102E+03 +- 6.23E+02 fb ( 11. %)
+models_ccww_zprime:
+ 5.6983638E+03 +- 6.02E+02 fb ( 11. %)
| There were no errors and 42 warning(s).
| WHIZARD run finished.
|=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/job_id_4.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/job_id_4.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/job_id_4.ref (revision 8158)
@@ -1,86 +1,86 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
seed = 0
| Process library 'job_id_4_lib': recorded process 'job_id_4_x'
openmp_num_threads = 1
?pacify = true
?sample_pacify = true
sqrts = 1.00000E+02
-$grid_path = "job_id_4_x.8001"
+$integrate_workspace = "job_id_4_x.8001"
$run_id = "8001.1"
| Integrate: current process library needs compilation
| Process library 'job_id_4_lib': compiling ...
| Process library 'job_id_4_lib': writing makefile
| Process library 'job_id_4_lib': removing old files
| Process library 'job_id_4_lib': writing driver
| Process library 'job_id_4_lib': creating source code
| Process library 'job_id_4_lib': compiling sources
| Process library 'job_id_4_lib': linking
| Process library 'job_id_4_lib': loading
| Process library 'job_id_4_lib': ... success.
| Integrate: compilation done
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Integrator: preparing VAMP grid directory 'job_id_4_x.8001'
| Initializing integration for process job_id_4_x:
| Run ID = "8001.1"
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 0.0000000E+00 GeV)
| e+ (mass = 0.0000000E+00 GeV)
| sqrts = 1.000000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
-| Phase space: writing configuration file 'job_id_4_x.8001.1.i1.phs'
+| Phase space: writing configuration file 'job_id_4_x.8001/job_id_4_x.8001.1.i1.phs'
| ------------------------------------------------------------------------
| Process [scattering]: 'job_id_4_x'
| Run ID = '8001.1'
| Library name = 'job_id_4_lib'
| Process index = 1
| Process components:
| 1: 'job_id_4_x_i1': e-, e+ => m-, m+ [omega]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'job_id_4_x'
| Integrate: iterations = 1:1000
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 1000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 800 8.680E+03 7.69E+00 0.09 0.03 66.6
|-----------------------------------------------------------------------------|
1 800 8.680E+03 7.69E+00 0.09 0.03 66.6
|=============================================================================|
n_events = 1
| Starting simulation for process 'job_id_4_x'
| Simulate: using integration grids from file 'job_id_4_x.8001/job_id_4_x.8001.1.m1.vg'
| 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] = 1.1520E-04
| Events: writing to raw file 'job_id_4_x.evx'
| Events: generating 1 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
| Events: actual unweighting efficiency = 100.00 %
| Events: closing raw file 'job_id_4_x.evx'
$out_file = "job_id_4_x.8001.3.dat"
| Opening file 'job_id_4_x.8001.3.dat' for output
| Writing analysis data to file 'job_id_4_x.8001.3.dat'
| Closing file 'job_id_4_x.8001.3.dat' for output
| There were no errors and 1 warning(s).
| WHIZARD run finished.
|=============================================================================|
* Files created by integrate:
-job_id_4_x.8001.1.i1.phs
job_id_4_x.8001.1.log
-* Files created in grid directory:
+* Files created in integrate workspace:
+job_id_4_x.8001/job_id_4_x.8001.1.i1.phs
job_id_4_x.8001/job_id_4_x.8001.1.m1.vg
Index: trunk/share/tests/functional_tests/ref-output/vars.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/vars.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/vars.ref (revision 8158)
@@ -1,372 +1,372 @@
?openmp_logging = false
[user variable] foo = -7.800000000000E-02
[user variable] bar = 1
[user variable] a = 2.010000000000E-05
[user variable] i = 3
[user variable] foo = 2.922000000000E+00
[user variable] i = 9
[user variable] foo = 2.922000000000E+00
[user variable] bar = 1
[user variable] i = 9
[user variable] k = 1
[user variable] k2 = 1.000000000000E+00
[user variable] i = -1
[user variable] k = 2
[user variable] k2 = 4.000000000000E+00
[user variable] i = -2
[user variable] k = 3
[user variable] k2 = 9.000000000000E+00
[user variable] i = -3
[user variable] k = 4
[user variable] k2 = 1.600000000000E+01
[user variable] i = -4
[user variable] k = 8
[user variable] k2 = 6.400000000000E+01
[user variable] i = -8
[user variable] i = 9
[user variable] MW = 7.980000000000E+01
[user variable] MW = 7.980000000000E+01
SM.mtau => 8.000000000000E-01
SM.mW => 8.011900000000E+01
SM.mW => 8.011900000000E+01
SM.sw* => 4.775372811515E-01
SM.mW => 7.500000000000E+01
SM.sw* => 5.688014954824E-01
SM.mW => 8.000000000000E+01
SM.sw* => 4.799305327664E-01
SM.mW => 8.050000000000E+01
SM.sw* => 4.697684723671E-01
SM.mW => 8.100000000000E+01
SM.sw* => 4.593162187090E-01
SM.mW => 8.150000000000E+01
SM.sw* => 4.485534858838E-01
SM.mW => 8.200000000000E+01
SM.sw* => 4.374573583998E-01
SM.mW => 8.300000000000E+01
SM.sw* => 4.141569403361E-01
SM.mW => 8.469722796445E+01
SM.sw* => 3.705366373038E-01
SM.mW => 8.642916174533E+01
SM.sw* => 3.188332912310E-01
SM.mW => 8.819651102555E+01
SM.sw* => 2.540459583362E-01
SM.mW => 9.000000000000E+01
SM.sw* => 1.609055729882E-01
mW is 80.119 and sw is: 0.4775
seed = 32
seed = 32
seed = 30
seed = 30
seed = 28
seed = 28
seed = 26
seed = 26
seed = 24
seed = 24
seed = 22
seed = 22
seed = 20
seed = 20
seed = 18
seed = 18
seed = 16
seed = 16
seed = 14
seed = 14
seed = 12
seed = 12
seed = 10
seed = 10
seed = 8
seed = 8
seed = 6
seed = 6
seed = 4
seed = 4
seed = 2
seed = 2
[user variable] $str = "foo"
[user variable] $str = "bar"
[user variable] ?ok = false
[user variable] ?ok = false
[user variable] ?ok = true
?sf_trace = false
?sf_allow_s_mapping = true
?hoppet_b_matching = false
?isr_recoil = false
?isr_keep_energy = false
?isr_handler = false
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
?circe1_generate = true
?circe1_map = true
?circe1_with_radiation = false
?circe2_polarized = true
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => true
?report_progress = true
[user variable] ?me_verbose = false
?omega_write_phs_output = false
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
?fatal_beam_decay = true
?helicity_selection_active = true
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
?unweighted = true
?negative_weights = false
?resonance_history = false
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
?polarized_events = false
?pacify = false
?out_advance = true
?stratified = true
?use_vamp_equivalences = true
?vamp_verbose = false
?vamp_history_global = true
?vamp_history_global_verbose = false
?vamp_history_channels = false
?vamp_history_channels_verbose = false
?integration_timer = true
?check_grid_file = true
?vis_channels = false
?check_phs_file = true
?phs_only = false
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
?normalize_bins = false
?y_log = false
?x_log = false
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
?analysis_file_only = false
?keep_flavors_when_clustering = false
?sample_pacify = false
?sample_select = true
?read_raw = true
?write_raw = true
?debug_process = true
?debug_transforms = true
?debug_decay = true
?debug_verbose = true
?dump_compressed = false
?dump_weights = false
?dump_summary = false
?dump_screen = false
?hepevt_ensure_order = false
?lhef_write_sqme_prc = true
?lhef_write_sqme_ref = false
?lhef_write_sqme_alt = true
?hepmc_output_cross_section = false
?allow_shower = true
?ps_fsr_active = false
?ps_isr_active = false
?ps_taudec_active = false
?muli_active = false
?shower_verbose = false
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
?ps_tauola_pol_vector = false
?mlm_matching = false
?powheg_matching = false
?powheg_use_singular_jacobian = false
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active* = false
?openmp_logging = false
?mpi_logging = false
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
?virtual_collinear_resonance_aware = true
?openloops_use_cms = true
?openloops_switch_off_muon_yukawa = false
?openloops_use_collier = true
?disable_subtraction = false
?vis_fks_regions = false
?combined_nlo_integration = false
?fixed_order_nlo_events = false
?check_event_weights_against_xsection = false
?keep_failed_events = false
?nlo_use_born_scale = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?powheg_rebuild_grids = true
?rebuild_events = true
[user variable] ?ok = true
[user variable] $str = "foo"
[user variable] $str = "foobar"
$sf_trace_file = ""
$lhapdf_dir = ""
$lhapdf_file = ""
$lhapdf_photon_file = ""
$pdf_builtin_set = "CTEQ6L"
$isr_handler_mode = "trivial"
$epa_handler_mode = "trivial"
$circe1_acc = "SBAND"
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
[undefined] $beam_events_file = [unknown string]
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
$model_name = "SM"
$method = "omega"
$restrictions = ""
$omega_flags = ""
$library_name = "vars_lib"
$rng_method = "tao"
$event_file_version = ""
$polarization_mode = "helicity"
$out_file = ""
$integration_method = "vamp"
$run_id = ""
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$phs_method = "default"
$phs_file = ""
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
$sample = ""
$sample_normalization = "auto"
$rescan_input_format = "raw"
$extension_raw = "evx"
$extension_default = "evt"
$debug_extension = "debug"
$dump_extension = "pset.dat"
$extension_hepevt = "hepevt"
$extension_ascii_short = "short.evt"
$extension_ascii_long = "long.evt"
$extension_athena = "athena.evt"
$extension_mokka = "mokka.evt"
$lhef_version = "2.0"
$lhef_extension = "lhe"
$extension_lha = "lha"
$extension_hepmc = "hepmc"
$extension_lcio = "slcio"
$extension_stdhep = "hep"
$extension_stdhep_up = "up.hep"
$extension_stdhep_ev4 = "ev4.hep"
$extension_hepevt_verb = "hepevt.verb"
$extension_lha_verb = "lha.verb"
$shower_method = "WHIZARD"
$ps_PYTHIA_PYGIVE = ""
$hadronization_method = "PYTHIA6"
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
$select_alpha_regions = ""
$virtual_selection = "Full"
$blha_ew_scheme = "alpha_qed"
$openloops_extra_cmd = ""
$fks_mapping_type = "default"
$resonances_exclude_particles = "default"
$gosam_filter_lo = ""
$gosam_filter_nlo = ""
$gosam_symmetries = "family,generation"
$gosam_fc = ""
$dalitz_plot = ""
$nlo_correction_type = "QCD"
$exclude_gauge_splittings = "c:b:t:e2:e3"
$fc => Fortran-compiler
$fcflags => Fortran-flags
[user variable] $str = "foobar"
[user variable] q = PDG(2)
[user variable] q = PDG(2, 1, -2, -1)
Q is only local and hence not not defined
******************************************************************************
*** ERROR: show: object 'Q' not found
******************************************************************************
| (WHIZARD run continues)
SM.u* = PDG(2)
[user variable] q = PDG(2, 1, -2, -1)
[user variable] i = 1
one = 1
[user variable] i = 2
two
[user variable] i = 3
three
[user variable] i = 4
four
[user variable] i = -1
[user variable] $str = "i<=0"
[user variable] i = 1
[user variable] $str = "i>0"
[user variable] i = 2
[user variable] $str = "i>1"
Testing the complex calculus
[user variable] ca = ( 2.000000000000E+00, 1.000000000000E+00)
[user variable] ca = ( 2.000000000000E+00, 1.000000000000E+00)
[user variable] ia = 2
[user variable] ia = 2
[user variable] ra = 2.000000000000E+00
[user variable] ra = 2.000000000000E+00
[user variable] cb = ( 3.000000000000E+00, 4.000000000000E+00)
[user variable] cb = ( 3.000000000000E+00, 4.000000000000E+00)
?pacify = true
[user variable] cc = ( 1.00000E+00, 0.00000E+00)
?pacify = true
[user variable] cc = ( 1.00000E+00, 0.00000E+00)
| There were 1 error(s) and no warnings.
| WHIZARD run finished.
|=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/pack_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/pack_1.ref (revision 0)
+++ trunk/share/tests/functional_tests/ref-output/pack_1.ref (revision 8158)
@@ -0,0 +1,10 @@
+Contents of directory pack_1.1:
+foo
+Contents of directory pack_1.2:
+bar
+Contents of file pack_1.3.tgz:
+pack_1.3/
+pack_1.3/foo
+Contents of file pack_1.4.tgz:
+pack_1.4/
+pack_1.4/bar
Index: trunk/share/tests/functional_tests/ref-output/show_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/show_1.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/show_1.ref (revision 8158)
@@ -1,359 +1,359 @@
?openmp_logging = false
?vis_history = false
?integration_timer = false
| Switching to model 'SM', scheme 'default'
| Process library 'show_1_lib': recorded process 'show_1_p1'
process_num_id = 77
| Process library 'show_1_lib': recorded process 'show_1_p2' (77)
| Process library 'show_1_lib': recorded process 'show_1_p3'
error_threshold = 1.000000000000E-08
| Integrate: current process library needs compilation
| Process library 'show_1_lib': compiling ...
| Process library 'show_1_lib': writing makefile
| Process library 'show_1_lib': removing old files
| Process library 'show_1_lib': writing driver
| Process library 'show_1_lib': creating source code
| Process library 'show_1_lib': compiling sources
| Process library 'show_1_lib': linking
| Process library 'show_1_lib': loading
| Process library 'show_1_lib': ... success.
| Integrate: compilation done
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 0
| Initializing integration for process show_1_p1:
| Beam structure: [any particles]
| Beam data (decay):
| H (mass = 1.2500000E+02 GeV)
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'show_1_p1.i1.phs'
| ------------------------------------------------------------------------
| Process [decay]: 'show_1_p1'
| Library name = 'show_1_lib'
| Process index = 1
| Process components:
| 1: 'show_1_p1_i1': H => b, bbar [omega]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'show_1_p1'
| Integrate: iterations not specified, using default
| Integrate: iterations = 1:100:""
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[GeV] Error[GeV] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 4.3122140E-03 0.00E+00 0.00 0.00* 100.00
|-----------------------------------------------------------------------------|
1 100 4.3122140E-03 0.00E+00 0.00 0.00 100.00
|=============================================================================|
| Unstable particle H: computed branching ratios:
| show_1_p1: 1.0000000E+00 b, bbar
| Total width = 4.3122140E-03 GeV (computed)
| = 4.1430000E-03 GeV (preset)
| Decay options: helicity treated exactly
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 1
| Initializing integration for process show_1_p2:
| Beam structure: [any particles]
| Beam data (decay):
| W+ (mass = 8.0419000E+01 GeV)
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'show_1_p2.i1.phs'
| ------------------------------------------------------------------------
| Process [decay]: 'show_1_p2'
| ID (num) = 77
| Library name = 'show_1_lib'
| Process index = 2
| Process components:
| 1: 'show_1_p2_i1': W+ => e+, nue [omega]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'show_1_p2'
| Integrate: iterations not specified, using default
| Integrate: iterations = 1:100:""
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[GeV] Error[GeV] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 2.2756406E-01 0.00E+00 0.00 0.00* 100.00
|-----------------------------------------------------------------------------|
1 100 2.2756406E-01 0.00E+00 0.00 0.00 100.00
|=============================================================================|
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 2
| Initializing integration for process show_1_p3:
| Beam structure: [any particles]
| Beam data (decay):
| W+ (mass = 8.0419000E+01 GeV)
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'show_1_p3.i1.phs'
| ------------------------------------------------------------------------
| Process [decay]: 'show_1_p3'
| Library name = 'show_1_lib'
| Process index = 3
| Process components:
| 1: 'show_1_p3_i1': W+ => mu+, numu [omega]
| ------------------------------------------------------------------------
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
Warning: No cuts have been defined.
| Starting integration for process 'show_1_p3'
| Integrate: iterations not specified, using default
| Integrate: iterations = 1:100:""
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 100 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[GeV] Error[GeV] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 100 2.2756347E-01 0.00E+00 0.00 0.00* 100.00
|-----------------------------------------------------------------------------|
1 100 2.2756347E-01 0.00E+00 0.00 0.00 100.00
|=============================================================================|
| Unstable particle W+: computed branching ratios:
| show_1_p2: 5.0000065E-01 e+, nue
| show_1_p3: 4.9999935E-01 mu+, numu
| Total width = 4.5512753E-01 GeV (computed)
| = 2.0490000E+00 GeV (preset)
| Decay options: helicity treated exactly
| Particle b declared as polarized
| Particle bbar declared as polarized
sqrts = 1.400000000000E+04
$lhapdf_dir = "/lhapdf/dir"
$lhapdf_file = "datafile.lhapdf"
$lhapdf_photon_file = "photonfile.lhapdf"
lhapdf_member = 4
lhapdf_photon_scheme = 1
Model: SM
Scheme: 'default' (1)
Particles:
d 1
dbar -1
u 2
ubar -2
s 3
sbar -3
c 4
cbar -4
b 5 polarized
bbar -5 polarized
t 6
tbar -6
e- 11
e+ -11
nue 12
nuebar -12
mu- 13
mu+ -13
numu 14
numubar -14
tau- 15
tau+ -15
nutau 16
nutaubar -16
gl 21
A 22
Z 23
W+ 24 decays: show_1_p2 show_1_p3
W- -24
H 25 decays: show_1_p1
p 2212
pbar -2212
hr 90
hr1 91
hr3 92
hr3bar -92
hr8 93
Independent parameters:
GF = 1.166390000000E-05
mZ = 9.118820000000E+01
mW = 8.041900000000E+01
mH = 1.250000000000E+02
alphas = 1.178000000000E-01
me = 5.109970000000E-04
mmu = 1.056583890000E-01
mtau = 1.777050000000E+00
ms = 9.500000000000E-02
mc = 1.200000000000E+00
mb = 4.200000000000E+00
mtop = 1.731000000000E+02
wtop = 1.523000000000E+00
wZ = 2.443000000000E+00
wW = 2.049000000000E+00
wH = 4.143000000000E-03
khgaz = 0.000000000000E+00
khgaga = 0.000000000000E+00
khgg = 0.000000000000E+00
xi0 = 0.000000000000E+00
xipm = 0.000000000000E+00
Derived parameters:
v = 2.462184581018E+02
cw = 8.819013863636E-01
sw = 4.714339240339E-01
ee = 3.079561542961E-01
alpha_em_i = 1.325049458125E+02
Process library: show_1_lib
external = T
makefile exists = T
driver exists = T
code status = active
Processes:
show_1_p1 [SM]
show_1_p1_i1: H => b, bbar [omega]
show_1_p2 (77) [SM]
show_1_p2_i1: W+ => e+, nue [omega]
show_1_p3 [SM]
show_1_p3_i1: W+ => mu+, numu [omega]
Process library: show_1_lib
external = T
makefile exists = T
driver exists = T
code status = active
Processes:
show_1_p1 [SM]
show_1_p1_i1: H => b, bbar [omega]
show_1_p2 (77) [SM]
show_1_p2_i1: W+ => e+, nue [omega]
show_1_p3 [SM]
show_1_p3_i1: W+ => mu+, numu [omega]
Beam structure: p, p => pdf_builtin
sqrts = 1.400000000000E+04 GeV
PDF set = "CTEQ6L"
Beam structure: p, p => lhapdf
sqrts = 1.400000000000E+04 GeV
LHAPDF dir = "/lhapdf/dir"
LHAPDF file = "datafile.lhapdf"
LHAPDF member = 4
Beam structure: p, p => lhapdf_photon
sqrts = 1.400000000000E+04 GeV
LHAPDF dir = "/lhapdf/dir"
LHAPDF file = "photonfile.lhapdf"
LHAPDF member = 4
LHAPDF scheme = 1
Beam structure: e-, e+ => isr
sqrts = 1.400000000000E+04 GeV
ISR alpha = 0.000000000000E+00
ISR Q max = 0.000000000000E+00
ISR mass = 0.000000000000E+00
ISR order = 3
ISR recoil = F
ISR energy cons. = F
Beam structure: e-, e+ => epa
sqrts = 1.400000000000E+04 GeV
EPA alpha = 0.000000000000E+00
EPA x min = 0.000000000000E+00
EPA Q min = 0.000000000000E+00
EPA E max = 0.000000000000E+00
EPA mass = 0.000000000000E+00
EPA recoil = F
EPA energy cons. = F
iterations = 1:1000:"gw", 3:5000:"gw"
Expression: cuts (parse tree):
+ SEQUENCE <lexpr> = <lsinglet>
+ SEQUENCE <lsinglet> = <lterm>
| + SEQUENCE <lterm> = true
| | + KEYWORD true = [keyword] true
Expression: scale (parse tree):
+ SEQUENCE <expr> = <term>
+ SEQUENCE <term> = <factor>
| + SEQUENCE <factor> = <integer_value>
| | + SEQUENCE <integer_value> = <integer_literal>
| | | + INTEGER <integer_literal> = 1
Expression: factorization_scale (parse tree):
+ SEQUENCE <expr> = <term>
+ SEQUENCE <term> = <factor>
| + SEQUENCE <factor> = <integer_value>
| | + SEQUENCE <integer_value> = <integer_literal>
| | | + INTEGER <integer_literal> = 2
Expression: renormalization_scale (parse tree):
+ SEQUENCE <expr> = <term>
+ SEQUENCE <term> = <factor>
| + SEQUENCE <factor> = <integer_value>
| | + SEQUENCE <integer_value> = <integer_literal>
| | | + INTEGER <integer_literal> = 3
Expression: weight (parse tree):
+ SEQUENCE <expr> = <term>
+ SEQUENCE <term> = <factor>
| + SEQUENCE <factor> = <integer_value>
| | + SEQUENCE <integer_value> = <integer_literal>
| | | + INTEGER <integer_literal> = 4
Expression: selection (parse tree):
+ SEQUENCE <lexpr> = <lsinglet>
+ SEQUENCE <lsinglet> = <lterm>
| + SEQUENCE <lterm> = false
| | + KEYWORD false = [keyword] false
Expression: reweight (parse tree):
+ SEQUENCE <expr> = <term>
+ SEQUENCE <term> = <factor>
| + SEQUENCE <factor> = <integer_value>
| | + SEQUENCE <integer_value> = <integer_literal>
| | | + INTEGER <integer_literal> = 5
Expression: analysis (parse tree):
+ SEQUENCE <lexpr> = <lsinglet>
+ SEQUENCE <lsinglet> = <lterm>
| + SEQUENCE <lterm> = true
| | + KEYWORD true = [keyword] true
sqrts = 1.400000000000E+04
$lhapdf_dir = "/lhapdf/dir"
?unweighted = true
SM.e1* = PDG(11)
SM.me => 5.109970000000E-04
[user variable] i = 42
[user variable] i = 42
Process: show_1_p1 [SM]
1: H => b, bbar [omega]
- Computed width = 4.3122140E-03 +- 0.00E+00 GeV
+ Computed width = 4.3122140E-03 +- 0.00E+00 GeV ( 0. %)
Process: show_1_p2 (77) [SM]
1: W+ => e+, nue [omega]
- Computed width = 2.2756406E-01 +- 0.00E+00 GeV
-show_1_p3:
- 2.2756347E-01 +- 0.00E+00 GeV
-show_1_p2 (77):
- 2.2756406E-01 +- 0.00E+00 GeV
+ Computed width = 2.2756406E-01 +- 0.00E+00 GeV ( 0. %)
show_1_p1:
- 4.3122140E-03 +- 0.00E+00 GeV
+ 4.3122140E-03 +- 0.00E+00 GeV ( 0. %)
+show_1_p2 (77):
+ 2.2756406E-01 +- 0.00E+00 GeV ( 0. %)
+show_1_p3:
+ 2.2756347E-01 +- 0.00E+00 GeV ( 0. %)
[user variable] i = 2
| expect: success
| Summary of value checks:
| Failures: 0 / Total: 1
Stable particles: d dbar u ubar s sbar c cbar b bbar t tbar e- e+ nue nuebar mu- mu+ numu numubar tau- tau+ nutau nutaubar gl A Z W- p pbar hr hr1 hr3 hr3bar hr8
Unstable particles: W+ H
Unstable particle W+: computed branching ratios:
show_1_p2: 5.0000065E-01 e+, nue
show_1_p3: 4.9999935E-01 mu+, numu
Total width = 4.5512753E-01 GeV (computed)
= 2.0490000E+00 GeV (preset)
Decay options: helicity treated exactly
Unstable particle H: computed branching ratios:
show_1_p1: 1.0000000E+00 b, bbar
Total width = 4.3122140E-03 GeV (computed)
= 4.1430000E-03 GeV (preset)
Decay options: helicity treated exactly
Polarized particles: b bbar
Unpolarized particles: d dbar u ubar s sbar c cbar t tbar e- e+ nue nuebar mu- mu+ numu numubar tau- tau+ nutau nutaubar gl A Z W+ W- H p pbar hr hr1 hr3 hr3bar hr8
integral(show_1_p1) = 4.312214000135E-03
error(show_1_p1) = 0.000000000000E+00
| Summary of value checks:
| Failures: 0 / Total: 1
| There were no errors and 3 warning(s).
| WHIZARD run finished.
|=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/show_5.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/show_5.ref (revision 0)
+++ trunk/share/tests/functional_tests/ref-output/show_5.ref (revision 8158)
@@ -0,0 +1,258 @@
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+seed = 0
+| Process library 'show_5_lib': recorded process 'show_5_a'
+| Process library 'show_5_lib': recorded process 'show_5_b'
+openmp_num_threads = 1
+?pacify = true
+?sample_pacify = true
+sqrts = 2.00000E+02
+$run_id = "a200"
+| Integrate: current process library needs compilation
+| Process library 'show_5_lib': compiling ...
+| Process library 'show_5_lib': writing makefile
+| Process library 'show_5_lib': removing old files
+| Process library 'show_5_lib': writing driver
+| Process library 'show_5_lib': creating source code
+| Process library 'show_5_lib': compiling sources
+| Process library 'show_5_lib': linking
+| Process library 'show_5_lib': loading
+| Process library 'show_5_lib': ... success.
+| Integrate: compilation done
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 0
+| Initializing integration for process show_5_a:
+| Run ID = "a200"
+| Beam structure: [any particles]
+| Beam data (collision):
+| e- (mass = 0.0000000E+00 GeV)
+| e+ (mass = 0.0000000E+00 GeV)
+| sqrts = 2.000000000000E+02 GeV
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'show_5_a.a200.i1.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'show_5_a'
+| Run ID = 'a200'
+| Library name = 'show_5_lib'
+| Process index = 1
+| Process components:
+| 1: 'show_5_a_i1': e-, e+ => mu-, mu+ [omega]
+| ------------------------------------------------------------------------
+| Phase space: 2 channels, 2 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+Warning: No cuts have been defined.
+| Starting integration for process 'show_5_a'
+| Integrate: iterations = 1:1000
+| Integrator: 2 chains, 2 channels, 2 dimensions
+| Integrator: Using VAMP channel equivalences
+| Integrator: 1000 initial calls, 20 bins, stratified = T
+| Integrator: VAMP
+|=============================================================================|
+| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
+|=============================================================================|
+ 1 784 2.845E+03 5.43E+00 0.19 0.05 38.4
+|-----------------------------------------------------------------------------|
+ 1 784 2.845E+03 5.43E+00 0.19 0.05 38.4
+|=============================================================================|
+$run_id = "b200"
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 1
+| Initializing integration for process show_5_b:
+| Run ID = "b200"
+| Beam structure: [any particles]
+| Beam data (collision):
+| e- (mass = 0.0000000E+00 GeV)
+| e+ (mass = 0.0000000E+00 GeV)
+| sqrts = 2.000000000000E+02 GeV
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'show_5_b.b200.i1.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'show_5_b'
+| Run ID = 'b200'
+| Library name = 'show_5_lib'
+| Process index = 2
+| Process components:
+| 1: 'show_5_b_i1': e-, e+ => W+, W- [omega]
+| ------------------------------------------------------------------------
+| Phase space: 3 channels, 2 dimensions
+| Phase space: found 3 channels, collected in 2 groves.
+| Phase space: Using 3 equivalences between channels.
+| Phase space: wood
+Warning: No cuts have been defined.
+| Starting integration for process 'show_5_b'
+| Integrate: iterations = 1:1000
+| Integrator: 2 chains, 3 channels, 2 dimensions
+| Integrator: Using VAMP channel equivalences
+| Integrator: 1000 initial calls, 20 bins, stratified = T
+| Integrator: VAMP
+|=============================================================================|
+| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
+|=============================================================================|
+ 1 864 1.937E+04 1.39E+02 0.72 0.21 34.7
+|-----------------------------------------------------------------------------|
+ 1 864 1.937E+04 1.39E+02 0.72 0.21 34.7
+|=============================================================================|
+Run a200: show_5_a:
+ 2.8454063E+03 +- 5.43E+00 fb ( 0.19 %)
+Run b200: show_5_b:
+ 1.9374705E+04 +- 1.39E+02 fb ( 0.72 %)
+| Exporting integration results to outer environment
+sqrts = 3.00000E+02
+$run_id = "a300"
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 2
+| Initializing integration for process show_5_a:
+| Run ID = "a300"
+| Beam structure: [any particles]
+| Beam data (collision):
+| e- (mass = 0.0000000E+00 GeV)
+| e+ (mass = 0.0000000E+00 GeV)
+| sqrts = 3.000000000000E+02 GeV
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'show_5_a.a300.i1.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'show_5_a'
+| Run ID = 'a300'
+| Library name = 'show_5_lib'
+| Process index = 1
+| Process components:
+| 1: 'show_5_a_i1': e-, e+ => mu-, mu+ [omega]
+| ------------------------------------------------------------------------
+| Phase space: 2 channels, 2 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+Warning: No cuts have been defined.
+| Starting integration for process 'show_5_a'
+| Integrate: iterations = 1:1000
+| Integrator: 2 chains, 2 channels, 2 dimensions
+| Integrator: Using VAMP channel equivalences
+| Integrator: 1000 initial calls, 20 bins, stratified = T
+| Integrator: VAMP
+|=============================================================================|
+| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
+|=============================================================================|
+ 1 784 1.209E+03 2.31E+00 0.19 0.05 39.9
+|-----------------------------------------------------------------------------|
+ 1 784 1.209E+03 2.31E+00 0.19 0.05 39.9
+|=============================================================================|
+$run_id = "b300"
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 3
+| Initializing integration for process show_5_b:
+| Run ID = "b300"
+| Beam structure: [any particles]
+| Beam data (collision):
+| e- (mass = 0.0000000E+00 GeV)
+| e+ (mass = 0.0000000E+00 GeV)
+| sqrts = 3.000000000000E+02 GeV
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'show_5_b.b300.i1.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'show_5_b'
+| Run ID = 'b300'
+| Library name = 'show_5_lib'
+| Process index = 2
+| Process components:
+| 1: 'show_5_b_i1': e-, e+ => W+, W- [omega]
+| ------------------------------------------------------------------------
+| Phase space: 3 channels, 2 dimensions
+| Phase space: found 3 channels, collected in 2 groves.
+| Phase space: Using 3 equivalences between channels.
+| Phase space: wood
+Warning: No cuts have been defined.
+| Starting integration for process 'show_5_b'
+| Integrate: iterations = 1:1000
+| Integrator: 2 chains, 3 channels, 2 dimensions
+| Integrator: Using VAMP channel equivalences
+| Integrator: 1000 initial calls, 20 bins, stratified = T
+| Integrator: VAMP
+|=============================================================================|
+| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
+|=============================================================================|
+ 1 864 1.341E+04 1.15E+02 0.86 0.25 26.7
+|-----------------------------------------------------------------------------|
+ 1 864 1.341E+04 1.15E+02 0.86 0.25 26.7
+|=============================================================================|
+Run a300: show_5_a:
+ 1.2094653E+03 +- 2.31E+00 fb ( 0.19 %)
+Run b300: show_5_b:
+ 1.3409389E+04 +- 1.15E+02 fb ( 0.86 %)
+| Exporting integration results to outer environment
+integral(show_5_a) = 1.20947E+03
+integral(show_5_b) = 1.34094E+04
+sqrts = 5.00000E+02
+$run_id = "a500"
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 4
+| Initializing integration for process show_5_a:
+| Run ID = "a500"
+| Beam structure: [any particles]
+| Beam data (collision):
+| e- (mass = 0.0000000E+00 GeV)
+| e+ (mass = 0.0000000E+00 GeV)
+| sqrts = 5.000000000000E+02 GeV
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'show_5_a.a500.i1.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'show_5_a'
+| Run ID = 'a500'
+| Library name = 'show_5_lib'
+| Process index = 1
+| Process components:
+| 1: 'show_5_a_i1': e-, e+ => mu-, mu+ [omega]
+| ------------------------------------------------------------------------
+| Phase space: 2 channels, 2 dimensions
+| Phase space: found 2 channels, collected in 2 groves.
+| Phase space: Using 2 equivalences between channels.
+| Phase space: wood
+Warning: No cuts have been defined.
+| Starting integration for process 'show_5_a'
+| Integrate: iterations = 1:1000
+| Integrator: 2 chains, 2 channels, 2 dimensions
+| Integrator: Using VAMP channel equivalences
+| Integrator: 1000 initial calls, 20 bins, stratified = T
+| Integrator: VAMP
+|=============================================================================|
+| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
+|=============================================================================|
+ 1 784 4.290E+02 8.39E-01 0.20 0.05 40.4
+|-----------------------------------------------------------------------------|
+ 1 784 4.290E+02 8.39E-01 0.20 0.05 40.4
+|=============================================================================|
+Run a500: show_5_a:
+ 4.2897782E+02 +- 8.39E-01 fb ( 0.20 %)
+integral(show_5_a) = 4.28978E+02
+integral(show_5_b) = 1.34094E+04
+$out_file = "show_5.results.dat"
+| Opening file 'show_5.results.dat' for output
+| show: copying output to file 'show_5.results.dat'
+Run a200: show_5_a:
+ 2.8454063E+03 +- 5.43E+00 fb ( 0.19 %)
+Run b200: show_5_b:
+ 1.9374705E+04 +- 1.39E+02 fb ( 0.72 %)
+Run a300: show_5_a:
+ 1.2094653E+03 +- 2.31E+00 fb ( 0.19 %)
+Run b300: show_5_b:
+ 1.3409389E+04 +- 1.15E+02 fb ( 0.86 %)
+| Closing file 'show_5.results.dat' for output
+| There were no errors and 5 warning(s).
+| WHIZARD run finished.
+|=============================================================================|
+Contents of file show_5.results.dat:
+Run a200: show_5_a:
+ 2.8454063E+03 +- 5.43E+00 fb ( 0.19 %)
+Run b200: show_5_b:
+ 1.9374705E+04 +- 1.39E+02 fb ( 0.72 %)
+Run a300: show_5_a:
+ 1.2094653E+03 +- 2.31E+00 fb ( 0.19 %)
+Run b300: show_5_b:
+ 1.3409389E+04 +- 1.15E+02 fb ( 0.86 %)
Index: trunk/share/tests/functional_tests/ref-output/process_log.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/process_log.ref (revision 8157)
+++ trunk/share/tests/functional_tests/ref-output/process_log.ref (revision 8158)
@@ -1,538 +1,538 @@
###############################################################################
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]
------------------------------------------------------------------------
Variable list: [not shown]
###############################################################################
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_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging = true
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 1
$model_name = "QED"
[undefined] process_num_id = [unknown integer]
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "process_log_lib"
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
alphas_order = 0
alphas_nf = 5
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
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
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$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
?keep_flavors_when_clustering = false
$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
$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_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_grid_sampling_points = 500000
powheg_pt_min = 1.000000000000E+00
powheg_lambda = 2.000000000000E-01
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp => false
?openmp_is_active = false
openmp_num_threads_default = 1
openmp_num_threads = 1
?openmp_logging = false
?mpi_logging = false
$born_me_method = ""
$loop_me_method = ""
$correlation_me_method = ""
$real_tree_me_method = ""
$dglap_me_method = ""
?test_soft_limit = false
?test_coll_limit = false
?test_anti_coll_limit = false
$select_alpha_regions = ""
$virtual_selection = "Full"
?virtual_collinear_resonance_aware = true
blha_top_yukawa = -1.000000000000E+00
$blha_ew_scheme = "alpha_qed"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
?openloops_use_collier = true
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 1.000000000000E-07
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_zero = 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 = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
real_partition_scale = 1.000000000000E+01
$fc = Fortran-compiler
$fcflags = Fortran-flags
?rebuild_library = true
?recompile_library = false
?rebuild_phase_space = true
?rebuild_grids = true
?powheg_rebuild_grids = true
?rebuild_events = true
[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]
###############################################################################
Index: trunk/share/tests/functional_tests/pack_1.sin
===================================================================
Index: trunk/share/tests/functional_tests/show_5.sin
===================================================================
--- trunk/share/tests/functional_tests/show_5.sin (revision 0)
+++ trunk/share/tests/functional_tests/show_5.sin (revision 8158)
@@ -0,0 +1,52 @@
+# SINDARIN input for WHIZARD self-test
+
+model = "SM"
+me = 0
+mmu = 0
+
+?logging = true
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+
+seed = 0
+
+process show_5_a = "e-", "e+" => "mu-", "mu+"
+process show_5_b = "e-", "e+" => "W+", "W-"
+
+!!! Tests should be run single-threaded
+openmp_num_threads = 1
+?pacify = true
+?sample_pacify = true
+
+iterations = 1:1000
+
+# Results to be exported
+scan sqrts = (200 GeV, 300 GeV) {
+ export (results)
+ $run_id = sprintf "a%d" (int (sqrts))
+ integrate (show_5_a)
+ $run_id = sprintf "b%d" (int (sqrts))
+ integrate (show_5_b)
+ show (results)
+}
+show (integral (show_5_a))
+show (integral (show_5_b))
+
+# Results not to be exported
+scan sqrts = (500 GeV) {
+ $run_id = sprintf "a%d" (int (sqrts))
+ integrate (show_5_a)
+ show (results)
+}
+show (integral (show_5_a))
+show (integral (show_5_b))
+
+# Results should also go there
+$out_file = "show_5.results.dat"
+open_out ($out_file)
+
+# Now show (only) results that were exported
+show (results)
+
+close_out ($out_file)
Index: trunk/share/tests/functional_tests/job_id_4.sin
===================================================================
--- trunk/share/tests/functional_tests/job_id_4.sin (revision 8157)
+++ trunk/share/tests/functional_tests/job_id_4.sin (revision 8158)
@@ -1,39 +1,39 @@
# SINDARIN input for WHIZARD self-test
model = "QED"
ee = 0.30286
me = 0
mmu = 0
?logging = true
?openmp_logging = false
?vis_history = false
?integration_timer = false
seed = 0
process job_id_4_x = "e-", "e+" => "mu-", "mu+"
!!! Tests should be run single-threaded
openmp_num_threads = 1
?pacify = true
?sample_pacify = true
sqrts = 100
-$grid_path = "job_id_4_x." & $job_id
+$integrate_workspace = "job_id_4_x." & $job_id
integrate (job_id_4_x) {
$run_id = $job_id & ".1"
iterations = 1:1000
}
observable o1
simulate (job_id_4_x) {
n_events = 1
}
write_analysis {
$out_file = "job_id_4_x." & $job_id & ".3.dat"
}
Index: trunk/share/tests/unit_tests/ref-output/rt_data_11.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/rt_data_11.ref (revision 0)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_11.ref (revision 8158)
@@ -0,0 +1,24 @@
+* Test output: rt_data_11
+* Purpose: handle export object list
+
+* Empty export list
+
+* Add an entry
+
++ results
+
+results
+
+* Add more entries, including doubler
+
++ foo
++ results
++ bar
+
+results
+foo
+bar
+
+* Cleanup
+
+* Test output end: rt_data_11
Index: trunk/share/tests/unit_tests/ref-output/rt_data_1.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/rt_data_1.ref (revision 8157)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_1.ref (revision 8158)
@@ -1,416 +1,416 @@
* 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_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => false
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
[undefined] $model_name = [unknown string]
[undefined] process_num_id = [unknown integer]
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
[undefined] $library_name = [unknown string]
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
alphas_order = 0
alphas_nf = 5
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
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
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
?keep_flavors_when_clustering = false
$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
$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_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_grid_sampling_points = 500000
powheg_pt_min = 1.000000000000E+00
powheg_lambda = 2.000000000000E-01
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp = false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = 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_qed"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
?openloops_use_collier = true
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 1.000000000000E-07
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_zero = 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 = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
real_partition_scale = 1.000000000000E+01
$fc => "Fortran-compiler"
$fcflags => "Fortran-flags"
========================================================================
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 8157)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_2.ref (revision 8158)
@@ -1,480 +1,480 @@
* 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_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => false
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "Test"
[undefined] process_num_id = [unknown integer]
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
[undefined] $library_name = [unknown string]
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
alphas_order = 0
alphas_nf = 5
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
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
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
?keep_flavors_when_clustering = false
$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
$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_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_grid_sampling_points = 500000
powheg_pt_min = 1.000000000000E+00
powheg_lambda = 2.000000000000E-01
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp = false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = 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_qed"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
?openloops_use_collier = true
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 1.000000000000E-07
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_zero = 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 = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
real_partition_scale = 1.000000000000E+01
$fc => "Fortran-compiler"
$fcflags => "Fortran-flags"
========================================================================
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 8157)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_3.ref (revision 8158)
@@ -1,1013 +1,1013 @@
* 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"
$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_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => false
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "Test"
[undefined] process_num_id = [unknown integer]
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "library_1"
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
alphas_order = 0
alphas_nf = 5
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
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
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
?keep_flavors_when_clustering = false
$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
$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_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_grid_sampling_points = 500000
powheg_pt_min = 1.000000000000E+00
powheg_lambda = 2.000000000000E-01
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp = false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = 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_qed"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
?openloops_use_collier = true
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 1.000000000000E-07
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_zero = 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 = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
real_partition_scale = 1.000000000000E+01
$fc => "Fortran-compiler"
$fcflags => "Fortran-flags"
========================================================================
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_recoil = false
?isr_keep_energy = false
?isr_handler = false
$isr_handler_mode = "trivial"
epa_alpha = 0.000000000000E+00
epa_x_min = 0.000000000000E+00
epa_q_min = 0.000000000000E+00
epa_q_max = 0.000000000000E+00
epa_mass = 0.000000000000E+00
?epa_recoil = false
?epa_keep_energy = false
?epa_handler = false
$epa_handler_mode = "trivial"
ewa_x_min = 0.000000000000E+00
ewa_pt_max = 0.000000000000E+00
ewa_mass = 0.000000000000E+00
?ewa_recoil = false
?ewa_keep_energy = false
?circe1_photon1 = false
?circe1_photon2 = false
[undefined] circe1_sqrts = [unknown real]
?circe1_generate = true
?circe1_map = true
circe1_mapping_slope = 2.000000000000E+00
circe1_eps = 1.000000000000E-05
circe1_ver = 0
circe1_rev = 0
$circe1_acc = "SBAND"
circe1_chat = 0
?circe1_with_radiation = false
?circe2_polarized = true
[undefined] $circe2_file = [unknown string]
$circe2_design = "*"
gaussian_spread1 = 0.000000000000E+00
gaussian_spread2 = 0.000000000000E+00
[undefined] $beam_events_file = [unknown string]
?beam_events_warn_eof = true
?energy_scan_normalize = false
?logging => false
[undefined] $job_id = [unknown string]
[undefined] $compile_workspace = [unknown string]
seed = 0
$model_name = "Test"
[undefined] process_num_id = [unknown integer]
$method = "omega"
?report_progress = true
[user variable] ?me_verbose = false
$restrictions = ""
?omega_write_phs_output = false
$omega_flags = ""
?read_color_factors = true
?slha_read_input = true
?slha_read_spectrum = true
?slha_read_decays = false
$library_name = "library_1"
?alphas_is_fixed = true
?alphas_from_lhapdf = false
?alphas_from_pdf_builtin = false
alphas_order = 0
alphas_nf = 5
?alphas_from_mz = false
?alphas_from_lambda_qcd = false
lambda_qcd = 2.000000000000E-01
?fatal_beam_decay = true
?helicity_selection_active = true
helicity_selection_threshold = 1.000000000000E+10
helicity_selection_cutoff = 1000
$rng_method = "tao"
?vis_diags = false
?vis_diags_color = false
?check_event_file = true
$event_file_version = ""
n_events = 0
event_index_offset = 0
?unweighted = true
safety_factor = 1.000000000000E+00
?negative_weights = false
?resonance_history = false
resonance_on_shell_limit = 4.000000000000E+00
resonance_on_shell_turnoff = 0.000000000000E+00
resonance_background_factor = 1.000000000000E+00
?keep_beams = false
?keep_remnants = true
?recover_beams = true
?update_event = false
?update_sqme = false
?update_weight = false
?use_alphas_from_file = false
?use_scale_from_file = false
?allow_decays = true
?auto_decays = false
auto_decays_multiplicity = 2
?auto_decays_radiative = false
?decay_rest_frame = false
?isotropic_decay = false
?diagonal_decay = false
[undefined] decay_helicity = [unknown integer]
?polarized_events = false
$polarization_mode = "helicity"
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
-$grid_path = ""
+[undefined] $integrate_workspace = [unknown string]
$phs_method = "default"
?vis_channels = false
?check_phs_file = true
$phs_file = ""
?phs_only = false
phs_threshold_s = 5.000000000000E+01
phs_threshold_t = 1.000000000000E+02
phs_off_shell = 2
phs_t_channel = 6
phs_e_scale = 1.000000000000E+01
phs_m_scale = 1.000000000000E+01
phs_q_scale = 1.000000000000E+01
?phs_keep_nonresonant = true
?phs_step_mapping = true
?phs_step_mapping_exp = true
?phs_s_mapping = true
?vis_history = false
n_bins = 20
?normalize_bins = false
$obs_label = ""
$obs_unit = ""
$title = ""
$description = ""
$x_label = ""
$y_label = ""
graph_width_mm = 130
graph_height_mm = 90
?y_log = false
?x_log = false
[undefined] x_min = [unknown real]
[undefined] x_max = [unknown real]
[undefined] y_min = [unknown real]
[undefined] y_max = [unknown real]
$gmlcode_bg = ""
$gmlcode_fg = ""
[undefined] ?draw_histogram = [unknown logical]
[undefined] ?draw_base = [unknown logical]
[undefined] ?draw_piecewise = [unknown logical]
[undefined] ?fill_curve = [unknown logical]
[undefined] ?draw_curve = [unknown logical]
[undefined] ?draw_errors = [unknown logical]
[undefined] ?draw_symbols = [unknown logical]
[undefined] $fill_options = [unknown string]
[undefined] $draw_options = [unknown string]
[undefined] $err_options = [unknown string]
[undefined] $symbol = [unknown string]
?analysis_file_only = false
kt_algorithm* = 0
cambridge_algorithm* = 1
antikt_algorithm* = 2
genkt_algorithm* = 3
cambridge_for_passive_algorithm* = 11
genkt_for_passive_algorithm* = 13
ee_kt_algorithm* = 50
ee_genkt_algorithm* = 53
plugin_algorithm* = 99
undefined_jet_algorithm* = 999
jet_algorithm = 999
jet_r = 0.000000000000E+00
jet_p = 0.000000000000E+00
jet_ycut = 0.000000000000E+00
?keep_flavors_when_clustering = false
$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
$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_mass_cutoff = 1.000000000000E+00
ps_fsr_lambda = 2.900000000000E-01
ps_isr_lambda = 2.900000000000E-01
ps_max_n_flavors = 5
?ps_isr_alphas_running = true
?ps_fsr_alphas_running = true
ps_fixed_alphas = 0.000000000000E+00
?ps_isr_pt_ordered = false
?ps_isr_angular_ordered = true
ps_isr_primordial_kt_width = 0.000000000000E+00
ps_isr_primordial_kt_cutoff = 5.000000000000E+00
ps_isr_z_cutoff = 9.990000000000E-01
ps_isr_minenergy = 1.000000000000E+00
ps_isr_tscalefactor = 1.000000000000E+00
?ps_isr_only_onshell_emitted_partons = false
?allow_hadronization = true
?hadronization_active = false
$hadronization_method = "PYTHIA6"
hadron_enhanced_fraction = 1.000000000000E-02
hadron_enhanced_width = 2.000000000000E+00
?ps_tauola_photos = false
?ps_tauola_transverse = false
?ps_tauola_dec_rad_cor = true
ps_tauola_dec_mode1 = 0
ps_tauola_dec_mode2 = 0
ps_tauola_mh = 1.250000000000E+02
ps_tauola_mix_angle = 9.000000000000E+01
?ps_tauola_pol_vector = false
?mlm_matching = false
mlm_Qcut_ME = 0.000000000000E+00
mlm_Qcut_PS = 0.000000000000E+00
mlm_ptmin = 0.000000000000E+00
mlm_etamax = 0.000000000000E+00
mlm_Rmin = 0.000000000000E+00
mlm_Emin = 0.000000000000E+00
mlm_nmaxMEjets = 0
mlm_ETclusfactor = 2.000000000000E-01
mlm_ETclusminE = 5.000000000000E+00
mlm_etaclusfactor = 1.000000000000E+00
mlm_Rclusfactor = 1.000000000000E+00
mlm_Eclusfactor = 1.000000000000E+00
?powheg_matching = false
?powheg_use_singular_jacobian = false
powheg_grid_size_xi = 5
powheg_grid_size_y = 5
powheg_grid_sampling_points = 500000
powheg_pt_min = 1.000000000000E+00
powheg_lambda = 2.000000000000E-01
?powheg_rebuild_grids = false
?powheg_test_sudakov = false
?powheg_disable_sudakov = false
?ckkw_matching = false
?omega_openmp = false
?openmp_is_active* = false
openmp_num_threads_default* = 1
openmp_num_threads = 1
?openmp_logging = 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_qed"
openloops_verbosity = 1
?openloops_use_cms = true
openloops_phs_tolerance = 7
openloops_stability_log = 0
?openloops_switch_off_muon_yukawa = false
$openloops_extra_cmd = ""
?openloops_use_collier = true
?disable_subtraction = false
fks_dij_exp1 = 1.000000000000E+00
fks_dij_exp2 = 1.000000000000E+00
fks_xi_min = 1.000000000000E-07
fks_y_max = 1.000000000000E+00
?vis_fks_regions = false
fks_xi_cut = 1.000000000000E+00
fks_delta_zero = 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 = true
?nlo_cut_all_sqmes = true
?nlo_use_real_partition = false
real_partition_scale = 1.000000000000E+01
$fc => "Fortran-compiler"
$fcflags => "Fortran-flags"
========================================================================
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/doc/manual.tex
===================================================================
--- trunk/share/doc/manual.tex (revision 8157)
+++ trunk/share/doc/manual.tex (revision 8158)
@@ -1,17061 +1,17132 @@
\documentclass[12pt]{book}
% \usepackage{feynmp}
\usepackage{microtype}
\usepackage{graphics,graphicx}
\usepackage{color}
\usepackage{amsmath,amssymb}
\usepackage[colorlinks,bookmarks,bookmarksnumbered=true]{hyperref}
\usepackage{thophys}
\usepackage{fancyvrb}
\usepackage{makeidx}
\usepackage{units}
\usepackage{ifpdf}
%HEVEA\pdftrue
\makeindex
\usepackage{url}
\usepackage[latin1]{inputenc}
%HEVEA\@def@charset{UTF-8}
%BEGIN LATEX
\usepackage{supertabular,fancyvrb}
\usepackage{hevea}
%END LATEX
\renewcommand{\topfraction}{0.9}
\renewcommand{\bottomfraction}{0.8}
\renewcommand{\textfraction}{0.1}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Macro section
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\newcommand{\email}[2]{\thanks{\ahref{#1@{}#2}{#1@{}#2}}}
\newcommand{\hepforgepage}{\url{https://whizard.hepforge.org}}
\newcommand{\whizardwiki}{\url{https://projects.hepforge.org/whizard/trac/wiki}}
\tocnumber
%BEGIN LATEX
\DeclareMathOperator{\diag}{diag}
%END LATEX
%BEGIN LATEX
\makeatletter
\newif\if@preliminary
\@preliminaryfalse
\def\preliminary{\@preliminarytrue}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Changes referring to article.cls
%
%%% Title page
\def\preprintno#1{\def\@preprintno{#1}}
\def\address#1{\def\@address{#1}}
\def\email#1#2{\thanks{\tt #1@{}#2}}
\def\abstract#1{\def\@abstract{#1}}
\newcommand\abstractname{ABSTRACT}
\newlength\preprintnoskip
\setlength\preprintnoskip{\textwidth\@plus -1cm}
\newlength\abstractwidth
\setlength\abstractwidth{\textwidth\@plus -3cm}
%
\@titlepagetrue
\renewcommand\maketitle{\begin{titlepage}%
\let\footnotesize\small
\hfill\parbox{\preprintnoskip}{%
\begin{flushright}\@preprintno\end{flushright}}\hspace*{1cm}
\vskip 60\p@
\begin{center}%
{\Large\bf\boldmath \@title \par}\vskip 1cm%
{\sc\@author \par}\vskip 3mm%
{\@address \par}%
\if@preliminary
\vskip 2cm {\large\sf PRELIMINARY DRAFT \par \@date}%
\fi
\end{center}\par
\@thanks
\vfill
\begin{center}%
\parbox{\abstractwidth}{\centerline{\abstractname}%
\vskip 3mm%
\@abstract}
\end{center}
\end{titlepage}%
\setcounter{footnote}{0}%
\let\thanks\relax\let\maketitle\relax
\gdef\@thanks{}\gdef\@author{}\gdef\@address{}%
\gdef\@title{}\gdef\@abstract{}\gdef\@preprintno{}
}%
%
%%% New settings of dimensions
\topmargin -1.5cm
\textheight 22cm
\textwidth 17cm
\oddsidemargin 0cm
\evensidemargin 0cm
%
%%% Original Latex definition of citex, except for the removal of
%%% 'space' following a ','. \citerange replaces the ',' by '--'.
\def\@citex[#1]#2{\if@filesw\immediate\write\@auxout{\string\citation{#2}}\fi
\def\@citea{}\@cite{\@for\@citeb:=#2\do
{\@citea\def\@citea{,\penalty\@m}\@ifundefined
{b@\@citeb}{{\bf ?}\@warning
{Citation `\@citeb' on page \thepage \space undefined}}%
\hbox{\csname b@\@citeb\endcsname}}}{#1}}
\def\citerange{\@ifnextchar [{\@tempswatrue\@citexr}{\@tempswafalse\@citexr[]}}
\def\@citexr[#1]#2{\if@filesw\immediate\write\@auxout{\string\citation{#2}}\fi
\def\@citea{}\@cite{\@for\@citeb:=#2\do
{\@citea\def\@citea{--\penalty\@m}\@ifundefined
{b@\@citeb}{{\bf ?}\@warning
{Citation `\@citeb' on page \thepage \space undefined}}%
\hbox{\csname b@\@citeb\endcsname}}}{#1}}
%
%%% Captions set in italics
\long\def\@makecaption#1#2{%
\vskip\abovecaptionskip
\sbox\@tempboxa{#1: \emph{#2}}%
\ifdim \wd\@tempboxa >\hsize
#1: \emph{#2}\par
\else
\hbox to\hsize{\hfil\box\@tempboxa\hfil}%
\fi
\vskip\belowcaptionskip}
%
%%% Other useful macros
\def\fmslash{\@ifnextchar[{\fmsl@sh}{\fmsl@sh[0mu]}}
\def\fmsl@sh[#1]#2{%
\mathchoice
{\@fmsl@sh\displaystyle{#1}{#2}}%
{\@fmsl@sh\textstyle{#1}{#2}}%
{\@fmsl@sh\scriptstyle{#1}{#2}}%
{\@fmsl@sh\scriptscriptstyle{#1}{#2}}}
\def\@fmsl@sh#1#2#3{\m@th\ooalign{$\hfil#1\mkern#2/\hfil$\crcr$#1#3$}}
\makeatother
% Labelling command for Feynman graphs generated by package FEYNMF
%\def\fmfL(#1,#2,#3)#4{\put(#1,#2){\makebox(0,0)[#3]{#4}}}
%END LATEX
%%%% Environment for showing user input and program response
\newenvironment{interaction}%
{\begingroup\small
\Verbatim}%
{\endVerbatim
\endgroup\noindent}
%BEGIN LATEX
%%%% Environment for typesetting listings verbatim
\newenvironment{code}%
{\begingroup\footnotesize
\quote
\Verbatim}%
{\endVerbatim
\endquote
\endgroup\noindent}
%%%% Boxed environment for typesetting listings verbatim
\newenvironment{Code}%
{\begingroup\footnotesize
\quote
\Verbatim[frame=single]}%
{\endVerbatim
\endquote
\endgroup\noindent}
%%% Environment for displaying syntax
\newenvironment{syntax}%
{\begin{quote}
\begin{flushleft}\tt}%
{\end{flushleft}
\end{quote}}
\newcommand{\var}[1]{$\langle$\textit{#1}$\rangle$}
%END LATEX
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Macros specific for this paper
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\newcommand{\ttt}[1]{\texttt{#1}}
\newcommand{\whizard}{\ttt{WHIZARD}}
\newcommand{\oMega}{\ttt{O'Mega}}
\newcommand{\vamp}{\ttt{VAMP}}
\newcommand{\vamptwo}{\ttt{VAMP2}}
\newcommand{\vegas}{\ttt{VEGAS}}
\newcommand{\madgraph}{\ttt{MadGraph}}
\newcommand{\CalcHep}{\ttt{CalcHep}}
\newcommand{\helas}{\ttt{HELAS}}
\newcommand{\herwig}{\ttt{HERWIG}}
\newcommand{\isajet}{\ttt{ISAJET}}
\newcommand{\pythia}{\ttt{PYTHIA}}
\newcommand{\pythiasix}{\ttt{PYTHIA6}}
\newcommand{\pythiaeight}{\ttt{PYTHIA8}}
\newcommand{\jetset}{\ttt{JETSET}}
\newcommand{\comphep}{\ttt{CompHEP}}
\newcommand{\circe}{\ttt{CIRCE}}
\newcommand{\circeone}{\ttt{CIRCE1}}
\newcommand{\circetwo}{\ttt{CIRCE2}}
\newcommand{\gamelan}{\textsf{gamelan}}
\newcommand{\stdhep}{\ttt{STDHEP}}
\newcommand{\lcio}{\ttt{LCIO}}
\newcommand{\pdflib}{\ttt{PDFLIB}}
\newcommand{\lhapdf}{\ttt{LHAPDF}}
\newcommand{\hepmc}{\ttt{HepMC}}
\newcommand{\fastjet}{\ttt{FastJet}}
\newcommand{\hoppet}{\ttt{HOPPET}}
\newcommand{\metapost}{\ttt{MetaPost}}
\newcommand{\sarah}{\ttt{SARAH}}
\newcommand{\spheno}{\ttt{SPheno}}
\newcommand{\Mathematica}{\ttt{Mathematica}}
\newcommand{\FeynRules}{\ttt{FeynRules}}
\newcommand{\UFO}{\ttt{UFO}}
\newcommand{\gosam}{\ttt{Gosam}}
\newcommand{\openloops}{\ttt{OpenLoops}}
\newcommand{\recola}{\ttt{Recola}}
\newcommand{\collier}{\ttt{Collier}}
\newcommand{\powheg}{\ttt{POWHEG}}
%%%%%
\newcommand{\sindarin}{\ttt{SINDARIN}}
\newcommand{\cpp}{\ttt{C++}}
\newcommand{\fortran}{\ttt{Fortran}}
\newcommand{\fortranSeventySeven}{\ttt{FORTRAN77}}
\newcommand{\fortranNinetyFive}{\ttt{Fortran95}}
\newcommand{\fortranOThree}{\ttt{Fortran2003}}
\newcommand{\ocaml}{\ttt{OCaml}}
\newcommand{\python}{\ttt{Python}}
\newenvironment{commands}{\begin{quote}\tt}{\end{quote}}
\newcommand{\eemm}{$e^+e^- \to \mu^+\mu^-$}
%\def\~{$\sim$}
\newcommand{\sgn}{\mathop{\rm sgn}\nolimits}
\newcommand{\GeV}{\textrm{GeV}}
\newcommand{\fb}{\textrm{fb}}
\newcommand{\ab}{\textrm{ab}}
\newenvironment{parameters}{%
\begin{center}
\begin{tabular}{lccp{65mm}}
\hline
Parameter & Value & Default & Description \\
\hline
}{%
\hline
\end{tabular}
\end{center}
}
\newenvironment{options}{%
\begin{center}
\begin{tabular}{llcp{80mm}}
\hline
Option & Long version & Value & Description \\
\hline
}{%
\hline
\end{tabular}
\end{center}
}
%BEGIN LATEX
\renewenvironment{options}{%
\begin{center}
\tablehead{\hline
Option & Long version & Value & Description \\
\hline
}
\begin{supertabular}{llcp{80mm}}
}{%
\hline
\end{supertabular}
\end{center}
}
%END LATEX
%BEGIN LATEX
\renewenvironment{parameters}{%
\begin{center}
\tablehead{\hline
Parameter & Value & Default & Description \\
\hline
}
\begin{supertabular}{lccp{65mm}}
}{%
\hline
\end{supertabular}
\end{center}
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%END LATEX
\newcommand{\thisversion}{2.6.4}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{document}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%BEGIN LATEX
\preprintno{}
%%%\preprintno{arXiv:0708.4233 (also based on LC-TOOL-2001-039 (revised))}
%END LATEX
\title{%
%HEVEA WHIZARD 2.6 \\
%BEGIN LATEX
\ttt{\huge WHIZARD 2.6} \\[\baselineskip]
%END LATEX
A generic \\ Monte-Carlo integration and event generation package \\
for multi-particle processes\\[\baselineskip]
MANUAL
\footnote{%
This work is supported by Helmholtz-Alliance ``Physics at the
Terascale''.
In former stages this work has also been supported by
the Helmholtz-Gemeinschaft VH--NG--005 \\
E-mail: \ttt{whizard@desy.de}
}
\\[\baselineskip]
}
% \def\authormail{\ttt{kilian@physik.uni-siegen.de},
% \ttt{ohl@physik.uni-wuerzburg.de},
% \ttt{juergen.reuter@desy.de}, \ttt{cnspeckn@googlemail.com}}
\author{%
Wolfgang Kilian,%
Thorsten Ohl,%
J\"urgen Reuter,%
with contributions from
Fabian Bach, %
Simon Bra\ss,
Bijan Chokouf\'{e} Nejad, %
Christian Fleper, %
Vincent Rothe, %
Sebastian Schmidt, %
Marco Sekulla, %
Christian Speckner, %
So Young Shim, %
Florian Staub, %
Christian Weiss}
%BEGIN LATEX
\address{%
Universit\"at Siegen, Emmy-Noether-Campus, Walter-Flex-Str. 3,
D--57068 Siegen, Germany \\
Universit\"at W\"urzburg, Emil-Hilb-Weg 22,
D--97074 W\"urzburg, Germany \\
Deutsches Elektronen-Synchrotron DESY, Notkestr. 85,
D--22603 Hamburg, Germany \\
%% \authormail
\vspace{1cm}
\begin{center}
\includegraphics[width=4cm]{Whizard-Logo}
\end{center}
\mbox{} \\
\vspace{2cm}
\mbox{} when using \whizard\ please cite: \\
W. Kilian, T. Ohl, J. Reuter, \\ {\em WHIZARD: Simulating Multi-Particle
Processes at LHC and ILC}, \\
Eur.Phys.J.{\bf C71} (2011) 1742, arXiv:
0708.4233 [hep-ph]; \\
M. Moretti, T. Ohl, J. Reuter, \\ {\em O'Mega: An Optimizing Matrix
Element Generator}, \\
arXiv: hep-ph/0102195
}
%END LATEX
%BEGIN LATEX
\abstract{%
\whizard\ is a program system designed for the efficient calculation
of multi-particle scattering cross sections and simulated event
samples. The generated events can be written to file in various formats
(including HepMC, LHEF, STDHEP, LCIO, and ASCII) or analyzed directly on the
parton or hadron level using a built-in \LaTeX-compatible graphics
package.
\\[\baselineskip]
Complete tree-level matrix elements are generated automatically for arbitrary
partonic multi-particle processes by calling the built-in matrix-element
generator \oMega. Beyond hard matrix elements, \whizard\ can generate
(cascade) decays with complete spin correlations.
Various models beyond the SM are implemented, in particular,
the MSSM is supported with an interface to the SUSY Les Houches Accord
input format. Matrix elements obtained by alternative methods (e.g.,
including loop corrections) may be interfaced as well.
\\[\baselineskip]
The program uses an adaptive multi-channel method for phase space
integration, which allows to calculate numerically stable signal and
background cross sections and generate unweighted event samples with
reasonable efficiency for processes with up to eight and more
final-state particles. Polarization is treated exactly for both the
initial and final states. Quark or lepton flavors can be
summed over automatically where needed.
\\[\baselineskip]
For hadron collider physics, we ship the package with the most recent
PDF sets from the MSTW/MMHT and CTEQ/CT10/CJ12/CJ15/CT14
collaborations. Furthermore, an interface to the \lhapdf\ library is
provided.
\\[\baselineskip]
For Linear Collider physics,
beamstrahlung (\circeone, \circetwo), Compton and ISR spectra are
included for electrons and photons, including the most recent ILC and
CLIC collider designs. Alternatively, beam-crossing events can be read
directly from file.
\\[\baselineskip]
For parton showering and matching/merging with hard matrix elements ,
fragmenting and hadronizing the final state, a first version of two
different parton shower algorithms are included in the \whizard\
package. This also includes infrastructure for the MLM matching and
merging algorithm. For hadronization and hadronic decays, \pythia\
and \herwig\ interfaces are provided which follow the Les Houches
Accord. In addition, the last and final version of (\fortran) \pythia\
is included in the package.
\\[\baselineskip]
The \whizard\ distribution is available at
%%% \begin{center}
%%% \ttt{http://whizard.event-generator.org}
%%% \end{center}
%%% or at
\begin{center}
\url{https://projects.hepforge.org/whizard}
\end{center}
where also the \ttt{svn} repository is located.
}
%END LATEX
%
\maketitle
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Text
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%\begin{fmffile}
\tableofcontents
\newpage
\chapter{Introduction}
\section{Disclaimer}
\emph{This is a preliminary version of the WHIZARD manual. Many parts
are still missing or incomplete, and some parts will be rewritten and
improved soon. To find updated versions of the manual,
visit the \whizard\ website}
\begin{center}
\hepforgepage
\end{center}
\emph{or consult the current version in the \ttt{svn} repository
on \hepforgepage\ directly. Note, that the most recent version of
the manual might contain information about features of the
current \ttt{svn} version, which are not contained in the last
official release version!}
\emph{For information that is not (yet) written in the manual, please
consult the examples in the \whizard\ distribution. You will find these in
the subdirectory \ttt{share/examples} of the main directory where
\whizard\ is installed. More information about the examples can be
found on the \whizard\ Wiki page}
\begin{center}
\whizardwiki .
\end{center}
%%%%%
\clearpage
\section{Overview}
\whizard\ is a multi-purpose event generator that covers all parts of
event generation (unweighted and weighted), either through intrinsic
components or interfaces to external packages. Realistic collider
environments are covered through sophisticated descriptions for beam
structures at hadron colliders, lepton colliders, lepton-hadron
colliders, both circular and linear machines. Other options include
scattering processes e.g. for dark matter annihilation or particle
decays. \whizard\ contains its in-house generator for (tree-level)
high-multiplicity matrix elements, \oMega\, that supports the whole
Standard Model (SM) of particle physics and basically all possibile
extensions of it. QCD parton shower describe high-multiplicity
partonic jet events that can be matched with matrix elements. At the
moment, only hadron collider parton distribution functions (PDFs) and
hadronization are handled by packages not written by the main
authors.
This manual is organized mainly along the lines of the way how to run
\whizard: this is done through a command language, \sindarin\ (Scripting
INtegration, Data Analysis, Results display and INterfaces.) Though
this seems a complication at first glance, the user is rewarded with a
large possibility, flexibility and versatility on how to steer
\whizard.
After some general remarks in the follow-up sections, in
Chap.~\ref{chap:installation} we describe how to get the program, the
package structure, the prerequisites, possible external extensions of
the program and the basics of the installation (both as superuser and
locally). Also, a first technical overview how to work with \whizard\
on single computer, batch clusters and farms are given. Furthermore,
some rare uncommon possible build problems are discussed, and a tour
through options for debugging, testing and validation is being made.
A first dive into the running of the program is made in
Chap.~\ref{chap:start}. This is following by an extensive, but rather
technical introduction into the steering language \sindarin\ in
Chap.~\ref{chap:sindarinintro}. Here, the basic elements of the
language like commands, statements, control structures, expressions
and variables as well as the form of warnings and error messages are
explained in detail.
Chap.~\ref{chap:sindarin} contains the application of the \sindarin\
command language to the main tasks in running \whizard\ in a physics
framework: the defintion of particles, subevents, cuts, and event
selections. The specification of a particular physics models is
\begin{figure}[t]
\centering
\includegraphics[width=0.9\textwidth]{whizstruct}
\caption{General structure of the \whizard\ package.}
\end{figure}
discussed, while the next sections are devoted to the setup and
compilation of code for particular processes, the specification of
beams, beam structure and polarization. The next step is the
integration, controlling the integration, phase space, generator cuts,
scales and weights, proceeding further to event generation and
decays. At the end of this chapter, \whizard's internal data analysis
methods and graphical visualization options are documented.
The following chapters are dedicated to the physics implemented in
\whizard: methods for hard matrix interactions in
Chap.~\ref{chap:hardint}. Then, in Chap.~\ref{chap:physics},
implemented methods for adaptive multi-channel integration,
particularly the integrator \vamp\ are explained, together with the
algorithms for the generation of the phase-space in \whizard. Finally,
an overview is given over the physics models implemented in \whizard\
and its matrix element generator \oMega, together with possibilities
for their extension. After that, the next chapter discusses parton
showering, matching and hadronization as well as options for event
normalizations and supported event formats. Also weighted event
generation is explained along the lines with options for negative
weights. Then, in Chap.~\ref{chap:user}, options for user to plug-in
self-written code into the \whizard\ framework are detailed, e.g. for
observables, selections and cut functions, or for spectra and
structure functions. Also, static executables are discussed.
Chap.~\ref{chap:visualization} is a stand-alone documentation of
GAMELAN, the interal graphics support for the visualization of data
and analysis. The next chapter, Chap.~\ref{chap:userint} details user
interfaces: how to use more options of the \whizard\ command on the
command line, how to use \whizard\ interactively, and how to include
\whizard\ as a library into the user's own program.
Then, an extensive list of examples in Chap.~\ref{chap:examples}
documenting physics examples from the LEP, SLC, HERA, Tevatron, and
LHC colliders to future linear and circular colliders. This chapter is
a particular good reference for the beginning, as the whole chain from
choosing a model, setting up processes, the beam structure, the
integration, and finally simulation and (graphical) analysis are
explained in detail.
More technical details about efficiency, tuning and advance usage of
\whizard\ are collected in Chap.~\ref{chap:tuning}. Then,
Chap.~\ref{chap:extmodels} shows how to set up your own new physics
model with the help of external programs like \sarah\ or
\FeynRules\ program or the Universal Feynrules Output, UFO, and
include it into the \whizard\ event generator.
In the appendices, we e.g. give an exhaustive reference list of
\sindarin\ commands and built-in variables.
Please report any inconsistencies, bugs, problems or simply pose open
questions to our contact \url{whizard@desy.de}.
%%%%%
\section{Historical remarks}
This section gives a historical overview over the development of
\whizard\ and can be easily skipped in a (first) reading of the
manual. \whizard\ has been developed in a first place as a tool for
the physics at the then planned linear electron-positron collider
TESLA around 1999. The intention was to have a tool at hand to
describe electroweak physics of multiple weak bosons and the Higgs
boson as precise as possible with full matrix elements. Hence, the
acronym: \ttt{WHiZard}, which stood for $\mathbf{W}$, {\bf H}iggs,
$\mathbf{Z}$, {\bf a}nd {\bf r}espective {\bf d}ecays.
Several components of the \whizard\ package that are also available as
independent sub-packages have been published already before the first
versions of the \whizard\ generator itself: the multi-channel adaptive
Monte-Carlo integration package \vamp\ has been released mid
1998~\cite{VAMP}. The dedicated packages for the simulation of linear
lepton collider beamstrahlung and the option for a photon collider on
Compton backscattering (\ttt{CIRCE1/2}) date back even to mid
1996~\cite{CIRCE}. Also parts of the code for \whizard's internal
graphical analysis (the \gamelan\ module) came into existence already
around 1998.
After first inofficial versions, the official version 1 of \whizard\
was release in the year 2000. The development, improvement and
incorporation of new features continued for roughly a decade. Major
milestones in the development were the full support of all kinds of
beyond the Standard Model (BSM) models including spin 3/2 and spin 2
particles and the inclusion of the MSSM, the NMSSM, Little Higgs
models and models for anomalous couplings as well as extra-dimensional
models from version 1.90 on. In the beginning, several methods for
matrix elements have been used, until the in-house matrix element
generator \oMega\ became available from version 1.20 on. It was
included as a part of the \whizard\ package from version 1.90 on. The
support for full color amplitudes came with version 1.50, but in a
full-fledged version from 2.0 on. Version 1.40 brought the necessary
setups for all kinds of collider environments, i.e. asymmetric beams,
decay processes, and intrinsic $p_T$ in structure functions.
Version 2.0 was released in April 2010 as an almost complete rewriting
of the original code. It brought the construction of an internal
density-matrix formalism which allowed the use of factorized
production and (cascade) decay processes including complete color and
spin correlations. Another big new feature was the command-line
language \sindarin\ for steering all parts of the program. Also, many
performance improvement have taken place in the new release series,
like OpenMP parallelization, speed gain in matrix element generation
etc. Version 2.2 came out in May 2014 as a major refactoring of the
program internals but keeping (almost everywhere) the same user
interface. New features are inclusive processes, reweighting, and more
interfaces for QCD environments (BLHA/HOPPET).
The following tables shows some of the major steps (physics
implementation and/or technical improvements) in the development
of \whizard:
\begin{center}
\begin{tabular}{|l|l|l|}\hline
0.99 & 08/1999 & Beta version \\\hline
1.00 & 12/2000 & First public version \\\hline
1.10 & 03/2001 & Libraries; \pythiasix\ interface \\
1.11 & 04/2001 & PDF support; anomalous couplings \\ \hline
1.20 & 02/2002 & \oMega\ matrix elements; \ttt{CIRCE} support\\
1.22 & 03/2002 & QED ISR; beam remnants, phase space improvements \\
1.25 & 05/2003 & MSSM; weighted events; user-code plug-in \\
1.28 & 04/2004 & Improved phase space; SLHA interface; signal catching
\\\hline
1.30 & 09/2004 & Major technical overhaul \\\hline
1.40 & 12/2004 & Asymmetric beams; decays; $p_T$ in structure
functions \\\hline
1.50 & 02/2006 & QCD support in \oMega\ (color flows); LHA format \\
1.51 & 06/2006 & $Hgg$, $H\gamma\gamma$; Spin 3/2 + 2; BSM models
\\\hline
1.90 & 11/2007 & \oMega\ included; LHAPDF support; $Z'$; $WW$ scattering \\
1.92 & 03/2008 & LHE format; UED; parton shower beta version \\
1.93 & 04/2009 & NMSSM; SLHA2 accord; improved color/flavor sums \\
1.95 & 02/2010 & MLM matching; development stop in version 1
\\
1.97 & 05/2011 & Manual for version 1 completed. \\\hline\hline
2.0.0 & 04/2010 & Major refactoring: automake setup; dynamic
libraries \\
& & improved speed; cascades; OpenMP; \sindarin\ steering language \\
2.0.3 & 07/2010 & QCD ISR+FSR shower; polarized beams \\
2.0.5 & 05/2011 & Builtin PDFs; static builds; relocation scripts \\
2.0.6 & 12/2011 & Anomalous top couplings; unit tests \\\hline
2.1.0 & 06/2012 & Analytic ISR+FSR parton shower; anomalous Higgs
couplings \\\hline
2.2.0 & 05/2014 & Major technical refactoring: abstract
object-orientation; THDM; \\
& & reweighting; LHE v2/3; BLHA; HOPPET interface; inclusive
processes \\
2.2.1 & 05/2014 & CJ12 PDFs; FastJet interface \\
2.2.2 & 07/2014 & LHAPDF6 support; correlated LC beams; GuineaPig
interface \\
2.2.3 & 11/2014 & O'Mega virtual machine; lepton collider top
pair threshold; Higgs singlet extension \\
2.2.4 & 02/2015 & LCIO support; progress on NLO; many technical
bug fixes \\
2.2.7 & 08/2015 & progress on POWHEG; fixed-order NLO events;
revalidation of ILC event chain \\
2.2.8 & 11/2015 & support for quadruple precision; StdHEP included;
SM dim 6 operators supported
\\\hline
2.3.0 & 07/2016 & NLO: resonance mappings for FKS subtraction; more
advanced cascade syntax; \\
& & GUI ($\alpha$ version); UFO support
($\alpha$ version); ILC v1.9x-v2.x final validation \\
2.3.1 & 08/2016 & Complex mass scheme
\\\hline
2.4.0 & 11/2016 & Refactoring of NLO setup \\
2.4.1 & 03/2017 & $\alpha$ version of new VEGAS implementation
\\\hline
2.5.0 & 05/2017 & Full UFO support (SM-like models)
\\\hline
2.6.0 & 09/2017 & MPI parallel integration and event generation;
resonance histories \\
& & for showers; RECOLA support \\
2.6.1 & 11/2017 & EPA/ISR transverse distributions, handling of
shower resonances; \\
& & more efficient (alternative) phase space generation \\
2.6.2 & 12/2017 & $Hee$ coupling, improved resonance matching \\
2.6.3 & 02/2018 & Partial NLO refactoring for quantum numbers,
unified RECOLA 1/2 interface. \\\hline
\end{tabular}
\end{center}
\vspace{.5cm}
For a detailed overview over the historical development of the code
confer the \ttt{ChangeLog} file and the commit messages in our
revision control system repository.
%%%%%
\section{About examples in this manual}
Although \whizard\ has been designed as a Monte Carlo event generator
for LHC physics, several elementary steps and aspects of its usage
throughout the manual will be demonstrated with the famous textbook
example of $e^+e^- \to \mu^+ \mu^-$. This is the same process, the
textbook by Peskin/Schroeder \cite{PeskinSchroeder} uses as a prime
example to teach the basics of quantum field theory. We use this
example not because it is very special for \whizard\ or at the time
being a relevant physics case, but simply because it is the easiest
fundamental field theoretic process without the complications of
structured beams (which can nevertheless be switched on like for ISR
and beamstrahlung!), the need for jet definitions/algorithms and
flavor sums; furthermore, it easily accomplishes a demonstration of
polarized beams. After the basics of \whizard\ usage have been
explained, we move on to actual physics cases from LHC (or Tevatron).
\newpage
\chapter{Installation}
\label{chap:installation}
\section{Package Structure}
\whizard\ is a software package that consists of a main executable
program (which is called \ttt{whizard}), libraries, auxiliary
executable programs, and machine-independent data files. The whole
package can be installed by the system administrator, by default, on a
central location in the file system (\ttt{/usr/local} with its proper
subdirectories). Alternatively, it is possible to install it in a
user's home directory, without administrator privileges, or at any
other location.
A \whizard\ run requires a workspace, i.e., a writable directory where
it can put generated code and data. There are no constraints on the
location of this directory, but we recommend to use a separate
directory for each \whizard\ project, or even for each \whizard\ run.
Since \whizard\ generates the matrix elements for scattering and decay
processes in form of \fortran\ code that is automatically compiled and
dynamically linked into the running program, it requires a working
\fortran\ compiler not just for the installation, but also at runtime.
The previous major version \whizard1 did put more constraints on the
setup. In a nutshell, not just the matrix element code was compiled
at runtime, but other parts of the program as well, so the whole
package was interleaved and had to be installed in user space. The
workflow was controlled by \ttt{make} and PERL scripts. These
constraints are gone in the present version in favor of a clean
separation of installation and runtime workspace.
\section{\label{sec:prerequisites}Prerequisites}
\subsection{No Binary Distribution}
\whizard\ is currently not distributed as a binary package, nor is it
available as a debian or RPM package. This might change in the
future. However, compiling from source is very simple (see below).
Since the package needs a compiler also at runtime, it would not work
without some development tools installed on the machine, anyway.
Note, however, that we support an install script, that downloads all
necessary prerequisites, and does the configuration and compilation
described below automatically. This is called the ``instant WHIZARD''
and is accessible through the WHIZARD webpage from version 2.1.1 on:
\url{https://whizard.hepforge.org/versions/install/install-whizard-2.X.X.sh}.
Download this shell script, make it executable by
\begin{interaction}
chmod +x install-whizard-2.X.X.sh
\end{interaction}
and execute it. Note that this also involves compilation of the
required \ttt{Fortran} compiler which takes 1-3 hours depending on
your system.
\ttt{Darwin} operating systems (a.k.a. as \ttt{Mac OS X}) have a very
similar general system for all sorts of software, called
\ttt{MacPorts} (\url{http://www.macports.org}). This offers to install
\whizard\ as one of its software ports, and is very similar to
``instant WHIZARD'' described above.
\subsection{Tarball Distribution}
This is the recommended way of obtaining \whizard. You may download
the current stable distribution from the \whizard\ webpage,
hosted at the HepForge webpage
\begin{quote}
\hepforgepage
\end{quote}
The distribution is a single file, say \ttt{whizard-\thisversion.tgz} for
version \thisversion.
You need the additional prerequisites:
\begin{itemize}
\item
GNU \ttt{tar} (or \ttt{gunzip} and \ttt{tar}) for unpacking the
tarball.
\item
The \ttt{make} utility. Other standard Unix utilities (\ttt{sed},
\ttt{grep}, etc.) are usually installed by default.
\item
A modern \fortran\ compiler (see Sec.~\ref{sec:compilers} for
details).
\item
The \ocaml\ system. \ocaml\ is a functional and object-oriented
language. Version 3.12 or later is required to compile all components
of \whizard. The package is freely available either as a debian/RPM package
on your system (it might be necessary to install it from the usual
repositories), or you can obtain it directly from
\begin{quote}
\url{http://caml.inria.fr}
\end{quote}
and install it yourself. If desired, the package can be installed
in user space without administrator privileges\footnote{
Unfortunately, the version of the \ocaml\
compiler from 3.12.0 broke backwards compatibility. Therefore,
versions of \oMega/\whizard\ up to 2.0.2 only compile with older
versions (3.11.x works). This has been fixed in versions
2.0.3 and later. See also Sec.~\ref{sec:buildproblems}.}.
\end{itemize}
The following optional external packages are not required, but used
for certain purposes. Make sure to check whether you will need any of
them, before you install \whizard.
\begin{itemize}
\item
\LaTeX\ and \metapost\ for data visualization. Both are part of the
\TeX\ program family. These programs are not absolutely necessary,
but \whizard\ will lack the tools for visualization without them.
\item
The \lhapdf\ structure-function library. See
Sec.~\ref{sec:lhapdf_install}.
\item
The \hoppet\ structure-function matching tool. See
Sec.~\ref{sec:hoppet}.
\item
The \hepmc\ event-format package. See Sec.~\ref{sec:hepmc}.
\item
The \fastjet\ jet-algorithm package. See Sec.~\ref{sec:fastjet}.
\item
The \lcio\ event-format package. See Sec.~\ref{sec:lcio}.
\end{itemize}
Until version v2.2.7 of \whizard, the event-format package \stdhep\ used
to be available as an external package. As their distribution is frozen
with the final version v5.06.01, and it used to be notoriously difficult to
compile and link \stdhep\ into \whizard, it was decided to include \stdhep\
into \whizard. This is the case from version v2.2.8 of \whizard\ on. Linking
against an external version of \stdhep\ is precluded from there
on. Nevertheless, we list some explanations in Sec.~\ref{sec:stdhep}.
Once these prerequisites are met, you may unpack the package in a
directory of your choice
\begin{quote}\small\tt
some-directory> tar xzf whizard-\thisversion.tgz
\end{quote}
and proceed.\footnote{Without GNU \ttt{tar}, this would read
\ttt{\small gunzip -c whizard-\thisversion.tgz | tar xz -}}
For using external physics models that are directly supported by
\whizard\ and \oMega, the user can use tools like \sarah\ or
\FeynRules. There installation and linking to \whizard\ will be
explained in Chap.~\ref{chap:extmodels}. Besides this, also new models
can be conveniently included via \UFO\ files, which will be explained
as well in that chapter.
The directory will then contain a subdirectory \ttt{whizard-\thisversion}
where the complete source tree is located. To update later to a new
version, repeat these steps. Each new version will unpack in a
separate directory with the appropriate name.
\subsection{SVN Repository Version}
If you want to install the latest development version, you have to
check it out from the \whizard\ SVN repository.
In addition to the prerequisites listed in the previous section, you
need:
\begin{itemize}
\item
The \ttt{subversion} package (\ttt{svn}), the tool for dealing with
SVN repositories.
\item
The \ttt{autoconf} package, part of the \ttt{autotools} development
system.
\item
The \ttt{noweb} package, a light-weight tool for literate programming. This
package is nowadays often part of Linux distributions\footnote{In
Ubuntu from version 10.04 on, and in Debian since
squeeze. For \ttt{Mac OS X}, \ttt{noweb} is available via the
\ttt{MacPorts} system.}. You can obtain the source code
from\footnote{Please, do not use any of the binary builds from this
webpage. Probably all of them are quite old and broken.}
\begin{quote}
\url{http://www.cs.tufts.edu/~nr/noweb/}
\end{quote}
\end{itemize}
To start, go to a directory of your choice and execute
\begin{interaction}
your-src-directory> svn checkout https://whizard.hepforge.org/svn/trunk/ .
\end{interaction}
The SVN source tree will appear in the current directory. To update
later, you just have to execute
\begin{interaction}
your-src-directory> svn update
\end{interaction}
within that directory.
After checking out the sources, you first have to create
\ttt{configure.ac} by executing the shell script
\ttt{build\_master.sh}. Afterwards, run\footnote{At least, version
2.65 of the \ttt{autoconf} package is required.}
\begin{interaction}
your-src-directory> autoreconf
\end{interaction}
This will generate a \ttt{configure} script.
\subsection{\label{sec:compilers}Fortran Compilers}
\whizard\ is written in modern \fortran. To be precise, it uses a
subset of the \fortranOThree\ standard. At the time of this writing,
this subset is supported by, at least, the following compilers:
\begin{itemize}
\item
\ttt{gfortran} (GNU, Open Source). You will need version 4.8.0
or higher\footnote{Note that \whizard\ versions 2.0.0 until 2.3.1 compiled
with \ttt{gfortran} 4.7.4, but the object-oriented
refactoring of the \whizard\ code from 2.4 on made a switch to
\ttt{gfortran} 4.8.0 or higher necessary.}. We recommend to use at
least version 4.8.4 or 4.9.4, as especially the the early version of
4.8.X and 4.9.X experience some severe bugs.
\item
\ttt{nagfor} (NAG). You will need version 6.0 or higher.
\item
\ttt{ifort} (Intel). You will need version 17.0.4 or
higher.
\end{itemize}
%%%%%
\subsection{LHAPDF}
\label{sec:lhapdf_install}
For computing scattering processes at hadron colliders such as the
LHC, \whizard\ has a small set of standard structure-function
parameterizations built in, cf.\ Sec.~\ref{sec:built-in-pdf}. For
many applications, this will be sufficient, and you can skip this
section.
However, if you need structure-function parameterizations that are not
in the default set (e.g. PDF error sets), you can use the \lhapdf\
structure-function library, which is an external package. It has to
be linked during \whizard\ installation. For use with \whizard,
version 5.3.0 or higher of the library is required\footnote{ Note that
PDF sets which contain photons as partons are only supported with
\whizard\ for \lhapdf\ version 5.7.1 or higher}. The \lhapdf\
package has undergone a major rewriting from \fortran\ version 5
to \ttt{C++} version 6. While still maintaining the interface for
the \lhapdf\ version 5 series, from version 2.2.2 of \whizard\ on, the
new release series of \lhapdf, version 6.0 and higher, is also
supported.
If \lhapdf\ is not yet installed on your system, you can download it from
\begin{quote}
\url{https://lhapdf.hepforge.org}
\end{quote}
for the most recent LHAPDF version 6 and newer, or
\begin{quote}
\url{https://lhapdf.hepforge.org/lhapdf5}
\end{quote}
for version 5 and older, and install it. The website contains
comprehensive documentation on the configuring and installation
procedure. Make sure that you have downloaded and installed not just
the package, but also the data sets. Note that \lhapdf\ version 5
needs both a \fortran\ and a \ttt{C++} compiler.
During \whizard\ configuration, \whizard\ looks for the script
\ttt{lhapdf} (which is present in \lhapdf\ series 6) first, and then
for \ttt{lhapdf-config} (which is present since \lhapdf\ version
4.1.0): if those are in an executable path (or only
the latter for \lhapdf\ version 5), the environment variables for
\lhapdf\ are automatically recognized by \whizard, as well as the
version number. This should look like this in the \ttt{configure}
output (for \lhapdf\ version 6 or newer),
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- LHAPDF ---
configure:
checking for lhapdf... /usr/local/bin/lhapdf
checking for lhapdf-config... /usr/local/bin/lhapdf-config
checking the LHAPDF version... 6.1.6
checking the major version... 6
checking the LHAPDF pdfsets path... /usr/local/share/LHAPDF
checking the standard PDF sets... all standard PDF sets installed
checking if LHAPDF is functional (may take a while)... yes
checking LHAPDF... yes
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
while for \lhapdf\ version 5 and older it looks like this:
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- LHAPDF ---
configure:
checking for lhapdf... no
checking for lhapdf-config... /usr/local/bin/lhapdf-config
checking the LHAPDF version... 5.9.1
checking the major version... 5
checking the LHAPDF pdfsets path... /usr/local/share/lhapdf/PDFsets
checking the standard PDF sets... all standard PDF sets installed
checking for getxminm in -lLHAPDF... yes
checking for has_photon in -lLHAPDF... yes
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
If you want to use a different \lhapdf\ (e.g. because the one installed
on your system by default is an older one), the preferred way to do so
is to put the \ttt{lhapdf} (and/or \ttt{lhapdf-config}) scripts in an
executable path that is checked before the system paths,
e.g. \ttt{<home>/bin}.
For the old series, \lhapdf\ version 5, a possible error could arise
if \lhapdf\ had been compiled with a different \fortran\ compiler than
\whizard, and if the run-time library of that \fortran\ compiler had
not been included in the \whizard\ configure process. The output then
looks like this:
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- LHAPDF ---
configure:
checking for lhapdf... no
checking for lhapdf-config... /usr/local/bin/lhapdf-config
checking the LHAPDF version... 5.9.1
checking the major version... 5
checking the LHAPDF pdfsets path... /usr/local/share/lhapdf/PDFsets
checking for standard PDF sets... all standard PDF sets installed
checking for getxminm in -lLHAPDF... no
checking for has_photon in -lLHAPDF... no
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
So, the \whizard\ configure found the \lhapdf\ distribution, but could
not link because it could not resolve the symbols inside the
library. In case of failure, for more details confer the
\ttt{config.log}.
If \lhapdf\ is installed in a non-default directory where
\whizard\ would not find it, set the environment variable
\ttt{LHAPDF\_DIR} to the correct installation path when configuring
\whizard.
The check for the standard PDF sets are those sets that are used in
the default \whizard\ self tests in the case \lhapdf\ is enabled and
correctly linked. If some of them are missing, then this test will
result in a failure. They are the \ttt{CT10} set for \lhapdf\ version
6 (for version 5, \ttt{cteq61.LHpdf}, \ttt{cteq6ll.LHpdf},
\ttt{cteq5l.LHgrid}, and \ttt{GSG961.LHgrid} are demanded). If you
want to use \lhapdf\ inside \whizard\ please install them such that
\whizard\ could perform all its sanity checks with them. The last
check is for the \ttt{has\_photon} flag, which tests whether photon
PDFs are available in the found \lhapdf\ installation.
%%%%%
\subsection{HOPPET}
\label{sec:hoppet}
\hoppet\ (not Hobbit) is a tool for the QCD DGLAP evolution of PDFs
for hadron colliders. It provides possibilities for matching
algorithms for 4- and 5-flavor schemes, that are important for
precision simulations of $b$-parton initiated processes at hadron
colliders. If you are not interested in those features, you can skip
this section. Note that this feature is not enabled by default (unlike
e.g. \lhapdf), but has to be explicitly during the configuration
(see below):
\begin{interaction}
your-build-directory> your-src-directory/configure --enable-hoppet
\end{interaction}
If you \ttt{configure} messages like the following:
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- HOPPET ---
configure:
checking for hoppet-config... /usr/local/bin/hoppet-config
checking for hoppetAssign in -lhoppet_v1... yes
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
then you know that \hoppet\ has been found and was correctly
linked. If that is not the case, you have to specify the location of
the \hoppet\ library, e.g. by adding
\begin{interaction}
HOPPET=<hoppet\_directory>/lib
\end{interaction}
to the \ttt{configure} options above. For more details, please confer
the \hoppet\ manual.
%%%%%
\subsection{HepMC}
\label{sec:hepmc}
Now, there is also a first attempt to support the new version 3 of
\hepmc. The configure step can already successfully recognize the two
different versions, but version 3 is not yet fully functional. So for
the moment, users should still use version 2. Also, version 3 of
\hepmc\ still lacks all features of version 2.
\hepmc\ is a \ttt{C++} class library for handling collider scattering
events. In particular, it provides a portable format for event files.
If you want to use this format, you should link \whizard\ with \hepmc,
otherwise you can skip this section.
If it is not already installed on your system, you may obtain
\hepmc\ from one of these two webpages:
\begin{quote}
\url{http://lcgapp.cern.ch/project/simu/HepMC/}
\end{quote}
or
\begin{quote}
\url{http://hepmc.web.cern.ch/hepmc/}
\end{quote}
If the \hepmc\ library is linked with the installation, \whizard\ is
able to read and write files in the \hepmc\ format.
Detailed information on the installation and usage can be found on the
\hepmc\ homepage. We give here only some brief details relevant for
the usage with \whizard: For the compilation of HepMC one needs a
\ttt{C++} compiler. Then the procedure is the same as for the
\whizard\ package, namely configure HepMC:
\begin{interaction}
configure --with-momentum=GEV --with-length=MM --prefix=<install dir>
\end{interaction}
Note that the particle momentum and decay length flags are mandatory, and
we highly recommend to set them to the values \ttt{GEV} and \ttt{MM},
respectively. After configuration, do \ttt{make}, an optional
\ttt{make check} (which might sometimes fail for non-standard values
of momentum and length), and finally \ttt{make install}.
A \whizard\ configuration for HepMC looks like this:
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- HepMC ---
configure:
checking the HepMC version... 2.06.09
checking for GenEvent class in -lHepMC... yes
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
If \hepmc\ is installed in a non-default directory where \whizard\
would not find it, set the environment variable \ttt{HEPMC\_DIR} to
the correct installation path when configuring \whizard. Furthermore,
the environment variable \ttt{CXXFLAGS} allows you to set specific
\ttt{C/C++} preprocessor flags, e.g. non-standard include paths for
header files.
%%%%%
\subsection{PYTHIA8}
\label{sec:pythia8}
\emph{NOTE: This is at the moment not yet supported, but merely a stub
with the only purpose to be recognized by the build system.}
\pythiaeight\ is a \ttt{C++} class library for handling hadronization,
showering and underlying event. If you want to use this feature (once it is
fully supported in \whizard), you should link \whizard\ with \pythiaeight,
otherwise you can skip this section.
If it is not already installed on your system, you may obtain
\pythiaeight\ from
\begin{quote}
\url{http://home.thep.lu.se/~torbjorn/Pythia.html}
\end{quote}
If the \pythiaeight\ library is linked with the installation, \whizard\ will
be able to use its hadronization and showering, once this is fully supported
within \whizard.
To link a \pythiaeight\ installation to \whizard, you should specify the flag
\begin{quote}
\ttt{--enable-pythia8}
\end{quote}
to \ttt{configure}. If \pythiaeight\ is installed in a non-default directory
where \whizard\ would not find it, specify also
\begin{quote}
\ttt{--with-pythia8=\emph{<your-pythia8-installation-path>}}
\end{quote}
A successful \whizard\ configuration should produce a screen output
similar to this:
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- SHOWERS PYTHIA6 PYTHIA8 MPI ---
configure:
[....]
checking for pythia8-config... /usr/local/bin/pythia8-config
checking if PYTHIA8 is functional... yes
checking PYTHIA8... yes
configure: WARNING: PYTHIA8 configure is for testing purposes at the moment.
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
%%%%%
\subsection{FastJet}
\label{sec:fastjet}
\emph{NOTE: This is an experimental feature.}
\fastjet\ is a \ttt{C++} class library for handling jet clustering.
If you want to use this feature, you should link \whizard\ with \fastjet,
otherwise you can skip this section.
If it is not already installed on your system, you may obtain
\fastjet\ from
\begin{quote}
\url{http://fastjet.fr}
\end{quote}
If the \fastjet\ library is linked with the installation, \whizard\ is
able to call the jet algorithms provided by this program for the purposes of
applying cuts and analysis.
To link a \fastjet\ installation to \whizard, you should specify the flag
\begin{quote}
\ttt{--enable-fastjet}
\end{quote}
to \ttt{configure}. If \fastjet\ is installed in a non-default directory
where \whizard\ would not find it, specify also
\begin{quote}
\ttt{--with-fastjet=\emph{<your-fastjet-installation-path>}}
\end{quote}
A successful \whizard\ configuration should produce a screen output
similar to this:
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- FASTJET ---
configure:
checking for fastjet-config... /usr/local/bin/fastjet-config
checking if FastJet is functional... yes
checking FastJet... yes
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
%%%%%
\subsection{STDHEP}
\label{sec:stdhep}
\stdhep\ is a library for handling collider scattering
events~\cite{stdhep}. In particular, it provides a portable format
for event files. Until version 2.2.7 of \whizard, \stdhep\ that was
maintained by Fermilab, could be linked as an externally compiled
library. As the \stdhep\ package is frozen in its final release
v5.06.1 and no longer maintained, it has from version 2.2.8 been
included \whizard. This eases many things, as it was notoriously
difficult to compile and link \stdhep\ in a way compatible with
\whizard. Not the full package has been included, but only the
libraries for file I/O (\ttt{mcfio}, the library for the XDR
conversion), while the various translation tools for \pythia, \herwig,
etc. have been abandoned. Note that \stdhep\ has largely been
replaced in the hadron collider community by the \hepmc\ format, and
in the lepton collider community by \lcio. \whizard\ might serve as a
conversion tools for all these formats, but other tools also exist, of
course.
If the \stdhep\ library is linked with the installation, \whizard\ is
able to write files in the \stdhep\ format, the corresponding
configure output notifies you that \stdhep\ is always included:
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- STDHEP ---
configure:
configure: StdHEP v5.06.01 is included internally
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
%%%%%
\subsection{LCIO}
\label{sec:lcio}
\lcio\ is a \ttt{C++} class library for handling collider scattering
events. In particular, it provides a portable format for event files.
If you want to use this format, you should link \whizard\ with \lcio,
otherwise you can skip this section.
If it is not already installed on your system, you may obtain
\lcio\ from:
\begin{quote}
\url{http://lcio.desy.de}
\end{quote}
If the \lcio\ library is linked with the installation, \whizard\ is
able to read and write files in the \lcio\ format.
Detailed information on the installation and usage can be found on the
\lcio\ homepage. We give here only some brief details relevant for
the usage with \whizard: For the compilation of \lcio\ one needs a
\ttt{C++} compiler. \lcio\ is based on \ttt{cmake}. For the
corresponding options please confer the \lcio\ manual.
A \whizard\ configuration for \lcio\ looks like this:
\begin{footnotesize}
\begin{verbatim}
configure: --------------------------------------------------------------
configure: --- LCIO ---
configure:
checking the LCIO version... 2.7.1
checking for LCEventImpl class in -llcio... yes
configure: --------------------------------------------------------------
\end{verbatim}
\end{footnotesize}
If \lcio\ is installed in a non-default directory where \whizard\
would not find it, set the environment variable \ttt{LCIO} or
\ttt{LCIO\_DIR} to the correct installation path when configuring
\whizard. The first one is the variable exported by the
\ttt{setup.sh} script while the second one is analogous to the
environment variables of other external packages. \ttt{LCIO} takes
precedence over \ttt{LCIO\_DIR}. Furthermore, the environment variable
\ttt{CXXFLAGS} allows you to set specific \ttt{C/C++} preprocessor
flags, e.g. non-standard include paths for header files.
%%%%%
\section{Installation}
\label{sec:installation}
Once you have unpacked the source (either the tarball or the SVN
version), you are ready to compile it. There are several options.
\subsection{Central Installation}
This is the default and recommended way, but it requires adminstrator
privileges. Make sure that all
prerequisites are met (Sec.~\ref{sec:prerequisites}).
\begin{enumerate}
\item
Create a fresh directory for the \whizard\ build. It is recommended
to keep this separate from the source directory.
\item
Go to that directory and execute
\begin{interaction}
your-build-directory> your-src-directory/configure
\end{interaction}
This will analyze your system and prepare the compilation of \whizard\
in the build directory. Make sure to set the proper options to
\ttt{configure}, see Sec.~\ref{sec:configure-options} below.
\item
Call \ttt{make} to compile and link \whizard:
\begin{interaction}
your-build-directory> make
\end{interaction}
\item
If you want to make sure that everything works, run
\begin{interaction}
your-build-directory> make check
\end{interaction}
This will take some more time.
\item
Become superuser and say
\begin{interaction}
your-build-directory> make install
\end{interaction}
\end{enumerate}
\whizard\ should now installed in the default locations, and the
executable should be available in the standard path. Try to call
\ttt{whizard --help} in order to check this.
\subsection{Installation in User Space}
You may lack administrator privileges on your system. In that case,
you can still install and run \whizard. Make sure that all
prerequisites are met (Sec.~\ref{sec:prerequisites}).
\begin{enumerate}
\item
Create a fresh directory for the \whizard\ build. It is recommended
to keep this separate from the source directory.
\item
Reserve a directory in user space for the \whizard\ installation.
It should be empty, or yet non-existent.
\item
Go to that directory and execute
\begin{interaction}
your-build-directory> your-src-directory/configure
--prefix=your-install-directory
\end{interaction}
This will analyze your system and prepare the compilation of \whizard\
in the build directory. Make sure to set the proper additional options to
\ttt{configure}, see Sec.~\ref{sec:configure-options} below.
\item
Call \ttt{make} to compile and link \whizard:
\begin{interaction}
your-build-directory> make
\end{interaction}
\item
If you want to make sure that everything works, run
\begin{interaction}
your-build-directory> make check
\end{interaction}
This will take some more time.
\item
Install:
\begin{interaction}
your-build-directory> make install
\end{interaction}
\end{enumerate}
\whizard\ should now be installed in the installation directory of your
choice. If the installation is not in your standard search paths, you
have to account for this by extending the paths appropriately, see
Sec.~\ref{sec:workspace}.
\subsection{Configure Options}
\label{sec:configure-options}
The configure script accepts environment variables and flags. They
can be given as arguments to the \ttt{configure} program in arbitrary
order. You may run \ttt{configure --help} for a listing; only the
last part of this long listing is specific for the \whizard\ system.
Here is an example:
\begin{interaction}
configure FC=gfortran-4.8 FCFLAGS="-g -O3" --enable-fc-openmp
\end{interaction}
The most important options are
\begin{itemize}
\item
\ttt{FC} (variable): The \fortran\ compiler. This is necessary if
you need a compiler different from the standard compiler on the
system, e.g., if the latter is too old.
\item
\ttt{FCFLAGS} (variable): The flags to be given to the Fortran
compiler. The main use is to control the level of optimization.
\item
\ttt{--prefix=\var{directory-name}}: Specify a non-default directory
for installation.
\item
\ttt{--enable-fc-openmp}: Enable parallel executing via OpenMP on a
multi-processor/multi-core machine. This works only if OpenMP is
supported by the compiler (e.g., \ttt{gfortran}). When running
\whizard, the number of processors that are actually requested can
be controlled by the user. Without this option, \whizard\ will run
in serial mode on a single core. See Sec.~\ref{sec:openmp} for
further details.
\item
\ttt{--enable-fc-mpi}: Enable parallel executing via MPI on a single
machine using several cores or several machines. This works only if a MPI
library is installed (e.g. \ttt{OpenMPI}) and \ttt{FC=mpifort CC=mpicc CXX=mpic++} is
set. Without this option, \whizard\ will run in serial mode on a single core.
The flag can be combined with \ttt{--enable-fc-openmp}. See Sec.~\ref{sec:mpi}
for further details.
\item
\ttt{LHADPF\_DIR} (variable): The location of the optional \lhapdf\
package, if non-default.
\item
\ttt{LOOPTOOLS\_DIR} (variable): The location of the optional \ttt{LOOPTOOLS}
package, if non-default.
\item
\ttt{OPENLOOPS\_DIR} (variable): The location of the optional \openloops\
package, if non-default.
\item
\ttt{GOSAM\_DIR} (variable): The location of the optional \gosam\
package, if non-default.
\item
\ttt{HOPPET\_DIR} (variable): The location of the optional \hoppet\
package, if non-default.
\item
\ttt{HEPMC\_DIR} (variable): The location of the optional \hepmc\ package, if
non-default.
\item
\ttt{LCIO}/\ttt{LCIO\_DIR} (variable): The location of the optional
\lcio\ package, if non-default.
\end{itemize}
Other flags that might help to work around possible problems are the
flags for the $C$ and $C++$ compilers as well as the \ttt{Fortran77}
compiler, or the linker flags and additional libraries for the linking
process.
\begin{itemize}
\item
\ttt{CC} (variable): \ttt{C} compiler command
\item
\ttt{F77} (variable): \ttt{Fortran77} compiler command
\item
\ttt{CXX} (variable): \ttt{C++} compiler command
\item
\ttt{CPP} (variable): \ttt{C} preprocessor
\item
\ttt{CXXCPP} (variable): \ttt{C++} preprocessor
\item
\ttt{CFLAGS} (variable): \ttt{C} compiler flags
\item
\ttt{FFLAGS} (variable): \ttt{Fortran77} compiler flags
\item
\ttt{CXXFLAGS} (variable): \ttt{C++} compiler flags
\item
\ttt{LIBS} (variable): libraries to be passed to the linker as
\ttt{-l{\em library}}
\item
\ttt{LDFLAGS} (variable): non-standard linker flags
\end{itemize}
For other options (like e.g. \ttt{--with-precision=...} etc.) please
see the \ttt{configure --help} option.
%%%%%
\subsection{Details on the Configure Process}
The configure process checks for the build and host system type; only
if this is not detected automatically, the user would have to specify
this by himself. After that system-dependent files are searched for,
LaTeX and Acroread for documentation and plots, the \fortran\ compiler
is checked, and finally the \ocaml\ compiler. The next step is the
checks for external programs like \lhapdf\ and \ttt{HepMC}.
Finally, all the Makefiles are being built.
The compilation is done by invoking \ttt{make} and finally
\ttt{make install}. You could also do a \ttt{make check} in
order to test whether the compilation has produced sane files on your
system. This is highly recommended.
Be aware that there be problems for the installation if the install
path or a user's home directory is part of an AFS file system. Several
times problems were encountered connected with conflicts with
permissions inside the OS permission environment variables and the AFS
permission flags which triggered errors during the \ttt{make install}
procedure. Also please avoid using \ttt{make -j} options of parallel
execution of \ttt{Makefile} directives as AFS filesystems might not be
fast enough to cope with this.
For specific problems that might have been encountered in rare
circumstances for some FORTRAN compilers confer the webpage
\url{https://projects.hepforge.org/whizard/compilers.html}.
Note that the \pythia\ bundle for showering and hadronization (and
some other external legacy code pieces) do still contain good old
\ttt{Fortran77} code. These parts should better be
compiled with the very same \ttt{Fortran2003} compiler as the
\whizard\ core. There is, however, one subtlety:
when the \ttt{configure} flag \ttt{FC} gets a full system path as
argument, \ttt{libtool} is not able to recognize this as a valid (GNU)
\ttt{Fortran77} compiler. It then searches automatically for binaries
like \ttt{f77}, \ttt{g77} etc. or a standard system compiler. This
might result in a compilation failure of the \ttt{Fortran77} code. A
viable solution is to define an executable link and use this (not the
full path!) as \ttt{FC} flag.
It is possible to compile \whizard\ without the \ocaml\ parts of
\oMega, namely by using the \ttt{--disable-omega} option of the
configure. This will result in a built of \whizard\ with the \oMega\
Fortran library, but without the binaries for the matrix element
generation. All selftests (cf. \ref{sec:selftests}) requiring \oMega\
matrix elements are thereby switched off. Note that you can install
such a built (e.g. on a batch system without \ocaml\ installation), but
the try to build a distribution (all \ttt{make distxxx} targets) will fail.
%%%%%%%%%%%
\subsection{\whizard\ self tests/checks}
\label{sec:selftests}
\whizard\ has a number of self-consistency checks and tests which assure
that most of its features are running in the intended way. The
standard procedure to invoke these self tests is to perform a
\ttt{make check} from the \ttt{build} directory. If \ttt{src}
and \ttt{build} directories are the same, all relevant files for
these self-tests reside in the \ttt{tests} subdirectory of the main
\whizard\ directory. In that case, one could in principle just call the
scripts individually from the command line. Note, that if \ttt{src}
and \ttt{build} directory are different as recommended, then the
input files will have been installed in
\ttt{prefix/share/whizard/test}, while the corresponding test shell
scripts remain in the \ttt{srcdir/test} directory. As the main shell
script \ttt{run\_whizard.sh} has been built in the \ttt{build}
directory, one now has to copy the files over by and set the correct
paths by hand, if one wishes to run the test scripts individually.
\ttt{make check} still correctly performs all \whizard\
self-consistency tests. The tests itself fall into two categories,
unit self test that individually test the modular structure of
\whizard, and tests that are run by \sindarin\ files. In future releases
of \whizard, these two categories of tests will be better separated
than in the 2.2.1 release.
There are additional, quite extensiv numerical tests for validation
and backwards compatibility checks for SM and MSSM processes. As a
standard, these extended self tests are not invoked. However, they can
be enabled by executing the corresponding specific \ttt{make check}
operations in the subdirectories for these extensive tests.
As the new \whizard\ testsuite does very thorough and scrupulous tests
of the whole \whizard\ structure, it is always possible that some
tests are failing due to some weird circumstances or because of
numerical fluctuations. In such a case do not panic, contact the
developers (\ttt{whizard@desy.de}) and provide them with the logfiles
of the failing test as well as the setup of your configuration.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\clearpage
\chapter{Working with \whizard}
\label{chap:start}
\whizard\ can run as a stand-alone program. You (the user) can steer
\whizard\ either interactively or by a script file. We will first
describe the latter method, since it will be the most common way to
interact with the \whizard\ system.
\section{Hello World}
The legacy version series 1 of the program relied on a bunch of input
files that the user had to provide in some obfuscated format. This
approach is sufficient for straightforward applications. However, once
you get experienced with a program, you start thinking about uses that
the program's authors did not foresee. In case of a Monte Carlo
package, typical abuses are parameter scans, complex patterns of cuts
and reweighting factors, or data analysis without recourse to external
packages. This requires more flexibility.
Instead of transferring control over data input to some generic
scripting language like PERL or PYTHON (or even C++), which come with
their own peculiarities and learning curves, we decided to unify data
input and scripting in a dedicated steering language that is
particularly adapted to the needs of Monte-Carlo integration,
simulation, and simple analysis of the results. Thus we discovered
what everybody knew anyway: that W(h)izards communicate in \sindarin,
Scripting INtegration, Data Analysis, Results display and INterfaces.
\sindarin\ is a DSL -- a domain-specific scripting language -- that is
designed for the single purpose of steering and talking to \whizard.
Now since \sindarin\ is a programming language, we honor the old
tradition of starting with the famous Hello World program. In
\sindarin\ this reads simply
\begin{quote}
\begin{verbatim}
printf "Hello World!"
\end{verbatim}
\end{quote}
Open your favorite editor, type this text, and save it into a file
named \verb|hello.sin|.
\begin{figure}
\centering
\begin{scriptsize}
\begin{Verbatim}[frame=single]
| Writing log to 'whizard.log'
|=============================================================================|
| |
| WW WW WW WW WW WWWWWW WW WWWWW WWWW |
| WW WW WW WW WW WW WW WWWW WW WW WW WW |
| WW WW WW WW WWWWWWW WW WW WW WW WWWWW WW WW |
| WWWW WWWW WW WW WW WW WWWWWWWW WW WW WW WW |
| WW WW WW WW WW WWWWWW WW WW WW WW WWWW |
| |
| |
| W |
| sW |
| WW |
| sWW |
| WWW |
| wWWW |
| wWWWW |
| WW WW |
| WW WW |
| wWW WW |
| wWW WW |
| WW WW |
| WW WW |
| WW WW |
| WW WW |
| WW WW |
| WW WW |
| wwwwww WW WW |
| WWWWWww WW WW |
| WWWWWwwwww WW WW |
| wWWWwwwwwWW WW |
| wWWWWWWWWWWwWWW WW |
| wWWWWW wW WWWWWWW |
| WWWW wW WW wWWWWWWWwww |
| WWWW wWWWWWWWwwww |
| WWWW WWWW WWw |
| WWWWww WWWW |
| WWWwwww WWWW |
| wWWWWwww wWWWWW |
| WwwwwwwwwWWW |
| |
| |
| |
| by: Wolfgang Kilian, Thorsten Ohl, Juergen Reuter |
| with contributions from Christian Speckner |
| Contact: <whizard@desy.de> |
| |
| if you use WHIZARD please cite: |
| W. Kilian, T. Ohl, J. Reuter, Eur.Phys.J.C71 (2011) 1742 |
| [arXiv: 0708.4233 [hep-ph]] |
| M. Moretti, T. Ohl, J. Reuter, arXiv: hep-ph/0102195 |
| |
|=============================================================================|
| WHIZARD 2.6.4
|=============================================================================|
| Reading model file '/usr/local/share/whizard/models/SM.mdl'
| Preloaded model: SM
| Process library 'default_lib': initialized
| Preloaded library: default_lib
| Reading commands from file 'hello.sin'
Hello World!
| WHIZARD run finished.
|=============================================================================|
\end{Verbatim}
\end{scriptsize}
\caption{Output of the \ttt{"Hello world!"} \sindarin\ script.\label{fig:helloworld}}
\end{figure}
Now we assume that you -- or your kind system administrator -- has
installed \whizard\ in your executable path. Then you should open a
command shell and execute (we will come to the meaning of the
\verb|-r| option later.)
\begin{verbatim}
/home/user$ whizard -r hello.sin
\end{verbatim}
and if everything works well, you get the output (the complete output
including the \whizard\ banner is shown in Fig.~\ref{fig:helloworld})
\begin{footnotesize}
\begin{verbatim}
| Writing log to 'whizard.log'
\end{verbatim}
\centerline{[... here a banner is displayed]}
\begin{Verbatim}
|=============================================================================|
| WHIZARD 2.6.4
|=============================================================================|
| Reading model file '/usr/local/share/whizard/models/SM.mdl'
| Preloaded model: SM
! Process library 'default_lib': initialized
! Preloaded library: default_lib
| Reading commands from file 'hello.sin'
Hello World!
| WHIZARD run finished.
|=============================================================================|
\end{Verbatim}
\end{footnotesize}
If this has just worked for you, you can be confident that you have a working
\whizard\ installation, and you have been able to successfully run the
program.
\section{A Simple Calculation}
You may object that \whizard\ is not exactly designed for printing out
plain text. So let us demonstrate a more useful example.
Looking at the Hello World output, we first observe that the program
writes a log file named (by default) \verb|whizard.log|. This file
receives all screen output, except for the output of external programs
that are called by \whizard. You don't have to cache \whizard's screen
output yourself.
After the welcome banner, \whizard\ tells you that it reads a physics
\emph{model}, and that it initializes and preloads a \emph{process library}. The
process library is initially empty. It is ready for receiving
definitions of elementary high-energy physics processes (scattering or
decay) that you provide. The processes are set in the context of a
definite model of high-energy physics. By default this is the
Standard Model, dubbed \verb|SM|.
Here is the \sindarin\ code for defining a SM physics process, computing
its cross section, and generating a simulated event sample in Les Houches
event format:
\begin{quote}
\begin{Verbatim}
process ee = e1, E1 => e2, E2
sqrts = 360 GeV
n_events = 10
sample_format = lhef
simulate (ee)
\end{Verbatim}
\end{quote}
As before, you save this text in a file (named, e.g.,
\verb|ee.sin|) which is run by
\begin{verbatim}
/home/user$ whizard -r ee.sin
\end{verbatim}
(We will come to the meaning of the \verb|-r| option later.)
This produces a lot of output which looks similar to this:
\begin{footnotesize}
\begin{verbatim}
| Writing log to 'whizard.log'
[... banner ...]
|=============================================================================|
| WHIZARD 2.6.4
|=============================================================================|
| Reading model file '/usr/local/share/whizard/models/SM.mdl'
| Preloaded model: SM
| Process library 'default_lib': initialized
| Preloaded library: default_lib
| Reading commands from file 'ee.sin'
| Process library 'default_lib': recorded process 'ee'
sqrts = 3.600000000000E+02
n_events = 10
\end{verbatim}
\begin{verbatim}
| Starting simulation for process 'ee'
| Simulate: process 'ee' needs integration
| Integrate: current process library needs compilation
| Process library 'default_lib': compiling ...
| Process library 'default_lib': writing makefile
| Process library 'default_lib': removing old files
rm -f default_lib.la
rm -f default_lib.lo default_lib_driver.mod opr_ee_i1.mod ee_i1.lo
rm -f ee_i1.f90
| Process library 'default_lib': writing driver
| Process library 'default_lib': creating source code
rm -f ee_i1.f90
rm -f opr_ee_i1.mod
rm -f ee_i1.lo
/usr/local/bin/omega_SM.opt -o ee_i1.f90 -target:whizard
-target:parameter_module parameters_SM -target:module opr_ee_i1
-target:md5sum '70DB728462039A6DC1564328E2F3C3A5' -fusion:progress
-scatter 'e- e+ -> mu- mu+'
[1/1] e- e+ -> mu- mu+ ... allowed. [time: 0.00 secs, total: 0.00 secs, remaining: 0.00 secs]
all processes done. [total time: 0.00 secs]
SUMMARY: 6 fusions, 2 propagators, 2 diagrams
| Process library 'default_lib': compiling sources
[.....]
\end{verbatim}
\begin{verbatim}
| Process library 'default_lib': loading
| Process library 'default_lib': ... success.
| Integrate: compilation done
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 9616
| Initializing integration for process ee:
| ------------------------------------------------------------------------
| Process [scattering]: 'ee'
| Library name = 'default_lib'
| Process index = 1
| Process components:
| 1: 'ee_i1': e-, e+ => mu-, mu+ [omega]
| ------------------------------------------------------------------------
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 5.1099700E-04 GeV)
| e+ (mass = 5.1099700E-04 GeV)
| sqrts = 3.600000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'ee_i1.phs'
| Phase space: 2 channels, 2 dimensions
| Phase space: found 2 channels, collected in 2 groves.
| Phase space: Using 2 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
\end{verbatim}
\begin{verbatim}
| Starting integration for process 'ee'
| Integrate: iterations not specified, using default
| Integrate: iterations = 3:1000:"gw", 3:10000:""
| Integrator: 2 chains, 2 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 1000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 784 8.3282892E+02 1.68E+00 0.20 0.06* 39.99
2 784 8.3118961E+02 1.23E+00 0.15 0.04* 76.34
3 784 8.3278951E+02 1.36E+00 0.16 0.05 54.45
|-----------------------------------------------------------------------------|
3 2352 8.3211789E+02 8.01E-01 0.10 0.05 54.45 0.50 3
|-----------------------------------------------------------------------------|
4 9936 8.3331732E+02 1.22E-01 0.01 0.01* 54.51
5 9936 8.3341072E+02 1.24E-01 0.01 0.01 54.52
6 9936 8.3331151E+02 1.23E-01 0.01 0.01* 54.51
|-----------------------------------------------------------------------------|
6 29808 8.3334611E+02 7.10E-02 0.01 0.01 54.51 0.20 3
|=============================================================================|
\end{verbatim}
\begin{verbatim}
[.....]
| Simulate: integration done
| Simulate: using integration grids from file 'ee_m1.vg'
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 9617
| Simulation: requested number of events = 10
| corr. to luminosity [fb-1] = 1.2000E-02
| Events: writing to LHEF file 'ee.lhe'
| Events: writing to raw file 'ee.evx'
| Events: generating 10 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
| Events: closing LHEF file 'ee.lhe'
| Events: closing raw file 'ee.evx'
| There were no errors and 1 warning(s).
| WHIZARD run finished.
|=============================================================================|
\end{verbatim}
\end{footnotesize}
%$
The final result is the desired event file, \ttt{ee.lhe}.
Let us discuss the output quickly to walk you through the procedures
of a \whizard\ run: after the logfile message and the banner, the
reading of the physics model and the initialization of a process
library, the recorded process with tag \ttt{'ee'} is recorded. Next,
user-defined parameters like the center-of-mass energy and the number
of demanded (unweighted) events are displayed. As a next step,
\whizard\ is starting the simulation of the process with tag
\ttt{'ee'}. It recognizes that there has not yet been an integration
over phase space (done by an optional \ttt{integrate} command,
cf. Sec.~\ref{sec:integrate}), and consequently starts the
integration. It then acknowledges, that the process code for the
process \ttt{'ee'} needs to be compiled first (done by an optional
\ttt{compile} command, cf. Sec.~\ref{sec:compilation}). So, \whizard\
compiles the process library, writes the makefile for its steering,
and as a safeguard against garbage removes possibly existing
files. Then, the source code for the library and its processes are
generated: for the process code, the default method -- the matrix
element generator \oMega\ is called (cf. Sec.~\ref{sec:omega_me}); and
the sources are being compiled.
The next steps are the loading of the process library, and \whizard\
reports the completion of the integration. For the Monte-Carlo
integration, a random number generator is initialized. Here, it is the
default generator, TAO (for more details, cf. Sec.~\ref{sec:tao},
while the random seed is set to a value initialized by the system
clock, as no seed has been provided in the \sindarin\ input file.
Now, the integration for the process \ttt{'ee'} is initialized, and
information about the process (its name, the name of its process
library, its index inside the library, and the process components out
of which it consists, cf. Sec.~\ref{sec:processcomp}) are
displayed. Then, the beam structure is shown, which in that case are
symmetric partonic electron and positron beams with the center-of-mass
energy provided by the user (360 GeV). The next step is the generation
of the phase space, for which the default phase space method
\ttt{wood} (for more details cf. Sec.~\ref{sec:wood}) is selected. The
integration is performed, and the result with absolute and relative
error, unweighting efficiency, accuracy, $\chi^2$ quality is shown.
The final step is the event generation
(cf. Chap.~\ref{chap:events}). The integration grids are now being
used, again the random number generator is initialized. Finally, event
generation of ten unweighted events starts (\whizard\ let us know to
which integrated luminosity that would correspond), and events are
written both in an internal (binary) event format as well as in the
demanded LHE format. This concludes the \whizard\ run.
After a more comprehensive introduction into the \sindarin\ steering
language in the next chapter, Chap.~\ref{chap:sindarinintro}, we will
discuss all the details of the different steps of this introductory
example.
\clearpage
\section{WHIZARD in a Computing Environment}
\subsection{Working on a Single Computer}
\label{sec:workspace}
After installation, \whizard\ is ready for use. There is a slight
complication if \whizard\ has been installed in a location that is not
in your standard search paths.
In that case, to successfully run \whizard, you may either
\begin{itemize}
\item
manually add \ttt{your-install-directory/bin} to your execution PATH\\
and \ttt{your-install-directory/lib} to your library search path
(LD\_LIBRARY\_PATH), or
\item
whenever you start a project, execute
\begin{interaction}
your-workspace> . your-install-directory/bin/whizard-setup.sh
\end{interaction}
which will enable the paths in your current environment, or
\item
source \ttt{whizard-setup.sh} script in your shell startup file.
\end{itemize}
In either case, try to call \ttt{whizard --help} in order to check
whether this is done correctly.
For a new \whizard\ project, you should set up a new (empty)
directory. Depending on the complexity of your task, you may want to
set up separate directories for each subproblem that you want to
tackle, or even for each separate run. The location of the
directories is arbitrary.
To run, \whizard\ needs only a single input file, a \sindarin\ command
script with extension \ttt{.sin} (by convention). Running
\whizard\ is as simple as
\begin{interaction}
your-workspace> whizard your-input.sin
\end{interaction}
No other configuration files are needed. The total number of
auxiliary and output files generated in a single run may get quite
large, however, and they may clutter your workspace. This is the
reason behind keeping subdirectories on a per-run basis.
Basic usage of \whizard\ is explained in Chapter~\ref{chap:start}, for
more details, consult the following chapters. In
Sec.~\ref{sec:cmdline-options} we give an account of the command-line
options that \whizard\ accepts.
\subsection{Working Parallel on Several Computers}
\label{sec:mpi}
For integration (only VAMP2), \whizard\ supports parallel execution via MPI
by communicating between parallel tasks on a single machine or distributed over
several machines.
During integration the calculation of channels is distributed along several
workers where a master worker collects the results and adapts weights and grids.
In wortwhile cases (e.g. high number of calls in one channel), the calculation
of a single grid is distributed.
In order to use these advancements, \whizard\ requires an installed MPI-3.1 capable
library (e.g. OpenMPI) and configuration and compilation with the appropriate flags,
cf.~Sec.~\ref{sec:installation}.
MPI support is only active when the integration method is set to VAMP2.
Additionally, to preserve the numerical properties of a single task run, it is
recommended to use the RNGstream as random number generator.
\begin{code}
$integration_method = 'vamp2'
$rng_method = 'rng_stream'
\end{code}
\whizard\ has then to be called by mpirun
\begin{footnotesize}
\begin{Verbatim}[frame=single]
your-workspace> mpirun -f hostfile -np 4 --output-filename mpi.log whizard your-input.sin
\end{Verbatim}
\end{footnotesize}
where the number of parallel tasks can be set by \ttt{-np} and a hostfile can be
given by \ttt{--hostfile}. It is recommended to use \ttt{--output-filename} which
lets mpirun redirect the standard (error) output to a file, for each worker separatly.
Some caveats exist regarding MPI which are mostly based on output operations.
Following are known issues,
\begin{itemize}
\item runIDs are not supported,
\item event generation must not be run with MPI.
\end{itemize}
The latter can be trivially parallelized by hand.
\subsection{Stopping and Resuming WHIZARD Jobs}
On a Unix-like system, it is possible to prematurely stop running jobs
by a \ttt{kill(1)} command, or by entering \ttt{Ctrl-C} on the
terminal.
If the system supports this, \whizard\ traps these signals. It also
traps some signals that a batch operating system might issue, e.g.,
for exceeding a predefined execution time limit. \whizard\ tries to
complete the calculation of the current event and gracefully close
open files. Then, the program terminates with a message and a nonzero
return code. Usually, this should not take more than a fraction of a
second.
If, for any reason, the program does not respond to an interrupt, it
is always possible to kill it by \ttt{kill -9}. A convenient method,
on a terminal, would be to suspend it first by \ttt{Ctrl-Z} and then
to kill the suspended process.
The program is usually able to recover after being stopped. Simply
run the job again from start, with the same input, all output files
generated so far left untouched. The results obtained so far will be
quickly recovered or gathered from files written in the previous run,
and the actual time-consuming calculation is resumed near the point
where it was interrupted.\footnote{This holds for simple workflow. In
case of scans and repeated integrations of the same process, there
may be name clashes on the written files which prevent resuming. A
future \whizard\ version will address this problem.} If the
interruption happened during an integration step, it is resumed after
the last complete iteration. If it was during event generation, the
previous events are taken from file and event generation is continued.
The same mechanism allows for efficiently redoing a calculation with
similar, somewhat modified input. For instance, you might want to add
a further observable to event analysis, or write the events in a
different format. The time for rerunning the program is determined
just by the time it takes to read the existing integration or event
files, and the additional calculation is done on the recovered
information.
By managing various checksums on its input and output files, \whizard\
detects changes that affect further calculations, so it does a
real recalculation only where it is actually needed. This applies to
all steps that are potentially time-consuming: matrix-element code
generation, compilation, phase-space setup, integration, and event
generation. If desired, you can set command-line options or
\sindarin\ parameters that explicitly discard previously generated
information.
\subsection{Files and Directories: default and customization}
\whizard\ jobs take a small set of files as input. In many cases, this is
just a single \sindarin\ script provided by the user.
When running, \whizard\ can produce a set of auxiliary and output files:
\begin{enumerate}
\item
\textbf{Job.}
Files pertaining to the \whizard\ job as a whole. This is the default log
file \ttt{whizard.log}.
\item
\textbf{Process compilation.} Files that originate from generating and
compiling process code. If the default \oMega\ generator is used, these
files include Fortran source code as well as compiled libraries that are
dynamically linked to the running executable. The file names are derived
from either the process-library name or the individual process names, as
defined in the \sindarin\ input. The default library name is
\ttt{default\_lib}.
\item
\textbf{Integration.}
Files that are created by integration, i.e., when calculating the total cross
section for a scattering process using the Monte-Carlo algorithm. The file
names are derived from the process name.
\item
\textbf{Simulation.}
Files that are created during simulation, i.e., generating event samples for
a process or a set of processes. By default, the file names are derived
from the name of the first process. Event-file formats are distinguished
by appropriate file name extensions.
\item
\textbf{Result Analysis.}
Files that are created by the internal analysis tools and written by the
command \ttt{write\_analysis} (or \ttt{compile\_analysis}). The default
base name is \ttt{whizard\_analysis}.
\end{enumerate}
A complex workflow with several processes, parameter sets, or runs, can easily
lead to in file-name clashes or a messy working directory. Furthermore,
running a batch job on a dedicated computing environment often requires
transferring data from a user directory to the server and back.
Custom directory and file names can be used to organize things and facilitate
dealing with the environment, along with the available batch-system tools for
coordinating file transfer.
\begin{enumerate}
\item
\textbf{Job.}
\begin{itemize}
\item
The \ttt{-L} option on the command line defines a custom base name for
the log file.
\item
The \ttt{-J} option on the command line defines a job ID. For instance,
this may be set to the job ID assigned by the batch system. Within the
\sindarin\ script, the job ID is available as the string variable
\ttt{\$job\_id} and can be used for constructing custom job-specific file
and directory names, as described below.
\end{itemize}
\item
\textbf{Process compilation.}
\begin{itemize}
\item
The user can require the program to put all files created during the
compilation step including the library to be linked, in a subdirectory of
the working directory. To enable this, set the string variable
\ttt{\$compile\_workspace} within the \sindarin\ script.
\end{itemize}
\item
\textbf{Integration.}
\begin{itemize}
\item
The value of the string variable \ttt{\$run\_id}, if set, is appended to
the base name of all files created by integration, separated by dots. If
the \sindarin\ script scans over parameters, varying the run ID avoids
repeatedly overwriting files with identical name during the scan.
-
- These files contain logs and results and are put in the working
- directory.
\item
- As a subset of the files created by integration, \vamp\ grid files are used
- for adapting integration passes and steering simulation. These files can
- become large for complicated processes. The string variable
- \ttt{\$grid\_path}, if set, tells the program to put those in a
- subdirectory of the working directory with the given name.
+ The user can require the program to put the important files created during
+ the integration step -- the phase-space configuration file and the
+ \vamp\ grid files -- in a subdirectory of the working directory. To
+ enable this, set the string variable \ttt{\$integrate\_workspace} within
+ the \sindarin\ script. (\ttt{\$compile\_workspace} and
+ \ttt{\$integrate\_workspace} may be set to the same value.)
\end{itemize}
+ Log files produced during the integration step are put in the working
+ directory.
\item
\textbf{Simulation.}
\begin{itemize}
\item
The value of the string variable \ttt{\$run\_id}, if set, identifies
the specific integration run that is used for the event sample. It is
also inserted into default event-sample file names.
\item
The variable \ttt{\$sample}, if set, defines an arbitrary base name for the
files related to the event sample.
\end{itemize}
Files resulting from simulation are put in the working directory.
\item
\textbf{Result Analysis.}
\begin{itemize}
\item
The variable \ttt{\$out\_file}, if set,
defines an arbitrary base name for the analysis data and
auxiliary files.
\end{itemize}
Files resulting from result analysis are put in the working directory.
\end{enumerate}
+\subsection{Batch jobs on a different machine}
+
+It is possible to separate the tasks of process-code compilation, integration,
+and simulation, and execute them on different machines. To make use of
+this feature, the local and remote machines including all
+installed libraries that are relevant for \whizard, must be
+binary-compatible.
+\begin{enumerate}
+\item
+ Process-code compilation may be done once on a local machine, while the
+ time-consuming tasks of integration and event generation for specific
+ parameter sets are delegated to a remote machine, e.g., a batch cluster. To
+ enable this, prepare a \sindarin\ script that just produces process code
+ (i.e., terminates with a \ttt{compile} command) for the local machine. You
+ may define \ttt{\$compile\_workspace} such that all generated code
+ conveniently ends up in a single subdirectory.
+
+ To start the batch job, transfer the workspace subdirectory to the remote
+ machine
+ and start \whizard\ there. The \sindarin\ script on the remote machine must
+ include the local script unchanged in all parts that are relevant for
+ process definition. The program will recognize the contents of the
+ workspace, skip compilation and instead link the process library immediately.
+ To proceed further, the script should define the run-specific parameters and
+ contain the appropriate commands for integration and simulation.
+\item
+ Analogously, you may execute both process-code compilation and integration
+ locally, but generate event samples on a remote machine. To this end,
+ prepare a \sindarin\ script that produces process code and computes integrals
+ (i.e., terminates with an \ttt{integrate} command) for the local machine.
+ You may define \ttt{\$compile\_workspace} and \ttt{\$integrate\_workspace}
+ (which may coincide) such that all generated code, phase-space and
+ integration grid data conveniently end up in subdirectories.
+
+ To start the batch job, transfer the workspace(s) to the remote machine and
+ start \whizard\ there. The \sindarin\ script on the remote machine must
+ include the local script unchanged in all parts that are relevant for
+ process definition and integration. The program will recognize the contents
+ of the workspace, skip compilation and integration and instead load the
+ process library and integration results immediately. To proceed further,
+ the script should define the sample-specific parameters and contain the
+ appropriate commands for simulation.
+\end{enumerate}
+
+To simplify transferring whole directories, \whizard\ supports the
+\ttt{--pack} and \ttt{--unpack} options. You may specify any number of these
+options for a \whizard\ run. (The feature relies on the GNU version of the
+\ttt{tar} utility.)
+
+For instance,
+\begin{code}
+whizard script1.sin --pack my_ws
+\end{code}
+runs \whizard\ with the \sindarin\ script \ttt{script1.sin} as input, where
+within the script you have defined
+\begin{code}
+$compile_workspace = "my_ws"
+\end{code}
+as the target directory for process-compilation files. After completion, the
+program will tar and gzip the target directory as \ttt{my\_ws.tgz}. You
+should copy this file to the remote machine as one of the job's input files.
+
+On the remote machine, you can then run the program with
+\begin{code}
+whizard script2.sin --unpack my_ws.tgz
+\end{code}
+where \ttt{script2.sin} should include \ttt{script1.sin}, and add integration
+or simulation commands. The contents of \ttt{ws.tgz} will thus be unpacked
+and reused on the remote machine, instead of generating new process code.
+
+
\subsection{Static Linkage}
In its default running mode, \whizard\ compiles process-specific matrix
element code on the fly and dynamically links the resulting library. On the
computing server, this requires availability of the appropriate Fortran
compiler, as well as the \ocaml\ compiler suite, and the dynamical linking
feature.
Since this may be unavailable or undesired, there is a possibility to
distribute \whizard\ as a statically linked executable that contains a
pre-compiled library of processes. This removes the need for the Fortran
compiler, the \ocaml\ system, and extra dynamic linking. Any external
libraries that are accessed (the \fortran\ runtime environment, and possibly
some dynamically linked external libraries and/or the C++ runtime library,
must still be available on the target system, binary-compatible. Otherwise,
there is no need for transferring the complete \whizard\ installation or
-relocating paths.
+process-code compilation data.
Generating, compiling and linking matrix element code is done in advance on a
machine that can access the required tools and produces compatible libraries.
This procedure is accomplished by \sindarin\ commands, explained below in
Sec.~\ref{sec:static}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\newpage
\section{Troubleshooting}
\label{sec:troubleshooting}
In this section, we list known issues or problems and give advice on
what can be done in case something does not work as intended.
\subsection{Possible (uncommon) build problems}
\label{sec:buildproblems}
\subsubsection{\ocaml\ versions and \oMega\ builds}
For the matrix element generator \oMega\ of \whizard\, the functional
programming language \ocaml\ is used. Unfortunately, the versions of
the \ocaml\ compiler from 3.12.0 on broke backwards
compatibility. Therefore, versions of \oMega/\whizard\ up to v2.0.2
only compile with older versions (3.04 to 3.11 works). This has been
fixed in all \whizard\ versions from 2.0.3 on.
\subsubsection{Identical Build and Source directories}
There is a problem that only occurred with version 2.0.0 and has been
corected for all follow-up versions. It can only appear if you
compile the \whizard\ sources in the source directory. Then an error
like this may occur:
\begin{footnotesize}
\begin{Verbatim}[frame=single]
...
libtool: compile: gfortran -I../misc -I../vamp -g -O2 -c processes.f90 -fPIC -o
.libs/processes.o
libtool: compile: gfortran -I../misc -I../vamp -g -O2 -c processes.f90 -o
processes.o >/dev/null 2>&1
make[2]: *** No rule to make target `limits.lo', needed by `decays.lo'. Stop.
...
make: *** [all-recursive] Error 1
\end{Verbatim}
\end{footnotesize}
In this case, please unpack a fresh copy of \whizard\ and configure it
in a separate directory (not necessarily a subdirectory). Then the
compilation will go through:
\begin{footnotesize}
\begin{Verbatim}[frame=single]
$ zcat whizard-2.0.0.tar.gz | tar xf -
$ cd whizard-2.0.0
$ mkdir _build
$ cd _build
$ ../configure FC=gfortran
$ make
\end{Verbatim}
\end{footnotesize}
The developers use this setup to be able to test different
compilers. Therefore building in the same directory is not as
thoroughly tested. This behavior has been patched from version 2.0.1
on. But note that in general it is always adviced to keep
build and source directory apart from each other.
%%%%%
\subsection{What happens if \whizard\ throws an error?}
\label{ref:errors}
\subsubsection{Particle name special characters in process
declarations}
Trying to use a process declaration like
\begin{code}
process foo = e-, e+ => mu-, mu+
\end{code}
will lead to a \sindarin\ syntax error:
\begin{Code}
process foo = e-, e+ => mu-, mu+
^^
| Expected syntax: SEQUENCE <cmd_process> = process <process_id> '=' <process_p
| Found token: KEYWORD: '-'
******************************************************************************
******************************************************************************
*** FATAL ERROR: Syntax error (at or before the location indicated above)
******************************************************************************
******************************************************************************
\end{Code}
\whizard\ tries to interpret the minus and plus signs as operators
(\ttt{KEYWORD: '-'}), so you have to quote the particle names:
\ttt{process foo = "e-", "e+" => "mu-", "mu+"}.
\subsubsection{Missing collider energy}
This happens if you forgot to set the collider energy in the
integration of a scattering process:
\begin{Code}
******************************************************************************
******************************************************************************
*** FATAL ERROR: Colliding beams: sqrts is zero (please set sqrts)
******************************************************************************
******************************************************************************
\end{Code}
This will solve your problem:
\begin{code}
sqrts = <your_energy>
\end{code}
\subsubsection{Missing process declaration}
If you try to integrate or simulate a process that has not declared
before (and is also not available in a library that might be loaded),
\whizard\ will complain:
\begin{Code}
******************************************************************************
******************************************************************************
*** FATAL ERROR: Process library doesn't contain process 'f00'
******************************************************************************
******************************************************************************
\end{Code}
Note that this could sometimes be a simple typo, e.g. in that case an
\ttt{integrate (f00)} instead of \ttt{integrate (foo)}
\subsubsection{Ambiguous initial state without beam declaration}
When the user declares a process with a flavor sum in the initial
state, e.g.
\begin{code}
process qqaa = u:d, U:D => A, A
sqrts = <your_energy>
integrate (qqaa)
\end{code}
then a fatal error will be issued:
\begin{Code}
******************************************************************************
******************************************************************************
*** FATAL ERROR: Setting up process 'qqaa':
*** --------------------------------------------
*** Inconsistent initial state. This happens if either
*** several processes with non-matching initial states
*** have been added, or for a single process with an
*** initial state flavor sum. In that case, please set beams
*** explicitly [singling out a flavor / structure function.]
******************************************************************************
******************************************************************************
\end{Code}
What now? Either a structure function providing a tensor structure in
flavors has to be provided like
\begin{code}
beams = p, pbar => pdf_builtin
\end{code}
or, if the partonic process was intended, a specific flavor has to be
singled out,
\begin{code}
beams = u, U
\end{code}
which would take only the up-quarks. Note that a sum over process
components with varying initial states is not possible.
\subsubsection{Invalid or unsupported beam structure}
An error message like
\begin{Code}
******************************************************************************
******************************************************************************
*** FATAL ERROR: Beam structure: [.......] not supported
******************************************************************************
******************************************************************************
\end{Code}
This happens if you try to use a beam structure with is either not
supported by \whizard\ (meaning that there is no phase-space
parameterization for Monte-Carlo integration available in order to
allow an efficient sampling), or you have chosen a combination of beam
structure functions that do not make sense physically. Here is an
example for the latter (lepton collider ISR applied to protons, then
proton PDFs):
\begin{code}
beams = p, p => isr => pdf_builtin
\end{code}
\subsubsection{Mismatch in beams}
Sometimes you get a rather long error output statement followed by a
fatal error:
\begin{Code}
Evaluator product
First interaction
Interaction: 6
Virtual:
Particle 1
[momentum undefined]
[.......]
State matrix: norm = 1.000000000000E+00
[f(2212)]
[f(11)]
[f(92) c(1 )]
[f(-6) c(-1 )] => ME(1) = ( 0.000000000000E+00, 0.000000000000E+00)
[.......]
******************************************************************************
******************************************************************************
*** FATAL ERROR: Product of density matrices is empty
*** --------------------------------------------
*** This happens when two density matrices are convoluted
*** but the processes they belong to (e.g., production
*** and decay) do not match. This could happen if the
*** beam specification does not match the hard
*** process. Or it may indicate a WHIZARD bug.
******************************************************************************
******************************************************************************
\end{Code}
As \whizard\ indicates, this could have happened because the hard
process setup did not match the specification of the beams as in:
\begin{code}
process neutral_current_DIS = e1, u => e1, u
beams_momentum = 27.5 GeV, 920 GeV
beams = p, e => pdf_builtin, none
integrate (neutral_current_DIS)
\end{code}
In that case, the order of the beam particles simply was wrong,
exchange proton and electron (together with the structure functions)
into \ttt{beams = e, p => none, pdf\_builtin}, and \whizard\ will be
happy.
\subsubsection{Unstable heavy beam particles}
If you try to use unstable particles as beams that can potentially
decay into the final state particles, you might encounter the
following error message:
\begin{Code}
******************************************************************************
******************************************************************************
*** FATAL ERROR: Phase space: Initial beam particle can decay
******************************************************************************
******************************************************************************
\end{Code}
This happens basically only for processes in testing/validation (like
$t \bar t \to b \bar b$). In principle, it could also happen in a real
physics setup, e.g. when simulating electron pairs at a muon collider:
\begin{code}
process mmee = "mu-", "mu+" => "e-", "e+"
\end{code}
However, \whizard\ at the moment does not allow a muon width, and so
\whizard\ is not able to decay a muon in a scattering process.
A possibile decay of the beam particle into (part of) the final state
might lead to instabilities in the phase space setup. Hence, \whizard\
do not let you perform such an integration right away. When you
nevertheless encounter such a rare occasion in your setup, there is a
possibility to convert this fatal error into a simple warning by
setting the flag:
\begin{code}
?fatal_beam_decay = false
\end{code}
\subsubsection{Impossible beam polarization}
If you specify a beam polarization that cannot correspond to any
physically allowed spin density matrix, e.g.,
\begin{code}
beams = e1, E1
beams_pol_density = @(-1), @(1:1:.5, -1, 1:-1)
\end{code}
\whizard\ will throw a fatal
error like this:
\begin{Code}
Trace of matrix square = 1.4444444444444444
Polarization: spin density matrix
spin type = 2
multiplicity = 2
massive = F
chirality = 0
pol.degree = 1.0000000
pure state = F
@(+1: +1: ( 3.333333333333E-01, 0.000000000000E+00))
@(-1: -1: ( 6.666666666667E-01, 0.000000000000E+00))
@(-1: +1: ( 6.666666666667E-01, 0.000000000000E+00))
******************************************************************************
******************************************************************************
*** FATAL ERROR: Spin density matrix: not permissible as density matrix
******************************************************************************
******************************************************************************
\end{Code}
\subsubsection{Beams with crossing angle}
Specifying a crossing angle (e.g. at a linear lepton collider) without
explicitly setting the beam momenta,
\begin{code}
sqrts = 1 TeV
beams = e1, E1
beams\_theta = 0, 10 degree
\end{code}
triggers a fatal:
\begin{Code}
******************************************************************************
******************************************************************************
*** FATAL ERROR: Beam structure: angle theta/phi specified but momentum/a p undefined
******************************************************************************
******************************************************************************
\end{Code}
In that case the single beam momenta have to be explicitly set:
\begin{code}
beams = e1, E1
beams\_momentum = 500 GeV, 500 GeV
beams\_theta = 0, 10 degree
\end{code}
\subsubsection{Phase-space generation failed}
Sometimes an error might be issued that \whizard\ could not generate a
valid phase-space parameterization:
\begin{Code}
| Phase space: ... failed. Increasing phs_off_shell ...
| Phase space: ... failed. Increasing phs_off_shell ...
| Phase space: ... failed. Increasing phs_off_shell ...
| Phase space: ... failed. Increasing phs_off_shell ...
******************************************************************************
******************************************************************************
*** FATAL ERROR: Phase-space: generation failed
******************************************************************************
******************************************************************************
\end{Code}
You see that \whizard\ tried to increase the number of off-shell lines
that are taken into account for the phase-space setup. The second most
important parameter for the phase-space setup, \ttt{phs\_t\_channel},
however, is not increased automatically. Its default value is $6$, so
e.g. for the process $e^+ e^- \to 8\gamma$ you will run into the
problem above. Setting
\begin{code}
phs_off_shell = <n>-1
\end{code}
where \ttt{<n>} is the number of final-state particles will solve the problem.
\subsubsection{Non-converging process integration}
There could be several reasons for this to happen. The most prominent
one is that no cuts have been specified for the process (\whizard\ttt{2}
does not apply default cuts), and there are singular regions in the
phase space over which the integration stumbles. If cuts have been
specified, it could be that they are not sufficient. E.g. in $pp \to
jj$ a distance cut between the two jets prevents singular collinear
splitting in their generation, but if no $p_T$ cut have been set,
there is still singular collinear splitting from the beams.
\subsubsection{Why is there no event file?}
If no event file has been generated, \whizard\ stumled over some error
and should have told you, or, you simply forgot to set a \ttt{simulate}
command for your process. In case there was a \ttt{simulate} command
but the process under consideration is not possible (e.g. a typo,
\ttt{e1, E1 => e2, E3} instead of \ttt{e1, E1 => e3, E3}), then you
get an error like that:
\begin{Code}
******************************************************************************
*** ERROR: Simulate: no process has a valid matrix element.
******************************************************************************
\end{Code}
\subsubsection{Why is the event file empty?}
In order to get events, you need to set either a desired number of
events:
\begin{code}
n_events = <integer>
\end{code}
or you have to specify a certain integrated luminosity (the default
unit being inverse femtobarn:
\begin{code}
luminosity = <real> / 1 fbarn
\end{code}
In case you set both, \whizard\ will take the one that leads to the
higher number of events.
\subsubsection{Parton showering fails}
For BSM models containing massive stable or long-lived particles
parton showering with \pythiasix\ fails:
\begin{Code}
Advisory warning type 3 given after 0 PYEXEC calls:
(PYRESD:) Failed to decay particle 1000022 with mass 15.000
******************************************************************************
******************************************************************************
*** FATAL ERROR: Simulation: failed to generate valid event after 10000 tries
******************************************************************************
******************************************************************************
\end{Code}
The solution to that problem is discussed in Sec.~\ref{sec:pythia6}.
\vspace{1cm}
%%%%%
\subsection{Debugging, testing, and validation}
\subsubsection{Catching/tracking arithmetic exceptions}
Catching arithmetic exceptions is not automatically supported by
\fortran\ compilers. In general, flags that cause the compiler to keep
track of arithmetic exceptions are diminishing the maximally possible
performance, and hence they should not be used in production
runs. Hence, we refrained from making these flags a default.
They can be added using the \ttt{FCFLAGS = {\em <flags>}} settings during
configuration. For the \ttt{NAG} \fortran\ compiler we use the flags
\ttt{-C=all -nan -gline} for debugging purposes. For the \ttt{gfortran}
compilers, the flags \ttt{-ffpe-trap=invalid,zero,overflow} are the
corresponding debugging flags. For tests, debugging or first sanity
checks on your setup, you might want to make use of these flags in
order to track possible numerical exceptions in the produced code.
Some compilers started to include \ttt{IEEE} exception handling
support (\ttt{Fortran 2008} status), but we do not use these
implementations in the \whizard\ code (yet).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Steering WHIZARD: \sindarin\ Overview}
\label{chap:sindarinintro}
\section{The command language for WHIZARD}
A conventional physics application program gets its data from a set of input
files. Alternatively, it is called as a library, so the user has to write his
own code to interface it, or it combines these two approaches. \whizard~1 was
built in this way: there were some input files which were written by the user,
and it could be called both stand-alone or as an external library.
\whizard~2 is also a stand-alone program. It comes with its own full-fledged
script language, called \sindarin. All interaction between the user and the
program is done in \sindarin\ expressions, commands, and scripts. Two main
reasons led us to this choice:
\begin{itemize}
\item
In any nontrivial physics study, cuts and (parton- or hadron-level) analysis
are of central importance. The task of specifying appropriate kinematics
and particle selection for a given process is well defined, but it is
impossible to cover all possiblities in a simple format like the cut files
of \whizard~1.
The usual way of dealing with this problem is to write analysis driver code
(often in \ttt{C++}), using external libraries for Lorentz algebra etc. However,
the overhead of writing correct \ttt{C++} or \ttt{Fortran} greatly blows up problems
that could be formulated in a few lines of text.
\item
While many problems lead to a repetitive workflow (process definition,
integration, simulation), there are more involved tasks that involve
parameter scans, comparisons of different processes, conditional execution,
or writing output in widely different formats. This is easily done by a
steering script, which should be formulated in a complete language.
\end{itemize}
The \sindarin\ language is built specifically around event analysis, suitably
extended to support steering, including data types, loops, conditionals, and
I/O.
It would have been possible to use an established general-purpose language for
these tasks. For instance, \ocaml\ which is a functional language would be a
suitable candidate, and the matrix-element generator \oMega\ is written in that
language. Another candidate would be a popular scripting language such as
PYTHON.
We started to support interfaces for commonly used languages: prime
examples for \ttt{C}, \ttt{C++}, and PYTHON are found in the
\ttt{share/interfaces} subdirectory. However, introducing a
special-purpose language has the three distinct
advantages: First, it is compiled and executed by the very \ttt{Fortran} code that
handles data and thus accesses it without interfaces. Second, it can be
designed with a syntax especially suited to the task of event handling and
Monte-Carlo steering, and third, the user is not forced to learn all those
features of a generic language that are of no relevance to the application he/she
is interested in.
\section{\sindarin\ scripts}
A \sindarin\ script tells the \whizard\ program what it has to do. Typically,
the script is contained in a file which you (the user) create. The file name
is arbitrary; by convention, it has the extension `\verb|.sin|'.
\whizard\ takes the file name as its argument on the command line and
executes the contained script:
\begin{verbatim}
/home/user$ whizard script.sin
\end{verbatim}
Alternatively, you can call \whizard\ interactively and execute
statements line by line; we describe this below in Sec.\ref{sec:whish}.
A \sindarin\ script is a sequence of \emph{statements}, similar to the
statements in any imperative language such as \ttt{Fortran} or
\ttt{C}. Examples of statements are commands like \ttt{integrate},
variable declarations like \ttt{logical ?flag} or assigments like
\ttt{mH = 130 GeV}.
The script is free-form, i.e., indentation, extra whitespace and
newlines are syntactically insignificant. In contrast to most
languages, there is no statement separator. Statements simply follow each
other, just separated by whitespace.
\begin{code}
statement1 statement2
statement3
statement4
\end{code}
Nevertheless, for clarity we recommend to
write one statement per line where possible, and to use proper
indentation for longer statements, nested and bracketed expressions.
A command may consist of a \emph{keyword}, a list of \emph{arguments} in
parantheses \ttt{(}\ldots\ttt{)}, and an \emph{option} script which
itself is a sequence of statements.
\begin{code}
command
command_with_args (arg1, arg2)
command_with_option { option }
command_with_options (arg) {
option_statement1
option_statement2
}
\end{code}
As a rule, parentheses \ttt{()} enclose arguments and expressions, as
you would expect. Arguments enclosed in square brackets \ttt{[]} also
exist. They have a special meaning, they denote subevents
(collections of momenta) in event analysis. Braces \ttt{\{\}} enclose
blocks of \sindarin\ code. In particular, the option script
associated with a command is a block of code that may contain local
parameter settings, for instance. Braces always indicate a scoping
unit, so parameters will be restored their previous values when the
execution of that command is completed.
The script can contain comments. Comments are initiated by either a \verb|#|
or a \verb|!| character and extend to the end of the current line.
\begin{code}
statement
# This is a comment
statement ! This is also a comment
\end{code}
%%%%%%%%%%%%%%%
\section{Errors}
\label{sec:errors}
Before turning to proper \sindarin\ syntax, let us consider error messages.
\sindarin\ distinguishes syntax errors and runtime errors.
Syntax errors are recognized when the script is read and compiled,
before any part is executed. Look at this example:
\begin{code}
process foo = u, ubar => d, dbar
md = 10
integrade (foo)
\end{code}
\whizard\ will fail with the error message
\begin{interaction}
sqrts = 1 TeV
integrade (foo)
^^
| Expected syntax: SEQUENCE <cmd_num> = <var_name> '=' <expr>
| Found token: KEYWORD: '('
******************************************************************************
******************************************************************************
*** FATAL ERROR: Syntax error (at or before the location indicated above)
******************************************************************************
******************************************************************************
WHIZARD run aborted.
\end{interaction}
which tells you that you have misspelled the command
\verb|integrate|, so the compiler tried to interpret it as a variable.
Runtime errors are categorized by their severity. A warning is simply
printed:
\begin{interaction}
Warning: No cuts have been defined.
\end{interaction}
This indicates a condition that is suspicious, but may actually be
intended by the user.
When an error is encountered, it is printed with more emphasis
\begin{interaction}
******************************************************************************
*** ERROR: Variable 'md' set without declaration
******************************************************************************
\end{interaction}
and the program tries to continue. However, this usually indicates
that there is something wrong. (The $d$ quark is defined
massless, so \verb|md| is not a model parameter.) \whizard\ counts
errors and warnings and tells you at the end
\begin{interaction}
| There were 1 error(s) and no warnings.
\end{interaction}
just in case you missed the message.
Other errors are considered fatal, and execution stops at this point.
\begin{interaction}
******************************************************************************
******************************************************************************
*** FATAL ERROR: Colliding beams: sqrts is zero (please set sqrts)
******************************************************************************
******************************************************************************
\end{interaction}
Here, \whizard\ was unable to do anything sensible. But at least (in
this case) it told the user what to do to resolve the problem.
%%%%%%%%%%%%%%%
\section{Statements}
\label{sec:statements}
\sindarin\ statements are executed one by one. For an overview, we
list the most common statements in the order in which they typically
appear in a \sindarin\ script, and quote the basic syntax and simple
examples. This should give an impression on the \whizard's
capabilities and on the user interface. The list is not complete.
Note that there are no
mandatory commands (although an empty \sindarin\ script is not really
useful). The details and options are explained in later sections.
\subsection{Process Configuration}
\subsubsection{model}
\begin{syntax}
model = \var{model-name}
\end{syntax}
This assignment sets or resets the current physics model. The
Standard Model is already preloaded, so the \ttt{model} assignment
applies to non-default models. Obviously, the model must be known to
\whizard. Example:
\begin{code}
model = MSSM
\end{code}
See Sec.~\ref{sec:models}.
\subsubsection{alias}
\begin{syntax}
alias \var{alias-name} = \var{alias-definition}
\end{syntax}
Particles are specified by their names. For most particles, there
are various equivalent names. Names containing special characters
such as a \verb|+| sign have to be quoted. The \ttt{alias} assignment
defines an alias for a list of particles. This is useful for setting
up processes with sums over flavors, cut expressions, and more. The
alias name is then used like a simple particle name. Example:
\begin{syntax}
alias jet = u:d:s:U:D:S:g
\end{syntax}
See Sec.~\ref{sec:alias}.
\subsubsection{process}
\begin{syntax}
process \var{tag} = \var{incoming} \verb|=>| \var{outgoing}
\end{syntax}
Define a process. You give the process a name \var{tag} by which it is
identified later, and specify the incoming and outgoing particles,
and possibly options. You can define an arbitrary number of processes
as long as they are distinguished by their names. Example:
\begin{code}
process w_plus_jets = g, g => "W+", jet, jet
\end{code}
See Sec.~\ref{sec:processes}.
\subsubsection{sqrts}
\begin{syntax}
sqrts = \var{energy-value}
\end{syntax}
Define the center-of-mass energy for collision processes. The default
setup will assume head-on central collisions of two beams. Example:
\begin{code}
sqrts = 500 GeV
\end{code}
See Sec.~\ref{sec:beam-setup}.
\subsubsection{beams}
\begin{syntax}
beams = \var{beam-particles} \\
beams = \var{beam-particles} => \var{structure-function-setup}
\end{syntax}
Declare beam particles and properties. The current value of \ttt{sqrts} is
used, unless specified otherwise. Example:
\begin{code}
beams = u:d:s, U:D:S => lhapdf
\end{code}
With options, the assignment allows for
defining beam structure in some detail. This includes beamstrahlung and ISR
for lepton colliders, precise structure function definition for hadron
colliders, asymmetric beams, beam polarization, and more. See
Sec.~\ref{sec:beams}.
\subsection{Parameters}
\subsubsection{Parameter settings}
\begin{syntax}
\var{parameter} = \var{value} \\
\var{type} \var{user-parameter} \\
\var{type} \var{user-parameter} = \var{value}
\end{syntax}
Specify a value for a parameter. There are predefined parameters that affect
the behavior of a command, model-specific parameters (masses, couplings), and
user-defined parameters. The latter have to be declared with a type, which
may be \ttt{int} (integer), \ttt{real}, \ttt{complex}, \ttt{logical},
\ttt{string}, or \ttt{alias}. Logical parameter
names begin with a question mark, string parameter names with a dollar sign.
Examples:
\begin{code}
mb = 4.2 GeV
?rebuild_grids = true
real mass_sum = mZ + mW
string $message = "This is a string"
\end{code}
% $
The value need not be a literal, it can be an arbitrary expression of the
correct type. See Sec.~\ref{sec:variables}.
\subsubsection{read\_slha}
\begin{syntax}
read\_slha (\var{filename})
\end{syntax}
This is useful only for supersymmetric models: read a parameter file
in the SUSY Les Houches Accord format. The file defines parameter
values and, optionally, decay widths, so this command removes the need
for writing assignments for each of them.
\begin{code}
read_slha ("sps1a.slha")
\end{code}
See Sec.~\ref{sec:slha}.
\subsubsection{show}
\begin{syntax}
show (\var{data-objects})
\end{syntax}
Print the current value of some data object. This includes not just
variables, but also models, libraries, cuts, etc. This is rather a
debugging aid, so don't expect the output to be concise in the latter
cases. Example:
\begin{code}
show (mH, wH)
\end{code}
See Sec.~\ref{sec:I/O}.
\subsubsection{printf}
\begin{syntax}
printf \var{format-string} (\var{data-objects})
\end{syntax}
Pretty-print the data objects according to the given format string.
If there are no data objects, just print the format string.
This command is borrowed from the \ttt{C} programming language; it is
actually an interface to the system's \ttt{printf(3)} function. The
conversion specifiers are restricted to \ttt{d,i,e,f,g,s},
corresponding to the output of integer, real, and string variables.
Example:
\begin{code}
printf "The Higgs mass is %f GeV" (mH)
\end{code}
See Sec.~\ref{sec:I/O}.
\subsection{Integration}
\subsubsection{cuts}
\begin{syntax}
cuts = \var{logical-cut-expression}
\end{syntax}
The cut expression is a logical macro expression that is evaluated for each
phase space point during integration and event generation. You may construct
expressions out of various observables that are computed for the (partonic)
particle content of the current event. If the expression evaluates to
\verb|true|, the matrix element is calculated and the event is used. If it
evaluates to \verb|false|, the matrix element is set zero and the event is
discarded. Note that for collisions the expression is evaluated in the
lab frame, while for decays it is evaluated in the rest frame of the
decaying particle. In case you want to impose cuts on a factorized
process, i.e. a combination of a production process and one or more
decay processes, you have to use the \ttt{selection} keyword
instead.
Example for the keyword \ttt{cuts}:
\begin{code}
cuts = all Pt > 20 GeV [jet]
and all mZ - 10 GeV < M < mZ + 10 GeV [lepton, lepton]
and no abs (Eta) < 2 [jet]
\end{code}
See Sec.~\ref{sec:cuts}.
\subsubsection{integrate}
\begin{syntax}
integrate (\var{process-tags})
\end{syntax}
Compute the total cross section for a process. The command takes into account
the definition of the process, the beam setup, cuts, and parameters as defined
in the script. Parameters may also be specified as options to the command.
Integration is necessary for each process for which you want to know total or
differential cross sections, or event samples. Apart from computing a value,
it sets up and adapts phase space and integration grids that are used in event
generation. If you just need an event sample, you can omit an explicit
\ttt{integrate} command; the \ttt{simulate} command will call it
automatically. Example:
\begin{code}
integrate (w_plus_jets, z_plus_jets)
\end{code}
See Sec.~\ref{sec:integrate}.
\subsubsection{?phs\_only/n\_calls\_test}
\begin{syntax}
integrate (\var{process-tag}) \{ ?phs\_only = true n\_calls\_test = 1000 \}
\end{syntax}
These are just optional settings for the \ttt{integrate} command
discussed just a second ago. The \ttt{?phs\_only = true} (note that
variables starting with a question mark are logicals) option tells
\whizard\ to prepare a process for integration, but instead of
performing the integration, just to generate a phase space
parameterization. \ttt{n\_calls\_test = <num>} evaluates the sampling
function for random integration channels and random momenta. \vamp\
integration grids are neither generated nor used, so the channel
selection corresponds to the first integration pass, before any grids
or channel weights are adapted. The number of sampling points is
given by \verb|<num>|. The output contains information about the
timing, number of sampling points that passed the kinematics
selection, and the number of matrix-element values that were actually
evaluated. This command is useful mainly for debugging and
diagnostics. Example:
\begin{code}
integrate (some_large_process) { ?phs_only = true n_calls_test = 1000 }
\end{code}
(Note that there used to be a separate command
\ttt{matrix\_element\_test} until version 2.1.1 of \whizard\ which has
been discarded in order to simplify the \sindarin\ syntax.)
\subsection{Events}
\subsubsection{histogram}
\begin{syntax}
histogram \var{tag} (\var{lower-bound}, \var{upper-bound}) \\
histogram \var{tag} (\var{lower-bound}, \var{upper-bound}, \var{step}) \\
\end{syntax}
Declare a histogram for event analysis. The histogram is filled by an
analysis expression, which is evaluated once for each event during a
subsequent simulation step. Example:
\begin{code}
histogram pt_distribution (0, 150 GeV, 10 GeV)
\end{code}
See Sec.~\ref{sec:histogram}.
\subsubsection{plot}
\begin{syntax}
plot \var{tag}
\end{syntax}
Declare a plot for displaying data points. The plot may be filled by an
analysis expression that is evaluated for each event; this would result in a
scatter plot. More likely, you will use this feature for displaying data such
as the energy dependence of a cross section. Example:
\begin{code}
plot total_cross_section
\end{code}
See Sec.~\ref{sec:plot}.
\subsubsection{selection}
\begin{syntax}
selection = \var{selection-expression}
\end{syntax}
The selection expression is a logical macro expression that is evaluated once
for each event. It is applied to the event record,
after all decays have been executed (if any). It is therefore intended
e.g. for modelling detector acceptance cuts etc. For unfactorized
processes the usage of \ttt{cuts} or \ttt{selection} leads to
the same results. Events for which the selection expression evaluates
to false are dropped; they are neither analyzed nor written to any
user-defined output file. However, the dropped events are written to
\whizard's native event file. For unfactorized processes it is
therefore preferable to implement all cuts using the \ttt{cuts}
keyword for the integration, see \ttt{cuts} above.
Example:
\begin{code}
selection = all Pt > 50 GeV [lepton]
\end{code}
The syntax is generically the same as for the \ttt{cuts
expression}, see Sec.~\ref{sec:cuts}. For more information see also
Sec.~\ref{sec:analysis}.
\subsubsection{analysis}
\begin{syntax}
analysis = \var{analysis-expression}
\end{syntax}
The analysis expression is a logical macro expression that is evaluated once
for each event that passes the integration and selection cuts in a
subsequent simulation step. The
expression has type logical in analogy with the cut expression; however, its
main use will be in side effects caused by embedded \ttt{record} expressions.
The \ttt{record} expression books a value, calculated from observables
evaluated for the current event, in one of the predefined histograms or plots.
Example:
\begin{code}
analysis = record pt_distribution (eval Pt [photon])
and record mval (eval M [lepton, lepton])
\end{code}
See Sec.~\ref{sec:analysis}.
\subsubsection{unstable}
\begin{syntax}
unstable \var{particle} (\var{decay-channels})
\end{syntax}
Specify that a particle can decay, if it occurs in the final state of a
subsequent simulation step. (In the integration step, all final-state
particles are considered stable.) The decay channels are processes which
should have been declared before by a \ttt{process} command
(alternatively, there are options that \whizard\ takes care of this
automatically; cf. Sec.~\ref{sec:decays}). They may be
integrated explicitly, otherwise the \ttt{unstable} command will take care of
the integration before particle decays are generated. Example:
\begin{code}
unstable Z (z_ee, z_jj)
\end{code}
Note that the decay is an on-shell approximation. Alternatively, \whizard\ is
capable of generating the final state(s) directly, automatically including the
particle as an internal resonance together with irreducible background.
Depending on the physical problem and on the complexity of the matrix-element
calculation, either option may be more appropriate.
See Sec.~\ref{sec:decays}.
\subsubsection{n\_events}
\begin{syntax}
n\_events = \var{integer}
\end{syntax}
Specify the number of events that a subsequent simulation step should produce.
By default, simulated events are unweighted. (Unweighting is done by a
rejection operation on weighted events, so the usual caveats on event
unweighting by a numerical Monte-Carlo generator do apply.) Example:
\begin{code}
n_events = 20000
\end{code}
See Sec.~\ref{sec:simulation}.
\subsubsection{simulate}
\begin{syntax}
simulate (\var{process-tags})
\end{syntax}
Generate an event sample. The command allows for analyzing the generated
events by the \ttt{analysis} expression. Furthermore, events can be written
to file in various formats. Optionally, the partonic events can be showered
and hadronized, partly using included external (\pythia) or truly
external programs called by \whizard. Example:
\begin{code}
simulate (w_plus_jets) { sample_format = lhef }
\end{code}
See Sec.~\ref{sec:simulation} and Chapter~\ref{chap:events}.
\subsubsection{graph}
\begin{syntax}
graph (\var{tag}) = \var{histograms-and-plots}
\end{syntax}
Combine existing histograms and plots into a common graph. Also
useful for pretty-printing single histograms or plots. Example:
\begin{code}
graph comparison {
$title = "$p_T$ distribution for two different values of $m_h$"
} = hist1 & hist2
\end{code}
% $
See Sec.~\ref{sec:graphs}.
\subsubsection{write\_analysis}
\begin{syntax}
write\_analysis (\var{analysis-objects})
\end{syntax}
Writes out data tables for the specified analysis objects (plots,
graphs, histograms). If the argument is empty or absent, write all
analysis objects currently available. The tables are
available for feeding external programs. Example:
\begin{code}
write_analysis
\end{code}
See Sec.~\ref{sec:analysis}.
\subsubsection{compile\_analysis}
\begin{syntax}
compile\_analysis (\var{analysis-objects})
\end{syntax}
Analogous to \ttt{write\_analysis}, but the generated data tables are
processed by \LaTeX\ and \gamelan, which produces Postscript and PDF
versions of the displayed data. Example:
\begin{code}
compile_analysis
\end{code}
See Sec.~\ref{sec:analysis}.
\section{Control Structures}
Like any complete programming language, \sindarin\ provides means for
branching and looping the program flow.
\subsection{Conditionals}
\subsubsection{if}
\begin{syntax}
if \var{logical\_expression} then \var{statements} \\
elsif \var{logical\_expression} then \var{statements} \\
else \var{statements} \\
endif
\end{syntax}
Execute statements conditionally, depending on the value of a logical
expression. There may be none or multiple \ttt{elsif} branches, and
the \ttt{else} branch is also optional. Example:
\begin{code}
if (sqrts > 2 * mtop) then
integrate (top_pair_production)
else
printf "Top pair production is not possible"
endif
\end{code}
The current \sindarin\ implementation puts some restriction on the
statements that can appear in a conditional. For instance, process
definitions must be done unconditionally.
\subsection{Loops}
\subsubsection{scan}
\begin{syntax}
scan \var{variable} = (\var{value-list}) \{ \var{statements} \}
\end{syntax}
Execute the statements repeatedly, once for each value of the scan
variable. The statements are executed in a local context, analogous
to the option statement list for commands. The value list is a
comma-separated list of expressions, where each item evaluates to the
value that is assigned to \ttt{\var{variable}} for this iteration.
The type of the variable is not restricted to numeric, scans can be
done for various object types. For instance, here is a scan over strings:
\begin{code}
scan string $str = ("%.3g", "%.4g", "%.5g") { printf $str (mW) }
\end{code}
% $
The output:
\begin{interaction}
[user variable] $str = "%.3g"
80.4
[user variable] $str = "%.4g"
80.42
[user variable] $str = "%.5g"
80.419
\end{interaction}
% $
For a numeric scan variable in particular, there are iterators that
implement the usual functionality of \ttt{for} loops. If the scan
variable is of type integer, an iterator may take one of the forms
\begin{syntax}
\var{start-value} \verb|=>| \var{end-value} \\
\var{start-value} \verb|=>| \var{end-value} \verb|/+| \var{add-step} \\
\var{start-value} \verb|=>| \var{end-value} \verb|/-| \var{subtract-step} \\
\var{start-value} \verb|=>| \var{end-value} \verb|/*| \var{multiplicator} \\
\var{start-value} \verb|=>| \var{end-value} \verb|//| \var{divisor} \\
\end{syntax}
The iterator can be put in place of an expression in the
\ttt{\var{value-list}}. Here is an example:
\begin{code}
scan int i = (1, (3 => 5), (10 => 20 /+ 4))
\end{code}
which results in the output
\begin{interaction}
[user variable] i = 1
[user variable] i = 3
[user variable] i = 4
[user variable] i = 5
[user variable] i = 10
[user variable] i = 14
[user variable] i = 18
\end{interaction}
[Note that the \ttt{\var{statements}} part of the scan construct may
be empty or absent.]
For real scan variables, there are even more possibilities for iterators:
\begin{syntax}
\var{start-value} \verb|=>| \var{end-value} \\
\var{start-value} \verb|=>| \var{end-value} \verb|/+| \var{add-step} \\
\var{start-value} \verb|=>| \var{end-value} \verb|/-| \var{subtract-step} \\
\var{start-value} \verb|=>| \var{end-value} \verb|/*| \var{multiplicator} \\
\var{start-value} \verb|=>| \var{end-value} \verb|//| \var{divisor} \\
\var{start-value} \verb|=>| \var{end-value} \verb|/+/| \var{n-points-linear} \\
\var{start-value} \verb|=>| \var{end-value} \verb|/*/| \var{n-points-logarithmic} \\
\end{syntax}
The first variant is equivalent to \ttt{/+ 1}. The \ttt{/+} and
\ttt{/-} operators are intended to add or subtract the given step once
for each iteration. Since in floating-point arithmetic this would be
plagued by rounding ambiguities, the actual implementation first
determines the (integer) number of iterations from the provided step
value, then recomputes the step so that the iterations are evenly
spaced with the first and last value included.
The \ttt{/*} and \ttt{//} operators are analogous. Here, the initial
value is intended to be multiplied by the step value once for each
iteration. After determining the integer number of iterations, the
actual scan values will be evenly spaced on a logarithmic scale.
Finally, the \ttt{/+/} and \ttt{/*/} operators allow to specify the
number of iterations (not counting the initial value) directly. The
\ttt{\var{start-value}} and \ttt{\var{end-value}} are always included,
and the intermediate values will be evenly spaced on a linear
(\ttt{/+/}) or logarithmic (\ttt{/*/}) scale.
Example:
\begin{code}
scan real mh = (130 GeV,
(140 GeV => 160 GeV /+ 5 GeV),
180 GeV,
(200 GeV => 1 TeV /*/ 10))
{ integrate (higgs_decay) }
\end{code}
\subsection{Including Files}
\subsubsection{include}
\begin{syntax}
include (\var{file-name})
\end{syntax}
Include a \sindarin\ script from the specified file. The contents
must be complete commands; they are compiled and executed as if they
were part of the current script. Example:
\begin{code}
include ("default_cuts.sin")
\end{code}
\section{Expressions}
\sindarin\ expressions are classified by their types. The
type of an expression is verified when the script is compiled, before
it is executed. This provides some safety against simple coding
errors.
Within expressions, grouping is done using ordinary brackets \ttt{()}.
For subevent expressions, use square brackets \ttt{[]}.
\subsection{Numeric}
The language supports the classical numeric types
\begin{itemize}
\item
\ttt{int} for integer: machine-default, usually 32 bit;
\item
\ttt{real}, usually \emph{double precision} or 64 bit;
\item
\ttt{complex}, consisting of real and imaginary part equivalent to a
\ttt{real} each.
\end{itemize}
\sindarin\ supports arithmetic expressions similar to conventional
languages. In arithmetic expressions, the three numeric types can be
mixed as appropriate. The computation essentially follows the rules
for mixed arithmetic in \ttt{Fortran}. The arithmetic operators are
\verb|+|, \verb|-|, \verb|*|, \verb|/|, \verb|^|. Standard functions
such as \ttt{sin}, \ttt{sqrt}, etc. are available. See
Sec.~\ref{sec:real} to Sec.~\ref{sec:complex}.
Numeric values can be associated with units. Units evaluate to
numerical factors, and their use is optional, but they can be useful
in the physics context for which \whizard\ is designed. Note that the
default energy/mass unit is \verb|GeV|, and the default unit for cross
sections is \verb|fbarn|.
\subsection{Logical and String}
The language also has the following standard types:
\begin{itemize}
\item
\ttt{logical} (a.k.a.\ boolean). Logical variable names have a
\ttt{?} (question mark) as prefix.
\item
\ttt{string} (arbitrary length). String variable names have a \ttt{\$}
(dollar) sign as prefix.
\end{itemize}
There are comparisons, logical operations, string concatenation, and a
mechanism for formatting objects as strings for output.
\subsection{Special}
Furthermore, \sindarin\ deals with a bunch of data types tailored
specifically for Monte Carlo applications:
\begin{itemize}
\item
\ttt{alias} objects denote a set of particle species.
\item
\ttt{subevt} objects denote a collection of particle momenta within an
event. They have their uses in cut and analysis expressions.
\item
\ttt{process} object are generated by a \ttt{process} statement.
There are no expressions involving processes, but they are referred
to by \ttt{integrate} and \ttt{simulate} commands.
\item
\ttt{model}: There is always a current object of type and name
\ttt{model}. Several models can be used concurrently by
appropriately defining processes, but this happens behind the scenes.
\item
\ttt{beams}: Similarly, the current implementation allows only for a single
object of this type at a given time, which is assigned by a \ttt{beams =}
statement and used by \ttt{integrate}.
\end{itemize}
In the current implementation, \sindarin\ has no container data types
derived from basic types, such as lists, arrays, or hashes, and there
are no user-defined data types. (The \ttt{subevt} type is a container
for particles in the context of events, but there is no type for an
individual particle: this is represented as a one-particle
\ttt{subevt}). There are also containers for inclusive processes which
are however simply handled as an expansion into several components of
a master process tag.
\section{Variables}
\label{sec:variables}
\sindarin\ supports global variables, variables local to a scoping unit (the
option body of a command, the body of a \ttt{scan} loop), and variables local
to an expression.
Some variables are predefined by the system (\emph{intrinsic
variables}). They are further separated into \emph{independent}
variables that can be reset by the user, and \emph{derived} or locked
variables that are automatically computed by the program, but not
directly user-modifiable. On top of that, the user is free to
introduce his own variables (\emph{user variables}).
The names of numerical variables consist of alphanumeric characters and
underscores. The first character must not be a digit. Logical
variable names are furthermore prefixed by a
\ttt{?} (question mark) sign, while string variable names begin
with a \ttt{\$} (dollar) sign.
Character case does matter. In this manual we follow the
convention that variable names consist of lower-case letters,
digits, and underscores only, but you may also use upper-case
letters if you wish.
Physics models contain their own, specific set of numeric variables
(masses, couplings). They are attached to the model where they are
defined, so they appear and disappear with the model that is currently
loaded. In particular, if two different models contain a variable
with the same name, these two variables are nevertheless distinct:
setting one doesn't affect the other. This feature might be called,
in computer-science jargon, a \emph{mixin}.
User variables -- global or local -- are declared by their type when they are
introduced, and acquire an initial value upon declaration. Examples:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
int i = 3
real my_cut_value = 10 GeV
complex c = 3 - 4 * I
logical ?top_decay_allowed = mH > 2 * mtop
string $hello = "Hello world!"
alias q = d:u:s:c
\end{verbatim}
\end{footnotesize}
\end{quote}
An existing user variable can be assigned a new value without a declaration:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
i = i + 1
\end{verbatim}
\end{footnotesize}
\end{quote}
and it may also be redeclared if the new declaration specifies the same type,
this is equivalent to assigning a new value.
Variables local to an expression are introduced by the \ttt{let ... in}
contruct. Example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
real a = let int n = 2 in
x^n + y^n
\end{verbatim}
\end{footnotesize}
\end{quote}
The explicit \ttt{int} declaration is necessary only if the variable \ttt{n}
has not been declared before. An intrinsic variable must not be declared:
\ttt{let mtop = 175.3 GeV in \ldots}
\ttt{let} constructs can be concatenated if several local variables need to
be assigned: \ttt{let a = 3 in let b = 4 in \textit{expression}}.
Variables of type \ttt{subevt} can only be defined in \ttt{let} constructs.
Exclusively in the context of particle selections (event analysis), there are
\emph{observables} as special numeric objects. They are used like numeric
variables, but they are never declared or assigned. They get their value
assigned dynamically, computed from the particle momentum configuration.
Hence, they may be understood as (intrinsic and predefined) macros.
By convention, observable names begin with a capital letter.
Further macros are
\begin{itemize}
\item
\ttt{cuts} and \ttt{analysis}. They are of type logical, and can be
assigned an expression by the user. They are evaluated once for
each event.
\item
\ttt{scale}, \ttt{factorization\_scale} and
\ttt{renormalization\_scale} are real numeric macros which define the
energy scale(s) of an event. The latter two override the former.
If no scale is defined, the partonic energy is used as the process scale.
\item
\ttt{weight} is a real numeric macro. If it is assigned an
expression, the expression is evaluated for each valid phase-space
point, and the result multiplies the matrix element.
\end{itemize}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{\sindarin\ in Details}
\label{chap:sindarin}
\section{Data and expressions}
\subsection{Real-valued objects}
\label{sec:real}
Real literals have their usual form, mantissa and, optionally, exponent:
\begin{center}
\ttt{0.}\quad \ttt{3.14}\quad \ttt{-.5}\quad
\ttt{2.345e-3}\quad \ttt{.890E-023}
\end{center}
Internally, real values are treated as double precision. The values are read
by the Fortran library, so details depend on its implementation.
A special feature of \sindarin\ is that numerics (real and integer) can be
immediately followed by a physical unit. The supported units are presently
hard-coded, they are
\begin{center}
\ttt{meV}\quad \ttt{eV}\quad \ttt{keV}\quad
\ttt{MeV}\quad \ttt{GeV}\quad \ttt{TeV}
\\
\ttt{nbarn}\quad \ttt{pbarn}\quad \ttt{fbarn}\quad \ttt{abarn}
\\
\ttt{rad}\quad \ttt{mrad}\quad \ttt{degree}
\\
\ttt{\%}
\end{center}
If a number is followed by a unit, it is automatically normalized to the
corresponding default unit: \ttt{14.TeV} is transformed into the real number
\ttt{14000.} Default units are \ttt{GeV}, \ttt{fbarn}, and \ttt{rad}. The
\ttt{\%} sign after a number has the effect that the number is multiplied by
$0.01$. Note that no checks for consistency of units are done, so you can add
\ttt{1 meV + 3 abarn} if you absolutely wish to. Omitting units is always
allowed, in that case, the default unit is assumed.
Units are not treated as variables. In particular, you can't write \ttt{theta
/ degree}, the correct form is \ttt{theta / 1 degree}.
There is a single predefined real constant, namely $\pi$ which is referred to
by the keyword \ttt{pi}. In addition, there is a single predefined
complex constant, which is the complex unit $i$, being referred to by
the keyword \ttt{I}.
The arithmetic operators are
\begin{center}
\verb|+| \verb|-| \verb|*| \verb|/| \verb|^|
\end{center}
with their obvious meaning and the usual precedence rules.
\sindarin\ supports a bunch of standard numerical functions, mostly equivalent
to their Fortran counterparts:
\begin{center}
\ttt{abs}\quad \ttt{conjg}\quad \ttt{sgn}\quad \ttt{mod}\quad \ttt{modulo}
\\
\ttt{sqrt}\quad \ttt{exp}\quad \ttt{log}\quad \ttt{log10}
\\
\ttt{sin}\quad \ttt{cos}\quad \ttt{tan}\quad
\ttt{asin}\quad \ttt{acos}\quad \ttt{atan}
\\
\ttt{sinh}\quad \ttt{cosh}\quad \ttt{tanh}
\end{center}
(Unlike Fortran, the \ttt{sgn} function takes only one argument and returns
$1.$, or $-1.$) The function argument is enclosed in brackets: \ttt{sqrt
(2.)}, \ttt{tan (11.5 degree)}.
There are two functions with two real arguments:
\begin{center}
\ttt{max}\quad \ttt{min}
\end{center}
Example: \verb|real lighter_mass = min (mZ, mH)|
The following functions of a real convert to integer:
\begin{center}
\ttt{int}\quad \ttt{nint}\quad \ttt{floor}\quad \ttt{ceiling} %% \; .
\end{center}
and this converts to complex type:
\begin{center}
\ttt{complex}
\end{center}
Real values can be compared by the following operators, the result is a
logical value:
\begin{center}
\verb|==|\quad \verb|<>|
\\
\verb|>|\quad \verb|<|\quad \verb|>=|\quad \verb|<=|
\end{center}
In \sindarin, it is possible to have more than two operands in a logical
expressions. The comparisons are done from left to right. Hence,
\begin{center}
\verb|115 GeV < mH < 180 GeV|
\end{center}
is valid \sindarin\ code and evaluates to \ttt{true} if the Higgs mass is in the
given range.
Tests for equality and inequality with machine-precision real numbers are
notoriously unreliable and should be avoided altogether. To deal with this
problem, \sindarin\ has the possibility to make the comparison operators
``fuzzy'' which should be read as ``equal (unequal) up to an absolute
tolerance'', where the tolerance is given by the real-valued intrinsic
variable \ttt{tolerance}. This variable is initially zero, but can be
set to any value (for instance, \ttt{tolerance = 1.e-13} by the user.
Note that for non-zero tolerance, operators like
\verb|==| and \verb|<>| or \verb|<| and \verb|>| are not mutually
exclusive\footnote{In older versions of \whizard, until v2.1.1, there
used to be separate comparators for the comparisons up to a tolerance,
namely \ttt{==\~{}} and \ttt{<>\~{}}. These have been discarded from
v2.2.0 on in order to simplify the syntax.}.
%%%%%%%%%%%%%%%
\subsection{Integer-valued objects}
\label{sec:integer}
Integer literals are obvious:
\begin{center}
\ttt{1}\quad \ttt{-98765}\quad \ttt{0123}
\end{center}
Integers are always signed. Their range is the default-integer range as
determined by the \fortran\ compiler.
Like real values, integer values can be followed by a physical unit: \ttt{1
TeV}, \ttt{30 degree}. This actually transforms the integer into a real.
Standard arithmetics is supported:
\begin{center}
\verb|+| \verb|-| \verb|*| \verb|/| \verb|^|
\end{center}
It is important to note that there is no fraction datatype, and pure integer
arithmetics does not convert to real. Hence \ttt{3/4} evaluates to \ttt{0},
but \ttt{3 GeV / 4 GeV} evaluates to \ttt{0.75}.
Since all arithmetics is handled by the underlying \fortran\ library, integer
overflow is not detected. If in doubt, do real arithmetics.
Integer functions are more restricted than real functions. We support the
following:
\begin{center}
\ttt{abs}\quad \ttt{sgn}\quad \ttt{mod}\quad \ttt{modulo}
\\
\ttt{max}\quad \ttt{min}
\end{center}
and the conversion functions
\begin{center}
\ttt{real}\quad \ttt{complex}
\end{center}
Comparisons of integers among themselves and with reals are possible using the
same set of comparison operators as for real values. This includes
the operators with a finite tolerance.
%%%%%%%%%%%%%%%%
\subsection{Complex-valued objects}
\label{sec:complex}
Complex variables and values are currently not yet used by the physics
models implemented in \whizard. There complex input coupling constants
are always split into their real and imaginary parts (or modulus and
phase). They are exclusively available for arithmetic calculations.
There is no form for complex literals. Complex values must be created via an
arithmetic expression,
\begin{center}
\ttt{complex c = 1 + 2 * I}
\end{center}
where the imaginary unit \ttt{I} is predefined as a constant.
The standard arithmetic operations are supported (also mixed with real and
integer). Support for functions is currently still incomplete, among the
supported functions there are \ttt{sqrt}, \ttt{log}, \ttt{exp}.
\subsection{Logical-valued objects}
There are two predefined logical constants, \ttt{true} and \ttt{false}.
Logicals are \emph{not} equivalent to integers (like in C) or to strings (like
in PERL), but they make up a type of their own. Only in \verb|printf| output,
they are treated as strings, that is, they require the \verb|%s| conversion
specifier.
The names of logical variables begin with a question mark \ttt{?}. Here is
the declaration of a logical user variable:
\begin{quote}
\begin{footnotesize}
\begin{footnotesize}
\begin{verbatim}
logical ?higgs_decays_into_tt = mH > 2 * mtop
\end{verbatim}
\end{footnotesize}
\end{footnotesize}
\end{quote}
Logical expressions use the standard boolean operations
\begin{center}
\ttt{or}\quad \ttt{and}\quad \ttt{not}
\end{center}
The results of comparisons (see above) are logicals.
There is also a special logical operator with lower priority, concatenation by
a semicolon:
\begin{center}
\ttt{\textit{lexpr1} ; \textit{lexpr2}}
\end{center}
This evaluates \textit{lexpr1} and throws its result away, then evaluates
\textit{lexpr2} and returns that result. This feature is to used with logical
expressions that have a side effect, namely the \ttt{record} function within
analysis expressions.
The primary use for intrinsic logicals are flags that change the behavior of
commands. For instance, \ttt{?unweighted = true} and \ttt{?unweighted =
false} switch the unweighting of simulated event samples on and off.
\subsection{String-valued objects and string operations}
\label{sec:sprintf}
String literals are enclosed in double quotes: \ttt{"This is a string."}
The empty string is \ttt{""}. String variables begin with the dollar
sign: \verb|$|. There is only one string operation, concatenation
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
string $foo = "abc" & "def"
\end{verbatim}
\end{footnotesize}
\end{quote}
However, it is possible to transform variables and values to a string using
the \ttt{sprintf} function. This function is an interface to the system's \ttt{C}
function \ttt{sprintf} with some restrictions and modifications. The allowed
conversion specifiers are
\begin{center}
\verb|%d|\quad \verb|%i| (integer)
\\
\verb|%e|\quad \verb|%f|\quad \verb|%g|\quad
\verb|%E|\quad \verb|%F|\quad \verb|%G| (real)
\\
\verb|%s| (string and logical)
\end{center}
The conversions can use flag parameter, field width, and precision, but length
modifiers are not supported since they have no meaning for the application.
(See also Sec.~\ref{sec:I/O}.)
The \ttt{sprintf} function has the syntax
\begin{center}
\ttt{sprintf} \textit{format-string}
\ttt{(}\textit{arg-list}\ttt{)}
\end{center}
This is an expression that evaluates to a string. The format string contains
the mentioned conversion specifiers. The argument list is optional. The
arguments are separated by commas. Allowed arguments are integer, real,
logical, and string variables, and numeric expressions. Logical and string
expressions can also be printed, but they have to be dressed as
\emph{anonymous variables}. A logical anonymous variable has the form
\ttt{?(}\textit{logical\_expr}\ttt{)} (example: \ttt{?(mH > 115 GeV)}). A
string anonymous variable has the form \ttt{\$(}\textit{string-expr}\ttt{)}.
Example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
string $unit = "GeV"
string $str = sprintf "mW = %f %s" (mW, $unit)
\end{verbatim}
\end{footnotesize}
\end{quote}
The related \ttt{printf} command with the same syntax prints the formatted
string to standard output\footnote{In older versions of \whizard,
until v2.1.1, there also used to be a \ttt{sprintd} function and a
\ttt{printd} command for default formats without a format
string. They have been discarded in order to simplify the syntax
from version v2.2.0 on.}.
\section{Particles and (sub)events}
\subsection{Particle aliases}
\label{sec:alias}
A particle species is denoted by its name as a string: \verb|"W+"|.
Alternatively, it can be addressed by an \ttt{alias}. For instance, the $W^+$
boson has the alias \ttt{Wp}. Aliases are used like variables in a context
where a particle species is expected, and the user can specify his/her own
aliases.
An alias may either denote a single particle species or a class of particles
species. A colon \ttt{:} concatenates particle names and aliases to yield
multi-species aliases:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
alias quark = u:d:s
alias wboson = "W+":"W-"
\end{verbatim}
\end{footnotesize}
\end{quote}
Such aliases are used for defining processes with summation over flavors, and
for defining classes of particles for analysis.
Each model files define both names and (single-particle) aliases for all
particles it contains. Furthermore, it defines the class aliases
\verb|colored| and \verb|charged| which are particularly useful for event
analysis.
\subsection{Subevents}
Subevents are sets of particles, extracted from an event. The sets are
unordered by default, but may be ordered by appropriate functions. Obviously,
subevents are meaningful only in a context where an event is available. The
possible context may be the specification of a cut, weight, scale, or analysis
expression.
To construct a simple subevent, we put a particle alias or an expression of
type particle alias into square brackets:
\begin{quote}
\begin{footnotesize}
\verb|["W+"]|\quad
\verb|[u:d:s]|\quad
\verb|[colored]|
\end{footnotesize}
\end{quote}
These subevents evaluate to the set of all $W^+$ bosons (to be precise, their
four-momenta), all $u$, $d$, or $s$ quarks, and all colored particles,
respectively.
A subevent can contain pseudoparticles, i.e., particle combinations.
That is, the four-momenta of
distinct particles are combined (added conmponent-wise), and the results
become subevent elements just like ordinary particles.
The (pseudo)particles in a subevent are non-overlapping. That is, for
any of the particles in the original event, there is at most one
(pseudo)particle in the subevent in which it is contained.
Sometimes, variables (actually, named constants) of type subevent are useful.
Subevent variables are declared by the \ttt{subevt} keyword, and their
names carry the prefix \verb|@|. Subevent variables exist only within the
scope of a \verb|cuts| (or \verb|scale|, \verb|analysis|, etc.) macro, which
is evaluated in the presence of an actual event. In the macro body, they are
assigned via the \ttt{let} construct:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
cuts =
let subevt @jets = select if Pt > 10 GeV [colored]
in
all Theta > 10 degree [@jets, @jets]
\end{verbatim}
\end{footnotesize}
\end{quote}
In this expression, we first define \verb|@jets| to stand for the set of all
colored partons with $p_T>10\;\mathrm{GeV}$. This abbreviation is then used
in a logical expression, which evaluates to true if all relative angles
between distinct jets are greater than $10$ degree.
We note that the example also introduces pairs of subevents: the square
bracket with two entries evaluates to the list of all possible pairs which do
not overlap. The objects within square brackets can be either subevents or
alias expressions. The latter are transformed into subevents before they are
used.
As a special case, the original event is always available as the predefined
subevent \verb|@evt|.
\subsection{Subevent functions}
There are several functions that take a subevent (or an alias) as an argument
and return a new subevent. Here we describe them:
\subsubsection{collect}
\begin{quote}
\begin{footnotesize}
\ttt{collect [\textit{particles}]} \\
\ttt{collect if \textit{condition} [\textit{particles}]} \\
\ttt{collect if \textit{condition} [\textit{particles}, \textit{ref\_particles}]}
\end{footnotesize}
\end{quote}
First version: collect all particle momenta in the argument and combine them
to a single four-momentum. The \textit{particles} argument may either be a
\ttt{subevt} expression or an \ttt{alias} expression. The result is a
one-entry \ttt{subevt}. In the second form, only those particles are collected
which satisfy the \textit{condition}, a logical expression. Example:
\ttt{collect if Pt > 10 GeV [colored]}
The third version is useful if you want to put binary observables (i.e.,
observables constructed from two different particles) in the condition. The
\textit{ref\_particles} provide the second argument for binary observables in
the \textit{condition}. A particle is taken into account if the condition is
true with respect to all reference particles that do not overlap with this
particle. Example: \ttt{collect if Theta > 5 degree [photon, charged]}:
combine all photons that are separated by 5 degrees from all charged
particles.
\subsubsection{cluster}
\emph{NOTE: This is an experimental feature, available from version
2.2.1 on.}
\begin{quote}
\begin{footnotesize}
\ttt{cluster [\textit{particles}]} \\
\ttt{cluster if \textit{condition} [\textit{particles}]} \\
\end{footnotesize}
\end{quote}
First version: collect all particle momenta in the argument and cluster them
to a set of jets. The \textit{particles} argument may either be a
\ttt{subevt} expression or an \ttt{alias} expression. The result is a
one-entry \ttt{subevt}. In the second form, only those particles are clustered
which satisfy the \textit{condition}, a logical expression. Example:
\ttt{cluster if Pt > 10 GeV [colored]}
% The third version is usefule if you want to put binary observables (i.e.,
% observables constructed from two different particles) in the condition. The
% \textit{ref\_particles} provide the second argument for binary observables in
% the \textit{condition}. A particle is taken into account if the condition is
% true with respect to all reference particles that do not overlap with this
% particle. Example: \ttt{cluster if Theta > 5 degree [photon, charged]}:
% combine all photons that are separated by 5 degrees from all charged
% particles.
This command is available from \whizard\ version 2.2.1 on, and only if
the \fastjet\ package has been installed and linked with \whizard\
(cf. Sec.\ref{sec:fastjet}); in a future version of \whizard\ it is
foreseen to have also an intrinsic clustering package inside \whizard\
which will be able to support some of the clustering algorithms
below. To use it in an analysis, you have to set the variable
\ttt{jet\_algorithm} to one of the predefined jet-algorithm values
(integer constants):
\begin{quote}
\begin{footnotesize}
\ttt{kt\_algorithm}\\
\ttt{cambridge\_algorithm}\\
\ttt{antikt\_algorithm}\\
\ttt{genkt\_algorithm}\\
\ttt{cambridge\_for\_passive\_algorithm}\\
\ttt{genkt\_for\_passive\_algorithm}\\
\ttt{ee\_kt\_algorithm}\\
\ttt{ee\_genkt\_algorithm}\\
\ttt{plugin\_algorithm}
\end{footnotesize}
\end{quote}
and the variable \ttt{jet\_r} to the desired $R$ parameter value, as
appropriate for the analysis and the jet algorithm. Example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
jet_algorithm = antikt_algorithm
jet_r = 0.7
cuts = all Pt > 15 GeV [cluster if Pt > 5 GeV [colored]]
\end{verbatim}
\end{footnotesize}
\end{quote}
\subsubsection{combine}
\begin{quote}
\begin{footnotesize}
\ttt{combine [\textit{particles\_1}, \textit{particles\_2}]} \\
\ttt{combine if \textit{condition}} [\textit{particles\_1}, \textit{particles\_2}]
\end{footnotesize}
\end{quote}
Make a new subevent of composite particles. The composites are generated by
combining all particles from subevent \textit{particles\_1} with all particles
from subevent \textit{particles\_2} in all possible combinations. Overlapping
combinations are excluded, however: if a (composite) particle in the first
argument has a constituent in common with a composite particle in the second
argument, the combination is dropped. In particular, this applies if the
particles are identical.
If a \textit{condition} is provided, the combination is done only when the
logical expression, applied to the particle pair in question, returns true.
For instance, here we reconstruct intermediate $W^-$ bosons:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
let @W_candidates = combine if 70 GeV < M < 80 GeV ["mu-", "numubar"]
in ...
\end{verbatim}
\end{footnotesize}
\end{quote}
Note that the combination may fail, so the resulting subevent could be empty.
\subsubsection{operator +}
If there is no condition, the $+$ operator provides a convenient
shorthand for the \verb|combine| command. In particular, it can be
used if there are several particles to combine. Example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
cuts = any 170 GeV < M < 180 GeV [b + lepton + invisible]
\end{verbatim}
\end{footnotesize}
\end{quote}
\subsubsection{select}
\begin{quote}
\begin{footnotesize}
\ttt{select if \textit{condition} [\textit{particles}]} \\
\ttt{select if \textit{condition} [\textit{particles}, \textit{ref\_particles}]}
\end{footnotesize}
\end{quote}
One argument: select all particles in the argument that satisfy the
\textit{condition} and drop the rest. Two arguments: the
\textit{ref\_particles} provide a second argument for binary observables.
Select particles if the condition is satisfied for all reference particles.
\subsubsection{extract}
\begin{quote}
\begin{footnotesize}
\ttt{extract [\textit{particles}]} \\
\ttt{extract index \textit{index-value} [\textit{particles}]}
\end{footnotesize}
\end{quote}
Return a single-particle subevent. In the first version, it contains the
first particle in the subevent \textit{particles}. In the second version, the
particle with index \textit{index-value} is returned, where
\textit{index-value} is an integer expression. If its value is negative, the
index is counted from the end of the subevent.
The order of particles in an event or subevent is not always well-defined, so
you may wish to sort the subevent before applying the \textit{extract}
function to it.
\subsubsection{sort}
\begin{quote}
\begin{footnotesize}
\ttt{sort [\textit{particles}]} \\
\ttt{sort by \textit{observable} [\textit{particles}]} \\
\ttt{sort by \textit{observable} [\textit{particles}, \textit{ref\_particle}]}
\end{footnotesize}
\end{quote}
Sort the subevent according to some criterion. If no criterion is supplied
(first version), the subevent is sorted by increasing PDG code (first
particles, then antiparticles). In the second version, the
\textit{observable} is a real expression which is evaluated for each particle
of the subevent in turn. The subevent is sorted by increasing value of this
expression, for instance:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
let @sorted_evt = sort by Pt [@evt]
in ...
\end{verbatim}
\end{footnotesize}
\end{quote}
In the third version, a reference particle is provided as second argument, so
the sorting can be done for binary observables. It doesn't make much sense to
have several reference particles at once, so the \ttt{sort} function uses
only the first entry in the subevent \textit{ref-particle}, if it has more
than one.
\subsubsection{join}
\begin{quote}
\begin{footnotesize}
\ttt{join [\textit{particles}, \textit{new\_particles}]} \\
\ttt{join if \textit{condition} [\textit{particles}, \textit{new\_particles}]}
\end{footnotesize}
\end{quote}
This commands appends the particles in subevent \textit{new\_particles} to the
subevent \textit{particles}, i.e., it joins the two particle sets. To be
precise, a (pseudo)particle from \textit{new\_particles} is only appended if it
does not overlap with any of the (pseudo)particles
present in \textit{particles}, so the function will not produce overlapping
entries.
In the second version, each particle from \textit{new\_particles} is also
checked with all particles in the first set whether \textit{condition} is
fulfilled. If yes, and there is no overlap, it is appended, otherwise
it is dropped.
\subsubsection{operator \&}
Subevents can also be concatenated by the operator \verb|&|. This effectively
applies \ttt{join} to all operands in turn. Example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
let @visible =
select if Pt > 10 GeV and E > 5 GeV [photon]
& select if Pt > 20 GeV and E > 10 GeV [colored]
& select if Pt > 10 GeV [lepton]
in ...
\end{verbatim}
\end{footnotesize}
\end{quote}
\subsection{Calculating observables}
Observables (invariant mass \ttt{M}, energy \ttt{E}, \ldots) are used in
expressions just like ordinary numeric variables. By convention, their names
start with a capital letter. They are computed using a particle momentum (or
two particle momenta) which are taken from a subsequent subevent argument.
We can extract the value of an observable for an event and make it available
for computing the \ttt{scale} value, or for histogramming etc.:
\subsubsection{eval}
\begin{quote}
\begin{footnotesize}
\ttt{eval \textit{expr} [\textit{particles}]} \\
\ttt{eval \textit{expr} [\textit{particles\_1}, \textit{particles\_2}]}
\end{footnotesize}
\end{quote}
The function \ttt{eval} takes an expression involving observables and
evaluates it for the first momentum (or momentum pair) of the subevent (or
subevent pair) in square brackets that follows the expression. For example,
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
eval Pt [colored]
\end{verbatim}
\end{footnotesize}
\end{quote}
evaluates to the transverse momentum of the first colored particle,
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
eval M [@jets, @jets]
\end{verbatim}
\end{footnotesize}
\end{quote}
evaluates to the invariant mass of the first distinct pair of jets (assuming
that \verb|@jets| has been defined in a \ttt{let} construct), and
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
eval E - M [combine [e1, N1]]
\end{verbatim}
\end{footnotesize}
\end{quote}
evaluates to the difference of energy and mass of the combination of the first
electron-neutrino pair in the event.
The last example illustrates why observables are treated like variables, even
though they are functions of particles: the \ttt{eval} construct with the
particle reference in square brackets after the expression allows to compute
derived observables -- observables which are functions of new observables --
without the need for hard-coding them as new functions.
\subsection{Cuts and event selection}
\label{sec:cuts}
Instead of a numeric value, we can use observables to compute a logical value.
\subsubsection{all}
\begin{quote}
\begin{footnotesize}
\ttt{all \textit{logical\_expr} [\textit{particles}]} \\
\ttt{all \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
\end{footnotesize}
\end{quote}
The \ttt{all} construct expects a logical expression and one or two subevent
arguments in square brackets.
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
all Pt > 10 GeV [charged]
all 80 GeV < M < 100 GeV [lepton, antilepton]
\end{verbatim}
\end{footnotesize}
\end{quote}
In the second example, \ttt{lepton} and \ttt{antilepton} should be aliases
defined in a \ttt{let} construct. (Recall that aliases are promoted to
subevents if they occur within square brackets.)
This construction defines a cut. The result value is \ttt{true} if the
logical expression evaluates to \ttt{true} for all particles in the subevent
in square brackets. In the two-argument case it must be \ttt{true} for all
non-overlapping combinations of particles in the two subevents. If one of the
arguments is the empty subevent, the result is also \ttt{true}.
\subsubsection{any}
\begin{quote}
\begin{footnotesize}
\ttt{any \textit{logical\_expr} [\textit{particles}]} \\
\ttt{any \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
\end{footnotesize}
\end{quote}
The \ttt{any} construct is true if the logical expression is true for at least
one particle or non-overlapping particle combination:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
any E > 100 GeV [photon]
\end{verbatim}
\end{footnotesize}
\end{quote}
This defines a trigger or selection condition. If a subevent argument is
empty, it evaluates to \ttt{false}
\subsubsection{no}
\begin{quote}
\begin{footnotesize}
\ttt{no \textit{logical\_expr} [\textit{particles}]} \\
\ttt{no \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
\end{footnotesize}
\end{quote}
The \ttt{no} construct is true if the logical expression is true for no single
one particle or non-overlapping particle combination:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
no 5 degree < Theta < 175 degree ["e-":"e+"]
\end{verbatim}
\end{footnotesize}
\end{quote}
This defines a veto condition. If a subevent argument is empty, it
evaluates to \ttt{true}. It is equivalent to \ttt{not any\ldots}, but
included for notational convenience.
\subsection{More particle functions}
\subsubsection{count}
\begin{quote}
\begin{footnotesize}
\ttt{count [\textit{particles}]} \\
\ttt{count [\textit{particles\_1}, \textit{particles\_2}]} \\
\ttt{count if \textit{logical-expr} [\textit{particles}]} \\
\ttt{count if \textit{logical-expr} [\textit{particles}, \textit{ref\_particles}]}
\end{footnotesize}
\end{quote}
This counts the number of events in a subevent, the result is of type
\ttt{int}. If there is a conditional expression, it counts the number of
\ttt{particle} in the subevent that pass the test. If there are two
arguments, it counts the number of non-overlapping particle pairs (that pass
the test, if any).
\subsubsection{Predefined observables}
The following real-valued observables are available in \sindarin\ for use in
\ttt{eval}, \ttt{all}, \ttt{any}, \ttt{no}, and \ttt{count} constructs. The
argument is always the subevent or alias enclosed in square brackets.
\begin{itemize}
\item \ttt{M2}
\begin{itemize}
\item One argument: Invariant mass squared of the (composite) particle in the
argument.
\item Two arguments: Invariant mass squared of the sum of the two momenta.
\end{itemize}
\item \ttt{M}
\begin{itemize}
\item Signed square root of \ttt{M2}: positive if $\ttt{M2}>0$, negative if
$\ttt{M2}<0$.
\end{itemize}
\item \ttt{E}
\begin{itemize}
\item One argument: Energy of the (composite) particle in the argument.
\item Two arguments: Sum of the energies of the two momenta.
\end{itemize}
\item \ttt{Px}, \ttt{Py}, \ttt{Pz}
\begin{itemize}
\item Like \ttt{E}, but returning the spatial momentum components.
\end{itemize}
\item \ttt{P}
\begin{itemize}
\item Like \ttt{E}, returning the absolute value of the spatial momentum.
\end{itemize}
\item \ttt{Pt}, \ttt{Pl}
\begin{itemize}
\item Like \ttt{E}, returning the transversal and longitudinal momentum,
respectively.
\end{itemize}
\item \ttt{Theta}
\begin{itemize}
\item One argument: Absolute polar angle in the lab frame
\item Two arguments: Angular distance of two particles in the lab frame.
\end{itemize}
\item \ttt{Theta\_star}
Only with two arguments, gives the relative polar angle of the two momenta
in the rest system of the momentum sum (i.e. mother particle).
\item \ttt{Phi}
\begin{itemize}
\item One argument: Absolute azimuthal angle in the lab frame
\item Two arguments: Azimuthal distance of two particles in the lab frame
\end{itemize}
\item \ttt{Rap}, \ttt{Eta}
\begin{itemize}
\item One argument: rapidity / pseudorapidity
\item Two arguments: rapidity / pseudorapidity difference
\end{itemize}
\item \ttt{Dist}
\begin{itemize}
\item Two arguments: Distance on the $\eta$-$\phi$ cylinder, i.e.,
$\sqrt{\Delta\eta^2 + \Delta\phi^2}$
\end{itemize}
\item \ttt{kT}
\begin{itemize}
\item Two arguments: $k_T$ jet clustering variable:
$2 \min (E_{j1}^2, E_{j2}^2) / Q^2 \times (1 -
\cos\theta_{j1,j2})$. At the moment, $Q^2 = 1$ GeV$^2$.
\end{itemize}
\end{itemize}
There is also an integer-valued observable:
\begin{itemize}
\item \ttt{PDG}
\begin{itemize}
\item One argument: PDG code of the particle. For a composite particle, the
code is undefined (value 0).
\end{itemize}
\end{itemize}
%%%%%%%%%%%%%%%
\section{Physics Models}
\label{sec:models}
A physics model is a combination of particles, numerical parameters (masses,
couplings, widths), and Feynman rules. Many physics analyses are done in the
context of the Standard Model (SM). The SM is also the default model for
\whizard. Alternatively, you can choose a subset of the SM (QED or QCD),
variants of the SM (e.g., with or without nontrivial CKM matrix), or various
extensions of the SM. The complete list is displayed in
Table~\ref{tab:models}.
The model definitions are contained in text files with filename extension
\ttt{.mdl}, e.g., \ttt{SM.mdl}, which are located in the \ttt{share/models}
subdirectory of the \whizard\ installation. These files are easily readable,
so if you need details of a model implementation, inspect their contents. The
model file contains the complete particle and parameter definitions as well as
their default values. It also contains a list of vertices. This is used only
for phase-space setup; the vertices used for generating amplitudes and the
corresponding Feynman rules are stored in different files within the
\oMega\ source tree.
In a \sindarin\ script, a model is a special object of type \ttt{model}. There
is always a \emph{current} model. Initially, this is the SM, so on startup
\whizard\ reads the \ttt{SM.mdl} model file and assigns its content to the
current model object. (You can change the default model by the \ttt{--model}
option on the command line. Also the preloading of a model can be
switched off with the \ttt{--no-model} option) Once the model has
been loaded, you can define processes for the model, and you have all
independent model parameters at your disposal. As noted before, these
are intrinsic parameters which need not be declared when you assign
them a value, for instance:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
mW = 80.33 GeV
wH = 243.1 MeV
\end{verbatim}
\end{footnotesize}
\end{quote}
Other parameters are \emph{derived}. They can be used in expressions like any
other parameter, they are also intrinsic, but they cannot be modified directly
at all. For instance, the electromagnetic coupling \ttt{ee} is a derived
parameter. If you change either \ttt{GF} (the Fermi constant), \ttt{mW} (the
$W$ mass), or \ttt{mZ} (the $Z$ mass), this parameter will reflect the change,
but setting it directly is an error. In other words, the SM is defined within
\whizard\ in the $G_F$-$m_W$-$m_Z$ scheme. (While this scheme is unusual for
loop calculations, it is natural for a tree-level event generator where the
$Z$ and $W$ poles have to be at their experimentally determined
location\footnote{In future versions of \whizard\ it is foreseen to
implement other electroweak schemes.}.)
The model also defines the particle names and aliases that you can use for
defining processes, cuts, or analyses.
If you would like to generate a SUSY process instead, for instance, you can
assign a different model (cf.\ Table~\ref{tab:models}) to the current model
object:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
model = MSSM
\end{verbatim}
\end{footnotesize}
\end{quote}
This assignment has the consequence that the list of SM parameters and
particles is replaced by the corresponding MSSM list (which is much longer).
The MSSM contains essentially all SM parameters by the same name, but in fact
they are different parameters. This is revealed when you say
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
model = SM
mb = 5.0 GeV
model = MSSM
show (mb)
\end{verbatim}
\end{footnotesize}
\end{quote}
After the model is reassigned, you will see the MSSM value of $m_b$ which
still has its default value, not the one you have given. However, if you
revert to the SM later,
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
model = SM
show (mb)
\end{verbatim}
\end{footnotesize}
\end{quote}
you will see that your modification of the SM's $m_b$ value has been
remembered. If you want both mass values to agree, you have to set them
separately in the context of their respective model. Although this might seem
cumbersome at first, it is nevertheless a sensible procedure since the
parameters defined by the user might anyhow not be defined or available for
all chosen models.
When using two different models which need an SLHA input file,
these {\em have} to be provided for both models.
Within a given scope, there is only one current model. The current model can
be reset permanently as above. It can also be temporarily be reset in a local
scope, i.e., the option body of a command or the body of a \ttt{scan} loop.
It is thus possible to use several models within the same script. For
instance, you may define a SUSY signal process and a pure-SM background
process. Each process depends only on the respective model's parameter set,
and a change to a parameter in one of the models affects only the
corresponding process.
\section{Processes}
\label{sec:processes}
The purpose of \whizard\ is the integration and simulation of high-energy
physics processes: scatterings and decays. Hence, \ttt{process} objects play
the central role in \sindarin\ scripts.
A \sindarin\ script may contain an arbitrary number of process definitions. The
initial states need not agree, and the processes may belong to different
physics models.
\subsection{Process definition}
\label{sec:procdef}
A process object is defined in a straightforward notation. The definition
syntax is straightforward:
\begin{quote}
\begin{footnotesize}
\ttt{process \textit{process-id} = \textit{incoming-particles}} \verb|=>|
\ttt{\textit{outgoing-particles}}
\end{footnotesize}
\end{quote}
Here are typical examples:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
process w_pair_production = e1, E1 => "W+", "W-"
process zdecay = Z => u, ubar
\end{verbatim}
\end{footnotesize}
\end{quote}
Throughout the program, the process will be identified by its
\textit{process-id}, so this is the name of the process object. This
identifier is arbitrary, chosen by the user. It follows the rules for
variable names, so it consists of alphanumeric characters and underscores,
where the first character is not numeric. As a special rule, it must not
contain upper-case characters. The reason is that this name is used for
identifying the process not just within the script, but also within the
\fortran\ code that the matrix-element generator produces for this process.
After the equals sign, there follow the lists of incoming and outgoing
particles. The number of incoming particles is either one or two: scattering
processes and decay processes. The number of outgoing particles should be two
or larger (as $2\to 1$ processes are proportional to a $\delta$
function they can only be sensibly integrated when using a structure
function like a hadron collider PDF or a beamstrahlung spectrum.).
There is no hard upper limit; the complexity of processes that
\whizard\ can handle depends only on the practical computing
limitations (CPU time and memory). Roughly speaking, one can assume
that processes up to $2\to 6$ particles are safe, $2\to 8$ processes
are feasible given sufficient time for reaching a stable integration,
while more complicated processes are largely unexplored.
We emphasize that in the default setup, the matrix element of a physics
process is computed exactly in leading-order perturbation theory, i.e., at
tree level. There is no restriction of intermediate states, the result always
contains the complete set of Feynman graphs that connect the initial with the
final state. If the result would actually be expanded in Feynman graphs
(which is not done by the \oMega\ matrix element generator that
\whizard\ uses), the number of graphs can easily reach several thousands,
depending on the complexity of the process and on the physics model.
More details about the different methods for quantum field-theoretical
matrix elements can be found in Chap.~\ref{chap:hardint}. In the
following, we will discuss particle names, options for processes like
restrictions on intermediate states, parallelization, flavor sums and
process components for inclusive event samples (process containers).
\subsection{Particle names}
The particle names are taken from the particle definition in the current model
file. Looking at the SM, for instance, the electron entry in
\ttt{share/models/SM.mdl} reads
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
particle E_LEPTON 11
spin 1/2 charge -1 isospin -1/2
name "e-" e1 electron e
anti "e+" E1 positron
tex_name "e^-"
tex_anti "e^+"
mass me
\end{verbatim}
\end{footnotesize}
\end{quote}
This tells that you can identify an electron either as \verb|"e-"|, \verb|e1|,
\verb|electron|, or simply \verb|e|. The first version is used for output,
but needs to be quoted, because otherwise \sindarin\ would interpret the minus
sign as an operator. (Technically, unquoted particle identifiers are aliases,
while the quoted versions -- you can say either \verb|e1| or \verb|"e1"| --
are names. On input, this makes no difference.) The alternative version
\verb|e1| follows a convention, inherited from
\comphep~\cite{Boos:2004kh}, that particles are indicated by lower
case, antiparticles by upper case, and for leptons, the generation
index is appended: \verb|e2| is the muon, \verb|e3| the tau. These
alternative names need not be quoted because they contain no special
characters.
In Table~\ref{tab:SM-particles}, we list the recommended names as well as
mass and width parameters for all SM particles. For other models, you may
look up the names in the corresponding model file.
\begin{table}[p]
\begin{center}
\begin{tabular}{|l|l|l|l|cc|}
\hline
& Particle & Output name & Alternative names & Mass & Width\\
\hline\hline
Leptons
&$e^-$ & \verb|e-| & \ttt{e1}\quad\ttt{electron} & \ttt{me} & \\
&$e^+$ & \verb|e+| & \ttt{E1}\quad\ttt{positron} & \ttt{me} & \\
\hline
&$\mu^-$ & \verb|mu-| & \ttt{e2}\quad\ttt{muon} & \ttt{mmu} & \\
&$\mu^+$ & \verb|mu+| & \ttt{E2} & \ttt{mmu} & \\
\hline
&$\tau^-$ & \verb|tau-| & \ttt{e3}\quad\ttt{tauon} & \ttt{mtau} & \\
&$\tau^+$ & \verb|tau+| & \ttt{E3} & \ttt{mtau} & \\
\hline\hline
Neutrinos
&$\nu_e$ & \verb|nue| & \ttt{n1} & & \\
&$\bar\nu_e$ & \verb|nuebar| & \ttt{N1} & & \\
\hline
&$\nu_\mu$ & \verb|numu| & \ttt{n2} & & \\
&$\bar\nu_\mu$ & \verb|numubar| & \ttt{N2} & & \\
\hline
&$\nu_\tau$ & \verb|nutau| & \ttt{n3} & & \\
&$\bar\nu_\tau$ & \verb|nutaubar| & \ttt{N3} & & \\
\hline\hline
Quarks
&$d$ & \verb|d| & \ttt{down} & & \\
&$\bar d$ & \verb|dbar| & \ttt{D} & & \\
\hline
&$u$ & \verb|u| & \ttt{up} & & \\
&$\bar u$ & \verb|ubar| & \ttt{U} & & \\
\hline
&$s$ & \verb|s| & \ttt{strange} & \ttt{ms} & \\
&$\bar s$ & \verb|sbar| & \ttt{S} & \ttt{ms} & \\
\hline
&$c$ & \verb|c| & \ttt{charm} & \ttt{mc} & \\
&$\bar c$ & \verb|cbar| & \ttt{C} & \ttt{mc} & \\
\hline
&$b$ & \verb|b| & \ttt{bottom} & \ttt{mb} & \\
&$\bar b$ & \verb|bbar| & \ttt{B} & \ttt{mb} & \\
\hline
&$t$ & \verb|t| & \ttt{top} & \ttt{mtop} & \ttt{wtop} \\
&$\bar t$ & \verb|tbar| & \ttt{T} & \ttt{mtop} & \ttt{wtop} \\
\hline\hline
Vector bosons
&$g$ & \verb|gl| & \ttt{g}\quad\ttt{G}\quad\ttt{gluon} & & \\
\hline
&$\gamma$ & \verb|A| & \ttt{gamma}\quad\ttt{photon} & & \\
\hline
&$Z$ & \verb|Z| & & \ttt{mZ} & \ttt{wZ} \\
\hline
&$W^+$ & \verb|W+| & \ttt{Wp} & \ttt{mW} & \ttt{wW} \\
&$W^-$ & \verb|W-| & \ttt{Wm} & \ttt{mW} & \ttt{wW} \\
\hline\hline
Scalar bosons
&$H$ & \verb|H| & \ttt{h}\quad \ttt{Higgs} & \ttt{mH} & \ttt{wH} \\
\hline
\end{tabular}
\end{center}
\caption{\label{tab:SM-particles} Names that can be used for SM particles.
Also shown are the intrinsic variables that can be used to set mass and
width, if applicable.}
\end{table}
Where no mass or width parameters are listed in the table, the particle is
assumed to be massless or stable, respectively. This is obvious for particles
such as the photon. For neutrinos, the mass is meaningless to particle
physics collider experiments, so it is zero. For quarks, the $u$ or
$d$ quark mass is unobservable directly, so we also set it zero. For
the heavier quarks, the mass may play a role, so it is kept. (The $s$
quark is borderline; one may argue that its mass is also unobservable
directly.) On the other hand, the electron mass is relevant, e.g., in
photon radiation without cuts, so it is not zero by default.
It pays off to set particle masses to zero, if the approximation is justified,
since fewer helicity states will contribute to the matrix element. Switching
off one of the helicity states of an external fermion speeds up the
calculation by a factor of two. Therefore, script files will usually contain
the assignments
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
me = 0 mmu = 0 ms = 0 mc = 0
\end{verbatim}
\end{footnotesize}
\end{quote}
unless they deal with processes where this simplification is
phenomenologically unacceptable. Often $m_\tau$ and $m_b$ can also be
neglected, but this excludes processes where the Higgs couplings of $\tau$ or
$b$ are relevant.
Setting fermion masses to zero enables, furthermore, the possibility to define
multi-flavor aliases
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
alias q = d:u:s:c
alias Q = D:U:S:C
\end{verbatim}
\end{footnotesize}
\end{quote}
and handle processes such as
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
process two_jets_at_ilc = e1, E1 => q, Q
process w_pairs_at_lhc = q, Q => Wp, Wm
\end{verbatim}
\end{footnotesize}
\end{quote}
where a sum over all allowed flavor combination is automatically included.
For technical reasons, such flavor sums are possible only for massless
particles (or more general for mass-degenerate particles). If you want
to generate inclusive processes with sums over particles of different
masses (e.g. summing over $W/Z$ in the final state etc.), confer below
the section about process components, Sec.~\ref{sec:processcomp}.
Assignments of masses, widths and other parameters are actually in effect when
a process is integrated, not when it is defined. So, these assignments may
come before or after the process definition, with no significant difference.
However, since flavor summation requires masses to be zero, the assignments
may be put before the alias definition which is used in the process.
The muon, tau, and the heavier quarks are actually unstable. However, the
width is set to zero because their decay is a macroscopic effect and, except for
the muon, affected by hadron physics, so it is not described by \whizard. (In
the current \whizard\ setup, all decays occur at the production vertex. A
future version may describe hadronic physics and/or macroscopic particle
propagation, and this restriction may be eventually removed.)
\subsection{Options for processes}
\label{sec:process options}
The \ttt{process} definition may contain an optional argument:
\begin{quote}
\begin{footnotesize}
\ttt{process \textit{process-id} = \textit{incoming-particles}} \verb|=>|
\ttt{\textit{outgoing-particles}} \ttt{\{\textit{options\ldots}\}}
\end{footnotesize}
\end{quote}
The \textit{options} are a \sindarin\ script that is executed in a context local
to the \ttt{process} command. The assignments it contains apply only to the
process that is defined. In the following, we describe the set of potentially
useful options (which all can be also set globally):
\subsubsection{Model reassignment}
It is possible to locally reassign the model via a \ttt{model =} statment,
permitting the definition of process using a model other than the globally
selected model. The process will retain this association during
integration and event generation.
\subsubsection{Restrictions on matrix elements}
\label{subsec:restrictions}
Another useful option is the setting
\begin{quote}
\begin{footnotesize}
\verb|$restrictions =| \ttt{\textit{string}}
\end{footnotesize}
\end{quote}
This option allows to select particular classes of Feynman graphs for the
process when using the \oMega\ matrix element generator. The
\verb|$restrictions| string specifies e.g. propagators that the graph
must contain. Here is an example:
\begin{code}
process zh_invis = e1, E1 => n1:n2:n3, N1:N2:N3, H { $restrictions = "1+2 ~ Z" }
\end{code}
The complete process $e^-e^+ \to \nu\bar\nu H$, summed over all neutrino
generations, contains both $ZH$ pair production (Higgs-strahlung) and
$W^+W^-\to H$ fusion. The restrictions string selects the Higgs-strahlung
graph where the initial electrons combine to a $Z$ boson. Here, the particles
in the process are consecutively numbered, starting with the initial
particles. An alternative for the same selection would be
\verb|$restrictions = "3+4 ~ Z"|. Restrictions can be combined using
\verb|&&|, for instance
\begin{code}
$restrictions = "1+2 ~ Z && 3 + 4 ~ Z"
\end{code}
which is redundant here, however.
The restriction keeps the full energy dependence in the intermediate
propagator, so the Breit-Wigner shape can be observed in distributions. This
breaks gauge invariance, in particular if the intermediate state is off shell,
so you should use the feature only if you know the implications. For
more details, cf. the Chap.~\ref{chap:hardint} and the \oMega\ manual.
Other restrictions that can be combined with the restrictions above on
intermediate propagators allow to exclude certain particles from
intermediate propagators, or to exclude certain vertices from the
matrix elements. For example,
\begin{code}
process eemm = e1, E1 => e2, E2 { $restrictions = "!A" }
\end{code}
would exclude all photon propagators from the matrix element and
leaves only the $Z$ exchange here. In the same way,
\verb|$restrictions = "!gl"| would exclude all gluon exchange. This
exclusion of internal propagators works also for lists of particles,
like
\begin{code}
$restrictions = "!Z:H"
\end{code}
excludes all $Z$ and $H$ propagators from the matrix elements.
Besides excluding certain particles as internal lines, it is also
possible to exclude certain vertices using the restriction command
\begin{code}
process eeww = e1, E1 => Wp, Wm { $restrictions = "^[W+,W-,Z]" }
\end{code}
This would generate the matrix element for the production of two $W$
bosons at LEP without the non-Abelian vertex $W^+W^-Z$. Again, these
restrictions are able to work on lists, so
\begin{code}
$restrictions = "^[W+,W-,A:Z]"
\end{code}
would exclude all triple gauge boson vertices from the above process
and leave only the $t$-channel neutrino exchange.
It is also possible to exlude vertices by their coupling constants,
e.g. the photon exchange in the process $e^+ e^- \to \mu^+ \mu^-$ can
also be removed by the following restriction:
\begin{code}
$restrictions = "^qlep"
\end{code}
Here, \ttt{qlep} is the \fortran\ variable for the coupling constant
of the electron-positron-photon vertex.
\begin{table}
\begin{center}
\begin{tabular}{|l|l|}
\hline
\verb|3+4~Z| & external particles 3 and 4 must come from
intermediate $Z$ \\\hline
\verb| && | & logical ``and'', e.g. in
\verb| 3+5~t && 4+6~tbar| \\\hline
\verb| !A | & exclude all $\gamma$ propagators \\\hline
\verb| !e+:nue | & exclude a list of propagators, here $\gamma$,
$\nu_e$ \\\hline
\verb|^qlep:gnclep| & exclude all vertices with
\ttt{qlep},\ttt{gnclep} coupling constants \\\hline
\verb|^[A:Z,W+,W-]| & exclude all vertices $W^+W^-Z$,
$W^+W^-\gamma$ \\\hline
\verb|^c1:c2:c3[H,H,H]| & exclude all triple Higgs couplings
with $c_i$ constants
\\\hline
\end{tabular}
\end{center}
\caption{List of possible restrictions that can be applied to
\oMega\ matrix elements.}
\label{tab:restrictions}
\end{table}
The Tab.~\ref{tab:restrictions} gives a list of options that can be
applied to the \oMega\ matrix elements.
\subsubsection{Other options}
There are some further options that the \oMega\ matrix-element generator can
take. If desired, any string of options that is contained in this variable
\begin{quote}
\begin{footnotesize}
\verb|$omega_flags =| \ttt{\textit{string}}
\end{footnotesize}
\end{quote}
will be copied verbatim to the \oMega\ call, after all other options.
One important application is the scheme of treating the width of unstable
particles in the $t$-channel. This is modified by the \verb|model:| class of
\oMega\ options.
It is well known that for some processes, e.g., single $W$ production from
photon-$W$ fusion, gauge invariance puts constraints on the treatment of the
unstable-particle width. By default, \oMega\ puts a nonzero width in the $s$
channel only. This correctly represents the resummed Dyson series for the
propagator, but it violates QED gauge invariance, although the effect is only
visible if the cuts permit the photon to be almost on-shell.
An alternative is
\begin{quote}
\begin{footnotesize}
\verb|$omega_flags = "-model:fudged_width"|
\end{footnotesize}
\end{quote}
which puts zero width in the matrix element, so that gauge cancellations
hold, and reinstates the $s$-channel width in the appropriate places by an
overall factor that multiplies the whole matrix element.
Another possibility is
\begin{quote}
\begin{footnotesize}
\verb|$omega_flags = "-model:constant_width"|
\end{footnotesize}
\end{quote}
which puts the width both in the $s$ and in the $t$ channel everywhere.
Note that both options apply only to charged unstable particles, such as the
$W$ boson.
\subsubsection{Multithreaded calculation of helicity sums via OpenMP}
\label{sec:openmp}
On multicore and / or multiprocessor systems, it is possible to speed
up the calculation by using multiple threads to perform the helicity
sum in the matrix element calculation. As the processing time used by
\whizard\ is not used up solely in the matrix element, the speedup thus
achieved varies greatly depending on the process under consideration;
while simple processes without flavor sums do not profit significantly
from this parallelization, the computation time for processes
involving flavor sums with four or more particles in the final state
is typically reduced by a factor between two and three when utilizing
four parallel threads.
The parallization is implemented using \ttt{OpenMP} and requires
\whizard\ to be compiled with an \ttt{OpenMP} aware compiler and the
appropiate compiler flags This is done in the configuration step, cf.\
Sec.~\ref{sec:installation}.
As with all \ttt{OpenMP} programs, the default number of threads used at
runtime is up to the compiler runtime support and typically set to the
number of independent hardware threads (cores / processors /
hyperthreads) available in the system. This default can be adjusted
by setting the \ttt{OMP\_NUM\_THREADS} environment variable prior to
calling WHIZARD. Alternatively, the available number of threads can
be reset anytime by the \sindarin\ parameter
\ttt{openmp\_num\_threads}. Note however that the total number of
threads that can be sensibly used is limited by the number of
nonvanishing helicity combinations.
%%%%%%%%%%%%%%%
\subsection{Process components}
\label{sec:processcomp}
It was mentioned above that processes with flavor sums (in the initial
or final state or both) have to be mass-degenerate (in most cases
massless) in all particles that are summed over at a certain
position. This condition is necessary in order to use the same
phase-space parameterization and integration for the flavor-summed
process. However, in many applications the user wants to handle
inclusive process definitions, e.g. by defining inclusive decays,
inclusive SUSY samples at hadron colliders (gluino pairs, squark
pairs, gluino-squark associated production), or maybe lepton-inclusive
samples where the tau and muon mass should be kept at different
values. In \whizard\, from version v2.2.0 on, there is the possibility
to define such inclusive process containers. The infrastructure for
this feature is realized via so-called process components: processes
are allowed to contain several process components. Those components
need not be provided by the same matrix element generator,
e.g. internal matrix elements, \oMega\ matrix elements, external
matrix element (e.g. from a one-loop program, OLP) can be mixed. The
very same infrastructure can also be used for next-to-leading order
(NLO) calculations, containing the born with real emission, possible
subtraction terms to make the several components infrared- and
collinear finite, as well as the virtual corrections.
Here, we want to discuss the use for inclusive particle samples. There
are several options, the simplest of which to add up different final
states by just using the \ttt{+} operator in \sindarin, e.g.:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
process multi_comp = e1, E1 => (e2, E2) + (e3, E3) + (A, A)
\end{verbatim}
\end{footnotesize}
\end{quote}
The brackets are not only used for a better grouping of the expressions,
they are not mandatory for \whizard\ to interpret the sum
correctly. When integrating, \whizard\ tells you that this a process
with three different components:
\begin{footnotesize}
\begin{Verbatim}
| Initializing integration for process multi_comp_1_p1:
| ------------------------------------------------------------------------
| Process [scattering]: 'multi_comp'
| Library name = 'default_lib'
| Process index = 1
| Process components:
| 1: 'multi_comp_i1': e-, e+ => m-, m+ [omega]
| 2: 'multi_comp_i2': e-, e+ => t-, t+ [omega]
| 3: 'multi_comp_i3': e-, e+ => A, A [omega]
| ------------------------------------------------------------------------
\end{Verbatim}
\end{footnotesize}
A different phase-space setup is used for each different
component. The integration for each different component is performed
separately, and displayed on screen. At the end, a sum of all
components is shown. All files that depend on the components are being
attached an \ttt{\_i{\em <n>}} where \ttt{{\em <n>}} is the number of
the process component that appears in the list above: the \fortran\
code for the matrix element, the \ttt{.phs} file for the phase space
parameterization, and the grid files for the \vamp\ Monte-Carlo
integration (or any other integration method). However, there will be
only one event file for the inclusive process, into which a mixture of
events according to the size of the individual process component cross
section enter.
More options are to specify additive lists of particles. \whizard\
then expands the final states according to tensor product algebra:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
process multi_tensor = e1, E1 => e2 + e3 + A, E2 + E3 + A
\end{verbatim}
\end{footnotesize}
\end{quote}
This gives the same three process components as above, but \whizard\
recognized that e.g. $e^- e^+ \to \mu^- \gamma$ is a vanishing
process, hence the numbering is different:
\begin{footnotesize}
\begin{Verbatim}
| Process component 'multi_tensor_i2': matrix element vanishes
| Process component 'multi_tensor_i3': matrix element vanishes
| Process component 'multi_tensor_i4': matrix element vanishes
| Process component 'multi_tensor_i6': matrix element vanishes
| Process component 'multi_tensor_i7': matrix element vanishes
| Process component 'multi_tensor_i8': matrix element vanishes
| ------------------------------------------------------------------------
| Process [scattering]: 'multi_tensor'
| Library name = 'default_lib'
| Process index = 1
| Process components:
| 1: 'multi_tensor_i1': e-, e+ => m-, m+ [omega]
| 5: 'multi_tensor_i5': e-, e+ => t-, t+ [omega]
| 9: 'multi_tensor_i9': e-, e+ => A, A [omega]
| ------------------------------------------------------------------------
\end{Verbatim}
\end{footnotesize}
Identical copies of the same process that would be created by
expanding the tensor product of final states are eliminated and appear
only once in the final sum of process components.
Naturally, inclusive process definitions are also available for
decays:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
process multi_dec = Wp => E2 + E3, n2 + n3
\end{Verbatim}
\end{footnotesize}
\end{quote}
This yields:
\begin{footnotesize}
\begin{Verbatim}
| Process component 'multi_dec_i2': matrix element vanishes
| Process component 'multi_dec_i3': matrix element vanishes
| ------------------------------------------------------------------------
| Process [decay]: 'multi_dec'
| Library name = 'default_lib'
| Process index = 2
| Process components:
| 1: 'multi_dec_i1': W+ => mu+, numu [omega]
| 4: 'multi_dec_i4': W+ => tau+, nutau [omega]
| ------------------------------------------------------------------------
\end{Verbatim}
\end{footnotesize}
%%%%%%%%%%%%%%%
\subsection{Compilation}
\label{sec:compilation}
Once processes have been set up, to make them available for integration they
have to be compiled. More precisely, the matrix-element generator
\oMega\ (and it works similarly if a different matrix element method
is chosen) is called to generate matrix element code, the compiler is
called to transform this \fortran\ code into object files, and the
linker is called to collect this in a dynamically loadable library.
Finally, this library is linked to the program. From version v2.2.0 of
\whizard\ this is no longer done by system calls of the OS but steered
via process library Makefiles. Hence, the user can execute and
manipulate those Makefiles in order to manually intervene in the
particular steps, if he/she wants to do so.
All this is done automatically when an \ttt{integrate}, \ttt{unstable}, or
\ttt{simulate} command is encountered for the first time. You may also force
compilation explicitly by the command
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
compile
\end{verbatim}
\end{footnotesize}
\end{quote}
which performs all steps as listed above, including loading the generated
library.
The \fortran\ part of the compilation will be done using the \fortran\ compiler
specified by the string variable
\verb|$fc| and the compiler flags specified as \verb|$fcflags|. The default
settings are those that have been used for compiling \whizard\ itself during
installation. For library compatibility, you should stick to the compiler.
The flags may be set differently. They are applied in the compilation and
loading steps, and they are processed by \ttt{libtool}, so
\ttt{libtool}-specific flags can also be given.
\whizard\ has some precautions against unnecessary repetitions. Hence, when a
\ttt{compile} command is executed (explicitly, or implicitly by the first
integration), the program checks first whether the library is already loaded,
and whether source code already exists for the requested processes. If yes,
this code is used and no calls to \oMega\ (or another matrix element
method) or to the compiler are issued.
Otherwise, it will detect any modification to the process configuration and
regenerate the matrix element or recompile accordingly. Thus, a \sindarin\
script can be executed repeatedly without rebuilding everything from scratch,
and you can safely add more processes to a script in a subsequent run without
having to worry about the processes that have already been treated.
This default behavior can be changed. By setting
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
?rebuild_library = true
\end{verbatim}
\end{footnotesize}
\end{quote}
code will be re-generated and re-compiled even if \whizard\ would think that
this is unncessary. The same effect is achieved by calling \whizard\ with a
command-line switch,
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
/home/user$ whizard --rebuild_library
\end{verbatim}
\end{footnotesize}
\end{quote}
There are further \ttt{rebuild} switches which are described below. If
everything is to be rebuilt, you can set a master switch \ttt{?rebuild} or the
command line option \verb|--rebuild|. The latter can be abbreviated as a short
command-line option:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
/home/user$ whizard -r
\end{verbatim}
\end{footnotesize}
\end{quote}
Setting this switch is always a good idea when starting a new project, just in
case some old files clutter the working directory. When re-running the same
script, possibly modified, the \verb|-r| switch should be omitted, so the
existing files can be reused.
\subsection{Process libraries}
Processes are collected in \emph{libraries}. A script may use more than one
library, although for most applications a single library will probably be
sufficient.
The default library is \ttt{default\_lib}. If you do not specify anything else,
the processes you compile will be collected by a driver file
\ttt{default\_lib.f90} which is compiled together with the process code and
combined as a libtool archive \ttt{default\_lib.la}, which is dynamically linked
to the running \whizard\ process.
Once in a while, you work on several projects at once, and you didn't care
about opening a new working directory for each. If the \verb|-r| option is
given, a new run will erase the existing library, which may contain processes
needed for the other project. You could omit \verb|-r|, so all processes will
be collected in the same library (this does not hurt), but you may wish to
cleanly separate the projects. In that case, you should open a separate
library for each project.
Again, there are two possibilities. You may start the script with the
specification
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
library = "my_lhc_proc"
\end{verbatim}
\end{footnotesize}
\end{quote}
to open a library \verb|my_lhc_proc| in place of the default library.
Repeating the command with different arguments, you may introduce several
libraries in the script. The active library is always the one specified
last. It is possible to issue this command locally, so a particular process
goes into its own library.
Alternatively, you may call \whizard\ with the option
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
/home/user$ whizard --library=my_lhc_proc
\end{verbatim}
\end{footnotesize}
\end{quote}
If several libraries are open simultaneously, the \ttt{compile} command will
compile all libraries that the script has referenced so far. If this is not
intended, you may give the command an argument,
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
compile ("my_lhc_proc", "my_other_proc")
\end{verbatim}
\end{footnotesize}
\end{quote}
to compile only a specific subset.
The command
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
show (library)
\end{verbatim}
\end{footnotesize}
\end{quote}
will display the contents of the actually loaded library together with
a status code which indicates the status of the library and the processes within.
%%%%%%%%%%%%%%%
\subsection{Stand-alone \whizard\ with precompiled processes}
\label{sec:static}
Once you have set up a process library, it is straightforward to make a
special stand-alone \whizard\ executable which will have this library
preloaded on startup. This is a matter of convenience, and it is also useful
if you need a statically linked executable for reasons of profiling,
batch processing, etc.
For this task, there is a variant of the \ttt{compile} command:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
compile as "my_whizard" ()
\end{verbatim}
\end{footnotesize}
\end{quote}
which produces an executable \verb|my_whizard|. You can omit the library
argument if you simply want to include everything. (Note that this command
will \emph{not} load a library into the current process, it is intended for
creating a separate program that will be started independently.)
As an example, the script
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
process proc1 = e1, E1 => e1, E1
process proc2 = e1, E1 => e2, E2
process proc3 = e1, E1 => e3, E3
compile as "whizard-leptons" ()
\end{verbatim}
\end{footnotesize}
\end{quote}
will make a new executable program \verb|whizard-leptons|. This
program behaves completely identical to vanilla \whizard, except for the fact
that the processes \ttt{proc1}, \ttt{proc2}, and \ttt{proc3} are available
without configuring them or loading any library.
% This feature is particularly useful when compiling with the \ttt{-static}
% flag. As long as the architecture is compatible, the resulting binary may be
% run on a different computer where no \whizard\ libraries are present. (The
% program will still need to find its model files, however.)
\section{Beams}
\label{sec:beams}
Before processes can be integrated and simulated, the program has to know
about the collider properties. They can be specified by the \ttt{beams}
statement.
In the command script, it is irrelevant whether a \ttt{beams} statement comes
before or after process specification. The \ttt{integrate} or \ttt{simulate}
commands will use the \ttt{beams} statement that was issued last.
\subsection{Beam setup}
\label{sec:beam-setup}
If the beams have no special properties, and the colliding particles are the
incoming particles in the process themselves, there is no need for a
\ttt{beams} statement at all. You only \emph{must} specify the
center-of-momentum energy of the collider by setting the value of $\sqrt{s}$,
for instance
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
sqrts = 14 TeV
\end{verbatim}
\end{footnotesize}
\end{quote}
The \ttt{beams} statement comes into play if
\begin{itemize}
\item
the beams have nontrivial structure, e.g., parton structure in hadron
collision or photon radiation in lepton collision, or
\item
the beams have non-standard properties: polarization, asymmetry, crossing
angle.
\end{itemize}
Note that some of the abovementioned beam properties had not yet been
reimplemented in the \whizard\ttt{2} release series. From version
v2.2.0 on all options of the legacy series \whizard\ttt{1} are
available again. From version v2.1 to version v2.2 of \whizard\ there
has also been a change in possible options to the \ttt{beams}
statement: in the early versions of \whizard\ttt{2} (v2.0/v2.1), local
options could be specified within the beam settings, e.g. \ttt{beams =
p, p { sqrts = 14 TeV } => pdf\_builtin}. These possibility has been
abandoned from version v2.2 on, and the \ttt{beams} command does not
allow for {\em any} optional arguments any more.
Hence, beam parameters can -- with the exception of the specification
of structure functions -- be specified only globally:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
sqrts = 14 TeV
beams = p, p => lhapdf
\end{verbatim}
\end{footnotesize}
\end{quote}
It does not make any difference whether the value of \ttt{sqrts} is
set before or after the \ttt{beams} statement, the last value found
before an \ttt{integrate} or \ttt{simulate} is the relevant one. This
in particularly allows to specify the beam structure, and then after
that perform a loop or scan over beam energies, beam parameters, or
structure function settings.
The \ttt{beams} statement also applies to particle decay processes, where there
is only a single beam. Here, it is usually redundant because no structure
functions are possible, and the energy is fixed to the decaying particle's
mass. However, it is needed for computing polarized decay, e.g.
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = Z
beams_pol_density = @(0)
\end{verbatim}
\end{footnotesize}
\end{quote}
where for a boson at rest, the polarization axis is defined to be the $z$
axis.
Beam polarization is described in detail below in Sec.~\ref{sec:polarization}.
Note also that future versions of \whizard\ might give support for
single-beam events, where structure functions for single particles
indeed do make sense.
In the following sections we list the available options for structure
functions or spectra inside \whizard\ and explain their usage. More
about the physics of the implemented structure functions can be found
in Chap.~\ref{chap:hardint}.
%%%%%%%%%%%%%%%
\subsection{Asymmetric beams and Crossing angles}
\label{sec:asymmetricbeams}
\whizard\ not only allows symmetric beam collisions, but basically
arbitrary collider setups. In the case there are two different beam
energies, the command
\begin{quote}
\begin{footnotesize}
\ttt{beams\_momentum = {\em <beam\_mom1>}, {\em <beam\_mom2>}}
\end{footnotesize}
\end{quote}
allows to specify the momentum (or as well energies for massless
particles) for the beams. Note that for scattering processes both
values for the beams must be present. So the following to setups for
14 TeV LHC proton-proton collisions are equivalent:
\begin{quote}
\begin{footnotesize}
\ttt{beams = p, p => pdf\_builtin} \newline
\ttt{sqrts = 14 TeV}
\end{footnotesize}
\end{quote}
and
\begin{quote}
\begin{footnotesize}
\ttt{beams = p, p => pdf\_builtin} \newline
\ttt{beams\_momentum = 7 TeV, 7 TeV}
\end{footnotesize}
\end{quote}
Asymmetric setups can be set by using different values for the two
beam momenta, e.g. in a HERA setup:
\begin{quote}
\begin{footnotesize}
\ttt{beams = e, p => none, pdf\_builtin}
\ttt{beams\_momentum = 27.5 GeV, 920 GeV}
\end{footnotesize}
\end{quote}
or for the BELLE experiment at the KEKB accelerator:
\begin{quote}
\begin{footnotesize}
\ttt{beams = e1, E1}
\ttt{beams\_momentum = 8 GeV, 3.5 GeV}
\end{footnotesize}
\end{quote}
\whizard\ lets you know about the beam structure and calculates for
you that the center of mass energy corresponds to 10.58 GeV:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
| Beam structure: e-, e+
| momentum = 8.000000000000E+00, 3.500000000000E+00
| Beam data (collision):
| e- (mass = 5.1099700E-04 GeV)
| e+ (mass = 5.1099700E-04 GeV)
| sqrts = 1.058300530253E+01 GeV
| Beam structure: lab and c.m. frame differ
\end{Verbatim}
\end{footnotesize}
\end{quote}
It is also possible to specify beams for decaying particles, where
\ttt{beams\_momentum} then only has a single argument, e.g.:
\begin{quote}
\begin{footnotesize}
\ttt{process zee = Z => "e-", "e+"} \\
\ttt{beams = Z} \\
\ttt{beams\_momentum = 500 GeV} \\
\ttt{simulate (zee) \{ n\_events = 100 \} }
\end{footnotesize}
\end{quote}
This would corresponds to a beam of $Z$ bosons with a momentum of 500
GeV. Note, however, that \whizard\ will always do the integration of
the particle width in the particle's rest frame, while the moving beam
is then only taken into account for the frame of reference for the
simulation.
Further options then simply having different beam energies describe a
non-vanishing between the two incoming beams. Such concepts are quite
common e.g. for linear colliders to improve the beam properties in the
collimation region at the beam interaction points. Such crossing
angles can be specified in the beam setup, too, using the
\ttt{beams\_theta} command:
\begin{quote}
\begin{footnotesize}
\ttt{beams = e1, E1} \\
\ttt{beams\_momentum = 500 GeV, 500 GeV} \\
\ttt{beams\_theta = 0, 10 degree}
\end{footnotesize}
\end{quote}
It is important that when a crossing angle is being specified, and the
collision system consequently never is the center-of-momentum system,
the beam momenta have to explicitly set. Besides a planar crossing
angle, one is even able to rotate an azimuthal distance:
\begin{quote}
\begin{footnotesize}
\ttt{beams = e1, E1} \\
\ttt{beams\_momentum = 500 GeV, 500 GeV} \\
\ttt{beams\_theta = 0, 10 degree} \\
\ttt{beams\_phi = 0, 45 degree}
\end{footnotesize}
\end{quote}
%%%%%%%%%%%%%%%
\subsection{LHAPDF}
\label{sec:lhapdf}
For incoming hadron beams, the \ttt{beams} statement specifies which structure
functions are used. The simplest example is the study of parton-parton
scattering processes at a hadron-hadron collider such as LHC or Tevatron. The
\lhapdf\ structure function set is selected by a syntax similar to the
process setup, namely the example already shown above:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = p, p => lhapdf
\end{verbatim}
\end{footnotesize}
\end{quote}
Note that there are slight differences in using the \lhapdf\ release
series 6 and the older \fortran\ \lhapdf\ release series 5, at least
concerning the naming conventions for the PDF sets~\footnote{Until
\whizard\ version 2.2.1 including, only the \lhapdf\ series 5 was
supported, while from version 2.2.2 on also the \lhapdf\ release
series 6 has been supported.}. The above \ttt{beams}
statement selects a default \lhapdf\ structure-function set for both
proton beams (which is the \ttt{CT10} central set for \lhapdf\ 6, and
\ttt{cteq6ll.LHpdf} central set for \lhapdf 5). The structure
function will apply for all quarks, antiquarks, and the gluon as far
as supported by the particular \lhapdf\ set. Choosing a different set
is done by adding the filename as a local option to the \ttt{lhapdf}
keyword:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = p, p => lhapdf
$lhapdf_file = "MSTW2008lo68cl"
\end{verbatim}
\end{footnotesize}
\end{quote}
for the actual \lhapdf\ 6 series, and
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = p, p => lhapdf
$lhapdf_file = "MSTW2008lo68cl.LHgrid"
\end{verbatim}
\end{footnotesize}
\end{quote}
for \lhapdf 5.Similarly, a member within the set is selected by the
numeric variable \verb|lhapdf_member| (for both release series of \lhapdf).
In some cases, different structure functions have to be chosen for the two
beams. For instance, we may look at $ep$ collisions:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = "e-", p => none, lhapdf
\end{verbatim}
\end{footnotesize}
\end{quote}
Here, there is a list of two independent structure functions (each with its
own option set, if applicable) which applies to the two beams.
Another mixed case is $p\gamma$ collisions, where the photon is to be
resolved as a hadron. The simple assignment
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = p, gamma => lhapdf, lhapdf_photon
\end{verbatim}
\end{footnotesize}
\end{quote}
will be understood as follows: \whizard\ selects the appropriate default
structure functions (here we are using \lhapdf\ 5 as an example as the
support of photon and pion PDFs in \lhapdf\ 6 has been dropped),
\ttt{cteq6ll.LHpdf} for the proton and
\ttt{GSG960.LHgrid} for the photon. The photon case has an additional
integer-valued parameter \verb|lhapdf_photon_scheme|. (There are also pion
structure functions available.) For modifying the default, you have to
specify separate structure functions
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = p, gamma => lhapdf, lhapdf_photon
$lhapdf_file = ...
$lhapdf_photon_file = ...
\end{verbatim}
\end{footnotesize}
\end{quote}
Finally, the scattering of elementary photons on partons is described by
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = p, gamma => lhapdf, none
\end{verbatim}
\end{footnotesize}
\end{quote}
Note that for \lhapdf\ version 5.7.1 or higher and for PDF sets which
support it, photons can be used as partons.
There is one more option for the \lhapdf\ PDFs, namely to specify the
path where the \lhapdf\ PDF sets reside: this is done with the string
variable \ttt{\$lhapdf\_dir = "{\em <path-to-lhapdf>}"}. Usually, it
is not necessary to set this because \whizard\ detects this path via
the \ttt{lhapdf-config} script during configuration, but in the case
paths have been moved, or special files/special locations are to be
used, the user can specify this location explicitly.
%%%%%%%%%%%%%%%
\subsection{Built-in PDFs}
\label{sec:built-in-pdf}
In addition to the possibility of linking against \lhapdf, \whizard\
comes with a couple of built-in PDFs which are selected via the
\verb?pdf_builtin? keyword
%
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = p, p => pdf_builtin
\end{verbatim}
\end{footnotesize}
\end{quote}
%
The default PDF set is CTEQ6L, but other choices are also available by
setting the string variable \verb?$pdf_builtin_set? to an
appropiate value. E.g, modifying the above
setup to
%
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = p, p => pdf_builtin
$pdf_builtin_set = "mrst2004qedp"
\end{verbatim}
\end{footnotesize}
\end{quote}
%
would select the proton PDF from the MRST2004QED set. A list of all currently
available PDFs can be found in Table~\ref{tab:pdfs}.
%
\begin{table}
\centerline{\begin{tabular}{|l||l|p{0.2\textwidth}|l|}
\hline
Tag & Name & Notes & References \\\hline\hline
%
\ttt{cteq6l} & CTEQ6L & \mbox{}\hfill---\hfill\mbox{} &
\cite{Pumplin:2002vw} \\\hline
\ttt{cteq6l1} & CTEQ6L1 & \mbox{}\hfill---\hfill\mbox{} &
\cite{Pumplin:2002vw} \\\hline
\ttt{cteq6d} & CTEQ6D & \mbox{}\hfill---\hfill\mbox{} &
\cite{Pumplin:2002vw} \\\hline
\ttt{cteq6m} & CTEQ6M & \mbox{}\hfill---\hfill\mbox{} &
\cite{Pumplin:2002vw} \\\hline
\hline
\ttt{mrst2004qedp} & MRST2004QED (proton) & includes photon &
\cite{Martin:2004dh} \\\hline
\hline
\ttt{mrst2004qedn} & MRST2004QED (neutron) & includes photon &
\cite{Martin:2004dh} \\\hline
\hline
\ttt{mstw2008lo} & MSTW2008LO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Martin:2009iq} \\\hline
\ttt{mstw2008nlo} & MSTW2008NLO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Martin:2009iq} \\\hline
\ttt{mstw2008nnlo} & MSTW2008NNLO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Martin:2009iq} \\\hline
\hline
\ttt{ct10} & CT10 & \mbox{}\hfill---\hfill\mbox{} &
\cite{Lai:2010vv} \\\hline
\hline
\ttt{CJ12\_max} & CJ12\_max & \mbox{}\hfill---\hfill\mbox{} &
\cite{Owens:2012bv} \\\hline
\ttt{CJ12\_mid} & CJ12\_mid & \mbox{}\hfill---\hfill\mbox{} &
\cite{Owens:2012bv} \\\hline
\ttt{CJ12\_min} & CJ12\_min & \mbox{}\hfill---\hfill\mbox{} &
\cite{Owens:2012bv} \\\hline
\hline
\ttt{CJ15LO} & CJ15LO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Accardi:2016qay} \\\hline
\ttt{CJ15NLO} & CJ15NLO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Accardi:2016qay} \\\hline
\hline
\ttt{mmht2014lo} & MMHT2014LO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Harland-Lang:2014zoa} \\\hline
\ttt{mmht2014nlo} & MMHT2014NLO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Harland-Lang:2014zoa} \\\hline
\ttt{mmht2014nnlo} & MMHT2014NNLO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Harland-Lang:2014zoa} \\\hline
\hline
\ttt{CT14LL} & CT14LLO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Dulat:2015mca} \\\hline
\ttt{CT14L} & CT14LO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Dulat:2015mca} \\\hline
\ttt{CT14N} & CT1414NLO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Dulat:2015mca} \\\hline
\ttt{CT14NN} & CT14NNLO & \mbox{}\hfill---\hfill\mbox{} &
\cite{Dulat:2015mca} \\\hline
\hline
%
\end{tabular}}
\caption{All PDF sets available as builtin sets. The two MRST2004QED
sets also contain a photon.}
\label{tab:pdfs}
\end{table}
The two MRST2004QED sets also contain the photon as a parton, which
can be used in the same way as for \lhapdf\ from v5.7.1 on. Note,
however, that there is no builtin PDF that contains a photon structure
function. There is a \ttt{beams} structure function specifier
\ttt{pdf\_builtin\_photon}, but at the moment this throws an error. It
just has been implemented for the case that in future versions of
\whizard\ a photon structure function might be included.
Note that in general only the data sets for the central values of the
different PDFs ship with \whizard. Using the error sets is possible,
i.e. it is supported in the syntax of the code, but you have to
download the corresponding data sets from the web pages of the PDF
fitting collaborations.
%%%%%%%%%%%%%%%
\subsection{HOPPET $b$ parton matching}
When the \hoppet\ tool~\cite{Salam:2008qg} for hadron-collider PDF
structure functions and their manipulations are
correctly linked to \whizard, it can be used for advanced
calculations and simulations of hadron collider physics. Its main
usage inside \whizard\ is for matching schemes between 4-flavor and
5-flavor schemes in $b$-parton initiated processes at hadron
colliders. Note that in versions 2.2.0 and 2.2.1 it only worked
together with \lhapdf\ version 5, while with the \lhapdf\ version 6
interface from version 2.2.2 on it can be used also with the modern
version of PDFs from \lhapdf. Furthermore, from version 2.2.2, the
\hoppet\ $b$ parton matching also works for the builtin PDFs.
It depends on the corresponding process and the energy scales involved
whether it is a better description to use the
$g\to b\bar b$ splitting from the DGLAP evolution inside the PDF and
just take the $b$ parton content of a PDF, e.g. in BSM Higgs
production for large $\tan\beta$: $pp \to H$ with a partonic
subprocess $b\bar b \to H$, or directly take the gluon PDFs and use
$pp \to b\bar b H$ with a partonic subprocess $gg \to b \bar b
H$. Elaborate schemes for a proper matching between the two
prescriptions have been developed and have been incorporated into the
\hoppet\ interface.
Another prime example for using these matching schemes is single top
production at hadron colliders. Let us consider the following setup:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
process proc1 = b, u => t, d
process proc2 = u, b => t, d
process proc3 = g, u => t, d, B { $restrictions = "2+4 ~ W+" }
process proc4 = u, g => t, d, B { $restrictions = "1+4 ~ W+" }
beams = p,p => pdf_builtin
sqrts = 14 TeV
?hoppet_b_matching = true
$sample = "single_top_matched"
luminosity = 1 / 1 fbarn
simulate (proc1, proc2, proc3, proc4)
\end{Verbatim}
\end{footnotesize}%$
\end{quote}
The first two processes are single top production from $b$ PDFs, the
last two processes contain an explicit $g\to b\bar b$ splitting (the
restriction, cf. Sec.~\ref{sec:process options} has been placed in
order to single out the single top production signal process). PDFs
are then chosen from the default builtin PDF (which is \ttt{CTEQ6L}),
and the \hoppet\ matching routines are switched on by the flag
\ttt{?hoppet\_b\_matching}.
%%%%%%%%%%%%%%%
\subsection{Lepton Collider ISR structure functions}
\label{sec:lepton_isr}
Initial state QED radiation off leptons is an important feature at all
kinds of lepton colliders: the radiative return to the $Z$ resonance
by ISR radiation was in fact the largest higher-order effect for the
SLC and LEP I colliders. The soft-collinear and soft photon radiation
can indeed be resummed/exponentiated to all orders in perturbation
theory~\cite{Gribov:1972rt}, while higher orders in hard-collinear
photons have to be explicitly calculated order by
order~\cite{Kuraev:1985hb,Skrzypek:1990qs}. \whizard\ has an intrinsic
implementation of the lepton ISR structure function that includes all
orders of soft and soft-collinear photons as well as up to the third
order in hard-collinear photons. It can be switched on by the
following statement:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, E1 => isr
\end{Verbatim}
\end{footnotesize}
\end{quote}
As the ISR structure function is a single-beam structure function,
this expression is synonymous for
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, E1 => isr, isr
\end{Verbatim}
\end{footnotesize}
\end{quote}
The ISR structure function can again be applied to only one of the two
beams, e.g. in a HERA-like setup:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, p => isr, pdf_builtin
\end{Verbatim}
\end{footnotesize}
\end{quote}
Their are several options for the lepton-collider ISR structure
function that are summarized in the following:
\vspace{2mm}
\centerline{\begin{tabular}{|l|l|l|}\hline
Parameter & Default & Meaning \\\hline\hline
\ttt{isr\_alpha} & \ttt{0}/intrinsic & value of $\alpha_{QED}$ for ISR
\\\hline
\ttt{isr\_order} & \ttt{3} & max. order of hard-collinear photon
emission \\\hline
\ttt{isr\_mass} & \ttt{0}/intrinsic & mass of the radiating lepton \\\hline
\ttt{isr\_q\_max} & \ttt{0}/$\sqrt{s}$ & upper cutoff for ISR \\\hline
\hline
\ttt{?isr\_recoil} & \ttt{false} & flag to switch on recoil/$p_T$
(\emph{deprecated})\\\hline
\ttt{?isr\_keep\_energy} & \ttt{false} & recoil flag: conserve
energy in splitting (\emph{deprecated})
\\\hline
\end{tabular}}\mbox{}
The maximal order of the hard-collinear photon emission taken into
account by \whizard\ is set by the integer variable \ttt{isr\_order};
the default is the maximally available order of three. With the
variable \ttt{isr\_alpha}, the value of the QED coupling constant
$\alpha_{QED}$ used in the ISR structure function can be set. The
default is taken from the active physics model. The mass of the
radiating lepton (in most cases the electron) is set by
\ttt{isr\_mass}; again the default is taken from the active physics
model. Furthermore, the upper integration border for the ISR structure
function which acts roughly as an upper hardness cutoff for the emitted
photons, can be set through \ttt{isr\_q\_max}; if not set, the
collider energy (possibly after beamstrahlung,
cf. Sec.~\ref{sec:beamstrahlung}) $\sqrt{s}$ (or $\sqrt{\widehat{s}}$)
is taken. Note that \whizard\ accounts for the
exclusive effects of ISR radiation at the moment by a single (hard,
resolved) photon in the event; a more realistic treatment of exclusive
ISR photons in simulation is foreseen for a future version.
While the ISR structure function is evaluated in the collinear limit,
it is possible to generate transverse momentum for both the radiated
photons and the recoiling partonic system. We recommend to stick to
the collinear approximation for the integration step. Integration
cuts should be set up such that they do not significantly depend on
photon transverse momentum. In a subsequent simulation step, it is
possible to transform the events with collinear ISR radiation into
more realistic events with non-collinear radiation. To this end,
\whizard\ provides a separate ISR photon handler which can be
activated in the simulation step. The algorithm operates on the
partonic event: it takes the radiated photons and the partons entering
the hard process, and applies a $p_T$ distribution to those particles
and their interaction products, i.e., all outgoing particles. Cuts
that depend on photon $p_T$ may be applied to the modified events.
For details on the ISR photon handler,
cf.\ Sec.~\ref{sec:isr-photon-handler}.
{\footnotesize The flag \ttt{?isr\_recoil} switches on $p_T$ recoil of
the emitting lepton against photon radiation during integration; per
default it is off. The flag \ttt{?isr\_keep\_energy} controls the
mode of on-shell projection for the splitting process with $p_T$.
Note that this feature is kept for backwards compatibility, but
should not be used for new simulations. The reason is as follows:
For a fraction of events, $p_T$ will become significant, and (i)
energy/momentum non-conservation, applied to both beams separately,
can lead to unexpected and unphysical effects, and (ii) the modified
momenta enter the hard process, so the collinear approximation used
in the ISR structure function computation does not hold. }
%%%%%%%%%%%%%%%
\subsection{Lepton Collider Beamstrahlung}
\label{sec:beamstrahlung}
At linear lepton colliders, the macroscopic electromagnetic
interaction of the bunches leads to a distortion of the spectrum of
the bunches that is important for an exact simulation of the beam
spectrum. There are several methods to account for these effects. The
most important tool to simulate classical beam-beam interactions in
lepton-collider physics is
\ttt{GuineaPig++}~\cite{Schulte:1998au,Schulte:1999tx,Schulte:2007zz}. A
direct interface between this tool \ttt{GuineaPig++} and \whizard\ had
existed as an inofficial add-on to the legacy branch \whizard\ttt{1},
but is no longer applicable in \whizard\ttt{2}. A \whizard-internal
interface is foreseen for the very near future, most probably within
this v2.2 release. Other options are to use parameterizations of the
beam spectrum that have been included in the package \circeone~\cite{CIRCE}
which has been interfaced to \whizard\ since version v1.20 and been
included in the \whizard\ttt{2} release series. Another option is to
generate a beam spectrum externally and then read it in as an ASCII
data file, cf. Sec.~\ref{sec:beamevents}. More about this can be found
in a dedicated section on lepton collider spectra,
Sec.~\ref{sec:beamspectra}.
In this section, we discuss the usage of beamstrahlung spectra by
means of the \circeone\ package. The beamstrahlung spectra are
true spectra, so they have to be applied to pairs of beams, and an
application to only one beam is meaningless. They are switched on by
this \ttt{beams} statement including structure functions:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, E1 => circe1
\end{Verbatim}
\end{footnotesize}
\end{quote}
It is important to note that the parameterization of the beamstrahlung
spectra within \circeone\ contain also processes where $e\to\gamma$
conversions have been taking place, i.e. also hard processes with one
(or two) initial photons can be simulated with beamstrahlung switched
on. In that case, the explicit photon flags, \ttt{?circe1\_photon1}
and \ttt{?circe1\_photon2}, for the two beams have to be properly set,
e.g. (ordering in the final state does not play a role):
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
process proc1 = A, e1 => A, e1
sqrts = 500 GeV
beams = e1, E1 => circe1
?circe1_photon1 = true
integrate (proc1)
process proc2 = e1, A => A, e1
sqrts = 1000 GeV
beams = e1, A => circe1
?circe1_photon2 = true
\end{Verbatim}
\end{footnotesize}
\end{quote}
or
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
process proc1 = A, A => Wp, Wm
sqrts = 200 GeV
beams = e1, E1 => circe1
?circe1_photon1 = true
?circe1_photon2 = true
?circe1_generate = false
\end{Verbatim}
\end{footnotesize}
\end{quote}
In all cases (one or both beams with photon conversion) the beam
spectrum applies to both beams simultaneously.
In the last example ($\gamma\gamma\to W^+W^-$) the default
\circeone\ generator mode was turned off by unsetting
\verb|?circe1_generate|. In the other examples this flag is
set, by default. For standard use cases,
\circeone\ implements a beam-event generator inside the
\whizard\ generator, which provides beam-event samples with correctly
distributed probability. For electrons, the beamstrahlung spectrum
sharply peaks near maximum energy. This distribution is most
efficiently handled by the generator mode. By contrast, in the $\gamma\gamma$
mode, the beam-event c.m.\ energy is concentrated at low values. For
final states with low invariant mass, which are typically produced by
beamstrahlung photons, the generator mode is appropriate.
However, the $W^+W^-$ system requires substantial energy, and such
events will be very rare in the beam-event sample. Switching off the
\circeone\ generator mode solves this
problem.
This is an overview over all options and flags for the \circeone\
setup for lepton collider beamstrahlung:
\vspace{2mm}
\centerline{\begin{tabular}{|l|l|l|}\hline
Parameter & Default & Meaning \\\hline\hline
\ttt{?circe1\_photon1} & \ttt{false} & $e\to\gamma$ conversion for beam 1
\\\hline
\ttt{?circe1\_photon2} & \ttt{false} & $e\to\gamma$ conversion for beam 2
\\\hline
\ttt{circe1\_sqrts} & $\sqrt{s}$ & collider energy for the beam spectrum \\\hline
\ttt{?circe1\_generate} & \ttt{true} & flag for the \circeone\ generator mode \\\hline
\ttt{?circe1\_map} & \ttt{true} & flag to apply special phase-space mapping
\\\hline
\ttt{circe1\_mapping\_slope} & \ttt{2.} & value of PS mapping exponent
\\\hline
\ttt{circe1\_eps} & \ttt{1E-5} & parameter for mapping of spectrum peak
position \\\hline
\ttt{circe1\_ver} & \ttt{0} & internal version of \circeone\ package
\\\hline
\ttt{circe1\_rev} & \ttt{0}/most recent & internal revision of
\circeone\ \\\hline
\ttt{\$circe1\_acc} & \ttt{SBAND} & accelerator type \\\hline
\ttt{circe1\_chat} & \ttt{0} & chattiness/verbosity of \circeone \\\hline
\end{tabular}}\mbox{}
The collider energy relevant for the beamstrahlung spectrum is set by
\ttt{circe1\_sqrts}. As a default, this is always the value of
\ttt{sqrts} set in the \sindarin\ script. However, sometimes these
values do not match, e.g. the user wants to simulate $t\bar t h$ at
\ttt{sqrts = 550 GeV}, but the only available beam spectrum is for 500
GeV. In that case, \ttt{circe1\_sqrts = 500 GeV} has to be set to use
the closest possible available beam spectrum.
As mentioned in the discussion of the examples above, in
\circeone\ there are two options to use the beam spectra for
beamstrahlung: intrinsic semi-analytic approximation formulae for the
spectra, or a Monte-Carlo sampling of the sampling. The second
possibility always give a better description of the spectra, and is
the default for \whizard. It can, however, be switched off by setting
the flag \ttt{?circe1\_generate} to \ttt{false}.
As the beamstrahlung spectra are sharply peaked at the collider
energy, but still having long tails, a mapping of the spectra for an
efficient phase-space sampling is almost mandatory. This is the
default in \whizard, which can be changed by the flag
\ttt{?circe1\_map}. Also, the default exponent for the mapping can be
changed from its default value \ttt{2.} with the variable
\ttt{circe1\_mapping\_slope}. It is important to efficiently sample
the peak position of the spectrum; the effective ratio of the peak to
the whole sampling interval can be set by the parameter
\ttt{circe1\_eps}. The integer parameter \ttt{circe1\_chat} sets the
chattiness or verbosity of the \circeone\ package, i.e. how many
messages and warnings from the beamstrahlung generation/sampling will
be issued.
The actual internal version and revision of the \circeone\ package are
set by the two integer parameters \ttt{circe1\_ver} and
\ttt{circe1\_rev}. The default is in any case always the newest
version and revision, while older versions are still kept for
backwards compatibility and regression testing.
Finally, the geometry and design of the accelerator type is set with
the string variable \ttt{\$circe1\_acc}: it contains the possible
options for the old \ttt{"SBAND"} and \ttt{"XBAND"} setups, as well as
the \ttt{"TESLA"} and JLC/NLC SLAC design \ttt{"JLCNLC"}. The setups
for the most important energies of the ILC as they are summarized in
the ILC
TDR~\cite{Behnke:2013xla,Baer:2013cma,Adolphsen:2013jya,Adolphsen:2013kya}
are available as \ttt{ILC}. Beam spectra for the
CLIC~\cite{Aicheler:2012bya,Lebrun:2012hj,Linssen:2012hp} linear
collider are much more demanding to correctly simulate (due to the
drive beam concept; only the low-energy modes where the drive beam is
off can be simulated with the same setup as the abovementioned
machines). Their setup will be supported soon in one of the upcoming
\whizard\ versions within the \circetwo\ package.
An example of how to generate beamstrahlung spectra with the help of
the package \circetwo\ (that is also a part of \whizard) is this:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
process eemm = e1, E1 => e2, E2
sqrts = 500 GeV
beams = e1, E1 => circe2
$circe2_file = "ilc500.circe"
$circe2_design = "ILC"
?circe_polarized = false
\end{Verbatim}
\end{footnotesize}%$
\end{quote}
Here, the ILC design is used for a beamstrahlung spectrum at 500 GeV
nominal energy, with polarization averaged (hence, the setting of
polarization to \ttt{false}). A list of all available options can be
found in Sec.~\ref{sec:photoncoll}.
More technical details about the simulation of beamstrahlung spectra
see the documented source code of the \circeone\ package, as well as
Chap.~\ref{chap:hardint}. In the next section, we discuss how to read
in beam spectra from external files.
%%%%%%%%%%%%%%%
\subsection{Beam events}
\label{sec:beamevents}
As mentioned in the previous section, beamstrahlung is one of the
crucial ingredients for a realistic simulation of linear lepton
colliders. One option is to take a pre-generated beam spectrum for
such a machine, and make it available for simulation within \whizard\
as an external ASCII data file. Such files basically contain only
pairs of energy fractions of the nominal collider energy $\sqrt{s}$
($x$ values). In \whizard\ they can be used in simulation with the
following \ttt{beams} statement:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, E1 => beam_events
$beam_events_file = "<beam_spectrum_file>"
\end{Verbatim}
\end{footnotesize}%$
\end{quote}
Note that beam spectra must always be pair spectra, i.e. they are
automatically applied to both beam simultaneously.
Beam spectra via external files are expected to reside in the current
working directory. Alternatively, \whizard\ searches for them in the
install directory of \whizard\ in \ttt{share/beam-sim}. There you can
find an example file, \ttt{uniform\_spread\_2.5\%.dat} for such a beam
spectrum. The only possible parameter that can be set is the flag
\ttt{?beam\_events\_warn\_eof} whose default is \ttt{true}. This
triggers the issuing of a warning when the end of file of an external
beam spectrum file is reached. In such a case, \whizard\ starts to
reuse the same file again from the beginning. If the available data
points in the beam events file are not big enough, this could result
in an insufficient sampling of the beam spectrum.
%%%%%%%%%%%%%%%
\subsection{Gaussian beam-energy spread}
\label{sec:gaussian}
Real beams have a small energy spread. If beamstrahlung is small, the spread
may be approximately described as Gaussian. As a replacement for the full
simulation that underlies \ttt{CIRCE2} spectra, it is possible to
impose a Gaussian distributed beam energy, separately for each beam.
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, E1 => gaussian
gaussian_spread_1 = 0.1\%
gaussian_spread_2 = 0.2\%
\end{Verbatim}
\end{footnotesize}%$
\end{quote}
(Note that the \% sign means multiplication by 0.01, as it should.) The
spread values are defined as the $\sigma$ value of the Gaussian distribution,
i.e., $2/3$ of the events are within $\pm 1\sigma$ for each beam,
respectively.
%%%%%%%%%%%%%%%%
\subsection{Equivalent photon approximation}
\label{sec:epa}
The equivalent photon approximation (EPA) uses an on-shell approximation for
the $e \to e\gamma$ collinear splitting to allow the simulation of
photon-induced backgrounds in lepton collider physics. The original
concept is that of the Weizs\"acker-Williams
approximation~\cite{vonWeizsacker:1934sx,Williams:1934ad,Budnev:1974de}. This
is a single-beam structure
function that can be applied to both beams, or also to one beam
only. Examples are:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, E1 => epa
\end{Verbatim}
\end{footnotesize}
\end{quote}
or for a single beam:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, p => epa, pdf_builtin
\end{Verbatim}
\end{footnotesize}
\end{quote}
The last process allows the reaction of (quasi-) on-shell photons with
protons.
In the following, we collect the parameters and flags that can be
adjusted when using the EPA inside \whizard:
\vspace{2mm}
\centerline{\begin{tabular}{|l|l|l|}\hline
Parameter & Default & Meaning \\\hline\hline
\ttt{epa\_alpha} & \ttt{0}/intrinsic & value of $\alpha_{QED}$ for EPA
\\\hline
\ttt{epa\_x\_min} & \ttt{0.} & soft photon cutoff in $x$ (mandatory)
\\\hline
\ttt{epa\_q\_min} & \ttt{0.} & minimal $\gamma$ momentum transfer \\\hline
\ttt{epa\_mass} & \ttt{0}/intrinsic & mass of the radiating fermion (mandatory) \\\hline
\ttt{epa\_q\_max} & \ttt{0}/$\sqrt{s}$ & upper cutoff for EPA \\\hline
\ttt{?epa\_recoil} & \ttt{false} & flag to switch on recoil/$p_T$
\\\hline
\ttt{?epa\_keep\_energy} & \ttt{false} & recoil flag to conserve
energy in splitting
\\\hline
\end{tabular}}\mbox{}
The adjustable parameters are partially similar to the parameters in
the QED initial-state radiation (ISR), cf. Sec.~\ref{sec:lepton_isr}:
the parameter \ttt{epa\_alpha} sets the value of the electromagnetic
coupling constant, $\alpha_{QED}$ used in the EPA structure
function. If not set, this is taken from the value inside the active
physics model. The same is true for the mass of the particle that
radiates the photon of the hard interaction, which can be reset by the
user with the variable \ttt{epa\_mass}. There are two dimensionful
scale parameters, the minimal momentum transfer to the photon,
\ttt{epa\_q\_min}, which must not be zero, and the upper momentum-transfer
cutoff
for the EPA structure function, \ttt{epa\_q\_max}. The default for the
latter value is the collider energy, $\sqrt{s}$, or the energy reduced
by another structure function like e.g. beamstrahlung,
$\sqrt{\hat{s}}$. Furthermore, there is a soft-photon regulator for
the splitting function in $x$ space, \ttt{epa\_x\_min}, which also has
to be explicitly set different from zero. Hence, a minimal viable
scenario that will be accepted by \whizard\ looks like this:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
beams = e1, E1 => epa
epa_q_min = 5 GeV
epa_x_min = 0.01
\end{Verbatim}
\end{footnotesize}
\end{quote}
Finally, like the ISR case in Sec.~\ref{sec:lepton_isr}, there is a
flag to consider the recoil of the photon against the radiating
electron by setting \ttt{?epa\_recoil} to \ttt{true} (default:
\ttt{false}).
Though in principle processes like $e^+ e^- \to e^+ e^- \gamma \gamma$
where the two photons have been created almost collinearly and then
initiate a hard process could be described by exact matrix elements
and exact kinematics. However, the numerical stability in the very far
collinear kinematics is rather challenging, such that the use of the
EPA is very often an acceptable trade-off between quality of the
description on the one hand and numerical stability and speed on the
other hand.
In the case, the EPA is set after a second structure function like a
hadron collider PDF, there is a flavor summation over the quark
constituents inside the proton, which are then the radiating fermions
for the EPA. Here, the masses of all fermions have to be identical.
More about the physics of the equivalent photon approximation can be
found in Chap.~\ref{chap:hardint}.
%%%%%%%%%%%%%%%
\subsection{Effective $W$ approximation}
\label{sec:ewa}
An approach similar to the equivalent photon approximation (EPA)
discussed in the previous section Sec.~\ref{sec:epa}, is the usage
of a collinear splitting function for the radiation of massive
electroweak vector bosons $W$/$Z$, the effective $W$ approximation
(EWA). It has been developed for the
description of high-energy weak vector-boson fusion and scattering
processes at hadron colliders, particularly the Superconducting
Super-Collider (SSC). This was at a time when the simulation of $2\to
4$ processes war still very challenging and $2\to 6$ processes almost
impossible, such that this approximation was the only viable solution
for the simulation of processes like $pp \to jjVV$ and subsequent
decays of the bosons $V \equiv W, Z$.
Unlike the EPA, the EWA is much more involved as the structure
functions do depend on the isospin of the radiating fermions, and are
also different for transversal and longitudinal polarizations. Also, a
truely collinear kinematics is never possible due to the finite $W$
and $Z$ boson masses, which start becoming more and more negligible
for energies larger than the nominal LHC energy of 14 TeV.
Though in principle all processes for which the EWA might be
applicable are technically feasible in \whizard\ to be generated also
via full matrix elements, the EWA has been implemented in \whizard\
for testing purposes, backwards compatibility and comparison with
older simulations. Like the EPA, it is a single-beam structure
function that can be applied to one or both beams. We only give an
example for both beams here, this is for a 3 TeV CLIC collider:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
sqrts = 3 TeV
beams = e1, E1 => ewa
\end{Verbatim}
\end{footnotesize}
\end{quote}
And this is for LHC or a higher-energy follow-up collider (which also
shows the concatenation of the single-beam structure functions,
applied to both beams consecutively,
cf. Sec.~\ref{sec:concatenation}:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
sqrts = 14 TeV
beams = p, p => pdf_builtin => ewa
\end{Verbatim}
\end{footnotesize}
\end{quote}
Again, we list all the options, parameters and flags that can be
adapted for the EWA:
\vspace{2mm}
\centerline{\begin{tabular}{|l|l|l|}\hline
Parameter & Default & Meaning \\\hline\hline
\ttt{ewa\_x\_min} & \ttt{0.} & soft $W$/$Z$ cutoff in $x$ (mandatory)
\\\hline
\ttt{ewa\_mass} & \ttt{0}/intrinsic & mass of the radiating fermion \\\hline
\ttt{ewa\_pt\_max} & \ttt{0}/$\sqrt{\hat{s}}$ & upper cutoff for EWA \\\hline
\ttt{?ewa\_recoil} & \ttt{false} & recoil switch
\\\hline
\ttt{?ewa\_keep\_energy} & \ttt{false} & energy conservation for
recoil in splitting
\\\hline
\end{tabular}}\mbox{}
First of all, all coupling constants are taken from the active physics
model as they have to be consistent with electroweak gauge
invariance. Like for EPA, there is a soft $x$ cutoff for the $f \to f
V$ splitting, \ttt{ewa\_x\_min}, that has to be set different from
zero by the user. Again, the mass of the radiating fermion can be set
explicitly by the user; and, also again, the masses for the flavor sum
of quarks after a PDF as radiators of the electroweak bosons have to
be identical. Also for the EWA, there is an upper cutoff for the $p_T$
of the electroweak boson, that can be set via
\ttt{eta\_pt\_max}. Indeed, the transversal $W$/$Z$ structure function
is logarithmically divergent in that variable. If it is not set by the
user, it is estimated from $\sqrt{s}$ and the splitting kinematics.
For the EWA, there is a flag to switch on a recoil for the
electroweak boson against the radiating fermion,
\ttt{?ewa\_recoil}. Note that this is an experimental feature that is
not completely tested. In any case, the non-collinear kinematics
violates 4-four momentum conservation, so there are two choices:
either to conserve the energy (\ttt{?ewa\_keep\_energy = true}) or to
conserve 3-momentum (\ttt{?ewa\_keep\_energy = false}). Momentum
conservation for the kinematics is the default. This is due to the
fact that for energy conservation, there will be a net total momentum
in the event including the beam remnants (ISR/EPA/EWA radiated
particles) that leeds to unexpected or unphysical features in the
energy distributions of the beam remnants recoiling against the rest
of the event.
More details about the physics can be found in
Chap.~\ref{chap:hardint}.
%%%%%%%%%%%%%%%
\subsection{Energy scans using structure functions}
In \whizard, there is an implementation of a pair spectrum,
\ttt{energy\_scan}, that allows to scan the energy dependence of a
cross section without actually scanning over the collider
energies. Instead, only a single integration at the upper end of the
scan interval over the process with an additional pair spectrum
structure function performed. The structure function is chosen
in such a way, that the distribution of $x$ values of the energy scan
pair spectrum translates in a plot over the energy of the final state
in an energy scan from \ttt{0} to \ttt{sqrts} for the process under
consideration.
The simplest example is the $1/s$ fall-off with the $Z$ resonance in
$e^+e^- \to \mu^+ \mu^-$, where the syntax is very easy:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
process eemm = e1, E1 => e2, E2
sqrts = 500 GeV
cuts = sqrts_hat > 50
beams = e1, E1 => energy_scan
integrate (eemm)
\end{Verbatim}
\end{footnotesize}
\end{quote}
The value of \ttt{sqrts = 500 GeV} gives the upper limit for the scan,
while the cut effectively let the scan start at 50 GeV. There are no
adjustable parameters for this structure function. How to plot the
invariant mass distribution of the final-state muon pair to show the
energy scan over the cross section, will be explained in
Sec.~\ref{sec:analysis}.
More details can be found in Chap.~\ref{chap:hardint}.
%%%%%%%%%%%%%%%
\subsection{Photon collider spectra}
\label{sec:photoncoll}
One option that has been discussed as an alternative possibility for a
high-energy linear lepton collider is to convert the electron and
positron beam via Compton backscattering off intense laser beams into
photon
beams~\cite{Ginzburg:1981vm,Telnov:1989sd,Telnov:1995hc}. Naturally,
due to the production
of the photon beams and the inherent electron spectrum, the photon
beams have a characteristic spectrum. The simulation of such spectra
is possible within \whizard\ by means of the subpackage \circetwo,
which have been mentioned already in Sec.~\ref{sec:beamstrahlung}. It
allows to give a much more elaborate description of a linear lepton
collider environment than
\circeone\ (which, however, is not in all cases necessary, as the ILC
beamspectra for electron/positrons can be perfectly well described
with \circeone).
Here is a typical photon collider setup where we take a
photon-initiated process:
\begin{quote}
\begin{footnotesize}
\begin{Verbatim}
process aaww = A, A => Wp, Wm
beams = A, A => circe2
$circe2_file = "teslagg_500_polavg.circe"
$circe2_design = "TESLA/GG"
?circe2_polarized = false
\end{Verbatim}
\end{footnotesize}%$
\end{quote}
Here, the photons are the initial states initiating the hard
scattering. The structure function is \ttt{circe2} which always is a
pair spectrum. The list of available options are:
\vspace{2mm}
\centerline{\begin{tabular}{|l|l|l|}\hline
Parameter & Default & Meaning \\\hline\hline
\ttt{?circe2\_polarized} & \ttt{true} & spectrum respects polarization info
\\\hline
\ttt{\$circe2\_file} & -- & name of beam spectrum data file
\\\hline
\ttt{\$circe2\_design} & \ttt{"*"} & collider design
\\\hline
\end{tabular}}\mbox{}
The only logical flag \ttt{?circe2\_polarized} let \whizard\ know
whether it should keep polarization information in the beam spectra or
average over polarizations. Naturally, because of the Compton
backscattering generation of the photons, photon spectra are always
polarized. The collider design can be specified by the string variable
\ttt{\$circe2\_design}, where the default setting \ttt{"*"}
corresponds to the default of \circetwo\ (which is the TESLA 500 GeV
machine as discussed in the TESLA Technical Design
Report~\cite{AguilarSaavedra:2001rg,Richard:2001qm}). Note that up to
now there have not been any setups for a photon collider option for
the modern linear collider concepts like ILC and CLIC. The string
variable \ttt{\$circe2\_file} then allows to give the name of the file
containing the actual beam spectrum; all files that ship with
\whizard\ are stored in the directory \ttt{circe2/share/data}.
More details about the subpackage \circetwo\ and the physics it
covers, can be found in its own manual and the chapter
Chap.~\ref{chap:hardint}.
%%%%%%%%%%%%%%%
\subsection{Concatenation of several structure functions}
\label{sec:concatenation}
As has been shown already in Sec.~\ref{sec:epa} and
Sec.~\ref{sec:ewa}, it is possible within \whizard\ to concatenate
more than one structure function, irrespective of the fact, whether
the structure functions are single-beam structure functions or pair
spectra. One important thing is whether there is a phase-space mapping
for these structure functions. Also, there are some combinations which
do not make sense from the physics point of view, for example using
lepton-collider ISR for protons, and then afterwards switching on
PDFs. Such combinations will be vetoed by \whizard, and you will find
an error message like (cf. also Sec.~\ref{sec:errors}):
\begin{interaction}
******************************************************************************
******************************************************************************
*** FATAL ERROR: Beam structure: [....] not supported
******************************************************************************
******************************************************************************
\end{interaction}
Common examples for the concatenation of structure functions are
linear collider applications, where beamstrahlung (macroscopic
electromagnetic beam-beam interactions) and electron QED initial-state
radiation are both switched on:
\begin{code}
beams = e1, E1 => circe1 => isr
\end{code}
Another possibility is the simulation of photon-induced backgrounds at
ILC or CLIC, using beamstrahlung and equivalent photon approximation
(EPA):
\begin{code}
beams = e1, E1 => circe1 => epa
\end{code}
or with beam events from a data file:
\begin{code}
beams = e1, E1 => beam_events => isr
\end{code}
In hadron collider physics, parton distribution functions (PDFs) are
basically always switched on, while afterwards the user could specify
to use the effective $W$ approximation (EWA) to simulate high-energy
vector boson scattering:
\begin{code}
sqrts = 100 TeV
beams = p, p => pdf_builtin => ewa
\end{code}
Note that this last case involves a flavor sum over the five active
quark (and anti-quark) species $u$, $d$, $c$, $s$, $b$ in the proton,
all of which act as radiators for the electroweak vector bosons in the
EWA.
This would be an example with three structure functions:
\begin{code}
beams = e1, E1 => circe1 => isr => epa
\end{code}
%%%%%%%%%%%%%%%
\section{Polarization}
\label{sec:polarization}
%%%%%
\subsection{Initial state polarization}
\label{sec:initialpolarization}
\whizard\ supports polarizing the inital state fully or partially by
assigning a nontrivial density matrix in helicity space.
Initial state polarization requires a beam setup and is initialized by
means of the \ttt{beams\_pol\_density} statement\footnote{Note that
the syntax for the specification of beam polarization has changed
from version v2.1 to v2.2 and is incompatible between the two
release series. The old syntax \ttt{beam\_polarization} with its
different polarization constructors has been discarded in favor of a
unified syntax.}:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams_pol_density = @([<spin entries>]), @([<spin entries>])
\end{verbatim}
\end{footnotesize}
\end{quote}
The command \ttt{beams\_pol\_fraction} gives the degree of
polarization of the two beams:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams_pol_fraction = <degree beam 1>, <degree beam 2>
\end{verbatim}
\end{footnotesize}
\end{quote}
Both commands in the form written above apply to scattering processes,
where the polarization of both beams must be specified. The
\ttt{beams\_pol\_density} and \ttt{beams\_pol\_fraction} are possible
with a single beam declaration if a decay process is considered, but
only then.
While the syntax for the command \ttt{beams\_pol\_fraction} is pretty
obvious, the syntax for the actual specification of the beam
polarization is more intricate. We start with the polarization
fraction: for each beam there is a real number between zero
(unpolarized) and one (complete polarization) that can be specified
either as a floating point number like \ttt{0.4} or with a percentage:
\ttt{40 \%}. Note that the actual arithmetics is sometimes
counterintuitive: 80 \% left-handed electron polarization means that
80 \% of the electron beam are polarized, 20 \% are unpolarized,
i.e. 20 \% have half left- and half right-handed polarization
each. Hence, 90 \% of the electron beam is left-handed, 10 \% is
right-handed.
How does the specification of the polarization work? If there are no
entries at all in the polarization constructor, \ttt{@()}, the beam is
unpolarized, and the spin density matrix is proportional to the
unit/identity matrix. Placing entries into the \ttt{@()} constructor
follows the concept of sparse matrices, i.e. the entries that have
been specified will be present, while the rest remains zero. Single
numbers do specify entries for that particular helicity on the main
diagonal of the spin density matrix, e.g. for an electron \ttt{@(-1)}
means (100\%) left-handed polarization. Different entries are
separated by commas: \ttt{@(1,-1)} sets the two diagonal entries at
positions $(1,1)$ and $(-1,-1)$ in the density matrix both equal to
one. Two remarks are in order
already here. First, note that you do not have to worry about the
correct normalization of the spin density matrix, \whizard\ is taking
care of this automatically. Second, in the screen output for the beam
data, only those entries of the spin density matrix that have been
specified by the user, will be displayed. If a
\ttt{beams\_pol\_fraction} statement appears, other components will be
non-zero, but might not be shown. E.g. ILC-like, 80 \% polarization of
the electrons, 30 \% positron polarization will be specified like this
for left-handed electrons and right-handed positrons:
\begin{code}
beams = e1, E1
beams_pol_density = @(-1), @(+1)
beams_pol_fraction = 80%, 30%
\end{code}
The screen output will be like this:
\begin{code}
| ------------------------------------------------------------------------
| Beam structure: e-, e+
| polarization (beam 1):
| @(-1: -1: ( 1.000000000000E+00, 0.000000000000E+00))
| polarization (beam 2):
| @(+1: +1: ( 1.000000000000E+00, 0.000000000000E+00))
| polarization degree = 0.8000000, 0.3000000
| Beam data (collision):
| e- (mass = 0.0000000E+00 GeV) polarized
| e+ (mass = 0.0000000E+00 GeV) polarized
\end{code}
But because of the fraction of unpolarized electrons and positrons,
the spin density matrices for electrons and positrons are:
\[
\rho(e^-) = \diag \left ( 0.10, 0.90 \right) \qquad
\rho(e^+) = \diag \left ( 0.65, 0.35 \right) \quad ,
\]
respectively. So, in general, only the entries due to the polarized
fraction will be displayed on screen. We will come back to more
examples below.
Again, the setting of a single entry, e.g. \ttt{@($\pm m$)}, which
always sets the diagonal component $(\pm m, \pm m)$ of the spin
density matrix equal to one. Here $m$ can have the following values
for the different spins (in parentheses are entries that exist only
for massive particles):
\vspace{1mm}
\begin{center}
\begin{tabular}{|l|l|l|}\hline
Spin $j$ & Particle type & possible $m$ values \\\hline
0 & Scalar boson & 0 \\
1/2 & Spinor & +1, -1 \\
1 & (Massive) Vector boson & +1, (0), -1 \\
3/2 & (Massive) Vectorspinor & +2, (+1), (-1), -2 \\
2 & (Massive) Tensor & +2, (+1), (0), (-1), -2
\\\hline
\end{tabular}
\end{center}
\vspace{1mm}
Off-diagonal entries that are equal to one (up to the normalization)
of the spin-density matrix can be specified simply by the position,
namely: \ttt{@($m$:$m'$, $m''$)}. This would result in a spin density
matrix with diagonal entry $1$ for the position $(m'', m'')$, and an entry
of $1$ for the off-diagonal position $(m,m')$.
Furthermore, entries in the density matrix different from $1$ with a
numerical value \ttt{{\em <val>}} can be
specified, separated by another colon: \ttt{@($m$:$m'$:{\em
<val>})}. Here, it does not matter whether $m$ and $m'$ are different
or not. For $m = m'$ also diagonal spin density matrix entries
different from one can be specified. Note that because spin density
matrices have to be Hermitian, only the entry $(m,m')$ has to be set,
while the complex conjugate entry at the transposed position $(m',m)$
is set automatically by \whizard.
We will give some general density
matrices now, and after that a few more definite examples. In the
general setups below, we always give the expression for the spin
density matrix only for one single beam.
%
{
\newcommand{\cssparse}[4]{%
\begin{pmatrix}
#1 & 0 & \cdots & \cdots & #3 \\
0 & 0 & \ddots & & 0 \\
\vdots & \ddots & \ddots & \ddots & \vdots \\
0 & & \ddots & 0 & 0 \\
#4 & \cdots & \cdots & 0 & #2
\end{pmatrix}%
}
%
\begin{itemize}
\item {\bf Unpolarized:}
\begin{center}
\begin{footnotesize}
\ttt{beams\_pol\_density = @()}
\end{footnotesize}
\end{center}
% \newline
This has the same effect as not specifying any
polarization at all and is the only constructor available for scalars and
fermions declared as left- or right-handed (like the neutrino). Density matrix:
\[ \rho = \frac{1}{|m|}\mathbb{I} \]
($|m|$: particle multiplicity which is 2 for massless, $2j + 1$ for massive particles).
%
\item {\bf Circular polarization:}
\begin{center}
\begin{footnotesize}
\ttt{beams\_pol\_density = @($\pm j$) \qquad beams\_pol\_fraction
= $f$}
\end{footnotesize}
\end{center}
A fraction $f$ (parameter range $f \in \left[0\;;\;1\right]$) of
the particles are in the maximum / minimum helicity eigenstate $\pm
j$, the remainder is unpolarized. For spin $\frac{1}{2}$ and massless
particles of spin $>0$, only the maximal / minimal entries of the
density matrix are populated, and the density matrix looks like this:
\[ \rho = \diag\left(\frac{1\pm f}{2}\;,\;0\;,\;\dots\;,\;0\;,
\frac{1\mp f}{2}\right) \]
%
\item {\bf Longitudinal polarization (massive):}
\begin{center}
\begin{footnotesize}
\ttt{beams\_pol\_density = @(0) \qquad beams\_pol\_fraction = $f$}
\end{footnotesize}
\end{center}
We consider massive particles with maximal spin component $j$, a
fraction $f$ of which having longitudinal polarization, the remainder
is unpolarized. Longitudinal polarization is (obviously) only
available for massive bosons of spin $>0$. Again, the parameter range
for the fraction is: $f \in \left[0\;;\;1\right]$. The density matrix
has the form:
\[ \rho = \diag\left(\frac{1-f}{|m|}\;,\;\dots\;,\;\frac{1-f}{|m|}\;,\;
\frac{1+f \left(|m| - 1\right)}{|m|}\;,\;\frac{1-f}{|m|}\;,
\;\dots\;,\;\frac{1-f}{|m|}\right)
\]
($|m| = 2j+1 $: particle multiplicity)
%
\item {\bf Transverse polarization (along an axis):}
\begin{center}
\begin{footnotesize}
\ttt{beams\_pol\_density = @(j, -j, j:-j:exp(-I*phi)) \qquad
beams\_pol\_fraction = $f$}
\end{footnotesize}
\end{center}
This so called transverse polarization is a polarization along an
arbitrary direction in the $x-y$ plane, with $\phi=0$ being the positive
$x$ direction and $\phi=90^\circ$ the positive $y$ direction. Note that
the value of \ttt{phi} has either to be set inside the beam
polarization expression explicitly or by a statement \ttt{real phi =
{\em val} degree} before. A fraction $f$ of the particles are
polarized, the remainder is unpolarized. Note that, although
this yields a valid density matrix for all particles with multiplicity
$>1$ (in which the only the highest and lowest helicity states are
populated), it is meaningful only for spin $\frac{1}{2}$ particles and
massless bosons of spin $>0$. The range of the parameters are:
$f \in \left[0\;;\;1\right]$ and $\phi \in \mathbb{R}$. This yields a
density matrix:
\[ \rho =
\cssparse{1}{1}
{\frac{f}{2}\,e^{-i\phi}} {\frac{f}{2}\,e^{i\phi}} \]
(for antiparticles, the matrix is conjugated).
%
\item {\bf Polarization along arbitrary axis $\left(\theta, \phi\right)$:}
\begin{center}
\begin{footnotesize}
\ttt{beams\_pol\_density = @(j:j:1-cos(theta),
j:-j:sin(theta)*exp(-I*phi), -j:-j:1+cos(theta))} \qquad\quad\qquad
\ttt{beams\_pol\_fraction = $f$}
\end{footnotesize}
\end{center}
This example describes polarization along an arbitrary axis in polar
coordinates (polar axis in positive $z$ direction, polar angle
$\theta$, azimuthal angle $\phi$). A fraction $f$ of the particles are
polarized, the remainder is unpolarized. Note that, although axis
polarization defines a valid density matrix for all particles with
multiplicity $>1$, it is meaningful only for particles with spin
$\frac{1}{2}$. Valid ranges for the parameters are $f \in
\left[0\;;\;1\right]$, $\theta \in \mathbb{R}$, $\phi \in
\mathbb{R}$. The density matrix then has the form:
\[ \rho = \frac{1}{2}\cdot
\cssparse{1 - f\cos\theta}{1 + f\cos\theta}
{f\sin\theta\, e^{-i\phi}}{f\sin\theta\, e^{i\phi}}
\]
%
\item {\bf Diagonal density matrix:}
\begin{center}
\begin{footnotesize}
\ttt{beams\_pol\_density = @(j:j:$h_j$, j-1:j-1:$h_{j-1}$,
$\ldots$, -j:-j:$h_{-j}$)}
\end{footnotesize}
\end{center}
This defines an arbitrary diagonal density matrix with entries
$\rho_{j,j}\,,\,\dots\,,\,\rho_{-j,-j}$.
%
\item {\bf Arbitrary density matrix:}
\begin{center}
\begin{footnotesize}
\ttt{beams\_pol\_density = @($\{m:m':x_{m,m'}\}$)}:
\end{footnotesize}
\end{center}
Here, \ttt{$\{m:m':x_{m,m'}\}$} denotes a selection of entries at
various positions somewhere in the spin density matrix. \whizard\
will check whether this is a valid spin density matrix, but it does
e.g. not have to correspond to a pure state.
%
\end{itemize}
}
%
The beam polarization statements can be used both globally directly
with the \ttt{beams} specification, or locally inside the
\ttt{integrate} or \ttt{simulate} command. Some more specific examples
are in order to show how initial state polarization works:
%
\begin{itemize}
\item
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = A, A
beams_pol_density = @(+1), @(1, -1, 1:-1:-I)
\end{verbatim}
\end{footnotesize}
\end{quote}
This declares the initial state to be composed of two incoming
photons, where the first photon is right-handed, and the second photon
has transverse polarization in $y$ direction.
%
\item
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = A, A
beams_pol_density = @(+1), @(1, -1, 1:-1:-1)
\end{verbatim}
\end{footnotesize}
\end{quote}
Same as before, but this time the second photon has transverse
polarization in $x$ direction.
%
\item
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = "W+"
beams_pol\_density = @(0)
\end{verbatim}
\end{footnotesize}
\end{quote}
This example sets up the decay of a longitudinal vector boson.
%
\item
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
beams = E1, e1
scan int hel_ep = (-1, 1) {
scan int hel_em = (-1, 1) {
beams_pol_density = @(hel_ep), @(hel_em)
integrate (eeww)
}
}
integrate (eeww)
\end{verbatim}
\end{footnotesize}
\end{quote}
This example loops over the different positron and electron helicity
combinations and calculates the respective integrals. The
\ttt{beams\_pol\_density} statement is local to the scan loop(s) and,
therefore, the last \ttt{integrate} calculates the unpolarized
integral.
\end{itemize}
%
Although beam polarization should be straightforward to use, some pitfalls exist
for the unwary:
\begin{itemize}
\item Once \ttt{beams\_pol\_density} is set globally, it persists and
is applied every time \ttt{beams} is executed (unless it is reset). In
particular, this means that code like
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
process wwaa = Wp, Wm => A, A
process zee = Z => e1, E1
sqrts = 200 GeV
beams_pol_density = @(1, -1, 1:-1:-1), @()
beams = Wp, Wm
integrate (wwaa)
beams = Z
integrate (zee)
beams_pol_density = @(0)
\end{verbatim}
\end{footnotesize}
\end{quote}
will throw an error, because \whizard\ complains that the spin density
matrix has the wrong dimensionality for the second (the decay) process.
This kind of trap can be avoided be using \ttt{beams\_pol\_density}
only locally in \ttt{integrate} or \ttt{simulate} statements.
%
\item On-the-fly integrations executed by \ttt{simulate}
use the beam
setup found at the point of execution. This implies that any polarization
settings you have previously done affect the result of the integration.
%
\item The \ttt{unstable} command also requires integrals of the selected decay
processes, and will compute them on-the-fly if they are unavailable. Here,
a polarized integral is not meaningful at all. Therefore, this command
ignores the current \ttt{beam} setting and issues a warning if a previous
polarized integral is available; this will be discarded.
\end{itemize}
\subsection{Final state polarization}
Final state polarization is available in \whizard\ in the sense that the
polarization of real final state particles can be retained when generating
simulated
events. In order for the polarization of a particle to be retained, it must be
declared as polarized via the \ttt{polarized} statement
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
polarized particle [, particle, ...]
\end{verbatim}
\end{footnotesize}
\end{quote}
The effect of \ttt{polarized} can be reversed with the \ttt{unpolarized}
statement which has the same syntax. For example,
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
polarized "W+", "W-", Z
\end{verbatim}
\end{footnotesize}
\end{quote}
will cause the polarization of all final state $W$ and $Z$ bosons to be
retained, while
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
unpolarized "W+", "W-", Z
\end{verbatim}
\end{footnotesize}
\end{quote}
will reverse the effect and cause the polarization to be summed over again. Note
that \ttt{polarized} and \ttt{unpolarized} are global statements which cannot be
used locally as command arguments and if you use them e.g. in a loop, the
effects will persist beyond the loop body. Also, a particle cannot be
\ttt{polarized} and \ttt{unstable} at the same time (this restriction
might be loosened in future versions of \whizard).
After toggling the polarization flag, the generation of polarized events can be
requested by using the \ttt{?polarized\_events} option of the \ttt{simulate}
command, e.g.
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
simulate (eeww) { ?polarized_events = true }
\end{verbatim}
\end{footnotesize}
\end{quote}
When \ttt{simulate} is run in this mode, helicity information for final state
particles that have been toggled as \ttt{polarized} is written to the event
file(s) (provided that polarization is supported by the selected event file
format(s) ) and can also be accessed in the analysis by means of the \ttt{Hel}
observable. For example, an analysis definition like
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
analysis =
if (all Hel == -1 ["W+"] and all Hel == -1 ["W-"] ) then
record cta_nn (eval cos (Theta) ["W+"]) endif;
if (all Hel == -1 ["W+"] and all Hel == 0 ["W-"] )
then record cta_nl (eval cos (Theta) ["W+"]) endif
\end{verbatim}
\end{footnotesize}
\end{quote}
can be used to histogram the angular distribution for the production of
polarized $W$ pairs (obviously, the example would have to be extended
to cover all possible helicity combinations). Note, however, that
helicity information is not available in the integration step;
therefore, it is not possible to use \ttt{Hel} as a cut observable.
While final state polarization is straightforward to use, there is a caveat when
used in combination with flavor products. If a particle in a flavor product is
defined as \ttt{polarized}, then all particles ``originating'' from the product will
act as if they had been declared as \ttt{polarized} --- their polarization will
be recorded in the generated events. E.g., the example
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
process test = u:d, ubar:dbar => d:u, dbar:ubar, u, ubar
! insert compilation, cuts and integration here
polarized d, dbar
simulate (test) {?polarized_events = true}
\end{verbatim}
\end{footnotesize}
\end{quote}
will generate events including helicity information for all final state $d$ and
$\overline{d}$ quarks, but only for part of the final state $u$ and $\overline{u}$
quarks. In this case, if you had wanted to keep the helicity information also
for all $u$ and $\overline{u}$, you would have had to explicitely include them
into the \ttt{polarized} statement.
\section{Cross sections}
Integrating matrix elements over phase space is the core of \whizard's
activities. For any process where we want the cross section, distributions,
or event samples, the cross section has to be determined first. This is done
by a doubly adaptive multi-channel Monte-Carlo integration. The integration,
in turn, requires a \emph{phase-space setup}, i.e., a collection of
phase-space \emph{channels}, which are mappings of the unit hypercube onto the
complete space of multi-particle kinematics. This phase-space information is
encoded in the file \emph{xxx}\ttt{.phs}, where \emph{xxx} is the process tag.
\whizard\ generates the phase-space file on the fly and can reuse it in later
integrations.
For each phase-space channel, the unit hypercube is binned in each dimension.
The bin boundaries are allowed to move during a sequence of iterations, each
with a fixed number of sampled phase-space points, so they adapt to the actual
phase-space density as far as possible. In addition to this \emph{intrinsic}
adaptation, the relative channel weights are also allowed to vary.
All these steps are done automatically when the \ttt{integrate} command is
executed. At the end of the iterative adaptation procedure, the program has
obtained an estimate for the integral of the matrix element over phase space,
together with an error estimate, and a set of integration \emph{grids} which
contains all information on channel weights and bin boundaries. This
information is stored in a file \emph{xxx}\ttt{.vg}, where \emph{xxx} is the
process tag, and is used for event generation by the \ttt{simulate}
command.
\subsection{Integration}
\label{sec:integrate}
Since everything can be handled automatically using default parameters, it
often suffices to write the command
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
integrate (proc1)
\end{verbatim}
\end{footnotesize}
\end{quote}
for integrating the process with name tag \ttt{proc1}, and similarly
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
integrate (proc1, proc2, proc3)
\end{verbatim}
\end{footnotesize}
\end{quote}
for integrating several processes consecutively. Options to the integrate
command are specified, if not globally, by a local option string
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
integrate (proc1, proc2, proc3) { mH = 200 GeV }
\end{verbatim}
\end{footnotesize}
\end{quote}
(It is possible to place a \ttt{beams} statement inside the option string, if
desired.)
If the process is configured but not compiled, compilation will be done
automatically. If it is not available at all, integration will fail.
The integration method can be specified by the string variable
\begin{quote}
\begin{footnotesize}
\ttt{\$integration\_method = "{\em <method>}"}
\end{footnotesize}
\end{quote} %$
The default method is called \ttt{"vamp"} and uses the \vamp\
algorithm and code. (At the moment, there is only a single simplistic
alternative, using the midpoint rule or rectangle method for
integration, \ttt{"midpoint"}. This is mainly for testing purposes. In
future versions of \whizard, more methods like e.g. Gauss integration
will be made available). \vamp, however, is clearly the main
integration method. It is done in several \emph{passes} (usually two),
and each pass consists of several \emph{iterations}. An iteration
consists of a definite number of \emph{calls} to the matrix-element
function.
For each iteration, \whizard\ computes an estimate of the integral and an
estimate of the error, based on the binned sums of matrix element values and
squares. It also computes an estimate of the rejection efficiency for
generating unweighted events, i.e., the ratio of the average sampling function
value over the maximum value of this function.
After each iteration, both the integration grids (the binnings) and the
relative weights of the integration channels can be adapted to
minimize the variance estimate of the integral. After each pass of several
iterations, \whizard\ computes an average of the iterations within the pass,
the corresponding error estimate, and a $\chi^2$ value. The integral, error,
efficiency and $\chi^2$ value computed for the most recent integration pass,
together with the most recent integration grid, are used for any subsequent
calculation that involves this process, in particular for event generation.
In the default setup, during the first pass(es) both grid binnings and channel
weights are adapted. In the final (usually second) pass, only binnings are
further adapted. Roughly speaking, the final pass is the actual calculation,
while the previous pass(es) are used for ``warming up'' the integration grids,
without using the numerical results. Below, in the section about the
specification of the iterations, Sec.~\ref{sec:iterations}, we will
explain how it is possible to change the behavior of adapting grids
and weights.
Here is an example of the integration output, which illustrates these
properties. The \sindarin\ script describes the process $e^+e^-\to q\bar q
q\bar q$ with $q$ being any light quark, i.e., $W^+W^-$ and $ZZ$ production
and hadronic decay together will any irreducible background. We cut on $p_T$
and energy of jets, and on the invariant mass of jet pairs. Here is the
script:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
alias q = d:u:s:c
alias Q = D:U:S:C
process proc_4f = e1, E1 => q, Q, q, Q
ms = 0 mc = 0
sqrts = 500 GeV
cuts = all (Pt > 10 GeV and E > 10 GeV) [q:Q]
and all M > 10 GeV [q:Q, q:Q]
integrate (proc_4f)
\end{verbatim}
\end{footnotesize}
\end{quote}
After the run is finished, the integration output looks like
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
| Process library 'default_lib': loading
| Process library 'default_lib': ... success.
| Integrate: compilation done
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 12511
| Initializing integration for process proc_4f:
| ------------------------------------------------------------------------
| Process [scattering]: 'proc_4f'
| Library name = 'default_lib'
| Process index = 1
| Process components:
| 1: 'proc_4f_i1': e-, e+ => d:u:s:c, dbar:ubar:sbar:cbar,
| d:u:s:c, dbar:ubar:sbar:cbar [omega]
| ------------------------------------------------------------------------
| 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 'proc_4f_i1.phs'
| Phase space: 123 channels, 8 dimensions
| Phase space: found 123 channels, collected in 15 groves.
| Phase space: Using 195 equivalences between channels.
| Phase space: wood
| Applying user-defined cuts.
| OpenMP: Using 8 threads
| Starting integration for process 'proc_4f'
| Integrate: iterations not specified, using default
| Integrate: iterations = 10:10000:"gw", 5:20000:""
| Integrator: 15 chains, 123 channels, 8 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 10000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 9963 2.3797857E+03 3.37E+02 14.15 14.13* 4.02
2 9887 2.8307603E+03 9.58E+01 3.39 3.37* 4.31
3 9815 3.0132091E+03 5.10E+01 1.69 1.68* 8.37
4 9754 2.9314937E+03 3.64E+01 1.24 1.23* 10.65
5 9704 2.9088284E+03 3.40E+01 1.17 1.15* 12.99
6 9639 2.9725788E+03 3.53E+01 1.19 1.17 15.34
7 9583 2.9812484E+03 3.10E+01 1.04 1.02* 17.97
8 9521 2.9295139E+03 2.88E+01 0.98 0.96* 22.27
9 9435 2.9749262E+03 2.94E+01 0.99 0.96 20.25
10 9376 2.9563369E+03 3.01E+01 1.02 0.99 21.10
|-----------------------------------------------------------------------------|
10 96677 2.9525019E+03 1.16E+01 0.39 1.22 21.10 1.15 10
|-----------------------------------------------------------------------------|
11 19945 2.9599072E+03 2.13E+01 0.72 1.02 15.03
12 19945 2.9367733E+03 1.99E+01 0.68 0.96* 12.68
13 19945 2.9487747E+03 2.03E+01 0.69 0.97 11.63
14 19945 2.9777794E+03 2.03E+01 0.68 0.96* 11.19
15 19945 2.9246612E+03 1.95E+01 0.67 0.94* 10.34
|-----------------------------------------------------------------------------|
15 99725 2.9488622E+03 9.04E+00 0.31 0.97 10.34 1.05 5
|=============================================================================|
| Time estimate for generating 10000 events: 0d:00h:00m:51s
| Creating integration history display proc_4f-history.ps and proc_4f-history.pdf
\end{verbatim}
\end{footnotesize}
\end{quote}
Each row shows the index of a single iteration, the number of matrix element
calls for that iteration, and the integral and error estimate. Note
that the number of calls displayed are the real calls to the matrix
elements after all cuts and possible rejections. The error
should be viewed as the $1\sigma$ uncertainty, computed on a statistical
\begin{figure}
\centering
\includegraphics[width=.56\textwidth]{proc_4f-history}
\caption{\label{fig:inthistory} Graphical output of the convergence
of the adaptation during the integration of a \whizard\ process.}
\end{figure}
basis. The next two columns display the error in percent, and the
\emph{accuracy} which is the same error normalized by $\sqrt{n_{\rm calls}}$.
The accuracy value has the property that it is independent of $n_{\rm calls}$,
it describes the quality of adaptation of the current grids. Good-quality
grids have a number of order one, the smaller the better. The next column is
the estimate for the rejection efficiency in percent. Here, the value should
be as high as possible, with $100\,\%$ being the possible maximum.
In the example, the grids are adapted over ten iterations, after which the
accuracy and efficiency have saturated at about $1.0$ and $10\,\%$,
respectively. The asterisk in the accuracy column marks those iterations
where an improvement over the previous iteration is seen. The average over
these iterations exhibits an accuracy of $1.22$, corresponding to $0.39\,\%$
error, and a $\chi^2$ value of $1.15$, which is just right:
apparently, the phase-space for this process and set of cuts is
well-behaved. The subsequent five iterations are used for obtaining
the final integral, which has an accuracy below one (error $0.3\,\%$),
while the efficiency settles at about
$10\,\%$. In this example, the final $\chi^2$ value happens to be quite
small, i.e., the individual results are closer together than the error
estimates would suggest. One should nevertheless not scale down the error,
but rather scale it up if the $\chi^2$ result happens to be much larger than
unity: this often indicates sub-optimally adapted grids, which insufficiently
map some corner of phase space.
One should note that all values are subject to statistical fluctuations, since
the number of calls within each iterations is finite. Typically, fluctuations
in the efficiency estimate are considerably larger than fluctuations in the
error/accuracy estimate. Two subsequent runs of the same script should yield
statistically independent results which may differ in all quantities, within
the error estimates, since the seed of the random-number generator will differ
by default.
It is possible to get exactly reproducible results by setting the
random-number seed explicitly, e.g.,
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
seed = 12345
\end{verbatim}
\end{footnotesize}
\end{quote}
at any point in the \sindarin\ script. \ttt{seed} is a predefined intrinsic
variable. The value can be any 32bit integer. Two runs with different seeds
can be safely taken as statistically independent. In the example
above, no seed has been set, and the seed has therefore been
determined internally by \whizard\ from the system clock.
The concluding line with the time estimate applies to a subsequent simulation
step with unweighted events, which is not actually requested in the current
example. It is based on the timing and efficiency estimate of the most recent
iteration.
As a default, a graphical output of the integration history will be
produced (if both \LaTeX\ and \metapost\ have been available during
configuration). Fig.~\ref{fig:inthistory} shows how this looks like,
and demonstrates how a proper convergence of the integral during the
adaptation looks like. The generation of these graphical history files
can be switched off using the command \ttt{?vis\_history = false}.
%%%%%
\subsection{Integration run IDs}
A single \sindarin\ script may contain multiple calls to the
\ttt{integrate} command with different parameters. By default,
files generated for the same process in a subsequent integration will
overwrite the previous ones. This is undesirable when the script is
re-run: all results that have been overwritten have to be recreated.
To avoid this, the user may identify a specific run by a string-valued
ID, e.g.
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
integrate (foo) { $run_id = "first" }
\end{verbatim}
\end{footnotesize}
\end{quote}
This ID will become part of the file name for all files that are
created specifically for this run. Often it is useful to create a run
ID from a numerical value using \ttt{sprintf}, e.g., in this scan:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
scan real mh = (100 => 200 /+ 10) {
$run_id = sprintf "%e" (mh)
integrate (h_production)
}
\end{verbatim}
\end{footnotesize}
\end{quote}
With unique run IDs, a subsequent run of the same \sindarin\ script
will be able to reuse all previous results, even if there is more than
a single integration per process.
\subsection{Controlling iterations}
\label{sec:iterations}
\whizard\ has some predefined numbers of iterations and calls for the first
and second integration pass, respectively, which depend on the number of
initial and final-state particles. They are guesses for values that yield
good-quality grids and error values in standard situations, where no
exceptionally strong peaks or loose cuts are present in the integrand.
Actually, the large number of warmup iterations in the previous example
indicates some safety margin in that respect.
It is possible, and often advisable, to adjust the iteration and call numbers
to the particular situation. One may reduce the default numbers to short-cut
the integration, if either less accuracy is needed, or CPU time is to be
saved. Otherwise, if convergence is bad, the number of iterations or calls
might be increased.
To set iterations manually, there is the \ttt{iterations} command:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
iterations = 5:50000, 3:100000
\end{verbatim}
\end{footnotesize}
\end{quote}
This is a comma-separated list. Each pair of values corresponds to an
integration pass. The value before the colon is the number of iterations for
this pass, the other number is the number of calls per iteration.
While the default number of passes is two (one for warmup, one for the final
result), you may specify a single pass
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
iterations = 5:100000
\end{verbatim}
\end{footnotesize}
\end{quote}
where the relative channel weights will \emph{not} be adjusted (because this
is the final pass). This is appropriate for well-behaved integrands where
weight adaptation is not necessary.
You can also define more than two passes. That might be useful when reusing a
previous grid file with insufficient quality: specify the previous passes
as-is, so the previous results will be read in, and then a new pass for
further adaptation.
In the final pass, the default behavior is to not adapt grids and
weights anymore. Otherwise, different iterations would be correlated,
and a final reliable error estimate would not be possible. For all but
the final passes, the user can decide whether to adapt grids and
weights by attaching a string specifier to the number of iterations:
\ttt{"g"} does adapt grids, but not weights, \ttt{"w"} the other way
round. \ttt{"gw"} or \ttt{"wg"} does adapt both. By the setting
\ttt{""}, all adaptations are switched off. An example looks like
this:
\begin{code}
iterations = 2:10000:"gw", 3:5000
\end{code}
Since it is often not known beforehand how many iterations the grid
adaptation will need, it is generally a good idea to give the first
pass a large number of iterations. However, in many cases these turn
out to be not necessary. To shortcut iterations, you can set any of
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
accuracy_goal
error_goal
relative_error_goal
\end{verbatim}
\end{footnotesize}
\end{quote}
to a positive value. If this is done, \whizard\ will skip warmup
iterations once all of the specified goals are reached by the current
iteration. The final iterations (without weight adaptation) are
always performed.
\subsection{Phase space}
Before \ttt{integrate} can start its work, it must have a phase-space
configuration for the process at hand. The method for the phase-space
parameterization is determined by the string variable
\ttt{\$phs\_method}. At the moment there are only two options,
\ttt{"single"}, for testing purposes, that is mainly used internally,
and \whizard's traditional method, \ttt{"wood"}. This parameterization
is particularly adapted and fine-tuned for electroweak processes and
might not be the ideal for for pure jet cross sections. In future
versions of \whizard, more options for phase-space parameterizations
will be made available, e.g. the \ttt{RAMBO} algorithm and its massive
cousin, and phase-space parameterizations that take care of the
dipole-like emission structure in collinear QCD (or QED) splittings.
For the standard method, the phase-space parameterization is laid out
in an ASCII file \ttt{\textit{<process-name>\_}i\textit{<comp>}.phs}.
Here, \ttt{{\em <process-name>}} is the process name chosen by the
user while \ttt{{\em <comp>}} is the number of the process component
of the corresponding process. This immediately shows that different
components of processes are getting different phase space setups. This
is necessary for inclusive processes, e.g. the sum of $pp \to Z + nj$
and $pp \to W + nj$, or in future versions of \whizard\ for NLO
processes, where one component is the interference between the virtual
and the Born matrix element, and another one is the subtraction terms.
Normally, you do not have to deal with this file, since \whizard\ will
generate one automatically if it does not find one. (\whizard\ is
careful to check for consistency of process definition and parameters
before using an existing file.)
Experts might find it useful to generate a phase-space file and inspect and/or
modify it before proceeding further. To this end, there is the parameter
\verb|?phs_only|. If you set this \ttt{true}, \whizard\ skips the actual
integration after the phase-space file has been generated. There is also a
parameter \verb|?vis_channels| which can be set independently; if this is
\ttt{true}, \whizard\ will generate a graphical visualization of the
phase-space parameterizations encoded in the phase-space file. This
file has to be taken with a grain of salt because phase space channels
are represented by sample Feynman diagrams for the corresponding
channel. This does however {\em not} mean that in the matrix element
other Feynman diagrams are missing (the default matrix element method,
\oMega, is not using Feynman-diagrammatic amplitudes at all).
Things might go wrong with the default phase-space generation, or manual
intervention might be necessary to improve later performance. There are a few
parameters that control the algorithm of phase-space generation. To
understand their meaning, you should realize that phase-space
parameterizations are modeled after (dominant) Feynman graphs for the current
process.
\subsubsection{The main phase space setup {\em wood}}
For the main phase-space parameterization of \whizard, which is called
\ttt{"wood"}, there are many different parameters and flags that allow
to tune and customize the phase-space setup for every certain process:
The parameter \verb|phs_off_shell| controls the number of off-shell lines in
those graphs, not counting $s$-channel resonances and logarithmically enhanced
$s$- and $t$-channel lines. The default value is $2$. Setting it to zero
will drop everything that is not resonant or logarithmically enhanced.
Increasing it will include more subdominant graphs. (\whizard\ increases the
value automatically if the default value does not work.)
There is a similar parameter \verb|phs_t_channel| which controls
multiperipheral graphs in the parameterizations. The default value is $6$, so
graphs with up to $6$ $t/u$-channel lines are considered. In particular
cases, such as $e^+e^-\to n\gamma$, all graphs are multiperipheral, and for
$n>7$ \whizard\ would find no parameterizations in the default setup.
Increasing the value of \verb|phs_t_channel| solves this problem. (This is
presently not done automatically.)
There are two numerical parameters that describe whether particles are treated
like massless particles in particular situations. The value of
\verb|phs_threshold_s| has the default value $50\;\GeV$. Hence, $W$ and $Z$
are considered massive, while $b$ quarks are considered massless. This
categorization is used for deciding whether radiation of $b$ quarks can lead
to (nearly) singular behavior, i.e., logarithmic enhancement, in the infrared
and collinear regions. If yes, logarithmic mappings are applied to phase
space. Analogously, \verb|phs_threshold_t| decides about potential
$t$-channel singularities. Here, the default value is $100\;\GeV$, so
amplitudes with $W$ and $Z$ in the $t$-channel are considered as
logarithmically enhanced. For a high-energy hadron collider of 40 or
100 TeV energy, also $W$ and $Z$ in $s$-channel like situations might
be necessary to be considered massless.
Such logarithmic mappings need a dimensionful scale as parameter. There are
three such scales, all with default value $10\;\GeV$: \verb|phs_e_scale|
(energy), \verb|phs_m_scale| (invariant mass), and \verb|phs_q_scale|
(momentum transfer). If cuts and/or masses are such that energies, invariant
masses of particle pairs, and momentum transfer values below $10\;\GeV$ are
excluded or suppressed, the values can be kept. In special cases they should
be changed: for instance, if you want to describe $\gamma^*\to\mu^+\mu^-$
splitting well down to the muon mass, no cuts, you may set
\verb|phs_m_scale = mmu|. The convergence of the Monte-Carlo integration
result will be considerably faster.
There are more flags. These and more details about the phase space
parameterization will be described in Sec.~\ref{sec:wood}.
\subsection{Cuts}
\whizard~2 does not apply default cuts to the integrand. Therefore, processes
with massless particles in the initial, intermediate, or final states may not
have a finite cross section. This fact will manifest itself in an integration
that does not converge, or is unstable, or does not yield a reasonable error
or reweighting efficiency even for very large numbers of iterations or calls
per iterations. When doing any calculation, you should verify first that the
result that you are going to compute is finite on physical grounds. If not,
you have to apply cuts that make it finite.
A set of cuts is defined by the \ttt{cuts} statement. Here is an example
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
cuts = all Pt > 20 GeV [colored]
\end{verbatim}
\end{footnotesize}
\end{quote}
This implies that events are kept only (for integration and simulation) if the
transverse momenta of all colored particles are above $20\;\GeV$.
Technically, \ttt{cuts} is a special object, which is unique within a given
scope, and is defined by the logical expression on the right-hand side of the
assignment. It may be defined in global scope, so it is applied to all
subsequent processes. It may be redefined by another \ttt{cuts} statement.
This overrides the first cuts setting: the \ttt{cuts} statement is not
cumulative. Multiple cuts should be specified by the logical operators of
\sindarin, for instance
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
cuts = all Pt > 20 GeV [colored]
and all E > 5 GeV [photon]
\end{verbatim}
\end{footnotesize}
\end{quote}
Cuts may also be defined local to an \ttt{integrate} command, i.e., in the
options in braces. They will apply only to the processes being integrated,
overriding any global cuts.
The right-hand side expression in the \ttt{cuts} statement is evaluated at the
point where it is used by an \ttt{integrate} command (which could be an
implicit one called by \ttt{simulate}). Hence, if the logical expression
contains parameters, such as
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
mH = 120 GeV
cuts = all M > mH [b, bbar]
mH = 150 GeV
integrate (myproc)
\end{verbatim}
\end{footnotesize}
\end{quote}
the Higgs mass value that is inserted is the value in place when
\ttt{integrate} is evaluated, $150\;\GeV$ in this example. This same value
will also be used when the process is called by a subsequent \ttt{simulate};
it is \ttt{integrate} which compiles the cut expression and stores it among
the process data. This behavior allows for scanning over parameters without
redefining the cuts every time.
The cut expression can make use of all variables and constructs that are
defined at the point where it is evaluated. In particular, it can make use of
the particle content and kinematics of the hard process, as in the example
above. In addition to the predefined variables and those defined by the user,
there are the following variables which depend on the hard process:
\begin{quote}
\begin{tabular}{ll}
integer: & \ttt{n\_in}, \ttt{n\_out}, \ttt{n\_tot} \\
real: & \ttt{sqrts}, \ttt{sqrts\_hat}
\end{tabular}
\end{quote}
Example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
cuts = sqrts_hat > 150 GeV
\end{verbatim}
\end{footnotesize}
\end{quote}
The constants \ttt{n\_in} etc.\ are sometimes useful if a generic set of cuts
is defined, which applies to various processes simultaneously.
The user is encouraged to define his/her own set of cuts, if possible in a
process-independent manner, even if it is not required. The \ttt{include}
command allows for storing a set of cuts in a separate \sindarin\ script which
may be read in anywhere. As an example, the system directories contain a file
\verb|default_cuts.sin| which may be invoked by
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
include ("default_cuts.sin")
\end{verbatim}
\end{footnotesize}
\end{quote}
\subsection{QCD scale and coupling}
\whizard\ treats all physical parameters of a model, the coefficients in the
Lagrangian, as constants. As a leading-order program, \whizard\ does not make
use of running parameters as they are described by renormalization theory.
For electroweak interactions where the perturbative expansion is sufficiently
well behaved, this is a consistent approach.
As far as QCD is concerned, this approach does not yield numerically
reliable results, even on the validity scale of the tree approximation.
In \whizard\ttt{2}, it is therefore possible to replace the fixed value of
$\alpha_s$ (which is accessible as the intrinsic model variable
\verb|alphas|), by a function of an energy scale $\mu$.
This is controlled by the parameter \verb|?alphas_is_fixed|, which is
\ttt{true} by default. Setting it to \ttt{false} enables running~$\alpha_s$.
The user has then to decide how $\alpha_s$ is calculated.
One option is to set \verb|?alphas_from_lhapdf| (default \ttt{false}). This
is recommended if the \lhapdf\ library is used for including structure
functions, but it may also be set if \lhapdf\ is not invoked. \whizard\ will
then use the $\alpha_s$ formula and value that matches the active
\lhapdf\ structure function set and member.
In the very same way, the $\alpha_s$ running from the PDFs implemented
intrinsically in \whizard\ can be taken by setting
\verb|?alphas_from_pdf_builtin| to \ttt{true}. This is the same
running then the one from \lhapdf, if the intrinsic PDF coincides with
a PDF chosen from \lhapdf.
If this is not appropriate, there are again two possibilities. If
\verb|?alphas_from_mz| is \ttt{true}, the user input value \verb|alphas| is
interpreted as the running value $\alpha_s(m_Z)$, and for the particular
event, the coupling is evolved to the appropriate scale $\mu$. The formula is
controlled by the further parameters \verb|alphas_order| (default $0$,
meaning leading-log; maximum $2$) and \verb|alphas_nf| (default $5$).
Otherwise there is the option to set \verb|?alphas_from_lambda_qcd = true|
in order to evaluate $\alpha_s$ from the scale $\Lambda_{\rm QCD}$,
represented by the intrinsic variable \verb|lambda_qcd|. The reference
value for the QCD scale is $\Lambda\_{\rm QCD} = 200$
MeV. \verb|alphas_order| and \verb|alphas_nf| apply analogously.
Note that for using one of the running options for $\alpha_s$, always
\ttt{?alphas\_is\_fixed = false} has to be invoked.
In any case, if $\alpha_s$ is not fixed, each event has to be assigned an
energy scale. By default, this is $\sqrt{\hat s}$, the partonic invariant
mass of the event. This can be replaced by a user-defined scale, the special
object \ttt{scale}. This is assigned and used just like the \ttt{cuts}
object. The right-hand side is a real-valued expression. Here is an example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
scale = eval Pt [sort by -Pt [colored]]
\end{verbatim}
\end{footnotesize}
\end{quote}
This selects the $p_T$ value of the first entry in the list of colored
particles sorted by decreasing $p_T$, i.e., the $p_T$ of the hardest jet.
The \ttt{scale} definition is used not just for running $\alpha_s$ (if
enabled), but it is also the factorization scale for the \lhapdf\ structure
functions.
These two values can be set differently by specifying
\ttt{factorization\_scale} for the scale at which the PDFs are
evaluated. Analogously, there is a variable
\ttt{renormalization\_scale} that sets the scale value for the running
$\alpha_s$. Whenever any of these two values is set, it supersedes the
\ttt{scale} value.
Just like the \ttt{cuts} expression, the expressions for \ttt{scale},
\ttt{factorization\_scale} and also \ttt{renormalization\_scale}
are evaluated at the point where it is read by an explicit or implicit
\ttt{integrate} command.
\subsection{Reweighting factor}
It is possible to reweight the integrand by a user-defined function of the
event kinematics. This is done by specifying a \ttt{weight} expression.
Syntax and usage is exactly analogous to the \ttt{scale} expression. Example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
weight = eval (1 + cos (Theta) ^ 2) [lepton]
\end{verbatim}
\end{footnotesize}
\end{quote}
We should note that the phase-space setup is not aware of this reweighting, so
in complicated cases you should not expect adaptation to achieve as accurate
results as for plain cross sections.
Needless to say, the default \ttt{weight} is unity.
\section{Events}
After the cross section integral of a scattering process is known (or the
partial-width integral of a decay process), \whizard\ can generate event
samples. There are two limiting cases or modes of event generation:
\begin{enumerate}
\item
For a physics simulation, one needs \emph{unweighted} events, so the
probability of a process and a kinematical configuration in the event sample
is given by its squared matrix element.
\item
Monte-Carlo integration yields \emph{weighted} events, where the probability
(without any grid adaptation) is uniformly distributed over phase space,
while the weight of the event is given by its squared matrix element.
\end{enumerate}
The choice of parameterizations and the iterative adaptation of the
integration grids gradually shift the generation mode from option 2 to option
1, which obviously is preferred since it simulates the actual outcome of an
experiment. Unfortunately, this adaptation is perfect only in trivial cases,
such that the Monte-Carlo integration yields non-uniform probability still
with weighted events. Unweighted events are obtained by rejection, i.e.,
accepting an event with a probability equal to its own weight divided by the
maximal possible weight. Furthermore, the maximal weight is never precisely
known, so this probability can only be estimated.
The default generation mode of \whizard\ is unweighted. This is controlled by
the parameter \verb|?unweighted| with default value \ttt{true}. Unweighted
events are easy to interpret and can be directly compared with experiment, if
properly interfaced with detector simulation and analysis.
However, when applying rejection to generate unweighted events, the generator
discards information, and for a single event it needs, on the average,
$1/\epsilon$ calls, where the efficiency $\epsilon$ is the ratio of the
average weight over the maximal weight. If \verb|?unweighted| is \ttt{false},
all events are kept and assigned their respective weights in histograms or
event files.
\subsection{Simulation}
\label{sec:simulation}
The \ttt{simulate} command generates an event sample. The number of events
can be set either by specifying the integer variable \verb|n_events|, or by
the real variable \verb|luminosity|. (This holds for unweighted events. If
weighted events are requested, the luminosity value is ignored.) The
luminosity is measured in
femtobarns, but other units can be used, too. Since the cross sections for the
processes are known at that point, the number of events is determined as the
luminosity multiplied by the cross section.
As usual, both parameters can be set either as global or as local parameters:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
n_events = 10000
simulate (proc1)
simulate (proc2, proc3) { luminosity = 100 / 1 pbarn }
\end{verbatim}
\end{footnotesize}
\end{quote}
In the second example, both \verb|n_events| and \verb|luminosity| are set.
In that case, \whizard\ chooses whatever produces the larger number of events.
If more than one process is specified in the argument of \ttt{simulate},
events are distributed among the processes with fractions proportional to
their cross section values. The processes are mixed randomly, as it would be
the case for real data.
The raw event sample is written to a file which is named after the first process
in the argument of \ttt{simulate}. If the process name is \ttt{proc1}, the
file will be named \ttt{proc1.evx}. You can choose another basename by the
string variable \verb|$sample|. For instance,
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
simulate (proc1) { n_events = 4000 $sample = "my_events" }
\end{verbatim}
\end{footnotesize}
\end{quote}
will produce an event file \verb|my_events.evx| which contains $4000$ events.
This event file is in a machine-dependent binary format, so it is not of
immediate use. Its principal purpose is to serve as a cache: if you re-run
the same script, before starting simulation, it will look for an existing
event file that matches the input. If nothing has changed, it will find the
file previously generated and read in the events, instead of generating them.
Thus you can modify the analysis or any further steps without repeating the
time-consuming task of generating a large event sample. If you change the
number of events to generate, the program will make use of the existing event
sample and generate further events only when it is used up. If necessary, you
can suppress the writing/reading of the raw event file by the parameters
\verb|?write_raw| and \verb|?read_raw|.
If you try to reuse an event file that has been written by a previous version
of \whizard, you may run into an incompatibility, which will be detected as an
error. If this happens, you may enforce a compatibility mode (also for
writing) by setting \ttt{\$event\_file\_version} to the appropriate version
string, e.g., \verb|"2.0"|. Be aware that this may break some more recent
features in the event analysis.
Generating an event sample can serve several purposes. First of all,
it can be analyzed directly, by \whizard's built-in capabilities, to
produce tables, histograms, or calculate inclusive observables. The
basic analysis features of \whizard\ are described below in
Sec.~\ref{sec:analysis}. It can be written to an external file in a
standard format that a human or an external program can understand.
In Chap.~\ref{chap:events}, you will find a more thorough discussion
of event generation with \whizard, which also covers in detail the
available event-file formats. Finally, \whizard\ can rescan an
existing event sample. The event sample may either be the result of a
previous \ttt{simulate} run or, under certain conditions, an external
event sample produced by another generator or reconstructed from
data.
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
rescan "my_events" (proc1) { $pdf_builtin_set = "MSTW2008LO" }
\end{verbatim}
\end{footnotesize}
\end{quote}
The rescanning may apply different parameters and recalculate the
matrix element, it may apply a different event selection, it may
reweight the events by a different PDF set (as above). The modified
event sample can again be analyzed or written to file. For more
details, cf.\ Sec.~\ref{sec:rescan}.
%%%%%%%%%%%%%%%
\subsection{Decays}
\label{sec:decays}
Normally, the events generated by the \ttt{simulate} command will be identical
in structure to the events that the \ttt{integrate} command generates. This
implies that for a process such as $pp\to W^+W^-$, the final-state particles
are on-shell and stable, so they appear explicitly in the generated event
files. If events are desired where the decay products of the $W$ bosons
appear, one has to generate another process, e.g., $pp\to u\bar d\bar ud$. In
this case, the intermediate vector bosons, if reconstructed, are off-shell as
dictated by physics, and the process contains all intermediate states that are
possible. In this example, the matrix element contains also $ZZ$, photon, and
non-resonant intermediate states. (This can be restricted via the
\verb|$restrictions| option, cf.\ \ref{sec:process options}.
Another approach is to factorize the process in production (of $W$ bosons) and
decays ($W\to q\bar q$). This is actually the traditional approach, since it
is much less computing-intensive. The factorization neglects all off-shell
effects and irreducible background diagrams that do not have the decaying
particles as an intermediate resonance. While \whizard\ is able to deal with
multi-particle processes without factorization, the needed computing resources
rapidly increase with the number of external particles. Particularly,
it is the phase space integration that becomes the true bottleneck for
a high multiplicity of final state particles.
In order to use the factorized approach, one has to specify particles
as \ttt{unstable}. (Also, the \ttt{?allow\_decays} switch must be \ttt{true};
this is however its default value.) We give an example for a $pp \to Wj$ final
state:
\begin{code}
process wj = u, gl => d, Wp
process wen = Wp => E1, n1
integrate (wen)
sqrts = 7 TeV
beams = p, p => pdf_builtin
unstable Wp (wen)
simulate (wj) { n_events = 1 }
\end{code}
This defines a $2 \to 2$ hard scattering process of $W + j$ production
at the 7 TeV LHC 2011 run. The $W^+$ is marked as unstable, with its
decay process being $W^+ \to e^+ \nu_e$. In the \ttt{simulate} command
both processes, the production process \ttt{wj} and the decay process
\ttt{wen} will be integrated, while the $W$ decays become effective
only in the final event sample. This event sample will contain final
states with multiplicity $3$, namely $e^+ \nu_e d$. Note that here
only one decay process is given, hence the branching ratio for the
decay will be taken to be $100 \%$ by \whizard.
A natural restriction of the factorized approach is the implied narrow-width
approximation. Theoretically, this restriction is necessary since whenever
the width plays an important role, the usage of the factorized approach will
not be fully justified. In particular, all involved matrix elements must be
evaluated on-shell, or otherwise gauge-invariance issues could spoil the
calculation. (There are plans for a future \whizard\ version
to also include Breit-Wigner or Gaussian distributions when using the
factorized approach.)
Decays can be concatenated, e.g. for top pair production and
decay, $e^+ e^- \to t \bar t$ with decay $t \to W^+ b$, and subsequent
leptonic decay of the $W$ as in $W^+ \to \mu^+ \nu_\mu$:
\begin{code}
process eett = e1, E1 => t, tbar
process t_dec = t => Wp, b
process W_dec = Wp => E2, n2
unstable t (t_dec)
unstable Wp (W_dec)
sqrts = 500
simulate (eett) { n_events = 1 }
\end{code}
Note that in this case the final state in the event file will consist
of $\bar t b \mu^+ \nu_\mu$ because the anti-top is not decayed.
If more than one decay process is being specified like in
\begin{code}
process eeww = e1, E1 => Wp, Wm
process w_dec1 = Wp => E2, n2
process w_dec2 = Wp => E3, n3
unstable Wp (w_dec1, w_dec2)
sqrts = 500
simulate (eeww) { n_events = 100 }
\end{code}
then \whizard\ takes the integrals of the specified decay processes
and distributes the decays statistically according to the calculated
branching ratio. Note that this might not be the true branching ratios
if decay processes are missing, or loop corrections to partial widths
give large(r) deviations. In the calculation of the code above,
\whizard\ will issue an output like
\begin{code}
| Unstable particle W+: computed branching ratios:
| w_dec1: 5.0018253E-01 mu+, numu
| w_dec2: 4.9981747E-01 tau+, nutau
| Total width = 4.5496085E-01 GeV (computed)
| = 2.0490000E+00 GeV (preset)
| Decay options: helicity treated exactly
\end{code}
So in this case, \whizard\ uses 50 \% muonic and 50 \% tauonic decays
of the positively charged $W$, while the $W^-$ appears directly in the
event file. \whizard\ shows the difference between the preset $W$
width from the physics model file and the value computed from the two
decay channels.
Note that a particle in a \sindarin\ input script can be also explictly
marked as being stable, using the
\begin{code}
stable <particle-tag>
\end{code}
constructor for the particle \ttt{<particle-tag>}.
\subsubsection{Resetting branching fractions}
\label{sec:br-reset}
As described above, decay processes that appear in a simulation must
first be integrated by the program, either explicitly via the
\verb|integrate| command, or implicitly by \verb|unstable|. In either
case, \whizard\ will use the computed partial widths in order to
determine branching fractions. In the spirit of a purely leading-order
calculation, this is consistent.
However, it may be desired to rather use different branching-fraction
values for the decays of a particle, for instance, NLO-corrected
values. In fact, after \whizard\ has integrated any process, the
integration result becomes available as an ordinary
\sindarin\ variable. For instance, if a decay process has the ID
\verb|h_bb|, the integral of this process -- the partial width, in
this case -- becomes the variable \verb|integral(h_bb)|. This
variable may be reset just like any other variable:
\begin{code}
integral(h_bb) = 2.40e-3 GeV
\end{code}
The new value will be used for all subsequent Higgs branching-ratio
calculations and decays, if an unstable Higgs appears in a process for
simulation.
\subsubsection{Spin correlations in decays}
\label{sec:spin-correlations}
By default, \whizard\ applies full spin and color correlations to the
factorized processes, so it keeps both color and spin coherence between
productions and decays. Correlations between decay products of distinct
unstable particles in the same event are also fully retained. The program
sums over all intermediate quantum numbers.
Although this approach obviously yields the optimal description with the
limits of production-decay factorization, there is support for a simplified
handling of particle decays. Essentially, there are four options, taking a
decay \ttt{W\_ud}: $W^-\to \bar u d$ as an example:
\begin{enumerate}
\item
Full spin correlations: \verb|unstable Wp (W_ud)|
\item
Isotropic decay: \verb|unstable Wp (W_ud) { ?isotropic_decay = true }|
\item
Diagonal decay matrix:
\verb|unstable Wp (W_ud) { ?diagonal_decay = true }|
\item
Project onto specific helicity:
\verb|unstable Wp (W_ud) { decay_helicity = -1 }|
\end{enumerate}
Here, the isotropic option completely eliminates spin correlations. The
diagonal-decays option eliminates just the off-diagonal entries of the $W$
spin-density matrix. This is equivalent to a measurement of spin before the
decay. As a result, spin correlations are still present in the classical
sense, while quantum coherence is lost. The definite-helicity option is
similar and additional selects only the specified helicity component for the
decaying particle, so its decay distribution assumes the shape for an
accordingly polarized particle. All options apply in the rest frame of the
decaying particle, with the particle's momentum as the quantization axis.
\subsubsection{Automatic decays}
A convenient option is if the user did not have to specify the decay
mode by hand, but if they were generated automatically. \whizard\ does
have this option: the flag \ttt{?auto\_decays} can be set to
\ttt{true}, and is taking care of that. In that case the list for the
decay processes of the particle marked as unstable is left empty (we
take a $W^-$ again as example):
\begin{code}
unstable Wm () { ?auto_decays = true }
\end{code}
\whizard\ then inspects at the local position within the \sindarin\
input file where that \ttt{unstable} statement appears the masses of
all the particles of the active physics model in order to determine
which decays are possible. It then calculates their partial widths.
There are a few options to customize the decays. The integer variable
\ttt{auto\_decays\_multiplicity} allows to set the maximal
multiplicity of the final states considered in the auto decay
option. The defaul value of that variable is \ttt{2}; please be quite
careful when setting this to values larger than that. If you do so,
the flag \ttt{?auto\_decays\_radiative} allows to specify whether
final states simply containing additional resolved gluons or photons
are taken into account or not. For the example above, you almost hit
the PDG value for the $W$ total width:
\begin{code}
| Unstable particle W-: computed branching ratios:
| decay_a24_1: 3.3337068E-01 d, ubar
| decay_a24_2: 3.3325864E-01 s, cbar
| decay_a24_3: 1.1112356E-01 e-, nuebar
| decay_a24_4: 1.1112356E-01 mu-, numubar
| decay_a24_5: 1.1112356E-01 tau-, nutaubar
| Total width = 2.0478471E+00 GeV (computed)
| = 2.0490000E+00 GeV (preset)
| Decay options: helicity treated exactly
\end{code}
\subsubsection{Future shorter notation for decays}
{\color{red} In an upcoming \whizard\ version there will be a shorter and more
concise notation already in the process definition for such decays,
which, however, is current not yet implemented. The two first examples
above will then be shorter and have this form:}
\begin{code}
process wj = u, gl => (Wp => E1, n1), d
\end{code}
{\color{red} as well as }
\begin{code}
process eett = e1, E1 => (t => (Wp => E2, n2), b), tbar
\end{code}
%%%%%
\subsection{Event formats}
As mentioned above, the internal \whizard\ event format is a
machine-dependent event format. There are a series of human-readable
ASCII event formats that are supported: very verbose formats intended
for debugging, formats that have been agreed upon during the Les
Houches workshops like LHA and LHEF, or formats that are steered
through external packages like HepMC. More details about event formats
can be found in Sec.~\ref{sec:eventformats}.
%%%%%%%%%%%%%%%
\section{Analysis and Visualization}
\label{sec:analysis}
\sindarin\ natively supports basic methods of data analysis and visualization
which are frequently used in high-energy physics studies. Data generated
during script execution, in particular simulated event samples, can be
analyzed to evaluate further observables, fill histograms, and draw
two-dimensional plots.
So the user does not have to rely on his/her own external graphical
analysis method (like e.g. \ttt{gnuplot} or \ttt{ROOT} etc.), but can
use methods that automatically ship with \whizard. In many cases, the
user, however, clearly will use his/her own analysis machinery,
especially experimental collaborations.
In the following sections, we first summarize the available data structures,
before we consider their graphical display.
\subsection{Observables}
Analyses in high-energy physics often involve averages of quantities other
than a total cross section. \sindarin\ supports this by its \ttt{observable}
objects. An \ttt{observable} is a container that collects a single
real-valued variable with a statistical distribution. It is declared by a
command of the form
\begin{quote}
\begin{footnotesize}
\ttt{observable \emph{analysis-tag}}
\end{footnotesize}
\end{quote}
where \ttt{\emph{analysis-tag}} is an identifier that follows the same rules
as a variable name.
Once the observable has been declared, it can be filled with values. This is
done via the \ttt{record} command:
\begin{quote}
\begin{footnotesize}
\ttt{record \emph{analysis-tag} (\emph{value})}
\end{footnotesize}
\end{quote}
To make use of this, after values have been filled, we want to perform the
actual analysis and display the results. For an observable, these are the
mean value and the standard deviation. There is the command
\ttt{write\_analysis}:
\begin{quote}
\begin{footnotesize}
\ttt{write\_analysis (\emph{analysis-tag})}
\end{footnotesize}
\end{quote}
Here is an example:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
observable obs
record obs (1.2) record obs (1.3) record obs (2.1) record obs (1.4)
write_analysis (obs)
\end{verbatim}
\end{footnotesize}
\end{quote}
The result is displayed on screen:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
###############################################################################
# Observable: obs
average = 1.500000000000E+00
error[abs] = 2.041241452319E-01
error[rel] = 1.360827634880E-01
n_entries = 4
\end{verbatim}
\end{footnotesize}
\end{quote}
\subsection{The analysis expression}
\label{subsec:analysis}
The most common application is the computation of event observables -- for
instance, a forward-backward asymmetry -- during simulation. To this end,
there is an \ttt{analysis} expression, which behaves very similar to the
\ttt{cuts} expression. It is defined either globally
\begin{quote}
\begin{footnotesize}
\ttt{analysis = \emph{logical-expr}}
\end{footnotesize}
\end{quote}
or as a local option to the \ttt{simulate} or \ttt{rescan} commands which
generate and handle event samples. If this expression is defined, it is not
evaluated immediately, but it is evaluated once for each event in the sample.
In contrast to the \ttt{cuts} expression, the logical value of the
\ttt{analysis} expression is discarded; the expression form has been chosen
just by analogy. To make this useful, there is a variant of the \ttt{record}
command, namely a \ttt{record} function with exactly the same syntax. As an
example, here is a calculation of the forward-backward symmetry in a process
\ttt{ee\_mumu} with final state $\mu^+\mu^-$:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
observable a_fb
analysis = record a_fb (eval sgn (Pz) ["mu-"])
simulate (ee_mumu) { luminosity = 1 / 1 fbarn }
\end{verbatim}
\end{footnotesize}
\end{quote}
The logical return value of \ttt{record} -- which is discarded here -- is
\ttt{true} if the recording was successful. In case of histograms (see below)
it is true if the value falls within bounds, false otherwise.
Note that the function version of \ttt{record} can be used anywhere in
expressions, not just in the \ttt{analysis} expression.
When \ttt{record} is called for an observable or histogram in simulation mode,
the recorded value is weighted appropriately. If \ttt{?unweighted} is true,
the weight is unity, otherwise it is the event weight.
The \ttt{analysis} expression can involve any other construct
that can be expressed as an expression in \sindarin. For instance, this
records the energy of the 4th hardest jet in a histogram \ttt{pt\_dist}, if it
is in the central region:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
analysis =
record pt_dist (eval E [extract index 4
[sort by - Pt
[select if -2.5 < Eta < 2.5 [colored]]]])
\end{verbatim}
\end{footnotesize}
\end{quote}
Here, if there is no 4th jet in the event which satisfies the criterion, the
result will be an undefined value which is not recorded. In that case,
\ttt{record} evaluates to \ttt{false}.
Selection cuts can be part of the analysis expression:
\begin{code}
analysis =
if any Pt > 50 GeV [lepton] then
record jet_energy (eval E [collect [jet]])
endif
\end{code}
Alternatively, we can specify a separate selection expression:
\begin{code}
selection = any Pt > 50 GeV [lepton]
analysis = record jet_energy (eval E [collect [jet]])
\end{code}
The former version writes all events to file (if requested), but
applies the analysis expression only to the selected events. This
allows for the simultaneous application of different selections to a
single event sample. The latter version applies the selection to all
events before they are analyzed or written to file.
The analysis expression can make use of all variables and constructs that are
defined at the point where it is evaluated. In particular, it can make use of
the particle content and kinematics of the hard process, as in the example
above. In addition to the predefined variables and those defined by the user,
there are the following variables which depend on the hard process. Some of
them are constants, some vary event by event:
\begin{quote}
\begin{tabular}{ll}
integer: &\ttt{event\_index} \\
integer: &\ttt{process\_num\_id} \\
string: &\ttt{\$process\_id} \\
integer: &\ttt{n\_in}, \ttt{n\_out}, \ttt{n\_tot} \\
real: &\ttt{sqrts}, \ttt{sqrts\_hat} \\
real: &\ttt{sqme}, \ttt{sqme\_ref} \\
real: &\ttt{event\_weight}, \ttt{event\_excess}
\end{tabular}
\end{quote}
The \ttt{process\_num\_id} is the numeric ID as used by external
programs, while the process index refers to the current library. By
default, the two are identical. The process index itself is not
available as a predefined observable. The \ttt{sqme} and
\ttt{sqme\_ref} values indicate the squared matrix element and the
reference squared matrix element, respectively. The latter applies
when comparing with a reference sample (the \ttt{rescan} command).
\ttt{record} evaluates to a logical, so several \ttt{record} functions may
be concatenated by the logical operators \ttt{and} or \ttt{or}. However,
since usually the further evaluation should not depend on the return value of
\ttt{record}, it is more advisable to concatenate them by the semicolon
(\ttt{;}) operator. This is an operator (\emph{not} a statement separator or
terminator) that connects two logical expressions and evaluates both of them
in order. The lhs result is discarded, the result is the value of the rhs:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
analysis =
record hist_pt (eval Pt [lepton]) ; record hist_ct (eval cos (Theta) [lepton])
\end{verbatim}
\end{footnotesize}
\end{quote}
\subsection{Histograms}
\label{sec:histogram}
In \sindarin, a histogram is declared by the command
\begin{quote}
\begin{footnotesize}
\ttt{histogram \emph{analysis-tag} (\emph{lower-bound}, \emph{upper-bound})}
\end{footnotesize}
\end{quote}
This creates a histogram data structure for an (unspecified) observable. The
entries are organized in bins between the real values \ttt{\emph{lower-bound}}
and \ttt{\emph{upper-bound}}. The number of bins is given by the value of the
intrinsic integer variable \ttt{n\_bins}, the default value is 20.
The \ttt{histogram} declaration supports an optional argument, so the number
of bins can be set locally, for instance
\begin{quote}
\begin{footnotesize}
\ttt{histogram pt\_distribution (0 GeV, 500 GeV) \{ n\_bins = 50 \}}
\end{footnotesize}
\end{quote}
Sometimes it is more convenient to set the bin width directly. This can be
done in a third argument to the \ttt{histogram} command.
\begin{quote}
\begin{footnotesize}
\ttt{histogram pt\_distribution (0 GeV, 500 GeV, 10 GeV)}
\end{footnotesize}
\end{quote}
If the bin width is specified this way, it overrides the setting of
\ttt{n\_bins}.
The \ttt{record} command or function fills histograms. A single call
\begin{quote}
\begin{footnotesize}
\ttt{record (\emph{real-expr})}
\end{footnotesize}
\end{quote}
puts the value of \ttt{\emph{real-expr}} into the appropriate bin. If
the call is issued during a simulation where \ttt{unweighted} is false, the
entry is weighted appropriately.
If the value is outside the range specified in the histogram declaration, it
is put into one of the special underflow and overflow bins.
The \ttt{write\_analysis} command prints the histogram contents as a table in
blank-separated fixed columns. The columns are: $x$ (bin midpoint), $y$ (bin
contents), $\Delta y$ (error), excess weight, and $n$ (number of entries).
The output also contains comments initiated by a \verb|#| sign, and following
the histogram proper, information about underflow and overflow as well as
overall contents is added.
\subsection{Plots}
\label{sec:plot}
While a histogram stores only summary information about a data set, a
\ttt{plot} stores all data as $(x,y)$ pairs, optionally with errors. A plot
declaration is as simple as
\begin{quote}
\begin{footnotesize}
\ttt{plot \emph{analysis-tag}}
\end{footnotesize}
\end{quote}
Like observables and histograms, plots are filled by the \ttt{record} command
or expression. To this end, it can take two arguments,
\begin{quote}
\begin{footnotesize}
\ttt{record (\emph{x-expr}, \emph{y-expr})}
\end{footnotesize}
\end{quote}
or up to four:
\begin{quote}
\begin{footnotesize}
\ttt{record (\emph{x-expr}, \emph{y-expr}, \emph{y-error})}
\\
\ttt{record (\emph{x-expr}, \emph{y-expr},
\emph{y-error-expr}, \emph{x-error-expr})}
\end{footnotesize}
\end{quote}
Note that the $y$ error comes first. This is because applications will
demand errors for the $y$ value much more often than $x$ errors.
The plot output, again written by \ttt{write\_analysis} contains the four
values for each point, again in the ordering $x,y,\Delta y, \Delta x$.
\subsection{Analysis Output}
There is a default format for piping information into observables,
histograms, and plots. In older versions of \whizard\ there was a
first version of a custom format, which was however rather limited.
A more versatile custom output format will be coming soon.
\begin{enumerate}
\item
By default, the \ttt{write\_analysis} command prints all data to the
standard output. The data are also written to a default file with the
name \ttt{whizard\_analysis.dat}.
Output is redirected to a file with a different name if the
variable \ttt{\$out\_file} has a nonempty value. If the file is
already open, the output will be appended to
the file, and it will be kept open. If the file is not open,
\ttt{write\_analysis} will open the output file by itself, overwriting any
previous file with the same name, and close it again after data have been
written.
The command is able to print more than one dataset, following the syntax
\begin{quote}
\begin{footnotesize}
\ttt{write\_analysis (\emph{analysis-tag1}, \emph{analysis-tag2}, \ldots)
\{ \emph{options} \}}
\end{footnotesize}
\end{quote}
The argument in brackets may also be empty or absent; in this case, all
currently existing datasets are printed.
The default data format is suitable for compiling analysis data by \whizard's
built-in \gamelan\ graphics driver (see below and particularly
Chap.~\ref{chap:visualization}). Data are written in
blank-separated fixed columns, headlines and comments are initiated by the
\verb|#| sign, and each data set is terminated by a blank line. However,
external programs often require special formatting.
The internal graphics driver \gamelan\ of \whizard\ is initiated by
the \ttt{compile\_analysis} command. Its syntax is the same, and it
contains the \ttt{write\_analysis} if that has not been separately
called (which is unnecessary). For more details about the \gamelan\
graphics driver and data visualization within \whizard, confer
Chap.~\ref{chap:visualization}.
\item
Custom format. Not yet (re-)implemented in a general form.
\end{enumerate}
\section{Custom Input/Output}
\label{sec:I/O}
\whizard\ is rather chatty. When you run examples or your own scripts, you
will observe that the program echoes most operations (assignments, commands,
etc.) on the standard output channel, i.e., on screen. Furthermore, all
screen output is copied to a log file which by default is named
\ttt{whizard.log}.
For each integration run, \whizard\ writes additional process-specific
information to a file \ttt{\var{tag}.log}, where \ttt{\var{tag}} is the
process name. Furthermore, the \ttt{write\_analysis} command dumps analysis
data -- tables for histograms and plots -- to its own set of files, cf.\
Sec.~\ref{sec:analysis}.
However, there is the occasional need to write data to extra files in a custom
format. \sindarin\ deals with that in terms of the following commands:
\subsection{Output Files}
\subsubsection{open\_out}
\begin{syntax}
open\_out (\var{filename}) \\
open\_out (\var{filename}) \{ \var{options} \}
\end{syntax}
Open an external file for writing. If the file exists, it is overwritten
without warning, otherwise it is created. Example:
\begin{code}
open_out ("my_output.dat")
\end{code}
\subsubsection{close\_out}
\begin{syntax}
close\_out (\var{filename}) \\
close\_out (\var{filename}) \{ \var{options} \}
\end{syntax}
Close an external file that is open for writing. Example:
\begin{code}
close_out ("my_output.dat")
\end{code}
\subsection{Printing Data}
\subsubsection{printf}
\begin{syntax}
printf \var{format-string-expr} \\
printf \var{format-string-expr} (\var{data-objects})
\end{syntax}
Format \ttt{\var{data-objects}} according to \ttt{\var{format-string-expr}}
and print the resulting string to standard output if the string variable
\ttt{\$out\_file} is undefined. If \ttt{\$out\_file} is defined and the file
with this name is open for writing, print to this file instead.
Print a newline at the end if \ttt{?out\_advance} is true, otherwise don't
finish the line.
The \ttt{\var{format-string-expr}} must evaluate to a string. Formatting
follows a subset of the rules for the \ttt{printf(3)} command in the \ttt{C}
language. The supported rules are:
\begin{itemize}
\item All characters are printed as-is, with the exception of embedded
conversion specifications.
\item Conversion specifications are initiated by a percent (\verb|%|) sign and
followed by an optional prefix flag, an optional integer value, an optional
dot followed by another integer, and a mandatory letter as the conversion
specifier.
\item A percent sign immediately followed by another percent sign is
interpreted as a single percent sign, not as a conversion specification.
\item The number of conversion specifiers must be equal to the number of data
objects. The data types must also match.
\item The first integer indicates the minimum field width, the second one the
precision. The field is expanded as needed.
\item The conversion specifiers \ttt{d} and \ttt{i} are equivalent, they
indicate an integer value.
\item The conversion specifier \ttt{e} indicates a real value that should be
printed in exponential notation.
\item The conversion specifier \ttt{f} indicates a real value that should be
printed in decimal notation without exponent.
\item The conversion specifier \ttt{g} indicates a real value that should be
printed either in exponential or in decimal notation, depending on its
value.
\item The conversion specifier \ttt{s} indicates a logical or string value
that should be printed as a string.
\item Possible prefixes are \verb|#| (alternate form, mandatory decimal point
for reals), \verb|0| (zero padding), \verb|-| (left adjusted), \verb|+|
(always print sign), `\verb| |' (print space before a positive number).
\end{itemize}
For more details, consult the \verb|printf(3)| manpage. Note that other
conversions are not supported and will be rejected by \whizard.
The data arguments are numeric, logical or string variables or expressions.
Numeric expressions must be enclosed in parantheses. Logical expressions must
be enclosed in parantheses prefixed by a question mark \verb|?|. String
expressions must be enclosed in parantheses prefixed by a dollar sign
\verb|$|. These forms behave as anonymous variables.
Note that for simply printing a text string, you may call \ttt{printf} with
just a format string and no data arguments.
Examples:
\begin{code}
printf "The W mass is %8f GeV" (mW)
int i = 2
int j = 3
printf "%i + %i = %i" (i, j, (i+j))
string $directory = "/usr/local/share"
string $file = "foo.dat"
printf "File path: %s/%s" ($directory, $file)
\end{code}
There is a related \ttt{sprintf} function, cf.~Sec.~\ref{sec:sprintf}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{WHIZARD at next-to-leading order}
\subsection{Prerequisites}
A full NLO computation requires virtual matrix elements obtained from
loop diagrams. Since \oMega\ cannot calculate such diagrams, external
programs are used. \whizard\ has a generic interface to matrix-element
generators that are BLHA-compatible.
Explicit implementations exist for \gosam, \openloops\ and \recola.
%%%%%
\subsubsection{Setting up \gosam}
The installation of \gosam\ is detailed on the HepForge page
\url{https://gosam/hepforge.org}. We mention here some of the steps
necessary to get it to be linked with \whizard.
{\bf Bug in \gosam\ installation scripts:} In many versions of
\gosam\ there is a bug in the installation scripts that is only
relevant if \gosam\ is installed with superuser privileges. Then all
files in \ttt{\$installdir/share/golem} do not have read privileges
for normal users. These privileges must be given manually to all files
in that directory.
Prerequisites for \gosam\ to produce code for one-loop matrix elements
are the scientific algebra program \ttt{form} and the generator of
loop topologies and diagrams, \ttt{qgraf}.
These can be accessed via their respective webpages
\url{http://www.nikhef.nl/~form/} and
\url{http://cfif.ist.utl.pt/~paulo/qgraf.html}. Note also that both
\ttt{Java} and the Java runtime environment have to be installed in
order for \gosam\ to properly work. Furthermore, \ttt{libtool}
needs to be installed. A more convenient way to install \gosam, is the
automatic installation script
\url{https://gosam.hepforge.org/gosam_installer.py}.
%%%%%
\subsubsection{Setting up \openloops}
\label{sec:openloops-setup}
The installation of \openloops\ is explained in detail on the HepForge
page \url{https://openloops.hepforge.org}. In the following, the main
steps for usage with \whizard\ are summarized.
Please note that at the moment, \openloops\ cannot be installed such
that in almost all cases the explicit \openloops\ package directory
has to be set via \ttt{--with-openloops=<openloops\_dir>}.
\openloops\ can be checked out with
\begin{code}
svn co https://openloops.hepforge.org/svn/OpenLoops/branches/public
\end{code}
The program can be build by running \ttt{scons} or \ttt{./scons}, a
local version that is included in the \openloops\ directory. This
produces the script \ttt{./openloops}, which is the main hook for the
further usage of the program.
\openloops\ works by downloading prebuild process libraries, which have
to be installed for each individual process. This requires the file
\ttt{openloops.cfg}, which should contain
the following content:
\begin{code}
[OpenLoops]
process\_repositories=public, whizard\\
compile\_extra=1
\end{code}
The first line instructs \openloops\ to also look for process libraries
in an additional lepton collider repository. The second line triggers
the inclusion of $N+1$-particle tree-level matrix elements in the
process directory, so that a complete NLO calculation including real
amplitudes can be performed only with \openloops.
The libraries can then be installed via
\begin{code}
./openloops libinstall proc_name
\end{code}
A list of supported library names can be found on the \openloops\ web
page. Note that a process library also includes all possible permutated
processes. The process library \ttt{ppll}, for example, can also be
used to compute the matrix elements for $e^+ e^- \rightarrow q \bar{q}$
(massless quarks only). The massive case of the top quark is handled in
\ttt{eett}. Additionally, there are process libraries for top and gauge
boson decays, \ttt{tbw}, \ttt{vjj}, \ttt{tbln} and \ttt{tbqq}.
Finally, \openloops\ can be linked to \whizard\ during configuration by
including
\begin{code}
--enable-openloops --with-openloops=$OPENLOOPS_PATH,
\end{code}
where \ttt{\$OPENLOOPS\_PATH} is the directory the \openloops\
executable is located in. \openloops\ one-loop diagrams can then be
used with the \sindarin\ option
\begin{code}
$loop_me_method = "openloops".
\end{code}
The functional tests which check the \openloops\ functionality require
the libraries \ttt{ppll}, \ttt{eett} and \ttt{tbw} to be installed (note
that \ttt{eett} is not contained in \ttt{ppll}). During the
configuration of \whizard, it is automatically checked that these two
libraries, as well as the option \ttt{compile\_extra=1}, are present.
\subsubsection{\openloops\ \sindarin\ flags}
Several \sindarin\ options exist to control the behavior of \openloops.
\begin{itemize}
\item \ttt{openloops\_verbosity}:\\
Decide how much \openloops\ output is printed. Can have values 0, 1
and 2.
\item \ttt{?openloops\_use\_cms}:\\
Activates the complex mass scheme. For computations with decaying
resonances like the top quark or W or Z bosons, this is the
preferred option to avoid gauge-dependencies.
\item \ttt{openloops\_phs\_tolerance}:\\
Controls the exponent of \ttt{extra psp\_tolerance} in the BLHA
interface, which is the numerical tolerance for the on-shell
condition of external particles
\item \ttt{openloops\_switch\_off\_muon\_yukawa}:\\
Sets the Yukawa coupling of muons to zero in order to assure
agreement with \oMega, which is possibly used for other
components and per default does not take $H\mu\mu$ couplings
into account.
\item \ttt{openloops\_stability\_log}:\\
Creates the directory \ttt{stability\_log}, which contains information
about the performance of the matrix elements. Possible values are
\begin{itemize}
\item 0: No output (default),
\item 1: On finish() call,
\item 2: Adaptive,
\item 3: Always
\end{itemize}
\item \ttt{?openloops\_use\_collier}: Use Collier as the reduction
method (default true).
\end{itemize}
%%%%%
\subsubsection{Setting up \recola}
\label{sec:recola-setup}
The installation of \recola\ is explained in detail on the HepForge page
\url{https://recola.hepforge.org}. In the following the main steps for
usage with \whizard\ are summarized. The minimal required version number
of \recola\ is 1.3.0.
\recola\ can be linked to \whizard\ during configuration by including
\begin{code}
--enable-recola
\end{code}
In case the \recola\ library is not in a standard path or a path
accessible in the \ttt{LD\_LIBRARY\_PATH} (or
\ttt{DYLD\_LIBRARY\_PATH}) of the operating system, then the option
\begin{code}
--with-recola=$RECOLA_PATH
\end{code}
can be set, where \ttt{\$RECOLA\_PATH} is the directory the
\recola\ library is located in. \recola\ can then be used with the
\sindarin\ option
\begin{code}
$method = "recola"
\end{code}
or any other of the matrix element methods.
Note that there might be a clash of the \collier\ libraries when you
have \collier\ installed both via \recola\ and via \openloops, but
have compiled them with different \fortran\ compilers.
%%%%%
\subsection{NLO cross sections}
An NLO computation can be switched on in \sindarin\ with
\begin{code}
process proc_nlo = in1, in2 => out1, ..., outN { nlo_calculation = <components> },
\end{code}
where the \ttt{nlo\_calculation} can be followed by a list of strings
specifying the desired NLO-components to be integrated, i.e.
\ttt{born}, \ttt{real}, \ttt{virtual}, \ttt{dglap}, (for hadron
collisions) or \ttt{mismatch} (for the soft mismatch in
resonance-aware computations) and \ttt{full}. The \ttt{full} option
switches on all components and is required if the total NLO result is
desired. For example, specifying
\begin{code}
nlo_calculation = born, virtual
\end{code}
will result in the computation of the Born and virtual component.
The integration can be carried out in two different modes: Combined
and separate integration. In the separate integration mode, each
component is integrated individually, allowing for a good overview of
their contributions to the total cross section and a fine tuned
control over the iterations in each component. In the combined
integration mode, all components are added up during integration so that
the sum of them is evaluated. Here, only one integration will be
displayed. The default method is the separate integration.
The convergence of the integration can crucially be influenced by the
presence of resonances. A better convergence is in this case achieved
activating the resonance-aware FKS subtraction,
\begin{code}
$fks_method = "resonances".
\end{code}
This mode comes with an additional integration component, the
so-called soft mismatch.
Note that you can modify the number of iterations in each component with
the multipliers:
\begin{itemize}
\item \ttt{mult\_call\_real} multiplies the number of calls to be used
in the integration of the real component. A reasonable choice is
\ttt{10.0} as the real phase-space is more complicated than the Born
but the matrix elements evaluate faster than the virtuals.
\item \ttt{mult\_call\_virt} multiplies the number of calls to be used
in the integration of the virtual component. A reasonable choice is
\ttt{0.5} to make sure that the fast Born component only contributes
a negligible MC error compared to the real and virtual components.
\item \ttt{mult\_call\_dglap} multiplies the number of calls to be used
in the integration of the DGLAP component.
\end{itemize}
\subsection{Fixed-order NLO events}
\label{ss:fixedorderNLOevents}
Fixed-order NLO events can also be produced in three different modes:
Combined weighted, combined unweighted and separated weighted.
\begin{itemize}
\item \textbf{Combined weighted}\\
In the combined mode, one single integration grid is produced, from
which events are generated with the total NLO weight. The
corresponding event file contains $N$ events with born-like
kinematics and weight equal to $\mathcal{B} + \mathcal{V} +
\sum_{\alpha_r} \mathcal{C}_{\alpha_r}$, where $\mathcal{B}$ is the
Born matrix element, $\mathcal{V}$ is the virtual matrix element and
$\mathcal{C}_{\alpha_r}$ are the subtraction terms in each singular
region. For resonance-aware processes, also the mismatch value is
added. Each born-like event is followed by $N_{\text{phs}}$
associated events with real kinematics, i.e. events where one
additional QCD particle is present. The corresponding real
matrix-elements $\mathcal{R}_\alpha$ form the weight of these events.
$N_{\text{phs}}$ the number of distinct phase spaces. Two phase spaces
are distinct if they share the same resonance history but have
different emitters. So, two $\alpha_r$ can share the same phase
space index.
The combined event mode is activated by
\begin{code}
?combined_nlo_integration = true
?unweighted = false
?fixed_order_nlo_events = true
\end{code}
Moreover, the process must be specified at next-to-leading-order in its
definition using \ttt{nlo\_calculation = full}. \whizard\ then
proceeds as in the usual simulation mode. I.e. it first checks
whether integration grids are already present and uses them if they
fit. Otherwise, it starts an integration.
\item \textbf{Combined unweighted}\\
The unweighted combined events can be generated by using the
\powheg\ mode, cf. also the next subsection, but disabling the
additional radiation and Sudakov factors with the
\ttt{?powheg\_disable\_sudakov} switch:
\begin{code}
?combined_nlo_integration = true
?powheg_matching = true
?powheg_disable_sudakov = true
\end{code}
This will produce events with Born kinematics and unit weights (as
\ttt{?unweighted} is \ttt{true} by default). The events are
unweighted by using $\mathcal{B} + \mathcal{V} + \sum_{\alpha_r}
(\mathcal{C}_{\alpha_r} + \mathcal{R}_{\alpha_r})$. Of course, this
only works when these weights are positive over the full
phase-space, which is not guaranteed for all scales and regions at
NLO. However, for many processes perturbation theory works nicely
and this is not an issue.
\item \textbf{Separate weighted}\\
In the separate mode, grids and events are generated for each
individual component of the NLO process. This method is preferable
for complicated processes, since it allows to individually tune each
grid generation. Moreover, the grid generation is then trivially
parallelized. The event files either contain only Born
kinematics with weight $\mathcal{B}$ or $\mathcal{V}$ (and mismatch
in case of a resonance-aware process) or mixed Born and real
kinematics for the real component like in the combined mode.
However, the Born events have only the weight $\sum_{\alpha_r}
\mathcal{C}_{\alpha_r}$ in this case.
The separate event mode is activated by
\begin{code}
?unweighted = false
?negative_weights = true
?fixed_order_nlo_events = true
\end{code}
Note that negative weights have to be switched on because, in contrast
to the combined mode, the total cross sections of the individual
components can be negative.
Also, the desired component has to appear in the process NLO
specification, e.g. using \ttt{nlo\_calculation = real}.
\end{itemize}
Weighted fixed-order NLO events are supported by any output format that
supports weights like the \ttt{HepMC} format and unweighted NLO events
work with any format. The output can either be written to disk or put
into a FIFO to interface it to an analysis program without writing
events to file.
The weights in the real event output, both in the combined and separate
weighted mode, are divided by a factor $N_{\text{phs}} + 1$. This
is to account for the fact that we artificially increase the number of
events in the output file. Thus, the sum of all event weights correctly
reproduces the total cross section.
\subsection{\powheg\ matching}
To match the NLO computation with a parton shower, \whizard\ supports
the \powheg\ matching. It generates a distribution according to
\begin{align}
\label{eq:powheg}
\text{d}\sigma &= \text{d}\Phi_n \,{\bar{B}_{\text{s}}}\,\biggl(
{\Delta_{\text{s}}}(p_T^{\text{min}}\bigr) +
\text{d}\Phi_{\text{rad}}\,{\Delta_{\text{s}}}(k_{\text{T}}(\Phi_{\text{rad}})\bigr)
{\frac{R_{\text{s}}}B}\biggr) \quad \text{where} \\
{\bar{B}_{\text{s}}} &= {B} + {\mathcal{V}} + \text{d}\Phi_{\text{rad}}\,
{\mathcal{R}_{\text{s}}} \quad \text{and} \\
{\Delta_{\text{s}}}(p_T) &= \exp\left[- \int{\text{d}\Phi_{\text{rad}}}
{\frac{R_{\text{s}}}{B}}\; \theta\left(k_T^2(\Phi_{\text{rad}}) -
p_T^2\right)\right]\;.
\end{align}
The subscript s refers to the singular part of the real component, cf.
to the next subsection. Eq.~\eqref{eq:powheg} produces either no or one
additional emission. These events can then either be analyzed directly
or passed on to the parton shower\footnote{E.g. \pythiaeight\ has
explicit examples for \powheg\ input, see also
\url{http://home.thep.lu.se/Pythia/pythia82html/POWHEGMerging.html}.}
for the full simulation. You activate this with
\begin{code}
?fixed_order_nlo_events = false
?combined_nlo_integration = true
?powheg_matching = true
\end{code}
The $p_T^{\text{min}}$ of Eq.~\eqref{eq:powheg} can be set with
\ttt{powheg\_pt\_min}. It sets the minimal scale for the \powheg\
evolution and should be of order 1 GeV and set accordingly in the
interfaced shower. The maximal scale is currently given by \ttt{sqrts}
but should in the future be changeable with \ttt{powheg\_pt\_min}.
Note that the \powheg\ event generation needs an additional grid for
efficient event generation that is automatically generated during
integration. Further options that steer the efficiency of this grid are
\ttt{powheg\_grid\_size\_xi} and \ttt{powheg\_grid\_size\_y}.
\subsection{Separation of finite and singular contributions}
For both the pure NLO computations as well as the \powheg\ event
generation, \whizard\ supports the partitioning of the real into finite
and singular contributions with the flag
\begin{code}
?nlo_use_real_partition = true
\end{code}
The finite contributions, which by definition should not contain soft or
collinear emissions, will then integrate like a ordinary LO integration
with one additional particle. Similarly, the event generation will
produce only real events without subtraction terms with Born kinematics
for this additional finite component. The \powheg\ event generation
will also only use the singular parts.
The current implementation uses the following parametrization
\begin{align}
R &= R_{\text{fin}} + R_{\text{sing}} \;,\\
R_{\text{sing}} &= R F(\Phi_{n+1}) \;,\\
R_{\text{fin}} &= R (1-F(\Phi_{n+1})) \;,\\
F(\Phi_{n+1}) &=
\begin{cases}
1 & \text{if} \quad\exists\,(i,j)\in\mathcal{P}_{\text{FKS}}\quad \text{with} \quad
\sqrt{(p_i+p_j)^2} < h + m_i + m_j \\
0 & \text{else}
\end{cases} \;.
\end{align}
Thus, a point is {singular ($F=1$)}, if {any} of the {FKS tuples}
forms an {invariant mass} that is {smaller than the hardness scale
$h$}. This parameter is controlled in \sindarin\ with
\ttt{real\_partition\_scale}.
This simplifies in {massless case} to
\begin{align}
F(\Phi_{n+1}) =
\begin{cases}
1 & \text{if} \;\exists\,(i,j)\in\mathcal{P}_{\text{FKS}}\quad \text{with} \quad
2 E_i E_j (1-\cos\theta_{ij}) < h^2 \\
0 & \text{else}
\end{cases} \;.
\end{align}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Random number generators}
\label{chap:rng}
\section{General remarks}
\label{sec:rng}
The random number generators (RNG) are one of the crucialer points of Monte
Carlo calculations, hence, giving those their ``randomness''. A decent
multipurpose random generator covers
\begin{itemize}
\item reproducibility
\item large period
\item fast generation
\item independence
\end{itemize}
of the random numbers. Therefore, special care is taken for the choice of the
RNGs in \whizard{}. It is stated that \whizard{} utilizes \textit{pseudo}-RNGs,
which are based on one (or more) recursive algorithm(s) and start-seed(s) to have
reproducible sequences of numbers. In contrast, a genuine random generator relies
on physical processes.
\whizard\ ships with two completely different random number generators which can be
selected by setting the \sindarin\ option
\begin{code}
$rng_method = "rng_tao"
\end{code}
Altough, \whizard{} sets a default seed, it is adviced to use a different one
\begin{code}
seed = 175368842
\end{code}
note that some RNGs do not allow certain seed values (e.g. zero seed).
\section{The TAO Random Number Generator}
\label{sec:tao}
The TAO (``The Art Of'') random number generator is a lagged Fibonacci
generator based upon (signed) 32-bit integer arithmetic and was proposed by
Donald E. Knuth and is implemented in the \vamp\ package.
The TAO random number generator is the default RNG of \whizard{}, but can additionally
be set as \sindarin\ option
\begin{code}
$rng_method = rng_tao
\end{code}
The TAO random number generators is a subtractive lagged Fibonacci generator
\begin{equation*}
x_{j} = \left( x_{j-k} - x_{j-L} \right) \mod 2^{30}
\end{equation*}
with lags $k = 100$ and $l = 37$ and period length $\rho = 2^{30} - 2$.
\section{The RNGStream Generator}
\label{sec:rngstream}
The RNGStream \cite{L_Ecuyer:2002} was originally implemented in \cpp\ with
floating point arithmetic and has been ported to \fortranOThree\. The RNGstream
can be selected by the \sindarin\ option
\begin{code}
$rng_method = "rng_stream"
\end{code}
The RNGstream supports multiple independent streams and substreams of random
numbers which can be directly accessed.
The main advantage of the RNGStream lies in the domain of parallelization where
different worker have to access different parts of the random number stream to
ensure numerical reproducibility. The RNGstream provides exactly this property with its
(sub)stream-driven model.
Unfortunately, the RNGStream can only be used in combination with \vamptwo{}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Integration Methods}
\section{The Monte-Carlo integration routine: \ttt{VAMP}}
\label{sec:vamp}
\vamp\ \cite{Ohl:1998jn}
is a multichannel extension of the \vegas\ \cite{Lepage:1980dq}
algorithm. For all possible singularities in the integrand, suitable
maps and integration channels are chosen which are then weighted and
superimposed to build the phase space parameterization. Both grids and
weights are modified in the adaption phase of the integration.
The multichannel integration algorithm is implemented as a
\fortranNinetyFive\ library with the task of mapping out the integrand
and finding suitable parameterizations being completely delegated to
the calling program (\whizard\ core in this case). This makes the
actual \vamp\ library completely agnostic of the model under
consideration.
\section{The next generation integrator: \ttt{VAMP2}}
\label{sec:vamp2}
\vamptwo\ is a modern implementation of the integrator package \vamp\ written
in \fortranOThree\, providing the same features. The backbone integrator is
still \vegas\ \cite{Lepage:1980dq}, although implemented differently as in
\vamp{}.
The main advantage over \vamp\ is the overall faster integration due to the usage
of \fortranOThree{}, the possible usage of different random number generators
and the complete parallelization of \vegas\ and the multichannel integration.
\vamptwo{} can be set by the \sindarin{} option
\begin{code}
$integration_method = "vamp2"
\end{code}
It is said that the generated grids between \vamp{} and \vamptwo{} are
incompatible.
\subsection{Multichannel integration}
\label{sec:multi-channel}
The usual matrix elements do not factorise with respect to their integration
variables, thus making an direct integration ansatz with VEGAS
unfavorable.\footnote{One prerequisite for the VEGAS algorithm is that the
integral factorises, and such produces only the best results for those.} Instead, we
apply the multichannel ansatz and let VEGAS integrate each channel in a
factorising mapping.
The different structures of the matrix element are separated by a partition of
unity and the respective mappings, such that each structure factorise at least
once. We define the mappings $\phi_i : U \mapsto \Omega$, where $U$ is the unit
hypercube and $\Omega$ the physical phase space. We refer to each mapping as a
\textit{channel}. Each channel then gives rise to a probability density $g_i : U
\mapsto [0, \infty)$, normalised to unity
\begin{equation*}
\int_0^1 g_i(\phi_i^{-1}(p)) \left| \frac{\partial \phi_i^{-1}}{\partial p} \right| \mathrm{d}\mu(p) = 1, \quad g_i(\phi_i^{-1}(p)) \geq 0,
\end{equation*}
written for a phase space point $p$ using the mapping $\phi_i$.
The \textit{a-priori} channel weights $\alpha_i$ are defined as partition of
unity by $\sum_{i\in I} \alpha_i = 1$ and $0 \leq \alpha_i \leq 1$. The overall
probability density $g$ of a random sample is then obtained by
\begin{equation*}
g(p) = \sum_{i \in I} \alpha_i g_i(\phi_i^{-1}(p)) \left| \frac{\partial \phi_i^{-1}}{\partial p} \right|,
\end{equation*}
which is also a non-negative and normalized probability density.
We reformulate the integral
\begin{equation*}
I(f) = \sum_{i \in I} \alpha_i \int_\Omega g_i(\phi_i^{-1}(p)) \left| \frac{\partial \phi_i^{-1}}{\partial p} \right| \frac{f(p)}{g(p)} \mathrm{d}\mu(p).
\end{equation*}
The actual integration of each channel is then done by VEGAS, which shapes the $g_i$.
\subsection{VEGAS}
\label{sec:vegas}
VEGAS is an adaptive and iterative Monte Carlo algorithm for integration using
importance sampling. After each iteration, VEGAS adapts the probability density
$g_i$ using information collected while sampling. For independent
integration variables, the probability density factorises $g_i = \prod_{j =
1}^{d} g_{i,j}$ for each integration axis and each (independent) $g_{i,j}$ is
defined by a normalised step function
\begin{equation*}
g_{i,j} (x_j) = \frac{1}{N\Delta x_{j,k}}, \quad x_{j,k} - \Delta x_{j,k} \leq x_{j} < x_{j,k},
\end{equation*}
where the steps are $0 = x_{j, 0} < \cdots < x_{j,k} < \cdots < x_{j,N} = 1$ for
each dimension $j$.
The algorithm randomly selects for each dimension a bin and a position inside
the bin and calculates the respective $g_{i,j}$.
\subsection{Channel equivalences}
\label{sec:equivalences}
The automated mulitchannel phasespace configuration can lead to a surplus of
degrees of freedom, e.g. for a highly complex process with a large number of
channels (VBS). In order to marginalize the redundant degrees of freedom of
phasespace configuration, the adaptation distribution of the grids are aligned in accordance to their
phasespace relation, hence the binning of the grids is equialized. These equivalences are activated by
default for \vamp{} and \vamptwo{}, but can be steered by:
\begin{code}
?use_vamp_equivalences = true
\end{code}
Be aware, that the usage of equivalences are currently only possible for LO
processes.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Phase space parameterizations}
\section{General remarks}
\whizard\ as a default performs an adaptive multi-channel Monte-Carlo
integration. Besides its default phase space algorithm, \ttt{wood}, to
be detailed in Sec.~\ref{sec:wood}, \whizard\ contains a phase space
method \ttt{phs\_none} which is a dummy method that is intended for
setups of processes where no phase space integration is needed, but
the program flow needs a (dummy) integrator for internal
consistency. Then, for testing purposes, there is a single-channel
phase space integrator, \ttt{phs\_single}. From version 2.6.0 of
\whizard\ on, there is also a second implementation of the \ttt{wood}
phase space algorithm, called \ttt{fast\_wood},
cf. Sec.~\ref{sec:fast_wood}, whose implementation differs technically
and which therefore solves certain technical flaws of the \ttt{wood}
implementation.
\section{The default method: \ttt{wood}}
\label{sec:wood}
The \ttt{wood} algorithm classifies different phase space channels
according to their importance for a full scattering or decay process
following heuristic rules. For that purpose, \whizard\ investigates
the kinematics of the different channels depending on the total
center-of-mass energy (or the mass of the decaying particle) and the
masses of the final-state particles.
The \ttt{wood} phase space inherits its name from the naming schemes
of structures of increasing complexities, namely trees, forests and
groves. Simply stated, a phase-space forest is a collection of
phase-space trees. A phase-space tree is a parameterization for a
valid channel in the multi-channel adaptive integration, and each
variable in the a tree corresponds to an integration dimension,
defined by an appropriate mapping of the $(0,1)$ interval of the unit
hypercube to the allowed range of the corresponding integration
variable. The whole set of these phase-space trees, collected in a
phase-space forest object hence contains all parameterizations of the
phase space that \whizard\ will use for a single hard process. Note
that processes might contain flavor sums of particles in the final
state. As \whizard\ will use the same phase space parameterization for
all channels for this set of subprocesses, all particles in those
flavor sums have to have the same mass. E.g. in the definition of a
"light" jet consisting of the first five quarks and antiquarks,
\begin{code}
alias jet = u:d:s:c:b:U:D:S:C:B
\end{code}
all quarks including strange, charm and bottom have to be massless for
the phase-space integration. \whizard\ can treat processes with
subprocesses having final-state particles with different masses in an
"additive" way, where each subprocess will become a distinct component
of the whole process. Each process component will get its own
phase-space parameterization, such that they can allow for different
masses. E.g. in a 4-flavor scheme for massless $u,d,s,c$ quarks one
can write
\begin{code}
alias jet = u:d:s:c:U:D:S:C
process eeqq = e1, E1 => (jet, jet) + (b, B)
\end{code}
In that case, the parameterizations will be for massless final state
quarks for the first subprocess, and for massive $b$ quarks for the
second subprocess. In general, for high-energy lepton colliders, the
difference would not matter much, but performing the integration
e.g. for $\sqrt{s} = 11$ GeV, the difference will be
tremendous. \whizard\ avoids inconsistent phase-space
parameterizations in that way.
As a multi-particle process will contain hundred or thousands of
different channels, the different integration channels (trees) are
grouped into so called {\em groves}. All channels/trees in the same
grove share a common weight for the phase-space integration, following
the assumption that they are related by some approximate symmetry. The
\vamp\ adaptive multi-channel integrator (cf. Sec.~\ref{sec:vamp})
allows for equivalences between different integration channels. This
means that trees/channels that are related by an exact symmetry are
connected by an array of these equivalences.
The phase-space setup, i.e. the detailed structure of trees and
forests, are written by \whizard\ into a phase-space file that has the
same name as the corresponding process (or process component) with the
suffix \ttt{.phs}. For the \ttt{wood} phase-space method this file is
written by a \fortran\ module which constructs a similar tree-like
structure as the directed acyclical graphs (DAGs) in the
\oMega\ matrix element generator but in a less efficient way.
In some very rare cases with externally generated models
(cf. Chapter~\ref{chap:extmodels}) the phase-space generation has been
reported to fail as \whizard\ could not find a valid phase-space
channel. Such pathological cases cannot occur for the hard-coded model
implementations inside \whizard. They can only happen if there are in
principle two different Feynman diagrams contributing to the same
phase-space channel and \whizard\ considers the second one as
extremely subleading (and would hence drop it). If for some reason
however the first Feynman diagram is then absent, no phase-space
channel could be found. This problem cannot occur with the
\ttt{fast\_wood} implementation discussed in the next section,
cf.~\ref{sec:fast_wood}.
The \ttt{wood} algorithms orders the different groves of phase-space
channels according to a heuristic importance depending on the
kinematic properties of the different phase-space channels in the
groves. A phase-space (\ttt{.phs}) file looks typically like this:
\begin{code}
process sm_i1
! List of subprocesses with particle bincodes:
! 8 4 1 2
! e+ e- => mu+ mu-
! 8 4 1 2
md5sum_process = "1B3B7A30C24664A73D3D027382CFB4EF"
md5sum_model_par = "7656C90A0B2C4325AD911301DACF50EB"
md5sum_phs_config = "6F72D447E8960F50FDE4AE590AD7044B"
sqrts = 1.000000000000E+02
m_threshold_s = 5.000000000000E+01
m_threshold_t = 1.000000000000E+02
off_shell = 2
t_channel = 6
keep_nonresonant = T
! Multiplicity = 2, no resonances, 0 logs, 0 off-shell, s-channel graph
grove #1
! Channel #1
tree 3
! Multiplicity = 1, 1 resonance, 0 logs, 0 off-shell, s-channel graph
grove #2
! Channel #2
tree 3
map 3 s_channel 23 ! Z
\end{code}
The first line contains the process name, followed by a list of
subprocesses with the external particles and their binary codes. Then
there are three lines of MD5 check sums, used for consistency
checks. \whizard\ (unless told otherwise) will check for the existence
of a phase-space file, and if the check sum matches, it will reuse the
existing file and not generate it again. Next, there are several
kinematic parameters, namely the center-of-mass energy of the process,
\ttt{sqrts}, and two mass thresholds, \ttt{m\_threshold\_s} and
\ttt{m\_threshold\_t}. The latter two are kinematical thresholds,
below which \whizard\ will consider $s$-channel and $t$-channel-like
kinematic configurations as effectively massless, respectively. The
default values shown in the example have turned out to be optimal
values for Standard Model particles. The two integers \ttt{off\_shell}
and \ttt{t\_channel} give the number of off-shell lines and of
$t$-channel lines that \whizard\ will allow for finding valid
phase-space channels, respectively. This neglects extremley multi-peripheral
background-like diagram constellations which are very subdominamnt
compared to resonant signal processes. The final flags specifies
whether \whizard\ will keep non-resonant phase-space channels
(default), or whether it will focus only on resonant situations.
After this header, there is a list of all groves, i.e. collections of
phase-space channels which are connected by quasi-symmetries, together
with the corresponding multiplicity of subchannels in that
grove. In the phase-space file, Behind the multiplicity
\whizard\ denotes the number of (massive) resonances, logarithmcally
enhanced kinematics (e.g. collinear regions), and number of off-shell
lines, respectively. The final entry in the grove header notifies
whether the diagrams in that grove have $s$-channel topologies, or
count the number of corresponding $t$-channel lines.
Another example is shown here,
\begin{code}
! Multiplicity = 3, no resonances, 2 logs, 0 off-shell, 1 t-channel line
grove #1
! Channel #1
tree 3 12
map 3 infrared 22 ! A
map 12 t_channel 2 ! u
! Channel #2
tree 3 11
map 3 infrared 22 ! A
map 11 t_channel 2 ! u
! Channel #3
tree 3 20
map 3 infrared 22 ! A
map 20 t_channel 2 ! u
! Channel #4
tree 3 19
map 3 infrared 22 ! A
map 19 t_channel 2 ! u
\end{code}
where \whizard\ notifies in different situations a photon exchange as
\ttt{infrared}. So it detects a possible infrared singularity where a
particle can become arbitrarily soft. Such a situation can tell the
user that there might be a cut necessary in order to get a meaningful
integration result.
The phase-space setup that is generated and used by the \ttt{wood}
phase-space method can be visualized using the \sindarin\ option
\begin{code}
?vis_channels = true
\end{code}
The \ttt{wood} phase-space method can be invoked with the
\sindarin\ command
\begin{code}
$phs_method = "wood"
\end{code}
Note that this line is unnecessary, as \ttt{wood} is the default
phase-space method of \whizard.
%%%%%
\section{A new method: \ttt{fast\_wood}}
\label{sec:fast_wood}
This method (which is available from version 2.6.0 on) is an
alternative implementation of the \ttt{wood} phase-space algorithm. It
uses the recursive structures inside the \oMega\ matrix element
generator to generate all the structures needed for the different
phase-space channels. In that way, it can avoid some of the
bottlenecks of the \ttt{wood} \fortran\ implementation of the
algorithm. On the other hand, it is only available if the
\oMega\ matrix element generator has been enabled (which is the
default for \whizard). The \ttt{fast\_wood} method is then invoked via
\begin{code}
?omega_write_phs_output = true
$phs_method = "fast_wood"
\end{code}
The first option is necessary in order to tell \oMega\ to write out
the output needed for the \ttt{fast\_wood} parser in order to generate
the phase-space file. This is not enabled by default in order not to
generate unnecessary files in case the default method \ttt{wood} is
used.
So the \ttt{fast\_wood} implementation of the \ttt{wood} phase-space
algorithm parses the tree-like represenation of the recursive set of
one-particle off-shell wave functions that make up the whole amplitude
inside \oMega\ in the form of a directed acyclical graph (DAG) in
order to generate the phase-space (\ttt{.phs}) file
(cf. Sec.~\ref{sec:wood}). In that way, the algorithm makes sure that
only phase-space channels are generated for which there are indeed
(sub)amplitudes in the matrix elements, and this also allows to
exclude vetoed channels due to restrictions imposed on the matrix
elements from the phase-space setup (cf. next
Sec.~\ref{sec:ps_restrictions}.
%%%%%
\section{Phase space respecting restrictions on subdiagrams}
\label{sec:ps_restrictions}
The \fortran\ implementation of the \ttt{wood} phase-space does not
know anything about possible restrictions that maybe imposed on the
\oMega\ matrix elements, cf. Sec.~\ref{sec:process options}.
Consequently, the \ttt{wood} phase space also generates phase-space
channels that might be absent when restrictions are imposed. This is
not a principal problem, as in the adaptation of the phase-space
channels \whizard's integrator \vamp\ will recognize that there is
zero weight in that channel and will drop the channel (stop sampling
in that channel) after some iterations. However, this is a waste of
ressources as it is in principle known that this channel is
absent. Using the \ttt{fast\_wood} phase-space algorithm
(cf. Sec.~\ref{sec:fast_wood} will take restrictions into account, as
\oMega\ will not generate trees for channels that are removed with the
restrictions command. So it advisable for the user in the case of very
complicated processes with restrictions to use the \ttt{fast\_wood}
phase-space method to make \whizard\ generation and integration of the
phase space less cumbersome.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Methods for Hard Interactions}
\label{chap:hardint}
The hard interaction process is the core of any physics simulation
within an MC event generator. One tries to describe the dominant
particle interaction in the physics process of interest at a given
order in perturbation theory, thereby making use of field-theoretic
factorization theorems, especially for QCD, in order to separate
non-perturbative physics like parton distribution functions (PDFs) or
fragmentation functions from the perturbative part. Still, it is in
many cases not possible to describe the perturbative part completely
by means of fixed-order hard matrix elements: in soft and/or collinear
regions of phase space, multiple emission of gluons and quarks (in
general QCD jets) and photons necessitates a resummation, as large
logarithms accompany the perturbative coupling constants and render
fixed-order perturbation theory unreliable. The resummation of these
large logarithms can be done analytically or (semi-)numerically,
however, usually only for very inclusive quantities. At the level of
exclusive events, these phase space regions are the realm of (QCD and
also QED) parton showers that approximate multi-leg matrix elements
from the hard perturbative into to the soft-/collinear regime.
The hard matrix elements are then the core building blocks of the
physics description inside the MC event generator. \whizard\ generates
these hard matrix elements at tree-level (or sometimes for
loop-induced processes using effective operators as insertions) as
leading-order processes. This is done by the \oMega\ subpackage that
is automatically called by \whizard. Besides these physical matrix
elements, there exist a couple of methods to generate dummy matrix
elements for testing purposes, or for generating beam profiles and
using them with externally linked special matrix elements.
Especially for one-loop processes (next-to-leading order for
tree-allowed processes or leading-order for loop-induced processes),
\whizard\ allows to use matrix elements from external providers, so
called OLP programs (one-loop providers). Of course, all of these
external packages can also generate tree-level matrix elements, which
can then be used as well in \whizard.
We start the discussion with the two different options for test matrix
elements, internal test matrix elements with no generated compiled code
in Sec.~\ref{sec:unit_me} and so called template matrix elements with
actual \fortran\ code that is compiled and linked, and can also be
modified by the user in Sec.~\ref{sec:template_me}. Then, we move to
the main matrix element method by the matrix element generator
\oMega\ in Sec.~\ref{sec:omega_me}. Matrix elements from the external
matrix element generators are discussed in the order of which
interfaces for the external tools have been implemented: \gosam\ in
Sec.~\ref{sec:gosam_me}, \openloops\ in Sec.~\ref{sec:openloops_me},
and \recola\ in Sec.~\ref{sec:recola_me}.
%%%%%
\section{Internal test matrix elements}
\label{sec:test_me}
This method is merely for internal consistency checks inside \whizard,
and is not really intended to be utilized by the user. The method is
invoked by
\begin{code}
$method = "unit_test"
\end{code}
This particular method is only applicable for the internal test model
\ttt{Test.mdl}, which just contains a Higgs boson and a top
quark. Technically, it will also works within model specifications
for the Standard Model, or the Minimal Supersymmetric Standard Model
(MSSM), or all models which contain particles named as \ttt{H} and
\ttt{t} with PDG codes 25 and 6, respectively. So, the models
\ttt{QED} and {QCD} will not work. Irrespective of what is given in
the \sindarin\ file as a scattering input process, \whizard\ will
always take the process
\begin{code}
model = SM
process <proc_name>= H, H => H, H
\end{code}
or for the test model:
\begin{code}
model = Test
process <proc_name>= s, s => s, s
\end{code}
as corresponding process. (This is the same process, just with
differing nomenclature in the different models). No matrix element
code is generated and compiled, the matrix element is completely
internal, included in the \whizard\ executable (or library), with a
unit value for the squared amplitude. The integration will always be
performed for this particularly process, even if the user provides a
different process for that method. Hence, the result will always be
the volume of the relativistic two-particle phase space. The only two
parameters that influence the result are the collider energy,
\ttt{sqrts}, and the mass of the Higgs particle with PDG code 25 (this
mass parameter can be changed in the model \ttt{Test} as \ttt{ms},
while it would be \ttt{mH} in the Standard Model \ttt{SM}.
It is also possible to use a test matrix element, again internal, for
decay processes, where again \whizard\ will take a predefined process:
\begin{code}
model = SM
process <proc_name> = H => t, tbar
\end{code}
in the \ttt{SM} model or
\begin{code}
model = Test
process <proc_name> = s => f, fbar
\end{code}
Again, this is the same process with PDG codes $25 \to 6 \; -6$ in the
corresponding models. Note that in the model \ttt{SM} the mass of the
quark is set via the variable \ttt{mtop}, while it is \ttt{mf} in the
model \ttt{Test}.
Besides the fact that the user always gets a fixed process and cannot
modify any matrix element code by hand, one can do all things as for a
normal process like generating events, different weights, testing
rebuild flags, using different setups and reweight events
accordingly. Also factorized processes with production and decay can
be tested that way.
In order to avoid confusion, it is highly recommended to use this
method \ttt{unit\_test} only with the test model setup, model
\ttt{Test}.
On the technical side, the method \ttt{unit\_test} does not produce a
process library (at least not an externally linked one), and also not
a makefile in order to modify any process files (which anyways do not
exist for that method). Except for the logfiles and the phase space
file, all files are internal.
%%%%%
\section{Template matrix elements}
\label{sec:template_me}
Much more versatile for the user than the previous matrix element
method in~\ref{sec:test_me}, are two different methods with constant
template matrix elements. These are written out as \fortran\ code by
the \whizard\ main executable (or library), providing an interface
that is (almost) identical to the matrix element code produced by the
\oMega\ generator (cf. the next section,
Sec.~\ref{sec:omega_me}. There are actually two different methods for
that purpose, providing matrix elements with different normalizations:
\begin{code}
$method = "template"
\end{code}
generates matrix elements which give after integration over phase
space exactly one. Of course, for multi-particle final states the
integration can fluctuate numerically and could then give numbers that
are only close to one but not exactly one. Furthermore, the
normalization is not exact if any of the external particles have
non-zero masses, or there are any cuts involved. But otherwise, the
integral from \whizard\ should give unity irrespective of the number
of final state particles.
In contrast to this, the second method,
\begin{code}
$method = "template_unity"
\end{code}
gives a unit matrix elements, or rather a matrix element that contains
helicity and color averaging factors for the initial state and the
square root of the factorials of identical final state particles in
the denominator. Hence, integration over the final state momentum
configuration gives a cross section that corresponds to the volume of
the $n$-particle final state phase space, divided by the corresponding
flux factor, resulting in
\begin{equation}
\sigma(s, 2 \to 2,0) = \frac{3.8937966\cdot 10^{11}}{16\pi} \cdot
\frac{1}{s \text{[GeV]}^2} \; \text{fb}
\end{equation}
for the massless case and
\begin{equation}
\sigma(s, 2 \to 2,m_i) = \frac{3.8937966\cdot 10^{11}}{16\pi} \cdot
\sqrt{\frac{\lambda (s,m_3^2,m_4^2)}{\lambda (s,m_1^2,m_2^2)}}
\cdot \frac{1}{s \text{[GeV]}^2} \; \text{fb}
\end{equation}
for the massive case. Here, $m_1$ and $m_2$ are the masses of the
incoming, $m_3$ and $m_4$ the masses of the outgoing particles, and
$\lambda(x,y,z) = x^2 + y^2 + z^2 - 2xy - 2xz - 2yz$.
For the general massless case with no cuts, the integral should be
exactly
\begin{equation}
\sigma(s, 2\to n, 0) = \frac{(2\pi)^4}{2 s}\Phi_n(s)
= \frac{1}{16\pi s}\,\frac{\Phi_n(s)}{\Phi_2(s)},
\end{equation}
where the volume of the massless $n$-particle phase space is
given by
\begin{equation}\label{phi-n}
\Phi_n(s) = \frac{1}{4(2\pi)^5} \left(\frac{s}{16\pi^2}\right)^{n-2}
\frac{1}{(n-1)!(n-2)!}.
\end{equation}
For $n\neq2$ the phase space volume is dimensionful, so the
units of the integral are $\fb\times\GeV^{2(n-2)}$. (Note that for
physical matrix elements this is compensated by momentum factors from
wave functions, propagators, vertices and possibly dimensionful
coupling constants, but here the matrix element is just equal to
unity.)
Note that the phase-space integration for the \ttt{template} and
\ttt{template\_unity} matrix element methods is organized in the same
way as it would be for the real $2\to n$ process. Since such a phase
space parameterization is not optimized for the constant matrix
element that is supplied instead, good convergence is not guaranteed.
(Setting \ttt{?stratified = true} may be helpful here.)
The possibility to call a dummy matrix element with this method allows
to histogram spectra or structure functions: Choose a trivial process
such as $uu\to dd$, select the \ttt{template\_unity} method, switch
on structure functions for one (or both) beams, and generate events.
The distribution of the final-state mass squared reflects the $x$
dependence of the selected structure function.
Furthermore, the constant in the source code of the unit matrix
elements can be easily modified by the user with their \fortran\ code
in order to study customized matrix elements. Just rerun
\whizard\ with the \ttt{--recompile} option after the modification of
the matrix element code.
Both methods, \ttt{template} and \ttt{template\_unity} will also work
even if no \ocaml\ compiler is found or used and consequently the
\oMega\ matrix elemente generator (cf. Sec.~\ref{sec:omega_me} is
disable. The methods produce a process library for their corresponding
processes, and a makefile, by which \whizard\ steers compilation and
linking of the process source code.
%%%%%
\section{The O'Mega matrix elements}
\label{sec:omega_me}
\oMega\ is a subpackage of \whizard, written in \ocaml, which can
produce matrix elements for a wide class of implemented physics models
(cf. Sec.~\ref{sec:smandfriends} and \ref{sec:bsmmodels} for a list of
all implemented physics models), and even almost arbitrary models when
using external Lagrange level tools, cf. Chap.~\ref{chap:extmodels}.
There are two different variants for matrix elements from \oMega:
the first one is invoked as
\begin{code}
$method = "omega"
\end{code}
and is the default method for \whizard. It produces matrix element as
\fortran\ code which is then compiled and linked. An alternative
method, which for the moment is only available for the Standard Model
and its variants as well models which are quite similar to the SM,
e.g. the Two-Higgs doublet model or the Higgs-singlet extension. This
method is taken when setting
\begin{code}
$method = "ovm"
\end{code}
The acronym \ttt{ovm} stands for \oMega\ Virtual Machine (OVM). The
first (default) method (\ttt{omega}) of \oMega\ matrix elements
produces \fortran\ code for the matrix elements,that is compiled by
the same compiler with which \whizard\ has been compiled. The OVM
method (\ttt{ovm}) generates an \ttt{ASCII} file with so called op
code for operations. These are just numbers which tell what numerical
operations are to be performed on momenta, wave functions and vertex
expression in order to yield a complex number for the amplitude. The
op codes are interpreted by the OVM in the same as a Java Virtual
Machine. In both cases, a compiled \fortran\ is generated which for
the \ttt{omega} method contains the full expression for the matrix
element as \fortran\ code, while for the \ttt{ovm} method this is the
driver file of the OVM. Hence, for the \ttt{ovm} method this file
always has roughly the same size irrespective of the complexity of the
process. For the \ttt{ovm} method, there will also be the \ttt{ASCII}
file that contains the op codes, which has a name with an \ttt{.hbc}
suffix: \ttt{<process\_name>.hbc}.
For both \oMega\ methods, there will be a process library created as
for the template matrix elements (cf. Sec.~\ref{sec:template_me})
named \ttt{default\_lib.f90} which can be given a user-defined name
using the \ttt{library = "<library>"} command. Again, for both methods
\ttt{omega} and \ttt{ovm}, a makefile named
\ttt{<library>\_lib.makefile} is generated by which \whizard\ steers
compilation, linking and clean-up of the process sources. This
makefile can handily be adapted by the user in case she or he wants to
modify the source code for the process (in the case of the source code
method).
Note that \whizard's default ME method via \oMega\ allows the user to
specify many different options either globally for all processes in
the \sindarin, or locally for each process separately in curly
brackets behind the corresponding process definition. Examples are
\begin{itemize}
\item
Restrictions for the matrix elements like the exclusion of
intermediate resonances, the appearance of specific vertices or
coupling constants in the matrix elments. For more details on this
cf. Sec.~\ref{subsec:restrictions}.
\item
Choice of a specific scheme for the width of massive intermediate
resonances, whether to use constant width, widths only in
$s$-channel like kinematics (this is the default), a fudged-width
scheme or the complex-mass scheme. The latter is actually steered as
a specific scheme of the underlying model and not with a specific
\oMega\ command.
\item
Choice of the electroweak gauge for the amplitude. The default is
the unitary gauge.
\end{itemize}
With the exception of the restrictions steered by the
\ttt{\$restrictions = "<restriction>"} string expression, these options
have to be set in their specific \oMega\ syntax verbatim via the
string command \ttt{\$omega\_flags = "<expr>"}.
%%%%%
\section{Interface to GoSam}
\label{sec:gosam_me}
One of the supported methods for automated matrix elements from
external providers is for the \gosam\ package. This program package
which is a combination of \python\ scripts and \fortran\ libraries,
allows both for tree and one-loop matrix elements (which is leading or
next-to-leading order, depending on whether the corresponding process
is allowed at the tree level or not). In principle, the advanced
version of \gosam\ also allows for the evaluation of two-loop virtual
matrix elements, however, this is currently not supported in
\whizard. This method is invoked via the command
\begin{code}
$method = "gosam"
\end{code}
Of course, this will only work correctly of \gosam\ with all its
subcomponents has been correctly found during configuration of
\whizard\ and then subsequently correctly linked.
In order to generate the tables for spin, flavor and color states for
the corresponding process, first \oMega\ is called to provide
\fortran\ code for the interfaces to all the metadata for the
process(es) to be evaluated. Next, the \gosam\ \python\ script is
automatically invoked that first checks for the necessary ingredients
to produce, compile and link the \gosam\ matrix elements. These are
the the \ttt{Qgraf} topology generator for the diagrams, \ttt{Form} to
perform algebra, the \ttt{Samurai}, \ttt{AVHLoop}, \ttt{QCDLoop} and
\ttt{Ninja} libraries for Passarino-Veltman reduction, one-loop tensor
integrals etc. As a next step, \gosam\ automatically writes and
executes a \ttt{configure} script, and then it exchanges the Binoth
Les Houches accord (BLHA) contract files between \whizard\ and
itself~\cite{Binoth:2010xt,Alioli:2013nda} to check whether it
actually generate code for the demanded process at the given
order. Note that the contract and answer files do not have to be
written by the user by hand, but are generated automatically within
the program work flow initiated by the original
\sindarin\ script. \gosam\ then generates \fortran\ code for the
different components of the processes, compiles it and links it into a
library, which is then automatically accessible (as an external
process library) from inside \whizard. The phase space setup and the
integration as well as the LO (and NLO) event generation work then in
exactly the same way as for \oMega\ matrix elements.
As an NLO calculation consists of different components for the Born,
the real correction, the virtual correction, the subtraction part and
possible further components depending on the details of the
calculation, there is the possible to separately choose the matrix
element method for those components via the keywords
\ttt{\$loop\_me\_method}, \ttt{\$real\_tree\_me\_method},
\ttt{\$correlation\_me\_method} etc. These
keywords overwrite the master switch of the \ttt{\$method} keyword.
For more information on the switches and details of the functionality
of \gosam, cf. \url{http://gosam.hepforge.org}.
%%%%%
\section{Interface to Openloops}
\label{sec:openloops_me}
Very similar to the case of \gosam, cf. Sec.~\ref{sec:gosam_me}, is
the case for \openloops\ matrix elements. Also here, first \oMega\ is
called in order to provide an interface for the spin, flavor and color
degrees of freedom for the corresponding process. Information exchange
between \whizard\ and \openloops\ then works in the same automatic way
as for \gosam\ via the BLHA interface. This matrix element method is
invoked via
\begin{code}
$method = "openloops"
\end{code}
This again is the master switch that will tell \whizard\ to use
\openloops\ for all components, while there are special keywords to
tailor-make the setup for the different components of an NLO
calculation (cf. Sec.~\ref{sec:gosam_me}.
The main difference between \openloops\ and \gosam\ is that for
\openloops\ there is no process code to be generated, compiled and
linked for a process, but a precompiled library is called and linked,
e.g. \ttt{ppll} for the Drell-Yan process. Of course, this library has
to be installed on the system, but if that is not the case, the user
can execute the \openloops\ script in the source directory of
\openloops\ to download, compile and link the corresponding dynamic
library. This limits (for the moment) the usage of \openloops\ to
processes where pre-existint libraries for that specific processes
have been generated by the \openloops\ authors. A new improved
generator for general process libraries for \openloops\ will get rid
of that restriction.
For more information on the installation, switches and details of the
functionality of \openloops, cf. \url{http://openloops.hepforge.org}.
%%%%%
\section{Interface to Recola}
\label{sec:recola_me}
The third one-loop provider (OLP) for external matrix elements that
is supported by \whizard, is \recola. In contrast to \gosam,
cf. Sec.~\ref{sec:gosam_me}, and \openloops,
cf. Sec.~\ref{sec:openloops_me}, \recola\ does not use a BLHA
interface to exchange information with \whizard, but its own
tailor-made C interoperable library interface to communicate to the
Monte Carlo side. \recola\ matrix elements are called for via
\begin{code}
$method = "recola"
\end{code}
\recola\ uses a highly efficient algorithm to generate process code
for LO and NLO SM amplitudes in a fully recursive manner. At the
moment, the setup of the interface within \whizard\ does not allow to
invoke more than one different process in \recola: this would lead to
a repeated initialization of the main setup of \recola\ and would
consequently crash it. It is foreseen in the future to have a
safeguard mechanism inside \whizard\ in order to guarantee
initialization of \recola\ only once, but this is not yet
implemented.
Further information on the installation, details and parameters of
\recola\ can be found at \url{http://recola.hepforge.org}.
%%%%%
\section{Special applications}
\label{sec:special_me}
There are also special applications with combinations of matrix
elements from different sources for dedicated purposes like e.g. for
the matched top--anti-top threshold in $e^+e^-$. For this special
application which depending on the order of the matching takes only
\oMega\ matrix elements or at NLO combines amplitudes from \oMega\ and
\openloops, is invoked by the method:
\begin{code}
$method = "threshold"
\end{code}
\newpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Implemented physics}
\label{chap:physics}
%%%%%
\section{The hard interaction models}
In this section, we give a brief overview over the different
incarnations of models for the description of the realm of subatomic
particles and their interactions inside \whizard. In
Sec.~\ref{sec:smandfriends}, the Standard Model (SM) itself and
straightforward extensions and modifications thereof in the gauge,
fermionic and Higgs sector are described. Then,
Sec.~\ref{sec:bsmmodels} gives a list and short description of all
genuine beyond the SM models (BSM) that are currently implemented in
\whizard\ and its matrix element generator \oMega. Additional models
beyond that can be integrated and handled via the interfaces to
external tools like \sarah\ and \FeynRules, or the universal model
format \UFO, cf. Chap.~\ref{chap:extmodels}.
%%%%%%%%%%%%%%%
\subsection{The Standard Model and friends}
\label{sec:smandfriends}
%%%%
\subsection{Beyond the Standard Model}
\label{sec:bsmmodels}
\begin{table}
\begin{center}
\begin{tabular}{|l|l|l|}
\hline
MODEL TYPE & with CKM matrix & trivial CKM \\
\hline\hline
Yukawa test model & \tt{---} & \tt{Test} \\
\hline
QED with $e,\mu,\tau,\gamma$ & \tt{---} & \tt{QED} \\
QCD with $d,u,s,c,b,t,g$ & \tt{---} & \tt{QCD} \\
Standard Model & \tt{SM\_CKM} & \tt{SM} \\
SM with anomalous gauge couplings & \tt{SM\_ac\_CKM} &
\tt{SM\_ac} \\
SM with $Hgg$, $H\gamma\gamma$, $H\mu\mu$, $He^+e^-$ &
\tt{SM\_Higgs\_CKM} & \tt{SM\_Higgs} \\
SM with bosonic dim-6 operators & \tt{---} &
\tt{SM\_dim6} \\
SM with charge 4/3 top & \tt{---} &
\tt{SM\_top} \\
SM with anomalous top couplings & \tt{---} &
\tt{SM\_top\_anom} \\
SM with anomalous Higgs couplings & \tt{---} &
\tt{SM\_rx}/\tt{NoH\_rx}/\tt{SM\_ul} \\\hline
SM extensions for $VV$ scattering & \tt{---} &
\tt{SSC}/\tt{AltH}/\tt{SSC\_2}/\tt{SSC\_AltT} \\\hline
SM with $Z'$ & \tt{---} & \tt{Zprime} \\
\hline
Two-Higgs Doublet Model & \tt{THDM\_CKM} & \tt{THDM} \\ \hline\hline
MSSM & \tt{MSSM\_CKM} & \tt{MSSM} \\
\hline
MSSM with gravitinos & \tt{---} & \tt{MSSM\_Grav} \\
\hline
NMSSM & \tt{NMSSM\_CKM} & \tt{NMSSM} \\
\hline
extended SUSY models & \tt{---} & \tt{PSSSM} \\
\hline\hline
Littlest Higgs & \tt{---} & \tt{Littlest} \\
\hline
Littlest Higgs with ungauged $U(1)$ & \tt{---} &
\tt{Littlest\_Eta} \\
\hline
Littlest Higgs with $T$ parity & \tt{---} &
\tt{Littlest\_Tpar} \\
\hline
Simplest Little Higgs (anomaly-free) & \tt{---} &
\tt{Simplest} \\
\hline
Simplest Little Higgs (universal) & \tt{---} &
\tt{Simplest\_univ} \\
\hline\hline
SM with graviton & \tt{---} & \tt{Xdim} \\
\hline
UED & \tt{---} & \tt{UED} \\
\hline
``SQED'' with gravitino & \tt{---} & \tt{GravTest} \\
\hline
Augmentable SM template & \tt{---} & \tt{Template} \\
\hline
\end{tabular}
\end{center}
\caption{\label{tab:models} List of models available in
\whizard. There are pure test models or models implemented
for theoretical investigations, a long list of SM variants
as well as a large number of BSM models.}
\end{table}
\subsubsection{Strongly Interacting Models and Composite Models}
Higgsless models have been studied extensively before the Higgs boson
discovery at the LHC Run I in 2012 in order to detect possible
loopholes in the electroweak Higgs sector discovery potential of this
collider. The Threesite Higgsless Model is one of the simplest
incarnations of these models, and was one of the first BSM models
beyond SUSY and Little Higgs models that have been implemented in
\whizard~\cite{Speckner:2010zi}. It is also called the Minimal
Higgsless Model (MHM)~\cite{Chivukula:2006cg} is a minimal
deconstructed Higgsless model which contains only the first resonance
in the tower of Kaluza-Klein modes of a Higgsless extra-dimensional
model. It is a non-renormalizable, effective theory whose
gauge group is an extension of the SM with an extra $SU(2)$ gauge
group. The breaking of the extended electroweak gauge symmetry is
accomplished by a set of nonlinear sigma fields which represent the
effects of physics at a higher scale and make the theory
nonrenormalizable. The physical vector boson spectrum contains the
usual photon, $W^\pm$ and $Z$ bosons as well as a $W'^\pm$ and $Z'$
boson. Additionally, a new set of heavy fermions are introduced to
accompany the new gauge group ``site'' which mix to form the physical
eigenstates. This mixing is controlled by the small mixing parameter
$\epsilon_L$ which is adjusted to satisfy constraints from precision
observables, such as the S parameter~\cite{Chivukula:2005xm}.
Here, additional weak gauge boson production at the LHC was
one of the focus of the studies with \whizard~\cite{Ohl:2008ri}.
\subsubsection{Supersymmetric Models}
\whizard/\oMega\ was the first multi-leg matrix-element/event
generator to include the full Minimal Supersymmetric Standard Model
(MSSM), and also the NMSSM. The SUSY implementations in \whizard\ have
been extensively tested~\cite{Ohl:2002jp,Reuter:2009ex}, and have been
used for many theoretical and experimental studies (some prime
examples
being~\cite{Kalinowski:2008fk,Robens:2008sa,Hagiwara:2005wg}.
\subsubsection{Little Higgs Models}
\subsubsection{Inofficial models}
There have been several models that have been included within the
\whizard/\oMega\ framework but never found their way into the official
release series. One famous example is the non-commutative extension of
the SM, the NCSM. There have been several studies, e.g. simulations on
the $s$-channel production of a $Z$ boson at the photon collider
option of the ILC~\cite{Ohl:2004tn}. Also, the production of
electroweak gauge bosons at the LHC in the framework of the NCSM have
been studied~\cite{Ohl:2010zf}.
%%%%%%%%%%%%%%%
\section{The SUSY Les Houches Accord (SLHA) interface}
\label{sec:slha}
To be filled in
...~\cite{Skands:2003cj,AguilarSaavedra:2005pw,Allanach:2008qq}.
The neutralino sector deserves special attention. After
diagonalization of the mass matrix expresssed in terms
of the gaugino and higgsino eigenstates, the resulting mass
eigenvalues may be either negative or positive. In this case, two
procedures can be followed. Either the masses are rendered
positive and the associated mixing matrix gets purely imaginary
entries or the masses are kept signed, the mixing matrix in this case
being real. According to the SLHA agreement, the second option is
adopted. For a specific eigenvalue, the phase is absorbed into the
definition of the relevant eigenvector, rendering the mass
negative. However, \whizard\ has not yet officially tested for
negative masses. For external SUSY models
(cf.~Chap.~\ref{chap:extmodels}) this means, that one must be careful
using a SLHA file with explicit factors of
the complex unity in the mixing matrix, and on the other hand,
real and positive masses for the neutralinos. For the hard-coded SUSY
models, this is completely handled internally. Especially
Ref.~\cite{Hagiwara:2005wg} discusses the details of the neutralino
(and chargino) mixing matrix.
%%%%%%%%%%%%%%%%
\section{Lepton Collider Beam Spectra}
\label{sec:beamspectra}
For the simulation of lepton collider beam spectra there are two
dedicated tools, \circeone\ and \circetwo\ that have been written as
in principle independent tools. Both attempt to describe the
details of electron (and positron) beams in a realistic lepton
collider environment. Due to the quest for achieving high peak
luminosities at $e^+e^-$ machines, the goal is to make the spatial
extension of the beam as small as possible but keeping the area of the
beam roughly constant. This is achieved by forcing the beams in the
final focus into the shape of a quasi-2D bunch. Due to the high charge
density in that bunch, the bunch electron distribution is modified by
classical electromagnetic radiation, so called {\em beamstrahlung}.
The two \circe\ packages are intended to perform a simulation of this
beamstrahlung and its consequences on the electron beam spectrum as
realistic as possible. More details about the two packages can be
found in their stand-alone documentations. We will discuss the basic
features of lepton-collider beam simulations in the next two sections,
including the technicalities of passing simulations of the machine
beam setup to \whizard. This will be followed by a section on the
simulation of photon collider spectra, included for historical
reasons.
%%%%%
\subsection{\circeone}
While the bunches in a linear collider cross only once, due to their
small size they experience a strong beam-beam effect. There is a
code to simulate the impact of this effect on luminosity and
background, called
\ttt{GuineaPig++}~\cite{Schulte:1998au,Schulte:1999tx,Schulte:2007zz}.
This takes into account the details of the accelerator, the final
focus etc. on the structure of the beam and the main features of the
resulting energy spectrum of the electrons and positrons. It offers
the state-of-the-art simulation of lepton-collider beam spectra as
close as possible to reality. However, for many high-luminosity
simulations, event files produced with \ttt{GuineaPig++} are usually
too small, in the sense that not enough independent events are
available for physics simulations. Lepton collider beam spectra do
peak at the nominal beam energy ($\sqrt{s}/2$) of the collider, and
feature very steeply falling tails. Such steeply falling distributions
are very poorly mapped by histogrammed distributions with fixed bin
widths.
The main working assumption to handle such spectra are being followed
within \circeone:
\begin{enumerate}
\label{circe1_assumptions}
\item The beam spectra for the two beams $P_1$ and $P_2$ factorize
(here $x_1$ and $x_2$ are the energy fractions of the two beams,
respectively):
\begin{equation*}
D_{P_1P_2} (x_1, x_2) = D_{P_1} (x_1) \cdot D_{P_2} (x_2)
\end{equation*}
\item
The peak is described with a delta distribution, and the tail with a
power law:
\begin{equation*}
D(x) = d \cdot \delta(1-x) \; + \; c \cdot x^\alpha \, (1-x)^\beta
\end{equation*}
\end{enumerate}
The two powers $\alpha$ and $\beta$ are the main coefficients that can
be tuned in order to describe the spectrum with \circeone\ as close as
possible as the original \ttt{GuineaPig++} spectrum. More details
about how \circeone\ works and what it does can be found in its own
write-up in \ttt{circe1/share/doc}.
\subsection{\circetwo}
The two conditions listed in \ref{circe1_assumptions} are too
restrictive and hence insufficient to describe more complicated
lepton-collider beam spectra, as they e.g. occur in the CLIC
drive-beam design. Here, the two beams are highly correlated and also
a power-law description does not give good enough precision for the
tails. To deal with these problems, \circetwo\ starts with a
two-dimensional histogram featuring factorized, but variable bin
widths in order to simulate the steep parts of the
distributions. The limited statistics from too small
\ttt{GuineaPig++} event output files leads to correlated
fluctuations that would leave strange artifacts in the
distributions. To abandon them, Gaussian filters are applied to smooth
out the correlated fluctuations. Here care has to be taken when going
from the continuum in $x$ momentum fraction space to the corresponding
\begin{figure}
\centering
\includegraphics{circe2-smoothing}
\caption{\label{fig:circe2-smoothing}
Smoothing the bin at the $x_{e^+} = 1$ boundary with Gaussian
filters of 3 and 10 bins width compared to no smoothing.}
\end{figure}
boundaries: separate smoothing procedures are being applied to the
bins in the continuum region and those in the boundary in order to
avoid artificial unphysical beam energy
spreads. Fig.~\ref{fig:circe2-smoothing} shows the smoothing of the
distribution for the bin at the $x_{e^+} = 1$ boundary. The blue dots
show the direct \ttt{GuineaPig++} output comprising the
fluctuations due to the low statistics. Gaussian filters with widths
of 3 and 10 bins, respectively, have been applied (orange and green
dots, resp.). While there is still considerable fluctuation for 3 bin
width Gaussian filtering, the distribution is perfectly smooth for 10
bin width. Hence, five bin widths seem a reasonable compromise for
histograms with a total of 100 bins. Note that the bins are not
equidistant, but shrink with a power law towards the $x_{e^-} = 1$
boundary on the right hand side of Fig.~\ref{fig:circe2-smoothing}.
\whizard\ ships (inside its subpackage \circetwo) with prepared beam
spectra ready to be used within \circetwo\ for the ILC beam spectra
used in the ILC
TDR~\cite{Behnke:2013xla,Baer:2013cma,Adolphsen:2013jya,Adolphsen:2013kya,Behnke:2013lya}. These
comprise the designed staging energies of 200 GeV, 230 GeV, 250 GeV,
350 GeV, and 500 GeV. Note that all of these spectra up to now do not
take polarization of the original beams on the beamstrahlung into
account, but are polarization-averaged. For backwards compatibility,
also the 500 GeV spectra for the TESLA
design~\cite{AguilarSaavedra:2001rg,Richard:2001qm}, here both for
polarized and polarization-averaged cases, are included. Correlated
spectra for CLIC staging energies like 350 GeV, 1400 GeV and 3000 GeV
are not yet (as of version 2.2.4) included in the \whizard\
distribution.
In the following we describe how to obtain such files with the tools
included in \whizard (resp. \circetwo). The procedure is equivalent to
the so-called \ttt{lumi-linker} construction used by Timothy
Barklow (SLAC) together with the legacy version \whizard\ttt{ 1.95}.
The workflow to produce such files is to run \ttt{GuineaPig++} with
the following input parameters:
\begin{Code}
do_lumi = 7;
num_lumi = 100000000;
num_lumi_eg = 100000000;
num_lumi_gg = 100000000;
\end{Code}
This demands from \ttt{GuineaPig++} the generation of distributions
for the $e^-e^+$, $e^\mp \gamma$, and $\gamma\gamma$ components of the
beamstrahlung's spectrum, respectively. These are the files
\ttt{lumi.ee.out}, \ttt{lumi.eg.out}, \ttt{lumi.ge.out}, and
\ttt{lumi.gg.out}, respectively. These contain pairs $(E_1, E_2)$
of beam energies, {\em not} fractions of the original beam
energy. Huge event numbers are out in here, as \ttt{GuineaPig++}
will produce only a small fraction due to a very low generation
efficiency.
The next step is to transfer these output files from
\ttt{GuineaPig++} into input files used with \circetwo. This is
done by means of the tool \ttt{circe\_tool.opt} that is installed
together with the \whizard\ main binary and libraries. The user should
run this executable with the following input file:
\begin{Code}
{ file="ilc500/ilc500.circe" # to be loaded by WHIZARD
{ design="ILC" roots=500 bins=100 scale=250 # E in [0,1]
{ pid/1=electron pid/2=positron pol=0 # unpolarized e-/e+
events="ilc500/lumi.ee.out" columns=2 # <= Guinea-Pig
lumi = 1564.763360 # <= Guinea-Pig
iterations = 10 # adapting bins
smooth = 5 [0,1) [0,1) # Gaussian filter 5 bins
smooth = 5 [1] [0,1) smooth = 5 [0,1) [1] } } }
\end{Code}
The first line defines the output file, that later can be read in into
the beamstrahlung's description of \whizard\ (cf. below). Then, in the
second line the design of the collider (here: ILC for 500 GeV
center-of-mass energy, with the number of bins) is specified. The next
line tells the tool to take the unpolarized case, then the
\ttt{GuineaPig++} parameters (event file and luminosity) are
set. In the last three lines, details concerning the adaptation of the
simulation as well as the smoothing procedure are being specified: the
number of iterations in the adaptation procedure, and for the
smoothing with the Gaussian filter first in the continuum and then at
the two edges of the spectrum. For more details confer the
documentation in the \circetwo\ subpackage.
This produces the corresponding input files that can be used within
\whizard\ to describe beamstrahlung for lepton colliders, using a
\sindarin\ input file like:
\begin{Code}
beams = e1, E1 => circe2
$circe2_file = "ilc500.circe"
$circe2_design = "ILC"
?circe2_polarized = false
\end{Code}
%%%%%
\subsection{Photon Collider Spectra}
For details confer the complete write-up of the \circetwo\
subpackage.
%%%%%
\section{Transverse momentum for ISR photons}
\label{sec:isr-photon-handler}
The structure functions that describe the splitting of a beam particle
into a particle pair, of which one enters the hard interaction and the
other one is radiated, are defined and evaluated in the strict
collinear approximation. In particular, this holds for the ISR
structure function which describes the radiation of photons off a
charged particle in the initial state.
The ISR structure function that is used by \whizard\ is understood to
be inclusive, i.e., it implicitly contains an integration over
transverse momentum. This approach is to be used for computing a
total cross section via \ttt{integrate}. In \whizard, it is possible
to unfold this integration, as a transformation that is applied by
\ttt{simulate} step, event by event. The resulting modified events
will show a proper logarithmic momentum-transfer ($Q^2$) distribution
for the radiated photons. The recoil is applied to the
hard-interaction system, such that four-momentum and $\sqrt{\hat s}$
are conserved. The distribution is cut off by $Q_{\text{max}}^2$
(cf. \ttt{isr\_q\_max}) for large momentum transfer, and smoothly by
the parton mass (cf.\ \ttt{isr\_mass}) for small momentum transfer.
To activate this modification, set
\begin{Code}
?isr_handler = true
$isr_handler_mode = "recoil"
\end{Code}
before, or as an option to, the \ttt{simulate} command.
Limitations: the current implementation of the $p_T$ modification
works only for the symmetric double-ISR case, i.e., both beams have to
be charged particles with identical mass (e.g., $e^+e^-$). The mode
\ttt{recoil} generates exactly one photon per beam, i.e., it modifies
the momentum of the single collinear photon that the ISR structure
function implementation produces, for each beam. (It is foreseen that
further modes or options will allow to generate multiple photons.
Alternatively, the \pythia\ shower can be used to simulate multiple
photons radiated from the initial state.)
%%%%%
\section{Transverse momentum for the EPA approximation}
\label{sec:epa-beam-handler}
For the equivalent-photon approximation (EPA), which is also defined
in the collinear limit, recoil momentum can be inserted into generated
events in an entirely analogous way. The appropriate settings are
\begin{Code}
?epa_handler = true
$epa_handler_mode = "recoil"
\end{Code}
Limitations: as for ISR, the current implementation of the $p_T$
modification works only for the symmetric double-EPA case. Both
incoming particles of the hard process must be photons, while both
beams must be charged particles with identical mass (e.g., $e^+e^-$).
Furthermore, the current implementation does not respect the
kinematical limit parameter \verb|epa_q_min|, it has to be set to
zero. In effect, the lower $Q^2$ cutoff is determined by the
beam-particle mass \verb|epa_mass|, and the upper cutoff is either
given by $Q_{\text{max}}$ (the parameter
\verb|epa_q_max|), or by the limit $\sqrt{s}$ if this is not set.
It is possible to combine the ISR and EPA handlers, for processes
where ISR is active for one of the beams, EPA for the other beam. For
this scenario to work, both handler switches must be on, and both mode
strings must coincide. The parameters are set separately for ISR and
EPA, as described above.
%%%%%
\section{Resonances and continuum}
\subsection{Complete matrix elements}
Many elementary physical processes are composed of contributions that can be
qualified as (multiply) \emph{resonant} or \emph{continuum}. For instance,
the amplitude for the process $e^+e^-\to q\bar q q\bar q$, evaluated at tree
level in perturbation theory, contains Feynman diagrams with zero, one, or two
$W$ and $Z$ bosons as virtual lines. If the kinematical constraints allow
this, two vector bosons can become simultaneously on-shell in part of phase
space. To a first approximation, this situation is understood as $W^+W^-$ or
$ZZ$ production with subsequent decay. The kinematical distributions show
distinct resonances in the quark-pair spectra. Other graphs contain only one
s-channel $W/Z$ boson, or none at all, such as graphs with $q\bar q$
production and subsequent gluon radiation, splitting into another $q\bar q$
pair.
A \whizard\ declaration of the form
\begin{Code}
process q4 = e1, E1 => u, U, d, D
\end{Code}
produces the full set of graphs for the selected final state, which after
squaring and integrating yields the exact tree-level result for the process.
The result contains all doubly and singly resonant parts, with correct
resonance shapes, as well as the continuum contribution and all interference.
This is, to given order in perturbation theory, the best possible
approximation to the true result.
\subsection{Processes restricted to resonances}
For an intuitive separation of a two-boson ``signal'' contribution, it is
possible to restrict the set of graphs to a certain intermediate state. For
instance, the declaration
\begin{Code}
process q4_zz = e1, E1 => u, U, d, D { $restrictions = "3+4~Z && 5+6~Z" }
\end{Code}
generates an amplitude that contains only those Feynman graphs where the
specified quarks are connected to a $Z$ virtual line. The result may be
understood as $ZZ$ production with subsequent decay, where the $Z$ resonances
exhibit a Breit-Wigner shape. Combining this with the
analogous $W^+W^-$ restricted process, the user can generate ``signal''
processes.
Adding both ``signal'' cross sections $WW$ and $ZZ$ will result in a
reasonable approximation to the exact tree-level cross section. The amplitude
misses the single-resonant and continuum contributions, and the squared
amplitude misses the interference terms, however. More importantly, the
restricted processes as such are not gauge-invariant (with respect to the
electroweak gauge group), and they are no longer dominant away from resonant
kinematics. We therefore strongly recommend that such restricted processes
are always accompanied by a cut setup that restricts the kinematics to an
approximately on-shell pattern for both resonances. For instance:
\begin{Code}
cuts = all 85 GeV < M < 95 GeV [u:U]
and all 85 GeV < M < 95 GeV [d:D]
\end{Code}
In this region, the gauge-dependent and continuum contributions are strictly
subdominant. Away from the resonance(s), the results for a restricted process
are meaningless, and the full process has to be computed instead.
\subsection{Factorized processes}
Another method for obtaining the signal contribution is a proper factorization
into resonance production and decay. We would have to generate a production
process and two decay processes:
\begin{Code}
process z_uu = Z => u, U
process z_dd = Z => d, D
process zz = e1, E1 => Z, Z
\end{Code}
All three processes must be integrated. The integration results are partial
decay widths and the $ZZ$ production cross section, respectively. (Note that
cut expressions in \sindarin\ apply to all integrations, so make sure that
no production-process cuts are active when integrating the decay
processes.)
During a later event-generation step, the $Z$ decays can then be activated by declaring the $Z$ as
unstable,
\begin{Code}
unstable Z (z_uu, z_dd)
\end{Code}
and then simulating the production process
\begin{Code}
simulate (zz)
\end{Code}
The generated events will consist of four-fermion final states, including all
combinations of both decay modes. It is important to note that in this setup,
the invariant $u\bar u$ and $d\bar d$ masses will be always \emph{exactly}
equal to the $Z$ mass. There is no Breit-Wigner shape involved. However, in
this approximation the results are gauge-invariant, as there is no off-shell
contribution involved.
For further details on factorized processes and spin correlations,
cf.\ Sec.~\ref{sec:spin-correlations}.
\subsection{Resonance insertion in the event record}
From the above discussion, we may conclude that it is always preferable to
compute the complete process for a given final state, as long as this is
computationally feasible. However, in the simulation step this approach also
has a drawback. Namely, if a parton-shower module (see below) is switched on,
the parton-shower algorithm relies on event details in order to determine the
radiation pattern of gluons and further splitting. In the generated event
records, the full-process events carry the signature of non-resonant continuum
production with no intermediate resonances. The parton shower will thus start
the evolution at the process energy scale, the total available energy. By
contrast, for an electroweak production and decay process, the evolution
should start only at the vector boson mass, $m_Z$. In effect, even though the
resonant contribution of $WW$ and $ZZ$ constitutes the bulk of the cross
section, the radiation pattern follows the dynamics of four-quark continuum
production. In general, the number of radiated hadrons will be too high.
\begin{figure}
\begin{center}
\includegraphics[width=.41\textwidth]{resonance_e_gam}
\includegraphics[width=.41\textwidth]{resonance_n_charged} \\
\includegraphics[width=.41\textwidth]{resonance_n_hadron}
\includegraphics[width=.41\textwidth]{resonance_n_particles} \\
\includegraphics[width=.41\textwidth]{resonance_n_photons}
\includegraphics[width=.41\textwidth]{resonance_n_visible}
\end{center}
\caption{The process $e^+e^- \to jjjj$ at 250 GeV center-of-mass
energy is compared transferring the partonic events naively to the
parton shower, i.e. without respecting any intermediate resonances
(red lines). The blue lines show the process factorized into $WW$
production and decay, where the shower knows the origin of the two
jet pairs. The orange and dark green lines show the resonance
treatment as mentioned in the text, with
\ttt{resonance\_on\_shell\_limit = 1} and \ttt{= 4},
respectively. \pythiasix\ parton shower and hadronization with the
OPAL tune have been used. The observables are: photon energy
distribution and number of charged tracks (upper line left/right,
number of hadrons and total number of particles (middle
left/right), and number of photons and neutral particles (lower
line left/right).}
\end{figure}
To overcome this problem, there is a refinement of the process description
available in \whizard. By modifying the process declaration to
\begin{Code}
?resonance_history = true
resonance_on_shell_limit = 4
process q4 = e1, E1 => u, U, d, D
\end{Code}
we advise the program to produce not just the complete matrix element, but
also all possible restricted matrix elements containing resonant intermediate
states. This has no effect at all on the integration step, and thus on the
total cross section.
However, when subsequently events are generated with this setting, the program
checks, for each event, the kinematics and determines the set of potentially
resonant contributions. The criterion is whether the off-shellness of a
particular would-be resonance is less than the resonance width multiplied by
the value of \verb|resonance_on_shell_limit| (default value $=4$). For the
set of resonance histories which pass this criterion (which can be empty),
their respective squared matrix element is related to the full-process matrix
element. The ratio is interpreted as a probability. The random-number
generator then selects one or none of the resonance histories, and modifies
the event record accordingly. In effect, for an appropriate fraction of the
events, depending on the kinematics, the parton-shower module is provided with
resonance information, so it can adjust the radiation pattern accordingly.
It has to be mentioned that generating the matrix-element code for all
possible resonance histories takes additional computing resources. In the
current default setup, this feature is switched off. It has to be explicitly
activated via the \verb|?resonance_history| flag.
Also, the feature can be activated or deactivated individually for
each process, such as in
\begin{Code}
?resonance_history = true
process q4_with_res = e1, E1 => u, U, d, D { ?resonance_history = true }
process q4_wo_res = e1, E1 => u, U, d, D { ?resonance_history = false }
\end{Code}
If the flag is \verb|false| for a process, no resonance code will be
generated. Similarly, the flag has to be globally or locally active
when \verb|simulate| is called, such that the feature takes effect for
event generation.
There are two additional parameters that can fine-tune the conditions for
resonance insertion in the event record. Firstly, the parameter
\verb|resonance_on_shell_turnoff|, if nonzero, enables a Gaussian suppression
of the probability for resonance insertion. For instance, setting
\begin{Code}
?resonance_history = true
resonance_on_shell_turnoff = 4
resonance_on_shell_limit = 8
\end{Code}
will reduce the probability for the event to be qualified as resonant by
$e^{-1}= 37\,\%$ if the kinematics is off-shell by four units of the width,
and by $e^{-4}=2\,\%$ at eight units of the width. Beyond this point, the
setting of the \verb|resonance_on_shell_limit| parameter eliminates resonance
insertion altogether. In effect, the resonance-background transition is
realized in a smooth way. Secondly, within the resonant-kinematics range the
probability for qualifying the event as background can be reduced by the
parameter \verb|resonance_background_factor| (default value $=1$) to a number
between zero and one. Setting this to zero means that the event will be
necessarily qualified as resonant, if it falls within the resonant-kinematics
range.
Note that if an event, by the above mechanism, is identified as following a
certain resonance history, the assigned color flow will be chosen to match the
resonance history, not the complete matrix element. This may result in a
reassignment of color flow with respect to the original partonic event.
Finally, we mention the order of execution: any additional
matrix element code is compiled and linked when \verb|compile| is
executed for the processes in question. If this command is omitted,
the \verb|simulate| command will trigger compilation.
\section{Parton showers and Hadronization}
In order to produce sensible events, final state QCD (and also QED)
radiation has to be considered as well as the binding of strongly
interacting partons into mesons and baryons. Furthermore, final state
hadronic resonances undergo subsequent decays into those particles
showing up in (or traversing) the detector. The latter are mostly
pions, kaons, photons, electrons and muons.
The physics associated with these topics can be divided into the
perturbative part which is the regime of the parton shower, and the
non-perturbative part which is the regime for the
hadronization. \whizard\ comes with its own two different parton
shower implementations, an analytic and a so-called $k_T$-ordered
parton shower that will be detailed in the next section.
Note that in general it is not advisable to use different shower and
hadronization methods, or in other words, when using shower and
hadronization methods from different programs these would have to be
tuned together again with the corresponding data.
Parton showers are approximations to full matrix elements taking only
the leading color flow into account, and neglecting all interferences
between different amplitudes leading to the same exclusive final
state. They rely on the QCD (and QED) splitting functions to describe
the emissions of partons off other partons. This is encoded in the
so-called Sudakov form factor~\cite{Sudakov:1954sw}:
\begin{equation*}
\Delta( t_1, t_2) = \exp \left[ \int\limits_{t_1}^{t_2} \mbox{d} t
\int\limits_{z_-}^{z_+} \mbox{d} z \frac{\alpha_s}{2 \pi t} P(z)
\right]
\end{equation*}
This gives the probability for a parton to evolve from scale $t_2$ to
$t_1$ without any further emissions of partons. $t$ is the evolution
parameter of the shower, which can be a parton energy, an emission
angle, a virtuality, a transverse momentum etc. The variable $z$
relates the two partons after the branching, with the most common
choice being the ratio of energies of the parton after and before the
branching. For final-state radiation brachings occur after the hard
interaction, the evolution of the shower starts at the scale of the
hard interaction, $t \sim \hat{s}$, down to a cut-off scale $t =
t_{\text{cut}}$ that marks the transition to the non-perturbative
regime of hadronization. In the space-like evolution for the
initial-state shower, the evolution is from a cut-off representing the
factorization scale for the parton distribution functions (PDFs) to the
inverse of the hard process scale, $-\hat{s}$. Technically, this
evolution is then backwards in (shower) time~\cite{Sjostrand:1985xi},
leading to the necessity to include the PDFs in the Sudakov factors.
The main switches for the shower and hadronization which are realized
as transformations on the partonic events within \whizard\ are
\ttt{?allow\_shower} and \ttt{?allow\_hadronization}, which are
true by default and only there for technical reasons. Next, different
shower and hadronization methods can be chosen within \whizard:
\begin{code}
$shower_method = "WHIZARD"
$hadronization_method = "PYTHIA6"
\end{code}
The snippet above shows the default choices in \whizard\, namely
\whizard's intrinsic parton shower, but \pythiasix\ as hadronization
tool. (Note that \whizard\ does not have its own hadronization module
yet.) The usage of \pythiasix\ for showering and hadronization will
be explained in Sec.~\ref{sec:pythia6}, while the two different
implementations of the \whizard\ homebrew parton showers are discussed
in Sec.~\ref{sec:ktordered} and~\ref{sec:analytic}, respectively.
%%%%%
\subsection{The $k_T$-ordered parton shower}
\label{sec:ktordered}
%%%%%
\subsection{The analytic parton shower}
\label{sec:analytic}
%%%%%
\subsection{Parton shower and hadronization from \pythiasix}
\label{sec:pythia6}
Development of the \pythiasix\ generator for parton shower and
hadronization (the \fortran\ version) has been discontinued by the
authors several years ago. Hence, the final release of that program is
frozen. This allowed to ship this final version, v6.427, with the
\whizard\ distribution without the need of updating it all the
time. One of the main reasons for that inclusion -- besides having the
standard tool for showering and hadronization for decays at hand -- is
to allow for backwards validation within \whizard\ particularly for
the event samples generated for the development of linear collider
physics: first for TESLA, JLC and NLC, and later on for the Conceptual
and Technical Design Report for ILC, for the Conceptual Design Report
for CLIC as well as for the Letters of Intent for the LC detectors,
ILD and SiD.
Usually, an external parton shower and hadronization program (PS) is
steered via the transfer of event files that are given to the PS via
LHE events, while the PS program then produces hadron level events,
usually in HepMC format. These can then be directed towards a full or
fast detector simulation program. As \pythiasix\ has been completely
integrated inside the \whizard\ framework, the showered or more
general hadron level events can be returned to and kept inside
\whizard's internal event record, and hence be used in \whizard's
internal event analysis. In that way, the events can be also written
out in event formats that are not supported by \pythiasix,
e.g. \ttt{LCIO} via the output capabilities of \whizard.
There are several switches to directly steer \pythiasix\ (the values
in brackets correspond to the \pythiasix\ variables):
\begin{code}
ps_mass_cutoff = 1 GeV [PARJ(82)]
ps_fsr_lambda = 0.29 GeV [PARP(72)]
ps_isr_lambda = 0.29 GeV [PARP(61)]
ps_max_n_flavors = 5 [MSTJ(45)]
?ps_isr_alphas_running = true [MSTP(64)]
?ps_fsr_alphas_running = true [MSTJ(44)]
ps_fixed_alphas = 0.2 [PARU(111)]
?ps_isr_angular_ordered = true [MSTP(62)]
ps_isr_primordial_kt_width = 1.5 GeV [PARP(91)]
ps_isr_primordial_kt_cutoff = 5.0 GeV [PARP(93)]
ps_isr_z_cutoff = 0.999 [1-PARP(66)]
ps_isr_minenergy = 2 GeV [PARP(65)]
?ps_isr_only_onshell_emitted_partons =
true [MSTP(63)]
\end{code}
The values given above are the default values. The first value
corresponds to the \pythiasix\ parameter \ttt{PARJ(82)}, its
squared being the minimal virtuality that is allowed for the parton
shower, i.e. the cross-over to the hadronization. The same parameter
is used also for the \whizard\ showers. \ttt{ps\_fsr\_lambda} is
the equivalent of \ttt{PARP(72)} and is the $\Lambda_{\text{QCD}}$
for the final state shower. The corresponding variable for the initial
state shower is called \ttt{PARP(61)} in \pythiasix. By the next
variable (\ttt{MSTJ(45)}), the maximal number of flavors produced
in splittings in the shower is given, together with the number of
active flavors in the running of
$\alpha_s$. \ttt{?ps\_isr\_alphas\_running} which corresponds to
\ttt{MSTP(64)} in \pythiasix\ determines whether or net a running
$\alpha_s$ is taken in the space-like initial state showers. The same
variable for the final state shower is \ttt{MSTJ(44)}. For fixed
$\alpha_s$, the default value is given by \ttt{ps\_fixed\_alpha},
corresponding to \ttt{PARU(111)}. \ttt{MSTP(62)} determines
whether the ISR shower is angular order, i.e. whether angles are
increasing towards the hard interaction. This is per default true, and
set in the variable \ttt{?ps\_isr\_angular\_ordered}. The width of
the distribution for the primordial (intrinsic) $k_T$ distribution
(which is a non-perturbative quantity) is the \pythiasix\ variable
\ttt{PARP(91)}, while in \whizard\ it is given by
\ttt{pythia\_isr\_primordial\_kt\_width}. The next variable
(\ttt{PARP(93}) gives the upper cutoff for that distribution, which
is 5 GeV per default. For splitting in space-like showers, there is a
cutoff on the $z$ variable named \ttt{ps\_isr\_z\_cutoff} in
\whizard. This corresponds to one minus the value of the
\pythiasix\ parameter \ttt{PARP(66)}. \ttt{PARP(65)}, on the
other hand, gives the minimal (effective) energy for a time-like or
on-shell emitted parton on a space-like QCD shower, given by the
\sindarin\ parameter \ttt{ps\_isr\_minenergy}. Whether or not
partons emitted from space-like showers are allowed to be only
on-shell is given by
\ttt{?ps\_isr\_only\_onshell\_emitted\_partons}, \ttt{MSTP(63)}
in \pythiasix\ language.
For more details confer the
\pythiasix\ manual~\cite{Sjostrand:2006za}.
Any other non-standard \pythiasix\ parameter can be fed into the
parton shower via the string variable
\begin{code}
$ps_PYTHIA_PYGIVE = "...."
\end{code}
Variables set here get preference over the ones set explicitly by
dedicated \sindarin\ commands. For example, the OPAL tune for hadronic
final states can be set via:
\begin{code}
$ps_PYTHIA_PYGIVE = "MSTJ(28)=0; PMAS(25,1)=120.; PMAS(25,2)=0.3605E-02; MSTJ(41)=2;
MSTU(22)=2000; PARJ(21)=0.40000; PARJ(41)=0.11000; PARJ(42)=0.52000; PARJ(81)=0.25000;
PARJ(82)=1.90000; MSTJ(11)=3; PARJ(54)=-0.03100; PARJ(55)=-0.00200; PARJ(1)=0.08500;
PARJ(3)=0.45000; PARJ(4)=0.02500; PARJ(2)=0.31000; PARJ(11)=0.60000; PARJ(12)=0.40000;
PARJ(13)=0.72000; PARJ(14)=0.43000; PARJ(15)=0.08000; PARJ(16)=0.08000;
PARJ(17)=0.17000; MSTP(3)=1;MSTP(71)=1"
\end{code}
\vspace{0.5cm}
A very common error that appears quite often when using
\pythiasix\ for SUSY or any other model having a stable particle that
serves as a possible Dark Matter candidate, is the following
warning/error message:
\begin{Code}
Advisory warning type 3 given after 0 PYEXEC calls:
(PYRESD:) Failed to decay particle 1000022 with mass 15.000
******************************************************************************
******************************************************************************
*** FATAL ERROR: Simulation: failed to generate valid event after 10000 tries
******************************************************************************
******************************************************************************
\end{Code}
In that case, \pythiasix\ gets a stable particle (here the lightest
neutralino with the PDG code 1000022) handed over and does not know
what to do with it. Particularly, it wants to treat it as a heavy
resonance which should be decayed, but does not know how do
that. After a certain number of tries (in the example abobe 10k),
\whizard\ ends with a fatal error telling the user that the event
transformation for the parton shower in the simulation has failed
without producing a valid event. The solution to work around that
problem is to let \pythiasix\ know that the neutralino (or any other
DM candidate) is stable by means of
\begin{code}
$ps_PYTHIA_PYGIVE = "MDCY(C1000022,1)=0"
\end{code}
Here, 1000022 has to be replaced by the stable dark matter candidate
or long-lived particle in the user's favorite model. Also note that
with other options being passed to \pythiasix\, the \ttt{MDCY}
option above has to be added to an existing
\ttt{\$ps\_PYTHIA\_PYGIVE} command separated by a semicolon.
%%%%%
\subsection{Parton shower and hadronization from \pythiaeight}
\subsection{Other tools for parton shower and hadronization}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{More on Event Generation}
\label{chap:events}
In order to perform a physics analysis with \whizard\ one has to
generate events. This seems to be a trivial statement, but as there
have been any questions like "My \whizard\ does not produce plots --
what has gone wrong?" we believe that repeating that rule is
worthwile. Of course, it is not mandatory to use \whizard's own analysis
set-up, the user can always choose to just generate events and use
his/her own analysis package like \ttt{ROOT}, or \ttt{TopDrawer}, or
you name it for the analysis.
Accordingly, we first start to describe how to generate events and
what options there are -- different event formats, renaming output
files, using weighted or unweighted events with different
normalizations. How to re-use and manipulate already generated event
samples, how to limit the number of events per file, etc. etc.
\section{Event generation}
To explain how event generation works, we again take our favourite
example, $e^+e^- \to \mu^+ \mu^-$,
\begin{verbatim}
process eemm = e1, E1 => e2, E2
\end{verbatim}
The command to trigger generation of events is \ttt{simulate
(<proc\_name>) \{ <options> \}}, so in our case -- neglecting any
options for now -- simply:
\begin{verbatim}
simulate (eemm)
\end{verbatim}
When you run this \sindarin\ file you will experience a fatal error:
\ttt{FATAL ERROR: Colliding beams: sqrts is zero (please set
sqrts)}. This is because \whizard\ needs to compile and integrate the
process \ttt{eemm} first before event simulation, because it needs the
information of the corresponding cross section, phase space
parameterization and grids. It does both automatically, but you have
to provide \whizard\ with the beam setup, or at least with the
center-of-momentum energy. A corresponding \ttt{integrate} command
like
\begin{verbatim}
sqrts = 500 GeV
integrate (eemm) { iterations = 3:10000 }
\end{verbatim}
obviously has to appear {\em before} the corresponding \ttt{simulate}
command (otherwise you would be punished by the same error message as
before). Putting things in the correct order results in an output
like:
\begin{footnotesize}
\begin{verbatim}
| Reading model file '/usr/local/share/whizard/models/SM.mdl'
| Preloaded model: SM
| Process library 'default_lib': initialized
| Preloaded library: default_lib
| Reading commands from file 'bla.sin'
| Process library 'default_lib': recorded process 'eemm'
sqrts = 5.000000000000E+02
| Integrate: current process library needs compilation
| Process library 'default_lib': compiling ...
| Process library 'default_lib': keeping makefile
| Process library 'default_lib': keeping driver
| Process library 'default_lib': active
| Process library 'default_lib': ... success.
| Integrate: compilation done
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 29912
| Initializing integration for process eemm:
| ------------------------------------------------------------------------
| Process [scattering]: 'eemm'
| Library name = 'default_lib'
| Process index = 1
| Process components:
| 1: 'eemm_i1': e-, e+ => mu-, mu+ [omega]
| ------------------------------------------------------------------------
| 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 'eemm_i1.phs'
| Phase space: 2 channels, 2 dimensions
| Phase space: found 2 channels, collected in 2 groves.
| Phase space: Using 2 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| OpenMP: Using 8 threads
| Starting integration for process 'eemm'
| Integrate: iterations = 3:10000
| Integrator: 2 chains, 2 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 10000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 9216 4.2833237E+02 7.14E-02 0.02 0.02* 40.29
2 9216 4.2829071E+02 7.08E-02 0.02 0.02* 40.29
3 9216 4.2838304E+02 7.04E-02 0.02 0.02* 40.29
|-----------------------------------------------------------------------------|
3 27648 4.2833558E+02 4.09E-02 0.01 0.02 40.29 0.43 3
|=============================================================================|
| Time estimate for generating 10000 events: 0d:00h:00m:04s
| Creating integration history display eemm-history.ps and eemm-history.pdf
| Starting simulation for process 'eemm'
| Simulate: using integration grids from file 'eemm_m1.vg'
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 29913
| OpenMP: Using 8 threads
| Simulation: requested number of events = 0
| corr. to luminosity [fb-1] = 0.0000E+00
| Events: writing to raw file 'eemm.evx'
| Events: generating 0 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
| Events: closing raw file 'eemm.evx'
| There were no errors and 1 warning(s).
| WHIZARD run finished.
|=============================================================================|
\end{verbatim}
\end{footnotesize}
So, \whizard\ tells you that it has entered simulation mode, but besides
this, it has not done anything. The next step is that you have to
demand event generation -- there are two ways to do this: you could
either specify a certain number, say 42, of events you want to have
generated by \whizard, or you could provide a number for an integrated
luminosity of some experiment. (Note, that if you choose to take both
options, \whizard\ will take the one which gives the larger event
sample. This, of course, depends on the given process(es) -- as well
as cuts -- and its corresponding cross section(s).) The first of these
options is set with the command: \ttt{n\_events = <number>}, the
second with \ttt{luminosity = <number> <opt. unit>}.
Another important point already stated several times in the manual is
that \whizard\ follows the commands in the steering \sindarin\ file in a
chronological order. Hence, a given number of events or luminosity
{\em after} a \ttt{simulate} command will be ignored -- or are
relevant only for any \ttt{simulate} command potentially following
further down in the \sindarin\ file. So, in our case, try:
\begin{verbatim}
n_events = 500
luminosity = 10
simulate (eemm)
\end{verbatim}
Per default, numbers for integrated luminosity are understood as
inverse femtobarn. So, for the cross section above this would
correspond to 4283 events, clearly superseding the demand for 500
events. After reducing the luminosity number from ten to one inverse
femtobarn, 500 is the larger number of events taken by \whizard\ for
event generation. Now \whizard\ tells you:
\begin{verbatim}
| Simulation: requested number of events = 500
| corr. to luminosity [fb-1] = 1.1673E+00
| Events: reading from raw file 'eemm.evx'
| Events: reading 500 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event file terminates after 0 events.
| Events: appending to raw file 'eemm.evx'
| Generating remaining 500 events ...
| ... event sample complete.
| Events: closing raw file 'eemm.evx'
\end{verbatim}
I.e., it evaluates the luminosity to which the sample of 500 events
would correspond to, which is now, of course, bigger than the $1
\fb^{-1}$ explicitly given for the luminosity. Furthermore, you can
read off that a file \ttt{whizard.evx} has been generated, containing
the demanded 500 events. (It was there before containing zero events,
because to \ttt{n\_events} or \ttt{luminosity} value had been
set. \whizard\ then tried to get the events first from file before
generating new ones). Files with the suffix \ttt{.evx} are binary
format event files, using a machine-dependent \whizard-specific
event file format. Before we list the event formats supported by
\whizard, the next two sections will tell you more about unweighted and
weighted events as well as different possibilities to normalize events
in \whizard.
As already explained for the libraries, as well as the phase space and
grid files in Chap.~\ref{chap:sindarin}, \whizard\ is trying to re-use
as much information as possible. This is of course also true for the
event files. There are special MD5 check sums testing the integrity
and compatibility of the event files. If you demand for a process for
which an event file already exists (as in the example above, though it
was empty) equally many or less events than generated before,
\whizard\ will not generate again but re-use the existing events (as
already explained, the events are stored in a \whizard-own
binary event format, i.e. in a so-called \ttt{.evx} file. If you
suppress generation of that file, as will be described in subsection
\ref{sec:eventformats} then \whizard\ has to generate events all the
time). From version v2.2.0 of \whizard\ on, the program is also able
to read in event from different event formats. However, most event
formats do not contain as many information as \whizard's internal
format, and a complete reconstruction of the events might not be
possible. Re-using event files is very practical for doing several
different analyses with the same data, especially if there are many
and big data samples. Consider
the case, there is an event file with 200 events, and you now ask
\whizard\ to generate 300 events, then it will re-use the 200 events
(if MD5 check sums are OK!), generate the remaining 100 events and
append them to the existing file. If the user for some reason,
however, wants to regenerate events (i.e. ignoring possibly existing
events), there is the command option \ttt{whizard --rebuild-events}.
%%%%%%%%%
\section{Unweighted and weighted events}
\whizard\ is able to generate unweighted events, i.e. events that are
distributed uniformly and each contribute with the same event weight
to the whole sample. This is done by mapping out the phase space of
the process under consideration according to its different phase space
channels (which each get their own weights), and then unweighting the
sample of weighted events. Only a sample of unweighted events could in
principle be compared to a real data sample from some experiment. The
seventh column in the \whizard\ iteration/adaptation procedure tells you
about the efficiency of the grids, i.e. how well the phase space is
mapped to a flat function. The better this is achieved, the higher the
efficiency becomes, and the closer the weights of the different phase
space channels are to uniformity. This means, for higher efficiency
less weighted events ("calls") are needed to generate a single
unweighted event. An efficiency of 10 \% means that ten weighted
events are needed to generate one single unweighted event. After the
integration is done, \whizard\ uses the duration of calls during the
adaptation to estimate a time interval needed to generate 10,000
unweighted events. The ability of the adaptive multi-channel Monte
Carlo decreases with the number of integrations, i.e. with the number
of final state particles. Adding more and more final state particles
in general also increases the complexity of phase space, especially
its singularity structure. For a $2 \to 2$ process the efficiency is
roughly of the order of several tens of per cent. As a rule of thumb,
one can say that with every additional pair of final state particle
the average efficiency one can achieve decreases by a factor of five
to ten.
The default of \whizard\ is to generate {\em unweighted} events. One can
use the logical variable \ttt{?unweighted = false} to disable
unweighting and generate weighted events. (The command
\ttt{?unweighted = true} is a tautology, because \ttt{true} is the
default for this variable.) Note that again this command has to appear
{\em before} the corresponding \ttt{simulate} command, otherwise it will
be ignored or effective only for any \ttt{simulate} command appearing
later in the \sindarin\ file.
In the unweighted procedure, \whizard\ is keeping track of the highest
weight that has been appeared during the adaptation, and the
efficiency for the unweighting has been estimated from the average
value of the sampling function compared to the maximum value. In
principle, during event generation no events should be generated whose
sampling function value exceeds the maximum function value encountered
during the grid adaptation. Sometimes, however, there are numerical
fluctuations and such events are happening. They are called {\em
excess events}. \whizard\ does keep track of these excess events
during event generation and will report about them, e.g.:
\begin{code}
Warning: Encountered events with excess weight: 9 events ( 0.090 %)
| Maximum excess weight = 6.083E-01
| Average excess weight = 2.112E-04
\end{code}
Whenever in an event generation excess events appear, this shows that
the adaptation of the sampling function has not been perfect. When the
number of excess weights is a finite number of percent, you should
inspect the phase-space setup and try to improve its settings to get a
better adaptation.
%%%%%%%%%
\section{Choice on event normalizations}
There are basically four different choices to normalize event weights
($\braket{\ldots}$ denotes the average):
\begin{enumerate}
\item $\braket{w_i} = 1$, \qquad\qquad $\Braket{\sum_i w_i} = N$
\item $\braket{w_i} = \sigma$, \qquad\qquad $\Braket{\sum_i w_i} = N
\times \sigma$
\item $\braket{w_i} = 1/N$, \quad\qquad $\Braket{\sum_i w_i} = 1$
\item $\braket{w_i} = \sigma/N$, \quad\qquad $\Braket{\sum_i w_i} = \sigma$
\end{enumerate}
So the four options are to have the average weight equal to unity, to
the cross section of the corresponding process, to one over the number
of events, or the cross section over the event calls. In these four
cases, the event weights sum up to the event number, the event number
times the cross section, to unity, and to the cross section,
respectively. Note that neither of these really guarantees that all
event weights individually lie in the interval $0 \leq w_i \leq 1$.
The user can steer the normalization of events by using in \sindarin\
input files the string variable \ttt{\$sample\_normalization}. The default is
\ttt{\$sample\_normalization = "auto"}, which uses option 1 for
unweighted and 2 for weighted events, respectively. Note that this is
also what the Les Houches Event Format (LHEF) demands for both types
of events. This is \whizard's preferred mode, also for the reason, that
event normalizations are independent from the number of events. Hence,
event samples can be cut or expanded without further need to adjust
the normalization. The unit normalization (option 1) can be switched
on also for weighted events by setting the event normalization
variable equal to \ttt{"1"}. Option 2 can be demanded
by setting \ttt{\$sample\_normalization = "sigma"}. Options 3 and 4 can
be set by \ttt{"1/n"} and \ttt{"sigma/n"}, respectively. \whizard\
accepts small and capital letters for these expressions.
In the following section we show some examples when discussing the
different event formats available in \whizard.
%%%%%%%%%
\section{Event selection}
The \ttt{selection} expression (cf.\ Sec.~\ref{subsec:analysis})
reduces the event sample during generation or rescanning, selecting
only events for which the expression evaluates to \ttt{true}. Apart
from internal analysis, the selection also applies to writing external
files. For instance, the following code generates a $e^+e^-\to
W^+W^-$ sample with longitudinally polarized $W$ bosons only:
\begin{footnotesize}
\begin{verbatim}
process ww = "e+", "e-" => "W-", "W+"
polarized "W+"
polarized "W-"
?polarized_events = true
sqrts = 500
selection = all Hel == 0 ["W+":"W-"]
simulate (ww) { n_events = 1000 }
\end{verbatim}
\end{footnotesize}
The number of events that end up in the sample on file is equal to the
number of events with longitudinally polarized $W$s in the generated
sample, so the file will contain less than 1000 events.
%%%%%%%%%
\section{Supported event formats}
\label{sec:eventformats}
Event formats can either be distinguished whether they are plain
text (i.e. ASCII) formats or binary formats. Besides this, one can
classify event formats according to whether they are natively
supported by \whizard\ or need some external program or library to be
linked. Table~\ref{tab:eventformats} gives a complete list of all
event formats available in \whizard. The second column shows whether
these are ASCII or binary formats, the third column contains brief
remarks about the corresponding format, while the last column tells
whether external programs or libraries are needed (which is the case
only for the HepMC formats).
\begin{table}
\begin{center}
\begin{tabular}{|l||l|l|r|}\hline
Format & Type & remark & ext. \\\hline
ascii & ASCII & \whizard\ verbose format & no
\\
Athena & ASCII & variant of HEPEVT & no
\\
debug & ASCII & most verbose \whizard\ format & no
\\
evx & binary & \whizard's home-brew & no
\\
HepMC & ASCII & HepMC format & yes
\\
HEPEVT & ASCII & \whizard~1 style & no
\\
LCIO & ASCII & LCIO format & yes
\\
LHA & ASCII & \whizard~1/old Les Houches style &no
\\
LHEF & ASCII & Les Houches accord compliant & no
\\
long & ASCII & variant of HEPEVT & no
\\
mokka & ASCII & variant of HEPEVT & no
\\
short & ASCII & variant of HEPEVT & no
\\
StdHEP (HEPEVT) & binary & based on HEPEVT common block & no
\\
StdHEP (HEPRUP/EUP) & binary & based on HEPRUP/EUP common block
& no \\
Weight stream & ASCII & just weights & no \\
\hline
\end{tabular}
\end{center}
\caption{\label{tab:eventformats}
Event formats supported by \whizard, classified according to
ASCII/binary formats and whether an external program or library is
needed to generate a file of this format. For both the HEPEVT and
the LHA format there is a more verbose variant.
}
\end{table}
The "\ttt{.evx}'' is \whizard's native binary event format. If you
demand event generation and do not specify anything further, \whizard\
will write out its events exclusively in this binary format. So in the
examples discussed in the previous chapters (where we omitted all
details about event formats), in all cases this and only this internal
binary format has been generated. The generation of this raw format
can be suppressed (e.g. if you want to have only one specific event
file type) by setting the variable \verb|?write_raw = false|. However,
if the raw event file is not present, \whizard\ is not able to re-use
existing events (e.g. from an ASCII file) and will regenerate events
for a given process. Note that from version v2.2.0 of \whizard\ on,
the program is able to (partially) reconstruct complete events also
from other formats than its internal format (e.g. LHEF), but this is
still under construction and not yet complete.
Other event formats can be written out by setting the variable
\ttt{sample\_format = <format>}, where \ttt{<format>} can be any of
the following supported variables:
\begin{itemize}
\item \ttt{ascii}: a quite verbose ASCII format which contains lots of
information (an example is shown in the appendix). \newline
Standard suffix: \ttt{.evt}
\item \ttt{debug}: an even more verbose ASCII format intended for
debugging which prints out also information about the internal data
structures \newline
Standard suffix: \ttt{.debug}
\item \ttt{hepevt}: ASCII format that writes out a specific
incarnation of the HEPEVT common block (\whizard~1
back-compatibility) \newline
Standard suffix: \ttt{.hepevt}
\item \ttt{hepevt\_verb}: more verbose version of \ttt{hepevt} (\whizard~1
back-compatibility) \newline
Standard suffix: \ttt{.hepevt.verb}
\item \ttt{short}: abbreviated variant of the previous HEPEVT (\whizard\
1 back-compatibility) \newline
Standard suffix: \ttt{.short.evt}
\item \ttt{long}: HEPEVT variant that contains a little bit more
information than the short format but less than HEPEVT (\whizard\
1 back-compatibility) \newline
Standard suffix: \ttt{.long.evt}
\item \ttt{athena}: HEPEVT variant suitable for read-out in the ATLAS
ATHENA software environment (\whizard\
1 back-compatibility) \newline
Standard suffix: \ttt{.athena.evt}
\item \ttt{mokka}: HEPEVT variant suitable for read-out in the MOKKA
ILC software environment \newline
Standard suffix: \ttt{.mokka.evt}
\item \ttt{lcio}: LCIO ASCII format (only available if LCIO is
installed and correctly linked) \newline
Standard suffix: \ttt{.lcio}
\item \ttt{lha}: Implementation of the Les Houches Accord as it was in
the old MadEvent and \whizard~1 \newline
Standard suffix: \ttt{.lha}
\item \ttt{lha\_verb}: more verbose version of \ttt{lha} \newline
Standard suffix: \ttt{.lha.verb}
\item \ttt{lhef}: Formatted Les Houches Accord implementation that
contains the XML headers \newline
Standard suffix: \ttt{.lhe}
\item \ttt{hepmc}: HepMC ASCII format (only available if HepMC is
installed and correctly linked) \newline
Standard suffix: \ttt{.hepmc}
\item \ttt{stdhep}: StdHEP binary format based on the HEPEVT common
block
\newline
Standard suffix: \ttt{.hep}
\item \ttt{stdhep\_up}: StdHEP binary format based on the HEPRUP/HEPEUP
common blocks
\newline
Standard suffix: \ttt{.up.hep}
\item \ttt{stdhep\_ev4}: StdHEP binary format based on the HEPEVT/HEPEV4
common blocks
\newline
Standard suffix: \ttt{.ev4.hep}
\item \ttt{weight\_stream}: Format that prints out only the event
weight (and maybe alternative ones) \newline
Standard suffix: \ttt{.weight.dat}
\end{itemize}
Of course, the variable \ttt{sample\_format} can contain more than one
of the above identifiers, in which case more than one different event
file format is generated. The list above also shows the standard
suffixes for these event formats (remember, that the native binary
format of \whizard\ does have the suffix \ttt{.evx}). (The suffix of
the different event formats can even be changed by the user by setting
the corresponding variable \ttt{\$extension\_lhef = "foo"} or
\ttt{\$extension\_ascii\_short = "bread"}. The dot is automatically
included.)
The name of the corresponding event sample is taken to be the string
of the name of the first process in the \ttt{simulate}
statement. Remember, that conventionally the events for all processes
in one \ttt{simulate} statement will be written into one single event
file. So \ttt{simulate (proc1, proc2)} will write events for the two
processes \ttt{proc1} and \ttt{proc2} into one single event file with
name \ttt{proc1.evx}. The name can be changed by the user with the
command \ttt{\$sample = "<name>"}.
The commands \ttt{\$sample} and \ttt{sample\_format} are both accepted
as optional arguments of a \ttt{simulate} command, so e.g.
\ttt{simulate (proc) \{ \$sample = "foo" sample\_format = hepmc \}}
generates an event sample in the HepMC format for the process
\ttt{proc} in the file \ttt{foo.hepmc}.
Examples for event formats, for specifications of the
event formats correspond the different accords and publicatios:
{\bf HEPEVT:}
The HEPEVT is an ASCII event format that does not contain an event
file header. There is a one-line header for each single event,
containing four entries. The number of particles in the event
(\ttt{ISTHEP}), which is four for a fictitious example process $hh\to
hh$, but could be larger if e.g. beam remnants are demanded to be included in the
event. The second entry and third entry are the number of outgoing
particles and beam remnants, respectively. The event weight is the
last entry. For each particle in the event there are three lines:
the first one is the status according to the HEPEVT format,
\ttt{ISTHEP}, the second one the PDG code, \ttt{IDHEP}, then there are
the one or two possible mother particle, \ttt{JMOHEP}, the first and
last possible daughter particle, \ttt{JDAHEP}, and the polarization.
The second line contains the three momentum components, $p_x$, $p_y$,
$p_z$, the particle energy $E$, and its mass, $m$.
The last line contains the position of the vertex in the event
reconstruction.
\begin{scriptsize}
\begin{verbatim}
4 2 0 3.0574068604E+08
2 25 0 0 3 4 0
0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
2 25 0 0 3 4 0
0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
1 25 1 2 0 0 0
-1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
1 25 1 2 0 0 0
1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
\end{verbatim}
\end{scriptsize}
{\bf ASCII SHORT:}
This is basically the same as the HEPEVT standard, but very much
abbreviated. The header line for each event is identical, but the first
line per particle does only contain the PDG and the polarization,
while the vertex information line is omitted.
\begin{scriptsize}
\begin{verbatim}
4 2 0 3.0574068604E+08
25 0
0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
25 0
0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
25 0
-1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
25 0
1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
\end{verbatim}
\end{scriptsize}
{\bf ASCII LONG:}
Identical to the ASCII short format, but after each event there is a
line containg two values: the value of the sample function to be
integrated over phase space, so basically the squared matrix element
including all normalization factors, flux factor, structure functions
etc.
\begin{scriptsize}
\begin{verbatim}
4 2 0 3.0574068604E+08
25 0
0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
25 0
0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
25 0
-1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
25 0
1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
1.0000000000E+00 1.0000000000E+00
\end{verbatim}
\end{scriptsize}
{\bf ATHENA:}
Quite similar to the HEPEVT ASCII format. The header line, however,
does contain only two numbers: an event counter, and the number of
particles in the event. The first line for each particle lacks the
polarization information (irrelevant for the ATHENA environment), but
has as leading entry an ordering number counting the particles in the
event. The vertex information line has only the four relevant position
entries.
\begin{scriptsize}
\begin{verbatim}
0 4
1 2 25 0 0 3 4
0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
2 2 25 0 0 3 4
0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
3 1 25 1 2 0 0
-1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
4 1 25 1 2 0 0
1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
\end{verbatim}
\end{scriptsize}
{\bf MOKKA:}
Quite similar to the ASCII short format, but the event entries are the
particle status, the PDG code, the first and last daughter, the
three spatial components of the momentum, as well as the mass.
\begin{scriptsize}
\begin{verbatim}
4 2 0 3.0574068604E+08
2 25 3 4 0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 1.2500000000E+02
2 25 3 4 0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 1.2500000000E+02
1 25 0 0 -1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 1.2500000000E+02
1 25 0 0 1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 1.2500000000E+02
\end{verbatim}
\end{scriptsize}
{\bf LHA:}
This is the implementation of the Les Houches Accord, as it was used
in \whizard\ 1 and the old MadEvent. There is a first line containing
six entries: 1. the number of particles in the event, \ttt{NUP},
2. the subprocess identification index, \ttt{IDPRUP}, 3. the event
weight, \ttt{XWGTUP}, 4. the scale of the process, \ttt{SCALUP},
5. the value or status of $\alpha_{QED}$, \ttt{AQEDUP}, 6. the value
for $\alpha_s$, \ttt{AQCDUP}. The next seven lines contain as many
entries as there are particles in the event: the first one has the PDG
codes, \ttt{IDUP}, the next two the first and second mother of the particles,
\ttt{MOTHUP}, the fourth and fifth line the two color indices,
\ttt{ICOLUP}, the next one the status of the particle, \ttt{ISTUP},
and the last line the polarization information, \ttt{ISPINUP}.
At the end of the event there are as lines for each particles with the
counter in the event and the four-vector of the particle. For more
information on this event format confer~\cite{LesHouches}.
\begin{scriptsize}
\begin{verbatim}
25 25 5.0000000000E+02 5.0000000000E+02 -1 -1 -1 -1 3 1
1.0000000000E-01 1.0000000000E-03 1.0000000000E+00 42
4 1 3.0574068604E+08 1.000000E+03 -1.000000E+00 -1.000000E+00
25 25 25 25
0 0 1 1
0 0 2 2
0 0 0 0
0 0 0 0
-1 -1 1 1
9 9 9 9
1 5.0000000000E+02 0.0000000000E+00 0.0000000000E+00 4.8412291828E+02
2 5.0000000000E+02 0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02
3 5.0000000000E+02 -1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00
4 5.0000000000E+02 1.4960220911E+02 4.6042825611E+02 0.0000000000E+00
\end{verbatim}
\end{scriptsize}
{\bf LHEF:}
This is the modern version of the Les Houches accord event format
(LHEF), for the details confer the corresponding publication~\cite{LHEF}.
\begin{scriptsize}
\begin{verbatim}
<LesHouchesEvents version="1.0">
<header>
<generator_name>WHIZARD</generator_name>
<generator_version>2.6.4</generator_version>
</header>
<init>
25 25 5.0000000000E+02 5.0000000000E+02 -1 -1 -1 -1 3 1
1.0000000000E-01 1.0000000000E-03 1.0000000000E+00 42
</init>
<event>
4 42 3.0574068604E+08 1.0000000000E+03 -1.0000000000E+00 -1.0000000000E+00
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
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
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
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
</event>
</LesHouchesEvents>
\end{verbatim}
\end{scriptsize}
Note that for the LHEF format, there are different versions according
to the different stages of agreement. They can be addressed from
within the \sindarin\ file by setting the string variable
\ttt{\$lhef\_version} to one of (at the moment) three values:
\ttt{"1.0"}, \ttt{"2.0"}, or \ttt{"3.0"}. The examples above
corresponds (as is indicated in the header) to the version \ttt{"1.0"}
of the LHEF format. Additional information in form of alternative
squared matrix elements or event weights in the event are the most
prominent features of the other two more advanced versions. For more
details confer the literature.
\vspace{.5cm}
Sample files for the default ASCII format as well as for the debug
event format are shown in the appendix.
%%%%%%%%%
\section[Interfaces to Parton Showers, Matching and
Hadronization]{Interfaces to Parton Showers, Matching\\and
Hadronization}
This section describes the interfaces to the internal parton shower as
well as the parton shower and hadronization routines from
\pythia. Moreover, our implementation of the MLM matching making use
of the parton showers is described. Sample \sindarin\ files are
located in the \ttt{share/examples} directory.
All input files come in two versions, one using the internal shower,
ending in \ttt{W.sin}, and one using \pythia's shower, ending in
\ttt{P.sin}. Thus we state all file names as ending with \ttt{X.sin},
where \ttt{X} has to be replaced by either \ttt{W} or \ttt{P}.
The input files include \ttt{EENoMatchingX.sin} and
\ttt{DrellYanNoMatchingX.sin} for $e^+ e^- \to hadrons$ and $p\bar{p}
\to Z$ without matching. The corresponding \sindarin\ files with
matching enabled are \ttt{EEMatching2X.sin} to \ttt{EEMatching5X.sin}
for $e^+ e^- \to hadrons$ with a different number of partons included
in the matrix element and \ttt{DrallYanMatchingX.sin} for Drell-Yan
with one matched emission.
\subsection{Parton Showers and Hadronization}
From version 2.1 onwards, \whizard\ contains an implementation of an
analytic parton shower as presented in \cite{Kilian:2011ka}, providing
the opportunity to perform the parton shower from whithin
\whizard. Moreover, an interface to \pythia\ is included, which can be
used to delegate the parton shower to \pythia. The same interface can
be used to hadronize events using the generated events using \pythia's
hadronization routines. Note that by \pythia's default, when
performing initial-state radiation multiple interactions are included
and when performing the hadronization hadronic decays are included. If
required, these additional steps have to be switched off using the
corresponding arguments for \pythia's \ttt{PYGIVE} routine vie the
\ttt{\$ps\_PYTHIA\_PYGIVE} string.
Note that from version 2.2.4 on the earlier flag
\ttt{--enable-shower} flag has been abandoned, and there is only a
flag to either compile or not compile the interally attached
\pythia\ttt{6} package (\ttt{--enable-pythia6}) last release of
the \fortran\ \pythia, v6.427) as well as the interface. It can be
invoked by the following \sindarin\ keywords:\\[2ex]
%
\centerline{\begin{tabular}{|l|l|}
\hline\ttt{?ps\_fsr\_active = true} & master switch for final-state
parton showers\\\hline
\ttt{?ps\_isr\_active = true} & master switch for initial-state parton
showers\\\hline
\ttt{?ps\_taudec\_active = true} & master switch for $\tau$ decays (at
the moment only via \ttt{TAUOLA}\\\hline
\ttt{?hadronization\_active = true} & master switch to enable
hadronization\\\hline
\ttt{\$shower\_method = "PYTHIA6"} & switch to use \pythiasix's parton
shower instead of \\ &
\whizard's own shower\\\hline
\end{tabular}}\mbox{}
\vspace{4mm}
If either \ttt{?ps\_fsr\_active} or \ttt{?ps\_isr\_active} is set to \verb|true|, the
event will be transferred to the internal shower routines or the \pythia\ data structures,
and the chosen shower steps (initial- and final-state radiation) will be
performed. If hadronization is enabled via the \ttt{?hadronization\_active} switch, \whizard\ will call \pythia's hadronization routine.
The hadron\-ization can be applied to events showered using the internal shower or showered using \pythia's shower routines, as well as unshowered events.
Any necessary transfer of event data to \pythia\ is automatically taken care of within \whizard's shower interface.
The resulting (showered and/or hadronized) event will be transferred back to \whizard,
the former final particles will be marked as intermediate. The
analysis can be applied to a showered and/or hadronized event just
like in the unshowered/unhadronized case. Any event file can be used
and will contain the showered/hadronized event.
Settings for the internal analytic parton shower are set via the following \sindarin\ variables:\\[2ex]
\begin{description}
\item[\ttt{ps\_mass\_cutoff}] The cut-off in virtuality, below
which, partons are assumed to radiate no more. Used for both ISR and
FSR. Given in $\mbox{GeV}$. (Default = 1.0)
\item[\ttt{ps\_fsr\_lambda}] The value for $\Lambda$ used in
calculating the value of the running coupling constant $\alpha_S$
for Final State Radiation. Given in $\mbox{GeV}$. (Default = 0.29)
\item[\ttt{ps\_isr\_lambda}] The value for $\Lambda$ used in
calculating the value of the running coupling constant $\alpha_S$
for Initial State Radiation. Given in $\mbox{GeV}$. (Default = 0.29)
\item[\ttt{ps\_max\_n\_flavors}] Number of quark flavours taken
into account during shower evolution. Meaningful choices are 3 to
include $u,d,s$-quarks, 4 to include $u,d,s,c$-quarks and 5 to
include $u,d,s,c,b$-quarks. (Default = 5)
\item[\ttt{?ps\_isr\_alphas\_running}] Switch to decide between a
constant $\alpha_S$, given by \ttt{ps\_fixed\_alphas}, and a
running $\alpha_S$, calculated using \ttt{ps\_isr\_lambda} for
ISR. (Default = true)
\item[\ttt{?ps\_fsr\_alphas\_running}] Switch to decide between a
constant $\alpha_S$, given by \ttt{ps\_fixed\_alphas}, and a
running $\alpha_S$, calculated using \ttt{ps\_fsr\_lambda} for
FSR. (Default = true)
\item[\ttt{ps\_fixed\_alphas}] Fixed value of $\alpha_S$ for the
parton shower. Used if either one of the variables
\ttt{?ps\_fsr\_alphas\_running}
or \ttt{?ps\_isr\_alphas\_running} are set to
\verb|false|. (Default = 0.0)
\item[\ttt{?ps\_isr\_angular\_ordered}] Switch for angular ordered
ISR. (Default = true )\footnote{The FSR is always simulated with
angular ordering enabled.}
\item[\ttt{ps\_isr\_primordial\_kt\_width}] The width in
$\mbox{GeV}$ of the Gaussian assumed to describe the transverse
momentum of partons inside the proton. Other shapes are not yet
implemented. (Default = 0.0)
\item[\ttt{ps\_isr\_primordial\_kt\_cutoff}] The maximal transverse
momentum in $\mbox{GeV}$ of a parton inside the proton. Used as a
cut-off for the Gaussian. (Default = 5.0)
\item[\ttt{ps\_isr\_z\_cutoff}] Maximal $z$-value in initial state
branchings. (Default = 0.999)
\item[\ttt{ps\_isr\_minenergy}] Minimal energy in $\mbox{GeV}$ of
an emitted timelike or final parton. Note that the energy is not
calculated in the labframe but in the center-of-mas frame of the two
most initial partons resolved so far, so deviations may
occur. (Default = 1.0)
\item[\ttt{ps\_isr\_tscalefactor}] Factor for the starting scale in
the initial state shower evolution. ( Default = 1.0 )
\item[\ttt{?ps\_isr\_only\_onshell\_emitted\_partons}] Switch to
allow only for on-shell emitted partons, thereby rejecting all
possible final state parton showers starting from partons emitted
during the ISR. (Default = false)
\end{description}
Settings for the \pythia\ are transferred using the following
\sindarin\ variables:\\[2ex]
\centerline{\begin{tabular}{|l|l|}
\hline\ttt{?ps\_PYTHIA\_verbose} & if set to false, output from
\pythia\ will be suppressed\\\hline
\ttt{\$ps\_PYTHIA\_PYGIVE} & a string containing settings transferred
to \pythia's \ttt{PYGIVE} subroutine.\\ & The format is explained in
the \pythia\ manual. The limitation to 100 \\ & characters mentioned
there does not apply here, the string is split \\ & appropriately
before being transferred to \pythia.\\\hline
\end{tabular}}\mbox{}
\vspace{4mm}
Note that the included version of \pythia\ uses \lhapdf\ for initial state
radiation whenever this is available, but the PDF set has to be set
manually in that case using the keyword \ttt{ps\_PYTHIA\_PYGIVE}.
\subsection{Parton shower -- Matrix Element Matching}
Along with the inclusion of the parton showers, \whizard\ includes an
implementation of the MLM matching procedure. For a detailed
description of the implemented steps see \cite{Kilian:2011ka}. The
inclusion of MLM matching still demands some manual settings in the
\sindarin\ file. For a given base process and a matching of $N$
additional jets, all processes that can be obtained by attaching up to
$N$ QCD splittings, either a quark emitting a gluon or a gluon
splitting into two quarks ar two gluons, have to be manually specified
as additional processes. These additional processes need to be
included in the \ttt{simulate} statement along with the original
process. The \sindarin\ variable \ttt{mlm\_nmaxMEjets} has to be
set to the maximum number of additional jets $N$. Moreover additional
cuts have to be specified for the additional processes.
\begin{verbatim}
alias quark = u:d:s:c
alias antiq = U:D:S:C
alias j = quark:antiq:g
?mlm_matching = true
mlm_ptmin = 5 GeV
mlm_etamax = 2.5
mlm_Rmin = 1
cuts = all Dist > mlm_Rmin [j, j]
and all Pt > mlm_ptmin [j]
and all abs(Eta) < mlm_etamax [j]
\end{verbatim}
Note that the variables \ttt{mlm\_ptmin}, \ttt{mlm\_etamax} and
\ttt{mlm\_Rmin} are used by the matching routine. Thus, replacing the
variables in the \ttt{cut} expression and omitting the assignment
would destroy the matching procedure.
The complete list of variables introduced to steer the matching procedure is as follows:
\begin{description}
\item[\ttt{?mlm\_matching\_active}] Master switch to enable MLM
matching. (Default = false)
\item[\ttt{mlm\_ptmin}] Minimal transverse momentum, also used in
the definition of a jet
\item[\ttt{mlm\_etamax}] Maximal absolute value of pseudorapidity
$\eta$, also used in defining a jet
\item[\ttt{mlm\_Rmin}] Minimal $\eta-\phi$ distance $R_{min}$
\item[\ttt{mlm\_nmaxMEjets}] Maximum number of jets $N$
\item[\ttt{mlm\_ETclusfactor}] Factor to vary the jet
definition. Should be $\geq 1$ for complete coverage of phase
space. (Default = 1)
\item[\ttt{mlm\_ETclusminE}] Minimal energy in the variation of the
jet definition
\item[\ttt{mlm\_etaclusfactor}] Factor in the variation of the jet
definition. Should be $\leq 1$ for complete coverage of phase
space. (Default = 1)
\item[\ttt{mlm\_Rclusfactor}] Factor in the variation of the jet
definition. Should be $\ge 1$ for complete coverage of phase
space. (Default = 1)
\end{description}
The variation of the jet definition is a tool to asses systematic
uncertainties introduced by the matching procedure (See section 3.1 in
\cite{Kilian:2011ka}).
%%%%%%%%%
\section{Rescanning and recalculating events}
\label{sec:rescan}
In the simplest mode of execution, \whizard\ handles its events at the
point where they are generated. It can apply event transforms such as
decays or shower (see above), it can analyze the events, calculate and
plot observables, and it can output them to file. However, it is also
possible to apply two different operations to those events in
parallel, or to reconsider and rescan an event sample that has been
previously generated.
We first discuss the possibilities that \ttt{simulate} offers. For
each event, \whizard\ calculates the matrix element for the hard
interaction, supplements this by Jacobian and phase-space factors in
order to obtain the event weight, optionally applies a rejection step
in order to gather uniformly weighted events, and applies the
cuts and analysis setup. We may ask about the event matrix element or
weight, or the analysis result, that we would have obtained for a
different setting. To this end, there is an \ttt{alt\_setup} option.
This option allows us to recalculate, event by event, the matrix
element, weight, or analysis contribution with a different parameter
set but identical kinematics. For instance, we may evaluate a
distribution for both zero and non-zero anomalous coupling \ttt{fw}
and enter some observable in separate histograms:
\begin{footnotesize}
\begin{verbatim}
simulate (some_proc) {
fw = 0
analysis = record hist1 (eval Pt [H])
alt_setup = {
fw = 0.01
analysis = record hist2 (eval Pt [H])
}
}
\end{verbatim}
\end{footnotesize}
In fact, the \ttt{alt\_setup} object is not restricted to a single
code block (enclosed in curly braces) but can take a list of those,
\begin{footnotesize}
\begin{verbatim}
alt_setup = { fw = 0.01 }, { fw = 0.02 }, ...
\end{verbatim}
\end{footnotesize}
Each block provides the environment for a separate evaluation of the
event data. The generation of these events, i.e., their kinematics,
is still steered by the primary environment.
The \ttt{alt\_setup} blocks may modify various settings that affect the
evaluation of an event, including physical parameters, PDF choice,
cuts and analysis, output format, etc. This must not (i.e., cannot)
affect the kinematics of an event, so don't modify particle masses.
When applying cuts, they can only reduce the generated event sample,
so they apply on top of the primary cuts for the simulation.
Alternatively, it is possible to \ttt{rescan} a sample that has been
generated by a previous \ttt{simulate} command:
\begin{footnotesize}
\begin{verbatim}
simulate (some_proc) { $sample = "my_events"
analysis = record hist1 (eval Pt [H])
}
?update_sqme = true
?update_weight = true
rescan "my_events" (some_proc) {
fw = 0.01
analysis = record hist2 (eval Pt [H])
}
rescan "my_events" (some_proc) {
fw = 0.05
analysis = record hist3 (eval Pt [H])
}
\end{verbatim}
\end{footnotesize}
In more complicated situation, rescanning is more transparent and
offers greater flexibility than doing all operations at the very point
of event generation.
Combining these features with the \ttt{scan} looping construct, we
already cover a considerable range of applications. (There are
limitations due to the fact that \sindarin\ doesn't provide array
objects, yet.) Note that the \ttt{rescan} construct also allows
for an \ttt{alt\_setup} option.
You may generate a new sample by rescanning, for which you may choose
any output format:
\begin{footnotesize}
\begin{verbatim}
rescan "my_events" (some_proc) {
selection = all Pt > 100 GeV [H]
$sample = "new_events"
sample_format = lhef
}
\end{verbatim}
\end{footnotesize}
The event sample that you rescan need not be an internal raw \whizard\
file, as above. You may rescan a LHEF file,
\begin{footnotesize}
\begin{verbatim}
rescan "lhef_events" (proc) {
$rescan_input_format = "lhef"
}
\end{verbatim}
\end{footnotesize}
This file may have any origin, not necessarily from \whizard. To
understand such an external file, \whizard\ must be able to
reconstruct the hard process and match it to a process with a known
name (e.g., \ttt{proc}), that has been defined in the \sindarin\ script
previously.
Within its limits, \whizard\ can thus be used for translating an event
sample from one format to another format.
There are three important switches that control the rescanning
behavior. They can be set or unset independently.
\begin{itemize}
\item \ttt{?update\_sqme} (default: false).
If true, \whizard\ will recalculate the hard matrix element for each
event. When applying an analysis, the recalculated squared matrix
element (averaged and summed over quantum numbers as usual) is
available as the variable \ttt{sqme\_prc}. This may be related to
\ttt{sqme\_ref}, the corresponding
value in the event file, if available. (For the \ttt{alt\_env}
option, this switch is implied.)
\item \ttt{?update\_weight} (default: false).
If true, \whizard\ will recalculate the event weight according to
the current environment and apply this to the event. In particular,
the user may apply a \ttt{reweight} expression. In an
analysis, the new weight value is available as \ttt{weight\_prc}, to
be related
to \ttt{weight\_ref} from the sample. The updated weight will be
applied for histograms and averages. An unweighted event sample
will thus be transformed into a weighted event sample. (This switch
is also implied for the \ttt{alt\_env} option.)
\item \ttt{?update\_event} (default: false).
If true, \whizard\ will generate a new decay chain etc., if
applicable. That is, it reuses just the particles in the hard
process. Otherwise, the complete event is kept as it is written to
file.
\end{itemize}
For these options to make sense, \whizard\ must have access to a full
process object, so the \sindarin\ script must contain not just a
definition but also a \ttt{compile} command for the matrix elements in
question.
If an event file (other than raw format) contains several processes as
a mixture, they must be identifiable by a numeric ID. \whizard\ will
recognize the processes if their respective \sindarin\ definitions
contain appropriate \ttt{process\_num\_id} options, such as
\begin{footnotesize}
\begin{verbatim}
process foo = u, ubar => d, dbar { process_num_id = 42 }
\end{verbatim}
\end{footnotesize}
Certain event-file formats, such as LHEF, support alternative
matrix-element values or weights. \whizard\ can thus write both
original and
recalculated matrix-element and weight values.
Other formats support only a single
event weight, so the \ttt{?update\_weight} option is necessary for a
visible effect.
External event files in formats such as LHEF, HepMC, or LCIO, also may
carry information about the value of the strong coupling $\alpha_s$
and the energy scale of each event. This information will also be
provided by \whizard\ when writing external event files. When such an
event file is rescanned, the user has the choice to either user the
$\alpha_s$ value that \whizard\ defines in the current context (or the
method for obtaining an event-specific running $\alpha_s$ value), or
override this for each event by using the value in the event file.
The corresponding parameter is \ttt{?use\_alphas\_from\_file}, which
is false by default. Analogously, the parameter
\ttt{?use\_scale\_from\_file} may be set to override the scale
definition in the current context. Obviously, these settings
influence matrix-element recalculation and therefore require
\ttt{?update\_sqme} to be set in order to become operational.
%%%%%%%%%
\section{Negative weight events}
For usage at NLO refer to Subsection~\ref{ss:fixedorderNLOevents}.
In case, you have some other mechanism to produce events with negative
weights (e.g. with the \ttt{weight = {\em <expr>}} command), keep in
mind that you should activate \ttt{?negative\_weights = true} and
\ttt{unweighted = false}. The generation of unweighted events with
varying sign (also known as events and counter events) is currently not
supported.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{User Code Plug-Ins}
\label{chap:user}
{\color{red}
Note that the user-code plug-in mechanism has been currently (for
version 2.2.0) disabled, as the huge refactoring of the code between
versions 2.1.X and 2.2.X has completely changed many of the
interfaces. We plan to bring the interface for user code for spectra,
structure functions and event shapes, cuts and observables back online
as soon as possible, at latest for version 2.4.0.
}
\vspace{2cm}
\section{The plug-in mechanism}
The capabilities of \whizard\ and its \sindarin\ command
language are not always sufficient to adapt to all users' needs. To
make the program more versatile, there are several spots in the
workflow where the user may plug in his/her own code, to enhance or
modify the default behavior.
User code can be injected, without touching \whizard's source code, in
the following places:
\begin{itemize}
\item
Cuts, weights, analysis, etc.:
\begin{itemize}
\item
Cut functions that operate on a whole subevent.
\item
Observable (e.g., event shapes) calculated from a whole subevent.
\item
Observable calculated for a particle or particle pair.
\end{itemize}
\item
Spectra and structure functions.
\end{itemize}
Additional plug-in locations may be added in the future.
User code is loaded dynamically by \whizard. There are two
possibilities:
\begin{enumerate}
\item
The user codes the required procedures in one or more Fortran source
files that are present in the working directory of the \whizard\
program. \whizard\ is called with the \ttt{-u} flag:
\begin{quote}
\ttt{whizard -u --user-src=\emph{user-source-code-file}} \ldots
\end{quote}
The file must have the extension \ttt{.f90}, and the file name must
be specified without extension.
There may be an arbitrary number of user source-code files. The
compilation is done in order of appearance. If the name of the user
source-code file is \ttt{user.f90}, the flag \ttt{--user-src} can
be omitted.
This tells the program to compile and dynamically link the code at
runtime. The basename of the linked library is \ttt{user}.
If a compiled (shared) library with that name already exists, it is taken
as-is. If the
user code changes or the library becomes invalid for other reasons,
recompilation of the user-code files can be forced by the flag
\ttt{--rebuild-user} or by the generic \ttt{-r} flag.
\item
The user codes and compiles the required procedures him/herself.
They should be provided in form of a library, where the interfaces of
the individual procedures follow C calling conventions and exactly
match the required interfaces as described in the following
sections. The library must be compiled in such a way that it can be
dynamically linked. If the calling conventions are met, the actual
user code may be written in any programming language. E.g., it may
be coded in Fortran, C, or C++ (with \ttt{extern(C)} specifications).
\whizard\ is called with the \ttt{-u} flag and is
given the name of the user library as
\begin{quote}
\ttt{whizard -u --user-lib=\emph{user-library-file}} \ldots
\end{quote}
\end{enumerate}
The library file should either be a dynamically loadable (shared)
library with appropriate extension (\ttt{.so} on Linux), or a libtool
archive (\ttt{.la}).
The user-provided procedures may have arbitrary names; the user just
has to avoid clashes with procedures from the Fortran runtime library
or from the operating-system environment.
\section{Data Types Used for Communication}
\label{sec:c_prt}
Since the user-code interface is designed to be interoperable with C,
it communicates with \whizard\ only via C-interoperable data types.
The basic data types (Fortran: integer and real kinds) \ttt{c\_int}
and \ttt{c\_double} are usually identical with the default kinds on
the Fortran side. If necessary, explicit conversion may be inserted.
For transferring particle data, we are using a specific derived type
\ttt{c\_prt\_t} which has the following content:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
type, bind(C) :: c_prt_t
integer(c_int) :: type
integer(c_int) :: pdg
integer(c_int) :: polarized
integer(c_int) :: h
real(c_double) :: pe
real(c_double) :: px
real(c_double) :: py
real(c_double) :: pz
real(c_double) :: p2
end type c_prt_t
\end{verbatim}
\end{footnotesize}
\end{quote}
The meaning of the entries is as follows:
\begin{description}
\item[\ttt{type}:] The type of the particle. The common type
codes are 1=incoming, 2=outgoing, and 3=composite. A composite
particle in a subevent is created from a combination of individual
particle momenta, e.g., in jet clustering. If the status code is
not defined, it is set to zero.
\item[\ttt{pdg}:] The particle identification code as proposed by the
Particle Data Group. If undefined, it is zero.
\item[\ttt{polarized}:] If nonzero, the particle is polarized. The
only polarization scheme supported at this stage is helicity. If
zero, particle polarization is ignored.
\item[\ttt{h}:] If the particle is polarized, this is the helicity. $0$
for a scalar, $\pm 1$ for a spin-1/2 fermion, $-1,0,1$ for a spin-1
boson.
\item[\ttt{pe}:] The energy in GeV.
\item[\ttt{px}/\ttt{py}:] The transversal momentum components in GeV.
\item[\ttt{pz}:] The longitudinal momentum component in GeV.
\item[\ttt{p2}:] The invariant mass squared of the actual momentum in GeV$^2$.
\end{description}
\whizard\ does not provide tools for manipulating \ttt{c\_prt\_t}
objects directly. However, the four-momentum can be used in
Lorentz-algebra calculations from the \ttt{lorentz} module. To this
end, this module defines the transformational functions
\ttt{vector4\_from\_c\_prt} and \ttt{vector4\_to\_c\_prt}.
\section{User-defined Observables and Functions}
\subsection{Cut function}
Instead of coding a cut expression in \sindarin, it may be coded in
Fortran, or in any other language with a C-compatible interface. A
user-defined cut expression is referenced in \sindarin\ as follows:
\begin{quote}
\begin{footnotesize}
\ttt{cuts = user\_cut (\emph{name-string}) [\emph{subevent}]}
\end{footnotesize}
\end{quote}
The \ttt{\emph{name-string}} is an expression that evaluates to
string, the name of the function to call in the user code. The
\emph{subevent} is a subevent expression, analogous to the built-in
cut definition syntax. The result of the \ttt{user\_cut} function is
a logical value in \sindarin. It is true if the event passes the cut,
false otherwise.
If coded in Fortran, the actual user-cut function in the user-provided
source code has the following form:
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
function user_cut_fun (prt, n_prt) result (iflag) bind(C)
use iso_c_binding
use c_particles
type(c_prt_t), dimension(*), intent(in) :: prt
integer(c_int), intent(in) :: n_prt
integer(c_int) :: iflag
! ... code that evaluates iflag
end function user_cut_fun
\end{verbatim}
\end{footnotesize}
\end{quote}
Here, \ttt{user\_cut\_fun} can be replaced by an arbitrary name by
which the function is referenced as \ttt{\emph{name-string}} above.
The \ttt{bind(C)} attribute in the function declaration is mandatory.
The argument \ttt{prt} is an array of objects of type \ttt{c\_prt\_t},
as described above. The integer \ttt{n\_prt} is the number of entries
in the array. It is passed separately in order to determine the
actual size of the assumed-size \ttt{prt} array.
The result \ttt{iflag} is an integer. A nonzero value indicates
\ttt{true} (i.e., the event passes the cut), zero value indicates
\ttt{false}. (We do not use boolean values in the interface because
their interoperability might be problematic on some systems.)
\subsection{Event-shape function}
An event-shape function is similar to a cut function. It takes a
subevent as argument and returns a real (i.e., C double) variable. It
can be used for defining subevent observables, event weights, or the
event scale, as in
\begin{quote}
\begin{footnotesize}
\ttt{analysis = record \emph{hist-id} (user\_event\_fun (\emph{name-string}) [\emph{subevent}])}
\end{footnotesize}
\end{quote}
or
\begin{quote}
\begin{footnotesize}
\ttt{scale = user\_event\_fun (\emph{name-string}) [\emph{subevent}]}
\end{footnotesize}
\end{quote}
The corresponding Fortran source code has the form
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
function user_event_fun (prt, n_prt) result (rval) bind(C)
use iso_c_binding
use c_particles
type(c_prt_t), dimension(*), intent(in) :: prt
integer(c_int), intent(in) :: n_prt
real(c_double) :: rval
! ... code that evaluates rval
end function user_event_fun
\end{verbatim}
\end{footnotesize}
\end{quote}
with \ttt{user\_event\_fun} replaced by \ttt{\emph{name-string}}.
\subsection{Observable}
In \sindarin, an observable-type function is a function of one or two
particle objects that returns a real value. The particle objects
result from scanning over subevents. In the \sindarin\ code, the
observable is used like a variable; the particle-object arguments are
implictly assigned.
A user-defined observable is used analogously, e.g.,
\begin{quote}
\begin{footnotesize}
\ttt{cuts = all user\_obs (\emph{name-string}) > 0 [\emph{subevent}]}
\end{footnotesize}
\end{quote}
The user observable is defined, as Fortran code, as either a unary or
as a binary C-double-valued function of \ttt{c\_prt\_t} objects. The
use in \sindarin\ (unary or binary) must match the definition.
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
function user_obs_unary (prt1) result (rval) bind(C)
use iso_c_binding
use c_particles
type(c_prt_t), intent(in) :: prt1
real(c_double) :: rval
! ... code that evaluates rval
end function user_obs_unary
\end{verbatim}
\end{footnotesize}
\end{quote}
or
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
function user_obs_binary (prt1, prt2) result (rval) bind(C)
use iso_c_binding
use c_particles
type(c_prt_t), intent(in) :: prt1, prt2
real(c_double) :: rval
! ... code that evaluates rval
end function user_obs_binary
\end{verbatim}
\end{footnotesize}
\end{quote}
with \ttt{user\_obs\_unary}/\ttt{binary} replaced by
\ttt{\emph{name-string}}.
\subsection{Examples}
For an example, we implement three different ways of computing the
transverse momentum of a particle. This observable is actually
built into \whizard, so the examples are not particularly useful. However,
implementing kinematical functions that are not supported (yet) by
\whizard\ (and not easily computed via \sindarin\ expressions)
proceeds along the same lines.
\subsubsection{Cut}
The first function is a complete cut which can be used as
\begin{quote}
\begin{footnotesize}
\ttt{cuts = user\_cut("ptcut") [\emph{subevt}]}
\end{footnotesize}
\end{quote}
It is equivalent to
\begin{quote}
\begin{footnotesize}
\ttt{cuts = all Pt $>$ 50 [\emph{subevt}]}
\end{footnotesize}
\end{quote}
The implementation reads
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
function ptcut (prt, n_prt) result (iflag) bind(C)
use iso_c_binding
use c_particles
use lorentz
type(c_prt_t), dimension(*), intent(in) :: prt
integer(c_int), intent(in) :: n_prt
integer(c_int) :: iflag
logical, save :: first = .true.
if (all (transverse_part (vector4_from_c_prt (prt(1:n_prt))) > 50)) then
iflag = 1
else
iflag = 0
end if
end function ptcut
\end{verbatim}
\end{footnotesize}
\end{quote}
The procedure makes use of the kinematical functions in the
\ttt{lorentz} module, after transforming the particles into a
\ttt{vector4} array.
\subsubsection{Event Shape}
Similar functionality can be achieved by implementing an event-shape
function. The function computes the minimum $p_T$ among all particles
in the subevent. The \sindarin\ expression reads
\begin{quote}
\begin{footnotesize}
\ttt{cuts = user\_event\_shape("pt\_min") [\emph{subevt}] $>$ 50}
\end{footnotesize}
\end{quote}
and the function is coded as
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
function pt_min (prt, n_prt) result (rval) bind(C)
use iso_c_binding
use c_particles
use lorentz
type(c_prt_t), dimension(*), intent(in) :: prt
integer(c_int), intent(in) :: n_prt
real(c_double) :: rval
rval = minval (transverse_part (vector4_from_c_prt (prt(1:n_prt))))
end function pt_min
\end{verbatim}
\end{footnotesize}
\end{quote}
\subsubsection{Observable}
The third (and probably simplest) user implementation of the $p_T$ cut
computes a single-particle observable. Here, the usage is
\begin{quote}
\begin{footnotesize}
\ttt{cuts = all user\_obs("ptval") $>$ 50 [\emph{subevt}]}
\end{footnotesize}
\end{quote}
and the subroutine reads
\begin{quote}
\begin{footnotesize}
\begin{verbatim}
function ptval (prt1) result (rval) bind(C)
use iso_c_binding
use c_particles
use lorentz
type(c_prt_t), intent(in) :: prt1
real(c_double) :: rval
rval = transverse_part (vector4_from_c_prt (prt1))
end function ptval
\end{verbatim}
\end{footnotesize}
\end{quote}
\section{User Code and Static Executables}
In Sec.~\ref{sec:static} we describe how to build a static executable that can
be submitted to batch jobs, e.g., on the grid, where a compiler may not be
available.
If there is user plug-in code, it would require the same setup of
libtool, compiler and linker on the target host, as physical process
code. To avoid this, it is preferable to link the user code
statically with the executable, which is then run as a monolithic
program.
This is actually simple. Two conditions have to be met:
\begin{enumerate}
\item
The \whizard\ job that creates the executable has to be given the appropriate
options (\ttt{-u}, \ttt{--user-src}, \ttt{--user-lib}) such that
the user code is dynamically compiled and linked.
\item
The compile command in the \sindarin\ script which creates the
executable takes options that list the procedures which the
stand-alone program should access:
\begin{quote}
\begin{footnotesize}
\ttt{%
compile as "\emph{executable-name}" \{ \\
\hspace*{2em} \$user\_procs\_cut = "\emph{cut-proc-names}"\\
\hspace*{2em} \$user\_procs\_event\_shape = "\emph{event-shape-proc-names}"\\
\hspace*{2em} \$user\_procs\_obs1 = "\emph{obs1-proc-names}"\\
\hspace*{2em} \$user\_procs\_obs2 = "\emph{obs2-proc-names}"\\
\hspace*{2em} \$user\_procs\_sf = "\emph{strfun-names}"\\
\}}
\end{footnotesize}
\end{quote}
The values of these option variables are comma-separated lists of procedure
names, grouped by their nature. \ttt{obs1} and \ttt{obs2} refer to unary
and binary observables, respectively. The \ttt{strfun-names} are
the names of the user-defined spectra or structure functions as they
would appear in the \sindarin\ file which uses them.
\end{enumerate}
With these conditions met, the stand-alone executable will have the
user code statically linked, and it will be able to use exactly those
user-defined routines that have been listed in the various option
strings. (It is possible nevertheless, to plug in additional user code
into the stand-alone executable, using the same options as for the
original \whizard\ program.)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Data Visualization}
\label{chap:visualization}
\section{GAMELAN}
The data values and tables that we have introduced in the previous section can
be visualized using built-in features of \whizard. To be precise,
\whizard\ can write \LaTeX\ code which incorporates code in the graphics
language GAMELAN to produce a pretty-printed account of observables,
histograms, and plots.
GAMELAN is a macro package for MetaPost, which is part of the
\TeX/\LaTeX\ family. MetaPost, a derivative of Knuth's MetaFont language for
font design, is usually bundled with the \TeX\ distribution, but might need a
separate switch for installation. The GAMELAN macros are contained in a
subdirectory of the \whizard\ package. Upon installation, they will be
installed in the appropriate directory, including the \ttt{gamelan.sty} driver
for \LaTeX. \whizard\ uses a subset of GAMELAN's graphics macros
directly, but it allows for access to the full package if desired.
An (incomplete) manual for GAMELAN can be found in the \ttt{share/doc}
subdirectory of the \whizard\ system. \whizard\ itself uses a subset of the
GAMELAN capabilities, interfaced by \sindarin\ commands and parameters. They
are described in this chapter.
To process analysis output beyond writing tables to file, the
\ttt{write\_analysis} command described in the previous section should be
replaced by \ttt{compile\_analysis}, with the same syntax:
\begin{quote}
\begin{footnotesize}
\ttt{compile\_analysis (\emph{analysis-tags}) \{ \ttt{\emph{options}} \}}
\end{footnotesize}
\end{quote}
where \ttt{\emph{analysis-tags}}, a comma-separated list of analysis objects,
is optional. If there are no tags, all analysis objects are processed. The
\ttt{\emph{options}} script of local commands is also optional, of course.
This command will perform the following actions:
\begin{enumerate}
\item
It writes a data file in default format, as \ttt{write\_analysis} would do.
The file name is given by \ttt{\$out\_file}, if nonempty. The file must not
be already open, since the command needs a self-contained file, but the name
is otherwise arbitrary. If the value of \ttt{\$out\_file} is empty, the
default file name is \ttt{whizard\_analysis.dat}.
\item
It writes a driver file for the chosen datasets, whose name is derived from
the data file by replacing the file extension of the data file with the
extension \ttt{.tex}. The driver file is a \LaTeX\ source file which
contains embedded GAMELAN code that handles the selected graphics data. In
the \LaTeX\ document, there is a separate section for each contained
dataset. Furthermore, a process-/analysis-specific makefile with the
name \ttt{<process\_name>\_ana.makefile} is created that can be used
to generate postscript or PDF output from the \LaTeX\ source. If the
steering flag \ttt{?analysis\_file\_only} is set to \ttt{true}, then
the \LaTeX\ file and the makefile are only written, but no execution
of the makefile resulting in compilation of the \LaTeX\ code (see
the next item) is invoked.
\item
As mentioned above, if the flag \ttt{?analysis\_file\_only} is set
to \ttt{false} (which is the default), the driver file is processed
by \LaTeX (invoked by calling the makefile with the name
\ttt{<process\_name>\_ana.makefile}), which generates an appropriate
GAMELAN source file with extension \ttt{.mp}. This code is executed
(calling GAMELAN/MetaPost, and again \LaTeX\ for typesetting embedded
labels). There is a second \LaTeX\ pass (automatically done by the
makefile) which collects the results, and finally conversion to
PostScript and PDF formats.
\end{enumerate}
The resulting PostScript or PDF file -- the file name is the name of the data
file with the extension replaced by \ttt{.ps} or \ttt{.pdf}, respectively
-- can be printed or viewed with an appropriate viewer such as \ttt{gv}. The
viewing command is not executed automatically by \whizard.
Note that \LaTeX\ will write further files with extensions \ttt{.log},
\ttt{.aux}, and \ttt{.dvi}, and GAMELAN will produce auxiliary files with
extensions \ttt{.ltp} and \ttt{.mpx}. The log file in particular, could
overwrite \whizard's log file if the basename is identical. Be careful to use
a value for \ttt{\$out\_file} which is not likely to cause name clashes.
\subsection{User-specific changes}
In the case, that the \sindarin\ \ttt{compile\_analysis} command is
invoked and the flag named \ttt{?analysis\_file\_only} is not changed
from its default value \ttt{false}, \whizard\ calls the
process-/analysis-specific makefile triggering the compilation of the
\LaTeX\ code and the GAMELAN plots and histograms. If the user wants
to edit the analysis output, for example changing captions, headlines,
labels, properties of the plots, graphs and histograms using GAMELAN
specials etc., this is possible and the output can be regenerated
using the makefile. The user can also directly invoke the GAMELAN
script, \ttt{whizard-gml}, that is installed in the binary directly
along with the \whizard\ binary and other scripts. Note however, that
the \LaTeX\ environment for the specific style files have to be set by
hand (the command line invocation in the makefile does this
automatically). Those style files are generally written into
\ttt{share/texmf/whizard/} directory. The user can execute the
commands in the same way as denoted in the process-/analysis-specific
makefile by hand.
%%%%%
\section{Histogram Display}
%%%%%
\section{Plot Display}
\section{Graphs}
\label{sec:graphs}
Graphs are an additional type of analysis object. In contrast to histograms
and plots, they do not collect data directly, but they rather act as
containers for graph elements, which are copies of existing histograms and
plots. Their single purpose is to be displayed by the GAMELAN driver.
Graphs are declared by simple assignments such as
\begin{quote}
\begin{footnotesize}
\ttt{graph g1 = hist1}
\\
\ttt{graph g2 = hist2 \& hist3 \& plot1}
\end{footnotesize}
\end{quote}
The first declaration copies a single histogram into the graph, the second one
copies two histograms and a plot. The syntax for collecting analysis objects
uses the \ttt{\&} concatenation operator, analogous to string concatenation.
In the assignment, the rhs must contain only histograms and plots. Further
concatenating previously declared graphs is not supported.
After the graph has been declared, its contents can be written to file
(\ttt{write\_analysis}) or, usually, compiledd by the \LaTeX/GAMELAN driver
via the \ttt{compile\_analysis} command.
The graph elements on the right-hand side of the graph assignment are copied
with their current data content. This implies a well-defined order of
statements: first, histograms and plots are declared, then they are filled via
\ttt{record} commands or functions, and finally they can be collected for
display by graph declarations.
A simple graph declaration without options as above is possible, but usually
there are option which affect the graph display. There are two kinds of
options: graph options and drawing options. Graph options apply to the graph
as a whole (title, labels, etc.) and are placed in braces on the lhs of the
assigment. Drawing options apply to the individual graph elements
representing the contained histograms and plots, and are placed together with
the graph element on the rhs of the assignment. Thus, the complete syntax for
assigning multiple graph elements is
\begin{quote}
\begin{footnotesize}
\ttt{graph \emph{graph-tag} \{ \emph{graph-options} \}}
\\
\ttt{= \emph{graph-element-tag1} \{ \emph{drawing-options1} \}}
\\
\ttt{\& \emph{graph-element-tag2} \{ \emph{drawing-options2} \}}
\\
\ldots
\end{footnotesize}
\end{quote}
This form is recommended, but graph and drawing options can also be set as
global parameters, as usual.
We list the supported graph and drawing options in
Tables~\ref{tab:graph-options} and \ref{tab:drawing-options}, respectively.
\begin{table}
\caption{Graph options. The content of strings of type \LaTeX\ must be
valid \LaTeX\ code (containing typesetting commands such as math mode).
The content of strings of type GAMELAN must be valid GAMELAN code.
If a graph bound is kept \emph{undefined}, the actual graph bound is
determined such as not to crop the graph contents in the selected
direction.}
\label{tab:graph-options}
\begin{center}
\begin{tabular}{|l|l|l|l|}
\hline
Variable & Default & Type & Meaning
\\
\hline\hline
\ttt{\$title} & \ttt{""} & \LaTeX &
Title of the graph = subsection headline
\\
\hline
\ttt{\$description} & \ttt{""} & \LaTeX &
Description text for the graph
\\
\hline
\ttt{\$x\_label} & \ttt{""} & \LaTeX &
$x$-axis label
\\
\hline
\ttt{\$y\_label} & \ttt{""} & \LaTeX &
$y$-axis label
\\
\hline
\ttt{graph\_width\_mm} & 130 & Integer &
graph width (on paper) in mm
\\
\hline
\ttt{graph\_height\_mm} & 90 & Integer &
graph height (on paper) in mm
\\
\hline
\ttt{?x\_log} & false & Logical &
Whether the $x$-axis scale is linear or logarithmic
\\
\hline
\ttt{?y\_log} & false & Logical &
Whether the $y$-axis scale is linear or logarithmic
\\
\hline
\ttt{x\_min} & \emph{undefined} & Real &
Lower bound for the $x$ axis
\\
\hline
\ttt{x\_max} & \emph{undefined} & Real &
Upper bound for the $x$ axis
\\
\hline
\ttt{y\_min} & \emph{undefined} & Real &
Lower bound for the $y$ axis
\\
\hline
\ttt{y\_max} & \emph{undefined} & Real &
Upper bound for the $y$ axis
\\
\hline
\ttt{gmlcode\_bg} & \ttt{""} & GAMELAN &
Code to be executed before drawing
\\
\hline
\ttt{gmlcode\_fg} & \ttt{""} & GAMELAN &
Code to be executed after drawing
\\
\hline
\end{tabular}
\end{center}
\end{table}
\begin{table}
\caption{Drawing options. The content of strings of type GAMELAN must be
valid GAMELAN code. The behavior w.r.t. the flags with \emph{undefined}
default value depends on the type of graph element. Histograms: draw
baseline, piecewise, fill area, draw curve, no errors, no symbols; Plots:
no baseline, no fill, draw curve, no errors, no symbols.}
\label{tab:drawing-options}
\begin{center}
\begin{tabular}{|l|l|l|l|}
\hline
Variable & Default & Type & Meaning
\\
\hline\hline
\ttt{?draw\_base} & \emph{undefined} & Logical &
Whether to draw a baseline for the curve
\\
\hline
\ttt{?draw\_piecewise} & \emph{undefined} & Logical &
Whether to draw bins separately (histogram)
\\
\hline
\ttt{?fill\_curve} & \emph{undefined} & Logical &
Whether to fill area between baseline and curve
\\
\hline
\ttt{\$fill\_options} & \ttt{""} & GAMELAN &
Options for filling the area
\\
\hline
\ttt{?draw\_curve} & \emph{undefined} & Logical &
Whether to draw the curve as a line
\\
\hline
\ttt{\$draw\_options} & \ttt{""} & GAMELAN &
Options for drawing the line
\\
\hline
\ttt{?draw\_errors} & \emph{undefined} & Logical &
Whether to draw error bars for data points
\\
\hline
\ttt{\$err\_options} & \ttt{""} & GAMELAN &
Options for drawing the error bars
\\
\hline
\ttt{?draw\_symbols} & \emph{undefined} & Logical &
Whether to draw symbols at data points
\\
\hline
\ttt{\$symbol} & Black dot & GAMELAN &
Symbol to be drawn
\\
\hline
\ttt{gmlcode\_bg} & \ttt{""} & GAMELAN &
Code to be executed before drawing
\\
\hline
\ttt{gmlcode\_fg} & \ttt{""} & GAMELAN &
Code to be executed after drawing
\\
\hline
\end{tabular}
\end{center}
\end{table}
\section{Drawing options}
The options for coloring lines, filling curves, or choosing line styles make
use of macros in the GAMELAN language. At this place, we do not intend to
give a full account of the possiblities, but we rather list a few basic
features that are likely to be useful for drawing graphs.
\subsubsection{Colors}
GAMELAN knows about basic colors identified by name:
\begin{center}
\ttt{black}, \ttt{white}, \ttt{red}, \ttt{green}, \ttt{blue}, \ttt{cyan},
\ttt{magenta}, \ttt{yellow}
\end{center}
More generically, colors in GAMELAN are RGB triplets of numbers (actually,
numeric expressions) with values between 0 and 1, enclosed in brackets:
\begin{center}
\ttt{(\emph{r}, \emph{g}, \emph{b})}
\end{center}
To draw an object in color, one should apply the construct \ttt{withcolor
\emph{color}} to its drawing code. The default color is always black.
Thus, this will make a plot drawn in blue:
\begin{quote}
\begin{footnotesize}
\ttt{\$draw\_options = "withcolor blue"}
\end{footnotesize}
\end{quote}
and this will fill the drawing area of some histogram with an RGB color:
\begin{quote}
\begin{footnotesize}
\ttt{\$fill\_options = "withcolor (0.8, 0.7, 1)"}
\end{footnotesize}
\end{quote}
\subsubsection{Dashes}
By default, lines are drawn continuously. Optionally, they can be drawn using
a \emph{dash pattern}. Predefined dash patterns are
\begin{center}
\ttt{evenly}, \ttt{withdots}, \ttt{withdashdots}
\end{center}
Going beyond the predefined patterns, a generic dash pattern has the syntax
\begin{center}
\ttt{dashpattern (on \emph{l1} off \emph{l2} on} \ldots \ttt{)}
\end{center}
with an arbitrary repetition of \ttt{on} and \ttt{off} clauses. The numbers
\ttt{\emph{l1}}, \ttt{\emph{l2}}, \ldots\ are lengths measured in pt.
To apply a dash pattern, the option syntax \ttt{dashed \emph{dash-pattern}}
should be used. Options strings can be concatenated. Here is how to draw in
color with dashes:
\begin{quote}
\begin{footnotesize}
\ttt{\$draw\_options = "withcolor red dashed evenly"}
\end{footnotesize}
\end{quote}
and this draws error bars consisting of intermittent dashes and
dots:
\begin{quote}
\begin{footnotesize}
\ttt{\$err\_options = "dashed (withdashdots scaled 0.5)"}
\end{footnotesize}
\end{quote}
The extra brackets ensure that the scale factor $1/2$ is applied only the dash
pattern.
\subsubsection{Hatching}
Areas (e.g., below a histogram) can be filled with plain colors by the
\ttt{withcolor} option. They can also be hatched by stripes, optionally
rotated by some angle. The syntax is completely analogous to dashes. There
are two predefined \emph{hatch patterns}:
\begin{center}
\ttt{withstripes}, \ttt{withlines}
\end{center}
and a generic hatch pattern is written
\begin{center}
\ttt{hatchpattern (on \emph{w1} off \emph{w2} on} \ldots \ttt{)}
\end{center}
where the numbers \ttt{\emph{l1}}, \ttt{\emph{l2}}, \ldots\ determine the
widths of the stripes, measured in pt.
When applying a hatch pattern, the pattern may be rotated by some angle (in
degrees) and scaled. This looks like
\begin{quote}
\begin{footnotesize}
\ttt{\$fill\_options = "hatched (withstripes scaled 0.8 rotated 60)"}
\end{footnotesize}
\end{quote}
\subsubsection{Smooth curves}
Plot points are normally connected by straight lines. If data are acquired by
statistical methods, such as Monte Carlo integration, this is usually
recommended. However, if a plot is generated using an analytic mathematical
formula, or with sufficient statistics to remove fluctuations, it might be
appealing to connect lines by some smooth interpolation. GAMELAN can switch
on spline interpolation by the specific drawing option \ttt{linked smoothly}.
Note that the results can be surprising if the data points do have sizable
fluctuations or sharp kinks.
\subsubsection{Error bars}
Plots and histograms can be drawn with error bars. For histograms, only
vertical error bars are supported, while plot points can have error bars in
$x$ and $y$ direction. Error bars are switched on by the \ttt{?draw\_errors}
flag.
There is an option to draw error bars with ticks: \ttt{withticks} and an
alternative option to draw arrow heads: \ttt{witharrows}. These can be used
in the \ttt{\$err\_options} string.
\subsubsection{Symbols}
To draw symbols at plot points (or histogram midpoints), the flag
\ttt{?draw\_symbols} has to be switched on.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{User Interfaces for WHIZARD}
\label{chap:userint}
\section{Command Line and \sindarin\ Input Files}
\label{sec:cmdline-options}
The standard way of using \whizard\ involves a command script written
in \sindarin. This script is executed by \whizard\ by mentioning it
on the command line:
\begin{interaction}
whizard script-name.sin
\end{interaction}
You may specify several script files on the command line; they will be
executed consecutively.
If there is no script file, \whizard\ will read commands from standard
input. Hence, this is equivalent:
\begin{interaction}
cat script-name.sin | whizard
\end{interaction}
When executed from the command line, \whizard\ accepts several options.
They are given in long form, i.e., they begin with two dashes. Values
that belong to options follow the option string, separated either by
whitespace or by an equals sign. Hence, \ttt{--prefix /usr} and
\ttt{--prefix=/usr} are equivalent. Some options are also available
in short form, a single dash with a single letter. Short-form options
can be concatenated, i.e., a dash followed by several option letters.
The first set of options is intended for normal operation.
\begin{description}
\item[\ttt{--debug AREA}]: Switch on debug output for \ttt{AREA}.
\ttt{AREA} can be one of \whizard's source directories or \ttt{all}.
\item[\ttt{--debug2 AREA}]: Switch on more verbose debug output for \ttt{AREA}.
\item[\ttt{--single-event}]: Only compute one phase-space point (for debugging).
\item[\ttt{--execute COMMANDS}]: Execute \ttt{COMMANDS} as a script
before the script file. Short version: \ttt{-e}
\item[\ttt{--help}]: List the available options and exit. Short version:
\ttt{-h}
\item[\ttt{--interactive}]: Run \whizard\ interactively. See
Sec.~\ref{sec:whish}. Short version: \ttt{-i}.
\item[\ttt{--library LIB}]: Preload process library \ttt{LIB}
(instead of the default \ttt{processes}). Short version: \ttt{-l}.
\item[\ttt{--localprefix DIR}]: Search in \ttt{DIR} for local
models. Default is \ttt{\$HOME/.whizard}.
\item[\ttt{--logfile \ttt{FILE}}]: Write log to \ttt{FILE}. Default is
\ttt{whizard.log}. Short version: \ttt{-L}.
\item[\ttt{--logging}]: Start logging on startup (default).
\item[\ttt{--model MODEL}]: Preload model \ttt{MODEL}. Default is the
Standard Model \ttt{SM}. Short version: \ttt{-m}.
\item[\ttt{--no-banner}]: Do not display banner at startup.
\item[\ttt{--no-library}]: Do not preload a library.
\item[\ttt{--no-logfile}]: Do not write a logfile.
\item[\ttt{--no-logging}]: Do not issue information into the logfile.
\item[\ttt{--no-model}]: Do not preload a specific physics model.
\item[\ttt{--no-rebuild}]: Do not force a rebuild.
\item[\ttt{--query VARIABLE}]: Display documentation of \ttt{VARIABLE}.
Short version: \ttt{-q}.
\item[\ttt{--rebuild}]: Do not preload a process library and do all
calculations from scratch, even if results exist. This combines all
rebuild options. Short version: \ttt{-r}.
\item[\ttt{--rebuild-library}]: Rebuild the process library, even if code
exists.
\item[\ttt{--rebuild-phase-space}]: Rebuild the phase space setup, even if
it exists.
\item[\ttt{--rebuild-grids}]: Redo the integration, even if previous grids
and results exist.
\item[\ttt{--rebuild-events}]: Redo event generation, discarding previous
event files.
\item[\ttt{--show-config}]: Show build-time configuration.
\item[\ttt{--version}]: Print version information and exit. Short version:
\ttt{-V}.
\item[-]: Any further options are interpreted as file names.
\end{description}
The second set of options refers to the configuration. They are
relevant when dealing with a relocated \whizard\ installation, e.g.,
on a batch systems.
\begin{description}
\item[\ttt{--prefix DIR}]: Specify the actual location of the \whizard\
installation, including all subdirectories.
\item[\ttt{--exec-prefix DIR}]: Specify the actual location of the
machine-specific parts of the \whizard\ installation (rarely needed).
\item[\ttt{--bindir DIR}]: Specify the actual location of the
executables contained in the \whizard\ installation (rarely needed).
\item[\ttt{--libdir DIR}]: Specify the actual location of the
libraries contained in the \whizard\ installation (rarely needed).
\item[\ttt{--includedir DIR}]: Specify the actual location of the
include files contained in the \whizard\ installation (rarely needed).
\item[\ttt{--datarootdir DIR}]: Specify the actual location of the
data files contained in the \whizard\ installation (rarely needed).
\item[\ttt{--libtool LOCAL\_LIBTOOL}]: Specify the actual location and
name of the \ttt{libtool} script that should be used by \whizard.
\item[\ttt{--lhapdfdir DIR}]: Specify the actual location and
of the \lhapdf\ installation that should be used by \whizard.
\end{description}
\section{WHISH -- The \whizard\ Shell/Interactive mode}
\label{sec:whish}
\whizard\ can be also run in the interactive mode using its own shell
environment. This is called the \whizard\ Shell (WHISH). For this
purpose, one starts with the command
\begin{interaction}
/home/user$ whizard --interactive
\end{interaction}
or
\begin{interaction}
/home/user$ whizard -i
\end{interaction}
\whizard\ will preload the Standard Model and display a command
prompt:
\begin{interaction}
whish?
\end{interaction}
You now can enter one or more \sindarin\ commands, just as if they
were contained in a script file. The commands are compiled and
executed after you hit the ENTER key. When done, you get a new
prompt. The WHISH can be closed by the \ttt{quit} command:
\begin{verbatim}
whish? quit
\end{verbatim}
Obviously, each input must be self-contained: commands must be
complete, and conditionals or scans must be closed on the same line.
If \whizard\ is run without options and without a script file, it
also reads commands interactively, from standard input. The
difference is that in this case, interactive input is multi-line,
terminated by \ttt{Ctrl-D}, the script is then compiled and
executed as a whole, and \whizard\ terminates.
In WHISH mode, each input line is compiled and executed individually.
Furthermore, fatal errors are masked, so in case of error the program
does not terminate but returns to the WHISH command line. (The
attempt to recover may fail in some circumstances, however.)
\section{Graphical user interface}
\emph{This is still experimental.}
\whizard\ ships with a graphical interface that can be steered in a
browser of your choice. It is located in \ttt{share/gui}. To use it,
you have to run \ttt{npm install} (which will install javascript
libraries locally in that folder) and \ttt{npm start} (which will start
a local web server on your machine) in that folder. More technical
details and how to get \ttt{npm} is discussed in
\ttt{share/gui/README.md}. When it is running, you can access the GUI
by entering \ttt{localhost:3000} as address in your browser. The GUI is
separated into different tabs for basic settings, integration,
simulation, cuts, scans, NLO and beams. You can select and enter what
you are interested in and the GUI will produce a \sindarin\ file. You
can use the GUI to run WHIZARD with that \sindarin\ or just produce it
with the GUI and then tweak it further with an editor. In case you run
it in the GUI, the log file will be updated in the browser as it is
produced. Any \sindarin\ features that are not supported by the GUI can
be added directly as "Additional Code".
\section{WHIZARD as a library}
\emph{This is planned, but not implemented yet.}
%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Examples}
\label{chap:examples}
In this chapter we discuss the running and steering of \whizard\ with
the help of several examples. These examples can be found in the
\ttt{share/examples} directory of your installation. All of these
examples are also shown on the \whizard\ Wiki page:
\url{https://whizard.hepforge.org/trac/wiki}.
\section{$Z$ lineshape at LEP I}
By this example, we demonstrate how a scan over collision energies
works, using as example the measurement of the $Z$ lineshape at LEP I
in 1989. The \sindarin\ script for this example, \ttt{Z-lineshape.sin}
can be found in the \ttt{share/examples} folder of the \whizard\
installation.
We first use the Standard model as physics model:
\begin{code}
model = SM
\end{code}
Aliases for electron, muon and their antiparticles as leptons and
those including the photon as particles in general are introduced:
\begin{code}
alias lep = e1:E1:e2:E2
alias prt = lep:A
\end{code}
Next, the two processes are defined, \eemm, and the same with an
explicit QED photon: $e^+e^- \to \mu^+\mu^-\gamma$,
\begin{code}
process bornproc = e1, E1 => e2, E2
process rc = e1, E1 => e2, E2, A
compile
\end{code}
and the processes are compiled. Now, we define some very loose cuts to
avoid singular regions in phase space, name an infrared cutoff of 100
MeV for all particles, a cut on the angular separation from the beam
axis and a di-particle invariant mass cut which regularizes collinear
singularities:
\begin{code}
cuts = all E >= 100 MeV [prt]
and all abs (cos(Theta)) <= 0.99 [prt]
and all M2 >= (1 GeV)^2 [prt, prt]
\end{code}
For the graphical analysis, we give a description and labels for the
$x$- and $y$-axis in \LaTeX\ syntax:
\begin{code}
$description = "A WHIZARD Example"
$x_label = "$\sqrt{s}$/GeV"
$y_label = "$\sigma(s)$/pb"
\end{code}
We define two plots for the lineshape of the \eemm\ process between 88
and 95 GeV,
\begin{code}
$title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-$"
plot lineshape_born { x_min = 88 GeV x_max = 95 GeV }
\end{code}
and the same for the radiative process with an additional photon:
\begin{code}
$title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-\gamma$"
plot lineshape_rc { x_min = 88 GeV x_max = 95 GeV }
\end{code}
%$
The next part of the \sindarin\ file actually performs the scan:
\begin{code}
scan sqrts = ((88.0 GeV => 90.0 GeV /+ 0.5 GeV),
(90.1 GeV => 91.9 GeV /+ 0.1 GeV),
(92.0 GeV => 95.0 GeV /+ 0.5 GeV)) {
beams = e1, E1
integrate (bornproc) { iterations = 2:1000:"gw", 1:2000 }
record lineshape_born (sqrts, integral (bornproc) / 1000)
integrate (rc) { iterations = 5:3000:"gw", 2:5000 }
record lineshape_rc (sqrts, integral (rc) / 1000)
}
\end{code}
So from 88 to 90 GeV, we go in 0.5 GeV steps, then from 90 to 92 GeV
in tenth of GeV, and then up to 95 GeV again in half a GeV steps. The
partonic beam definition is redundant. Then, the born process is
integrated, using a certain specification of calls with adaptation of
grids and weights, as well as a final pass. The lineshape of the Born
process is defined as a \ttt{record} statement, generating tuples of
$\sqrt{s}$ and the Born cross section (converted from femtobarn to
picobarn). The same happens for the radiative $2\to3$ process with a
bit more iterations because of the complexity, and the definition of
the corresponding lineshape record.
If you run the \sindarin\ script, you will find an output like:
\begin{scriptsize}
\begin{Verbatim}[frame=single]
| Process library 'default_lib': loading
| Process library 'default_lib': ... success.
$description = "A WHIZARD Example"
$x_label = "$\sqrt{s}$/GeV"
$y_label = "$\sigma(s)$/pb"
$title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-$"
x_min = 8.800000000000E+01
x_max = 9.500000000000E+01
$title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-\gamma$"
x_min = 8.800000000000E+01
x_max = 9.500000000000E+01
sqrts = 8.800000000000E+01
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 10713
| Initializing integration for process bornproc:
| ------------------------------------------------------------------------
| Process [scattering]: 'bornproc'
| Library name = 'default_lib'
| Process index = 1
| Process components:
| 1: 'bornproc_i1': e-, e+ => mu-, mu+ [omega]
| ------------------------------------------------------------------------
| Beam structure: e-, e+
| Beam data (collision):
| e- (mass = 5.1099700E-04 GeV)
| e+ (mass = 5.1099700E-04 GeV)
| sqrts = 8.800000000000E+01 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'bornproc_i1.phs'
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
| Applying user-defined cuts.
| OpenMP: Using 8 threads
| Starting integration for process 'bornproc'
| Integrate: iterations = 2:1000:"gw", 1:2000
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 1000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 800 2.5881432E+05 1.85E+03 0.72 0.20* 48.97
2 800 2.6368495E+05 9.25E+02 0.35 0.10* 28.32
|-----------------------------------------------------------------------------|
2 1600 2.6271122E+05 8.28E+02 0.32 0.13 28.32 5.54 2
|-----------------------------------------------------------------------------|
3 1988 2.6313791E+05 5.38E+02 0.20 0.09* 35.09
|-----------------------------------------------------------------------------|
3 1988 2.6313791E+05 5.38E+02 0.20 0.09 35.09
|=============================================================================|
| Time estimate for generating 10000 events: 0d:00h:00m:05s
[.......]
\end{Verbatim}
\end{scriptsize} %$
and then the integrations for the other energy points of the scan will
\begin{figure}
\centering
\includegraphics[width=.47\textwidth]{Z-lineshape_1}
\includegraphics[width=.47\textwidth]{Z-lineshape_2}
\caption{\label{fig:zlineshape} $Z$ lineshape in the dimuon final
state (left), and with an additional photon (right)}
\end{figure}
follow, and finally the same is done for the radiative process as
well. At the end of the \sindarin\ script we compile the graphical
\whizard\ analysis and direct the data for the plots into the file
\ttt{Z-lineshape.dat}:
\begin{code}
compile_analysis { $out_file = "Z-lineshape.dat" }
\end{code}
%$
In this case there is no event generation, but simply the cross
section values for the scan are dumped into a data file:
\begin{scriptsize}
\begin{Verbatim}[frame=single]
$out_file = "Z-lineshape.dat"
| Opening file 'Z-lineshape.dat' for output
| Writing analysis data to file 'Z-lineshape.dat'
| Closing file 'Z-lineshape.dat' for output
| Compiling analysis results display in 'Z-lineshape.tex'
\end{Verbatim}
\end{scriptsize}
%$
Fig.~\ref{fig:zlineshape} shows the graphical \whizard\ output of the
$Z$ lineshape in the dimuon final state from the scan on the left, and
the same for the radiative process with an additional photon on the
right.
%%%%%%%%%%%%%%%
\section{$W$ pairs at LEP II}
This example which can be found as file \ttt{LEP\_cc10.sin} in the
\ttt{share/examples} directory, shows $W$ pair production in the
semileptonic mode at LEP II with its final energy of 209 GeV. Because
there are ten contributing Feynman diagrams, the process has been
dubbed CC10: charged current process with 10 diagrams. We work within
the Standard Model:
\begin{code}
model = SM
\end{code}
Then the process is defined, where no flavor summation is done for the
jets here:
\begin{code}
process cc10 = e1, E1 => e2, N2, u, D
\end{code}
A compilation statement is optional, and then we set the muon mass to
zero:
\begin{code}
mmu = 0
\end{code}
The final LEP center-of-momentum energy of 209 GeV is set:
\begin{code}
sqrts = 209 GeV
\end{code}
Then, we integrate the process:
\begin{code}
integrate (cc10) { iterations = 12:20000 }
\end{code}
Running the \sindarin\ file up to here, results in the output:
\begin{scriptsize}
\begin{Verbatim}[frame=single]
| Process library 'default_lib': loading
| Process library 'default_lib': ... success.
SM.mmu = 0.000000000000E+00
sqrts = 2.090000000000E+02
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 31255
| Initializing integration for process cc10:
| ------------------------------------------------------------------------
| Process [scattering]: 'cc10'
| Library name = 'default_lib'
| Process index = 1
| Process components:
| 1: 'cc10_i1': e-, e+ => mu-, numubar, u, dbar [omega]
| ------------------------------------------------------------------------
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 5.1099700E-04 GeV)
| e+ (mass = 5.1099700E-04 GeV)
| sqrts = 2.090000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'cc10_i1.phs'
| Phase space: 25 channels, 8 dimensions
| Phase space: found 25 channels, collected in 7 groves.
| Phase space: Using 25 equivalences between channels.
| Phase space: wood
Warning: No cuts have been defined.
| OpenMP: Using 8 threads
| Starting integration for process 'cc10'
| Integrate: iterations = 12:20000
| Integrator: 7 chains, 25 channels, 8 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 20000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 19975 6.4714908E+02 2.17E+01 3.36 4.75* 2.33
2 19975 7.3251876E+02 2.45E+01 3.34 4.72* 2.17
3 19975 6.7746497E+02 2.39E+01 3.52 4.98 1.77
4 19975 7.2075198E+02 2.41E+01 3.34 4.72* 1.76
5 19975 6.5976152E+02 2.26E+01 3.43 4.84 1.46
6 19975 6.6633310E+02 2.26E+01 3.39 4.79* 1.43
7 19975 6.7539385E+02 2.29E+01 3.40 4.80 1.43
8 19975 6.6754027E+02 2.11E+01 3.15 4.46* 1.41
9 19975 7.3975817E+02 2.52E+01 3.40 4.81 1.53
10 19975 7.2284275E+02 2.39E+01 3.31 4.68* 1.47
11 19975 6.5476917E+02 2.18E+01 3.33 4.71 1.33
12 19975 7.2963866E+02 2.54E+01 3.48 4.92 1.46
|-----------------------------------------------------------------------------|
12 239700 6.8779583E+02 6.69E+00 0.97 4.76 1.46 2.18 12
|=============================================================================|
| Time estimate for generating 10000 events: 0d:00h:01m:16s
| Creating integration history display cc10-history.ps and cc10-history.pdf
\end{Verbatim}
\end{scriptsize}
\begin{figure}
\centering
\includegraphics[width=.6\textwidth]{cc10_1}
\\\vspace{5mm}
\includegraphics[width=.6\textwidth]{cc10_2}
\caption{Histogram of the dijet invariant mass from the CC10 $W$
pair production at LEP II, peaking around the $W$ mass (upper
plot), and of the muon energy (lower plot).}
\label{fig:cc10}
\end{figure}
The next step is event generation. In order to get smooth
distributions, we set the integrated luminosity to 10
fb${}^{-1}$. (Note that LEP II in its final year 2000 had an
integrated luminosity of roughly 0.2 fb${}^{-1}$.)
\begin{code}
luminosity = 10
\end{code}
With the simulated events corresponding to those 10 inverse femtobarn
we want to perform a \whizard\ analysis: we are going to plot the
dijet invariant mass, as well as the energy of the outgoing muon. For
the plot of the analysis, we define a description and label the $y$
axis:
\begin{code}
$description =
"A WHIZARD Example.
Charged current CC10 process from LEP 2."
$y_label = "$N_{\textrm{events}}$"
\end{code}
We also use \LaTeX-syntax for the title of the first plot and the
$x$-label, and then define the histogram of the dijet invariant mass
in the range around the $W$ mass from 70 to 90 GeV in steps of half a
GeV:
\begin{code}
$title = "Di-jet invariant mass $M_{jj}$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
$x_label = "$M_{jj}$/GeV"
histogram m_jets (70 GeV, 90 GeV, 0.5 GeV)
\end{code}
And we do the same for the second histogram of the muon energy:
\begin{code}
$title = "Muon energy $E_\mu$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
$x_label = "$E_\mu$/GeV"
histogram e_muon (0 GeV, 209 GeV, 4)
\end{code}
Now, we define the \ttt{analysis} consisting of two \ttt{record}
statements initializing the two observables that are plotted as
histograms:
\begin{code}
analysis = record m_jets (eval M [u,D]);
record e_muon (eval E [e2])
\end{code}
At the very end, we perform the event generation
\begin{code}
simulate (cc10)
\end{code}
and finally the writing and compilation of the analysis in a named
data file:
\begin{code}
compile_analysis { $out_file = "cc10.dat" }
\end{code}
This event generation part screen output looks like this:
\begin{scriptsize}
\begin{Verbatim}[frame=single]
luminosity = 1.000000000000E+01
$description = "A WHIZARD Example.
Charged current CC10 process from LEP 2."
$y_label = "$N_{\textrm{events}}$"
$title = "Di-jet invariant mass $M_{jj}$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
$x_label = "$M_{jj}$/GeV"
$title = "Muon energy $E_\mu$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
$x_label = "$E_\mu$/GeV"
| Starting simulation for process 'cc10'
| Simulate: using integration grids from file 'cc10_m1.vg'
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 9910
| OpenMP: Using 8 threads
| Simulation: using n_events as computed from luminosity value
| Events: writing to raw file 'cc10.evx'
| Events: generating 6830 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
Warning: Encountered events with excess weight: 39 events ( 0.571 %)
| Maximum excess weight = 1.027E+00
| Average excess weight = 6.764E-04
| Events: closing raw file 'cc10.evx'
$out_file = "cc10.dat"
| Opening file 'cc10.dat' for output
| Writing analysis data to file 'cc10.dat'
| Closing file 'cc10.dat' for output
| Compiling analysis results display in 'cc10.tex'
\end{Verbatim}
\end{scriptsize} %$
Then comes the \LaTeX\ output of the compilation of the graphical
analysis. Fig.~\ref{fig:cc10} shows the two histograms as the are
produced as result of the \whizard\ internal graphical analysis.
%%%%%%%%%%%%%%%
\section{Higgs search at LEP II}
This example can be found under the name \ttt{LEP\_higgs.sin} in the
\ttt{share/doc} folder of \whizard. It displays different search
channels for a very light would-be SM Higgs boson of mass 115 GeV at
the LEP II machine at its highest energy it finally achieved, 209 GeV.
First, we use the Standard Model:
\begin{code}
model = SM
\end{code}
Then, we define aliases for neutrinos, antineutrinos, light quarks and
light anti-quarks:
\begin{code}
alias n = n1:n2:n3
alias N = N1:N2:N3
alias q = u:d:s:c
alias Q = U:D:S:C
\end{code}
Now, we define the signal process, which is Higgsstrahlung,
\begin{code}
process zh = e1, E1 => Z, h
\end{code}
the missing-energy channel,
\begin{code}
process nnbb = e1, E1 => n, N, b, B
\end{code}
and finally the 4-jet as well as dilepton-dijet channels:
\begin{code}
process qqbb = e1, E1 => q, Q, b, B
process bbbb = e1, E1 => b, B, b, B
process eebb = e1, E1 => e1, E1, b, B
process qqtt = e1, E1 => q, Q, e3, E3
process bbtt = e1, E1 => b, B, e3, E3
compile
\end{code}
and we compile the code. We set the center-of-momentum energy to the
highest energy LEP II achieved,
\begin{code}
sqrts = 209 GeV
\end{code}
For the Higgs boson, we take the values of a would-be SM Higgs boson
with mass of 115 GeV, which would have had a width of a bit more than
3 MeV:
\begin{code}
mH = 115 GeV
wH = 3.228 MeV
\end{code}
We take a running $b$ quark mass to take into account NLO corrections
to the $Hb\bar b$ vertex, while all other fermions are massless:
\begin{code}
mb = 2.9 GeV
me = 0
ms = 0
mc = 0
\end{code}
\begin{scriptsize}
\begin{Verbatim}[frame=single]
| Process library 'default_lib': loading
| Process library 'default_lib': ... success.
sqrts = 2.090000000000E+02
SM.mH = 1.150000000000E+02
SM.wH = 3.228000000000E-03
SM.mb = 2.900000000000E+00
SM.me = 0.000000000000E+00
SM.ms = 0.000000000000E+00
SM.mc = 0.000000000000E+00
\end{Verbatim}
\end{scriptsize}
To avoid soft-collinear singular phase-space regions, we apply an
invariant mass cut on light quark pairs:
\begin{code}
cuts = all M >= 10 GeV [q,Q]
\end{code}
Now, we integrate the signal process as well as the combined signal
and background processes:
\begin{code}
integrate (zh) { iterations = 5:5000}
integrate(nnbb,qqbb,bbbb,eebb,qqtt,bbtt) { iterations = 12:20000 }
\end{code}
\begin{scriptsize}
\begin{Verbatim}[frame=single]
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 21791
| Initializing integration for process zh:
| ------------------------------------------------------------------------
| Process [scattering]: 'zh'
| Library name = 'default_lib'
| Process index = 1
| Process components:
| 1: 'zh_i1': e-, e+ => Z, H [omega]
| ------------------------------------------------------------------------
| Beam structure: [any particles]
| Beam data (collision):
| e- (mass = 0.0000000E+00 GeV)
| e+ (mass = 0.0000000E+00 GeV)
| sqrts = 2.090000000000E+02 GeV
| Phase space: generating configuration ...
| Phase space: ... success.
| Phase space: writing configuration file 'zh_i1.phs'
| Phase space: 1 channels, 2 dimensions
| Phase space: found 1 channel, collected in 1 grove.
| Phase space: Using 1 equivalence between channels.
| Phase space: wood
| Applying user-defined cuts.
| OpenMP: Using 8 threads
| Starting integration for process 'zh'
| Integrate: iterations = 5:5000
| Integrator: 1 chains, 1 channels, 2 dimensions
| Integrator: Using VAMP channel equivalences
| Integrator: 5000 initial calls, 20 bins, stratified = T
| Integrator: VAMP
|=============================================================================|
| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] |
|=============================================================================|
1 4608 1.6114109E+02 5.52E-04 0.00 0.00* 99.43
2 4608 1.6114220E+02 5.59E-04 0.00 0.00 99.43
3 4608 1.6114103E+02 5.77E-04 0.00 0.00 99.43
4 4608 1.6114111E+02 5.74E-04 0.00 0.00* 99.43
5 4608 1.6114103E+02 5.66E-04 0.00 0.00* 99.43
|-----------------------------------------------------------------------------|
5 23040 1.6114130E+02 2.53E-04 0.00 0.00 99.43 0.82 5
|=============================================================================|
[.....]
\end{Verbatim}
\end{scriptsize}
\begin{figure}
\centering
\includegraphics[width=.48\textwidth]{lep_higgs_1}
\includegraphics[width=.48\textwidth]{lep_higgs_2}
\\\vspace{5mm}
\includegraphics[width=.48\textwidth]{lep_higgs_3}
\caption{Upper line: final state $bb + E_{miss}$, histogram of
the invisible mass distribution (left), and of the di-$b$
distribution (right). Lower plot: light dijet distribution in the
$bbjj$ final state.}
\label{fig:lep_higgs}
\end{figure}
Because the other integrations look rather similar, we refrain from
displaying them here, too. As a next step, we define titles,
descriptions and axis labels for the histograms we want to
generate. There are two of them, one os the invisible mass
distribution, the other is the di-$b$-jet invariant mass. Both
histograms are taking values between 70 and 130 GeV with
bin widths of half a GeV:
\begin{code}
$description =
"A WHIZARD Example. Light Higgs search at LEP. A 115 GeV pseudo-Higgs
has been added. Luminosity enlarged by two orders of magnitude."
$y_label = "$N_{\textrm{events}}$"
$title = "Invisible mass distribution in $e^+e^- \to \nu\bar\nu b \bar b$"
$x_label = "$M_{\nu\nu}$/GeV"
histogram m_invisible (70 GeV, 130 GeV, 0.5 GeV)
$title = "$bb$ invariant mass distribution in $e^+e^- \to \nu\bar\nu b \bar b$"
$x_label = "$M_{b\bar b}$/GeV"
histogram m_bb (70 GeV, 130 GeV, 0.5 GeV)
\end{code}
The analysis is initialized by defining the two records for the
invisible mass and the invariant mass of the two $b$ jets:
\begin{code}
analysis = record m_invisible (eval M [n,N]);
record m_bb (eval M [b,B])
\end{code}
In order to have enough statistics, we enlarge the LEP integrated
luminosity at 209 GeV by more than two orders of magnitude:
\begin{code}
luminosity = 10
\end{code}
We start event generation by simulating the process with two $b$ jets
and two neutrinos in the final state:
\begin{code}
simulate (nnbb)
\end{code}
As a third histogram, we define the dijet invariant mass of two light
jets:
\begin{code}
$title = "Dijet invariant mass distribution in $e^+e^- \to q \bar q b \bar b$"
$x_label = "$M_{q\bar q}$/GeV"
histogram m_jj (70 GeV, 130 GeV, 0.5 GeV)
\end{code}
Then we simulate the 4-jet process defining the light-dijet
distribution as a local record:
\begin{code}
simulate (qqbb) { analysis = record m_jj (eval M / 1 GeV [combine [q,Q]]) }
\end{code}
Finally, we compile the analysis,
\begin{code}
compile_analysis { $out_file = "lep_higgs.dat" }
\end{code}
\begin{scriptsize}
\begin{Verbatim}[frame=single]
| Starting simulation for process 'nnbb'
| Simulate: using integration grids from file 'nnbb_m1.vg'
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 21798
| OpenMP: Using 8 threads
| Simulation: using n_events as computed from luminosity value
| Events: writing to raw file 'nnbb.evx'
| Events: generating 1070 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
Warning: Encountered events with excess weight: 207 events ( 19.346 %)
| Maximum excess weight = 1.534E+00
| Average excess weight = 4.909E-02
| Events: closing raw file 'nnbb.evx'
$title = "Dijet invariant mass distribution in $e^+e^- \to q \bar q b \bar b$"
$x_label = "$M_{q\bar q}$/GeV"
| Starting simulation for process 'qqbb'
| Simulate: using integration grids from file 'qqbb_m1.vg'
| RNG: Initializing TAO random-number generator
| RNG: Setting seed for random-number generator to 21799
| OpenMP: Using 8 threads
| Simulation: using n_events as computed from luminosity value
| Events: writing to raw file 'qqbb.evx'
| Events: generating 4607 unweighted, unpolarized events ...
| Events: event normalization mode '1'
| ... event sample complete.
Warning: Encountered events with excess weight: 112 events ( 2.431 %)
| Maximum excess weight = 8.875E-01
| Average excess weight = 4.030E-03
| Events: closing raw file 'qqbb.evx'
$out_file = "lep_higgs.dat"
| Opening file 'lep_higgs.dat' for output
| Writing analysis data to file 'lep_higgs.dat'
| Closing file 'lep_higgs.dat' for output
| Compiling analysis results display in 'lep_higgs.tex'
\end{Verbatim}
\end{scriptsize}
The graphical analysis of the events generated by \whizard\ are shown
in Fig.~\ref{fig:lep_higgs}. In the upper left, the invisible mass
distribution in the $b\bar b + E_{miss}$ state is shown, peaking
around the $Z$ mass. The upper right shows the $M(b\bar b)$
distribution in the same final state, while the lower plot has the
invariant mass distribution of the two non-$b$-tagged (light) jets in
the $bbjj$ final state. The latter shows only the $Z$
peak, while the former exhibits the narrow would-be 115 GeV Higgs
state.
%%%%%%%%%%%%%%%
\section{Deep Inelastic Scattering at HERA}
%%%%%%%%%%%%%%%
\section{$W$ endpoint at LHC}
%%%%%%%%%%%%%%%
\section{SUSY Cascades at LHC}
%%%%%%%%%%%%%%%
\section{Polarized $WW$ at ILC}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Technical details -- Advanced Spells}
\label{chap:tuning}
\section{Efficiency and tuning}
Since massless fermions and vector bosons (or almost massless states
in a certain approximation) lead to restrictive selection rules for
allowed helicity combinations in the initial and final state. To make
use of this fact for the efficiency of the \whizard\ program, we are
applying some sort of heuristics: \whizard\ dices events into all
combinatorially possible helicity configuration during a warm-up
phase. The user can specify a helicity threshold which sets the number
of zeros \whizard\ should have got back from a specific helicity
combination in order to ignore that combination from now on. By that
mechanism, typically half up to more than three quarters of all
helicity combinations are discarded (and hence the corresponding
number of matrix element calls). This reduces calculation time up to
more than one order of magnitude. \whizard\ shows at the end of the
integration those helicity combinations which finally contributed to
the process matrix element.
Note that this list -- due to the numerical heuristics -- might very
well depend on the number of calls for the matrix elements per
iteration, and also on the corresponding random number seed.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{New External Physics Models}
\label{chap:extmodels}
It is never possible to include all incarnations of physics models that
can be described by the maybe weirdest form of a quantum field theory
in a tailor-made implementation within a program like \whizard. Users
clearly want to be able to use their own special type of model; in
order to do so there are external tools to translate models described
by their field content and Lagrangian densities into Feynman rules and
make them available in an event generator like \whizard. In this
chapter, we describe the interfaces to two such external models,
\sarah\ and \FeynRules.
The \FeynRules\ interface had been started already for the legacy
version \whizard\ttt{1} (where it had to be downloaded from
\url{https://projects.hepforge.org/whizard} as a separate package), but
for the \whizard\ttt{two} release series it has been included in the
\FeynRules\ package (from their version v1.6.0 on). Note that there
was a regression for the usage of external models (from either \sarah\
or \FeynRules) in the first release of series v2.2, v2.2.0. This has
been fixed in all upcoming versions.
Besides using \sarah\ or \FeynRules\ via their interfaces, there is
now a much easier way to let those programs output model files in the
"Universal FeynRules Output" (or \UFO). This option does not have any
principle limitations for models, and also does not rely on the never
truly constant interfaces between two different tools. Their usage is
described in Sec.~\ref{sec:ufo}.
%%%%%%%%%%%%%%%
\section{New physics models via \sarah}
\sarah~\cite{Staub:2008uz,Staub:2009bi,Staub:2010jh,Staub:2012pb,Staub:2013tta}
is a \Mathematica~\cite{mathematica} package which
derives for a given model the
minimum conditions of the vacuum, the mass matrices, and vertices at tree-level
as well as expressions for the one-loop corrections for all masses and the
full two-loop renormalization group equations (RGEs). The vertices can be exported
to be used with \whizard/\oMega. All other information can be used to generate
\fortran\ source code for the RGE solution tool and spectrum generator
\spheno~\cite{Porod:2003um,Porod:2011nf} to get a spectrum generator
for any model. The
advantage is that \spheno\ calculates a consistent set of parameters (couplings,
masses, rotation matrices, decay widths) which can be used as input for \whizard.
\sarah\ and \spheno\ can be also downloaded from the \ttt{HepForge} server:
\begin{center}
\url{https://sarah.hepforge.org} \\
\url{https://spheno.hepforge.org}
\end{center}
\subsection{\whizard/\oMega\ model files from \sarah}
\subsubsection{Generating the model files}
Here we are giving only the information relevant to generate models
for \whizard. For more details about the installation of \sarah\ and
an exhaustion documentation about its usage, confer the \sarah\
manual.
To generate the model files for \whizard/\oMega\ with \sarah, a
new \Mathematica\ session has to be started. \sarah\ is loaded via
\begin{code}
<<SARAH-4.2.1/SARAH.m;
\end{code}
if \sarah\ has been stored in the applications directory of
\Mathematica. Otherwise, the full path has to be given
\begin{code}
<<[Path_to_SARAH]/SARAH.m;
\end{code}
To get an overview which models are delivered with \sarah, the command \verb"ShowModels"
can be used. As an example, we use in the following the triplet
extended MSSM (TMSSM) and initialize it in \sarah\ via
\begin{code}
Start["TMSSM"];
\end{code}
Finally, the output intended for \whizard/\oMega\ is started via
\begin{code}
MakeWHIZARD[Options]
\end{code}
The possible options of the \verb"MakeWHIZARD" command are
\begin{enumerate}
\item \verb"WriteOmega", with values: \verb"True" or \verb"False", default:
\verb"True" \\
Defines if the model files for \oMega\ should be written
\item \verb"WriteWHIZARD", with values: \verb"True" or \verb"False",
default: \verb"True" \\
Defines if the model files for \whizard\ should be written
\item \verb"Exclude", with values: list of generic type, Default:
\verb"{SSSS}" \\
Defines which generic vertices are {\em not} exported to the model
file
\item \verb"WOModelName", with values: string, default: name of the
model in \sarah\ followed by \verb"_sarah" \\
Gives the possibility to change the model name
\item \verb"MaximalCouplingsPerFile", with values: integer, default:
\ttt{150} \\
Defines the maximal number of couplings written per file
\item \verb"Version", with values: formatted number, Default:
\verb"2.2.1"~\footnote{Due to a regression in \whizard\ version
v2.2.0, \sarah\ models cannot be successfully linked within
that version. Hence, the default value here has been set to
version number 2.2.1}, \\
Defines the version of \whizard\ for which the model file is generated
\end{enumerate}
All options and the default values are also shown in the
\Mathematica\ session via \newline\verb"Options[MakeWHIZARD]".
\subsubsection{Using the generated model files with \whizard}
After the interface has completed evaluation, the generated files can
be found in the subdirectory \verb"WHIZARD_Omega" of {\sarah}s output
directory. In order to use it the generated code must be compiled and
installed. For this purpose, open a terminal, enter the output directory
\begin{code}
<PATH_to_SARAH>/Output/TMSSM/EWSB/WHIZARD_Omega/
\end{code}
and run
%
\begin{code}
./configure
make install
\end{code}
%
By default, the last command installs the compiled model into \verb".whizard"
in current user's home directory where it is automatically picked up by
\whizard. Alternative installation paths can be specified using the
\verb"--prefix" option to \whizard.
%
\begin{code}
./configure --prefix=/path/to/installation/prefix
\end{code}
%
If the files are installed into the \whizard\
installation prefix, the program will also pick them up automatically, while
{\whizard}'s \verb"--localprefix" option must be used to communicate any other
choice to \whizard. In case \whizard\ is not available in the binary search
path, the \verb"WO_CONFIG" environment variable can be used to point
\verb"configure" to the binaries
%
\begin{code}
./configure WO_CONFIG=/path/to/whizard/binaries
\end{code}
%
More information on the available options and their syntax can be obtained with
the
\verb"--help" option.
After the model is compiled it can be used in \whizard\ as
\begin{code}
model = tmssm_sarah
\end{code}
\subsection{Linking \spheno\ and \whizard}
As mentioned above, the user can also use \spheno\ to generate spectra
for its models. This is done by means of \fortran\ code for \spheno,
exported from \sarah. To do so, the user has to apply the command
\verb"MakeSPheno[]". For more details
about the options of this command and how to compile and use the \spheno\ output,
we refer to the \sarah\ manual. \\
As soon as the \spheno\ version for the given model is ready it can be used to
generate files with all necessary numerical values for the parameters in a format
which is understood by \whizard. For this purpose, the corresponding flag in the
Les Houches input file of \spheno\ has to be turned on:
\begin{code}
Block SPhenoInput # SPheno specific input
...
75 1 # Write WHIZARD files
\end{code}
Afterwards, \spheno\ returns not only the spectrum file in the
standard SUSY Les Houches accord (SLHA) format (for more details about
the SLHA and the \whizard\ SLHA interface cf. Sec.~\ref{sec:slha}),
but also an additional file called \verb"WHIZARD.par.TMSSM" for our example.
This file can be used
in the \sindarin\ input file via
\begin{code}
include ("WHIZARD.par.TMSSM")
\end{code}
%%%%%
\subsection{BSM Toolbox}
A convenient way to install \sarah\ together with \whizard, \spheno\
and some other codes are the \ttt{BSM Toolbox} scripts
\footnote{Those script have been published
under the name SUSY Toolbox but \sarah\ is with version 4 no longer
restricted to SUSY models}~\cite{Staub:2011dp}. These scripts are
available at
\begin{center}
\url{https://projects.hepforge.org/sarah/Toolbox.html}
\end{center}
The \ttt{Toolbox} provides two scripts. First, the \verb"configure" script is
used via
\begin{code}
toolbox-src-dir> mkdir build
toolbox-src-dir> cd build
toolbox-src-dir> ../configure
\end{code}
%
The \verb"configure" script checks for the requirements of the
different packages and downloads all codes. All downloaded archives will
be placed in the \verb"tarballs" subdirectory of the directory containing the
\verb"configure" script.
Command line options can be used to disable specific packages and to point the
script to custom locations of compilers and of the \Mathematica\ kernel; a full
list of those can be obtained by calling \verb"configure" with the \verb"--help"
option.
After \verb"configure" finishes successfully, \verb"make" can be called to build
all configured packages
%
\begin{code}
toolbox-build-dir> make
\end{code}
\verb"configure" creates also the second script which automates the implementation
of a new model into all packages. The \verb"butler" script takes as argument the
name of the model in \sarah, e.g.
\begin{code}
> ./butler TMSSM
\end{code}
The \verb"butler" script runs \sarah\ to get the output in the same
form as the \whizard/\oMega\
model files and the code for \spheno. Afterwards, it installs the
model in all packages and compiles the new \whizard/\oMega\ model
files as well as the new \spheno\ module.
%%%%%
\newpage
\section{New physics models via \FeynRules}
In this section, we present the interface between the external tool
\FeynRules\ \cite{Christensen:2008py,Christensen:2009jx,Duhr:2011se}
and \whizard. \FeynRules\ is a
\Mathematica~\cite{mathematica} package that allows to derive
Feynman rules from any perturbative quantum field theory-based Lagrangian
in an automated way. It can be downloaded from
\begin{center}
\url{http://feynrules.irmp.ucl.ac.be/}
\end{center}
The input provided by the user is threefold and consists
of the Lagrangian defining the model, together with the definitions of
all the
particles and parameters that appear in the model.
Once this information is provided, \FeynRules\ can perform basic checks
on the sanity of the implementation (e.g. hermiticity, normalization
of the quadratic terms), and finally computes all the interaction
vertices associated with the model and store them in an internal
format for later processing. After the Feynman rules have been
obtained, \FeynRules\ can export the interaction vertices to \whizard\
via a dedicated interface~\cite{Christensen:2010wz}. The interface
checks whether all the vertices are compliant with the structures
supported by \whizard's
matrix element generator \oMega, and discard them in the case
they are not supported. The output of the interface consists of a set
of files organized in a single directory which can be injected into
\whizard/\oMega\ and used as any other built-in models. Together with
the model files, a framework is created which allows to communicate
the new models to \whizard\ in a well defined way, after which
step the model can be used exactly like the built-in ones.
This specifically means that the user is not required to
manually modify the code of \whizard/\oMega, the models created by the
interface can be used directly without any further user intervention.
We first describe the installation and general usage of the interface,
and then list the general properties like the supported particle
types, color quantum numbers and Lorentz structures as well as types
of gauge interactions.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Installation and Usage of the \whizard-\FeynRules\ interface}
\label{sec:interface-usage}
\paragraph{{\bf Installation and basic usage:}}
%
From \FeynRules\ version 1.6.0 onward, the interface to \whizard\ is
part of the \FeynRules\ distribution\footnote{Note that though the
main interface of \FeynRules\ to \whizard\ is for the most recent
\whizard\ release, but also the legacy branch
\whizard\ttt{1} is supported.}. In addition, the latest version
of the interface can be downloaded from the \whizard\ homepage on
\ttt{HepForge}. There you can also find an installer that can be used
to inject the interface into an existing \FeynRules\
installation (which allows to use the interface with the \FeynRules\
release series1.4.x where it is not part of the package).
Once installed, the interface can be called and used in the same way
\FeynRules' other interfaces described
in~\cite{Christensen:2008py}. The details of how to install and use
\FeynRules\ itself can be found
there,~\cite{Christensen:2008py,Christensen:2009jx,Duhr:2011se}. Here,
we only describe how to use the interface to inject new models into
\whizard. For example, once the \FeynRules\ environment has been
initialized and a model has been loaded, the command
\begin{code}
WriteWOOutput[L]
\end{code}
will call the \ttt{FeynmanRules} command to extract the Feynman
rules from the Lagrangian \ttt{L}, translate them together with the
model data and finally write the files necessary for using the model
within \whizard\ to an output directory (the name of which is inferred
from the model name by default). Options can be added for further
control over the translation process (see
Sec.~\ref{app:interface-options}). Instead of using a Lagrangian, it
is also possible to call the interface on a pure vertex list. For
example, the following command
\begin{code}
WriteWOOutput[Input -> list]
\end{code}
will directly translate the vertex list \ttt{list}. Note that this
vertex list must be given in flavor-expanded form in order for the
interface to process it correctly.
The interface also supports the \ttt{WriteWOExtParams} command
described in~\cite{Christensen:2008py}. Issuing
\begin{code}
WriteWOExtParams[filename]
\end{code}
will write a list of all the external parameters to
\ttt{filename}. This is done in the form of a \sindarin\
script. The only option accepted by the command above is the target
version of \whizard, set by the option \ttt{WOWhizardVersion}.
During execution, the interface will print out a series of
messages. It is highly advised to carefully read through this output
as it not only summarizes the settings and the location of the output
files, but also contains information on any skipped vertices or
potential incompatibilities of the model with \whizard.
After the interface has run successfully and written the model files to the
output directory, the model must be imported into \whizard. For doing
so, the model files have to be compiled and can then be installed
independently of \whizard. In the simplest scenario, assuming that the
output directory is the current working directory and that the
\whizard\ binaries can be found in the current \ttt{\$\{PATH\}},
the installation is performed by simply executing
\begin{code}
./configure~\&\&~make clean~\&\&~make install
\end{code}
This will compile the model and install it into the directory
\ttt{\$\{HOME\}/.whizard}, making it fully available to \whizard\
without any further intervention. The build system can be adapted to
more complicated cases through several options to the
\ttt{configure} which are listed in the \ttt{INSTALL} file
created in the output directory. A detailed explanation of all options
can be found in Sec.~\ref{app:interface-options}.
\paragraph{\bf Supported fields and vertices:}
The following fields are currently supported by the interface:
scalars, Dirac and Majorana fermions, vectors and symmetric tensors.
The set of accepted operators, the full list of which can be found in
Tab.~\ref{tab-operators}, is a subset of all the operators supported
by \oMega. While still limited, this list is sufficient for a large
number of BSM models. In addition, a future version of
\whizard/\oMega\ will support the definition of completely general
Lorentz structures in the model, allowing the interface to
translate all interactions handled by \FeynRules. This will be done by
means of a parser within \oMega\ of the \ttt{UFO} file format for
model files from \FeynRules.
\begin{table*}[!t]
\centerline{\begin{tabular}{|c|c|}
\hline Particle spins & Supported Lorentz structures \\\hline\hline
FFS & \parbox{0.7\textwidth}{\raggedright
All operators of dimension four are supported.
\strut}\\\hline
FFV & \parbox[t]{0.7\textwidth}{\raggedright
All operators of dimension four are
supported.
\strut}\\\hline
SSS & \parbox{0.7\textwidth}{\raggedright
All dimension three interactions are supported.
\strut}\\\hline
SVV & \parbox[t]{0.7\textwidth}{\raggedright
Supported operators:\\
\mbox{}\hspace{5ex}$\begin{aligned}
\text{dimension 3:} & \quad\mathcal{O}_3 = V_1^\mu V_{2\mu}\phi \mbox{}\\
\text{dimension 5:} & \quad\mathcal{O}_5 = \phi
\left(\partial^\mu V_1^\nu - \partial^\nu V_1^\mu\right)
\left(\partial_\mu V_{2\nu} - \partial_\nu V_{2\mu}\right)
\end{aligned}$\\
Note that $\mathcal{O}_5$ generates the effective gluon-gluon-Higgs couplings obtained by integrating out heavy quarks.
\strut}\\\hline
SSV & \parbox[t]{0.7\textwidth}{\raggedright
$\left(\phi_1\partial^\mu\phi_2 - \phi_2\partial^\mu\phi_1\right)V_\mu\;$
type interactions are supported.
\strut}\\\hline
SSVV & \parbox{0.7\textwidth}{\raggedright
All dimension four interactions are supported.
\strut}\\\hline
SSSS & \parbox{0.7\textwidth}{\raggedright
All dimension four interactions are supported.
\strut}\\\hline
VVV & \parbox[t]{0.7\textwidth}{\raggedright
All parity-conserving dimension four operators are supported, with
the restriction that non-gauge interactions may be split into
several vertices and can only be handled if all three fields are
mutually different.\strut
\strut}\\\hline
VVVV & \parbox[t]{0.7\textwidth}{\raggedright
All parity conserving dimension four operators are supported.
\strut}\\\hline
TSS, TVV, TFF & \parbox[t]{0.7\textwidth}{\raggedright
The three point couplings in the Appendix of Ref.\
\cite{Han:1998sg} are supported.
\strut}\\\hline
\end{tabular}}
\caption{All Lorentz structures currently supported by the
\whizard-\FeynRules\ interface, sorted with respect to the spins of
the particles. ``S'' stands for scalar, ``F'' for fermion (either
Majorana or Dirac) and ``V'' for vector.}
\label{tab-operators}
\end{table*}
\paragraph{\bf Color:}
%
Color is treated in \oMega\ in the color flow decomposition,
with the flow structure being implicitly determined from
the representations of the particles present at the vertex. Therefore, the
interface has to strip the color structure from the vertices derived by
\FeynRules\ before writing them out to the model files.
While this process is straightforward for all color structures which
correspond only to a single flow assignment, vertices with several
possible flow configurations must be treated with care in order to
avoid mismatches between the flows assigned by \oMega\ and those
actually encoded in the couplings. To this end, the interface derives
the color flow decomposition from the color structure determined by
\FeynRules\ and rejects all vertices which would lead to a wrong flow
assignment by \oMega\ (these rejections are accompanied by warnings
from the interface)\footnote{For the old \whizard\ttt{1} legacy
branch, there was a maximum number of external color flows that had
to explicitly specified. Essentially, this is $n_8 - \frac{1}{2}n_3$
where $n_8$ is the maximum number of external color octets and $n_3$
is the maximum number of external triplets and antitriplets. This
can be set in the \whizard/\FeynRules\ interface by the
\ttt{WOMaxNcf} command, whose default is \ttt{4}.}.
At the moment, the $SU(3)_C$ representations supported by
both \whizard\ and the interface are singlets ($1$), triplets ($3$),
antitriplets ($\bar{3}$) and octets ($8$). Tab.~\ref{tab:su3struct}
shows all combinations of these representations which can
form singlets together with the support status of the respective color
structures in \whizard\ and the interface. Although the supported
color structures do not comprise all possible singlets, the list is
sufficient for a large number of SM extensions. Furthermore, a future
revision of \whizard/\oMega\ will allow for explicit color flow
assignments, thus removing most of the current restrictions.
\begin{table*}
\centerline{\begin{tabular}{|c|c|}
\hline $SU(3)_C$ representations &
Support status
\\\hline\hline
\parbox[t]{0.2\textwidth}{
\centerline{\begin{tabular}[t]{lll}
$111,\quad$ & $\bar{3}31,\quad$ & $\bar{3}38,$ \\
$1111,$ & $\bar{3}311,$ & $\bar{3}381$
\end{tabular}}} &
\parbox[t]{0.7\textwidth}{\raggedright\strut Fully supported by the interface\strut}
\\\hline
$888,\quad 8881$ &
\parbox{0.7\textwidth}{\raggedright\strut Supported only if at least two of the octets
are identical particles.\strut}
\\\hline
$881,\quad 8811$ &
\parbox{0.7\textwidth}{\raggedright\strut Fully supported by the
interface\footnote{%
Not available in version 1.95 and earlier. Note that in order to
use such couplings in 1.96/97, the
\oMega\ option \ttt{2g} must be added to the process definition
in \ttt{whizard.prc}.}.\strut}
\\\hline
$\bar{3}388$ &
\parbox{0.7\textwidth}{\raggedright\strut Supported only if the octets
are identical
particles.\strut}
\\\hline
$8888$ &
\parbox{0.7\textwidth}{\raggedright\strut The only supported flow structure is
\begin{equation*}
\parbox{21mm}{\includegraphics{flow4}}\cdot\;\Gamma(1,2,3,4)
\quad+\quad \text{all acyclic permutations}
\end{equation*}
where $\Gamma(1,2,3,4)$ represents the Lorentz structure associated with the
first flow.\strut}
\\\hline
\parbox[t]{0.2\textwidth}{
\centerline{\begin{tabular}[t]{lll}
$333,\quad$ & $\bar{3}\bar{3}\bar{3},\quad$ & $3331$\\
$\bar{3}\bar{3}\bar{3}1,$ & $\bar{3}\bar{3}33$
\end{tabular}}} &
\parbox[t]{0.7\textwidth}{\raggedright\strut Unsupported (at the
moment)\strut}
\\\hline
\end{tabular}}
\caption{All possible combinations of three or four $SU(3)_C$
representations supported by \FeynRules\ which can be used to build singlets,
together with the support status of the corresponding color structures in
\whizard\ and the interface.}
\label{tab:su3struct}
\end{table*}
\paragraph{\bf Running $\alpha_S$:}
While a running strong coupling is fully supported by the interface, a
choice has to be made which quantities are to be reevaluated when the
strong coupling is evolved. By default \ttt{aS}, \ttt{G} (see
Ref.~\cite{Christensen:2008py} for the nomenclature regarding
the QCD coupling) and any vertex factors depending on them are evolved.
The list of internal parameters that are to be recalculated (together
with the vertex factors depending on them) can be
extended (beyond \ttt{aS} and \ttt{G}) by using
the option \ttt{WORunParameters} when calling the
interface~\footnote{As the legacy branch, \whizard\ttt{1}, does not
support a running strong coupling, this is also vetoed by the
interface when using \whizard \ttt{1.x}.}.
\paragraph{\bf Gauge choices:}
\label{sec:gauge-choices}
The interface supports the unitarity, Feynman and $R_\xi$ gauges. The choice of
gauge must be communicated to the interface via the option \ttt{WOGauge}.
Note that massless gauge bosons are always treated in Feynman gauge.
If the selected gauge is Feynman or $R_\xi$, the interface can
automatically assign the proper masses to the Goldstone bosons. This behavior is
requested by using the \ttt{WOAutoGauge} option. In the $R_\xi$
gauges, the symbol representing the gauge $\xi$ must be communicated to the
interface by using the \ttt{WOGaugeSymbol} option (the symbol is
automatically introduced into the list of external
parameters if \ttt{WOAutoGauge} is
selected at the same time). This feature can be used to automatically extend
models implemented in Feynman gauge to the $R_\xi$ gauges.
Since \whizard\ (at least until the release series 2.3) is a
tree-level tool working with helicity amplitudes, the ghost sector is
irrelevant for \whizard\ and hence dropped by the interface.
\subsection{Options of the \whizard-\FeynRules\ interface}
\label{app:interface-options}
In the following we present a comprehensive list of all the options accepted by
\ttt{WriteWOOutput}. Additionally, we note that all options of the
\FeynRules\ command \ttt{FeynmanRules} are accepted by
\ttt{WriteWOOutput}, which passes them on to \ttt{FeynmanRules}.
\begin{description}
\item[\ttt{Input}]\mbox{}\\
An optional vertex list to use instead of a Lagrangian (which can then be
omitted).
%
\item[\ttt{WOWhizardVersion}]\mbox{}\\
Select the \whizard\ version for which code is to be generated.
The currently available choices are summarized in
Tab.~\ref{tab-wowhizardversion}.
%%
\begin{table}
\centerline{\begin{tabular}{|l|l|}
\hline \ttt{WOWhizardVersion} & \whizard\ versions supported
\\\hline\hline
\ttt{"2.0.3"} (default) & 2.0.3+ \\\hline
\ttt{"2.0"} & 2.0.0 -- 2.0.2 \\\hline\hline
\ttt{"1.96"} & 1.96+ \qquad (deprecated) \\\hline
\ttt{"1.93"} & 1.93 -- 1.95 \qquad (deprecated) \\\hline
\ttt{"1.92"} & 1.92 \qquad (deprecated) \\\hline
\end{tabular}}
\caption{Currently available choices for the \ttt{WOWhizardVersion} option,
together with the respective \whizard\ versions supported by them.}
\label{tab-wowhizardversion}
\end{table}
%%
This list will expand as the program evolves. To get a summary
of all choices available in a particular version of the interface, use
the command
\ttt{?WOWhizardVersion}.
%
\item[\ttt{WOModelName}]\mbox{}\\
The name under which the model will be known to
\whizard\footnote{For versions 1.9x, model names must start
with ``\ttt{fr\_}'' if they are to be picked up by \whizard\
automatically.}. The default is determined from the \FeynRules\
model name.
%
\item[\ttt{Output}]\mbox{}\\
The name of the output directory. The default is determined from the
\FeynRules\ model name.
%
\item[\ttt{WOGauge}]\mbox{}\\
Gauge choice (\emph{cf.} Sec.~\ref{sec:gauge-choices}).
Possible values are: \ttt{WOUnitarity} (default),
\ttt{WOFeynman}, \ttt{WORxi}
%
\item[\ttt{WOGaugeParameter}]\mbox{}\\
The external or internal parameter representing the gauge $\xi$ in
the $R_\xi$ gauges (\emph{cf.} Sec.~\ref{sec:gauge-choices}). Default:
\ttt{Rxi}
%
\item[\ttt{WOAutoGauge}]\mbox{}\\
Automatically assign the Goldstone boson masses in the Feynman and $R_\xi$
gauges and automatically append the symbol for $\xi$ to the parameter list in
the $R_\xi$ gauges. Default: \ttt{False}
%
\item[\ttt{WORunParameters}]\mbox{}\\
The list of all internal parameters which will be recalculated if $\alpha_S$ is
evolved (see above)\footnote{Not available for versions older than
2.0.0}. Default: \mbox{\ttt{\{aS, G\}}}
%
\item[\ttt{WOFast}]\mbox{}\\
If the interface drops vertices which are supported, this option can be
set to \ttt{False} to enable some more time consuming checks which might aid
the identification. Default: \ttt{True}
%
\item[\ttt{WOMaxCouplingsPerFile}]\mbox{}\\
The maximum number of couplings that are written to a single \fortran\
file. If compilation takes too long or fails, this can be
lowered. Default: \ttt{500}
%
\item[\ttt{WOVerbose}]\mbox{}\\
Enable verbose output and in particular more extensive information on any
skipped vertices. Default: \ttt{False}
\end{description}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Validation of the interface}
The output of the interface has been extensively
validated. Specifically, the integrated cross sections for all
possible $2\rightarrow 2$ processes in the \FeynRules\ SM, the MSSM
and the Three-Site Higgsless Model have been compared between
\whizard, \madgraph, and \CalcHep, using the respective \FeynRules\
interfaces as well as the in-house implementations of these models
(the Three-Site Higgsless model not being available in \madgraph).
Also, different gauges have been checked for \whizard\ and \CalcHep.
In all comparisons, excellent agreement within the Monte Carlo errors
was achieved. The detailed comparison including examples of the
comparison tables can be found in~\cite{Christensen:2010wz}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Examples for the \whizard-/\FeynRules\ interface}
Here, we will use the Standard Model, the MSSM and the Three-Site
Higgsless Model as prime examples to explain the usage of the
interface. Those are the models that have been used in the validation
of the interface in~\cite{Christensen:2010wz}. The examples are
constructed to show the application of the different options of the
interface and to serve as a starting point for the generation of the
user's own \whizard\ versions of other \FeynRules\ models.
\subsubsection{\whizard-\FeynRules\ example: Standard
Model}\label{sec:usageSM}
To start off, we will create {\sc Whizard} 2 versions of the Standard
Model as implemented in \FeynRules\ for different gauge choices.
\paragraph{SM: Unitarity Gauge}
In order to invoke \FeynRules, we change to the corresponding
directory and load the program in \Mathematica\ via
\begin{code}
$FeynRulesPath =
SetDirectory["<path-to-FeynRules>"];
<<FeynRules`
\end{code}
%$
The model is loaded by
\begin{code}
LoadModel["Models/SM/SM.fr"];
FeynmanGauge = False;
\end{code}
Note that the second line is required to switch the Standard
Model to Unitarity gauge as opposed to Feynman gauge (which is the default).
Generating a \whizard\ model is now simply done by
\begin{code}
WriteWOOutput[LSM];
\end{code}
After invokation, the interface first gives a short summary of the setup
\begin{code}
Short model name is "fr_standard_model"
Gauge: Unitarity
Generating code for WHIZARD / O'Mega
version 2.0.3
Maximum number of couplings per FORTRAN
module: 500
Extensive lorentz structure checks disabled.
\end{code}
Note that, as we have not changed any options, those settings represent the
defaults. The output proceeds with the calculation of the Feynman rules from the
Standard Model Lagrangian \verb?LSM?. After the rules have been derived, the
interface starts generating output and tries to match the vertices to
their \whizard/\oMega\ counterparts.
\begin{code}
10 of 75 vertices processed...
20 of 75 vertices processed...
30 of 75 vertices processed...
40 of 75 vertices processed...
50 of 75 vertices processed...
60 of 75 vertices processed...
70 of 75 vertices processed...
processed a total of 75 vertices, kept 74
of them and threw away 1, 1 of which
contained ghosts or goldstone bosons.
\end{code}
The last line of the above output is particularily interesting, as it informs us
that everything worked out correctly: the interface was able to match all
vertices, and the only discarded vertex was the QCD ghost interaction.
After the interface has finished running, the model files in the output
directory are ready to use and can be compiled using the procedure described in
the previous section.
%%%%%
\paragraph{SM: Feynman and $R_\xi$ gauges}
As the Standard Model as implemented in \FeynRules\ also supports Feynman
gauge, we can use the program to generate a Feynman gauge version of the model.
Loading \FeynRules\ and the model proceeds as above, with the only
difference being the change
\begin{code}
FeynmanGauge = True;
\end{code}
In order to inform the interface about the modified gauge, we have to
add the option \verb?WOGauge?
\begin{code}
WriteWOOutput[LSM, WOGauge -> WOFeynman];
\end{code}
The modified gauge is reflected in the output of the interface
\begin{code}
Short model name is "fr_standard_model"
Gauge: Feynman
Generating code for WHIZARD / O'Mega
version 2.0.3
Maximum number of couplings per FORTRAN
module: 500
Extensive lorentz structure checks disabled.
\end{code}
The summary of the vertex identification now takes the following form
\begin{code}
processed a total of 163 vertices, kept 139
of them and threw away 24, 24 of which
contained ghosts.
\end{code}
Again, this line tells us that there were no problems --- the only
discarded interactions involved the ghost sector which is irrelevant
for the tree-level part of \whizard.
For a tree-level calculation, the only difference between the
different gauges from the perspective of the interface are the gauge
boson propagators and the Goldstone boson masses. Therefore, the
interface can automatically convert a model in Feynman gauge to a
model in $R_\xi$ gauge. To this end, the call to the interface must be
changed to
\begin{code}
WriteWOOutput[LSM, WOGauge -> WORxi,
WOAutoGauge -> True];
\end{code}
The \verb?WOAutoGauge? argument instructs the interface to
automatically
\begin{enumerate}
\item Introduce a symbol for the gauge parameter $\xi$ into the
list of external parameters
\item Generate the Goldstone boson masses from those of the associated
gauge bosons (ignoring the values provided by \FeynRules)
\end{enumerate}
The modified setup is again reflected in the interface output
\begin{code}
Short model name is "fr_standard_model"
Gauge: Rxi
Gauge symbol: "Rxi"
Generating code for WHIZARD / O'Mega
version 2.0.3
Maximum number of couplings per FORTRAN
module: 500
Extensive lorentz structure checks disabled.
\end{code}
Note the default choice \verb?Rxi? for the name of the $\xi$ parameter
-- this can be modified via the option \verb?WOGaugeParameter?.
While the \verb?WOAutoGauge? feature allows to generate $R_\xi$ gauged models
from models implemented in Feynman gauge, it is of course also possible to use
models genuinely implemented in $R_\xi$ gauge by setting this parameter to
\verb?False?. Also, note that the choice of gauge only affects the propagators
of massive fields. Massless gauge bosons are always treated in Feynman
gauge.
\paragraph{Compilation and usage}
In order to compile and use the freshly generated model files, change to the
output directory which can be determined from the interface output (in this
example, it is \verb?fr_standard_model-WO?). Assuming that \whizard\ is
available in the binary search path, compilation and installation proceeds as
described above by executing
\begin{code}
./configure && make && make install
\end{code}
The model is now ready and can be used similarly to the builtin
\whizard\ models. For example, a minimal \whizard\ input file for
calculating the $e^+e^- \longrightarrow W^+W^-$ scattering cross
section in the freshly generated model would look like
\begin{code}
model = fr_standard_model
process test = "e+", "e-" -> "W+", "W-"
sqrts = 500 GeV
integrate (test)
\end{code}
%%%%%
\subsubsection{\whizard/\FeynRules\ example: MSSM}
In this Section, we illustrate the usage of the interface between {\sc
FeynRules} and {\sc Whizard} in the context of the MSSM. All the
parameters of the model are then ordered in Les Houches blocks and
counters following the SUSY Les Houches Accord (SLHA)
\cite{Skands:2003cj,AguilarSaavedra:2005pw,Allanach:2008qq} (cf. also
Sec.~\ref{sec:slha}).
After having downloaded the model
from the \FeynRules\ website, we store it in a new directory, labelled
\verb"MSSM", of the model library of the local installation of
\FeynRules. The model can then be loaded in \Mathematica\ as in the
case of the SM example above
\begin{code}
$FeynRulesPath =
SetDirectory["<path-to-FeynRules>"];
<<FeynRules`
LoadModel["Models/MSSM/MSSM.fr"];
FeynmanGauge = False;
\end{code}
%$
We are again adopting unitarity gauge.
The number of vertices associated to supersymmetric Lagrangians is in general
very large (several thousands). For such models with many interactions,
it is recommended to first extract all the Feynman rules of the theory before
calling the interface between \whizard\ and \FeynRules.
The reason is related to the efficiency of the interface which takes
a lot of time in the extraction of the interaction vertices. In the
case one wishes to study the phenomenology of several benchmark
scenarios, this procedure, which is illustrated below,
allows to use the interface in the best way. The Feynman rules
are derived from the Lagrangian once and for all and then reused by the
interface for each set of \whizard\ model files to be produced,
considerably speeding up the generation of multiple model files
issued from a single Lagrangian. In addition, the scalar potential of
supersymmetric theories contains a large set of four scalar
interactions, in general irrelevant for collider phenomenology. These
vertices can be neglected with the help of the
\verb"Exclude4Scalars->True" option of both interface commands
\verb"FeynmanRules" and \verb"WriteWOOutput". The Feynman
rules of the MSSM are then computed within the \Mathematica\ notebook
by
\begin{code}
rules = FeynmanRules[lag,
Exclude4Scalars->True, FlavorExpand->True];
\end{code}
where \verb'lag' is the variable containing the Lagrangian.
By default, all the parameters of the model are set to the value of
\ttt{1}. A complete parameter \ttt{{\em <slha\_params>}.dat} file
must therefore be loaded. Such a parameter file can be downloaded from
the \FeynRules\ website or created by hand by the user, and loaded
into \FeynRules\ as
\begin{code}
ReadLHAFile[Input -> "<slha_params>.dat"];
\end{code}
This command does not reduce the size of the model output by removing
vertices with vanishing couplings. However, if desired, this task
could be done with the \ttt{LoadRestriction} command (see Ref.\
\cite{Fuks:2012im} for details).
The vertices are exported to \whizard\ by the command
\begin{code}
WriteWOOutput[Input -> rules];
\end{code}
Note that the numerical values of the parameters of the model can be
modified directly from \whizard, without having to generate a second
time the \whizard\ model files from \FeynRules. A \sindarin\ script is
created by the interface with the help of the instruction
\begin{code}
WriteWOExtParams["parameters.sin"];
\end{code}
and can be further modified according to the needs of the user.
\subsubsection{\whizard-\FeynRules\ example: Three-Site Higgsless Model}
The Three-Site Higgsless model or Minimal Higgsless model (MHM) has
been implemented into \ttt{LanHEP}~\cite{He:2007ge}, \FeynRules\
and independently into \whizard~\cite{Speckner:2010zi},
and the collider phenomenology has been studied by making use of these
implementations \cite{He:2007ge,Ohl:2010zf,Speckner:2010zi}.
Furthermore, the independent implementations in \FeynRules\ and
directly into {\sc Whizard} have been compared and found to
agree~\cite{Christensen:2010wz}. After the discovery of a Higgs boson
at the LHC in 2012, such a model is not in good agreement with
experimental data any more. Here, we simply use it as a guinea pig to
describe the handling of a model with non-renormalizable interactions
with the \FeynRules\ interface, and discuss how to generate \whizard\
model files for it. The model has been implemented in Feynman gauge as
well as unitarity gauge and contains the variable \verb|FeynmanGauge|
which can be set to \verb|True| or \verb|False|. When set to
\verb|True|, the option \verb|WOGauge-> WOFeynman| must be used, as
explained in~\cite{Christensen:2010wz}. $R_\xi$ gauge can also be
accomplished with this model by use of the options
\verb|WOGauge -> WORxi| and \verb?WOAutoGauge -> True?.
Since this model makes use of a nonlinear sigma field of the form
\begin{equation}
\Sigma = 1 + i\pi - \frac{1}{2}\pi^2+\cdots
\end{equation}
many higher dimensional operators are included in the model which are
not currently not supported by \whizard. Even for a future release of
\whizard\ containing general Lorentz structures in interaction
vertices, the user would be forced to expand the series only up to a
certain order. Although \whizard\ can reject these vertices
and print a warning message to the user, it is preferable to remove
the vertices right away in the interface by the option
\verb|MaxCanonicalDimension->4|. This is passed to the command
\verb|FeynmanRules| and restricts the Feynman rules to those of
dimension four and smaller\footnote{\ttt{MaxCanonicalDimension} is an
option of the \ttt{FeynmanRules} function rather than of the
interface, itself. In fact, the interface accepts all the options of
{\tt FeynmanRules} and simply passes them on to the latter.}.
As the use of different gauges was already illustrated in the SM
example, we discuss the model only in Feynman gauge here. We load
\FeynRules:
\begin{code}
$FeynRulesPath =
SetDirectory["<path-to-FeynRules>"];
<<FeynRules`
\end{code}
%$
The MHM model itself is then loaded by
\begin{code}
SetDirectory["<path-to-MHM>"];
LoadModel["3-Site-particles.fr",
"3-Site-parameters.fr",
"3-Site-lagrangian.fr"];
FeynmanGauge = True;
\end{code}
where \verb|<path-to-MHM>| is the path to the directory where the MHM
model files are stored and where the output of the \whizard\
interface will be written. The \whizard\ interface is then initiated:
\begin{code}
WriteWOOutput[LGauge, LGold, LGhost, LFermion,
LGoldLeptons, LGoldQuarks,
MaxCanonicalDimension->4,
WOGauge->WOFeynman, WOModelName->"fr_mhm"];
\end{code}
where we have also made use of the option \verb|WOModelName| to change
the name of the model as seen by \whizard. As in the case of the SM,
the interface begins by writing a short informational message:
\begin{code}
Short model name is "fr_mhm"
Gauge: Feynman
Generating code for WHIZARD / O'Mega
version 2.0.3
Automagically assigning Goldstone
boson masses...
Maximum number of couplings per FORTRAN
module: 500
Extensive lorentz structure checks disabled.
\end{code}
After calculating the Feynman rules and processing the vertices, the
interface gives a summary:
\begin{code}
processed a total of 922 vertices, kept 633
of them and threw away 289, 289 of which
contained ghosts.
\end{code}
showing that no vertices were missed. The files are stored in the
directory \verb|fr_mhm| and are ready to be installed and used with
\whizard.
%%%%%%%%%%%%%%%
\section{New physics models via the \UFO\ file format}
\label{sec:ufo}
In this section, we describe how to use the {\em Universal FeynRules
Output} (\UFO, \cite{Degrande:2011ua}) format for physics models
inside \whizard. Please refer the manuals of e.g.~\FeynRules\ manual
for details on how to generate a \UFO\ file for your favorite physics
model. \UFO\ files are a collection of \ttt{Python} scripts that
encode the particles, the couplings, the Lorentz structures, the
decays, as well as parameters, vertices and propagators of the
corresponding model. They reside in a directory of the exact name of
the model they have been created from.
If the user wants to generate events for processes from a physics
model from a \UFO\ file, then this directory of scripts generated by
\FeynRules\ is immediately available if it is a subdirectory of the working
directory of \whizard. The directory name will be taken as the model
name. (The \UFO-model file name must not start with a
non-letter character, i.e. especially not a number. In case such a
file name wants to be used at all costs, the model name in the
\sindarin\ script has to put in quotation marks, but this is not
guaranteed to always work.) Then, a \UFO\ model named, e.g.,
\ttt{test\_model} is accessed by an extra \ttt{ufo} tag in the model
assignment:
\begin{Code}
model = test_model (ufo)
\end{Code}
If desired, \whizard\ can access a directory of \UFO\ files elsewhere
on the file system. For instance, if \FeynRules\ output resides in
the subdirectory \ttt{MyMdl} of
\ttt{/home/users/john/ufo}, \whizard\ can use the model
named \ttt{MyMdl} as follows
\begin{Code}
model = MyMdl (ufo ('/home/users/john/my_ufo_models'))
\end{Code}
that is, the \sindarin\ keyword \ttt{ufo} can take an argument. Note
however, that the latter approach can backfire --- in case just the working
directory is packed and archived for future reference.
%%%%%%%%%%%%%%%
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\appendix
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{\sindarin\ Reference}
In the \sindarin\ language, there are certain pre-defined constructors or
commands that cannot be used in different context by the user, which
are e.g. \ttt{alias}, \ttt{beams}, \ttt{integrate}, \ttt{simulate} etc.
A complete list will be given below. Also units are fixed, like
\ttt{degree}, \ttt{eV}, \ttt{keV},
\ttt{MeV}, \ttt{GeV}, and \ttt{TeV}. Again, these tags are locked and
not user-redefinable. Their functionality will be listed in detail
below, too. Furthermore, a variable with a preceding
question mark, ?, is a logical, while a preceding dollar, \$, denotes a
character string variable. Also, a lot of unary and binary operators
exist, \ttt{+ - $\backslash$ , = : => < > <= >= \^ \; () [] \{\} }
\url{==}, as well as quotation marks, ". Note that the
different parentheses and brackets fulfill different purposes, which
will be explained below. Comments in a line can either be marked by a
hash, \#, or an exclamation mark, !.
\section{Commands and Operators}
We begin the \sindarin\ reference with all commands, operators, functions
and constructors.
The list of variables (which can be set to change behavior of \whizard) can
be found in the next section.
\begin{itemize}
\item
\ttt{+} \newline
1) Arithmetic operator for addition of integers, reals and complex
numbers. Example: \ttt{real mm = mH + mZ} (cf. also \ttt{-}, \ttt{*},
\ttt{/}, \ttt{\^{}}). 2) It also adds different particles for inclusive
process containers: \ttt{process foo = e1, E1 => (e2, E2) + (e3,
E3)}. 3) It also serves as a shorthand notation for the
concatenation of ($\to$) \ttt{combine} operations on
particles/subevents, e.g. \ttt{cuts = any 170 GeV < M < 180 GeV [b +
lepton + invisible]}.
%%%%%
\item
\ttt{-} \newline
Arithmetic operator for subtraction of integers, reals and complex
numbers. Example: \ttt{real foo = 3.1 - 5.7} (cf. also \ttt{+}, \ttt{*},
\ttt{/}, \ttt{\^{}}).
%%%%%
\item
\ttt{/} \newline
Arithmetic operator for division of integers, reals and complex
numbers. Example: \ttt{scale = mH / 2} (cf. also \ttt{+}, \ttt{*},
\ttt{-}, \ttt{\^{}}).
%%%%%
\item
\ttt{*} \newline
Arithmetic operator for multiplication of integers, reals and complex
numbers. Example: \ttt{complex z = 2 * I} (cf. also \ttt{+}, \ttt{/},
\ttt{-}, \ttt{\^{}}).
%%%%%
\item
\ttt{\^{}} \newline
Arithmetic operator for exponentiation of integers, reals and complex
numbers. Example: \ttt{real z = x\^{}2 + y\^{}2} (cf. also \ttt{+},
\ttt{/}, \ttt{-}, \ttt{\^{}}).
%%%%%
\item
\ttt{<} \newline
Arithmetic comparator between values that checks for ordering
of two values: \ttt{{\em <val1>} < {\em <val2>}} tests whether
\ttt{{\em val1}} is smaller than \ttt{{\em val2}}. Allowed for
integer and real values. Note that this is an exact comparison if
\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
\ttt{==}, \ttt{>}, \ttt{>=}, \ttt{<=})
%%%%%
\item
\ttt{>} \newline
Arithmetic comparator between values that checks for ordering
of two values: \ttt{{\em <val1>} > {\em <val2>}} tests whether
\ttt{{\em val1}} is larger than \ttt{{\em val2}}. Allowed for
integer and real values. Note that this is an exact comparison if
\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
\ttt{==}, \ttt{>}, \ttt{>=}, \ttt{<=})
%%%%%
\item
\ttt{<=} \newline
Arithmetic comparator between values that checks for ordering
of two values: \ttt{{\em <val1>} <= {\em <val2>}} tests whether
\ttt{{\em val1}} is smaller than or equal \ttt{{\em val2}}. Allowed for
integer and real values. Note that this is an exact comparison if
\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
\ttt{==}, \ttt{>}, \ttt{<}, \ttt{>=})
%%%%%
\item
\ttt{>=} \newline
Arithmetic comparator between values that checks for ordering
of two values: \ttt{{\em <val1>} >= {\em <val2>}} tests whether
\ttt{{\em val1}} is larger than or equal \ttt{{\em val2}}. Allowed for
integer and real values. Note that this is an exact comparison if
\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
\ttt{==}, \ttt{>}, \ttt{<}, \ttt{>=})
%%%%%
\item
\ttt{==} \newline
Arithmetic comparator between values that checks for identity
of two values: \ttt{{\em <val1>} == {\em <val2>}}. Allowed for
integer and real values. Note that this is an exact comparison if
\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
\ttt{>}, \ttt{<}, \ttt{>=}, \ttt{<=})
%%%%%
\item
\ttt{<>} \newline
Arithmetic comparator between values that checks for
two values being unequal: \ttt{{\em <val1>} <> {\em <val2>}}. Allowed for
integer and real values. Note that this is an exact comparison if
\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{==},
\ttt{>}, \ttt{<}, \ttt{>=}, \ttt{<=})
%%%%%
\item
\ttt{!} \newline
The exclamation mark tells \sindarin\ that everything that follows in
that line should be treated as a comment. It is the same as ($\to$)
\ttt{\#}.
%%%%%
\item
\ttt{\#} \newline
The hash tells \sindarin\ that everything that follows in
that line should be treated as a comment. It is the same as ($\to$)
\ttt{!}.
%%%%%
\item
\ttt{\&} \newline
Concatenates two or more particle lists/subevents and hence acts in
the same way as the subevent function ($\to$) \ttt{join}: \ttt{let
@visible = [photon] \& [colored] \& [lepton] in ...}. (cf. also
\ttt{join}, \ttt{combine}, \ttt{collect}, \ttt{extract}, \ttt{sort}).
%%%%%
\item
\ttt{\$} \newline
Constructor at the beginning of a variable name,
\ttt{\${\em <string\_var>}}, that specifies a string variable.
%%%%%
\item
\ttt{@} \newline
Constructor at the beginning of a variable name, \ttt{@{\em
<subevt\_var>}}, that specifies a subevent variable, e.g. \ttt{let
@W\_candidates = combine ["mu-", "numubar"] in ...}.
%%%%%
\item
\ttt{=} \newline
Binary constructor to appoint values to commands, e.g. \ttt{{\em <command>}
= {\em <expr>}} or \newline \ttt{{\em <command>} {\em <var\_name>} =
{\em <expr>}}.
%%%%%
\item
\ttt{\%} \newline
Constructor that gives the percentage of a number, so in
principle multiplies a real number by \ttt{0.01}. Example: \ttt{1.23
\%} is equal to \ttt{0.0123}.
%%%%%
\item
\ttt{:} \newline
Separator in alias expressions for particles, e.g. \ttt{alias neutrino
= n1:n2:n3:N1:N2:N3}. (cf. also \ttt{alias})
%%%%%
\item
\ttt{;} \newline
Concatenation operator for logical expressions: \ttt{{\em lexpr1} ;
{\em lexpr2}}. Evaluates \ttt{{\em lexpr1}} and throws the result
away, then evaluates \ttt{{\em lexpr2}} and returns that result. Used
in analysis expressions. (cf. also \ttt{analysis}, \ttt{record})
%%%%%
\item
\ttt{/+} \newline
Incrementor for ($\to$) \ttt{scan} ranges, that increments additively,
\ttt{scan {\em <num\_spec> <num>} = ({\em <lower val>} => {\em <upper
val>} /+ {\em <step
size>})}. E.g. \ttt{scan int i = (1 => 5 /+ 2)} scans over the values \ttt{1},
\ttt{3}, \ttt{5}. For real ranges, it divides the interval between
upper and lower bound into as many intervals as the incrementor
provides, e.g. \ttt{scan real r = (1 => 1.5 /+ 0.2)} runs over
\ttt{1.0}, \ttt{1.333}, \ttt{1.667}, \ttt{1.5}.
%%%%%
\item
\ttt{/+/} \newline
Incrementor for ($\to$) \ttt{scan} ranges, that increments additively,
but the number after the incrementor is the number of steps, not the
step size: \ttt{scan {\em <num\_spec> <num>} = ({\em <lower val>} =>
{\em <upper val>}
/+/ {\em <steps>})}. It is only available for real scan ranges, and divides
the interval \ttt{{\em <upper val>} - {\em <lower val>}} into
\ttt{{\em <steps>}} steps,
e.g. \ttt{scan real r = (1 => 1.5 /+/ 3)} runs over \ttt{1.0},
\ttt{1.25}, \ttt{1.5}.
%%%%%
\item
\ttt{/-} \newline
Incrementor for ($\to$) \ttt{scan} ranges, that increments subtractively,
\ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} /- {\em <step
size>})}. E.g. \ttt{scan int i = (9 => 0 /+ 3)} scans over the values \ttt{9},
\ttt{6}, \ttt{3}, \ttt{0}. For real ranges, it divides the interval
between upper and lower bound into as many intervals as the incrementor
provides, e.g. \ttt{scan real r = (1 => 0.5 /- 0.2)} runs over
\ttt{1.0}, \ttt{0.833}, \ttt{0.667}, \ttt{0.5}.
%%%%%
\item
\ttt{/*} \newline
Incrementor for ($\to$) \ttt{scan} ranges, that increments multiplicatively,
\ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} /* {\em <step
size>})}. E.g. \ttt{scan int i = (1 => 4 /* 2)} scans over the values \ttt{1},
\ttt{2}, \ttt{4}. For real ranges, it divides the interval
between upper and lower bound into as many intervals as the incrementor
provides, e.g. \ttt{scan real r = (1 => 5 /* 2)} runs over
\ttt{1.0}, \ttt{2.236} (i.e. $\sqrt{5}$), \ttt{5.0}.
%%%%%
\item
\ttt{/*/} \newline
Incrementor for ($\to$) \ttt{scan} ranges, that increments multiplicatively,
but the number after the incrementor is the number of steps, not the
step size: \ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>}
/*/ {\em <steps>})}. It is only available for real scan ranges, and divides
the interval \ttt{{\em <upper val>} - {\em <lower val>}} into \ttt{{\em <steps>}} steps,
e.g. \ttt{scan real r = (1 => 9 /*/ 4)} runs over \ttt{1.000},
\ttt{2.080}, \ttt{4.327}, \ttt{9.000}.
%%%%%
\item
\ttt{//} \newline
Incrementor for ($\to$) \ttt{scan} ranges, that increments by division,
\ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} // {\em <step
size>})}. E.g. \ttt{scan int i = (13 => 0 // 3)} scans over the values \ttt{13},
\ttt{4}, \ttt{1}, \ttt{0}. For real ranges, it divides the interval
between upper and lower bound into as many intervals as the incrementor
provides, e.g. \ttt{scan real r = (5 => 1 // 2)} runs over
\ttt{5.0}, \ttt{2.236} (i.e. $\sqrt{5}$), \ttt{1.0}.
%%%%%
\item
\ttt{=>} \newline
Binary operator that is used in several different contexts: 1) in
process declarations between the particles specifying the
initial and final state, e.g. \ttt{process {\em <proc\_name>} = {\em <in1>}, {\em <in2>}
=> {\em <out1>}, ....}; 2) for the specification of beams when
structure functions are applied to the beam particles, e.g. \ttt{beams
= p, p => pdf\_builtin}; 3) for the specification of the scan range in
the \ttt{scan {\em <var>} {\em <var\_name>} = ({\em <scan\_start>} => {\em <scan\_end>}
{\em <incrementor>})} (cf. also \ttt{process}, \ttt{beams}, \ttt{scan})
%%%%%
\item
\ttt{\%d} \newline
Format specifier in analogy to the \ttt{C} language for the print out
on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
\ttt{sprintf} command. It is used for decimal integer numbers,
e.g. \ttt{printf "one = \%d" (i)}. The difference between \ttt{\%i}
and \ttt{\%d} does not play a role here. (cf. also \ttt{printf}, \ttt{sprintf},
\ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
\ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{\%e} \newline
Format specifier in analogy to the \ttt{C} language for the print out
on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
\ttt{sprintf} command. It is used for floating-point numbers in
standard form \ttt{[-]d.ddd e[+/-]ddd}. Usage e.g. \ttt{printf "pi =
\%e" (PI)}. (cf. also \ttt{printf}, \ttt{sprintf},
\ttt{\%d}, \ttt{\%i}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
\ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{\%E} \newline
Same as ($\to$) \ttt{\%e}, but using upper-case letters. (cf. also
\ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
\ttt{\%g}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{\%f} \newline
Format specifier in analogy to the \ttt{C} language for the print out
on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
\ttt{sprintf} command. It is used for floating-point numbers in
fixed-point form. Usage e.g. \ttt{printf "pi =
\%f" (PI)}. (cf. also \ttt{printf}, \ttt{sprintf},
\ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
\ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{\%F} \newline
Same as ($\to$) \ttt{\%f}, but using upper-case letters. (cf. also
\ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
\ttt{\%g}, \ttt{\%E}, \ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{\%g} \newline
Format specifier in analogy to the \ttt{C} language for the print out
on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
\ttt{sprintf} command. It is used for floating-point numbers in
normal or exponential notation, whichever is more approriate. Usage
e.g. \ttt{printf "pi = \%g" (PI)}. (cf. also \ttt{printf}, \ttt{sprintf},
\ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%E}, \ttt{\%F},
\ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{\%G} \newline
Same as ($\to$) \ttt{\%g}, but using upper-case letters. (cf. also
\ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
\ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%s})
%%%%%
\item
\ttt{\%i} \newline
Format specifier in analogy to the \ttt{C} language for the print out
on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
\ttt{sprintf} command. It is used for integer numbers,
e.g. \ttt{printf "one = \%i" (i)}. The difference between \ttt{\%i}
and \ttt{\%d} does not play a role here. (cf. \ttt{printf}, \ttt{sprintf},
\ttt{\%d}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
\ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{\%s} \newline
Format specifier in analogy to the \ttt{C} language for the print out
on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
\ttt{sprintf} command. It is used for logical or string variables
e.g. \ttt{printf "foo = \%s" (\$method)}. (cf. \ttt{printf}, \ttt{sprintf},
\ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
\ttt{\%G})
%%%%%
\item
\ttt{abarn} \newline
Physical unit, stating that a number is in attobarns ($10^{-18}$
barn). (cf. also \ttt{nbarn}, \ttt{fbarn}, \ttt{pbarn})
%%%%%
\item
\ttt{abs} \newline
Numerical function that takes the absolute value of its argument:
\ttt{abs ({\em <num\_val>})} yields \ttt{|{\em
<num\_val>}|}. (cf. also \ttt{conjg}, \ttt{sgn}, \ttt{mod}, \ttt{modulo})
%%%%%
\item
\ttt{acos} \newline
Numerical function \ttt{asin ({\em <num\_val>})} that calculates the
arccosine trigonometric function (inverse of \ttt{cos}) of real and
complex numerical numbers or variables. (cf. also \ttt{sin},
\ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{atan})
%%%%%
\item
\ttt{alias} \newline
This allows to define a collective expression for a class of
particles, e.g. to define a generic expression for leptons, neutrinos
or a jet as \ttt{alias lepton = e1:e2:e3:E1:E2:E3}, \ttt{alias
neutrino = n1:n2:n3:N1:N2:N3}, and \ttt{alias jet =
u:d:s:c:U:D:S:C:g}, respectively.
%%%%%
\item
\ttt{all} \newline
\ttt{all} is a function that works on a logical expression and a list,
\ttt{all {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if and only if
\ttt{log\_expr} is fulfilled for {\em all} entries in \ttt{list}, and
\ttt{false} otherwise. Examples: \ttt{all Pt > 100 GeV [lepton]}
checks whether all leptons are harder than 100 GeV, \ttt{all Dist > 2
[u:U, d:D]} checks whether all pairs of corresponding quarks
are separated in $R$ space by more than 2. Logical expressions with
\ttt{all} can be logically combined with \ttt{and} and
\ttt{or}. (cf. also \ttt{any}, \ttt{and}, \ttt{no}, and \ttt{or})
%%%%%
\item
\ttt{alt\_setup} \newline
This command allows to specify alternative setups for a process/list
of processes, \ttt{alt\_setup = \{ {\em <setup1>} \} [, \{ {\em <setup2>} \} ,
...]}. An alternative setup can be a resetting of a coupling
constant, or different cuts etc. It can be particularly used in a
($\to$) \ttt{rescan} procedure.
%%%%%
\item
\ttt{analysis} \newline
This command, \ttt{analysis = {\em <log\_expr>}}, allows to define an
analysis as a logical expression, with a syntax similar to the ($\to$)
\ttt{cuts} or ($\to$) \ttt{selection} command. Note that a ($\to$)
formally is a logical expression.
%%%%%
\item
\ttt{and} \newline
This is the standard two-place logical connective that has the value
true if both of its operands are true, otherwise a value of false. It
is applied to logical values, e.g. cut expressions. (cf. also
\ttt{all}, \ttt{no}, \ttt{or}).
%%%%%
\item
\ttt{any} \newline
\ttt{any} is a function that works on a logical expression and a list,
\ttt{any {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if
\ttt{log\_expr} is fulfilled for any entry in \ttt{list}, and
\ttt{false} otherwise. Examples: \ttt{any PDG == 13 [lepton]} checks
whether any lepton is a muon, \ttt{any E > 2 * mW [jet]} checks
whether any jet has an energy of twice the $W$ mass. Logical
expressions with \ttt{any} can be logically combined with \ttt{and}
and \ttt{or}. (cf. also \ttt{all}, \ttt{and}, \ttt{no}, and \ttt{or})
%%%%%
\item
\ttt{as} \newline
cf. \ttt{compile}
%%%%%
\item
\ttt{ascii} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the standard \whizard\ verbose/debug ASCII event
files. (cf. also \ttt{\$sample}, \ttt{\$sample\_normalization},
\ttt{sample\_format})
%%%%%
\item
\ttt{asin} \newline
Numerical function \ttt{asin ({\em <num\_val>})} that calculates the
arcsine trigonometric function (inverse of \ttt{sin}) of real and
complex numerical numbers or variables. (cf. also \ttt{sin},
\ttt{cos}, \ttt{tan}, \ttt{acos}, \ttt{atan})
%%%%%
\item
\ttt{atan} \newline
Numerical function \ttt{atan ({\em <num\_val>})} that calculates the
arctangent trigonometric function (inverse of \ttt{tan}) of real and
complex numerical numbers or variables. (cf. also \ttt{sin},
\ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{acos})
%%%%%
\item
\ttt{athena} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the ATHENA variant for HEPEVT ASCII event
files. (cf. also \ttt{\$sample}, \ttt{\$sample\_normalization},
\ttt{sample\_format})
%%%%%
\item
\ttt{beam} \newline
Constructor that specifies a particle (in a subevent) as beam particle. It is
used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
degree [beam lepton, lepton]}. (cf. also \ttt{incoming}, \ttt{outgoing},
\ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
%%%%%
\item
\ttt{beam\_events} \newline
Beam structure specifier to read in lepton collider beamstrahlung's
spectra from external files as pairs of energy fractions: \ttt{beams:
e1, E1 => beam\_events}. Note that this is a pair spectrum that has to
be applied to both beams simultaneously. (cf. also \ttt{beams},
\ttt{\$beam\_events\_file}, \ttt{?beam\_events\_warn\_eof})
%%%%%
\item
\ttt{beams} \newline
This specifies the contents and structure of the beams: \ttt{beams =
{\em <prt1>}, {\em <prt2>} [ => {\em <str\_fun1>} ....]}. If this
command is absent in the input file, \whizard\ automatically takes the
two incoming partons (or one for decays) of the corresponding process
as beam particles, and no structure functions are applied. Protons and
antiprotons as beam particles are predefined as \ttt{p} and
\ttt{pbar}, respectively. A structure function, like \ttt{pdf\_builtin},
\ttt{ISR}, \ttt{EPA} and so on are switched on as e.g. \ttt{beams = p,
p => lhapdf}. Structure functions can be specified for one of the two
beam particles only, of the structure function is not a
spectrum. (cf. also \ttt{beams\_momentum}, \ttt{beams\_theta},
\ttt{beams\_phi}, \ttt{beams\_pol\_density},
\ttt{beams\_pol\_fraction}, \ttt{beam\_events}, \ttt{circe1},
\ttt{circe2}, \ttt{energy\_scan}, \ttt{epa}, \ttt{ewa}, \ttt{isr},
\ttt{lhapdf}, \ttt{pdf\_builtin}).
%%%%%
\item
\ttt{beams\_momentum} \newline
Command to set the momenta (or energies) for the two beams of a
scattering process: \ttt{beams\_momentum = {\em <mom1>}, {\em <mom2>}} to allow
for asymmetric beam setups (e.g. HERA: \ttt{beams\_momentum = 27.5
GeV, 920 GeV}). Two arguments must be present
for a scattering process, but the command can be used with one
argument to integrate and simulate a decay of a moving
particle. (cf. also \ttt{beams}, \ttt{beams\_theta},
\ttt{beams\_phi}, \ttt{beams\_pol\_density},
\ttt{beams\_pol\_fraction})
%%%%%
\item
\ttt{beams\_phi} \newline
Same as ($\to$) \ttt{beams\_theta}, but to allow for a non-vanishing
beam azimuth angle, too. (cf. also \ttt{beams}, \ttt{beams\_theta},
\ttt{beams\_momentum}, \ttt{beams\_pol\_density},
\ttt{beams\_pol\_fraction})
%%%%%
\item
\ttt{beams\_pol\_density} \newline
This command allows to specify the initial state for polarized beams
by the syntax: \ttt{beams\_pol\_density = @({\em <pol\_spec\_1>}),
@({\em <pol\_spec\_2>})}. Two polarization specifiers are mandatory for
scattering, while one can be used for decays from polarized
probes. The specifier \ttt{{\em <pol\_spec\_i>}} can be empty (no
polarization), has one entry (for a definite helicity/spin
orientation), or ranges of entries of a spin density matrix. The
command can be used globally, or as a local argument of the
\ttt{integrate} command. For detailed information, see
Sec.~\ref{sec:initialpolarization}. It is also possible to use
variables as placeholders in the specifiers. Note that polarization is
assumed to be complete, for partial polarization use ($\to$)
\ttt{beams\_pol\_fraction}. (cf. also \ttt{beams}, \ttt{beams\_theta},
\ttt{beams\_phi}, \ttt{beams\_momentum}, \ttt{beams\_pol\_fraction})
%%%%%
\item
\ttt{beams\_pol\_fraction} \newline
This command allows to specify the amount of polarization when using
polarized beams ($\to$ \ttt{beams\_pol\_density}). The syntax is:
\ttt{beams\_pol\_fraction = {\em <frac\_1>}, {\em <frac\_2>}}. Two fractions must
be present for scatterings, being real numbers between \ttt{0} and
\ttt{1}. A specification with percentage is also possible,
e.g. \ttt{beams\_pol\_fraction = 80\%, 40\%}. (cf. also \ttt{beams},
\ttt{beams\_theta}, \ttt{beams\_phi}, \ttt{beams\_momentum},
\ttt{beams\_pol\_density})
%%%%%
\item
\ttt{beams\_theta} \newline
Command to set a crossing angle (with respect to the $z$ axis) for one
or both of the beams of a
scattering process: \ttt{beams\_theta = {\em <angle1>}, {\em <angle2>}} to allow
for asymmetric beam setups (e.g. \ttt{beams\_angle = 0, 10
degree}). Two arguments must be present for a scattering process, but
the command can be used with one argument to integrate and simulate a
decay of a moving particle. (cf. also \ttt{beams}, \ttt{beams\_phi},
\ttt{beams\_momentum}, \ttt{beams\_pol\_density},
\ttt{beams\_pol\_fraction})
%%%%%
\item
\ttt{by} \newline
Constructor that replaces the default sorting criterion (according to
PDG codes) of the ($\to$) \ttt{sort} function on particle
lists/subevents by one given by a unary or binary particle observable:
\ttt{sort by {\em <observable>} [{\em <particles>} [, {\em
<ref\_particles>}] ]}. (cf. also \ttt{sort}, \ttt{extract}, \ttt{join},
\ttt{collect}, \ttt{combine}, \ttt{+})
%%%%%
\item
\ttt{ceiling} \newline
This is a function \ttt{ceiling ({\em <num\_val>})} that gives the
least integer greater than or equal to \ttt{{\em <num\_val>}},
e.g. \ttt{int i = ceiling (4.56789)} gives \ttt{i = 5}. (cf. also
\ttt{int}, \ttt{nint}, \ttt{floor})
%%%%%
\item
\ttt{circe1} \newline
Beam structure specifier for the \circeone\ structure function for
beamstrahlung at a linear lepton collider: \ttt{beams = e1, E1 =>
circe1}. Note that this is a pair spectrum, so the specifier acts for
both beams simultaneously. (cf. also \ttt{beams}, \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})
%%%%%
\item
\ttt{circe2} \newline
Beam structure specifier for the lepton-collider structure function
for photon spectra, \circetwo: \ttt{beams = A, A => circe2}. Note that
this is a pair spectrum, an application to only one beam is not
possible. (cf. also \ttt{beams}, \ttt{?circe2\_polarized},
\ttt{\$circe2\_file}, \ttt{\$circe2\_design})
%%%%%
\item
\ttt{clear} \newline
This command allows to clear a variable set before: \ttt{clear
({\em <clearable var.>})} resets the variable \ttt{{\em <clearable var.>}} which
could be the \ttt{beams}, the \ttt{unstable} settings, \ttt{sqrts},
any kind of \ttt{cuts} or \ttt{scale} expressions, any user-set
variable etc. The syntax of the command is completely analogous to
($\to$) \ttt{show}.
%%%%%
\item
\ttt{close\_out} \newline
With the command, \ttt{close\_out ("{\em <out\_file">})} user-defined
information like data or ($\to$) \ttt{printf} statements can be
written out to a user-defined file. The command closes an I/O stream to
an external file \ttt{{\em <out\_file>}}. (cf. also \ttt{open\_out},
\ttt{\$out\_file}, \ttt{printf})
%%%%%
\item
\ttt{cluster} \newline
Command that allows to cluster all particles in a subevent to a set of
jets: \ttt{cluster [{\em<particles>}]}. It also to cluster particles
subject to a certain boolean condition, \ttt{cluster if
{\em<condition>} [{\em<particles>}]}. At the moment only available
if the \fastjet\ package is linked.
(cf. also \ttt{jet\_r}, \ttt{combine}, \ttt{jet\_algorithm},
\ttt{kt\_algorithm}, \newline \ttt{cambridge\_[for\_passive\_]algorithm},
\ttt{antikt\_algorithm}, \ttt{plugin\_algorithm}, \newline
\ttt{genkt\_[for\_passive\_]algorithm},
\ttt{ee\_kt\_algorithm}, \ttt{ee\_genkt\_algorithm},
\ttt{?keep\_flavors\_when\_clustering})
%%%%%
\item
\ttt{collect} \newline
The \ttt{collect [{\em <list>}]} operation collects all particles in
the list \ttt{{\em <list>}} into a one-entry subevent with a
four-momentum of the sum of all four-momenta of non-overlapping
particles in \ttt{{\em <list>}}. (cf. also \ttt{combine},
\ttt{select}, \ttt{extract}, \ttt{sort})
%%%%%
\item
\ttt{complex} \newline
Defines a complex variable. The syntax is e.g. \ttt{complex x = 2 + 3
* I}. (cf.~also \ttt{int}, \ttt{real})
%%%%%
\item
\ttt{combine} \newline
The \ttt{combine [{\em <list1>}, {\em <list2>}]} operation makes a particle list
whose entries are the result of adding (the momenta of) each pair of
particles in the two input lists \ttt{list1}, {list2}. For example,
\ttt{combine [incoming lepton, lepton]} constructs all mutual pairings
of an incoming lepton with an outgoing lepton (an alias for the
leptons has to be defined, of course). (cf. also \ttt{collect},
\ttt{select}, \ttt{extract}, \ttt{sort}, \ttt{+})
%%%%%
\item
\ttt{compile} \newline
The \ttt{compile ()} command has no arguments (the parentheses can
also been left out: /\ttt{compile ()}. The command is optional, it
invokes the compilation of the process(es) (i.e. the matrix element
file(s)) to be compiled as a shared library. This shared object file
has the standard name \ttt{default\_lib.so} and resides in the
\ttt{.libs} subdirectory of the corresponding user workspace. If the
user has defined a different library name \ttt{lib\_name} with the
\ttt{library} command, then WHIZARD compiles this as the shared object
\ttt{.libs/lib\_name.so}. (This allows to split process classes and to
avoid too large libraries.)
Another possibility is to use the command \ttt{compile as
"static\_name"}. This will compile and link the process library in a
static way and create the static executable \ttt{static\_name} in the
user workspace. (cf. also \ttt{library})
%%%%%
\item
\ttt{compile\_analysis} \newline
The \ttt{compile\_analysis} statement does the same as
the \ttt{write\_analysis} command, namely to tell \whizard\ to write
the analysis setup by the user for the \sindarin\ input file under
consideration. If no \ttt{\$out\_file} is provided, the histogram
tables/plot data etc. are written to the default file
\ttt{whizard\_analysis.dat}. In addition to \ttt{write\_analysis},
\ttt{compile\_analysis} also invokes the \whizard\ \LaTeX routines for
producing postscript or PDF output of the data (unless the flag
$\rightarrow$ \ttt{?analysis\_file\_only} is set to \ttt{true}).
(cf. also \ttt{\$out\_file}, \ttt{write\_analysis},
\ttt{?analysis\_file\_only})
%%%%%
\item
\ttt{conjg} \newline
Numerical function that takes the complex conjugate of its argument:
\ttt{conjg ({\em <num\_val>})} yields \ttt{{\em
<num\_val>}$^\ast$}. (cf. also \ttt{abs}, \ttt{sgn}, \ttt{mod}, \ttt{modulo})
%%%%%
\item
\ttt{cos} \newline
Numerical function \ttt{cos ({\em <num\_val>})} that calculates the
cosine trigonometric function of real and complex numerical numbers or
variables. (cf. also \ttt{sin}, \ttt{tan}, \ttt{asin}, \ttt{acos},
\ttt{atan})
%%%%%
\item
\ttt{cosh} \newline
Numerical function \ttt{cosh ({\em <num\_val>})} that calculates the
hyperbolic cosine function of real and complex numerical numbers or
variables. Note that its inverse function is part of the
\ttt{Fortran2008} status and hence not realized. (cf. also \ttt{sinh},
\ttt{tanh})
%%%%%
\item
\ttt{count} \newline
Subevent function that counts the number of particles or particle
pairs in a subevent: \ttt{count [{\em <particles\_1>} [, {\em
<particles\_2>}]]}. This can also be a counting subject to a
condition: \ttt{count if {\em <condition>} [{\em <particles\_1>} [,
{\em <particles\_2>}]]}.
%%%%%
\item
\ttt{cuts} \newline
This command defines the cuts to be applied to certain processes. The
syntax is: \ttt{cuts = {\em <log\_class>} {\em <log\_expr>} [{\em <unary or binary
particle (list) arg>}]}, where the cut expression must be initialized
with a logical classifier \ttt{log\_class} like \ttt{all}, \ttt{any},
\ttt{no}. The logical expression \ttt{log\_expr} contains the cut to
be evaluated. Note that this need not only be a kinematical cut
expression like \ttt{E > 10 GeV} or \ttt{5 degree < Theta < 175
degree}, but can also be some sort of trigger expression or event
selection, e.g. \ttt{PDG == 15} would select a tau lepton. Whether the
expression is evaluated on particles or pairs of particles depends on
whether the discriminating variable is unary or binary, \ttt{Dist}
being obviously binary, \ttt{Pt} being unary. Note that some variables
are both unary and binary, e.g. the invariant mass $M$. Cut
expressions can be connected by the logical connectives \ttt{and} and
\ttt{or}. The \ttt{cuts} statement acts on all subsequent process
integrations and analyses until a new \ttt{cuts} statement appears.
(cf. also \ttt{all}, \ttt{any},
\ttt{Dist}, \ttt{E}, \ttt{M},
\ttt{no}, \ttt{Pt}).
%%%%%
\item
\ttt{debug} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the very verbose \whizard\ ASCII event
file format intended for debugging. (cf. also \ttt{\$sample},
\ttt{sample\_format}, \ttt{\$sample\_normalization})
%%%%%
\item
\ttt{degree} \newline
Expression specifying the physical unit of degree for angular
variables, e.g. the cut expression function \ttt{Theta}. (if no unit is
specified for angular variables, radians are used; cf. \ttt{rad}, \ttt{mrad}).
%%%%
\item
\ttt{Dist} \newline
Binary observable specifier, that gives the $\eta$-$\phi$-
(pseudorapidity-azimuth) distance $R = \sqrt{(\Delta \eta)^2 +
(\Delta\phi)^2}$ between the momenta of the two particles: \ttt{eval
Dist [jet, jet]}. (cf. also \ttt{eval}, \ttt{cuts}, \ttt{selection},
\ttt{Theta}, \ttt{Eta}, \ttt{Phi})
%%%%%
\item
\ttt{dump} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the intrinsic \whizard\ event record format
(output of the \ttt{particle\_t} type container). (cf. also
\ttt{\$sample}, \ttt{sample\_format}, \ttt{\$sample\_normalization}
%%%%%
\item
\ttt{E} \newline
Unary (binary) observable specifier for the energy of a single
(two) particle(s), e.g. \ttt{eval E ["W+"]}, \ttt{all E > 200 GeV [b,
B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
%%%%%
\item
\ttt{else} \label{sindarin_else}\newline
Constructor for providing an alternative in a conditional clause:
\ttt{if {\em <log\_expr>} then {\em <expr 1>} else {\em <expr 2>} endif}. (cf. also
\ttt{if}, \ttt{elsif}, \ttt{endif}, \ttt{then}).
%%%%%
\item
\ttt{elsif} \newline
Constructor for concatenating more than one conditional clause with
each other: \ttt{if {\em <log\_expr 1>} then {\em <expr 1>} elsif {\em <log\_expr 2>}
then {\em <expr 2>} \ldots endif}. (cf. also \ttt{if}, \ttt{else},
\ttt{endif}, \ttt{then}).
%%%%%
\item
\ttt{endif} \newline
Mandatory constructor to conclude a conditional clause: \ttt{if
{\em <log\_expr>} then \ldots endif}. (cf. also \ttt{if},
\ttt{else}, \ttt{elsif}, \ttt{then}).
%%%%%
\item
\ttt{energy\_scan} \newline
Beam structure specifier for the energy scan structure function:
\ttt{beams = e1, E1 => energy\_scan}. This pair spectrum that has to
be applied to both beams simultaneously can be used to scan over a
range of collider energies without using the \ttt{scan} command.
(cf. also \ttt{beams}, \ttt{scan}, \ttt{?energy\_scan\_normalize})
%%%%%
\item
\ttt{epa} \newline
Beam structure specifier for the equivalent-photon approximation
(EPA), i.e the Weizs\"acker-Williams structure function:
e.g. \ttt{beams = e1, E1 => epa} (applied to both beams), or
e.g. \ttt{beams = e1, u => epa, none} (applied to only one
beam). (cf. also \ttt{beams}, \ttt{epa\_alpha}, \ttt{epa\_x\_min},
\ttt{epa\_mass}, \ttt{epa\_q\_max}, \ttt{epa\_q\_min},
\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})
%%%%%
\item
\ttt{Eta} \newline
Unary and also binary observable specifier, that as a unary observable
gives the pseudorapidity of a particle momentum. The pseudorapidity is
given by $\eta = - \log \left[ \tan (\theta/2) \right]$, where
$\theta$ is the angle with the beam direction. As a binary
observable, it gives the pseudorapidity difference between the momenta
of two particles, where $\theta$ is the enclosed angle: \ttt{eval Eta
[e1]}, \ttt{all abs (Eta) < 3.5 [jet, jet]}. (cf. also \ttt{eval},
\ttt{cuts}, \ttt{selection}, \ttt{Rap}, \ttt{abs})
%%%%%
\item
\ttt{eV} \newline
Physical unit, stating that the corresponding number is in electron
volt. (cf. also \ttt{keV}, \ttt{meV}, \ttt{MeV}, \ttt{GeV}, \ttt{TeV})
%%%%%
\item
\ttt{eval} \newline
Evaluator that tells \whizard\ to evaluate the following expr:
\ttt{eval {\em <expr>}}. Examples are: \ttt{eval Rap [e1]}, \ttt{eval
M / 1 GeV [combine [q,Q]]} etc. (cf. also \ttt{cuts},
\ttt{selection}, \ttt{record})
%%%%%
\item
\ttt{ewa} \newline
Beam structure specifier for the equivalent-photon approximation
(EWA): e.g. \ttt{beams = e1, E1 => ewa} (applied to both beams), or
e.g. \ttt{beams = e1, u => ewa, none} (applied to only one
beam). (cf. also \ttt{beams}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max},
\ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy},
\ttt{?ewa\_recoil})
%%%%%
\item
\ttt{exec} \newline
Constructor \ttt{exec ("{\em <cmd\_name>}")} that demands WHIZARD to
execute/run the command \ttt{cmd\_name}. For this to work that
specific command must be present either in the path of the operating
system or as a command in the user workspace.
%%%%%
\item
\ttt{exit} \newline
Command to finish the \whizard\ run (and not execute any further code
beyond the appearance of \ttt{exit} in the \sindarin\ file. The command
(which is the same as $\to$ \ttt{quit}) allows for an argument,
\ttt{exit ({\em <expr>})}, where the expression can be executed, e.g. a
screen message or an exit code.
%%%%%
\item
\ttt{exp} \newline
Numerical function \ttt{exp ({\em <num\_val>})} that calculates the
exponential of real and complex numerical numbers or
variables. (cf. also \ttt{sqrt}, \ttt{log}, \ttt{log10})
%%%%%
\item
\ttt{expect} \newline
The binary function \ttt{expect} compares two numerical expressions
whether they fulfill a certain ordering condition or are equal up
to a specific uncertainty or tolerance which can bet set by the
specifier \ttt{tolerance}, i.e. in principle it checks whether a
logical expression is true. The \ttt{expect} function does actually
not just check a value for correctness, but also records its result.
If failures are present when the program terminates, the exit code is
nonzero. The syntax is \ttt{expect ({\em <num1>} {\em
<log\_comp>} {\em <num2>})}, where \ttt{{\em <num1>}} and
\ttt{{\em <num2>}} are two numerical values (or
corresponding variables) and \ttt{{\em <log\_comp>}} is one of the following
logical comparators: \ttt{<}, \ttt{>}, \ttt{<=}, \ttt{>=}, \ttt{==},
\ttt{<>}.
(cf. also \ttt{<}, \ttt{>}, \ttt{<=}, \ttt{>=}, \ttt{==}, \ttt{<>},
\ttt{tolerance}).
%%%%%
\item
\ttt{extract} \newline
Subevent function that either extracts the first element of a
particle list/subevent: \ttt{extract [ {\em <particles>}]}, or the
element at position \ttt{<index\_value>} of the particle list:
\ttt{extract {\em index <index\_value>} [ {\em
<particles>}]}. Negative index values count from the end of the
list. (cf. also \ttt{sort}, \ttt{combine},
\ttt{collect}, \ttt{+}, \ttt{index})
%%%%%
\item
\ttt{factorization\_scale} \newline
This is a command, \ttt{factorization\_scale = {\em <expr>}}, that sets
the factorization scale of a process or list of processes. It
overwrites a possible scale set by the ($\to$) \ttt{scale} command.
\ttt{{\em <expr>}} can be any kinematic expression that leads to a result of
momentum dimension one, e.g. \ttt{100 GeV}, \ttt{eval
Pt [e1]}. (cf. also \ttt{renormalization\_scale}).
%%%%%
\item
\ttt{false} \newline
Constructor stating that a logical expression or variable is false,
e.g. \ttt{?{\em <log\_var>} = false}. (cf. also \ttt{true}).
%%%%%
\item
\ttt{fbarn} \newline
Physical unit, stating that a number is in femtobarns ($10^{-15}$
barn). (cf. also \ttt{nbarn}, \ttt{abarn}, \ttt{pbarn})
%%%%%
\item
\ttt{floor} \newline
This is a function \ttt{floor ({\em <num\_val>})} that gives the
greatest integer less than or equal to \ttt{{\em <num\_val>}},
e.g. \ttt{int i = floor (4.56789)} gives \ttt{i = 4}. (cf. also
\ttt{int}, \ttt{nint}, \ttt{ceiling})
%%%%%
\item
\ttt{gaussian} \newline
Beam structure specifier that imposes a Gaussian energy distribution,
separately for each beam. The $\sigma$ values are set by
\ttt{gaussian\_spread1} and \ttt{gaussian\_spread2}, respectively.
%%%%%
\item
\ttt{GeV} \newline
Physical unit, energies in $10^9$ electron volt. This is the default
energy unit of WHIZARD. (cf. also \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{meV},
\ttt{TeV})
%%%%%
\item
\ttt{graph} \newline
This command defines the necessary information regarding producing
a graph of a function in \whizard's internal graphical \gamelan\
output. The syntax is: \ttt{graph {\em <record\_name>} \{ {\em <optional
arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
defined, either before or after the graph definition. Possible optional
arguments of the \ttt{graph} command are the minimal and maximal values
of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
(cf. \ttt{plot}, \ttt{histogram}, \ttt{record})
%%%%%
\item
\ttt{Hel} \newline
Unary observable specifier that allows to specify the helicity of a
particle, e.g. \ttt{all Hel == -1 [e1]} in a selection. (cf. also
\ttt{eval}, \ttt{cuts}, \ttt{selection})
%%%%%
\item
\ttt{hepevt} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of HEPEVT ASCII event files. (cf. also \ttt{\$sample},
\ttt{sample\_format})
%%%%%
\item
\ttt{hepevt\_verb} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the extended or verbose version of HEPEVT ASCII event
files. (cf. also \ttt{\$sample}, \ttt{sample\_format})
%%%%%
\item
\ttt{hepmc} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of HepMC ASCII event files. Note that this is only
available if the HepMC package is installed and correctly
linked. (cf. also \ttt{\$sample}, \ttt{sample\_format},
\ttt{?hepmc\_output\_cross\_section})
%%%%%
\item
\ttt{histogram} \newline
This command defines the necessary information regarding plotting data
as a histogram, in the form of: \ttt{histogram {\em <record\_name>} \{
{\em <optional arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
defined, either before or after the histogram definition. Possible optional
arguments of the \ttt{histogram} command are the minimal and maximal values
of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
(cf. \ttt{graph}, \ttt{plot}, \ttt{record})
%%%%%
\item
\ttt{if} \newline
Conditional clause with the construction \ttt{if {\em <log\_expr>} then
{\em <expr>} [else {\em <expr>} \ldots] endif}. Note that there must be an
\ttt{endif} statement. For more complicated expressions it is better
to use expressions in parentheses: \ttt{if ({\em <log\_expr>}) then
\{{\em <expr>}\} else \{{\em <expr>}\} endif}. Examples are a selection of up quarks
over down quarks depending on a logical variable: \ttt{if ?ok then u
else d}, or the setting of an integer variable depending on the
rapidity of some particle: \ttt{if (eta > 0) then \{ a = +1\} else
\{ a = -1\}}. (cf. also \ttt{elsif}, \ttt{endif}, \ttt{then})
%%%%%
\item
\ttt{in} \newline
Second part of the constructor to let a variable be local to an
expression. It has the syntax \ttt{let {\em <var>} = {\em <value>} in
{\em <expression>}}. E.g. \ttt{let int a = 3 in let int b = 4 in
{\em <expression>}} (cf. also \ttt{let})
%%%%%
\item
\ttt{include} \newline
The \ttt{include} statement, \ttt{include ("file.sin")} allows to
include external \sindarin\ files \ttt{file.sin} into the main WHIZARD
input file. A standard example is the inclusion of the standard cut
file \ttt{default\_cuts.sin}.
%%%%%
\item
\ttt{incoming} \newline
Constructor that specifies particles (or subevents) as incoming. It is
used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
degree [incoming lepton, lepton]}. (cf. also \ttt{beam}, \ttt{outgoing},
\ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
%%%%%
\item
\ttt{index} \newline
Specifies the position of the element of a particle to be extracted by
the subevent function ($\to$) \ttt{extract}: \ttt{extract {\em index
<index\_value>} [ {\em <particles>}]}. Negative index values count
from the end of the list. (cf. also \ttt{extract}, \ttt{sort}, \ttt{combine},
\ttt{collect}, \ttt{+})
%%%%%
\item
\ttt{int} \newline
1) This is a constructor to specify integer constants in the input
file. Strictly speaking, it is a unary function setting the value
\ttt{int\_val} of the integer variable \ttt{int\_var}:
\ttt{int {\em <int\_var>} = {\em <int\_val>}}. Note that is mandatory for all
user-defined variables. (cf. also \ttt{real} and \ttt{complex})
2) It is a function \ttt{int ({\em <num\_val>})} that converts real and
complex numbers (here their real parts) into integers. (cf. also
\ttt{nint}, \ttt{floor}, \ttt{ceiling})
%%%%%
\item
\ttt{integrate} \newline
The \ttt{integrate ({\em <proc\_name>}) \{ {\em <integrate\_options>} \}} command
invokes the integration (phase-space generation and Monte-Carlo
sampling) of the process \ttt{proc\_name} (which can also be a list of
processes) with the integration options
\ttt{{\em <integrate\_options>}}. Possible options are (1) via
\ttt{\$integration\_method = "{\em <intg. method>}"} the integration
method (the default being VAMP), (2) the number of iterations and
calls per integration during the Monte-Carlo phase-space integration
via the \ttt{iterations} specifier; (3) goal for the
accuracy, error or relative error (\ttt{accuracy\_goal},
\ttt{error\_goal}, \ttt{relative\_error\_goal}). (4) Invoking only
phase space generation (\ttt{?phs\_only = true}), (5) making test
calls of the matrix element. (cf. also \ttt{iterations},
\ttt{accuracy\_goal}, \ttt{error\_goal}, \ttt{relative\_error\_goal},
\ttt{error\_threshold})
%%%%%
\item
\ttt{isr} \newline
Beam structure specifier for the lepton-collider/QED initial-state
radiation (ISR) structure function: e.g. \ttt{beams = e1, E1 => isr}
(applied to both beams), or e.g. \ttt{beams = e1, u => isr, none}
(applied to only one beam). (cf. also \ttt{beams}, \ttt{isr\_alpha},
\ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order},
\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})
%%%%%
\item
\ttt{iterations} \qquad (default: internal heuristics) \newline
Option to set the number of iterations and calls per iteration during
the Monte-Carlo phase-space integration process. The syntax is
\ttt{iterations = {\em <n\_iterations>}:{\em <n\_calls>}}. Note that this can be
also a list, separated by colons, which breaks up the integration
process into passes of the specified number of integrations and calls
each. It works for all integration methods. For VAMP, there is the
additional option to specify whether grids and channel weights should
be adapted during iterations (\ttt{"g"}, \ttt{"w"},
\ttt{"gw"} for both, or \ttt{""} for no adaptation). (cf. also
\ttt{integrate}, \ttt{accuracy\_goal}, \ttt{error\_goal},
\ttt{relative\_error\_goal}, \ttt{error\_threshold}).
%%%%%
\item
\ttt{join} \newline
Subevent function that concatenates two particle lists/subevents if
there is no overlap: \ttt{join [{\em <particles>}, {\em
<new\_particles>}]}. The joining of the two lists can also be made
depending on a condition: \ttt{join if {\em <condition>} [{\em
<particles>}, {\em <new\_particles>}]}. (cf. also \ttt{\&},
\ttt{collect}, \ttt{combine}, \ttt{extract}, \ttt{sort}, \ttt{+})
%%%%%
\item
\ttt{keV} \newline
Physical unit, energies in $10^3$ electron volt. (cf. also \ttt{eV},
\ttt{meV}, \ttt{MeV}, \ttt{GeV}, \ttt{TeV})
%%%%%
\item
\ttt{kT} \newline
Binary particle observable that represents a jet $k_T$ clustering
measure: \ttt{kT [j1, j2]} gives the following kinematic expression:
$2 \min(E_{j1}^2, E_{j2}^2) / Q^2 \times (1 - \cos\theta_{j1,j2})$. At the
moment, $Q^2 = 1$.
%%%%%
\item
\ttt{let} \newline
This allows to let a variable be local to an expression. It has the
syntax \ttt{let {\em <var>} = {\em <value>} in {\em <expression>}}.
E.g. \ttt{let int a = 3 in let int b = 4 in {\em <expression>}}
(cf. also \ttt{in})
%%%%%
\item
\ttt{lha} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the \whizard\ version 1 style (deprecated) LHA ASCII event
format files. (cf. also \ttt{\$sample}, \newline
\ttt{sample\_format})
%%%%%
\item
\ttt{lhapdf} \newline
This is a beams specifier to demand calling \lhapdf\ parton densities as
structure functions to integrate processes in hadron collisions. Note
that this only works if the external \lhapdf\ library is present and
correctly linked. (cf. \ttt{beams}, \ttt{\$lhapdf\_dir},
\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon},
\ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member},
\ttt{lhapdf\_photon\_scheme})
%%%%%
\item
\ttt{lhapdf\_photon} \newline
This is a beams specifier to demand calling \lhapdf\ parton densities as
structure functions to integrate processes in hadron collisions with a
photon as initializer of the hard scattering process. Note
that this only works if the external \lhapdf\ library is present and
correctly linked. (cf. \ttt{beams}, \ttt{lhapdf}, \ttt{\$lhapdf\_dir},
\ttt{\$lhapdf\_file}, \ttt{\$lhapdf\_photon\_file},
\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})
%%%%%
\item
\ttt{lhef} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the Les Houches Accord (LHEF) event format files, with
XML headers. There are several different versions of this format,
which can be selected via the \ttt{\$lhef\_version} specifier
(cf. also \ttt{\$sample}, \ttt{sample\_format}, \ttt{\$lhef\_version},
\ttt{\$lhef\_extension}, \ttt{?lhef\_write\_sqme\_prc},
\newline \ttt{?lhef\_write\_sqme\_ref}, \ttt{?lhef\_write\_sqme\_alt})
%%%%%
\item
\ttt{library} \newline
The command \ttt{library = "{\em <lib\_name>}"} allows to specify a separate
shared object library archive \ttt{lib\_name.so}, not using the
standard library \ttt{default\_lib.so}. Those libraries (when using
shared libraries) are located in the \ttt{.libs} subdirectory of the
user workspace. Specifying a separate library is useful for splitting
up large lists of processes, or to restrict a larger number of
different loaded model files to one specific process library.
(cf. also \ttt{compile}, \ttt{\$library\_name})
%%%%%
\item
\ttt{log} \newline
Numerical function \ttt{log ({\em <num\_val>})} that calculates the
natural logarithm of real and complex numerical numbers or
variables. (cf. also \ttt{sqrt}, \ttt{exp}, \ttt{log10})
%%%%%
\item
\ttt{log10} \newline
Numerical function \ttt{log10 ({\em <num\_val>})} that calculates the
base 10 logarithm of real and complex numerical numbers or
variables. (cf. also \ttt{sqrt}, \ttt{exp}, \ttt{log})
%%%%%
\item
\ttt{long} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the long variant of HEPEVT ASCII event
files. (cf. also \ttt{\$sample},
\ttt{sample\_format})
%%%%%
\item
\ttt{M} \newline
Unary (binary) observable specifier for the (signed) mass of a single
(two) particle(s), e.g. \ttt{eval M [e1]}, \ttt{any M = 91 GeV [e2,
E2]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
%%%%%
\item
\ttt{M2} \newline
Unary (binary) observable specifier for the mass squared of a single
(two) particle(s), e.g. \ttt{eval M2 [e1]}, \ttt{all M2 > 2*mZ [e2,
E2]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
%%%%%
\item
\ttt{max} \newline
Numerical function with two arguments \ttt{max ({\em <var1>}, {\em
<var2>})} that gives the maximum of the two arguments: $\max (var1,
var2)$. It can act on all combinations of integer and real
variables. Example: \ttt{real heavier\_mass = max (mZ, mH)}. (cf. also
\ttt{min})
%%%%%
\item
\ttt{meV} \newline
Physical unit, stating that the corresponding number is in $10^{-3}$
electron volt. (cf. also \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV},
\ttt{TeV})
%%%%%
\item
\ttt{MeV} \newline
Physical unit, energies in $10^6$ electron volt. (cf. also \ttt{eV},
\ttt{keV}, \ttt{meV}, \ttt{GeV}, \ttt{TeV})
%%%%%
\item
\ttt{min} \newline
Numerical function with two arguments \ttt{min ({\em <var1>}, {\em
<var2>})} that gives the minimum of the two arguments: $\min (var1,
var2)$. It can act on all combinations of integer and real
variables. Example: \ttt{real lighter\_mass = min (mZ, mH)}. (cf. also
\ttt{max})
%%%%%
\item
\ttt{mod} \newline
Numerical function for integer and real numbers \ttt{mod (x, y)} that
computes the remainder of the division of \ttt{x} by \ttt{y} (which
must not be zero). (cf. also
\ttt{abs}, \ttt{conjg}, \ttt{sgn}, \ttt{modulo})
%%%%%
\item
\ttt{model} \qquad (default: \ttt{SM}) \newline
With this specifier, \ttt{model = {\em <model\_name>}}, one sets the hard
interaction physics model for the processes defined after this model
specification. The list of available models can be found in Table
\ref{tab:models}. Note that the model specification can appear
arbitrarily often in a \sindarin\ input file, e.g. for compiling and
running processes defined in different physics models. (cf. also
\ttt{\$model\_name})
%%%%%
\item
\ttt{modulo} \newline
Numerical function for integer and real numbers \ttt{modulo (x, y)} that
computes the value of $x$ modulo $y$. (cf. also
\ttt{abs}, \ttt{conjg}, \ttt{sgn}, \ttt{mod})
%%%%%
\item
\ttt{mokka} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the MOKKA variant for HEPEVT ASCII event
files. (cf. also \ttt{\$sample},
\ttt{sample\_format})
%%%%%
\item
\ttt{mrad} \newline
Expression specifying the physical unit of milliradians for angular
variables. This default in \whizard\ is \ttt{rad}. (cf. \ttt{degree}, \ttt{rad}).
%%%%%
\item
\ttt{nbarn} \newline
Physical unit, stating that a number is in nanobarns ($10^{-9}$
barn). (cf. also \ttt{abarn}, \ttt{fbarn}, \ttt{pbarn})
%%%%%
\item
\ttt{n\_in} \newline
Integer variable that accesses the number of incoming particles of a
process. It can be used in cuts or in an analysis. (cf. also
\ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record}, \ttt{n\_out}, \ttt{n\_tot})
%%%%%
\item
\ttt{nint} \newline
This is a function \ttt{nint ({\em <num\_val>})} that converts real
numbers into the closest integer, e.g. \ttt{int i = nint (4.56789)}
gives \ttt{i = 5}. (cf. also
\ttt{int}, \ttt{floor}, \ttt{ceiling})
%%%%%
\item
\ttt{no} \newline
\ttt{no} is a function that works on a logical expression and a list,
\ttt{no {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if and only if
\ttt{log\_expr} is fulfilled for {\em none} of the entries in
\ttt{list}, and \ttt{false} otherwise. Examples: \ttt{no Pt < 100 GeV
[lepton]} checks whether no lepton is softer than 100 GeV. It is the
logical opposite of the function \ttt{all}. Logical expressions with
\ttt{no} can be logically combined with \ttt{and} and
\ttt{or}. (cf. also \ttt{all}, \ttt{any}, \ttt{and}, and \ttt{or})
%%%%%
\item
\ttt{none} \newline
Beams specifier that can used to explicitly {\em not} apply a
structure function to a beam, e.g. in HERA physics: \ttt{beams = e1, P
=> none, pdf\_builtin}. (cf. also \ttt{beams})
%%%%%
\item
\ttt{not} \newline
This is the standard logical negation that converts true into false
and vice versa. It is applied to logical values, e.g. cut
expressions. (cf. also \ttt{and}, \ttt{or}).
%%%%%
\item
\ttt{n\_out} \newline
Integer variable that accesses the number of outgoing particles of a
process. It can be used in cuts or in an analysis. (cf. also
\ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record}, \ttt{n\_in}, \ttt{n\_tot})
%%%%%
\item
\ttt{n\_tot} \newline
Integer variable that accesses the total number of particles (incoming
plus outgoing) of a process. It can be used in cuts or in an
analysis. (cf. also \ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record},
\ttt{n\_in}, \ttt{n\_out})
%%%%%
\item
\ttt{observable} \newline
With this, \ttt{observable = {\em <obs\_spec>}}, the user is able to define
a variable specifier \ttt{obs\_spec} for observables. These can be
reused in the analysis, e.g. as a \ttt{record}, as functions of the
fundamental kinematical variables of the processes.
(cf. \ttt{analysis}, \ttt{record})
%%%%%
\item
\ttt{open\_out} \newline
With the command, \ttt{open\_out ("{\em <out\_file">})} user-defined
information like data or ($\to$) \ttt{printf} statements can be
written out to a user-defined file. The command opens an I/O stream to
an external file \ttt{{\em <out\_file>}}. (cf. also \ttt{close\_out},
\ttt{\$out\_file}, \ttt{printf})
%%%%%
\item
\ttt{or} \newline
This is the standard two-place logical connective that has the value
true if one of its operands is true, otherwise a value of false. It
is applied to logical values, e.g. cut expressions. (cf. also
\ttt{and}, \ttt{not}).
%%%%%
\item
\ttt{outgoing} \newline
Constructor that specifies particles (or subevents) as outgoing. It is
used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
degree [incoming lepton, outgoing lepton]}. Note that the \ttt{outgoing}
keyword is redundant and included only for completeness: \ttt{outgoing lepton}
has the same meaning as \ttt{lepton}. (cf. also \ttt{beam},
\ttt{incoming},
\ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
%%%%%
\item
\ttt{P} \newline
Unary (binary) observable specifier for the spatial momentum
$\sqrt{\vec{p}^2}$ of a single (two) particle(s), e.g. \ttt{eval P
["W+"]}, \ttt{all P > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
\ttt{selection})
%%%%%
\item
\ttt{pbarn} \newline
Physical unit, stating that a number is in picobarns ($10^{-12}$
barn). (cf. also \ttt{abarn}, \ttt{fbarn}, \ttt{nbarn})
%%%%%
\item
\ttt{pdf\_builtin} \newline
This is a beams specifier for \whizard's internal PDF structure
functions to integrate processes in hadron collisions.
(cf. \ttt{beams}, \ttt{pdf\_builtin\_photon},
\ttt{\$pdf\_builtin\_file})
%%%%%
\item
\ttt{pdf\_builtin\_photon} \newline
This is a beams specifier for \whizard's internal PDF structure
functions to integrate processes in hadron collisions with a photon as
initializer of the hard scattering process.
(cf. \ttt{beams}, \ttt{\$pdf\_builtin\_file})
%%%%%
\item
\ttt{PDG} \newline
Unary observable specifier that allows to specify the PDG code of a
particle, e.g. \ttt{eval PDG [e1]}, giving \ttt{11}. (cf. also
\ttt{eval}, \ttt{cuts}, \ttt{selection})
%%%%%
\item
\ttt{Phi} \newline
Unary and also binary observable specifier, that as a unary observable
gives the azimuthal angle of a particle's momentum in the detector
frame (beam into $+z$ direction). As a binary observable, it gives the
azimuthal difference between the momenta of two particles: \ttt{eval
Phi [e1]}, \ttt{all Phi > Pi [jet, jet]}. (cf. also \ttt{eval},
\ttt{cuts}, \ttt{selection}, \ttt{Theta})
%%%%%
\item
\ttt{Pl} \newline
Unary (binary) observable specifier for the longitudinal momentum
($p_z$ in the c.m. frame) of a single (two) particle(s),
e.g. \ttt{eval Pl ["W+"]}, \ttt{all Pl > 200 GeV [b,
B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
%%%%%
\item
\ttt{plot} \newline
This command defines the necessary information regarding plotting data
as a graph, in the form of: \ttt{plot {\em <record\_name>} \{ {\em <optional
arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
defined, either before or after the plot definition. Possible optional
arguments of the \ttt{plot} command are the minimal and maximal values
of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
(cf. \ttt{graph}, \ttt{histogram}, \ttt{record})
%%%%%
\item
\ttt{polarized} \newline
Constructor to instruct \whizard\ to retain polarization of the
corresponding particles in the generated events: \ttt{polarized {\em <prt1>}
[, {\em <prt2>} , ...]}. (cf. also \ttt{unpolarized}, \ttt{simulate},
\ttt{?polarized\_events})
%%%%%
\item
\ttt{printf} \newline
Command that allows to print data as screen messages, into logfiles or
into user-defined output files: \ttt{printf "{\em <string\_expr>}"}. There
exist format specifiers, very similar to the \ttt{C} command
\ttt{printf}, e.g. \ttt{printf "\%i" (123)}. (cf. also
\ttt{open\_out}, \ttt{close\_out}, \ttt{\$out\_file},
\ttt{?out\_advance}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e},
\ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{process} \newline
Allows to set a hard interaction process, either for a decay process
with name \ttt{{\em <decay\_proc>}} as \ttt{process {\em
<decay\_proc>} = {\em <mother>} => {\em <daughter1>}, {\em
<daughter2>}, ...}, or for a scattering process
with name \ttt{{\em <scat\_proc}} as \ttt{process {\em <scat\_proc>} =
{\em <in1>}, {\em <in2>} => {\em <out1>}, {\em <out2>}, ...}. Note
that there can be arbitrarily many processes to be defined in a
\sindarin\ input file. There are two options for particle/process sums: flavor sums:
\ttt{{\em <prt1>}:{\em <prt2>}:...}, where all masses have to be identical, and
inclusive sums, \ttt{{\em <prt1>} + {\em <prt2>} + ...}. The latter can be done on
the level of individual particles, or sums over whole final
states. Here, masses can differ, and terms will be translated into
different process components. The \ttt{process} command also allows for
optional arguments, e.g. to specify a numerical identifier
(cf. \ttt{process\_num\_id}), the method how to generate the code for
the matrix element(s): \ttt{\$method}, possible methods are either
with the \oMega\ matrix element generator, using template matrix
elements with different normalizations, or completely internal matrix
element; for \oMega\ matrix elements there is also the possibility to
specify possible restrictions (cf. \ttt{\$restrictions}).
%%%%%
\item
\ttt{Pt} \newline
Unary (binary) observable specifier for the transverse momentum
($\sqrt{p_x^2 + p_y^2}$ in the c.m. frame) of a single (two)
particle(s), e.g. \ttt{eval Pt ["W+"]}, \ttt{all Pt > 200 GeV [b,
B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
%%%%%
\item
\ttt{Px} \newline
Unary (binary) observable specifier for the $x$-component of the
momentum of a single (two) particle(s), e.g. \ttt{eval Px ["W+"]},
\ttt{all Px > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
\ttt{selection})
%%%%%
\item
\ttt{Py} \newline
Unary (binary) observable specifier for the $y$-component of the
momentum of a single (two) particle(s), e.g. \ttt{eval Py ["W+"]},
\ttt{all Py > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
\ttt{selection})
%%%%%
\item
\ttt{Pz} \newline
Unary (binary) observable specifier for the $z$-component of the
momentum of a single (two) particle(s), e.g. \ttt{eval Pz ["W+"]},
\ttt{all Pz > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
\ttt{selection})
%%%%%
\item
\ttt{quit} \newline
Command to finish the \whizard\ run (and not execute any further code
beyond the appearance of \ttt{quit} in the \sindarin\ file. The command
(which is the same as $\to$ \ttt{exit}) allows for an argument,
\ttt{quit ({\em <expr>})}, where the expression can be executed, e.g. a
screen message or an quit code.
%%%%%
\item
\ttt{rad} \newline
Expression specifying the physical unit of radians for angular
variables. This is the default in \whizard. (cf. \ttt{degree}, \ttt{mrad}).
%%%%%
\item
\ttt{Rap} \newline
Unary and also binary observable specifier, that as a unary observable
gives the rapidity of a particle momentum. The rapidity is given by $y
= \frac12 \log \left[ (E + p_z)/(E-p_z) \right]$. As a binary
observable, it gives the rapidity difference between the momenta of
two particles: \ttt{eval Rap [e1]}, \ttt{all abs (Rap) < 3.5 [jet,
jet]}. (cf. also \ttt{eval}, \ttt{cuts}, \ttt{selection}, \ttt{Eta},
\ttt{abs})
%%%%%
\item
\ttt{read\_slha} \newline
Tells \whizard\ to read in an input file in the SUSY Les Houches accord
(SLHA), as \ttt{read\_slha ("slha\_file.slha")}. Note that the files
for the use in \whizard\ should have the suffix \ttt{.slha}.
(cf. also \ttt{write\_slha}, \ttt{?slha\_read\_decays},
\ttt{?slha\_read\_input}, \ttt{?slha\_read\_spectrum})
%%%%%
\item
\ttt{real} \newline
This is a constructor to specify real constants in the input
file. Strictly speaking, it is a unary function setting the value
\ttt{real\_val} of the real variable \ttt{real\_var}:
\ttt{real {\em <real\_var>} = {\em <real\_val>}}. (cf. also \ttt{int} and
\ttt{complex})
%%%%%
\item
\ttt{real\_epsilon}\\
Predefined real; the relative uncertainty intrinsic to the floating
point type of the \fortran\ compiler with which \whizard\ has been
built.
%%%%%
\item
\ttt{real\_precision}\\
Predefined integer; the decimal precision of the floating point type
of the \fortran\ compiler with which \whizard\ has been built.
%%%%%
\item
\ttt{real\_range}\\
Predefined integer; the decimal range of the floating point type of
the \fortran\ compiler with which \whizard\ has been built.
%%%%%
\item
\ttt{real\_tiny}\\
Predefined real; the smallest number which can be represented by the
floating point type of the \fortran\ compiler with which \whizard\ has
been built.
%%%%%
\item
\ttt{record} \newline
The \ttt{record} constructor provides an internal data structure in
\sindarin\ input files. Its syntax is in general \ttt{record
{\em <record\_name>} ({\em <cmd\_expr>})}. The \ttt{{\em <cmd\_expr>}} could be the
definition of a tuple of points for a histogram or an \ttt{eval}
constructor that tells \whizard\ e.g. by which rule to calculate an
observable to be stored in the record \ttt{record\_name}. Example:
\ttt{record h (12)} is a record for a histogram defined under the name
\ttt{h} with the single data point (bin) at value 12; \ttt{record rap1
(eval Rap [e1])} defines a record with name \ttt{rap1} which has an
evaluator to calculate the rapidity (predefined \whizard\ function) of
an outgoing electron.
(cf. also \ttt{eval}, \ttt{histogram}, \ttt{plot})
%%%%%
\item
\ttt{renormalization\_scale} \newline
This is a command, \ttt{renormalization\_scale = {\em <expr>}}, that sets
the renormalization scale of a process or list of processes. It
overwrites a possible scale set by the ($\to$) \ttt{scale} command.
\ttt{{\em <expr>}} can be any kinematic expression that leads to a result of
momentum dimension one, e.g. \ttt{100 GeV}, \ttt{eval
Pt [e1]}. (cf. also \ttt{factorization\_scale}).
%%%%%
\item
\ttt{rescan} \newline
This command allows to rescan event samples with modified model
parameter, beam structure etc. to recalculate (analysis) observables,
e.g.: \newline
\ttt{rescan "{\em <event\_file>}" ({\em <proc\_name>}) \{ {\em <rescan\_setup>}\}}.
\newline
\ttt{"{\em <event\_file>}"} is the name of the event file and
\ttt{{\em <proc\_name>}} is the process whose (existing) event
file of arbitrary size that is to be rescanned. Several flags allow to
reconstruct the beams ($\to$ \ttt{?recover\_beams}), to reuse only the
hard process but rebuild the full events ($\to$
\ttt{?update\_event}), to recalculate the matrix element ($\to$
\ttt{?update\_sqme}) or to recalculate the individual event weight ($\to$
\ttt{?update\_weight}). Further rescan options are redefining model
parameter input, or defining a completely new alternative setup ($\to$
\ttt{alt\_setup}) (cf. also \ttt{\$rescan\_input\_format})
%%%%%
\item
\ttt{results} \newline
Only used in the combination \ttt{show (results)}. Forces \whizard\ to
print out a results summary for the integrated processes.
(cf. also \ttt{show})
%%%%%
\item
\ttt{reweight} \newline
The \ttt{reweight = {\em <expr>}} command allows to give for a process or
list of processes an alternative weight, given by any kind of scalar
expression \ttt{{\em <expr>}}, e.g. \ttt{reweight = 0.2} or \ttt{reweight =
(eval M2 [e1, E1]) / (eval M2 [e2, E2])}. (cf. also \ttt{alt\_setup},
\ttt{weight}, \ttt{rescan})
%%%%%
\item
\ttt{sample\_format} \newline
Variable that allows the user to specify additional event formats
beyond the \whizard\ native binary event format. Its syntax is
\ttt{sample\_format = {\em <format>}}, where \ttt{{\em <format>}} can be any of
the following specifiers: \ttt{hepevt}, \ttt{hepevt\_verb}, \ttt{ascii},
\ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, \ttt{hepmc},
\ttt{lhef}, \ttt{lha}, \ttt{lha\_verb}, \ttt{stdhep}, \ttt{stdhep\_up}.
(cf. also \ttt{\$sample}, \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}, \newline
\ttt{\$sample\_normalization}, \ttt{?sample\_pacify},
\ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt},
\ttt{sample\_split\_n\_kbytes})
%%%%%
\item
\ttt{scale} \newline
This is a command, \ttt{scale = {\em <expr>}}, that sets the kinematic scale
of a process or list of processes. Unless overwritten explicitly by
($\to$) \ttt{factorization\_scale} and/or ($\to$)
\ttt{renormalization\_scale} it sets both scales. \ttt{{\em <expr>}} can be
any kinematic expression that leads to a result of momentum dimension
one, e.g. \ttt{scale = 100 GeV}, \ttt{scale = eval Pt [e1]}.
%%%%%
\item
\ttt{scan} \newline
Constructor to perform loops over variables or scan over processes in
the integration procedure. The syntax is \ttt{scan {\em <var>} {\em <var\_name>}
({\em <value list>} or {\em <value\_init>} => {\em <value\_fin>} /{\em <incrementor>}
{\em <increment>}) \{ {\em <scan\_cmd>} \}}. The variable \ttt{var} can be
specified if it is not a real, e.g. an integer. \ttt{var\_name} is the
name of the variable which is also allowed to be a predefined one like
\ttt{seed}. For the scan, one can either specify an explicit list of
values \ttt{value list}, or use an initial and final value and a
rule to increment. The \ttt{scan\_cmd} can either be just a
\ttt{show} to print out the scanned variable or the integration of a process.
Examples are: \ttt{scan seed (32 => 1 // 2) \{ show (seed\_value) \}
}, which runs the seed down in steps 32, 16, 8, 4, 2, 1 (division by
two). \ttt{scan mW (75 GeV, 80 GeV => 82 GeV /+ 0.5 GeV, 83 GeV => 90
GeV /* 1.2) \{ show (sw) \} } scans over the $W$ mass for the values
75, 80, 80.5, 81, 81.5, 82, 83 GeV, namely one discrete value, steps
by adding 0.5 GeV, and increase by 20 \% (the latter having no effect
as it already exceeds the final value). It prints out the
corresponding value of the effective mixing angle which is defined as
a dependent variable in the model input file(s). \ttt{scan sqrts (500 GeV =>
600 GeV /+ 10 GeV) \{ integrate (proc) \} } integrates the process
\ttt{proc} in eleven increasing 10 GeV steps in center-of-mass energy
from 500 to 600 GeV. (cf. also \ttt{/+}, \ttt{/+/}, \ttt{/-},
\ttt{/*}, \ttt{/*/}, \ttt{//})
%%%%%
\item
\ttt{select} \newline
Subevent function \ttt{select if {\em <condition>} [{\em <list1>} [ ,
{\em <list2>}]]} that select all particles in \ttt{{\em <list1>}}
that satisfy the condition \ttt{{\em <condition>}}. The second
particle list \ttt{{\em <list2>}} is for conditions that depend on
binary observables. (cf. also \ttt{collect},
\ttt{combine}, \ttt{extract}, \ttt{sort}, \ttt{+})
%%%%%
\item
\ttt{selection} \newline
Command that allows to select particular final states in an analysis
selection, \ttt{selection = {\em <log\_expr>}}. The term \ttt{log\_expr} can
be any kind of logical expression. The syntax matches exactly
the one of the ($\to$) \ttt{cuts} command. E.g. \ttt{selection = any
PDG == 13} is an electron selection in a lepton sample.
%%%%%
\item
\ttt{sgn} \newline
Numerical function for integer and real numbers that gives the sign of
its argument: \ttt{sgn ({\em <num\_val>})} yields $+1$ if \ttt{{\em
<num\_val>}} is positive or zero, and $-1$ otherwise. (cf. also
\ttt{abs}, \ttt{conjg}, \ttt{mod}, \ttt{modulo})
%%%%%
\item
\ttt{short} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of the short variant of HEPEVT ASCII event
files. (cf. also \ttt{\$sample}, \ttt{sample\_format})
%%%%%
\item
\ttt{show} \newline
This is a unary function that is operating on specific constructors in
order to print them out in the \whizard\ screen output as well as the
log file \ttt{whizard.log}. Examples are \ttt{show({\em <parameter\_name>})}
to issue a specific parameter from a model or a constant defined in a
\sindarin\ input file, \ttt{show(integral({\em <proc\_name>}))},
\ttt{show(library)}, \ttt{show(results)}, or \ttt{show({\em <var>})} for any
arbitrary variable. Further possibilities are \ttt{show(real)},
\ttt{show(string)}, \ttt{show(logical)} etc. to allow to show all
defined real, string, logical etc. variables, respectively.
(cf. also \ttt{library}, \ttt{results})
%%%%%
\item
\ttt{simulate} \newline
This command invokes the generation of events for the process
\ttt{proc} by means of \ttt{simulate ({\em <proc>})}.
Optional arguments: \ttt{\$sample}, \ttt{sample\_format},
\ttt{checkpoint} (cf. also \ttt{integrate}, \ttt{luminosity},
\ttt{n\_events}, \ttt{\$sample}, \ttt{sample\_format},
\ttt{checkpoint}, \ttt{?unweighted}, \ttt{safety\_factor},
\ttt{?negative\_weights}, \ttt{sample\_max\_tries},
\ttt{sample\_split\_n\_evt}, \ttt{sample\_split\_n\_kbytes})
%%%%%
\item
\ttt{sin} \newline
Numerical function \ttt{sin ({\em <num\_val>})} that calculates the
sine trigonometric function of real and complex numerical numbers or
variables. (cf. also \ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{acos},
\ttt{atan})
%%%%%
\item
\ttt{sinh} \newline
Numerical function \ttt{sinh ({\em <num\_val>})} that calculates the
hyperbolic sine function of real and complex numerical numbers or
variables. Note that its inverse function is part of the
\ttt{Fortran2008} status and hence not realized. (cf. also \ttt{cosh},
\ttt{tanh})
%%%%%
\item
\ttt{sort} \newline
Subevent function that allows to sort a particle list/subevent either
by increasing PDG code: \ttt{sort [{\em <particles>}]} (particles
first, then antiparticles). Alternatively, it can sort according to a
unary or binary particle observable (in that case there is a second
particle list, where the first particle is taken as a reference):
\ttt{sort by {\em <observable>} [{\em <particles>} [, {\em
<ref\_particles>}]]}. (cf. also \ttt{extract}, \ttt{combine},
\ttt{collect}, \ttt{join}, \ttt{by}, \ttt{+})
%%%%%
\item
\ttt{sprintf} \newline
Command that allows to print data into a string variable: \ttt{sprintf
"{\em <string\_expr>}"}. There exist format specifiers, very similar
to the \ttt{C} command \ttt{sprintf}, e.g. \ttt{sprintf "\%i"
(123)}. (cf. \ttt{printf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e},
\ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
%%%%%
\item
\ttt{sqrt} \newline
Numerical function \ttt{sqrt ({\em <num\_val>})} that calculates the
square root of real and complex numerical numbers or
variables. (cf. also \ttt{exp}, \ttt{log}, \ttt{log10})
%%%%%
\item
\ttt{sqrts\_hat} \newline
Real variable that accesses the partonic energy of a hard-scattering
process. It can be used in cuts or in an analysis, e.g. \ttt{cuts =
sqrts\_hat > {\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}. (cf. also \ttt{sqrts}, \ttt{cuts}, \ttt{record})
%%%%%
\item
\ttt{stable} \newline
This constructor allows particles in the final states of processes in
decay cascade set-up to be set as stable, and not letting them
decay. The syntax is \ttt{stable {\em <prt\_name>}} (cf. also \ttt{unstable})
%%%%%
\item
\ttt{stdhep} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of binary StdHEP event files based on the HEPEVT common
block. (cf. also \ttt{\$sample}, \ttt{sample\_format})
%%%%%
\item
\ttt{stdhep\_up} \newline
Specifier for the \ttt{sample\_format} command to demand the
generation of binary StdHEP event files based on the HEPRUP/HEPEUP common
blocks. (cf. also \ttt{\$sample}, \ttt{sample\_format})
%%%%%
\item
\ttt{tan} \newline
Numerical function \ttt{tan ({\em <num\_val>})} that calculates the
tangent trigonometric function of real and complex numerical numbers or
variables. (cf. also \ttt{sin}, \ttt{cos}, \ttt{asin}, \ttt{acos},
\ttt{atan})
%%%%%
\item
\ttt{tanh} \newline
Numerical function \ttt{tanh ({\em <num\_val>})} that calculates the
hyperbolic tangent function of real and complex numerical numbers or
variables. Note that its inverse function is part of the
\ttt{Fortran2008} status and hence not realized. (cf. also \ttt{cosh},
\ttt{sinh})
%%%%%
\item
\ttt{TeV} \newline
Physical unit, for energies in $10^{12}$ electron volt. (cf. also
\ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{meV}, \ttt{GeV})
%%%%
\item
\ttt{then} \newline
Mandatory phrase in a conditional clause: \ttt{if {\em <log\_expr>} then
{\em <expr 1>} \ldots endif}. (cf. also \ttt{if}, \ttt{else}, \ttt{elsif},
\ttt{endif}).
%%%%%
\item
\ttt{Theta} \newline
Unary and also binary observable specifier, that as a unary observable
gives the angle between a particle's momentum and the beam axis ($+z$
direction). As a binary observable, it gives the angle enclosed
between the momenta of the two particles: \ttt{eval Theta [e1]},
\ttt{all Theta > 30 degrees [jet, jet]}. (cf. also \ttt{eval},
\ttt{cuts}, \ttt{selection}, \ttt{Phi}, \ttt{Theta\_star})
%%%%%
\item
\ttt{Theta\_star} \newline
Binary observable specifier, that gives the polar angle enclosed
between the momenta of the two particles in the rest frame of the
mother particle (momentum sum of the two particle): \ttt{eval
Theta\_star [jet, jet]}. (cf. also \ttt{eval},
\ttt{cuts}, \ttt{selection}, \ttt{Theta})
%%%%%
\item
\ttt{true} \newline
Constructor stating that a logical expression or variable is true,
e.g. \ttt{?{\em <log\_var>} = true}. (cf. also \ttt{false}).
%%%%%
\item
\ttt{unpolarized} \newline
Constructor to force \whizard\ to discard polarization of the
corresponding particles in the generated events: \ttt{unpolarized {\em <prt1>}
[, {\em <prt2>} , ...]}. (cf. also \ttt{polarized}, \ttt{simulate},
\ttt{?polarized\_events})
%%%%%
\item
\ttt{unstable} \newline
This constructor allows to let final state particles of the hard
interaction undergo a subsequent (cascade) decay (in the on-shell
approximation). For this the user has to define the list of desired
\begin{figure}
\begin{Verbatim}[frame=single]
process zee = Z => e1, E1
process zuu = Z => u, U
process zz = e1, E1 => Z, Z
compile
integrate (zee) { iterations = 1:100 }
integrate (zuu) { iterations = 1:100 }
sqrts = 500 GeV
integrate (zz) { iterations = 3:5000, 2:5000 }
unstable Z (zee, zuu)
\end{Verbatim}
\caption{\label{fig:ex_unstable} \sindarin\ input file for unstable
particles and inclusive decays.}
\end{figure}
decay channels as \ttt{unstable {\em <mother>} ({\em <decay1>}, {\em <decay2>}, ....)},
where \ttt{mother} is the mother particle, and the argument is a list
of decay channels. Note that -- unless the \ttt{?auto\_decays = true}
flag has been set -- these decay channels have to be provided by the
user as in the example in Fig. \ref{fig:ex_unstable}. First, the $Z$
decays to electrons and up quarks are generated, then $ZZ$ production
at a 500 GeV ILC is called, and then both $Z$s are decayed according
to the probability distribution of the two generated decay matrix
elements. This obviously allows also for inclusive decays.
(cf. also \ttt{stable}, \ttt{?auto\_decays})
%%%%%
\item
\ttt{weight} \newline
This is a command, \ttt{weight = {\em <expr>}}, that allows to specify a
weight for a process or list of processes. \ttt{{\em <expr>}} can be
any expression that leads to a scalar result, e.g. \ttt{weight = 0.2},
\ttt{weight = eval Pt [jet]}. (cf. also \ttt{rescan},
\ttt{alt\_setup}, \ttt{reweight})
%%%%%
\item
\ttt{write\_analysis} \newline
The \ttt{write\_analysis} statement tells \whizard\ to write the
analysis setup by the user for the \sindarin\ input file under
consideration. If no \ttt{\$out\_file} is provided, the histogram
tables/plot data etc. are written to the default file
\ttt{whizard\_analysis.dat}. Note that the related command
\ttt{compile\_analysis} does the same as \ttt{write\_analysis} but in
addition invokes the \whizard\ \LaTeX routines for producing
postscript or PDF output of the data.
(cf. also \ttt{\$out\_file}, \ttt{compile\_analysis})
%%%%%
\item
\ttt{write\_slha} \newline
Demands \whizard\ to write out a file in the SUSY Les Houches accord
(SLHA) format. (cf. also \ttt{read\_slha}, \ttt{?slha\_read\_decays},
\ttt{?slha\_read\_input}, \ttt{?slha\_read\_spectrum})
%%%%%
\end{itemize}
\section{Variables}
\subsection{Rebuild Variables}
\begin{itemize}
\item
\ttt{?rebuild\_events} \qquad (default: \ttt{false}) \newline
This logical variable, if set \ttt{true} triggers \whizard\ to newly
create an event sample, even if nothing seems to have changed,
including the MD5 checksum. This can be used when manually
manipulating some settings. (cf also \ttt{?rebuild\_grids},
\ttt{?rebuild\_library}, \ttt{?rebuild\_phase\_space})
%%%%%
\item
\ttt{?rebuild\_grids} \qquad (default: \ttt{false}) \newline
The logical variable \ttt{?rebuild\_grids} forces \whizard\ to newly
create the VAMP grids when using VAMP as an integration method, even
if they are already present. (cf. also \ttt{?rebuild\_events},
\ttt{?rebuild\_library}, \ttt{?rebuild\_phase\_space})
%%%%%
\item
\ttt{?rebuild\_library} \qquad (default: \ttt{false}) \newline
The logical variable \ttt{?rebuild\_library = true/false} specifies
whether the library(-ies) for the matrix element code for processes is
re-generated (incl. possible Makefiles etc.) by the corresponding ME
method (e.g. if the process has been changed, but not its name). This
can also be set as a command-line option \ttt{whizard --rebuild}. The
default is \ttt{false}, i.e. code is never re-generated if it is
present and the MD5 checksum is valid.
(cf. also \ttt{?recompile\_library}, \ttt{?rebuild\_grids},
\ttt{?rebuild\_phase\_space})
%%%%%
\item
\ttt{?rebuild\_phase\_space} \qquad (default: \ttt{false}) \newline
This logical variable, if set \ttt{true}, triggers recreation of the
phase space file by \whizard\. (cf. also \ttt{?rebuild\_events},
\ttt{?rebuild\_grids}, \ttt{?rebuild\_library})
%%%%%
\item
\ttt{?recompile\_library} \qquad (default: \ttt{false}) \newline
The logical variable \ttt{?recompile\_library = true/false} specifies
whether the library(-ies) for the matrix element code for processes is
re-compiled (e.g. if the process code has been manually modified by
the user). This can also be set as a command-line option \ttt{whizard
--recompile}. The default is \ttt{false}, i.e. code is never
re-compiled if its corresponding object file is present. (cf. also
\ttt{?rebuild\_library})
%%%%%
\end{itemize}
\subsection{Standard Variables}
\begin{itemize}
\input{variables}
\end{itemize}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\clearpage
\section*{Acknowledgements}
We would like to thank E.~Boos, R.~Chierici, K.~Desch, M.~Kobel,
F.~Krauss, P.M.~Manakos, N.~Meyer, K.~M\"onig, H.~Reuter, T.~Robens,
S.~Rosati, J.~Schumacher, M.~Schumacher, and C.~Schwinn who
contributed to \whizard\ by their suggestions, bits of codes and
valuable remarks and/or used several versions of the program for
real-life applications and thus helped a lot in debugging and
improving the code. Special thanks go to A.~Vaught and J.~Weill for
their continuos efforts on improving the g95 and gfortran compilers,
respectively.
%\end{fmffile}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% References
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%\baselineskip15pt
\begin{thebibliography}{19}
\bibitem{PYTHIA}
T.~Sj\"ostrand,
Comput.\ Phys.\ Commun.\ \textbf{82} (1994) 74.
\bibitem{comphep}
A.~Pukhov, \emph{et al.},
Preprint INP MSU 98-41/542, \ttt{hep-ph/9908288}.
\bibitem{madgraph}
T.~Stelzer and W.F.~Long,
Comput.\ Phys.\ Commun.\ \textbf{81} (1994) 357.
\bibitem{omega}
T.~Ohl,
\emph{Proceedings of the Seventh International Workshop on
Advanced Computing and Analysis Technics in Physics Research},
ACAT 2000, Fermilab, October 2000,
IKDA-2000-30, \ttt{hep-ph/0011243};
M.~Moretti, Th.~Ohl, and J.~Reuter,
LC-TOOL-2001-040
\bibitem{VAMP}
T.~Ohl,
{\em Vegas revisited: Adaptive Monte Carlo integration beyond
factorization},
Comput.\ Phys.\ Commun.\ {\bf 120}, 13 (1999)
[arXiv:hep-ph/9806432].
%%CITATION = CPHCB,120,13;%%
\bibitem{CIRCE}
T.~Ohl,
{\em CIRCE version 1.0: Beam spectra for simulating linear collider
physics},
Comput.\ Phys.\ Commun.\ {\bf 101}, 269 (1997)
[arXiv:hep-ph/9607454].
%%CITATION = CPHCB,101,269;%%
%\cite{Gribov:1972rt}
\bibitem{Gribov:1972rt}
V.~N.~Gribov and L.~N.~Lipatov,
{\em e+ e- pair annihilation and deep inelastic e p scattering in
perturbation theory},
Sov.\ J.\ Nucl.\ Phys.\ {\bf 15}, 675 (1972)
[Yad.\ Fiz.\ {\bf 15}, 1218 (1972)].
%%CITATION = SJNCA,15,675;%%
%\cite{Kuraev:1985hb}
\bibitem{Kuraev:1985hb}
E.~A.~Kuraev and V.~S.~Fadin,
{\em On Radiative Corrections to e+ e- Single Photon Annihilation at
High-Energy},
Sov.\ J.\ Nucl.\ Phys.\ {\bf 41}, 466 (1985)
[Yad.\ Fiz.\ {\bf 41}, 733 (1985)].
%%CITATION = SJNCA,41,466;%%
%\cite{Skrzypek:1990qs}
\bibitem{Skrzypek:1990qs}
M.~Skrzypek and S.~Jadach,
{\em Exact and approximate solutions for the electron nonsinglet
structure function in QED},
Z.\ Phys.\ C {\bf 49}, 577 (1991).
%%CITATION = ZEPYA,C49,577;%%
%\cite{Schulte:1998au}
\bibitem{Schulte:1998au}
D.~Schulte,
{\em Beam-beam simulations with Guinea-Pig},
eConf C {\bf 980914}, 127 (1998).
%%CITATION = ECONF,C980914,127;%%
%\cite{Schulte:1999tx}
\bibitem{Schulte:1999tx}
D.~Schulte,
{\em Beam-beam simulations with GUINEA-PIG},
CERN-PS-99-014-LP.
%%CITATION = CERN-PS-99-014-LP;%%
%\cite{Schulte:2007zz}
\bibitem{Schulte:2007zz}
D.~Schulte, M.~Alabau, P.~Bambade, O.~Dadoun, G.~Le Meur, C.~Rimbault and F.~Touze,
{\em GUINEA PIG++ : An Upgraded Version of the Linear Collider Beam
Beam Interaction Simulation Code GUINEA PIG},
Conf.\ Proc.\ C {\bf 070625}, 2728 (2007).
%%CITATION = CONFP,C070625,2728;%%
%\cite{Behnke:2013xla}
\bibitem{Behnke:2013xla}
T.~Behnke, J.~E.~Brau, B.~Foster, J.~Fuster, M.~Harrison, J.~M.~Paterson, M.~Peskin and M.~Stanitzki {\it et al.},
{\em The International Linear Collider Technical Design Report -
Volume 1: Executive Summary},
arXiv:1306.6327 [physics.acc-ph].
%%CITATION = ARXIV:1306.6327;%%
%\cite{Baer:2013cma}
\bibitem{Baer:2013cma}
H.~Baer, T.~Barklow, K.~Fujii, Y.~Gao, A.~Hoang, S.~Kanemura, J.~List and H.~E.~Logan {\it et al.},
{\em The International Linear Collider Technical Design Report -
Volume 2: Physics},
arXiv:1306.6352 [hep-ph].
%%CITATION = ARXIV:1306.6352;%%
%\cite{Adolphsen:2013jya}
\bibitem{Adolphsen:2013jya}
C.~Adolphsen, M.~Barone, B.~Barish, K.~Buesser, P.~Burrows, J.~Carwardine, J.~Clark and H\'{e}l\`{e}n.~M.~Durand {\it et al.},
{\em The International Linear Collider Technical Design Report -
Volume 3.I: Accelerator \& in the Technical Design Phase},
arXiv:1306.6353 [physics.acc-ph].
%%CITATION = ARXIV:1306.6353;%%
%\cite{Adolphsen:2013kya}
\bibitem{Adolphsen:2013kya}
C.~Adolphsen, M.~Barone, B.~Barish, K.~Buesser, P.~Burrows, J.~Carwardine, J.~Clark and H\'{e}l\`{e}n.~M.~Durand {\it et al.},
{\em The International Linear Collider Technical Design Report -
Volume 3.II: Accelerator Baseline Design},
arXiv:1306.6328 [physics.acc-ph].
%%CITATION = ARXIV:1306.6328;%%
%\cite{Behnke:2013lya}
\bibitem{Behnke:2013lya}
T.~Behnke, J.~E.~Brau, P.~N.~Burrows, J.~Fuster, M.~Peskin, M.~Stanitzki, Y.~Sugimoto and S.~Yamada {\it et al.},
%``The International Linear Collider Technical Design Report - Volume 4: Detectors,''
arXiv:1306.6329 [physics.ins-det].
%%CITATION = ARXIV:1306.6329;%%
%\cite{Aicheler:2012bya}
\bibitem{Aicheler:2012bya}
M.~Aicheler, P.~Burrows, M.~Draper, T.~Garvey, P.~Lebrun, K.~Peach and N.~Phinney {\it et al.},
{\em A Multi-TeV Linear Collider Based on CLIC Technology : CLIC
Conceptual Design Report},
CERN-2012-007.
%%CITATION = CERN-2012-007;%%
%\cite{Lebrun:2012hj}
\bibitem{Lebrun:2012hj}
P.~Lebrun, L.~Linssen, A.~Lucaci-Timoce, D.~Schulte, F.~Simon, S.~Stapnes, N.~Toge and H.~Weerts {\it et al.},
{\em The CLIC Programme: Towards a Staged e+e- Linear Collider
Exploring the Terascale : CLIC Conceptual Design Report},
arXiv:1209.2543 [physics.ins-det].
%%CITATION = ARXIV:1209.2543;%%
%\cite{Linssen:2012hp}
\bibitem{Linssen:2012hp}
L.~Linssen, A.~Miyamoto, M.~Stanitzki and H.~Weerts,
{\em Physics and Detectors at CLIC: CLIC Conceptual Design Report},
arXiv:1202.5940 [physics.ins-det].
%%CITATION = ARXIV:1202.5940;%%
%\cite{vonWeizsacker:1934sx}
\bibitem{vonWeizsacker:1934sx}
C.~F.~von Weizs\"acker,
{\em Radiation emitted in collisions of very fast electrons},
Z.\ Phys.\ {\bf 88}, 612 (1934).
%%CITATION = ZEPYA,88,612;%%
%\cite{Williams:1934ad}
\bibitem{Williams:1934ad}
E.~J.~Williams,
{\em Nature of the high-energy particles of penetrating radiation
and status of ionization and radiation formulae},
Phys.\ Rev.\ {\bf 45}, 729 (1934).
%%CITATION = PHRVA,45,729;%%
%\cite{Budnev:1974de}
\bibitem{Budnev:1974de}
V.~M.~Budnev, I.~F.~Ginzburg, G.~V.~Meledin and V.~G.~Serbo,
{\em The Two photon particle production mechanism. Physical problems.
Applications. Equivalent photon approximation},
Phys.\ Rept.\ {\bf 15} (1974) 181.
%%CITATION = PRPLC,15,181;%%
%\cite{Ginzburg:1981vm}
\bibitem{Ginzburg:1981vm}
I.~F.~Ginzburg, G.~L.~Kotkin, V.~G.~Serbo and V.~I.~Telnov,
{\em Colliding gamma e and gamma gamma Beams Based on the Single
Pass Accelerators (of Vlepp Type)},
Nucl.\ Instrum.\ Meth.\ {\bf 205}, 47 (1983).
%%CITATION = NUIMA,205,47;%%
%\cite{Telnov:1989sd}
\bibitem{Telnov:1989sd}
V.~I.~Telnov,
{\em Problems of Obtaining $\gamma \gamma$ and $\gamma \epsilon$
Colliding Beams at Linear Colliders},
Nucl.\ Instrum.\ Meth.\ A {\bf 294}, 72 (1990).
%%CITATION = NUIMA,A294,72;%%
%\cite{Telnov:1995hc}
\bibitem{Telnov:1995hc}
V.~I.~Telnov,
{\em Principles of photon colliders},
Nucl.\ Instrum.\ Meth.\ A {\bf 355}, 3 (1995).
%%CITATION = NUIMA,A355,3;%%
%\cite{AguilarSaavedra:2001rg}
\bibitem{AguilarSaavedra:2001rg}
J.~A.~Aguilar-Saavedra {\it et al.} [ECFA/DESY LC Physics Working
Group Collaboration],
{\em TESLA: The Superconducting electron positron linear collider
with an integrated x-ray laser laboratory. Technical design
report. Part 3. Physics at an e+ e- linear collider},
hep-ph/0106315.
%%CITATION = HEP-PH/0106315;%%
%\cite{Richard:2001qm}
\bibitem{Richard:2001qm}
F.~Richard, J.~R.~Schneider, D.~Trines and A.~Wagner,
{\em TESLA, The Superconducting Electron Positron Linear Collider
with an Integrated X-ray Laser Laboratory, Technical Design Report
Part 1 : Executive Summary},
hep-ph/0106314.
%%CITATION = HEP-PH/0106314;%%
%\cite{Sudakov:1954sw}
\bibitem{Sudakov:1954sw}
V.~V.~Sudakov,
%``Vertex parts at very high-energies in quantum electrodynamics,''
Sov.\ Phys.\ JETP {\bf 3}, 65 (1956)
[Zh.\ Eksp.\ Teor.\ Fiz.\ {\bf 30}, 87 (1956)].
%%CITATION = SPHJA,3,65;%%
\cite{Sjostrand:1985xi}
\bibitem{Sjostrand:1985xi}
T.~Sjostrand,
%``A Model for Initial State Parton Showers,''
Phys.\ Lett.\ {\bf 157B}, 321 (1985).
doi:10.1016/0370-2693(85)90674-4
%%CITATION = doi:10.1016/0370-2693(85)90674-4;%%
%\cite{Sjostrand:2006za}
\bibitem{Sjostrand:2006za}
T.~Sjostrand, S.~Mrenna and P.~Z.~Skands,
%``PYTHIA 6.4 Physics and Manual,''
JHEP {\bf 0605}, 026 (2006)
doi:10.1088/1126-6708/2006/05/026
[hep-ph/0603175].
%%CITATION = doi:10.1088/1126-6708/2006/05/026;%%
%\cite{Ohl:1998jn}
\bibitem{Ohl:1998jn}
T.~Ohl,
{\em Vegas revisited: Adaptive Monte Carlo integration beyond
factorization},
Comput.\ Phys.\ Commun.\ {\bf 120}, 13 (1999)
[hep-ph/9806432].
%%CITATION = HEP-PH/9806432;%%
%\cite{Lepage:1980dq}
\bibitem{Lepage:1980dq}
G.~P.~Lepage,
%``Vegas: An Adaptive Multidimensional Integration Program,''
CLNS-80/447.
%%CITATION = CLNS-80/447;%%
\bibitem{HDECAY}
A.~Djouadi, J.~Kalinowski, M.~Spira,
Comput.\ Phys.\ Commun.\ \textbf{108} (1998) 56-74.
%\cite{Beyer:2006hx}
\bibitem{Beyer:2006hx}
M.~Beyer, W.~Kilian, P.~Krstono\v{s}ic, K.~M\"onig, J.~Reuter, E.~Schmidt
and H.~Schr\"oder,
{\em Determination of New Electroweak Parameters at the ILC -
Sensitivity to New Physics},
Eur.\ Phys.\ J.\ C {\bf 48}, 353 (2006)
[hep-ph/0604048].
%%CITATION = HEP-PH/0604048;%%
%\cite{Alboteanu:2008my}
\bibitem{Alboteanu:2008my}
A.~Alboteanu, W.~Kilian and J.~Reuter,
{\em Resonances and Unitarity in Weak Boson Scattering at the LHC},
JHEP {\bf 0811}, 010 (2008)
[arXiv:0806.4145 [hep-ph]].
%%CITATION = ARXIV:0806.4145;%%
%\cite{Binoth:2010xt}
\bibitem{Binoth:2010xt}
T.~Binoth {\it et al.},
%``A Proposal for a standard interface between Monte Carlo tools and one-loop programs,''
Comput.\ Phys.\ Commun.\ {\bf 181}, 1612 (2010)
doi:10.1016/j.cpc.2010.05.016
[arXiv:1001.1307 [hep-ph]].
%%CITATION = doi:10.1016/j.cpc.2010.05.016;%%
%\cite{Alioli:2013nda}
\bibitem{Alioli:2013nda}
S.~Alioli {\it et al.},
%``Update of the Binoth Les Houches Accord for a standard interface
%between Monte Carlo tools and one-loop programs,''
Comput.\ Phys.\ Commun.\ {\bf 185}, 560 (2014)
doi:10.1016/j.cpc.2013.10.020
[arXiv:1308.3462 [hep-ph]].
%%CITATION = doi:10.1016/j.cpc.2013.10.020;%%
%\cite{Speckner:2010zi}
\bibitem{Speckner:2010zi}
C.~Speckner,
{\em LHC Phenomenology of the Three-Site Higgsless Model},
PhD thesis, arXiv:1011.1851 [hep-ph].
%%CITATION = ARXIV:1011.1851;%%
%\cite{Chivukula:2006cg}
\bibitem{Chivukula:2006cg}
R.~S.~Chivukula, B.~Coleppa, S.~Di Chiara, E.~H.~Simmons, H.~-J.~He,
M.~Kurachi and M.~Tanabashi,
{\em A Three Site Higgsless Model},
Phys.\ Rev.\ D {\bf 74}, 075011 (2006)
[hep-ph/0607124].
%%CITATION = HEP-PH/0607124;%%
%\cite{Chivukula:2005xm}
\bibitem{Chivukula:2005xm}
R.~S.~Chivukula, E.~H.~Simmons, H.~-J.~He, M.~Kurachi and M.~Tanabashi,
{\em Ideal fermion delocalization in Higgsless models},
Phys.\ Rev.\ D {\bf 72}, 015008 (2005)
[hep-ph/0504114].
%%CITATION = HEP-PH/0504114;%%
%\cite{Ohl:2008ri}
\bibitem{Ohl:2008ri}
T.~Ohl and C.~Speckner,
{\em Production of Almost Fermiophobic Gauge Bosons in the Minimal
Higgsless Model at the LHC},
Phys.\ Rev.\ D {\bf 78}, 095008 (2008)
[arXiv:0809.0023 [hep-ph]].
%%CITATION = ARXIV:0809.0023;%%
%\cite{Ohl:2002jp}
\bibitem{Ohl:2002jp}
T.~Ohl and J.~Reuter,
{\em Clockwork SUSY: Supersymmetric Ward and Slavnov-Taylor
identities at work in Green's functions and scattering
amplitudes},
Eur.\ Phys.\ J.\ C {\bf 30}, 525 (2003)
[hep-th/0212224].
%%CITATION = HEP-TH/0212224;%%
%\cite{Reuter:2009ex}
\bibitem{Reuter:2009ex}
J.~Reuter and F.~Braam,
{\em The NMSSM implementation in WHIZARD},
AIP Conf.\ Proc.\ {\bf 1200}, 470 (2010)
[arXiv:0909.3059 [hep-ph]].
%%CITATION = ARXIV:0909.3059;%%
%\cite{Kalinowski:2008fk}
\bibitem{Kalinowski:2008fk}
J.~Kalinowski, W.~Kilian, J.~Reuter, T.~Robens and K.~Rolbiecki,
{\em Pinning down the Invisible Sneutrino},
JHEP {\bf 0810}, 090 (2008)
[arXiv:0809.3997 [hep-ph]].
%%CITATION = ARXIV:0809.3997;%%
%\cite{Robens:2008sa}
\bibitem{Robens:2008sa}
T.~Robens, J.~Kalinowski, K.~Rolbiecki, W.~Kilian and J.~Reuter,
{\em (N)LO Simulation of Chargino Production and Decay},
Acta Phys.\ Polon.\ B {\bf 39}, 1705 (2008)
[arXiv:0803.4161 [hep-ph]].
%%CITATION = ARXIV:0803.4161;%%
%\cite{Kilian:2004pp}
\bibitem{Kilian:2004pp}
W.~Kilian, D.~Rainwater and J.~Reuter,
{\em Pseudo-axions in little Higgs models},
Phys.\ Rev.\ D {\bf 71}, 015008 (2005)
[hep-ph/0411213].
%%CITATION = HEP-PH/0411213;%%
%\cite{Kilian:2006eh}
\bibitem{Kilian:2006eh}
W.~Kilian, D.~Rainwater and J.~Reuter,
{\em Distinguishing little-Higgs product and simple group models at
the LHC and ILC},
Phys.\ Rev.\ D {\bf 74}, 095003 (2006)
[Erratum-ibid.\ D {\bf 74}, 099905 (2006)]
[hep-ph/0609119].
%%CITATION = HEP-PH/0609119;%%
%\cite{Ohl:2004tn}
\bibitem{Ohl:2004tn}
T.~Ohl and J.~Reuter,
{\em Testing the noncommutative standard model at a future photon
collider},
Phys.\ Rev.\ D {\bf 70}, 076007 (2004)
[hep-ph/0406098].
%%CITATION = HEP-PH/0406098;%%
%\cite{Ohl:2010zf}
\bibitem{Ohl:2010zf}
T.~Ohl and C.~Speckner,
{\em The Noncommutative Standard Model and Polarization in Charged
Gauge Boson Production at the LHC},
Phys.\ Rev.\ D {\bf 82}, 116011 (2010)
[arXiv:1008.4710 [hep-ph]].
%%CITATION = ARXIV:1008.4710;%%
\bibitem{LesHouches}
E.~Boos {\it et al.},
{\em Generic user process interface for event generators},
arXiv:hep-ph/0109068.
%%CITATION = HEP-PH/0109068;%%
\bibitem{Skands:2003cj}
P.~Z.~Skands {\it et al.},
{\em SUSY Les Houches Accord: Interfacing SUSY Spectrum Calculators, Decay
Packages, and Event Generators},
JHEP {\bf 0407}, 036 (2004)
[arXiv:hep-ph/0311123].
%%CITATION = JHEPA,0407,036;%%
%\cite{AguilarSaavedra:2005pw}
\bibitem{AguilarSaavedra:2005pw}
J.~A.~Aguilar-Saavedra, A.~Ali, B.~C.~Allanach, R.~L.~Arnowitt, H.~A.~Baer, J.~A.~Bagger, C.~Balazs and V.~D.~Barger {\it et al.},
{\em Supersymmetry parameter analysis: SPA convention and project},
Eur.\ Phys.\ J.\ C {\bf 46}, 43 (2006)
[hep-ph/0511344].
%%CITATION = HEP-PH/0511344;%%
%\cite{Allanach:2008qq}
\bibitem{Allanach:2008qq}
B.~C.~Allanach, C.~Balazs, G.~Belanger, M.~Bernhardt, F.~Boudjema, D.~Choudhury, K.~Desch and U.~Ellwanger {\it et al.},
%``SUSY Les Houches Accord 2,''
Comput.\ Phys.\ Commun.\ {\bf 180}, 8 (2009)
[arXiv:0801.0045 [hep-ph]].
%%CITATION = ARXIV:0801.0045;%%
\bibitem{LHEF}
J.~Alwall {\it et al.},
{\em A standard format for Les Houches event files},
Comput.\ Phys.\ Commun.\ {\bf 176}, 300 (2007)
[arXiv:hep-ph/0609017].
%%CITATION = CPHCB,176,300;%%
\bibitem{Hagiwara:2005wg}
K.~Hagiwara {\it et al.},
{\em Supersymmetry simulations with off-shell effects for LHC and
ILC},
Phys.\ Rev.\ D {\bf 73}, 055005 (2006)
[arXiv:hep-ph/0512260].
%%CITATION = PHRVA,D73,055005;%%
\bibitem{Allanach:2002nj}
B.~C.~Allanach {\it et al.},
{\em The Snowmass points and slopes: Benchmarks for SUSY searches},
in {\it Proc. of the APS/DPF/DPB Summer Study on the Future of Particle Physics (Snowmass 2001) } ed. N.~Graf,
Eur.\ Phys.\ J.\ C {\bf 25} (2002) 113
[eConf {\bf C010630} (2001) P125]
[arXiv:hep-ph/0202233].
%%CITATION = HEP-PH 0202233;%%
\bibitem{PeskinSchroeder}
M.E. Peskin, D.V.Schroeder, {\em An Introduction to Quantum Field
Theory}, Addison-Wesley Publishing Co., 1995.
\bibitem{stdhep}
L.~Garren, {\em StdHep, Monte Carlo Standardization at FNAL},
Fermilab CS-doc-903,
\url{http://cd-docdb.fnal.gov/cgi-bin/ShowDocument?docid=903}
\bibitem{LHAPDF}
W.~Giele {\it et al.},
{\em The QCD / SM working group: Summary report},
arXiv:hep-ph/0204316;
%%CITATION = HEP-PH/0204316;%%
M.~R.~Whalley, D.~Bourilkov and R.~C.~Group,
{\em The Les Houches Accord PDFs (LHAPDF) and Lhaglue},
arXiv:hep-ph/0508110;
%%CITATION = HEP-PH/0508110;%%
D.~Bourilkov, R.~C.~Group and M.~R.~Whalley,
{\em LHAPDF: PDF use from the Tevatron to the LHC},
arXiv:hep-ph/0605240.
%%CITATION = HEP-PH/0605240;%%
\bibitem{HepMC}
M.~Dobbs and J.~B.~Hansen,
{\em The HepMC C++ Monte Carlo event record for High Energy
Physics},
Comput.\ Phys.\ Commun.\ {\bf 134}, 41 (2001).
%%CITATION = CPHCB,134,41;%%
%\cite{Boos:2004kh}
\bibitem{Boos:2004kh}
E.~Boos {\it et al.} [CompHEP Collaboration],
%``CompHEP 4.4: Automatic computations from Lagrangians to events,''
Nucl.\ Instrum.\ Meth.\ A {\bf 534}, 250 (2004)
[hep-ph/0403113].
%%CITATION = HEP-PH/0403113;%%
%493 citations counted in INSPIRE as of 12 May 2014
% Parton distributions
%\cite{Pumplin:2002vw}
\bibitem{Pumplin:2002vw}
J.~Pumplin, D.~R.~Stump, J.~Huston {\it et al.},
{\em New generation of parton distributions with uncertainties from
global QCD analysis},
JHEP {\bf 0207}, 012 (2002).
[hep-ph/0201195].
%\cite{Martin:2004dh}
\bibitem{Martin:2004dh}
A.~D.~Martin, R.~G.~Roberts, W.~J.~Stirling {\it et al.},
{\em Parton distributions incorporating QED contributions},
Eur.\ Phys.\ J.\ {\bf C39}, 155-161 (2005).
[hep-ph/0411040].
%\cite{Martin:2009iq}
\bibitem{Martin:2009iq}
A.~D.~Martin, W.~J.~Stirling, R.~S.~Thorne {\it et al.},
{\em Parton distributions for the LHC},
Eur.\ Phys.\ J.\ {\bf C63}, 189-285 (2009).
[arXiv:0901.0002 [hep-ph]].
%\cite{Lai:2010vv}
\bibitem{Lai:2010vv}
H.~L.~Lai, M.~Guzzi, J.~Huston, Z.~Li, P.~M.~Nadolsky, J.~Pumplin and C.~P.~Yuan,
{\em New parton distributions for collider physics},
Phys.\ Rev.\ D {\bf 82}, 074024 (2010)
[arXiv:1007.2241 [hep-ph]].
%%CITATION = PHRVA,D82,074024;%%
%\cite{Owens:2012bv}
\bibitem{Owens:2012bv}
J.~F.~Owens, A.~Accardi and W.~Melnitchouk,
{\em Global parton distributions with nuclear and finite-$Q^2$
corrections},
Phys.\ Rev.\ D {\bf 87}, no. 9, 094012 (2013)
[arXiv:1212.1702 [hep-ph]].
%%CITATION = ARXIV:1212.1702;%%
%\cite{Accardi:2016qay}
\bibitem{Accardi:2016qay}
A.~Accardi, L.~T.~Brady, W.~Melnitchouk, J.~F.~Owens and N.~Sato,
%``Constraints on large-$x$ parton distributions from new weak boson production and deep-inelastic scattering data,''
arXiv:1602.03154 [hep-ph].
%%CITATION = ARXIV:1602.03154;%%
%\cite{Harland-Lang:2014zoa}
\bibitem{Harland-Lang:2014zoa}
L.~A.~Harland-Lang, A.~D.~Martin, P.~Motylinski and R.~S.~Thorne,
%``Parton distributions in the LHC era: MMHT 2014 PDFs,''
arXiv:1412.3989 [hep-ph].
%%CITATION = ARXIV:1412.3989;%%
%\cite{Dulat:2015mca}
\bibitem{Dulat:2015mca}
S.~Dulat {\it et al.},
%``The CT14 Global Analysis of Quantum Chromodynamics,''
arXiv:1506.07443 [hep-ph].
%%CITATION = ARXIV:1506.07443;%%
%\cite{Salam:2008qg}
\bibitem{Salam:2008qg}
G.~P.~Salam and J.~Rojo,
{\em A Higher Order Perturbative Parton Evolution Toolkit (HOPPET)},
Comput.\ Phys.\ Commun.\ {\bf 180}, 120 (2009)
[arXiv:0804.3755 [hep-ph]].
%%CITATION = ARXIV:0804.3755;%%
%\cite{Kilian:2011ka}
\bibitem{Kilian:2011ka}
W.~Kilian, J.~Reuter, S.~Schmidt and D.~Wiesler,
{\em An Analytic Initial-State Parton Shower},
JHEP {\bf 1204} (2012) 013
[arXiv:1112.1039 [hep-ph]].
%%CITATION = ARXIV:1112.1039;%%
%\cite{Staub:2008uz}
\bibitem{Staub:2008uz}
F.~Staub,
{\em Sarah},
arXiv:0806.0538 [hep-ph].
%%CITATION = ARXIV:0806.0538;%%
%\cite{Staub:2009bi}
\bibitem{Staub:2009bi}
F.~Staub,
{\em From Superpotential to Model Files for FeynArts and
CalcHep/CompHep},
Comput.\ Phys.\ Commun.\ {\bf 181}, 1077 (2010)
[arXiv:0909.2863 [hep-ph]].
%%CITATION = ARXIV:0909.2863;%%
%\cite{Staub:2010jh}
\bibitem{Staub:2010jh}
F.~Staub,
{\em Automatic Calculation of supersymmetric Renormalization Group
Equations and Self Energies},
Comput.\ Phys.\ Commun.\ {\bf 182}, 808 (2011)
[arXiv:1002.0840 [hep-ph]].
%%CITATION = ARXIV:1002.0840;%%
%\cite{Staub:2012pb}
\bibitem{Staub:2012pb}
F.~Staub,
{\em SARAH 3.2: Dirac Gauginos, UFO output, and more},
Computer Physics Communications {\bf 184}, pp. 1792 (2013)
[Comput.\ Phys.\ Commun.\ {\bf 184}, 1792 (2013)]
[arXiv:1207.0906 [hep-ph]].
%%CITATION = ARXIV:1207.0906;%%
%\cite{Staub:2013tta}
\bibitem{Staub:2013tta}
F.~Staub,
{\em SARAH 4: A tool for (not only SUSY) model builders},
Comput.\ Phys.\ Commun.\ {\bf 185}, 1773 (2014)
[arXiv:1309.7223 [hep-ph]].
%%CITATION = ARXIV:1309.7223;%%
\bibitem{mathematica}
\Mathematica\ is a registered trademark of Wolfram Research, Inc.,
Champain, IL, USA.
%\cite{Porod:2003um}
\bibitem{Porod:2003um}
W.~Porod,
{\em SPheno, a program for calculating supersymmetric spectra, SUSY
particle decays and SUSY particle production at e+ e- colliders},
Comput.\ Phys.\ Commun.\ {\bf 153}, 275 (2003)
[hep-ph/0301101].
%%CITATION = HEP-PH/0301101;%%
%\cite{Porod:2011nf}
\bibitem{Porod:2011nf}
W.~Porod and F.~Staub,
{\em SPheno 3.1: Extensions including flavour, CP-phases and models
beyond the MSSM},
Comput.\ Phys.\ Commun.\ {\bf 183}, 2458 (2012)
[arXiv:1104.1573 [hep-ph]].
%%CITATION = ARXIV:1104.1573;%%
%\cite{Staub:2011dp}
\bibitem{Staub:2011dp}
F.~Staub, T.~Ohl, W.~Porod and C.~Speckner,
%``A Tool Box for Implementing Supersymmetric Models,''
Comput.\ Phys.\ Commun.\ {\bf 183}, 2165 (2012)
[arXiv:1109.5147 [hep-ph]].
%%CITATION = ARXIV:1109.5147;%%
%%%%% FeynRules %%%%%
%\cite{Christensen:2008py}
\bibitem{Christensen:2008py}
N.~D.~Christensen and C.~Duhr,
{\em FeynRules - Feynman rules made easy},
Comput.\ Phys.\ Commun.\ {\bf 180}, 1614 (2009)
[arXiv:0806.4194 [hep-ph]].
%%CITATION = ARXIV:0806.4194;%%
%\cite{Christensen:2009jx}
\bibitem{Christensen:2009jx}
N.~D.~Christensen, P.~de Aquino, C.~Degrande, C.~Duhr, B.~Fuks,
M.~Herquet, F.~Maltoni and S.~Schumann,
{\em A Comprehensive approach to new physics simulations},
Eur.\ Phys.\ J.\ C {\bf 71}, 1541 (2011)
[arXiv:0906.2474 [hep-ph]].
%%CITATION = ARXIV:0906.2474;%%
%\cite{Duhr:2011se}
\bibitem{Duhr:2011se}
C.~Duhr and B.~Fuks,
%``A superspace module for the FeynRules package,''
Comput.\ Phys.\ Commun.\ {\bf 182}, 2404 (2011)
[arXiv:1102.4191 [hep-ph]].
%%CITATION = ARXIV:1102.4191;%%
%\cite{Christensen:2010wz}
\bibitem{Christensen:2010wz}
N.~D.~Christensen, C.~Duhr, B.~Fuks, J.~Reuter and C.~Speckner,
{\em Introducing an interface between WHIZARD and FeynRules},
Eur.\ Phys.\ J.\ C {\bf 72}, 1990 (2012)
[arXiv:1010.3251 [hep-ph]].
%%CITATION = ARXIV:1010.3251;%%
%\cite{Degrande:2011ua}
\bibitem{Degrande:2011ua}
C.~Degrande, C.~Duhr, B.~Fuks, D.~Grellscheid, O.~Mattelaer and T.~Reiter,
%``UFO - The Universal FeynRules Output,''
Comput.\ Phys.\ Commun.\ {\bf 183}, 1201 (2012)
doi:10.1016/j.cpc.2012.01.022
[arXiv:1108.2040 [hep-ph]].
%%CITATION = doi:10.1016/j.cpc.2012.01.022;%%
%\cite{Han:1998sg}
\bibitem{Han:1998sg}
T.~Han, J.~D.~Lykken and R.~-J.~Zhang,
{\em On Kaluza-Klein states from large extra dimensions},
Phys.\ Rev.\ D {\bf 59}, 105006 (1999)
[hep-ph/9811350].
%%CITATION = HEP-PH/9811350;%%
%\cite{Fuks:2012im}
\bibitem{Fuks:2012im}
B.~Fuks,
{\em Beyond the Minimal Supersymmetric Standard Model: from theory
to phenomenology},
Int.\ J.\ Mod.\ Phys.\ A {\bf 27}, 1230007 (2012)
[arXiv:1202.4769 [hep-ph]].
%%CITATION = ARXIV:1202.4769;%%
%\cite{He:2007ge}
\bibitem{He:2007ge}
H.~-J.~He, Y.~-P.~Kuang, Y.~-H.~Qi, B.~Zhang, A.~Belyaev,
R.~S.~Chivukula, N.~D.~Christensen and A.~Pukhov {\it et al.},
{\em CERN LHC Signatures of New Gauge Bosons in Minimal Higgsless
Model},
Phys.\ Rev.\ D {\bf 78}, 031701 (2008)
[arXiv:0708.2588 [hep-ph]].
%%CITATION = ARXIV:0708.2588;%%
%%%%% WHIZARD NLO %%%%%
%\cite{Kilian:2006cj}
\bibitem{Kilian:2006cj}
W.~Kilian, J.~Reuter and T.~Robens,
{\em NLO Event Generation for Chargino Production at the ILC},
Eur.\ Phys.\ J.\ C {\bf 48}, 389 (2006)
[hep-ph/0607127].
%%CITATION = HEP-PH/0607127;%%
%\cite{Binoth:2010ra}
\bibitem{Binoth:2010ra}
J.~R.~Andersen {\it et al.} [SM and NLO Multileg Working Group
Collaboration],
{\em Les Houches 2009: The SM and NLO Multileg Working Group:
Summary report},
arXiv:1003.1241 [hep-ph].
%%CITATION = ARXIV:1003.1241;%%
%\cite{Butterworth:2010ym}
\bibitem{Butterworth:2010ym}
J.~M.~Butterworth, A.~Arbey, L.~Basso, S.~Belov, A.~Bharucha,
F.~Braam, A.~Buckley and M.~Campanelli {\it et al.},
{\em Les Houches 2009: The Tools and Monte Carlo working group
Summary Report},
arXiv:1003.1643 [hep-ph], arXiv:1003.1643 [hep-ph].
%%CITATION = ARXIV:1003.1643;%%
%\cite{Binoth:2009rv}
\bibitem{Binoth:2009rv}
T.~Binoth, N.~Greiner, A.~Guffanti, J.~Reuter, J.-P.~.Guillet and T.~Reiter,
{\em Next-to-leading order QCD corrections to pp --> b anti-b b
anti-b + X at the LHC: the quark induced case},
Phys.\ Lett.\ B {\bf 685}, 293 (2010)
[arXiv:0910.4379 [hep-ph]].
%%CITATION = ARXIV:0910.4379;%%
%\cite{Greiner:2011mp}
\bibitem{Greiner:2011mp}
N.~Greiner, A.~Guffanti, T.~Reiter and J.~Reuter,
{\em NLO QCD corrections to the production of two bottom-antibottom
pairs at the LHC}
Phys.\ Rev.\ Lett.\ {\bf 107}, 102002 (2011)
[arXiv:1105.3624 [hep-ph]].
%% CITATION = ARXIV:1105.3624;%%
%\cite{L_Ecuyer:2002}
\bibitem{L_Ecuyer:2002}
P.~L\'{e}Ecuyer, R.~Simard, E.~J.~Chen, and W.~D.~Kelton,
{\em An Object-Oriented Random-Number Package with Many Long Streams and
Substreams}
Operations Research, vol. 50, no. 6, pp. 1073-1075, Dec. 2002.
\end{thebibliography}
\end{document}
Index: trunk/ChangeLog
===================================================================
--- trunk/ChangeLog (revision 8157)
+++ trunk/ChangeLog (revision 8158)
@@ -1,1765 +1,1770 @@
ChangeLog -- Summary of changes to the WHIZARD package
Use svn log to see detailed changes.
Version 2.6.4
2018-03-31
RELEASE: version 2.6.4
2018-06-30
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
Bugfix 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
Bugfix 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
Bugfix 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
Bugfix for generator status in LCIO
##################################################################
2016-11-28
RELEASE: version 2.4.0
2016-11-24
Bugfix for OpenLoops interface: EW scheme
is set by WHIZARD
Bugfixes 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
Bugfix 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
Bugfix 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
Bugfix 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
Bugfix 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
Bugfix 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/matrix_elements/matrix_elements.nw
===================================================================
--- trunk/src/matrix_elements/matrix_elements.nw (revision 8157)
+++ trunk/src/matrix_elements/matrix_elements.nw (revision 8158)
@@ -1,10254 +1,10254 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: matrix elements and process libraries
\chapter{Matrix Element Handling}
\includemodulegraph{matrix_elements}
In this chapter, we support internal and external matrix elements:
initialization, automatic generation where necessary, and numerical
evaluation. We provide the interface for code generation and linking.
Matrix-element code is organized in processes and process libraries.
\begin{description}
\item[process\_constants]
A record of static process properties, for easy transfer between
various \whizard\ modules.
\item[prclib\_interfaces]
This module deals with matrix-element code which is accessible via
external libraries (Fortran libraries or generic C-compatible
libraries) and must either be generated by the program or provided
by the user explicitly.
The module defines and uses an abstract type [[prc_writer_t]] and two
abstract extensions, one for a Fortran module and one for a C-compatible
library. The implementation provides the specific methods for writing the
appropriate parts in external matrix element code.
\item[prc\_core\_def]
This module defines the abstract types [[prc_core_def_t]] and
[[prc_driver_t]]. The implementation of the former provides the
configuration for processes of a certain class, while the latter accesses
the corresponding matrix element, in particular those generated by the
appropriate [[prc_writer_t]] object.
\item[process\_libraries]
This module combines the functionality of
the previous module with the means for holding processes definitions
(the internal counterpart of appropriate declarations in the user
interface), for handling matrix elements which do not need external
code, and for accessing the matrix elements by the procedures for
matrix-element evaluation, integration and event generation.
\item[prclib\_stacks]
Collect process libraries.
\item[test\_me] This module provides a test implementation for the abstract
types in the [[prc_core_def]] module. The implementation is intended for
self-tests of several later modules. The implementation is internal, i.e.,
no external code has is generated.
\end{description}
All data structures which are specific for a particular way of
generating code or evaluating matrix element are kept abstract and
thus generic. Later modules such as [[prc_omega]] provide
implementations, in the form of type extensions for the various
abstract types.
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process data block}
We define a simple transparent type that contains universal constant
process data. We will reference objects of this type for the
phase-space setup, for interfacing with process libraries, for
implementing matrix-element generation, and in the master
process-handling module.
<<[[process_constants.f90]]>>=
<<File header>>
module process_constants
<<Use kinds>>
<<Use strings>>
use io_units, only: given_output_unit, free_unit
use format_utils, only: write_integer_array
use md5, only: md5sum
use pdg_arrays
<<Standard module head>>
<<Process Constants: public>>
<<Process Constants: types>>
contains
<<Process Constants: procedures>>
end module process_constants
@ %def process_constants
@
The data type is just a block of public objects, only elementary
types, no type-bound procedures.
<<Process Constants: public>>=
public :: process_constants_t
<<Process Constants: types>>=
type :: process_constants_t
type(string_t) :: id
type(string_t) :: model_name
character(32) :: md5sum = ""
logical :: openmp_supported = .false.
integer :: n_in = 0
integer :: n_out = 0
integer :: n_flv = 0
integer :: n_hel = 0
integer :: n_col = 0
integer :: n_cin = 0
integer :: n_cf = 0
integer, dimension(:,:), allocatable :: flv_state
integer, dimension(:,:), allocatable :: hel_state
integer, dimension(:,:,:), allocatable :: col_state
logical, dimension(:,:), allocatable :: ghost_flag
complex(default), dimension(:), allocatable :: color_factors
integer, dimension(:,:), allocatable :: cf_index
contains
<<Process Constants: process constants: TBP>>
end type process_constants_t
@ %def process_constants_t
@
<<Process Constants: process constants: TBP>>=
procedure :: get_n_tot => process_constants_get_n_tot
<<Process Constants: procedures>>=
elemental function process_constants_get_n_tot (prc_const) result (n_tot)
integer :: n_tot
class(process_constants_t), intent(in) :: prc_const
n_tot = prc_const%n_in + prc_const%n_out
end function process_constants_get_n_tot
@ %def process_constants_get_n_tot
@
<<Process Constants: process constants: TBP>>=
procedure :: get_flv_state => process_constants_get_flv_state
<<Process Constants: procedures>>=
subroutine process_constants_get_flv_state (prc_const, flv_state)
class(process_constants_t), intent(in) :: prc_const
integer, dimension(:,:), allocatable, intent(out) :: flv_state
allocate (flv_state (size (prc_const%flv_state, 1), &
size (prc_const%flv_state, 2)))
flv_state = prc_const%flv_state
end subroutine process_constants_get_flv_state
@ %def process_constants_get_flv_state
@
<<Process Constants: process constants: TBP>>=
procedure :: get_n_flv => process_constants_get_n_flv
<<Process Constants: procedures>>=
function process_constants_get_n_flv (data) result (n_flv)
integer :: n_flv
class(process_constants_t), intent(in) :: data
n_flv = data%n_flv
end function process_constants_get_n_flv
@ %def process_constants_get_n_flv
@
<<Process Constants: process constants: TBP>>=
procedure :: get_n_hel => process_constants_get_n_hel
<<Process Constants: procedures>>=
function process_constants_get_n_hel (data) result (n_hel)
integer :: n_hel
class(process_constants_t), intent(in) :: data
n_hel = data%n_hel
end function process_constants_get_n_hel
@ %def process_constants_get_n_flv
@
<<Process Constants: process constants: TBP>>=
procedure :: get_hel_state => process_constants_get_hel_state
<<Process Constants: procedures>>=
subroutine process_constants_get_hel_state (prc_const, hel_state)
class(process_constants_t), intent(in) :: prc_const
integer, dimension(:,:), allocatable, intent(out) :: hel_state
allocate (hel_state (size (prc_const%hel_state, 1), &
size (prc_const%hel_state, 2)))
hel_state = prc_const%hel_state
end subroutine process_constants_get_hel_state
@ %def process_constants_get_hel_state
@
<<Process Constants: process constants: TBP>>=
procedure :: get_col_state => process_constants_get_col_state
<<Process Constants: procedures>>=
subroutine process_constants_get_col_state (prc_const, col_state)
class(process_constants_t), intent(in) :: prc_const
integer, dimension(:,:,:), allocatable, intent(out) :: col_state
allocate (col_state (size (prc_const%col_state, 1), &
size (prc_const%col_state, 2), size (prc_const%col_state, 3)))
col_state = prc_const%col_state
end subroutine process_constants_get_col_state
@ %def process_constants_get_col_state
@
<<Process Constants: process constants: TBP>>=
procedure :: get_ghost_flag => process_constants_get_ghost_flag
<<Process Constants: procedures>>=
subroutine process_constants_get_ghost_flag (prc_const, ghost_flag)
class(process_constants_t), intent(in) :: prc_const
logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
allocate (ghost_flag (size (prc_const%ghost_flag, 1), &
size (prc_const%ghost_flag, 2)))
ghost_flag = prc_const%ghost_flag
end subroutine process_constants_get_ghost_flag
@ %def process_constants_get_ghost_flag
@
<<Process Constants: process constants: TBP>>=
procedure :: get_color_factors => process_constants_get_color_factors
<<Process Constants: procedures>>=
subroutine process_constants_get_color_factors (prc_const, col_facts)
class(process_constants_t), intent(in) :: prc_const
complex(default), dimension(:), allocatable, intent(out) :: col_facts
allocate (col_facts (size (prc_const%color_factors)))
col_facts = prc_const%color_factors
end subroutine process_constants_get_color_factors
@ %def process_constants_get_color_factors
@
<<Process Constants: process constants: TBP>>=
procedure :: get_cf_index => process_constants_get_cf_index
<<Process Constants: procedures>>=
subroutine process_constants_get_cf_index (prc_const, cf_index)
class(process_constants_t), intent(in) :: prc_const
integer, intent(out), dimension(:,:), allocatable :: cf_index
allocate (cf_index (size (prc_const%cf_index, 1), &
size (prc_const%cf_index, 2)))
cf_index = prc_const%cf_index
end subroutine process_constants_get_cf_index
@ %def process_constants_get_cf_index
@
<<Process Constants: process constants: TBP>>=
procedure :: set_flv_state => process_constants_set_flv_state
<<Process Constants: procedures>>=
subroutine process_constants_set_flv_state (prc_const, flv_state)
class(process_constants_t), intent(inout) :: prc_const
integer, intent(in), dimension(:,:), allocatable :: flv_state
if (allocated (prc_const%flv_state)) deallocate (prc_const%flv_state)
allocate (prc_const%flv_state (size (flv_state, 1), &
size (flv_state, 2)))
prc_const%flv_state = flv_state
prc_const%n_flv = size (flv_state, 2)
end subroutine process_constants_set_flv_state
@ %def process_constants_set_flv_state
@
<<Process Constants: process constants: TBP>>=
procedure :: set_col_state => process_constants_set_col_state
<<Process Constants: procedures>>=
subroutine process_constants_set_col_state (prc_const, col_state)
class(process_constants_t), intent(inout) :: prc_const
integer, intent(in), dimension(:,:,:), allocatable :: col_state
allocate (prc_const%col_state (size (col_state, 1), &
size (col_state, 2), size (col_state, 3)))
prc_const%col_state = col_state
end subroutine process_constants_set_col_state
@ %def process_constants_set_col_state
@
<<Process Constants: process constants: TBP>>=
procedure :: set_cf_index => process_constants_set_cf_index
<<Process Constants: procedures>>=
subroutine process_constants_set_cf_index (prc_const, cf_index)
class(process_constants_t), intent(inout) :: prc_const
integer, dimension(:,:), intent(in), allocatable :: cf_index
allocate (prc_const%cf_index (size (cf_index, 1), &
size (cf_index, 2)))
prc_const%cf_index = cf_index
end subroutine process_constants_set_cf_index
@ %def process_constants_set_cf_index
@
<<Process Constants: process constants: TBP>>=
procedure :: set_color_factors => process_constants_set_color_factors
<<Process Constants: procedures>>=
subroutine process_constants_set_color_factors (prc_const, color_factors)
class(process_constants_t), intent(inout) :: prc_const
complex(default), dimension(:), intent(in), allocatable :: color_factors
allocate (prc_const%color_factors (size (color_factors)))
prc_const%color_factors = color_factors
end subroutine process_constants_set_color_factors
@ %def process_constants_set_color_factors
@
<<Process Constants: process constants: TBP>>=
procedure :: set_ghost_flag => process_constants_set_ghost_flag
<<Process Constants: procedures>>=
subroutine process_constants_set_ghost_flag (prc_const, ghost_flag)
class(process_constants_t), intent(inout) :: prc_const
logical, dimension(:,:), allocatable, intent(in) :: ghost_flag
allocate (prc_const%ghost_flag (size (ghost_flag, 1), &
size (ghost_flag, 2)))
prc_const%ghost_flag = ghost_flag
end subroutine process_constants_set_ghost_flag
@ %def process_constants_set_ghost_flag
@
<<Process Constants: process constants: TBP>>=
procedure :: get_pdg_in => process_constants_get_pdg_in
<<Process Constants: procedures>>=
function process_constants_get_pdg_in (prc_const) result (pdg_in)
type(pdg_array_t), dimension(:), allocatable :: pdg_in
class(process_constants_t), intent(in) :: prc_const
type(pdg_array_t) :: pdg_tmp
integer :: i
allocate (pdg_in (prc_const%n_in))
do i = 1, prc_const%n_in
pdg_tmp = prc_const%flv_state(i,:)
pdg_in(i) = sort_abs (pdg_tmp, unique = .true.)
end do
end function process_constants_get_pdg_in
@ %def process_constants_get_pdg_in
@
<<Process Constants: process constants: TBP>>=
procedure :: compute_md5sum => process_constants_compute_md5sum
<<Process Constants: procedures>>=
subroutine process_constants_compute_md5sum (prc_const, include_id)
class(process_constants_t), intent(inout) :: prc_const
logical, intent(in) :: include_id
integer :: unit
unit = prc_const%fill_unit_for_md5sum (include_id)
rewind (unit)
prc_const%md5sum = md5sum (unit)
close (unit)
end subroutine process_constants_compute_md5sum
@ %process_constants_compute_md5sum
@
<<Process Constants: process constants: TBP>>=
procedure :: fill_unit_for_md5sum => process_constants_fill_unit_for_md5sum
<<Process Constants: procedures>>=
function process_constants_fill_unit_for_md5sum (prc_const, include_id) result (unit)
integer :: unit
class(process_constants_t), intent(in) :: prc_const
logical, intent(in) :: include_id
integer :: i, j, k
unit = free_unit ()
open (unit, status="scratch", action="readwrite")
if (include_id) write (unit, '(A)') char (prc_const%id)
write (unit, '(A)') char (prc_const%model_name)
write (unit, '(L1)') prc_const%openmp_supported
write (unit, '(I0)') prc_const%n_in
write (unit, '(I0)') prc_const%n_out
write (unit, '(I0)') prc_const%n_flv
write (unit, '(I0)') prc_const%n_hel
write (unit, '(I0)') prc_const%n_col
write (unit, '(I0)') prc_const%n_cin
write (unit, '(I0)') prc_const%n_cf
do i = 1, size (prc_const%flv_state, dim=1)
do j = 1, size (prc_const%flv_state, dim=2)
write (unit, '(I0)') prc_const%flv_state (i, j)
end do
end do
do i = 1, size (prc_const%hel_state, dim=1)
do j = 1, size (prc_const%hel_state, dim=2)
write (unit, '(I0)') prc_const%hel_state (i, j)
end do
end do
do i = 1, size (prc_const%col_state, dim=1)
do j = 1, size (prc_const%col_state, dim=2)
do k = 1, size (prc_const%col_state, dim=3)
write (unit, '(I0)') prc_const%col_state (i, j, k)
end do
end do
end do
do i = 1, size (prc_const%ghost_flag, dim=1)
do j = 1, size (prc_const%ghost_flag, dim=2)
write (unit, '(L1)') prc_const%ghost_flag (i, j)
end do
end do
do i = 1, size (prc_const%color_factors)
write (unit, '(F0.0,F0.0)') real (prc_const%color_factors(i)), &
aimag (prc_const%color_factors(i))
end do
do i = 1, size (prc_const%cf_index, dim=1)
do j = 1, size (prc_const%cf_index, dim=2)
write (unit, '(I0)') prc_const%cf_index(i, j)
end do
end do
end function process_constants_fill_unit_for_md5sum
@ %def process_constants_fill_unit_for_md5sum
@
<<Process Constants: process constants: TBP>>=
procedure :: write => process_constants_write
<<Process Constants: procedures>>=
subroutine process_constants_write (prc_const, unit)
class(process_constants_t), intent(in) :: prc_const
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A,A)") "Process data of id: ", char (prc_const%id)
write (u, "(1x,A,A)") "Associated model: ", char (prc_const%model_name)
write (u, "(1x,A,I0)") "n_in: ", prc_const%n_in
write (u, "(1x,A,I0)") "n_out: ", prc_const%n_out
write (u, "(1x,A,I0)") "n_flv: ", prc_const%n_flv
write (u, "(1x,A,I0)") "n_hel: ", prc_const%n_hel
write (u, "(1x,A,I0)") "n_col: ", prc_const%n_col
write (u, "(1x,A,I0)") "n_cin: ", prc_const%n_cin
write (u, "(1x,A,I0)") "n_cf: ", prc_const%n_cf
write (u, "(1x,A)") "Flavors: "
do i = 1, prc_const%n_flv
write (u, "(1x,A,I0)") "i_flv: ", i
call write_integer_array (prc_const%flv_state (:,i))
end do
end subroutine process_constants_write
@ %def process_constants_write
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process library interface}
The module [[prclib_interfaces]] handles external matrix-element code.
\subsection{Overview}
The top-level data structure is the [[prclib_driver_t]] data type.
The associated type-bound procedures deal with the generation of
external code, compilation and linking, and accessing the active
external library.
An object of type [[prclib_driver_t]] consists of the following parts:
\begin{enumerate}
\item\ Metadata that identify name and status of the library driver,
etc.
\item\ An array of process records ([[prclib_driver_record_t]]), one
for each external matrix element.
\item\ A record of type [[dlaccess_t]] which handles the
operating-system part of linking a dynamically loadable library.
\item\ A collection of procedure pointers which have a counterpart in
the external library interface. Given the unique identifier of a
matrix element, the procedures retrieve generic matrix-element
information such as the particle content and helicity combination
tables. There is also a procedure which returns pointers to the
more specific procedures that a matrix element provides, called
\emph{features}.
\end{enumerate}
The process records of type [[prclib_driver_record_t]] handle the
individual matrix elements. Each record identifies a process by name
([[id]]), names the physics model to be loaded for this process, lists
the features that the associated matrix-element code provides, and
holds a [[writer]] object which handles all operations that depend on
the process type. The numbering of process records is identical to
the numbering of matrix-element codes in the external library.
The writer object is of abstract type [[prc_writer_t]]. The module
defines two basic, also abstract, extensions:
[[prc_writer_f_module_t]] and [[prc_writer_c_lib_t]]. The first
version is for matrix-element code that is available in form of
Fortran modules. The writer contains type-bound procedures which
create appropriate [[use]] directives and [[C]]-compatible wrapper
functions for the given set of Fortran modules and their features.
The second version is for matrix-element code that is available in
form of a C-compatible library (this includes Fortran libraries with
proper C bindings). The writer needs not write wrapper function, but
explicit interface blocks for the matrix-element features.
Each matrix-element variant is encoded in an appropriate extension of
[[prc_writer_t]]. For instance, \oMega\ matrix elements provide an
implementation [[omega_writer_t]] which extends
[[prc_writer_f_module_t]].
\subsection{Workflow}
We expect that the functionality provided by this module is called in
the following order:
\begin{enumerate}
\item
The caller initializes the [[prclib_driver_t]] object and fills the
array of [[prclib_record_t]] entries with the appropriate process
data and process-specific writer objects.
\item
It calls the [[generate_makefile]] method to set up an appropriate
makefile in the current directory. The makefile will handle source
generation, compilation and linking both for the individual matrix
elements (unless this has to be done manually) and for the common
external driver code which interfaces those matrix element.
\item
The [[generate_driver_code]] writes the common driver as source code
to file.
\item
The methods [[make_source]], [[make_compile]], and [[make_link]]
individually perform the corresponding steps in building the
library. Wherever possible, they simply use the generated makefile.
By calling [[make]], we make sure that we can avoid
unnecessary recompilation. For the
compilation and linking steps, the makefile will employ [[libtool]].
\item
The [[load]] method loads the library procedures into the
corresponding procedure pointers, using the [[dlopen]] mechanism via
the [[dlaccess]] subobject.
\end{enumerate}
\subsection{The module}
<<[[prclib_interfaces.f90]]>>=
<<File header>>
module prclib_interfaces
use, intrinsic :: iso_c_binding !NODEP!
use kinds
<<Use strings>>
use io_units
use system_defs, only: TAB
use string_utils, only: lower_case
use diagnostics
use os_interface
<<Standard module head>>
<<Prclib interfaces: public>>
<<Prclib interfaces: types>>
<<Prclib interfaces: interfaces>>
contains
<<Prclib interfaces: procedures>>
end module prclib_interfaces
@ %def prclib_interfaces
@
\subsection{Writers}
External matrix element code provides externally visible procedures,
which we denote as \emph{features}. The features consist of
informational subroutines and functions which are mandatory (universal
features) and matrix-element specific subroutines and functions
(specific features). The driver interfaces the
generic features directly, while it returns the specific features in
form of bind(C) procedure pointers to the caller. For instance,
function [[n_in]] is generic, while the matrix matrix-element value
itself is specific.
To implement these tasks, the driver needs [[use]] directives for
Fortran module procedures, interface blocks for other external stuff,
wrapper code, and Makefile snippets.
\subsubsection{Generic writer}
In the [[prc_writer_t]] data type, we collect the procedures which
implement the writing tasks. The type is abstract. The
concrete implementations are defined by an extension which is specific
for the process type.
The MD5 sum stored here should be the MD5 checksum of the current process
component, which can be calculated once the process is configured completely.
It can be used by implementations which work with external files, such as
\oMega.
<<Prclib interfaces: public>>=
public :: prc_writer_t
<<Prclib interfaces: types>>=
type, abstract :: prc_writer_t
character(32) :: md5sum = ""
contains
<<Prclib interfaces: prc writer: TBP>>
end type prc_writer_t
@ %def prc_writer_t
@ In any case, it is useful to have a string representation of the
writer type. This must be implemented by all extensions.
<<Prclib interfaces: prc writer: TBP>>=
procedure(get_const_string), nopass, deferred :: type_name
<<Prclib interfaces: interfaces>>=
abstract interface
function get_const_string () result (string)
import
type(string_t) :: string
end function get_const_string
end interface
@ %def get_const_string
@ Return the name of a procedure that implements a given feature, as
it is provided by the external matrix-element code. For a reasonable
default, we take the feature name unchanged.
<<Prclib interfaces: prc writer: TBP>>=
procedure, nopass :: get_procname => prc_writer_get_procname
<<Prclib interfaces: procedures>>=
function prc_writer_get_procname (feature) result (name)
type(string_t) :: name
type(string_t), intent(in) :: feature
name = feature
end function prc_writer_get_procname
@ %def prc_writer_get_procname
@ Return the name of a procedure that implements a given feature with
the bind(C) property, so it can be accessed via a C procedure pointer and
handled by dlopen. We need this for all special features of a matrix
element, since the interface has to return a C function pointer for it.
For a default implementation, we prefix the external procedure name by
the process ID.
<<Prclib interfaces: prc writer: TBP>>=
procedure :: get_c_procname => prc_writer_get_c_procname
<<Prclib interfaces: procedures>>=
function prc_writer_get_c_procname (writer, id, feature) result (name)
class(prc_writer_t), intent(in) :: writer
type(string_t), intent(in) :: id, feature
type(string_t) :: name
name = id // "_" // feature
end function prc_writer_get_c_procname
@ %def get_c_procname
@ Common signature of code-writing procedures. The procedure may
use the process ID, and the feature name.
(Not necessarily all of them.)
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine write_code_file (writer, id)
import
class(prc_writer_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine write_code_file
end interface
abstract interface
subroutine write_code (writer, unit, id)
import
class(prc_writer_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
end subroutine write_code
end interface
abstract interface
subroutine write_code_os (writer, unit, id, os_data, verbose, testflag)
import
class(prc_writer_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
end subroutine write_code_os
end interface
abstract interface
subroutine write_feature_code (writer, unit, id, feature)
import
class(prc_writer_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
end subroutine write_feature_code
end interface
@ %def write_code write_feature_code
@ There must be a procedure which writes an interface block for a
given feature. If the external matrix element is implemented as a
Fortran module, this is required only for the specific features which
are returned as procedure pointers.
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_feature_code), deferred :: write_interface
@ %def write_interface
@ There must also be a procedure which writes Makefile code which is
specific for the current process, but not the feature.
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code_os), deferred :: write_makefile_code
@ %def write_makefile_code
@ This procedure writes code process-specific source-code file
(which need not be Fortran). It is called before [[make]] [[source]] is
called. It may be a no-op, if the source code is
generated by Make instead.
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code_file), deferred :: write_source_code
@ %def write_source_code
@ This procedure is executed, once for each process, before (after)
[[make]] [[compile]] is called, respectively.
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code_file), deferred :: before_compile
procedure(write_code_file), deferred :: after_compile
@ %def before_compile
@ %def after_compile
@
\subsubsection{Writer for Fortran-module matrix elements}
If the matrix element is available as a Fortran module, we have
specific requirements: (i) the features are imported via [[use]]
directives, (ii) the specific features require bind(C) wrappers.
The type is still abstract, all methods must be implemented explicitly
for a specific matrix-element variant.
<<Prclib interfaces: public>>=
public :: prc_writer_f_module_t
<<Prclib interfaces: types>>=
type, extends (prc_writer_t), abstract :: prc_writer_f_module_t
contains
<<Prclib interfaces: prc writer f module: TBP>>
end type prc_writer_f_module_t
@ %def prc_writer_f_module_t
@ Return the name of the Fortran module. As a default
implementation, we take the process ID unchanged.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure, nopass :: get_module_name => prc_writer_get_module_name
<<Prclib interfaces: procedures>>=
function prc_writer_get_module_name (id) result (name)
type(string_t) :: name
type(string_t), intent(in) :: id
name = id
end function prc_writer_get_module_name
@ %def prc_writer_get_module_name
@ Write a [[use]] directive that associates the driver reference with
the procedure in the matrix element code. By default, we use the C
name for this.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_use_line => prc_writer_write_use_line
<<Prclib interfaces: procedures>>=
subroutine prc_writer_write_use_line (writer, unit, id, feature)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t) :: id, feature
write (unit, "(2x,9A)") "use ", char (writer%get_module_name (id)), &
", only: ", char (writer%get_c_procname (id, feature)), &
" => ", char (writer%get_procname (feature))
end subroutine prc_writer_write_use_line
@ %def prc_writer_write_use_line
@ Write a wrapper routine for a feature. This also associates a C
name the module procedure. The details depend on the writer variant.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure(prc_write_wrapper), deferred :: write_wrapper
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_write_wrapper (writer, unit, id, feature)
import
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
end subroutine prc_write_wrapper
end interface
@ %def prc_write_wrapper
@ This is used for testing only: initialize the writer with a specific MD5 sum
string.
<<Prclib interfaces: prc writer: TBP>>=
procedure :: init_test => prc_writer_init_test
<<Prclib interfaces: procedures>>=
subroutine prc_writer_init_test (writer)
class(prc_writer_t), intent(out) :: writer
writer%md5sum = "1234567890abcdef1234567890abcdef"
end subroutine prc_writer_init_test
@ %def prc_writer_init_test
@
\subsubsection{Writer for C-library matrix elements}
This applies if the matrix element is available as a C library or a Fortran
library with bind(C) compatible interface. We can use the basic
version.
The type is still abstract, all methods must be implemented explicitly
for a specific matrix-element variant.
<<Prclib interfaces: public>>=
public :: prc_writer_c_lib_t
<<Prclib interfaces: types>>=
type, extends (prc_writer_t), abstract :: prc_writer_c_lib_t
contains
<<Prclib interfaces: prc writer c lib: TBP>>
end type prc_writer_c_lib_t
@ %def prc_writer_c_lib_t
@
\subsection{Process records in the library driver}
A process record holds the process (component) [[ID]], the physics
[[model_name]], and the array of [[feature]]s that are
implemented by the corresponding matrix element code.
The [[writer]] component holds procedures. The procedures write
source code for the current record, either for the driver or for the
Makefile.
<<Prclib interfaces: types>>=
type :: prclib_driver_record_t
type(string_t) :: id
type(string_t) :: model_name
type(string_t), dimension(:), allocatable :: feature
class(prc_writer_t), pointer :: writer => null ()
contains
<<Prclib interfaces: prclib driver record: TBP>>
end type prclib_driver_record_t
@ %def prclib_driver_record
@ Output routine. We indent the output, so it smoothly integrates
into the output routine for the whole driver.
Note: the pointer [[writer]] is introduced as a workaround for a NAG compiler
bug.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write => prclib_driver_record_write
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write (object, unit)
class(prclib_driver_record_t), intent(in) :: object
integer, intent(in) :: unit
integer :: j
class(prc_writer_t), pointer :: writer
write (unit, "(3x,A,2x,'[',A,']')") &
char (object%id), char (object%model_name)
if (allocated (object%feature)) then
writer => object%writer
write (unit, "(5x,A,A)", advance="no") &
char (writer%type_name ()), ":"
do j = 1, size (object%feature)
write (unit, "(1x,A)", advance="no") &
char (object%feature(j))
end do
write (unit, *)
end if
end subroutine prclib_driver_record_write
@ %def prclib_driver_record_write
@ Get the C procedure name for a feature.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: get_c_procname => prclib_driver_record_get_c_procname
<<Prclib interfaces: procedures>>=
function prclib_driver_record_get_c_procname (record, feature) result (name)
type(string_t) :: name
class(prclib_driver_record_t), intent(in) :: record
type(string_t), intent(in) :: feature
name = record%writer%get_c_procname (record%id, feature)
end function prclib_driver_record_get_c_procname
@ %def prclib_driver_record_get_c_procname
@ Write a USE directive for a given feature. Applies only if the
record corresponds to a Fortran module.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_use_line => prclib_driver_record_write_use_line
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_use_line (record, unit, feature)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
type(string_t), intent(in) :: feature
select type (writer => record%writer)
class is (prc_writer_f_module_t)
call writer%write_use_line (unit, record%id, feature)
end select
end subroutine prclib_driver_record_write_use_line
@ %def prclib_driver_record_write_use_line
@ The alternative: write an interface block for a given feature,
unless the record corresponds to a Fortran module.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_interface => prclib_driver_record_write_interface
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_interface (record, unit, feature)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
type(string_t), intent(in) :: feature
select type (writer => record%writer)
class is (prc_writer_f_module_t)
class default
call writer%write_interface (unit, record%id, feature)
end select
end subroutine prclib_driver_record_write_interface
@ %def prclib_driver_record_write_use_line
@ Write all special feature interfaces for the current record. Do
this for all process variants.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_interfaces => prclib_driver_record_write_interfaces
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_interfaces (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
integer :: i
do i = 1, size (record%feature)
call record%writer%write_interface (unit, record%id, record%feature(i))
end do
end subroutine prclib_driver_record_write_interfaces
@ %def prclib_driver_record_write_interfaces
@ Write the wrapper routines for this record, if it corresponds to a
Fortran module.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_wrappers => prclib_driver_record_write_wrappers
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_wrappers (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
integer :: i
select type (writer => record%writer)
class is (prc_writer_f_module_t)
do i = 1, size (record%feature)
call writer%write_wrapper (unit, record%id, record%feature(i))
end do
end select
end subroutine prclib_driver_record_write_wrappers
@ %def prclib_driver_record_write_wrappers
@ Write the Makefile code for this record.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_makefile_code => prclib_driver_record_write_makefile_code
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_makefile_code &
(record, unit, os_data, verbose, testflag)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
call record%writer%write_makefile_code &
(unit, record%id, os_data, verbose, testflag)
end subroutine prclib_driver_record_write_makefile_code
@ %def prclib_driver_record_write_makefile_code
@ Write source-code files for this record. This can be used as an alternative
to handling source code via Makefile. In fact, this procedure is executed
before [[make]] [[source]] is called. Usually, does nothing.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_source_code => prclib_driver_record_write_source_code
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_source_code (record)
class(prclib_driver_record_t), intent(in) :: record
call record%writer%write_source_code (record%id)
end subroutine prclib_driver_record_write_source_code
@ %def prclib_driver_record_write_source_code
@ Execute commands for this record that depend on the sources, so they
cannot be included in the previous procedure. This procedure is
executed before (after) [[make]] [[compile]] is called, respectively.
Usually, does nothing.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: before_compile => prclib_driver_record_before_compile
procedure :: after_compile => prclib_driver_record_after_compile
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_before_compile (record)
class(prclib_driver_record_t), intent(in) :: record
call record%writer%before_compile (record%id)
end subroutine prclib_driver_record_before_compile
subroutine prclib_driver_record_after_compile (record)
class(prclib_driver_record_t), intent(in) :: record
call record%writer%after_compile (record%id)
end subroutine prclib_driver_record_after_compile
@ %def prclib_driver_record_before_compile
@ %def prclib_driver_record_after_compile
@
\subsection{The process library driver object}
A [[prclib_driver_t]] object provides the interface to external matrix element
code. The code is provided by an external library which is either
statically or dynamically linked.
The dynamic and static versions of the library are two different
implementations of the abstract base type.
The [[basename]] identifies the library, both by file names and by Fortran
variable names.
The [[loaded]] flag becomes true once all procedure pointers to the
matrix element have been assigned.
For a dynamical external library, the communication proceeds via a
[[dlaccess]] object.
[[n_processes]] is the number of external process code components that
are referenced by this library. The code is addressed by index ([[i_lib]]
in the process library entry above). This number should be equal to
the number returned by [[get_n_prc]].
For each external process, there is a separate [[record]] which holds
the data that are needed for the driver parts which are specific
for a given process component. The actual pointers for the loaded
library will be assigned elsewhere.
The remainder is a collection of procedure pointers, which can be
assigned once all external code has been compiled and linked.
The procedure pointers all take a process component code
index as an argument. Most return information about the process
component that should match the process definition. The [[get_fptr]]
procedures return a function pointer, which is the actual means to
compute matrix elements or retrieve associated data.
Finally, the [[unload_hook]] and [[reload_hook]] pointers allow for
the insertion of additional code when a library is loaded.
<<Prclib interfaces: public>>=
public :: prclib_driver_t
<<Prclib interfaces: types>>=
type, abstract :: prclib_driver_t
type(string_t) :: basename
character(32) :: md5sum = ""
logical :: loaded = .false.
type(string_t) :: libname
type(string_t) :: modellibs_ldflags
integer :: n_processes = 0
type(prclib_driver_record_t), dimension(:), allocatable :: record
procedure(prc_get_n_processes), nopass, pointer :: &
get_n_processes => null ()
procedure(prc_get_stringptr), nopass, pointer :: &
get_process_id_ptr => null ()
procedure(prc_get_stringptr), nopass, pointer :: &
get_model_name_ptr => null ()
procedure(prc_get_stringptr), nopass, pointer :: &
get_md5sum_ptr => null ()
procedure(prc_get_log), nopass, pointer :: &
get_openmp_status => null ()
procedure(prc_get_int), nopass, pointer :: get_n_in => null ()
procedure(prc_get_int), nopass, pointer :: get_n_out => null ()
procedure(prc_get_int), nopass, pointer :: get_n_flv => null ()
procedure(prc_get_int), nopass, pointer :: get_n_hel => null ()
procedure(prc_get_int), nopass, pointer :: get_n_col => null ()
procedure(prc_get_int), nopass, pointer :: get_n_cin => null ()
procedure(prc_get_int), nopass, pointer :: get_n_cf => null ()
procedure(prc_set_int_tab1), nopass, pointer :: &
set_flv_state_ptr => null ()
procedure(prc_set_int_tab1), nopass, pointer :: &
set_hel_state_ptr => null ()
procedure(prc_set_col_state), nopass, pointer :: &
set_col_state_ptr => null ()
procedure(prc_set_color_factors), nopass, pointer :: &
set_color_factors_ptr => null ()
procedure(prc_get_fptr), nopass, pointer :: get_fptr => null ()
contains
<<Prclib interfaces: prclib driver: TBP>>
end type prclib_driver_t
@ %def prclib_driver_t
@ This is the dynamic version. It contains a [[dlaccess]] object for
communicating with the OS.
<<Prclib interfaces: public>>=
public :: prclib_driver_dynamic_t
<<Prclib interfaces: types>>=
type, extends (prclib_driver_t) :: prclib_driver_dynamic_t
type(dlaccess_t) :: dlaccess
contains
<<Prclib interfaces: prclib driver dynamic: TBP>>
end type prclib_driver_dynamic_t
@ %def prclib_driver_dynamic_t
@ Print just the metadata. Procedure pointers cannot be printed.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write => prclib_driver_write
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_write (object, unit, libpath)
class(prclib_driver_t), intent(in) :: object
integer, intent(in) :: unit
logical, intent(in), optional :: libpath
logical :: write_lib
integer :: i
write_lib = .true.
if (present (libpath)) write_lib = libpath
write (unit, "(1x,A,A)") &
"External matrix-element code library: ", char (object%basename)
select type (object)
type is (prclib_driver_dynamic_t)
write (unit, "(3x,A,L1)") "static = F"
class default
write (unit, "(3x,A,L1)") "static = T"
end select
write (unit, "(3x,A,L1)") "loaded = ", object%loaded
write (unit, "(3x,A,A,A)") "MD5 sum = '", object%md5sum, "'"
if (write_lib) then
write (unit, "(3x,A,A,A)") "Mdl flags = '", &
char (object%modellibs_ldflags), "'"
end if
select type (object)
type is (prclib_driver_dynamic_t)
write (unit, *)
call object%dlaccess%write (unit)
end select
write (unit, *)
if (allocated (object%record)) then
write (unit, "(1x,A)") "Matrix-element code entries:"
do i = 1, object%n_processes
call object%record(i)%write (unit)
end do
else
write (unit, "(1x,A)") "Matrix-element code entries: [undefined]"
end if
end subroutine prclib_driver_write
@ %def prclib_driver_write
@ Allocate a library as either static or dynamic. For static
libraries, the procedure defers control to an external procedure which
knows about the available static libraries. By default, this
procedure is empty, but when we build a stand-alone executable, we
replace the dummy by an actual dispatcher for the available
static libraries. If the static dispatcher was not successful, we
allocate a dynamic library.
The default version of [[dispatch_prclib_static]] resides in the
[[prebuilt]] section of the \whizard\ tree, in a separate
library. It does nothing, but can be replaced by a different
procedure that allocates a static library driver if requested by name.
Note: [[intent(out)]] for the [[driver]] argument segfaults with
gfortran 4.7.
<<Prclib interfaces: public>>=
public :: dispatch_prclib_driver
<<Prclib interfaces: procedures>>=
subroutine dispatch_prclib_driver &
(driver, basename, modellibs_ldflags)
class(prclib_driver_t), intent(inout), allocatable :: driver
type(string_t), intent(in) :: basename
type(string_t), intent(in), optional :: modellibs_ldflags
procedure(dispatch_prclib_driver) :: dispatch_prclib_static
if (allocated (driver)) deallocate (driver)
call dispatch_prclib_static (driver, basename)
if (.not. allocated (driver)) then
allocate (prclib_driver_dynamic_t :: driver)
end if
driver%basename = basename
driver%modellibs_ldflags = modellibs_ldflags
end subroutine dispatch_prclib_driver
@ %def dispatch_prclib_driver
@ Initialize the ID array and set [[n_processes]] accordingly.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: init => prclib_driver_init
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_init (driver, n_processes)
class(prclib_driver_t), intent(inout) :: driver
integer, intent(in) :: n_processes
driver%n_processes = n_processes
allocate (driver%record (n_processes))
end subroutine prclib_driver_init
@ %def prclib_driver_init
@ Set the MD5 sum. This is separate because the MD5 sum may be known only
after initialization.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_md5sum => prclib_driver_set_md5sum
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_set_md5sum (driver, md5sum)
class(prclib_driver_t), intent(inout) :: driver
character(32), intent(in) :: md5sum
driver%md5sum = md5sum
end subroutine prclib_driver_set_md5sum
@ %def prclib_driver_set_md5sum
@ Set the process record for a specific library entry. If the index
is zero, we do nothing.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_record => prclib_driver_set_record
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_set_record (driver, i, &
id, model_name, features, writer)
class(prclib_driver_t), intent(inout) :: driver
integer, intent(in) :: i
type(string_t), intent(in) :: id
type(string_t), intent(in) :: model_name
type(string_t), dimension(:), intent(in) :: features
class(prc_writer_t), intent(in), pointer :: writer
if (i > 0) then
associate (record => driver%record(i))
record%id = id
record%model_name = model_name
allocate (record%feature (size (features)))
record%feature = features
record%writer => writer
end associate
end if
end subroutine prclib_driver_set_record
@ %def prclib_driver_set_record
@ Write all USE directives for a given feature, scanning the array of
processes. Only Fortran-module processes count. Then, write
interface blocks for the remaining processes.
The [[implicit none]] statement must go in-between.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_interfaces => prclib_driver_write_interfaces
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_write_interfaces (driver, unit, feature)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: feature
integer :: i
do i = 1, driver%n_processes
call driver%record(i)%write_use_line (unit, feature)
end do
write (unit, "(2x,9A)") "implicit none"
do i = 1, driver%n_processes
call driver%record(i)%write_interface (unit, feature)
end do
end subroutine prclib_driver_write_interfaces
@ %def prclib_driver_write_interfaces
@
\subsection{Write makefile}
The makefile contains constant parts, parts that depend on the library
name, and parts that depend on the specific processes and their types.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: generate_makefile => prclib_driver_generate_makefile
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_generate_makefile (driver, unit, os_data, verbose, testflag)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
integer :: i
write (unit, "(A)") "# WHIZARD: Makefile for process library '" &
// char (driver%basename) // "'"
write (unit, "(A)") "# Automatically generated file, do not edit"
write (unit, "(A)") ""
write (unit, "(A)") "# Integrity check (don't modify the following line!)"
write (unit, "(A)") "MD5SUM = '" // driver%md5sum // "'"
write (unit, "(A)") ""
write (unit, "(A)") "# Library name"
write (unit, "(A)") "BASE = " // char (driver%basename)
write (unit, "(A)") ""
write (unit, "(A)") "# Compiler"
write (unit, "(A)") "FC = " // char (os_data%fc)
write (unit, "(A)") "CC = " // char (os_data%cc)
write (unit, "(A)") ""
write (unit, "(A)") "# Included libraries"
write (unit, "(A)") "FCINCL = " // char (os_data%whizard_includes)
write (unit, "(A)") ""
write (unit, "(A)") "# Compiler flags"
write (unit, "(A)") "FCFLAGS = " // char (os_data%fcflags)
write (unit, "(A)") "FCFLAGS_PIC = " // char (os_data%fcflags_pic)
write (unit, "(A)") "CFLAGS = " // char (os_data%cflags)
write (unit, "(A)") "CFLAGS_PIC = " // char (os_data%cflags_pic)
write (unit, "(A)") "LDFLAGS = " // char (os_data%whizard_ldflags) &
// " " // char (os_data%ldflags) // " " // &
char (driver%modellibs_ldflags)
write (unit, "(A)") ""
write (unit, "(A)") "# LaTeX setup"
write (unit, "(A)") "LATEX = " // char (os_data%latex)
write (unit, "(A)") "MPOST = " // char (os_data%mpost)
write (unit, "(A)") "DVIPS = " // char (os_data%dvips)
write (unit, "(A)") "PS2PDF = " // char (os_data%ps2pdf)
write (unit, "(A)") 'TEX_FLAGS = "$$TEXINPUTS:' // &
char(os_data%whizard_texpath) // '"'
write (unit, "(A)") 'MP_FLAGS = "$$MPINPUTS:' // &
char(os_data%whizard_texpath) // '"'
write (unit, "(A)") ""
write (unit, "(A)") "# Libtool"
write (unit, "(A)") "LIBTOOL = " // char (os_data%whizard_libtool)
if (verbose) then
write (unit, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
write (unit, "(A)") "CCOMPILE = $(LIBTOOL) --tag=CC --mode=compile"
write (unit, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
else
write (unit, "(A)") "FCOMPILE = @$(LIBTOOL) --silent --tag=FC --mode=compile"
write (unit, "(A)") "CCOMPILE = @$(LIBTOOL) --silent --tag=CC --mode=compile"
write (unit, "(A)") "LINK = @$(LIBTOOL) --silent --tag=FC --mode=link"
end if
write (unit, "(A)") ""
write (unit, "(A)") "# Compile commands (default)"
write (unit, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c &
&$(FCINCL) $(FCFLAGS) $(FCFLAGS_PIC)"
write (unit, "(A)") "LTCCOMPILE = $(CCOMPILE) $(CC) -c &
&$(CFLAGS) $(CFLAGS_PIC)"
write (unit, "(A)") ""
write (unit, "(A)") "# Default target"
write (unit, "(A)") "all: link diags"
write (unit, "(A)") ""
write (unit, "(A)") "# Matrix-element code files"
do i = 1, size (driver%record)
call driver%record(i)%write_makefile_code (unit, os_data, verbose, testflag)
end do
write (unit, "(A)") ""
write (unit, "(A)") "# Library driver"
write (unit, "(A)") "$(BASE).lo: $(BASE).f90 $(OBJECTS)"
write (unit, "(A)") TAB // "$(LTFCOMPILE) $<"
if (.not. verbose) then
write (unit, "(A)") TAB // '@echo " FC " $@'
end if
write (unit, "(A)") ""
write (unit, "(A)") "# Library"
write (unit, "(A)") "$(BASE).la: $(BASE).lo $(OBJECTS)"
if (.not. verbose) then
write (unit, "(A)") TAB // '@echo " FCLD " $@'
end if
write (unit, "(A)") TAB // "$(LINK) $(FC) -module -rpath /dev/null &
&$(FCFLAGS) $(LDFLAGS) -o $(BASE).la $^"
write (unit, "(A)") ""
write (unit, "(A)") "# Main targets"
write (unit, "(A)") "link: compile $(BASE).la"
write (unit, "(A)") "compile: source $(OBJECTS) $(TEX_OBJECTS) $(BASE).lo"
write (unit, "(A)") "compile_tex: $(TEX_OBJECTS)"
write (unit, "(A)") "source: $(SOURCES) $(BASE).f90 $(TEX_SOURCES)"
write (unit, "(A)") ".PHONY: link diags compile compile_tex source"
write (unit, "(A)") ""
write (unit, "(A)") "# Specific cleanup targets"
do i = 1, size (driver%record)
write (unit, "(A)") "clean-" // char (driver%record(i)%id) // ":"
write (unit, "(A)") ".PHONY: clean-" // char (driver%record(i)%id)
end do
write (unit, "(A)") ""
write (unit, "(A)") "# Generic cleanup targets"
write (unit, "(A)") "clean-library:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(BASE).la"
else
write (unit, "(A)") TAB // '@echo " RM $(BASE).la"'
write (unit, "(A)") TAB // "@rm -f $(BASE).la"
end if
write (unit, "(A)") "clean-objects:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(BASE).lo $(BASE)_driver.mod &
&$(CLEAN_OBJECTS)"
else
write (unit, "(A)") TAB // '@echo " RM $(BASE).lo &
&$(BASE)_driver.mod $(CLEAN_OBJECTS)"'
write (unit, "(A)") TAB // "@rm -f $(BASE).lo $(BASE)_driver.mod &
&$(CLEAN_OBJECTS)"
end if
write (unit, "(A)") "clean-source:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(CLEAN_SOURCES)"
else
write (unit, "(A)") TAB // '@echo " RM $(CLEAN_SOURCES)"'
write (unit, "(A)") TAB // "@rm -f $(CLEAN_SOURCES)"
end if
write (unit, "(A)") "clean-driver:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(BASE).f90"
else
write (unit, "(A)") TAB // '@echo " RM $(BASE).f90"'
write (unit, "(A)") TAB // "@rm -f $(BASE).f90"
end if
write (unit, "(A)") "clean-makefile:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(BASE).makefile"
else
write (unit, "(A)") TAB // '@echo " RM $(BASE).makefile"'
write (unit, "(A)") TAB // "@rm -f $(BASE).makefile"
end if
write (unit, "(A)") ".PHONY: clean-library clean-objects &
&clean-source clean-driver clean-makefile"
write (unit, "(A)") ""
write (unit, "(A)") "clean: clean-library clean-objects clean-source"
write (unit, "(A)") "distclean: clean clean-driver clean-makefile"
write (unit, "(A)") ".PHONY: clean distclean"
end subroutine prclib_driver_generate_makefile
@ %def prclib_driver_generate_makefile
@
\subsection{Write driver file}
This procedure writes the process library driver source code to the
specified output unit. The individual routines for writing
source-code procedures are given below.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: generate_driver_code => prclib_driver_generate_code
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_generate_code (driver, unit)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t) :: prefix
integer :: i
prefix = driver%basename // "_"
write (unit, "(A)") "! WHIZARD matrix-element code interface"
write (unit, "(A)") "!"
write (unit, "(A)") "! Automatically generated file, do not edit"
call driver%write_module (unit, prefix)
call driver%write_lib_md5sum_fun (unit, prefix)
call driver%write_get_n_processes_fun (unit, prefix)
call driver%write_get_process_id_fun (unit, prefix)
call driver%write_get_model_name_fun (unit, prefix)
call driver%write_get_md5sum_fun (unit, prefix)
call driver%write_string_to_array_fun (unit, prefix)
call driver%write_get_openmp_status_fun (unit, prefix)
call driver%write_get_int_fun (unit, prefix, var_str ("n_in"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_out"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_flv"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_hel"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_col"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_cin"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_cf"))
call driver%write_set_int_sub (unit, prefix, var_str ("flv_state"))
call driver%write_set_int_sub (unit, prefix, var_str ("hel_state"))
call driver%write_set_col_state_sub (unit, prefix)
call driver%write_set_color_factors_sub (unit, prefix)
call driver%write_get_fptr_sub (unit, prefix)
do i = 1, driver%n_processes
call driver%record(i)%write_wrappers (unit)
end do
end subroutine prclib_driver_generate_code
@ %def prclib_driver_generate_code
@ The driver module is used and required \emph{only} if we intend to
link the library statically. Then, it provides the (static) driver
type as a concrete implementation of the abstract library driver.
This type contains the internal dispatcher for assigning the library
procedures to their appropriate procedure pointers. In the dynamical
case, the assignment is done via the base-type dispatcher which invokes
the DL mechanism.
However, compiling this together with the rest in any case should not
do any harm.
<<Prclib interfaces: prclib driver: TBP>>=
procedure, nopass :: write_module => prclib_driver_write_module
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_write_module (unit, prefix)
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(A)") ""
write (unit, "(A)") "! Module: define library driver as an extension &
&of the abstract driver type."
write (unit, "(A)") "! This is used _only_ by the library dispatcher &
&of a static executable."
write (unit, "(A)") "! For a dynamical library, the stand-alone proce&
&dures are linked via libdl."
write (unit, "(A)") ""
write (unit, "(A)") "module " &
// char (prefix) // "driver"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " use iso_varying_string, string_t => varying_string"
write (unit, "(A)") " use diagnostics"
write (unit, "(A)") " use prclib_interfaces"
write (unit, "(A)") ""
write (unit, "(A)") " implicit none"
write (unit, "(A)") ""
write (unit, "(A)") " type, extends (prclib_driver_t) :: " &
// char (prefix) // "driver_t"
write (unit, "(A)") " contains"
write (unit, "(A)") " procedure :: get_c_funptr => " &
// char (prefix) // "driver_get_c_funptr"
write (unit, "(A)") " end type " &
// char (prefix) // "driver_t"
write (unit, "(A)") ""
write (unit, "(A)") "contains"
write (unit, "(A)") ""
write (unit, "(A)") " function " &
// char (prefix) // "driver_get_c_funptr (driver, feature) result &
&(c_fptr)"
write (unit, "(A)") " class(" &
// char (prefix) // "driver_t), intent(inout) :: driver"
write (unit, "(A)") " type(string_t), intent(in) :: feature"
write (unit, "(A)") " type(c_funptr) :: c_fptr"
call write_decl ("get_n_processes", "get_n_processes")
call write_decl ("get_stringptr", "get_process_id_ptr")
call write_decl ("get_stringptr", "get_model_name_ptr")
call write_decl ("get_stringptr", "get_md5sum_ptr")
call write_decl ("get_log", "get_openmp_status")
call write_decl ("get_int", "get_n_in")
call write_decl ("get_int", "get_n_out")
call write_decl ("get_int", "get_n_flv")
call write_decl ("get_int", "get_n_hel")
call write_decl ("get_int", "get_n_col")
call write_decl ("get_int", "get_n_cin")
call write_decl ("get_int", "get_n_cf")
call write_decl ("set_int_tab1", "set_flv_state_ptr")
call write_decl ("set_int_tab1", "set_hel_state_ptr")
call write_decl ("set_col_state", "set_col_state_ptr")
call write_decl ("set_color_factors", "set_color_factors_ptr")
call write_decl ("get_fptr", "get_fptr")
write (unit, "(A)") " select case (char (feature))"
call write_case ("get_n_processes")
call write_case ("get_process_id_ptr")
call write_case ("get_model_name_ptr")
call write_case ("get_md5sum_ptr")
call write_case ("get_openmp_status")
call write_case ("get_n_in")
call write_case ("get_n_out")
call write_case ("get_n_flv")
call write_case ("get_n_hel")
call write_case ("get_n_col")
call write_case ("get_n_cin")
call write_case ("get_n_cf")
call write_case ("set_flv_state_ptr")
call write_case ("set_hel_state_ptr")
call write_case ("set_col_state_ptr")
call write_case ("set_color_factors_ptr")
call write_case ("get_fptr")
write (unit, "(A)") " case default"
write (unit, "(A)") " call msg_bug ('prclib2 driver setup: unknown &
&function name')"
write (unit, "(A)") " end select"
write (unit, "(A)") " end function " &
// char (prefix) // "driver_get_c_funptr"
write (unit, "(A)") ""
write (unit, "(A)") "end module " &
// char (prefix) // "driver"
write (unit, "(A)") ""
write (unit, "(A)") "! Stand-alone external procedures: used for both &
&static and dynamic linkage"
contains
subroutine write_decl (template, feature)
character(*), intent(in) :: template, feature
write (unit, "(A)") " procedure(prc_" // template // ") &"
write (unit, "(A)") " :: " &
// char (prefix) // feature
end subroutine write_decl
subroutine write_case (feature)
character(*), intent(in) :: feature
write (unit, "(A)") " case ('" // feature // "')"
write (unit, "(A)") " c_fptr = c_funloc (" &
// char (prefix) // feature // ")"
end subroutine write_case
end subroutine prclib_driver_write_module
@ %def prclib_driver_write_module
@ This function provides the overall library MD5sum. The function is for
internal use (therefore not bind(C)), the external interface is via the
[[get_md5sum_ptr]] procedure with index 0.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_lib_md5sum_fun => prclib_driver_write_lib_md5sum_fun
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_write_lib_md5sum_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(A)") ""
write (unit, "(A)") "! The MD5 sum of the library"
write (unit, "(A)") "function " // char (prefix) &
// "md5sum () result (md5sum)"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " character(32) :: md5sum"
write (unit, "(A)") " md5sum = '" // driver%md5sum // "'"
write (unit, "(A)") "end function " // char (prefix) // "md5sum"
end subroutine prclib_driver_write_lib_md5sum_fun
@ %def prclib_driver_write_lib_md5sum_fun
@
\subsection{Interface bodies for informational functions}
These interfaces implement the communication between WHIZARD (the main
program) and the process-library driver. The procedures are all
BIND(C), so they can safely be exposed by the library and handled by
the [[dlopen]] mechanism, which apparently understands only C calling
conventions.
In the sections below, for each procedure, we provide both the
interface itself and a procedure that writes the correponding
procedure as source code to the process library driver.
\subsubsection{Process count}
Return the number of processes contained in the library.
<<Prclib interfaces: public>>=
public :: prc_get_n_processes
<<Prclib interfaces: interfaces>>=
abstract interface
function prc_get_n_processes () result (n) bind(C)
import
integer(c_int) :: n
end function prc_get_n_processes
end interface
@ %def prc_get_n_processes
@ Here is the code.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_n_processes_fun
<<Prclib interfaces: procedures>>=
subroutine write_get_n_processes_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(A)") ""
write (unit, "(A)") "! Return the number of processes in this library"
write (unit, "(A)") "function " // char (prefix) &
// "get_n_processes () result (n) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " integer(c_int) :: n"
write (unit, "(A,I0)") " n = ", driver%n_processes
write (unit, "(A)") "end function " // char (prefix) &
// "get_n_processes"
end subroutine write_get_n_processes_fun
@ %def write_get_n_processes_fun
@
\subsubsection{Informational string functions}
These functions return constant information about the matrix-element
code.
The following procedures have to return strings. With the BIND(C)
constraint, we choose to return the C pointer to a string, and its
length, so the procedures implement this interface. They are actually
subroutines.
<<Prclib interfaces: public>>=
public :: prc_get_stringptr
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_get_stringptr (i, cptr, len) bind(C)
import
integer(c_int), intent(in) :: i
type(c_ptr), intent(out) :: cptr
integer(c_int), intent(out) :: len
end subroutine prc_get_stringptr
end interface
@ %def prc_get_stringptr
@ To hide this complication, we introduce a subroutine that converts the
returned C pointer to a [[string_t]] object. As a side effect, we
deallocate the original after conversion -- otherwise, we might have a
memory leak.
For the conversion, we first pointer-convert the C pointer to a
Fortran character array pointer, length 1 and size [[len]]. Using
argument association and an internal subroutine, we convert this to a
character array with length [[len]] and size 1. Using ordinary
assignment, we finally convert this to [[string_t]].
The function takes the pointer-returning function as an argument. The
index [[i]] identifies the process in the library.
<<Prclib interfaces: procedures>>=
subroutine get_string_via_cptr (string, i, get_stringptr)
type(string_t), intent(out) :: string
integer, intent(in) :: i
procedure(prc_get_stringptr) :: get_stringptr
type(c_ptr) :: cptr
integer(c_int) :: pid, len
character(kind=c_char), dimension(:), pointer :: c_array
pid = i
call get_stringptr (pid, cptr, len)
if (c_associated (cptr)) then
call c_f_pointer (cptr, c_array, shape = [len])
call set_string (c_array)
call get_stringptr (0_c_int, cptr, len)
else
string = ""
end if
contains
subroutine set_string (buffer)
character(len, kind=c_char), dimension(1), intent(in) :: buffer
string = buffer(1)
end subroutine set_string
end subroutine get_string_via_cptr
@ %def get_string_via_cptr
@ Since the module procedures return Fortran strings, we have to
convert them. This is the necessary auxiliary routine. The routine
is not BIND(C), it is not accessed from outside.
<<Prclib interfaces: prclib driver: TBP>>=
procedure, nopass :: write_string_to_array_fun
<<Prclib interfaces: procedures>>=
subroutine write_string_to_array_fun (unit, prefix)
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(A)") ""
write (unit, "(A)") "! Auxiliary: convert character string &
&to array pointer"
write (unit, "(A)") "subroutine " // char (prefix) &
// "string_to_array (string, a)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " character(*), intent(in) :: string"
write (unit, "(A)") " character(kind=c_char), dimension(:), &
&allocatable, intent(out) :: a"
write (unit, "(A)") " integer :: i"
write (unit, "(A)") " allocate (a (len (string)))"
write (unit, "(A)") " do i = 1, size (a)"
write (unit, "(A)") " a(i) = string(i:i)"
write (unit, "(A)") " end do"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "string_to_array"
end subroutine write_string_to_array_fun
@ %def write_string_to_array_fun
@ The above routine is called by other functions. It is not in a
module, so they need its interface explicitly.
<<Prclib interfaces: procedures>>=
subroutine write_string_to_array_interface (unit, prefix)
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(2x,A)") "interface"
write (unit, "(2x,A)") " subroutine " // char (prefix) &
// "string_to_array (string, a)"
write (unit, "(2x,A)") " use iso_c_binding"
write (unit, "(2x,A)") " implicit none"
write (unit, "(2x,A)") " character(*), intent(in) :: string"
write (unit, "(2x,A)") " character(kind=c_char), dimension(:), &
&allocatable, intent(out) :: a"
write (unit, "(2x,A)") " end subroutine " // char (prefix) &
// "string_to_array"
write (unit, "(2x,A)") "end interface"
end subroutine write_string_to_array_interface
@ %def write_string_to_array_interface
@
Here are the info functions which return strings, implementing the interface
[[prc_get_stringptr]].
Return the process ID for each process.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_process_id_fun
<<Prclib interfaces: procedures>>=
subroutine write_get_process_id_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
write (unit, "(A)") ""
write (unit, "(A)") "! Return the process ID of process #i &
&(as a C pointer to a character array)"
write (unit, "(A)") "subroutine " // char (prefix) &
// "get_process_id_ptr (i, cptr, len) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
write (unit, "(A)") " integer(c_int), intent(out) :: len"
write (unit, "(A)") " character(kind=c_char), dimension(:), &
&allocatable, target, save :: a"
call write_string_to_array_interface (unit, prefix)
write (unit, "(A)") " select case (i)"
write (unit, "(A)") " case (0); if (allocated (a)) deallocate (a)"
do i = 1, driver%n_processes
write (unit, "(A,I0,9A)") " case (", i, "); ", &
"call ", char (prefix), "string_to_array ('", &
char (driver%record(i)%id), "', a)"
end do
write (unit, "(A)") " end select"
write (unit, "(A)") " if (allocated (a)) then"
write (unit, "(A)") " cptr = c_loc (a)"
write (unit, "(A)") " len = size (a)"
write (unit, "(A)") " else"
write (unit, "(A)") " cptr = c_null_ptr"
write (unit, "(A)") " len = 0"
write (unit, "(A)") " end if"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "get_process_id_ptr"
end subroutine write_get_process_id_fun
@ %def write_get_process_id_fun
@ Return the model name, given explicitly.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_model_name_fun
<<Prclib interfaces: procedures>>=
subroutine write_get_model_name_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
write (unit, "(A)") ""
write (unit, "(A)") "! Return the model name for process #i &
&(as a C pointer to a character array)"
write (unit, "(A)") "subroutine " // char (prefix) &
// "get_model_name_ptr (i, cptr, len) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
write (unit, "(A)") " integer(c_int), intent(out) :: len"
write (unit, "(A)") " character(kind=c_char), dimension(:), &
&allocatable, target, save :: a"
call write_string_to_array_interface (unit, prefix)
write (unit, "(A)") " select case (i)"
write (unit, "(A)") " case (0); if (allocated (a)) deallocate (a)"
do i = 1, driver%n_processes
write (unit, "(A,I0,9A)") " case (", i, "); ", &
"call ", char (prefix), "string_to_array ('" , &
char (driver%record(i)%model_name), &
"', a)"
end do
write (unit, "(A)") " end select"
write (unit, "(A)") " if (allocated (a)) then"
write (unit, "(A)") " cptr = c_loc (a)"
write (unit, "(A)") " len = size (a)"
write (unit, "(A)") " else"
write (unit, "(A)") " cptr = c_null_ptr"
write (unit, "(A)") " len = 0"
write (unit, "(A)") " end if"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "get_model_name_ptr"
end subroutine write_get_model_name_fun
@ %def write_get_model_name_fun
@ Call the MD5 sum function for the process. The function calls the
corresponding function of the matrix-element code, and it returns the
C address of a character array with length 32.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_md5sum_fun
<<Prclib interfaces: procedures>>=
subroutine write_get_md5sum_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
write (unit, "(A)") ""
write (unit, "(A)") "! Return the MD5 sum for the process configuration &
&(as a C pointer to a character array)"
write (unit, "(A)") "subroutine " // char (prefix) &
// "get_md5sum_ptr (i, cptr, len) bind(C)"
write (unit, "(A)") " use iso_c_binding"
call driver%write_interfaces (unit, var_str ("md5sum"))
write (unit, "(A)") " interface"
write (unit, "(A)") " function " // char (prefix) &
// "md5sum () result (md5sum)"
write (unit, "(A)") " character(32) :: md5sum"
write (unit, "(A)") " end function " // char (prefix) // "md5sum"
write (unit, "(A)") " end interface"
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
write (unit, "(A)") " integer(c_int), intent(out) :: len"
write (unit, "(A)") " character(kind=c_char), dimension(32), &
&target, save :: md5sum"
write (unit, "(A)") " select case (i)"
write (unit, "(A)") " case (0)"
write (unit, "(A)") " call copy (" // char (prefix) // "md5sum ())"
write (unit, "(A)") " cptr = c_loc (md5sum)"
do i = 1, driver%n_processes
write (unit, "(A,I0,A)") " case (", i, ")"
call driver%record(i)%write_md5sum_call (unit)
end do
write (unit, "(A)") " case default"
write (unit, "(A)") " cptr = c_null_ptr"
write (unit, "(A)") " end select"
write (unit, "(A)") " len = 32"
write (unit, "(A)") "contains"
write (unit, "(A)") " subroutine copy (md5sum_tmp)"
write (unit, "(A)") " character, dimension(32), intent(in) :: &
&md5sum_tmp"
write (unit, "(A)") " md5sum = md5sum_tmp"
write (unit, "(A)") " end subroutine copy"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "get_md5sum_ptr"
end subroutine write_get_md5sum_fun
@ %def write_get_md5sum_fun
@ The actual call depends on the type of matrix element.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_md5sum_call => prclib_driver_record_write_md5sum_call
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_md5sum_call (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
call record%writer%write_md5sum_call (unit, record%id)
end subroutine prclib_driver_record_write_md5sum_call
@ %def prclib_driver_record_write_md5sum_call
@ The interface goes into the writer base type:
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code), deferred :: write_md5sum_call
@ %def write_md5sum_call
@ In the Fortran module case, we take a detour. The string returned
by the Fortran function is copied into a fixed-size array. The copy
routine is an internal subroutine of [[get_md5sum_ptr]]. We
return the C address of the target array.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_md5sum_call => prc_writer_f_module_write_md5sum_call
<<Prclib interfaces: procedures>>=
subroutine prc_writer_f_module_write_md5sum_call (writer, unit, id)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "call copy (", &
char (writer%get_c_procname (id, var_str ("md5sum"))), " ())"
write (unit, "(5x,9A)") "cptr = c_loc (md5sum)"
end subroutine prc_writer_f_module_write_md5sum_call
@ %def prc_writer_f_module_write_md5sum_call
@ In the C library case, the library function returns a C pointer,
which we can just copy.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_md5sum_call => prc_writer_c_lib_write_md5sum_call
<<Prclib interfaces: procedures>>=
subroutine prc_writer_c_lib_write_md5sum_call (writer, unit, id)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") &
"cptr = ", &
char (writer%get_c_procname (id, var_str ("get_md5sum"))), " ()"
end subroutine prc_writer_c_lib_write_md5sum_call
@ %def prc_writer_c_lib_write_md5sum_call
@
\subsubsection{Actual references to the info functions}
The string-valued info functions return C character arrays. For the
API of the library driver, we provide convenience functions which
(re)convert those arrays into [[string_t]] objects.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: get_process_id => prclib_driver_get_process_id
procedure :: get_model_name => prclib_driver_get_model_name
procedure :: get_md5sum => prclib_driver_get_md5sum
<<Prclib interfaces: procedures>>=
function prclib_driver_get_process_id (driver, i) result (string)
type(string_t) :: string
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
call get_string_via_cptr (string, i, driver%get_process_id_ptr)
end function prclib_driver_get_process_id
function prclib_driver_get_model_name (driver, i) result (string)
type(string_t) :: string
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
call get_string_via_cptr (string, i, driver%get_model_name_ptr)
end function prclib_driver_get_model_name
function prclib_driver_get_md5sum (driver, i) result (string)
type(string_t) :: string
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
call get_string_via_cptr (string, i, driver%get_md5sum_ptr)
end function prclib_driver_get_md5sum
@ %def prclib_driver_get_process_id
@ %def prclib_driver_get_model_name
@ %def prclib_driver_get_md5sum
@
\subsubsection{Informational logical functions}
When returning a logical value, we use the C boolean type, which
may differ from Fortran.
<<Prclib interfaces: public>>=
public :: prc_get_log
<<Prclib interfaces: interfaces>>=
abstract interface
function prc_get_log (pid) result (l) bind(C)
import
integer(c_int), intent(in) :: pid
logical(c_bool) :: l
end function prc_get_log
end interface
@ %def prc_get_log
@ Return a logical flag which tells whether OpenMP is supported for a
specific process code.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_openmp_status_fun
<<Prclib interfaces: procedures>>=
subroutine write_get_openmp_status_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
write (unit, "(A)") ""
write (unit, "(A)") "! Return the OpenMP support status"
write (unit, "(A)") "function " // char (prefix) &
// "get_openmp_status (i) result (openmp_status) bind(C)"
write (unit, "(A)") " use iso_c_binding"
call driver%write_interfaces (unit, var_str ("openmp_supported"))
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " logical(c_bool) :: openmp_status"
write (unit, "(A)") " select case (i)"
do i = 1, driver%n_processes
write (unit, "(A,I0,9A)") " case (", i, "); ", &
"openmp_status = ", &
char (driver%record(i)%get_c_procname &
(var_str ("openmp_supported"))), " ()"
end do
write (unit, "(A)") " end select"
write (unit, "(A)") "end function " // char (prefix) &
// "get_openmp_status"
end subroutine write_get_openmp_status_fun
@ %def write_get_openmp_status_fun
@
\subsubsection{Informational integer functions}
Various process metadata are integer values. We can use a single
interface for all of them.
<<Prclib interfaces: public>>=
public :: prc_get_int
<<Prclib interfaces: interfaces>>=
abstract interface
function prc_get_int (pid) result (n) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int) :: n
end function prc_get_int
end interface
@ %def prc_get_int
@ This function returns any data of type integer, for each process.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_int_fun
<<Prclib interfaces: procedures>>=
subroutine write_get_int_fun (driver, unit, prefix, feature)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
type(string_t), intent(in) :: feature
integer :: i
write (unit, "(A)") ""
write (unit, "(9A)") "! Return the value of ", char (feature)
write (unit, "(9A)") "function ", char (prefix), &
"get_", char (feature), " (pid)", &
" result (", char (feature), ") bind(C)"
write (unit, "(9A)") " use iso_c_binding"
call driver%write_interfaces (unit, feature)
write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
write (unit, "(9A)") " integer(c_int) :: ", char (feature)
write (unit, "(9A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(2x,A,I0,9A)") "case (", i, "); ", &
char (feature), " = ", &
char (driver%record(i)%get_c_procname (feature)), &
" ()"
end do
write (unit, "(9A)") " end select"
write (unit, "(9A)") "end function ", char (prefix), &
"get_", char (feature)
end subroutine write_get_int_fun
@ %def write_get_int_fun
@ Write a [[case]] line that assigns the value of the external function
to the current return value.
<<Prclib interfaces: procedures>>=
subroutine write_case_int_fun (record, unit, i, feature)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
integer, intent(in) :: i
type(string_t), intent(in) :: feature
write (unit, "(5x,A,I0,9A)") "case (", i, "); ", &
char (feature), " = ", char (record%get_c_procname (feature))
end subroutine write_case_int_fun
@ %def write_case_int_fun
@
\subsubsection{Flavor and helicity tables}
Transferring tables is more complicated. First, a two-dimensional array.
<<Prclib interfaces: public>>=
public :: prc_set_int_tab1
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_set_int_tab1 (pid, tab, shape) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int), dimension(*), intent(out) :: tab
integer(c_int), dimension(2), intent(in) :: shape
end subroutine prc_set_int_tab1
end interface
@ %def prc_set_int_tab1
@ This subroutine returns a table of integers.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_set_int_sub
<<Prclib interfaces: procedures>>=
subroutine write_set_int_sub (driver, unit, prefix, feature)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
type(string_t), intent(in) :: feature
integer :: i
write (unit, "(A)") ""
write (unit, "(9A)") "! Set table: ", char (feature)
write (unit, "(9A)") "subroutine ", char (prefix), &
"set_", char (feature), "_ptr (pid, ", char (feature), &
", shape) bind(C)"
write (unit, "(9A)") " use iso_c_binding"
call driver%write_interfaces (unit, feature)
write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
write (unit, "(9A)") " integer(c_int), dimension(*), intent(out) :: ", &
char (feature)
write (unit, "(9A)") " integer(c_int), dimension(2), intent(in) :: shape"
write (unit, "(9A)") " integer, dimension(:,:), allocatable :: ", &
char (feature), "_tmp"
write (unit, "(9A)") " integer :: i, j"
write (unit, "(9A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(2x,A,I0,A)") "case (", i, ")"
call driver%record(i)%write_int_sub_call (unit, feature)
end do
write (unit, "(9A)") " end select"
write (unit, "(9A)") "end subroutine ", char (prefix), &
"set_", char (feature), "_ptr"
end subroutine write_set_int_sub
@ %def write_set_int_sub
@ The actual call depends on the type of matrix element.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_int_sub_call => prclib_driver_record_write_int_sub_call
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_int_sub_call (record, unit, feature)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
type(string_t), intent(in) :: feature
call record%writer%write_int_sub_call (unit, record%id, feature)
end subroutine prclib_driver_record_write_int_sub_call
@ %def prclib_driver_record_write_int_sub_call
@ The interface goes into the writer base type:
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_feature_code), deferred :: write_int_sub_call
@ %def write_int_sub_call
@ In the Fortran module case, we need an extra copy in the
(academical) situation where default integer and [[c_int]] differ.
Otherwise, we just associate a Fortran array with the C pointer and
let the matrix-element subroutine fill the array.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_int_sub_call => prc_writer_f_module_write_int_sub_call
<<Prclib interfaces: procedures>>=
subroutine prc_writer_f_module_write_int_sub_call (writer, unit, id, feature)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(5x,9A)") "allocate (", char (feature), "_tmp ", &
"(shape(1), shape(2)))"
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, feature)), &
" (", char (feature), "_tmp)"
write (unit, "(5x,9A)") "forall (i=1:shape(1), j=1:shape(2)) "
write (unit, "(8x,9A)") char (feature), "(i + shape(1)*(j-1)) = ", &
char (feature), "_tmp", "(i,j)"
write (unit, "(5x,9A)") "end forall"
end subroutine prc_writer_f_module_write_int_sub_call
@ %def prc_writer_f_module_write_int_sub_call
@ In the C library case, we just transfer the C pointer to the library
function.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_int_sub_call => prc_writer_c_lib_write_int_sub_call
<<Prclib interfaces: procedures>>=
subroutine prc_writer_c_lib_write_int_sub_call (writer, unit, id, feature)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, feature)), " (", char (feature), ")"
end subroutine prc_writer_c_lib_write_int_sub_call
@ %def prc_writer_c_lib_write_int_sub_call
@
\subsubsection{Color state table}
The color-state specification needs a table of integers (one array per
color flow) and a corresponding array of color-ghost flags.
<<Prclib interfaces: public>>=
public :: prc_set_col_state
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_set_col_state (pid, col_state, ghost_flag, shape) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int), dimension(*), intent(out) :: col_state
logical(c_bool), dimension(*), intent(out) :: ghost_flag
integer(c_int), dimension(3), intent(in) :: shape
end subroutine prc_set_col_state
end interface
@ %def prc_set_int_tab2
@
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_set_col_state_sub
<<Prclib interfaces: procedures>>=
subroutine write_set_col_state_sub (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
type(string_t) :: feature
feature = "col_state"
write (unit, "(A)") ""
write (unit, "(9A)") "! Set tables: col_state, ghost_flag"
write (unit, "(9A)") "subroutine ", char (prefix), &
"set_col_state_ptr (pid, col_state, ghost_flag, shape) bind(C)"
write (unit, "(9A)") " use iso_c_binding"
call driver%write_interfaces (unit, feature)
write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
write (unit, "(9A)") &
" integer(c_int), dimension(*), intent(out) :: col_state"
write (unit, "(9A)") &
" logical(c_bool), dimension(*), intent(out) :: ghost_flag"
write (unit, "(9A)") &
" integer(c_int), dimension(3), intent(in) :: shape"
write (unit, "(9A)") &
" integer, dimension(:,:,:), allocatable :: col_state_tmp"
write (unit, "(9A)") &
" logical, dimension(:,:), allocatable :: ghost_flag_tmp"
write (unit, "(9A)") " integer :: i, j, k"
write (unit, "(A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(A,I0,A)") " case (", i, ")"
call driver%record(i)%write_col_state_call (unit)
end do
write (unit, "(A)") " end select"
write (unit, "(9A)") "end subroutine ", char (prefix), &
"set_col_state_ptr"
end subroutine write_set_col_state_sub
@ %def write_set_col_state_sub
@ The actual call depends on the type of matrix element.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_col_state_call => prclib_driver_record_write_col_state_call
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_col_state_call (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
call record%writer%write_col_state_call (unit, record%id)
end subroutine prclib_driver_record_write_col_state_call
@ %def prclib_driver_record_write_col_state_call
@ The interface goes into the writer base type:
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code), deferred :: write_col_state_call
@ %def write_col_state_call
@ In the Fortran module case, we need an extra copy in the
(academical) situation where default integer and [[c_int]] differ.
Otherwise, we just associate a Fortran array with the C pointer and
let the matrix-element subroutine fill the array.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_col_state_call => prc_writer_f_module_write_col_state_call
<<Prclib interfaces: procedures>>=
subroutine prc_writer_f_module_write_col_state_call (writer, unit, id)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(9A)") " allocate (col_state_tmp ", &
"(shape(1), shape(2), shape(3)))"
write (unit, "(5x,9A)") "allocate (ghost_flag_tmp ", &
"(shape(2), shape(3)))"
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, var_str ("col_state"))), &
" (col_state_tmp, ghost_flag_tmp)"
write (unit, "(5x,9A)") "forall (i = 1:shape(2), j = 1:shape(3))"
write (unit, "(8x,9A)") "forall (k = 1:shape(1))"
write (unit, "(11x,9A)") &
"col_state(k + shape(1) * (i + shape(2)*(j-1) - 1)) ", &
"= col_state_tmp(k,i,j)"
write (unit, "(8x,9A)") "end forall"
write (unit, "(8x,9A)") &
"ghost_flag(i + shape(2)*(j-1)) = ghost_flag_tmp(i,j)"
write (unit, "(5x,9A)") "end forall"
end subroutine prc_writer_f_module_write_col_state_call
@ %def prc_writer_f_module_write_col_state_call
@ In the C library case, we just transfer the C pointer to the library
function.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_col_state_call => prc_writer_c_lib_write_col_state_call
<<Prclib interfaces: procedures>>=
subroutine prc_writer_c_lib_write_col_state_call (writer, unit, id)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, var_str ("col_state"))), &
" (col_state, ghost_flag)"
end subroutine prc_writer_c_lib_write_col_state_call
@ %def prc_writer_c_lib_write_col_state_call
@
\subsubsection{Color factors}
For the color-factor information, we return two integer arrays and a
complex array.
<<Prclib interfaces: public>>=
public :: prc_set_color_factors
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_set_color_factors &
(pid, cf_index1, cf_index2, color_factors, shape) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int), dimension(*), intent(out) :: cf_index1, cf_index2
complex(c_default_complex), dimension(*), intent(out) :: color_factors
integer(c_int), dimension(1), intent(in) :: shape
end subroutine prc_set_color_factors
end interface
@ %def prc_set_color_factors
@ This subroutine returns the color-flavor factor table.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_set_color_factors_sub
<<Prclib interfaces: procedures>>=
subroutine write_set_color_factors_sub (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
type(string_t) :: feature
feature = "color_factors"
write (unit, "(A)") ""
write (unit, "(A)") "! Set tables: color factors"
write (unit, "(9A)") "subroutine ", char (prefix), &
"set_color_factors_ptr (pid, cf_index1, cf_index2, color_factors, ", &
"shape) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " use kinds"
write (unit, "(A)") " use omega_color"
call driver%write_interfaces (unit, feature)
write (unit, "(A)") " integer(c_int), intent(in) :: pid"
write (unit, "(A)") " integer(c_int), dimension(1), intent(in) :: shape"
write (unit, "(A)") " integer(c_int), dimension(*), intent(out) :: &
&cf_index1, cf_index2"
write (unit, "(A)") " complex(c_default_complex), dimension(*), &
&intent(out) :: color_factors"
write (unit, "(A)") " type(omega_color_factor), dimension(:), &
&allocatable :: cf"
write (unit, "(A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(2x,A,I0,A)") "case (", i, ")"
call driver%record(i)%write_color_factors_call (unit)
end do
write (unit, "(A)") " end select"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "set_color_factors_ptr"
end subroutine write_set_color_factors_sub
@ %def write_set_color_factors_sub
@ The actual call depends on the type of matrix element.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_color_factors_call => prclib_driver_record_write_color_factors_call
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_record_write_color_factors_call (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
call record%writer%write_color_factors_call (unit, record%id)
end subroutine prclib_driver_record_write_color_factors_call
@ %def prclib_driver_record_write_color_factors_call
@ The interface goes into the writer base type:
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code), deferred :: write_color_factors_call
@ %def write_color_factors_call
@ In the Fortran module case, the matrix-element procedure fills an
array of [[omega_color_factor]] elements. We distribute this array
among two integer arrays and one complex-valued array, for which we
have the C pointers.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_color_factors_call => prc_writer_f_module_write_color_factors_call
<<Prclib interfaces: procedures>>=
subroutine prc_writer_f_module_write_color_factors_call (writer, unit, id)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,A)") "allocate (cf (shape(1)))"
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, var_str ("color_factors"))), " (cf)"
write (unit, "(5x,9A)") "cf_index1(1:shape(1)) = cf%i1"
write (unit, "(5x,9A)") "cf_index2(1:shape(1)) = cf%i2"
write (unit, "(5x,9A)") "color_factors(1:shape(1)) = cf%factor"
end subroutine prc_writer_f_module_write_color_factors_call
@ %def prc_writer_f_module_write_color_factors_call
@ In the C library case, we just transfer the C pointers to the library
function. There are three arrays.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_color_factors_call => &
prc_writer_c_lib_write_color_factors_call
<<Prclib interfaces: procedures>>=
subroutine prc_writer_c_lib_write_color_factors_call (writer, unit, id)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, var_str ("color_factors"))), &
" (cf_index1, cf_index2, color_factors)"
end subroutine prc_writer_c_lib_write_color_factors_call
@ %def prc_writer_c_lib_write_color_factors_call
@
\subsection{Interfaces for C-library matrix element}
If the matrix element code is not provided as a Fortran module but as
a C or bind(C) Fortran library, we need explicit interfaces for the
library functions. They are not identical to the Fortran module
versions. They transfer pointers directly.
The implementation is part of the [[prc_writer_c_lib]] type, which
serves as base type for all C-library writers. It writes specific
interfaces depending on the feature.
We bind this as the method [[write_standard_interface]] instead of
[[write_interface]], because we have to override the latter.
Otherwise we could not call the method because the writer type is
abstract.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_standard_interface => prc_writer_c_lib_write_interface
<<Prclib interfaces: procedures>>=
subroutine prc_writer_c_lib_write_interface (writer, unit, id, feature)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
select case (char (feature))
case ("md5sum")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "function ", &
char (writer%get_c_procname (id, var_str ("get_md5sum"))), &
" () result (cptr) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "type(c_ptr) :: cptr"
write (unit, "(5x,9A)") "end function ", &
char (writer%get_c_procname (id, var_str ("get_md5sum")))
write (unit, "(2x,9A)") "end interface"
case ("openmp_supported")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "function ", &
char (writer%get_c_procname (id, feature)), &
" () result (status) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "logical(c_bool) :: status"
write (unit, "(5x,9A)") "end function ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case ("n_in", "n_out", "n_flv", "n_hel", "n_col", "n_cin", "n_cf")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "function ", &
char (writer%get_c_procname (id, feature)), &
" () result (n) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int) :: n"
write (unit, "(5x,9A)") "end function ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case ("flv_state", "hel_state")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (", char (feature), ") bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), dimension(*), intent(out) ", &
":: ", char (feature)
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case ("col_state")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (col_state, ghost_flag) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), dimension(*), intent(out) ", &
":: col_state"
write (unit, "(7x,9A)") "logical(c_bool), dimension(*), intent(out) ", &
":: ghost_flag"
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case ("color_factors")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (cf_index1, cf_index2, color_factors) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), dimension(*), &
&intent(out) :: cf_index1"
write (unit, "(7x,9A)") "integer(c_int), dimension(*), &
&intent(out) :: cf_index2"
write (unit, "(7x,9A)") "complex(c_default_complex), dimension(*), &
&intent(out) :: color_factors"
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
end select
end subroutine prc_writer_c_lib_write_interface
@ %def prc_writer_c_lib_write_interface
@
\subsection{Retrieving the tables}
In the previous section we had the writer routines for procedures that
return tables, actually C pointers to tables. Here, we write
convenience routines that unpack them and move the contents to
suitable Fortran arrays.
The flavor and helicity tables are two-dimensional integer arrays. We
use intermediate storage for correctly transforming C to Fortran data
types.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_flv_state => prclib_driver_set_flv_state
procedure :: set_hel_state => prclib_driver_set_hel_state
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_set_flv_state (driver, i, flv_state)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
integer, dimension(:,:), allocatable, intent(out) :: flv_state
integer :: n_tot, n_flv
integer(c_int) :: pid
integer(c_int), dimension(:,:), allocatable :: c_flv_state
pid = i
n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
n_flv = driver%get_n_flv (pid)
allocate (flv_state (n_tot, n_flv))
allocate (c_flv_state (n_tot, n_flv))
call driver%set_flv_state_ptr &
(pid, c_flv_state, int ([n_tot, n_flv], kind=c_int))
flv_state = c_flv_state
end subroutine prclib_driver_set_flv_state
subroutine prclib_driver_set_hel_state (driver, i, hel_state)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
integer, dimension(:,:), allocatable, intent(out) :: hel_state
integer :: n_tot, n_hel
integer(c_int) :: pid
integer(c_int), dimension(:,:), allocatable, target :: c_hel_state
pid = i
n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
n_hel = driver%get_n_hel (pid)
allocate (hel_state (n_tot, n_hel))
allocate (c_hel_state (n_tot, n_hel))
call driver%set_hel_state_ptr &
(pid, c_hel_state, int ([n_tot, n_hel], kind=c_int))
hel_state = c_hel_state
end subroutine prclib_driver_set_hel_state
@ %def prclib_driver_set_flv_state
@ %def prclib_driver_set_hel_state
@ The color-flow table is three-dimensional, otherwise similar. We
simultaneously set the ghost-flag table, which consists of logical
entries.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_col_state => prclib_driver_set_col_state
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_set_col_state (driver, i, col_state, ghost_flag)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
integer, dimension(:,:,:), allocatable, intent(out) :: col_state
logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
integer :: n_cin, n_tot, n_col
integer(c_int) :: pid
integer(c_int), dimension(:,:,:), allocatable :: c_col_state
logical(c_bool), dimension(:,:), allocatable :: c_ghost_flag
pid = i
n_cin = driver%get_n_cin (pid)
n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
n_col = driver%get_n_col (pid)
allocate (col_state (n_cin, n_tot, n_col))
allocate (c_col_state (n_cin, n_tot, n_col))
allocate (ghost_flag (n_tot, n_col))
allocate (c_ghost_flag (n_tot, n_col))
call driver%set_col_state_ptr (pid, &
c_col_state, c_ghost_flag, int ([n_cin, n_tot, n_col], kind=c_int))
col_state = c_col_state
ghost_flag = c_ghost_flag
end subroutine prclib_driver_set_col_state
@ %def prclib_driver_set_col_state
@ The color-factor table is a sparse matrix: a two-column array of indices and
one array which contains the corresponding factors.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_color_factors => prclib_driver_set_color_factors
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_set_color_factors (driver, i, color_factors, cf_index)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
complex(default), dimension(:), allocatable, intent(out) :: color_factors
integer, dimension(:,:), allocatable, intent(out) :: cf_index
integer :: n_cf
integer(c_int) :: pid
complex(c_default_complex), dimension(:), allocatable, target :: c_color_factors
integer(c_int), dimension(:), allocatable, target :: c_cf_index1
integer(c_int), dimension(:), allocatable, target :: c_cf_index2
pid = i
n_cf = driver%get_n_cf (pid)
allocate (color_factors (n_cf))
allocate (c_color_factors (n_cf))
allocate (c_cf_index1 (n_cf))
allocate (c_cf_index2 (n_cf))
call driver%set_color_factors_ptr (pid, &
c_cf_index1, c_cf_index2, &
c_color_factors, int ([n_cf], kind=c_int))
color_factors = c_color_factors
allocate (cf_index (2, n_cf))
cf_index(1,:) = c_cf_index1
cf_index(2,:) = c_cf_index2
end subroutine prclib_driver_set_color_factors
@ %def prclib_driver_set_color_factors
@
\subsection{Returning a procedure pointer}
The functions that directly access the matrix element, event by event,
are assigned to a process-specific driver object as procedure
pointers. For the [[dlopen]] interface, we use C function pointers.
This subroutine returns such a pointer:
<<Prclib interfaces: public>>=
public :: prc_get_fptr
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_get_fptr (pid, fid, fptr) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int), intent(in) :: fid
type(c_funptr), intent(out) :: fptr
end subroutine prc_get_fptr
end interface
@ %def prc_get_fptr
@ This procedure writes the source code for the procedure pointer
returning subroutine.
All C functions that are provided by the matrix element code of a
specific process are handled here. The selection consists of a double
layered [[select]] [[case]] construct.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_fptr_sub
<<Prclib interfaces: procedures>>=
subroutine write_get_fptr_sub (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i, j
write (unit, "(A)") ""
write (unit, "(A)") "! Return C pointer to a procedure:"
write (unit, "(A)") "! pid = process index; fid = function index"
write (unit, "(4A)") "subroutine ", char (prefix), "get_fptr ", &
"(pid, fid, fptr) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " use kinds"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " integer(c_int), intent(in) :: pid"
write (unit, "(A)") " integer(c_int), intent(in) :: fid"
write (unit, "(A)") " type(c_funptr), intent(out) :: fptr"
do i = 1, driver%n_processes
call driver%record(i)%write_interfaces (unit)
end do
write (unit, "(A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(2x,A,I0,A)") "case (", i, ")"
write (unit, "(5x,A)") "select case (fid)"
associate (record => driver%record(i))
do j = 1, size (record%feature)
write (unit, "(5x,A,I0,9A)") "case (", j, "); ", &
"fptr = c_funloc (", &
char (record%get_c_procname (record%feature(j))), &
")"
end do
end associate
write (unit, "(5x,A)") "end select"
end do
write (unit, "(A)") " end select"
write (unit, "(3A)") "end subroutine ", char (prefix), "get_fptr"
end subroutine write_get_fptr_sub
@ %def write_get_fptr_sub
@ The procedures for which we want to return a pointer (the 'features'
of the matrix element code) are actually Fortran module procedures.
If we want to have a C signature, we must write wrapper functions for
all of them. The procedures, their signatures, and the appropriate
writer routines are specific for the process type.
To keep this generic, we do not provide the writer routines here, but
just the interface for a writer routine. The actual routines are
stored in the process record.
The [[prefix]] indicates the library, the [[id]] indicates the
process, and [[procname]] is the bare name of the procedure to be
written.
<<Prclib interfaces: public>>=
public :: write_driver_code
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine write_driver_code (unit, prefix, id, procname)
import
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
type(string_t), intent(in) :: id
type(string_t), intent(in) :: procname
end subroutine write_driver_code
end interface
@ %def write_driver_code
@
\subsection{Hooks}
Interface for additional library unload / reload hooks (currently unused!)
<<Prclib interfaces: public>>=
public :: prclib_unload_hook
public :: prclib_reload_hook
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prclib_unload_hook (libname)
import
type(string_t), intent(in) :: libname
end subroutine prclib_unload_hook
subroutine prclib_reload_hook (libname)
import
type(string_t), intent(in) :: libname
end subroutine prclib_reload_hook
end interface
@ %def prclib_unload_hook
@ %def prclib_reload_hook
@
\subsection{Make source, compile, link}
Since we should have written a Makefile, these tasks amount to simple
[[make]] calls. Note that the Makefile targets depend on each other,
so calling [[link]] executes also the [[source]] and [[compile]]
steps, when necessary.
Optionally, we can use a subdirectory. We construct a prefix for the
subdirectory, and generate a shell [[cd]] call that moves us into the
workspace.
The [[prefix]] version is intended to be prepended to a filename, and can be
empty. The [[path]] version is intended to be prepended with a following
slash, so the default is [[.]].
<<Prclib interfaces: public>>=
public :: workspace_prefix
public :: workspace_path
<<Prclib interfaces: procedures>>=
function workspace_prefix (workspace) result (prefix)
type(string_t), intent(in), optional :: workspace
type(string_t) :: prefix
if (present (workspace)) then
if (workspace /= "") then
prefix = workspace // "/"
else
prefix = ""
end if
else
prefix = ""
end if
end function workspace_prefix
function workspace_path (workspace) result (path)
type(string_t), intent(in), optional :: workspace
type(string_t) :: path
if (present (workspace)) then
if (workspace /= "") then
path = workspace
else
path = "."
end if
else
path = "."
end if
end function workspace_path
function workspace_cmd (workspace) result (cmd)
type(string_t), intent(in), optional :: workspace
type(string_t) :: cmd
if (present (workspace)) then
if (workspace /= "") then
cmd = "cd " // workspace // " && "
else
cmd = ""
end if
else
cmd = ""
end if
end function workspace_cmd
@ %def workspace_prefix
@ %def workspace_path
@ %def workspace_cmd
@ The first routine writes source-code files for the individual
processes. First it calls the writer routines directly for each
process, then it calls [[make source]]. The make command may either
post-process the files, or it may do the complete work, e.g., calling
an external program the generates the files.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: make_source => prclib_driver_make_source
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_make_source (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
integer :: i
do i = 1, driver%n_processes
call driver%record(i)%write_source_code ()
end do
call os_system_call ( &
workspace_cmd (workspace) &
// "make source " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end subroutine prclib_driver_make_source
@ %def prclib_driver_make_source
@ Compile matrix element source code and the driver source code. As above, we
first iterate through all processes and call [[before_compile]]. This is
usually empty, but can execute code that depends on [[make_source]] already
completed. Similarly, [[after_compile]] scans all processes again.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: make_compile => prclib_driver_make_compile
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_make_compile (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
integer :: i
do i = 1, driver%n_processes
call driver%record(i)%before_compile ()
end do
call os_system_call ( &
workspace_cmd (workspace) &
// "make compile " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
do i = 1, driver%n_processes
call driver%record(i)%after_compile ()
end do
end subroutine prclib_driver_make_compile
@ %def prclib_driver_make_compile
@ Combine all matrix-element code together with the driver in a
process library on disk.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: make_link => prclib_driver_make_link
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_make_link (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
integer :: i
call os_system_call ( &
workspace_cmd (workspace) &
// "make link " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end subroutine prclib_driver_make_link
@ %def prclib_driver_make_link
@
\subsection{Clean up generated files}
The task of cleaning any generated files should also be deferred to
Makefile targets. Apart from removing everything, removing specific
files may be useful for partial rebuilds. (Note that removing the
makefile itself can only be done once, for obvious reasons.)
If there is no makefile, do nothing.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: clean_library => prclib_driver_clean_library
procedure :: clean_objects => prclib_driver_clean_objects
procedure :: clean_source => prclib_driver_clean_source
procedure :: clean_driver => prclib_driver_clean_driver
procedure :: clean_makefile => prclib_driver_clean_makefile
procedure :: clean => prclib_driver_clean
procedure :: distclean => prclib_driver_distclean
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_clean_library (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-library " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_library
subroutine prclib_driver_clean_objects (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-objects " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_objects
subroutine prclib_driver_clean_source (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-source " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_source
subroutine prclib_driver_clean_driver (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-driver " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_driver
subroutine prclib_driver_clean_makefile (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-makefile " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_makefile
subroutine prclib_driver_clean (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean
subroutine prclib_driver_distclean (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make distclean " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_distclean
@ %def prclib_driver_clean_library
@ %def prclib_driver_clean_objects
@ %def prclib_driver_clean_source
@ %def prclib_driver_clean_driver
@ %def prclib_driver_clean_makefile
@ %def prclib_driver_clean
@ %def prclib_driver_distclean
@ This Make target should remove all files that apply to a specific process.
We execute this when we want to force remaking source code. Note that source
targets need not have prerequisites, so just calling [[make_source]] would not
do anything if the files exist.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: clean_proc => prclib_driver_clean_proc
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_clean_proc (driver, i, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
type(string_t) :: id
if (driver%makefile_exists ()) then
id = driver%record(i)%id
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-" // driver%record(i)%id // " " &
// os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_proc
@ %def prclib_driver_clean_proc
@
\subsection{Further Tools}
Check for the appropriate makefile.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: makefile_exists => prclib_driver_makefile_exists
<<Prclib interfaces: procedures>>=
function prclib_driver_makefile_exists (driver, workspace) result (flag)
class(prclib_driver_t), intent(in) :: driver
type(string_t), intent(in), optional :: workspace
logical :: flag
inquire (file = char (workspace_prefix (workspace) &
& // driver%basename) // ".makefile", &
exist = flag)
end function prclib_driver_makefile_exists
@ %def prclib_driver_makefile_exists
@
\subsection{Load the library}
Once the library has been linked, we can dlopen it and assign all
procedure pointers to their proper places in the library driver
object. The [[loaded]] flag is set only if all required pointers
have become assigned.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: load => prclib_driver_load
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_load (driver, os_data, noerror, workspace)
class(prclib_driver_t), intent(inout) :: driver
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: noerror
type(string_t), intent(in), optional :: workspace
type(c_funptr) :: c_fptr
logical :: ignore
ignore = .false.; if (present (noerror)) ignore = noerror
driver%libname = os_get_dlname ( &
workspace_prefix (workspace) // driver%basename, &
os_data, noerror, noerror)
if (driver%libname == "") return
select type (driver)
type is (prclib_driver_dynamic_t)
if (.not. dlaccess_is_open (driver%dlaccess)) then
call dlaccess_init &
(driver%dlaccess, workspace_path (workspace), &
driver%libname, os_data)
if (.not. ignore) call driver%check_dlerror ()
end if
driver%loaded = dlaccess_is_open (driver%dlaccess)
class default
driver%loaded = .true.
end select
if (.not. driver%loaded) return
c_fptr = driver%get_c_funptr (var_str ("get_n_processes"))
call c_f_procpointer (c_fptr, driver%get_n_processes)
driver%loaded = driver%loaded .and. associated (driver%get_n_processes)
c_fptr = driver%get_c_funptr (var_str ("get_process_id_ptr"))
call c_f_procpointer (c_fptr, driver%get_process_id_ptr)
driver%loaded = driver%loaded .and. associated (driver%get_process_id_ptr)
c_fptr = driver%get_c_funptr (var_str ("get_model_name_ptr"))
call c_f_procpointer (c_fptr, driver%get_model_name_ptr)
driver%loaded = driver%loaded .and. associated (driver%get_model_name_ptr)
c_fptr = driver%get_c_funptr (var_str ("get_md5sum_ptr"))
call c_f_procpointer (c_fptr, driver%get_md5sum_ptr)
driver%loaded = driver%loaded .and. associated (driver%get_md5sum_ptr)
c_fptr = driver%get_c_funptr (var_str ("get_openmp_status"))
call c_f_procpointer (c_fptr, driver%get_openmp_status)
driver%loaded = driver%loaded .and. associated (driver%get_openmp_status)
c_fptr = driver%get_c_funptr (var_str ("get_n_in"))
call c_f_procpointer (c_fptr, driver%get_n_in)
driver%loaded = driver%loaded .and. associated (driver%get_n_in)
c_fptr = driver%get_c_funptr (var_str ("get_n_out"))
call c_f_procpointer (c_fptr, driver%get_n_out)
driver%loaded = driver%loaded .and. associated (driver%get_n_out)
c_fptr = driver%get_c_funptr (var_str ("get_n_flv"))
call c_f_procpointer (c_fptr, driver%get_n_flv)
driver%loaded = driver%loaded .and. associated (driver%get_n_flv)
c_fptr = driver%get_c_funptr (var_str ("get_n_hel"))
call c_f_procpointer (c_fptr, driver%get_n_hel)
driver%loaded = driver%loaded .and. associated (driver%get_n_hel)
c_fptr = driver%get_c_funptr (var_str ("get_n_col"))
call c_f_procpointer (c_fptr, driver%get_n_col)
driver%loaded = driver%loaded .and. associated (driver%get_n_col)
c_fptr = driver%get_c_funptr (var_str ("get_n_cin"))
call c_f_procpointer (c_fptr, driver%get_n_cin)
driver%loaded = driver%loaded .and. associated (driver%get_n_cin)
c_fptr = driver%get_c_funptr (var_str ("get_n_cf"))
call c_f_procpointer (c_fptr, driver%get_n_cf)
driver%loaded = driver%loaded .and. associated (driver%get_n_cf)
c_fptr = driver%get_c_funptr (var_str ("set_flv_state_ptr"))
call c_f_procpointer (c_fptr, driver%set_flv_state_ptr)
driver%loaded = driver%loaded .and. associated (driver%set_flv_state_ptr)
c_fptr = driver%get_c_funptr (var_str ("set_hel_state_ptr"))
call c_f_procpointer (c_fptr, driver%set_hel_state_ptr)
driver%loaded = driver%loaded .and. associated (driver%set_hel_state_ptr)
c_fptr = driver%get_c_funptr (var_str ("set_col_state_ptr"))
call c_f_procpointer (c_fptr, driver%set_col_state_ptr)
driver%loaded = driver%loaded .and. associated (driver%set_col_state_ptr)
c_fptr = driver%get_c_funptr (var_str ("set_color_factors_ptr"))
call c_f_procpointer (c_fptr, driver%set_color_factors_ptr)
driver%loaded = driver%loaded .and. associated (driver%set_color_factors_ptr)
c_fptr = driver%get_c_funptr (var_str ("get_fptr"))
call c_f_procpointer (c_fptr, driver%get_fptr)
driver%loaded = driver%loaded .and. associated (driver%get_fptr)
end subroutine prclib_driver_load
@ %def prclib_driver_load
@ Unload. To be sure, nullify the procedure pointers.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: unload => prclib_driver_unload
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_unload (driver)
class(prclib_driver_t), intent(inout) :: driver
select type (driver)
type is (prclib_driver_dynamic_t)
if (dlaccess_is_open (driver%dlaccess)) then
call dlaccess_final (driver%dlaccess)
call driver%check_dlerror ()
end if
end select
driver%loaded = .false.
nullify (driver%get_n_processes)
nullify (driver%get_process_id_ptr)
nullify (driver%get_model_name_ptr)
nullify (driver%get_md5sum_ptr)
nullify (driver%get_openmp_status)
nullify (driver%get_n_in)
nullify (driver%get_n_out)
nullify (driver%get_n_flv)
nullify (driver%get_n_hel)
nullify (driver%get_n_col)
nullify (driver%get_n_cin)
nullify (driver%get_n_cf)
nullify (driver%set_flv_state_ptr)
nullify (driver%set_hel_state_ptr)
nullify (driver%set_col_state_ptr)
nullify (driver%set_color_factors_ptr)
nullify (driver%get_fptr)
end subroutine prclib_driver_unload
@ %def prclib_driver_unload
@ This subroutine checks the [[dlerror]] content and issues a fatal
error if it finds an error there.
<<Prclib interfaces: prclib driver dynamic: TBP>>=
procedure :: check_dlerror => prclib_driver_check_dlerror
<<Prclib interfaces: procedures>>=
subroutine prclib_driver_check_dlerror (driver)
class(prclib_driver_dynamic_t), intent(in) :: driver
if (dlaccess_has_error (driver%dlaccess)) then
call msg_fatal (char (dlaccess_get_error (driver%dlaccess)))
end if
end subroutine prclib_driver_check_dlerror
@ %def prclib_driver_check_dlerror
@ Get the handle (C function pointer) for a given ``feature'' of the
matrix element code, so it can be assigned to the appropriate
procedure pointer slot. In the static case, this is a
trivial pointer assignment, hard-coded into the driver type
implementation.
<<Prclib interfaces: prclib driver: TBP>>=
procedure (prclib_driver_get_c_funptr), deferred :: get_c_funptr
<<Prclib interfaces: interfaces>>=
abstract interface
function prclib_driver_get_c_funptr (driver, feature) result (c_fptr)
import
class(prclib_driver_t), intent(inout) :: driver
type(string_t), intent(in) :: feature
type(c_funptr) :: c_fptr
end function prclib_driver_get_c_funptr
end interface
@ %def prclib_driver_get_c_funptr
@ In the dynamic-library case, we call the DL interface to retrieve the C
pointer to a named procedure.
<<Prclib interfaces: prclib driver dynamic: TBP>>=
procedure :: get_c_funptr => prclib_driver_dynamic_get_c_funptr
<<Prclib interfaces: procedures>>=
function prclib_driver_dynamic_get_c_funptr (driver, feature) result (c_fptr)
class(prclib_driver_dynamic_t), intent(inout) :: driver
type(string_t), intent(in) :: feature
type(c_funptr) :: c_fptr
type(string_t) :: prefix, full_name
prefix = lower_case (driver%basename) // "_"
full_name = prefix // feature
c_fptr = dlaccess_get_c_funptr (driver%dlaccess, full_name)
call driver%check_dlerror ()
end function prclib_driver_dynamic_get_c_funptr
@ %def prclib_driver_get_c_funptr
@
\subsection{MD5 sums}
Recall the MD5 sum written in the Makefile
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: get_md5sum_makefile => prclib_driver_get_md5sum_makefile
<<Prclib interfaces: procedures>>=
function prclib_driver_get_md5sum_makefile (driver, workspace) result (md5sum)
class(prclib_driver_t), intent(in) :: driver
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum
type(string_t) :: filename
character(80) :: buffer
logical :: exist
integer :: u, iostat
md5sum = ""
filename = workspace_prefix (workspace) // driver%basename // ".makefile"
inquire (file = char (filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (filename), action = "read", status = "old")
iostat = 0
do
read (u, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
buffer = adjustl (buffer)
select case (buffer(1:9))
case ("MD5SUM = ")
read (buffer(11:), "(A32)") md5sum
exit
end select
end do
close (u)
end if
end function prclib_driver_get_md5sum_makefile
@ %def prclib_driver_get_md5sum_makefile
@ Recall the MD5 sum written in the driver source code.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: get_md5sum_driver => prclib_driver_get_md5sum_driver
<<Prclib interfaces: procedures>>=
function prclib_driver_get_md5sum_driver (driver, workspace) result (md5sum)
class(prclib_driver_t), intent(in) :: driver
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum
type(string_t) :: filename
character(80) :: buffer
logical :: exist
integer :: u, iostat
md5sum = ""
filename = workspace_prefix (workspace) // driver%basename // ".f90"
inquire (file = char (filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (filename), action = "read", status = "old")
iostat = 0
do
read (u, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
buffer = adjustl (buffer)
select case (buffer(1:9))
case ("md5sum = ")
read (buffer(11:), "(A32)") md5sum
exit
end select
end do
close (u)
end if
end function prclib_driver_get_md5sum_driver
@ %def prclib_driver_get_md5sum_driver
@ Recall the MD5 sum written in the matrix element source code.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: get_md5sum_source => prclib_driver_get_md5sum_source
<<Prclib interfaces: procedures>>=
function prclib_driver_get_md5sum_source &
(driver, i, workspace) result (md5sum)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum
type(string_t) :: filename
character(80) :: buffer
logical :: exist
integer :: u, iostat
md5sum = ""
filename = workspace_prefix (workspace) // driver%record(i)%id // ".f90"
inquire (file = char (filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (filename), action = "read", status = "old")
iostat = 0
do
read (u, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
buffer = adjustl (buffer)
select case (buffer(1:9))
case ("md5sum = ")
read (buffer(11:), "(A32)") md5sum
exit
end select
end do
close (u)
end if
end function prclib_driver_get_md5sum_source
@ %def prclib_driver_get_md5sum_source
@
\subsection{Unit Test}
Test module, followed by the corresponding implementation module.
<<[[prclib_interfaces_ut.f90]]>>=
<<File header>>
module prclib_interfaces_ut
use kinds
use system_dependencies, only: CC_IS_GNU, CC_HAS_QUADMATH
use unit_tests
use prclib_interfaces_uti
<<Standard module head>>
<<Prclib interfaces: public test>>
<<Prclib interfaces: public test auxiliary>>
contains
<<Prclib interfaces: test driver>>
end module prclib_interfaces_ut
@ %def prclib_interfaces_ut
@
<<[[prclib_interfaces_uti.f90]]>>=
<<File header>>
module prclib_interfaces_uti
use, intrinsic :: iso_c_binding !NODEP!
use kinds
use system_dependencies, only: CC_HAS_QUADMATH, DEFAULT_FC_PRECISION
<<Use strings>>
use io_units
use system_defs, only: TAB
use os_interface
use prclib_interfaces
<<Standard module head>>
<<Prclib interfaces: public test auxiliary>>
<<Prclib interfaces: test declarations>>
<<Prclib interfaces: test types>>
contains
<<Prclib interfaces: tests>>
<<Prclib interfaces: test auxiliary>>
end module prclib_interfaces_uti
@ %def prclib_interfaces_ut
@ API: driver for the unit tests below.
<<Prclib interfaces: public test>>=
public :: prclib_interfaces_test
<<Prclib interfaces: test driver>>=
subroutine prclib_interfaces_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Prclib interfaces: execute tests>>
end subroutine prclib_interfaces_test
@ %def prclib_interfaces_test
@
\subsubsection{Empty process list}
Test 1: Create a driver object and display its contents. One of the
feature lists references a writer procedure; this is just a dummy that
does nothing useful.
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_1, "prclib_interfaces_1", &
"create driver object", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_1
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_1 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
character(32), parameter :: md5sum = "prclib_interfaces_1_md5sum "
class(prc_writer_t), pointer :: test_writer_1
write (u, "(A)") "* Test output: prclib_interfaces_1"
write (u, "(A)") "* Purpose: display the driver object contents"
write (u, *)
write (u, "(A)") "* Create a prclib driver object"
write (u, "(A)")
call dispatch_prclib_driver (driver, var_str ("prclib"), var_str (""))
call driver%init (3)
call driver%set_md5sum (md5sum)
allocate (test_writer_1_t :: test_writer_1)
call driver%set_record (1, var_str ("test1"), var_str ("test_model"), &
[var_str ("init")], test_writer_1)
call driver%set_record (2, var_str ("test2"), var_str ("foo_model"), &
[var_str ("another_proc")], test_writer_1)
call driver%set_record (3, var_str ("test3"), var_str ("test_model"), &
[var_str ("init"), var_str ("some_proc")], test_writer_1)
call driver%write (u)
deallocate (test_writer_1)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_1"
end subroutine prclib_interfaces_1
@ %def prclib_interfaces_1
@ The writer: the procedures write just comment lines. We can fix an
instance of this as a parameter (since it has no mutable content) and
just reference the fixed parameter.
NOTE: temporarily made public.
<<Prclib interfaces: test types>>=
type, extends (prc_writer_t) :: test_writer_1_t
contains
procedure, nopass :: type_name => test_writer_1_type_name
procedure :: write_makefile_code => test_writer_1_mk
procedure :: write_source_code => test_writer_1_src
procedure :: write_interface => test_writer_1_if
procedure :: write_md5sum_call => test_writer_1_md5sum
procedure :: write_int_sub_call => test_writer_1_int_sub
procedure :: write_col_state_call => test_writer_1_col_state
procedure :: write_color_factors_call => test_writer_1_col_factors
procedure :: before_compile => test_writer_1_before_compile
procedure :: after_compile => test_writer_1_after_compile
end type test_writer_1_t
@ %def test_writer_1
@
<<Prclib interfaces: test auxiliary>>=
function test_writer_1_type_name () result (string)
type(string_t) :: string
string = "test_1"
end function test_writer_1_type_name
subroutine test_writer_1_mk (writer, unit, id, os_data, verbose, testflag)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "# Makefile code for process ", char (id), &
" goes here."
end subroutine test_writer_1_mk
subroutine test_writer_1_src (writer, id)
class(test_writer_1_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_1_src
subroutine test_writer_1_if (writer, unit, id, feature)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(2x,9A)") "! Interface code for ", &
char (id), "_", char (writer%get_procname (feature)), &
" goes here."
end subroutine test_writer_1_if
subroutine test_writer_1_md5sum (writer, unit, id)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "! MD5sum call for ", char (id), " goes here."
end subroutine test_writer_1_md5sum
subroutine test_writer_1_int_sub (writer, unit, id, feature)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(5x,9A)") "! ", char (feature), " call for ", &
char (id), " goes here."
end subroutine test_writer_1_int_sub
subroutine test_writer_1_col_state (writer, unit, id)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "! col_state call for ", &
char (id), " goes here."
end subroutine test_writer_1_col_state
subroutine test_writer_1_col_factors (writer, unit, id)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "! color_factors call for ", &
char (id), " goes here."
end subroutine test_writer_1_col_factors
subroutine test_writer_1_before_compile (writer, id)
class(test_writer_1_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_1_before_compile
subroutine test_writer_1_after_compile (writer, id)
class(test_writer_1_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_1_after_compile
@ %def test_writer_1_type_name
@ %def test_writer_1_mk test_writer_1_if
@ %def test_writer_1_md5sum test_writer_1_int_sub
@ %def test_writer_1_col_state test_writer_1_col_factors
@ %def test_writer_1_before_compile test_writer_1_after_compile
@
\subsubsection{Process library driver file}
Test 2: Write the driver file for a test case with two processes. The
first process needs no wrapper (C library), the second one needs
wrappers (Fortran module library).
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_2, "prclib_interfaces_2", &
"write driver file", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_2
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_2 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
character(32), parameter :: md5sum = "prclib_interfaces_2_md5sum "
class(prc_writer_t), pointer :: test_writer_1, test_writer_2
write (u, "(A)") "* Test output: prclib_interfaces_2"
write (u, "(A)") "* Purpose: check the generated driver source code"
write (u, "(A)")
write (u, "(A)") "* Create a prclib driver object (2 processes)"
write (u, "(A)")
call dispatch_prclib_driver (driver, var_str ("prclib2"), var_str (""))
call driver%init (2)
call driver%set_md5sum (md5sum)
allocate (test_writer_1_t :: test_writer_1)
allocate (test_writer_2_t :: test_writer_2)
call driver%set_record (1, var_str ("test1"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_1)
call driver%set_record (2, var_str ("test2"), var_str ("Test_model"), &
[var_str ("proc1"), var_str ("proc2")], test_writer_2)
call driver%write (u)
write (u, "(A)")
write (u, "(A)") "* Write the driver file"
write (u, "(A)") "* File contents:"
write (u, "(A)")
call driver%generate_driver_code (u)
deallocate (test_writer_1)
deallocate (test_writer_2)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_2"
end subroutine prclib_interfaces_2
@ %def prclib_interfaces_2
@ A writer with wrapper code: the procedures again write just comment
lines. Since all procedures are NOPASS, we can reuse two of the TBP.
<<Prclib interfaces: test types>>=
type, extends (prc_writer_f_module_t) :: test_writer_2_t
contains
procedure, nopass :: type_name => test_writer_2_type_name
procedure :: write_makefile_code => test_writer_2_mk
procedure :: write_source_code => test_writer_2_src
procedure :: write_interface => test_writer_2_if
procedure :: write_wrapper => test_writer_2_wr
procedure :: before_compile => test_writer_2_before_compile
procedure :: after_compile => test_writer_2_after_compile
end type test_writer_2_t
@ %def test_writer_2
@
<<Prclib interfaces: test auxiliary>>=
function test_writer_2_type_name () result (string)
type(string_t) :: string
string = "test_2"
end function test_writer_2_type_name
subroutine test_writer_2_mk (writer, unit, id, os_data, verbose, testflag)
class(test_writer_2_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "# Makefile code for process ", char (id), &
" goes here."
end subroutine test_writer_2_mk
subroutine test_writer_2_src (writer, id)
class(test_writer_2_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_2_src
subroutine test_writer_2_if (writer, unit, id, feature)
class(test_writer_2_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(2x,9A)") "! Interface code for ", &
char (writer%get_module_name (id)), "_", &
char (writer%get_procname (feature)), " goes here."
end subroutine test_writer_2_if
subroutine test_writer_2_wr (writer, unit, id, feature)
class(test_writer_2_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, *)
write (unit, "(9A)") "! Wrapper code for ", &
char (writer%get_c_procname (id, feature)), " goes here."
end subroutine test_writer_2_wr
subroutine test_writer_2_before_compile (writer, id)
class(test_writer_2_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_2_before_compile
subroutine test_writer_2_after_compile (writer, id)
class(test_writer_2_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_2_after_compile
@ %def test_writer_2_type_name test_writer_2_wr
@ %def test_writer_2_before_compile test_writer_2_after_compile
@
\subsubsection{Process library makefile}
Test 3: Write the makefile for compiling and linking the process
library (processes and driver code). There are two processes, one
with one method, one with two methods.
To have predictable output, we reset the system-dependent initial
components of [[os_data]] to known values.
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_3, "prclib_interfaces_3", &
"write makefile", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_3
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_3 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
type(os_data_t) :: os_data
character(32), parameter :: md5sum = "prclib_interfaces_3_md5sum "
class(prc_writer_t), pointer :: test_writer_1, test_writer_2
call os_data_init (os_data)
os_data%fc = "fortran-compiler"
os_data%whizard_includes = "-I module-dir"
os_data%fcflags = "-C=all"
os_data%fcflags_pic = "-PIC"
os_data%cc = "c-compiler"
os_data%cflags = "-I include-dir"
os_data%cflags_pic = "-PIC"
os_data%whizard_ldflags = ""
os_data%ldflags = ""
os_data%whizard_libtool = "my-libtool"
os_data%latex = "latex -halt-on-error"
os_data%mpost = "mpost --math=scaled -halt-on-error"
os_data%dvips = "dvips"
os_data%ps2pdf = "ps2pdf14"
os_data%whizard_texpath = ""
write (u, "(A)") "* Test output: prclib_interfaces_3"
write (u, "(A)") "* Purpose: check the generated Makefile"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (2 processes)"
write (u, "(A)")
call dispatch_prclib_driver (driver, var_str ("prclib3"), var_str (""))
call driver%init (2)
call driver%set_md5sum (md5sum)
allocate (test_writer_1_t :: test_writer_1)
allocate (test_writer_2_t :: test_writer_2)
call driver%set_record (1, var_str ("test1"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_1)
call driver%set_record (2, var_str ("test2"), var_str ("Test_model"), &
[var_str ("proc1"), var_str ("proc2")], test_writer_2)
call driver%write (u)
write (u, "(A)")
write (u, "(A)") "* Write Makefile"
write (u, "(A)") "* File contents:"
write (u, "(A)")
call driver%generate_makefile (u, os_data, verbose = .true.)
deallocate (test_writer_1)
deallocate (test_writer_2)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_3"
end subroutine prclib_interfaces_3
@ %def prclib_interfaces_3
@
\subsubsection{Compile test with Fortran module}
Test 4: Write driver and makefile and try to compile and link the
library driver.
There is a single test process with a single feature. The process
code is provided as a Fortran module, therefore we need a wrapper for
the featured procedure.
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_4, "prclib_interfaces_4", &
"compile and link (Fortran module)", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_4
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_4 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
class(prc_writer_t), pointer :: test_writer_4
type(os_data_t) :: os_data
integer :: u_file
integer, dimension(:,:), allocatable :: flv_state
integer, dimension(:,:), allocatable :: hel_state
integer, dimension(:,:,:), allocatable :: col_state
logical, dimension(:,:), allocatable :: ghost_flag
integer, dimension(:,:), allocatable :: cf_index
complex(default), dimension(:), allocatable :: color_factors
character(32), parameter :: md5sum = "prclib_interfaces_4_md5sum "
character(32) :: md5sum_file
type(c_funptr) :: proc1_ptr
interface
subroutine proc1_t (n) bind(C)
import
integer(c_int), intent(out) :: n
end subroutine proc1_t
end interface
procedure(proc1_t), pointer :: proc1
integer(c_int) :: n
write (u, "(A)") "* Test output: prclib_interfaces_4"
write (u, "(A)") "* Purpose: compile, link, and load process library"
write (u, "(A)") "* with (fake) matrix-element code &
&as a Fortran module"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (1 process)"
write (u, "(A)")
call os_data_init (os_data)
allocate (test_writer_4_t :: test_writer_4)
call test_writer_4%init_test ()
call dispatch_prclib_driver (driver, var_str ("prclib4"), var_str (""))
call driver%init (1)
call driver%set_md5sum (md5sum)
call driver%set_record (1, var_str ("test4"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_4)
call driver%write (u)
write (u, *)
write (u, "(A)") "* Write Makefile"
u_file = free_unit ()
open (u_file, file="prclib4.makefile", status="replace", action="write")
call driver%generate_makefile (u_file, os_data, verbose = .false.)
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Recall MD5 sum from Makefile"
write (u, "(A)")
md5sum_file = driver%get_md5sum_makefile ()
write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"
write (u, "(A)")
write (u, "(A)") "* Write driver source code"
u_file = free_unit ()
open (u_file, file="prclib4.f90", status="replace", action="write")
call driver%generate_driver_code (u_file)
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Recall MD5 sum from driver source"
write (u, "(A)")
md5sum_file = driver%get_md5sum_driver ()
write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"
write (u, "(A)")
write (u, "(A)") "* Write matrix-element source code"
call driver%make_source (os_data)
write (u, "(A)")
write (u, "(A)") "* Recall MD5 sum from matrix-element source"
write (u, "(A)")
md5sum_file = driver%get_md5sum_source (1)
write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"
write (u, "(A)")
write (u, "(A)") "* Compile source code"
call driver%make_compile (os_data)
write (u, "(A)") "* Link library"
call driver%make_link (os_data)
write (u, "(A)") "* Load library"
call driver%load (os_data)
write (u, *)
call driver%write (u)
write (u, *)
if (driver%loaded) then
write (u, "(A)") "* Call library functions:"
write (u, *)
write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
write (u, "(1x,A,A,A)") "process_id = '", &
char (driver%get_process_id (1)), "'"
write (u, "(1x,A,A,A)") "model_name = '", &
char (driver%get_model_name (1)), "'"
write (u, "(1x,A,A,A)") "md5sum (lib) = '", &
char (driver%get_md5sum (0)), "'"
write (u, "(1x,A,A,A)") "md5sum (proc) = '", &
char (driver%get_md5sum (1)), "'"
write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)
call driver%set_flv_state (1, flv_state)
write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state
call driver%set_hel_state (1, hel_state)
write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state
call driver%set_col_state (1, col_state, ghost_flag)
write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag
call driver%set_color_factors (1, color_factors, cf_index)
write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index
call driver%get_fptr (1, 1, proc1_ptr)
call c_f_procpointer (proc1_ptr, proc1)
if (associated (proc1)) then
write (u, *)
call proc1 (n)
write (u, "(1x,A,I0)") "proc1(1) = ", n
end if
end if
deallocate (test_writer_4)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_4"
end subroutine prclib_interfaces_4
@ %def prclib_interfaces_4
@ This version of test-code writer actually writes an interface and
wrapper code. The wrapped function is a no-parameter function with integer
result.
The stored MD5 sum may be modified.
We will reuse this later, therefore public.
<<Prclib interfaces: public test auxiliary>>=
public :: test_writer_4_t
<<Prclib interfaces: test types>>=
type, extends (prc_writer_f_module_t) :: test_writer_4_t
contains
procedure, nopass :: type_name => test_writer_4_type_name
procedure, nopass :: get_module_name => &
test_writer_4_get_module_name
procedure :: write_makefile_code => test_writer_4_mk
procedure :: write_source_code => test_writer_4_src
procedure :: write_interface => test_writer_4_if
procedure :: write_wrapper => test_writer_4_wr
procedure :: before_compile => test_writer_4_before_compile
procedure :: after_compile => test_writer_4_after_compile
end type test_writer_4_t
@ %def test_writer_4
@
<<Prclib interfaces: test auxiliary>>=
function test_writer_4_type_name () result (string)
type(string_t) :: string
string = "test_4"
end function test_writer_4_type_name
function test_writer_4_get_module_name (id) result (name)
type(string_t), intent(in) :: id
type(string_t) :: name
name = "tpr_" // id
end function test_writer_4_get_module_name
subroutine test_writer_4_mk (writer, unit, id, os_data, verbose, testflag)
class(test_writer_4_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "SOURCES += ", char (id), ".f90"
write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
write (unit, "(5A)") "CLEAN_SOURCES += ", char (id), ".f90"
write (unit, "(5A)") "CLEAN_OBJECTS += tpr_", char (id), ".mod"
write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), ".lo"
write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
if (.not. verbose) then
write (unit, "(5A)") TAB // '@echo " FC " $@'
end if
write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
end subroutine test_writer_4_mk
subroutine test_writer_4_src (writer, id)
class(test_writer_4_t), intent(in) :: writer
type(string_t), intent(in) :: id
call write_test_module_file (id, var_str ("proc1"), writer%md5sum)
end subroutine test_writer_4_src
subroutine test_writer_4_if (writer, unit, id, feature)
class(test_writer_4_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (n) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), intent(out) :: n"
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
end subroutine test_writer_4_if
subroutine test_writer_4_wr (writer, unit, id, feature)
class(test_writer_4_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, *)
write (unit, "(9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (n) bind(C)"
write (unit, "(2x,9A)") "use iso_c_binding"
write (unit, "(2x,9A)") "use tpr_", char (id), ", only: ", &
char (writer%get_procname (feature))
write (unit, "(2x,9A)") "implicit none"
write (unit, "(2x,9A)") "integer(c_int), intent(out) :: n"
write (unit, "(2x,9A)") "call ", char (feature), " (n)"
write (unit, "(9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
end subroutine test_writer_4_wr
subroutine test_writer_4_before_compile (writer, id)
class(test_writer_4_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_4_before_compile
subroutine test_writer_4_after_compile (writer, id)
class(test_writer_4_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_4_after_compile
@ %def test_writer_2_type_name test_writer_4_wr
@ %def test_writer_4_before_compile test_writer_4_after_compile
@
We need a test module file (actually, one for each process in the test
above) that allows us to check compilation and linking. The test
module implements a colorless $1\to 2$ process, and it implements one
additional function (feature), the name given as an argument.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_module_file (basename, feature, md5sum)
type(string_t), intent(in) :: basename
type(string_t), intent(in) :: feature
character(32), intent(in) :: md5sum
integer :: u
u = free_unit ()
open (u, file = char (basename) // ".f90", &
status = "replace", action = "write")
write (u, "(A)") "! (Pseudo) matrix element code file &
&for WHIZARD self-test"
write (u, *)
write (u, "(A)") "module tpr_" // char (basename)
write (u, *)
write (u, "(2x,A)") "use kinds"
write (u, "(2x,A)") "use omega_color, OCF => omega_color_factor"
write (u, *)
write (u, "(2x,A)") "implicit none"
write (u, "(2x,A)") "private"
write (u, *)
call write_test_me_code_1 (u)
write (u, *)
write (u, "(2x,A)") "public :: " // char (feature)
write (u, *)
write (u, "(A)") "contains"
write (u, *)
call write_test_me_code_2 (u, md5sum)
write (u, *)
write (u, "(2x,A)") "subroutine " // char (feature) // " (n)"
write (u, "(2x,A)") " integer, intent(out) :: n"
write (u, "(2x,A)") " n = 42"
write (u, "(2x,A)") "end subroutine " // char (feature)
write (u, *)
write (u, "(A)") "end module tpr_" // char (basename)
close (u)
end subroutine write_test_module_file
@ %def write_test_module_file
@
The following two subroutines provide building blocks for a
matrix-element source code file, useful only for testing the
workflow. The first routine writes the header part, the other routine
the implementation of the procedures listed in the header.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_me_code_1 (u)
integer, intent(in) :: u
write (u, "(2x,A)") "public :: md5sum"
write (u, "(2x,A)") "public :: openmp_supported"
write (u, *)
write (u, "(2x,A)") "public :: n_in"
write (u, "(2x,A)") "public :: n_out"
write (u, "(2x,A)") "public :: n_flv"
write (u, "(2x,A)") "public :: n_hel"
write (u, "(2x,A)") "public :: n_cin"
write (u, "(2x,A)") "public :: n_col"
write (u, "(2x,A)") "public :: n_cf"
write (u, *)
write (u, "(2x,A)") "public :: flv_state"
write (u, "(2x,A)") "public :: hel_state"
write (u, "(2x,A)") "public :: col_state"
write (u, "(2x,A)") "public :: color_factors"
end subroutine write_test_me_code_1
subroutine write_test_me_code_2 (u, md5sum)
integer, intent(in) :: u
character(32), intent(in) :: md5sum
write (u, "(2x,A)") "pure function md5sum ()"
write (u, "(2x,A)") " character(len=32) :: md5sum"
write (u, "(2x,A)") " md5sum = '" // md5sum // "'"
write (u, "(2x,A)") "end function md5sum"
write (u, *)
write (u, "(2x,A)") "pure function openmp_supported () result (status)"
write (u, "(2x,A)") " logical :: status"
write (u, "(2x,A)") " status = .false."
write (u, "(2x,A)") "end function openmp_supported"
write (u, *)
write (u, "(2x,A)") "pure function n_in () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_in"
write (u, *)
write (u, "(2x,A)") "pure function n_out () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 2"
write (u, "(2x,A)") "end function n_out"
write (u, *)
write (u, "(2x,A)") "pure function n_flv () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_flv"
write (u, *)
write (u, "(2x,A)") "pure function n_hel () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_hel"
write (u, *)
write (u, "(2x,A)") "pure function n_cin () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 2"
write (u, "(2x,A)") "end function n_cin"
write (u, *)
write (u, "(2x,A)") "pure function n_col () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_col"
write (u, *)
write (u, "(2x,A)") "pure function n_cf () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_cf"
write (u, *)
write (u, "(2x,A)") "pure subroutine flv_state (a)"
write (u, "(2x,A)") " integer, dimension(:,:), intent(out) :: a"
write (u, "(2x,A)") " a = reshape ([1,2,3], [3,1])"
write (u, "(2x,A)") "end subroutine flv_state"
write (u, *)
write (u, "(2x,A)") "pure subroutine hel_state (a)"
write (u, "(2x,A)") " integer, dimension(:,:), intent(out) :: a"
write (u, "(2x,A)") " a = reshape ([0,0,0], [3,1])"
write (u, "(2x,A)") "end subroutine hel_state"
write (u, *)
write (u, "(2x,A)") "pure subroutine col_state (a, g)"
write (u, "(2x,A)") " integer, dimension(:,:,:), intent(out) :: a"
write (u, "(2x,A)") " logical, dimension(:,:), intent(out) :: g"
write (u, "(2x,A)") " a = reshape ([0,0, 0,0, 0,0], [2,3,1])"
write (u, "(2x,A)") " g = reshape ([.false., .false., .false.], [3,1])"
write (u, "(2x,A)") "end subroutine col_state"
write (u, *)
write (u, "(2x,A)") "pure subroutine color_factors (cf)"
write (u, "(2x,A)") " type(OCF), dimension(:), intent(out) :: cf"
write (u, "(2x,A)") " cf = [ OCF(1,1,+1._default) ]"
write (u, "(2x,A)") "end subroutine color_factors"
end subroutine write_test_me_code_2
@ %def write_test_me_code_1 write_test_me_code_2
@
\subsubsection{Compile test with Fortran bind(C) library}
Test 5: Write driver and makefile and try to compile and link the
library driver.
There is a single test process with a single feature. The process
code is provided as a Fortran library of independent procedures.
These procedures are bind(C).
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_5, "prclib_interfaces_5", &
"compile and link (Fortran library)", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_5
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_5 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
class(prc_writer_t), pointer :: test_writer_5
type(os_data_t) :: os_data
integer :: u_file
integer, dimension(:,:), allocatable :: flv_state
integer, dimension(:,:), allocatable :: hel_state
integer, dimension(:,:,:), allocatable :: col_state
logical, dimension(:,:), allocatable :: ghost_flag
integer, dimension(:,:), allocatable :: cf_index
complex(default), dimension(:), allocatable :: color_factors
character(32), parameter :: md5sum = "prclib_interfaces_5_md5sum "
type(c_funptr) :: proc1_ptr
interface
subroutine proc1_t (n) bind(C)
import
integer(c_int), intent(out) :: n
end subroutine proc1_t
end interface
procedure(proc1_t), pointer :: proc1
integer(c_int) :: n
write (u, "(A)") "* Test output: prclib_interfaces_5"
write (u, "(A)") "* Purpose: compile, link, and load process library"
write (u, "(A)") "* with (fake) matrix-element code &
&as a Fortran bind(C) library"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (1 process)"
write (u, "(A)")
call os_data_init (os_data)
allocate (test_writer_5_t :: test_writer_5)
call dispatch_prclib_driver (driver, var_str ("prclib5"), var_str (""))
call driver%init (1)
call driver%set_md5sum (md5sum)
call driver%set_record (1, var_str ("test5"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_5)
call driver%write (u)
write (u, *)
write (u, "(A)") "* Write makefile"
u_file = free_unit ()
open (u_file, file="prclib5.makefile", status="replace", action="write")
call driver%generate_makefile (u_file, os_data, verbose = .false.)
close (u_file)
write (u, "(A)") "* Write driver source code"
u_file = free_unit ()
open (u_file, file="prclib5.f90", status="replace", action="write")
call driver%generate_driver_code (u_file)
close (u_file)
write (u, "(A)") "* Write matrix-element source code"
call driver%make_source (os_data)
write (u, "(A)") "* Compile source code"
call driver%make_compile (os_data)
write (u, "(A)") "* Link library"
call driver%make_link (os_data)
write (u, "(A)") "* Load library"
call driver%load (os_data)
write (u, *)
call driver%write (u)
write (u, *)
if (driver%loaded) then
write (u, "(A)") "* Call library functions:"
write (u, *)
write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
write (u, "(1x,A,A)") "process_id = ", &
char (driver%get_process_id (1))
write (u, "(1x,A,A)") "model_name = ", &
char (driver%get_model_name (1))
write (u, "(1x,A,A)") "md5sum = ", &
char (driver%get_md5sum (1))
write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)
call driver%set_flv_state (1, flv_state)
write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state
call driver%set_hel_state (1, hel_state)
write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state
call driver%set_col_state (1, col_state, ghost_flag)
write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag
call driver%set_color_factors (1, color_factors, cf_index)
write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index
call driver%get_fptr (1, 1, proc1_ptr)
call c_f_procpointer (proc1_ptr, proc1)
if (associated (proc1)) then
write (u, *)
call proc1 (n)
write (u, "(1x,A,I0)") "proc1(1) = ", n
end if
end if
deallocate (test_writer_5)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_5"
end subroutine prclib_interfaces_5
@ %def prclib_interfaces_5
@ This version of test-code writer writes interfaces for all standard
features plus one specific feature. The interfaces are all bind(C),
so no wrapper is needed.
<<Prclib interfaces: test types>>=
type, extends (prc_writer_c_lib_t) :: test_writer_5_t
contains
procedure, nopass :: type_name => test_writer_5_type_name
procedure :: write_makefile_code => test_writer_5_mk
procedure :: write_source_code => test_writer_5_src
procedure :: write_interface => test_writer_5_if
procedure :: before_compile => test_writer_5_before_compile
procedure :: after_compile => test_writer_5_after_compile
end type test_writer_5_t
@ %def test_writer_5
@ The
<<Prclib interfaces: test auxiliary>>=
function test_writer_5_type_name () result (string)
type(string_t) :: string
string = "test_5"
end function test_writer_5_type_name
subroutine test_writer_5_mk (writer, unit, id, os_data, verbose, testflag)
class(test_writer_5_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "SOURCES += ", char (id), ".f90"
write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
if (.not. verbose) then
write (unit, "(5A)") TAB // '@echo " FC " $@'
end if
write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
end subroutine test_writer_5_mk
subroutine test_writer_5_src (writer, id)
class(test_writer_5_t), intent(in) :: writer
type(string_t), intent(in) :: id
call write_test_f_lib_file (id, var_str ("proc1"))
end subroutine test_writer_5_src
subroutine test_writer_5_if (writer, unit, id, feature)
class(test_writer_5_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
select case (char (feature))
case ("proc1")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (n) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), intent(out) :: n"
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case default
call writer%write_standard_interface (unit, id, feature)
end select
end subroutine test_writer_5_if
subroutine test_writer_5_before_compile (writer, id)
class(test_writer_5_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_5_before_compile
subroutine test_writer_5_after_compile (writer, id)
class(test_writer_5_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_5_after_compile
@ %def test_writer_5_type_name test_writer_5_mk
@ %def test_writer_5_if
@ %def test_writer_5_before_compile test_writer_5_after_compile
@
We need a test module file (actually, one for each process in the test
above) that allows us to check compilation and linking. The test
module implements a colorless $1\to 2$ process, and it implements one
additional function (feature), the name given as an argument.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_f_lib_file (basename, feature)
type(string_t), intent(in) :: basename
type(string_t), intent(in) :: feature
integer :: u
u = free_unit ()
open (u, file = char (basename) // ".f90", &
status = "replace", action = "write")
write (u, "(A)") "! (Pseudo) matrix element code file &
&for WHIZARD self-test"
call write_test_me_code_3 (u, char (basename))
write (u, *)
write (u, "(A)") "subroutine " // char (basename) // "_" &
// char (feature) // " (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), intent(out) :: n"
write (u, "(A)") " n = 42"
write (u, "(A)") "end subroutine " // char (basename) // "_" &
// char (feature)
close (u)
end subroutine write_test_f_lib_file
@ %def write_test_module_file
@
The following matrix-element source code is identical to the previous
one, but modified such as to provide independent procedures without a
module envelope.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_me_code_3 (u, id)
integer, intent(in) :: u
character(*), intent(in) :: id
write (u, "(A)") "function " // id // "_get_md5sum () &
&result (cptr) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " type(c_ptr) :: cptr"
write (u, "(A)") " character(c_char), dimension(32), &
&target, save :: md5sum"
write (u, "(A)") " md5sum = copy (c_char_&
&'1234567890abcdef1234567890abcdef')"
write (u, "(A)") " cptr = c_loc (md5sum)"
write (u, "(A)") "contains"
write (u, "(A)") " function copy (md5sum)"
write (u, "(A)") " character(c_char), dimension(32) :: copy"
write (u, "(A)") " character(c_char), dimension(32), intent(in) :: &
&md5sum"
write (u, "(A)") " copy = md5sum"
write (u, "(A)") " end function copy"
write (u, "(A)") "end function " // id // "_get_md5sum"
write (u, *)
write (u, "(A)") "function " // id // "_openmp_supported () &
&result (status) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " logical(c_bool) :: status"
write (u, "(A)") " status = .false."
write (u, "(A)") "end function " // id // "_openmp_supported"
write (u, *)
write (u, "(A)") "function " // id // "_n_in () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_in"
write (u, *)
write (u, "(A)") "function " // id // "_n_out () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 2"
write (u, "(A)") "end function " // id // "_n_out"
write (u, *)
write (u, "(A)") "function " // id // "_n_flv () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_flv"
write (u, *)
write (u, "(A)") "function " // id // "_n_hel () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_hel"
write (u, *)
write (u, "(A)") "function " // id // "_n_cin () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 2"
write (u, "(A)") "end function " // id // "_n_cin"
write (u, *)
write (u, "(A)") "function " // id // "_n_col () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_col"
write (u, *)
write (u, "(A)") "function " // id // "_n_cf () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_cf"
write (u, *)
write (u, "(A)") "subroutine " // id // "_flv_state (flv_state) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: flv_state"
write (u, "(A)") " flv_state(1:3) = [1,2,3]"
write (u, "(A)") "end subroutine " // id // "_flv_state"
write (u, *)
write (u, "(A)") "subroutine " // id // "_hel_state (hel_state) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: hel_state"
write (u, "(A)") " hel_state(1:3) = [0,0,0]"
write (u, "(A)") "end subroutine " // id // "_hel_state"
write (u, *)
write (u, "(A)") "subroutine " // id // "_col_state &
&(col_state, ghost_flag) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) &
&:: col_state"
write (u, "(A)") " logical(c_bool), dimension(*), intent(out) &
&:: ghost_flag"
write (u, "(A)") " col_state(1:6) = [0,0, 0,0, 0,0]"
write (u, "(A)") " ghost_flag(1:3) = [.false., .false., .false.]"
write (u, "(A)") "end subroutine " // id // "_col_state"
write (u, *)
write (u, "(A)") "subroutine " // id // "_color_factors &
&(cf_index1, cf_index2, color_factors) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " use kinds"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: cf_index1"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: cf_index2"
write (u, "(A)") " complex(c_default_complex), dimension(*), &
&intent(out) :: color_factors"
write (u, "(A)") " cf_index1(1:1) = [1]"
write (u, "(A)") " cf_index2(1:1) = [1]"
write (u, "(A)") " color_factors(1:1) = [1]"
write (u, "(A)") "end subroutine " // id // "_color_factors"
end subroutine write_test_me_code_3
@ %def write_test_me_code_3
@
\subsubsection{Compile test with genuine C library}
Test 6: Write driver and makefile and try to compile and link the
library driver.
There is a single test process with a single feature. The process
code is provided as a C library of independent procedures.
These procedures should match the Fortran bind(C) interface.
<<Prclib interfaces: execute tests>>=
if (default == double .or. (CC_IS_GNU .and. CC_HAS_QUADMATH)) then
call test (prclib_interfaces_6, "prclib_interfaces_6", &
"compile and link (C library)", &
u, results)
end if
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_6
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_6 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
class(prc_writer_t), pointer :: test_writer_6
type(os_data_t) :: os_data
integer :: u_file
integer, dimension(:,:), allocatable :: flv_state
integer, dimension(:,:), allocatable :: hel_state
integer, dimension(:,:,:), allocatable :: col_state
logical, dimension(:,:), allocatable :: ghost_flag
integer, dimension(:,:), allocatable :: cf_index
complex(default), dimension(:), allocatable :: color_factors
character(32), parameter :: md5sum = "prclib_interfaces_6_md5sum "
type(c_funptr) :: proc1_ptr
interface
subroutine proc1_t (n) bind(C)
import
integer(c_int), intent(out) :: n
end subroutine proc1_t
end interface
procedure(proc1_t), pointer :: proc1
integer(c_int) :: n
write (u, "(A)") "* Test output: prclib_interfaces_6"
write (u, "(A)") "* Purpose: compile, link, and load process library"
write (u, "(A)") "* with (fake) matrix-element code &
&as a C library"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (1 process)"
write (u, "(A)")
call os_data_init (os_data)
allocate (test_writer_6_t :: test_writer_6)
call dispatch_prclib_driver (driver, var_str ("prclib6"), var_str (""))
call driver%init (1)
call driver%set_md5sum (md5sum)
call driver%set_record (1, var_str ("test6"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_6)
call driver%write (u)
write (u, *)
write (u, "(A)") "* Write makefile"
u_file = free_unit ()
open (u_file, file="prclib6.makefile", status="replace", action="write")
call driver%generate_makefile (u_file, os_data, verbose = .false.)
close (u_file)
write (u, "(A)") "* Write driver source code"
u_file = free_unit ()
open (u_file, file="prclib6.f90", status="replace", action="write")
call driver%generate_driver_code (u_file)
close (u_file)
write (u, "(A)") "* Write matrix-element source code"
call driver%make_source (os_data)
write (u, "(A)") "* Compile source code"
call driver%make_compile (os_data)
write (u, "(A)") "* Link library"
call driver%make_link (os_data)
write (u, "(A)") "* Load library"
call driver%load (os_data)
write (u, *)
call driver%write (u)
write (u, *)
if (driver%loaded) then
write (u, "(A)") "* Call library functions:"
write (u, *)
write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
write (u, "(1x,A,A)") "process_id = ", &
char (driver%get_process_id (1))
write (u, "(1x,A,A)") "model_name = ", &
char (driver%get_model_name (1))
write (u, "(1x,A,A)") "md5sum = ", &
char (driver%get_md5sum (1))
write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)
call driver%set_flv_state (1, flv_state)
write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state
call driver%set_hel_state (1, hel_state)
write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state
call driver%set_col_state (1, col_state, ghost_flag)
write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag
call driver%set_color_factors (1, color_factors, cf_index)
write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index
call driver%get_fptr (1, 1, proc1_ptr)
call c_f_procpointer (proc1_ptr, proc1)
if (associated (proc1)) then
write (u, *)
call proc1 (n)
write (u, "(1x,A,I0)") "proc1(1) = ", n
end if
end if
deallocate (test_writer_6)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_6"
end subroutine prclib_interfaces_6
@ %def prclib_interfaces_6
@ This version of test-code writer writes interfaces for all standard
features plus one specific feature. The interfaces are all bind(C),
so no wrapper is needed.
The driver part is identical to the Fortran case, so we simply extend
the previous [[test_writer_5]] type. We only have to override the
Makefile writer.
<<Prclib interfaces: test types>>=
type, extends (test_writer_5_t) :: test_writer_6_t
contains
procedure, nopass :: type_name => test_writer_6_type_name
procedure :: write_makefile_code => test_writer_6_mk
procedure :: write_source_code => test_writer_6_src
end type test_writer_6_t
@ %def test_writer_6
@
<<Prclib interfaces: test auxiliary>>=
function test_writer_6_type_name () result (string)
type(string_t) :: string
string = "test_6"
end function test_writer_6_type_name
subroutine test_writer_6_mk (writer, unit, id, os_data, verbose, testflag)
class(test_writer_6_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "SOURCES += ", char (id), ".c"
write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
write (unit, "(5A)") char (id), ".lo: ", char (id), ".c"
if (.not. verbose) then
write (unit, "(5A)") TAB // '@echo " FC " $@'
end if
write (unit, "(5A)") TAB, "$(LTCCOMPILE) $<"
end subroutine test_writer_6_mk
subroutine test_writer_6_src (writer, id)
class(test_writer_6_t), intent(in) :: writer
type(string_t), intent(in) :: id
call write_test_c_lib_file (id, var_str ("proc1"))
end subroutine test_writer_6_src
@ %def test_writer_6_type_name test_writer_6_mk
@
We need a test module file (actually, one for each process in the test
above) that allows us to check compilation and linking. The test
module implements a colorless $1\to 2$ process, and it implements one
additional function (feature), the name given as an argument.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_c_lib_file (basename, feature)
type(string_t), intent(in) :: basename
type(string_t), intent(in) :: feature
integer :: u
u = free_unit ()
open (u, file = char (basename) // ".c", &
status = "replace", action = "write")
write (u, "(A)") "/* (Pseudo) matrix element code file &
&for WHIZARD self-test */"
write (u, "(A)") "#include <stdbool.h>"
if (CC_HAS_QUADMATH) then
write (u, "(A)") "#include <quadmath.h>"
end if
write (u, *)
call write_test_me_code_4 (u, char (basename))
write (u, *)
write (u, "(A)") "void " // char (basename) // "_" &
// char (feature) // "(int* n) {"
write (u, "(A)") " *n = 42;"
write (u, "(A)") "}"
close (u)
end subroutine write_test_c_lib_file
@ %def write_test_module_file
@
The following matrix-element source code is equivalent to the code in
the previous example, but coded in C.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_me_code_4 (u, id)
integer, intent(in) :: u
character(*), intent(in) :: id
write (u, "(A)") "char* " // id // "_get_md5sum() {"
write (u, "(A)") " return ""1234567890abcdef1234567890abcdef"";"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "bool " // id // "_openmp_supported() {"
write (u, "(A)") " return false;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_in() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_out() {"
write (u, "(A)") " return 2;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_flv() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_hel() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_cin() {"
write (u, "(A)") " return 2;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_col() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_cf() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "void " // id // "_flv_state( int (*a)[] ) {"
write (u, "(A)") " static int flv_state[1][3] = { { 1, 2, 3 } };"
write (u, "(A)") " int j;"
write (u, "(A)") " for (j = 0; j < 3; j++) { (*a)[j] &
&= flv_state[0][j]; }"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "void " // id // "_hel_state( int (*a)[] ) {"
write (u, "(A)") " static int hel_state[1][3] = { { 0, 0, 0 } };"
write (u, "(A)") " int j;"
write (u, "(A)") " for (j = 0; j < 3; j++) { (*a)[j] &
&= hel_state[0][j]; }"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "void " // id // "_col_state&
&( int (*a)[], bool (*g)[] ) {"
write (u, "(A)") " static int col_state[1][3][2] = &
&{ { {0, 0}, {0, 0}, {0, 0} } };"
write (u, "(A)") " static bool ghost_flag[1][3] = &
&{ { false, false, false } };"
write (u, "(A)") " int j,k;"
write (u, "(A)") " for (j = 0; j < 3; j++) {"
write (u, "(A)") " for (k = 0; k < 2; k++) {"
write (u, "(A)") " (*a)[j*2+k] = col_state[0][j][k];"
write (u, "(A)") " }"
write (u, "(A)") " (*g)[j] = ghost_flag[0][j];"
write (u, "(A)") " }"
write (u, "(A)") "}"
write (u, *)
select case (DEFAULT_FC_PRECISION)
case ("quadruple")
write (u, "(A)") "void " // id // "_color_factors&
&( int (*cf_index1)[], int (*cf_index2)[], &
&__complex128 (*color_factors)[] ) {"
case ("extended")
write (u, "(A)") "void " // id // "_color_factors&
&( int (*cf_index1)[], int (*cf_index2)[], &
&long double _Complex (*color_factors)[] ) {"
case default
write (u, "(A)") "void " // id // "_color_factors&
&( int (*cf_index1)[], int (*cf_index2)[], &
&double _Complex (*color_factors)[] ) {"
end select
write (u, "(A)") " (*color_factors)[0] = 1;"
write (u, "(A)") " (*cf_index1)[0] = 1;"
write (u, "(A)") " (*cf_index2)[0] = 1;"
write (u, "(A)") "}"
end subroutine write_test_me_code_4
@ %def write_test_me_code_4
@
\subsubsection{Test cleanup targets}
Test 7: Repeat test 4 (create, compile, link Fortran module and
driver) and properly clean up all generated files.
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_7, "prclib_interfaces_7", &
"cleanup", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_7
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_7 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
class(prc_writer_t), pointer :: test_writer_4
type(os_data_t) :: os_data
integer :: u_file
character(32), parameter :: md5sum = "1234567890abcdef1234567890abcdef"
write (u, "(A)") "* Test output: prclib_interfaces_7"
write (u, "(A)") "* Purpose: compile and link process library"
write (u, "(A)") "* with (fake) matrix-element code &
&as a Fortran module"
write (u, "(A)") "* then clean up generated files"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (1 process)"
allocate (test_writer_4_t :: test_writer_4)
call os_data_init (os_data)
call dispatch_prclib_driver (driver, var_str ("prclib7"), var_str (""))
call driver%init (1)
call driver%set_md5sum (md5sum)
call driver%set_record (1, var_str ("test7"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_4)
write (u, "(A)") "* Write makefile"
u_file = free_unit ()
open (u_file, file="prclib7.makefile", status="replace", action="write")
call driver%generate_makefile (u_file, os_data, verbose = .false.)
close (u_file)
write (u, "(A)") "* Write driver source code"
u_file = free_unit ()
open (u_file, file="prclib7.f90", status="replace", action="write")
call driver%generate_driver_code (u_file)
close (u_file)
write (u, "(A)") "* Write matrix-element source code"
call driver%make_source (os_data)
write (u, "(A)") "* Compile source code"
call driver%make_compile (os_data)
write (u, "(A)") "* Link library"
call driver%make_link (os_data)
write (u, "(A)") "* File check"
write (u, *)
call check_file (u, "test7.f90")
call check_file (u, "tpr_test7.mod")
call check_file (u, "test7.lo")
call check_file (u, "prclib7.makefile")
call check_file (u, "prclib7.f90")
call check_file (u, "prclib7.lo")
call check_file (u, "prclib7.la")
write (u, *)
write (u, "(A)") "* Delete library"
write (u, *)
call driver%clean_library (os_data)
call check_file (u, "prclib7.la")
write (u, *)
write (u, "(A)") "* Delete object code"
write (u, *)
call driver%clean_objects (os_data)
call check_file (u, "test7.lo")
call check_file (u, "tpr_test7.mod")
call check_file (u, "prclib7.lo")
write (u, *)
write (u, "(A)") "* Delete source code"
write (u, *)
call driver%clean_source (os_data)
call check_file (u, "test7.f90")
write (u, *)
write (u, "(A)") "* Delete driver source code"
write (u, *)
call driver%clean_driver (os_data)
call check_file (u, "prclib7.f90")
write (u, *)
write (u, "(A)") "* Delete makefile"
write (u, *)
call driver%clean_makefile (os_data)
call check_file (u, "prclib7.makefile")
deallocate (test_writer_4)
write (u, *)
write (u, "(A)") "* Test output end: prclib_interfaces_7"
end subroutine prclib_interfaces_7
@ %def prclib_interfaces_7
@ Auxiliary routine: check and report existence of a file
<<Prclib interfaces: test auxiliary>>=
subroutine check_file (u, file)
integer, intent(in) :: u
character(*), intent(in) :: file
logical :: exist
inquire (file=file, exist=exist)
write (u, "(2x,A,A,L1)") file, " = ", exist
end subroutine check_file
@ %def check_file
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Abstract process core configuration}
In this module, we define abstract data types that handle the method-specific
part of defining a process (including all of its options) and accessing an
external matrix element.
There are no unit tests, these are deferred to the [[process_libraries]]
module below.
<<[[prc_core_def.f90]]>>=
<<File header>>
module prc_core_def
<<Use strings>>
use io_units
use diagnostics
use process_constants
use prclib_interfaces
<<Standard module head>>
<<Prc core def: public>>
<<Prc core def: types>>
<<Prc core def: interfaces>>
contains
<<Prc core def: procedures>>
end module prc_core_def
@ %def prc_core_def
@
\subsection{Process core definition type}
For storing configuration data that depend on the specific process
variant, we introduce a polymorphic type. At this point, we just
declare an abstract base type. This allows us to defer the
implementation to later modules.
There should be no components that need explicit finalization,
otherwise we would have to call a finalizer from the
[[process_component_def_t]] wrapper.
@ Translate a [[prc_core_def_t]] to above named integers
<<Prc core def: public>>=
public :: prc_core_def_t
<<Prc core def: types>>=
type, abstract :: prc_core_def_t
class(prc_writer_t), allocatable :: writer
contains
<<Prc core def: process core def: TBP>>
end type prc_core_def_t
@ %def prc_core_def_t
@ Interfaces for the deferred methods.
This returns a string. No passed argument; the string is constant and
depends just on the type.
<<Prc core def: process core def: TBP>>=
procedure (prc_core_def_get_string), nopass, deferred :: type_string
<<Prc core def: interfaces>>=
abstract interface
function prc_core_def_get_string () result (string)
import
type(string_t) :: string
end function prc_core_def_get_string
end interface
@ %def prc_core_def_get_string
@
The [[write]] method should
display the content completely.
<<Prc core def: process core def: TBP>>=
procedure (prc_core_def_write), deferred :: write
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_write (object, unit)
import
class(prc_core_def_t), intent(in) :: object
integer, intent(in) :: unit
end subroutine prc_core_def_write
end interface
@ %def prc_core_def_write
@
The [[read]] method should
fill the content completely.
<<Prc core def: process core def: TBP>>=
procedure (prc_core_def_read), deferred :: read
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_read (object, unit)
import
class(prc_core_def_t), intent(out) :: object
integer, intent(in) :: unit
end subroutine prc_core_def_read
end interface
@ %def prc_core_def_read
@ This communicates a MD5 checksum to the writer inside the [[core_def]]
object, if there is any. Usually, this checksum is not yet known at the time
when the writer is initialized.
<<Prc core def: process core def: TBP>>=
procedure :: set_md5sum => prc_core_def_set_md5sum
<<Prc core def: procedures>>=
subroutine prc_core_def_set_md5sum (core_def, md5sum)
class(prc_core_def_t), intent(inout) :: core_def
character(32) :: md5sum
if (allocated (core_def%writer)) core_def%writer%md5sum = md5sum
end subroutine prc_core_def_set_md5sum
@ %def prc_core_def_set_md5sum
@ Allocate an appropriate driver object which corresponds to the
chosen process core definition.
For internal matrix element (i.e., those which do not need external
code), the driver should have access to all matrix element information
from the beginning. In short, it is the matrix-element code.
For external matrix elements, the driver will get access to the
external matrix element code.
<<Prc core def: process core def: TBP>>=
procedure(prc_core_def_allocate_driver), deferred :: allocate_driver
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_allocate_driver (object, driver, basename)
import
class(prc_core_def_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
end subroutine prc_core_def_allocate_driver
end interface
@ %def prc_core_def_allocate_driver
@ This flag tells whether the particular variant needs external code.
We implement a default function which returns false. The flag
depends only on the type, therefore we implement it as [[nopass]].
<<Prc core def: process core def: TBP>>=
procedure, nopass :: needs_code => prc_core_def_needs_code
<<Prc core def: procedures>>=
function prc_core_def_needs_code () result (flag)
logical :: flag
flag = .false.
end function prc_core_def_needs_code
@ %def prc_core_def_needs_code
@ This subroutine allocates an array which holds the name of all
features that this process core implements. This feature
applies to matrix element code that is not coded as a Fortran module
but communicates via independent library functions, which follow the C
calling conventions. The addresses of those functions are returned as
C function pointers, which can be converted into Fortran procedure
pointers. The conversion is done in code specific for the process
variant; here we just retrieve the C function pointer.
The array returned here serves the purpose of writing specific
driver code. The driver interfaces only those C functions which are
supported for the given process core.
If the process core does not require external code, this array is
meaningless.
<<Prc core def: process core def: TBP>>=
procedure(prc_core_def_get_features), nopass, deferred &
:: get_features
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_get_features (features)
import
type(string_t), dimension(:), allocatable, intent(out) :: features
end subroutine prc_core_def_get_features
end interface
@ %def prc_core_def_get_features
@ Assign pointers to the process-specific procedures to the driver, if
the process is external.
<<Prc core def: process core def: TBP>>=
procedure(prc_core_def_connect), deferred :: connect
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_connect (def, lib_driver, i, proc_driver)
import
class(prc_core_def_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
end subroutine prc_core_def_connect
end interface
@ %def prc_core_def_connect
@
\subsection{Process core template}
We must be able to automatically allocate a process core definition object
with the appropriate type, given only the type name.
To this end, we introduce a [[prc_template_t]] type which is simply a wrapper
for an empty [[prc_core_def_t]] object. Choosing one of the templates from an
array, we can allocate the target object.
<<Prc core def: public>>=
public :: prc_template_t
<<Prc core def: types>>=
type :: prc_template_t
class(prc_core_def_t), allocatable :: core_def
end type prc_template_t
@ %def prc_template_t
@ The allocation routine. We use the [[source]] option of the [[allocate]]
statement. The [[mold]] option would probably more appropriate, but is a
F2008 feature.
<<Prc core def: public>>=
public :: allocate_core_def
<<Prc core def: procedures>>=
subroutine allocate_core_def (template, name, core_def)
type(prc_template_t), dimension(:), intent(in) :: template
type(string_t), intent(in) :: name
class(prc_core_def_t), allocatable :: core_def
integer :: i
do i = 1, size (template)
if (template(i)%core_def%type_string () == name) then
allocate (core_def, source = template(i)%core_def)
return
end if
end do
end subroutine allocate_core_def
@ %def allocate_core_def
@
\subsection{Process driver}
For each process component, we implement a driver object which holds
the calls to the matrix element and various auxiliary routines as
procedure pointers. Any actual calculation will use this object to
communicate with the process.
Depending on the type of process (as described by a corresponding
[[prc_core_def]] object), the procedure pointers may refer to
external or internal code, and there may be additional procedures for
certain types. The base type defined here is abstract.
<<Prc core def: public>>=
public :: prc_core_driver_t
<<Prc core def: types>>=
type, abstract :: prc_core_driver_t
contains
<<Prc core def: process driver: TBP>>
end type prc_core_driver_t
@ %def prc_core_driver_t
@ This returns the process type. No reference to contents.
<<Prc core def: process driver: TBP>>=
procedure(prc_core_driver_type_name), nopass, deferred :: type_name
<<Prc core def: interfaces>>=
abstract interface
function prc_core_driver_type_name () result (type)
import
type(string_t) :: type
end function prc_core_driver_type_name
end interface
@ %def prc_core_driver_type_name
@
\subsection{Process driver for intrinsic process}
This is an abstract extension for the driver type. It has one
additional method, namely a subroutine that fills the record of
constant process data. For an external process, this task is
performed by the external library driver instead.
<<Prc core def: public>>=
public :: process_driver_internal_t
<<Prc core def: types>>=
type, extends (prc_core_driver_t), abstract :: process_driver_internal_t
contains
<<Prc core def: process driver internal: TBP>>
end type process_driver_internal_t
@ %def process_driver_internal_t
<<Prc core def: process driver internal: TBP>>=
procedure(process_driver_fill_constants), deferred :: fill_constants
<<Prc core def: interfaces>>=
abstract interface
subroutine process_driver_fill_constants (driver, data)
import
class(process_driver_internal_t), intent(in) :: driver
type(process_constants_t), intent(out) :: data
end subroutine process_driver_fill_constants
end interface
@ %def process_driver_fill_constants
@
\subsection{Process driver for user-defined processes}
This is another abstract extension of the driver type. It links user-defined
matrix element methods like BLHA, which also allow the dircet calculation of
squared matrix elements.
<<Prc core def: public>>=
public :: prc_user_defined_base_driver_t
<<Prc core def: types>>=
type, abstract, extends (prc_core_driver_t) :: prc_user_defined_base_driver_t
end type prc_user_defined_base_driver_t
@ %def prc_user_defined_base_driver_t
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process library access}
\label{sec:process_libraries}
Processes (the code and data that are necessary for evaluating matrix
elements of a particular process or process component) are organized
in process libraries. In full form, process libraries contain
generated and dynamically compiled and linked code, so they are actual
libraries on the OS level. Alternatively, there may be simple
processes that can be generated without referring to external
libraries, and external libraries that are just linked in.
This module interfaces the OS to create, build, and use process
libraries.
We work with two related data structures. There is the list of
process configurations that stores the user input and data derived
from it. A given process configuration list is scanned for creating a
process library, which consists of both data and code. The creation
step involves calling external programs and incorporating external
code.
For the subsequent integration and event generation steps, we read the
process library. We also support partial (re)creation of the process
library. To this end, we should be able to reconstruct the
configuration data records from the process library.
<<[[process_libraries.f90]]>>=
<<File header>>
module process_libraries
use, intrinsic :: iso_c_binding !NODEP!
<<Use strings>>
use io_units
use diagnostics
use md5
use physics_defs
use os_interface
use model_data
use particle_specifiers
use process_constants
use prclib_interfaces
use prc_core_def
<<Standard module head>>
<<Process libraries: public>>
<<Process libraries: parameters>>
<<Process libraries: types>>
contains
<<Process libraries: procedures>>
end module process_libraries
@ %def process_libraries
@
\subsection{Auxiliary stuff}
Here is a small subroutine that strips the left-hand side and the
equals sign off an equation.
<<Process libraries: public>>=
public :: strip_equation_lhs
<<Process libraries: procedures>>=
subroutine strip_equation_lhs (buffer)
character(*), intent(inout) :: buffer
type(string_t) :: string, prefix
string = buffer
call split (string, prefix, "=")
buffer = string
end subroutine strip_equation_lhs
@ %def strip_equation_lhs
@
\subsection{Process definition objects}
We collect process configuration data in a derived type,
[[process_def_t]]. A process can be a collection of several
components which are treated as a single entity for the purpose of
observables and event generation. Multiple process components may
initially be defined by the user. The system may add additional
components, e.g., subtraction terms. The common data type is
[[process_component_def_t]]. Within each component, there are several
universal data items, and a part which depend on the particular
process variant. The latter is covered by an abstract type
[[prc_core_def_t]] and its extensions.
@
\subsubsection{Wrapper for components}
We define a wrapper type for the configuration of individual
components.
The string [[basename]] is used for building file, module, and
function names for the current process component. Initially, it will
be built from the corresponding process basename by appending an
alphanumeric suffix.
The logical [[initial]] tells whether this is a user-defined (true) or
system-generated (false) configuration.
The numbers [[n_in]], [[n_out]], and [[n_tot]] denote the incoming,
outgoing and total number of particles (partons) participating in the
process component, respectively. These are the nominal particles, as
input by the user (recombination may change the particle content, for
the output events).
The string arrays [[prt_in]] and [[prt_out]] hold the particle
specifications as provided by the user. For a system-generated
process component, they remain deallocated.
The [[method]] string is used to determine the type of process matrix
element and how it is obtained.
The [[description]] string collects the information about particle
content and method in a single human-readable string.
The pointer object [[core_def]] is allocated according to the
actual process variant, which depends on the method. The subobject
holds any additional configuration data that is relevant for the
process component.
We assume that no finalizer is needed.
<<Process libraries: public>>=
public :: process_component_def_t
<<Process libraries: types>>=
type :: process_component_def_t
private
type(string_t) :: basename
logical :: initial = .false.
integer :: n_in = 0
integer :: n_out = 0
integer :: n_tot = 0
type(prt_spec_t), dimension(:), allocatable :: prt_in
type(prt_spec_t), dimension(:), allocatable :: prt_out
type(string_t) :: method
type(string_t) :: description
class(prc_core_def_t), allocatable :: core_def
character(32) :: md5sum = ""
integer :: nlo_type = BORN
integer, dimension(N_ASSOCIATED_COMPONENTS) :: associated_components = 0
logical :: active
integer :: fixed_emitter = -1
integer :: alpha_power = 0
integer :: alphas_power = 0
contains
<<Process libraries: process component def: TBP>>
end type process_component_def_t
@ %def process_component_def_t
@ Display the complete content.
<<Process libraries: process component def: TBP>>=
procedure :: write => process_component_def_write
<<Process libraries: procedures>>=
subroutine process_component_def_write (object, unit)
class(process_component_def_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,A)") "Component ID = ", char (object%basename)
write (u, "(3x,A,L1)") "Initial component = ", object%initial
write (u, "(3x,A,I0,1x,I0,1x,I0)") "N (in, out, tot) = ", &
object%n_in, object%n_out, object%n_tot
write (u, "(3x,A)", advance="no") "Particle content = "
if (allocated (object%prt_in)) then
call prt_spec_write (object%prt_in, u, advance="no")
else
write (u, "(A)", advance="no") "[undefined]"
end if
write (u, "(A)", advance="no") " => "
if (allocated (object%prt_out)) then
call prt_spec_write (object%prt_out, u, advance="no")
else
write (u, "(A)", advance="no") "[undefined]"
end if
write (u, "(A)")
if (object%method /= "") then
write (u, "(3x,A,A)") "Method = ", &
char (object%method)
else
write (u, "(3x,A)") "Method = [undefined]"
end if
if (allocated (object%core_def)) then
write (u, "(3x,A,A)") "Process variant = ", &
char (object%core_def%type_string ())
call object%core_def%write (u)
else
write (u, "(3x,A)") "Process variant = [undefined]"
end if
write (u, "(3x,A,A,A)") "MD5 sum (def) = '", object%md5sum, "'"
end subroutine process_component_def_write
@ %def process_component_def_write
@ Read the process component definition. Allocate the process variant
definition with appropriate type, matching the type name on file with
the provided templates.
<<Process libraries: process component def: TBP>>=
procedure :: read => process_component_def_read
<<Process libraries: procedures>>=
subroutine process_component_def_read (component, unit, core_def_templates)
class(process_component_def_t), intent(out) :: component
integer, intent(in) :: unit
type(prc_template_t), dimension(:), intent(in) :: core_def_templates
character(80) :: buffer
type(string_t) :: var_buffer, prefix, in_state, out_state
type(string_t) :: variant_type
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
component%basename = trim (adjustl (buffer))
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) component%initial
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) component%n_in, component%n_out, component%n_tot
call get (unit, var_buffer)
call split (var_buffer, prefix, "=") ! keeps 'in => out'
call split (var_buffer, prefix, "=") ! actually: separator is '=>'
in_state = prefix
if (component%n_in > 0) then
call prt_spec_read (component%prt_in, in_state)
end if
out_state = extract (var_buffer, 2)
if (component%n_out > 0) then
call prt_spec_read (component%prt_out, out_state)
end if
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
component%method = trim (adjustl (buffer))
if (component%method == "[undefined]") &
component%method = ""
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
variant_type = trim (adjustl (buffer))
call allocate_core_def &
(core_def_templates, variant_type, component%core_def)
if (allocated (component%core_def)) then
call component%core_def%read (unit)
end if
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer(3:34), "(A32)") component%md5sum
end subroutine process_component_def_read
@ %def process_component_def_read
@ Short account.
<<Process libraries: process component def: TBP>>=
procedure :: show => process_component_def_show
<<Process libraries: procedures>>=
subroutine process_component_def_show (object, unit)
class(process_component_def_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(6x,A)", advance="no") char (object%basename)
if (.not. object%initial) &
write (u, "('*')", advance="no")
write (u, "(':',1x)", advance="no")
if (allocated (object%prt_in)) then
call prt_spec_write (object%prt_in, u, advance="no")
else
write (u, "(A)", advance="no") "[undefined]"
end if
write (u, "(A)", advance="no") " => "
if (allocated (object%prt_out)) then
call prt_spec_write (object%prt_out, u, advance="no")
else
write (u, "(A)", advance="no") "[undefined]"
end if
if (object%method /= "") then
write (u, "(2x,'[',A,']')") char (object%method)
else
write (u, *)
end if
end subroutine process_component_def_show
@ %def process_component_def_show
@ Compute the MD5 sum of a process component. We reset the stored MD5
sum to the empty string (so a previous value is not included in the
calculation), the write a temporary file and calculate the MD5 sum of
that file.
This implies that all data that are displayed by the [[write]] method
become part of the MD5 sum calculation.
The [[model]] is not part of the object, but must be included in the MD5 sum.
Otherwise, modifying the model and nothing else would not trigger remaking the
process-component source. Note that the model parameters may change later and
therefore are not incorporated.
After the MD5 sum of the component has been computed, we communicate it to the
[[writer]] subobject of the specific [[core_def]] component. Although these
types are abstract, the MD5-related features are valid for the abstract
types.
<<Process libraries: process component def: TBP>>=
procedure :: compute_md5sum => process_component_def_compute_md5sum
<<Process libraries: procedures>>=
subroutine process_component_def_compute_md5sum (component, model)
class(process_component_def_t), intent(inout) :: component
class(model_data_t), intent(in), optional, target :: model
integer :: u
component%md5sum = ""
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
if (present (model)) write (u, "(A32)") model%get_md5sum ()
call component%write (u)
rewind (u)
component%md5sum = md5sum (u)
close (u)
if (allocated (component%core_def)) then
call component%core_def%set_md5sum (component%md5sum)
end if
end subroutine process_component_def_compute_md5sum
@ %def process_component_def_compute_md5sum
@
<<Process libraries: process component def: TBP>>=
procedure :: get_def_type_string => process_component_def_get_def_type_string
<<Process libraries: procedures>>=
function process_component_def_get_def_type_string (component) result (type_string)
type(string_t) :: type_string
class(process_component_def_t), intent(in) :: component
type_string = component%core_def%type_string ()
end function process_component_def_get_def_type_string
@ %def process_component_def_get_def_type_string
@ Allocate the process driver (with a suitable type) for a process
component. For internal processes, we may set all data already at
this stage.
<<Process libraries: process component def: TBP>>=
procedure :: allocate_driver => process_component_def_allocate_driver
<<Process libraries: procedures>>=
subroutine process_component_def_allocate_driver (component, driver)
class(process_component_def_t), intent(in) :: component
class(prc_core_driver_t), intent(out), allocatable :: driver
if (allocated (component%core_def)) then
call component%core_def%allocate_driver (driver, component%basename)
end if
end subroutine process_component_def_allocate_driver
@ %def process_component_def_allocate_driver
@ Tell whether the process core needs external code.
<<Process libraries: process component def: TBP>>=
procedure :: needs_code => process_component_def_needs_code
<<Process libraries: procedures>>=
function process_component_def_needs_code (component) result (flag)
class(process_component_def_t), intent(in) :: component
logical :: flag
flag = component%core_def%needs_code ()
end function process_component_def_needs_code
@ %def process_component_def_needs_code
@ If there is external code, the [[core_def]] subobject should
provide a writer object. This method returns a pointer to the writer.
<<Process libraries: process component def: TBP>>=
procedure :: get_writer_ptr => process_component_def_get_writer_ptr
<<Process libraries: procedures>>=
function process_component_def_get_writer_ptr (component) result (writer)
class(process_component_def_t), intent(in), target :: component
class(prc_writer_t), pointer :: writer
writer => component%core_def%writer
end function process_component_def_get_writer_ptr
@ %def process_component_def_get_writer_ptr
@ Return an array which holds the names of all C functions that this
process component implements.
<<Process libraries: process component def: TBP>>=
procedure :: get_features => process_component_def_get_features
<<Process libraries: procedures>>=
function process_component_def_get_features (component) result (features)
class(process_component_def_t), intent(in) :: component
type(string_t), dimension(:), allocatable :: features
call component%core_def%get_features (features)
end function process_component_def_get_features
@ %def process_component_def_get_features
@ Assign procedure pointers in the [[driver]] component (external
processes). For internal processes, this is meaningless.
<<Process libraries: process component def: TBP>>=
procedure :: connect => process_component_def_connect
<<Process libraries: procedures>>=
subroutine process_component_def_connect &
(component, lib_driver, i, proc_driver)
class(process_component_def_t), intent(in) :: component
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
select type (proc_driver)
class is (process_driver_internal_t)
!!! Nothing to do
class default
call component%core_def%connect (lib_driver, i, proc_driver)
end select
end subroutine process_component_def_connect
@ %def process_component_def_connect
@ Return a pointer to the process core definition, which is of
abstract type.
<<Process libraries: process component def: TBP>>=
procedure :: get_core_def_ptr => process_component_get_core_def_ptr
<<Process libraries: procedures>>=
function process_component_get_core_def_ptr (component) result (ptr)
class(process_component_def_t), intent(in), target :: component
class(prc_core_def_t), pointer :: ptr
ptr => component%core_def
end function process_component_get_core_def_ptr
@ %def process_component_get_core_def_ptr
@ Return nominal particle counts, as input by the user.
<<Process libraries: process component def: TBP>>=
procedure :: get_n_in => process_component_def_get_n_in
procedure :: get_n_out => process_component_def_get_n_out
procedure :: get_n_tot => process_component_def_get_n_tot
<<Process libraries: procedures>>=
function process_component_def_get_n_in (component) result (n_in)
class(process_component_def_t), intent(in) :: component
integer :: n_in
n_in = component%n_in
end function process_component_def_get_n_in
function process_component_def_get_n_out (component) result (n_out)
class(process_component_def_t), intent(in) :: component
integer :: n_out
n_out = component%n_out
end function process_component_def_get_n_out
function process_component_def_get_n_tot (component) result (n_tot)
class(process_component_def_t), intent(in) :: component
integer :: n_tot
n_tot = component%n_tot
end function process_component_def_get_n_tot
@ %def process_component_def_get_n_in
@ %def process_component_def_get_n_out
@ %def process_component_def_get_n_tot
@ Allocate and return string arrays for the incoming and outgoing particles.
<<Process libraries: process component def: TBP>>=
procedure :: get_prt_in => process_component_def_get_prt_in
procedure :: get_prt_out => process_component_def_get_prt_out
<<Process libraries: procedures>>=
subroutine process_component_def_get_prt_in (component, prt)
class(process_component_def_t), intent(in) :: component
type(string_t), dimension(:), intent(out), allocatable :: prt
integer :: i
allocate (prt (component%n_in))
do i = 1, component%n_in
prt(i) = component%prt_in(i)%to_string ()
end do
end subroutine process_component_def_get_prt_in
subroutine process_component_def_get_prt_out (component, prt)
class(process_component_def_t), intent(in) :: component
type(string_t), dimension(:), intent(out), allocatable :: prt
integer :: i
allocate (prt (component%n_out))
do i = 1, component%n_out
prt(i) = component%prt_out(i)%to_string ()
end do
end subroutine process_component_def_get_prt_out
@ %def process_component_def_get_prt_in
@ %def process_component_def_get_prt_out
@ Return the incoming and outgoing particle specifiers as-is.
<<Process libraries: process component def: TBP>>=
procedure :: get_prt_spec_in => process_component_def_get_prt_spec_in
procedure :: get_prt_spec_out => process_component_def_get_prt_spec_out
<<Process libraries: procedures>>=
function process_component_def_get_prt_spec_in (component) result (prt)
class(process_component_def_t), intent(in) :: component
type(prt_spec_t), dimension(:), allocatable :: prt
allocate (prt (component%n_in))
prt(:) = component%prt_in(:)
end function process_component_def_get_prt_spec_in
function process_component_def_get_prt_spec_out (component) result (prt)
class(process_component_def_t), intent(in) :: component
type(prt_spec_t), dimension(:), allocatable :: prt
allocate (prt (component%n_out))
prt(:) = component%prt_out(:)
end function process_component_def_get_prt_spec_out
@ %def process_component_def_get_prt_spec_in
@ %def process_component_def_get_prt_spec_out
@ Return the combination of incoming particles as a PDG code
<<Process libraries: process component def: TBP>>=
procedure :: get_pdg_in => process_component_def_get_pdg_in
<<Process libraries: procedures>>=
subroutine process_component_def_get_pdg_in (component, model, pdg)
class(process_component_def_t), intent(in) :: component
class(model_data_t), intent(in), target :: model
integer, intent(out), dimension(:) :: pdg
integer :: i
do i = 1, size (pdg)
pdg(i) = model%get_pdg (component%prt_in(i)%to_string ())
end do
end subroutine process_component_def_get_pdg_in
@ %def process_component_def_get_pdg_in
@ Return the MD5 sum.
<<Process libraries: process component def: TBP>>=
procedure :: get_md5sum => process_component_def_get_md5sum
<<Process libraries: procedures>>=
pure function process_component_def_get_md5sum (component) result (md5sum)
class(process_component_def_t), intent(in) :: component
character(32) :: md5sum
md5sum = component%md5sum
end function process_component_def_get_md5sum
@ %def process_component_def_get_md5sum
@ Get NLO data
<<Process libraries: process component def: TBP>>=
procedure :: get_nlo_type => process_component_def_get_nlo_type
procedure :: get_associated_born &
=> process_component_def_get_associated_born
procedure :: get_associated_real_fin &
=> process_component_def_get_associated_real_fin
procedure :: get_associated_real_sing &
=> process_component_def_get_associated_real_sing
procedure :: get_associated_subtraction &
=> process_component_def_get_associated_subtraction
procedure :: get_association_list &
=> process_component_def_get_association_list
procedure :: can_be_integrated &
=> process_component_def_can_be_integrated
procedure :: get_associated_real => process_component_def_get_associated_real
<<Process libraries: procedures>>=
elemental function process_component_def_get_nlo_type (component) result (nlo_type)
integer :: nlo_type
class(process_component_def_t), intent(in) :: component
nlo_type = component%nlo_type
end function process_component_def_get_nlo_type
elemental function process_component_def_get_associated_born (component) result (i_born)
integer :: i_born
class(process_component_def_t), intent(in) :: component
i_born = component%associated_components(ASSOCIATED_BORN)
end function process_component_def_get_associated_born
elemental function process_component_def_get_associated_real_fin (component) result (i_rfin)
integer :: i_rfin
class(process_component_def_t), intent(in) :: component
i_rfin = component%associated_components(ASSOCIATED_REAL_FIN)
end function process_component_def_get_associated_real_fin
elemental function process_component_def_get_associated_real_sing (component) result (i_rsing)
integer :: i_rsing
class(process_component_def_t), intent(in) :: component
i_rsing = component%associated_components(ASSOCIATED_REAL_SING)
end function process_component_def_get_associated_real_sing
elemental function process_component_def_get_associated_subtraction (component) result (i_sub)
integer :: i_sub
class(process_component_def_t), intent(in) :: component
i_sub = component%associated_components(ASSOCIATED_SUB)
end function process_component_def_get_associated_subtraction
elemental function process_component_def_can_be_integrated (component) result (active)
logical :: active
class(process_component_def_t), intent(in) :: component
active = component%active
end function process_component_def_can_be_integrated
function process_component_def_get_association_list (component, i_skip_in) result (list)
integer, dimension(:), allocatable :: list
class(process_component_def_t), intent(in) :: component
integer, intent(in), optional :: i_skip_in
integer :: i, j, n, i_skip
logical :: valid
i_skip = 0; if (present (i_skip_in)) i_skip = i_skip_in
n = count (component%associated_components /= 0) - 1
if (i_skip > 0) n = n - 1
allocate (list (n))
j = 1
do i = 1, size(component%associated_components)
valid = component%associated_components(i) /= 0 &
.and. i /= ASSOCIATED_SUB .and. i /= i_skip
if (valid) then
list(j) = component%associated_components(i)
j = j + 1
end if
end do
end function process_component_def_get_association_list
function process_component_def_get_associated_real (component) result (i_real)
integer :: i_real
class(process_component_def_t), intent(in) :: component
i_real = component%associated_components(ASSOCIATED_REAL)
end function process_component_def_get_associated_real
@ %def process_component_def_get_nlo_type, process_component_def_get_associated_born
@ %def process_component_def_can_be_integrated
@ %def process_component_def_get_association_list
@ %def process_component_def_get_associated_real
@ %def process_component_def_get_associated_real_fin
@ %def process_component_def_get_associated_subtraction
@
<<Process libraries: process component def: TBP>>=
procedure :: get_me_method => process_component_def_get_me_method
<<Process libraries: procedures>>=
elemental function process_component_def_get_me_method (component) result (method)
type(string_t) :: method
class(process_component_def_t), intent(in) :: component
method = component%method
end function process_component_def_get_me_method
@ %def process_component_def_get_me_method
@
<<Process libraries: process component def: TBP>>=
procedure :: get_fixed_emitter => process_component_def_get_fixed_emitter
<<Process libraries: procedures>>=
function process_component_def_get_fixed_emitter (component) result (emitter)
integer :: emitter
class(process_component_def_t), intent(in) :: component
emitter = component%fixed_emitter
end function process_component_def_get_fixed_emitter
@ %def process_component_def_get_fixed_emitter
@
<<Process libraries: process component def: TBP>>=
procedure :: get_coupling_powers => process_component_def_get_coupling_powers
<<Process libraries: procedures>>=
pure subroutine process_component_def_get_coupling_powers (component, alpha_power, alphas_power)
class(process_component_def_t), intent(in) :: component
integer, intent(out) :: alpha_power, alphas_power
alpha_power = component%alpha_power
alphas_power = component%alphas_power
end subroutine process_component_def_get_coupling_powers
@ %def process_component_def_get_coupling_powers
@
\subsubsection{Process definition}
The process component definitions are collected in a common process
definition object.
The [[id]] is the ID string that the user has provided for identifying
this process. It must be a string that is allowed as part of a
Fortran variable name, since it may be used for generating code.
The number [[n_in]] is 1 or 2 for a decay or scattering process,
respectively. This must be identical to [[n_in]] for all components.
The initial and extra component definitions (see above) are allocated as the
[[initial]] and [[extra]] arrays, respectively. The latter
are determined from the former.
The [[md5sum]] is used to verify the integrity of the configuration.
<<Process libraries: public>>=
public :: process_def_t
<<Process libraries: types>>=
type :: process_def_t
private
type(string_t) :: id
integer :: num_id = 0
class(model_data_t), pointer :: model => null ()
type(string_t) :: model_name
integer :: n_in = 0
integer :: n_initial = 0
integer :: n_extra = 0
type(process_component_def_t), dimension(:), allocatable :: initial
type(process_component_def_t), dimension(:), allocatable :: extra
character(32) :: md5sum = ""
logical :: nlo_process = .false.
logical :: requires_resonances = .false.
contains
<<Process libraries: process def: TBP>>
end type process_def_t
@ %def process_def_t
@ Write the process definition including components:
<<Process libraries: process def: TBP>>=
procedure :: write => process_def_write
<<Process libraries: procedures>>=
subroutine process_def_write (object, unit)
class(process_def_t), intent(in) :: object
integer, intent(in) :: unit
integer :: i
write (unit, "(1x,A,A,A)") "ID = '", char (object%id), "'"
if (object%num_id /= 0) &
write (unit, "(1x,A,I0)") "ID(num) = ", object%num_id
select case (object%n_in)
case (1); write (unit, "(1x,A)") "Decay"
case (2); write (unit, "(1x,A)") "Scattering"
case default
write (unit, "(1x,A)") "[Undefined process]"
return
end select
if (object%model_name /= "") then
write (unit, "(1x,A,A)") "Model = ", char (object%model_name)
else
write (unit, "(1x,A)") "Model = [undefined]"
end if
write (unit, "(1x,A,I0)") "Initially defined component(s) = ", &
object%n_initial
write (unit, "(1x,A,I0)") "Extra generated component(s) = ", &
object%n_extra
if (object%requires_resonances) then
! This line has to matched with the reader below!
write (unit, "(1x,A,I0)") "Resonant subprocesses required"
end if
write (unit, "(1x,A,A,A)") "MD5 sum = '", object%md5sum, "'"
if (allocated (object%initial)) then
do i = 1, size (object%initial)
write (unit, "(1x,A,I0)") "Component #", i
call object%initial(i)%write (unit)
end do
end if
if (allocated (object%extra)) then
do i = 1, size (object%extra)
write (unit, "(1x,A,I0)") "Component #", object%n_initial + i
call object%extra(i)%write (unit)
end do
end if
end subroutine process_def_write
@ %def process_def_write
@ Read the process definition including components.
<<Process libraries: process def: TBP>>=
procedure :: read => process_def_read
<<Process libraries: procedures>>=
subroutine process_def_read (object, unit, core_def_templates)
class(process_def_t), intent(out) :: object
integer, intent(in) :: unit
type(prc_template_t), dimension(:), intent(in) :: core_def_templates
integer :: i, i1, i2
character(80) :: buffer, ref
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
i1 = scan (buffer, "'")
i2 = scan (buffer, "'", back=.true.)
if (i2 > i1) then
object%id = buffer(i1+1:i2-1)
else
object%id = ""
end if
read (unit, "(A)") buffer
select case (buffer(2:11))
case ("Decay "); object%n_in = 1
case ("Scattering"); object%n_in = 2
case default
return
end select
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
object%model_name = trim (adjustl (buffer))
if (object%model_name == "[undefined]") object%model_name = ""
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) object%n_initial
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) object%n_extra
read (unit, "(A)") buffer
if (buffer(1:9) == " Resonant") then
object%requires_resonances = .true.
read (unit, "(A)") buffer
else
object%requires_resonances = .false.
end if
call strip_equation_lhs (buffer)
read (buffer(3:34), "(A32)") object%md5sum
if (object%n_initial > 0) then
allocate (object%initial (object%n_initial))
do i = 1, object%n_initial
read (unit, "(A)") buffer
write (ref, "(1x,A,I0)") "Component #", i
if (buffer /= ref) return ! Wrong component header
call object%initial(i)%read (unit, core_def_templates)
end do
end if
end subroutine process_def_read
@ %def process_def_read
@ Short account.
<<Process libraries: process def: TBP>>=
procedure :: show => process_def_show
<<Process libraries: procedures>>=
subroutine process_def_show (object, unit)
class(process_def_t), intent(in) :: object
integer, intent(in) :: unit
integer :: i
write (unit, "(4x,A)", advance="no") char (object%id)
if (object%num_id /= 0) &
write (unit, "(1x,'(',I0,')')", advance="no") object%num_id
if (object%model_name /= "") &
write (unit, "(1x,'[',A,']')", advance="no") char (object%model_name)
if (object%requires_resonances) then
write (unit, "(1x,A)", advance="no") "[+ resonant subprocesses]"
end if
write (unit, *)
if (allocated (object%initial)) then
do i = 1, size (object%initial)
call object%initial(i)%show (unit)
end do
end if
if (allocated (object%extra)) then
do i = 1, size (object%extra)
call object%extra(i)%show (unit)
end do
end if
end subroutine process_def_show
@ %def process_def_show
@ Initialize an entry (initialize the process definition inside). We
allocate the 'initial' set of components. Extra components remain
unallocated.
The model should be present as a pointer. This allows us to retrieve the
model's MD5 sum. However, for various tests it is sufficient to have the
name.
We create the basenames for the process components by appending a
suffix which we increment for each component.
<<Process libraries: process def: TBP>>=
procedure :: init => process_def_init
<<Process libraries: procedures>>=
subroutine process_def_init (def, id, &
model, model_name, n_in, n_components, num_id, &
nlo_process, requires_resonances)
class(process_def_t), intent(out) :: def
type(string_t), intent(in), optional :: id
class(model_data_t), intent(in), optional, target :: model
type(string_t), intent(in), optional :: model_name
integer, intent(in), optional :: n_in
integer, intent(in), optional :: n_components
integer, intent(in), optional :: num_id
logical, intent(in), optional :: nlo_process
logical, intent(in), optional :: requires_resonances
character(16) :: suffix
integer :: i
if (present (id)) then
def%id = id
else
def%id = ""
end if
if (present (num_id)) then
def%num_id = num_id
end if
if (present (model)) then
def%model => model
def%model_name = model%get_name ()
else
def%model => null ()
if (present (model_name)) then
def%model_name = model_name
else
def%model_name = ""
end if
end if
if (present (n_in)) def%n_in = n_in
if (present (n_components)) then
def%n_initial = n_components
allocate (def%initial (n_components))
end if
if (present (nlo_process)) then
def%nlo_process = nlo_process
end if
if (present (requires_resonances)) then
def%requires_resonances = requires_resonances
end if
def%initial%initial = .true.
def%initial%method = ""
do i = 1, def%n_initial
write (suffix, "(A,I0)") "_i", i
def%initial(i)%basename = def%id // trim (suffix)
end do
def%initial%description = ""
end subroutine process_def_init
@ %def process_def_init
@ Explicitly set the model name (for unit test).
<<Process libraries: process def: TBP>>=
procedure :: set_model_name => process_def_set_model_name
<<Process libraries: procedures>>=
subroutine process_def_set_model_name (def, model_name)
class(process_def_t), intent(inout) :: def
type(string_t), intent(in) :: model_name
def%model_name = model_name
end subroutine process_def_set_model_name
@ %def process_def_set_model_name
@ Initialize an initial component. The particle content
must be specified. The process core block is not (yet) allocated.
We assume that the particle arrays match the [[n_in]] and
[[n_out]] values in size. The model is referred to by name; it is
identified as an existing model later. The index [[i]] must refer to
an existing element of the component array.
Data specific for the process core of a component are imported as
the [[core_def]] argument. We should allocate an object of class
[[prc_core_def_t]] with the appropriate specific type, fill it,
and transfer it to the process component definition here. The
allocation is moved, so the original allocated object is returned empty.
<<Process libraries: process def: TBP>>=
procedure :: import_component => process_def_import_component
<<Process libraries: procedures>>=
subroutine process_def_import_component (def, &
i, n_out, prt_in, prt_out, method, variant, &
nlo_type, can_be_integrated)
class(process_def_t), intent(inout) :: def
integer, intent(in) :: i
integer, intent(in), optional :: n_out
type(prt_spec_t), dimension(:), intent(in), optional :: prt_in
type(prt_spec_t), dimension(:), intent(in), optional :: prt_out
type(string_t), intent(in), optional :: method
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: can_be_integrated
type(string_t) :: nlo_type_string
class(prc_core_def_t), &
intent(inout), allocatable, optional :: variant
integer :: p
associate (comp => def%initial(i))
if (present (n_out)) then
comp%n_in = def%n_in
comp%n_out = n_out
comp%n_tot = def%n_in + n_out
end if
if (present (prt_in)) then
allocate (comp%prt_in (size (prt_in)))
comp%prt_in = prt_in
end if
if (present (prt_out)) then
allocate (comp%prt_out (size (prt_out)))
comp%prt_out = prt_out
end if
if (present (method)) comp%method = method
if (present (variant)) then
call move_alloc (variant, comp%core_def)
end if
if (present (nlo_type)) then
comp%nlo_type = nlo_type
end if
if (present (can_be_integrated)) then
comp%active = can_be_integrated
else
comp%active = .true.
end if
if (allocated (comp%prt_in) .and. allocated (comp%prt_out)) then
associate (d => comp%description)
d = ""
do p = 1, size (prt_in)
if (p > 1) d = d // ", "
d = d // comp%prt_in(p)%to_string ()
end do
d = d // " => "
do p = 1, size (prt_out)
if (p > 1) d = d // ", "
d = d // comp%prt_out(p)%to_string ()
end do
if (comp%method /= "") then
! TODO: (bcn 2016-09-16) better output for subtraction
if ((def%nlo_process .and. .not. comp%active) .or. &
comp%nlo_type == NLO_SUBTRACTION) then
d = d // " [inactive]"
else
d = d // " [" // comp%method // "]"
end if
end if
nlo_type_string = component_status (comp%nlo_type)
if (nlo_type_string /= "born") then
d = d // ", [" // nlo_type_string // "]"
end if
end associate
end if
end associate
end subroutine process_def_import_component
@ %def process_def_import_component
@
<<Process libraries: process def: TBP>>=
procedure :: get_n_components => process_def_get_n_components
<<Process libraries: procedures>>=
function process_def_get_n_components (def) result (n)
class(process_def_t), intent(in) :: def
integer :: n
n = size (def%initial)
end function process_def_get_n_components
@ %def process_def_get_n_components
@
<<Process libraries: process def: TBP>>=
procedure :: set_fixed_emitter => process_def_set_fixed_emitter
<<Process libraries: procedures>>=
subroutine process_def_set_fixed_emitter (def, i, emitter)
class(process_def_t), intent(inout) :: def
integer, intent(in) :: i, emitter
def%initial(i)%fixed_emitter = emitter
end subroutine process_def_set_fixed_emitter
@ %def process_def_set_fixed_emitter
@
<<Process libraries: process def: TBP>>=
procedure :: set_coupling_powers => process_def_set_coupling_powers
<<Process libraries: procedures>>=
subroutine process_def_set_coupling_powers (def, alpha_power, alphas_power)
class(process_def_t), intent(inout) :: def
integer, intent(in) :: alpha_power, alphas_power
def%initial(1)%alpha_power = alpha_power
def%initial(1)%alphas_power = alphas_power
end subroutine process_def_set_coupling_powers
@ %def process_def_set_coupling_powers
@
<<Process libraries: process def: TBP>>=
procedure :: set_associated_components => &
process_def_set_associated_components
<<Process libraries: procedures>>=
subroutine process_def_set_associated_components (def, i, &
i_list, remnant, real_finite, mismatch)
class(process_def_t), intent(inout) :: def
logical, intent(in) :: remnant, real_finite, mismatch
integer, intent(in) :: i
integer, dimension(:), intent(in) :: i_list
integer :: add_index
add_index = 0
associate (comp => def%initial(i)%associated_components)
comp(ASSOCIATED_BORN) = i_list(1)
comp(ASSOCIATED_REAL) = i_list(2)
comp(ASSOCIATED_VIRT) = i_list(3)
comp(ASSOCIATED_SUB) = i_list(4)
if (remnant) then
comp(ASSOCIATED_PDF) = i_list(5)
add_index = add_index + 1
end if
if (real_finite) then
comp(ASSOCIATED_REAL_FIN) = i_list(5+add_index)
add_index = add_index + 1
end if
if (mismatch) then
!!! incomplete
end if
end associate
end subroutine process_def_set_associated_components
@ %def process_def_set_associated_components
@
Compute the MD5 sum for this process definition. We compute the MD5
sums for all components individually, than concatenate a string of
those and compute the MD5 sum of this string. We also include the
model name. All other data part of the component definitions.
<<Process libraries: process def: TBP>>=
procedure :: compute_md5sum => process_def_compute_md5sum
<<Process libraries: procedures>>=
subroutine process_def_compute_md5sum (def, model)
class(process_def_t), intent(inout) :: def
class(model_data_t), intent(in), optional, target :: model
integer :: i
type(string_t) :: buffer
buffer = def%model_name
do i = 1, def%n_initial
call def%initial(i)%compute_md5sum (model)
buffer = buffer // def%initial(i)%md5sum
end do
do i = 1, def%n_extra
call def%extra(i)%compute_md5sum (model)
buffer = buffer // def%initial(i)%md5sum
end do
def%md5sum = md5sum (char (buffer))
end subroutine process_def_compute_md5sum
@ %def process_def_compute_md5sum
@ Return the MD5 sum of the process or of a process component.
<<Process libraries: process def: TBP>>=
procedure :: get_md5sum => process_def_get_md5sum
<<Process libraries: procedures>>=
function process_def_get_md5sum (def, i_component) result (md5sum)
class(process_def_t), intent(in) :: def
integer, intent(in), optional :: i_component
character(32) :: md5sum
if (present (i_component)) then
md5sum = def%initial(i_component)%md5sum
else
md5sum = def%md5sum
end if
end function process_def_get_md5sum
@ %def process_def_get_md5sum
@ Return a pointer to the definition of a particular component (for
test purposes).
<<Process libraries: process def: TBP>>=
procedure :: get_core_def_ptr => process_def_get_core_def_ptr
<<Process libraries: procedures>>=
function process_def_get_core_def_ptr (def, i_component) result (ptr)
class(process_def_t), intent(in), target :: def
integer, intent(in) :: i_component
class(prc_core_def_t), pointer :: ptr
ptr => def%initial(i_component)%get_core_def_ptr ()
end function process_def_get_core_def_ptr
@ %def process_def_get_core_def_ptr
@
This query tells whether a specific process component relies on
external code. This includes all traditional WHIZARD matrix elements
which rely on \oMega\ for code generation. Other process components
(trivial decays, subtraction terms) do not require external code.
NOTE: Implemented only for initial component.
The query is passed to the process component.
<<Process libraries: process def: TBP>>=
procedure :: needs_code => process_def_needs_code
<<Process libraries: procedures>>=
function process_def_needs_code (def, i_component) result (flag)
class(process_def_t), intent(in) :: def
integer, intent(in) :: i_component
logical :: flag
flag = def%initial(i_component)%needs_code ()
end function process_def_needs_code
@ %def process_def_needs_code
@ Return the first entry for the incoming particle(s), PDG code, of
this process.
<<Process libraries: process def: TBP>>=
procedure :: get_pdg_in_1 => process_def_get_pdg_in_1
<<Process libraries: procedures>>=
subroutine process_def_get_pdg_in_1 (def, pdg)
class(process_def_t), intent(in), target :: def
integer, dimension(:), intent(out) :: pdg
call def%initial(1)%get_pdg_in (def%model, pdg)
end subroutine process_def_get_pdg_in_1
@ %def process_def_get_pdg_in_1
@
<<Process libraries: process def: TBP>>=
procedure :: get_nlo_type => process_def_get_nlo_type
<<Process libraries: procedures>>=
elemental function process_def_get_nlo_type (def, i_component) result (nlo_type)
integer :: nlo_type
class(process_def_t), intent(in) :: def
integer, intent(in) :: i_component
nlo_type = def%initial(i_component)%nlo_type
end function process_def_get_nlo_type
@ %def process_def_get_nlo_type
@
\subsubsection{Process definition list}
A list of process definitions is the starting point for creating a
process library. The list is built when reading the user input. When
reading an existing process library, the list is used for
cross-checking and updating the configuration.
We need a type for the list entry. The simplest way is to extend the
process definition type, so all methods apply to the process
definition directly.
<<Process libraries: public>>=
public :: process_def_entry_t
<<Process libraries: types>>=
type, extends (process_def_t) :: process_def_entry_t
private
type(process_def_entry_t), pointer :: next => null ()
end type process_def_entry_t
@ %def process_def_entry_t
@ This is the type for the list itself.
<<Process libraries: public>>=
public :: process_def_list_t
<<Process libraries: types>>=
type :: process_def_list_t
private
type(process_def_entry_t), pointer :: first => null ()
type(process_def_entry_t), pointer :: last => null ()
contains
<<Process libraries: process def list: TBP>>
end type process_def_list_t
@ %def process_def_list_t
@ The deallocates the list iteratively. We assume that the list
entries do not need finalization themselves.
<<Process libraries: process def list: TBP>>=
procedure :: final => process_def_list_final
<<Process libraries: procedures>>=
subroutine process_def_list_final (list)
class(process_def_list_t), intent(inout) :: list
type(process_def_entry_t), pointer :: current
nullify (list%last)
do while (associated (list%first))
current => list%first
list%first => current%next
deallocate (current)
end do
end subroutine process_def_list_final
@ %def process_def_list_final
@ Write the complete list.
<<Process libraries: process def list: TBP>>=
procedure :: write => process_def_list_write
<<Process libraries: procedures>>=
subroutine process_def_list_write (object, unit, libpath)
class(process_def_list_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: libpath
type(process_def_entry_t), pointer :: entry
integer :: i, u
u = given_output_unit (unit)
if (associated (object%first)) then
i = 1
entry => object%first
do while (associated (entry))
write (u, "(1x,A,I0,A)") "Process #", i, ":"
call entry%write (u)
i = i + 1
entry => entry%next
if (associated (entry)) write (u, *)
end do
else
write (u, "(1x,A)") "Process definition list: [empty]"
end if
end subroutine process_def_list_write
@ %def process_def_list_write
@ Short account.
<<Process libraries: process def list: TBP>>=
procedure :: show => process_def_list_show
<<Process libraries: procedures>>=
subroutine process_def_list_show (object, unit)
class(process_def_list_t), intent(in) :: object
integer, intent(in), optional :: unit
type(process_def_entry_t), pointer :: entry
integer :: u
u = given_output_unit (unit)
if (associated (object%first)) then
write (u, "(2x,A)") "Processes:"
entry => object%first
do while (associated (entry))
call entry%show (u)
entry => entry%next
end do
else
write (u, "(2x,A)") "Processes: [empty]"
end if
end subroutine process_def_list_show
@ %def process_def_list_show
@ Read the complete list. We need an array of templates for the
component subobjects of abstract [[prc_core_t]] type, to
allocate them with the correct specific type.
NOTE: Error handling is missing. Reading will just be aborted on
error, or an I/O error occurs.
<<Process libraries: process def list: TBP>>=
procedure :: read => process_def_list_read
<<Process libraries: procedures>>=
subroutine process_def_list_read (object, unit, core_def_templates)
class(process_def_list_t), intent(out) :: object
integer, intent(in) :: unit
type(prc_template_t), dimension(:), intent(in) :: core_def_templates
type(process_def_entry_t), pointer :: entry
character(80) :: buffer, ref
integer :: i
read (unit, "(A)") buffer
write (ref, "(1x,A)") "Process definition list: [empty]"
if (buffer == ref) return ! OK: empty library
backspace (unit)
READ_ENTRIES: do i = 1, huge (0)
if (i > 1) read (unit, *, end=1)
read (unit, "(A)") buffer
write (ref, "(1x,A,I0,A)") "Process #", i, ":"
if (buffer /= ref) return ! Wrong process header: done.
allocate (entry)
call entry%read (unit, core_def_templates)
call object%append (entry)
end do READ_ENTRIES
1 continue ! EOF: done
end subroutine process_def_list_read
@ %def process_def_list_read
@ Append an entry to the list. The entry should be allocated as a
pointer, and the pointer allocation is transferred. The original
pointer is returned null.
<<Process libraries: process def list: TBP>>=
procedure :: append => process_def_list_append
<<Process libraries: procedures>>=
subroutine process_def_list_append (list, entry)
class(process_def_list_t), intent(inout) :: list
type(process_def_entry_t), intent(inout), pointer :: entry
if (list%contains (entry%id)) then
call msg_fatal ("Recording process: '" // char (entry%id) &
// "' has already been defined")
end if
if (associated (list%first)) then
list%last%next => entry
else
list%first => entry
end if
list%last => entry
entry => null ()
end subroutine process_def_list_append
@ %def process_def_list_append
@
\subsubsection{Probe the process definition list}
Return the number of processes supported by the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_n_processes => process_def_list_get_n_processes
<<Process libraries: procedures>>=
function process_def_list_get_n_processes (list) result (n)
integer :: n
class(process_def_list_t), intent(in) :: list
type(process_def_entry_t), pointer :: current
n = 0
current => list%first
do while (associated (current))
n = n + 1
current => current%next
end do
end function process_def_list_get_n_processes
@ %def process_def_list_get_n_processes
@ Allocate an array with the process IDs supported by the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_process_id_list => process_def_list_get_process_id_list
<<Process libraries: procedures>>=
subroutine process_def_list_get_process_id_list (list, id)
class(process_def_list_t), intent(in) :: list
type(string_t), dimension(:), allocatable, intent(out) :: id
type(process_def_entry_t), pointer :: current
integer :: i
allocate (id (list%get_n_processes ()))
i = 0
current => list%first
do while (associated (current))
i = i + 1
id(i) = current%id
current => current%next
end do
end subroutine process_def_list_get_process_id_list
@ %def process_def_list_get_process_id_list
@ Return just the processes which require resonant subprocesses.
<<Process libraries: process def list: TBP>>=
procedure :: get_process_id_req_resonant => &
process_def_list_get_process_id_req_resonant
<<Process libraries: procedures>>=
subroutine process_def_list_get_process_id_req_resonant (list, id)
class(process_def_list_t), intent(in) :: list
type(string_t), dimension(:), allocatable, intent(out) :: id
type(process_def_entry_t), pointer :: current
integer :: i
allocate (id (list%get_n_processes ()))
i = 0
current => list%first
do while (associated (current))
if (current%requires_resonances) then
i = i + 1
id(i) = current%id
end if
current => current%next
end do
id = id(1:i)
end subroutine process_def_list_get_process_id_req_resonant
@ %def process_def_list_get_process_id_list
@ Return true if a given process is in the library.
<<Process libraries: process def list: TBP>>=
procedure :: contains => process_def_list_contains
<<Process libraries: procedures>>=
function process_def_list_contains (list, id) result (flag)
logical :: flag
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) then
flag = .true.; return
end if
current => current%next
end do
flag = .false.
end function process_def_list_contains
@ %def process_def_list_contains
@ Return the index of the entry that corresponds to a given process.
<<Process libraries: process def list: TBP>>=
procedure :: get_entry_index => process_def_list_get_entry_index
<<Process libraries: procedures>>=
function process_def_list_get_entry_index (list, id) result (n)
integer :: n
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
n = 0
current => list%first
do while (associated (current))
n = n + 1
if (id == current%id) then
return
end if
current => current%next
end do
n = 0
end function process_def_list_get_entry_index
@ %def process_def_list_get_entry_index
@ Return the numerical ID for a process.
<<Process libraries: process def list: TBP>>=
procedure :: get_num_id => process_def_list_get_num_id
<<Process libraries: procedures>>=
function process_def_list_get_num_id (list, id) result (num_id)
integer :: num_id
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) then
num_id = current%num_id
return
end if
current => current%next
end do
num_id = 0
end function process_def_list_get_num_id
@ %def process_def_list_get_num_id
@ Return the model name for a given process in the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_model_name => process_def_list_get_model_name
<<Process libraries: procedures>>=
function process_def_list_get_model_name (list, id) result (model_name)
type(string_t) :: model_name
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) then
model_name = current%model_name
return
end if
current => current%next
end do
model_name = ""
end function process_def_list_get_model_name
@ %def process_def_list_get_model_name
@ Return the number of incoming particles of a given process in the library.
This tells us whether the process is a decay or a scattering.
<<Process libraries: process def list: TBP>>=
procedure :: get_n_in => process_def_list_get_n_in
<<Process libraries: procedures>>=
function process_def_list_get_n_in (list, id) result (n)
integer :: n
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) then
n = current%n_in
return
end if
current => current%next
end do
end function process_def_list_get_n_in
@ %def process_def_list_get_n_in
@ Return the incoming particle pdg codesnumber of incoming particles
of a given process in the library. If there is a PDG array, return
only the first code for each beam. This serves as a quick way
for (re)constructing beam properties.
<<Process libraries: process def list: TBP>>=
procedure :: get_pdg_in_1 => process_def_list_get_pdg_in_1
<<Process libraries: procedures>>=
subroutine process_def_list_get_pdg_in_1 (list, id, pdg)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
integer, dimension(:), intent(out) :: pdg
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) then
call current%get_pdg_in_1 (pdg)
return
end if
current => current%next
end do
end subroutine process_def_list_get_pdg_in_1
@ %def process_def_list_get_pdg_in_1
@ Return the number of components of a given process in the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_n_components => process_def_list_get_n_components
<<Process libraries: procedures>>=
function process_def_list_get_n_components (list, id) result (n)
integer :: n
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) then
n = current%n_initial + current%n_extra
return
end if
current => current%next
end do
end function process_def_list_get_n_components
@ %def process_def_list_get_n_components
@ Return a pointer to a specific process component definition.
<<Process libraries: process def list: TBP>>=
procedure :: get_component_def_ptr => process_def_list_get_component_def_ptr
<<Process libraries: procedures>>=
function process_def_list_get_component_def_ptr (list, id, i) result (ptr)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
integer, intent(in) :: i
type(process_component_def_t), pointer :: ptr
type(process_def_entry_t), pointer :: current
ptr => null ()
current => list%first
do while (associated (current))
if (id == current%id) then
if (i <= current%n_initial) then
ptr => current%initial(i)
else if (i <= current%n_initial + current%n_extra) then
ptr => current%extra(i-current%n_initial)
end if
return
end if
current => current%next
end do
end function process_def_list_get_component_def_ptr
@ %def process_def_list_get_component_def_ptr
@ Return the list of component IDs of a given process in the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_component_list => process_def_list_get_component_list
<<Process libraries: procedures>>=
subroutine process_def_list_get_component_list (list, id, cid)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(string_t), dimension(:), allocatable, intent(out) :: cid
type(process_def_entry_t), pointer :: current
integer :: i, n
current => list%first
do while (associated (current))
if (id == current%id) then
allocate (cid (current%n_initial + current%n_extra))
do i = 1, current%n_initial
cid(i) = current%initial(i)%basename
end do
n = current%n_initial
do i = 1, current%n_extra
cid(n + i) = current%extra(i)%basename
end do
return
end if
current => current%next
end do
end subroutine process_def_list_get_component_list
@ %def process_def_list_get_component_list
@ Return the list of component description strings for a given process
in the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_component_description_list => &
process_def_list_get_component_description_list
<<Process libraries: procedures>>=
subroutine process_def_list_get_component_description_list &
(list, id, description)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(string_t), dimension(:), allocatable, intent(out) :: description
type(process_def_entry_t), pointer :: current
integer :: i, n
current => list%first
do while (associated (current))
if (id == current%id) then
allocate (description (current%n_initial + current%n_extra))
do i = 1, current%n_initial
description(i) = current%initial(i)%description
end do
n = current%n_initial
do i = 1, current%n_extra
description(n + i) = current%extra(i)%description
end do
return
end if
current => current%next
end do
end subroutine process_def_list_get_component_description_list
@ %def process_def_list_get_component_description_list
@ Return whether the entry requires construction of a resonanct
subprocess set.
<<Process libraries: process def list: TBP>>=
procedure :: req_resonant => process_def_list_req_resonant
<<Process libraries: procedures>>=
function process_def_list_req_resonant (list, id) result (nlo)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
logical :: nlo
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) then
nlo = current%requires_resonances
return
end if
current => current%next
end do
end function process_def_list_req_resonant
@ %def process_def_list_req_resonant
@ Return whether the entry corresponds to an NLO-process
<<Process libraries: process def list: TBP>>=
procedure :: get_nlo_process => process_def_list_get_nlo_process
<<Process libraries: procedures>>=
function process_def_list_get_nlo_process (list, id) result (nlo)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
logical :: nlo
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) then
nlo = current%nlo_process
return
end if
current => current%next
end do
end function process_def_list_get_nlo_process
@ %def process_def_list_get_nlo_process
@
\subsection{Process library}
The process library object is the interface between the process
definition data, as provided by the user, generated or linked process
code on file, and the process run data that reference the process
code.
\subsubsection{Process library entry}
For each process component that is part of the library, there is a
separate library entry ([[process_library_entry_t]]. The library
entry connects a process definition with the specific code (if any) in
the compiled driver library.
The [[status]] indicates how far the process has been
processed by the system (definition, code generation, compilation,
linking). A process with status [[STAT_LOADED]] is accessible for
computing matrix elements.
The [[def]] pointer identifies the corresponding process definition.
The process component within that definition is identified by the
[[i_component]] index.
The [[i_external]] index refers to the compiled library driver. If it is zero,
there is no associated matrix-element code.
The [[driver]] component holds the pointers to the matrix-element
specific functions, in particular the matrix element function itself.
<<Process libraries: types>>=
type :: process_library_entry_t
private
integer :: status = STAT_UNKNOWN
type(process_def_t), pointer :: def => null ()
integer :: i_component = 0
integer :: i_external = 0
class(prc_core_driver_t), allocatable :: driver
contains
<<Process libraries: process library entry: TBP>>
end type process_library_entry_t
@ %def process_library_entry_t
@ Here are the available status codes. An entry starts with
[[UNKNOWN]] status. Once the association with a valid process
definition is established, the status becomes [[CONFIGURED]].
If matrix element source code is to be generated by the system or
provided from elsewhere, [[CODE_GENERATED]] indicates that this is
done. The [[COMPILED]] status is next, it also applies to
processes which are accessed as precompiled binaries. Finally, the
library is linked and process pointers are set; this is marked as
[[LOADED]].
For a process library, the initial status is [[OPEN]], since process
definitions may be added. After configuration, the process content is fixed
and the status becomes [[CONFIGURED]]. The further states are as above,
always referring to the lowest status among the process entries.
<<Process libraries: parameters>>=
integer, parameter, public :: STAT_UNKNOWN = 0
integer, parameter, public :: STAT_OPEN = 1
integer, parameter, public :: STAT_CONFIGURED = 2
integer, parameter, public :: STAT_SOURCE = 3
integer, parameter, public :: STAT_COMPILED = 4
integer, parameter, public :: STAT_LINKED = 5
integer, parameter, public :: STAT_ACTIVE = 6
integer, parameter, public :: ASSOCIATED_BORN = 1
integer, parameter, public :: ASSOCIATED_REAL = 2
integer, parameter, public :: ASSOCIATED_VIRT = 3
integer, parameter, public :: ASSOCIATED_SUB = 4
integer, parameter, public :: ASSOCIATED_PDF = 5
integer, parameter, public :: ASSOCIATED_REAL_SING = 6
integer, parameter, public :: ASSOCIATED_REAL_FIN = 7
integer, parameter, public :: N_ASSOCIATED_COMPONENTS = 7
@ %def STAT_UNKNOWN STAT_OPEN STAT_CONFIGURED
@ %def STAT_SOURCE STAT_COMPILED STAT_LINKED STAT_ACTIVE
@ These are the associated code letters, for output:
<<Process libraries: parameters>>=
character, dimension(0:6), parameter :: STATUS_LETTER = &
["?", "o", "f", "s", "c", "l", "a"]
@ %def STATUS_LETTER
@ This produces a condensed account of the library entry. The status
is indicated by a letter in brackets, then the ID and component index
of the associated process definition, finally the library index, if available.
<<Process libraries: process library entry: TBP>>=
procedure :: to_string => process_library_entry_to_string
<<Process libraries: procedures>>=
function process_library_entry_to_string (object) result (string)
type(string_t) :: string
class(process_library_entry_t), intent(in) :: object
character(32) :: buffer
string = "[" // STATUS_LETTER(object%status) // "]"
select case (object%status)
case (STAT_UNKNOWN)
case default
if (associated (object%def)) then
write (buffer, "(I0)") object%i_component
string = string // " " // object%def%id // "." // trim (buffer)
end if
if (object%i_external /= 0) then
write (buffer, "(I0)") object%i_external
string = string // " = ext:" // trim (buffer)
else
string = string // " = int"
end if
if (allocated (object%driver)) then
string = string // " (" // object%driver%type_name () // ")"
end if
end select
end function process_library_entry_to_string
@ %def process_library_entry_to_string
@ Initialize with data. Used for the unit tests.
<<Process libraries: process library entry: TBP>>=
procedure :: init => process_library_entry_init
<<Process libraries: procedures>>=
subroutine process_library_entry_init (object, &
status, def, i_component, i_external, driver_template)
class(process_library_entry_t), intent(out) :: object
integer, intent(in) :: status
type(process_def_t), target, intent(in) :: def
integer, intent(in) :: i_component
integer, intent(in) :: i_external
class(prc_core_driver_t), intent(inout), allocatable, optional &
:: driver_template
object%status = status
object%def => def
object%i_component = i_component
object%i_external = i_external
if (present (driver_template)) then
call move_alloc (driver_template, object%driver)
end if
end subroutine process_library_entry_init
@ %def process_library_entry_init
@ Assign pointers for all process-specific features. We have to
combine the method from the [[core_def]] specification, the
assigned pointers within the library driver, the index within that
driver, and the process driver which should receive the links.
<<Process libraries: process library entry: TBP>>=
procedure :: connect => process_library_entry_connect
<<Process libraries: procedures>>=
subroutine process_library_entry_connect (entry, lib_driver, i)
class(process_library_entry_t), intent(inout) :: entry
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
call entry%def%initial(entry%i_component)%connect &
(lib_driver, i, entry%driver)
end subroutine process_library_entry_connect
@ %def process_library_entry_connect
@
\subsubsection{The process library object}
The [[process_library_t]] type is an extension of the
[[process_def_list_t]] type. Thus, it automatically contains the
process definition list.
The [[basename]] identifies the library generically.
The [[external]] flag is true if any process within the library needs external
code, so the library must correspond to an actual code library (statically or
dynamically linked).
The [[entry]] array contains all process components that can be handled by this
library. Each entry refers to the process (component) definition and to the
associated external matrix element code, if there is any.
The [[driver]] object is needed only if [[external]] is true. This object
handles all interactions with external matrix-element code.
The [[md5sum]] summarizes the complete [[process_def_list_t]] base
object. It can be used to check if the library configuration has changed.
<<Process libraries: public>>=
public :: process_library_t
<<Process libraries: types>>=
type, extends (process_def_list_t) :: process_library_t
private
type(string_t) :: basename
integer :: n_entries = 0
logical :: external = .false.
integer :: status = STAT_UNKNOWN
logical :: static = .false.
logical :: driver_exists = .false.
logical :: makefile_exists = .false.
integer :: update_counter = 0
type(process_library_entry_t), dimension(:), allocatable :: entry
class(prclib_driver_t), allocatable :: driver
character(32) :: md5sum = ""
contains
<<Process libraries: process library: TBP>>
end type process_library_t
@ %def process_library_t
@ For the output, we write first the metadata and the DL access
record, then the library entries in short form, and finally the
process definition list which is the base object.
Don't write the MD5 sum since this is used to generate it.
<<Process libraries: process library: TBP>>=
procedure :: write => process_library_write
<<Process libraries: procedures>>=
subroutine process_library_write (object, unit, libpath)
class(process_library_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: libpath
integer :: i, u
u = given_output_unit (unit)
write (u, "(1x,A,A)") "Process library: ", char (object%basename)
write (u, "(3x,A,L1)") "external = ", object%external
write (u, "(3x,A,L1)") "makefile exists = ", object%makefile_exists
write (u, "(3x,A,L1)") "driver exists = ", object%driver_exists
write (u, "(3x,A,A1)") "code status = ", &
STATUS_LETTER (object%status)
write (u, *)
if (allocated (object%entry)) then
write (u, "(1x,A)", advance="no") "Process library entries:"
write (u, "(1x,I0)") object%n_entries
do i = 1, size (object%entry)
write (u, "(1x,A,I0,A,A)") "Entry #", i, ": ", &
char (object%entry(i)%to_string ())
end do
write (u, *)
end if
if (object%external) then
call object%driver%write (u, libpath)
write (u, *)
end if
call object%process_def_list_t%write (u)
end subroutine process_library_write
@ %def process_library_write
@ Condensed version for screen output.
<<Process libraries: process library: TBP>>=
procedure :: show => process_library_show
<<Process libraries: procedures>>=
subroutine process_library_show (object, unit)
class(process_library_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(A,A)") "Process library: ", char (object%basename)
write (u, "(2x,A,L1)") "external = ", object%external
if (object%static) then
write (u, "(2x,A,L1)") "static = ", .true.
else
write (u, "(2x,A,L1)") "makefile exists = ", object%makefile_exists
write (u, "(2x,A,L1)") "driver exists = ", object%driver_exists
end if
write (u, "(2x,A,A1)", advance="no") "code status = "
select case (object%status)
case (STAT_UNKNOWN); write (u, "(A)") "[unknown]"
case (STAT_OPEN); write (u, "(A)") "open"
case (STAT_CONFIGURED); write (u, "(A)") "configured"
case (STAT_SOURCE); write (u, "(A)") "source code exists"
case (STAT_COMPILED); write (u, "(A)") "compiled"
case (STAT_LINKED); write (u, "(A)") "linked"
case (STAT_ACTIVE); write (u, "(A)") "active"
end select
call object%process_def_list_t%show (u)
end subroutine process_library_show
@ %def process_library_show
@
The initializer defines just the basename. We may now add process definitions
to the library.
<<Process libraries: process library: TBP>>=
procedure :: init => process_library_init
<<Process libraries: procedures>>=
subroutine process_library_init (lib, basename)
class(process_library_t), intent(out) :: lib
type(string_t), intent(in) :: basename
lib%basename = basename
lib%status = STAT_OPEN
call msg_message ("Process library '" // char (basename) &
// "': initialized")
end subroutine process_library_init
@ %def process_library_init
@
This alternative initializer declares the library as static. We
should now add process definitions to the library, but all external
process code exists already. We need the driver object, and we should
check the defined processes against the stored ones.
<<Process libraries: process library: TBP>>=
procedure :: init_static => process_library_init_static
<<Process libraries: procedures>>=
subroutine process_library_init_static (lib, basename)
class(process_library_t), intent(out) :: lib
type(string_t), intent(in) :: basename
lib%basename = basename
lib%status = STAT_OPEN
lib%static = .true.
call msg_message ("Static process library '" // char (basename) &
// "': initialized")
end subroutine process_library_init_static
@ %def process_library_init_static
@ The [[configure]] procedure scans the allocated entries in the process
definition list. The configuration proceeds in three passes.
In the first pass, we scan the process definition list and count the
number of process components and the number of components which need
external code. This is used to allocate the [[entry]] array.
In the second pass, we initialize the [[entry]] elements which connect
process definitions, process driver objects, and external code.
In the third pass, we initialize the library driver object, allocating
an entry for each external matrix element.
NOTE: Currently we handle only [[initial]] process components; [[extra]]
components are ignored.
<<Process libraries: process library: TBP>>=
procedure :: configure => process_library_configure
<<Process libraries: procedures>>=
subroutine process_library_configure (lib, os_data)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
type(process_def_entry_t), pointer :: def_entry
integer :: n_entries, n_external, i_entry, i_external
type(string_t) :: model_name
integer :: i_component
n_entries = 0
n_external = 0
if (allocated (lib%entry)) deallocate (lib%entry)
def_entry => lib%first
do while (associated (def_entry))
do i_component = 1, def_entry%n_initial
n_entries = n_entries + 1
if (def_entry%initial(i_component)%needs_code ()) then
n_external = n_external + 1
lib%external = .true.
end if
end do
def_entry => def_entry%next
end do
call lib%allocate_entries (n_entries)
i_entry = 0
i_external = 0
def_entry => lib%first
do while (associated (def_entry))
do i_component = 1, def_entry%n_initial
i_entry = i_entry + 1
associate (lib_entry => lib%entry(i_entry))
lib_entry%status = STAT_CONFIGURED
lib_entry%def => def_entry%process_def_t
lib_entry%i_component = i_component
if (def_entry%initial(i_component)%needs_code ()) then
i_external = i_external + 1
lib_entry%i_external = i_external
end if
call def_entry%initial(i_component)%allocate_driver &
(lib_entry%driver)
end associate
end do
def_entry => def_entry%next
end do
call dispatch_prclib_driver (lib%driver, &
lib%basename, lib%get_modellibs_ldflags (os_data))
call lib%driver%init (n_external)
do i_entry = 1, n_entries
associate (lib_entry => lib%entry(i_entry))
i_component = lib_entry%i_component
model_name = lib_entry%def%model_name
associate (def => lib_entry%def%initial(i_component))
if (def%needs_code ()) then
call lib%driver%set_record (lib_entry%i_external, &
def%basename, &
model_name, &
def%get_features (), def%get_writer_ptr ())
end if
end associate
end associate
end do
if (lib%static) then
if (lib%n_entries /= 0) lib%entry%status = STAT_LINKED
lib%status = STAT_LINKED
else if (lib%external) then
where (lib%entry%i_external == 0) lib%entry%status = STAT_LINKED
lib%status = STAT_CONFIGURED
lib%makefile_exists = .false.
lib%driver_exists = .false.
else
if (lib%n_entries /= 0) lib%entry%status = STAT_LINKED
lib%status = STAT_LINKED
end if
end subroutine process_library_configure
@ %def process_library_configure
@ Basic setup: allocate the [[entry]] array.
<<Process libraries: process library: TBP>>=
procedure :: allocate_entries => process_library_allocate_entries
<<Process libraries: procedures>>=
subroutine process_library_allocate_entries (lib, n_entries)
class(process_library_t), intent(inout) :: lib
integer, intent(in) :: n_entries
lib%n_entries = n_entries
allocate (lib%entry (n_entries))
end subroutine process_library_allocate_entries
@ %def process_library_allocate_entries
@ Initialize an entry with data (used by unit tests).
<<Process libraries: process library: TBP>>=
procedure :: init_entry => process_library_init_entry
<<Process libraries: procedures>>=
subroutine process_library_init_entry (lib, i, &
status, def, i_component, i_external, driver_template)
class(process_library_t), intent(inout) :: lib
integer, intent(in) :: i
integer, intent(in) :: status
type(process_def_t), target, intent(in) :: def
integer, intent(in) :: i_component
integer, intent(in) :: i_external
class(prc_core_driver_t), intent(inout), allocatable, optional &
:: driver_template
call lib%entry(i)%init (status, def, i_component, i_external, &
driver_template)
end subroutine process_library_init_entry
@ %def process_library_init_entry
@ Compute the MD5 sum. We concatenate the individual MD5 sums of all
processes (which, in turn, are derived from the MD5 sums of their
components) and compute the MD5 sum of that.
This should be executed \emph{after} configuration, where the driver was
initialized, since otherwise the MD5 sum stored in the driver would be
overwritten.
<<Process libraries: process library: TBP>>=
procedure :: compute_md5sum => process_library_compute_md5sum
<<Process libraries: procedures>>=
subroutine process_library_compute_md5sum (lib, model)
class(process_library_t), intent(inout) :: lib
class(model_data_t), intent(in), optional, target :: model
type(process_def_entry_t), pointer :: def_entry
type(string_t) :: buffer
buffer = lib%basename
def_entry => lib%first
do while (associated (def_entry))
call def_entry%compute_md5sum (model)
buffer = buffer // def_entry%md5sum
def_entry => def_entry%next
end do
lib%md5sum = md5sum (char (buffer))
call lib%driver%set_md5sum (lib%md5sum)
end subroutine process_library_compute_md5sum
@ %def process_library_compute_md5sum
@ Write an appropriate makefile, if there are external processes. Unless
[[force]] is in effect, first check if there is already a makefile with the
correct MD5 sum. If yes, do nothing.
The [[workspace]] optional argument puts any library code in a subdirectory.
<<Process libraries: process library: TBP>>=
procedure :: write_makefile => process_library_write_makefile
<<Process libraries: procedures>>=
subroutine process_library_write_makefile &
(lib, os_data, force, verbose, testflag, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: force, verbose
logical, intent(in), optional :: testflag
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum_file
logical :: generate
integer :: unit
if (lib%external .and. .not. lib%static) then
generate = .true.
if (.not. force) then
- md5sum_file = lib%driver%get_md5sum_makefile ()
+ md5sum_file = lib%driver%get_md5sum_makefile (workspace)
if (lib%md5sum == md5sum_file) then
call msg_message ("Process library '" // char (lib%basename) &
// "': keeping makefile")
generate = .false.
end if
end if
if (generate) then
call msg_message ("Process library '" // char (lib%basename) &
// "': writing makefile")
unit = free_unit ()
open (unit, &
file = char (workspace_prefix (workspace) &
& // lib%driver%basename // ".makefile"), &
status="replace", action="write")
call lib%driver%generate_makefile (unit, os_data, verbose, testflag)
close (unit)
end if
lib%makefile_exists = .true.
end if
end subroutine process_library_write_makefile
@ %def process_library_write_makefile
@
@ Write the driver source code for the library to file, if there are
external processes.
<<Process libraries: process library: TBP>>=
procedure :: write_driver => process_library_write_driver
<<Process libraries: procedures>>=
subroutine process_library_write_driver (lib, force, workspace)
class(process_library_t), intent(inout) :: lib
logical, intent(in) :: force
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum_file
logical :: generate
integer :: unit
if (lib%external .and. .not. lib%static) then
generate = .true.
if (.not. force) then
md5sum_file = lib%driver%get_md5sum_driver (workspace)
if (lib%md5sum == md5sum_file) then
call msg_message ("Process library '" // char (lib%basename) &
// "': keeping driver")
generate = .false.
end if
end if
if (generate) then
call msg_message ("Process library '" // char (lib%basename) &
// "': writing driver")
unit = free_unit ()
open (unit, &
file = char (workspace_prefix (workspace) &
& // lib%driver%basename // ".f90"), &
status="replace", action="write")
call lib%driver%generate_driver_code (unit)
close (unit)
end if
lib%driver_exists = .true.
end if
end subroutine process_library_write_driver
@ %def process_library_write_driver
@ Update the compilation status of an external library.
Strictly speaking, this is not necessary for a one-time run, since the
individual library methods will update the status themselves.
However, it allows us to identify compilation steps that we can skip
because the file exists or is already loaded, for the whole library or
for particular entries.
Independently, the building process is controlled by a makefile.
Thus, previous files are reused if they are not modified by the
current compilation.
\begin{enumerate}
\item
If it is not already loaded, attempt to load the library. If successful,
check the overall MD5 sum. If it matches, just keep it loaded and mark as
ACTIVE. If not, check the MD5 sum for all linked process components.
Where it matches, mark the entry as COMPILED. Then, unload the library and
mark as CONFIGURED.
Thus, we can identify compiled files for all matrix elements which are
accessible via the previous compiled library, even if it is no longer up to
date.
\item
If the library is now in CONFIGURED state, look for valid source files.
Each entry that is just in CONFIGURED state will advance to SOURCE if the
MD5 sum matches. Finally, advance the whole library to SOURCE if all
entries are at least in this condition.
\end{enumerate}
<<Process libraries: process library: TBP>>=
procedure :: update_status => process_library_update_status
<<Process libraries: procedures>>=
subroutine process_library_update_status (lib, os_data, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum_file
integer :: i, i_external, i_component
if (lib%external) then
select case (lib%status)
case (STAT_CONFIGURED:STAT_LINKED)
call lib%driver%load (os_data, noerror=.true., workspace=workspace)
end select
if (lib%driver%loaded) then
md5sum_file = lib%driver%get_md5sum (0)
if (lib%md5sum == md5sum_file) then
call lib%load_entries ()
lib%entry%status = STAT_ACTIVE
lib%status = STAT_ACTIVE
call msg_message ("Process library '" // char (lib%basename) &
// "': active")
else
do i = 1, lib%n_entries
associate (entry => lib%entry(i))
i_external = entry%i_external
i_component = entry%i_component
if (i_external /= 0) then
md5sum_file = lib%driver%get_md5sum (i_external)
if (entry%def%get_md5sum (i_component) == md5sum_file) then
entry%status = STAT_COMPILED
else
entry%status = STAT_CONFIGURED
end if
end if
end associate
end do
call lib%driver%unload ()
lib%status = STAT_CONFIGURED
end if
end if
select case (lib%status)
case (STAT_CONFIGURED)
do i = 1, lib%n_entries
associate (entry => lib%entry(i))
i_external = entry%i_external
i_component = entry%i_component
if (i_external /= 0) then
select case (entry%status)
case (STAT_CONFIGURED)
md5sum_file = lib%driver%get_md5sum_source &
(i_external, workspace)
if (entry%def%get_md5sum (i_component) == md5sum_file) then
entry%status = STAT_SOURCE
end if
end select
end if
end associate
end do
if (all (lib%entry%status >= STAT_SOURCE)) then
md5sum_file = lib%driver%get_md5sum_driver (workspace)
if (lib%md5sum == md5sum_file) then
lib%status = STAT_SOURCE
end if
end if
end select
end if
end subroutine process_library_update_status
@ %def process_library_update_status
@
This procedure triggers code generation for all processes where this
is possible.
We generate code only for external processes of status
[[STAT_CONFIGURED]], which then advance to [[STAT_SOURCE]]. If, for a
particular process, the status is already advanced, we do not remove previous
files, so [[make]] will consider them as up to date if they exist. Otherwise,
we remove those files to force a fresh [[make]].
Finally, if any source code has been generated, we need a driver file.
<<Process libraries: process library: TBP>>=
procedure :: make_source => process_library_make_source
<<Process libraries: procedures>>=
subroutine process_library_make_source &
(lib, os_data, keep_old_source, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: keep_old_source
type(string_t), intent(in), optional :: workspace
logical :: keep_old
integer :: i, i_external
keep_old = .false.
if (present (keep_old_source)) keep_old = keep_old_source
if (lib%external .and. .not. lib%static) then
select case (lib%status)
case (STAT_CONFIGURED)
if (keep_old) then
call msg_message ("Process library '" // char (lib%basename) &
// "': keeping source code")
else
call msg_message ("Process library '" // char (lib%basename) &
// "': creating source code")
do i = 1, size (lib%entry)
associate (entry => lib%entry(i))
i_external = entry%i_external
if (i_external /= 0 &
.and. lib%entry(i)%status == STAT_CONFIGURED) then
call lib%driver%clean_proc &
(i_external, os_data, workspace)
end if
end associate
if (signal_is_pending ()) return
end do
call lib%driver%make_source (os_data, workspace)
end if
lib%status = STAT_SOURCE
where (lib%entry%i_external /= 0 &
.and. lib%entry%status == STAT_CONFIGURED)
lib%entry%status = STAT_SOURCE
end where
lib%status = STAT_SOURCE
end select
end if
end subroutine process_library_make_source
@ %def process_library_make_source
@ Compile the generated code and update the status codes. Try to make
the sources first, just in case. This includes compiling possible \LaTeX
Feynman diagram files.
<<Process libraries: process library: TBP>>=
procedure :: make_compile => process_library_make_compile
<<Process libraries: procedures>>=
subroutine process_library_make_compile &
(lib, os_data, keep_old_source, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: keep_old_source
type(string_t), intent(in), optional :: workspace
if (lib%external .and. .not. lib%static) then
select case (lib%status)
case (STAT_CONFIGURED)
call lib%make_source (os_data, keep_old_source, workspace)
end select
if (signal_is_pending ()) return
select case (lib%status)
case (STAT_SOURCE)
call msg_message ("Process library '" // char (lib%basename) &
// "': compiling sources")
call lib%driver%make_compile (os_data, workspace)
where (lib%entry%i_external /= 0 &
.and. lib%entry%status == STAT_SOURCE)
lib%entry%status = STAT_COMPILED
end where
lib%status = STAT_COMPILED
end select
end if
end subroutine process_library_make_compile
@ %def process_library_make_compile
@ Link the process library. Try to compile first, just in case.
<<Process libraries: process library: TBP>>=
procedure :: make_link => process_library_make_link
<<Process libraries: procedures>>=
subroutine process_library_make_link &
(lib, os_data, keep_old_source, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: keep_old_source
type(string_t), intent(in), optional :: workspace
if (lib%external .and. .not. lib%static) then
select case (lib%status)
case (STAT_CONFIGURED:STAT_SOURCE)
call lib%make_compile (os_data, keep_old_source, workspace)
end select
if (signal_is_pending ()) return
select case (lib%status)
case (STAT_COMPILED)
call msg_message ("Process library '" // char (lib%basename) &
// "': linking")
call lib%driver%make_link (os_data, workspace)
lib%entry%status = STAT_LINKED
lib%status = STAT_LINKED
end select
end if
end subroutine process_library_make_link
@ %def process_library_make_link
@ Load the process library, i.e., assign pointers to the library
functions.
<<Process libraries: process library: TBP>>=
procedure :: load => process_library_load
<<Process libraries: procedures>>=
subroutine process_library_load (lib, os_data, keep_old_source, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: keep_old_source
type(string_t), intent(in), optional :: workspace
select case (lib%status)
case (STAT_CONFIGURED:STAT_COMPILED)
call lib%make_link (os_data, keep_old_source, workspace)
end select
if (signal_is_pending ()) return
select case (lib%status)
case (STAT_LINKED)
if (lib%external) then
call msg_message ("Process library '" // char (lib%basename) &
// "': loading")
call lib%driver%load (os_data, workspace=workspace)
call lib%load_entries ()
end if
lib%entry%status = STAT_ACTIVE
lib%status = STAT_ACTIVE
end select
end subroutine process_library_load
@ %def process_library_load
@ This is the actual loading part for the process methods.
<<Process libraries: process library: TBP>>=
procedure :: load_entries => process_library_load_entries
<<Process libraries: procedures>>=
subroutine process_library_load_entries (lib)
class(process_library_t), intent(inout) :: lib
integer :: i
do i = 1, size (lib%entry)
associate (entry => lib%entry(i))
if (entry%i_external /= 0) then
call entry%connect (lib%driver, entry%i_external)
end if
end associate
end do
end subroutine process_library_load_entries
@ %def process_library_load_entries
@ Unload the library, if possible. This reverts the status to ``linked''.
<<Process libraries: process library: TBP>>=
procedure :: unload => process_library_unload
<<Process libraries: procedures>>=
subroutine process_library_unload (lib)
class(process_library_t), intent(inout) :: lib
select case (lib%status)
case (STAT_ACTIVE)
if (lib%external) then
call msg_message ("Process library '" // char (lib%basename) &
// "': unloading")
call lib%driver%unload ()
end if
lib%entry%status = STAT_LINKED
lib%status = STAT_LINKED
end select
end subroutine process_library_unload
@ %def process_library_unload
@ Unload, clean all generated files and revert the library status. If
[[distclean]] is set, also remove the makefile and the driver source.
<<Process libraries: process library: TBP>>=
procedure :: clean => process_library_clean
<<Process libraries: procedures>>=
subroutine process_library_clean (lib, os_data, distclean, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: distclean
type(string_t), intent(in), optional :: workspace
call lib%unload ()
if (lib%external .and. .not. lib%static) then
call msg_message ("Process library '" // char (lib%basename) &
// "': removing old files")
if (distclean) then
call lib%driver%distclean (os_data, workspace)
else
call lib%driver%clean (os_data, workspace)
end if
end if
where (lib%entry%i_external /= 0)
lib%entry%status = STAT_CONFIGURED
elsewhere
lib%entry%status = STAT_LINKED
end where
if (lib%external) then
lib%status = STAT_CONFIGURED
else
lib%status = STAT_LINKED
end if
end subroutine process_library_clean
@ %def process_library_clean
@ Unload and revert the library status to INITIAL. This allows for
appending new processes. No files are deleted.
<<Process libraries: process library: TBP>>=
procedure :: open => process_library_open
<<Process libraries: procedures>>=
subroutine process_library_open (lib)
class(process_library_t), intent(inout) :: lib
select case (lib%status)
case (STAT_OPEN)
case default
call lib%unload ()
if (.not. lib%static) then
lib%entry%status = STAT_OPEN
lib%status = STAT_OPEN
if (lib%external) lib%update_counter = lib%update_counter + 1
call msg_message ("Process library '" // char (lib%basename) &
// "': open")
else
call msg_error ("Static process library '" // char (lib%basename) &
// "': processes can't be appended")
end if
end select
end subroutine process_library_open
@ %def process_library_open
@
\subsection{Use the library}
Return the base name of the library
<<Process libraries: process library: TBP>>=
procedure :: get_name => process_library_get_name
<<Process libraries: procedures>>=
function process_library_get_name (lib) result (name)
class(process_library_t), intent(in) :: lib
type(string_t) :: name
name = lib%basename
end function process_library_get_name
@ %def process_library_get_name
@
Once activated, we view the process library object as an interface for
accessing the matrix elements.
<<Process libraries: process library: TBP>>=
procedure :: is_active => process_library_is_active
<<Process libraries: procedures>>=
function process_library_is_active (lib) result (flag)
logical :: flag
class(process_library_t), intent(in) :: lib
flag = lib%status == STAT_ACTIVE
end function process_library_is_active
@ %def process_library_is_active
@ Return the current status code of the library. If an index is
provided, return the status of that entry.
<<Process libraries: process library: TBP>>=
procedure :: get_status => process_library_get_status
<<Process libraries: procedures>>=
function process_library_get_status (lib, i) result (status)
class(process_library_t), intent(in) :: lib
integer, intent(in), optional :: i
integer :: status
if (present (i)) then
status = lib%entry(i)%status
else
status = lib%status
end if
end function process_library_get_status
@ %def process_library_get_status
@ Return the update counter. Since this is incremented each time the
library is re-opened, we can use this to check if existing pointers to
matrix element code are still valid.
<<Process libraries: process library: TBP>>=
procedure :: get_update_counter => process_library_get_update_counter
<<Process libraries: procedures>>=
function process_library_get_update_counter (lib) result (counter)
class(process_library_t), intent(in) :: lib
integer :: counter
counter = lib%update_counter
end function process_library_get_update_counter
@ %def process_library_get_update_counter
@ Manually set the current status code of the library. If the
optional flag is set, set also the entry status codes. This is used
for unit tests.
<<Process libraries: process library: TBP>>=
procedure :: set_status => process_library_set_status
<<Process libraries: procedures>>=
subroutine process_library_set_status (lib, status, entries)
class(process_library_t), intent(inout) :: lib
integer, intent(in) :: status
logical, intent(in), optional :: entries
lib%status = status
if (present (entries)) then
if (entries) lib%entry%status = status
end if
end subroutine process_library_set_status
@ %def process_library_set_status
@ Return the load status of the associated driver.
<<Process libraries: process library: TBP>>=
procedure :: is_loaded => process_library_is_loaded
<<Process libraries: procedures>>=
function process_library_is_loaded (lib) result (flag)
class(process_library_t), intent(in) :: lib
logical :: flag
flag = lib%driver%loaded
end function process_library_is_loaded
@ %def process_library_is_loaded
@ Retrieve constants using the process library driver. We assume that
the process code has been loaded, if external.
<<Process libraries: process library entry: TBP>>=
procedure :: fill_constants => process_library_entry_fill_constants
<<Process libraries: procedures>>=
subroutine process_library_entry_fill_constants (entry, driver, data)
class(process_library_entry_t), intent(in) :: entry
class(prclib_driver_t), intent(in) :: driver
type(process_constants_t), intent(out) :: data
integer :: i
if (entry%i_external /= 0) then
i = entry%i_external
data%id = driver%get_process_id (i)
data%model_name = driver%get_model_name (i)
data%md5sum = driver%get_md5sum (i)
data%openmp_supported = driver%get_openmp_status (i)
data%n_in = driver%get_n_in (i)
data%n_out = driver%get_n_out (i)
data%n_flv = driver%get_n_flv (i)
data%n_hel = driver%get_n_hel (i)
data%n_col = driver%get_n_col (i)
data%n_cin = driver%get_n_cin (i)
data%n_cf = driver%get_n_cf (i)
call driver%set_flv_state (i, data%flv_state)
call driver%set_hel_state (i, data%hel_state)
call driver%set_col_state (i, data%col_state, data%ghost_flag)
call driver%set_color_factors (i, data%color_factors, data%cf_index)
else
select type (proc_driver => entry%driver)
class is (process_driver_internal_t)
call proc_driver%fill_constants (data)
end select
end if
end subroutine process_library_entry_fill_constants
@ %def process_library_entry_fill_constants
@ Retrieve the constants for a process
<<Process libraries: process library: TBP>>=
procedure :: fill_constants => process_library_fill_constants
<<Process libraries: procedures>>=
subroutine process_library_fill_constants (lib, id, i_component, data)
class(process_library_t), intent(in) :: lib
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
type(process_constants_t), intent(out) :: data
integer :: i
do i = 1, size (lib%entry)
associate (entry => lib%entry(i))
if (entry%def%id == id .and. entry%i_component == i_component) then
call entry%fill_constants (lib%driver, data)
return
end if
end associate
end do
end subroutine process_library_fill_constants
@ %def process_library_fill_constants
@ Retrieve the constants and a connected driver for a process,
identified by a process ID and a subprocess index. We
scan the process entries until we have found a match.
<<Process libraries: process library: TBP>>=
procedure :: connect_process => process_library_connect_process
<<Process libraries: procedures>>=
subroutine process_library_connect_process &
(lib, id, i_component, data, proc_driver)
class(process_library_t), intent(in) :: lib
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
type(process_constants_t), intent(out) :: data
class(prc_core_driver_t), allocatable, intent(out) :: proc_driver
integer :: i
do i = 1, size (lib%entry)
associate (entry => lib%entry(i))
if (entry%def%id == id .and. entry%i_component == i_component) then
call entry%fill_constants (lib%driver, data)
allocate (proc_driver, source = entry%driver)
return
end if
end associate
end do
call msg_fatal ("Process library '" // char (lib%basename) &
// "': process '" // char (id) // "' not found")
end subroutine process_library_connect_process
@ %def process_library_connect_process
@
Shortcut for use in unit tests: fetch the MD5sum from a specific
library entry and inject it into the writer of a specific record.
<<Process libraries: process library: TBP>>=
procedure :: test_transfer_md5sum => process_library_test_transfer_md5sum
<<Process libraries: procedures>>=
subroutine process_library_test_transfer_md5sum (lib, r, e, c)
class(process_library_t), intent(inout) :: lib
integer, intent(in) :: r, e, c
associate (writer => lib%driver%record(r)%writer)
writer%md5sum = lib%entry(e)%def%get_md5sum (c)
end associate
end subroutine process_library_test_transfer_md5sum
@ %def process_library_test_transfer_md5sum
@
<<Process libraries: process library: TBP>>=
procedure :: get_nlo_type => process_library_get_nlo_type
<<Process libraries: procedures>>=
function process_library_get_nlo_type (lib, id, i_component) result (nlo_type)
integer :: nlo_type
class(process_library_t), intent(in) :: lib
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
integer :: i
do i = 1, size (lib%entry)
if (lib%entry(i)%def%id == id .and. lib%entry(i)%i_component == i_component) then
nlo_type = lib%entry(i)%def%get_nlo_type (i_component)
exit
end if
end do
end function process_library_get_nlo_type
@ %def process_library_get_nlo_type
@
\subsection{Collect model-specific libraries}
This returns appropriate linker flags for the model parameter libraries that
are used by the generated matrix element. At the end, the main libwhizard is
appended (again), because functions from that may be reqired.
Extra models in the local user space need to be treated individually.
<<Process libraries: process library: TBP>>=
procedure :: get_modellibs_ldflags => process_library_get_modellibs_ldflags
<<Process libraries: procedures>>=
function process_library_get_modellibs_ldflags (prc_lib, os_data) result (flags)
class(process_library_t), intent(in) :: prc_lib
type(os_data_t), intent(in) :: os_data
type(string_t) :: flags
type(string_t), dimension(:), allocatable :: models
type(string_t) :: modelname, modellib, modellib_full
logical :: exist
integer :: i, j, mi
flags = " -lomega"
if ((.not. os_data%use_testfiles) .and. &
os_dir_exist (os_data%whizard_models_libpath_local)) &
flags = flags // " -L" // os_data%whizard_models_libpath_local
flags = flags // " -L" // os_data%whizard_models_libpath
allocate (models(prc_lib%n_entries + 1))
models = ""
mi = 1
if (allocated (prc_lib%entry)) then
SCAN: do i = 1, prc_lib%n_entries
if (associated (prc_lib%entry(i)%def)) then
if (prc_lib%entry(i)%def%model_name /= "") then
modelname = prc_lib%entry(i)%def%model_name
else
cycle SCAN
end if
else
cycle SCAN
end if
do j = 1, mi
if (models(mi) == modelname) cycle SCAN
end do
models(mi) = modelname
mi = mi + 1
if (os_data%use_libtool) then
modellib = "libparameters_" // modelname // ".la"
else
modellib = "libparameters_" // modelname // ".a"
end if
exist = .false.
if (.not. os_data%use_testfiles) then
modellib_full = os_data%whizard_models_libpath_local &
// "/" // modellib
inquire (file=char (modellib_full), exist=exist)
end if
if (.not. exist) then
modellib_full = os_data%whizard_models_libpath &
// "/" // modellib
inquire (file=char (modellib_full), exist=exist)
end if
if (exist) flags = flags // " -lparameters_" // modelname
end do SCAN
end if
deallocate (models)
flags = flags // " -lwhizard"
end function process_library_get_modellibs_ldflags
@ %def process_library_get_modellibs_ldflags
@
<<Process libraries: process library: TBP>>=
procedure :: get_static_modelname => process_library_get_static_modelname
<<Process libraries: procedures>>=
function process_library_get_static_modelname (prc_lib, os_data) result (name)
class(process_library_t), intent(in) :: prc_lib
type(os_data_t), intent(in) :: os_data
type(string_t) :: name
type(string_t), dimension(:), allocatable :: models
type(string_t) :: modelname, modellib, modellib_full
logical :: exist
integer :: i, j, mi
name = ""
allocate (models(prc_lib%n_entries + 1))
models = ""
mi = 1
if (allocated (prc_lib%entry)) then
SCAN: do i = 1, prc_lib%n_entries
if (associated (prc_lib%entry(i)%def)) then
if (prc_lib%entry(i)%def%model_name /= "") then
modelname = prc_lib%entry(i)%def%model_name
else
cycle SCAN
end if
else
cycle SCAN
end if
do j = 1, mi
if (models(mi) == modelname) cycle SCAN
end do
models(mi) = modelname
mi = mi + 1
modellib = "libparameters_" // modelname // ".a"
exist = .false.
if (.not. os_data%use_testfiles) then
modellib_full = os_data%whizard_models_libpath_local &
// "/" // modellib
inquire (file=char (modellib_full), exist=exist)
end if
if (.not. exist) then
modellib_full = os_data%whizard_models_libpath &
// "/" // modellib
inquire (file=char (modellib_full), exist=exist)
end if
if (exist) name = name // " " // modellib_full
end do SCAN
end if
deallocate (models)
end function process_library_get_static_modelname
@ %def process_library_get_static_modelname
@
\subsection{Unit Test}
Test module, followed by the corresponding implementation module.
<<[[process_libraries_ut.f90]]>>=
<<File header>>
module process_libraries_ut
use unit_tests
use process_libraries_uti
<<Standard module head>>
<<Process libraries: public test>>
contains
<<Process libraries: test driver>>
end module process_libraries_ut
@ %def process_libraries_ut
@
<<[[process_libraries_uti.f90]]>>=
<<File header>>
module process_libraries_uti
use, intrinsic :: iso_c_binding !NODEP!
<<Use strings>>
use io_units
use os_interface
use particle_specifiers, only: new_prt_spec
use process_constants
use prclib_interfaces
use prc_core_def
use process_libraries
use prclib_interfaces_ut, only: test_writer_4_t
<<Standard module head>>
<<Process libraries: test declarations>>
<<Process libraries: test types>>
contains
<<Process libraries: tests>>
<<Process libraries: test auxiliary>>
end module process_libraries_uti
@ %def process_libraries_ut
@ API: driver for the unit tests below.
<<Process libraries: public test>>=
public :: process_libraries_test
<<Process libraries: test driver>>=
subroutine process_libraries_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Process libraries: execute tests>>
end subroutine process_libraries_test
@ %def process_libraries_test
@
\subsubsection{Empty process list}
Test 1: Write an empty process list.
<<Process libraries: execute tests>>=
call test (process_libraries_1, "process_libraries_1", &
"empty process list", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_1
<<Process libraries: tests>>=
subroutine process_libraries_1 (u)
integer, intent(in) :: u
type(process_def_list_t) :: process_def_list
write (u, "(A)") "* Test output: process_libraries_1"
write (u, "(A)") "* Purpose: Display an empty process definition list"
write (u, "(A)")
call process_def_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_1"
end subroutine process_libraries_1
@ %def process_libraries_1
@
\subsubsection{Process definition list}
Test 2: Process definition list with processes and components.
Construct the list, write to file, read it in again, and display.
Finalize and delete the list after use.
We define a trivial 'test' type for the process variant. The test
type contains just one (meaningless) data item, which is an integer.
<<Process libraries: test types>>=
type, extends (prc_core_def_t) :: prcdef_2_t
integer :: data = 0
logical :: file = .false.
contains
<<Process libraries: prcdef 2: TBP>>
end type prcdef_2_t
@ %def prcdef_2_t
@ The process variant is named 'test'.
<<Process libraries: prcdef 2: TBP>>=
procedure, nopass :: type_string => prcdef_2_type_string
<<Process libraries: test auxiliary>>=
function prcdef_2_type_string () result (string)
type(string_t) :: string
string = "test"
end function prcdef_2_type_string
@ %def prcdef_2_type_string
@ Write the contents (the integer value).
<<Process libraries: prcdef 2: TBP>>=
procedure :: write => prcdef_2_write
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_write (object, unit)
class(prcdef_2_t), intent(in) :: object
integer, intent(in) :: unit
write (unit, "(3x,A,I0)") "Test data = ", object%data
end subroutine prcdef_2_write
@ %def prcdef_2_write
@ Recover the integer value.
<<Process libraries: prcdef 2: TBP>>=
procedure :: read => prcdef_2_read
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_read (object, unit)
class(prcdef_2_t), intent(out) :: object
integer, intent(in) :: unit
character(80) :: buffer
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) object%data
end subroutine prcdef_2_read
@ %def prcdef_2_read
@ No external procedures.
<<Process libraries: prcdef 2: TBP>>=
procedure, nopass :: get_features => prcdef_2_get_features
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_get_features (features)
type(string_t), dimension(:), allocatable, intent(out) :: features
allocate (features (0))
end subroutine prcdef_2_get_features
@ %def prcdef_2_get_features
@ No code generated.
<<Process libraries: prcdef 2: TBP>>=
procedure :: generate_code => prcdef_2_generate_code
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_generate_code (object, &
basename, model_name, prt_in, prt_out)
class(prcdef_2_t), intent(in) :: object
type(string_t), intent(in) :: basename
type(string_t), intent(in) :: model_name
type(string_t), dimension(:), intent(in) :: prt_in
type(string_t), dimension(:), intent(in) :: prt_out
end subroutine prcdef_2_generate_code
@ %def prcdef_2_generate_code
@ Allocate the driver with the appropriate type.
<<Process libraries: prcdef 2: TBP>>=
procedure :: allocate_driver => prcdef_2_allocate_driver
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_allocate_driver (object, driver, basename)
class(prcdef_2_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
allocate (prctest_2_t :: driver)
end subroutine prcdef_2_allocate_driver
@ %def prcdef_2_allocate_driver
@ Nothing to connect.
<<Process libraries: prcdef 2: TBP>>=
procedure :: connect => prcdef_2_connect
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_connect (def, lib_driver, i, proc_driver)
class(prcdef_2_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
end subroutine prcdef_2_connect
@ %def prcdef_2_connect
@ The associated driver type.
<<Process libraries: test types>>=
type, extends (process_driver_internal_t) :: prctest_2_t
contains
<<Process libraries: prctest 2: TBP>>
end type prctest_2_t
@ %def prctest_2_t
@ Return the type name.
<<Process libraries: prctest 2: TBP>>=
procedure, nopass :: type_name => prctest_2_type_name
<<Process libraries: test auxiliary>>=
function prctest_2_type_name () result (type)
type(string_t) :: type
type = "test"
end function prctest_2_type_name
@ %def prctest_2_type_name
@ This should fill constant process data. We do not check those here,
however, therefore nothing done.
<<Process libraries: prctest 2: TBP>>=
procedure :: fill_constants => prctest_2_fill_constants
<<Process libraries: test auxiliary>>=
subroutine prctest_2_fill_constants (driver, data)
class(prctest_2_t), intent(in) :: driver
type(process_constants_t), intent(out) :: data
end subroutine prctest_2_fill_constants
@ %def prctest_2_fill_constants
@
Here is the actual test.
For reading, we need a list of templates, i.e., an array containing
allocated objects for all available process variants. This is the
purpose of [[process_core_templates]]. Here, we have only a single
template for the 'test' variant.
<<Process libraries: execute tests>>=
call test (process_libraries_2, "process_libraries_2", &
"process definition list", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_2
<<Process libraries: tests>>=
subroutine process_libraries_2 (u)
integer, intent(in) :: u
type(prc_template_t), dimension(:), allocatable :: process_core_templates
type(process_def_list_t) :: process_def_list
type(process_def_entry_t), pointer :: entry => null ()
class(prc_core_def_t), allocatable :: test_def
integer :: scratch_unit
write (u, "(A)") "* Test output: process_libraries_2"
write (u, "(A)") "* Purpose: Construct a process definition list,"
write (u, "(A)") "* write it to file and reread it"
write (u, "(A)") ""
write (u, "(A)") "* Construct a process definition list"
write (u, "(A)") "* First process definition: empty"
write (u, "(A)") "* Second process definition: two components"
write (u, "(A)") "* First component: empty"
write (u, "(A)") "* Second component: test data"
write (u, "(A)") "* Third process definition:"
write (u, "(A)") "* Embedded decays and polarization"
write (u, "(A)")
allocate (process_core_templates (1))
allocate (prcdef_2_t :: process_core_templates(1)%core_def)
allocate (entry)
call entry%init (var_str ("first"), n_in = 0, n_components = 0)
call entry%compute_md5sum ()
call process_def_list%append (entry)
allocate (entry)
call entry%init (var_str ("second"), model_name = var_str ("Test"), &
n_in = 1, n_components = 2)
allocate (prcdef_2_t :: test_def)
select type (test_def)
type is (prcdef_2_t); test_def%data = 42
end select
call entry%import_component (2, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = test_def)
call entry%compute_md5sum ()
call process_def_list%append (entry)
allocate (entry)
call entry%init (var_str ("third"), model_name = var_str ("Test"), &
n_in = 2, n_components = 1)
allocate (prcdef_2_t :: test_def)
call entry%import_component (1, n_out = 3, &
prt_in = &
new_prt_spec ([var_str ("a"), var_str ("b")]), &
prt_out = &
[new_prt_spec (var_str ("c")), &
new_prt_spec (var_str ("d"), .true.), &
new_prt_spec (var_str ("e"), [var_str ("e_decay")])], &
method = var_str ("test"), &
variant = test_def)
call entry%compute_md5sum ()
call process_def_list%append (entry)
call process_def_list%write (u)
write (u, "(A)") ""
write (u, "(A)") "* Write the process definition list to (scratch) file"
scratch_unit = free_unit ()
open (unit = scratch_unit, status="scratch", action = "readwrite")
call process_def_list%write (scratch_unit)
call process_def_list%final ()
write (u, "(A)") "* Reread it"
write (u, "(A)") ""
rewind (scratch_unit)
call process_def_list%read (scratch_unit, process_core_templates)
close (scratch_unit)
call process_def_list%write (u)
call process_def_list%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_2"
end subroutine process_libraries_2
@ %def process_libraries_2
@
\subsubsection{Process library object}
Test 3: Process library object with several process definitions and
library entries. Just construct the object, modify some initial
content, and write the result. The modifications are mostly applied
directly, so we do not test anything but the contents and the output
routine.
<<Process libraries: execute tests>>=
call test (process_libraries_3, "process_libraries_3", &
"recover process definition list from file", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_3
<<Process libraries: tests>>=
subroutine process_libraries_3 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_driver_t), allocatable :: driver_template
write (u, "(A)") "* Test output: process_libraries_3"
write (u, "(A)") "* Purpose: Construct a process library object &
&with entries"
write (u, "(A)") ""
write (u, "(A)") "* Construct and display a process library object"
write (u, "(A)") "* with 5 entries"
write (u, "(A)") "* associated with 3 matrix element codes"
write (u, "(A)") "* corresponding to 3 process definitions"
write (u, "(A)") "* with 2, 1, 1 components, respectively"
write (u, "(A)")
call lib%init (var_str ("testlib"))
call lib%set_status (STAT_ACTIVE)
call lib%allocate_entries (5)
allocate (entry)
call entry%init (var_str ("test_a"), n_in = 2, n_components = 2)
allocate (prctest_2_t :: driver_template)
call lib%init_entry (3, STAT_SOURCE, entry%process_def_t, 2, 2, &
driver_template)
call lib%init_entry (4, STAT_COMPILED, entry%process_def_t, 1, 0)
call lib%append (entry)
allocate (entry)
call entry%init (var_str ("test_b"), n_in = 2, n_components = 1)
call lib%init_entry (2, STAT_CONFIGURED, entry%process_def_t, 1, 1)
call lib%append (entry)
allocate (entry)
call entry%init (var_str ("test_c"), n_in = 2, n_components = 1)
allocate (prctest_2_t :: driver_template)
call lib%init_entry (5, STAT_LINKED, entry%process_def_t, 1, 3, &
driver_template)
call lib%append (entry)
call lib%write (u)
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_3"
end subroutine process_libraries_3
@ %def process_libraries_3
@
\subsubsection{Process library for test matrix element (no file)}
Test 4: We proceed through the library generation and loading phases
with a test matrix element type that needs no code written on file.
<<Process libraries: execute tests>>=
call test (process_libraries_4, "process_libraries_4", &
"build and load internal process library", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_4
<<Process libraries: tests>>=
subroutine process_libraries_4 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_def_t), allocatable :: core_def
type(os_data_t) :: os_data
write (u, "(A)") "* Test output: process_libraries_4"
write (u, "(A)") "* Purpose: build a process library with an &
&internal (pseudo) matrix element"
write (u, "(A)") "* No Makefile or code should be generated"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry &
&(no external code)"
write (u, "(A)")
call os_data_init (os_data)
call lib%init (var_str ("proclibs4"))
allocate (prcdef_2_t :: core_def)
allocate (entry)
call entry%init (var_str ("proclibs4_a"), n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, variant = core_def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Compute MD5 sum"
write (u, "(A)")
call lib%compute_md5sum ()
write (u, "(A)") "* Write makefile (no-op)"
write (u, "(A)")
call lib%write_makefile (os_data, force = .true., verbose = .true.)
write (u, "(A)") "* Write driver source code (no-op)"
write (u, "(A)")
call lib%write_driver (force = .true.)
write (u, "(A)") "* Write process source code (no-op)"
write (u, "(A)")
call lib%make_source (os_data)
write (u, "(A)") "* Compile (no-op)"
write (u, "(A)")
call lib%make_compile (os_data)
write (u, "(A)") "* Link (no-op)"
write (u, "(A)")
call lib%make_link (os_data)
write (u, "(A)") "* Load (no-op)"
write (u, "(A)")
call lib%load (os_data)
call lib%write (u)
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_4"
end subroutine process_libraries_4
@ %def process_libraries_4
@
\subsubsection{Build workflow for test matrix element}
Test 5: We write source code for a dummy process.
We define another trivial type for the process variant. The test
type contains just no variable data, but produces code on file.
<<Process libraries: test types>>=
type, extends (prc_core_def_t) :: prcdef_5_t
contains
<<Process libraries: prcdef 5: TBP>>
end type prcdef_5_t
@ %def prcdef_5_t
@ The process variant is named [[test_file]].
<<Process libraries: prcdef 5: TBP>>=
procedure, nopass :: type_string => prcdef_5_type_string
<<Process libraries: test auxiliary>>=
function prcdef_5_type_string () result (string)
type(string_t) :: string
string = "test_file"
end function prcdef_5_type_string
@ %def prcdef_5_type_string
@ We reuse the writer [[test_writer_4]] from the previous module.
<<Process libraries: prcdef 5: TBP>>=
procedure :: init => prcdef_5_init
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_init (object)
class(prcdef_5_t), intent(out) :: object
allocate (test_writer_4_t :: object%writer)
end subroutine prcdef_5_init
@ %def prcdef_5_init
@ Nothing to write.
<<Process libraries: prcdef 5: TBP>>=
procedure :: write => prcdef_5_write
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_write (object, unit)
class(prcdef_5_t), intent(in) :: object
integer, intent(in) :: unit
end subroutine prcdef_5_write
@ %def prcdef_5_write
@ Nothing to read.
<<Process libraries: prcdef 5: TBP>>=
procedure :: read => prcdef_5_read
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_read (object, unit)
class(prcdef_5_t), intent(out) :: object
integer, intent(in) :: unit
end subroutine prcdef_5_read
@ %def prcdef_5_read
@ Allocate the driver with the appropriate type.
<<Process libraries: prcdef 5: TBP>>=
procedure :: allocate_driver => prcdef_5_allocate_driver
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_allocate_driver (object, driver, basename)
class(prcdef_5_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
allocate (prctest_5_t :: driver)
end subroutine prcdef_5_allocate_driver
@ %def prcdef_5_allocate_driver
@ This time we need code:
<<Process libraries: prcdef 5: TBP>>=
procedure, nopass :: needs_code => prcdef_5_needs_code
<<Process libraries: test auxiliary>>=
function prcdef_5_needs_code () result (flag)
logical :: flag
flag = .true.
end function prcdef_5_needs_code
@ %def prcdef_5_needs_code
@ For the test case, we implement a single feature [[proc1]].
<<Process libraries: prcdef 5: TBP>>=
procedure, nopass :: get_features => prcdef_5_get_features
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_get_features (features)
type(string_t), dimension(:), allocatable, intent(out) :: features
allocate (features (1))
features = [ var_str ("proc1") ]
end subroutine prcdef_5_get_features
@ %def prcdef_5_get_features
@ Nothing to connect.
<<Process libraries: prcdef 5: TBP>>=
procedure :: connect => prcdef_5_connect
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_connect (def, lib_driver, i, proc_driver)
class(prcdef_5_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
end subroutine prcdef_5_connect
@ %def prcdef_5_connect
@ The driver type.
<<Process libraries: test types>>=
type, extends (prc_core_driver_t) :: prctest_5_t
contains
<<Process libraries: prctest 5: TBP>>
end type prctest_5_t
@ %def prctest_5_t
@ Return the type name.
<<Process libraries: prctest 5: TBP>>=
procedure, nopass :: type_name => prctest_5_type_name
<<Process libraries: test auxiliary>>=
function prctest_5_type_name () result (type)
type(string_t) :: type
type = "test_file"
end function prctest_5_type_name
@ %def prctest_5_type_name
@
Here is the actual test:
<<Process libraries: execute tests>>=
call test (process_libraries_5, "process_libraries_5", &
"build external process library", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_5
<<Process libraries: tests>>=
subroutine process_libraries_5 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_def_t), allocatable :: core_def
type(os_data_t) :: os_data
write (u, "(A)") "* Test output: process_libraries_5"
write (u, "(A)") "* Purpose: build a process library with an &
&external (pseudo) matrix element"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call lib%init (var_str ("proclibs5"))
call os_data_init (os_data)
allocate (prcdef_5_t :: core_def)
select type (core_def)
type is (prcdef_5_t)
call core_def%init ()
end select
allocate (entry)
call entry%init (var_str ("proclibs5_a"), &
model_name = var_str ("Test_Model"), &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = core_def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Compute MD5 sum"
write (u, "(A)")
call lib%compute_md5sum ()
write (u, "(A)") "* Write makefile"
write (u, "(A)")
call lib%write_makefile (os_data, force = .true., verbose = .false.)
write (u, "(A)") "* Write driver source code"
write (u, "(A)")
call lib%write_driver (force = .true.)
write (u, "(A)") "* Write process source code"
write (u, "(A)")
call lib%make_source (os_data)
write (u, "(A)") "* Compile"
write (u, "(A)")
call lib%make_compile (os_data)
write (u, "(A)") "* Link"
write (u, "(A)")
call lib%make_link (os_data)
call lib%write (u, libpath = .false.)
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_5"
end subroutine process_libraries_5
@ %def process_libraries_5
@
\subsubsection{Build and load library with test matrix element}
Test 6: We write source code for a dummy process.
This process variant is identical to the previous case, but it
supports a driver for the test procedure 'proc1'.
<<Process libraries: test types>>=
type, extends (prc_core_def_t) :: prcdef_6_t
contains
<<Process libraries: prcdef 6: TBP>>
end type prcdef_6_t
@ %def prcdef_6_t
@ The process variant is named [[test_file]].
<<Process libraries: prcdef 6: TBP>>=
procedure, nopass :: type_string => prcdef_6_type_string
<<Process libraries: test auxiliary>>=
function prcdef_6_type_string () result (string)
type(string_t) :: string
string = "test_file"
end function prcdef_6_type_string
@ %def prcdef_6_type_string
@ We reuse the writer [[test_writer_4]] from the previous module.
<<Process libraries: prcdef 6: TBP>>=
procedure :: init => prcdef_6_init
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_init (object)
class(prcdef_6_t), intent(out) :: object
allocate (test_writer_4_t :: object%writer)
call object%writer%init_test ()
end subroutine prcdef_6_init
@ %def prcdef_6_init
@ Nothing to write.
<<Process libraries: prcdef 6: TBP>>=
procedure :: write => prcdef_6_write
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_write (object, unit)
class(prcdef_6_t), intent(in) :: object
integer, intent(in) :: unit
end subroutine prcdef_6_write
@ %def prcdef_6_write
@ Nothing to read.
<<Process libraries: prcdef 6: TBP>>=
procedure :: read => prcdef_6_read
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_read (object, unit)
class(prcdef_6_t), intent(out) :: object
integer, intent(in) :: unit
end subroutine prcdef_6_read
@ %def prcdef_6_read
@ Allocate the driver with the appropriate type.
<<Process libraries: prcdef 6: TBP>>=
procedure :: allocate_driver => prcdef_6_allocate_driver
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_allocate_driver (object, driver, basename)
class(prcdef_6_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
allocate (prctest_6_t :: driver)
end subroutine prcdef_6_allocate_driver
@ %def prcdef_6_allocate_driver
@ This time we need code:
<<Process libraries: prcdef 6: TBP>>=
procedure, nopass :: needs_code => prcdef_6_needs_code
<<Process libraries: test auxiliary>>=
function prcdef_6_needs_code () result (flag)
logical :: flag
flag = .true.
end function prcdef_6_needs_code
@ %def prcdef_6_needs_code
@ For the test case, we implement a single feature [[proc1]].
<<Process libraries: prcdef 6: TBP>>=
procedure, nopass :: get_features => prcdef_6_get_features
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_get_features (features)
type(string_t), dimension(:), allocatable, intent(out) :: features
allocate (features (1))
features = [ var_str ("proc1") ]
end subroutine prcdef_6_get_features
@ %def prcdef_6_get_features
@ The interface of the only specific feature.
<<Process libraries: test types>>=
abstract interface
subroutine proc1_t (n) bind(C)
import
integer(c_int), intent(out) :: n
end subroutine proc1_t
end interface
@ %def proc1_t
@ Connect the feature [[proc1]] with the process driver.
<<Process libraries: prcdef 6: TBP>>=
procedure :: connect => prcdef_6_connect
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_connect (def, lib_driver, i, proc_driver)
class(prcdef_6_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
integer(c_int) :: pid, fid
type(c_funptr) :: fptr
select type (proc_driver)
type is (prctest_6_t)
pid = i
fid = 1
call lib_driver%get_fptr (pid, fid, fptr)
call c_f_procpointer (fptr, proc_driver%proc1)
end select
end subroutine prcdef_6_connect
@ %def prcdef_6_connect
@
The driver type.
<<Process libraries: test types>>=
type, extends (prc_core_driver_t) :: prctest_6_t
procedure(proc1_t), nopass, pointer :: proc1 => null ()
contains
<<Process libraries: prctest 6: TBP>>
end type prctest_6_t
@ %def prctest_6_t
@ Return the type name.
<<Process libraries: prctest 6: TBP>>=
procedure, nopass :: type_name => prctest_6_type_name
<<Process libraries: test auxiliary>>=
function prctest_6_type_name () result (type)
type(string_t) :: type
type = "test_file"
end function prctest_6_type_name
@ %def prctest_6_type_name
@
Here is the actual test:
<<Process libraries: execute tests>>=
call test (process_libraries_6, "process_libraries_6", &
"build and load external process library", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_6
<<Process libraries: tests>>=
subroutine process_libraries_6 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_def_t), allocatable :: core_def
type(os_data_t) :: os_data
type(string_t), dimension(:), allocatable :: name_list
type(process_constants_t) :: data
class(prc_core_driver_t), allocatable :: proc_driver
integer :: i
integer(c_int) :: n
write (u, "(A)") "* Test output: process_libraries_6"
write (u, "(A)") "* Purpose: build and load a process library"
write (u, "(A)") "* with an external (pseudo) matrix element"
write (u, "(A)") "* Check single-call linking"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call lib%init (var_str ("proclibs6"))
call os_data_init (os_data)
allocate (prcdef_6_t :: core_def)
select type (core_def)
type is (prcdef_6_t)
call core_def%init ()
end select
allocate (entry)
call entry%init (var_str ("proclibs6_a"), &
model_name = var_str ("Test_model"), &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = core_def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Write makefile"
write (u, "(A)")
call lib%write_makefile (os_data, force = .true., verbose = .false.)
write (u, "(A)") "* Write driver source code"
write (u, "(A)")
call lib%write_driver (force = .true.)
write (u, "(A)") "* Write process source code, compile, link, load"
write (u, "(A)")
call lib%load (os_data)
call lib%write (u, libpath = .false.)
write (u, "(A)")
write (u, "(A)") "* Probe library API:"
write (u, "(A)")
write (u, "(1x,A,A,A)") "name = '", &
char (lib%get_name ()), "'"
write (u, "(1x,A,L1)") "is active = ", &
lib%is_active ()
write (u, "(1x,A,I0)") "n_processes = ", &
lib%get_n_processes ()
write (u, "(1x,A)", advance="no") "processes ="
call lib%get_process_id_list (name_list)
do i = 1, size (name_list)
write (u, "(1x,A)", advance="no") char (name_list(i))
end do
write (u, *)
write (u, "(1x,A,L1)") "proclibs6_a is process = ", &
lib%contains (var_str ("proclibs6_a"))
write (u, "(1x,A,I0)") "proclibs6_a has index = ", &
lib%get_entry_index (var_str ("proclibs6_a"))
write (u, "(1x,A,L1)") "foobar is process = ", &
lib%contains (var_str ("foobar"))
write (u, "(1x,A,I0)") "foobar has index = ", &
lib%get_entry_index (var_str ("foobar"))
write (u, "(1x,A,I0)") "n_in(proclibs6_a) = ", &
lib%get_n_in (var_str ("proclibs6_a"))
write (u, "(1x,A,A)") "model_name(proclibs6_a) = ", &
char (lib%get_model_name (var_str ("proclibs6_a")))
write (u, "(1x,A,I0)") "n_components(proclibs6_a) = ", &
lib%get_n_components (var_str ("proclibs6_a"))
write (u, "(1x,A)", advance="no") "components(proclibs6_a) ="
call lib%get_component_list (var_str ("proclibs6_a"), name_list)
do i = 1, size (name_list)
write (u, "(1x,A)", advance="no") char (name_list(i))
end do
write (u, *)
write (u, "(A)")
write (u, "(A)") "* Constants of proclibs6_a_i1:"
write (u, "(A)")
call lib%connect_process (var_str ("proclibs6_a"), 1, data, proc_driver)
write (u, "(1x,A,A)") "component ID = ", char (data%id)
write (u, "(1x,A,A)") "model name = ", char (data%model_name)
write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
write (u, "(1x,A,I0)") "n_in = ", data%n_in
write (u, "(1x,A,I0)") "n_out = ", data%n_out
write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
write (u, "(1x,A,I0)") "n_col = ", data%n_col
write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
write (u, "(1x,A,10(1x,I0))") "hel state =", data%hel_state
write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index
write (u, "(A)")
write (u, "(A)") "* Call feature of proclibs6_a:"
write (u, "(A)")
select type (proc_driver)
type is (prctest_6_t)
call proc_driver%proc1 (n)
write (u, "(1x,A,I0)") "proc1 = ", n
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_6"
end subroutine process_libraries_6
@ %def process_libraries_6
@
\subsubsection{MD5 sums}
Check MD5 sum calculation.
<<Process libraries: execute tests>>=
call test (process_libraries_7, "process_libraries_7", &
"process definition list", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_7
<<Process libraries: tests>>=
subroutine process_libraries_7 (u)
integer, intent(in) :: u
type(prc_template_t), dimension(:), allocatable :: process_core_templates
type(process_def_entry_t), target :: entry
class(prc_core_def_t), allocatable :: test_def
class(prc_core_def_t), pointer :: def
write (u, "(A)") "* Test output: process_libraries_7"
write (u, "(A)") "* Purpose: Construct a process definition list &
&and check MD5 sums"
write (u, "(A)")
write (u, "(A)") "* Construct a process definition list"
write (u, "(A)") "* Process: two components"
write (u, "(A)")
allocate (process_core_templates (1))
allocate (prcdef_2_t :: process_core_templates(1)%core_def)
call entry%init (var_str ("first"), model_name = var_str ("Test"), &
n_in = 1, n_components = 2)
allocate (prcdef_2_t :: test_def)
select type (test_def)
type is (prcdef_2_t); test_def%data = 31
end select
call entry%import_component (1, n_out = 3, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c"), &
var_str ("e")]), &
method = var_str ("test"), &
variant = test_def)
allocate (prcdef_2_t :: test_def)
select type (test_def)
type is (prcdef_2_t); test_def%data = 42
end select
call entry%import_component (2, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = test_def)
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute MD5 sums"
write (u, "(A)")
call entry%compute_md5sum ()
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Recalculate MD5 sums (should be identical)"
write (u, "(A)")
call entry%compute_md5sum ()
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Modify a component and recalculate MD5 sums"
write (u, "(A)")
def => entry%get_core_def_ptr (2)
select type (def)
type is (prcdef_2_t)
def%data = 54
end select
call entry%compute_md5sum ()
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Modify the model and recalculate MD5 sums"
write (u, "(A)")
call entry%set_model_name (var_str ("foo"))
call entry%compute_md5sum ()
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_7"
end subroutine process_libraries_7
@ %def process_libraries_7
@
Here is the actual test:
<<Process libraries: execute tests>>=
call test (process_libraries_8, "process_libraries_8", &
"library status checks", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_8
<<Process libraries: tests>>=
subroutine process_libraries_8 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_def_t), allocatable :: core_def
type(os_data_t) :: os_data
write (u, "(A)") "* Test output: process_libraries_8"
write (u, "(A)") "* Purpose: build and load a process library"
write (u, "(A)") "* with an external (pseudo) matrix element"
write (u, "(A)") "* Check status updates"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call lib%init (var_str ("proclibs8"))
call os_data_init (os_data)
allocate (prcdef_6_t :: core_def)
select type (core_def)
type is (prcdef_6_t)
call core_def%init ()
end select
allocate (entry)
call entry%init (var_str ("proclibs8_a"), &
model_name = var_str ("Test_model"), &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = core_def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
call lib%compute_md5sum ()
call lib%test_transfer_md5sum (1, 1, 1)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(A)")
write (u, "(A)") "* Write makefile"
write (u, "(A)")
call lib%write_makefile (os_data, force = .true., verbose = .false.)
write (u, "(A)") "* Update status"
write (u, "(A)")
call lib%update_status (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(A)")
write (u, "(A)") "* Write driver source code"
write (u, "(A)")
call lib%write_driver (force = .false.)
write (u, "(A)") "* Write process source code"
write (u, "(A)")
call lib%make_source (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(A)")
write (u, "(A)") "* Compile and load"
write (u, "(A)")
call lib%load (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(A)")
write (u, "(A)") "* Append process and reconfigure"
write (u, "(A)")
allocate (prcdef_6_t :: core_def)
select type (core_def)
type is (prcdef_6_t)
call core_def%init ()
end select
allocate (entry)
call entry%init (var_str ("proclibs8_b"), &
model_name = var_str ("Test_model"), &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("d")]), &
method = var_str ("test"), &
variant = core_def)
call lib%append (entry)
call lib%configure (os_data)
call lib%compute_md5sum ()
call lib%test_transfer_md5sum (2, 2, 1)
call lib%write_makefile (os_data, force = .false., verbose = .false.)
call lib%write_driver (force = .false.)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Update status"
write (u, "(A)")
call lib%update_status (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Write source code"
write (u, "(A)")
call lib%make_source (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Reset status"
write (u, "(A)")
call lib%set_status (STAT_CONFIGURED, entries=.true.)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Update status"
write (u, "(A)")
call lib%update_status (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Partial cleanup"
write (u, "(A)")
call lib%clean (os_data, distclean = .false.)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Update status"
write (u, "(A)")
call lib%update_status (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Complete cleanup"
call lib%clean (os_data, distclean = .true.)
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_8"
end subroutine process_libraries_8
@ %def process_libraries_8
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process Library Stacks}
For storing and handling multiple libraries, we define process library stacks.
These are ordinary stacks where new entries are pushed onto the top.
<<[[prclib_stacks.f90]]>>=
<<File header>>
module prclib_stacks
<<Use strings>>
use io_units
use format_utils, only: write_separator
use process_libraries
<<Standard module head>>
<<Prclib stacks: public>>
<<Prclib stacks: types>>
contains
<<Prclib stacks: procedures>>
end module prclib_stacks
@ %def prclib_stacks
@
\subsection{The stack entry type}
A stack entry is a process library object, augmented by a pointer to the
next entry. We do not need specific methods, all relevant methods are
inherited.
On higher level, process libraries should be prepared as process entry objects.
<<Prclib stacks: public>>=
public :: prclib_entry_t
<<Prclib stacks: types>>=
type, extends (process_library_t) :: prclib_entry_t
type(prclib_entry_t), pointer :: next => null ()
end type prclib_entry_t
@ %def prclib_entry_t
@
\subsection{The prclib 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.
<<Prclib stacks: public>>=
public :: prclib_stack_t
<<Prclib stacks: types>>=
type :: prclib_stack_t
integer :: n = 0
type(prclib_entry_t), pointer :: first => null ()
contains
<<Prclib stacks: prclib stack: TBP>>
end type prclib_stack_t
@ %def prclib_stack_t
@ Finalizer. Iteratively deallocate the stack entries. The resulting
empty stack can be immediately recycled, if necessary.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: final => prclib_stack_final
<<Prclib stacks: procedures>>=
subroutine prclib_stack_final (object)
class(prclib_stack_t), intent(inout) :: object
type(prclib_entry_t), pointer :: lib
do while (associated (object%first))
lib => object%first
object%first => lib%next
call lib%final ()
deallocate (lib)
end do
object%n = 0
end subroutine prclib_stack_final
@ %def prclib_stack_final
@ Output. The entries on the stack will be ordered LIFO, i.e., backwards.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: write => prclib_stack_write
<<Prclib stacks: procedures>>=
subroutine prclib_stack_write (object, unit, libpath)
class(prclib_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: libpath
type(prclib_entry_t), pointer :: lib
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
select case (object%n)
case (0)
write (u, "(1x,A)") "Process library stack: [empty]"
case default
write (u, "(1x,A)") "Process library stack:"
lib => object%first
do while (associated (lib))
call write_separator (u)
call lib%write (u, libpath)
lib => lib%next
end do
end select
call write_separator (u, 2)
end subroutine prclib_stack_write
@ %def prclib_stack_write
@
\subsection{Operating on Stacks}
We take a library entry pointer and push it onto the stack. The previous
pointer is nullified. Subsequently, the library entry is `owned' by the
stack and will be finalized when the stack is deleted.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: push => prclib_stack_push
<<Prclib stacks: procedures>>=
subroutine prclib_stack_push (stack, lib)
class(prclib_stack_t), intent(inout) :: stack
type(prclib_entry_t), intent(inout), pointer :: lib
lib%next => stack%first
stack%first => lib
lib => null ()
stack%n = stack%n + 1
end subroutine prclib_stack_push
@ %def prclib_stack_push
@
\subsection{Accessing Contents}
Return a pointer to the topmost stack element. The result type is
just the bare [[process_library_t]]. There is no [[target]] attribute
required since the stack elements are allocated via pointers.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: get_first_ptr => prclib_stack_get_first_ptr
<<Prclib stacks: procedures>>=
function prclib_stack_get_first_ptr (stack) result (ptr)
class(prclib_stack_t), intent(in) :: stack
type(process_library_t), pointer :: ptr
if (associated (stack%first)) then
ptr => stack%first%process_library_t
else
ptr => null ()
end if
end function prclib_stack_get_first_ptr
@ %def prclib_stack_get_first_ptr
@ Return a complete list of the libraries (names) in the stack. The list is
in the order in which the elements got pushed onto the stack, so the 'first'
entry is listed last.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: get_names => prclib_stack_get_names
<<Prclib stacks: procedures>>=
subroutine prclib_stack_get_names (stack, libname)
class(prclib_stack_t), intent(in) :: stack
type(string_t), dimension(:), allocatable, intent(out) :: libname
type(prclib_entry_t), pointer :: lib
integer :: i
allocate (libname (stack%n))
i = stack%n
lib => stack%first
do while (associated (lib))
libname(i) = lib%get_name ()
i = i - 1
lib => lib%next
end do
end subroutine prclib_stack_get_names
@ %def prclib_stack_get_names
@ Return a pointer to the library with given name.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: get_library_ptr => prclib_stack_get_library_ptr
<<Prclib stacks: procedures>>=
function prclib_stack_get_library_ptr (stack, libname) result (ptr)
class(prclib_stack_t), intent(in) :: stack
type(string_t), intent(in) :: libname
type(process_library_t), pointer :: ptr
type(prclib_entry_t), pointer :: current
current => stack%first
do while (associated (current))
if (current%get_name () == libname) then
ptr => current%process_library_t
return
end if
current => current%next
end do
ptr => null ()
end function prclib_stack_get_library_ptr
@ %def prclib_stack_get_library_ptr
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[prclib_stacks_ut.f90]]>>=
<<File header>>
module prclib_stacks_ut
use unit_tests
use prclib_stacks_uti
<<Standard module head>>
<<Prclib stacks: public test>>
contains
<<Prclib stacks: test driver>>
end module prclib_stacks_ut
@ %def prclib_stacks_ut
@
<<[[prclib_stacks_uti.f90]]>>=
<<File header>>
module prclib_stacks_uti
<<Use strings>>
use prclib_stacks
<<Standard module head>>
<<Prclib stacks: test declarations>>
contains
<<Prclib stacks: tests>>
end module prclib_stacks_uti
@ %def prclib_stacks_ut
@ API: driver for the unit tests below.
<<Prclib stacks: public test>>=
public :: prclib_stacks_test
<<Prclib stacks: test driver>>=
subroutine prclib_stacks_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Prclib stacks: execute tests>>
end subroutine prclib_stacks_test
@ %def prclib_stacks_test
@
\subsubsection{Write an empty process library stack}
The most trivial test is to write an uninitialized process library stack.
<<Prclib stacks: execute tests>>=
call test (prclib_stacks_1, "prclib_stacks_1", &
"write an empty process library stack", &
u, results)
<<Prclib stacks: test declarations>>=
public :: prclib_stacks_1
<<Prclib stacks: tests>>=
subroutine prclib_stacks_1 (u)
integer, intent(in) :: u
type(prclib_stack_t) :: stack
write (u, "(A)") "* Test output: prclib_stacks_1"
write (u, "(A)") "* Purpose: display an empty process library stack"
write (u, "(A)")
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_stacks_1"
end subroutine prclib_stacks_1
@ %def prclib_stacks_1
@
\subsubsection{Fill a process library stack}
Fill a process library stack with two (identical) processes.
<<Prclib stacks: execute tests>>=
call test (prclib_stacks_2, "prclib_stacks_2", &
"fill a process library stack", &
u, results)
<<Prclib stacks: test declarations>>=
public :: prclib_stacks_2
<<Prclib stacks: tests>>=
subroutine prclib_stacks_2 (u)
integer, intent(in) :: u
type(prclib_stack_t) :: stack
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: prclib_stacks_2"
write (u, "(A)") "* Purpose: fill a process library stack"
write (u, "(A)")
write (u, "(A)") "* Initialize two (empty) libraries &
&and push them on the stack"
write (u, "(A)")
allocate (lib)
call lib%init (var_str ("lib1"))
call stack%push (lib)
allocate (lib)
call lib%init (var_str ("lib2"))
call stack%push (lib)
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_stacks_2"
end subroutine prclib_stacks_2
@ %def prclib_stacks_2
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Trivial matrix element for tests}
For the purpose of testing the workflow, we implement here two matrix
elements with the simplest possible structure.
This matrix element generator can only generate a single scattering
process and a single decay process. The scattering process is a
quartic interaction of a massless, neutral and colorless scalar [[s]]
with unit coupling results in a trivial $2\to 2$ scattering process.
The matrix element is implemented internally, so we do not need the
machinery of external process libraries. The decay process is a decay
of [[s]] into a pair of colored fermions [[f]].
<<[[prc_test.f90]]>>=
<<File header>>
module prc_test
use, intrinsic :: iso_c_binding !NODEP!
<<Use kinds>>
<<Use strings>>
use os_interface
use process_constants
use prclib_interfaces
use prc_core_def
use particle_specifiers, only: new_prt_spec
use process_libraries
<<Standard module head>>
<<Test ME: public>>
<<Test ME: types>>
contains
<<Test ME: procedures>>
end module prc_test
@ %def prc_test
@
\subsection{Process definition}
For the process definition we implement an extension of the
[[prc_core_def_t]] abstract type.
<<Test ME: public>>=
public :: prc_test_def_t
<<Test ME: types>>=
type, extends (prc_core_def_t) :: prc_test_def_t
type(string_t) :: model_name
type(string_t), dimension(:), allocatable :: prt_in
type(string_t), dimension(:), allocatable :: prt_out
contains
<<Test ME: test me def: TBP>>
end type prc_test_def_t
@ %def prc_test_def_t
<<Test ME: test me def: TBP>>=
procedure, nopass :: type_string => prc_test_def_type_string
<<Test ME: procedures>>=
function prc_test_def_type_string () result (string)
type(string_t) :: string
string = "test_me"
end function prc_test_def_type_string
@ %def prc_test_def_type_string
@ There is no 'feature' here since there is no external code.
<<Test ME: test me def: TBP>>=
procedure, nopass :: get_features => prc_test_def_get_features
<<Test ME: procedures>>=
subroutine prc_test_def_get_features (features)
type(string_t), dimension(:), allocatable, intent(out) :: features
allocate (features (0))
end subroutine prc_test_def_get_features
@ %def prc_test_def_get_features
@ Initialization: set some data (not really useful).
<<Test ME: test me def: TBP>>=
procedure :: init => prc_test_def_init
<<Test ME: procedures>>=
subroutine prc_test_def_init (object, model_name, prt_in, prt_out)
class(prc_test_def_t), intent(out) :: object
type(string_t), intent(in) :: model_name
type(string_t), dimension(:), intent(in) :: prt_in
type(string_t), dimension(:), intent(in) :: prt_out
object%model_name = model_name
allocate (object%prt_in (size (prt_in)))
object%prt_in = prt_in
allocate (object%prt_out (size (prt_out)))
object%prt_out = prt_out
end subroutine prc_test_def_init
@ %def prc_test_def_init
@ Write/read process- and method-specific data. (No-op)
<<Test ME: test me def: TBP>>=
procedure :: write => prc_test_def_write
<<Test ME: procedures>>=
subroutine prc_test_def_write (object, unit)
class(prc_test_def_t), intent(in) :: object
integer, intent(in) :: unit
end subroutine prc_test_def_write
@ %def prc_test_def_write
@
<<Test ME: test me def: TBP>>=
procedure :: read => prc_test_def_read
<<Test ME: procedures>>=
subroutine prc_test_def_read (object, unit)
class(prc_test_def_t), intent(out) :: object
integer, intent(in) :: unit
end subroutine prc_test_def_read
@ %def prc_test_def_read
@ Allocate the driver for test ME matrix elements. We get the
actual component ID (basename), and we can transfer all
process-specific data from the process definition.
<<Test ME: test me def: TBP>>=
procedure :: allocate_driver => prc_test_def_allocate_driver
<<Test ME: procedures>>=
subroutine prc_test_def_allocate_driver (object, driver, basename)
class(prc_test_def_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
allocate (prc_test_t :: driver)
select type (driver)
type is (prc_test_t)
driver%id = basename
driver%model_name = object%model_name
select case (size (object%prt_in))
case (1); driver%scattering = .false.
case (2); driver%scattering = .true.
end select
end select
end subroutine prc_test_def_allocate_driver
@ %def prc_test_def_allocate_driver
@ Nothing to connect. This subroutine will not be called.
<<Test ME: test me def: TBP>>=
procedure :: connect => prc_test_def_connect
<<Test ME: procedures>>=
subroutine prc_test_def_connect (def, lib_driver, i, proc_driver)
class(prc_test_def_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
end subroutine prc_test_def_connect
@ %def prc_test_def_connect
@
\subsection{Driver}
<<Test ME: public>>=
public :: prc_test_t
<<Test ME: types>>=
type, extends (process_driver_internal_t) :: prc_test_t
type(string_t) :: id
type(string_t) :: model_name
logical :: scattering = .true.
contains
<<Test ME: test me driver: TBP>>
end type prc_test_t
@ %def prc_test_t
@ In contrast to generic matrix-element implementations, we can
hard-wire the amplitude method as a type-bound procedure.
<<Test ME: test me driver: TBP>>=
procedure, nopass :: get_amplitude => prc_test_get_amplitude
<<Test ME: procedures>>=
function prc_test_get_amplitude (p) result (amp)
complex(default) :: amp
real(default), dimension(:,:), intent(in) :: p
amp = 1
end function prc_test_get_amplitude
@ %def prc_test_get_amplitude
@ The reported type is the same as for the [[prc_test_def_t]] type.
<<Test ME: test me driver: TBP>>=
procedure, nopass :: type_name => prc_test_type_name
<<Test ME: procedures>>=
function prc_test_type_name () result (string)
type(string_t) :: string
string = "test_me"
end function prc_test_type_name
@ %def prc_test_type_name
@ Fill process constants.
<<Test ME: test me driver: TBP>>=
procedure :: fill_constants => prc_test_fill_constants
<<Test ME: procedures>>=
subroutine prc_test_fill_constants (driver, data)
class(prc_test_t), intent(in) :: driver
type(process_constants_t), intent(out) :: data
data%id = driver%id
data%model_name = driver%model_name
if (driver%scattering) then
data%n_in = 2
data%n_out = 2
data%n_flv = 1
data%n_hel = 1
data%n_col = 1
data%n_cin = 2
data%n_cf = 1
allocate (data%flv_state (4, 1))
data%flv_state = 25
allocate (data%hel_state (4, 1))
data%hel_state = 0
allocate (data%col_state (2, 4, 1))
data%col_state = 0
allocate (data%ghost_flag (4, 1))
data%ghost_flag = .false.
allocate (data%color_factors (1))
data%color_factors = 1
allocate (data%cf_index (2, 1))
data%cf_index = 1
else
data%n_in = 1
data%n_out = 2
data%n_flv = 1
data%n_hel = 2
data%n_col = 1
data%n_cin = 2
data%n_cf = 1
allocate (data%flv_state (3, 1))
data%flv_state(:,1) = [25, 6, -6]
allocate (data%hel_state (3, 2))
data%hel_state(:,1) = [0, 1,-1]
data%hel_state(:,2) = [0,-1, 1]
allocate (data%col_state (2, 3, 1))
data%col_state = reshape ([0,0, 1,0, 0,-1], [2,3,1])
allocate (data%ghost_flag (3, 1))
data%ghost_flag = .false.
allocate (data%color_factors (1))
data%color_factors = 3
allocate (data%cf_index (2, 1))
data%cf_index = 1
end if
end subroutine prc_test_fill_constants
@ %def prc_test_fill_constants
@
\subsection{Shortcut}
Since this module is there for testing purposes, we set up a
subroutine that does all the work at once: create a library with the
two processes (scattering and decay), configure and load, and set up
the driver.
<<Test ME: public>>=
public :: prc_test_create_library
<<Test ME: procedures>>=
subroutine prc_test_create_library &
(libname, lib, scattering, decay, procname1, procname2)
type(string_t), intent(in) :: libname
type(process_library_t), intent(out) :: lib
logical, intent(in), optional :: scattering, decay
type(string_t), intent(in), optional :: procname1, procname2
type(string_t) :: model_name, procname
type(string_t), dimension(:), allocatable :: prt_in, prt_out
class(prc_core_def_t), allocatable :: def
type(process_def_entry_t), pointer :: entry
type(os_data_t) :: os_data
logical :: sca, dec
sca = .true.; if (present (scattering)) sca = scattering
dec = .false.; if (present (decay)) dec = decay
call os_data_init (os_data)
call lib%init (libname)
model_name = "Test"
if (sca) then
if (present (procname1)) then
procname = procname1
else
procname = libname
end if
allocate (prt_in (2), prt_out (2))
prt_in = [var_str ("s"), var_str ("s")]
prt_out = [var_str ("s"), var_str ("s")]
allocate (prc_test_def_t :: def)
select type (def)
type is (prc_test_def_t)
call def%init (model_name, prt_in, prt_out)
end select
allocate (entry)
call entry%init (procname, model_name = model_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 ("test_me"), &
variant = def)
call lib%append (entry)
end if
if (dec) then
if (present (procname2)) then
procname = procname2
else
procname = libname
end if
if (allocated (prt_in)) deallocate (prt_in, prt_out)
allocate (prt_in (1), prt_out (2))
prt_in = [var_str ("s")]
prt_out = [var_str ("f"), var_str ("fbar")]
allocate (prc_test_def_t :: def)
select type (def)
type is (prc_test_def_t)
call def%init (model_name, prt_in, prt_out)
end select
allocate (entry)
call entry%init (procname, model_name = model_name, &
n_in = 1, 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 ("test_decay"), &
variant = def)
call lib%append (entry)
end if
call lib%configure (os_data)
call lib%load (os_data)
end subroutine prc_test_create_library
@ %def prc_test_create_library
@
\subsection{Unit Test}
Test module, followed by the corresponding implementation module.
<<[[prc_test_ut.f90]]>>=
<<File header>>
module prc_test_ut
use unit_tests
use prc_test_uti
<<Standard module head>>
<<Test ME: public test>>
contains
<<Test ME: test driver>>
end module prc_test_ut
@ %def prc_test_ut
@
<<[[prc_test_uti.f90]]>>=
<<File header>>
module prc_test_uti
<<Use kinds>>
<<Use strings>>
use os_interface
use particle_specifiers, only: new_prt_spec
use process_constants
use prc_core_def
use process_libraries
use prc_test
<<Standard module head>>
<<Test ME: test declarations>>
contains
<<Test ME: tests>>
end module prc_test_uti
@ %def prc_test_ut
@ API: driver for the unit tests below.
<<Test ME: public test>>=
public :: prc_test_test
<<Test ME: test driver>>=
subroutine prc_test_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Test ME: execute tests>>
end subroutine prc_test_test
@ %def prc_test_test
@
\subsubsection{Generate and load the scattering process}
The process is $s s \to s s$, where $s$ is a trivial scalar particle,
for vanishing mass and unit coupling. We initialize the process,
build the library, and compute the particular matrix element for
momenta of unit energy and right-angle scattering. (The scattering is
independent of angle.) The matrix element is equal to unity.
<<Test ME: execute tests>>=
call test (prc_test_1, "prc_test_1", &
"build and load trivial process", &
u, results)
<<Test ME: test declarations>>=
public :: prc_test_1
<<Test ME: tests>>=
subroutine prc_test_1 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(process_library_t) :: lib
class(prc_core_def_t), allocatable :: def
type(process_def_entry_t), pointer :: entry
type(string_t) :: model_name
type(string_t), dimension(:), allocatable :: prt_in, prt_out
type(process_constants_t) :: data
class(prc_core_driver_t), allocatable :: driver
real(default), dimension(0:3,4) :: p
integer :: i
write (u, "(A)") "* Test output: prc_test_1"
write (u, "(A)") "* Purpose: create a trivial process"
write (u, "(A)") "* build a library and &
&access the matrix element"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call os_data_init (os_data)
call lib%init (var_str ("prc_test1"))
model_name = "Test"
allocate (prt_in (2), prt_out (2))
prt_in = [var_str ("s"), var_str ("s")]
prt_out = [var_str ("s"), var_str ("s")]
allocate (prc_test_def_t :: def)
select type (def)
type is (prc_test_def_t)
call def%init (model_name, prt_in, prt_out)
end select
allocate (entry)
call entry%init (var_str ("prc_test1_a"), model_name = model_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 ("test_me"), &
variant = def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Load library"
write (u, "(A)")
call lib%load (os_data)
call lib%write (u)
write (u, "(A)")
write (u, "(A)") "* Probe library API:"
write (u, "(A)")
write (u, "(1x,A,L1)") "is active = ", &
lib%is_active ()
write (u, "(1x,A,I0)") "n_processes = ", &
lib%get_n_processes ()
write (u, "(A)")
write (u, "(A)") "* Constants of prc_test1_a_i1:"
write (u, "(A)")
call lib%connect_process (var_str ("prc_test1_a"), 1, data, driver)
write (u, "(1x,A,A)") "component ID = ", char (data%id)
write (u, "(1x,A,A)") "model name = ", char (data%model_name)
write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
write (u, "(1x,A,I0)") "n_in = ", data%n_in
write (u, "(1x,A,I0)") "n_out = ", data%n_out
write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
write (u, "(1x,A,I0)") "n_col = ", data%n_col
write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index
write (u, "(A)")
write (u, "(A)") "* Set kinematics:"
write (u, "(A)")
p = reshape ([ &
1.0_default, 0.0_default, 0.0_default, 1.0_default, &
1.0_default, 0.0_default, 0.0_default,-1.0_default, &
1.0_default, 1.0_default, 0.0_default, 0.0_default, &
1.0_default,-1.0_default, 0.0_default, 0.0_default &
], [4,4])
do i = 1, 4
write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
end do
write (u, "(A)")
write (u, "(A)") "* Compute matrix element:"
write (u, "(A)")
select type (driver)
type is (prc_test_t)
write (u, "(1x,A,1x,E11.4)") "|amp| =", abs (driver%get_amplitude (p))
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prc_test_1"
end subroutine prc_test_1
@ %def prc_test_1
@
\subsubsection{Shortcut}
This is identical to the previous test, but we create the library be a single
command. This is handy for other modules which use the test process.
<<Test ME: execute tests>>=
call test (prc_test_2, "prc_test_2", &
"build and load trivial process using shortcut", &
u, results)
<<Test ME: test declarations>>=
public :: prc_test_2
<<Test ME: tests>>=
subroutine prc_test_2 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
class(prc_core_driver_t), allocatable :: driver
type(process_constants_t) :: data
real(default), dimension(0:3,4) :: p
write (u, "(A)") "* Test output: prc_test_2"
write (u, "(A)") "* Purpose: create a trivial process"
write (u, "(A)") "* build a library and &
&access the matrix element"
write (u, "(A)")
write (u, "(A)") "* Build and load a process library with one entry"
call prc_test_create_library (var_str ("prc_test2"), lib)
call lib%connect_process (var_str ("prc_test2"), 1, data, driver)
p = reshape ([ &
1.0_default, 0.0_default, 0.0_default, 1.0_default, &
1.0_default, 0.0_default, 0.0_default,-1.0_default, &
1.0_default, 1.0_default, 0.0_default, 0.0_default, &
1.0_default,-1.0_default, 0.0_default, 0.0_default &
], [4,4])
write (u, "(A)")
write (u, "(A)") "* Compute matrix element:"
write (u, "(A)")
select type (driver)
type is (prc_test_t)
write (u, "(1x,A,1x,E11.4)") "|amp| =", abs (driver%get_amplitude (p))
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prc_test_2"
end subroutine prc_test_2
@ %def prc_test_2
@
\subsubsection{Generate and load the decay process}
The process is $s \to f\bar f$, where $s$ is a trivial scalar particle
and $f$ is a colored fermion. We initialize the process,
build the library, and compute the particular matrix element for a
fixed momentum configuration. (The decay is
independent of angle.) The matrix element is equal to unity.
<<Test ME: execute tests>>=
call test (prc_test_3, "prc_test_3", &
"build and load trivial decay", &
u, results)
<<Test ME: test declarations>>=
public :: prc_test_3
<<Test ME: tests>>=
subroutine prc_test_3 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(process_library_t) :: lib
class(prc_core_def_t), allocatable :: def
type(process_def_entry_t), pointer :: entry
type(string_t) :: model_name
type(string_t), dimension(:), allocatable :: prt_in, prt_out
type(process_constants_t) :: data
class(prc_core_driver_t), allocatable :: driver
real(default), dimension(0:3,3) :: p
integer :: i
write (u, "(A)") "* Test output: prc_test_3"
write (u, "(A)") "* Purpose: create a trivial decay process"
write (u, "(A)") "* build a library and &
&access the matrix element"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call os_data_init (os_data)
call lib%init (var_str ("prc_test3"))
model_name = "Test"
allocate (prt_in (1), prt_out (2))
prt_in = [var_str ("s")]
prt_out = [var_str ("f"), var_str ("F")]
allocate (prc_test_def_t :: def)
select type (def)
type is (prc_test_def_t)
call def%init (model_name, prt_in, prt_out)
end select
allocate (entry)
call entry%init (var_str ("prc_test3_a"), model_name = model_name, &
n_in = 1, 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 ("test_me"), &
variant = def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Load library"
write (u, "(A)")
call lib%load (os_data)
call lib%write (u)
write (u, "(A)")
write (u, "(A)") "* Probe library API:"
write (u, "(A)")
write (u, "(1x,A,L1)") "is active = ", &
lib%is_active ()
write (u, "(1x,A,I0)") "n_processes = ", &
lib%get_n_processes ()
write (u, "(A)")
write (u, "(A)") "* Constants of prc_test3_a_i1:"
write (u, "(A)")
call lib%connect_process (var_str ("prc_test3_a"), 1, data, driver)
write (u, "(1x,A,A)") "component ID = ", char (data%id)
write (u, "(1x,A,A)") "model name = ", char (data%model_name)
write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
write (u, "(1x,A,I0)") "n_in = ", data%n_in
write (u, "(1x,A,I0)") "n_out = ", data%n_out
write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
write (u, "(1x,A,I0)") "n_col = ", data%n_col
write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,2)
write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index
write (u, "(A)")
write (u, "(A)") "* Set kinematics:"
write (u, "(A)")
p = reshape ([ &
125._default, 0.0_default, 0.0_default, 0.0_default, &
62.5_default, 0.0_default, 0.0_default, 62.5_default, &
62.5_default, 0.0_default, 0.0_default,-62.5_default &
], [4,3])
do i = 1, 3
write (u, "(2x,A,I0,A,4(1x,F8.4))") "p", i, " =", p(:,i)
end do
write (u, "(A)")
write (u, "(A)") "* Compute matrix element:"
write (u, "(A)")
select type (driver)
type is (prc_test_t)
write (u, "(1x,A,1x,E11.4)") "|amp| =", abs (driver%get_amplitude (p))
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prc_test_3"
end subroutine prc_test_3
@ %def prc_test_3
@
\subsubsection{Shortcut}
This is identical to the previous test, but we create the library be a single
command. This is handy for other modules which use the test process.
<<Test ME: execute tests>>=
call test (prc_test_4, "prc_test_4", &
"build and load trivial decay using shortcut", &
u, results)
<<Test ME: test declarations>>=
public :: prc_test_4
<<Test ME: tests>>=
subroutine prc_test_4 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
class(prc_core_driver_t), allocatable :: driver
type(process_constants_t) :: data
real(default), dimension(0:3,3) :: p
write (u, "(A)") "* Test output: prc_test_4"
write (u, "(A)") "* Purpose: create a trivial decay process"
write (u, "(A)") "* build a library and &
&access the matrix element"
write (u, "(A)")
write (u, "(A)") "* Build and load a process library with one entry"
call prc_test_create_library (var_str ("prc_test4"), lib, &
scattering=.false., decay=.true.)
call lib%connect_process (var_str ("prc_test4"), 1, data, driver)
p = reshape ([ &
125._default, 0.0_default, 0.0_default, 0.0_default, &
62.5_default, 0.0_default, 0.0_default, 62.5_default, &
62.5_default, 0.0_default, 0.0_default,-62.5_default &
], [4,3])
write (u, "(A)")
write (u, "(A)") "* Compute matrix element:"
write (u, "(A)")
select type (driver)
type is (prc_test_t)
write (u, "(1x,A,1x,E11.4)") "|amp| =", abs (driver%get_amplitude (p))
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prc_test_4"
end subroutine prc_test_4
@ %def prc_test_4
Index: trunk/src/variables/variables.nw
===================================================================
--- trunk/src/variables/variables.nw (revision 8157)
+++ trunk/src/variables/variables.nw (revision 8158)
@@ -1,6700 +1,6703 @@
% -*- 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 io_units
use format_utils, only: pac_fmt
use format_defs, only: FMT_12, FMT_19
use constants, only: eps0
use os_interface, only: paths_t
use physics_defs, only: LAMBDA_QCD_REF
use system_dependencies
use fastjet !NODEP!
use diagnostics
use pdg_arrays
use subevents
use var_base
<<Standard module head>>
<<Variables: public>>
<<Variables: parameters>>
<<Variables: types>>
<<Variables: interfaces>>
contains
<<Variables: procedures>>
end module variables
@ %def variables
@
\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_UOBS1_INT = 31, V_UOBS2_INT = 32
integer, parameter, public :: V_UOBS1_REAL = 41, V_UOBS2_REAL = 42
@ %def V_NONE V_LOG V_INT V_REAL V_CMPLX V_PRT V_SEV V_PDG
@ %def V_OBS1_INT V_OBS2_INT V_OBS1_REAL V_OBS2_REAL
@ %def V_UOBS1_INT V_UOBS2_INT V_UOBS1_REAL V_UOBS2_REAL
@
\subsubsection{The type}
This is an entry in the variable list. It can be of any type; in
each case only one value is allocated. It may be physically
allocated upon creation, in which case [[is_allocated]] is true, or
it may contain just a pointer to a value somewhere else, in which case
[[is_allocated]] is false.
The flag [[is_defined]] is set when the variable is given a value, even the
undefined value. (Therefore it is distinct from [[is_known]].) This matters
for variable declaration in the SINDARIN language. The variable is set up in
the compilation step and initially marked as defined, but after compilation
all variables are set undefined. Each variable becomes defined when it is
explicitly set. The difference matters in loops.
[[is_locked]] means that it cannot be given a value using the interface
routines [[var_list_set_XXX]] below. It can only be initialized, or change
automatically due to a side effect.
[[is_copy]] means that this is a local copy of a global variable. The copy
has a pointer to the original, which can be used to restore a previous value.
[[is_intrinsic]] means that this variable is defined by the program, not by
the user. Intrinsic variables cannot be (re)declared, but their values can be
reset unless they are locked. [[is_user_var]] means that the variable has
been declared by the user. It could be a new variable, or a local copy of an
intrinsic variable.
The flag [[is_known]] is a pointer which parallels the use of the
value pointer. For pointer variables, it is set if the value should point to
a known value. For ordinary variables, it should be true.
The value is implemented as a set of alternative type-specific pointers. This
emulates polymorphism, and it allows for actual pointer variables.
Observable-type variables have function pointers as values, so they behave
like macros. The functions make use of the particle objects accessible via
the pointers [[prt1]] and [[prt2]].
Finally, the [[next]] pointer indicates that we are making lists of
variables. A more efficient implementation might switch to hashes or
similar; the current implementation has $O(N)$ lookup.
<<Variables: public>>=
public :: var_entry_t
<<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 ()
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
<<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
@ %def obs_unary_int obs_unary_real obs_binary_real
@
\subsubsection{Initialization}
Initialize an entry, optionally with a physical value. We also
allocate the [[is_known]] flag and set it if the value is set.
<<Variables: public>>=
public :: var_entry_init_int
<<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
@ %def var_entry_init_obs
@ 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 subevt_write (var%pval, u, prefix=" ", &
pacified = pacified)
else
write (u, "(A)", advance=advance) "[unknown subevent]"
end if
case (V_PDG)
if (var%is_known) then
call pdg_array_write (var%aval, u); write (u, *)
else
write (u, "(A)", advance=advance) "[unknown PDG array]"
end if
case (V_STR)
if (var%is_known) then
if (et) then
write (u, "(A)", advance=advance) '"' // char (replace ( &
replace (var%sval, "_", "\_", every=.true.), "$", "\$" )) // '"'
else
write (u, "(A)", advance=advance) '"' // char (var%sval) // '"'
end if
else
write (u, "(A)", advance=advance) "[unknown string]"
end if
case (V_OBS1_INT); write (u, "(A)", advance=advance) "[int] = unary observable"
case (V_OBS2_INT); write (u, "(A)", advance=advance) "[int] = binary observable"
case (V_OBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary observable"
case (V_OBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary observable"
case (V_UOBS1_INT); write (u, "(A)", advance=advance) "[int] = unary user observable"
case (V_UOBS2_INT); write (u, "(A)", advance=advance) "[int] = binary user observable"
case (V_UOBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary user observable"
case (V_UOBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary user observable"
end select
end subroutine var_write_val
@ %def procedure
@
\subsubsection{Accessing contents}
<<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
(there was a nagfor bug).
<<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
@ %def var_entry_assign_obs1_int_ptr var_entry_assign_obs1_real_ptr
@ %def var_entry_assign_obs2_int_ptr var_entry_assign_obs2_real_ptr
@
\subsection{Setting values}
Undefine the value.
<<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: public>>=
public :: var_entry_set_description
<<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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: public>>=
public :: var_list_append_log
public :: var_list_append_int
public :: var_list_append_real
public :: var_list_append_cmplx
public :: var_list_append_subevt
public :: var_list_append_pdg_array
public :: var_list_append_string
<<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: procedures>>=
subroutine var_list_append_log_s &
(var_list, name, lval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
logical, intent(in), optional :: lval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_log (var, name, lval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_log_s
subroutine var_list_append_int_s &
(var_list, name, ival, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
integer, intent(in), optional :: ival
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_int (var, name, ival, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_int_s
subroutine var_list_append_real_s &
(var_list, name, rval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
real(default), intent(in), optional :: rval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_real (var, name, rval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_real_s
subroutine var_list_append_cmplx_s &
(var_list, name, cval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in), optional :: cval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_cmplx (var, name, cval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_cmplx_s
subroutine var_list_append_subevt_s &
(var_list, name, pval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in), optional :: pval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_subevt (var, name, pval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_subevt_s
subroutine var_list_append_pdg_array_s &
(var_list, name, aval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), optional :: aval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_pdg_array (var, name, aval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_pdg_array_s
subroutine var_list_append_string_s &
(var_list, name, sval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: sval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_string (var, name, sval, intrinsic, user)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_string_s
subroutine var_list_append_log_c &
(var_list, name, lval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
logical, intent(in), optional :: lval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_log_s &
(var_list, var_str (name), lval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_log_c
subroutine var_list_append_int_c &
(var_list, name, ival, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
integer, intent(in), optional :: ival
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_int_s &
(var_list, var_str (name), ival, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_int_c
subroutine var_list_append_real_c &
(var_list, name, rval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
real(default), intent(in), optional :: rval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_real_s &
(var_list, var_str (name), rval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_real_c
subroutine var_list_append_cmplx_c &
(var_list, name, cval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
complex(default), intent(in), optional :: cval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_cmplx_s &
(var_list, var_str (name), cval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_cmplx_c
subroutine var_list_append_subevt_c &
(var_list, name, pval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
type(subevt_t), intent(in), optional :: pval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_subevt_s &
(var_list, var_str (name), pval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_subevt_c
subroutine var_list_append_pdg_array_c &
(var_list, name, aval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
type(pdg_array_t), intent(in), optional :: aval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
call var_list_append_pdg_array_s &
(var_list, var_str (name), aval, locked, verbose, &
intrinsic, user, description)
end subroutine var_list_append_pdg_array_c
subroutine var_list_append_string_c &
(var_list, name, sval, locked, verbose, intrinsic, user, description)
class(var_list_t), intent(inout) :: var_list
character(*), intent(in) :: name
character(*), intent(in), optional :: sval
logical, intent(in), optional :: locked, verbose, intrinsic, user
type(string_t), intent(in), optional :: description
if (present (sval)) then
call var_list_append_string_s &
(var_list, var_str (name), var_str (sval), &
locked, verbose, intrinsic, user, description)
else
call var_list_append_string_s &
(var_list, var_str (name), &
locked=locked, verbose=verbose, intrinsic=intrinsic, &
user=user, description=description)
end if
end subroutine var_list_append_string_c
@ %def var_list_append_log
@ %def var_list_append_int
@ %def var_list_append_real
@ %def var_list_append_cmplx
@ %def var_list_append_subevt
@ %def var_list_append_pdg_array
@ %def var_list_append_string
<<Variables: public>>=
public :: var_list_append_log_ptr
public :: var_list_append_int_ptr
public :: var_list_append_real_ptr
public :: var_list_append_cmplx_ptr
public :: var_list_append_pdg_array_ptr
public :: var_list_append_subevt_ptr
public :: var_list_append_string_ptr
<<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: procedures>>=
subroutine var_list_append_log_ptr &
(var_list, name, lval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
logical, intent(in), target :: lval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_log_ptr (var, name, lval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_log_ptr
subroutine var_list_append_int_ptr &
(var_list, name, ival, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
integer, intent(in), target :: ival
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_int_ptr (var, name, ival, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_int_ptr
subroutine var_list_append_real_ptr &
(var_list, name, rval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
real(default), intent(in), target :: rval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_real_ptr (var, name, rval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_real_ptr
subroutine var_list_append_cmplx_ptr &
(var_list, name, cval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in), target :: cval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_cmplx_ptr
subroutine var_list_append_pdg_array_ptr &
(var_list, name, aval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), target :: aval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_pdg_array_ptr
subroutine var_list_append_subevt_ptr &
(var_list, name, pval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in), target :: pval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_subevt_ptr
subroutine var_list_append_string_ptr &
(var_list, name, sval, is_known, locked, verbose, intrinsic, description)
class(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in), target :: sval
logical, intent(in), target :: is_known
logical, intent(in), optional :: locked, verbose, intrinsic
type(string_t), intent(in), optional :: description
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_string_ptr (var, name, sval, is_known, intrinsic)
if (present (description)) call var_entry_set_description (var, description)
if (present (locked)) call var_entry_lock (var, locked)
call var_list_append (var_list, var, verbose)
end subroutine var_list_append_string_ptr
@ %def var_list_append_log_ptr
@ %def var_list_append_int_ptr
@ %def var_list_append_real_ptr
@ %def var_list_append_cmplx_ptr
@ %def var_list_append_pdg_array_ptr
@ %def var_list_append_subevt_ptr
@
\subsubsection{Finalizer}
Finalize, delete the list entry by entry. The link itself is kept
intact. Follow link and delete recursively only if requested
explicitly.
<<Variables: var list: TBP>>=
procedure :: final => var_list_final
<<Variables: procedures>>=
recursive subroutine var_list_final (vars, follow_link)
class(var_list_t), intent(inout) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
vars%last => null ()
do while (associated (vars%first))
var => vars%first
vars%first => var%next
call var_entry_final (var)
deallocate (var)
end do
if (present (follow_link)) then
if (follow_link) then
if (associated (vars%next)) then
call vars%next%final (follow_link)
deallocate (vars%next)
end if
end if
end if
end subroutine var_list_final
@ %def var_list_final
@
\subsubsection{Output}
Show variable list with precise control over options. E.g.,
show only variables of a certain type.
Many options, thus not an ordinary [[write]] method.
<<Variables: public>>=
public :: var_list_write
<<Variables: var list: TBP>>=
procedure :: write => var_list_write
<<Variables: procedures>>=
recursive subroutine var_list_write &
(var_list, unit, follow_link, only_type, prefix, model_name, &
intrinsic, pacified, descriptions, ascii_output)
class(var_list_t), intent(in), target :: var_list
integer, intent(in), optional :: unit
logical, intent(in), optional :: follow_link
integer, intent(in), optional :: only_type
character(*), intent(in), optional :: prefix
type(string_t), intent(in), optional :: model_name
logical, intent(in), optional :: intrinsic
logical, intent(in), optional :: pacified
logical, intent(in), optional :: descriptions
logical, intent(in), optional :: ascii_output
type(var_entry_t), pointer :: var
integer :: u, length
logical :: write_this, write_next
u = given_output_unit (unit); if (u < 0) return
if (present (prefix)) length = len (prefix)
var => var_list%first
if (associated (var)) then
do while (associated (var))
if (present (only_type)) then
write_this = only_type == var%type
else
write_this = .true.
end if
if (write_this .and. present (prefix)) then
if (prefix /= extract (var%name, 1, length)) &
write_this = .false.
end if
if (write_this) then
call var_entry_write &
(var, unit, model_name=model_name, &
intrinsic=intrinsic, pacified=pacified, &
descriptions=descriptions, ascii_output=ascii_output)
end if
var => var%next
end do
end if
if (present (follow_link)) then
write_next = follow_link .and. associated (var_list%next)
else
write_next = associated (var_list%next)
end if
if (write_next) then
call var_list_write (var_list%next, &
unit, follow_link, only_type, prefix, model_name, &
intrinsic, pacified)
end if
end subroutine var_list_write
@ %def var_list_write
@ Write only a certain variable.
<<Variables: public>>=
public :: var_list_write_var
<<Variables: var list: TBP>>=
procedure :: write_var => var_list_write_var
<<Variables: procedures>>=
recursive subroutine var_list_write_var &
(var_list, name, unit, type, follow_link, &
model_name, pacified, defined, descriptions, ascii_output)
class(var_list_t), intent(in), target :: var_list
type(string_t), intent(in) :: name
integer, intent(in), optional :: unit
integer, intent(in), optional :: type
logical, intent(in), optional :: follow_link
type(string_t), intent(in), optional :: model_name
logical, intent(in), optional :: pacified
logical, intent(in), optional :: defined
logical, intent(in), optional :: descriptions
logical, intent(in), optional :: ascii_output
type(var_entry_t), pointer :: var
integer :: u
u = given_output_unit (unit); if (u < 0) return
var => var_list_get_var_ptr &
(var_list, name, type, follow_link=follow_link, defined=defined)
if (associated (var)) then
call var_entry_write &
(var, unit, model_name = model_name, &
pacified = pacified, &
descriptions=descriptions, ascii_output=ascii_output)
else
write (u, "(A)") char (name) // " = [undefined]"
end if
end subroutine var_list_write_var
@ %def var_list_write_var
@
\subsection{Tools}
Return a pointer to the variable list linked to by the current one.
<<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: public>>=
public :: var_list_get_var_ptr
<<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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
function var_list_get_lval (vars, name, follow_link) result (lval)
logical :: lval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_LOG, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
lval = var%lval
else
lval = .false.
end if
else
lval = .false.
end if
end function var_list_get_lval
function var_list_get_ival (vars, name, follow_link) result (ival)
integer :: ival
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_INT, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
ival = var%ival
else
ival = 0
end if
else
ival = 0
end if
end function var_list_get_ival
function var_list_get_rval (vars, name, follow_link) result (rval)
real(default) :: rval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_REAL, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
rval = var%rval
else
rval = 0
end if
else
rval = 0
end if
end function var_list_get_rval
function var_list_get_cval (vars, name, follow_link) result (cval)
complex(default) :: cval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_CMPLX, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
cval = var%cval
else
cval = 0
end if
else
cval = 0
end if
end function var_list_get_cval
function var_list_get_aval (vars, name, follow_link) result (aval)
type(pdg_array_t) :: aval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_PDG, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
aval = var%aval
end if
end if
end function var_list_get_aval
function var_list_get_pval (vars, name, follow_link) result (pval)
type(subevt_t) :: pval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_SEV, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
pval = var%pval
end if
end if
end function var_list_get_pval
function var_list_get_sval (vars, name, follow_link) result (sval)
type(string_t) :: sval
type(string_t), intent(in) :: name
class(var_list_t), intent(in) :: vars
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr &
(vars, name, V_STR, follow_link, defined=.true.)
if (associated (var)) then
if (var_has_value (var)) then
sval = var%sval
else
sval = ""
end if
else
sval = ""
end if
end function var_list_get_sval
@ %def var_list_get_lval
@ %def var_list_get_ival
@ %def var_list_get_rval
@ %def var_list_get_cval
@ %def var_list_get_pval
@ %def var_list_get_aval
@ %def var_list_get_sval
@ Check for a valid value, given a pointer. Issue error messages if invalid.
<<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: procedures>>=
subroutine var_list_get_lptr (var_list, name, lptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
logical, pointer, intent(out) :: lptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_LOG)
if (associated (var)) then
lptr => var_entry_get_lval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
lptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_lptr
subroutine var_list_get_iptr (var_list, name, iptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
integer, pointer, intent(out) :: iptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_INT)
if (associated (var)) then
iptr => var_entry_get_ival_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
iptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_iptr
subroutine var_list_get_rptr (var_list, name, rptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
real(default), pointer, intent(out) :: rptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_REAL)
if (associated (var)) then
rptr => var_entry_get_rval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
rptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_rptr
subroutine var_list_get_cptr (var_list, name, cptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
complex(default), pointer, intent(out) :: cptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_CMPLX)
if (associated (var)) then
cptr => var_entry_get_cval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
cptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_cptr
subroutine var_list_get_aptr (var_list, name, aptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), pointer, intent(out) :: aptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_PDG)
if (associated (var)) then
aptr => var_entry_get_aval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
aptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_aptr
subroutine var_list_get_pptr (var_list, name, pptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(subevt_t), pointer, intent(out) :: pptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_SEV)
if (associated (var)) then
pptr => var_entry_get_pval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
pptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_pptr
subroutine var_list_get_sptr (var_list, name, sptr, known)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
type(string_t), pointer, intent(out) :: sptr
logical, pointer, intent(out), optional :: known
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_STR)
if (associated (var)) then
sptr => var_entry_get_sval_ptr (var)
if (present (known)) known => var_entry_get_known_ptr (var)
else
sptr => null ()
if (present (known)) known => null ()
end if
end subroutine var_list_get_sptr
@ %def var_list_get_lptr
@ %def var_list_get_iptr
@ %def var_list_get_rptr
@ %def var_list_get_cptr
@ %def var_list_get_aptr
@ %def var_list_get_pptr
@ %def var_list_get_sptr
@
This bunch of methods handles the procedure-pointer cases.
<<Variables: var list: TBP>>=
procedure :: get_obs1_iptr => var_list_get_obs1_iptr
procedure :: get_obs2_iptr => var_list_get_obs2_iptr
procedure :: get_obs1_rptr => var_list_get_obs1_rptr
procedure :: get_obs2_rptr => var_list_get_obs2_rptr
<<Variables: procedures>>=
subroutine var_list_get_obs1_iptr (var_list, name, obs1_iptr, p1)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_int), pointer, intent(out) :: obs1_iptr
type(prt_t), pointer, intent(out) :: p1
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBS1_INT)
if (associated (var)) then
call var_entry_assign_obs1_int_ptr (obs1_iptr, var)
p1 => var_entry_get_prt1_ptr (var)
else
obs1_iptr => null ()
p1 => null ()
end if
end subroutine var_list_get_obs1_iptr
subroutine var_list_get_obs2_iptr (var_list, name, obs2_iptr, p1, p2)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_int), pointer, intent(out) :: obs2_iptr
type(prt_t), pointer, intent(out) :: p1, p2
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBS2_INT)
if (associated (var)) then
call var_entry_assign_obs2_int_ptr (obs2_iptr, var)
p1 => var_entry_get_prt1_ptr (var)
p2 => var_entry_get_prt2_ptr (var)
else
obs2_iptr => null ()
p1 => null ()
p2 => null ()
end if
end subroutine var_list_get_obs2_iptr
subroutine var_list_get_obs1_rptr (var_list, name, obs1_rptr, p1)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_real), pointer, intent(out) :: obs1_rptr
type(prt_t), pointer, intent(out) :: p1
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBS1_REAL)
if (associated (var)) then
call var_entry_assign_obs1_real_ptr (obs1_rptr, var)
p1 => var_entry_get_prt1_ptr (var)
else
obs1_rptr => null ()
p1 => null ()
end if
end subroutine var_list_get_obs1_rptr
subroutine var_list_get_obs2_rptr (var_list, name, obs2_rptr, p1, p2)
class(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_real), pointer, intent(out) :: obs2_rptr
type(prt_t), pointer, intent(out) :: p1, p2
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_OBS2_REAL)
if (associated (var)) then
call var_entry_assign_obs2_real_ptr (obs2_rptr, var)
p1 => var_entry_get_prt1_ptr (var)
p2 => var_entry_get_prt2_ptr (var)
else
obs2_rptr => null ()
p1 => null ()
p2 => null ()
end if
end subroutine var_list_get_obs2_rptr
@ %def var_list_get_obs1_iptr
@ %def var_list_get_obs2_iptr
@ %def var_list_get_obs1_rptr
@ %def var_list_get_obs2_rptr
@
\subsection{Process Result Variables}
These variables are associated to process (integration) runs and their
results. Their names contain brackets (so they look like function
evaluations), therefore we need to special-case them.
<<Variables: public>>=
public :: var_list_set_procvar_int
public :: var_list_set_procvar_real
<<Variables: procedures>>=
subroutine var_list_set_procvar_int (var_list, proc_id, name, ival)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
type(string_t), intent(in) :: name
integer, intent(in), optional :: ival
type(string_t) :: var_name
type(var_entry_t), pointer :: var
var_name = name // "(" // proc_id // ")"
var => var_list_get_var_ptr (var_list, var_name)
if (.not. associated (var)) then
call var_list%append_int (var_name, ival, intrinsic=.true.)
else if (present (ival)) then
call var_list%set_int (var_name, ival, is_known=.true.)
end if
end subroutine var_list_set_procvar_int
subroutine var_list_set_procvar_real (var_list, proc_id, name, rval)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
type(string_t), intent(in) :: name
real(default), intent(in), optional :: rval
type(string_t) :: var_name
type(var_entry_t), pointer :: var
var_name = name // "(" // proc_id // ")"
var => var_list_get_var_ptr (var_list, var_name)
if (.not. associated (var)) then
call var_list%append_real (var_name, rval, intrinsic=.true.)
else if (present (rval)) then
call var_list%set_real (var_name, rval, is_known=.true.)
end if
end subroutine var_list_set_procvar_real
@ %def var_list_set_procvar_int
@ %def var_list_set_procvar_real
@
\subsection{Observable initialization}
Observables are formally treated as variables, which however are
evaluated each time the observable is used. The arguments (pointers)
to evaluate and the function are part of the variable-list entry.
<<Variables: public>>=
public :: var_list_append_obs1_iptr
public :: var_list_append_obs2_iptr
public :: var_list_append_obs1_rptr
public :: var_list_append_obs2_rptr
<<Variables: procedures>>=
subroutine var_list_append_obs1_iptr (var_list, name, obs1_iptr, p1)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_int) :: obs1_iptr
type(prt_t), intent(in), target :: p1
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs (var, name, V_OBS1_INT, p1)
var%obs1_int => obs1_iptr
call var_list_append (var_list, var)
end subroutine var_list_append_obs1_iptr
subroutine var_list_append_obs2_iptr (var_list, name, obs2_iptr, p1, p2)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_int) :: obs2_iptr
type(prt_t), intent(in), target :: p1, p2
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs (var, name, V_OBS2_INT, p1, p2)
var%obs2_int => obs2_iptr
call var_list_append (var_list, var)
end subroutine var_list_append_obs2_iptr
subroutine var_list_append_obs1_rptr (var_list, name, obs1_rptr, p1)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_unary_real) :: obs1_rptr
type(prt_t), intent(in), target :: p1
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs (var, name, V_OBS1_REAL, p1)
var%obs1_real => obs1_rptr
call var_list_append (var_list, var)
end subroutine var_list_append_obs1_rptr
subroutine var_list_append_obs2_rptr (var_list, name, obs2_rptr, p1, p2)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
procedure(obs_binary_real) :: obs2_rptr
type(prt_t), intent(in), target :: p1, p2
type(var_entry_t), pointer :: var
allocate (var)
call var_entry_init_obs (var, name, V_OBS2_REAL, p1, p2)
var%obs2_real => obs2_rptr
call var_list_append (var_list, var)
end subroutine var_list_append_obs2_rptr
@ %def var_list_append_obs1_iptr
@ %def var_list_append_obs2_iptr
@ %def var_list_append_obs1_rptr
@ %def var_list_append_obs2_rptr
@ User observables: no pointer needs to be stored.
<<Variables: public>>=
public :: var_list_append_uobs_int
public :: var_list_append_uobs_real
<<Variables: procedures>>=
subroutine var_list_append_uobs_int (var_list, name, p1, p2)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(prt_t), intent(in), target :: p1
type(prt_t), intent(in), target, optional :: p2
type(var_entry_t), pointer :: var
allocate (var)
if (present (p2)) then
call var_entry_init_obs (var, name, V_UOBS2_INT, p1, p2)
else
call var_entry_init_obs (var, name, V_UOBS1_INT, p1)
end if
call var_list_append (var_list, var)
end subroutine var_list_append_uobs_int
subroutine var_list_append_uobs_real (var_list, name, p1, p2)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: name
type(prt_t), intent(in), target :: p1
type(prt_t), intent(in), target, optional :: p2
type(var_entry_t), pointer :: var
allocate (var)
if (present (p2)) then
call var_entry_init_obs (var, name, V_UOBS2_REAL, p1, p2)
else
call var_entry_init_obs (var, name, V_UOBS1_REAL, p1)
end if
call var_list_append (var_list, var)
end subroutine var_list_append_uobs_real
@ %def var_list_append_uobs_int
@ %def var_list_append_uobs_real
@
\subsection{API for variable lists}
Set a new value. If the variable holds a pointer, this pointer is
followed, e.g., a model parameter is actually set. If [[ignore]] is
set, do nothing if the variable does not exist. If [[verbose]] is
set, echo the new value.
Clear a variable (all variables), i.e., undefine the value.
<<Variables: var list: TBP>>=
procedure :: unset => var_list_clear
<<Variables: procedures>>=
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: procedures>>=
subroutine var_list_set_ival (vars, name, ival, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
integer, intent(in) :: ival
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_int (var, ival, is_known=.true.)
end if
end subroutine var_list_set_ival
subroutine var_list_set_rval (vars, name, rval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
real(default), intent(in) :: rval
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_real (var, rval, is_known=.true.)
end if
end subroutine var_list_set_rval
subroutine var_list_set_cval (vars, name, cval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
complex(default), intent(in) :: cval
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_cmplx (var, cval, is_known=.true.)
end if
end subroutine var_list_set_cval
subroutine var_list_set_lval (vars, name, lval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
logical, intent(in) :: lval
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_log (var, lval, is_known=.true.)
end if
end subroutine var_list_set_lval
subroutine var_list_set_sval (vars, name, sval, follow_link)
class(var_list_t), intent(inout) :: vars
type(string_t), intent(in) :: name
type(string_t), intent(in) :: sval
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
if (associated (var)) then
call var_entry_set_string (var, sval, is_known=.true.)
end if
end subroutine var_list_set_sval
@ %def var_list_set_ival
@ %def var_list_set_rval
@ %def var_list_set_cval
@ %def var_list_set_lval
@ %def var_list_set_sval
@
Setting the value, verbose specific versions (as subroutines):
<<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: procedures>>=
subroutine var_list_set_log &
(var_list, name, lval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
logical, intent(in) :: lval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_LOG)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_LOG)
call var_entry_set_log (var, lval, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_log
subroutine var_list_set_int &
(var_list, name, ival, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
integer, intent(in) :: ival
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_INT)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_INT)
call var_entry_set_int (var, ival, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_int
subroutine var_list_set_real &
(var_list, name, rval, is_known, ignore, force, &
verbose, model_name, pacified)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
real(default), intent(in) :: rval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose, pacified
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_REAL)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_REAL)
call var_entry_set_real &
(var, rval, is_known, verbose, model_name, pacified)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_real
subroutine var_list_set_cmplx &
(var_list, name, cval, is_known, ignore, force, &
verbose, model_name, pacified)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
complex(default), intent(in) :: cval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose, pacified
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_CMPLX)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_CMPLX)
call var_entry_set_cmplx &
(var, cval, is_known, verbose, model_name, pacified)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_cmplx
subroutine var_list_set_pdg_array &
(var_list, name, aval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in) :: aval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_PDG)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_PDG)
call var_entry_set_pdg_array &
(var, aval, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_pdg_array
subroutine var_list_set_subevt &
(var_list, name, pval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(subevt_t), intent(in) :: pval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_SEV)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_SEV)
call var_entry_set_subevt &
(var, pval, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_subevt
subroutine var_list_set_string &
(var_list, name, sval, is_known, ignore, force, verbose, model_name)
class(var_list_t), intent(inout), target :: var_list
type(string_t), intent(in) :: name
type(string_t), intent(in) :: sval
logical, intent(in) :: is_known
logical, intent(in), optional :: ignore, force, verbose
type(string_t), intent(in), optional :: model_name
type(var_entry_t), pointer :: var
var => var_list_get_var_ptr (var_list, name, V_STR)
if (associated (var)) then
if (.not. var_entry_is_locked (var, force)) then
select case (var%type)
case (V_STR)
call var_entry_set_string &
(var, sval, is_known, verbose, model_name)
case default
call var_mismatch_error (name)
end select
else
call var_locked_error (name)
end if
else
call var_missing_error (name, ignore)
end if
end subroutine var_list_set_string
subroutine var_mismatch_error (name)
type(string_t), intent(in) :: name
call msg_fatal ("Type mismatch for variable '" // char (name) // "'")
end subroutine var_mismatch_error
subroutine var_locked_error (name)
type(string_t), intent(in) :: name
call msg_error ("Variable '" // char (name) // "' is not user-definable")
end subroutine var_locked_error
subroutine var_missing_error (name, ignore)
type(string_t), intent(in) :: name
logical, intent(in), optional :: ignore
logical :: error
if (present (ignore)) then
error = .not. ignore
else
error = .true.
end if
if (error) then
call msg_fatal ("Variable '" // char (name) // "' has not been declared")
end if
end subroutine var_missing_error
@ %def var_list_set_log
@ %def var_list_set_int
@ %def var_list_set_real
@ %def var_list_set_cmplx
@ %def var_list_set_subevt
@ %def var_list_set_pdg_array
@ %def var_list_set_string
@ %def var_mismatch_error
@ %def var_missing_error
@
Import values for the current variable list from another list.
<<Variables: public>>=
public :: var_list_import
<<Variables: var list: TBP>>=
procedure :: import => var_list_import
<<Variables: procedures>>=
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: public>>=
public :: var_list_undefine
<<Variables: var list: TBP>>=
procedure :: undefine => var_list_undefine
<<Variables: procedures>>=
recursive subroutine var_list_undefine (var_list, follow_link)
class(var_list_t), intent(inout) :: var_list
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var
logical :: rec
rec = .true.; if (present (follow_link)) rec = follow_link
var => var_list%first
do while (associated (var))
call var_entry_undefine (var)
var => var%next
end do
if (rec .and. associated (var_list%next)) then
call var_list_undefine (var_list%next, follow_link=follow_link)
end if
end subroutine var_list_undefine
@ %def var_list_undefine
@ Make a deep copy of a variable list.
<<Variables: public>>=
public :: var_list_init_snapshot
<<Variables: var list: TBP>>=
procedure :: init_snapshot => var_list_init_snapshot
<<Variables: procedures>>=
recursive subroutine var_list_init_snapshot (var_list, vars_in, follow_link)
class(var_list_t), intent(out) :: var_list
type(var_list_t), intent(in) :: vars_in
logical, intent(in), optional :: follow_link
type(var_entry_t), pointer :: var, var_in
type(var_list_t), pointer :: var_list_next
logical :: rec
rec = .true.; if (present (follow_link)) rec = follow_link
var_in => vars_in%first
do while (associated (var_in))
allocate (var)
call var_entry_init_copy (var, var_in)
call var_entry_copy_value (var, var_in)
call var_list_append (var_list, var)
var_in => var_in%next
end do
if (rec .and. associated (vars_in%next)) then
allocate (var_list_next)
call var_list_init_snapshot (var_list_next, vars_in%next)
call var_list%link (var_list_next)
end if
end subroutine var_list_init_snapshot
@ %def var_list_init_snapshot
@ Check if a user variable can be set. The [[new]] flag is set if the user
variable has an explicit declaration. If an error occurs, return [[V_NONE]]
as variable type.
Also determine the actual type of generic numerical variables, which enter the
procedure with type [[V_NONE]].
<<Variables: public>>=
public :: var_list_check_user_var
<<Variables: var list: TBP>>=
procedure :: check_user_var => var_list_check_user_var
<<Variables: procedures>>=
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: procedures>>=
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_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: procedures>>=
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})'))
call var_list%append_int (var_str ("isr_order"), 3, &
intrinsic=.true., &
description=var_str ('For lepton collider initial-state QED ' // &
'radiation (ISR), this integer parameter allows to set the order ' // &
'up to which hard-collinear radiation is taken into account. ' // &
'Default is the highest available, namely third order. (cf. ' // &
'also \ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_alpha}, ' // &
'\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})'))
call var_list%append_log (var_str ("?isr_recoil"), .false., &
intrinsic=.true., &
description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // &
'$p_T$-kick for the lepton collider initial-state QED radiation ' // &
'(ISR). (cf. also \ttt{isr}, \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, ' // &
'\ttt{isr\_order}, \ttt{isr\_q\_max})'))
call var_list%append_log (var_str ("?isr_keep_energy"), .false., &
intrinsic=.true., &
description=var_str ('As the splitting kinematics for the ISR ' // &
'structure function violates Lorentz invariance when the recoil ' // &
'is switched on, this flag forces energy conservation when set ' // &
'to true, otherwise violating energy conservation. (cf. also ' // &
'\ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // &
'\ttt{?isr\_recoil}, \ttt{?isr\_alpha})'))
call var_list%append_log (var_str ("?isr_handler"), .false., &
intrinsic=.true., &
description=var_str ('Activate ISR ' // &
'handler for event generation (no effect on integration). ' // &
'Requires \ttt{isr\_recoil = false}'))
call var_list%append_string (var_str ("$isr_handler_mode"), &
var_str ("trivial"), &
intrinsic=.true., &
description=var_str ('Operation mode for the ISR ' // &
'event handler. Allowed values: \ttt{trivial} (no effect), ' // &
'\ttt{recoil} (recoil kinematics with two photons)'))
call var_list%append_real (var_str ("epa_alpha"), 0._default, &
intrinsic=.true., &
description=var_str ('For the equivalent photon approximation ' // &
'(EPA), this real parameter sets the value of $\alpha_{em}$ ' // &
'used in the structure function. If not set, it is taken from ' // &
'the parameter set of the physics model in use (cf. also \ttt{epa}, ' // &
'\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_e\_max}, \ttt{epa\_q\_min}, ' // &
'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
call var_list%append_real (var_str ("epa_x_min"), 0._default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the lower cutoff ' // &
'for the energy fraction in the splitting for the equivalent-photon ' // &
'approximation (EPA). This parameter has to be set by the user ' // &
'to a non-zero value smaller than one. (cf. also \ttt{epa}, ' // &
'\ttt{epa\_e\_max}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // &
'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
call var_list%append_real (var_str ("epa_q_min"), 0._default, &
intrinsic=.true., &
description=var_str ('In the equivalent-photon approximation ' // &
'(EPA), this real parameters sets the minimal value for the ' // &
'transferred momentum. Either this parameter or the mass of ' // &
'the beam particle has to be non-zero. (cf. also \ttt{epa}, ' // &
'\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_max}, ' // &
'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
call var_list%append_real (var_str ("epa_q_max"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set the ' // &
'upper energy cutoff for the equivalent-photon approximation ' // &
'(EPA). If not set, \whizard\ simply takes the collider energy, ' // &
'$\sqrt{s}$. (cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, ' // &
'\ttt{epa\_alpha}, \ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
call var_list%append_real (var_str ("epa_mass"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set by hand ' // &
'the mass of the incoming particle for the equivalent-photon ' // &
'approximation (EPA). If not set, the mass for the initial beam ' // &
'particle is taken from the model in use. (cf. also \ttt{epa}, ' // &
'\ttt{epa\_x\_min}, \ttt{epa\_e\_max}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // &
'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
call var_list%append_log (var_str ("?epa_recoil"), .false., &
intrinsic=.true., &
description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // &
'$p_T$-kick for the equivalent-photon approximation (EPA). ' // &
'(cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // &
'\ttt{epa\_e\_max}, \ttt{epa\_q\_min}, \ttt{?epa\_keep\_energy})'))
call var_list%append_log (var_str ("?epa_keep_energy"), .false., &
intrinsic=.true., &
description=var_str ('As the splitting kinematics for the EPA ' // &
'structure function violates Lorentz invariance when the recoil ' // &
'is switched on, this flag forces energy conservation when set ' // &
'to true, otherwise violating energy conservation. (cf. also ' // &
'\ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // &
'\ttt{epa\_q\_min}, \ttt{?epa\_recoil})'))
call var_list%append_log (var_str ("?epa_handler"), .false., &
intrinsic=.true., &
description=var_str ('Activate EPA ' // &
'handler for event generation (no effect on integration). ' // &
'Requires \ttt{epa\_recoil = false}'))
call var_list%append_string (var_str ("$epa_handler_mode"), &
var_str ("trivial"), &
intrinsic=.true., &
description=var_str ('Operation mode for the EPA ' // &
'event handler. Allowed values: \ttt{trivial} (no effect), ' // &
'\ttt{recoil} (recoil kinematics with two beams)'))
call var_list%append_real (var_str ("ewa_x_min"), 0._default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the lower cutoff ' // &
'for the energy fraction in the splitting for the equivalent ' // &
'$W$ approximation (EWA). This parameter has to be set by the ' // &
'user to a non-zero value smaller than one. (cf. also \ttt{ewa}, ' // &
'\ttt{ewa\_pt\_max}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // &
'\ttt{?ewa\_recoil})'))
call var_list%append_real (var_str ("ewa_pt_max"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set the ' // &
'upper $p_T$ cutoff for the equivalent $W$ approximation (EWA). ' // &
'If not set, \whizard\ simply takes the collider energy, $\sqrt{s}$. ' // &
'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // &
'\ttt{?ewa\_recoil})'))
call var_list%append_real (var_str ("ewa_mass"), 0._default, &
intrinsic=.true., &
description=var_str ('This real parameter allows to set by hand ' // &
'the mass of the incoming particle for the equivalent $W$ approximation ' // &
'(EWA). If not set, the mass for the initial beam particle is ' // &
'taken from the model in use. (cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, ' // &
'\ttt{ewa\_pt\_max}, \ttt{?ewa\_keep\_energy}, \ttt{?ewa\_recoil})'))
call var_list%append_log (var_str ("?ewa_recoil"), .false., &
intrinsic=.true., &
description=var_str ('For the equivalent $W$ approximation (EWA), ' // &
'this flag switches on recoil, i.e. non-collinear splitting. ' // &
'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // &
'\ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy})'))
call var_list%append_log (var_str ("?ewa_keep_energy"), .false., &
intrinsic=.true., &
description=var_str ('As the splitting kinematics for the equivalent ' // &
'$W$ approximation (EWA) violates Lorentz invariance when the ' // &
'recoil is switched on, this flag forces energy conservation ' // &
'when set to true, otherwise violating energy conservation. ' // &
'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // &
'\ttt{ewa\_mass}, \ttt{?ewa\_recoil})'))
call var_list%append_log (var_str ("?circe1_photon1"), .false., &
intrinsic=.true., &
description=var_str ('Flag to tell \whizard\ to use the photon ' // &
'of the \circeone\ beamstrahlung structure function as initiator ' // &
'for the hard scattering process in the first beam. (cf. also ' // &
'\ttt{circe1}, \ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, ' // &
'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
'\ttt{?circe1\_with\_radiation})'))
call var_list%append_log (var_str ("?circe1_photon2"), .false., &
intrinsic=.true., &
description=var_str ('Flag to tell \whizard\ to use the photon ' // &
'of the \circeone\ beamstrahlung structure function as initiator ' // &
'for the hard scattering process in the second beam. (cf. also ' // &
'\ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{circe1\_sqrts}, ' // &
'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // &
'\newline\ttt{?circe1\_with\_radiation})'))
call var_list%append_real (var_str ("circe1_sqrts"), &
intrinsic=.true., &
description=var_str ('Real parameter that allows to set the ' // &
'value of the collider energy for the lepton collider beamstrahlung ' // &
'structure function \circeone. If not set, $\sqrt{s}$ is taken. ' // &
'(cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // &
'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
'\ttt{?circe1\_with\_radiation})'))
call var_list%append_log (var_str ("?circe1_generate"), .true., &
intrinsic=.true., &
description=var_str ('Flag that determines whether the \circeone\ ' // &
'structure function for lepton collider beamstrahlung uses the ' // &
'generator mode for the spectrum, or a pre-defined (semi-)analytical ' // &
'parameterization. Default is the generator mode. (cf. also ' // &
'\ttt{circe1}, \ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_map}, \ttt{circe1\_mapping\_slope}, ' // &
'\ttt{circe1\_eps}, \newline \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // &
'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_log (var_str ("?circe1_map"), .true., &
intrinsic=.true., &
description=var_str ('Flag that determines whether the \circeone\ ' // &
'structure function for lepton collider beamstrahlung uses special ' // &
'mappings for $s$-channel resonances. (cf. also \ttt{circe1}, ' // &
'\ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_eps}, \newline ' // &
'\ttt{circe1\_ver}, \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, ' // &
'\ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_real (var_str ("circe1_mapping_slope"), 2._default, &
intrinsic=.true., &
description=var_str ('Real parameter that allows to vary the ' // &
'slope of the mapping function for the \circeone\ structure ' // &
'function for lepton collider beamstrahlung from the default ' // &
'value \ttt{2.}. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // &
'\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
'\ttt{?circe1\_map}, \ttt{circe1\_eps}, \ttt{circe1\_ver}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
'\ttt{?circe1\_with\_radiation})'))
call var_list%append_real (var_str ("circe1_eps"), 1e-5_default, &
intrinsic=.true., &
description=var_str ('Real parameter, that takes care of the ' // &
'mapping of the peak in the lepton collider beamstrahlung structure ' // &
'function spectrum of \circeone. (cf. also \ttt{circe1}, \ttt{?circe1\_photons}, ' // &
'\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
'\ttt{?circe1\_map}, \ttt{circe1\_eps}, \newline ' // &
'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // &
'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline\ttt{?circe1\_with\_radiation})'))
call var_list%append_int (var_str ("circe1_ver"), 0, intrinsic=.true., &
description=var_str ('Integer parameter that sets the internal ' // &
'versioning number of the \circeone\ structure function for lepton-collider ' // &
'beamstrahlung. It has to be set by the user explicitly, it takes ' // &
'values from one to ten. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // &
'\ttt{?circe1\_photon2}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, ' // &
'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // &
'\ttt{?circe1\_with\_radiation})'))
call var_list%append_int (var_str ("circe1_rev"), 0, intrinsic=.true., &
description=var_str ('Integer parameter that sets the internal ' // &
'revision number of the \circeone\ structure function for lepton-collider ' // &
'beamstrahlung. The default \ttt{0} translates always into the ' // &
'most recent version; older versions have to be accessed through ' // &
'the explicit revision date. For more details cf.~the \circeone ' // &
'manual. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // &
'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, \ttt{circe1\_ver}, ' // &
'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_string (var_str ("$circe1_acc"), var_str ("SBAND"), &
intrinsic=.true., &
description=var_str ('String variable that specifies the accelerator ' // &
'type for the \circeone\ structure function for lepton-collider ' // &
'beamstrahlung. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\newline \ttt{circe1\_rev}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_int (var_str ("circe1_chat"), 0, intrinsic=.true., &
description=var_str ('Chattiness of the \circeone\ structure ' // &
'function for lepton-collider beamstrahlung. The higher the integer ' // &
'value, the more information will be given out by the \circeone\ ' // &
'package. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{?circe1\_with\_radiation})'))
call var_list%append_log (var_str ("?circe1_with_radiation"), .false., &
intrinsic=.true., &
description=var_str ('This logical decides whether the additional photon ' // &
'or electron ("beam remnant") will be considered in the event record or ' // &
'not. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
'\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc})'))
call var_list%append_log (var_str ("?circe2_polarized"), .true., &
intrinsic=.true., &
description=var_str ('Flag whether the photon spectra from the ' // &
'\circetwo\ structure function for lepton colliders should be ' // &
'treated polarized. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, ' // &
'\ttt{\$circe2\_design})'))
call var_list%append_string (var_str ("$circe2_file"), &
intrinsic=.true., &
description=var_str ('String variable by which the corresponding ' // &
'photon collider spectrum for the \circetwo\ structure function ' // &
'can be selected. (cf. also \ttt{circe2}, \ttt{?circe2\_polarized}, ' // &
'\ttt{\$circe2\_design})'))
call var_list%append_string (var_str ("$circe2_design"), var_str ("*"), &
intrinsic=.true., &
description=var_str ('String variable that sets the collider ' // &
'design for the \circetwo\ structure function for photon collider ' // &
'spectra. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, \ttt{?circe2\_polarized})'))
call var_list%append_real (var_str ("gaussian_spread1"), 0._default, &
intrinsic=.true., &
description=var_str ('Parameter that sets the energy spread ' // &
'($\sigma$ value) of the first beam for a Gaussian spectrum. ' // &
'(cf. \ttt{gaussian})'))
call var_list%append_real (var_str ("gaussian_spread2"), 0._default, &
intrinsic=.true., &
description=var_str ('Ditto, for the second beam.'))
call var_list%append_string (var_str ("$beam_events_file"), &
intrinsic=.true., &
description=var_str ('String variable that allows to set the ' // &
"name of the external file from which a beamstrahlung's spectrum " // &
'for lepton colliders as pairs of energy fractions is read in. ' // &
'(cf. also \ttt{beam\_events}, \ttt{?beam\_events\_warn\_eof})'))
call var_list%append_log (var_str ("?beam_events_warn_eof"), .true., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to ' // &
'issue a warning when in a simulation the end of an external ' // &
"file for beamstrahlung's spectra for lepton colliders are reached, " // &
'and energy fractions from the beginning of the file are reused. ' // &
'(cf. also \ttt{beam\_events}, \ttt{\$beam\_events\_file})'))
call var_list%append_log (var_str ("?energy_scan_normalize"), .false., &
intrinsic=.true., &
description=var_str ('Normalization flag for the energy scan ' // &
'structure function: if set the total cross section is normalized ' // &
'to unity. (cf. also \ttt{energy\_scan})'))
end subroutine var_list_set_beams_defaults
@ %def var_list_set_beams_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_core_defaults => var_list_set_core_defaults
<<Variables: procedures>>=
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})'))
+ '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})'))
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.'))
!!! JRR: WK please check (#529)
! call var_list_append_string &
! (var_list, var_str ("$user_procs_cut"), var_str (""), &
! intrinsic=.true.)
! call var_list_append_string &
! (var_list, var_str ("$user_procs_event_shape"), var_str (""), &
! intrinsic=.true.)
! call var_list_append_string &
! (var_list, var_str ("$user_procs_obs1"), var_str (""), &
! intrinsic=.true.)
! call var_list_append_string &
! (var_list, var_str ("$user_procs_obs2"), var_str (""), &
! intrinsic=.true.)
! call var_list_append_string &
! (var_list, var_str ("$user_procs_sf"), var_str (""), &
! intrinsic=.true.)
call var_list%append_log (var_str ("?slha_read_input"), .true., &
intrinsic=.true., &
description=var_str ('Flag which decides whether \whizard\ reads ' // &
'in the SM and parameter information from the \ttt{SMINPUTS} ' // &
'and \ttt{MINPAR} common blocks of the SUSY Les Houches Accord ' // &
'files. (cf. also \ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, ' // &
'\ttt{?slha\_read\_decays})'))
call var_list%append_log (var_str ("?slha_read_spectrum"), .true., &
intrinsic=.true., &
description=var_str ('Flag which decides whether \whizard\ reads ' // &
'in the whole spectrum and mixing angle information from the ' // &
'common blocks of the SUSY Les Houches Accord files. (cf. also ' // &
'\ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_decays}, ' // &
'\ttt{?slha\_read\_input})'))
call var_list%append_log (var_str ("?slha_read_decays"), .false., &
intrinsic=.true., &
description=var_str ('Flag which decides whether \whizard\ reads ' // &
'in the widths and branching ratios from the \ttt{DCINFO} common ' // &
'block of the SUSY Les Houches Accord files. (cf. also \ttt{read\_slha}, ' // &
'\ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, \ttt{?slha\_read\_input})'))
call var_list%append_string (var_str ("$library_name"), &
intrinsic=.true., &
description=var_str ('Similar to \ttt{\$model\_name}, this string ' // &
'variable is used solely to access the name of the active process ' // &
'library, e.g. in \ttt{printf} statements. (cf. \ttt{compile}, ' // &
'\ttt{library}, \ttt{printf}, \ttt{show}, \ttt{\$model\_name})'))
call var_list%append_log (var_str ("?alphas_is_fixed"), .true., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use a non-running ' // &
'$\alpha_s$. Note that this has to be set explicitly to $\ttt{false}$ ' // &
'if the user wants to use one of the running $\alpha_s$ options. ' // &
'(cf. also \ttt{alphas\_order}, \ttt{?alphas\_from\_lhapdf}, ' // &
'\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // &
'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
call var_list%append_log (var_str ("?alphas_from_lhapdf"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use a running ' // &
'$\alpha_s$ from the \lhapdf\ library (which has to be correctly ' // &
'linked). Note that \ttt{?alphas\_is\_fixed} has to be set ' // &
'explicitly to $\ttt{false}$. (cf. also \ttt{alphas\_order}, ' // &
'\ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // &
'\ttt{lambda\_qcd})'))
call var_list%append_log (var_str ("?alphas_from_pdf_builtin"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use a running ' // &
'$\alpha_s$ from the internal PDFs. Note that in that case \ttt{?alphas\_is\_fixed} ' // &
'has to be set explicitly to $\ttt{false}$. (cf. also ' // &
'\ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // &
'\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \newline \ttt{?alphas\_from\_lambda\_qcd}, ' // &
'\ttt{lambda\_qcd})'))
call var_list%append_int (var_str ("alphas_order"), 0, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the order ' // &
'of the internal evolution for running $\alpha_s$ in \whizard: ' // &
'the default, \ttt{0}, is LO running, \ttt{1} is NLO, \ttt{2} ' // &
'is NNLO. (cf. also \ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // &
'\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // &
'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
call var_list%append_int (var_str ("alphas_nf"), 5, &
intrinsic=.true., &
description=var_str ('Integer parameter that sets the number ' // &
'of active quark flavors for the internal evolution for running ' // &
'$\alpha_s$ in \whizard: the default is \ttt{5}. (cf. also ' // &
'\ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\ttt{alphas\_order}, \ttt{?alphas\_from\_mz}, \newline ' // &
'\ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
call var_list%append_log (var_str ("?alphas_from_mz"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use its internal ' // &
'running $\alpha_s$ from $\alpha_s(M_Z)$. Note that in that ' // &
'case \ttt{?alphas\_is\_fixed} has to be set explicitly to ' // &
'$\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // &
'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
call var_list%append_log (var_str ("?alphas_from_lambda_qcd"), .false., &
intrinsic=.true., &
description=var_str ('Flag that tells \whizard\ to use its internal ' // &
'running $\alpha_s$ from $\alpha_s(\Lambda_{QCD})$. Note that ' // &
'in that case \ttt{?alphas\_is\_fixed} has to be set explicitly ' // &
'to $\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // &
'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\newline \ttt{?alphas\_from\_mz}, \ttt{lambda\_qcd})'))
call var_list%append_real (var_str ("lambda_qcd"), 200.e-3_default, &
intrinsic=.true., &
description=var_str ('Real parameter that sets the value for ' // &
'$\Lambda_{QCD}$ used in the internal evolution for running ' // &
'$\alpha_s$ in \whizard. (cf. also \ttt{alphas\_is\_fixed}, ' // &
'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, ' // &
'\newline \ttt{?alphas\_from\_pdf\_builtin}, ' // &
'\ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // &
'\ttt{alphas\_order})'))
call var_list%append_log (var_str ("?fatal_beam_decay"), .true., &
intrinsic=.true., &
description=var_str ('Logical variable that let the user decide ' // &
'whether the possibility of a beam decay is treated as a fatal ' // &
'error or only as a warning. An example is a process $b t \to ' // &
'X$, where the bottom quark as an inital state particle appears ' // &
'as a possible decay product of the second incoming particle, ' // &
'the top quark. This might trigger inconsistencies or instabilities ' // &
'in the phase space set-up.'))
call var_list%append_log (var_str ("?helicity_selection_active"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether \whizard\ uses ' // &
'a numerical selection rule for vanishing helicities: if active, ' // &
'then, if a certain helicity combination yields an absolute ' // &
'(\oMega) matrix element smaller than a certain threshold ($\to$ ' // &
'\ttt{helicity\_selection\_threshold}) more often than a certain ' // &
'cutoff ($\to$ \ttt{helicity\_selection\_cutoff}), it will be dropped.'))
call var_list%append_real (var_str ("helicity_selection_threshold"), &
1E10_default, &
intrinsic=.true., &
description=var_str ('Real parameter that gives the threshold ' // &
'for the absolute value of a certain helicity combination of ' // &
'an (\oMega) amplitude. If a certain number ($\to$ ' // &
'\ttt{helicity\_selection\_cutoff}) of calls stays below this ' // &
'threshold, that combination will be dropped from then on. (cf. ' // &
'also \ttt{?helicity\_selection\_active})'))
call var_list%append_int (var_str ("helicity_selection_cutoff"), 1000, &
intrinsic=.true., &
description=var_str ('Integer parameter that gives the number ' // &
"a certain helicity combination of an (\oMega) amplitude has " // &
'to be below a certain threshold ($\to$ \ttt{helicity\_selection\_threshold}) ' // &
'in order to be dropped from then on. (cf. also \ttt{?helicity\_selection\_active})'))
call var_list%append_string (var_str ("$rng_method"), var_str ("tao"), &
intrinsic=.true., &
description=var_str ('String variable that allows to set the ' // &
'method for the random number generation. Default is Donald ' // &
"Knuth' RNG method \ttt{TAO}."))
call var_list%append_log (var_str ("?vis_diags"), .false., &
intrinsic=.true., &
description=var_str ('Logical variable that allows to give out ' // &
"a Postscript or PDF file for the Feynman diagrams for a \oMega\ " // &
'process. (cf. \ttt{?vis\_diags\_color}).'))
call var_list%append_log (var_str ("?vis_diags_color"), .false., &
intrinsic=.true., &
description=var_str ('Same as \ttt{?vis\_diags}, but switches ' // &
'on color flow instead of Feynman diagram generation. (cf. \ttt{?vis\_diags}).'))
call var_list%append_log (var_str ("?check_event_file"), .true., &
intrinsic=.true., &
description=var_str ('Setting this to false turns off all sanity ' // &
'checks when reading a raw event file with previously generated ' // &
'events. Use this at your own risk; the program may return ' // &
'wrong results or crash if data do not match. (cf. also \ttt{?check\_grid\_file}, ' // &
'\ttt{?check\_phs\_file})'))
call var_list%append_string (var_str ("$event_file_version"), var_str (""), &
intrinsic=.true., &
description=var_str ('String variable that allows to set the ' // &
'format version of the \whizard\ internal binary event format.'))
call var_list%append_int (var_str ("n_events"), 0, &
intrinsic=.true., &
description=var_str ('This specifier \ttt{n\_events = {\em <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 ("?recover_beams"), .true., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the beam particles ' // &
'should be reconstructed when reading event/rescanning files ' // &
'into \whizard. (cf. \ttt{rescan}, \ttt{?update\_event}, \ttt{?update\_sqme}, ' // &
'\newline \ttt{?update\_weight})'))
call var_list%append_log (var_str ("?update_event"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the events in ' // &
'an event file should be rebuilt from the hard process when ' // &
'reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // &
'\ttt{?recover\_beams}, \ttt{?update\_sqme}, \ttt{?update\_weight})'))
call var_list%append_log (var_str ("?update_sqme"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whehter the squared ' // &
'matrix element in an event file should be updated/recalculated ' // &
'when reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // &
'\newline \ttt{?recover\_beams}, \ttt{?update\_event}, \ttt{?update\_weight})'))
call var_list%append_log (var_str ("?update_weight"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the weights ' // &
'in an event file should be updated/recalculated when reading ' // &
'event/rescanning files into \whizard. (cf. \ttt{rescan}, \ttt{?recover\_beams}, ' // &
'\newline \ttt{?update\_event}, \ttt{?update\_sqme})'))
call var_list%append_log (var_str ("?use_alphas_from_file"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the current ' // &
'$\alpha_s$ definition should be used when recalculating matrix ' // &
'elements for events read from file, or the value that is stored ' // &
'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // &
'\ttt{?use\_scale\_from\_file})'))
call var_list%append_log (var_str ("?use_scale_from_file"), .false., &
intrinsic=.true., &
description=var_str ('Flag that decides whether the current ' // &
'energy-scale expression should be used when recalculating matrix ' // &
'elements for events read from file, or the value that is stored ' // &
'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // &
'\ttt{?use\_alphas\_from\_file})'))
call var_list%append_log (var_str ("?allow_decays"), .true., &
intrinsic=.true., &
description=var_str ('Master flag to switch on cascade decays ' // &
'for final state particles as an event transform. As a default, ' // &
'it is switched on. (cf. also \ttt{?auto\_decays}, ' // &
'\ttt{auto\_decays\_multiplicity}, \ttt{?auto\_decays\_radiative}, ' // &
'\ttt{?decay\_rest\_frame})'))
call var_list%append_log (var_str ("?auto_decays"), .false., &
intrinsic=.true., &
description=var_str ('Flag, particularly as optional argument of the ($\to$) ' // &
'\ttt{unstable} command, that tells \whizard\ to automatically ' // &
'determine the decays of that particle up to the final state ' // &
'multplicity ($\to$) \ttt{auto\_decays\_multiplicity}. Depending ' // &
'on the flag ($\to$) \ttt{?auto\_decays\_radiative}, radiative ' // &
'decays will be taken into account or not. (cf. also \ttt{unstable}, ' // &
'\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay})'))
call var_list%append_int (var_str ("auto_decays_multiplicity"), 2, &
intrinsic=.true., &
description=var_str ('Integer parameter, that sets -- ' // &
'for the ($\to$) \ttt{?auto\_decays} option to let \whizard\ ' // &
'automatically determine the decays of a particle set as ($\to$) ' // &
'\ttt{unstable} -- the maximal final state multiplicity that ' // &
'is taken into account. The default is \ttt{2}. The flag \ttt{?auto\_decays\_radiative} ' // &
'decides whether radiative decays are taken into account. (cf.\ ' // &
'also \ttt{unstable}, \ttt{?auto\_decays})'))
call var_list%append_log (var_str ("?auto_decays_radiative"), .false., &
intrinsic=.true., &
description=var_str ("If \whizard's automatic detection " // &
'of decay channels are switched on ($\to$ \ttt{?auto\_decays} ' // &
'for the ($\to$) \ttt{unstable} command, this flags decides ' // &
'whether radiative decays (e.g. containing additional photon(s)/gluon(s)) ' // &
'are taken into account or not. (cf. also \ttt{unstable}, \ttt{auto\_decays\_multiplicity})'))
call var_list%append_log (var_str ("?decay_rest_frame"), .false., &
intrinsic=.true., &
description=var_str ('Flag that allows to force a particle decay ' // &
'to be simulated in its rest frame. This simplifies the calculation ' // &
'for decays as stand-alone processes, but makes the process ' // &
'unsuitable for use in a decay chain.'))
call var_list%append_log (var_str ("?isotropic_decay"), .false., &
intrinsic=.true., &
description=var_str ('Flag that -- in case of using factorized ' // &
'production and decays using the ($\to$) \ttt{unstable} command ' // &
'-- tells \whizard\ to switch off spin correlations completely ' // &
'(isotropic decay). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // &
'\ttt{decay\_helicity}, \ttt{?diagonal\_decay})'))
call var_list%append_log (var_str ("?diagonal_decay"), .false., &
intrinsic=.true., &
description=var_str ('Flag that -- in case of using factorized ' // &
'production and decays using the ($\to$) \ttt{unstable} command ' // &
'-- tells \whizard\ instead of full spin correlations to take ' // &
'only the diagonal entries in the spin-density matrix (i.e. ' // &
'classical spin correlations). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // &
'\ttt{decay\_helicity}, \ttt{?isotropic\_decay})'))
call var_list%append_int (var_str ("decay_helicity"), &
intrinsic=.true., &
description=var_str ('If this parameter is given an integer ' // &
'value, any particle decay triggered by a subsequent \ttt{unstable} ' // &
'declaration will receive a projection on the given helicity ' // &
'state for the unstable particle. (cf. also \ttt{unstable}, ' // &
'\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay}. The latter ' // &
'parameters, if true, take precdence over any \ttt{?decay\_helicity} setting.)'))
call var_list%append_log (var_str ("?polarized_events"), .false., &
intrinsic=.true., &
description=var_str ('Flag that allows to select certain helicity ' // &
'combinations in final state particles in the event files, ' // &
'and perform analysis on polarized event samples. (cf. also ' // &
'\ttt{simulate}, \ttt{polarized}, \ttt{unpolarized})'))
call var_list%append_string (var_str ("$polarization_mode"), &
var_str ("helicity"), &
intrinsic=.true., &
description=var_str ('String variable that specifies the mode in ' // &
'which the polarization of particles is handled when polarized events ' // &
'are written out. Possible options are \ttt{"ignore"}, \ttt{"helicity"}, ' // &
'\ttt{"factorized"}, and \ttt{"correlated"}. For more details cf. the ' // &
'detailed section.'))
call var_list%append_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})'))
!!! JRR: WK please check (#542)
! call var_list%append_log (var_str ("?out_custom"), .false., &
! intrinsic=.true.)
! call var_list%append_string (var_str ("$out_comment"), var_str ("# "), &
! intrinsic=.true.)
! call var_list%append_log (var_str ("?out_header"), .true., &
! intrinsic=.true.)
! call var_list%append_log (var_str ("?out_yerr"), .true., &
! intrinsic=.true.)
! call var_list%append_log (var_str ("?out_xerr"), .true., &
! intrinsic=.true.)
call var_list%append_int (var_str ("real_range"), &
range (real_specimen), intrinsic = .true., locked = .true., &
description=var_str ('This integer gives the decimal exponent ' // &
'range of the numeric model for the real float type in use. It cannot ' // &
'be set by the user. (cf. also \ttt{real\_precision}, ' // &
'\ttt{real\_epsilon}, \ttt{real\_tiny}).'))
call var_list%append_int (var_str ("real_precision"), &
precision (real_specimen), intrinsic = .true., locked = .true., &
description=var_str ('This integer gives the precision of ' // &
'the numeric model for the real float type in use. It cannot ' // &
'be set by the user. (cf. also \ttt{real\_range}, ' // &
'\ttt{real\_epsilon}, \ttt{real\_tiny}).'))
call var_list%append_real (var_str ("real_epsilon"), &
epsilon (real_specimen), intrinsic = .true., locked = .true., &
description=var_str ('This gives the smallest number $E$ ' // &
'of the same kind as the float type for which $1 + E > 1$. ' // &
'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // &
'\ttt{real\_tiny}, \ttt{real\_precision}).'))
call var_list%append_real (var_str ("real_tiny"), &
tiny (real_specimen), intrinsic = .true., locked = .true., &
description=var_str ('This gives the smallest positive (non-zero) ' // &
'number in the numeric model for the real float type in use. ' // &
'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // &
'\ttt{real\_epsilon}, \ttt{real\_precision}).'))
end subroutine var_list_set_core_defaults
@ %def var_list_set_core_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_integration_defaults => var_list_set_integration_defaults
<<Variables: procedures>>=
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 ("$grid_path"), var_str (""), &
+ call var_list%append_string (var_str ("$integrate_workspace"), &
intrinsic=.true., &
description=var_str ('Character string that tells \whizard\ ' // &
- 'the path where to find the \vamp\ and \vamptwo\ grid files. ' // &
- 'If empty (as per default), \whizard\ searches for them in the ' // &
- 'current directory.'))
+ '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})'))
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: procedures>>=
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: procedures>>=
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: procedures>>=
subroutine var_list_set_clustering_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_int (&
var_str ("kt_algorithm"), &
kt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the ' // &
'interfaced external \fastjet\ package. (cf. also ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, ' // &
'\ttt{plugin\_algorithm}, ' // &
'\newline\ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})'))
call var_list%append_int (&
var_str ("cambridge_algorithm"), &
cambridge_algorithm, intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("antikt_algorithm"), &
antikt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("genkt_algorithm"), &
genkt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_for\_passive\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("cambridge_for_passive_algorithm"), &
cambridge_for_passive_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_algorithm}, \ttt{plugin\_algorithm}, \newline ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("genkt_for_passive_algorithm"), &
genkt_for_passive_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})'))
call var_list%append_int (&
var_str ("ee_kt_algorithm"), &
ee_kt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_genkt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("ee_genkt_algorithm"), &
ee_genkt_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("plugin_algorithm"), &
plugin_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
'subevent function. At the moment only available for the interfaced ' // &
'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r})'))
call var_list%append_int (&
var_str ("undefined_jet_algorithm"), &
undefined_jet_algorithm, &
intrinsic = .true., locked = .true., &
description=var_str ('This is just a place holder for any kind of jet ' // &
'jet algorithm that is not further specified. (cf. also \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // &
'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
'\ttt{jet\_r}, \ttt{plugin\_algorithm})'))
call var_list%append_int (&
var_str ("jet_algorithm"), undefined_jet_algorithm, &
intrinsic = .true., &
description=var_str ('Variable that allows to set the type of ' // &
'jet algorithm when using the external \fastjet\ library. It ' // &
'accepts one of the following algorithms: ($\to$) \ttt{kt\_algorithm}, ' // &
'\newline ($\to$) \ttt{cambridge\_[for\_passive\_]algorithm}, ' // &
'($\to$) \ttt{antikt\_algorithm}, ($\to$) \ttt{plugin\_algorithm}, ' // &
'($\to$) \ttt{genkt\_[for\_passive\_]algorithm}, ($\to$) ' // &
'\ttt{ee\_[gen]kt\_algorithm}). (cf. also \ttt{cluster}, ' // &
'\ttt{jet\_p}, \ttt{jet\_r}, \ttt{jet\_ycut})'))
call var_list%append_real (&
var_str ("jet_r"), 0._default, &
intrinsic = .true., &
description=var_str ('Value for the distance measure $R$ used in ' // &
'the (non-Cambridge) algorithms that are available via the interface ' // &
'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
'\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_ycut})'))
call var_list%append_real (&
var_str ("jet_p"), 0._default, &
intrinsic = .true., &
description=var_str ('Value for the exponent of the distance measure $R$ in ' // &
'the generalized $k_T$ algorithms that are available via the interface ' // &
'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
'\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r}, \newline\ttt{jet\_ycut})'))
call var_list%append_real (&
var_str ("jet_ycut"), 0._default, &
intrinsic = .true., &
description=var_str ('Value for the $y$ separation measure used in ' // &
'the Cambridge-Aachen algorithms that are available via the interface ' // &
'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
'\ttt{kt\_algorithm}, \ttt{jet\_algorithm}, ' // &
'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_r})'))
call var_list%append_log (&
var_str ("?keep_flavors_when_clustering"), .false., &
intrinsic = .true., &
description=var_str ('The logical variable \ttt{?keep\_flavors\_when\_clustering ' // &
'= true/false} specifies whether the flavor of a jet should be ' // &
'kept during \ttt{cluster} when a jet consists of one quark and ' // &
'zero or more gluons. Especially useful for cuts on b-tagged ' // &
'jets (cf. also \ttt{cluster}).'))
end subroutine var_list_set_clustering_defaults
@ %def var_list_set_clustering_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_eio_defaults => var_list_set_eio_defaults
<<Variables: procedures>>=
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_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: procedures>>=
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_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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
subroutine var_list_set_powheg_matching_defaults (var_list)
class(var_list_t), intent(inout) :: var_list
call var_list%append_log (var_str ("?powheg_matching"), &
.false., intrinsic = .true., &
description=var_str ('Activates Powheg matching. Needs to be ' // &
'combined with the \ttt{?combined\_nlo\_integration}-method.'))
call var_list%append_log (var_str ("?powheg_use_singular_jacobian"), &
.false., intrinsic = .true., &
description=var_str ('This allows to give a different ' // &
'normalization of the Jacobian, resulting in an alternative ' // &
'POWHEG damping in the singular regions.'))
call var_list%append_int (var_str ("powheg_grid_size_xi"), &
5, intrinsic = .true., &
description=var_str ('Number of $\xi$ points in the POWHEG grid.'))
call var_list%append_int (var_str ("powheg_grid_size_y"), &
5, intrinsic = .true., &
description=var_str ('Number of $y$ points in the POWHEG grid.'))
call var_list%append_int (var_str ("powheg_grid_sampling_points"), &
500000, intrinsic = .true., &
description=var_str ('Number of calls used to initialize the ' // &
'POWHEG grid.'))
call var_list%append_real (var_str ("powheg_pt_min"), &
1._default, intrinsic = .true., &
description=var_str ('Lower $p_T$-cut-off for the POWHEG ' // &
'hardest emission.'))
call var_list%append_real (var_str ("powheg_lambda"), &
LAMBDA_QCD_REF, intrinsic = .true., &
description=var_str ('Reference scale of the $\alpha_s$ evolution ' // &
'in the POWHEG matching algorithm.'))
call var_list%append_log (var_str ("?powheg_rebuild_grids"), &
.false., intrinsic = .true., &
description=var_str ('If set to \ttt{true}, the existing POWHEG ' // &
'grid is discarded and a new one is generated.'))
call var_list%append_log (var_str ("?powheg_test_sudakov"), &
.false., intrinsic = .true., &
description=var_str ('Performs an internal consistency check ' // &
'on the POWHEG event generation.'))
call var_list%append_log (var_str ("?powheg_disable_sudakov"), &
.false., intrinsic = .true., &
description=var_str ('This flag allows to set the Sudakov form ' // &
'factor to one. This effectively results in a version of ' // &
'the matrix-element method (MEM) at NLO.'))
end subroutine var_list_set_powheg_matching_defaults
@ %def var_list_set_powheg_matching_defaults
@
<<Variables: var list: TBP>>=
procedure :: set_openmp_defaults => var_list_set_openmp_defaults
<<Variables: procedures>>=
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: procedures>>=
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: procedures>>=
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.0001$ ' // &
'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.999$ 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.999$ as radiation variables. This way, only anti-collinear, ' // &
'but non-soft phase space points are generated, which allows ' // &
'for testing subtraction in this region. Can be combined with ' // &
'\ttt{?test\_soft\_limit} to probe soft-collinear regions.'))
call var_list%append_string (var_str ("$select_alpha_regions"), &
var_str (""), intrinsic = .true., &
description=var_str ('Fixes the $\alpha_r$ in the real ' // &
' subtraction component. Allows for testing in one individual ' // &
'singular region.'))
call var_list%append_string (var_str ("$virtual_selection"), &
var_str ("Full"), intrinsic = .true., &
description=var_str ('String variable to select either the full ' // &
'or only parts of the virtual components of an NLO calculation. ' // &
'Possible modes are \ttt{"Full"}, \ttt{"OLP"} and ' // &
'\ttt{"Subtraction."}. Mainly for debugging purposes.'))
call var_list%append_log (var_str ("?virtual_collinear_resonance_aware"), &
.true., intrinsic = .true., &
description=var_str ('This flag allows to switch between two ' // &
'different implementations of the collinear subtraction in the ' // &
'resonance-aware FKS setup.'))
call var_list%append_real (&
var_str ("blha_top_yukawa"), -1._default, intrinsic = .true., &
description=var_str ('If this value is set, the given value will ' // &
'be used as the top Yukawa coupling instead of the top mass. ' // &
'Note that having different values for $y_t$ and $m_t$ must be ' // &
'supported by your OLP-library and yield errors if this is not the case.'))
call var_list%append_string (var_str ("$blha_ew_scheme"), &
var_str ("alpha_qed"), intrinsic = .true., &
description=var_str ('String variable that transfers the electroweak ' // &
'renormalization scheme via BLHA to the one-loop provider. Possible ' // &
'values are \ttt{GF} or \ttt{Gmu} for the $G_\mu$ scheme, ' // &
'\ttt{alpha\_qed}, \ttt{alpha\_mz} and \ttt{alpha\_0} or ' // &
'\ttt{alpha\_thompson} for different schemes with $\alpha$ as input.'))
call var_list%append_int (var_str ("openloops_verbosity"), 1, &
intrinsic = .true., &
description=var_str ('Decides how much \openloops output is printed. ' // &
'Can have values 0, 1 and 2, where 2 is the highest verbosity level.'))
call var_list%append_log (var_str ("?openloops_use_cms"), &
.true., intrinsic = .true., &
description=var_str ('Activates the complex mass scheme in ' // &
'\openloops. (cf. also ' // &
'\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
'\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // &
'\ttt{openloops\_stability\_log}, \newline' // &
'\ttt{\$openloops\_extra\_cmd})'))
call var_list%append_int (var_str ("openloops_phs_tolerance"), 7, &
intrinsic = .true., &
description=var_str ('This integer parameter gives via ' // &
'\ttt{openloops\_phs\_tolerance = <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_log (var_str ("?openloops_use_collier"), &
.true., intrinsic = .true., &
description=var_str ('Use \collier\ as the reduction method of ' // &
'\openloops. Otherwise, \ttt{CutTools} will be used. (cf. also ' // &
'\ttt{\$method}, \ttt{openloos\_verbosity}, ' // &
'\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
'\ttt{?openloops\_switch\_off\_muon\_yukawa})'))
call var_list%append_log (var_str ("?disable_subtraction"), &
.false., intrinsic = .true., &
description=var_str ('Disables the subtraction of soft and collinear ' // &
'divergences from the real matrix element.'))
call var_list%append_real (var_str ("fks_dij_exp1"), &
1._default, intrinsic = .true., &
description=var_str ('Fine-tuning parameters of the FKS ' // &
'partition functions. The exact meaning depends on the mapping ' // &
'implementation. (cf. also \ttt{fks\_dij\_exp2}, ' // &
'\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})'))
call var_list%append_real (var_str ("fks_dij_exp2"), &
1._default, intrinsic = .true., &
description=var_str ('Fine-tuning parameters of the FKS ' // &
'partition functions. The exact meaning depends on the mapping ' // &
'implementation. (cf. also \ttt{fks\_dij\_exp1}, ' // &
'\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})'))
call var_list%append_real (var_str ("fks_xi_min"), &
0.0000001_default, intrinsic = .true., &
description=var_str ('Real parameter for the FKS ' // &
'phase space that sets the numerical lower value of the $\xi$ ' // &
'variable. (cf. also \ttt{fks\_dij\_exp1}, ' // &
'\ttt{fks\_dij\_exp2}, \ttt{\$fks\_mapping\_type}, \ttt{fks\_y\_max})'))
call var_list%append_real (var_str ("fks_y_max"), &
1._default, intrinsic = .true., &
description=var_str ('Real parameter for the FKS ' // &
'phase space that sets the numerical upper value of the $y$ ' // &
'variable. (cf. also \ttt{fks\_dij\_exp1}, ' // &
'\ttt{\$fks\_mapping\_type}, \ttt{fks\_dij\_exp2}, \ttt{fks\_y\_max})'))
call var_list%append_log (var_str ("?vis_fks_regions"), &
.false., intrinsic = .true., &
description=var_str ('Logical variable that, if set to ' // &
'\ttt{true}, generates \LaTeX\ code and executes it into a PDF ' // &
' to produce a table of all singular FKS regions and their ' // &
' flavor structures. The default is \ttt{false}.'))
call var_list%append_real (var_str ("fks_xi_cut"), &
1.0_default, intrinsic = .true., &
description = var_str ('Real paramter for the FKS ' // &
'phase space that applies a cut to $\xi$ variable with $0 < \xi_{\text{cut}}' // &
'\leq \xi_{\text{max}}$. The dependence on the parameter vanishs between ' // &
'real subtraction and integrated subtraction term.'))
call var_list%append_real (var_str ("fks_delta_zero"), &
2._default, intrinsic = .true., &
description = var_str ('Real paramter for the FKS ' // &
'phase space that applies a cut to the $y$ variable with $0 < \delta_0 \leq 2$. ' // &
'The dependence on the parameter vanishs between real subtraction and integrated' // &
'subtraction term.'))
call var_list%append_real (var_str ("fks_delta_i"), &
2._default, intrinsic = .true., &
description = var_str ('Real paramter for the FKS ' // &
'phase space that applies a cut to the $y$ variable with $0 < \delta_{\mathrm{I}} \leq 2$ '// &
'for initial state singularities only. ' // &
'The dependence on the parameter vanishs between real subtraction and integrated' // &
'subtraction term.'))
call var_list%append_string (var_str ("$fks_mapping_type"), &
var_str ("default"), intrinsic = .true., &
description=var_str ('Sets the FKS mapping type. Possible values ' // &
'are \ttt{"default"} and \ttt{"resonances"}. The latter option ' // &
'activates the resonance-aware subtraction mode and induces the ' // &
'generation of a soft mismatch component. (cf. also ' // &
'\ttt{fks\_dij\_exp1}, \ttt{fks\_dij\_exp2}, \ttt{fks\_xi\_min}, ' // &
'\ttt{fks\_y\_max})'))
call var_list%append_string (var_str ("$resonances_exclude_particles"), &
var_str ("default"), intrinsic = .true., &
description=var_str ('Accepts a string of particle names. These ' // &
'particles will be ignored when the resonance histories are generated. ' // &
'If \ttt{\$fks\_mapping\_type} is not \ttt{"resonances"}, this ' // &
'option does nothing.'))
call var_list%append_int (var_str ("alpha_power"), &
2, intrinsic = .true., &
description=var_str ('Fixes the electroweak coupling ' // &
'powers used by BLHA matrix element generators. Setting these ' // &
'values is necessary for the correct generation of OLP-files. ' // &
'Having inconsistent values yields to error messages by the corresponding ' // &
'OLP-providers.'))
call var_list%append_int (var_str ("alphas_power"), &
0, intrinsic = .true., &
description=var_str ('Fixes the strong coupling ' // &
'powers used by BLHA matrix element generators. Setting these ' // &
'values is necessary for the correct generation of OLP-files. ' // &
'Having inconsistent values yields to error messages by the corresponding ' // &
'OLP-providers.'))
call var_list%append_log (var_str ("?combined_nlo_integration"), &
.false., intrinsic = .true., &
description=var_str ('When this option is set to \ttt{true}, ' // &
'the NLO integration will not be performed in the separate components, ' // &
'but instead the sum of all components will be integrated directly. ' // &
'When fixed-order NLO events are requested, this integration ' // &
'mode is possible, but not necessary. However, it is necessary ' // &
'for POWHEG events.'))
call var_list%append_log (var_str ("?fixed_order_nlo_events"), &
.false., intrinsic = .true., &
description=var_str ('Induces the generation of fixed-order ' // &
'NLO events. Deprecated name: \ttt{?nlo\_fixed\_order}.'))
call var_list%append_log (var_str ("?check_event_weights_against_xsection"), &
.false., intrinsic = .true., &
description=var_str ('Activates an internal recording of event ' // &
'weights when unweighted events are generated. At the end of ' // &
'the simulation, the mean value of the weights and its standard ' // &
'deviation are displayed. This allows to cross-check event generation ' // &
'and integration, because the value displayed must be equal to ' // &
'the integration result.'))
call var_list%append_log (var_str ("?keep_failed_events"), &
.false., intrinsic = .true., &
description=var_str ('In the context of weighted event generation, ' // &
'if set to \ttt{true}, events with failed kinematics will be ' // &
'written to the event output with an associated weight of zero. ' // &
'This way, the total cross section can be reconstructed from the event output.'))
call var_list%append_int (var_str ("gks_multiplicity"), &
0, intrinsic = .true., &
description=var_str ('Jet multiplicity for the GKS merging scheme.'))
call var_list%append_string (var_str ("$gosam_filter_lo"), &
var_str (""), intrinsic = .true., &
description=var_str ('The filter string given to \gosam\ in order to ' // &
'filter out tree-level diagrams. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // &
'\ttt{\$gosam\_symmetries})'))
call var_list%append_string (var_str ("$gosam_filter_nlo"), &
var_str (""), intrinsic = .true., &
description=var_str ('The same as \ttt{\$gosam\_filter\_lo}, but for ' // &
'loop matrix elements. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // &
'\ttt{\$gosam\_symmetries})'))
call var_list%append_string (var_str ("$gosam_symmetries"), &
var_str ("family,generation"), intrinsic = .true., &
description=var_str ('String variable that is transferred to \gosam\ ' // &
'configuration file to determine whether certain helicity configurations ' // &
'are considered to be equal. Possible values are \ttt{flavour}, ' // &
'\ttt{family} etc. For more info see the \gosam\ manual.'))
call var_list%append_int (var_str ("form_threads"), &
2, intrinsic = .true., &
description=var_str ('The number of threads used by \gosam when ' // &
'matrix elements are evaluated using \ttt{FORM}'))
call var_list%append_int (var_str ("form_workspace"), &
1000, intrinsic = .true., &
description=var_str ('The size of the workspace \gosam requires ' // &
'from \ttt{FORM}. Inside \ttt{FORM}, it corresponds to the heap ' // &
'size used by the algebra processor.'))
call var_list%append_string (var_str ("$gosam_fc"), &
var_str (""), intrinsic = .true., &
description=var_str ('The Fortran compiler used by \gosam.'))
call var_list%append_real (&
var_str ("mult_call_real"), 1._default, &
intrinsic = .true., &
description=var_str ('(Real-valued) multiplier for the number ' // &
'of calls used in the integration of the real subtraction ' // &
'NLO component. This way, a higher accuracy can be achieved for ' // &
'the real component, while simultaneously avoiding redundant ' // &
'integration calls for the other components. (cf. also ' // &
'\ttt{mult\_call\_dglap}, \ttt{mult\_call\_virt})'))
call var_list%append_real (&
var_str ("mult_call_virt"), 1._default, &
intrinsic = .true., &
description=var_str ('(Real-valued) multiplier for the number ' // &
'of calls used in the integration of the virtual NLO ' // &
'component. This way, a higher accuracy can be achieved for ' // &
'this component, while simultaneously avoiding redundant ' // &
'integration calls for the other components. (cf. also ' // &
'\ttt{mult\_call\_dglap}, \ttt{mult\_call\_real})'))
call var_list%append_real (&
var_str ("mult_call_dglap"), 1._default, &
intrinsic = .true., &
description=var_str ('(Real-valued) multiplier for the number ' // &
'of calls used in the integration of the DGLAP remnant NLO ' // &
'component. This way, a higher accuracy can be achieved for ' // &
'this component, while simultaneously avoiding redundant ' // &
'integration calls for the other components. (cf. also ' // &
'\ttt{mult\_call\_real}, \ttt{mult\_call\_virt})'))
call var_list%append_string (var_str ("$dalitz_plot"), &
var_str (''), intrinsic = .true., &
description=var_str ('This string variable has two purposes: ' // &
'when different from the empty string, it switches on generation ' // &
'of the Dalitz plot file (ASCII tables) for the real emitters. ' // &
'The string variable itself provides the file name.'))
call var_list%append_string (var_str ("$nlo_correction_type"), &
var_str ("QCD"), intrinsic = .true., &
description=var_str ('String variable which sets the NLO correction ' // &
'type via \ttt{nlo\_correction\_type = "{\em <type>}"} to either ' // &
'\ttt{"QCD"} or \ttt{"QED"}, or to both with \ttt{\em{<type>}} ' // &
'set to \ttt{"Full"}.'))
call var_list%append_string (var_str ("$exclude_gauge_splittings"), &
var_str ("c:b:t:e2:e3"), intrinsic = .true., &
description=var_str ('String variable that allows via ' // &
'\ttt{\$exclude\_gauge\_splittings = "{\em <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"), &
.true., intrinsic = .true., &
description=var_str ('Flag that decides whether a scale expression ' // &
'defined for the Born component of an NLO process shall be applied ' // &
'to all other components as well or not. ' // &
'(cf. also \ttt{?nlo\_cut\_all\_sqmes})'))
call var_list%append_log (var_str ("?nlo_cut_all_sqmes"), &
.true., intrinsic = .true., &
description=var_str ('Flag that decides whether in the case that ' // &
'some NLO component does not pass a cut, all other components ' // &
'shall be discarded for that phase space point as well or not. ' // &
'(cf. also \ttt{?nlo\_use\_born\_scale})'))
call var_list%append_log (var_str ("?nlo_use_real_partition"), &
.false., intrinsic = .true., &
description=var_str (' If set to \ttt{true}, the real matrix ' // &
'element is split into a finite and a singular part using a ' // &
'partition function $f$, such that $\mathcal{R} ' // &
'= [1-f(p_T^2)]\mathcal{R} + f(p_T^2)\mathcal{R} = ' // &
'\mathcal{R}_{\text{fin}} ' // &
'+ \mathcal{R}_{\text{sing}}$. The emission ' // &
'generation is then performed using $\mathcal{R}_{\text{sing}}$, ' // &
'whereas $\mathcal{R}_{\text{fin}}$ is treated separately. ' // &
'(cf. also \ttt{real\_partition\_scale})'))
call var_list%append_real (var_str ("real_partition_scale"), &
10._default, intrinsic = .true., &
description=var_str ('This real variable sets the invariant mass ' // &
'of the FKS pair used as a separator between the singular and the ' // &
'finite part of the real subtraction terms in an NLO calculation, ' // &
'e.g. in $e^+e^- \to ' // &
't\bar tj$. (cf. also \ttt{?nlo\_use\_real\_partition})'))
end subroutine var_list_set_nlo_defaults
@ %def var_list_set_nlo_defaults
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Observables}
In this module we define concrete variables and operators (observables)
that we want to support in expressions.
<<[[observables.f90]]>>=
<<File header>>
module observables
<<Use kinds>>
<<Use strings>>
use io_units
use diagnostics
use lorentz
use subevents
use variables
<<Standard module head>>
<<Observables: public>>
contains
<<Observables: procedures>>
end module observables
@ %def observables
@
\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: procedures>>=
subroutine var_list_init_num_id (var_list, proc_id, num_id)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
integer, intent(in), optional :: num_id
call var_list_set_procvar_int (var_list, proc_id, &
var_str ("num_id"), num_id)
end subroutine var_list_init_num_id
@ %def var_list_init_num_id
@
Integration results are stored in special variables. They are
initialized by this subroutine. The values may or may not already
known.
Note: the values which are accessible are those that are unique for a
process with multiple MCI records. The rest has been discarded.
<<Observables: public>>=
public :: var_list_init_process_results
<<Observables: procedures>>=
subroutine var_list_init_process_results (var_list, proc_id, &
n_calls, integral, error, accuracy, chi2, efficiency)
type(var_list_t), intent(inout) :: var_list
type(string_t), intent(in) :: proc_id
integer, intent(in), optional :: n_calls
real(default), intent(in), optional :: integral, error, accuracy
real(default), intent(in), optional :: chi2, efficiency
call var_list_set_procvar_real (var_list, proc_id, &
var_str ("integral"), integral)
call var_list_set_procvar_real (var_list, proc_id, &
var_str ("error"), error)
end subroutine var_list_init_process_results
@ %def var_list_init_process_results
@
\subsection{Observables as Pseudo-Variables}
Unary and binary observables are different. Most unary observables
can be equally well evaluated for particle pairs. Binary observables
cannot be evaluated for single particles.
<<Observables: public>>=
public :: var_list_set_observables_unary
public :: var_list_set_observables_binary
<<Observables: procedures>>=
subroutine var_list_set_observables_unary (var_list, prt1)
type(var_list_t), intent(inout) :: var_list
type(prt_t), intent(in), target :: prt1
call var_list_append_obs1_iptr &
(var_list, var_str ("PDG"), obs_pdg1, prt1)
call var_list_append_obs1_iptr &
(var_list, var_str ("Hel"), obs_helicity1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("M"), obs_signed_mass1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("M2"), obs_mass_squared1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("E"), obs_energy1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Px"), obs_px1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Py"), obs_py1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Pz"), obs_pz1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("P"), obs_p1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Pl"), obs_pl1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Pt"), obs_pt1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Theta"), obs_theta1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Phi"), obs_phi1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Rap"), obs_rap1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Eta"), obs_eta1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Theta_star"), obs_theta_star1, prt1)
call var_list_append_obs1_rptr &
(var_list, var_str ("Dist"), obs_dist1, prt1)
call var_list_append_uobs_real &
(var_list, var_str ("_User_obs_real"), prt1)
call var_list_append_uobs_int &
(var_list, var_str ("_User_obs_int"), prt1)
end subroutine var_list_set_observables_unary
subroutine var_list_set_observables_binary (var_list, prt1, prt2)
type(var_list_t), intent(inout) :: var_list
type(prt_t), intent(in), target :: prt1
type(prt_t), intent(in), optional, target :: prt2
call var_list_append_obs2_iptr &
(var_list, var_str ("PDG"), obs_pdg2, prt1, prt2)
call var_list_append_obs2_iptr &
(var_list, var_str ("Hel"), obs_helicity2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("M"), obs_signed_mass2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("M2"), obs_mass_squared2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("E"), obs_energy2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Px"), obs_px2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Py"), obs_py2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Pz"), obs_pz2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("P"), obs_p2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Pl"), obs_pl2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Pt"), obs_pt2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Theta"), obs_theta2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Phi"), obs_phi2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Rap"), obs_rap2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Eta"), obs_eta2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Theta_star"), obs_theta_star2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("Dist"), obs_dist2, prt1, prt2)
call var_list_append_obs2_rptr &
(var_list, var_str ("kT"), obs_ktmeasure, prt1, prt2)
call var_list_append_uobs_real &
(var_list, var_str ("_User_obs_real"), prt1, prt2)
call var_list_append_uobs_int &
(var_list, var_str ("_User_obs_int"), prt1, prt2)
end subroutine var_list_set_observables_binary
@ %def var_list_set_observables_unary var_list_set_observables_binary
@
\subsection{Checks}
<<Observables: public>>=
public :: var_list_check_observable
<<Observables: procedures>>=
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", "M", "M2", "E", "Px", "Py", "Pz", "P", "Pl", "Pt", &
"Theta", "Phi", "Rap", "Eta", "Theta_star", "Dist", "kT")
flag = .true.
case default
flag = .false.
end select
end function string_is_observable_id
@ %def string_is_observable_id
@ Check for result and process variables.
<<Observables: public>>=
public :: var_list_check_result_var
<<Observables: procedures>>=
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
@
\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
@
\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
@ %def obs_pdg2
@ %def obs_helicity2
@
\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
Index: trunk/src/mci/mci.nw
===================================================================
--- trunk/src/mci/mci.nw (revision 8157)
+++ trunk/src/mci/mci.nw (revision 8158)
@@ -1,14020 +1,14020 @@
%% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: integration and event generation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Multi-Channel Integration}
\includemodulegraph{mci}
The abstract representation of multi-channel
Monte Carlo algorithms for integration and event generation.
\begin{description}
\item[Module [[mci_base]]:]
The abstract types and their methods. It provides a test integrator
that is referenced in later unit tests.
\item[iterations]
Container for defining integration call and pass settings.
\item[integration\_results]
This module handles results from integrating processes. It records passes
and iterations, calculates statistical averages, and provides the user
output of integration results.
\end{description}
These are the implementations:
\begin{description}
\item[Module [[mci_midpoint]]:]
A simple integrator that uses the midpoint rule to sample the
integrand uniformly over the unit hypercube. There is only one
integration channel, so this can be matched only to single-channel
phase space.
\item[Module [[mci_vamp]]:]
Interface for the VAMP package.
\end{description}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\clearpage
\section{Generic Integrator}
This module provides a multi-channel integrator (MCI) base type, a
corresponding configuration type, and methods for integration and event
generation.
<<[[mci_base.f90]]>>=
<<File header>>
module mci_base
use kinds
use io_units
use format_utils, only: pac_fmt
use format_defs, only: FMT_14, FMT_17
use diagnostics
use cputime
use phs_base
use rng_base
<<Standard module head>>
<<MCI base: public>>
<<MCI base: types>>
<<MCI base: interfaces>>
contains
<<MCI base: procedures>>
end module mci_base
@ %def mci_base
@
\subsection{MCI: integrator}
The MCI object contains the methods for integration and event generation.
For the actual work and data storage, it spawns an MCI instance object.
The base object contains the number of integration dimensions and the number
of channels as configuration data. Further configuration data are stored in
the concrete extensions.
The MCI sum contains all relevant information about the integrand. It can be
used for comparing the current configuration against a previous one. If they
match, we can skip an actual integration. (Implemented only for the VAMP
version.)
There is a random-number generator (its state with associated methods)
available as [[rng]]. It may or may not be used for integration. It
will be used for event generation.
<<MCI base: public>>=
public :: mci_t
<<MCI base: types>>=
type, abstract :: mci_t
integer :: n_dim = 0
integer :: n_channel = 0
integer :: n_chain = 0
integer, dimension(:), allocatable :: chain
real(default), dimension(:), allocatable :: chain_weights
character(32) :: md5sum = ""
logical :: integral_known = .false.
logical :: error_known = .false.
logical :: efficiency_known = .false.
real(default) :: integral = 0
real(default) :: error = 0
real(default) :: efficiency = 0
logical :: use_timer = .false.
type(timer_t) :: timer
class(rng_t), allocatable :: rng
contains
<<MCI base: mci: TBP>>
end type mci_t
@ %def mci_t
@ Finalizer: the random-number generator may need one.
<<MCI base: mci: TBP>>=
procedure :: base_final => mci_final
procedure (mci_final), deferred :: final
<<MCI base: procedures>>=
subroutine mci_final (object)
class(mci_t), intent(inout) :: object
if (allocated (object%rng)) call object%rng%final ()
end subroutine mci_final
@ %def mci_final
@ Output: basic and extended output.
<<MCI base: mci: TBP>>=
procedure :: base_write => mci_write
procedure (mci_write), deferred :: write
<<MCI base: procedures>>=
subroutine mci_write (object, unit, pacify, md5sum_version)
class(mci_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
logical, intent(in), optional :: md5sum_version
logical :: md5sum_ver
integer :: u, i, j
character(len=7) :: fmt
call pac_fmt (fmt, FMT_17, FMT_14, pacify)
u = given_output_unit (unit)
md5sum_ver = .false.
if (present (md5sum_version)) md5sum_ver = md5sum_version
if (object%use_timer .and. .not. md5sum_ver) then
write (u, "(2x)", advance="no")
call object%timer%write (u)
end if
if (object%integral_known) then
write (u, "(3x,A," // fmt // ")") &
"Integral = ", object%integral
end if
if (object%error_known) then
write (u, "(3x,A," // fmt // ")") &
"Error = ", object%error
end if
if (object%efficiency_known) then
write (u, "(3x,A," // fmt // ")") &
"Efficiency = ", object%efficiency
end if
write (u, "(3x,A,I0)") "Number of channels = ", object%n_channel
write (u, "(3x,A,I0)") "Number of dimensions = ", object%n_dim
if (object%n_chain > 0) then
write (u, "(3x,A,I0)") "Number of chains = ", object%n_chain
write (u, "(3x,A)") "Chains:"
do i = 1, object%n_chain
write (u, "(5x,I0,':')", advance = "no") i
do j = 1, object%n_channel
if (object%chain(j) == i) &
write (u, "(1x,I0)", advance = "no") j
end do
write (u, "(A)")
end do
end if
end subroutine mci_write
@ %def mci_write
@ Print an informative message when starting integration.
<<MCI base: mci: TBP>>=
procedure (mci_startup_message), deferred :: startup_message
procedure :: base_startup_message => mci_startup_message
<<MCI base: procedures>>=
subroutine mci_startup_message (mci, unit, n_calls)
class(mci_t), intent(in) :: mci
integer, intent(in), optional :: unit, n_calls
if (mci%n_chain > 0) then
write (msg_buffer, "(A,3(1x,I0,1x,A))") &
"Integrator:", mci%n_chain, "chains,", &
mci%n_channel, "channels,", &
mci%n_dim, "dimensions"
else
write (msg_buffer, "(A,3(1x,I0,1x,A))") &
"Integrator:", &
mci%n_channel, "channels,", &
mci%n_dim, "dimensions"
end if
call msg_message (unit = unit)
end subroutine mci_startup_message
@ %def mci_startup_message
@ Dump type-specific info to a logfile.
<<MCI base: mci: TBP>>=
procedure(mci_write_log_entry), deferred :: write_log_entry
<<MCI base: interfaces>>=
abstract interface
subroutine mci_write_log_entry (mci, u)
import
class(mci_t), intent(in) :: mci
integer, intent(in) :: u
end subroutine mci_write_log_entry
end interface
@ %def mci_write_log_entry
In order to avoid dependencies on definite MCI implementations,
we introduce a MD5 sum calculator.
<<MCI base: mci: TBP>>=
procedure(mci_compute_md5sum), deferred :: compute_md5sum
<<MCI base: interfaces>>=
abstract interface
subroutine mci_compute_md5sum (mci, pacify)
import
class(mci_t), intent(inout) :: mci
logical, intent(in), optional :: pacify
end subroutine mci_compute_md5sum
end interface
@ %def mci_compute_md5sum@
@ Record the index of the MCI object within a process. For
multi-component processes with more than one integrator, the
integrator should know about its own index, so file names can be
unique, etc. The default implementation does nothing, however.
<<MCI base: mci: TBP>>=
procedure :: record_index => mci_record_index
<<MCI base: procedures>>=
subroutine mci_record_index (mci, i_mci)
class(mci_t), intent(inout) :: mci
integer, intent(in) :: i_mci
end subroutine mci_record_index
@ %def mci_record_index
@ There is no Initializer for the abstract type, but a generic setter
for the number of channels and dimensions. We make two aliases
available, to be able to override it.
<<MCI base: mci: TBP>>=
procedure :: set_dimensions => mci_set_dimensions
procedure :: base_set_dimensions => mci_set_dimensions
<<MCI base: procedures>>=
subroutine mci_set_dimensions (mci, n_dim, n_channel)
class(mci_t), intent(inout) :: mci
integer, intent(in) :: n_dim
integer, intent(in) :: n_channel
mci%n_dim = n_dim
mci%n_channel = n_channel
end subroutine mci_set_dimensions
@ %def mci_set_dimensions
@ Declare particular dimensions as flat. This information can be used
to simplify integration. When generating events, the flat dimensions
should be sampled with uniform and uncorrelated distribution. It
depends on the integrator what to do with that information.
<<MCI base: mci: TBP>>=
procedure (mci_declare_flat_dimensions), deferred :: declare_flat_dimensions
<<MCI base: interfaces>>=
abstract interface
subroutine mci_declare_flat_dimensions (mci, dim_flat)
import
class(mci_t), intent(inout) :: mci
integer, dimension(:), intent(in) :: dim_flat
end subroutine mci_declare_flat_dimensions
end interface
@ %def mci_declare_flat_dimensions
@ Declare particular channels as equivalent, possibly allowing for
permutations or reflections of dimensions. We use the information
stored in the [[phs_channel_t]] object array that the phase-space module
provides.
(We do not test this here, deferring the unit test to the [[mci_vamp]]
implementation where we actually use this feature.)
<<MCI base: mci: TBP>>=
procedure (mci_declare_equivalences), deferred :: declare_equivalences
<<MCI base: interfaces>>=
abstract interface
subroutine mci_declare_equivalences (mci, channel, dim_offset)
import
class(mci_t), intent(inout) :: mci
type(phs_channel_t), dimension(:), intent(in) :: channel
integer, intent(in) :: dim_offset
end subroutine mci_declare_equivalences
end interface
@ %def mci_declare_equivalences
@ Declare particular channels as chained together. The implementation may use
this array for keeping their weights equal to each other, etc.
The chain array is an array sized by the number of channels. For each
channel, there is an integer entry that indicates the correponding
chains. The total number of chains is the maximum value of this
entry.
<<MCI base: mci: TBP>>=
procedure :: declare_chains => mci_declare_chains
<<MCI base: procedures>>=
subroutine mci_declare_chains (mci, chain)
class(mci_t), intent(inout) :: mci
integer, dimension(:), intent(in) :: chain
allocate (mci%chain (size (chain)))
mci%n_chain = maxval (chain)
allocate (mci%chain_weights (mci%n_chain), source = 0._default)
mci%chain = chain
end subroutine mci_declare_chains
@ %def mci_declare_chains
@ Collect channel weights according to chains and store them in the
[[chain_weights]] for output. We sum up the weights for all channels that
share the same [[chain]] index and store the results in the [[chain_weights]]
array.
<<MCI base: mci: TBP>>=
procedure :: collect_chain_weights => mci_collect_chain_weights
<<MCI base: procedures>>=
subroutine mci_collect_chain_weights (mci, weight)
class(mci_t), intent(inout) :: mci
real(default), dimension(:), intent(in) :: weight
integer :: i, c
if (allocated (mci%chain)) then
mci%chain_weights = 0
do i = 1, size (mci%chain)
c = mci%chain(i)
mci%chain_weights(c) = mci%chain_weights(c) + weight(i)
end do
end if
end subroutine mci_collect_chain_weights
@ %def mci_collect_chain_weights
@ Check if there are chains.
<<MCI base: mci: TBP>>=
procedure :: has_chains => mci_has_chains
<<MCI base: procedures>>=
function mci_has_chains (mci) result (flag)
class(mci_t), intent(in) :: mci
logical :: flag
flag = allocated (mci%chain)
end function mci_has_chains
@ %def mci_has_chains
@ Output of the chain weights, kept separate from the main [[write]] method.
[The formatting will work as long as the number of chains is less than
$10^{10}$\ldots]
<<MCI base: mci: TBP>>=
procedure :: write_chain_weights => mci_write_chain_weights
<<MCI base: procedures>>=
subroutine mci_write_chain_weights (mci, unit)
class(mci_t), intent(in) :: mci
integer, intent(in), optional :: unit
integer :: u, i, n, n_digits
character(4) :: ifmt
u = given_output_unit (unit)
if (allocated (mci%chain_weights)) then
write (u, "(1x,A)") "Weights of channel chains (groves):"
n_digits = 0
n = size (mci%chain_weights)
do while (n > 0)
n = n / 10
n_digits = n_digits + 1
end do
write (ifmt, "(A1,I1)") "I", n_digits
do i = 1, size (mci%chain_weights)
write (u, "(3x," // ifmt // ",F13.10)") i, mci%chain_weights(i)
end do
end if
end subroutine mci_write_chain_weights
@ %def mci_write_chain_weights
@ Set the MD5 sum, independent of initialization.
<<MCI base: mci: TBP>>=
procedure :: set_md5sum => mci_set_md5sum
<<MCI base: procedures>>=
subroutine mci_set_md5sum (mci, md5sum)
class(mci_t), intent(inout) :: mci
character(32), intent(in) :: md5sum
mci%md5sum = md5sum
end subroutine mci_set_md5sum
@ %def mci_set_md5sum
@ Initialize a new integration pass. This is not necessarily
meaningful, so we provide an empty base method. The [[mci_vamp]]
implementation overrides this.
<<MCI base: mci: TBP>>=
procedure :: add_pass => mci_add_pass
<<MCI base: procedures>>=
subroutine mci_add_pass (mci, adapt_grids, adapt_weights, final_pass)
class(mci_t), intent(inout) :: mci
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final_pass
end subroutine mci_add_pass
@ %def mci_add_pass
@ Allocate an instance with matching type. This must be deferred.
<<MCI base: mci: TBP>>=
procedure (mci_allocate_instance), deferred :: allocate_instance
<<MCI base: interfaces>>=
abstract interface
subroutine mci_allocate_instance (mci, mci_instance)
import
class(mci_t), intent(in) :: mci
class(mci_instance_t), intent(out), pointer :: mci_instance
end subroutine mci_allocate_instance
end interface
@ %def mci_allocate_instance
@ Import a random-number generator. We transfer the allocation of an
existing generator state into the object. The generator state may
already be initialized, or we can reset it by its [[init]]
method.
<<MCI base: mci: TBP>>=
procedure :: import_rng => mci_import_rng
<<MCI base: procedures>>=
subroutine mci_import_rng (mci, rng)
class(mci_t), intent(inout) :: mci
class(rng_t), intent(inout), allocatable :: rng
call move_alloc (rng, mci%rng)
end subroutine mci_import_rng
@ %def mci_import_rng
@ Activate or deactivate the timer.
<<MCI base: mci: TBP>>=
procedure :: set_timer => mci_set_timer
<<MCI base: procedures>>=
subroutine mci_set_timer (mci, active)
class(mci_t), intent(inout) :: mci
logical, intent(in) :: active
mci%use_timer = active
end subroutine mci_set_timer
@ %def mci_set_timer
@ Start and stop signal for the timer, if active. The elapsed time
can then be retrieved from the MCI record.
<<MCI base: mci: TBP>>=
procedure :: start_timer => mci_start_timer
procedure :: stop_timer => mci_stop_timer
<<MCI base: procedures>>=
subroutine mci_start_timer (mci)
class(mci_t), intent(inout) :: mci
if (mci%use_timer) call mci%timer%start ()
end subroutine mci_start_timer
subroutine mci_stop_timer (mci)
class(mci_t), intent(inout) :: mci
if (mci%use_timer) call mci%timer%stop ()
end subroutine mci_stop_timer
@ %def mci_start_timer
@ %def mci_stop_timer
@ Sampler test. Evaluate the sampler a given number of times. Results are
discarded, so we don't need the MCI instance which would record them.
The evaluation channel is iterated, and the [[x]] parameters are randomly
chosen.
<<MCI base: mci: TBP>>=
procedure :: sampler_test => mci_sampler_test
<<MCI base: procedures>>=
subroutine mci_sampler_test (mci, sampler, n_calls)
class(mci_t), intent(inout) :: mci
class(mci_sampler_t), intent(inout), target :: sampler
integer, intent(in) :: n_calls
real(default), dimension(:), allocatable :: x_in, f
real(default), dimension(:,:), allocatable :: x_out
real(default) :: val
integer :: i, c
allocate (x_in (mci%n_dim))
allocate (f (mci%n_channel))
allocate (x_out (mci%n_dim, mci%n_channel))
do i = 1, n_calls
c = mod (i, mci%n_channel) + 1
call mci%rng%generate_array (x_in)
call sampler%evaluate (c, x_in, val, x_out, f)
end do
end subroutine mci_sampler_test
@ %def mci_sampler_test
@ Integrate: this depends on the implementation. We foresee a pacify
flag to take care of small numerical noise on different platforms.
<<MCI base: mci: TBP>>=
procedure (mci_integrate), deferred :: integrate
<<MCI base: interfaces>>=
abstract interface
subroutine mci_integrate (mci, instance, sampler, &
n_it, n_calls, results, pacify)
import
class(mci_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: pacify
class(mci_results_t), intent(inout), optional :: results
end subroutine mci_integrate
end interface
@ %def mci_integrate
@ Event generation. Depending on the implementation,
event generation may or may not require a previous integration pass.
Instead of a black-box [[simulate]] method, we require an initializer,
a finalizer, and procedures for generating a single event. This
allows us to interface simulation event by event from the outside, and
it facilitates the further processing of an event after successful
generation. For integration, this is not necessary.
The initializer has [[intent(inout)]] for the [[mci]] passed object. The
reason is that the initializer can read integration results and grids from
file, where the results can modify the [[mci]] record.
<<MCI base: mci: TBP>>=
procedure (mci_prepare_simulation), deferred :: prepare_simulation
@ %def mci_final_simulation
<<MCI base: interfaces>>=
abstract interface
subroutine mci_prepare_simulation (mci)
import
class(mci_t), intent(inout) :: mci
end subroutine mci_prepare_simulation
end interface
@ %def mci_prepare_simulation
@
The generated event will reside in in the [[instance]] object (overall
results and weight) and in the [[sampler]] object (detailed data). In
the real application, we can subsequently call methods of the
[[sampler]] in order to further process the generated event.
The [[target]] attributes are required by the VAMP implementation,
which uses pointers to refer to the instance and sampler objects from
within the integration function.
<<MCI base: mci: TBP>>=
procedure (mci_generate), deferred :: generate_weighted_event
procedure (mci_generate), deferred :: generate_unweighted_event
@ %def mci_generate_weighted_event
@ %def mci_generate_unweighted_event
<<MCI base: interfaces>>=
abstract interface
subroutine mci_generate (mci, instance, sampler)
import
class(mci_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
end subroutine mci_generate
end interface
@ %def mci_generate
@ This is analogous, but we rebuild the event from the information
stored in [[state]] instead of generating it.
Note: currently unused outside of tests, might be deleted later.
<<MCI base: mci: TBP>>=
procedure (mci_rebuild), deferred :: rebuild_event
<<MCI base: interfaces>>=
abstract interface
subroutine mci_rebuild (mci, instance, sampler, state)
import
class(mci_t), intent(inout) :: mci
class(mci_instance_t), intent(inout) :: instance
class(mci_sampler_t), intent(inout) :: sampler
class(mci_state_t), intent(in) :: state
end subroutine mci_rebuild
end interface
@ %def mci_rebuild
@
Pacify: reduce numerical noise. The base implementation does nothing.
<<MCI base: mci: TBP>>=
procedure :: pacify => mci_pacify
<<MCI base: procedures>>=
subroutine mci_pacify (object, efficiency_reset, error_reset)
class(mci_t), intent(inout) :: object
logical, intent(in), optional :: efficiency_reset, error_reset
end subroutine mci_pacify
@ %def mci_pacify
@
Return the value of the integral, error, efficiency, and time per call.
<<MCI base: mci: TBP>>=
procedure :: get_integral => mci_get_integral
procedure :: get_error => mci_get_error
procedure :: get_efficiency => mci_get_efficiency
procedure :: get_time => mci_get_time
<<MCI base: procedures>>=
function mci_get_integral (mci) result (integral)
class(mci_t), intent(in) :: mci
real(default) :: integral
if (mci%integral_known) then
integral = mci%integral
else
call msg_bug ("The integral is unknown. This is presumably a" // &
"WHIZARD bug.")
end if
end function mci_get_integral
function mci_get_error (mci) result (error)
class(mci_t), intent(in) :: mci
real(default) :: error
if (mci%error_known) then
error = mci%error
else
error = 0
end if
end function mci_get_error
function mci_get_efficiency (mci) result (efficiency)
class(mci_t), intent(in) :: mci
real(default) :: efficiency
if (mci%efficiency_known) then
efficiency = mci%efficiency
else
efficiency = 0
end if
end function mci_get_efficiency
function mci_get_time (mci) result (time)
class(mci_t), intent(in) :: mci
real(default) :: time
if (mci%use_timer) then
time = mci%timer
else
time = 0
end if
end function mci_get_time
@ %def mci_get_integral
@ %def mci_get_error
@ %def mci_get_efficiency
@ %def mci_get_time
@ Return the MD5 sum of the configuration. This may be overridden in
an extension, to return a different MD5 sum.
<<MCI base: mci: TBP>>=
procedure :: get_md5sum => mci_get_md5sum
<<MCI base: procedures>>=
pure function mci_get_md5sum (mci) result (md5sum)
class(mci_t), intent(in) :: mci
character(32) :: md5sum
md5sum = mci%md5sum
end function mci_get_md5sum
@ %def mci_get_md5sum
@
\subsection{MCI instance}
The base type contains an array of channel weights. The value [[mci_weight]]
is the combined MCI weight that corresponds to a particular sampling point.
For convenience, we also store the [[x]] and Jacobian values for this sampling
point.
<<MCI base: public>>=
public :: mci_instance_t
<<MCI base: types>>=
type, abstract :: mci_instance_t
logical :: valid = .false.
real(default), dimension(:), allocatable :: w
real(default), dimension(:), allocatable :: f
real(default), dimension(:,:), allocatable :: x
integer :: selected_channel = 0
real(default) :: mci_weight = 0
real(default) :: integrand = 0
logical :: negative_weights = .false.
contains
<<MCI base: mci instance: TBP>>
end type mci_instance_t
@ %def mci_instance_t
@ Output: deferred
<<MCI base: mci instance: TBP>>=
procedure (mci_instance_write), deferred :: write
<<MCI base: interfaces>>=
abstract interface
subroutine mci_instance_write (object, unit, pacify)
import
class(mci_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
end subroutine mci_instance_write
end interface
@ %def mci_instance_write
@ A finalizer, just in case.
<<MCI base: mci instance: TBP>>=
procedure (mci_instance_final), deferred :: final
<<MCI base: interfaces>>=
abstract interface
subroutine mci_instance_final (object)
import
class(mci_instance_t), intent(inout) :: object
end subroutine mci_instance_final
end interface
@ %def mci_instance_final
@ Init: basic initializer for the arrays, otherwise deferred. Assigning
the [[mci]] object is also deferred, because it depends on the concrete type.
The weights are initialized with an uniform normalized value.
<<MCI base: mci instance: TBP>>=
procedure (mci_instance_base_init), deferred :: init
procedure :: base_init => mci_instance_base_init
<<MCI base: procedures>>=
subroutine mci_instance_base_init (mci_instance, mci)
class(mci_instance_t), intent(out) :: mci_instance
class(mci_t), intent(in), target :: mci
allocate (mci_instance%w (mci%n_channel))
allocate (mci_instance%f (mci%n_channel))
allocate (mci_instance%x (mci%n_dim, mci%n_channel))
if (mci%n_channel > 0) then
call mci_instance%set_channel_weights &
(spread (1._default, dim=1, ncopies=mci%n_channel))
end if
mci_instance%f = 0
mci_instance%x = 0
end subroutine mci_instance_base_init
@ %def mci_instance_base_init
@ Explicitly set the array of channel weights.
<<MCI base: mci instance: TBP>>=
procedure :: set_channel_weights => mci_instance_set_channel_weights
<<MCI base: procedures>>=
subroutine mci_instance_set_channel_weights (mci_instance, weights, sum_non_zero)
class(mci_instance_t), intent(inout) :: mci_instance
real(default), dimension(:), intent(in) :: weights
logical, intent(out), optional :: sum_non_zero
real(default) :: wsum
wsum = sum (weights)
if (wsum /= 0) then
mci_instance%w = weights / wsum
if (present (sum_non_zero)) sum_non_zero = .true.
else
if (present (sum_non_zero)) sum_non_zero = .false.
call msg_warning ("MC sampler initialization:&
& sum of channel weights is zero")
end if
end subroutine mci_instance_set_channel_weights
@ %def mci_instance_set_channel_weights
@ Compute the overall weight factor for a configuration of $x$ values and
Jacobians $f$. The $x$ values come in [[n_channel]] rows with [[n_dim]]
entries each. The $f$ factors constitute an array with [[n_channel]] entries.
We assume that the $x$ and $f$ arrays are already stored inside the MC
instance. The result is also stored there.
<<MCI base: mci instance: TBP>>=
procedure (mci_instance_compute_weight), deferred :: compute_weight
<<MCI base: interfaces>>=
abstract interface
subroutine mci_instance_compute_weight (mci, c)
import
class(mci_instance_t), intent(inout) :: mci
integer, intent(in) :: c
end subroutine mci_instance_compute_weight
end interface
@ %def mci_instance_compute_weight
@ Record the integrand as returned by the sampler. Depending on the
implementation, this may merely copy the value, or do more complicated things.
We may need the MCI weight for the actual computations, so this should
be called after the previous routine.
<<MCI base: mci instance: TBP>>=
procedure (mci_instance_record_integrand), deferred :: record_integrand
<<MCI base: interfaces>>=
abstract interface
subroutine mci_instance_record_integrand (mci, integrand)
import
class(mci_instance_t), intent(inout) :: mci
real(default), intent(in) :: integrand
end subroutine mci_instance_record_integrand
end interface
@ %def mci_instance_record_integrand
@ Sample a point directly: evaluate the sampler, then compute the weight and
the weighted integrand. Finally, record the integrand within the MCI instance.
If a signal (interrupt) was raised recently, we abort the calculation before
entering the sampler. Thus, a previous calculation will have
completed and any data are already recorded, but any new point can be
discarded. If the [[abort]] flag is present, we may delay the interrupt, so
we can do some cleanup.
<<MCI base: mci instance: TBP>>=
procedure :: evaluate => mci_instance_evaluate
<<MCI base: procedures>>=
subroutine mci_instance_evaluate (mci, sampler, c, x)
class(mci_instance_t), intent(inout) :: mci
class(mci_sampler_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x
real(default) :: val
call sampler%evaluate (c, x, val, mci%x, mci%f)
mci%valid = sampler%is_valid ()
if (mci%valid) then
call mci%compute_weight (c)
call mci%record_integrand (val)
end if
end subroutine mci_instance_evaluate
@ %def mci_instance_evaluate
@ Initiate and terminate simulation. In contrast to integration, we implement
these as methods of the process instance, since the [[mci]] configuration
object is unchanged.
The safety factor reduces the acceptance probability for unweighted
events. The implementation of this feature depends on the concrete type.
<<MCI base: mci instance: TBP>>=
procedure (mci_instance_init_simulation), deferred :: init_simulation
procedure (mci_instance_final_simulation), deferred :: final_simulation
<<MCI base: interfaces>>=
abstract interface
subroutine mci_instance_init_simulation (instance, safety_factor)
import
class(mci_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: safety_factor
end subroutine mci_instance_init_simulation
end interface
abstract interface
subroutine mci_instance_final_simulation (instance)
import
class(mci_instance_t), intent(inout) :: instance
end subroutine mci_instance_final_simulation
end interface
@ %def mci_instance_init_simulation mci_instance_final_simulation
@ Assuming that the sampler is in a completely defined state, just
extract the data that [[evaluate]] would compute. Also record the integrand.
<<MCI base: mci instance: TBP>>=
procedure :: fetch => mci_instance_fetch
<<MCI base: procedures>>=
subroutine mci_instance_fetch (mci, sampler, c)
class(mci_instance_t), intent(inout) :: mci
class(mci_sampler_t), intent(in) :: sampler
integer, intent(in) :: c
real(default) :: val
mci%valid = sampler%is_valid ()
if (mci%valid) then
call sampler%fetch (val, mci%x, mci%f)
call mci%compute_weight (c)
call mci%record_integrand (val)
end if
end subroutine mci_instance_fetch
@ %def mci_instance_fetch
@ The value, i.e., the weighted integrand, is the integrand (which
should be taken as-is from the sampler) multiplied by the MCI weight.
<<MCI base: mci instance: TBP>>=
procedure :: get_value => mci_instance_get_value
<<MCI base: procedures>>=
function mci_instance_get_value (mci) result (value)
class(mci_instance_t), intent(in) :: mci
real(default) :: value
if (mci%valid) then
value = mci%integrand * mci%mci_weight
else
value = 0
end if
end function mci_instance_get_value
@ %def mci_instance_get_value
@ This is an extra routine. By default, the event weight is equal to
the value returned by the previous routine. However, if we select a
channel for event generation not just based on the channel weights,
the event weight has to account for this bias, so the event weight
that applies to event generation is different. In that case, we
should override the default routine.
<<MCI base: mci instance: TBP>>=
procedure :: get_event_weight => mci_instance_get_value
@ %def mci_instance_get_event_weight
@ Excess weight can occur during unweighted event generation, if the
assumed maximum value of the integrand is too small. This excess
should be normalized in the same way as the event weight above (which
for unweighted events becomes unity).
<<MCI base: mci instance: TBP>>=
procedure (mci_instance_get_event_excess), deferred :: get_event_excess
<<MCI base: interfaces>>=
abstract interface
function mci_instance_get_event_excess (mci) result (excess)
import
class(mci_instance_t), intent(in) :: mci
real(default) :: excess
end function mci_instance_get_event_excess
end interface
@ %def mci_instance_get_event_excess
@
\subsection{MCI state}
This object can hold the relevant information that allows us to
reconstruct the MCI instance without re-evaluating the sampler completely.
We store the [[x_in]] MC input parameter set, which coincides with the
section of the complete [[x]] array that belongs to a particular
channel. We also store the MC function value. When we want to
reconstruct the state, we can use the input array to recover the
complete [[x]] and [[f]] arrays (i.e., the kinematics), but do not
need to recompute the MC function value (the dynamics).
The [[mci_state_t]] may be extended, to allow storing/recalling more
information. In that case, we would override the type-bound
procedures. However, the base type is also a concrete type and
self-contained.
<<MCI base: public>>=
public :: mci_state_t
<<MCI base: types>>=
type :: mci_state_t
integer :: selected_channel = 0
real(default), dimension(:), allocatable :: x_in
real(default) :: val
contains
<<MCI base: mci state: TBP>>
end type mci_state_t
@ %def mci_state_t
@ Output:
<<MCI base: mci state: TBP>>=
procedure :: write => mci_state_write
<<MCI base: procedures>>=
subroutine mci_state_write (object, unit)
class(mci_state_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "MCI state:"
write (u, "(3x,A,I0)") "Channel = ", object%selected_channel
write (u, "(3x,A,999(1x,F12.10))") "x (in) =", object%x_in
write (u, "(3x,A,ES19.12)") "Integrand = ", object%val
end subroutine mci_state_write
@ %def mci_state_write
@ To store the object, we take the relevant section of the [[x]]
array. The channel used for storing data is taken from the
[[instance]] object, but it could be arbitrary in principle.
<<MCI base: mci instance: TBP>>=
procedure :: store => mci_instance_store
<<MCI base: procedures>>=
subroutine mci_instance_store (mci, state)
class(mci_instance_t), intent(in) :: mci
class(mci_state_t), intent(out) :: state
state%selected_channel = mci%selected_channel
allocate (state%x_in (size (mci%x, 1)))
state%x_in = mci%x(:,mci%selected_channel)
state%val = mci%integrand
end subroutine mci_instance_store
@ %def mci_instance_store
@ Recalling the state, we must consult the sampler in order to fully
reconstruct the [[x]] and [[f]] arrays. The integrand value is known,
and we also give it to the sampler, bypassing evaluation.
The final steps are equivalent to the [[evaluate]] method above.
<<MCI base: mci instance: TBP>>=
procedure :: recall => mci_instance_recall
<<MCI base: procedures>>=
subroutine mci_instance_recall (mci, sampler, state)
class(mci_instance_t), intent(inout) :: mci
class(mci_sampler_t), intent(inout) :: sampler
class(mci_state_t), intent(in) :: state
if (size (state%x_in) == size (mci%x, 1) &
.and. state%selected_channel <= size (mci%x, 2)) then
call sampler%rebuild (state%selected_channel, &
state%x_in, state%val, mci%x, mci%f)
call mci%compute_weight (state%selected_channel)
call mci%record_integrand (state%val)
else
call msg_fatal ("Recalling event: mismatch in channel or dimension")
end if
end subroutine mci_instance_recall
@ %def mci_instance_recall
@
\subsection{MCI sampler}
A sampler is an object that implements a multi-channel parameterization of the
unit hypercube. Specifically, it is able to compute, given a channel and a
set of $x$ MC parameter values, a the complete set of $x$ values and
associated Jacobian factors $f$ for all channels.
Furthermore, the sampler should return a single real value, the integrand, for
the given point in the hypercube.
It must implement a method [[evaluate]] for performing the above
computations.
<<MCI base: public>>=
public :: mci_sampler_t
<<MCI base: types>>=
type, abstract :: mci_sampler_t
contains
<<MCI base: mci sampler: TBP>>
end type mci_sampler_t
@ %def mci_sampler_t
@ Output, deferred to the implementation.
<<MCI base: mci sampler: TBP>>=
procedure (mci_sampler_write), deferred :: write
<<MCI base: interfaces>>=
abstract interface
subroutine mci_sampler_write (object, unit, testflag)
import
class(mci_sampler_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
end subroutine mci_sampler_write
end interface
@ %def mci_sampler_write
@ The evaluation routine. Input is the channel index [[c]] and the
one-dimensional parameter array [[x_in]]. Output are the integrand value
[[val]], the two-dimensional parameter array [[x]] and the Jacobian array
[[f]].
<<MCI base: mci sampler: TBP>>=
procedure (mci_sampler_evaluate), deferred :: evaluate
<<MCI base: interfaces>>=
abstract interface
subroutine mci_sampler_evaluate (sampler, c, x_in, val, x, f)
import
class(mci_sampler_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
end subroutine mci_sampler_evaluate
end interface
@ %def mci_sampler_evaluate
@ Query the validity of the sampling point. Can be called after
[[evaluate]].
<<MCI base: mci sampler: TBP>>=
procedure (mci_sampler_is_valid), deferred :: is_valid
<<MCI base: interfaces>>=
abstract interface
function mci_sampler_is_valid (sampler) result (valid)
import
class(mci_sampler_t), intent(in) :: sampler
logical :: valid
end function mci_sampler_is_valid
end interface
@ %def mci_sampler_is_valid
@ The shortcut. Again, the channel index [[c]] and the parameter
array [[x_in]] are input. However, we also provide the integrand
value [[val]], and we just require that the complete parameter array
[[x]] and Jacobian array [[f]] are recovered.
<<MCI base: mci sampler: TBP>>=
procedure (mci_sampler_rebuild), deferred :: rebuild
<<MCI base: interfaces>>=
abstract interface
subroutine mci_sampler_rebuild (sampler, c, x_in, val, x, f)
import
class(mci_sampler_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
end subroutine mci_sampler_rebuild
end interface
@ %def mci_sampler_rebuild
@ This routine should extract the important data from a sampler that
has been filled by other means. We fetch the integrand value [[val]],
the two-dimensional parameter array [[x]] and the Jacobian array [[f]].
<<MCI base: mci sampler: TBP>>=
procedure (mci_sampler_fetch), deferred :: fetch
<<MCI base: interfaces>>=
abstract interface
subroutine mci_sampler_fetch (sampler, val, x, f)
import
class(mci_sampler_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
end subroutine mci_sampler_fetch
end interface
@ %def mci_sampler_fetch
@
\subsection{Results record}
This is an abstract type which allows us to implement callback: each
integration results can optionally be recorded to an instance of this
object. The actual object may store a new result, average results,
etc. It may also display a result on-line or otherwise, whenever
the [[record]] method is called.
<<MCI base: public>>=
public :: mci_results_t
<<MCI base: types>>=
type, abstract :: mci_results_t
contains
<<MCI base: mci results: TBP>>
end type mci_results_t
@ %def mci_results_t
@ The output routine is deferred. We provide an extra [[verbose]]
flag, which could serve any purpose.
<<MCI base: mci results: TBP>>=
procedure (mci_results_write), deferred :: write
procedure (mci_results_write_verbose), deferred :: write_verbose
<<MCI base: interfaces>>=
abstract interface
subroutine mci_results_write (object, unit, suppress)
import
class(mci_results_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: suppress
end subroutine mci_results_write
subroutine mci_results_write_verbose (object, unit)
import
class(mci_results_t), intent(in) :: object
integer, intent(in), optional :: unit
end subroutine mci_results_write_verbose
end interface
@ %def mci_results_write
@ This is the generic [[record]] method, which can be called directly from the
integrator. The [[record_extended]] procedure store additionally the valid
calls, positive and negative efficiency.
<<MCI base: mci results: TBP>>=
generic :: record => record_simple, record_extended
procedure (mci_results_record_simple), deferred :: record_simple
procedure (mci_results_record_extended), deferred :: record_extended
<<MCI base: interfaces>>=
abstract interface
subroutine mci_results_record_simple (object, n_it, &
n_calls, integral, error, efficiency, chain_weights, suppress)
import
class(mci_results_t), intent(inout) :: object
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
real(default), intent(in) :: integral
real(default), intent(in) :: error
real(default), intent(in) :: efficiency
real(default), dimension(:), intent(in), optional :: chain_weights
logical, intent(in), optional :: suppress
end subroutine mci_results_record_simple
subroutine mci_results_record_extended (object, n_it, n_calls,&
& n_calls_valid, integral, error, efficiency, efficiency_pos,&
& efficiency_neg, chain_weights, suppress)
import
class(mci_results_t), intent(inout) :: object
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
integer, intent(in) :: n_calls_valid
real(default), intent(in) :: integral
real(default), intent(in) :: error
real(default), intent(in) :: efficiency
real(default), intent(in) :: efficiency_pos
real(default), intent(in) :: efficiency_neg
real(default), dimension(:), intent(in), optional :: chain_weights
logical, intent(in), optional :: suppress
end subroutine mci_results_record_extended
end interface
@ %def mci_results_record
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[mci_base_ut.f90]]>>=
<<File header>>
module mci_base_ut
use unit_tests
use mci_base_uti
<<Standard module head>>
<<MCI base: public test>>
<<MCI base: public test auxiliary>>
contains
<<MCI base: test driver>>
end module mci_base_ut
@ %def mci_base_ut
@
<<[[mci_base_uti.f90]]>>=
<<File header>>
module mci_base_uti
<<Use kinds>>
use io_units
use diagnostics
use phs_base
use rng_base
use mci_base
use rng_base_ut, only: rng_test_t
<<Standard module head>>
<<MCI base: public test auxiliary>>
<<MCI base: test declarations>>
<<MCI base: test types>>
contains
<<MCI base: tests>>
end module mci_base_uti
@ %def mci_base_ut
@ API: driver for the unit tests below.
<<MCI base: public test>>=
public :: mci_base_test
<<MCI base: test driver>>=
subroutine mci_base_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<MCI base: execute tests>>
end subroutine mci_base_test
@ %def mci_base_test
@
\subsubsection{Test implementation of the configuration type}
The concrete type contains the number of requested calls and the integral
result, to be determined.
The [[max_factor]] entry is set for the actual test integration, where the
integrand is not unity but some other constant value. This value should be
set here, such that the actual maximum of the integrand is known when
vetoing unweighted events.
<<MCI base: public test auxiliary>>=
public :: mci_test_t
<<MCI base: test types>>=
type, extends (mci_t) :: mci_test_t
integer :: divisions = 0
integer :: tries = 0
real(default) :: max_factor = 1
contains
procedure :: final => mci_test_final
procedure :: write => mci_test_write
procedure :: startup_message => mci_test_startup_message
procedure :: write_log_entry => mci_test_write_log_entry
procedure :: compute_md5sum => mci_test_compute_md5sum
procedure :: declare_flat_dimensions => mci_test_ignore_flat_dimensions
procedure :: declare_equivalences => mci_test_ignore_equivalences
procedure :: set_divisions => mci_test_set_divisions
procedure :: set_max_factor => mci_test_set_max_factor
procedure :: allocate_instance => mci_test_allocate_instance
procedure :: integrate => mci_test_integrate
procedure :: prepare_simulation => mci_test_ignore_prepare_simulation
procedure :: generate_weighted_event => mci_test_generate_weighted_event
procedure :: generate_unweighted_event => &
mci_test_generate_unweighted_event
procedure :: rebuild_event => mci_test_rebuild_event
end type mci_test_t
@ %def mci_test_t
@ Finalizer: base version is sufficient
<<MCI base: tests>>=
subroutine mci_test_final (object)
class(mci_test_t), intent(inout) :: object
call object%base_final ()
end subroutine mci_test_final
@ %def mci_test_final
@ Output: trivial
<<MCI base: tests>>=
subroutine mci_test_write (object, unit, pacify, md5sum_version)
class(mci_test_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
logical, intent(in), optional :: md5sum_version
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Test integrator:"
call object%base_write (u, pacify, md5sum_version)
if (object%divisions /= 0) then
write (u, "(3x,A,I0)") "Number of divisions = ", object%divisions
end if
if (allocated (object%rng)) call object%rng%write (u)
end subroutine mci_test_write
@ %def mci_test_write
@ Short version.
<<MCI base: tests>>=
subroutine mci_test_startup_message (mci, unit, n_calls)
class(mci_test_t), intent(in) :: mci
integer, intent(in), optional :: unit, n_calls
call mci%base_startup_message (unit = unit, n_calls = n_calls)
write (msg_buffer, "(A,1x,I0,1x,A)") &
"Integrator: Test:", mci%divisions, "divisions"
call msg_message (unit = unit)
end subroutine mci_test_startup_message
@ %def mci_test_startup_message
@ Log entry: nothing.
<<MCI base: tests>>=
subroutine mci_test_write_log_entry (mci, u)
class(mci_test_t), intent(in) :: mci
integer, intent(in) :: u
end subroutine mci_test_write_log_entry
@ %def mci_test_write_log_entry
@ Compute MD5 sum: nothing.
<<MCI base: tests>>=
subroutine mci_test_compute_md5sum (mci, pacify)
class(mci_test_t), intent(inout) :: mci
logical, intent(in), optional :: pacify
end subroutine mci_test_compute_md5sum
@ %def mci_test_compute_md5sum
@ This is a no-op for the test integrator.
<<MCI base: tests>>=
subroutine mci_test_ignore_flat_dimensions (mci, dim_flat)
class(mci_test_t), intent(inout) :: mci
integer, dimension(:), intent(in) :: dim_flat
end subroutine mci_test_ignore_flat_dimensions
@ %def mci_test_ignore_flat_dimensions
@ Ditto.
<<MCI base: tests>>=
subroutine mci_test_ignore_equivalences (mci, channel, dim_offset)
class(mci_test_t), intent(inout) :: mci
type(phs_channel_t), dimension(:), intent(in) :: channel
integer, intent(in) :: dim_offset
end subroutine mci_test_ignore_equivalences
@ %def mci_test_ignore_equivalences
@ Set the number of divisions to a nonzero value.
<<MCI base: tests>>=
subroutine mci_test_set_divisions (object, divisions)
class(mci_test_t), intent(inout) :: object
integer, intent(in) :: divisions
object%divisions = divisions
end subroutine mci_test_set_divisions
@ %def mci_test_set_divisions
@ Set the maximum factor (default is 1).
<<MCI base: tests>>=
subroutine mci_test_set_max_factor (object, max_factor)
class(mci_test_t), intent(inout) :: object
real(default), intent(in) :: max_factor
object%max_factor = max_factor
end subroutine mci_test_set_max_factor
@ %def mci_test_set_max_factor
@ Allocate instance with matching type.
<<MCI base: tests>>=
subroutine mci_test_allocate_instance (mci, mci_instance)
class(mci_test_t), intent(in) :: mci
class(mci_instance_t), intent(out), pointer :: mci_instance
allocate (mci_test_instance_t :: mci_instance)
end subroutine mci_test_allocate_instance
@ %def mci_test_allocate_instance
@ Integrate: sample at the midpoints of uniform bits and add the results.
We implement this for one and for two dimensions. In the latter case,
we scan over two channels and multiply with the channel weights.
The arguments [[n_it]] and [[n_calls]] are ignored in this implementations.
The test integrator does not set error or efficiency, so those will
remain undefined.
<<MCI base: tests>>=
subroutine mci_test_integrate (mci, instance, sampler, &
n_it, n_calls, results, pacify)
class(mci_test_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: pacify
class(mci_results_t), intent(inout), optional :: results
real(default), dimension(:), allocatable :: integral
real(default), dimension(:), allocatable :: x
integer :: i, j, c
select type (instance)
type is (mci_test_instance_t)
allocate (integral (mci%n_channel))
integral = 0
allocate (x (mci%n_dim))
select case (mci%n_dim)
case (1)
do c = 1, mci%n_channel
do i = 1, mci%divisions
x(1) = (i - 0.5_default) / mci%divisions
call instance%evaluate (sampler, c, x)
integral(c) = integral(c) + instance%get_value ()
end do
end do
mci%integral = dot_product (instance%w, integral) &
/ mci%divisions
mci%integral_known = .true.
case (2)
do c = 1, mci%n_channel
do i = 1, mci%divisions
x(1) = (i - 0.5_default) / mci%divisions
do j = 1, mci%divisions
x(2) = (j - 0.5_default) / mci%divisions
call instance%evaluate (sampler, c, x)
integral(c) = integral(c) + instance%get_value ()
end do
end do
end do
mci%integral = dot_product (instance%w, integral) &
/ mci%divisions / mci%divisions
mci%integral_known = .true.
end select
if (present (results)) then
call results%record (n_it, n_calls, &
mci%integral, mci%error, &
efficiency = 0._default)
end if
end select
end subroutine mci_test_integrate
@ %def mci_test_integrate
@ Simulation initializer and finalizer: nothing to do here.
<<MCI base: tests>>=
subroutine mci_test_ignore_prepare_simulation (mci)
class(mci_test_t), intent(inout) :: mci
end subroutine mci_test_ignore_prepare_simulation
@ %def mci_test_ignore_prepare_simulation
@ Event generator. We use mock random numbers for first selecting the
channel and then setting the $x$ values. The results reside in the
state of [[instance]] and [[sampler]].
<<MCI base: tests>>=
subroutine mci_test_generate_weighted_event (mci, instance, sampler)
class(mci_test_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
real(default) :: r
real(default), dimension(:), allocatable :: x
integer :: c
select type (instance)
type is (mci_test_instance_t)
allocate (x (mci%n_dim))
select case (mci%n_channel)
case (1)
c = 1
call mci%rng%generate (x(1))
case (2)
call mci%rng%generate (r)
if (r < instance%w(1)) then
c = 1
else
c = 2
end if
call mci%rng%generate (x)
end select
call instance%evaluate (sampler, c, x)
end select
end subroutine mci_test_generate_weighted_event
@ %def mci_test_generate_weighted_event
@ For unweighted events, we generate weighted events and apply a
simple rejection step to the relative event weight, until an event passes.
(This might result in an endless loop if we happen to be in sync with
the mock random generator cycle. Therefore, limit the number of tries.)
<<MCI base: tests>>=
subroutine mci_test_generate_unweighted_event (mci, instance, sampler)
class(mci_test_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
real(default) :: r
integer :: i
select type (instance)
type is (mci_test_instance_t)
mci%tries = 0
do i = 1, 10
call mci%generate_weighted_event (instance, sampler)
mci%tries = mci%tries + 1
call mci%rng%generate (r)
if (r < instance%rel_value) exit
end do
end select
end subroutine mci_test_generate_unweighted_event
@ %def mci_test_generate_unweighted_event
@ Here, we rebuild the event from the state without consulting the rng.
<<MCI base: tests>>=
subroutine mci_test_rebuild_event (mci, instance, sampler, state)
class(mci_test_t), intent(inout) :: mci
class(mci_instance_t), intent(inout) :: instance
class(mci_sampler_t), intent(inout) :: sampler
class(mci_state_t), intent(in) :: state
select type (instance)
type is (mci_test_instance_t)
call instance%recall (sampler, state)
end select
end subroutine mci_test_rebuild_event
@ %def mci_test_rebuild_event
@
\subsubsection{Instance of the test MCI type}
This instance type simulates the VAMP approach. We implement the VAMP
multi-channel formula, but keep the channel-specific probability
functions $g_i$ smooth and fixed. We also keep the weights fixed.
The setup is as follows: we have $n$ mappings of the unit hypercube
\begin{equation}
x = x (x^{(k)}) \qquad \text{where $x=(x_1,\ldots)$}.
\end{equation}
The Jacobian factors are the determinants
\begin{equation}
f^{(k)}(x^{(k)}) = \left|\frac{\partial x}{\partial x^{(k)}}\right|
\end{equation}
We introduce arbitrary probability functions
\begin{equation}
g^{(k)}(x^{(k)}) \qquad
\text{with}\quad \int dx^{(k)} g^{(k)}(x^{(k)}) = 1
\end{equation}
and weights
\begin{equation}
w_k \qquad \text{with}\quad \sum_k w_k = 1
\end{equation}
and construct the joint probability function
\begin{equation}
g(x) = \sum_k w_k\frac{g^{(k)}(x^{(k)}(x))}{f^{(k)}(x^{(k)}(x))}
\end{equation}
which also satisfies
\begin{equation}
\int g(x)\,dx = 1.
\end{equation}
The algorithm implements a resolution of unity as follows
\begin{align}
1 &= \int dx = \int\frac{g(x)}{g(x)} dx
\nonumber\\
&= \sum w_k \int \frac{g^{(k)}(x^{(k)}(x))}{f^{(k)}(x^{(k)}(x))}
\,\frac{dx}{g(x)}
\nonumber\\
&= \sum w_k \int g^{(k)}(x^{(k)}) \frac{dx^{(k)}}{g(x(x^{(k)}))}
\end{align}
where each of the integrals in the sum is evaluated using the
channel-specific variables $x^{(k)}$.
We provide two examples: (1) trivial with one channel, one dimension,
and all functions unity and (2) two channels and two dimensions with
\begin{align}
x (x^{(1)}) &= (x^{(1)}_1, x^{(1)}_2)
\nonumber\\
x (x^{(2)}) &= (x^{(2)}_1{}^2, x^{(2)}_2)
\end{align}
hence
\begin{align}
f^{(1)}&\equiv 1,
&f^{(2)}(x^{(2)}) &= 2x^{(2)}_1
\end{align}
The probability functions are
\begin{align}
g^{(1)}&\equiv 1,
&g^{(2)}(x^{(2)}) = 2 x^{(2)}_2
\end{align}
In the concrete implementation of the integrator instance we store
values for the channel probabilities $g_i$ and the accumulated
probability $g$.
We also store the result (product of integrand and MCI weight), the
expected maximum for the result in each channel.
<<XXX MCI base: public>>=
public :: mci_test_instance_t
<<MCI base: test types>>=
type, extends (mci_instance_t) :: mci_test_instance_t
type(mci_test_t), pointer :: mci => null ()
real(default) :: g = 0
real(default), dimension(:), allocatable :: gi
real(default) :: value = 0
real(default) :: rel_value = 0
real(default), dimension(:), allocatable :: max
contains
procedure :: write => mci_test_instance_write
procedure :: final => mci_test_instance_final
procedure :: init => mci_test_instance_init
procedure :: compute_weight => mci_test_instance_compute_weight
procedure :: record_integrand => mci_test_instance_record_integrand
procedure :: init_simulation => mci_test_instance_init_simulation
procedure :: final_simulation => mci_test_instance_final_simulation
procedure :: get_event_excess => mci_test_instance_get_event_excess
end type mci_test_instance_t
@ %def mci_test_instance_t
@ Output: trivial
<<MCI base: tests>>=
subroutine mci_test_instance_write (object, unit, pacify)
class(mci_test_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
integer :: u, c
u = given_output_unit (unit)
write (u, "(1x,A,ES13.7)") "Result value = ", object%value
write (u, "(1x,A,ES13.7)") "Rel. weight = ", object%rel_value
write (u, "(1x,A,ES13.7)") "Integrand = ", object%integrand
write (u, "(1x,A,ES13.7)") "MCI weight = ", object%mci_weight
write (u, "(3x,A,I0)") "c = ", object%selected_channel
write (u, "(3x,A,ES13.7)") "g = ", object%g
write (u, "(1x,A)") "Channel parameters:"
do c = 1, object%mci%n_channel
write (u, "(1x,I0,A,4(1x,ES13.7))") c, ": w/f/g/m =", &
object%w(c), object%f(c), object%gi(c), object%max(c)
write (u, "(4x,A,9(1x,F9.7))") "x =", object%x(:,c)
end do
end subroutine mci_test_instance_write
@ %def mci_test_instance_write
@ The finalizer is empty.
<<MCI base: tests>>=
subroutine mci_test_instance_final (object)
class(mci_test_instance_t), intent(inout) :: object
end subroutine mci_test_instance_final
@ %def mci_test_instance_final
@ Initializer. We make use of the analytical result that the maximum of
the weighted integrand, in each channel, is equal to $1$
(one-dimensional case) and $2$ (two-dimensional case), respectively.
<<MCI base: tests>>=
subroutine mci_test_instance_init (mci_instance, mci)
class(mci_test_instance_t), intent(out) :: mci_instance
class(mci_t), intent(in), target :: mci
call mci_instance%base_init (mci)
select type (mci)
type is (mci_test_t)
mci_instance%mci => mci
end select
allocate (mci_instance%gi (mci%n_channel))
mci_instance%gi = 0
allocate (mci_instance%max (mci%n_channel))
select case (mci%n_channel)
case (1)
mci_instance%max = 1._default
case (2)
mci_instance%max = 2._default
end select
end subroutine mci_test_instance_init
@ %def mci_test_instance_init
@ Compute weight: we implement the VAMP multi-channel formula. The channel
probabilities [[gi]] are predefined functions.
<<MCI base: tests>>=
subroutine mci_test_instance_compute_weight (mci, c)
class(mci_test_instance_t), intent(inout) :: mci
integer, intent(in) :: c
integer :: i
mci%selected_channel = c
select case (mci%mci%n_dim)
case (1)
mci%gi(1) = 1
case (2)
mci%gi(1) = 1
mci%gi(2) = 2 * mci%x(2,2)
end select
mci%g = 0
do i = 1, mci%mci%n_channel
mci%g = mci%g + mci%w(i) * mci%gi(i) / mci%f(i)
end do
mci%mci_weight = mci%gi(c) / mci%g
end subroutine mci_test_instance_compute_weight
@ %def mci_test_instance_compute_weight
@ Record the integrand. Apply the Jacobian weight to get the absolute value.
Divide by the channel maximum and by any overall factor to get the value
relative to the maximum.
<<MCI base: tests>>=
subroutine mci_test_instance_record_integrand (mci, integrand)
class(mci_test_instance_t), intent(inout) :: mci
real(default), intent(in) :: integrand
mci%integrand = integrand
mci%value = mci%integrand * mci%mci_weight
mci%rel_value = mci%value / mci%max(mci%selected_channel) &
/ mci%mci%max_factor
end subroutine mci_test_instance_record_integrand
@ %def mci_test_instance_record_integrand
@ Nothing to do here.
<<MCI base: tests>>=
subroutine mci_test_instance_init_simulation (instance, safety_factor)
class(mci_test_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: safety_factor
end subroutine mci_test_instance_init_simulation
subroutine mci_test_instance_final_simulation (instance)
class(mci_test_instance_t), intent(inout) :: instance
end subroutine mci_test_instance_final_simulation
@ %def mci_test_instance_init_simulation
@ %def mci_test_instance_final_simulation
@ Return always zero.
<<MCI base: tests>>=
function mci_test_instance_get_event_excess (mci) result (excess)
class(mci_test_instance_t), intent(in) :: mci
real(default) :: excess
excess = 0
end function mci_test_instance_get_event_excess
@ %def mci_test_instance_get_event_excess
@
\subsubsection{Test sampler}
The test sampler implements a fixed configuration, either trivial
(one-channel, one-dimension), or slightly nontrivial (two-channel,
two-dimension). In the second channel, the first parameter is mapped
according to $x_1 = x^{(2)}_1{}^2$, so we have $f^{(2)}(x^{(2)}) =
2x^{(2)}_1$.
For display purposes, we store the return values inside the object. This is
not strictly necessary.
<<MCI base: test types>>=
type, extends (mci_sampler_t) :: test_sampler_t
real(default) :: integrand = 0
integer :: selected_channel = 0
real(default), dimension(:,:), allocatable :: x
real(default), dimension(:), allocatable :: f
contains
procedure :: init => test_sampler_init
procedure :: write => test_sampler_write
procedure :: compute => test_sampler_compute
procedure :: is_valid => test_sampler_is_valid
procedure :: evaluate => test_sampler_evaluate
procedure :: rebuild => test_sampler_rebuild
procedure :: fetch => test_sampler_fetch
end type test_sampler_t
@ %def test_sampler_t
<<MCI base: tests>>=
subroutine test_sampler_init (sampler, n)
class(test_sampler_t), intent(out) :: sampler
integer, intent(in) :: n
allocate (sampler%x (n, n))
allocate (sampler%f (n))
end subroutine test_sampler_init
@ %def test_sampler_init
@ Output
<<MCI base: tests>>=
subroutine test_sampler_write (object, unit, testflag)
class(test_sampler_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, c
u = given_output_unit (unit)
write (u, "(1x,A)") "Test sampler:"
write (u, "(3x,A,ES13.7)") "Integrand = ", object%integrand
write (u, "(3x,A,I0)") "Channel = ", object%selected_channel
do c = 1, size (object%f)
write (u, "(1x,I0,':',1x,A,ES13.7)") c, "f = ", object%f(c)
write (u, "(4x,A,9(1x,F9.7))") "x =", object%x(:,c)
end do
end subroutine test_sampler_write
@ %def test_sampler_write
@ Compute $x$ and Jacobians, given the input parameter array. This is called
both by [[evaluate]] and [[rebuild]].
<<MCI base: tests>>=
subroutine test_sampler_compute (sampler, c, x_in)
class(test_sampler_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
sampler%selected_channel = c
select case (size (sampler%f))
case (1)
sampler%x(:,1) = x_in
sampler%f = 1
case (2)
select case (c)
case (1)
sampler%x(:,1) = x_in
sampler%x(1,2) = sqrt (x_in(1))
sampler%x(2,2) = x_in(2)
case (2)
sampler%x(1,1) = x_in(1) ** 2
sampler%x(2,1) = x_in(2)
sampler%x(:,2) = x_in
end select
sampler%f(1) = 1
sampler%f(2) = 2 * sampler%x(1,2)
end select
end subroutine test_sampler_compute
@ %def test_sampler_kineamtics
@ The point is always valid.
<<MCI base: tests>>=
function test_sampler_is_valid (sampler) result (valid)
class(test_sampler_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_is_valid
@ %def test_sampler_is_valid
@ The integrand is always equal to 1.
<<MCI base: tests>>=
subroutine test_sampler_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%compute (c, x_in)
sampler%integrand = 1
val = sampler%integrand
x = sampler%x
f = sampler%f
end subroutine test_sampler_evaluate
@ %def test_sampler_evaluate
@ Construct kinematics from the input $x$ array. Set the integrand
instead of evaluating it.
<<MCI base: tests>>=
subroutine test_sampler_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%compute (c, x_in)
sampler%integrand = val
x = sampler%x
f = sampler%f
end subroutine test_sampler_rebuild
@ %def test_sampler_rebuild
@ Recall contents.
<<MCI base: tests>>=
subroutine test_sampler_fetch (sampler, val, x, f)
class(test_sampler_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%integrand
x = sampler%x
f = sampler%f
end subroutine test_sampler_fetch
@ %def test_sampler_fetch
@
\subsubsection{Test results object}
This mock object just stores and displays the current result.
<<MCI base: test types>>=
type, extends (mci_results_t) :: mci_test_results_t
integer :: n_it = 0
integer :: n_calls = 0
real(default) :: integral = 0
real(default) :: error = 0
real(default) :: efficiency = 0
contains
<<MCI base: mci test results: TBP>>
end type mci_test_results_t
@ %def mci_test_results_t
@ Output.
<<MCI base: mci test results: TBP>>=
procedure :: write => mci_test_results_write
procedure :: write_verbose => mci_test_results_write_verbose
<<MCI base: tests>>=
subroutine mci_test_results_write (object, unit, suppress)
class(mci_test_results_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: suppress
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,1x,I0)") "Iterations = ", object%n_it
write (u, "(3x,A,1x,I0)") "Calls = ", object%n_calls
write (u, "(3x,A,1x,F12.10)") "Integral = ", object%integral
write (u, "(3x,A,1x,F12.10)") "Error = ", object%error
write (u, "(3x,A,1x,F12.10)") "Efficiency = ", object%efficiency
end subroutine mci_test_results_write
subroutine mci_test_results_write_verbose (object, unit)
class(mci_test_results_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,1x,I0)") "Iterations = ", object%n_it
write (u, "(3x,A,1x,I0)") "Calls = ", object%n_calls
write (u, "(3x,A,1x,F12.10)") "Integral = ", object%integral
write (u, "(3x,A,1x,F12.10)") "Error = ", object%error
write (u, "(3x,A,1x,F12.10)") "Efficiency = ", object%efficiency
end subroutine mci_test_results_write_verbose
@ %def mci_test_results_write
@ Record result.
<<MCI base: mci test results: TBP>>=
procedure :: record_simple => mci_test_results_record_simple
procedure :: record_extended => mci_test_results_record_extended
<<MCI base: tests>>=
subroutine mci_test_results_record_simple (object, n_it, n_calls, &
integral, error, efficiency, chain_weights, suppress)
class(mci_test_results_t), intent(inout) :: object
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
real(default), intent(in) :: integral
real(default), intent(in) :: error
real(default), intent(in) :: efficiency
real(default), dimension(:), intent(in), optional :: chain_weights
logical, intent(in), optional :: suppress
object%n_it = n_it
object%n_calls = n_calls
object%integral = integral
object%error = error
object%efficiency = efficiency
end subroutine mci_test_results_record_simple
subroutine mci_test_results_record_extended (object, n_it, n_calls, &
& n_calls_valid, integral, error, efficiency, efficiency_pos, &
& efficiency_neg, chain_weights, suppress)
class(mci_test_results_t), intent(inout) :: object
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
integer, intent(in) :: n_calls_valid
real(default), intent(in) :: integral
real(default), intent(in) :: error
real(default), intent(in) :: efficiency
real(default), intent(in) :: efficiency_pos
real(default), intent(in) :: efficiency_neg
real(default), dimension(:), intent(in), optional :: chain_weights
logical, intent(in), optional :: suppress
object%n_it = n_it
object%n_calls = n_calls
object%integral = integral
object%error = error
object%efficiency = efficiency
end subroutine mci_test_results_record_extended
@ %def mci_test_results_record
@
\subsubsection{Integrator configuration data}
Construct and display a test integrator configuration object.
<<MCI base: execute tests>>=
call test (mci_base_1, "mci_base_1", &
"integrator configuration", &
u, results)
<<MCI base: test declarations>>=
public :: mci_base_1
<<MCI base: tests>>=
subroutine mci_base_1 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
real(default) :: integrand
write (u, "(A)") "* Test output: mci_base_1"
write (u, "(A)") "* Purpose: initialize and display &
&test integrator"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_test_t :: mci)
call mci%set_dimensions (2, 2)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_t :: sampler)
select type (sampler)
type is (test_sampler_t)
call sampler%init (2)
end select
write (u, "(A)") "* Evaluate sampler for given point and channel"
write (u, "(A)")
call sampler%evaluate (1, [0.25_default, 0.8_default], &
integrand, mci_instance%x, mci_instance%f)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute MCI weight"
write (u, "(A)")
call mci_instance%compute_weight (1)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Get integrand and compute weight for another point"
write (u, "(A)")
call mci_instance%evaluate (sampler, 2, [0.5_default, 0.6_default])
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Recall results, again"
write (u, "(A)")
call mci_instance%final ()
deallocate (mci_instance)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
call mci_instance%fetch (sampler, 2)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Retrieve value"
write (u, "(A)")
write (u, "(1x,A,ES13.7)") "Weighted integrand = ", &
mci_instance%get_value ()
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_base_1"
end subroutine mci_base_1
@ %def mci_base_1
@
\subsubsection{Trivial integral}
Use the MCI approach to compute a trivial one-dimensional integral.
<<MCI base: execute tests>>=
call test (mci_base_2, "mci_base_2", &
"integration", &
u, results)
<<MCI base: test declarations>>=
public :: mci_base_2
<<MCI base: tests>>=
subroutine mci_base_2 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
write (u, "(A)") "* Test output: mci_base_2"
write (u, "(A)") "* Purpose: perform a test integral"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_test_t :: mci)
call mci%set_dimensions (1, 1)
select type (mci)
type is (mci_test_t)
call mci%set_divisions (10)
end select
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_t :: sampler)
select type (sampler)
type is (test_sampler_t)
call sampler%init (1)
end select
write (u, "(A)") "* Integrate"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 0, 0)
call mci%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_base_2"
end subroutine mci_base_2
@ %def mci_base_2
@
\subsubsection{Nontrivial integral}
Use the MCI approach to compute a simple two-dimensional integral with
two channels.
<<MCI base: execute tests>>=
call test (mci_base_3, "mci_base_3", &
"integration (two channels)", &
u, results)
<<MCI base: test declarations>>=
public :: mci_base_3
<<MCI base: tests>>=
subroutine mci_base_3 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
write (u, "(A)") "* Test output: mci_base_3"
write (u, "(A)") "* Purpose: perform a nontrivial test integral"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_test_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_test_t)
call mci%set_divisions (10)
end select
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_t :: sampler)
select type (sampler)
type is (test_sampler_t)
call sampler%init (2)
end select
write (u, "(A)") "* Integrate"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 0, 0)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with higher resolution"
write (u, "(A)")
select type (mci)
type is (mci_test_t)
call mci%set_divisions (100)
end select
call mci%integrate (mci_instance, sampler, 0, 0)
call mci%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_base_3"
end subroutine mci_base_3
@ %def mci_base_3
@
\subsubsection{Event generation}
We generate ``random'' events, one weighted and one unweighted. The
test implementation does not require an integration pass, we can
generate events immediately.
<<MCI base: execute tests>>=
call test (mci_base_4, "mci_base_4", &
"event generation (two channels)", &
u, results)
<<MCI base: test declarations>>=
public :: mci_base_4
<<MCI base: tests>>=
subroutine mci_base_4 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_base_4"
write (u, "(A)") "* Purpose: generate events"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, instance, sampler"
write (u, "(A)")
allocate (mci_test_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_test_t)
call mci%set_divisions (10)
end select
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_t :: sampler)
select type (sampler)
type is (test_sampler_t)
call sampler%init (2)
end select
allocate (rng_test_t :: rng)
call mci%import_rng (rng)
write (u, "(A)") "* Generate weighted event"
write (u, "(A)")
call mci%generate_weighted_event (mci_instance, sampler)
call sampler%write (u)
write (u, *)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate unweighted event"
write (u, "(A)")
call mci%generate_unweighted_event (mci_instance, sampler)
select type (mci)
type is (mci_test_t)
write (u, "(A,I0)") " Success in try ", mci%tries
write (u, "(A)")
end select
call sampler%write (u)
write (u, *)
call mci_instance%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_base_4"
end subroutine mci_base_4
@ %def mci_base_4
@
\subsubsection{Store and recall data}
We generate an event and store the relevant data, i.e., the input
parameters and the result value for a particular channel. Then we use
those data to recover the event, as far as the MCI record is concerned.
<<MCI base: execute tests>>=
call test (mci_base_5, "mci_base_5", &
"store and recall", &
u, results)
<<MCI base: test declarations>>=
public :: mci_base_5
<<MCI base: tests>>=
subroutine mci_base_5 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
class(mci_state_t), allocatable :: state
write (u, "(A)") "* Test output: mci_base_5"
write (u, "(A)") "* Purpose: store and recall an event"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, instance, sampler"
write (u, "(A)")
allocate (mci_test_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_test_t)
call mci%set_divisions (10)
end select
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_t :: sampler)
select type (sampler)
type is (test_sampler_t)
call sampler%init (2)
end select
allocate (rng_test_t :: rng)
call mci%import_rng (rng)
write (u, "(A)") "* Generate weighted event"
write (u, "(A)")
call mci%generate_weighted_event (mci_instance, sampler)
call sampler%write (u)
write (u, *)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Store data"
write (u, "(A)")
allocate (state)
call mci_instance%store (state)
call mci_instance%final ()
deallocate (mci_instance)
call state%write (u)
write (u, "(A)")
write (u, "(A)") "* Recall data and rebuild event"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
call mci%rebuild_event (mci_instance, sampler, state)
call sampler%write (u)
write (u, *)
call mci_instance%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_base_5"
end subroutine mci_base_5
@ %def mci_base_5
@
\subsubsection{Chained channels}
Chain channels together. In the base configuration, this just fills entries
in an extra array (each channel may belong to a chain). In type
implementations, this will be used for grouping equivalent channels by keeping
their weights equal.
<<MCI base: execute tests>>=
call test (mci_base_6, "mci_base_6", &
"chained channels", &
u, results)
<<MCI base: test declarations>>=
public :: mci_base_6
<<MCI base: tests>>=
subroutine mci_base_6 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
write (u, "(A)") "* Test output: mci_base_6"
write (u, "(A)") "* Purpose: initialize and display &
&test integrator with chains"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_test_t :: mci)
call mci%set_dimensions (1, 5)
write (u, "(A)") "* Introduce chains"
write (u, "(A)")
call mci%declare_chains ([1, 2, 2, 1, 2])
call mci%write (u)
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_base_6"
end subroutine mci_base_6
@ %def mci_base_6
@
\subsubsection{Recording results}
Compute a simple two-dimensional integral and record the result.
<<MCI base: execute tests>>=
call test (mci_base_7, "mci_base_7", &
"recording results", &
u, results)
<<MCI base: test declarations>>=
public :: mci_base_7
<<MCI base: tests>>=
subroutine mci_base_7 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(mci_results_t), allocatable :: results
write (u, "(A)") "* Test output: mci_base_7"
write (u, "(A)") "* Purpose: perform a nontrivial test integral &
&and record results"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_test_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_test_t)
call mci%set_divisions (10)
end select
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_t :: sampler)
select type (sampler)
type is (test_sampler_t)
call sampler%init (2)
end select
allocate (mci_test_results_t :: results)
write (u, "(A)") "* Integrate"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 1, 1000, results)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Display results"
write (u, "(A)")
call results%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_base_7"
end subroutine mci_base_7
@ %def mci_base_7
@
\subsubsection{Timer}
Simple checks for the embedded timer.
<<MCI base: execute tests>>=
call test (mci_base_8, "mci_base_8", &
"timer", &
u, results)
<<MCI base: test declarations>>=
public :: mci_base_8
<<MCI base: tests>>=
subroutine mci_base_8 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
real(default) :: dummy
write (u, "(A)") "* Test output: mci_base_8"
write (u, "(A)") "* Purpose: check timer availability"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator with timer"
write (u, "(A)")
allocate (mci_test_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_test_t)
call mci%set_divisions (10)
end select
call mci%set_timer (active = .true.)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Start timer"
write (u, "(A)")
call mci%start_timer ()
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Stop timer"
write (u, "(A)")
call mci%stop_timer ()
write (u, "(A)") " (ok)"
write (u, "(A)")
write (u, "(A)") "* Readout"
write (u, "(A)")
dummy = mci%get_time ()
write (u, "(A)") " (ok)"
write (u, "(A)")
write (u, "(A)") "* Deactivate timer"
write (u, "(A)")
call mci%set_timer (active = .false.)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_base_8"
end subroutine mci_base_8
@ %def mci_base_8
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Iterations}
This module defines a container for the list of iterations and calls, to be
submitted to integration.
<<[[iterations.f90]]>>=
<<File header>>
module iterations
<<Use kinds>>
<<Use strings>>
use io_units
use diagnostics
<<Standard module head>>
<<Iterations: public>>
<<Iterations: types>>
contains
<<Iterations: procedures>>
end module iterations
@ %def iterations
@
\subsection{The iterations list}
Each integration pass has a number of iterations and a number of calls
per iteration. The last pass produces the end result; the previous
passes are used for adaptation.
The flags [[adapt_grid]] and [[adapt_weight]] are used only if
[[custom_adaptation]] is set. Otherwise, default settings are used
that depend on the integration pass.
<<Iterations: types>>=
type :: iterations_spec_t
private
integer :: n_it = 0
integer :: n_calls = 0
logical :: custom_adaptation = .false.
logical :: adapt_grids = .false.
logical :: adapt_weights = .false.
end type iterations_spec_t
@ %def iterations_spec_t
@ We build up a list of iterations.
<<Iterations: public>>=
public :: iterations_list_t
<<Iterations: types>>=
type :: iterations_list_t
private
integer :: n_pass = 0
type(iterations_spec_t), dimension(:), allocatable :: pass
contains
<<Iterations: iterations list: TBP>>
end type iterations_list_t
@ %def iterations_list_t
@ Initialize an iterations list. For each pass, we have to specify
the number of iterations and calls. We may provide the adaption
conventions explicitly, either as character codes or as logicals.
For passes where the adaptation conventions are not specified, we use
the following default setting: adapt weights and grids for all passes
except the last one.
<<Iterations: iterations list: TBP>>=
procedure :: init => iterations_list_init
<<Iterations: procedures>>=
subroutine iterations_list_init &
(it_list, n_it, n_calls, adapt, adapt_code, adapt_grids, adapt_weights)
class(iterations_list_t), intent(inout) :: it_list
integer, dimension(:), intent(in) :: n_it, n_calls
logical, dimension(:), intent(in), optional :: adapt
type(string_t), dimension(:), intent(in), optional :: adapt_code
logical, dimension(:), intent(in), optional :: adapt_grids, adapt_weights
integer :: i
it_list%n_pass = size (n_it)
if (allocated (it_list%pass)) deallocate (it_list%pass)
allocate (it_list%pass (it_list%n_pass))
it_list%pass%n_it = n_it
it_list%pass%n_calls = n_calls
if (present (adapt)) then
it_list%pass%custom_adaptation = adapt
do i = 1, it_list%n_pass
if (adapt(i)) then
if (verify (adapt_code(i), "wg") /= 0) then
call msg_error ("iteration specification: " &
// "adaptation code letters must be 'w' or 'g'")
end if
it_list%pass(i)%adapt_grids = scan (adapt_code(i), "g") /= 0
it_list%pass(i)%adapt_weights = scan (adapt_code(i), "w") /= 0
end if
end do
else if (present (adapt_grids) .and. present (adapt_weights)) then
it_list%pass%custom_adaptation = .true.
it_list%pass%adapt_grids = adapt_grids
it_list%pass%adapt_weights = adapt_weights
end if
do i = 1, it_list%n_pass - 1
if (.not. it_list%pass(i)%custom_adaptation) then
it_list%pass(i)%adapt_grids = .true.
it_list%pass(i)%adapt_weights = .true.
end if
end do
end subroutine iterations_list_init
@ %def iterations_list_init
<<Iterations: iterations list: TBP>>=
procedure :: clear => iterations_list_clear
<<Iterations: procedures>>=
subroutine iterations_list_clear (it_list)
class(iterations_list_t), intent(inout) :: it_list
it_list%n_pass = 0
deallocate (it_list%pass)
end subroutine iterations_list_clear
@ %def iterations_list_clear
@ Write the list of iterations.
<<Iterations: iterations list: TBP>>=
procedure :: write => iterations_list_write
<<Iterations: procedures>>=
subroutine iterations_list_write (it_list, unit)
class(iterations_list_t), intent(in) :: it_list
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(A)") char (it_list%to_string ())
end subroutine iterations_list_write
@ %def iterations_list_write
@ The output as a single-line string.
<<Iterations: iterations list: TBP>>=
procedure :: to_string => iterations_list_to_string
<<Iterations: procedures>>=
function iterations_list_to_string (it_list) result (buffer)
class(iterations_list_t), intent(in) :: it_list
type(string_t) :: buffer
character(30) :: ibuf
integer :: i
buffer = "iterations = "
if (it_list%n_pass > 0) then
do i = 1, it_list%n_pass
if (i > 1) buffer = buffer // ", "
write (ibuf, "(I0,':',I0)") &
it_list%pass(i)%n_it, it_list%pass(i)%n_calls
buffer = buffer // trim (ibuf)
if (it_list%pass(i)%custom_adaptation &
.or. it_list%pass(i)%adapt_grids &
.or. it_list%pass(i)%adapt_weights) then
buffer = buffer // ':"'
if (it_list%pass(i)%adapt_grids) buffer = buffer // "g"
if (it_list%pass(i)%adapt_weights) buffer = buffer // "w"
buffer = buffer // '"'
end if
end do
else
buffer = buffer // "[undefined]"
end if
end function iterations_list_to_string
@ %def iterations_list_to_string
@
\subsection{Tools}
Return the total number of passes.
<<Iterations: iterations list: TBP>>=
procedure :: get_n_pass => iterations_list_get_n_pass
<<Iterations: procedures>>=
function iterations_list_get_n_pass (it_list) result (n_pass)
class(iterations_list_t), intent(in) :: it_list
integer :: n_pass
n_pass = it_list%n_pass
end function iterations_list_get_n_pass
@ %def iterations_list_get_n_pass
@ Return the number of calls for a specific pass.
<<Iterations: iterations list: TBP>>=
procedure :: get_n_calls => iterations_list_get_n_calls
<<Iterations: procedures>>=
function iterations_list_get_n_calls (it_list, pass) result (n_calls)
class(iterations_list_t), intent(in) :: it_list
integer :: n_calls
integer, intent(in) :: pass
if (pass <= it_list%n_pass) then
n_calls = it_list%pass(pass)%n_calls
else
n_calls = 0
end if
end function iterations_list_get_n_calls
@ %def iterations_list_get_n_calls
@
<<Iterations: iterations list: TBP>>=
procedure :: set_n_calls => iterations_list_set_n_calls
<<Iterations: procedures>>=
subroutine iterations_list_set_n_calls (it_list, pass, n_calls)
class(iterations_list_t), intent(inout) :: it_list
integer, intent(in) :: pass, n_calls
it_list%pass(pass)%n_calls = n_calls
end subroutine iterations_list_set_n_calls
@ %def iterations_list_set_n_calls
@ Get the adaptation mode (automatic/custom) and, for custom adaptation, the
flags for a specific pass.
<<Iterations: iterations list: TBP>>=
procedure :: adapt_grids => iterations_list_adapt_grids
procedure :: adapt_weights => iterations_list_adapt_weights
<<Iterations: procedures>>=
function iterations_list_adapt_grids (it_list, pass) result (flag)
logical :: flag
class(iterations_list_t), intent(in) :: it_list
integer, intent(in) :: pass
if (pass <= it_list%n_pass) then
flag = it_list%pass(pass)%adapt_grids
else
flag = .false.
end if
end function iterations_list_adapt_grids
function iterations_list_adapt_weights (it_list, pass) result (flag)
logical :: flag
class(iterations_list_t), intent(in) :: it_list
integer, intent(in) :: pass
if (pass <= it_list%n_pass) then
flag = it_list%pass(pass)%adapt_weights
else
flag = .false.
end if
end function iterations_list_adapt_weights
@ %def iterations_list_has_custom_adaptation
@ %def iterations_list_adapt_grids
@ %def iterations_list_adapt_weights
@ Return the total number of iterations / the iterations for a specific pass.
<<Iterations: iterations list: TBP>>=
procedure :: get_n_it => iterations_list_get_n_it
<<Iterations: procedures>>=
function iterations_list_get_n_it (it_list, pass) result (n_it)
class(iterations_list_t), intent(in) :: it_list
integer :: n_it
integer, intent(in) :: pass
if (pass <= it_list%n_pass) then
n_it = it_list%pass(pass)%n_it
else
n_it = 0
end if
end function iterations_list_get_n_it
@ %def iterations_list_get_n_it
@
\subsection{Iteration Multipliers}
<<Iterations: public>>=
public :: iteration_multipliers_t
<<Iterations: types>>=
type :: iteration_multipliers_t
real(default) :: mult_real = 1._default
real(default) :: mult_virt = 1._default
real(default) :: mult_dglap = 1._default
real(default) :: mult_threshold = 1._default
integer, dimension(:), allocatable :: n_calls0
end type iteration_multipliers_t
@ %def iterations_multipliers
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[iterations_ut.f90]]>>=
<<File header>>
module iterations_ut
use unit_tests
use iterations_uti
<<Standard module head>>
<<Iterations: public test>>
contains
<<Iterations: test driver>>
end module iterations_ut
@ %def iterations_ut
@
<<[[iterations_uti.f90]]>>=
<<File header>>
module iterations_uti
<<Use strings>>
use iterations
<<Standard module head>>
<<Iterations: test declarations>>
contains
<<Iterations: tests>>
end module iterations_uti
@ %def iterations_ut
@ API: driver for the unit tests below.
<<Iterations: public test>>=
public :: iterations_test
<<Iterations: test driver>>=
subroutine iterations_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Iterations: execute tests>>
end subroutine iterations_test
@ %def iterations_test
@
\subsubsection{Empty list}
<<Iterations: execute tests>>=
call test (iterations_1, "iterations_1", &
"empty iterations list", &
u, results)
<<Iterations: test declarations>>=
public :: iterations_1
<<Iterations: tests>>=
subroutine iterations_1 (u)
integer, intent(in) :: u
type(iterations_list_t) :: it_list
write (u, "(A)") "* Test output: iterations_1"
write (u, "(A)") "* Purpose: display empty iterations list"
write (u, "(A)")
call it_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: iterations_1"
end subroutine iterations_1
@ %def iterations_1
@
\subsubsection{Fill list}
<<Iterations: execute tests>>=
call test (iterations_2, "iterations_2", &
"create iterations list", &
u, results)
<<Iterations: test declarations>>=
public :: iterations_2
<<Iterations: tests>>=
subroutine iterations_2 (u)
integer, intent(in) :: u
type(iterations_list_t) :: it_list
write (u, "(A)") "* Test output: iterations_2"
write (u, "(A)") "* Purpose: fill and display iterations list"
write (u, "(A)")
write (u, "(A)") "* Minimal setup (2 passes)"
write (u, "(A)")
call it_list%init ([2, 4], [5000, 20000])
call it_list%write (u)
call it_list%clear ()
write (u, "(A)")
write (u, "(A)") "* Setup with flags (3 passes)"
write (u, "(A)")
call it_list%init ([2, 4, 5], [5000, 20000, 400], &
[.false., .true., .true.], &
[var_str (""), var_str ("g"), var_str ("wg")])
call it_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Extract data"
write (u, "(A)")
write (u, "(A,I0)") "n_pass = ", it_list%get_n_pass ()
write (u, "(A)")
write (u, "(A,I0)") "n_calls(2) = ", it_list%get_n_calls (2)
write (u, "(A)")
write (u, "(A,I0)") "n_it(3) = ", it_list%get_n_it (3)
write (u, "(A)")
write (u, "(A)") "* Test output end: iterations_2"
end subroutine iterations_2
@ %def iterations_2
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Integration results}
We record integration results and errors in a dedicated type. This
allows us to do further statistics such as weighted average,
chi-squared, grouping by integration passes, etc.
Note WHIZARD 2.2.0: This code is taken from the previous [[processes]]
module essentially unchanged and converted into a separate module. It
lacks an overhaul and, in particular, self-tests.
<<[[integration_results.f90]]>>=
module integration_results
<<Use kinds>>
<<Use strings>>
use io_units
use format_utils, only: mp_format, pac_fmt
use format_defs, only: FMT_10, FMT_14
use diagnostics
use md5
use os_interface
use mci_base
<<Standard module head>>
<<Integration results: public>>
<<Integration results: parameters>>
<<Integration results: types>>
<<Integration results: interfaces>>
contains
<<Integration results: procedures>>
end module integration_results
@ %def integration_results
@
\subsection{Integration results entry}
This object collects the results of an integration pass and makes them
available to the outside.
The results object has to distinguish the process type:
We store the process type, the index of the integration pass and the
absolute iteration index, the number of iterations contained in this
result (for averages), and the integral (cross section or partial
width), error estimate, efficiency.
For intermediate results, we set a flag if this result is an
improvement w.r.t. previous ones.
The process type indicates decay or scattering. Dummy entries
(skipped iterations) have a process type of [[PRC_UNKNOWN]].
The additional information [[n_calls_valid]], [[efficiency_pos]] and
[[efficiency_neg]] are stored, but only used in verbose mode.
<<Integration results: public>>=
public :: integration_entry_t
<<Integration results: types>>=
type :: integration_entry_t
private
integer :: process_type = PRC_UNKNOWN
integer :: pass = 0
integer :: it = 0
integer :: n_it = 0
integer :: n_calls = 0
integer :: n_calls_valid = 0
logical :: improved = .false.
real(default) :: integral = 0
real(default) :: error = 0
real(default) :: efficiency = 0
real(default) :: efficiency_pos = 0
real(default) :: efficiency_neg = 0
real(default) :: chi2 = 0
real(default), dimension(:), allocatable :: chain_weights
contains
<<Integration results: integration entry: TBP>>
end type integration_entry_t
@ %def integration_result_t
@
The possible values of the type indicator:
<<Integration results: parameters>>=
integer, parameter, public :: PRC_UNKNOWN = 0
integer, parameter, public :: PRC_DECAY = 1
integer, parameter, public :: PRC_SCATTERING = 2
@ %def PRC_UNKNOWN PRC_DECAY PRC_SCATTERING
@ Initialize with all relevant data.
<<Integration results: interfaces>>=
interface integration_entry_t
module procedure integration_entry_init
end interface integration_entry_t
<<Integration results: procedures>>=
type(integration_entry_t) function integration_entry_init (process_type, pass,&
& it, n_it, n_calls, n_calls_valid, improved, integral, error,&
& efficiency, efficiency_pos, efficiency_neg, chi2, chain_weights)&
& result (entry)
integer, intent(in) :: process_type, pass, it, n_it, n_calls, n_calls_valid
logical, intent(in) :: improved
real(default), intent(in) :: integral, error, efficiency, efficiency_pos, efficiency_neg
real(default), intent(in), optional :: chi2
real(default), dimension(:), intent(in), optional :: chain_weights
entry%process_type = process_type
entry%pass = pass
entry%it = it
entry%n_it = n_it
entry%n_calls = n_calls
entry%n_calls_valid = n_calls_valid
entry%improved = improved
entry%integral = integral
entry%error = error
entry%efficiency = efficiency
entry%efficiency_pos = efficiency_pos
entry%efficiency_neg = efficiency_neg
if (present (chi2)) entry%chi2 = chi2
if (present (chain_weights)) then
allocate (entry%chain_weights (size (chain_weights)))
entry%chain_weights = chain_weights
end if
end function integration_entry_init
@ %def integration_entry_init
@ Access values, some of them computed on demand:
<<Integration results: integration entry: TBP>>=
procedure :: get_pass => integration_entry_get_pass
procedure :: get_n_calls => integration_entry_get_n_calls
procedure :: get_n_calls_valid => integration_entry_get_n_calls_valid
procedure :: get_integral => integration_entry_get_integral
procedure :: get_error => integration_entry_get_error
procedure :: get_rel_error => integration_entry_get_relative_error
procedure :: get_accuracy => integration_entry_get_accuracy
procedure :: get_efficiency => integration_entry_get_efficiency
procedure :: get_efficiency_pos => integration_entry_get_efficiency_pos
procedure :: get_efficiency_neg => integration_entry_get_efficiency_neg
procedure :: get_chi2 => integration_entry_get_chi2
procedure :: has_improved => integration_entry_has_improved
procedure :: get_n_groves => integration_entry_get_n_groves
<<Integration results: procedures>>=
elemental function integration_entry_get_pass (entry) result (n)
integer :: n
class(integration_entry_t), intent(in) :: entry
n = entry%pass
end function integration_entry_get_pass
elemental function integration_entry_get_n_calls (entry) result (n)
integer :: n
class(integration_entry_t), intent(in) :: entry
n = entry%n_calls
end function integration_entry_get_n_calls
elemental function integration_entry_get_n_calls_valid (entry) result (n)
integer :: n
class(integration_entry_t), intent(in) :: entry
n = entry%n_calls_valid
end function integration_entry_get_n_calls_valid
elemental function integration_entry_get_integral (entry) result (int)
real(default) :: int
class(integration_entry_t), intent(in) :: entry
int = entry%integral
end function integration_entry_get_integral
elemental function integration_entry_get_error (entry) result (err)
real(default) :: err
class(integration_entry_t), intent(in) :: entry
err = entry%error
end function integration_entry_get_error
elemental function integration_entry_get_relative_error (entry) result (err)
real(default) :: err
class(integration_entry_t), intent(in) :: entry
err = 0
if (entry%integral /= 0) then
err = entry%error / entry%integral
end if
end function integration_entry_get_relative_error
elemental function integration_entry_get_accuracy (entry) result (acc)
real(default) :: acc
class(integration_entry_t), intent(in) :: entry
acc = accuracy (entry%integral, entry%error, entry%n_calls)
end function integration_entry_get_accuracy
elemental function accuracy (integral, error, n_calls) result (acc)
real(default) :: acc
real(default), intent(in) :: integral, error
integer, intent(in) :: n_calls
acc = 0
if (integral /= 0) then
acc = error / integral * sqrt (real (n_calls, default))
end if
end function accuracy
elemental function integration_entry_get_efficiency (entry) result (eff)
real(default) :: eff
class(integration_entry_t), intent(in) :: entry
eff = entry%efficiency
end function integration_entry_get_efficiency
elemental function integration_entry_get_efficiency_pos (entry) result (eff)
real(default) :: eff
class(integration_entry_t), intent(in) :: entry
eff = entry%efficiency_pos
end function integration_entry_get_efficiency_pos
elemental function integration_entry_get_efficiency_neg (entry) result (eff)
real(default) :: eff
class(integration_entry_t), intent(in) :: entry
eff = entry%efficiency_neg
end function integration_entry_get_efficiency_neg
elemental function integration_entry_get_chi2 (entry) result (chi2)
real(default) :: chi2
class(integration_entry_t), intent(in) :: entry
chi2 = entry%chi2
end function integration_entry_get_chi2
elemental function integration_entry_has_improved (entry) result (flag)
logical :: flag
class(integration_entry_t), intent(in) :: entry
flag = entry%improved
end function integration_entry_has_improved
elemental function integration_entry_get_n_groves (entry) result (n_groves)
integer :: n_groves
class(integration_entry_t), intent(in) :: entry
n_groves = 0
if (allocated (entry%chain_weights)) then
n_groves = size (entry%chain_weights, 1)
end if
end function integration_entry_get_n_groves
@ %def integration_entry_get_pass
@ %def integration_entry_get_integral
@ %def integration_entry_get_error
@ %def integration_entry_get_relative_error
@ %def integration_entry_get_accuracy
@ %def accuracy
@ %def integration_entry_get_efficiency
@ %def integration_entry_get_chi2
@ %def integration_entry_has_improved
@ %def integration_entry_get_n_groves
@ This writes the standard result account into one screen line. The
verbose version uses multiple lines and prints the unabridged values.
Dummy entries are not written.
<<Integration results: integration entry: TBP>>=
procedure :: write => integration_entry_write
procedure :: write_verbose => integration_entry_write_verbose
<<Integration results: procedures>>=
subroutine integration_entry_write (entry, unit, verbosity, suppress)
class(integration_entry_t), intent(in) :: entry
integer, intent(in), optional :: unit
integer, intent(in), optional :: verbosity
logical, intent(in), optional :: suppress
integer :: u
character(1) :: star
character(12) :: fmt
character(7) :: fmt2
character(120) :: buffer
integer :: verb
logical :: supp
u = given_output_unit (unit); if (u < 0) return
verb = 0; if (present (verbosity)) verb = verbosity
supp = .false.; if (present (suppress)) supp = suppress
if (entry%process_type /= PRC_UNKNOWN) then
if (entry%improved .and. .not. supp) then
star = "*"
else
star = " "
end if
call pac_fmt (fmt, FMT_14, "3x," // FMT_10 // ",1x", suppress)
call pac_fmt (fmt2, "1x,F6.2", "2x,F5.1", suppress)
write (buffer, "(1x,I3,1x,I10)") entry%it, entry%n_calls
if (verb > 1) then
write (buffer, "(A,1x,I10)") trim (buffer), entry%n_calls_valid
end if
write (buffer, "(A,1x," // fmt // ",1x,ES9.2,1x,F7.2," // &
"1x,F7.2,A1," // fmt2 // ")") &
trim (buffer), &
entry%integral, &
abs(entry%error), &
abs(integration_entry_get_relative_error (entry)) * 100, &
abs(integration_entry_get_accuracy (entry)), &
star, &
entry%efficiency * 100
if (verb > 2) then
write (buffer, "(A,1X," // fmt2 // ",1X," // fmt2 // ")") &
trim (buffer), &
entry%efficiency_pos * 100, &
entry%efficiency_neg * 100
end if
if (entry%n_it /= 1) then
write (buffer, "(A,1x,F7.2,1x,I3)") &
trim (buffer), &
entry%chi2, &
entry%n_it
end if
write (u, "(A)") trim (buffer)
end if
flush (u)
end subroutine integration_entry_write
subroutine integration_entry_write_verbose (entry, unit)
class(integration_entry_t), intent(in) :: entry
integer, intent(in) :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, *) " process_type = ", entry%process_type
write (u, *) " pass = ", entry%pass
write (u, *) " it = ", entry%it
write (u, *) " n_it = ", entry%n_it
write (u, *) " n_calls = ", entry%n_calls
write (u, *) " n_calls_valid = ", entry%n_calls_valid
write (u, *) " improved = ", entry%improved
write (u, *) " integral = ", entry%integral
write (u, *) " error = ", entry%error
write (u, *) " efficiency = ", entry%efficiency
write (u, *) "efficiency_pos = ", entry%efficiency_pos
write (u, *) "efficiency_neg = ", entry%efficiency_neg
write (u, *) " chi2 = ", entry%chi2
if (allocated (entry%chain_weights)) then
write (u, *) " n_groves = ", size (entry%chain_weights)
write (u, *) "chain_weights = ", entry%chain_weights
else
write (u, *) " n_groves = 0"
end if
flush (u)
end subroutine integration_entry_write_verbose
@ %def integration_entry_write
@ Read the entry, assuming it has been written in verbose format.
<<Integration results: integration entry: TBP>>=
procedure :: read => integration_entry_read
<<Integration results: procedures>>=
subroutine integration_entry_read (entry, unit)
class(integration_entry_t), intent(out) :: entry
integer, intent(in) :: unit
character(30) :: dummy
character :: equals
integer :: n_groves
read (unit, *) dummy, equals, entry%process_type
read (unit, *) dummy, equals, entry%pass
read (unit, *) dummy, equals, entry%it
read (unit, *) dummy, equals, entry%n_it
read (unit, *) dummy, equals, entry%n_calls
read (unit, *) dummy, equals, entry%n_calls_valid
read (unit, *) dummy, equals, entry%improved
read (unit, *) dummy, equals, entry%integral
read (unit, *) dummy, equals, entry%error
read (unit, *) dummy, equals, entry%efficiency
read (unit, *) dummy, equals, entry%efficiency_pos
read (unit, *) dummy, equals, entry%efficiency_neg
read (unit, *) dummy, equals, entry%chi2
read (unit, *) dummy, equals, n_groves
if (n_groves /= 0) then
allocate (entry%chain_weights (n_groves))
read (unit, *) dummy, equals, entry%chain_weights
end if
end subroutine integration_entry_read
@ %def integration_entry_read
@ Write an account of the channel weights, accumulated by groves.
<<Integration results: integration entry: TBP>>=
procedure :: write_chain_weights => integration_entry_write_chain_weights
<<Integration results: procedures>>=
subroutine integration_entry_write_chain_weights (entry, unit)
class(integration_entry_t), intent(in) :: entry
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
if (allocated (entry%chain_weights)) then
do i = 1, size (entry%chain_weights)
write (u, "(1x,I3)", advance="no") nint (entry%chain_weights(i) * 100)
end do
write (u, *)
end if
end subroutine integration_entry_write_chain_weights
@ %def integration_entry_write_chain_weights
@
\subsection{Combined integration results}
We collect a list of results which grows during the execution of the
program. This is implemented as an array which grows if necessary; so
we can easily compute averages.
We implement this as an extension of the [[mci_results_t]] which is
defined in [[mci_base]] as an abstract type. We thus decouple the
implementation of the integrator from the implementation of the
results display, but nevertheless can record intermediate results
during integration. This implies that the present extension
implements a [[record]] method.
<<Integration results: public>>=
public :: integration_results_t
<<Integration results: types>>=
type, extends (mci_results_t) :: integration_results_t
private
integer :: process_type = PRC_UNKNOWN
integer :: current_pass = 0
integer :: n_pass = 0
integer :: n_it = 0
logical :: screen = .false.
integer :: unit = 0
integer :: verbosity = 0
real(default) :: error_threshold = 0
type(integration_entry_t), dimension(:), allocatable :: entry
type(integration_entry_t), dimension(:), allocatable :: average
contains
<<Integration results: integration results: TBP>>
end type integration_results_t
@ %def integration_results_t
@ The array is extended in chunks of 10 entries.
<<Integration results: parameters>>=
integer, parameter :: RESULTS_CHUNK_SIZE = 10
@ %def RESULTS_CHUNK_SIZE
@ The standard does not require to explicitly initialize the integers;
however, some gfortran version has a bug here and misses the default
initialization in the type definition.
<<Integration results: integration results: TBP>>=
procedure :: init => integration_results_init
<<Integration results: procedures>>=
subroutine integration_results_init (results, process_type)
class(integration_results_t), intent(out) :: results
integer, intent(in) :: process_type
results%process_type = process_type
results%n_pass = 0
results%n_it = 0
allocate (results%entry (RESULTS_CHUNK_SIZE))
allocate (results%average (RESULTS_CHUNK_SIZE))
end subroutine integration_results_init
@ %def integration_results_init
@ Set verbose output of the integration results. In verbose mode, valid calls,
negative as positive efficiency will be printed.
<<Integration results: integration results: TBP>>=
procedure :: set_verbosity => integration_results_set_verbosity
<<Integration results: procedures>>=
subroutine integration_results_set_verbosity (results, verbosity)
class(integration_results_t), intent(inout) :: results
integer, intent(in) :: verbosity
results%verbosity = verbosity
end subroutine integration_results_set_verbosity
@ %def integration_results_set_verbose
@ Set additional parameters: the [[error_threshold]] declares that any error
value (in absolute numbers) smaller than this is to be considered zero.
<<Integration results: integration results: TBP>>=
procedure :: set_error_threshold => integration_results_set_error_threshold
<<Integration results: procedures>>=
subroutine integration_results_set_error_threshold (results, error_threshold)
class(integration_results_t), intent(inout) :: results
real(default), intent(in) :: error_threshold
results%error_threshold = error_threshold
end subroutine integration_results_set_error_threshold
@ %def integration_results_set_error_threshold
@ Output (ASCII format). The [[verbose]] format is used for writing
the header in grid files.
<<Integration results: integration results: TBP>>=
procedure :: write => integration_results_write
procedure :: write_verbose => integration_results_write_verbose
<<Integration results: procedures>>=
subroutine integration_results_write (object, unit, suppress)
class(integration_results_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: suppress
logical :: verb
integer :: u, n
u = given_output_unit (unit); if (u < 0) return
call object%write_dline (unit)
if (object%n_it /= 0) then
call object%write_header (unit, logfile = .false.)
call object%write_dline (unit)
do n = 1, object%n_it
if (n > 1) then
if (object%entry(n)%pass /= object%entry(n-1)%pass) then
call object%write_hline (unit)
call object%average(object%entry(n-1)%pass)%write ( &
& unit, suppress = suppress)
call object%write_hline (unit)
end if
end if
call object%entry(n)%write (unit, &
suppress = suppress)
end do
call object%write_hline(unit)
call object%average(object%n_pass)%write (unit, suppress = suppress)
else
call msg_message ("[WHIZARD integration results: empty]", unit)
end if
call object%write_dline (unit)
flush (u)
end subroutine integration_results_write
subroutine integration_results_write_verbose (object, unit)
class(integration_results_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, n
u = given_output_unit (unit); if (u < 0) return
write (u, *) "begin(integration_results)"
write (u, *) " n_pass = ", object%n_pass
write (u, *) " n_it = ", object%n_it
if (object%n_it > 0) then
write (u, *) "begin(integration_pass)"
do n = 1, object%n_it
if (n > 1) then
if (object%entry(n)%pass /= object%entry(n-1)%pass) then
write (u, *) "end(integration_pass)"
write (u, *) "begin(integration_pass)"
end if
end if
write (u, *) "begin(iteration)"
call object%entry(n)%write_verbose (unit)
write (u, *) "end(iteration)"
end do
write (u, *) "end(integration_pass)"
end if
write (u, *) "end(integration_results)"
flush (u)
end subroutine integration_results_write_verbose
@ %def integration_results_write integration_results_verbose
@ Write a concise table of chain weights, i.e., the channel history where
channels are collected by chains.
<<Integration results: integration results: TBP>>=
procedure :: write_chain_weights => &
integration_results_write_chain_weights
<<Integration results: procedures>>=
subroutine integration_results_write_chain_weights (results, unit)
class(integration_results_t), intent(in) :: results
integer, intent(in), optional :: unit
integer :: u, i, n
u = given_output_unit (unit); if (u < 0) return
if (allocated (results%entry(1)%chain_weights) .and. results%n_it /= 0) then
call msg_message ("Phase-space chain (grove) weight history: " &
// "(numbers in %)", unit)
write (u, "(A9)", advance="no") "| chain |"
do i = 1, integration_entry_get_n_groves (results%entry(1))
write (u, "(1x,I3)", advance="no") i
end do
write (u, *)
call results%write_dline (unit)
do n = 1, results%n_it
if (n > 1) then
if (results%entry(n)%pass /= results%entry(n-1)%pass) then
call results%write_hline (unit)
end if
end if
write (u, "(1x,I6,1x,A1)", advance="no") n, "|"
call results%entry(n)%write_chain_weights (unit)
end do
flush (u)
call results%write_dline(unit)
end if
end subroutine integration_results_write_chain_weights
@ %def integration_results_write_chain_weights
@ Read the list from file. The file must be written using the
[[verbose]] option of the writing routine.
<<Integration results: integration results: TBP>>=
procedure :: read => integration_results_read
<<Integration results: procedures>>=
subroutine integration_results_read (results, unit)
class(integration_results_t), intent(out) :: results
integer, intent(in) :: unit
character(80) :: buffer
character :: equals
integer :: pass, it
read (unit, *) buffer
if (trim (adjustl (buffer)) /= "begin(integration_results)") then
call read_err (); return
end if
read (unit, *) buffer, equals, results%n_pass
read (unit, *) buffer, equals, results%n_it
allocate (results%entry (results%n_it + RESULTS_CHUNK_SIZE))
allocate (results%average (results%n_it + RESULTS_CHUNK_SIZE))
it = 0
do pass = 1, results%n_pass
read (unit, *) buffer
if (trim (adjustl (buffer)) /= "begin(integration_pass)") then
call read_err (); return
end if
READ_ENTRIES: do
read (unit, *) buffer
if (trim (adjustl (buffer)) /= "begin(iteration)") then
exit READ_ENTRIES
end if
it = it + 1
call results%entry(it)%read (unit)
read (unit, *) buffer
if (trim (adjustl (buffer)) /= "end(iteration)") then
call read_err (); return
end if
end do READ_ENTRIES
if (trim (adjustl (buffer)) /= "end(integration_pass)") then
call read_err (); return
end if
results%average(pass) = compute_average (results%entry, pass)
end do
read (unit, *) buffer
if (trim (adjustl (buffer)) /= "end(integration_results)") then
call read_err (); return
end if
contains
subroutine read_err ()
call msg_fatal ("Reading integration results from file: syntax error")
end subroutine read_err
end subroutine integration_results_read
@ %def integration_results_read
@ Auxiliary output.
<<Integration results: integration results: TBP>>=
procedure, private :: write_header
procedure, private :: write_hline
procedure, private :: write_dline
<<Integration results: procedures>>=
subroutine write_header (results, unit, logfile)
class(integration_results_t), intent(in) :: results
integer, intent(in), optional :: unit
logical, intent(in), optional :: logfile
character(5) :: phys_unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
select case (results%process_type)
case (PRC_DECAY); phys_unit = "[GeV]"
case (PRC_SCATTERING); phys_unit = "[fb] "
case default
phys_unit = " "
end select
write (msg_buffer, "(A, A)") &
"It Calls"
if (results%verbosity > 1) then
write (msg_buffer, "(A, A)") trim (msg_buffer), &
" Valid"
end if
write (msg_buffer, "(A, A)") trim (msg_buffer), &
" Integral" // phys_unit // &
" Error" // phys_unit // &
" Err[%] Acc Eff[%]"
if (results%verbosity > 2) then
write (msg_buffer, "(A, A)") trim (msg_buffer), &
" (+)[%] (-)[%]"
end if
write (msg_buffer, "(A, A)") trim (msg_buffer), &
" Chi2 N[It] |"
call msg_message (unit=u, logfile=logfile)
end subroutine write_header
subroutine write_hline (results, unit)
class(integration_results_t), intent(in) :: results
integer, intent(in), optional :: unit
integer :: u, len
u = given_output_unit (unit); if (u < 0) return
len = 77
if (results%verbosity > 1) len = len + 11
if (results%verbosity > 2) len = len + 16
write (u, "(A)") "|" // (repeat ("-", len)) // "|"
flush (u)
end subroutine write_hline
subroutine write_dline (results, unit)
class(integration_results_t), intent(in) :: results
integer, intent(in), optional :: unit
integer :: u, len
u = given_output_unit (unit); if (u < 0) return
len = 77
if (results%verbosity > 1) len = len + 11
if (results%verbosity > 2) len = len + 16
write (u, "(A)") "|" // (repeat ("=", len)) // "|"
flush (u)
end subroutine write_dline
@ %def write_header write_hline write_dline
@ During integration, we do not want to print all results at once, but
each intermediate result as soon as we get it. Thus, the previous procedure
is chopped in pieces. First piece: store the
output unit and a flag whether we want to print to standard output as
well. Then write the header if the results are still empty, i.e.,
before integration has started. The second piece writes a single
result to the saved output channels. We call this from the [[record]]
method, which can be called from the integrator directly. The third
piece writes the average result, once a pass has been completed. The
fourth piece writes a footer (if any), assuming that this is the final result.
<<Integration results: integration results: TBP>>=
procedure :: display_init => integration_results_display_init
procedure :: display_current => integration_results_display_current
procedure :: display_pass => integration_results_display_pass
procedure :: display_final => integration_results_display_final
<<Integration results: procedures>>=
subroutine integration_results_display_init &
(results, screen, unit)
class(integration_results_t), intent(inout) :: results
logical, intent(in) :: screen
integer, intent(in), optional :: unit
integer :: u
if (present (unit)) results%unit = unit
u = given_output_unit ()
results%screen = screen
if (results%n_it == 0) then
if (results%screen) then
call results%write_dline (u)
call results%write_header (u, &
logfile=.false.)
call results%write_dline (u)
end if
if (results%unit /= 0) then
call results%write_dline (results%unit)
call results%write_header (results%unit, &
logfile=.false.)
call results%write_dline (results%unit)
end if
else
if (results%screen) then
call results%write_hline (u)
end if
if (results%unit /= 0) then
call results%write_hline (results%unit)
end if
end if
end subroutine integration_results_display_init
subroutine integration_results_display_current (results, pacify)
class(integration_results_t), intent(in) :: results
integer :: u
logical, intent(in), optional :: pacify
u = given_output_unit ()
if (results%screen) then
call results%entry(results%n_it)%write (u, &
verbosity = results%verbosity, suppress = pacify)
end if
if (results%unit /= 0) then
call results%entry(results%n_it)%write ( &
results%unit, verbosity = results%verbosity, suppress = pacify)
end if
end subroutine integration_results_display_current
subroutine integration_results_display_pass (results, pacify)
class(integration_results_t), intent(in) :: results
logical, intent(in), optional :: pacify
integer :: u
u = given_output_unit ()
if (results%screen) then
call results%write_hline (u)
call results%average(results%entry(results%n_it)%pass)%write ( &
u, verbosity = results%verbosity, suppress = pacify)
end if
if (results%unit /= 0) then
call results%write_hline (results%unit)
call results%average(results%entry(results%n_it)%pass)%write ( &
results%unit, verbosity = results%verbosity, suppress = pacify)
end if
end subroutine integration_results_display_pass
subroutine integration_results_display_final (results)
class(integration_results_t), intent(inout) :: results
integer :: u
u = given_output_unit ()
if (results%screen) then
call results%write_dline (u)
end if
if (results%unit /= 0) then
call results%write_dline (results%unit)
end if
results%screen = .false.
results%unit = 0
end subroutine integration_results_display_final
@ %def integration_results_display_init
@ %def integration_results_display_current
@ %def integration_results_display_pass
@ Expand the list of entries if the limit has been reached:
<<Integration results: integration results: TBP>>=
procedure :: expand => integration_results_expand
<<Integration results: procedures>>=
subroutine integration_results_expand (results)
class(integration_results_t), intent(inout) :: results
type(integration_entry_t), dimension(:), allocatable :: entry_tmp
if (results%n_it == size (results%entry)) then
allocate (entry_tmp (results%n_it))
entry_tmp = results%entry
deallocate (results%entry)
allocate (results%entry (results%n_it + RESULTS_CHUNK_SIZE))
results%entry(:results%n_it) = entry_tmp
deallocate (entry_tmp)
end if
if (results%n_pass == size (results%average)) then
allocate (entry_tmp (results%n_pass))
entry_tmp = results%average
deallocate (results%average)
allocate (results%average (results%n_it + RESULTS_CHUNK_SIZE))
results%average(:results%n_pass) = entry_tmp
deallocate (entry_tmp)
end if
end subroutine integration_results_expand
@ %def integration_results_expand
@ Increment the [[current_pass]] counter. Must be done before each new
integration pass; after integration, the recording method may use the value of
this counter to define the entry.
<<Integration results: integration results: TBP>>=
procedure :: new_pass => integration_results_new_pass
<<Integration results: procedures>>=
subroutine integration_results_new_pass (results)
class(integration_results_t), intent(inout) :: results
results%current_pass = results%current_pass + 1
end subroutine integration_results_new_pass
@ %def integration_results_new_pass
@ Enter results into the results list. For the error value, we may compare
them with a given threshold. This guards against numerical noise, if the
exact error would be zero.
<<Integration results: integration results: TBP>>=
procedure :: append => integration_results_append
<<Integration results: procedures>>=
subroutine integration_results_append (results, &
n_it, n_calls, n_calls_valid, &
integral, error, efficiency, efficiency_pos, efficiency_neg, &
chain_weights)
class(integration_results_t), intent(inout) :: results
integer, intent(in) :: n_it, n_calls, n_calls_valid
real(default), intent(in) :: integral, error, efficiency, efficiency_pos, &
& efficiency_neg
real(default), dimension(:), intent(in), optional :: chain_weights
logical :: improved
type(integration_entry_t) :: entry
real(default) :: err_checked
improved = .true.
if (results%n_it /= 0) improved = abs(accuracy (integral, error, n_calls)) &
< abs(results%entry(results%n_it)%get_accuracy ())
err_checked = 0
if (abs (error) >= results%error_threshold) err_checked = error
entry = integration_entry_t ( &
results%process_type, results%current_pass, &
results%n_it+1, n_it, n_calls, n_calls_valid, improved, &
integral, err_checked, efficiency, efficiency_pos, efficiency_neg, &
chain_weights=chain_weights)
if (results%n_it == 0) then
results%n_it = 1
results%n_pass = 1
else
call results%expand ()
if (entry%pass /= results%entry(results%n_it)%pass) &
results%n_pass = results%n_pass + 1
results%n_it = results%n_it + 1
end if
results%entry(results%n_it) = entry
results%average(results%n_pass) = &
compute_average (results%entry, entry%pass)
end subroutine integration_results_append
@ %def integration_results_append
@ Record an integration pass executed by an [[mci]] integrator
object.
There is a tolerance below we treat an error (relative to the
integral) as zero.
<<Integration results: parameters>>=
real(default), parameter, public :: INTEGRATION_ERROR_TOLERANCE = 1e-10
@ %def INTEGRATION_ERROR_TOLERANCE
@
<<Integration results: integration results: TBP>>=
procedure :: record_simple => integration_results_record_simple
<<Integration results: procedures>>=
subroutine integration_results_record_simple &
(object, n_it, n_calls, integral, error, efficiency, &
chain_weights, suppress)
class(integration_results_t), intent(inout) :: object
integer, intent(in) :: n_it, n_calls
real(default), intent(in) :: integral, error, efficiency
real(default), dimension(:), intent(in), optional :: chain_weights
real(default) :: err
logical, intent(in), optional :: suppress
err = 0._default
if (abs (error) >= abs (integral) * INTEGRATION_ERROR_TOLERANCE) then
err = error
end if
call object%append (n_it, n_calls, 0, integral, err, efficiency, 0._default,&
& 0._default, chain_weights)
call object%display_current (suppress)
end subroutine integration_results_record_simple
@ %def integration_results_record_simple
@ Record extended results from integration pass.
<<Integration results: integration results: TBP>>=
procedure :: record_extended => integration_results_record_extended
<<Integration results: procedures>>=
subroutine integration_results_record_extended (object, n_it, n_calls,&
& n_calls_valid, integral, error, efficiency, efficiency_pos,&
& efficiency_neg, chain_weights, suppress)
class(integration_results_t), intent(inout) :: object
integer, intent(in) :: n_it, n_calls, n_calls_valid
real(default), intent(in) :: integral, error, efficiency, efficiency_pos,&
& efficiency_neg
real(default), dimension(:), intent(in), optional :: chain_weights
real(default) :: err
logical, intent(in), optional :: suppress
err = 0._default
if (abs (error) >= abs (integral) * INTEGRATION_ERROR_TOLERANCE) then
err = error
end if
call object%append (n_it, n_calls, n_calls_valid, integral, err, efficiency,&
& efficiency_pos, efficiency_neg, chain_weights)
call object%display_current (suppress)
end subroutine integration_results_record_extended
@ %def integration_results_record_extended
@ Compute the average for all entries in the specified integration
pass. The integrals are weighted w.r.t.\ their individual errors.
The quoted error of the result is the expected error, computed from
the weighted average of the given individual errors.
This should be compared to the actual distribution of the results,
from which we also can compute an error estimate if there is more than
one iteration. The ratio of the distribution error and the averaged
error, is the $\chi^2$ value.
All error distributions are assumed Gaussian, of course. The $\chi^2$
value is a partial check for this assumption. If it is significantly
greater than unity, there is something wrong with the individual errors.
The efficiency returned is the one of the last entry in the
integration pass.
If any error vanishes, averaging by this algorithm would fail. In this case,
we simply average the entries and use the deviations from this average (if
any) to estimate the error.
<<Integration results: procedures>>=
type(integration_entry_t) function compute_average (entry, pass) &
& result (result)
type(integration_entry_t), dimension(:), intent(in) :: entry
integer, intent(in) :: pass
integer :: i
logical, dimension(size(entry)) :: mask
real(default), dimension(size(entry)) :: ivar
real(default) :: sum_ivar, variance
result%process_type = entry(1)%process_type
result%pass = pass
mask = entry%pass == pass .and. entry%process_type /= PRC_UNKNOWN
result%it = maxval (entry%it, mask)
result%n_it = count (mask)
result%n_calls = sum (entry%n_calls, mask)
result%n_calls_valid = sum (entry%n_calls_valid, mask)
if (.not. any (mask .and. entry%error == 0)) then
where (mask)
ivar = 1 / entry%error ** 2
elsewhere
ivar = 0
end where
sum_ivar = sum (ivar, mask)
variance = 0
if (sum_ivar /= 0) then
variance = 1 / sum_ivar
end if
result%integral = sum (entry%integral * ivar, mask) * variance
if (result%n_it > 1) then
result%chi2 = &
sum ((entry%integral - result%integral)**2 * ivar, mask) &
/ (result%n_it - 1)
end if
else if (result%n_it /= 0) then
result%integral = sum (entry%integral, mask) / result%n_it
variance = 0
if (result%n_it > 1) then
variance = &
sum ((entry%integral - result%integral)**2, mask) &
/ (result%n_it - 1)
if (result%integral /= 0) then
if (abs (variance / result%integral) &
< 100 * epsilon (1._default)) then
variance = 0
end if
end if
end if
result%chi2 = variance / result%n_it
end if
result%error = sqrt (variance)
result%efficiency = entry(last_index (mask))%efficiency
result%efficiency_pos = entry(last_index (mask))%efficiency_pos
result%efficiency_neg = entry(last_index (mask))%efficiency_neg
contains
integer function last_index (mask) result (index)
logical, dimension(:), intent(in) :: mask
integer :: i
do i = size (mask), 1, -1
if (mask(i)) exit
end do
index = i
end function last_index
end function compute_average
@ %def compute_average
@
\subsection{Access results}
Return true if the results object has entries.
<<Integration results: integration results: TBP>>=
procedure :: exist => integration_results_exist
<<Integration results: procedures>>=
function integration_results_exist (results) result (flag)
logical :: flag
class(integration_results_t), intent(in) :: results
flag = results%n_pass > 0
end function integration_results_exist
@ %def integration_results_exist
@ Retrieve information from the results record. If [[last]] is set and
true, take the last iteration. If [[it]] is set instead, take this
iteration. If [[pass]] is set, take this average. If none is set,
take the final average.
If the result would be invalid, the entry is not assigned. Due to
default initialization, this returns a null entry.
<<Integration results: integration results: TBP>>=
procedure :: get_entry => results_get_entry
<<Integration results: procedures>>=
function results_get_entry (results, last, it, pass) result (entry)
class(integration_results_t), intent(in) :: results
type(integration_entry_t) :: entry
logical, intent(in), optional :: last
integer, intent(in), optional :: it, pass
if (present (last)) then
if (allocated (results%entry) .and. results%n_it > 0) then
entry = results%entry(results%n_it)
else
call error ()
end if
else if (present (it)) then
if (allocated (results%entry) .and. it > 0 .and. it <= results%n_it) then
entry = results%entry(it)
else
call error ()
end if
else if (present (pass)) then
if (allocated (results%average) &
.and. pass > 0 .and. pass <= results%n_pass) then
entry = results%average (pass)
else
call error ()
end if
else
if (allocated (results%average) .and. results%n_pass > 0) then
entry = results%average (results%n_pass)
else
call error ()
end if
end if
contains
subroutine error ()
call msg_fatal ("Requested integration result is not available")
end subroutine error
end function results_get_entry
@ %def results_get_entry
@ The individual procedures. The [[results]] record should have the
[[target]] attribute, but only locally within the function.
<<Integration results: integration results: TBP>>=
procedure :: get_n_calls => integration_results_get_n_calls
procedure :: get_integral => integration_results_get_integral
procedure :: get_error => integration_results_get_error
procedure :: get_accuracy => integration_results_get_accuracy
procedure :: get_chi2 => integration_results_get_chi2
procedure :: get_efficiency => integration_results_get_efficiency
<<Integration results: procedures>>=
function integration_results_get_n_calls (results, last, it, pass) &
result (n_calls)
class(integration_results_t), intent(in), target :: results
integer :: n_calls
logical, intent(in), optional :: last
integer, intent(in), optional :: it, pass
type(integration_entry_t) :: entry
entry = results%get_entry (last, it, pass)
n_calls = entry%get_n_calls ()
end function integration_results_get_n_calls
function integration_results_get_integral (results, last, it, pass) &
result (integral)
class(integration_results_t), intent(in), target :: results
real(default) :: integral
logical, intent(in), optional :: last
integer, intent(in), optional :: it, pass
type(integration_entry_t) :: entry
entry = results%get_entry (last, it, pass)
integral = entry%get_integral ()
end function integration_results_get_integral
function integration_results_get_error (results, last, it, pass) &
result (error)
class(integration_results_t), intent(in), target :: results
real(default) :: error
logical, intent(in), optional :: last
integer, intent(in), optional :: it, pass
type(integration_entry_t) :: entry
entry = results%get_entry (last, it, pass)
error = entry%get_error ()
end function integration_results_get_error
function integration_results_get_accuracy (results, last, it, pass) &
result (accuracy)
class(integration_results_t), intent(in), target :: results
real(default) :: accuracy
logical, intent(in), optional :: last
integer, intent(in), optional :: it, pass
type(integration_entry_t) :: entry
entry = results%get_entry (last, it, pass)
accuracy = entry%get_accuracy ()
end function integration_results_get_accuracy
function integration_results_get_chi2 (results, last, it, pass) &
result (chi2)
class(integration_results_t), intent(in), target :: results
real(default) :: chi2
logical, intent(in), optional :: last
integer, intent(in), optional :: it, pass
type(integration_entry_t) :: entry
entry = results%get_entry (last, it, pass)
chi2 = entry%get_chi2 ()
end function integration_results_get_chi2
function integration_results_get_efficiency (results, last, it, pass) &
result (efficiency)
class(integration_results_t), intent(in), target :: results
real(default) :: efficiency
logical, intent(in), optional :: last
integer, intent(in), optional :: it, pass
type(integration_entry_t) :: entry
entry = results%get_entry (last, it, pass)
efficiency = entry%get_efficiency ()
end function integration_results_get_efficiency
@ %def integration_results_get_n_calls
@ %def integration_results_get_integral
@ %def integration_results_get_error
@ %def integration_results_get_accuracy
@ %def integration_results_get_chi2
@ %def integration_results_get_efficiency
@ Return the last pass index and the index of the last iteration
\emph{within} the last pass. The third routine returns the absolute
index of the last iteration.
<<Integration results: procedures>>=
function integration_results_get_current_pass (results) result (pass)
integer :: pass
type(integration_results_t), intent(in) :: results
pass = results%n_pass
end function integration_results_get_current_pass
function integration_results_get_current_it (results) result (it)
integer :: it
type(integration_results_t), intent(in) :: results
it = 0
if (allocated (results%entry)) then
it = count (results%entry(1:results%n_it)%pass == results%n_pass)
end if
end function integration_results_get_current_it
function integration_results_get_last_it (results) result (it)
integer :: it
type(integration_results_t), intent(in) :: results
it = results%n_it
end function integration_results_get_last_it
@ %def integration_results_get_current_pass
@ %def integration_results_get_current_it
@ %def integration_results_get_last_it
@ Return the index of the best iteration (lowest accuracy value)
within the current pass. If none qualifies, return zero.
<<Integration results: procedures>>=
function integration_results_get_best_it (results) result (it)
integer :: it
type(integration_results_t), intent(in) :: results
integer :: i
real(default) :: acc, acc_best
acc_best = -1
it = 0
do i = 1, results%n_it
if (results%entry(i)%pass == results%n_pass) then
acc = integration_entry_get_accuracy (results%entry(i))
if (acc_best < 0 .or. acc <= acc_best) then
acc_best = acc
it = i
end if
end if
end do
end function integration_results_get_best_it
@ %def integration_results_get_best_it
@ Compute the MD5 sum by printing everything and checksumming the
resulting file.
<<Integration results: procedures>>=
function integration_results_get_md5sum (results) result (md5sum_results)
character(32) :: md5sum_results
type(integration_results_t), intent(in) :: results
integer :: u
u = free_unit ()
open (unit = u, status = "scratch", action = "readwrite")
call results%write_verbose (u)
rewind (u)
md5sum_results = md5sum (u)
close (u)
end function integration_results_get_md5sum
@ %def integration_results_get_md5sum
@
This is (ab)used to suppress numerical noise when integrating constant
matrix elements.
<<Integration results: integration results: TBP>>=
procedure :: pacify => integration_results_pacify
<<Integration results: procedures>>=
subroutine integration_results_pacify (results, efficiency_reset)
class(integration_results_t), intent(inout) :: results
logical, intent(in), optional :: efficiency_reset
integer :: i
logical :: reset
reset = .false.
if (present (efficiency_reset)) reset = efficiency_reset
if (allocated (results%entry)) then
do i = 1, size (results%entry)
call pacify (results%entry(i)%error, &
results%entry(i)%integral * 1.E-9_default)
if (reset) results%entry(i)%efficiency = 1
end do
end if
if (allocated (results%average)) then
do i = 1, size (results%average)
call pacify (results%average(i)%error, &
results%average(i)%integral * 1.E-9_default)
if (reset) results%average(i)%efficiency = 1
end do
end if
end subroutine integration_results_pacify
@ %def integration_results_pacify
@
<<Integration results: integration results: TBP>>=
procedure :: record_correction => integration_results_record_correction
<<Integration results: procedures>>=
subroutine integration_results_record_correction (object, corr, err)
class(integration_results_t), intent(inout) :: object
real(default), intent(in) :: corr, err
integer :: u
u = given_output_unit ()
if (object%screen) then
call object%write_hline (u)
call msg_message ("NLO Correction: [O(alpha_s+1)/O(alpha_s)]")
write(msg_buffer,'(1X,A1,F8.4,A4,F9.5,1X,A3)') '(', corr, ' +- ', err, ') %'
call msg_message ()
end if
end subroutine integration_results_record_correction
@ %def integration_results_record_correction
@
\subsection{Results display}
Write a driver file for history visualization.
The ratio of $y$ range over $y$ value must not become too small, otherwise
we run into an arithmetic overflow in GAMELAN. 2\% appears to be safe.
<<Integration results: parameters>>=
real, parameter, public :: GML_MIN_RANGE_RATIO = 0.02
<<Integration results: public>>=
public :: integration_results_write_driver
<<Integration results: procedures>>=
subroutine integration_results_write_driver (results, filename, eff_reset)
type(integration_results_t), intent(inout) :: results
type(string_t), intent(in) :: filename
logical, intent(in), optional :: eff_reset
type(string_t) :: file_tex
integer :: unit
integer :: n, i, n_pass, pass
integer, dimension(:), allocatable :: ipass
real(default) :: ymin, ymax, yavg, ydif, y0, y1
real(default), dimension(results%n_it) :: ymin_arr, ymax_arr
logical :: reset
file_tex = filename // ".tex"
unit = free_unit ()
open (unit=unit, file=char(file_tex), action="write", status="replace")
reset = .false.; if (present (eff_reset)) reset = eff_reset
n = results%n_it
n_pass = results%n_pass
allocate (ipass (results%n_pass))
ipass(1) = 0
pass = 2
do i = 1, n-1
if (integration_entry_get_pass (results%entry(i)) &
/= integration_entry_get_pass (results%entry(i+1))) then
ipass(pass) = i
pass = pass + 1
end if
end do
ymin_arr = integration_entry_get_integral (results%entry(:n)) &
- integration_entry_get_error (results%entry(:n))
ymin = minval (ymin_arr)
ymax_arr = integration_entry_get_integral (results%entry(:n)) &
+ integration_entry_get_error (results%entry(:n))
ymax = maxval (ymax_arr)
yavg = (ymax + ymin) / 2
ydif = (ymax - ymin)
if (ydif * 1.5 > GML_MIN_RANGE_RATIO * yavg) then
y0 = yavg - ydif * 0.75
y1 = yavg + ydif * 0.75
else
y0 = yavg * (1 - GML_MIN_RANGE_RATIO / 2)
y1 = yavg * (1 + GML_MIN_RANGE_RATIO / 2)
end if
write (unit, "(A)") "\documentclass{article}"
write (unit, "(A)") "\usepackage{a4wide}"
write (unit, "(A)") "\usepackage{gamelan}"
write (unit, "(A)") "\usepackage{amsmath}"
write (unit, "(A)") ""
write (unit, "(A)") "\begin{document}"
write (unit, "(A)") "\begin{gmlfile}"
write (unit, "(A)") "\section*{Integration Results Display}"
write (unit, "(A)") ""
write (unit, "(A)") "Process: \verb|" // char (filename) // "|"
write (unit, "(A)") ""
write (unit, "(A)") "\vspace*{2\baselineskip}"
write (unit, "(A)") "\unitlength 1mm"
write (unit, "(A)") "\begin{gmlcode}"
write (unit, "(A)") " picture sym; sym = fshape (circle scaled 1mm)();"
write (unit, "(A)") " color col.band; col.band = 0.9white;"
write (unit, "(A)") " color col.eband; col.eband = 0.98white;"
write (unit, "(A)") "\end{gmlcode}"
write (unit, "(A)") "\begin{gmlgraph*}(130,180)[history]"
write (unit, "(A)") " setup (linear, linear);"
write (unit, "(A,I0,A)") " history.n_pass = ", n_pass, ";"
write (unit, "(A,I0,A)") " history.n_it = ", n, ";"
write (unit, "(A,A,A)") " history.y0 = #""", char (mp_format (y0)), """;"
write (unit, "(A,A,A)") " history.y1 = #""", char (mp_format (y1)), """;"
write (unit, "(A)") &
" graphrange (#0.5, history.y0), (#(n+0.5), history.y1);"
do pass = 1, n_pass
write (unit, "(A,I0,A,I0,A)") &
" history.pass[", pass, "] = ", ipass(pass), ";"
write (unit, "(A,I0,A,A,A)") &
" history.avg[", pass, "] = #""", &
char (mp_format &
(integration_entry_get_integral (results%average(pass)))), &
""";"
write (unit, "(A,I0,A,A,A)") &
" history.err[", pass, "] = #""", &
char (mp_format &
(integration_entry_get_error (results%average(pass)))), &
""";"
write (unit, "(A,I0,A,A,A)") &
" history.chi[", pass, "] = #""", &
char (mp_format &
(integration_entry_get_chi2 (results%average(pass)))), &
""";"
end do
write (unit, "(A,I0,A,I0,A)") &
" history.pass[", n_pass + 1, "] = ", n, ";"
write (unit, "(A)") " for i = 1 upto history.n_pass:"
write (unit, "(A)") " if history.chi[i] greater one:"
write (unit, "(A)") " fill plot ("
write (unit, "(A)") &
" (#(history.pass[i] +.5), " &
// "history.avg[i] minus history.err[i] times history.chi[i]),"
write (unit, "(A)") &
" (#(history.pass[i+1]+.5), " &
// "history.avg[i] minus history.err[i] times history.chi[i]),"
write (unit, "(A)") &
" (#(history.pass[i+1]+.5), " &
// "history.avg[i] plus history.err[i] times history.chi[i]),"
write (unit, "(A)") &
" (#(history.pass[i] +.5), " &
// "history.avg[i] plus history.err[i] times history.chi[i])"
write (unit, "(A)") " ) withcolor col.eband fi;"
write (unit, "(A)") " fill plot ("
write (unit, "(A)") &
" (#(history.pass[i] +.5), history.avg[i] minus history.err[i]),"
write (unit, "(A)") &
" (#(history.pass[i+1]+.5), history.avg[i] minus history.err[i]),"
write (unit, "(A)") &
" (#(history.pass[i+1]+.5), history.avg[i] plus history.err[i]),"
write (unit, "(A)") &
" (#(history.pass[i] +.5), history.avg[i] plus history.err[i])"
write (unit, "(A)") " ) withcolor col.band;"
write (unit, "(A)") " draw plot ("
write (unit, "(A)") &
" (#(history.pass[i] +.5), history.avg[i]),"
write (unit, "(A)") &
" (#(history.pass[i+1]+.5), history.avg[i])"
write (unit, "(A)") " ) dashed evenly;"
write (unit, "(A)") " endfor"
write (unit, "(A)") " for i = 1 upto history.n_pass + 1:"
write (unit, "(A)") " draw plot ("
write (unit, "(A)") &
" (#(history.pass[i]+.5), history.y0),"
write (unit, "(A)") &
" (#(history.pass[i]+.5), history.y1)"
write (unit, "(A)") " ) dashed withdots;"
write (unit, "(A)") " endfor"
do i = 1, n
write (unit, "(A,I0,A,A,A,A,A)") " plot (history) (#", &
i, ", #""", &
char (mp_format (integration_entry_get_integral (results%entry(i)))),&
""") vbar #""", &
char (mp_format (integration_entry_get_error (results%entry(i)))), &
""";"
end do
write (unit, "(A)") " draw piecewise from (history) " &
// "withsymbol sym;"
write (unit, "(A)") " fullgrid.lr (5,20);"
write (unit, "(A)") " standardgrid.bt (n);"
write (unit, "(A)") " begingmleps ""Whizard-Logo.eps"";"
write (unit, "(A)") " base := (120*unitlength,170*unitlength);"
write (unit, "(A)") " height := 9.6*unitlength;"
write (unit, "(A)") " width := 11.2*unitlength;"
write (unit, "(A)") " endgmleps;"
write (unit, "(A)") "\end{gmlgraph*}"
write (unit, "(A)") "\end{gmlfile}"
write (unit, "(A)") "\clearpage"
write (unit, "(A)") "\begin{verbatim}"
if (reset) then
call results%pacify (reset)
end if
call integration_results_write (results, unit)
write (unit, "(A)") "\end{verbatim}"
write (unit, "(A)") "\end{document}"
close (unit)
end subroutine integration_results_write_driver
@ %def integration_results_write_driver
@ Call \LaTeX\ and Metapost for the history driver file, and convert to PS and
PDF.
<<Integration results: public>>=
public :: integration_results_compile_driver
<<Integration results: procedures>>=
subroutine integration_results_compile_driver (results, filename, os_data)
type(integration_results_t), intent(in) :: results
type(string_t), intent(in) :: filename
type(os_data_t), intent(in) :: os_data
integer :: unit_dev, status
type(string_t) :: file_tex, file_dvi, file_ps, file_pdf, file_mp
type(string_t) :: setenv_tex, setenv_mp, pipe, pipe_dvi
if (.not. os_data%event_analysis) then
call msg_warning ("Skipping integration history display " &
// "because latex or mpost is not available")
return
end if
file_tex = filename // ".tex"
file_dvi = filename // ".dvi"
file_ps = filename // ".ps"
file_pdf = filename // ".pdf"
file_mp = filename // ".mp"
call msg_message ("Creating integration history display "&
// char (file_ps) // " and " // char (file_pdf))
BLOCK: do
unit_dev = free_unit ()
open (file = "/dev/null", unit = unit_dev, &
action = "write", iostat = status)
if (status /= 0) then
pipe = ""
pipe_dvi = ""
else
pipe = " > /dev/null"
pipe_dvi = " 2>/dev/null 1>/dev/null"
end if
close (unit_dev)
if (os_data%whizard_texpath /= "") then
setenv_tex = &
"TEXINPUTS=" // os_data%whizard_texpath // ":$TEXINPUTS "
setenv_mp = &
"MPINPUTS=" // os_data%whizard_texpath // ":$MPINPUTS "
else
setenv_tex = ""
setenv_mp = ""
end if
call os_system_call (setenv_tex // os_data%latex // " " // &
file_tex // pipe, status)
if (status /= 0) exit BLOCK
if (os_data%gml /= "") then
call os_system_call (setenv_mp // os_data%gml // " " // &
file_mp // pipe, status)
else
call msg_error ("Could not use GAMELAN/MetaPOST.")
exit BLOCK
end if
if (status /= 0) exit BLOCK
call os_system_call (setenv_tex // os_data%latex // " " // &
file_tex // pipe, status)
if (status /= 0) exit BLOCK
if (os_data%event_analysis_ps) then
call os_system_call (os_data%dvips // " " // &
file_dvi // pipe_dvi, status)
if (status /= 0) exit BLOCK
else
call msg_warning ("Skipping PostScript generation because dvips " &
// "is not available")
exit BLOCK
end if
if (os_data%event_analysis_pdf) then
call os_system_call (os_data%ps2pdf // " " // &
file_ps, status)
if (status /= 0) exit BLOCK
else
call msg_warning ("Skipping PDF generation because ps2pdf " &
// "is not available")
exit BLOCK
end if
exit BLOCK
end do BLOCK
if (status /= 0) then
call msg_error ("Unable to compile integration history display")
end if
end subroutine integration_results_compile_driver
@ %def integration_results_compile_driver
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[integration_results_ut.f90]]>>=
<<File header>>
module integration_results_ut
use unit_tests
use integration_results_uti
<<Standard module head>>
<<integration results: public test>>
contains
<<integration results: test driver>>
end module integration_results_ut
@ %def integration_results_ut
@
<<[[integration_results_uti.f90]]>>=
<<File header>>
module integration_results_uti
<<Use kinds>>
use integration_results
<<Standard module head>>
<<integration results: test declarations>>
contains
<<integration results: tests>>
end module integration_results_uti
@ %def integration_results_ut
@ API: driver for the unit tests below.
<<integration results: public test>>=
public :: integration_results_test
<<integration results: test driver>>=
subroutine integration_results_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<integration results: execute tests>>
end subroutine integration_results_test
@ %def integration_results_test
@
\subsubsection{Integration entry}
<<integration results: execute tests>>=
call test (integration_results_1, "integration_results_1", &
"record single line and write to log", &
u, results)
<<integration results: test declarations>>=
public :: integration_results_1
<<integration results: tests>>=
subroutine integration_results_1 (u)
integer, intent(in) :: u
type(integration_entry_t) :: entry
write (u, "(A)") "* Test output: integration_results_1"
write (u, "(A)") "* Purpose: record single entry and write to log"
write (u, "(A)")
write (u, "(A)") "* Write single line output"
write (u, "(A)")
entry = integration_entry_t ( &
& process_type = 1, &
& pass = 1, &
& it = 1, &
& n_it = 10, &
& n_calls = 1000, &
& n_calls_valid = 500, &
& improved = .true., &
& integral = 1.0_default, &
& error = 0.5_default, &
& efficiency = 0.25_default, &
& efficiency_pos = 0.22_default, &
& efficiency_neg = 0.03_default)
call entry%write (u, 3)
write (u, "(A)")
write (u, "(A)") "* Test output end: integration_results_1"
end subroutine integration_results_1
@ %def integration_results_1
@
<<integration results: execute tests>>=
call test (integration_results_2, "integration_results_2", &
"record single result and write to log", &
u, results)
<<integration results: test declarations>>=
public :: integration_results_2
<<integration results: tests>>=
subroutine integration_results_2 (u)
integer, intent(in) :: u
type(integration_results_t) :: results
write (u, "(A)") "* Test output: integration_results_2"
write (u, "(A)") "* Purpose: record single result and write to log"
write (u, "(A)")
write (u, "(A)") "* Write single line output"
write (u, "(A)")
call results%init (PRC_DECAY)
call results%append (1, 250, 0, 1.0_default, 0.5_default, 0.25_default,&
& 0._default, 0._default)
call results%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: integration_results_2"
end subroutine integration_results_2
@ %def integration_results_2
@
<<integration results: execute tests>>=
call test (integration_results_3, "integration_results_3", &
"initialize display and add/display each entry", &
u, results)
<<integration results: test declarations>>=
public :: integration_results_3
<<integration results: tests>>=
subroutine integration_results_3 (u)
integer, intent(in) :: u
type(integration_results_t) :: results
write (u, "(A)") "* Test output: integration_results_2"
write (u, "(A)") "* Purpose: intialize display, record three entries,&
& display pass average and finalize display"
write (u, "(A)")
write (u, "(A)") "* Initialize display and add entry"
write (u, "(A)")
call results%init (PRC_DECAY)
call results%set_verbosity (1)
call results%display_init (screen = .false., unit = u)
call results%new_pass ()
call results%record (1, 250, 1.0_default, 0.5_default, 0.25_default)
call results%record (1, 250, 1.1_default, 0.5_default, 0.25_default)
call results%record (1, 250, 0.9_default, 0.5_default, 0.25_default)
write (u, "(A)")
write (u, "(A)") "* Display pass"
write (u, "(A)")
call results%display_pass ()
write (u, "(A)")
write (u, "(A)") "* Finalize displays"
write (u, "(A)")
call results%display_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integration_results_3"
end subroutine integration_results_3
@ %def integration_results_3
@
<<integration results: execute tests>>=
call test (integration_results_4, "integration_results_4", &
"record extended results and display", &
u, results)
<<integration results: test declarations>>=
public :: integration_results_4
<<integration results: tests>>=
subroutine integration_results_4 (u)
integer, intent(in) :: u
type(integration_results_t) :: results
write (u, "(A)") "* Test output: integration_results_4"
write (u, "(A)") "* Purpose: record extended results and display with verbosity = 2"
write (u, "(A)")
write (u, "(A)") "* Initialize display and record extended result"
write (u, "(A)")
call results%init (PRC_DECAY)
call results%set_verbosity (2)
call results%display_init (screen = .false., unit = u)
call results%new_pass ()
call results%record (1, 250, 150, 1.0_default, 0.5_default, 0.25_default,&
& 0.22_default, 0.03_default)
call results%record (1, 250, 180, 1.1_default, 0.5_default, 0.25_default,&
& 0.23_default, 0.02_default)
call results%record (1, 250, 130, 0.9_default, 0.5_default, 0.25_default,&
& 0.25_default, 0.00_default)
write (u, "(A)")
write (u, "(A)") "* Display pass"
write (u, "(A)")
call results%display_pass ()
write (u, "(A)")
write (u, "(A)") "* Finalize displays"
write (u, "(A)")
call results%display_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integration_results_4"
end subroutine integration_results_4
@ %def integration_results_4
@
<<integration results: execute tests>>=
call test (integration_results_5, "integration_results_5", &
"record extended results and display", &
u, results)
<<integration results: test declarations>>=
public :: integration_results_5
<<integration results: tests>>=
subroutine integration_results_5 (u)
integer, intent(in) :: u
type(integration_results_t) :: results
write (u, "(A)") "* Test output: integration_results_5"
write (u, "(A)") "* Purpose: record extended results and display with verbosity = 3"
write (u, "(A)")
write (u, "(A)") "* Initialize display and record extended result"
write (u, "(A)")
call results%init (PRC_DECAY)
call results%set_verbosity (3)
call results%display_init (screen = .false., unit = u)
call results%new_pass ()
call results%record (1, 250, 150, 1.0_default, 0.5_default, 0.25_default,&
& 0.22_default, 0.03_default)
call results%record (1, 250, 180, 1.1_default, 0.5_default, 0.25_default,&
& 0.23_default, 0.02_default)
call results%record (1, 250, 130, 0.9_default, 0.5_default, 0.25_default,&
& 0.25_default, 0.00_default)
call results%display_pass ()
call results%display_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integration_results_5"
end subroutine integration_results_5
@ %def integration_results_5
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Dummy integrator}
This implementation acts as a placeholder for cases where no
integration or event generation is required at all.
<<[[mci_none.f90]]>>=
<<File header>>
module mci_none
<<Use kinds>>
use io_units, only: given_output_unit
use diagnostics, only: msg_message, msg_fatal
use phs_base, only: phs_channel_t
use mci_base
<<Standard module head>>
<<MCI none: public>>
<<MCI none: types>>
contains
<<MCI none: procedures>>
end module mci_none
@ %def mci_none
@
\subsection{Integrator}
The object contains the methods for integration and event generation.
For the actual work and data storage, it spawns an instance object.
After an integration pass, we update the [[max]] parameter to indicate
the maximum absolute value of the integrand that the integrator
encountered. This is required for event generation.
<<MCI none: public>>=
public :: mci_none_t
<<MCI none: types>>=
type, extends (mci_t) :: mci_none_t
contains
<<MCI none: mci none: TBP>>
end type mci_none_t
@ %def mci_t
@ Finalizer: no-op.
<<MCI none: mci none: TBP>>=
procedure :: final => mci_none_final
<<MCI none: procedures>>=
subroutine mci_none_final (object)
class(mci_none_t), intent(inout) :: object
end subroutine mci_none_final
@ %def mci_none_final
@ Output.
<<MCI none: mci none: TBP>>=
procedure :: write => mci_none_write
<<MCI none: procedures>>=
subroutine mci_none_write (object, unit, pacify, md5sum_version)
class(mci_none_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
logical, intent(in), optional :: md5sum_version
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Integrator: non-functional dummy"
end subroutine mci_none_write
@ %def mci_none_write
@ Startup message: short version.
<<MCI none: mci none: TBP>>=
procedure :: startup_message => mci_none_startup_message
<<MCI none: procedures>>=
subroutine mci_none_startup_message (mci, unit, n_calls)
class(mci_none_t), intent(in) :: mci
integer, intent(in), optional :: unit, n_calls
call msg_message ("Integrator: none")
end subroutine mci_none_startup_message
@ %def mci_none_startup_message
@ Log entry: just headline.
<<MCI none: mci none: TBP>>=
procedure :: write_log_entry => mci_none_write_log_entry
<<MCI none: procedures>>=
subroutine mci_none_write_log_entry (mci, u)
class(mci_none_t), intent(in) :: mci
integer, intent(in) :: u
write (u, "(1x,A)") "MC Integrator is none (no-op)"
end subroutine mci_none_write_log_entry
@ %def mci_none_write_log_entry
@ MD5 sum: nothing.
<<MCI none: mci none: TBP>>=
procedure :: compute_md5sum => mci_none_compute_md5sum
<<MCI none: procedures>>=
subroutine mci_none_compute_md5sum (mci, pacify)
class(mci_none_t), intent(inout) :: mci
logical, intent(in), optional :: pacify
end subroutine mci_none_compute_md5sum
@ %def mci_none_compute_md5sum
@ The number of channels must be one.
<<CCC MCI none: mci none: TBP>>=
procedure :: set_dimensions => mci_none_set_dimensions
<<CCC MCI none: procedures>>=
subroutine mci_none_set_dimensions (mci, n_dim, n_channel)
class(mci_none_t), intent(inout) :: mci
integer, intent(in) :: n_dim
integer, intent(in) :: n_channel
if (n_channel == 1) then
mci%n_channel = n_channel
mci%n_dim = n_dim
allocate (mci%dim_is_binned (mci%n_dim))
mci%dim_is_binned = .true.
mci%n_dim_binned = count (mci%dim_is_binned)
allocate (mci%n_bin (mci%n_dim))
mci%n_bin = 0
else
call msg_fatal ("Attempt to initialize single-channel integrator &
&for multiple channels")
end if
end subroutine mci_none_set_dimensions
@ %def mci_none_set_dimensions
@ Required by API.
<<MCI none: mci none: TBP>>=
procedure :: declare_flat_dimensions => mci_none_ignore_flat_dimensions
<<MCI none: procedures>>=
subroutine mci_none_ignore_flat_dimensions (mci, dim_flat)
class(mci_none_t), intent(inout) :: mci
integer, dimension(:), intent(in) :: dim_flat
end subroutine mci_none_ignore_flat_dimensions
@ %def mci_none_ignore_flat_dimensions
@ Required by API.
<<MCI none: mci none: TBP>>=
procedure :: declare_equivalences => mci_none_ignore_equivalences
<<MCI none: procedures>>=
subroutine mci_none_ignore_equivalences (mci, channel, dim_offset)
class(mci_none_t), intent(inout) :: mci
type(phs_channel_t), dimension(:), intent(in) :: channel
integer, intent(in) :: dim_offset
end subroutine mci_none_ignore_equivalences
@ %def mci_none_ignore_equivalences
@ Allocate instance with matching type.
<<MCI none: mci none: TBP>>=
procedure :: allocate_instance => mci_none_allocate_instance
<<MCI none: procedures>>=
subroutine mci_none_allocate_instance (mci, mci_instance)
class(mci_none_t), intent(in) :: mci
class(mci_instance_t), intent(out), pointer :: mci_instance
allocate (mci_none_instance_t :: mci_instance)
end subroutine mci_none_allocate_instance
@ %def mci_none_allocate_instance
@ Integrate. This must not be called at all.
<<MCI none: mci none: TBP>>=
procedure :: integrate => mci_none_integrate
<<MCI none: procedures>>=
subroutine mci_none_integrate (mci, instance, sampler, n_it, n_calls, &
results, pacify)
class(mci_none_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: pacify
class(mci_results_t), intent(inout), optional :: results
call msg_fatal ("Integration: attempt to integrate with the 'mci_none' method")
end subroutine mci_none_integrate
@ %def mci_none_integrate
@ Simulation initializer and finalizer: nothing to do here.
<<MCI none: mci none: TBP>>=
procedure :: prepare_simulation => mci_none_ignore_prepare_simulation
<<MCI none: procedures>>=
subroutine mci_none_ignore_prepare_simulation (mci)
class(mci_none_t), intent(inout) :: mci
end subroutine mci_none_ignore_prepare_simulation
@ %def mci_none_ignore_prepare_simulation
@ Generate events, must not be called.
<<MCI none: mci none: TBP>>=
procedure :: generate_weighted_event => mci_none_generate_no_event
procedure :: generate_unweighted_event => mci_none_generate_no_event
<<MCI none: procedures>>=
subroutine mci_none_generate_no_event (mci, instance, sampler)
class(mci_none_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
call msg_fatal ("Integration: attempt to generate event with the 'mci_none' method")
end subroutine mci_none_generate_no_event
@ %def mci_none_generate_no_event
@ Rebuild an event, no-op.
<<MCI none: mci none: TBP>>=
procedure :: rebuild_event => mci_none_rebuild_event
<<MCI none: procedures>>=
subroutine mci_none_rebuild_event (mci, instance, sampler, state)
class(mci_none_t), intent(inout) :: mci
class(mci_instance_t), intent(inout) :: instance
class(mci_sampler_t), intent(inout) :: sampler
class(mci_state_t), intent(in) :: state
end subroutine mci_none_rebuild_event
@ %def mci_none_rebuild_event
@
\subsection{Integrator instance}
Covering the case of flat dimensions, we store a complete [[x]] array. This
is filled when generating events.
<<MCI none: public>>=
public :: mci_none_instance_t
<<MCI none: types>>=
type, extends (mci_instance_t) :: mci_none_instance_t
contains
<<MCI none: mci none instance: TBP>>
end type mci_none_instance_t
@ %def mci_none_instance_t
@ Output.
<<MCI none: mci none instance: TBP>>=
procedure :: write => mci_none_instance_write
<<MCI none: procedures>>=
subroutine mci_none_instance_write (object, unit, pacify)
class(mci_none_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Integrator instance: non-functional dummy"
end subroutine mci_none_instance_write
@ %def mci_none_instance_write
@ The finalizer is empty.
<<MCI none: mci none instance: TBP>>=
procedure :: final => mci_none_instance_final
<<MCI none: procedures>>=
subroutine mci_none_instance_final (object)
class(mci_none_instance_t), intent(inout) :: object
end subroutine mci_none_instance_final
@ %def mci_none_instance_final
@ Initializer, empty.
<<MCI none: mci none instance: TBP>>=
procedure :: init => mci_none_instance_init
<<MCI none: procedures>>=
subroutine mci_none_instance_init (mci_instance, mci)
class(mci_none_instance_t), intent(out) :: mci_instance
class(mci_t), intent(in), target :: mci
end subroutine mci_none_instance_init
@ %def mci_none_instance_init
@ Copy the stored extrema of the integrand in the instance record.
<<CCC MCI none: mci none instance: TBP>>=
procedure :: get_max => mci_none_instance_get_max
<<CCC MCI none: procedures>>=
subroutine mci_none_instance_get_max (instance)
class(mci_none_instance_t), intent(inout) :: instance
associate (mci => instance%mci)
if (mci%max_known) then
instance%max_known = .true.
instance%max = mci%max
instance%min = mci%min
instance%max_abs = mci%max_abs
instance%min_abs = mci%min_abs
end if
end associate
end subroutine mci_none_instance_get_max
@ %def mci_none_instance_get_max
@ Reverse operations: recall the extrema, but only if they are wider
than the extrema already stored in the configuration. Also recalculate the
efficiency value.
<<CCC MCI none: mci none instance: TBP>>=
procedure :: set_max => mci_none_instance_set_max
<<CCC MCI none: procedures>>=
subroutine mci_none_instance_set_max (instance)
class(mci_none_instance_t), intent(inout) :: instance
associate (mci => instance%mci)
if (instance%max_known) then
if (mci%max_known) then
mci%max = max (mci%max, instance%max)
mci%min = min (mci%min, instance%min)
mci%max_abs = max (mci%max_abs, instance%max_abs)
mci%min_abs = min (mci%min_abs, instance%min_abs)
else
mci%max = instance%max
mci%min = instance%min
mci%max_abs = instance%max_abs
mci%min_abs = instance%min_abs
mci%max_known = .true.
end if
if (mci%max_abs /= 0) then
if (mci%integral_neg == 0) then
mci%efficiency = mci%integral / mci%max_abs
mci%efficiency_known = .true.
else if (mci%n_calls /= 0) then
mci%efficiency = &
(mci%integral_pos - mci%integral_neg) / mci%max_abs
mci%efficiency_known = .true.
end if
end if
end if
end associate
end subroutine mci_none_instance_set_max
@ %def mci_none_instance_set_max
@ The weight cannot be computed.
<<MCI none: mci none instance: TBP>>=
procedure :: compute_weight => mci_none_instance_compute_weight
<<MCI none: procedures>>=
subroutine mci_none_instance_compute_weight (mci, c)
class(mci_none_instance_t), intent(inout) :: mci
integer, intent(in) :: c
call msg_fatal ("Integration: attempt to compute weight with the 'mci_none' method")
end subroutine mci_none_instance_compute_weight
@ %def mci_none_instance_compute_weight
@ Record the integrand, no-op.
<<MCI none: mci none instance: TBP>>=
procedure :: record_integrand => mci_none_instance_record_integrand
<<MCI none: procedures>>=
subroutine mci_none_instance_record_integrand (mci, integrand)
class(mci_none_instance_t), intent(inout) :: mci
real(default), intent(in) :: integrand
end subroutine mci_none_instance_record_integrand
@ %def mci_none_instance_record_integrand
@ No-op.
<<MCI none: mci none instance: TBP>>=
procedure :: init_simulation => mci_none_instance_init_simulation
procedure :: final_simulation => mci_none_instance_final_simulation
<<MCI none: procedures>>=
subroutine mci_none_instance_init_simulation (instance, safety_factor)
class(mci_none_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: safety_factor
end subroutine mci_none_instance_init_simulation
subroutine mci_none_instance_final_simulation (instance)
class(mci_none_instance_t), intent(inout) :: instance
end subroutine mci_none_instance_final_simulation
@ %def mci_none_instance_init_simulation
@ %def mci_none_instance_final_simulation
@ Return excess weight for the current event: return zero, just in case.
<<MCI none: mci none instance: TBP>>=
procedure :: get_event_excess => mci_none_instance_get_event_excess
<<MCI none: procedures>>=
function mci_none_instance_get_event_excess (mci) result (excess)
class(mci_none_instance_t), intent(in) :: mci
real(default) :: excess
excess = 0
end function mci_none_instance_get_event_excess
@ %def mci_none_instance_get_event_excess
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[mci_none_ut.f90]]>>=
<<File header>>
module mci_none_ut
use unit_tests
use mci_none_uti
<<Standard module head>>
<<MCI none: public test>>
contains
<<MCI none: test driver>>
end module mci_none_ut
@ %def mci_none_ut
@
<<[[mci_none_uti.f90]]>>=
<<File header>>
module mci_none_uti
use mci_base
use mci_none
<<Standard module head>>
<<MCI none: test declarations>>
<<MCI none: test types>>
contains
<<MCI none: tests>>
end module mci_none_uti
@ %def mci_none_ut
@ API: driver for the unit tests below.
<<MCI none: public test>>=
public :: mci_none_test
<<MCI none: test driver>>=
subroutine mci_none_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<MCI none: execute tests>>
end subroutine mci_none_test
@ %def mci_none_test
@
\subsubsection{Trivial sanity check}
Construct an integrator and display it.
<<MCI none: execute tests>>=
call test (mci_none_1, "mci_none_1", &
"dummy integrator", &
u, results)
<<MCI none: test declarations>>=
public :: mci_none_1
<<MCI none: tests>>=
subroutine mci_none_1 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
write (u, "(A)") "* Test output: mci_none_1"
write (u, "(A)") "* Purpose: display mci configuration"
write (u, "(A)")
write (u, "(A)") "* Allocate integrator"
write (u, "(A)")
allocate (mci_none_t :: mci)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
call mci_instance%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_none_1"
end subroutine mci_none_1
@ %def mci_none_1
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Simple midpoint integration}
This is a most simple implementation of an integrator. The algorithm
is the straightforward multi-dimensional midpoint rule, i.e., the
integration hypercube is binned uniformly, the integrand is evaluated
at the midpoints of each bin, and the result is the average. The
binning is equivalent for all integration dimensions.
This rule is accurate to the order $h^2$, where $h$ is the bin width.
Given that $h=N^{-1/d}$, where $d$ is the integration dimension and
$N$ is the total number of sampling points, we get a relative error
of order $N^{-2/d}$. This is superior to MC integration if $d<4$, and
equivalent if $d=4$. It is not worse than higher-order formulas
(such as Gauss integration) if the integrand is not smooth, e.g., if
it contains cuts.
The integrator is specifically single-channel. However, we do not
limit the dimension.
<<[[mci_midpoint.f90]]>>=
<<File header>>
module mci_midpoint
<<Use kinds>>
use io_units
use diagnostics
use phs_base
use mci_base
<<Standard module head>>
<<MCI midpoint: public>>
<<MCI midpoint: types>>
contains
<<MCI midpoint: procedures>>
end module mci_midpoint
@ %def mci_midpoint
@
\subsection{Integrator}
The object contains the methods for integration and event generation.
For the actual work and data storage, it spawns an instance object.
After an integration pass, we update the [[max]] parameter to indicate
the maximum absolute value of the integrand that the integrator
encountered. This is required for event generation.
<<MCI midpoint: public>>=
public :: mci_midpoint_t
<<MCI midpoint: types>>=
type, extends (mci_t) :: mci_midpoint_t
integer :: n_dim_binned = 0
logical, dimension(:), allocatable :: dim_is_binned
logical :: calls_known = .false.
integer :: n_calls = 0
integer :: n_calls_pos = 0
integer :: n_calls_nul = 0
integer :: n_calls_neg = 0
real(default) :: integral_pos = 0
real(default) :: integral_neg = 0
integer, dimension(:), allocatable :: n_bin
logical :: max_known = .false.
real(default) :: max = 0
real(default) :: min = 0
real(default) :: max_abs = 0
real(default) :: min_abs = 0
contains
<<MCI midpoint: mci midpoint: TBP>>
end type mci_midpoint_t
@ %def mci_t
@ Finalizer: base version is sufficient
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: final => mci_midpoint_final
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_final (object)
class(mci_midpoint_t), intent(inout) :: object
call object%base_final ()
end subroutine mci_midpoint_final
@ %def mci_midpoint_final
@ Output.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: write => mci_midpoint_write
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_write (object, unit, pacify, md5sum_version)
class(mci_midpoint_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
logical, intent(in), optional :: md5sum_version
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "Single-channel midpoint rule integrator:"
call object%base_write (u, pacify, md5sum_version)
if (object%n_dim_binned < object%n_dim) then
write (u, "(3x,A,99(1x,I0))") "Flat dimensions =", &
pack ([(i, i = 1, object%n_dim)], mask = .not. object%dim_is_binned)
write (u, "(3x,A,I0)") "Number of binned dim = ", object%n_dim_binned
end if
if (object%calls_known) then
write (u, "(3x,A,99(1x,I0))") "Number of bins =", object%n_bin
write (u, "(3x,A,I0)") "Number of calls = ", object%n_calls
if (object%n_calls_pos /= object%n_calls) then
write (u, "(3x,A,I0)") " positive value = ", object%n_calls_pos
write (u, "(3x,A,I0)") " zero value = ", object%n_calls_nul
write (u, "(3x,A,I0)") " negative value = ", object%n_calls_neg
write (u, "(3x,A,ES17.10)") &
"Integral (pos. part) = ", object%integral_pos
write (u, "(3x,A,ES17.10)") &
"Integral (neg. part) = ", object%integral_neg
end if
end if
if (object%max_known) then
write (u, "(3x,A,ES17.10)") "Maximum of integrand = ", object%max
write (u, "(3x,A,ES17.10)") "Minimum of integrand = ", object%min
if (object%min /= object%min_abs) then
write (u, "(3x,A,ES17.10)") "Maximum (abs. value) = ", object%max_abs
write (u, "(3x,A,ES17.10)") "Minimum (abs. value) = ", object%min_abs
end if
end if
if (allocated (object%rng)) call object%rng%write (u)
end subroutine mci_midpoint_write
@ %def mci_midpoint_write
@ Startup message: short version.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: startup_message => mci_midpoint_startup_message
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_startup_message (mci, unit, n_calls)
class(mci_midpoint_t), intent(in) :: mci
integer, intent(in), optional :: unit, n_calls
call mci%base_startup_message (unit = unit, n_calls = n_calls)
if (mci%n_dim_binned < mci%n_dim) then
write (msg_buffer, "(A,2(1x,I0,1x,A))") &
"Integrator: Midpoint rule:", &
mci%n_dim_binned, "binned dimensions"
else
write (msg_buffer, "(A,2(1x,I0,1x,A))") &
"Integrator: Midpoint rule"
end if
call msg_message (unit = unit)
end subroutine mci_midpoint_startup_message
@ %def mci_midpoint_startup_message
@ Log entry: just headline.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: write_log_entry => mci_midpoint_write_log_entry
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_write_log_entry (mci, u)
class(mci_midpoint_t), intent(in) :: mci
integer, intent(in) :: u
write (u, "(1x,A)") "MC Integrator is Midpoint rule"
end subroutine mci_midpoint_write_log_entry
@ %def mci_midpoint_write_log_entry
@ MD5 sum: nothing.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: compute_md5sum => mci_midpoint_compute_md5sum
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_compute_md5sum (mci, pacify)
class(mci_midpoint_t), intent(inout) :: mci
logical, intent(in), optional :: pacify
end subroutine mci_midpoint_compute_md5sum
@ %def mci_midpoint_compute_md5sum
@ The number of channels must be one.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: set_dimensions => mci_midpoint_set_dimensions
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_set_dimensions (mci, n_dim, n_channel)
class(mci_midpoint_t), intent(inout) :: mci
integer, intent(in) :: n_dim
integer, intent(in) :: n_channel
if (n_channel == 1) then
mci%n_channel = n_channel
mci%n_dim = n_dim
allocate (mci%dim_is_binned (mci%n_dim))
mci%dim_is_binned = .true.
mci%n_dim_binned = count (mci%dim_is_binned)
allocate (mci%n_bin (mci%n_dim))
mci%n_bin = 0
else
call msg_fatal ("Attempt to initialize single-channel integrator &
&for multiple channels")
end if
end subroutine mci_midpoint_set_dimensions
@ %def mci_midpoint_set_dimensions
@ Declare particular dimensions as flat. These dimensions will not be binned.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: declare_flat_dimensions => mci_midpoint_declare_flat_dimensions
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_declare_flat_dimensions (mci, dim_flat)
class(mci_midpoint_t), intent(inout) :: mci
integer, dimension(:), intent(in) :: dim_flat
integer :: d
mci%n_dim_binned = mci%n_dim - size (dim_flat)
do d = 1, size (dim_flat)
mci%dim_is_binned(dim_flat(d)) = .false.
end do
mci%n_dim_binned = count (mci%dim_is_binned)
end subroutine mci_midpoint_declare_flat_dimensions
@ %def mci_midpoint_declare_flat_dimensions
@ Declare particular channels as equivalent. This has no effect.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: declare_equivalences => mci_midpoint_ignore_equivalences
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_ignore_equivalences (mci, channel, dim_offset)
class(mci_midpoint_t), intent(inout) :: mci
type(phs_channel_t), dimension(:), intent(in) :: channel
integer, intent(in) :: dim_offset
end subroutine mci_midpoint_ignore_equivalences
@ %def mci_midpoint_ignore_equivalences
@ Allocate instance with matching type.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: allocate_instance => mci_midpoint_allocate_instance
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_allocate_instance (mci, mci_instance)
class(mci_midpoint_t), intent(in) :: mci
class(mci_instance_t), intent(out), pointer :: mci_instance
allocate (mci_midpoint_instance_t :: mci_instance)
end subroutine mci_midpoint_allocate_instance
@ %def mci_midpoint_allocate_instance
@ Integrate. The number of dimensions is arbitrary. We make sure
that the number of calls is evenly distributed among the dimensions.
The actual number of calls will typically be smaller than the
requested number, but never smaller than 1.
The sampling over a variable number of dimensions implies a variable
number of nested loops. We implement this by a recursive subroutine,
one loop in each recursion level.
The number of iterations [[n_it]] is ignored. Also, the error is set
to zero in the current implementation.
With this integrator, we allow the calculation to abort immediately when
forced by a signal. There is no state that we can save, hence we do not catch
an interrupt.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: integrate => mci_midpoint_integrate
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_integrate (mci, instance, sampler, n_it, n_calls, &
results, pacify)
class(mci_midpoint_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: pacify
class(mci_results_t), intent(inout), optional :: results
real(default), dimension(:), allocatable :: x
real(default) :: integral, integral_pos, integral_neg
integer :: n_bin
select type (instance)
type is (mci_midpoint_instance_t)
allocate (x (mci%n_dim))
integral = 0
integral_pos = 0
integral_neg = 0
select case (mci%n_dim_binned)
case (1)
n_bin = n_calls
case (2:)
n_bin = max (int (n_calls ** (1. / mci%n_dim_binned)), 1)
end select
where (mci%dim_is_binned)
mci%n_bin = n_bin
elsewhere
mci%n_bin = 1
end where
mci%n_calls = product (mci%n_bin)
mci%n_calls_pos = 0
mci%n_calls_nul = 0
mci%n_calls_neg = 0
mci%calls_known = .true.
call sample_dim (mci%n_dim)
mci%integral = integral / mci%n_calls
mci%integral_pos = integral_pos / mci%n_calls
mci%integral_neg = integral_neg / mci%n_calls
mci%integral_known = .true.
call instance%set_max ()
if (present (results)) then
call results%record (1, mci%n_calls, &
mci%integral, mci%error, mci%efficiency)
end if
end select
contains
recursive subroutine sample_dim (d)
integer, intent(in) :: d
integer :: i
real(default) :: value
do i = 1, mci%n_bin(d)
x(d) = (i - 0.5_default) / mci%n_bin(d)
if (d > 1) then
call sample_dim (d - 1)
else
if (signal_is_pending ()) return
call instance%evaluate (sampler, 1, x)
value = instance%get_value ()
if (value > 0) then
mci%n_calls_pos = mci%n_calls_pos + 1
integral = integral + value
integral_pos = integral_pos + value
else if (value == 0) then
mci%n_calls_nul = mci%n_calls_nul + 1
else
mci%n_calls_neg = mci%n_calls_neg + 1
integral = integral + value
integral_neg = integral_neg + value
end if
end if
end do
end subroutine sample_dim
end subroutine mci_midpoint_integrate
@ %def mci_midpoint_integrate
@ Simulation initializer and finalizer: nothing to do here.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: prepare_simulation => mci_midpoint_ignore_prepare_simulation
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_ignore_prepare_simulation (mci)
class(mci_midpoint_t), intent(inout) :: mci
end subroutine mci_midpoint_ignore_prepare_simulation
@ %def mci_midpoint_ignore_prepare_simulation
@ Generate weighted event.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: generate_weighted_event => mci_midpoint_generate_weighted_event
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_generate_weighted_event (mci, instance, sampler)
class(mci_midpoint_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
real(default), dimension(mci%n_dim) :: x
select type (instance)
type is (mci_midpoint_instance_t)
call mci%rng%generate (x)
call instance%evaluate (sampler, 1, x)
instance%excess_weight = 0
end select
end subroutine mci_midpoint_generate_weighted_event
@ %def mci_midpoint_generate_weighted_event
@ For unweighted events, we generate weighted events and apply a
simple rejection step to the relative event weight, until an event
passes.
Note that we use the [[max_abs]] value stored in the configuration
record, not the one stored in the instance. The latter may change
during event generation. After an event generation pass is over, we
may update the value for a subsequent pass.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: generate_unweighted_event => &
mci_midpoint_generate_unweighted_event
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_generate_unweighted_event (mci, instance, sampler)
class(mci_midpoint_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
real(default) :: x, norm, int
select type (instance)
type is (mci_midpoint_instance_t)
if (mci%max_known .and. mci%max_abs > 0) then
norm = abs (mci%max_abs * instance%safety_factor)
REJECTION: do
call mci%generate_weighted_event (instance, sampler)
if (sampler%is_valid ()) then
call mci%rng%generate (x)
int = abs (instance%integrand)
if (x * norm <= int) then
if (norm > 0 .and. norm < int) then
instance%excess_weight = int / norm - 1
end if
exit REJECTION
end if
end if
if (signal_is_pending ()) return
end do REJECTION
else
call msg_fatal ("Unweighted event generation: &
&maximum of integrand is zero or unknown")
end if
end select
end subroutine mci_midpoint_generate_unweighted_event
@ %def mci_midpoint_generate_unweighted_event
@ Rebuild an event, using the [[state]] input.
<<MCI midpoint: mci midpoint: TBP>>=
procedure :: rebuild_event => mci_midpoint_rebuild_event
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_rebuild_event (mci, instance, sampler, state)
class(mci_midpoint_t), intent(inout) :: mci
class(mci_instance_t), intent(inout) :: instance
class(mci_sampler_t), intent(inout) :: sampler
class(mci_state_t), intent(in) :: state
select type (instance)
type is (mci_midpoint_instance_t)
call instance%recall (sampler, state)
end select
end subroutine mci_midpoint_rebuild_event
@ %def mci_midpoint_rebuild_event
@
\subsection{Integrator instance}
Covering the case of flat dimensions, we store a complete [[x]] array. This
is filled when generating events.
<<MCI midpoint: public>>=
public :: mci_midpoint_instance_t
<<MCI midpoint: types>>=
type, extends (mci_instance_t) :: mci_midpoint_instance_t
type(mci_midpoint_t), pointer :: mci => null ()
logical :: max_known = .false.
real(default) :: max = 0
real(default) :: min = 0
real(default) :: max_abs = 0
real(default) :: min_abs = 0
real(default) :: safety_factor = 1
real(default) :: excess_weight = 0
contains
<<MCI midpoint: mci midpoint instance: TBP>>
end type mci_midpoint_instance_t
@ %def mci_midpoint_instance_t
@ Output.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: write => mci_midpoint_instance_write
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_instance_write (object, unit, pacify)
class(mci_midpoint_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A,9(1x,F12.10))") "x =", object%x(:,1)
write (u, "(1x,A,ES19.12)") "Integrand = ", object%integrand
write (u, "(1x,A,ES19.12)") "Weight = ", object%mci_weight
if (object%safety_factor /= 1) then
write (u, "(1x,A,ES19.12)") "Safety f = ", object%safety_factor
end if
if (object%excess_weight /= 0) then
write (u, "(1x,A,ES19.12)") "Excess = ", object%excess_weight
end if
if (object%max_known) then
write (u, "(1x,A,ES19.12)") "Maximum = ", object%max
write (u, "(1x,A,ES19.12)") "Minimum = ", object%min
if (object%min /= object%min_abs) then
write (u, "(1x,A,ES19.12)") "Max.(abs) = ", object%max_abs
write (u, "(1x,A,ES19.12)") "Min.(abs) = ", object%min_abs
end if
end if
end subroutine mci_midpoint_instance_write
@ %def mci_midpoint_instance_write
@ The finalizer is empty.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: final => mci_midpoint_instance_final
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_instance_final (object)
class(mci_midpoint_instance_t), intent(inout) :: object
end subroutine mci_midpoint_instance_final
@ %def mci_midpoint_instance_final
@ Initializer.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: init => mci_midpoint_instance_init
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_instance_init (mci_instance, mci)
class(mci_midpoint_instance_t), intent(out) :: mci_instance
class(mci_t), intent(in), target :: mci
call mci_instance%base_init (mci)
select type (mci)
type is (mci_midpoint_t)
mci_instance%mci => mci
call mci_instance%get_max ()
mci_instance%selected_channel = 1
end select
end subroutine mci_midpoint_instance_init
@ %def mci_midpoint_instance_init
@ Copy the stored extrema of the integrand in the instance record.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: get_max => mci_midpoint_instance_get_max
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_instance_get_max (instance)
class(mci_midpoint_instance_t), intent(inout) :: instance
associate (mci => instance%mci)
if (mci%max_known) then
instance%max_known = .true.
instance%max = mci%max
instance%min = mci%min
instance%max_abs = mci%max_abs
instance%min_abs = mci%min_abs
end if
end associate
end subroutine mci_midpoint_instance_get_max
@ %def mci_midpoint_instance_get_max
@ Reverse operations: recall the extrema, but only if they are wider
than the extrema already stored in the configuration. Also recalculate the
efficiency value.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: set_max => mci_midpoint_instance_set_max
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_instance_set_max (instance)
class(mci_midpoint_instance_t), intent(inout) :: instance
associate (mci => instance%mci)
if (instance%max_known) then
if (mci%max_known) then
mci%max = max (mci%max, instance%max)
mci%min = min (mci%min, instance%min)
mci%max_abs = max (mci%max_abs, instance%max_abs)
mci%min_abs = min (mci%min_abs, instance%min_abs)
else
mci%max = instance%max
mci%min = instance%min
mci%max_abs = instance%max_abs
mci%min_abs = instance%min_abs
mci%max_known = .true.
end if
if (mci%max_abs /= 0) then
if (mci%integral_neg == 0) then
mci%efficiency = mci%integral / mci%max_abs
mci%efficiency_known = .true.
else if (mci%n_calls /= 0) then
mci%efficiency = &
(mci%integral_pos - mci%integral_neg) / mci%max_abs
mci%efficiency_known = .true.
end if
end if
end if
end associate
end subroutine mci_midpoint_instance_set_max
@ %def mci_midpoint_instance_set_max
@ The weight is the Jacobian of the mapping for the only channel.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: compute_weight => mci_midpoint_instance_compute_weight
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_instance_compute_weight (mci, c)
class(mci_midpoint_instance_t), intent(inout) :: mci
integer, intent(in) :: c
select case (c)
case (1)
mci%mci_weight = mci%f(1)
case default
call msg_fatal ("MCI midpoint integrator: only single channel supported")
end select
end subroutine mci_midpoint_instance_compute_weight
@ %def mci_midpoint_instance_compute_weight
@ Record the integrand. Update stored values for maximum and minimum.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: record_integrand => mci_midpoint_instance_record_integrand
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_instance_record_integrand (mci, integrand)
class(mci_midpoint_instance_t), intent(inout) :: mci
real(default), intent(in) :: integrand
mci%integrand = integrand
if (mci%max_known) then
mci%max = max (mci%max, integrand)
mci%min = min (mci%min, integrand)
mci%max_abs = max (mci%max_abs, abs (integrand))
mci%min_abs = min (mci%min_abs, abs (integrand))
else
mci%max = integrand
mci%min = integrand
mci%max_abs = abs (integrand)
mci%min_abs = abs (integrand)
mci%max_known = .true.
end if
end subroutine mci_midpoint_instance_record_integrand
@ %def mci_midpoint_instance_record_integrand
@ We store the safety factor, otherwise nothing to do here.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: init_simulation => mci_midpoint_instance_init_simulation
procedure :: final_simulation => mci_midpoint_instance_final_simulation
<<MCI midpoint: procedures>>=
subroutine mci_midpoint_instance_init_simulation (instance, safety_factor)
class(mci_midpoint_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: safety_factor
if (present (safety_factor)) instance%safety_factor = safety_factor
end subroutine mci_midpoint_instance_init_simulation
subroutine mci_midpoint_instance_final_simulation (instance)
class(mci_midpoint_instance_t), intent(inout) :: instance
end subroutine mci_midpoint_instance_final_simulation
@ %def mci_midpoint_instance_init_simulation
@ %def mci_midpoint_instance_final_simulation
@ Return excess weight for the current event.
<<MCI midpoint: mci midpoint instance: TBP>>=
procedure :: get_event_excess => mci_midpoint_instance_get_event_excess
<<MCI midpoint: procedures>>=
function mci_midpoint_instance_get_event_excess (mci) result (excess)
class(mci_midpoint_instance_t), intent(in) :: mci
real(default) :: excess
excess = mci%excess_weight
end function mci_midpoint_instance_get_event_excess
@ %def mci_midpoint_instance_get_event_excess
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[mci_midpoint_ut.f90]]>>=
<<File header>>
module mci_midpoint_ut
use unit_tests
use mci_midpoint_uti
<<Standard module head>>
<<MCI midpoint: public test>>
contains
<<MCI midpoint: test driver>>
end module mci_midpoint_ut
@ %def mci_midpoint_ut
@
<<[[mci_midpoint_uti.f90]]>>=
<<File header>>
module mci_midpoint_uti
<<Use kinds>>
use io_units
use rng_base
use mci_base
use mci_midpoint
use rng_base_ut, only: rng_test_t
<<Standard module head>>
<<MCI midpoint: test declarations>>
<<MCI midpoint: test types>>
contains
<<MCI midpoint: tests>>
end module mci_midpoint_uti
@ %def mci_midpoint_ut
@ API: driver for the unit tests below.
<<MCI midpoint: public test>>=
public :: mci_midpoint_test
<<MCI midpoint: test driver>>=
subroutine mci_midpoint_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<MCI midpoint: execute tests>>
end subroutine mci_midpoint_test
@ %def mci_midpoint_test
@
\subsubsection{Test sampler}
A test sampler object should implement a function with known integral that
we can use to check the integrator.
This is the function $f(x) = 3 x^2$ with integral $\int_0^1
f(x)\,dx=1$ and maximum $f(1)=3$. If the integration dimension is
greater than one, the function is extended as a constant in the other
dimension(s).
Mimicking the behavior of a process object, we store the argument
and result inside the sampler, so we can [[fetch]] results.
<<MCI midpoint: test types>>=
type, extends (mci_sampler_t) :: test_sampler_1_t
real(default), dimension(:), allocatable :: x
real(default) :: val
contains
<<MCI midpoint: test sampler 1: TBP>>
end type test_sampler_1_t
@ %def test_sampler_1_t
@ Output: There is nothing stored inside, so just print an informative line.
<<MCI midpoint: test sampler 1: TBP>>=
procedure :: write => test_sampler_1_write
<<MCI midpoint: tests>>=
subroutine test_sampler_1_write (object, unit, testflag)
class(test_sampler_1_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2"
end subroutine test_sampler_1_write
@ %def test_sampler_1_write
@ Evaluation: compute the function value. The output $x$ parameter
(only one channel) is identical to the input $x$, and the Jacobian is 1.
<<MCI midpoint: test sampler 1: TBP>>=
procedure :: evaluate => test_sampler_1_evaluate
<<MCI midpoint: tests>>=
subroutine test_sampler_1_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_1_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
if (allocated (sampler%x)) deallocate (sampler%x)
allocate (sampler%x (size (x_in)))
sampler%x = x_in
sampler%val = 3 * x_in(1) ** 2
call sampler%fetch (val, x, f)
end subroutine test_sampler_1_evaluate
@ %def test_sampler_1_evaluate
@ The point is always valid.
<<MCI midpoint: test sampler 1: TBP>>=
procedure :: is_valid => test_sampler_1_is_valid
<<MCI midpoint: tests>>=
function test_sampler_1_is_valid (sampler) result (valid)
class(test_sampler_1_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_1_is_valid
@ %def test_sampler_1_is_valid
@ Rebuild: compute all but the function value.
<<MCI midpoint: test sampler 1: TBP>>=
procedure :: rebuild => test_sampler_1_rebuild
<<MCI midpoint: tests>>=
subroutine test_sampler_1_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_1_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
if (allocated (sampler%x)) deallocate (sampler%x)
allocate (sampler%x (size (x_in)))
sampler%x = x_in
sampler%val = val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_1_rebuild
@ %def test_sampler_1_rebuild
@ Extract the results.
<<MCI midpoint: test sampler 1: TBP>>=
procedure :: fetch => test_sampler_1_fetch
<<MCI midpoint: tests>>=
subroutine test_sampler_1_fetch (sampler, val, x, f)
class(test_sampler_1_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_1_fetch
@ %def test_sampler_1_fetch
@
This is the function $f(x) = 3 x^2 + 2 y$ with integral $\int_0^1
f(x,y)\,dx\,dy=2$ and maximum $f(1)=5$.
<<MCI midpoint: test types>>=
type, extends (mci_sampler_t) :: test_sampler_2_t
real(default) :: val
real(default), dimension(2) :: x
contains
<<MCI midpoint: test sampler 2: TBP>>
end type test_sampler_2_t
@ %def test_sampler_2_t
@ Output: There is nothing stored inside, so just print an informative line.
<<MCI midpoint: test sampler 2: TBP>>=
procedure :: write => test_sampler_2_write
<<MCI midpoint: tests>>=
subroutine test_sampler_2_write (object, unit, testflag)
class(test_sampler_2_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2 + 2 y"
end subroutine test_sampler_2_write
@ %def test_sampler_2_write
@ Evaluate: compute the function value. The output $x$ parameter
(only one channel) is identical to the input $x$, and the Jacobian is 1.
<<MCI midpoint: test sampler 2: TBP>>=
procedure :: evaluate => test_sampler_2_evaluate
<<MCI midpoint: tests>>=
subroutine test_sampler_2_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_2_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
sampler%x = x_in
sampler%val = 3 * x_in(1) ** 2 + 2 * x_in(2)
call sampler%fetch (val, x, f)
end subroutine test_sampler_2_evaluate
@ %def test_sampler_2_evaluate
@ The point is always valid.
<<MCI midpoint: test sampler 2: TBP>>=
procedure :: is_valid => test_sampler_2_is_valid
<<MCI midpoint: tests>>=
function test_sampler_2_is_valid (sampler) result (valid)
class(test_sampler_2_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_2_is_valid
@ %def test_sampler_2_is_valid
@ Rebuild: compute all but the function value.
<<MCI midpoint: test sampler 2: TBP>>=
procedure :: rebuild => test_sampler_2_rebuild
<<MCI midpoint: tests>>=
subroutine test_sampler_2_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_2_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
sampler%x = x_in
sampler%val = val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_2_rebuild
@ %def test_sampler_2_rebuild
<<MCI midpoint: test sampler 2: TBP>>=
procedure :: fetch => test_sampler_2_fetch
<<MCI midpoint: tests>>=
subroutine test_sampler_2_fetch (sampler, val, x, f)
class(test_sampler_2_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_2_fetch
@ %def test_sampler_2_fetch
@
This is the function $f(x) = (1 - 3 x^2)\,\theta(x-1/2)$ with integral
$\int_0^1 f(x)\,dx=-3/8$, minimum $f(1)=-2$ and maximum $f(1/2)=1/4$.
If the integration dimension is greater than one, the function is
extended as a constant in the other dimension(s).
<<MCI midpoint: test types>>=
type, extends (mci_sampler_t) :: test_sampler_4_t
real(default) :: val
real(default), dimension(:), allocatable :: x
contains
<<MCI midpoint: test sampler 4: TBP>>
end type test_sampler_4_t
@ %def test_sampler_4_t
@ Output: There is nothing stored inside, so just print an informative line.
<<MCI midpoint: test sampler 4: TBP>>=
procedure :: write => test_sampler_4_write
<<MCI midpoint: tests>>=
subroutine test_sampler_4_write (object, unit, testflag)
class(test_sampler_4_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Test sampler: f(x) = 1 - 3 x^2"
end subroutine test_sampler_4_write
@ %def test_sampler_4_write
@ Evaluation: compute the function value. The output $x$ parameter
(only one channel) is identical to the input $x$, and the Jacobian is 1.
<<MCI midpoint: test sampler 4: TBP>>=
procedure :: evaluate => test_sampler_4_evaluate
<<MCI midpoint: tests>>=
subroutine test_sampler_4_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_4_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
if (x_in(1) >= .5_default) then
sampler%val = 1 - 3 * x_in(1) ** 2
else
sampler%val = 0
end if
if (.not. allocated (sampler%x)) allocate (sampler%x (size (x_in)))
sampler%x = x_in
call sampler%fetch (val, x, f)
end subroutine test_sampler_4_evaluate
@ %def test_sampler_4_evaluate
@ The point is always valid.
<<MCI midpoint: test sampler 4: TBP>>=
procedure :: is_valid => test_sampler_4_is_valid
<<MCI midpoint: tests>>=
function test_sampler_4_is_valid (sampler) result (valid)
class(test_sampler_4_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_4_is_valid
@ %def test_sampler_4_is_valid
@ Rebuild: compute all but the function value.
<<MCI midpoint: test sampler 4: TBP>>=
procedure :: rebuild => test_sampler_4_rebuild
<<MCI midpoint: tests>>=
subroutine test_sampler_4_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_4_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
sampler%x = x_in
sampler%val = val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_4_rebuild
@ %def test_sampler_4_rebuild
<<MCI midpoint: test sampler 4: TBP>>=
procedure :: fetch => test_sampler_4_fetch
<<MCI midpoint: tests>>=
subroutine test_sampler_4_fetch (sampler, val, x, f)
class(test_sampler_4_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_4_fetch
@ %def test_sampler_4_fetch
@
\subsubsection{One-dimensional integration}
Construct an integrator and use it for a one-dimensional sampler.
<<MCI midpoint: execute tests>>=
call test (mci_midpoint_1, "mci_midpoint_1", &
"one-dimensional integral", &
u, results)
<<MCI midpoint: test declarations>>=
public :: mci_midpoint_1
<<MCI midpoint: tests>>=
subroutine mci_midpoint_1 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
write (u, "(A)") "* Test output: mci_midpoint_1"
write (u, "(A)") "* Purpose: integrate function in one dimension"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_midpoint_t :: mci)
call mci%set_dimensions (1, 1)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_1_t :: sampler)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for x = 0.8"
write (u, "(A)")
call mci_instance%evaluate (sampler, 1, [0.8_default])
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for x = 0.7"
write (u, "(A)")
call mci_instance%evaluate (sampler, 1, [0.7_default])
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for x = 0.9"
write (u, "(A)")
call mci_instance%evaluate (sampler, 1, [0.9_default])
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_calls = 1000"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 1, 1000)
call mci%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_midpoint_1"
end subroutine mci_midpoint_1
@ %def mci_midpoint_1
@
\subsubsection{Two-dimensional integration}
Construct an integrator and use it for a two-dimensional sampler.
<<MCI midpoint: execute tests>>=
call test (mci_midpoint_2, "mci_midpoint_2", &
"two-dimensional integral", &
u, results)
<<MCI midpoint: test declarations>>=
public :: mci_midpoint_2
<<MCI midpoint: tests>>=
subroutine mci_midpoint_2 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
write (u, "(A)") "* Test output: mci_midpoint_2"
write (u, "(A)") "* Purpose: integrate function in two dimensions"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_midpoint_t :: mci)
call mci%set_dimensions (2, 1)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_2_t :: sampler)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for x = 0.8, y = 0.2"
write (u, "(A)")
call mci_instance%evaluate (sampler, 1, [0.8_default, 0.2_default])
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_calls = 1000"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 1, 1000)
call mci%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_midpoint_2"
end subroutine mci_midpoint_2
@ %def mci_midpoint_2
@
\subsubsection{Two-dimensional integration with flat dimension}
Construct an integrator and use it for a two-dimensional sampler,
where the function is constant in the second dimension.
<<MCI midpoint: execute tests>>=
call test (mci_midpoint_3, "mci_midpoint_3", &
"two-dimensional integral with flat dimension", &
u, results)
<<MCI midpoint: test declarations>>=
public :: mci_midpoint_3
<<MCI midpoint: tests>>=
subroutine mci_midpoint_3 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
write (u, "(A)") "* Test output: mci_midpoint_3"
write (u, "(A)") "* Purpose: integrate function with one flat dimension"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_midpoint_t :: mci)
select type (mci)
type is (mci_midpoint_t)
call mci%set_dimensions (2, 1)
call mci%declare_flat_dimensions ([2])
end select
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_1_t :: sampler)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for x = 0.8, y = 0.2"
write (u, "(A)")
call mci_instance%evaluate (sampler, 1, [0.8_default, 0.2_default])
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_calls = 1000"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 1, 1000)
call mci%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_midpoint_3"
end subroutine mci_midpoint_3
@ %def mci_midpoint_3
@
\subsubsection{Integrand with sign flip}
Construct an integrator and use it for a one-dimensional sampler.
<<MCI midpoint: execute tests>>=
call test (mci_midpoint_4, "mci_midpoint_4", &
"integrand with sign flip", &
u, results)
<<MCI midpoint: test declarations>>=
public :: mci_midpoint_4
<<MCI midpoint: tests>>=
subroutine mci_midpoint_4 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
write (u, "(A)") "* Test output: mci_midpoint_4"
write (u, "(A)") "* Purpose: integrate function with sign flip &
&in one dimension"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_midpoint_t :: mci)
call mci%set_dimensions (1, 1)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_4_t :: sampler)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for x = 0.8"
write (u, "(A)")
call mci_instance%evaluate (sampler, 1, [0.8_default])
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_calls = 1000"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 1, 1000)
call mci%write (u)
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_midpoint_4"
end subroutine mci_midpoint_4
@ %def mci_midpoint_4
@
\subsubsection{Weighted events}
Generate weighted events. Without rejection, we do not need to know maxima
and minima, so we can start generating events immediately. We have two
dimensions.
<<MCI midpoint: execute tests>>=
call test (mci_midpoint_5, "mci_midpoint_5", &
"weighted events", &
u, results)
<<MCI midpoint: test declarations>>=
public :: mci_midpoint_5
<<MCI midpoint: tests>>=
subroutine mci_midpoint_5 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
class(mci_state_t), allocatable :: state
write (u, "(A)") "* Test output: mci_midpoint_5"
write (u, "(A)") "* Purpose: generate weighted events"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_midpoint_t :: mci)
call mci%set_dimensions (2, 1)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_2_t :: sampler)
write (u, "(A)") "* Initialize random-number generator"
write (u, "(A)")
allocate (rng_test_t :: rng)
call rng%init ()
call mci%import_rng (rng)
write (u, "(A)") "* Generate weighted event"
write (u, "(A)")
call mci%generate_weighted_event (mci_instance, sampler)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate weighted event"
write (u, "(A)")
call mci%generate_weighted_event (mci_instance, sampler)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Store data"
write (u, "(A)")
allocate (state)
call mci_instance%store (state)
call mci_instance%final ()
deallocate (mci_instance)
call state%write (u)
write (u, "(A)")
write (u, "(A)") "* Recall data and rebuild event"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
call mci%rebuild_event (mci_instance, sampler, state)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
deallocate (mci_instance)
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_midpoint_5"
end subroutine mci_midpoint_5
@ %def mci_midpoint_5
@
\subsubsection{Unweighted events}
Generate unweighted events. The integrand has a sign flip in it.
<<MCI midpoint: execute tests>>=
call test (mci_midpoint_6, "mci_midpoint_6", &
"unweighted events", &
u, results)
<<MCI midpoint: test declarations>>=
public :: mci_midpoint_6
<<MCI midpoint: tests>>=
subroutine mci_midpoint_6 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_midpoint_6"
write (u, "(A)") "* Purpose: generate unweighted events"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_midpoint_t :: mci)
call mci%set_dimensions (1, 1)
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_4_t :: sampler)
write (u, "(A)") "* Initialize random-number generator"
write (u, "(A)")
allocate (rng_test_t :: rng)
call rng%init ()
call mci%import_rng (rng)
write (u, "(A)") "* Integrate (determine maximum of integrand"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 1, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate unweighted event"
write (u, "(A)")
call mci%generate_unweighted_event (mci_instance, sampler)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
deallocate (mci_instance)
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_midpoint_6"
end subroutine mci_midpoint_6
@ %def mci_midpoint_6
@
\subsubsection{Excess weight}
Generate unweighted events. With only 2 points for integration, the
maximum of the integrand is too low, and we produce excess weight.
<<MCI midpoint: execute tests>>=
call test (mci_midpoint_7, "mci_midpoint_7", &
"excess weight", &
u, results)
<<MCI midpoint: test declarations>>=
public :: mci_midpoint_7
<<MCI midpoint: tests>>=
subroutine mci_midpoint_7 (u)
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_midpoint_7"
write (u, "(A)") "* Purpose: generate unweighted event &
&with excess weight"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_midpoint_t :: mci)
call mci%set_dimensions (1, 1)
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_4_t :: sampler)
write (u, "(A)") "* Initialize random-number generator"
write (u, "(A)")
allocate (rng_test_t :: rng)
call rng%init ()
call mci%import_rng (rng)
write (u, "(A)") "* Integrate (determine maximum of integrand"
write (u, "(A)")
call mci%integrate (mci_instance, sampler, 1, 2)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate unweighted event"
write (u, "(A)")
call mci_instance%init_simulation ()
call mci%generate_unweighted_event (mci_instance, sampler)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Use getter methods"
write (u, "(A)")
write (u, "(1x,A,1x,ES19.12)") "weight =", mci_instance%get_event_weight ()
write (u, "(1x,A,1x,ES19.12)") "excess =", mci_instance%get_event_excess ()
write (u, "(A)")
write (u, "(A)") "* Apply safety factor"
write (u, "(A)")
call mci_instance%init_simulation (safety_factor = 2.1_default)
write (u, "(A)") "* Generate unweighted event"
write (u, "(A)")
call mci%generate_unweighted_event (mci_instance, sampler)
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Use getter methods"
write (u, "(A)")
write (u, "(1x,A,1x,ES19.12)") "weight =", mci_instance%get_event_weight ()
write (u, "(1x,A,1x,ES19.12)") "excess =", mci_instance%get_event_excess ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
deallocate (mci_instance)
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_midpoint_7"
end subroutine mci_midpoint_7
@ %def mci_midpoint_7
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{\vamp\ interface}
The standard method for integration is \vamp: the multi-channel
version of the VEGAS algorithm. Each parameterization (channel) of
the hypercube is binned in each dimension. The binning is equally
equidistant, but an iteration of the integration procedure,
the binning is updated for each dimension, according to the variance
distribution of the integrand, summed over all other dimension. In
the next iteration, the binning approximates (hopefully) follows the
integrand more closely, and the accuracy of the result is increased.
Furthermore, the relative weight of the individual channels is also updated
after an iteration.
The bin distribution is denoted as the grid for a channel, which we
can write to file and reuse later.
In our implementation we specify the generic \vamp\ algorithm more
tightly: the number of bins is equal for all dimensions, the initial
weights are all equal. The user controls whether to update bins
and/or weights after each iteration. The integration is organized in
passes, each one consisting of several iterations with a common number
of calls to the integrand. The first passes are intended as warmup,
so the results are displayed but otherwise discarded. In the final
pass, the integration estimates for the individual iterations are
averaged for the final result.
<<[[mci_vamp.f90]]>>=
<<File header>>
module mci_vamp
<<Use kinds>>
<<Use strings>>
use io_units
use constants, only: zero
use format_utils, only: pac_fmt
use format_utils, only: write_separator
use format_defs, only: FMT_12, FMT_14, FMT_17, FMT_19
use diagnostics
use md5
use phs_base
use rng_base
use rng_tao
use vamp !NODEP!
use exceptions !NODEP!
use mci_base
<<Standard module head>>
<<MCI vamp: public>>
<<MCI vamp: types>>
<<MCI vamp: interfaces>>
contains
<<MCI vamp: procedures>>
end module mci_vamp
@ %def mci_vamp
@
\subsection{Grid parameters}
This is a transparent container. It holds the parameters that are
stored in grid files, and are checked when grid files are read.
<<MCI vamp: public>>=
public :: grid_parameters_t
<<MCI vamp: types>>=
type :: grid_parameters_t
integer :: threshold_calls = 0
integer :: min_calls_per_channel = 10
integer :: min_calls_per_bin = 10
integer :: min_bins = 3
integer :: max_bins = 20
logical :: stratified = .true.
logical :: use_vamp_equivalences = .true.
real(default) :: channel_weights_power = 0.25_default
real(default) :: accuracy_goal = 0
real(default) :: error_goal = 0
real(default) :: rel_error_goal = 0
contains
<<MCI vamp: grid parameters: TBP>>
end type grid_parameters_t
@ %def grid_parameters_t
@ I/O:
<<MCI vamp: grid parameters: TBP>>=
procedure :: write => grid_parameters_write
<<MCI vamp: procedures>>=
subroutine grid_parameters_write (object, unit)
class(grid_parameters_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,I0)") "threshold_calls = ", &
object%threshold_calls
write (u, "(3x,A,I0)") "min_calls_per_channel = ", &
object%min_calls_per_channel
write (u, "(3x,A,I0)") "min_calls_per_bin = ", &
object%min_calls_per_bin
write (u, "(3x,A,I0)") "min_bins = ", &
object%min_bins
write (u, "(3x,A,I0)") "max_bins = ", &
object%max_bins
write (u, "(3x,A,L1)") "stratified = ", &
object%stratified
write (u, "(3x,A,L1)") "use_vamp_equivalences = ", &
object%use_vamp_equivalences
write (u, "(3x,A,F10.7)") "channel_weights_power = ", &
object%channel_weights_power
if (object%accuracy_goal > 0) then
write (u, "(3x,A,F10.7)") "accuracy_goal = ", &
object%accuracy_goal
end if
if (object%error_goal > 0) then
write (u, "(3x,A,F10.7)") "error_goal = ", &
object%error_goal
end if
if (object%rel_error_goal > 0) then
write (u, "(3x,A,F10.7)") "rel_error_goal = ", &
object%rel_error_goal
end if
end subroutine grid_parameters_write
@ %def grid_parameters_write
@
\subsection{History parameters}
The history parameters are also stored in a transparent container.
This is not a part of the grid definition, and should not be included
in the MD5 sum.
<<MCI vamp: public>>=
public :: history_parameters_t
<<MCI vamp: types>>=
type :: history_parameters_t
logical :: global = .true.
logical :: global_verbose = .false.
logical :: channel = .false.
logical :: channel_verbose = .false.
contains
<<MCI vamp: history parameters: TBP>>
end type history_parameters_t
@ %def history_parameters_t
@ I/O:
<<MCI vamp: history parameters: TBP>>=
procedure :: write => history_parameters_write
<<MCI vamp: procedures>>=
subroutine history_parameters_write (object, unit)
class(history_parameters_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,L1)") "history(global) = ", object%global
write (u, "(3x,A,L1)") "history(global) verb. = ", object%global_verbose
write (u, "(3x,A,L1)") "history(channels) = ", object%channel
write (u, "(3x,A,L1)") "history(chann.) verb. = ", object%channel_verbose
end subroutine history_parameters_write
@ %def history_parameters_write
@
\subsection{Integration pass}
We store the parameters for each integration pass in a linked list.
<<MCI vamp: types>>=
type :: pass_t
integer :: i_pass = 0
integer :: i_first_it = 0
integer :: n_it = 0
integer :: n_calls = 0
integer :: n_bins = 0
logical :: adapt_grids = .false.
logical :: adapt_weights = .false.
logical :: is_final_pass = .false.
logical :: integral_defined = .false.
integer, dimension(:), allocatable :: calls
integer, dimension(:), allocatable :: calls_valid
real(default), dimension(:), allocatable :: integral
real(default), dimension(:), allocatable :: error
real(default), dimension(:), allocatable :: efficiency
type(vamp_history), dimension(:), allocatable :: v_history
type(vamp_history), dimension(:,:), allocatable :: v_histories
type(pass_t), pointer :: next => null ()
contains
<<MCI vamp: pass: TBP>>
end type pass_t
@ %def pass_t
@ Finalizer. The VAMP histories contain a pointer array.
<<MCI vamp: pass: TBP>>=
procedure :: final => pass_final
<<MCI vamp: procedures>>=
subroutine pass_final (object)
class(pass_t), intent(inout) :: object
if (allocated (object%v_history)) then
call vamp_delete_history (object%v_history)
end if
if (allocated (object%v_histories)) then
call vamp_delete_history (object%v_histories)
end if
end subroutine pass_final
@ %def pass_final
@ Output. Note that the precision of the numerical values should match the
precision for comparing output from file with data.
<<MCI vamp: pass: TBP>>=
procedure :: write => pass_write
<<MCI vamp: procedures>>=
subroutine pass_write (object, unit, pacify)
class(pass_t), intent(in) :: object
integer, intent(in) :: unit
logical, intent(in), optional :: pacify
integer :: u, i
character(len=7) :: fmt
call pac_fmt (fmt, FMT_17, FMT_14, pacify)
u = given_output_unit (unit)
write (u, "(3x,A,I0)") "n_it = ", object%n_it
write (u, "(3x,A,I0)") "n_calls = ", object%n_calls
write (u, "(3x,A,I0)") "n_bins = ", object%n_bins
write (u, "(3x,A,L1)") "adapt grids = ", object%adapt_grids
write (u, "(3x,A,L1)") "adapt weights = ", object%adapt_weights
if (object%integral_defined) then
write (u, "(3x,A)") "Results: [it, calls, valid, integral, error, efficiency]"
do i = 1, object%n_it
write (u, "(5x,I0,2(1x,I0),3(1x," // fmt // "))") &
i, object%calls(i), object%calls_valid(i), object%integral(i), object%error(i), &
object%efficiency(i)
end do
else
write (u, "(3x,A)") "Results: [undefined]"
end if
end subroutine pass_write
@ %def pass_write
@ Read and reconstruct the pass.
<<MCI vamp: pass: TBP>>=
procedure :: read => pass_read
<<MCI vamp: procedures>>=
subroutine pass_read (object, u, n_pass, n_it)
class(pass_t), intent(out) :: object
integer, intent(in) :: u, n_pass, n_it
integer :: i, j
character(80) :: buffer
object%i_pass = n_pass + 1
object%i_first_it = n_it + 1
call read_ival (u, object%n_it)
call read_ival (u, object%n_calls)
call read_ival (u, object%n_bins)
call read_lval (u, object%adapt_grids)
call read_lval (u, object%adapt_weights)
allocate (object%calls (object%n_it), source = 0)
allocate (object%calls_valid (object%n_it), source = 0)
allocate (object%integral (object%n_it), source = 0._default)
allocate (object%error (object%n_it), source = 0._default)
allocate (object%efficiency (object%n_it), source = 0._default)
read (u, "(A)") buffer
select case (trim (adjustl (buffer)))
case ("Results: [it, calls, valid, integral, error, efficiency]")
do i = 1, object%n_it
read (u, *) &
j, object%calls(i), object%calls_valid(i), object%integral(i), object%error(i), &
object%efficiency(i)
end do
object%integral_defined = .true.
case ("Results: [undefined]")
object%integral_defined = .false.
case default
call msg_fatal ("Reading integration pass: corrupted file")
end select
end subroutine pass_read
@ %def pass_read
@ Write the VAMP history for this pass. (The subroutine writes the
whole array at once.)
<<MCI vamp: pass: TBP>>=
procedure :: write_history => pass_write_history
<<MCI vamp: procedures>>=
subroutine pass_write_history (pass, unit)
class(pass_t), intent(in) :: pass
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (allocated (pass%v_history)) then
call vamp_write_history (u, pass%v_history)
else
write (u, "(1x,A)") "Global history: [undefined]"
end if
if (allocated (pass%v_histories)) then
write (u, "(1x,A)") "Channel histories:"
call vamp_write_history (u, pass%v_histories)
else
write (u, "(1x,A)") "Channel histories: [undefined]"
end if
end subroutine pass_write_history
@ %def pass_write_history
@ Given a number of calls and iterations, compute remaining data.
<<MCI vamp: pass: TBP>>=
procedure :: configure => pass_configure
<<MCI vamp: procedures>>=
subroutine pass_configure (pass, n_it, n_calls, min_calls, &
min_bins, max_bins, min_channel_calls)
class(pass_t), intent(inout) :: pass
integer, intent(in) :: n_it, n_calls, min_channel_calls
integer, intent(in) :: min_calls, min_bins, max_bins
pass%n_it = n_it
if (min_calls /= 0) then
pass%n_bins = max (min_bins, &
min (n_calls / min_calls, max_bins))
else
pass%n_bins = max_bins
end if
pass%n_calls = max (n_calls, max (min_calls, min_channel_calls))
if (pass%n_calls /= n_calls) then
write (msg_buffer, "(A,I0)") "VAMP: too few calls, resetting " &
// "n_calls to ", pass%n_calls
call msg_warning ()
end if
allocate (pass%calls (n_it), source = 0)
allocate (pass%calls_valid (n_it), source = 0)
allocate (pass%integral (n_it), source = 0._default)
allocate (pass%error (n_it), source = 0._default)
allocate (pass%efficiency (n_it), source = 0._default)
end subroutine pass_configure
@ %def pass_configure
@ Allocate the VAMP history and give options. We assume that the
[[configure]] routine above has been executed, so the number of
iterations is known.
<<MCI vamp: pass: TBP>>=
procedure :: configure_history => pass_configure_history
<<MCI vamp: procedures>>=
subroutine pass_configure_history (pass, n_channels, par)
class(pass_t), intent(inout) :: pass
integer, intent(in) :: n_channels
type(history_parameters_t), intent(in) :: par
if (par%global) then
allocate (pass%v_history (pass%n_it))
call vamp_create_history (pass%v_history, &
verbose = par%global_verbose)
end if
if (par%channel) then
allocate (pass%v_histories (pass%n_it, n_channels))
call vamp_create_history (pass%v_histories, &
verbose = par%channel_verbose)
end if
end subroutine pass_configure_history
@ %def pass_configure_history
@ Given two pass objects, compare them. All parameters must match. Where
integrations are done in both (number of calls nonzero), the results must be
equal (up to numerical noise).
The allocated array sizes might be different, but should match up to the
common [[n_it]] value.
<<MCI vamp: interfaces>>=
interface operator (.matches.)
module procedure pass_matches
end interface operator (.matches.)
<<MCI vamp: procedures>>=
function pass_matches (pass, ref) result (ok)
type(pass_t), intent(in) :: pass, ref
integer :: n
logical :: ok
ok = .true.
if (ok) ok = pass%i_pass == ref%i_pass
if (ok) ok = pass%i_first_it == ref%i_first_it
if (ok) ok = pass%n_it == ref%n_it
if (ok) ok = pass%n_calls == ref%n_calls
if (ok) ok = pass%n_bins == ref%n_bins
if (ok) ok = pass%adapt_grids .eqv. ref%adapt_grids
if (ok) ok = pass%adapt_weights .eqv. ref%adapt_weights
if (ok) ok = pass%integral_defined .eqv. ref%integral_defined
if (pass%integral_defined) then
n = pass%n_it
if (ok) ok = all (pass%calls(:n) == ref%calls(:n))
if (ok) ok = all (pass%calls_valid(:n) == ref%calls_valid (:n))
if (ok) ok = all (pass%integral(:n) .matches. ref%integral(:n))
if (ok) ok = all (pass%error(:n) .matches. ref%error(:n))
if (ok) ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
end if
end function pass_matches
@ %def pass_matches
@ Update a pass object, given a reference. The parameters must match, except
for the [[n_it]] entry. The number of complete iterations must be less or
equal to the reference, and the number of complete iterations in the reference
must be no larger than [[n_it]]. Where results are present in both passes,
they must match. Where results are present in the reference only, the pass is
updated accordingly.
<<MCI vamp: pass: TBP>>=
procedure :: update => pass_update
<<MCI vamp: procedures>>=
subroutine pass_update (pass, ref, ok)
class(pass_t), intent(inout) :: pass
type(pass_t), intent(in) :: ref
logical, intent(out) :: ok
integer :: n, n_ref
ok = .true.
if (ok) ok = pass%i_pass == ref%i_pass
if (ok) ok = pass%i_first_it == ref%i_first_it
if (ok) ok = pass%n_calls == ref%n_calls
if (ok) ok = pass%n_bins == ref%n_bins
if (ok) ok = pass%adapt_grids .eqv. ref%adapt_grids
if (ok) ok = pass%adapt_weights .eqv. ref%adapt_weights
if (ok) then
if (ref%integral_defined) then
if (.not. allocated (pass%calls)) then
allocate (pass%calls (pass%n_it), source = 0)
allocate (pass%calls_valid (pass%n_it), source = 0)
allocate (pass%integral (pass%n_it), source = 0._default)
allocate (pass%error (pass%n_it), source = 0._default)
allocate (pass%efficiency (pass%n_it), source = 0._default)
end if
n = count (pass%calls /= 0)
n_ref = count (ref%calls /= 0)
ok = n <= n_ref .and. n_ref <= pass%n_it
if (ok) ok = all (pass%calls(:n) == ref%calls(:n))
if (ok) ok = all (pass%calls_valid(:n) == ref%calls_valid(:n))
if (ok) ok = all (pass%integral(:n) .matches. ref%integral(:n))
if (ok) ok = all (pass%error(:n) .matches. ref%error(:n))
if (ok) ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
if (ok) then
pass%calls(n+1:n_ref) = ref%calls(n+1:n_ref)
pass%calls_valid(n+1:n_ref) = ref%calls_valid(n+1:n_ref)
pass%integral(n+1:n_ref) = ref%integral(n+1:n_ref)
pass%error(n+1:n_ref) = ref%error(n+1:n_ref)
pass%efficiency(n+1:n_ref) = ref%efficiency(n+1:n_ref)
pass%integral_defined = any (pass%calls /= 0)
end if
end if
end if
end subroutine pass_update
@ %def pass_update
@ Match two real numbers: they are equal up to a tolerance, which is
$10^{-8}$, matching the number of digits that are output by [[pass_write]].
In particular, if one number is exactly zero, the other one must also be zero.
<<MCI vamp: interfaces>>=
interface operator (.matches.)
module procedure real_matches
end interface operator (.matches.)
<<MCI vamp: procedures>>=
elemental function real_matches (x, y) result (ok)
real(default), intent(in) :: x, y
logical :: ok
real(default), parameter :: tolerance = 1.e-8_default
ok = abs (x - y) <= tolerance * max (abs (x), abs (y))
end function real_matches
@ %def real_matches
@ Return the index of the most recent complete integration. If there is none,
return zero.
<<MCI vamp: pass: TBP>>=
procedure :: get_integration_index => pass_get_integration_index
<<MCI vamp: procedures>>=
function pass_get_integration_index (pass) result (n)
class (pass_t), intent(in) :: pass
integer :: n
integer :: i
n = 0
if (allocated (pass%calls)) then
do i = 1, pass%n_it
if (pass%calls(i) == 0) exit
n = i
end do
end if
end function pass_get_integration_index
@ %def pass_get_integration_index
@ Return the most recent integral and error, if available.
<<MCI vamp: pass: TBP>>=
procedure :: get_calls => pass_get_calls
procedure :: get_calls_valid => pass_get_calls_valid
procedure :: get_integral => pass_get_integral
procedure :: get_error => pass_get_error
procedure :: get_efficiency => pass_get_efficiency
<<MCI vamp: procedures>>=
function pass_get_calls (pass) result (calls)
class(pass_t), intent(in) :: pass
integer :: calls
integer :: n
n = pass%get_integration_index ()
if (n /= 0) then
calls = pass%calls(n)
else
calls = 0
end if
end function pass_get_calls
function pass_get_calls_valid (pass) result (calls_valid)
class(pass_t), intent(in) :: pass
integer :: calls_valid
integer :: n
n = pass%get_integration_index ()
if (n /= 0) then
calls_valid = pass%calls_valid(n)
else
calls_valid = 0
end if
end function pass_get_calls_valid
function pass_get_integral (pass) result (integral)
class(pass_t), intent(in) :: pass
real(default) :: integral
integer :: n
n = pass%get_integration_index ()
if (n /= 0) then
integral = pass%integral(n)
else
integral = 0
end if
end function pass_get_integral
function pass_get_error (pass) result (error)
class(pass_t), intent(in) :: pass
real(default) :: error
integer :: n
n = pass%get_integration_index ()
if (n /= 0) then
error = pass%error(n)
else
error = 0
end if
end function pass_get_error
function pass_get_efficiency (pass) result (efficiency)
class(pass_t), intent(in) :: pass
real(default) :: efficiency
integer :: n
n = pass%get_integration_index ()
if (n /= 0) then
efficiency = pass%efficiency(n)
else
efficiency = 0
end if
end function pass_get_efficiency
@ %def pass_get_calls
@ %def pass_get_calls_valid
@ %def pass_get_integral
@ %def pass_get_error
@ %def pass_get_efficiency
@
\subsection{Integrator}
<<MCI vamp: public>>=
public :: mci_vamp_t
<<MCI vamp: types>>=
type, extends (mci_t) :: mci_vamp_t
logical, dimension(:), allocatable :: dim_is_flat
type(grid_parameters_t) :: grid_par
type(history_parameters_t) :: history_par
integer :: min_calls = 0
type(pass_t), pointer :: first_pass => null ()
type(pass_t), pointer :: current_pass => null ()
type(vamp_equivalences_t) :: equivalences
logical :: rebuild = .true.
logical :: check_grid_file = .true.
logical :: grid_filename_set = .false.
logical :: negative_weights = .false.
logical :: verbose = .false.
type(string_t) :: grid_filename
character(32) :: md5sum_adapted = ""
contains
<<MCI vamp: mci vamp: TBP>>
end type mci_vamp_t
@ %def mci_vamp_t
@ Reset: delete integration-pass entries.
<<MCI vamp: mci vamp: TBP>>=
procedure :: reset => mci_vamp_reset
<<MCI vamp: procedures>>=
subroutine mci_vamp_reset (object)
class(mci_vamp_t), intent(inout) :: object
type(pass_t), pointer :: current_pass
do while (associated (object%first_pass))
current_pass => object%first_pass
object%first_pass => current_pass%next
call current_pass%final ()
deallocate (current_pass)
end do
object%current_pass => null ()
end subroutine mci_vamp_reset
@ %def mci_vamp_reset
@ Finalizer: reset and finalize the equivalences list.
<<MCI vamp: mci vamp: TBP>>=
procedure :: final => mci_vamp_final
<<MCI vamp: procedures>>=
subroutine mci_vamp_final (object)
class(mci_vamp_t), intent(inout) :: object
call object%reset ()
call vamp_equivalences_final (object%equivalences)
call object%base_final ()
end subroutine mci_vamp_final
@ %def mci_vamp_final
@ Output. Do not output the grids themselves, this may result in tons
of data.
<<MCI vamp: mci vamp: TBP>>=
procedure :: write => mci_vamp_write
<<MCI vamp: procedures>>=
subroutine mci_vamp_write (object, unit, pacify, md5sum_version)
class(mci_vamp_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
logical, intent(in), optional :: md5sum_version
type(pass_t), pointer :: current_pass
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "VAMP integrator:"
call object%base_write (u, pacify, md5sum_version)
if (allocated (object%dim_is_flat)) then
write (u, "(3x,A,999(1x,I0))") "Flat dimensions =", &
pack ([(i, i = 1, object%n_dim)], object%dim_is_flat)
end if
write (u, "(1x,A)") "Grid parameters:"
call object%grid_par%write (u)
write (u, "(3x,A,I0)") "min_calls = ", object%min_calls
write (u, "(3x,A,L1)") "negative weights = ", &
object%negative_weights
write (u, "(3x,A,L1)") "verbose = ", &
object%verbose
if (object%grid_par%use_vamp_equivalences) then
call vamp_equivalences_write (object%equivalences, u)
end if
current_pass => object%first_pass
do while (associated (current_pass))
write (u, "(1x,A,I0,A)") "Integration pass:"
call current_pass%write (u, pacify)
current_pass => current_pass%next
end do
if (object%md5sum_adapted /= "") then
write (u, "(1x,A,A,A)") "MD5 sum (including results) = '", &
object%md5sum_adapted, "'"
end if
end subroutine mci_vamp_write
@ %def mci_vamp_write
@ Write the history parameters.
<<MCI vamp: mci vamp: TBP>>=
procedure :: write_history_parameters => mci_vamp_write_history_parameters
<<MCI vamp: procedures>>=
subroutine mci_vamp_write_history_parameters (mci, unit)
class(mci_vamp_t), intent(in) :: mci
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "VAMP history parameters:"
call mci%history_par%write (unit)
end subroutine mci_vamp_write_history_parameters
@ %def mci_vamp_write_history_parameters
@ Write the history, iterating over passes. We keep this separate
from the generic [[write]] routine.
<<MCI vamp: mci vamp: TBP>>=
procedure :: write_history => mci_vamp_write_history
<<MCI vamp: procedures>>=
subroutine mci_vamp_write_history (mci, unit)
class(mci_vamp_t), intent(in) :: mci
integer, intent(in), optional :: unit
type(pass_t), pointer :: current_pass
integer :: i_pass
integer :: u
u = given_output_unit (unit)
if (associated (mci%first_pass)) then
write (u, "(1x,A)") "VAMP history (global):"
i_pass = 0
current_pass => mci%first_pass
do while (associated (current_pass))
i_pass = i_pass + 1
write (u, "(1x,A,I0,':')") "Pass #", i_pass
call current_pass%write_history (u)
current_pass => current_pass%next
end do
end if
end subroutine mci_vamp_write_history
@ %def mci_vamp_write_history
@ Compute the MD5 sum, including the configuration MD5 sum and the
printout, which incorporates the current results.
<<MCI vamp: mci vamp: TBP>>=
procedure :: compute_md5sum => mci_vamp_compute_md5sum
<<MCI vamp: procedures>>=
subroutine mci_vamp_compute_md5sum (mci, pacify)
class(mci_vamp_t), intent(inout) :: mci
logical, intent(in), optional :: pacify
integer :: u
mci%md5sum_adapted = ""
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
write (u, "(A)") mci%md5sum
call mci%write (u, pacify, md5sum_version = .true.)
rewind (u)
mci%md5sum_adapted = md5sum (u)
close (u)
end subroutine mci_vamp_compute_md5sum
@ %def mci_vamp_compute_md5sum
@ Return the MD5 sum: If available, return the adapted one.
<<MCI vamp: mci vamp: TBP>>=
procedure :: get_md5sum => mci_vamp_get_md5sum
<<MCI vamp: procedures>>=
pure function mci_vamp_get_md5sum (mci) result (md5sum)
class(mci_vamp_t), intent(in) :: mci
character(32) :: md5sum
if (mci%md5sum_adapted /= "") then
md5sum = mci%md5sum_adapted
else
md5sum = mci%md5sum
end if
end function mci_vamp_get_md5sum
@ %def mci_vamp_get_md5sum
@ Startup message: short version.
<<MCI vamp: mci vamp: TBP>>=
procedure :: startup_message => mci_vamp_startup_message
<<MCI vamp: procedures>>=
subroutine mci_vamp_startup_message (mci, unit, n_calls)
class(mci_vamp_t), intent(in) :: mci
integer, intent(in), optional :: unit, n_calls
integer :: num_calls, n_bins
if (present (n_calls)) then
num_calls = n_calls
else
num_calls = 0
end if
if (mci%min_calls /= 0) then
n_bins = max (mci%grid_par%min_bins, &
min (num_calls / mci%min_calls, &
mci%grid_par%max_bins))
else
n_bins = mci%grid_par%max_bins
end if
call mci%base_startup_message (unit = unit, n_calls = n_calls)
if (mci%grid_par%use_vamp_equivalences) then
write (msg_buffer, "(A,2(1x,I0,1x,A))") &
"Integrator: Using VAMP channel equivalences"
call msg_message (unit = unit)
end if
write (msg_buffer, "(A,2(1x,I0,1x,A),L1)") &
"Integrator:", num_calls, &
"initial calls,", n_bins, &
"bins, stratified = ", &
mci%grid_par%stratified
call msg_message (unit = unit)
write (msg_buffer, "(A,2(1x,I0,1x,A))") &
"Integrator: VAMP"
call msg_message (unit = unit)
end subroutine mci_vamp_startup_message
@ %def mci_vamp_startup_message
@ Log entry: just headline.
<<MCI vamp: mci vamp: TBP>>=
procedure :: write_log_entry => mci_vamp_write_log_entry
<<MCI vamp: procedures>>=
subroutine mci_vamp_write_log_entry (mci, u)
class(mci_vamp_t), intent(in) :: mci
integer, intent(in) :: u
write (u, "(1x,A)") "MC Integrator is VAMP"
call write_separator (u)
call mci%write_history (u)
call write_separator (u)
if (mci%grid_par%use_vamp_equivalences) then
call vamp_equivalences_write (mci%equivalences, u)
else
write (u, "(3x,A)") "No VAMP equivalences have been used"
end if
call write_separator (u)
call mci%write_chain_weights (u)
end subroutine mci_vamp_write_log_entry
@ %def mci_vamp_write_log_entry
@ Set the MCI index (necessary for processes with multiple components).
We append the index to the grid filename, just before the final dotted
suffix.
<<MCI vamp: mci vamp: TBP>>=
procedure :: record_index => mci_vamp_record_index
<<MCI vamp: procedures>>=
subroutine mci_vamp_record_index (mci, i_mci)
class(mci_vamp_t), intent(inout) :: mci
integer, intent(in) :: i_mci
type(string_t) :: basename, suffix
character(32) :: buffer
if (mci%grid_filename_set) then
basename = mci%grid_filename
call split (basename, suffix, ".", back=.true.)
write (buffer, "(I0)") i_mci
if (basename /= "") then
mci%grid_filename = basename // ".m" // trim (buffer) // "." // suffix
else
mci%grid_filename = suffix // ".m" // trim (buffer) // ".vg"
end if
end if
end subroutine mci_vamp_record_index
@ %def mci_vamp_record_index
@ Set the grid parameters.
<<MCI vamp: mci vamp: TBP>>=
procedure :: set_grid_parameters => mci_vamp_set_grid_parameters
<<MCI vamp: procedures>>=
subroutine mci_vamp_set_grid_parameters (mci, grid_par)
class(mci_vamp_t), intent(inout) :: mci
type(grid_parameters_t), intent(in) :: grid_par
mci%grid_par = grid_par
mci%min_calls = grid_par%min_calls_per_bin * mci%n_channel
end subroutine mci_vamp_set_grid_parameters
@ %def mci_vamp_set_grid_parameters
@ Set the history parameters.
<<MCI vamp: mci vamp: TBP>>=
procedure :: set_history_parameters => mci_vamp_set_history_parameters
<<MCI vamp: procedures>>=
subroutine mci_vamp_set_history_parameters (mci, history_par)
class(mci_vamp_t), intent(inout) :: mci
type(history_parameters_t), intent(in) :: history_par
mci%history_par = history_par
end subroutine mci_vamp_set_history_parameters
@ %def mci_vamp_set_history_parameters
@ Set the rebuild flag, also the flag for checking the grid file.
<<MCI vamp: mci vamp: TBP>>=
procedure :: set_rebuild_flag => mci_vamp_set_rebuild_flag
<<MCI vamp: procedures>>=
subroutine mci_vamp_set_rebuild_flag (mci, rebuild, check_grid_file)
class(mci_vamp_t), intent(inout) :: mci
logical, intent(in) :: rebuild
logical, intent(in) :: check_grid_file
mci%rebuild = rebuild
mci%check_grid_file = check_grid_file
end subroutine mci_vamp_set_rebuild_flag
@ %def mci_vamp_set_rebuild_flag
@ Set the filename.
<<MCI vamp: mci vamp: TBP>>=
procedure :: set_grid_filename => mci_vamp_set_grid_filename
<<MCI vamp: procedures>>=
subroutine mci_vamp_set_grid_filename (mci, name, run_id)
class(mci_vamp_t), intent(inout) :: mci
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: run_id
if (present (run_id)) then
mci%grid_filename = name // "." // run_id // ".vg"
else
mci%grid_filename = name // ".vg"
end if
mci%grid_filename_set = .true.
end subroutine mci_vamp_set_grid_filename
@ %def mci_vamp_set_grid_filename
@ To simplify the interface, we prepend a grid path in a separate subroutine.
<<MCI vamp: mci vamp: TBP>>=
procedure :: prepend_grid_path => mci_vamp_prepend_grid_path
<<MCI vamp: procedures>>=
subroutine mci_vamp_prepend_grid_path (mci, prefix)
class(mci_vamp_t), intent(inout) :: mci
type(string_t), intent(in) :: prefix
if (mci%grid_filename_set) then
mci%grid_filename = prefix // "/" // mci%grid_filename
else
call msg_warning ("Cannot add prefix to invalid grid filename!")
end if
end subroutine mci_vamp_prepend_grid_path
@ %def mci_vamp_prepend_grid_path
@ Declare particular dimensions as flat.
<<MCI vamp: mci vamp: TBP>>=
procedure :: declare_flat_dimensions => mci_vamp_declare_flat_dimensions
<<MCI vamp: procedures>>=
subroutine mci_vamp_declare_flat_dimensions (mci, dim_flat)
class(mci_vamp_t), intent(inout) :: mci
integer, dimension(:), intent(in) :: dim_flat
integer :: d
allocate (mci%dim_is_flat (mci%n_dim), source = .false.)
do d = 1, size (dim_flat)
mci%dim_is_flat(dim_flat(d)) = .true.
end do
end subroutine mci_vamp_declare_flat_dimensions
@ %def mci_vamp_declare_flat_dimensions
@ Declare equivalences. We have an array of channel equivalences,
provided by the phase-space module. Here, we translate this into the
[[vamp_equivalences]] array.
<<MCI vamp: mci vamp: TBP>>=
procedure :: declare_equivalences => mci_vamp_declare_equivalences
<<MCI vamp: procedures>>=
subroutine mci_vamp_declare_equivalences (mci, channel, dim_offset)
class(mci_vamp_t), intent(inout) :: mci
type(phs_channel_t), dimension(:), intent(in) :: channel
integer, intent(in) :: dim_offset
integer, dimension(:), allocatable :: perm, mode
integer :: n_channels, n_dim, n_equivalences
integer :: c, i, j, left, right
n_channels = mci%n_channel
n_dim = mci%n_dim
n_equivalences = 0
do c = 1, n_channels
n_equivalences = n_equivalences + size (channel(c)%eq)
end do
call vamp_equivalences_init (mci%equivalences, &
n_equivalences, n_channels, n_dim)
allocate (perm (n_dim))
allocate (mode (n_dim))
perm(1:dim_offset) = [(i, i = 1, dim_offset)]
mode(1:dim_offset) = VEQ_IDENTITY
c = 1
j = 0
do i = 1, n_equivalences
if (j < size (channel(c)%eq)) then
j = j + 1
else
c = c + 1
j = 1
end if
associate (eq => channel(c)%eq(j))
left = c
right = eq%c
perm(dim_offset+1:) = eq%perm + dim_offset
mode(dim_offset+1:) = eq%mode
call vamp_equivalence_set (mci%equivalences, &
i, left, right, perm, mode)
end associate
end do
call vamp_equivalences_complete (mci%equivalences)
end subroutine mci_vamp_declare_equivalences
@ %def mci_vamp_declare_equivalences
@ Allocate instance with matching type.
<<MCI vamp: mci vamp: TBP>>=
procedure :: allocate_instance => mci_vamp_allocate_instance
<<MCI vamp: procedures>>=
subroutine mci_vamp_allocate_instance (mci, mci_instance)
class(mci_vamp_t), intent(in) :: mci
class(mci_instance_t), intent(out), pointer :: mci_instance
allocate (mci_vamp_instance_t :: mci_instance)
end subroutine mci_vamp_allocate_instance
@ %def mci_vamp_allocate_instance
@ Allocate a new integration pass. We can preset everything that does not
depend on the number of iterations and calls. This is postponed to
the [[integrate]] method.
In the final pass, we do not check accuracy goal etc., since we can assume
that the user wants to perform and average all iterations in this pass.
<<MCI vamp: mci vamp: TBP>>=
procedure :: add_pass => mci_vamp_add_pass
<<MCI vamp: procedures>>=
subroutine mci_vamp_add_pass (mci, adapt_grids, adapt_weights, final_pass)
class(mci_vamp_t), intent(inout) :: mci
logical, intent(in), optional :: adapt_grids, adapt_weights, final_pass
integer :: i_pass, i_it
type(pass_t), pointer :: new
allocate (new)
if (associated (mci%current_pass)) then
i_pass = mci%current_pass%i_pass + 1
i_it = mci%current_pass%i_first_it + mci%current_pass%n_it
mci%current_pass%next => new
else
i_pass = 1
i_it = 1
mci%first_pass => new
end if
mci%current_pass => new
new%i_pass = i_pass
new%i_first_it = i_it
if (present (adapt_grids)) then
new%adapt_grids = adapt_grids
else
new%adapt_grids = .false.
end if
if (present (adapt_weights)) then
new%adapt_weights = adapt_weights
else
new%adapt_weights = .false.
end if
if (present (final_pass)) then
new%is_final_pass = final_pass
else
new%is_final_pass = .false.
end if
end subroutine mci_vamp_add_pass
@ %def mci_vamp_add_pass
@ Update the list of integration passes. All passes except for the last one
must match exactly. For the last one, integration results are updated. The
reference output may contain extra passes, these are ignored.
<<MCI vamp: mci vamp: TBP>>=
procedure :: update_from_ref => mci_vamp_update_from_ref
<<MCI vamp: procedures>>=
subroutine mci_vamp_update_from_ref (mci, mci_ref, success)
class(mci_vamp_t), intent(inout) :: mci
class(mci_t), intent(in) :: mci_ref
logical, intent(out) :: success
type(pass_t), pointer :: current_pass, ref_pass
select type (mci_ref)
type is (mci_vamp_t)
current_pass => mci%first_pass
ref_pass => mci_ref%first_pass
success = .true.
do while (success .and. associated (current_pass))
if (associated (ref_pass)) then
if (associated (current_pass%next)) then
success = current_pass .matches. ref_pass
else
call current_pass%update (ref_pass, success)
if (current_pass%integral_defined) then
mci%integral = current_pass%get_integral ()
mci%error = current_pass%get_error ()
mci%efficiency = current_pass%get_efficiency ()
mci%integral_known = .true.
mci%error_known = .true.
mci%efficiency_known = .true.
end if
end if
current_pass => current_pass%next
ref_pass => ref_pass%next
else
success = .false.
end if
end do
end select
end subroutine mci_vamp_update_from_ref
@ %def mci_vamp_update
@ Update the MCI record (i.e., the integration passes) by reading from input
stream. The stream should contain a [[write]] output from a previous run. We
first check the MD5 sum of the configuration parameters. If that matches, we
proceed directly to the stored integration passes. If successful, we may
continue to read the file; the position will be after a blank line that
must follow the MCI record.
<<MCI vamp: mci vamp: TBP>>=
procedure :: update => mci_vamp_update
<<MCI vamp: procedures>>=
subroutine mci_vamp_update (mci, u, success)
class(mci_vamp_t), intent(inout) :: mci
integer, intent(in) :: u
logical, intent(out) :: success
character(80) :: buffer
character(32) :: md5sum_file
type(mci_vamp_t) :: mci_file
integer :: n_pass, n_it
call read_sval (u, md5sum_file)
if (mci%check_grid_file) then
success = md5sum_file == mci%md5sum
else
success = .true.
end if
if (success) then
read (u, *)
read (u, "(A)") buffer
if (trim (adjustl (buffer)) == "VAMP integrator:") then
n_pass = 0
n_it = 0
do
read (u, "(A)") buffer
select case (trim (adjustl (buffer)))
case ("")
exit
case ("Integration pass:")
call mci_file%add_pass ()
call mci_file%current_pass%read (u, n_pass, n_it)
n_pass = n_pass + 1
n_it = n_it + mci_file%current_pass%n_it
end select
end do
call mci%update_from_ref (mci_file, success)
call mci_file%final ()
else
call msg_fatal ("VAMP: reading grid file: corrupted data")
end if
end if
end subroutine mci_vamp_update
@ %def mci_vamp_update
@ Read / write grids from / to file.
Bug fix for 2.2.5: after reading grids from file, channel weights
must be copied back to the [[mci_instance]] record.
<<MCI vamp: mci vamp: TBP>>=
procedure :: write_grids => mci_vamp_write_grids
procedure :: read_grids_header => mci_vamp_read_grids_header
procedure :: read_grids_data => mci_vamp_read_grids_data
procedure :: read_grids => mci_vamp_read_grids
<<MCI vamp: procedures>>=
subroutine mci_vamp_write_grids (mci, instance)
class(mci_vamp_t), intent(in) :: mci
class(mci_instance_t), intent(inout) :: instance
integer :: u
select type (instance)
type is (mci_vamp_instance_t)
if (mci%grid_filename_set) then
if (instance%grids_defined) then
u = free_unit ()
open (u, file = char (mci%grid_filename), &
action = "write", status = "replace")
write (u, "(1x,A,A,A)") "MD5sum = '", mci%md5sum, "'"
write (u, *)
call mci%write (u)
write (u, *)
write (u, "(1x,A)") "VAMP grids:"
call vamp_write_grids (instance%grids, u, &
write_integrals = .true.)
close (u)
else
call msg_bug ("VAMP: write grids: grids undefined")
end if
else
call msg_bug ("VAMP: write grids: filename undefined")
end if
end select
end subroutine mci_vamp_write_grids
subroutine mci_vamp_read_grids_header (mci, success)
class(mci_vamp_t), intent(inout) :: mci
logical, intent(out) :: success
logical :: exist
integer :: u
success = .false.
if (mci%grid_filename_set) then
inquire (file = char (mci%grid_filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (mci%grid_filename), &
action = "read", status = "old")
call mci%update (u, success)
close (u)
if (.not. success) then
write (msg_buffer, "(A,A,A)") &
"VAMP: parameter mismatch, discarding grid file '", &
char (mci%grid_filename), "'"
call msg_message ()
end if
end if
else
call msg_bug ("VAMP: read grids: filename undefined")
end if
end subroutine mci_vamp_read_grids_header
subroutine mci_vamp_read_grids_data (mci, instance, read_integrals)
class(mci_vamp_t), intent(in) :: mci
class(mci_instance_t), intent(inout) :: instance
logical, intent(in), optional :: read_integrals
integer :: u
character(80) :: buffer
select type (instance)
type is (mci_vamp_instance_t)
if (.not. instance%grids_defined) then
u = free_unit ()
open (u, file = char (mci%grid_filename), &
action = "read", status = "old")
do
read (u, "(A)") buffer
if (trim (adjustl (buffer)) == "VAMP grids:") exit
end do
call vamp_read_grids (instance%grids, u, read_integrals)
close (u)
call instance%set_channel_weights (instance%grids%weights)
instance%grids_defined = .true.
else
call msg_bug ("VAMP: read grids: grids already defined")
end if
end select
end subroutine mci_vamp_read_grids_data
subroutine mci_vamp_read_grids (mci, instance, success)
class(mci_vamp_t), intent(inout) :: mci
class(mci_instance_t), intent(inout) :: instance
logical, intent(out) :: success
logical :: exist
integer :: u
character(80) :: buffer
select type (instance)
type is (mci_vamp_instance_t)
success = .false.
if (mci%grid_filename_set) then
if (.not. instance%grids_defined) then
inquire (file = char (mci%grid_filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (mci%grid_filename), &
action = "read", status = "old")
call mci%update (u, success)
if (success) then
read (u, "(A)") buffer
if (trim (adjustl (buffer)) == "VAMP grids:") then
call vamp_read_grids (instance%grids, u)
else
call msg_fatal ("VAMP: reading grid file: &
&corrupted grid data")
end if
else
write (msg_buffer, "(A,A,A)") &
"VAMP: parameter mismatch, discarding grid file '", &
char (mci%grid_filename), "'"
call msg_message ()
end if
close (u)
instance%grids_defined = success
end if
else
call msg_bug ("VAMP: read grids: grids already defined")
end if
else
call msg_bug ("VAMP: read grids: filename undefined")
end if
end select
end subroutine mci_vamp_read_grids
@ %def mci_vamp_write_grids
@ %def mci_vamp_read_grids_header
@ %def mci_vamp_read_grids_data
@ %def mci_vamp_read_grids
@ Auxiliary: Read real, integer, string value. We search for an equals sign,
the value must follow.
<<MCI vamp: procedures>>=
subroutine read_rval (u, rval)
integer, intent(in) :: u
real(default), intent(out) :: rval
character(80) :: buffer
read (u, "(A)") buffer
buffer = adjustl (buffer(scan (buffer, "=") + 1:))
read (buffer, *) rval
end subroutine read_rval
subroutine read_ival (u, ival)
integer, intent(in) :: u
integer, intent(out) :: ival
character(80) :: buffer
read (u, "(A)") buffer
buffer = adjustl (buffer(scan (buffer, "=") + 1:))
read (buffer, *) ival
end subroutine read_ival
subroutine read_sval (u, sval)
integer, intent(in) :: u
character(*), intent(out) :: sval
character(80) :: buffer
read (u, "(A)") buffer
buffer = adjustl (buffer(scan (buffer, "=") + 1:))
read (buffer, *) sval
end subroutine read_sval
subroutine read_lval (u, lval)
integer, intent(in) :: u
logical, intent(out) :: lval
character(80) :: buffer
read (u, "(A)") buffer
buffer = adjustl (buffer(scan (buffer, "=") + 1:))
read (buffer, *) lval
end subroutine read_lval
@ %def read_rval read_ival read_sval read_lval
@ Integrate. Perform a new integration pass (possibly reusing
previous results), which may consist of several iterations.
Note: we record the integral once per iteration. The integral stored
in the [[mci]] record itself is the last integral of the current
iteration, no averaging done. The [[results]] record may average results.
Note: recording the efficiency is not supported yet.
<<MCI vamp: mci vamp: TBP>>=
procedure :: integrate => mci_vamp_integrate
<<MCI vamp: procedures>>=
subroutine mci_vamp_integrate (mci, instance, sampler, &
n_it, n_calls, results, pacify)
class(mci_vamp_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
class(mci_results_t), intent(inout), optional :: results
logical, intent(in), optional :: pacify
integer :: it
logical :: reshape, from_file, success
select type (instance)
type is (mci_vamp_instance_t)
if (associated (mci%current_pass)) then
mci%current_pass%integral_defined = .false.
call mci%current_pass%configure (n_it, n_calls, &
mci%min_calls, mci%grid_par%min_bins, &
mci%grid_par%max_bins, &
mci%grid_par%min_calls_per_channel * mci%n_channel)
call mci%current_pass%configure_history &
(mci%n_channel, mci%history_par)
instance%pass_complete = .false.
instance%it_complete = .false.
call instance%new_pass (reshape)
if (.not. instance%grids_defined .or. instance%grids_from_file) then
if (mci%grid_filename_set .and. .not. mci%rebuild) then
call mci%read_grids_header (success)
from_file = success
if (.not. instance%grids_defined .and. success) then
call mci%read_grids_data (instance)
end if
else
from_file = .false.
end if
else
from_file = .false.
end if
if (from_file) then
if (.not. mci%check_grid_file) &
call msg_warning ("Reading grid file: MD5 sum check disabled")
call msg_message ("VAMP: " &
// "using grids and results from file '" &
// char (mci%grid_filename) // "'")
else if (.not. instance%grids_defined) then
call instance%create_grids ()
end if
do it = 1, instance%n_it
if (signal_is_pending ()) return
instance%grids_from_file = from_file .and. &
it <= mci%current_pass%get_integration_index ()
if (.not. instance%grids_from_file) then
instance%it_complete = .false.
call instance%adapt_grids ()
if (signal_is_pending ()) return
call instance%adapt_weights ()
if (signal_is_pending ()) return
call instance%discard_integrals (reshape)
if (mci%grid_par%use_vamp_equivalences) then
call instance%sample_grids (mci%rng, sampler, &
mci%equivalences)
else
call instance%sample_grids (mci%rng, sampler)
end if
if (signal_is_pending ()) return
instance%it_complete = .true.
if (instance%integral /= 0) then
mci%current_pass%calls(it) = instance%calls
mci%current_pass%calls_valid(it) = instance%calls_valid
mci%current_pass%integral(it) = instance%integral
if (abs (instance%error / instance%integral) &
> epsilon (1._default)) then
mci%current_pass%error(it) = instance%error
end if
mci%current_pass%efficiency(it) = instance%efficiency
end if
mci%current_pass%integral_defined = .true.
end if
if (present (results)) then
if (mci%has_chains ()) then
call mci%collect_chain_weights (instance%w)
call results%record (1, &
n_calls = mci%current_pass%calls(it), &
n_calls_valid = mci%current_pass%calls_valid(it), &
integral = mci%current_pass%integral(it), &
error = mci%current_pass%error(it), &
efficiency = mci%current_pass%efficiency(it), &
! TODO pos. and neg. Efficiency
efficiency_pos = 0._default, &
efficiency_neg = 0._default, &
chain_weights = mci%chain_weights, &
suppress = pacify)
else
call results%record (1, &
n_calls = mci%current_pass%calls(it), &
n_calls_valid = mci%current_pass%calls_valid(it), &
integral = mci%current_pass%integral(it), &
error = mci%current_pass%error(it), &
efficiency = mci%current_pass%efficiency(it), &
! TODO pos. and neg. Efficiency
efficiency_pos = 0._default, &
efficiency_neg = 0._default, &
suppress = pacify)
end if
end if
if (.not. instance%grids_from_file &
.and. mci%grid_filename_set) then
call mci%write_grids (instance)
end if
call instance%allow_adaptation ()
reshape = .false.
if (.not. mci%current_pass%is_final_pass) then
call mci%check_goals (it, success)
if (success) exit
end if
end do
if (signal_is_pending ()) return
instance%pass_complete = .true.
mci%integral = mci%current_pass%get_integral()
mci%error = mci%current_pass%get_error()
mci%efficiency = mci%current_pass%get_efficiency()
mci%integral_known = .true.
mci%error_known = .true.
mci%efficiency_known = .true.
call mci%compute_md5sum (pacify)
else
call msg_bug ("MCI integrate: current_pass object not allocated")
end if
end select
end subroutine mci_vamp_integrate
@ %def mci_vamp_integrate
@ Check whether we are already finished with this pass.
<<MCI vamp: mci vamp: TBP>>=
procedure :: check_goals => mci_vamp_check_goals
<<MCI vamp: procedures>>=
subroutine mci_vamp_check_goals (mci, it, success)
class(mci_vamp_t), intent(inout) :: mci
integer, intent(in) :: it
logical, intent(out) :: success
success = .false.
if (mci%error_reached (it)) then
mci%current_pass%n_it = it
call msg_message ("VAMP: error goal reached; &
&skipping iterations")
success = .true.
return
end if
if (mci%rel_error_reached (it)) then
mci%current_pass%n_it = it
call msg_message ("VAMP: relative error goal reached; &
&skipping iterations")
success = .true.
return
end if
if (mci%accuracy_reached (it)) then
mci%current_pass%n_it = it
call msg_message ("VAMP: accuracy goal reached; &
&skipping iterations")
success = .true.
return
end if
end subroutine mci_vamp_check_goals
@ %def mci_vamp_check_goals
@ Return true if the error, relative error, or accuracy goal has been reached,
if any.
<<MCI vamp: mci vamp: TBP>>=
procedure :: error_reached => mci_vamp_error_reached
procedure :: rel_error_reached => mci_vamp_rel_error_reached
procedure :: accuracy_reached => mci_vamp_accuracy_reached
<<MCI vamp: procedures>>=
function mci_vamp_error_reached (mci, it) result (flag)
class(mci_vamp_t), intent(in) :: mci
integer, intent(in) :: it
logical :: flag
real(default) :: error_goal, error
error_goal = mci%grid_par%error_goal
if (error_goal > 0) then
associate (pass => mci%current_pass)
if (pass%integral_defined) then
error = abs (pass%error(it))
flag = error < error_goal
else
flag = .false.
end if
end associate
else
flag = .false.
end if
end function mci_vamp_error_reached
function mci_vamp_rel_error_reached (mci, it) result (flag)
class(mci_vamp_t), intent(in) :: mci
integer, intent(in) :: it
logical :: flag
real(default) :: rel_error_goal, rel_error
rel_error_goal = mci%grid_par%rel_error_goal
if (rel_error_goal > 0) then
associate (pass => mci%current_pass)
if (pass%integral_defined) then
if (pass%integral(it) /= 0) then
rel_error = abs (pass%error(it) / pass%integral(it))
flag = rel_error < rel_error_goal
else
flag = .true.
end if
else
flag = .false.
end if
end associate
else
flag = .false.
end if
end function mci_vamp_rel_error_reached
function mci_vamp_accuracy_reached (mci, it) result (flag)
class(mci_vamp_t), intent(in) :: mci
integer, intent(in) :: it
logical :: flag
real(default) :: accuracy_goal, accuracy
accuracy_goal = mci%grid_par%accuracy_goal
if (accuracy_goal > 0) then
associate (pass => mci%current_pass)
if (pass%integral_defined) then
if (pass%integral(it) /= 0) then
accuracy = abs (pass%error(it) / pass%integral(it)) &
* sqrt (real (pass%calls(it), default))
flag = accuracy < accuracy_goal
else
flag = .true.
end if
else
flag = .false.
end if
end associate
else
flag = .false.
end if
end function mci_vamp_accuracy_reached
@ %def mci_vamp_error_reached
@ %def mci_vamp_rel_error_reached
@ %def mci_vamp_accuracy_reached
@ Prepare an event generation pass. Should be called before a sequence of
events is generated, then we should call the corresponding finalizer.
The pass-specific data of the previous integration pass are retained,
but we reset the number of iterations and calls to zero. The latter
now counts the number of events (calls to the sampling function, actually).
<<MCI vamp: mci vamp: TBP>>=
procedure :: prepare_simulation => mci_vamp_prepare_simulation
<<MCI vamp: procedures>>=
subroutine mci_vamp_prepare_simulation (mci)
class(mci_vamp_t), intent(inout) :: mci
logical :: success
if (mci%grid_filename_set) then
call mci%read_grids_header (success)
call mci%compute_md5sum ()
if (.not. success) then
call msg_fatal ("Simulate: " &
// "reading integration grids from file '" &
// char (mci%grid_filename) // "' failed")
end if
else
call msg_bug ("VAMP: simulation: no grids, no grid filename")
end if
end subroutine mci_vamp_prepare_simulation
@ %def mci_vamp_prepare_simulation
@ Generate weighted event. Note that the event weight
([[vamp_weight]]) is not just the MCI weight. [[vamp_next_event]]
selects a channel based on the channel weights multiplied by the
(previously recorded) maximum integrand value of the channel. The
MCI weight is renormalized accordingly, to cancel this effect on the
result.
<<MCI vamp: mci vamp: TBP>>=
procedure :: generate_weighted_event => mci_vamp_generate_weighted_event
<<MCI vamp: procedures>>=
subroutine mci_vamp_generate_weighted_event (mci, instance, sampler)
class(mci_vamp_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
class(vamp_data_t), allocatable :: data
type(exception) :: vamp_exception
select type (instance)
type is (mci_vamp_instance_t)
instance%vamp_weight_set = .false.
allocate (mci_workspace_t :: data)
select type (data)
type is (mci_workspace_t)
data%sampler => sampler
data%instance => instance
end select
select type (rng => mci%rng)
type is (rng_tao_t)
if (instance%grids_defined) then
call vamp_next_event ( &
instance%vamp_x, &
rng%state, &
instance%grids, &
vamp_sampling_function, &
data, &
phi = phi_trivial, &
weight = instance%vamp_weight, &
exc = vamp_exception)
call handle_vamp_exception (vamp_exception, mci%verbose)
instance%vamp_excess = 0
instance%vamp_weight_set = .true.
else
call msg_bug ("VAMP: generate event: grids undefined")
end if
class default
call msg_fatal ("VAMP event generation: &
&random-number generator must be TAO")
end select
end select
end subroutine mci_vamp_generate_weighted_event
@ %def mci_vamp_generate_weighted_event
@ Generate unweighted event.
<<MCI vamp: mci vamp: TBP>>=
procedure :: generate_unweighted_event => &
mci_vamp_generate_unweighted_event
<<MCI vamp: procedures>>=
subroutine mci_vamp_generate_unweighted_event (mci, instance, sampler)
class(mci_vamp_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
class(vamp_data_t), allocatable :: data
logical :: positive
type(exception) :: vamp_exception
select type (instance)
type is (mci_vamp_instance_t)
instance%vamp_weight_set = .false.
allocate (mci_workspace_t :: data)
select type (data)
type is (mci_workspace_t)
data%sampler => sampler
data%instance => instance
end select
select type (rng => mci%rng)
type is (rng_tao_t)
if (instance%grids_defined) then
REJECTION: do
call vamp_next_event ( &
instance%vamp_x, &
rng%state, &
instance%grids, &
vamp_sampling_function, &
data, &
phi = phi_trivial, &
excess = instance%vamp_excess, &
positive = positive, &
exc = vamp_exception)
if (signal_is_pending ()) return
if (sampler%is_valid ()) exit REJECTION
end do REJECTION
call handle_vamp_exception (vamp_exception, mci%verbose)
if (positive) then
instance%vamp_weight = 1
else if (instance%negative_weights) then
instance%vamp_weight = -1
else
call msg_fatal ("VAMP: event with negative weight generated")
instance%vamp_weight = 0
end if
instance%vamp_weight_set = .true.
else
call msg_bug ("VAMP: generate event: grids undefined")
end if
class default
call msg_fatal ("VAMP event generation: &
&random-number generator must be TAO")
end select
end select
end subroutine mci_vamp_generate_unweighted_event
@ %def mci_vamp_generate_unweighted_event
@ Rebuild an event, using the [[state]] input.
Note: This feature is currently unused.
<<MCI vamp: mci vamp: TBP>>=
procedure :: rebuild_event => mci_vamp_rebuild_event
<<MCI vamp: procedures>>=
subroutine mci_vamp_rebuild_event (mci, instance, sampler, state)
class(mci_vamp_t), intent(inout) :: mci
class(mci_instance_t), intent(inout) :: instance
class(mci_sampler_t), intent(inout) :: sampler
class(mci_state_t), intent(in) :: state
call msg_bug ("MCI vamp rebuild event not implemented yet")
end subroutine mci_vamp_rebuild_event
@ %def mci_vamp_rebuild_event
@ Pacify: override the default no-op, since VAMP numerics might need
some massage.
<<MCI vamp: mci vamp: TBP>>=
procedure :: pacify => mci_vamp_pacify
<<MCI vamp: procedures>>=
subroutine mci_vamp_pacify (object, efficiency_reset, error_reset)
class(mci_vamp_t), intent(inout) :: object
logical, intent(in), optional :: efficiency_reset, error_reset
logical :: err_reset
type(pass_t), pointer :: current_pass
err_reset = .false.
if (present (error_reset)) err_reset = error_reset
current_pass => object%first_pass
do while (associated (current_pass))
if (allocated (current_pass%error) .and. err_reset) then
current_pass%error = 0
end if
if (allocated (current_pass%efficiency) .and. err_reset) then
current_pass%efficiency = 1
end if
current_pass => current_pass%next
end do
end subroutine mci_vamp_pacify
@ %def mci_vamp_pacify
@
\subsection{Sampler as Workspace}
In the full setup, the sampling function requires the process instance
object as workspace. We implement this by (i) implementing the
process instance as a type extension of the abstract [[sampler_t]]
object used by the MCI implementation and (ii) providing such an
object as an extra argument to the sampling function that VAMP can
call. To minimize cross-package dependencies, we use an abstract type
[[vamp_workspace]] that VAMP declares and extend this by including a
pointer to the [[sampler]] and [[instance]] objects. In the body of
the sampling function, we dereference this pointer and can then work
with the contents.
<<MCI vamp: types>>=
type, extends (vamp_data_t) :: mci_workspace_t
class(mci_sampler_t), pointer :: sampler => null ()
class(mci_vamp_instance_t), pointer :: instance => null ()
end type mci_workspace_t
@ %def mci_workspace_t
@
\subsection{Integrator instance}
The history entries should point to the corresponding history entry in
the [[pass_t]] object. If there is none, we may allocate a local
history, which is then just transient.
<<MCI vamp: public>>=
public :: mci_vamp_instance_t
<<MCI vamp: types>>=
type, extends (mci_instance_t) :: mci_vamp_instance_t
type(mci_vamp_t), pointer :: mci => null ()
logical :: grids_defined = .false.
logical :: grids_from_file = .false.
integer :: n_it = 0
integer :: it = 0
logical :: pass_complete = .false.
integer :: n_calls = 0
integer :: calls = 0
integer :: calls_valid = 0
logical :: it_complete = .false.
logical :: enable_adapt_grids = .false.
logical :: enable_adapt_weights = .false.
logical :: allow_adapt_grids = .false.
logical :: allow_adapt_weights = .false.
integer :: n_adapt_grids = 0
integer :: n_adapt_weights = 0
logical :: generating_events = .false.
real(default) :: safety_factor = 1
type(vamp_grids) :: grids
real(default) :: g = 0
real(default), dimension(:), allocatable :: gi
real(default) :: integral = 0
real(default) :: error = 0
real(default) :: efficiency = 0
real(default), dimension(:), allocatable :: vamp_x
logical :: vamp_weight_set = .false.
real(default) :: vamp_weight = 0
real(default) :: vamp_excess = 0
logical :: allocate_global_history = .false.
type(vamp_history), dimension(:), pointer :: v_history => null ()
logical :: allocate_channel_history = .false.
type(vamp_history), dimension(:,:), pointer :: v_histories => null ()
contains
<<MCI vamp: mci vamp instance: TBP>>
end type mci_vamp_instance_t
@ %def mci_vamp_instance_t
@ Output.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: write => mci_vamp_instance_write
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_write (object, unit, pacify)
class(mci_vamp_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
integer :: u, i
character(len=7) :: fmt
call pac_fmt (fmt, FMT_17, FMT_14, pacify)
u = given_output_unit (unit)
write (u, "(3x,A," // FMT_19 // ")") "Integrand = ", object%integrand
write (u, "(3x,A," // FMT_19 // ")") "Weight = ", object%mci_weight
if (object%vamp_weight_set) then
write (u, "(3x,A," // FMT_19 // ")") "VAMP wgt = ", object%vamp_weight
if (object%vamp_excess /= 0) then
write (u, "(3x,A," // FMT_19 // ")") "VAMP exc = ", &
object%vamp_excess
end if
end if
write (u, "(3x,A,L1)") "adapt grids = ", object%enable_adapt_grids
write (u, "(3x,A,L1)") "adapt weights = ", object%enable_adapt_weights
if (object%grids_defined) then
if (object%grids_from_file) then
write (u, "(3x,A)") "VAMP grids: read from file"
else
write (u, "(3x,A)") "VAMP grids: defined"
end if
else
write (u, "(3x,A)") "VAMP grids: [undefined]"
end if
write (u, "(3x,A,I0)") "n_it = ", object%n_it
write (u, "(3x,A,I0)") "it = ", object%it
write (u, "(3x,A,L1)") "pass complete = ", object%it_complete
write (u, "(3x,A,I0)") "n_calls = ", object%n_calls
write (u, "(3x,A,I0)") "calls = ", object%calls
write (u, "(3x,A,I0)") "calls_valid = ", object%calls_valid
write (u, "(3x,A,L1)") "it complete = ", object%it_complete
write (u, "(3x,A,I0)") "n adapt.(g) = ", object%n_adapt_grids
write (u, "(3x,A,I0)") "n adapt.(w) = ", object%n_adapt_weights
write (u, "(3x,A,L1)") "gen. events = ", object%generating_events
write (u, "(3x,A,L1)") "neg. weights = ", object%negative_weights
if (object%safety_factor /= 1) write &
(u, "(3x,A," // fmt // ")") "safety f = ", object%safety_factor
write (u, "(3x,A," // fmt // ")") "integral = ", object%integral
write (u, "(3x,A," // fmt // ")") "error = ", object%error
write (u, "(3x,A," // fmt // ")") "eff. = ", object%efficiency
write (u, "(3x,A)") "weights:"
do i = 1, size (object%w)
write (u, "(5x,I0,1x," // FMT_12 // ")") i, object%w(i)
end do
end subroutine mci_vamp_instance_write
@ %def mci_vamp_instance_write
@ Write the grids to the specified unit.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: write_grids => mci_vamp_instance_write_grids
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_write_grids (object, unit)
class(mci_vamp_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (object%grids_defined) then
call vamp_write_grids (object%grids, u, write_integrals = .true.)
end if
end subroutine mci_vamp_instance_write_grids
@ %def mci_vamp_instance_write_grids
@ Finalizer: the history arrays are pointer arrays and need finalization.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: final => mci_vamp_instance_final
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_final (object)
class(mci_vamp_instance_t), intent(inout) :: object
if (object%allocate_global_history) then
if (associated (object%v_history)) then
call vamp_delete_history (object%v_history)
deallocate (object%v_history)
end if
end if
if (object%allocate_channel_history) then
if (associated (object%v_histories)) then
call vamp_delete_history (object%v_histories)
deallocate (object%v_histories)
end if
end if
if (object%grids_defined) then
call vamp_delete_grids (object%grids)
object%grids_defined = .false.
end if
end subroutine mci_vamp_instance_final
@ %def mci_vamp_instance_final
@ Initializer.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: init => mci_vamp_instance_init
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_init (mci_instance, mci)
class(mci_vamp_instance_t), intent(out) :: mci_instance
class(mci_t), intent(in), target :: mci
call mci_instance%base_init (mci)
select type (mci)
type is (mci_vamp_t)
mci_instance%mci => mci
allocate (mci_instance%gi (mci%n_channel))
mci_instance%allocate_global_history = .not. mci%history_par%global
mci_instance%allocate_channel_history = .not. mci%history_par%channel
mci_instance%negative_weights = mci%negative_weights
end select
end subroutine mci_vamp_instance_init
@ %def mci_vamp_instance_init
@ Prepare a new integration pass: write the pass-specific settings to
the [[instance]] object. This should be called initially, together
with the [[create_grids]] procedure, and whenever we start a new
integration pass.
Set [[reshape]] if the number of calls is different than previously (unless it
was zero, indicating the first pass).
We link VAMP histories to the allocated histories in the current pass
object, so the recorded results are persistent. However, if there are
no histories present there, we allocate them locally. In that case,
the histories will disappear together with the MCI instance object.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: new_pass => mci_vamp_instance_new_pass
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_new_pass (instance, reshape)
class(mci_vamp_instance_t), intent(inout) :: instance
logical, intent(out) :: reshape
type(pass_t), pointer :: current
associate (mci => instance%mci)
current => mci%current_pass
instance%n_it = current%n_it
if (instance%n_calls == 0) then
reshape = .false.
instance%n_calls = current%n_calls
else if (instance%n_calls == current%n_calls) then
reshape = .false.
else
reshape = .true.
instance%n_calls = current%n_calls
end if
instance%it = 0
instance%calls = 0
instance%calls_valid = 0
instance%enable_adapt_grids = current%adapt_grids
instance%enable_adapt_weights = current%adapt_weights
instance%generating_events = .false.
if (instance%allocate_global_history) then
if (associated (instance%v_history)) then
call vamp_delete_history (instance%v_history)
deallocate (instance%v_history)
end if
allocate (instance%v_history (instance%n_it))
call vamp_create_history (instance%v_history, verbose = .false.)
else
instance%v_history => current%v_history
end if
if (instance%allocate_channel_history) then
if (associated (instance%v_histories)) then
call vamp_delete_history (instance%v_histories)
deallocate (instance%v_histories)
end if
allocate (instance%v_histories (instance%n_it, mci%n_channel))
call vamp_create_history (instance%v_histories, verbose = .false.)
else
instance%v_histories => current%v_histories
end if
end associate
end subroutine mci_vamp_instance_new_pass
@ %def mci_vamp_instance_new_pass
@
Create a grid set within the [[instance]] object, using the data of
the current integration pass. Also reset counters that track this
grid set.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: create_grids => mci_vamp_instance_create_grids
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_create_grids (instance)
class(mci_vamp_instance_t), intent(inout) :: instance
type (pass_t), pointer :: current
integer, dimension(:), allocatable :: num_div
real(default), dimension(:,:), allocatable :: region
associate (mci => instance%mci)
current => mci%current_pass
allocate (num_div (mci%n_dim))
allocate (region (2, mci%n_dim))
region(1,:) = 0
region(2,:) = 1
num_div = current%n_bins
instance%n_adapt_grids = 0
instance%n_adapt_weights = 0
if (.not. instance%grids_defined) then
call vamp_create_grids (instance%grids, &
region, &
current%n_calls, &
weights = instance%w, &
num_div = num_div, &
stratified = mci%grid_par%stratified)
instance%grids_defined = .true.
else
call msg_bug ("VAMP: create grids: grids already defined")
end if
end associate
end subroutine mci_vamp_instance_create_grids
@ %def mci_vamp_instance_create_grids
@ Reset a grid set, so we can start a fresh integration pass. In
effect, we delete results of previous integrations, but keep the grid
shapes, weights, and variance arrays, so adaptation is still possible.
The grids are prepared for a specific number of calls (per iteration)
and sampling mode (stratified/importance).
The [[vamp_discard_integrals]] implementation will reshape the grids
only if the argument [[num_calls]] is present.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: discard_integrals => mci_vamp_instance_discard_integrals
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_discard_integrals (instance, reshape)
class(mci_vamp_instance_t), intent(inout) :: instance
logical, intent(in) :: reshape
instance%calls = 0
instance%calls_valid = 0
instance%integral = 0
instance%error = 0
instance%efficiency = 0
associate (mci => instance%mci)
if (instance%grids_defined) then
if (mci%grid_par%use_vamp_equivalences) then
if (reshape) then
call vamp_discard_integrals (instance%grids, &
num_calls = instance%n_calls, &
stratified = mci%grid_par%stratified, &
eq = mci%equivalences)
else
call vamp_discard_integrals (instance%grids, &
stratified = mci%grid_par%stratified, &
eq = mci%equivalences)
end if
else
if (reshape) then
call vamp_discard_integrals (instance%grids, &
num_calls = instance%n_calls, &
stratified = mci%grid_par%stratified)
else
call vamp_discard_integrals (instance%grids, &
stratified = mci%grid_par%stratified)
end if
end if
else
call msg_bug ("VAMP: discard integrals: grids undefined")
end if
end associate
end subroutine mci_vamp_instance_discard_integrals
@ %def mci_vamp_instance_discard_integrals
@ After grids are created (with equidistant binning and equal weight),
adaptation is redundant. Therefore, we should allow it only after a
complete integration step has been performed, calling this.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: allow_adaptation => mci_vamp_instance_allow_adaptation
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_allow_adaptation (instance)
class(mci_vamp_instance_t), intent(inout) :: instance
instance%allow_adapt_grids = .true.
instance%allow_adapt_weights = .true.
end subroutine mci_vamp_instance_allow_adaptation
@ %def mci_vamp_instance_allow_adaptation
@ Adapt grids.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: adapt_grids => mci_vamp_instance_adapt_grids
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_adapt_grids (instance)
class(mci_vamp_instance_t), intent(inout) :: instance
if (instance%enable_adapt_grids .and. instance%allow_adapt_grids) then
if (instance%grids_defined) then
call vamp_refine_grids (instance%grids)
instance%n_adapt_grids = instance%n_adapt_grids + 1
else
call msg_bug ("VAMP: adapt grids: grids undefined")
end if
end if
end subroutine mci_vamp_instance_adapt_grids
@ %def mci_vamp_instance_adapt_grids
@ Adapt weights. Use the variance array returned by \vamp\ for
recalculating the weight array. The parameter
[[channel_weights_power]] dampens fluctuations.
If the number of calls in a given channel falls below a user-defined threshold,
the weight is not lowered further but kept at this threshold. The other
channel weights are reduced accordingly.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: adapt_weights => mci_vamp_instance_adapt_weights
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_adapt_weights (instance)
class(mci_vamp_instance_t), intent(inout) :: instance
real(default) :: w_sum, w_avg_ch, sum_w_underflow, w_min
real(default), dimension(:), allocatable :: weights
integer :: n_ch, ch, n_underflow
logical, dimension(:), allocatable :: mask, underflow
type(exception) :: vamp_exception
logical :: wsum_non_zero
if (instance%enable_adapt_weights .and. instance%allow_adapt_weights) then
associate (mci => instance%mci)
if (instance%grids_defined) then
allocate (weights (size (instance%grids%weights)))
weights = instance%grids%weights &
* vamp_get_variance (instance%grids%grids) &
** mci%grid_par%channel_weights_power
w_sum = sum (weights)
if (w_sum /= 0) then
weights = weights / w_sum
if (mci%n_chain /= 0) then
allocate (mask (mci%n_channel))
do ch = 1, mci%n_chain
mask = mci%chain == ch
n_ch = count (mask)
if (n_ch /= 0) then
w_avg_ch = sum (weights, mask) / n_ch
where (mask) weights = w_avg_ch
end if
end do
end if
if (mci%grid_par%threshold_calls /= 0) then
w_min = &
real (mci%grid_par%threshold_calls, default) &
/ instance%n_calls
allocate (underflow (mci%n_channel))
underflow = weights /= 0 .and. abs (weights) < w_min
n_underflow = count (underflow)
sum_w_underflow = sum (weights, mask=underflow)
if (sum_w_underflow /= 1) then
where (underflow)
weights = w_min
elsewhere
weights = weights &
* (1 - n_underflow * w_min) / (1 - sum_w_underflow)
end where
end if
end if
end if
call instance%set_channel_weights (weights, wsum_non_zero)
if (wsum_non_zero) call vamp_update_weights &
(instance%grids, weights, exc = vamp_exception)
call handle_vamp_exception (vamp_exception, mci%verbose)
else
call msg_bug ("VAMP: adapt weights: grids undefined")
end if
end associate
instance%n_adapt_weights = instance%n_adapt_weights + 1
end if
end subroutine mci_vamp_instance_adapt_weights
@ %def mci_vamp_instance_adapt_weights
@ Integration: sample the VAMP grids. The number of calls etc. are
already stored inside the grids. We provide the random-number
generator, the sampling function, and a link to the workspace object,
which happens to contain a pointer to the sampler object. The sampler
object thus becomes the workspace of the sampling function.
Note: in the current implementation, the random-number generator must
be the TAO generator. This explicit dependence should be removed from
the VAMP implementation.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: sample_grids => mci_vamp_instance_sample_grids
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_sample_grids (instance, rng, sampler, eq)
class(mci_vamp_instance_t), intent(inout), target :: instance
class(rng_t), intent(inout) :: rng
class(mci_sampler_t), intent(inout), target :: sampler
type(vamp_equivalences_t), intent(in), optional :: eq
class(vamp_data_t), allocatable :: data
type(exception) :: vamp_exception
allocate (mci_workspace_t :: data)
select type (data)
type is (mci_workspace_t)
data%sampler => sampler
data%instance => instance
end select
select type (rng)
type is (rng_tao_t)
instance%it = instance%it + 1
instance%calls = 0
if (instance%grids_defined) then
call vamp_sample_grids ( &
rng%state, &
instance%grids, &
vamp_sampling_function, &
data, &
1, &
eq = eq, &
history = instance%v_history(instance%it:), &
histories = instance%v_histories(instance%it:,:), &
integral = instance%integral, &
std_dev = instance%error, &
exc = vamp_exception, &
negative_weights = instance%negative_weights)
call handle_vamp_exception (vamp_exception, instance%mci%verbose)
instance%efficiency = instance%get_efficiency ()
else
call msg_bug ("VAMP: sample grids: grids undefined")
end if
class default
call msg_fatal ("VAMP integration: random-number generator must be TAO")
end select
end subroutine mci_vamp_instance_sample_grids
@ %def mci_vamp_instance_sample_grids
@
Compute the reweighting efficiency for the current grids, suitable
averaged over all active channels.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: get_efficiency_array => mci_vamp_instance_get_efficiency_array
procedure :: get_efficiency => mci_vamp_instance_get_efficiency
<<MCI vamp: procedures>>=
function mci_vamp_instance_get_efficiency_array (mci) result (efficiency)
class(mci_vamp_instance_t), intent(in) :: mci
real(default), dimension(:), allocatable :: efficiency
allocate (efficiency (mci%mci%n_channel))
if (.not. mci%negative_weights) then
where (mci%grids%grids%f_max /= 0)
efficiency = mci%grids%grids%mu(1) / abs (mci%grids%grids%f_max)
elsewhere
efficiency = 0
end where
else
where (mci%grids%grids%f_max /= 0)
efficiency = &
(mci%grids%grids%mu_plus(1) - mci%grids%grids%mu_minus(1)) &
/ abs (mci%grids%grids%f_max)
elsewhere
efficiency = 0
end where
end if
end function mci_vamp_instance_get_efficiency_array
function mci_vamp_instance_get_efficiency (mci) result (efficiency)
class(mci_vamp_instance_t), intent(in) :: mci
real(default) :: efficiency
real(default), dimension(:), allocatable :: weight
real(default) :: norm
allocate (weight (mci%mci%n_channel))
weight = mci%grids%weights * abs (mci%grids%grids%f_max)
norm = sum (weight)
if (norm /= 0) then
efficiency = dot_product (mci%get_efficiency_array (), weight) / norm
else
efficiency = 1
end if
end function mci_vamp_instance_get_efficiency
@ %def mci_vamp_instance_get_efficiency_array
@ %def mci_vamp_instance_get_efficiency
@ Prepare an event generation pass. Should be called before a sequence of
events is generated, then we should call the corresponding finalizer.
The pass-specific data of the previous integration pass are retained,
but we reset the number of iterations and calls to zero. The latter
now counts the number of events (calls to the sampling function, actually).
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: init_simulation => mci_vamp_instance_init_simulation
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_init_simulation (instance, safety_factor)
class(mci_vamp_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: safety_factor
associate (mci => instance%mci)
allocate (instance%vamp_x (mci%n_dim))
instance%it = 0
instance%calls = 0
instance%generating_events = .true.
if (present (safety_factor)) instance%safety_factor = safety_factor
if (.not. instance%grids_defined) then
if (mci%grid_filename_set) then
if (.not. mci%check_grid_file) &
call msg_warning ("Reading grid file: MD5 sum check disabled")
call msg_message ("Simulate: " &
// "using integration grids from file '" &
// char (mci%grid_filename) // "'")
call mci%read_grids_data (instance)
if (instance%safety_factor /= 1) then
write (msg_buffer, "(A,ES10.3,A)") "Simulate: &
&applying safety factor", instance%safety_factor, &
" to event rejection"
call msg_message ()
instance%grids%grids%f_max = &
instance%grids%grids%f_max * instance%safety_factor
end if
else
call msg_bug ("VAMP: simulation: no grids, no grid filename")
end if
end if
end associate
end subroutine mci_vamp_instance_init_simulation
@ %def mci_vamp_init_simulation
@ Finalize an event generation pass. Should be called before a sequence of
events is generated, then we should call the corresponding finalizer.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: final_simulation => mci_vamp_instance_final_simulation
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_final_simulation (instance)
class(mci_vamp_instance_t), intent(inout) :: instance
if (allocated (instance%vamp_x)) deallocate (instance%vamp_x)
end subroutine mci_vamp_instance_final_simulation
@ %def mci_vamp_instance_final_simulation
@
\subsection{Sampling function}
The VAMP sampling function has a well-defined interface which we have
to implement. The [[data]] argument allows us to pass pointers to the
[[sampler]] and [[instance]] objects, so we can access configuration
data and fill point-dependent contents within these objects.
The [[weights]] and [[channel]] argument must be present in the call.
Note: we would normally declare the [[instance]] pointer with the
concrete type, or just use the [[data]] component directly.
Unfortunately, gfortran 4.6 forgets the inherited base-type methods in
that case.
Note: this is the place where we must look for external signals, i.e.,
interrupt from the OS. We would like to raise a \vamp\ exception which is then
caught by [[vamp_sample_grids]] as the caller, so it dumps its current state
and returns (with the signal still pending). \whizard\ will then terminate
gracefully. Of course, VAMP should be able to resume from the dump.
In the current implementation, we handle the exception in place and terminate
immediately. The incomplete current integration pass is lost.
<<MCI vamp: procedures>>=
function vamp_sampling_function &
(xi, data, weights, channel, grids) result (f)
real(default) :: f
real(default), dimension(:), intent(in) :: xi
class(vamp_data_t), intent(in) :: data
real(default), dimension(:), intent(in), optional :: weights
integer, intent(in), optional :: channel
type(vamp_grid), dimension(:), intent(in), optional :: grids
type(exception) :: exc
logical :: verbose
character(*), parameter :: FN = "WHIZARD sampling function"
class(mci_instance_t), pointer :: instance
select type (data)
type is (mci_workspace_t)
instance => data%instance
select type (instance)
class is (mci_vamp_instance_t)
verbose = instance%mci%verbose
call instance%evaluate (data%sampler, channel, xi)
if (signal_is_pending ()) then
call raise_exception (exc, EXC_FATAL, FN, "signal received")
call handle_vamp_exception (exc, verbose)
call terminate_now_if_signal ()
end if
instance%calls = instance%calls + 1
if (data%sampler%is_valid ()) &
& instance%calls_valid = instance%calls_valid + 1
f = instance%get_value ()
call terminate_now_if_single_event ()
class default
call msg_bug("VAMP: " // FN // ": unknown MCI instance type")
end select
end select
end function vamp_sampling_function
@ %def vamp_sampling_function
@ This is supposed to be the mapping between integration channels.
The VAMP event generating procedures technically require it, but it is
meaningless in our setup where all transformations happen inside the
sampler object. So, this implementation is trivial:
<<MCI vamp: procedures>>=
pure function phi_trivial (xi, channel_dummy) result (x)
real(default), dimension(:), intent(in) :: xi
integer, intent(in) :: channel_dummy
real(default), dimension(size(xi)) :: x
x = xi
end function phi_trivial
@ %def phi_trivial
@
\subsection{Integrator instance: evaluation}
Here, we compute the multi-channel reweighting factor for the current
channel, that accounts for the Jacobians of the transformations
from/to all other channels.
The computation of the VAMP probabilities may consume considerable
time, therefore we enable parallel evaluation. (Collecting the
contributions to [[mci%g]] is a reduction, which we should also
implement via OpenMP.)
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: compute_weight => mci_vamp_instance_compute_weight
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_compute_weight (mci, c)
class(mci_vamp_instance_t), intent(inout) :: mci
integer, intent(in) :: c
integer :: i
mci%selected_channel = c
!$OMP PARALLEL PRIVATE(i) SHARED(mci)
!$OMP DO
do i = 1, mci%mci%n_channel
if (mci%w(i) /= 0) then
mci%gi(i) = vamp_probability (mci%grids%grids(i), mci%x(:,i))
else
mci%gi(i) = 0
end if
end do
!$OMP END DO
!$OMP END PARALLEL
mci%g = 0
if (mci%gi(c) /= 0) then
do i = 1, mci%mci%n_channel
if (mci%w(i) /= 0 .and. mci%f(i) /= 0) then
mci%g = mci%g + mci%w(i) * mci%gi(i) / mci%f(i)
end if
end do
end if
if (mci%g /= 0) then
mci%mci_weight = mci%gi(c) / mci%g
else
mci%mci_weight = 0
end if
end subroutine mci_vamp_instance_compute_weight
@ %def mci_vamp_instance_compute_weight
@ Record the integrand.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: record_integrand => mci_vamp_instance_record_integrand
<<MCI vamp: procedures>>=
subroutine mci_vamp_instance_record_integrand (mci, integrand)
class(mci_vamp_instance_t), intent(inout) :: mci
real(default), intent(in) :: integrand
mci%integrand = integrand
end subroutine mci_vamp_instance_record_integrand
@ %def mci_vamp_instance_record_integrand
@ Get the event weight. The default routine returns the same value that
we would use for integration. This is correct if we select the integration
channel according to the channel weight. [[vamp_next_event]] does
differently, so we should rather rely on the weight that VAMP
returns. This is the value stored in [[vamp_weight]]. We override
the default TBP accordingly.
<<MCI vamp: mci vamp instance: TBP>>=
procedure :: get_event_weight => mci_vamp_instance_get_event_weight
procedure :: get_event_excess => mci_vamp_instance_get_event_excess
<<MCI vamp: procedures>>=
function mci_vamp_instance_get_event_weight (mci) result (value)
class(mci_vamp_instance_t), intent(in) :: mci
real(default) :: value
if (mci%vamp_weight_set) then
value = mci%vamp_weight
else
call msg_bug ("VAMP: attempt to read undefined event weight")
end if
end function mci_vamp_instance_get_event_weight
function mci_vamp_instance_get_event_excess (mci) result (value)
class(mci_vamp_instance_t), intent(in) :: mci
real(default) :: value
if (mci%vamp_weight_set) then
value = mci%vamp_excess
else
call msg_bug ("VAMP: attempt to read undefined event excess weight")
end if
end function mci_vamp_instance_get_event_excess
@ %def mci_vamp_instance_get_event_excess
@
\subsection{VAMP exceptions}
A VAMP routine may have raised an exception. Turn this into a WHIZARD
error message.
An external signal could raise a fatal exception, but this should be delayed and
handled by the correct termination routine.
<<MCI vamp: procedures>>=
subroutine handle_vamp_exception (exc, verbose)
type(exception), intent(in) :: exc
logical, intent(in) :: verbose
integer :: exc_level
if (verbose) then
exc_level = EXC_INFO
else
exc_level = EXC_ERROR
end if
if (exc%level >= exc_level) then
write (msg_buffer, "(A,':',1x,A)") trim (exc%origin), trim (exc%message)
select case (exc%level)
case (EXC_INFO); call msg_message ()
case (EXC_WARN); call msg_warning ()
case (EXC_ERROR); call msg_error ()
case (EXC_FATAL)
if (signal_is_pending ()) then
call msg_message ()
else
call msg_fatal ()
end if
end select
end if
end subroutine handle_vamp_exception
@ %def handle_vamp_exception
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[mci_vamp_ut.f90]]>>=
<<File header>>
module mci_vamp_ut
use unit_tests
use mci_vamp_uti
<<Standard module head>>
<<MCI vamp: public test>>
contains
<<MCI vamp: test driver>>
end module mci_vamp_ut
@ %def mci_vamp_ut
@
<<[[mci_vamp_uti.f90]]>>=
<<File header>>
module mci_vamp_uti
<<Use kinds>>
<<Use strings>>
use io_units
use constants, only: PI, TWOPI
use rng_base
use rng_tao
use phs_base
use mci_base
use vamp, only: vamp_write_grids !NODEP!
use mci_vamp
<<Standard module head>>
<<MCI vamp: test declarations>>
<<MCI vamp: test types>>
contains
<<MCI vamp: tests>>
end module mci_vamp_uti
@ %def mci_vamp_ut
@ API: driver for the unit tests below.
<<MCI vamp: public test>>=
public :: mci_vamp_test
<<MCI vamp: test driver>>=
subroutine mci_vamp_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<MCI vamp: execute tests>>
end subroutine mci_vamp_test
@ %def mci_vamp_test
@
\subsubsection{Test sampler}
A test sampler object should implement a function with known integral that
we can use to check the integrator.
In mode [[1]], the function is $f(x) = 3 x^2$ with integral $\int_0^1
f(x)\,dx=1$ and maximum $f(1)=3$. If the integration dimension is
greater than one, the function is extended as a constant in the other
dimension(s).
In mode [[2]], the function is $11 x^{10}$, also with integral $1$.
Mode [[4]] includes ranges of zero and negative function value, the
integral is negative. The results should be identical to the results
of [[mci_midpoint_4]], where the same function is evaluated. The
function is $f(x) = (1 - 3 x^2)\,\theta(x-1/2)$ with integral
$\int_0^1 f(x)\,dx=-3/8$, minimum $f(1)=-2$ and maximum $f(1/2)=1/4$.
<<MCI vamp: test types>>=
type, extends (mci_sampler_t) :: test_sampler_1_t
real(default), dimension(:), allocatable :: x
real(default) :: val
integer :: mode = 1
contains
<<MCI vamp: test sampler 1: TBP>>
end type test_sampler_1_t
@ %def test_sampler_1_t
@ Output: There is nothing stored inside, so just print an informative line.
<<MCI vamp: test sampler 1: TBP>>=
procedure :: write => test_sampler_1_write
<<MCI vamp: tests>>=
subroutine test_sampler_1_write (object, unit, testflag)
class(test_sampler_1_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
select case (object%mode)
case (1)
write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2"
case (2)
write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10"
case (3)
write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10 * 2 * cos^2 (2 pi y)"
case (4)
write (u, "(1x,A)") "Test sampler: f(x) = (1 - 3 x^2) theta(x - 1/2)"
end select
end subroutine test_sampler_1_write
@ %def test_sampler_1_write
@ Evaluation: compute the function value. The output $x$ parameter
(only one channel) is identical to the input $x$, and the Jacobian is 1.
<<MCI vamp: test sampler 1: TBP>>=
procedure :: evaluate => test_sampler_1_evaluate
<<MCI vamp: tests>>=
subroutine test_sampler_1_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_1_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
if (allocated (sampler%x)) deallocate (sampler%x)
allocate (sampler%x (size (x_in)))
sampler%x = x_in
select case (sampler%mode)
case (1)
sampler%val = 3 * x_in(1) ** 2
case (2)
sampler%val = 11 * x_in(1) ** 10
case (3)
sampler%val = 11 * x_in(1) ** 10 * 2 * cos (twopi * x_in(2)) ** 2
case (4)
if (x_in(1) >= .5_default) then
sampler%val = 1 - 3 * x_in(1) ** 2
else
sampler%val = 0
end if
end select
call sampler%fetch (val, x, f)
end subroutine test_sampler_1_evaluate
@ %def test_sampler_1_evaluate
@ The point is always valid.
<<MCI vamp: test sampler 1: TBP>>=
procedure :: is_valid => test_sampler_1_is_valid
<<MCI vamp: tests>>=
function test_sampler_1_is_valid (sampler) result (valid)
class(test_sampler_1_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_1_is_valid
@ %def test_sampler_1_is_valid
@ Rebuild: compute all but the function value.
<<MCI vamp: test sampler 1: TBP>>=
procedure :: rebuild => test_sampler_1_rebuild
<<MCI vamp: tests>>=
subroutine test_sampler_1_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_1_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
if (allocated (sampler%x)) deallocate (sampler%x)
allocate (sampler%x (size (x_in)))
sampler%x = x_in
sampler%val = val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_1_rebuild
@ %def test_sampler_1_rebuild
@ Extract the results.
<<MCI vamp: test sampler 1: TBP>>=
procedure :: fetch => test_sampler_1_fetch
<<MCI vamp: tests>>=
subroutine test_sampler_1_fetch (sampler, val, x, f)
class(test_sampler_1_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_1_fetch
@ %def test_sampler_1_fetch
@
\subsubsection{Two-channel, two dimension test sampler}
This sampler implements the function
\begin{equation}
f(x, y) = 4\sin^2(\pi x)\sin^2(\pi y) + 2\sin^2(\pi v)
\end{equation}
where
\begin{align}
x &= u^v &u &= xy
\\
y &= u^{(1-v)} &v &= \frac12\left(1 + \frac{\log(x/y)}{\log xy}\right)
\end{align}
Each term contributes $1$ to the integral. The first term in the function is
peaked along a cross aligned to the coordinates $x$ and $y$, while the second
term is peaked along the diagonal $x=y$.
The Jacobian is
\begin{equation}
\frac{\partial(x,y)}{\partial(u,v)} = |\log u|
\end{equation}
<<MCI vamp: test types>>=
type, extends (mci_sampler_t) :: test_sampler_2_t
real(default), dimension(:,:), allocatable :: x
real(default), dimension(:), allocatable :: f
real(default) :: val
contains
<<MCI vamp: test sampler 2: TBP>>
end type test_sampler_2_t
@ %def test_sampler_2_t
@ Output: There is nothing stored inside, so just print an informative line.
<<MCI vamp: test sampler 2: TBP>>=
procedure :: write => test_sampler_2_write
<<MCI vamp: tests>>=
subroutine test_sampler_2_write (object, unit, testflag)
class(test_sampler_2_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Two-channel test sampler 2"
end subroutine test_sampler_2_write
@ %def test_sampler_2_write
@ Kinematics: compute $x$ and Jacobians, given the input parameter array.
<<MCI vamp: test sampler 2: TBP>>=
procedure :: compute => test_sampler_2_compute
<<MCI vamp: tests>>=
subroutine test_sampler_2_compute (sampler, c, x_in)
class(test_sampler_2_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default) :: xx, yy, uu, vv
if (.not. allocated (sampler%x)) &
allocate (sampler%x (size (x_in), 2))
if (.not. allocated (sampler%f)) &
allocate (sampler%f (2))
select case (c)
case (1)
xx = x_in(1)
yy = x_in(2)
uu = xx * yy
vv = (1 + log (xx/yy) / log (xx*yy)) / 2
case (2)
uu = x_in(1)
vv = x_in(2)
xx = uu ** vv
yy = uu ** (1 - vv)
end select
sampler%val = (2 * sin (pi * xx) * sin (pi * yy)) ** 2 &
+ 2 * sin (pi * vv) ** 2
sampler%f(1) = 1
sampler%f(2) = abs (log (uu))
sampler%x(:,1) = [xx, yy]
sampler%x(:,2) = [uu, vv]
end subroutine test_sampler_2_compute
@ %def test_sampler_kinematics
@ Evaluation: compute the function value. The output $x$ parameter
(only one channel) is identical to the input $x$, and the Jacobian is 1.
<<MCI vamp: test sampler 2: TBP>>=
procedure :: evaluate => test_sampler_2_evaluate
<<MCI vamp: tests>>=
subroutine test_sampler_2_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_2_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%compute (c, x_in)
call sampler%fetch (val, x, f)
end subroutine test_sampler_2_evaluate
@ %def test_sampler_2_evaluate
@ The point is always valid.
<<MCI vamp: test sampler 2: TBP>>=
procedure :: is_valid => test_sampler_2_is_valid
<<MCI vamp: tests>>=
function test_sampler_2_is_valid (sampler) result (valid)
class(test_sampler_2_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_2_is_valid
@ %def test_sampler_2_is_valid
@ Rebuild: compute all but the function value.
<<MCI vamp: test sampler 2: TBP>>=
procedure :: rebuild => test_sampler_2_rebuild
<<MCI vamp: tests>>=
subroutine test_sampler_2_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_2_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%compute (c, x_in)
x = sampler%x
f = sampler%f
end subroutine test_sampler_2_rebuild
@ %def test_sampler_2_rebuild
@ Extract the results.
<<MCI vamp: test sampler 2: TBP>>=
procedure :: fetch => test_sampler_2_fetch
<<MCI vamp: tests>>=
subroutine test_sampler_2_fetch (sampler, val, x, f)
class(test_sampler_2_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%val
x = sampler%x
f = sampler%f
end subroutine test_sampler_2_fetch
@ %def test_sampler_2_fetch
@
\subsubsection{Two-channel, one dimension test sampler}
This sampler implements the function
\begin{equation}
f(x, y) = a * 5 x^4 + b * 5 (1-x)^4
\end{equation}
Each term contributes $1$ to the integral, multiplied by $a$ or $b$,
respectively. The first term is peaked at $x=1$, the second one at $x=0$..
We implement the two mappings
\begin{equation}
x = u^{1/5} \quad\text{and}\quad x = 1 - v^{1/5},
\end{equation}
with Jacobians
\begin{equation}
\frac{\partial(x)}{\partial(u)} = u^{-4/5}/5 \quad\text{and}\quad v^{-4/5}/5,
\end{equation}
respectively. The first mapping concentrates points near $x=1$, the
second one near $x=0$.
<<MCI vamp: test types>>=
type, extends (mci_sampler_t) :: test_sampler_3_t
real(default), dimension(:,:), allocatable :: x
real(default), dimension(:), allocatable :: f
real(default) :: val
real(default) :: a = 1
real(default) :: b = 1
contains
<<MCI vamp: test sampler 3: TBP>>
end type test_sampler_3_t
@ %def test_sampler_3_t
@ Output: display $a$ and $b$
<<MCI vamp: test sampler 3: TBP>>=
procedure :: write => test_sampler_3_write
<<MCI vamp: tests>>=
subroutine test_sampler_3_write (object, unit, testflag)
class(test_sampler_3_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Two-channel test sampler 3"
write (u, "(3x,A,F5.2)") "a = ", object%a
write (u, "(3x,A,F5.2)") "b = ", object%b
end subroutine test_sampler_3_write
@ %def test_sampler_3_write
@ Kinematics: compute $x$ and Jacobians, given the input parameter array.
<<MCI vamp: test sampler 3: TBP>>=
procedure :: compute => test_sampler_3_compute
<<MCI vamp: tests>>=
subroutine test_sampler_3_compute (sampler, c, x_in)
class(test_sampler_3_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default) :: u, v, xx
if (.not. allocated (sampler%x)) &
allocate (sampler%x (size (x_in), 2))
if (.not. allocated (sampler%f)) &
allocate (sampler%f (2))
select case (c)
case (1)
u = x_in(1)
xx = u ** 0.2_default
v = (1 - xx) ** 5._default
case (2)
v = x_in(1)
xx = 1 - v ** 0.2_default
u = xx ** 5._default
end select
sampler%val = sampler%a * 5 * xx ** 4 + sampler%b * 5 * (1 - xx) ** 4
sampler%f(1) = 0.2_default * u ** (-0.8_default)
sampler%f(2) = 0.2_default * v ** (-0.8_default)
sampler%x(:,1) = [u]
sampler%x(:,2) = [v]
end subroutine test_sampler_3_compute
@ %def test_sampler_kineamtics
@ Evaluation: compute the function value. The output $x$ parameter
(only one channel) is identical to the input $x$, and the Jacobian is 1.
<<MCI vamp: test sampler 3: TBP>>=
procedure :: evaluate => test_sampler_3_evaluate
<<MCI vamp: tests>>=
subroutine test_sampler_3_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_3_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%compute (c, x_in)
call sampler%fetch (val, x, f)
end subroutine test_sampler_3_evaluate
@ %def test_sampler_3_evaluate
@ The point is always valid.
<<MCI vamp: test sampler 3: TBP>>=
procedure :: is_valid => test_sampler_3_is_valid
<<MCI vamp: tests>>=
function test_sampler_3_is_valid (sampler) result (valid)
class(test_sampler_3_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_3_is_valid
@ %def test_sampler_3_is_valid
@ Rebuild: compute all but the function value.
<<MCI vamp: test sampler 3: TBP>>=
procedure :: rebuild => test_sampler_3_rebuild
<<MCI vamp: tests>>=
subroutine test_sampler_3_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_3_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%compute (c, x_in)
x = sampler%x
f = sampler%f
end subroutine test_sampler_3_rebuild
@ %def test_sampler_3_rebuild
@ Extract the results.
<<MCI vamp: test sampler 3: TBP>>=
procedure :: fetch => test_sampler_3_fetch
<<MCI vamp: tests>>=
subroutine test_sampler_3_fetch (sampler, val, x, f)
class(test_sampler_3_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%val
x = sampler%x
f = sampler%f
end subroutine test_sampler_3_fetch
@ %def test_sampler_3_fetch
@
\subsubsection{One-dimensional integration}
Construct an integrator and use it for a one-dimensional sampler.
Note: We would like to check the precise contents of the grid
allocated during integration, but the output format for reals is very
long (for good reasons), so the last digits in the grid content
display are numerical noise. So, we just check the integration
results.
<<MCI vamp: execute tests>>=
call test (mci_vamp_1, "mci_vamp_1", &
"one-dimensional integral", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_1
<<MCI vamp: tests>>=
subroutine mci_vamp_1 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_1"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(single channel)"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 1)
select type (mci)
type is (mci_vamp_t)
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_1_t :: sampler)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_calls = 1000"
write (u, "(A)") " (lower precision to avoid"
write (u, "(A)") " numerical noise)"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass ()
end select
call mci%integrate (mci_instance, sampler, 1, 1000, pacify = .true.)
call mci%write (u, .true.)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u, .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_1"
end subroutine mci_vamp_1
@ %def mci_vamp_1
@
\subsubsection{Multiple iterations}
Construct an integrator and use it for a one-dimensional sampler.
Integrate with five iterations without grid adaptation.
<<MCI vamp: execute tests>>=
call test (mci_vamp_2, "mci_vamp_2", &
"multiple iterations", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_2
<<MCI vamp: tests>>=
subroutine mci_vamp_2 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_2"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(single channel)"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 1)
select type (mci)
type is (mci_vamp_t)
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_1_t :: sampler)
select type (sampler)
type is (test_sampler_1_t)
sampler%mode = 2
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 100"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .false.)
end select
call mci%integrate (mci_instance, sampler, 3, 100)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_2"
end subroutine mci_vamp_2
@ %def mci_vamp_2
@
\subsubsection{Grid adaptation}
Construct an integrator and use it for a one-dimensional sampler.
Integrate with three iterations and in-between grid adaptations.
<<MCI vamp: execute tests>>=
call test (mci_vamp_3, "mci_vamp_3", &
"grid adaptation", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_3
<<MCI vamp: tests>>=
subroutine mci_vamp_3 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_3"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(single channel)"
write (u, "(A)") "* and adapt grid"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 1)
select type (mci)
type is (mci_vamp_t)
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_1_t :: sampler)
select type (sampler)
type is (test_sampler_1_t)
sampler%mode = 2
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 100"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 100)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_3"
end subroutine mci_vamp_3
@ %def mci_vamp_3
@
\subsubsection{Two-dimensional integral}
Construct an integrator and use it for a two-dimensional sampler.
Integrate with three iterations and in-between grid adaptations.
<<MCI vamp: execute tests>>=
call test (mci_vamp_4, "mci_vamp_4", &
"two-dimensional integration", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_4
<<MCI vamp: tests>>=
subroutine mci_vamp_4 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_4"
write (u, "(A)") "* Purpose: integrate function in two dimensions &
&(single channel)"
write (u, "(A)") "* and adapt grid"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (2, 1)
select type (mci)
type is (mci_vamp_t)
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_1_t :: sampler)
select type (sampler)
type is (test_sampler_1_t)
sampler%mode = 3
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_4"
end subroutine mci_vamp_4
@ %def mci_vamp_4
@
\subsubsection{Two-channel integral}
Construct an integrator and use it for a two-dimensional sampler with two
channels.
Integrate with three iterations and in-between grid adaptations.
<<MCI vamp: execute tests>>=
call test (mci_vamp_5, "mci_vamp_5", &
"two-dimensional integration", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_5
<<MCI vamp: tests>>=
subroutine mci_vamp_5 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_5"
write (u, "(A)") "* Purpose: integrate function in two dimensions &
&(two channels)"
write (u, "(A)") "* and adapt grid"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_2_t :: sampler)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_5"
end subroutine mci_vamp_5
@ %def mci_vamp_5
@
\subsubsection{Weight adaptation}
Construct an integrator and use it for a one-dimensional sampler with two
channels.
Integrate with three iterations and in-between weight adaptations.
<<MCI vamp: execute tests>>=
call test (mci_vamp_6, "mci_vamp_6", &
"weight adaptation", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_6
<<MCI vamp: tests>>=
subroutine mci_vamp_6 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_6"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(two channels)"
write (u, "(A)") "* and adapt weights"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_3_t :: sampler)
select type (sampler)
type is (test_sampler_3_t)
sampler%a = 0.9_default
sampler%b = 0.1_default
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_weights = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
deallocate (mci_instance)
deallocate (mci)
write (u, "(A)")
write (u, "(A)") "* Re-initialize with chained channels"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 2)
call mci%declare_chains ([1,1])
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_weights = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_6"
end subroutine mci_vamp_6
@ %def mci_vamp_6
@
\subsubsection{Equivalences}
Construct an integrator and use it for a one-dimensional sampler with two
channels.
Integrate with three iterations and in-between grid adaptations.
Apply an equivalence between the two channels, so the binning of the
two channels is forced to coincide. Compare this with the behavior
without equivalences.
<<MCI vamp: execute tests>>=
call test (mci_vamp_7, "mci_vamp_7", &
"use channel equivalences", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_7
<<MCI vamp: tests>>=
subroutine mci_vamp_7 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
type(phs_channel_t), dimension(:), allocatable :: channel
class(rng_t), allocatable :: rng
real(default), dimension(:,:), allocatable :: x
integer :: u_grid, iostat, i, div, ch
character(16) :: buffer
write (u, "(A)") "* Test output: mci_vamp_7"
write (u, "(A)") "* Purpose: check effect of channel equivalences"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_3_t :: sampler)
select type (sampler)
type is (test_sampler_3_t)
sampler%a = 0.7_default
sampler%b = 0.3_default
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 2 and n_calls = 1000, &
&adapt grids"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 2, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Write grids and extract binning"
write (u, "(A)")
u_grid = free_unit ()
open (u_grid, status = "scratch", action = "readwrite")
select type (mci_instance)
type is (mci_vamp_instance_t)
call vamp_write_grids (mci_instance%grids, u_grid)
end select
rewind (u_grid)
allocate (x (0:20, 2))
do div = 1, 2
FIND_BINS1: do
read (u_grid, "(A)") buffer
if (trim (adjustl (buffer)) == "begin d%x") then
do
read (u_grid, *, iostat = iostat) i, x(i,div)
if (iostat /= 0) exit FIND_BINS1
end do
end if
end do FIND_BINS1
end do
close (u_grid)
write (u, "(1x,A,L1)") "Equal binning in both channels = ", &
all (x(:,1) == x(:,2))
deallocate (x)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
deallocate (mci_instance)
deallocate (mci)
write (u, "(A)")
write (u, "(A)") "* Re-initialize integrator, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .true.
call mci%set_grid_parameters (grid_par)
end select
write (u, "(A)") "* Define equivalences"
write (u, "(A)")
allocate (channel (2))
do ch = 1, 2
allocate (channel(ch)%eq (2))
do i = 1, 2
associate (eq => channel(ch)%eq(i))
call eq%init (1)
eq%c = i
eq%perm = [1]
eq%mode = [0]
end associate
end do
write (u, "(1x,I0,':')", advance = "no") ch
call channel(ch)%write (u)
end do
call mci%declare_equivalences (channel, dim_offset = 0)
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 2 and n_calls = 1000, &
&adapt grids"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 2, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Write grids and extract binning"
write (u, "(A)")
u_grid = free_unit ()
open (u_grid, status = "scratch", action = "readwrite")
select type (mci_instance)
type is (mci_vamp_instance_t)
call vamp_write_grids (mci_instance%grids, u_grid)
end select
rewind (u_grid)
allocate (x (0:20, 2))
do div = 1, 2
FIND_BINS2: do
read (u_grid, "(A)") buffer
if (trim (adjustl (buffer)) == "begin d%x") then
do
read (u_grid, *, iostat = iostat) i, x(i,div)
if (iostat /= 0) exit FIND_BINS2
end do
end if
end do FIND_BINS2
end do
close (u_grid)
write (u, "(1x,A,L1)") "Equal binning in both channels = ", &
all (x(:,1) == x(:,2))
deallocate (x)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_7"
end subroutine mci_vamp_7
@ %def mci_vamp_7
@
\subsubsection{Multiple passes}
Integrate with three passes and different settings for weight and grid
adaptation.
<<MCI vamp: execute tests>>=
call test (mci_vamp_8, "mci_vamp_8", &
"integration passes", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_8
<<MCI vamp: tests>>=
subroutine mci_vamp_8 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_8"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(two channels)"
write (u, "(A)") "* in three passes"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_3_t :: sampler)
select type (sampler)
type is (test_sampler_3_t)
sampler%a = 0.9_default
sampler%b = 0.1_default
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with grid and weight adaptation"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true., adapt_weights = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with grid adaptation"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate without adaptation"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass ()
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_8"
end subroutine mci_vamp_8
@ %def mci_vamp_8
@
\subsubsection{Weighted events}
Construct an integrator and use it for a two-dimensional sampler with two
channels. Integrate and generate a weighted event.
<<MCI vamp: execute tests>>=
call test (mci_vamp_9, "mci_vamp_9", &
"weighted event", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_9
<<MCI vamp: tests>>=
subroutine mci_vamp_9 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_9"
write (u, "(A)") "* Purpose: integrate function in two dimensions &
&(two channels)"
write (u, "(A)") "* and generate a weighted event"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_2_t :: sampler)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
write (u, "(A)")
call mci%add_pass ()
call mci%integrate (mci_instance, sampler, 1, 1000)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate a weighted event"
write (u, "(A)")
call mci_instance%init_simulation ()
call mci%generate_weighted_event (mci_instance, sampler)
write (u, "(1x,A)") "MCI instance:"
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final_simulation ()
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_9"
end subroutine mci_vamp_9
@ %def mci_vamp_9
@
\subsubsection{Grids I/O}
Construct an integrator and allocate grids. Write grids to file, read
them in again and compare.
<<MCI vamp: execute tests>>=
call test (mci_vamp_10, "mci_vamp_10", &
"grids I/O", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_10
<<MCI vamp: tests>>=
subroutine mci_vamp_10 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
type(string_t) :: file1, file2
character(80) :: buffer1, buffer2
integer :: u1, u2, iostat1, iostat2
logical :: equal, success
write (u, "(A)") "* Test output: mci_vamp_10"
write (u, "(A)") "* Purpose: write and read VAMP grids"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
mci%md5sum = "1234567890abcdef1234567890abcdef"
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_2_t :: sampler)
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
write (u, "(A)")
call mci%add_pass ()
call mci%integrate (mci_instance, sampler, 1, 1000)
write (u, "(A)") "* Write grids to file"
write (u, "(A)")
file1 = "mci_vamp_10.1"
select type (mci)
type is (mci_vamp_t)
call mci%set_grid_filename (file1)
call mci%write_grids (mci_instance)
end select
call mci_instance%final ()
call mci%final ()
deallocate (mci)
write (u, "(A)") "* Read grids from file"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_vamp_t)
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
mci%md5sum = "1234567890abcdef1234567890abcdef"
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
select type (mci)
type is (mci_vamp_t)
call mci%set_grid_filename (file1)
call mci%add_pass ()
call mci%current_pass%configure (1, 1000, &
mci%min_calls, &
mci%grid_par%min_bins, mci%grid_par%max_bins, &
mci%grid_par%min_calls_per_channel * mci%n_channel)
call mci%read_grids_header (success)
call mci%compute_md5sum ()
call mci%read_grids_data (mci_instance, read_integrals = .true.)
end select
write (u, "(1x,A,L1)") "success = ", success
write (u, "(A)")
write (u, "(A)") "* Write grids again"
write (u, "(A)")
file2 = "mci_vamp_10.2"
select type (mci)
type is (mci_vamp_t)
call mci%set_grid_filename (file2)
call mci%write_grids (mci_instance)
end select
u1 = free_unit ()
open (u1, file = char (file1) // ".vg", action = "read", status = "old")
u2 = free_unit ()
open (u2, file = char (file2) // ".vg", action = "read", status = "old")
equal = .true.
iostat1 = 0
iostat2 = 0
do while (equal .and. iostat1 == 0 .and. iostat2 == 0)
read (u1, "(A)", iostat = iostat1) buffer1
read (u2, "(A)", iostat = iostat2) buffer2
equal = buffer1 == buffer2 .and. iostat1 == iostat2
end do
close (u1)
close (u2)
if (equal) then
write (u, "(1x,A)") "Success: grid files are identical"
else
write (u, "(1x,A)") "Failure: grid files differ"
end if
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_10"
end subroutine mci_vamp_10
@ %def mci_vamp_10
@
\subsubsection{Weighted events with grid I/O}
Construct an integrator and use it for a two-dimensional sampler with two
channels. Integrate, write grids, and generate a weighted event using
the grids from file.
<<MCI vamp: execute tests>>=
call test (mci_vamp_11, "mci_vamp_11", &
"weighted events with grid I/O", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_11
<<MCI vamp: tests>>=
subroutine mci_vamp_11 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_11"
write (u, "(A)") "* Purpose: integrate function in two dimensions &
&(two channels)"
write (u, "(A)") "* and generate a weighted event"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
call mci%set_grid_filename (var_str ("mci_vamp_11"))
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_2_t :: sampler)
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
write (u, "(A)")
call mci%add_pass ()
call mci%integrate (mci_instance, sampler, 1, 1000)
write (u, "(A)") "* Reset instance"
write (u, "(A)")
call mci_instance%final ()
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Generate a weighted event"
write (u, "(A)")
call mci_instance%init_simulation ()
call mci%generate_weighted_event (mci_instance, sampler)
write (u, "(A)") "* Cleanup"
call mci_instance%final_simulation ()
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_11"
end subroutine mci_vamp_11
@ %def mci_vamp_11
@
\subsubsection{Unweighted events with grid I/O}
Construct an integrator and use it for a two-dimensional sampler with two
channels.
<<MCI vamp: execute tests>>=
call test (mci_vamp_12, "mci_vamp_12", &
"unweighted events with grid I/O", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_12
<<MCI vamp: tests>>=
subroutine mci_vamp_12 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_12"
write (u, "(A)") "* Purpose: integrate function in two dimensions &
&(two channels)"
write (u, "(A)") "* and generate an unweighted event"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
call mci%set_grid_filename (var_str ("mci_vamp_12"))
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_2_t :: sampler)
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
write (u, "(A)")
call mci%add_pass ()
call mci%integrate (mci_instance, sampler, 1, 1000)
write (u, "(A)") "* Reset instance"
write (u, "(A)")
call mci_instance%final ()
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Generate an unweighted event"
write (u, "(A)")
call mci_instance%init_simulation ()
call mci%generate_unweighted_event (mci_instance, sampler)
write (u, "(1x,A)") "MCI instance:"
call mci_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final_simulation ()
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_12"
end subroutine mci_vamp_12
@ %def mci_vamp_12
@
\subsubsection{Update integration results}
Compare two [[mci]] objects; match the two and update the first if
successful.
<<MCI vamp: execute tests>>=
call test (mci_vamp_13, "mci_vamp_13", &
"updating integration results", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_13
<<MCI vamp: tests>>=
subroutine mci_vamp_13 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci, mci_ref
logical :: success
write (u, "(A)") "* Test output: mci_vamp_13"
write (u, "(A)") "* Purpose: match and update integrators"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator with no passes"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (2, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
end select
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize reference"
write (u, "(A)")
allocate (mci_vamp_t :: mci_ref)
call mci_ref%set_dimensions (2, 2)
select type (mci_ref)
type is (mci_vamp_t)
call mci_ref%set_grid_parameters (grid_par)
end select
select type (mci_ref)
type is (mci_vamp_t)
call mci_ref%add_pass (adapt_grids = .true.)
call mci_ref%current_pass%configure (2, 1000, 0, 1, 5, 0)
mci_ref%current_pass%calls = [77, 77]
mci_ref%current_pass%integral = [1.23_default, 3.45_default]
mci_ref%current_pass%error = [0.23_default, 0.45_default]
mci_ref%current_pass%efficiency = [0.1_default, 0.6_default]
mci_ref%current_pass%integral_defined = .true.
call mci_ref%add_pass ()
call mci_ref%current_pass%configure (2, 2000, 0, 1, 7, 0)
mci_ref%current_pass%calls = [99, 0]
mci_ref%current_pass%integral = [7.89_default, 0._default]
mci_ref%current_pass%error = [0.89_default, 0._default]
mci_ref%current_pass%efficiency = [0.86_default, 0._default]
mci_ref%current_pass%integral_defined = .true.
end select
call mci_ref%write (u)
write (u, "(A)")
write (u, "(A)") "* Update integrator (no-op, should succeed)"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%update_from_ref (mci_ref, success)
end select
write (u, "(1x,A,L1)") "success = ", success
write (u, "(A)")
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Add pass to integrator"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
call mci%current_pass%configure (2, 1000, 0, 1, 5, 0)
mci%current_pass%calls = [77, 77]
mci%current_pass%integral = [1.23_default, 3.45_default]
mci%current_pass%error = [0.23_default, 0.45_default]
mci%current_pass%efficiency = [0.1_default, 0.6_default]
mci%current_pass%integral_defined = .true.
end select
write (u, "(A)") "* Update integrator (no-op, should succeed)"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%update_from_ref (mci_ref, success)
end select
write (u, "(1x,A,L1)") "success = ", success
write (u, "(A)")
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Add pass to integrator, wrong parameters"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass ()
call mci%current_pass%configure (2, 1000, 0, 1, 7, 0)
end select
write (u, "(A)") "* Update integrator (should fail)"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%update_from_ref (mci_ref, success)
end select
write (u, "(1x,A,L1)") "success = ", success
write (u, "(A)")
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Reset and add passes to integrator"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%reset ()
call mci%add_pass (adapt_grids = .true.)
call mci%current_pass%configure (2, 1000, 0, 1, 5, 0)
mci%current_pass%calls = [77, 77]
mci%current_pass%integral = [1.23_default, 3.45_default]
mci%current_pass%error = [0.23_default, 0.45_default]
mci%current_pass%efficiency = [0.1_default, 0.6_default]
mci%current_pass%integral_defined = .true.
call mci%add_pass ()
call mci%current_pass%configure (2, 2000, 0, 1, 7, 0)
end select
write (u, "(A)") "* Update integrator (should succeed)"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%update_from_ref (mci_ref, success)
end select
write (u, "(1x,A,L1)") "success = ", success
write (u, "(A)")
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Update again (no-op, should succeed)"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%update_from_ref (mci_ref, success)
end select
write (u, "(1x,A,L1)") "success = ", success
write (u, "(A)")
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Add extra result to integrator"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
mci%current_pass%calls(2) = 1234
end select
write (u, "(A)") "* Update integrator (should fail)"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%update_from_ref (mci_ref, success)
end select
write (u, "(1x,A,L1)") "success = ", success
write (u, "(A)")
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci%final ()
call mci_ref%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_13"
end subroutine mci_vamp_13
@ %def mci_vamp_13
@
\subsubsection{Accuracy Goal}
Integrate with multiple iterations. Skip iterations once an accuracy goal has
been reached.
<<MCI vamp: execute tests>>=
call test (mci_vamp_14, "mci_vamp_14", &
"accuracy goal", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_14
<<MCI vamp: tests>>=
subroutine mci_vamp_14 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_14"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(single channel)"
write (u, "(A)") "* and check accuracy goal"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 1)
select type (mci)
type is (mci_vamp_t)
grid_par%use_vamp_equivalences = .false.
grid_par%accuracy_goal = 5E-2_default
call mci%set_grid_parameters (grid_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_1_t :: sampler)
select type (sampler)
type is (test_sampler_1_t)
sampler%mode = 2
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 5 and n_calls = 100"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 5, 100)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_14"
end subroutine mci_vamp_14
@ %def mci_vamp_14
@
\subsubsection{VAMP history}
Integrate with three passes and different settings for weight and grid
adaptation. Then show the VAMP history.
<<MCI vamp: execute tests>>=
call test (mci_vamp_15, "mci_vamp_15", &
"VAMP history", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_15
<<MCI vamp: tests>>=
subroutine mci_vamp_15 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
type(history_parameters_t) :: history_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_15"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(two channels)"
write (u, "(A)") "* in three passes, show history"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
history_par%channel = .true.
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 2)
select type (mci)
type is (mci_vamp_t)
grid_par%stratified = .false.
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
call mci%set_history_parameters (history_par)
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_3_t :: sampler)
select type (sampler)
type is (test_sampler_3_t)
sampler%a = 0.9_default
sampler%b = 0.1_default
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Pass 1: grid and weight adaptation"
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true., adapt_weights = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
write (u, "(A)")
write (u, "(A)") "* Pass 2: grid adaptation"
select type (mci)
type is (mci_vamp_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
write (u, "(A)")
write (u, "(A)") "* Pass 3: without adaptation"
select type (mci)
type is (mci_vamp_t)
call mci%add_pass ()
end select
call mci%integrate (mci_instance, sampler, 3, 1000)
write (u, "(A)")
write (u, "(A)") "* Contents of MCI record, with history"
write (u, "(A)")
call mci%write (u)
select type (mci)
type is (mci_vamp_t)
call mci%write_history (u)
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_15"
end subroutine mci_vamp_15
@ %def mci_vamp_15
@
\subsubsection{One-dimensional integration with sign change}
Construct an integrator and use it for a one-dimensional sampler.
<<MCI vamp: execute tests>>=
call test (mci_vamp_16, "mci_vamp_16", &
"1-D integral with sign change", &
u, results)
<<MCI vamp: test declarations>>=
public :: mci_vamp_16
<<MCI vamp: tests>>=
subroutine mci_vamp_16 (u)
integer, intent(in) :: u
type(grid_parameters_t) :: grid_par
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
write (u, "(A)") "* Test output: mci_vamp_16"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(single channel)"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator"
write (u, "(A)")
allocate (mci_vamp_t :: mci)
call mci%set_dimensions (1, 1)
select type (mci)
type is (mci_vamp_t)
grid_par%use_vamp_equivalences = .false.
call mci%set_grid_parameters (grid_par)
mci%negative_weights = .true.
end select
allocate (rng_tao_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)") "* Initialize test sampler"
write (u, "(A)")
allocate (test_sampler_1_t :: sampler)
select type (sampler)
type is (test_sampler_1_t)
sampler%mode = 4
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_calls = 1000"
write (u, "(A)") " (lower precision to avoid"
write (u, "(A)") " numerical noise)"
write (u, "(A)")
select type (mci)
type is (mci_vamp_t)
call mci%add_pass ()
end select
call mci%integrate (mci_instance, sampler, 1, 1000, pacify = .true.)
call mci%write (u, .true.)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u, .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp_16"
end subroutine mci_vamp_16
@ %def mci_vamp_16
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Multi-channel integration with VAMP2}
\label{sec:vegas-integration}
The multi-channel integration uses VEGAS as backbone integrator.
The base interface for the multi-channel integration is given by [[mci_base]] module.
We interface the VAMP2 interface given by [[vamp2]] module.
<<[[mci_vamp2.f90]]>>=
<<File header>>
module mci_vamp2
<<Use kinds>>
<<Use strings>>
use io_units
use format_utils, only: pac_fmt
use format_utils, only: write_separator, write_indent
use format_defs, only: FMT_12, FMT_14, FMT_17, FMT_19
use diagnostics
use md5
use phs_base
use rng_base
use mci_base
use vegas, only: VEGAS_MODE_IMPORTANCE, VEGAS_MODE_IMPORTANCE_ONLY
use vamp2
<<MCI vamp2: modules>>
<<Standard module head>>
<<MCI vamp2: public>>
<<MCI vamp2: types>>
<<MCI vamp2: interfaces>>
contains
<<MCI vamp2: procedures>>
end module mci_vamp2
@ %def mci_vamp2
<<MCI vamp2: modules>>=
@
<<MPI: MCI vamp2: modules>>=
use mpi_f08 !NODEP!
@ %def mpi_f08
@
\subsection{Type: mci\_vamp2\_func\_t}
\label{sec:mci-vamp2-func}
<<MCI vamp2: types>>=
type, extends (vamp2_func_t) :: mci_vamp2_func_t
private
real(default) :: integrand = 0.
class(mci_sampler_t), pointer :: sampler => null ()
class(mci_vamp2_instance_t), pointer :: instance => null ()
contains
<<MCI vamp2: mci vamp2 func: TBP>>
end type mci_vamp2_func_t
@ %def mci_vamp2_func_t
@ Set instance and sampler aka workspace. Also, reset number of [[n_calls]].
<<MCI vamp2: mci vamp2 func: TBP>>=
procedure, public :: set_workspace => mci_vamp2_func_set_workspace
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_func_set_workspace (self, instance, sampler)
class(mci_vamp2_func_t), intent(inout) :: self
class(mci_vamp2_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
self%instance => instance
self%sampler => sampler
end subroutine mci_vamp2_func_set_workspace
@ %def mci_vamp2_func_set_workspace
@ Get the different channel probabilities.
<<MCI vamp2: mci vamp2 func: TBP>>=
procedure, public :: get_probabilities => mci_vamp2_func_get_probabilities
<<MCI vamp2: procedures>>=
function mci_vamp2_func_get_probabilities (self) result (gi)
class(mci_vamp2_func_t), intent(inout) :: self
real(default), dimension(self%n_channel) :: gi
gi = self%gi
end function mci_vamp2_func_get_probabilities
@ %def mci_vamp2_func_get_probabilities
@ Get multi-channel weight.
<<MCI vamp2: mci vamp2 func: TBP>>=
procedure, public :: get_weight => mci_vamp2_func_get_weight
<<MCI vamp2: procedures>>=
real(default) function mci_vamp2_func_get_weight (self) result (g)
class(mci_vamp2_func_t), intent(in) :: self
g = self%g
end function mci_vamp2_func_get_weight
@ %def mci_vamp2_func_get_weight
@ Set integrand.
<<MCI vamp2: mci vamp2 func: TBP>>=
procedure, public :: set_integrand => mci_vamp2_func_set_integrand
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_func_set_integrand (self, integrand)
class(mci_vamp2_func_t), intent(inout) :: self
real(default), intent(in) :: integrand
self%integrand = integrand
end subroutine mci_vamp2_func_set_integrand
@ %def mci_vamp2_func_set_integrand
@ Evaluate the mappings.
<<MCI vamp2: mci vamp2 func: TBP>>=
procedure, public :: evaluate_maps => mci_vamp2_func_evaluate_maps
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_func_evaluate_maps (self, x)
class(mci_vamp2_func_t), intent(inout) :: self
real(default), dimension(:), intent(in) :: x
select type (self)
type is (mci_vamp2_func_t)
call self%instance%evaluate (self%sampler, self%current_channel, x)
end select
self%valid_x = self%instance%valid
self%xi = self%instance%x
self%det = self%instance%f
end subroutine mci_vamp2_func_evaluate_maps
@ %def mci_vamp2_func_evaluate_maps
@ Evaluate the function, more or less.
<<MCI vamp2: mci vamp2 func: TBP>>=
procedure, public :: evaluate_func => mci_vamp2_func_evaluate_func
<<MCI vamp2: procedures>>=
real(default) function mci_vamp2_func_evaluate_func (self, x) result (f)
class(mci_vamp2_func_t), intent(in) :: self
real(default), dimension(:), intent(in) :: x
f = self%integrand
if (signal_is_pending ()) then
call msg_message ("MCI VAMP2: function evalutae func: signal received")
call terminate_now_if_signal ()
end if
call terminate_now_if_single_event ()
end function mci_vamp2_func_evaluate_func
@ %def mci_vamp2_func_evaluate_func
@
\subsection{Type: mci\_vamp2\_config\_t}
We extend [[vamp2_config_t]].
<<MCI vamp2: public>>=
public :: mci_vamp2_config_t
<<MCI vamp2: types>>=
type, extends (vamp2_config_t) :: mci_vamp2_config_t
!
end type mci_vamp2_config_t
@ %def mci_vamp2_config_t
@
\subsection{Integration pass}
The list of passes is organized in a separate container. We store the parameters
and results for each integration pass in [[pass_t]] and the linked list is
stored in [[list_pass_t]].
<<MCI vamp2: types>>=
type :: list_pass_t
type(pass_t), pointer :: first => null ()
type(pass_t), pointer :: current => null ()
contains
<<MCI vamp2: list pass: TBP>>
end type list_pass_t
@ %def list_pass_t
@ Finalizer. Deallocate each element of the list beginning by the first.
<<MCI vamp2: list pass: TBP>>=
procedure :: final => list_pass_final
<<MCI vamp2: procedures>>=
subroutine list_pass_final (self)
class(list_pass_t), intent(inout) :: self
type(pass_t), pointer :: current
current => self%first
do while (associated (current))
self%first => current%next
deallocate (current)
current => self%first
end do
end subroutine list_pass_final
@ %def pass_final
@ Add a new pass.
<<MCI vamp2: list pass: TBP>>=
procedure :: add => list_pass_add
<<MCI vamp2: procedures>>=
subroutine list_pass_add (self, adapt_grids, adapt_weights, final_pass)
class(list_pass_t), intent(inout) :: self
logical, intent(in), optional :: adapt_grids, adapt_weights, final_pass
type(pass_t), pointer :: new_pass
allocate (new_pass)
new_pass%i_pass = 1
new_pass%i_first_it = 1
new_pass%adapt_grids = .false.; if (present (adapt_grids)) &
& new_pass%adapt_grids = adapt_grids
new_pass%adapt_weights = .false.; if (present (adapt_weights)) &
& new_pass%adapt_weights = adapt_weights
new_pass%is_final_pass = .false.; if (present (final_pass)) &
& new_pass%is_final_pass = final_pass
if (.not. associated (self%first)) then
self%first => new_pass
else
new_pass%i_pass = new_pass%i_pass + self%current%i_pass
new_pass%i_first_it = self%current%i_first_it + self%current%n_it
self%current%next => new_pass
end if
self%current => new_pass
end subroutine list_pass_add
@ %def list_pass_add
@ Update list from a reference. All passes except for the last one must match
exactly. For the last one, integration results are updated. The reference output
may contain extra passes, these are ignored.
<<MCI vamp2: list pass: TBP>>=
procedure :: update_from_ref => list_pass_update_from_ref
<<MCI vamp2: procedures>>=
subroutine list_pass_update_from_ref (self, ref, success)
class(list_pass_t), intent(inout) :: self
type(list_pass_t), intent(in) :: ref
logical, intent(out) :: success
type(pass_t), pointer :: current, ref_current
current => self%first
ref_current => ref%first
success = .true.
do while (success .and. associated (current))
if (associated (ref_current)) then
if (associated (current%next)) then
success = current .matches. ref_current
else
call current%update (ref_current, success)
end if
current => current%next
ref_current => ref_current%next
else
success = .false.
end if
end do
end subroutine list_pass_update_from_ref
@ %def list_pass_update_from_ref
@ Output. Write the complete linked list to the specified unit.
<<MCI vamp2: list pass: TBP>>=
procedure :: write => list_pass_write
<<MCI vamp2: procedures>>=
subroutine list_pass_write (self, unit, pacify)
class(list_pass_t), intent(in) :: self
integer, intent(in) :: unit
logical, intent(in), optional :: pacify
type(pass_t), pointer :: current
current => self%first
do while (associated (current))
write (unit, "(1X,A)") "Integration pass:"
call current%write (unit, pacify)
current => current%next
end do
end subroutine list_pass_write
@ %def list_pass_write
@ The parameters and results are stored in the nodes [[pass_t]] of the linked
list.
<<MCI vamp2: types>>=
type :: pass_t
integer :: i_pass = 0
integer :: i_first_it = 0
integer :: n_it = 0
integer :: n_calls = 0
logical :: adapt_grids = .false.
logical :: adapt_weights = .false.
logical :: is_final_pass = .false.
logical :: integral_defined = .false.
integer, dimension(:), allocatable :: calls
integer, dimension(:), allocatable :: calls_valid
real(default), dimension(:), allocatable :: integral
real(default), dimension(:), allocatable :: error
real(default), dimension(:), allocatable :: efficiency
type(pass_t), pointer :: next => null ()
contains
<<MCI vamp2: pass: TBP>>
end type pass_t
@ %def pass_t
@ Output. Note that the precision of the numerical values should match the
precision for comparing output from file with data.
<<MCI vamp2: pass: TBP>>=
procedure :: write => pass_write
<<MCI vamp2: procedures>>=
subroutine pass_write (self, unit, pacify)
class(pass_t), intent(in) :: self
integer, intent(in) :: unit
logical, intent(in), optional :: pacify
integer :: u, i
character(len=7) :: fmt
call pac_fmt (fmt, FMT_17, FMT_14, pacify)
u = given_output_unit (unit)
write (u, "(3X,A,I0)") "n_it = ", self%n_it
write (u, "(3X,A,I0)") "n_calls = ", self%n_calls
write (u, "(3X,A,L1)") "adapt grids = ", self%adapt_grids
write (u, "(3X,A,L1)") "adapt weights = ", self%adapt_weights
if (self%integral_defined) then
write (u, "(3X,A)") "Results: [it, calls, valid, integral, error, efficiency]"
do i = 1, self%n_it
write (u, "(5x,I0,2(1x,I0),3(1x," // fmt // "))") &
i, self%calls(i), self%calls_valid(i), self%integral(i), self%error(i), &
self%efficiency(i)
end do
else
write (u, "(3x,A)") "Results: [undefined]"
end if
end subroutine pass_write
@ %def pass_write
@ Read and reconstruct the pass.
<<MCI vamp2: pass: TBP>>=
procedure :: read => pass_read
<<MCI vamp2: procedures>>=
subroutine pass_read (self, u, n_pass, n_it)
class(pass_t), intent(out) :: self
integer, intent(in) :: u, n_pass, n_it
integer :: i, j
character(80) :: buffer
self%i_pass = n_pass + 1
self%i_first_it = n_it + 1
call read_ival (u, self%n_it)
call read_ival (u, self%n_calls)
call read_lval (u, self%adapt_grids)
call read_lval (u, self%adapt_weights)
allocate (self%calls (self%n_it), source = 0)
allocate (self%calls_valid (self%n_it), source = 0)
allocate (self%integral (self%n_it), source = 0._default)
allocate (self%error (self%n_it), source = 0._default)
allocate (self%efficiency (self%n_it), source = 0._default)
read (u, "(A)") buffer
select case (trim (adjustl (buffer)))
case ("Results: [it, calls, valid, integral, error, efficiency]")
do i = 1, self%n_it
read (u, *) &
j, self%calls(i), self%calls_valid(i), self%integral(i), self%error(i), &
self%efficiency(i)
end do
self%integral_defined = .true.
case ("Results: [undefined]")
self%integral_defined = .false.
case default
call msg_fatal ("Reading integration pass: corrupted file")
end select
end subroutine pass_read
@ %def pass_read
@ Auxiliary: Read real, integer, string value. We search for an equals sign,
the value must follow.
<<MCI vamp2: procedures>>=
subroutine read_rval (u, rval)
integer, intent(in) :: u
real(default), intent(out) :: rval
character(80) :: buffer
read (u, "(A)") buffer
buffer = adjustl (buffer(scan (buffer, "=") + 1:))
read (buffer, *) rval
end subroutine read_rval
subroutine read_ival (u, ival)
integer, intent(in) :: u
integer, intent(out) :: ival
character(80) :: buffer
read (u, "(A)") buffer
buffer = adjustl (buffer(scan (buffer, "=") + 1:))
read (buffer, *) ival
end subroutine read_ival
subroutine read_sval (u, sval)
integer, intent(in) :: u
character(*), intent(out) :: sval
character(80) :: buffer
read (u, "(A)") buffer
buffer = adjustl (buffer(scan (buffer, "=") + 1:))
read (buffer, *) sval
end subroutine read_sval
subroutine read_lval (u, lval)
integer, intent(in) :: u
logical, intent(out) :: lval
character(80) :: buffer
read (u, "(A)") buffer
buffer = adjustl (buffer(scan (buffer, "=") + 1:))
read (buffer, *) lval
end subroutine read_lval
@ %def read_rval read_ival read_sval read_lval
@ Configure. We adjust the number of [[n_calls]], if it is lower than
[[n_calls_min_per_channel]] times [[b_channel]], and print a warning message.
<<MCI vamp2: pass: TBP>>=
procedure :: configure => pass_configure
<<MCI vamp2: procedures>>=
subroutine pass_configure (pass, n_it, n_calls, n_calls_min)
class(pass_t), intent(inout) :: pass
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
integer, intent(in) :: n_calls_min
pass%n_it = n_it
pass%n_calls = max (n_calls, n_calls_min)
if (pass%n_calls /= n_calls) then
write (msg_buffer, "(A,I0)") "VAMP2: too few calls, resetting " &
// "n_calls to ", pass%n_calls
call msg_warning ()
end if
allocate (pass%calls (n_it), source = 0)
allocate (pass%calls_valid (n_it), source = 0)
allocate (pass%integral (n_it), source = 0._default)
allocate (pass%error (n_it), source = 0._default)
allocate (pass%efficiency (n_it), source = 0._default)
end subroutine pass_configure
@ %def pass_configure
@ Given two pass objects, compare them. All parameters must match. Where
integrations are done in both (number of calls nonzero), the results must be
equal (up to numerical noise).
The allocated array sizes might be different, but should match up to the
common [[n_it]] value.
<<MCI vamp2: interfaces>>=
interface operator (.matches.)
module procedure pass_matches
end interface operator (.matches.)
<<MCI vamp2: procedures>>=
function pass_matches (pass, ref) result (ok)
type(pass_t), intent(in) :: pass, ref
integer :: n
logical :: ok
ok = .true.
if (ok) ok = pass%i_pass == ref%i_pass
if (ok) ok = pass%i_first_it == ref%i_first_it
if (ok) ok = pass%n_it == ref%n_it
if (ok) ok = pass%n_calls == ref%n_calls
if (ok) ok = pass%adapt_grids .eqv. ref%adapt_grids
if (ok) ok = pass%adapt_weights .eqv. ref%adapt_weights
if (ok) ok = pass%integral_defined .eqv. ref%integral_defined
if (pass%integral_defined) then
n = pass%n_it
if (ok) ok = all (pass%calls(:n) == ref%calls(:n))
if (ok) ok = all (pass%calls_valid(:n) == ref%calls_valid(:n))
if (ok) ok = all (pass%integral(:n) .matches. ref%integral(:n))
if (ok) ok = all (pass%error(:n) .matches. ref%error(:n))
if (ok) ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
end if
end function pass_matches
@ %def pass_matches
@ Update a pass object, given a reference. The parameters must match, except
for the [[n_it]] entry. The number of complete iterations must be less or
equal to the reference, and the number of complete iterations in the reference
must be no larger than [[n_it]]. Where results are present in both passes,
they must match. Where results are present in the reference only, the pass is
updated accordingly.
<<MCI vamp2: pass: TBP>>=
procedure :: update => pass_update
<<MCI vamp2: procedures>>=
subroutine pass_update (pass, ref, ok)
class(pass_t), intent(inout) :: pass
type(pass_t), intent(in) :: ref
logical, intent(out) :: ok
integer :: n, n_ref
ok = .true.
if (ok) ok = pass%i_pass == ref%i_pass
if (ok) ok = pass%i_first_it == ref%i_first_it
if (ok) ok = pass%n_calls == ref%n_calls
if (ok) ok = pass%adapt_grids .eqv. ref%adapt_grids
if (ok) ok = pass%adapt_weights .eqv. ref%adapt_weights
if (ok) then
if (ref%integral_defined) then
if (.not. allocated (pass%calls)) then
allocate (pass%calls (pass%n_it), source = 0)
allocate (pass%calls_valid (pass%n_it), source = 0)
allocate (pass%integral (pass%n_it), source = 0._default)
allocate (pass%error (pass%n_it), source = 0._default)
allocate (pass%efficiency (pass%n_it), source = 0._default)
end if
n = count (pass%calls /= 0)
n_ref = count (ref%calls /= 0)
ok = n <= n_ref .and. n_ref <= pass%n_it
if (ok) ok = all (pass%calls(:n) == ref%calls(:n))
if (ok) ok = all (pass%calls_valid(:n) == ref%calls_valid(:n))
if (ok) ok = all (pass%integral(:n) .matches. ref%integral(:n))
if (ok) ok = all (pass%error(:n) .matches. ref%error(:n))
if (ok) ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
if (ok) then
pass%calls(n+1:n_ref) = ref%calls(n+1:n_ref)
pass%calls_valid(n+1:n_ref) = ref%calls_valid(n+1:n_ref)
pass%integral(n+1:n_ref) = ref%integral(n+1:n_ref)
pass%error(n+1:n_ref) = ref%error(n+1:n_ref)
pass%efficiency(n+1:n_ref) = ref%efficiency(n+1:n_ref)
pass%integral_defined = any (pass%calls /= 0)
end if
end if
end if
end subroutine pass_update
@ %def pass_update
@ Match two real numbers: they are equal up to a tolerance, which is
$10^{-8}$, matching the number of digits that are output by [[pass_write]].
In particular, if one number is exactly zero, the other one must also be zero.
<<MCI vamp2: interfaces>>=
interface operator (.matches.)
module procedure real_matches
end interface operator (.matches.)
<<MCI vamp2: procedures>>=
elemental function real_matches (x, y) result (ok)
real(default), intent(in) :: x, y
logical :: ok
real(default), parameter :: tolerance = 1.e-8_default
ok = abs (x - y) <= tolerance * max (abs (x), abs (y))
end function real_matches
@ %def real_matches
@ Return the index of the most recent complete integration. If there is none,
return zero.
<<MCI vamp2: pass: TBP>>=
procedure :: get_integration_index => pass_get_integration_index
<<MCI vamp2: procedures>>=
function pass_get_integration_index (pass) result (n)
class (pass_t), intent(in) :: pass
integer :: n
integer :: i
n = 0
if (allocated (pass%calls)) then
do i = 1, pass%n_it
if (pass%calls(i) == 0) exit
n = i
end do
end if
end function pass_get_integration_index
@ %def pass_get_integration_index
@ Return the most recent integral and error, if available.
<<MCI vamp2: pass: TBP>>=
procedure :: get_calls => pass_get_calls
procedure :: get_calls_valid => pass_get_calls_valid
procedure :: get_integral => pass_get_integral
procedure :: get_error => pass_get_error
procedure :: get_efficiency => pass_get_efficiency
<<MCI vamp2: procedures>>=
function pass_get_calls (pass) result (calls)
class(pass_t), intent(in) :: pass
integer :: calls
integer :: n
n = pass%get_integration_index ()
calls = 0
if (n /= 0) then
calls = pass%calls(n)
end if
end function pass_get_calls
function pass_get_calls_valid (pass) result (valid)
class(pass_t), intent(in) :: pass
integer :: valid
integer :: n
n = pass%get_integration_index ()
valid = 0
if (n /= 0) then
valid = pass%calls_valid(n)
end if
end function pass_get_calls_valid
function pass_get_integral (pass) result (integral)
class(pass_t), intent(in) :: pass
real(default) :: integral
integer :: n
n = pass%get_integration_index ()
integral = 0
if (n /= 0) then
integral = pass%integral(n)
end if
end function pass_get_integral
function pass_get_error (pass) result (error)
class(pass_t), intent(in) :: pass
real(default) :: error
integer :: n
n = pass%get_integration_index ()
error = 0
if (n /= 0) then
error = pass%error(n)
end if
end function pass_get_error
function pass_get_efficiency (pass) result (efficiency)
class(pass_t), intent(in) :: pass
real(default) :: efficiency
integer :: n
n = pass%get_integration_index ()
efficiency = 0
if (n /= 0) then
efficiency = pass%efficiency(n)
end if
end function pass_get_efficiency
@ %def pass_get_calls
@ %def pass_get_calls_valid
@ %def pass_get_integral
@ %def pass_get_error
@ %def pass_get_efficiency
@
\subsection{Integrator}
\label{sec:integrator}
We store the different passes of integration, adaptation and actual sampling, in
a linked list.
We store the total number of calls [[n_calls]] and the minimal number of calls
[[n_calls_min]]. The latter is calculated based on [[n_channel]] and
[[min_calls_per_channel]]. If [[n_calls]] is smaller than [[n_calls_min]], then
we replace [[n_calls]] with [[n_min_calls]].
<<MCI vamp2: public>>=
public :: mci_vamp2_t
<<MCI vamp2: types>>=
type, extends(mci_t) :: mci_vamp2_t
type(mci_vamp2_config_t) :: config
type(vamp2_t) :: integrator
type(vamp2_equivalences_t) :: equivalences
logical :: integrator_defined = .false.
logical :: integrator_from_file = .false.
logical :: adapt_grids = .false.
logical :: adapt_weights = .false.
integer :: n_adapt_grids = 0
integer :: n_adapt_weights = 0
integer :: n_calls = 0
type(list_pass_t) :: list_pass
logical :: rebuild = .true.
logical :: check_grid_file = .true.
logical :: integrator_filename_set = .false.
logical :: negative_weights = .false.
logical :: verbose = .false.
logical :: pass_complete = .false.
logical :: it_complete = .false.
type(string_t) :: integrator_filename
character(32) :: md5sum_adapted = ""
contains
<<MCI vamp2: mci vamp2: TBP>>
end type mci_vamp2_t
@ %def mci_vamp2_t
@ Finalizer: call to base and list finalizer.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: final => mci_vamp2_final
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_final (object)
class(mci_vamp2_t), intent(inout) :: object
call object%list_pass%final ()
call object%base_final ()
end subroutine mci_vamp2_final
@ %def mci_vamp2_final
@ Output. Do not output the grids themselves, this may result in tons of data.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: write => mci_vamp2_write
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_write (object, unit, pacify, md5sum_version)
class(mci_vamp2_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
logical, intent(in), optional :: md5sum_version
integer :: u, i
u = given_output_unit (unit)
write (u, "(1X,A)") "VAMP2 integrator:"
call object%base_write (u, pacify, md5sum_version)
write (u, "(1X,A)") "Grid config:"
call object%config%write (u)
write (u, "(3X,A,L1)") "Integrator defined = ", object%integrator_defined
write (u, "(3X,A,L1)") "Integrator from file = ", object%integrator_from_file
write (u, "(3X,A,L1)") "Adapt grids = ", object%adapt_grids
write (u, "(3X,A,L1)") "Adapt weights = ", object%adapt_weights
write (u, "(3X,A,I0)") "No. of adapt grids = ", object%n_adapt_grids
write (u, "(3X,A,I0)") "No. of adapt weights = ", object%n_adapt_weights
write (u, "(3X,A,L1)") "Verbose = ", object%verbose
if (object%config%equivalences) then
call object%equivalences%write (u)
end if
call object%list_pass%write (u, pacify)
if (object%md5sum_adapted /= "") then
write (u, "(1X,A,A,A)") "MD5 sum (including results) = '", &
& object%md5sum_adapted, "'"
end if
end subroutine mci_vamp2_write
@ %def mci_vamp2_write
@ Compute the (adapted) MD5 sum, including the configuration MD5 sum and the
printout, which incorporates the current results.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: compute_md5sum => mci_vamp2_compute_md5sum
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_compute_md5sum (mci, pacify)
class(mci_vamp2_t), intent(inout) :: mci
logical, intent(in), optional :: pacify
integer :: u
mci%md5sum_adapted = ""
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
write (u, "(A)") mci%md5sum
call mci%write (u, pacify, md5sum_version = .true.)
rewind (u)
mci%md5sum_adapted = md5sum (u)
close (u)
end subroutine mci_vamp2_compute_md5sum
@ %def mci_vamp2_compute_md5sum
@ Return the MD5 sum: If available, return the adapted one.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: get_md5sum => mci_vamp2_get_md5sum
<<MCI vamp2: procedures>>=
pure function mci_vamp2_get_md5sum (mci) result (md5sum)
class(mci_vamp2_t), intent(in) :: mci
character(32) :: md5sum
if (mci%md5sum_adapted /= "") then
md5sum = mci%md5sum_adapted
else
md5sum = mci%md5sum
end if
end function mci_vamp2_get_md5sum
@ %def mci_vamp_get_md5sum
@ Startup message: short version. Make a call to the base function and print
additional information about the multi-channel parameters.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: startup_message => mci_vamp2_startup_message
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_startup_message (mci, unit, n_calls)
class(mci_vamp2_t), intent(in) :: mci
integer, intent(in), optional :: unit, n_calls
integer :: num_calls, n_bins
num_calls = 0; if (present (n_calls)) num_calls = n_calls
n_bins = mci%config%n_bins_max
call mci%base_startup_message (unit = unit, n_calls = n_calls)
if (mci%config%equivalences) then
write (msg_buffer, "(A)") &
"Integrator: Using VAMP2 channel equivalences"
call msg_message (unit = unit)
end if
write (msg_buffer, "(A,2(1x,I0,1x,A),L1)") &
"Integrator:", num_calls, &
"initial calls,", n_bins, &
"max. bins, stratified = ", &
mci%config%stratified
call msg_message (unit = unit)
write (msg_buffer, "(A,2(1x,I0,1x,A))") &
"Integrator: VAMP2"
call msg_message (unit = unit)
end subroutine mci_vamp2_startup_message
@ %def mci_vamp2_startup_message
@ Log entry: just headline.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: write_log_entry => mci_vamp2_write_log_entry
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_write_log_entry (mci, u)
class(mci_vamp2_t), intent(in) :: mci
integer, intent(in) :: u
write (u, "(1x,A)") "MC Integrator is VAMP2"
call write_separator (u)
if (mci%config%equivalences) then
call mci%equivalences%write (u)
else
write (u, "(3x,A)") "No channel equivalences have been used."
end if
call write_separator (u)
call mci%write_chain_weights (u)
end subroutine mci_vamp2_write_log_entry
@ %def mci_vamp2_write_log_entry
@ Set the MCI index (necessary for processes with multiple components). We
append the index to the grid filename, just before the final dotted suffix.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: record_index => mci_vamp2_record_index
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_record_index (mci, i_mci)
class(mci_vamp2_t), intent(inout) :: mci
integer, intent(in) :: i_mci
type(string_t) :: basename, suffix
character(32) :: buffer
if (mci%integrator_filename_set) then
basename = mci%integrator_filename
call split (basename, suffix, ".", back=.true.)
write (buffer, "(I0)") i_mci
if (basename /= "") then
mci%integrator_filename = basename // ".m" // trim (buffer) // "." // suffix
else
mci%integrator_filename = suffix // ".m" // trim (buffer) // ".vg2"
end if
end if
end subroutine mci_vamp2_record_index
@ %def mci_vamp2_record_index
@ Set the configuration object.
We adjust the maximum number of bins [[n_bins_max]] according to [[n_calls]]
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: set_config => mci_vamp2_set_config
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_set_config (mci, config)
class(mci_vamp2_t), intent(inout) :: mci
type(mci_vamp2_config_t), intent(in) :: config
mci%config = config
end subroutine mci_vamp2_set_config
@ %def mci_vamp2_set_config
@ Set the the rebuild flag, also the for checking the grid.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: set_rebuild_flag => mci_vamp2_set_rebuild_flag
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_set_rebuild_flag (mci, rebuild, check_grid_file)
class(mci_vamp2_t), intent(inout) :: mci
logical, intent(in) :: rebuild
logical, intent(in) :: check_grid_file
mci%rebuild = rebuild
mci%check_grid_file = check_grid_file
end subroutine mci_vamp2_set_rebuild_flag
@ %def mci_vegaa_set_rebuild_flag
@ Set the filename.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: set_integrator_filename => mci_vamp2_set_integrator_filename
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_set_integrator_filename (mci, name, run_id)
class(mci_vamp2_t), intent(inout) :: mci
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: run_id
mci%integrator_filename = name // ".vg2"
if (present (run_id)) then
mci%integrator_filename = name // "." // run_id // ".vg2"
end if
mci%integrator_filename_set = .true.
end subroutine mci_vamp2_set_integrator_filename
@ %def mci_vamp2_set_integrator_filename
@ To simplify the interface, we prepend a grid path in a separate subroutine.
<<MCI vamp2: mci vamp2: TBP>>=
procedure :: prepend_integrator_path => mci_vamp2_prepend_integrator_path
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_prepend_integrator_path (mci, prefix)
class(mci_vamp2_t), intent(inout) :: mci
type(string_t), intent(in) :: prefix
if (.not. mci%integrator_filename_set) then
call msg_warning ("Cannot add prefix to invalid integrator filename!")
end if
mci%integrator_filename = prefix // "/" // mci%integrator_filename
end subroutine mci_vamp2_prepend_integrator_path
@ %def mci_vamp2_prepend_integrator_path
@ TODO: Not implemented.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: declare_flat_dimensions => mci_vamp2_declare_flat_dimensions
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_declare_flat_dimensions (mci, dim_flat)
class(mci_vamp2_t), intent(inout) :: mci
integer, dimension(:), intent(in) :: dim_flat
end subroutine mci_vamp2_declare_flat_dimensions
@ %def mci_vamp2_declare_flat_dimensions
@ TODO: Not implemented.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: declare_equivalences => mci_vamp2_declare_equivalences
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_declare_equivalences (mci, channel, dim_offset)
class(mci_vamp2_t), intent(inout) :: mci
type(phs_channel_t), dimension(:), intent(in) :: channel
integer, intent(in) :: dim_offset
integer, dimension(:), allocatable :: perm, mode
integer :: n_channels, n_dim, n_equivalences
integer :: c, i, j, dest, src
n_channels = mci%n_channel
n_dim = mci%n_dim
n_equivalences = 0
do c = 1, n_channels
n_equivalences = n_equivalences + size (channel(c)%eq)
end do
mci%equivalences = vamp2_equivalences_t (&
n_eqv = n_equivalences, n_channel = n_channels, n_dim = n_dim)
allocate (perm (n_dim))
allocate (mode (n_dim))
perm(1:dim_offset) = [(i, i = 1, dim_offset)]
mode(1:dim_offset) = 0
c = 1
j = 0
do i = 1, n_equivalences
if (j < size (channel(c)%eq)) then
j = j + 1
else
c = c + 1
j = 1
end if
associate (eq => channel(c)%eq(j))
dest = c
src = eq%c
perm(dim_offset+1:) = eq%perm + dim_offset
mode(dim_offset+1:) = eq%mode
call mci%equivalences%set_equivalence &
(i, dest, src, perm, mode)
end associate
end do
call mci%equivalences%freeze ()
end subroutine mci_vamp2_declare_equivalences
@ %def mci_vamp2_declare_quivalences
@ Allocate instance with matching type.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: allocate_instance => mci_vamp2_allocate_instance
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_allocate_instance (mci, mci_instance)
class(mci_vamp2_t), intent(in) :: mci
class(mci_instance_t), intent(out), pointer :: mci_instance
allocate (mci_vamp2_instance_t :: mci_instance)
end subroutine mci_vamp2_allocate_instance
@ %def mci_vamp2_allocate_instance
@ Allocate a new integration pass. We can preset everything that does not depend
on the number of iterations and calls. This is postponed to the integrate
method.
In the final pass, we do not check accuracy goal etc., since we can assume
that the user wants to perform and average all iterations in this pass.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: add_pass => mci_vamp2_add_pass
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_add_pass (mci, adapt_grids, adapt_weights, final_pass)
class(mci_vamp2_t), intent(inout) :: mci
logical, intent(in), optional :: adapt_grids, adapt_weights, final_pass
call mci%list_pass%add (adapt_grids, adapt_weights, final_pass)
end subroutine mci_vamp2_add_pass
@ %def mci_vamp2_add_pass
@ Update the list of integration passes.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: update_from_ref => mci_vamp2_update_from_ref
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_update_from_ref (mci, mci_ref, success)
class(mci_vamp2_t), intent(inout) :: mci
class(mci_t), intent(in) :: mci_ref
logical, intent(out) :: success
select type (mci_ref)
type is (mci_vamp2_t)
call mci%list_pass%update_from_ref (mci_ref%list_pass, success)
if (mci%list_pass%current%integral_defined) then
mci%integral = mci%list_pass%current%get_integral ()
mci%error = mci%list_pass%current%get_error ()
mci%efficiency = mci%list_pass%current%get_efficiency ()
mci%integral_known = .true.
mci%error_known = .true.
mci%efficiency_known = .true.
end if
end select
end subroutine mci_vamp2_update_from_ref
@ %def mci_vamp2_update_from_ref
@ Update the MCI record (i.e., the integration passes) by reading from input
stream. The stream should contain a write output from a previous run. We first
check the MD5 sum of the configuration parameters. If that matches, we proceed
directly to the stored integration passes. If successful, we may continue to
read the file; the position will be after a blank line that must follow the MCI
record.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: update => mci_vamp2_update
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_update (mci, u, success)
class(mci_vamp2_t), intent(inout) :: mci
integer, intent(in) :: u
logical, intent(out) :: success
character(80) :: buffer
character(32) :: md5sum_file
type(mci_vamp2_t) :: mci_file
integer :: n_pass, n_it
call read_sval (u, md5sum_file)
success = .true.; if (mci%check_grid_file) &
& success = (md5sum_file == mci%md5sum)
if (success) then
read (u, *)
read (u, "(A)") buffer
if (trim (adjustl (buffer)) /= "VAMP2 integrator:") then
call msg_fatal ("VAMP2: reading grid file: corrupted data")
end if
n_pass = 0
n_it = 0
do
read (u, "(A)") buffer
select case (trim (adjustl (buffer)))
case ("")
exit
case ("Integration pass:")
call mci_file%list_pass%add ()
call mci_file%list_pass%current%read (u, n_pass, n_it)
n_pass = n_pass + 1
n_it = n_it + mci_file%list_pass%current%n_it
end select
end do
call mci%update_from_ref (mci_file, success)
call mci_file%final ()
end if
end subroutine mci_vamp2_update
@ %def mci_vamp2_update
@ Read / write grids from / to file.
We split the reading process in two parts. First, we check on the header where
we check (and update) all relevant pass data using [[mci_vamp2_update]]. In the
second part we only read the integrator data. We implement [[mci_vamp2_read]]
for completeness.
<<MCI vamp2: mci vamp2: TBP>>=
procedure :: write_grids => mci_vamp2_write_grids
procedure :: read_header => mci_vamp2_read_header
procedure :: read_data => mci_vamp2_read_data
procedure :: read_grids => mci_vamp2_read_grids
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_write_grids (mci)
class(mci_vamp2_t), intent(in) :: mci
integer :: u
if (.not. mci%integrator_filename_set) then
call msg_bug ("VAMP2: write grids: filename undefined")
end if
if (.not. mci%integrator_defined) then
call msg_bug ("VAMP2: write grids: grids undefined")
end if
u = free_unit ()
open (u, file = char (mci%integrator_filename), &
action = "write", status = "replace")
write (u, "(1X,A,A,A)") "MD5sum = '", mci%md5sum, "'"
write (u, *)
call mci%write (u)
write (u, *)
write (u, "(1X,A)") "VAMP2 grids:"
call mci%integrator%write_grids (u)
close (u)
end subroutine mci_vamp2_write_grids
subroutine mci_vamp2_read_header (mci, success)
class(mci_vamp2_t), intent(inout) :: mci
logical, intent(out) :: success
logical :: exist
integer :: u
success = .false.
if (.not. mci%integrator_filename_set) then
call msg_bug ("VAMP2: read grids: filename undefined")
end if
inquire (file = char (mci%integrator_filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (mci%integrator_filename), &
action = "read", status = "old")
call mci%update (u, success)
close (u)
if (.not. success) then
write (msg_buffer, "(A,A,A)") &
"VAMP2: header: parameter mismatch, discarding grid file '", &
char (mci%integrator_filename), "'"
call msg_message ()
end if
end if
end subroutine mci_vamp2_read_header
subroutine mci_vamp2_read_data (mci)
class(mci_vamp2_t), intent(inout) :: mci
integer :: u
character(80) :: buffer
if (mci%integrator_defined) then
call msg_bug ("VAMP2: read grids: grids already defined")
end if
u = free_unit ()
open (u, file = char (mci%integrator_filename), &
action = "read", status = "old")
do
read (u, "(A)") buffer
if (trim (adjustl (buffer)) == "VAMP2 grids:") exit
end do
call mci%integrator%read_grids (u)
close (u)
mci%integrator_defined = .true.
end subroutine mci_vamp2_read_data
subroutine mci_vamp2_read_grids (mci, success)
class(mci_vamp2_t), intent(inout) :: mci
logical, intent(out) :: success
logical :: exist
integer :: u
character(80) :: buffer
success = .false.
if (.not. mci%integrator_filename_set) then
call msg_bug ("VAMP2: read grids: filename undefined")
end if
if (mci%integrator_defined) then
call msg_bug ("VAMP2: read grids: grids already defined")
end if
inquire (file = char (mci%integrator_filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (mci%integrator_filename), &
action = "read", status = "old")
call mci%update (u, success)
if (success) then
read (u, "(A)") buffer
if (trim (adjustl (buffer)) /= "VAMP2 grids:") then
call msg_fatal ("VAMP2: reading grid file: &
&corrupted grid data")
end if
call mci%integrator%read_grids (u)
else
write (msg_buffer, "(A,A,A)") &
"VAMP2: read grids: parameter mismatch, discarding grid file '", &
char (mci%integrator_filename), "'"
call msg_message ()
end if
close (u)
mci%integrator_defined = success
end if
end subroutine mci_vamp2_read_grids
@ %def mci_vamp2_write_grids
@ %def mci_vamp2_read_header
@ %def mci_vamp2_read_data
@ %def mci_vamp2_read_grids
@
\subsubsection{Interface: VAMP2}
\label{sec:interface-vamp2}
We define the interfacing procedures, as such, initialising the VAMP2 integrator
or resetting the results.
Initialise the VAMP2 integrator which is stored within the [[mci]] object, using
the data of the current integration pass. Furthermore, reset the counters that
track this set of integrator.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: init_integrator => mci_vamp2_init_integrator
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_init_integrator (mci)
class(mci_vamp2_t), intent(inout) :: mci
type (pass_t), pointer :: current
integer :: ch, vegas_mode
current => mci%list_pass%current
vegas_mode = merge (VEGAS_MODE_IMPORTANCE, VEGAS_MODE_IMPORTANCE_ONLY,&
& mci%config%stratified)
mci%n_adapt_grids = 0
mci%n_adapt_weights = 0
if (mci%integrator_defined) then
call msg_bug ("[MCI VAMP2]: init integrator: &
& integrator is already initialised.")
end if
mci%integrator = vamp2_t (mci%n_channel, mci%n_dim, &
& n_bins_max = mci%config%n_bins_max, &
& iterations = 1, &
& mode = vegas_mode)
if (mci%has_chains ()) call mci%integrator%set_chain (mci%n_chain, mci%chain)
call mci%integrator%set_config (mci%config)
mci%integrator_defined = .true.
end subroutine mci_vamp2_init_integrator
@ %def mci_vamp2_init_integrator
@ Reset a grid set. Purge the accumulated results.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: reset_result => mci_vamp2_reset_result
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_reset_result (mci)
class(mci_vamp2_t), intent(inout) :: mci
if (.not. mci%integrator_defined) then
call msg_bug ("[MCI VAMP2] reset results: integrator undefined")
end if
call mci%integrator%reset_result ()
end subroutine mci_vamp2_reset_result
@ %def mci_vamp2_reset_result
@ Set calls per channel. The number of calls to each channel is defined by the
channel weight
\begin{equation}
\alpha_i = \frac{N_i}{\sum N_i}.
\end{equation}
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: set_calls => mci_vamp2_set_calls
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_set_calls (mci, n_calls)
class(mci_vamp2_t), intent(inout) :: mci
integer :: n_calls
if (.not. mci%integrator_defined) then
call msg_bug ("[MCI VAMP2] set calls: grids undefined")
end if
call mci%integrator%set_calls (n_calls)
end subroutine mci_vamp2_set_calls
@ %def mci_vamp2_set_calls
\subsubsection{Integration}
Initialize. We prepare the integrator from a previous pass, or from file, or
with new objects.
At the emd, set the number of calls for the current, if the integrator is not
read from file.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, private :: init_integration => mci_vamp2_init_integration
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_init_integration (mci, n_it, n_calls, instance)
class(mci_vamp2_t), intent(inout) :: mci
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
class(mci_instance_t), intent(inout) :: instance
logical :: from_file, success
if (.not. associated (mci%list_pass%current)) then
call msg_bug ("MCI integrate: current_pass object not allocated")
end if
associate (current_pass => mci%list_pass%current)
current_pass%integral_defined = .false.
mci%config%n_calls_min = mci%config%n_calls_min_per_channel * mci%config%n_channel
call current_pass%configure (n_it, n_calls, mci%config%n_calls_min)
mci%adapt_grids = current_pass%adapt_grids
mci%adapt_weights = current_pass%adapt_weights
mci%pass_complete = .false.
mci%it_complete = .false.
from_file = .false.
if (.not. mci%integrator_defined .or. mci%integrator_from_file) then
if (mci%integrator_filename_set .and. .not. mci%rebuild) then
call mci%read_header (success)
from_file = success
if (.not. mci%integrator_defined .and. success) &
& call mci%read_data ()
end if
end if
if (from_file) then
if (.not. mci%check_grid_file) &
& call msg_warning ("Reading grid file: MD5 sum check disabled")
call msg_message ("VAMP2: " &
// "using grids and results from file ’" &
// char (mci%integrator_filename) // "’")
else if (.not. mci%integrator_defined) then
call mci%init_integrator ()
end if
mci%integrator_from_file = from_file
if (.not. mci%integrator_from_file) then
call mci%integrator%set_calls (current_pass%n_calls)
end if
call mci%integrator%set_equivalences (mci%equivalences)
end associate
end subroutine mci_vamp2_init_integration
@ %def mci_vamp2_init
@ Integrate. Perform a new integration pass (possibly reusing previous results),
which may consist of several iterations.
We reinitialise the sampling new each time and set the workspace again.
Note: we record the integral once per iteration. The integral stored in the
mci record itself is the last integral of the current iteration, no averaging done.
The results record may average results.
Note: recording the efficiency is not supported yet.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: integrate => mci_vamp2_integrate
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_integrate (mci, instance, sampler, &
n_it, n_calls, results, pacify)
class(mci_vamp2_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
class(mci_results_t), intent(inout), optional :: results
logical, intent(in), optional :: pacify
integer :: it
logical :: from_file, success
<<MCI vamp2: mci vamp2 integrate: variables>>
<<MCI vamp2: mci vamp2 integrate: initialization>>
call mci%init_integration (n_it, n_calls, instance)
from_file = mci%integrator_from_file
select type (instance)
type is (mci_vamp2_instance_t)
call instance%set_workspace (sampler)
end select
associate (current_pass => mci%list_pass%current)
do it = 1, current_pass%n_it
if (signal_is_pending ()) return
mci%integrator_from_file = from_file .and. &
it <= current_pass%get_integration_index ()
if (.not. mci%integrator_from_file) then
mci%it_complete = .false.
select type (instance)
type is (mci_vamp2_instance_t)
call mci%integrator%integrate (instance%func, mci%rng, &
& iterations = 1, &
& opt_reset_result = .true., &
& opt_refine_grid = mci%adapt_grids, &
& opt_adapt_weight = mci%adapt_weights, &
& opt_verbose = mci%verbose)
end select
if (signal_is_pending ()) return
mci%it_complete = .true.
integral = mci%integrator%get_integral ()
calls = mci%integrator%get_n_calls ()
select type (instance)
type is (mci_vamp2_instance_t)
calls_valid = instance%func%get_n_calls ()
call instance%func%reset_n_calls ()
end select
error = sqrt (mci%integrator%get_variance ())
efficiency = mci%integrator%get_efficiency ()
<<MCI vamp2: mci vamp2 integrate: sampling>>
if (integral /= 0) then
current_pass%integral(it) = integral
current_pass%calls(it) = calls
current_pass%calls_valid(it) = calls_valid
current_pass%error(it) = error
current_pass%efficiency(it) = efficiency
end if
current_pass%integral_defined = .true.
end if
if (present (results)) then
if (mci%has_chains ()) then
call mci%collect_chain_weights (instance%w)
call results%record (1, &
n_calls = current_pass%calls(it), &
n_calls_valid = current_pass%calls_valid(it), &
integral = current_pass%integral(it), &
error = current_pass%error(it), &
efficiency = current_pass%efficiency(it), &
efficiency_pos = current_pass%efficiency(it), &
efficiency_neg = 0._default, &
chain_weights = mci%chain_weights, &
suppress = pacify)
else
call results%record (1, &
n_calls = current_pass%calls(it), &
n_calls_valid = current_pass%calls_valid(it), &
integral = current_pass%integral(it), &
error = current_pass%error(it), &
efficiency = current_pass%efficiency(it), &
efficiency_pos = current_pass%efficiency(it), &
efficiency_neg = 0._default, &
suppress = pacify)
end if
end if
if (.not. mci%integrator_from_file &
.and. mci%integrator_filename_set) then
<<MCI vamp2: mci vamp2 integrate: post sampling>> call mci%write_grids ()
end if
if (.not. current_pass%is_final_pass) then
call check_goals (it, success)
if (success) exit
end if
end do
if (signal_is_pending ()) return
mci%pass_complete = .true.
mci%integral = current_pass%get_integral()
mci%error = current_pass%get_error()
mci%efficiency = current_pass%get_efficiency()
mci%integral_known = .true.
mci%error_known = .true.
mci%efficiency_known = .true.
call mci%compute_md5sum (pacify)
end associate
contains
<<MCI vamp2: mci vamp2 integrate: procedures>>
end subroutine mci_vamp2_integrate
@ %def mci_vamp2_integrate
<<MCI vamp2: mci vamp2 integrate: variables>>=
real(default) :: integral, error, efficiency
integer :: calls, calls_valid
@
<<MCI vamp2: mci vamp2 integrate: initialization>>=
@
<<MCI vamp2: mci vamp2 integrate: sampling>>=
@
<<MCI vamp2: mci vamp2 integrate: post sampling>>=
@
<<MPI: MCI vamp2: mci vamp2 integrate: variables>>=
integer :: rank, n_size
type(MPI_Request), dimension(6) :: request
@ MPI procedure-specific initialization.
<<MPI: MCI vamp2: mci vamp2 integrate: initialization>>=
call MPI_Comm_size (MPI_COMM_WORLD, n_size)
call MPI_Comm_rank (MPI_COMM_WORLD, rank)
@ We broadcast the current results to all worker, such that they can store them
in to the pass list.
<<MPI: MCI vamp2: mci vamp2 integrate: sampling>>=
call MPI_Ibcast (integral, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, request(1))
call MPI_Ibcast (calls, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, request(2))
call MPI_Ibcast (calls_valid, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, request(3))
call MPI_Ibcast (error, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, request(4))
call MPI_Ibcast (efficiency, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, request(5))
call MPI_Waitall (5, request, MPI_STATUSES_IGNORE)
@ We only allow the master to write the grids to file.
<<MPI: MCI vamp2: mci vamp2 integrate: post sampling>>=
if (rank == 0)
@ Check whether we are already finished with this pass.
<<MCI vamp2: mci vamp2 integrate: procedures>>=
subroutine check_goals (it, success)
integer, intent(in) :: it
logical, intent(out) :: success
success = .false.
associate (current_pass => mci%list_pass%current)
if (error_reached (it)) then
current_pass%n_it = it
call msg_message ("[MCI VAMP2] error goal reached; &
&skipping iterations")
success = .true.
return
end if
if (rel_error_reached (it)) then
current_pass%n_it = it
call msg_message ("[MCI VAMP2] relative error goal reached; &
&skipping iterations")
success = .true.
return
end if
if (accuracy_reached (it)) then
current_pass%n_it = it
call msg_message ("[MCI VAMP2] accuracy goal reached; &
&skipping iterations")
success = .true.
return
end if
end associate
end subroutine check_goals
@ %def mci_vamp2_check_goals
@ Return true if the error, relative error or accurary goals hase been reached,
if any.
<<MCI vamp2: mci vamp2 integrate: procedures>>=
function error_reached (it) result (flag)
integer, intent(in) :: it
logical :: flag
real(default) :: error_goal, error
error_goal = mci%config%error_goal
flag = .false.
associate (current_pass => mci%list_pass%current)
if (error_goal > 0 .and. current_pass%integral_defined) then
error = abs (current_pass%error(it))
flag = error < error_goal
end if
end associate
end function error_reached
function rel_error_reached (it) result (flag)
integer, intent(in) :: it
logical :: flag
real(default) :: rel_error_goal, rel_error
rel_error_goal = mci%config%rel_error_goal
flag = .false.
associate (current_pass => mci%list_pass%current)
if (rel_error_goal > 0 .and. current_pass%integral_defined) then
rel_error = abs (current_pass%error(it) / current_pass%integral(it))
flag = rel_error < rel_error_goal
end if
end associate
end function rel_error_reached
function accuracy_reached (it) result (flag)
integer, intent(in) :: it
logical :: flag
real(default) :: accuracy_goal, accuracy
accuracy_goal = mci%config%accuracy_goal
flag = .false.
associate (current_pass => mci%list_pass%current)
if (accuracy_goal > 0 .and. current_pass%integral_defined) then
if (current_pass%integral(it) /= 0) then
accuracy = abs (current_pass%error(it) / current_pass%integral(it)) &
* sqrt (real (current_pass%calls(it), default))
flag = accuracy < accuracy_goal
else
flag = .true.
end if
end if
end associate
end function accuracy_reached
@ %def error_reached, rel_error_reached, accuracy_reached
@
\subsection{Event generation}
Prepare simulation. We check the grids and reread them from file, if necessary.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: prepare_simulation => mci_vamp2_prepare_simulation
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_prepare_simulation (mci)
class(mci_vamp2_t), intent(inout) :: mci
logical :: success
if (.not. mci%integrator_filename_set) then
call msg_bug ("VAMP2: preapre simulation: integrator filename not set.")
end if
call mci%read_header (success)
call mci%compute_md5sum ()
if (.not. success) then
call msg_fatal ("Simulate: " &
// "reading integration grids from file ’" &
// char (mci%integrator_filename) // "’ failed")
end if
if (.not. mci%integrator_defined) then
call mci%read_data ()
end if
end subroutine mci_vamp2_prepare_simulation
@ %def mci_vamp2_prepare_simulation
@ Generate an unweighted event. We only set the workspace again before
generating an event.
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: generate_weighted_event => mci_vamp2_generate_weighted_event
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_generate_weighted_event (mci, instance, sampler)
class(mci_vamp2_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
if (.not. mci%integrator_defined) then
call msg_bug ("VAMP2: generate weighted event: undefined integrator")
end if
select type (instance)
type is (mci_vamp2_instance_t)
instance%event_generated = .false.
call instance%set_workspace (sampler)
call mci%integrator%generate_weighted (&
& instance%func, mci%rng, instance%event_x)
instance%event_weight = mci%integrator%get_evt_weight ()
instance%event_excess = 0
instance%n_events = instance%n_events + 1
instance%event_generated = .true.
end select
end subroutine mci_vamp2_generate_weighted_event
@ %def mci_vamp2_generate_weighted_event
@ We apply an additional rescaling factor for [[f_max]] (either for the positive or negative distribution).
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: generate_unweighted_event => mci_vamp2_generate_unweighted_event
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_generate_unweighted_event (mci, instance, sampler)
class(mci_vamp2_t), intent(inout) :: mci
class(mci_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
if (.not. mci%integrator_defined) then
call msg_bug ("VAMP2: generate unweighted event: undefined integrator")
end if
select type (instance)
type is (mci_vamp2_instance_t)
instance%event_generated = .false.
call instance%set_workspace (sampler)
generate: do
call mci%integrator%generate_unweighted (&
& instance%func, mci%rng, instance%event_x, &
& opt_event_rescale = instance%event_rescale_f_max)
instance%event_excess = mci%integrator%get_evt_weight_excess ()
if (signal_is_pending ()) return
if (sampler%is_valid ()) exit generate
end do generate
if (mci%integrator%get_evt_weight () < 0.) then
if (.not. mci%negative_weights) then
call msg_fatal ("MCI VAMP2 cannot sample negative weights!")
end if
instance%event_weight = -1._default
else
instance%event_weight = 1._default
end if
instance%n_events = instance%n_events + 1
instance%event_generated = .true.
end select
end subroutine mci_vamp2_generate_unweighted_event
@ %def mci_vamp2_generate_unweighted_event
@
<<MCI vamp2: mci vamp2: TBP>>=
procedure, public :: rebuild_event => mci_vamp2_rebuild_event
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_rebuild_event (mci, instance, sampler, state)
class(mci_vamp2_t), intent(inout) :: mci
class(mci_instance_t), intent(inout) :: instance
class(mci_sampler_t), intent(inout) :: sampler
class(mci_state_t), intent(in) :: state
call msg_bug ("MCI VAMP2 rebuild event not implemented yet.")
end subroutine mci_vamp2_rebuild_event
@ %def mci_vamp2_rebuild_event
@
\subsection{Integrator instance}
\label{sec:nistance}
We store all information relevant for simulation. The event weight is stored, when a
weighted event is generated, and the event excess, when a larger weight occurs
than actual stored max. weight.
We give the possibility to rescale the [[f_max]] within the integrator object
with [[event_rescale_f_max]].
<<MCI vamp2: public>>=
public :: mci_vamp2_instance_t
<<MCI vamp2: types>>=
type, extends (mci_instance_t) :: mci_vamp2_instance_t
class(mci_vamp2_func_t), allocatable :: func
real(default), dimension(:), allocatable :: gi
integer :: n_events = 0
logical :: event_generated = .false.
real(default) :: event_weight = 0.
real(default) :: event_excess = 0.
real(default) :: event_rescale_f_max = 1.
real(default), dimension(:), allocatable :: event_x
contains
<<MCI vamp2: mci vamp2 instance: TBP>>
end type mci_vamp2_instance_t
@ %def mci_vamp2_instance_t
@ Output.
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: write => mci_vamp2_instance_write
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_instance_write (object, unit, pacify)
class(mci_vamp2_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
integer :: u, ch, j
character(len=7) :: fmt
call pac_fmt (fmt, FMT_17, FMT_14, pacify)
u = given_output_unit (unit)
write (u, "(1X,A)") "MCI VAMP2 instance:"
write (u, "(1X,A,I0)") &
& "Selected channel = ", object%selected_channel
write (u, "(1X,A25,1X," // fmt // ")") &
& "Integrand = ", object%integrand
write (u, "(1X,A25,1X," // fmt // ")") &
& "MCI weight = ", object%mci_weight
write (u, "(1X,A,L1)") &
& "Valid = ", object%valid
write (u, "(1X,A)") "MCI a-priori weight:"
do ch = 1, size (object%w)
write (u, "(3X,I25,1X," // fmt // ")") ch, object%w(ch)
end do
write (u, "(1X,A)") "MCI jacobian:"
do ch = 1, size (object%w)
write (u, "(3X,I25,1X," // fmt // ")") ch, object%f(ch)
end do
write (u, "(1X,A)") "MCI mapped x:"
do ch = 1, size (object%w)
do j = 1, size (object%x, 1)
write (u, "(3X,2(1X,I8),1X," // fmt // ")") j, ch, object%x(j, ch)
end do
end do
write (u, "(1X,A)") "MCI channel weight:"
do ch = 1, size (object%w)
write (u, "(3X,I25,1X," // fmt // ")") ch, object%gi(ch)
end do
write (u, "(1X,A,I0)") &
& "Number of event = ", object%n_events
write (u, "(1X,A,L1)") &
& "Event generated = ", object%event_generated
write (u, "(1X,A25,1X," // fmt // ")") &
& "Event weight = ", object%event_weight
write (u, "(1X,A25,1X," // fmt // ")") &
& "Event excess = ", object%event_excess
write (u, "(1X,A25,1X," // fmt // ")") &
& "Event rescale f max = ", object%event_rescale_f_max
write (u, "(1X,A,L1)") &
& "Negative (event) weight = ", object%negative_weights
write (u, "(1X,A)") "MCI event"
do j = 1, size (object%event_x)
write (u, "(3X,I25,1X," // fmt // ")") j, object%event_x(j)
end do
end subroutine mci_vamp2_instance_write
@ %def mci_vamp2_instance_write
@ Finalizer. We are only using allocatable, so there is nothing to do here.
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: final => mci_vamp2_instance_final
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_instance_final (object)
class(mci_vamp2_instance_t), intent(inout) :: object
!
end subroutine mci_vamp2_instance_final
@ %def mci_vamp2_instance_final
@ Initializer.
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: init => mci_vamp2_instance_init
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_instance_init (mci_instance, mci)
class(mci_vamp2_instance_t), intent(out) :: mci_instance
class(mci_t), intent(in), target :: mci
call mci_instance%base_init (mci)
allocate (mci_instance%gi(mci%n_channel), source=0._default)
allocate (mci_instance%event_x(mci%n_dim), source=0._default)
allocate (mci_vamp2_func_t :: mci_instance%func)
call mci_instance%func%init (n_dim = mci%n_dim, n_channel = mci%n_channel)
end subroutine mci_vamp2_instance_init
@ %def mci_vamp2_instance_init
@ Set workspace for [[mci_vamp2_func_t]].
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: set_workspace => mci_vamp2_instance_set_workspace
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_instance_set_workspace (instance, sampler)
class(mci_vamp2_instance_t), intent(inout), target :: instance
class(mci_sampler_t), intent(inout), target :: sampler
call instance%func%set_workspace (instance, sampler)
end subroutine mci_vamp2_instance_set_workspace
@ %def mci_vmp2_instance_set_workspace
@
\subsubsection{Evaluation}
Compute multi-channel weight. The computation of the multi-channel weight is
done by the VAMP2 function. We retrieve the information.
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: compute_weight => mci_vamp2_instance_compute_weight
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_instance_compute_weight (mci, c)
class(mci_vamp2_instance_t), intent(inout) :: mci
integer, intent(in) :: c
mci%gi = mci%func%get_probabilities ()
mci%mci_weight = mci%func%get_weight ()
end subroutine mci_vamp2_instance_compute_weight
@ %def mci_vamp2_instance_compute_weight
@ Record the integrand.
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: record_integrand => mci_vamp2_instance_record_integrand
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_instance_record_integrand (mci, integrand)
class(mci_vamp2_instance_t), intent(inout) :: mci
real(default), intent(in) :: integrand
mci%integrand = integrand
call mci%func%set_integrand (integrand)
end subroutine mci_vamp2_instance_record_integrand
@ %def mci_vamp2_instance_record_integrand
@ \subsubsection{Event simulation}
In contrast to VAMP, we reset only counters
and set the safety factor, which will then will be applied each time a event is
generated. In that way we do not rescale the actual values in the integrator,
but more the current value!
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: init_simulation => mci_vamp2_instance_init_simulation
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_instance_init_simulation (instance, safety_factor)
class(mci_vamp2_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: safety_factor
if (present (safety_factor)) instance%event_rescale_f_max = safety_factor
instance%n_events = 0
instance%event_generated = .false.
if (instance%event_rescale_f_max /= 1) then
write (msg_buffer, "(A,ES10.3,A)") "Simulate: &
&applying safety factor ", instance%event_rescale_f_max, &
& " to event rejection."
call msg_message ()
end if
end subroutine mci_vamp2_instance_init_simulation
@ %def mci_vamp2_instance_init_simulation
@
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: final_simulation => mci_vamp2_instance_final_simulation
<<MCI vamp2: procedures>>=
subroutine mci_vamp2_instance_final_simulation (instance)
class(mci_vamp2_instance_t), intent(inout) :: instance
!
end subroutine mci_vamp2_instance_final_simulation
@ %def mci_vamp2_instance_final
@
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: get_event_weight => mci_vamp2_instance_get_event_weight
<<MCI vamp2: procedures>>=
function mci_vamp2_instance_get_event_weight (mci) result (weight)
class(mci_vamp2_instance_t), intent(in) :: mci
real(default) :: weight
if (.not. mci%event_generated) then
call msg_bug ("MCI VAMP2: get event weight: no event generated")
end if
weight = mci%event_weight
end function mci_vamp2_instance_get_event_weight
@ %def mci_vamp2_instance_get_event_weight
@
<<MCI vamp2: mci vamp2 instance: TBP>>=
procedure, public :: get_event_excess => mci_vamp2_instance_get_event_excess
<<MCI vamp2: procedures>>=
function mci_vamp2_instance_get_event_excess (mci) result (excess)
class(mci_vamp2_instance_t), intent(in) :: mci
real(default) :: excess
if (.not. mci%event_generated) then
call msg_bug ("MCI VAMP2: get event excess: no event generated")
end if
excess = mci%event_excess
end function mci_vamp2_instance_get_event_excess
@ %def mci_vamp2_instance_get_event_excess
@
\clearpage
\subsection{Unit tests}
\label{sec:mic-vamp2-ut}
Test module, followed by the corresponding implementation module.
<<[[mci_vamp2_ut.f90]]>>=
<<File header>>
module mci_vamp2_ut
use unit_tests
use mci_vamp2_uti
<<Standard module head>>
<<MCI vamp2: public test>>
contains
<<MCI vamp2: test driver>>
end module mci_vamp2_ut
@ %def mci_vamp2_ut
@
<<[[mci_vamp2_uti.f90]]>>=
<<File header>>
module mci_vamp2_uti
<<Use kinds>>
<<Use strings>>
use io_units
use constants, only: PI, TWOPI
use rng_base
use rng_tao
use rng_stream
use mci_base
use mci_vamp2
<<Standard module head>>
<<MCI vamp2: test declarations>>
<<MCI vamp2: test types>>
contains
<<MCI vamp2: tests>>
end module mci_vamp2_uti
@ %def mci_vamp2_uti
@ API: driver for the unit tests below.
<<MCI vamp2: public test>>=
public :: mci_vamp2_test
<<MCI vamp2: test driver>>=
subroutine mci_vamp2_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<MCI vamp2: execute tests>>
end subroutine mci_vamp2_test
@ %def mci_vamp2_test
@
\subsubsection{Test sampler}
\label{sec:mci-vamp2-test-sampler}
A test sampler object should implement a function with known integral that
we can use to check the integrator.
In mode [[1]], the function is $f(x) = 3 x^2$ with integral $\int_0^1
f(x)\,dx=1$ and maximum $f(1)=3$. If the integration dimension is
greater than one, the function is extended as a constant in the other
dimension(s).
In mode [[2]], the function is $11 x^{10}$, also with integral $1$.
Mode [[4]] includes ranges of zero and negative function value, the
integral is negative. The results should be identical to the results
of [[mci_midpoint_4]], where the same function is evaluated. The
function is $f(x) = (1 - 3 x^2)\,\theta(x-1/2)$ with integral
$\int_0^1 f(x)\,dx=-3/8$, minimum $f(1)=-2$ and maximum $f(1/2)=1/4$.
<<MCI vamp2: test types>>=
type, extends (mci_sampler_t) :: test_sampler_1_t
real(default), dimension(:), allocatable :: x
real(default) :: val
integer :: mode = 1
contains
<<MCI vamp2: test sampler 1: TBP>>
end type test_sampler_1_t
@ %def test_sampler_1_t
@ Output: There is nothing stored inside, so just print an informative line.
<<MCI vamp2: test sampler 1: TBP>>=
procedure, public :: write => test_sampler_1_write
<<MCI vamp2: tests>>=
subroutine test_sampler_1_write (object, unit, testflag)
class(test_sampler_1_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
select case (object%mode)
case (1)
write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2"
case (2)
write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10"
case (3)
write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10 * 2 * cos^2 (2 pi y)"
case (4)
write (u, "(1x,A)") "Test sampler: f(x) = (1 - 3 x^2) theta(x - 1/2)"
end select
end subroutine test_sampler_1_write
@ %def test_sampler_1_write
@ Evaluation: compute the function value. The output $x$ parameter
(only one channel) is identical to the input $x$, and the Jacobian is 1.
<<MCI vamp2: test sampler 1: TBP>>=
procedure, public :: evaluate => test_sampler_1_evaluate
<<MCI vamp2: tests>>=
subroutine test_sampler_1_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_1_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
if (allocated (sampler%x)) deallocate (sampler%x)
allocate (sampler%x (size (x_in)))
sampler%x = x_in
select case (sampler%mode)
case (1)
sampler%val = 3 * x_in(1) ** 2
case (2)
sampler%val = 11 * x_in(1) ** 10
case (3)
sampler%val = 11 * x_in(1) ** 10 * 2 * cos (twopi * x_in(2)) ** 2
case (4)
if (x_in(1) >= .5_default) then
sampler%val = 1 - 3 * x_in(1) ** 2
else
sampler%val = 0
end if
end select
call sampler%fetch (val, x, f)
end subroutine test_sampler_1_evaluate
@ %def test_sampler_1_evaluate
@ The point is always valid.
<<MCI vamp2: test sampler 1: TBP>>=
procedure, public :: is_valid => test_sampler_1_is_valid
<<MCI vamp2: tests>>=
function test_sampler_1_is_valid (sampler) result (valid)
class(test_sampler_1_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_1_is_valid
@ %def test_sampler_1_is_valid
@ Rebuild: compute all but the function value.
<<MCI vamp2: test sampler 1: TBP>>=
procedure, public :: rebuild => test_sampler_1_rebuild
<<MCI vamp2: tests>>=
subroutine test_sampler_1_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_1_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
if (allocated (sampler%x)) deallocate (sampler%x)
allocate (sampler%x (size (x_in)))
sampler%x = x_in
sampler%val = val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_1_rebuild
@ %def test_sampler_1_rebuild
@ Extract the results.
<<MCI vamp2: test sampler 1: TBP>>=
procedure, public :: fetch => test_sampler_1_fetch
<<MCI vamp2: tests>>=
subroutine test_sampler_1_fetch (sampler, val, x, f)
class(test_sampler_1_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%val
x(:,1) = sampler%x
f = 1
end subroutine test_sampler_1_fetch
@ %def test_sampler_1_fetch
@
\subsubsection{Two-channel, two dimension test sampler}
This sampler implements the function
\begin{equation}
f(x, y) = 4\sin^2(\pi x)\sin^2(\pi y) + 2\sin^2(\pi v)
\end{equation}
where
\begin{align}
x &= u^v &u &= xy
\\
y &= u^{(1-v)} &v &= \frac12\left(1 + \frac{\log(x/y)}{\log xy}\right)
\end{align}
Each term contributes $1$ to the integral. The first term in the function is
peaked along a cross aligned to the coordinates $x$ and $y$, while the second
term is peaked along the diagonal $x=y$.
The Jacobian is
\begin{equation}
\frac{\partial(x,y)}{\partial(u,v)} = |\log u|
\end{equation}
<<MCI vamp2: test types>>=
type, extends (mci_sampler_t) :: test_sampler_2_t
real(default), dimension(:,:), allocatable :: x
real(default), dimension(:), allocatable :: f
real(default) :: val
contains
<<MCI vamp2: test sampler 2: TBP>>
end type test_sampler_2_t
@ %def test_sampler_2_t
@ Output: There is nothing stored inside, so just print an informative line.
<<MCI vamp2: test sampler 2: TBP>>=
procedure, public :: write => test_sampler_2_write
<<MCI vamp2: tests>>=
subroutine test_sampler_2_write (object, unit, testflag)
class(test_sampler_2_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Two-channel test sampler 2"
end subroutine test_sampler_2_write
@ %def test_sampler_2_write
@ Kinematics: compute $x$ and Jacobians, given the input parameter array.
<<MCI vamp2: test sampler 2: TBP>>=
procedure, public :: compute => test_sampler_2_compute
<<MCI vamp2: tests>>=
subroutine test_sampler_2_compute (sampler, c, x_in)
class(test_sampler_2_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default) :: xx, yy, uu, vv
if (.not. allocated (sampler%x)) &
allocate (sampler%x (size (x_in), 2))
if (.not. allocated (sampler%f)) &
allocate (sampler%f (2))
select case (c)
case (1)
xx = x_in(1)
yy = x_in(2)
uu = xx * yy
vv = (1 + log (xx/yy) / log (xx*yy)) / 2
case (2)
uu = x_in(1)
vv = x_in(2)
xx = uu ** vv
yy = uu ** (1 - vv)
end select
sampler%val = (2 * sin (pi * xx) * sin (pi * yy)) ** 2 &
+ 2 * sin (pi * vv) ** 2
sampler%f(1) = 1
sampler%f(2) = abs (log (uu))
sampler%x(:,1) = [xx, yy]
sampler%x(:,2) = [uu, vv]
end subroutine test_sampler_2_compute
@ %def test_sampler_kinematics
@ Evaluation: compute the function value. The output $x$ parameter (only one
channel) is identical to the input $x$, and the Jacobian is 1.
<<MCI vamp2: test sampler 2: TBP>>=
procedure, public :: evaluate => test_sampler_2_evaluate
<<MCI vamp2: tests>>=
subroutine test_sampler_2_evaluate (sampler, c, x_in, val, x, f)
class(test_sampler_2_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%compute (c, x_in)
call sampler%fetch (val, x, f)
end subroutine test_sampler_2_evaluate
@ %def test_sampler_2_evaluate
@ The point is always valid.
<<MCI vamp2: test sampler 2: TBP>>=
procedure, public :: is_valid => test_sampler_2_is_valid
<<MCI vamp2: tests>>=
function test_sampler_2_is_valid (sampler) result (valid)
class(test_sampler_2_t), intent(in) :: sampler
logical :: valid
valid = .true.
end function test_sampler_2_is_valid
@ %def test_sampler_2_is_valid
@ Rebuild: compute all but the function value.
<<MCI vamp2: test sampler 2: TBP>>=
procedure, public :: rebuild => test_sampler_2_rebuild
<<MCI vamp2: tests>>=
subroutine test_sampler_2_rebuild (sampler, c, x_in, val, x, f)
class(test_sampler_2_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%compute (c, x_in)
x = sampler%x
f = sampler%f
end subroutine test_sampler_2_rebuild
@ %def test_sampler_2_rebuild
@ Extract the results.
<<MCI vamp2: test sampler 2: TBP>>=
procedure, public :: fetch => test_sampler_2_fetch
<<MCI vamp2: tests>>=
subroutine test_sampler_2_fetch (sampler, val, x, f)
class(test_sampler_2_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
val = sampler%val
x = sampler%x
f = sampler%f
end subroutine test_sampler_2_fetch
@ %def test_sampler_2_fetch
@
\subsubsection{One-dimensional integration}
\label{sec:mci-vamp2-one-dim}
Construct an integrator and use it for a one-dimensional sampler.
<<MCI vamp2: execute tests>>=
call test (mci_vamp2_1, "mci_vamp2_1", "one-dimensional integral", u, results)
<<MCI vamp2: test declarations>>=
public :: mci_vamp2_1
<<MCI vamp2: tests>>=
subroutine mci_vamp2_1 (u)
integer, intent(in) :: u
type(mci_vamp2_config_t) :: config
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable, target :: mci_sampler
class(rng_t), allocatable :: rng
type(string_t) :: filename
write (u, "(A)") "* Test output: mci_vamp2_1"
write (u, "(A)") "* Purpose: integrate function in one dimension (single channel)"
write (u, "(A)")
write (u, "(A)") "* Initialise integrator"
write (u, "(A)")
allocate (mci_vamp2_t :: mci)
call mci%set_dimensions (1, 1)
filename = "mci_vamp2_1"
select type (mci)
type is (mci_vamp2_t)
call mci%set_config (config)
call mci%set_integrator_filename (filename)
end select
allocate (rng_stream_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%write (u, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Initialise instance"
write (u, "(A)")
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
write (u, "(A)")
write (u, "(A)") "* Initialise test sampler"
write (u, "(A)")
allocate (test_sampler_1_t :: mci_sampler)
call mci_sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_calls = 1000"
write (u, "(A)") " (lower precision to avoid"
write (u, "(A)") " numerical noise)"
write (u, "(A)")
select type (mci)
type is (mci_vamp2_t)
call mci%add_pass ()
end select
call mci%integrate (mci_instance, mci_sampler, 1, 1000, pacify = .true.)
call mci%write (u, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Dump channel weights and grids to file"
write (u, "(A)")
mci%md5sum = "1234567890abcdef1234567890abcdef"
select type (mci)
type is (mci_vamp2_t)
call mci%write_grids ()
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp2_1"
end subroutine mci_vamp2_1
@ %def mci_vamp2_test1
@
\subsubsection{Multiple iterations}
Construct an integrator and use it for a one-dimensional sampler.
Integrate with five iterations without grid adaptation.
<<MCI vamp2: execute tests>>=
call test (mci_vamp2_2, "mci_vamp2_2", &
"multiple iterations", &
u, results)
<<MCI vamp2: test declarations>>=
public :: mci_vamp2_2
<<MCI vamp2: tests>>=
subroutine mci_vamp2_2 (u)
type(mci_vamp2_config_t) :: config
integer, intent(in) :: u
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
type(string_t) :: filename
write (u, "(A)") "* Test output: mci_vamp2_2"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(single channel), but multiple iterations."
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp2_t :: mci)
call mci%set_dimensions (1, 1)
filename = "mci_vamp2_2"
select type (mci)
type is (mci_vamp2_t)
call mci%set_config (config)
call mci%set_integrator_filename (filename)
end select
allocate (rng_stream_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_1_t :: sampler)
select type (sampler)
type is (test_sampler_1_t)
sampler%mode = 2
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 100"
write (u, "(A)")
select type (mci)
type is (mci_vamp2_t)
call mci%add_pass (adapt_grids = .false.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000, pacify = .true.)
call mci%write (u, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Dump channel weights and grids to file"
write (u, "(A)")
mci%md5sum = "1234567890abcdef1234567890abcdef"
select type (mci)
type is (mci_vamp2_t)
call mci%write_grids ()
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp2_2"
end subroutine mci_vamp2_2
@ %def mci_vamp2_2
@
\subsubsection{Grid adaptation}
Construct an integrator and use it for a one-dimensional sampler.
Integrate with three iterations and in-between grid adaptations.
<<MCI vamp2: execute tests>>=
call test (mci_vamp2_3, "mci_vamp2_3", &
"grid adaptation", &
u, results)
<<MCI vamp2: test declarations>>=
public :: mci_vamp2_3
<<MCI vamp2: tests>>=
subroutine mci_vamp2_3 (u)
integer, intent(in) :: u
type(mci_vamp2_config_t) :: config
class(mci_t), allocatable, target :: mci
class(mci_instance_t), pointer :: mci_instance => null ()
class(mci_sampler_t), allocatable :: sampler
class(rng_t), allocatable :: rng
type(string_t) :: filename
write (u, "(A)") "* Test output: mci_vamp2_3"
write (u, "(A)") "* Purpose: integrate function in one dimension &
&(single channel)"
write (u, "(A)") "* and adapt grid"
write (u, "(A)")
write (u, "(A)") "* Initialize integrator, sampler, instance"
write (u, "(A)")
allocate (mci_vamp2_t :: mci)
call mci%set_dimensions (1, 1)
filename = "mci_vamp2_3"
select type (mci)
type is (mci_vamp2_t)
call mci%set_integrator_filename (filename)
call mci%set_config (config)
end select
allocate (rng_stream_t :: rng)
call rng%init ()
call mci%import_rng (rng)
call mci%allocate_instance (mci_instance)
call mci_instance%init (mci)
allocate (test_sampler_1_t :: sampler)
select type (sampler)
type is (test_sampler_1_t)
sampler%mode = 2
end select
call sampler%write (u)
write (u, "(A)")
write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 100"
write (u, "(A)")
select type (mci)
type is (mci_vamp2_t)
call mci%add_pass (adapt_grids = .true.)
end select
call mci%integrate (mci_instance, sampler, 3, 1000, pacify = .true.)
call mci%write (u, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Contents of mci_instance:"
write (u, "(A)")
call mci_instance%write (u, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Dump channel weights and grids to file"
write (u, "(A)")
mci%md5sum = "1234567890abcdef1234567890abcdef"
select type (mci)
type is (mci_vamp2_t)
call mci%write_grids ()
end select
write (u, "(A)")
write (u, "(A)") "* Cleanup"
write (u, "(A)")
call mci_instance%final ()
call mci%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: mci_vamp2_3"
end subroutine mci_vamp2_3
@ %def mci_vamp2_3
@
\section{Dispatch}
@
<<[[dispatch_mci.f90]]>>=
<<File header>>
module dispatch_mci
<<Use strings>>
use diagnostics
use os_interface
use variables
use mci_base
use mci_none
use mci_midpoint
use mci_vamp
use mci_vamp2
<<Standard module head>>
<<Dispatch mci: public>>
<<Dispatch mci: parameters>>
contains
<<Dispatch mci: procedures>>
end module dispatch_mci
@ %def dispatch_mci
Allocate an integrator according to the variable [[$integration_method]].
<<Dispatch mci: public>>=
public :: dispatch_mci_s
<<Dispatch mci: procedures>>=
subroutine dispatch_mci_s (mci, var_list, process_id, is_nlo)
class(mci_t), allocatable, intent(inout) :: mci
logical, intent(in), optional :: is_nlo
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in) :: process_id
type(string_t) :: run_id
type(string_t) :: integration_method
type(grid_parameters_t) :: grid_par
type(history_parameters_t) :: history_par
type(mci_vamp2_config_t) :: mci_vamp2_config
logical :: rebuild_grids, check_grid_file, negative_weights, verbose
logical :: dispatch_nlo
type(string_t) :: grid_path
dispatch_nlo = .false.; if (present (is_nlo)) dispatch_nlo = is_nlo
integration_method = &
var_list%get_sval (var_str ("$integration_method"))
select case (char (integration_method))
case ("none")
allocate (mci_none_t :: mci)
case ("midpoint")
allocate (mci_midpoint_t :: mci)
case ("vamp", "default")
call unpack_options_vamp ()
allocate (mci_vamp_t :: mci)
select type (mci)
type is (mci_vamp_t)
call mci%set_grid_parameters (grid_par)
if (run_id /= "") then
call mci%set_grid_filename (process_id, run_id)
else
call mci%set_grid_filename (process_id)
end if
- grid_path = var_list%get_sval (var_str ("$grid_path"))
+ grid_path = var_list%get_sval (var_str ("$integrate_workspace"))
if (grid_path /= "") then
call setup_grid_path (grid_path)
call mci%prepend_grid_path (grid_path)
end if
call mci%set_history_parameters (history_par)
call mci%set_rebuild_flag (rebuild_grids, check_grid_file)
mci%negative_weights = negative_weights
mci%verbose = verbose
end select
case ("vamp2")
call unpack_options_vamp2 ()
allocate (mci_vamp2_t :: mci)
select type (mci)
type is (mci_vamp2_t)
call mci%set_config (mci_vamp2_config)
if (run_id /= "") then
call mci%set_integrator_filename (process_id, run_id)
else
call mci%set_integrator_filename (process_id)
end if
- grid_path = var_list%get_sval (var_str ("$grid_path"))
+ grid_path = var_list%get_sval (var_str ("$integrate_workspace"))
if (grid_path /= "") then
call setup_grid_path (grid_path)
call mci%prepend_integrator_path (grid_path)
end if
call mci%set_rebuild_flag (rebuild_grids, check_grid_file)
mci%negative_weights = negative_weights
mci%verbose = verbose
end select
case default
call msg_fatal ("Integrator '" &
// char (integration_method) // "' not implemented")
end select
contains
<<Dispatch mci s: procedures>>
end subroutine dispatch_mci_s
@ %def dispatch_mci_s
@
<<Dispatch mci s: procedures>>=
subroutine unpack_options_vamp ()
grid_par%threshold_calls = &
var_list%get_ival (var_str ("threshold_calls"))
grid_par%min_calls_per_channel = &
var_list%get_ival (var_str ("min_calls_per_channel"))
grid_par%min_calls_per_bin = &
var_list%get_ival (var_str ("min_calls_per_bin"))
grid_par%min_bins = &
var_list%get_ival (var_str ("min_bins"))
grid_par%max_bins = &
var_list%get_ival (var_str ("max_bins"))
grid_par%stratified = &
var_list%get_lval (var_str ("?stratified"))
if (.not. dispatch_nlo) then
grid_par%use_vamp_equivalences = &
var_list%get_lval (var_str ("?use_vamp_equivalences"))
else
grid_par%use_vamp_equivalences = .false.
end if
grid_par%channel_weights_power = &
var_list%get_rval (var_str ("channel_weights_power"))
grid_par%accuracy_goal = &
var_list%get_rval (var_str ("accuracy_goal"))
grid_par%error_goal = &
var_list%get_rval (var_str ("error_goal"))
grid_par%rel_error_goal = &
var_list%get_rval (var_str ("relative_error_goal"))
history_par%global = &
var_list%get_lval (var_str ("?vamp_history_global"))
history_par%global_verbose = &
var_list%get_lval (var_str ("?vamp_history_global_verbose"))
history_par%channel = &
var_list%get_lval (var_str ("?vamp_history_channels"))
history_par%channel_verbose = &
var_list%get_lval (var_str ("?vamp_history_channels_verbose"))
verbose = &
var_list%get_lval (var_str ("?vamp_verbose"))
check_grid_file = &
var_list%get_lval (var_str ("?check_grid_file"))
run_id = &
var_list%get_sval (var_str ("$run_id"))
rebuild_grids = &
var_list%get_lval (var_str ("?rebuild_grids"))
negative_weights = &
var_list%get_lval (var_str ("?negative_weights")) .or. dispatch_nlo
end subroutine unpack_options_vamp
subroutine unpack_options_vamp2 ()
mci_vamp2_config%n_bins_max = &
var_list%get_ival (var_str ("max_bins"))
mci_vamp2_config%n_calls_min_per_channel = &
var_list%get_ival (var_str ("min_calls_per_channel"))
mci_vamp2_config%n_calls_threshold = &
var_list%get_ival (var_str ("threshold_calls"))
mci_vamp2_config%beta = &
var_list%get_rval (var_str ("channel_weights_power"))
mci_vamp2_config%stratified = &
var_list%get_lval (var_str ("?stratified"))
if (.not. dispatch_nlo) then
mci_vamp2_config%equivalences = &
var_list%get_lval (var_str ("?use_vamp_equivalences"))
else
mci_vamp2_config%equivalences = .false.
end if
mci_vamp2_config%accuracy_goal = &
var_list%get_rval (var_str ("accuracy_goal"))
mci_vamp2_config%error_goal = &
var_list%get_rval (var_str ("error_goal"))
mci_vamp2_config%rel_error_goal = &
var_list%get_rval (var_str ("relative_error_goal"))
verbose = &
var_list%get_lval (var_str ("?vamp_verbose"))
check_grid_file = &
var_list%get_lval (var_str ("?check_grid_file"))
run_id = &
var_list%get_sval (var_str ("$run_id"))
rebuild_grids = &
var_list%get_lval (var_str ("?rebuild_grids"))
negative_weights = &
var_list%get_lval (var_str ("?negative_weights")) .or. dispatch_nlo
end subroutine unpack_options_vamp2
@
@ Make sure that the VAMP grid subdirectory, if requested, exists before it is
used. Also include a sanity check on the directory name.
<<Dispatch mci: parameters>>=
character(*), parameter :: ALLOWED_IN_DIRNAME = &
"abcdefghijklmnopqrstuvwxyz&
&ABCDEFGHIJKLMNOPQRSTUVWXYZ&
&1234567890&
&.,_-+="
@ %def ALLOWED_IN_DIRNAME
<<Dispatch mci: procedures>>=
subroutine setup_grid_path (grid_path)
type(string_t), intent(in) :: grid_path
if (verify (grid_path, ALLOWED_IN_DIRNAME) == 0) then
call msg_message ("Integrator: preparing VAMP grid directory '" &
// char (grid_path) // "'")
call os_system_call ("mkdir -p '" // grid_path // "'")
else
call msg_fatal ("Integrator: VAMP grid_path '" &
// char (grid_path) // "' contains illegal characters")
end if
end subroutine setup_grid_path
@ %def setup_grid_path
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[dispatch_mci_ut.f90]]>>=
<<File header>>
module dispatch_mci_ut
use unit_tests
use dispatch_mci_uti
<<Standard module head>>
<<Dispatch mci: public test>>
contains
<<Dispatch mci: test driver>>
end module dispatch_mci_ut
@ %def dispatch_mci_ut
@
<<[[dispatch_mci_uti.f90]]>>=
<<File header>>
module dispatch_mci_uti
<<Use kinds>>
<<Use strings>>
use variables
use mci_base
use mci_none
use mci_midpoint
use mci_vamp
use dispatch_mci
<<Standard module head>>
<<Dispatch mci: test declarations>>
contains
<<Dispatch mci: tests>>
end module dispatch_mci_uti
@ %def dispatch_mci_ut
@ API: driver for the unit tests below.
<<Dispatch mci: public test>>=
public ::dispatch_mci_test
<<Dispatch mci: test driver>>=
subroutine dispatch_mci_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Dispatch mci: execute tests>>
end subroutine dispatch_mci_test
@ %def dispatch_mci_test
@
\subsubsection{Select type: integrator core}
<<Dispatch mci: execute tests>>=
call test (dispatch_mci_1, "dispatch_mci_1", &
"integration method", &
u, results)
<<Dispatch mci: test declarations>>=
public :: dispatch_mci_1
<<Dispatch mci: tests>>=
subroutine dispatch_mci_1 (u)
integer, intent(in) :: u
type(var_list_t) :: var_list
class(mci_t), allocatable :: mci
type(string_t) :: process_id
write (u, "(A)") "* Test output: dispatch_mci_1"
write (u, "(A)") "* Purpose: select integration method"
write (u, "(A)")
call var_list%init_defaults (0)
process_id = "dispatch_mci_1"
write (u, "(A)") "* Allocate MCI as none_t"
write (u, "(A)")
call var_list%set_string (&
var_str ("$integration_method"), &
var_str ("none"), is_known = .true.)
call dispatch_mci_s (mci, var_list, process_id)
select type (mci)
type is (mci_none_t)
call mci%write (u)
end select
call mci%final ()
deallocate (mci)
write (u, "(A)")
write (u, "(A)") "* Allocate MCI as midpoint_t"
write (u, "(A)")
call var_list%set_string (&
var_str ("$integration_method"), &
var_str ("midpoint"), is_known = .true.)
call dispatch_mci_s (mci, var_list, process_id)
select type (mci)
type is (mci_midpoint_t)
call mci%write (u)
end select
call mci%final ()
deallocate (mci)
write (u, "(A)")
write (u, "(A)") "* Allocate MCI as vamp_t"
write (u, "(A)")
call var_list%set_string (&
var_str ("$integration_method"), &
var_str ("vamp"), is_known = .true.)
call var_list%set_int (var_str ("threshold_calls"), &
1, is_known = .true.)
call var_list%set_int (var_str ("min_calls_per_channel"), &
2, is_known = .true.)
call var_list%set_int (var_str ("min_calls_per_bin"), &
3, is_known = .true.)
call var_list%set_int (var_str ("min_bins"), &
4, is_known = .true.)
call var_list%set_int (var_str ("max_bins"), &
5, is_known = .true.)
call var_list%set_log (var_str ("?stratified"), &
.false., is_known = .true.)
call var_list%set_log (var_str ("?use_vamp_equivalences"),&
.false., is_known = .true.)
call var_list%set_real (var_str ("channel_weights_power"),&
4._default, is_known = .true.)
call var_list%set_log (&
var_str ("?vamp_history_global_verbose"), &
.true., is_known = .true.)
call var_list%set_log (&
var_str ("?vamp_history_channels"), &
.true., is_known = .true.)
call var_list%set_log (&
var_str ("?vamp_history_channels_verbose"), &
.true., is_known = .true.)
call var_list%set_log (var_str ("?stratified"), &
.false., is_known = .true.)
call dispatch_mci_s (mci, var_list, process_id)
select type (mci)
type is (mci_vamp_t)
call mci%write (u)
call mci%write_history_parameters (u)
end select
call mci%final ()
deallocate (mci)
write (u, "(A)")
write (u, "(A)") "* Allocate MCI as vamp_t, allow for negative weights"
write (u, "(A)")
call var_list%set_string (&
var_str ("$integration_method"), &
var_str ("vamp"), is_known = .true.)
call var_list%set_log (var_str ("?negative_weights"), &
.true., is_known = .true.)
call dispatch_mci_s (mci, var_list, process_id)
select type (mci)
type is (mci_vamp_t)
call mci%write (u)
call mci%write_history_parameters (u)
end select
call mci%final ()
deallocate (mci)
call var_list%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_mci_1"
end subroutine dispatch_mci_1
@ %def dispatch_mci_1
Index: trunk/src/phase_space/phase_space.nw
===================================================================
--- trunk/src/phase_space/phase_space.nw (revision 8157)
+++ trunk/src/phase_space/phase_space.nw (revision 8158)
@@ -1,26750 +1,26764 @@
% -*- 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\_1none]
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 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
use lorentz
use model_data
use flavors
use process_constants
<<Standard module head>>
<<PHS base: public>>
<<PHS base: types>>
<<PHS base: interfaces>>
contains
<<PHS base: procedures>>
end module phs_base
@ %def phs_base
@
\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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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.
<<PHS base: phs channel: TBP>>=
procedure :: set_resonant => channel_set_resonant
<<PHS base: 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.
<<PHS base: phs channel: TBP>>=
procedure :: set_on_shell => channel_set_on_shell
<<PHS base: 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: procedures>>=
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.
Note: eliminating the [[string]] auxiliary triggers an ICE in gfortran 4.7.2.
<<PHS base: phs channel collection: TBP>>=
procedure :: write => phs_channel_collection_write
<<PHS base: procedures>>=
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
type(string_t) :: string
integer :: u
u = given_output_unit (unit)
entry => object%first
do while (associated (entry))
if (allocated (entry%prop)) then
string = entry%prop%to_string ()
write (u, "(1x,I0,1x,A)") entry%i, char (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: procedures>>=
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: procedures>>=
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: procedures>>=
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 :: cm_frame = .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: procedures>>=
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)") "cm_frame = ", object%cm_frame
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: procedures>>=
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, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
- nlo_type)
+ 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 :: cm_frame
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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%cm_frame) 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: procedures>>=
subroutine phs_base_init (phs, phs_config)
class(phs_t), intent(out) :: phs
class(phs_config_t), intent(in), target :: phs_config
real(default), dimension(phs_config%n_in) :: m_in
real(default), dimension(phs_config%n_out) :: m_out
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))
!!! !!! !!! Workaround for gfortran 5.0 ICE
m_in = phs_config%flv(:phs_config%n_in, 1)%get_mass ()
m_out = phs_config%flv(phs_config%n_in+1:, 1)%get_mass ()
allocate (phs%m_in (phs%config%n_in), source = m_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 = m_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: procedures>>=
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: procedures>>=
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%cm_frame) 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 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: procedures>>=
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%cm_frame) 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: procedures>>=
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%cm_frame) 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 :: is_cm_frame => phs_is_cm_frame
<<PHS base: procedures>>=
function phs_is_cm_frame (phs) result (cm_frame)
logical :: cm_frame
class(phs_t), intent(in) :: phs
cm_frame = phs%config%cm_frame
end function phs_is_cm_frame
@ %def phs_is_cm_frame
@
<<PHS base: phs: TBP>>=
procedure :: get_n_tot => phs_get_n_tot
<<PHS base: procedures>>=
elemental 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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
<<PHS base: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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 [[cm_frame]] 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, cm_frame, azimuthal_dependence, rebuild, &
- ignore_mismatch, nlo_type)
+ 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 :: cm_frame
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 (cm_frame)) then
phs_config%cm_frame = cm_frame
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 io_units, only: given_output_unit
use diagnostics, only: msg_message, msg_fatal
use phs_base, only: phs_config_t, phs_t
<<Standard module head>>
<<PHS none: public>>
<<PHS none: types>>
contains
<<PHS none: procedures>>
end module phs_none
@ %def phs_none
@
\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: procedures>>=
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: procedures>>=
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: procedures>>=
subroutine phs_none_config_configure (phs_config, sqrts, &
sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
- nlo_type)
+ 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 :: cm_frame
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: procedures>>=
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.
<<PHS none: phs none config: TBP>>=
procedure, nopass :: allocate_instance => phs_none_config_allocate_instance
<<PHS none: 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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
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: procedures>>=
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 io_units
use constants
use numeric_utils
use diagnostics
use os_interface
use lorentz
use physics_defs
use model_data
use flavors
use process_constants
use phs_base
<<Standard module head>>
<<PHS single: public>>
<<PHS single: types>>
contains
<<PHS single: procedures>>
end module phs_single
@ %def phs_single
@
\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: procedures>>=
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: procedures>>=
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: procedures>>=
subroutine phs_single_config_configure (phs_config, sqrts, &
sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
- nlo_type)
+ 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 :: cm_frame
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 (cm_frame)) phs_config%cm_frame = cm_frame
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: procedures>>=
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.
<<PHS single: phs single config: TBP>>=
procedure, nopass :: allocate_instance => phs_single_config_allocate_instance
<<PHS single: 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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
!!! !!! !!! Catching a gfortran bogus warning
type(vector4_t), dimension(2) :: p_dum
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)
!!! !!! !!! Catching a gfortran bogus warning
!!! call compute_kinematics_solid_angle (phs%decay_p (), phs%q, x)
p_dum = phs%decay_p ()
call compute_kinematics_solid_angle (p_dum, 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
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: procedures>>=
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: procedures>>=
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, cm_frame=.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{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 string_utils, only: str
use format_utils, only: write_indent
use io_units
use diagnostics
use lorentz
use constants, only: one
use model_data, only: model_data_t
use flavors, only: flavor_t
<<Standard module head>>
<<Resonances: public>>
<<Resonances: parameters>>
<<Resonances: types>>
contains
<<Resonances: procedures>>
end module resonances
@ %def resonances
@
\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: procedures>>=
elemental 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: procedures>>=
pure 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: procedures>>=
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: procedures>>=
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: procedures>>=
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
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
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
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: procedures>>=
elemental 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: procedures>>=
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: procedures>>=
elemental 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 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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
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
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
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
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: procedures>>=
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: procedures>>=
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
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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 io_units
use constants, only: pi
use format_defs, only: FMT_19
use diagnostics
use md5
use model_data
use flavors
<<Standard module head>>
<<Mappings: public>>
<<Mappings: parameters>>
<<Mappings: types>>
<<Mappings: interfaces>>
contains
<<Mappings: procedures>>
end module mappings
@ %def mappings
@
\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: procedures>>=
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: procedures>>=
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: public>>=
public :: mapping_write
<<Mappings: procedures>>=
subroutine mapping_write (map, unit, verbose)
type(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: public>>=
public :: mapping_init
<<Mappings: procedures>>=
subroutine mapping_init (mapping, bincode, type, f, model)
type(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: public>>=
public :: mapping_set_parameters
<<Mappings: procedures>>=
subroutine mapping_set_parameters (map, mapping_defaults, variable_limits)
type(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 mapping_write (map)
call msg_fatal &
& (" S-channel resonance must have positive mass")
else if (map%width <= 0) then
call mapping_write (map)
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: public>>=
public :: mapping_set_step_mapping_parameters
<<Mappings: procedures>>=
subroutine mapping_set_step_mapping_parameters (map, &
mass, width, variable_limits)
type(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: public>>=
public :: mapping_is_set
public :: mapping_is_s_channel
public :: mapping_is_on_shell
<<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: procedures>>=
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
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
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: procedures>>=
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: procedures>>=
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: public>>=
public :: mapping_get_mass
public :: mapping_get_width
<<Mappings: procedures>>=
function mapping_get_mass (mapping) result (mass)
real(default) :: mass
type(mapping_t), intent(in) :: mapping
mass = mapping%mass
end function mapping_get_mass
function mapping_get_width (mapping) result (width)
real(default) :: width
type(mapping_t), intent(in) :: mapping
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: procedures>>=
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: public>>=
public :: mapping_compute_msq_from_x
<<Mappings: procedures>>=
subroutine mapping_compute_msq_from_x (map, s, msq_min, msq_max, msq, f, x)
type(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: public>>=
public :: mapping_compute_x_from_msq
<<Mappings: procedures>>=
subroutine mapping_compute_x_from_msq (map, s, msq_min, msq_max, msq, f, x)
type(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: public>>=
public :: mapping_compute_ct_from_x
<<Mappings: procedures>>=
subroutine mapping_compute_ct_from_x (map, s, ct, st, f, x)
type(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: public>>=
public :: mapping_compute_x_from_ct
<<Mappings: procedures>>=
subroutine mapping_compute_x_from_ct (map, s, ct, f, x)
type(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 io_units
use constants, only: twopi, twopi2, twopi5
use format_defs, only: FMT_19
use numeric_utils, only: vanishes
use diagnostics
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>>
contains
<<PHS trees: procedures>>
end module phs_trees
@ %def phs_trees
@
\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
end type phs_prt_t
@ %def phs_prt_t
@ Set contents:
<<PHS trees: public>>=
public :: phs_prt_set_defined
public :: phs_prt_set_undefined
public :: phs_prt_set_momentum
public :: phs_prt_set_msq
<<PHS trees: procedures>>=
elemental subroutine phs_prt_set_defined (prt)
type(phs_prt_t), intent(inout) :: prt
prt%defined = .true.
end subroutine phs_prt_set_defined
elemental subroutine phs_prt_set_undefined (prt)
type(phs_prt_t), intent(inout) :: prt
prt%defined = .false.
end subroutine phs_prt_set_undefined
elemental subroutine phs_prt_set_momentum (prt, p)
type(phs_prt_t), intent(inout) :: prt
type(vector4_t), intent(in) :: p
prt%p = p
end subroutine phs_prt_set_momentum
elemental subroutine phs_prt_set_msq (prt, p2)
type(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: public>>=
public :: phs_prt_is_defined
public :: phs_prt_get_momentum
public :: phs_prt_get_msq
<<PHS trees: procedures>>=
elemental function phs_prt_is_defined (prt) result (defined)
logical :: defined
type(phs_prt_t), intent(in) :: prt
defined = prt%defined
end function phs_prt_is_defined
elemental function phs_prt_get_momentum (prt) result (p)
type(vector4_t) :: p
type(phs_prt_t), intent(in) :: prt
p = prt%p
end function phs_prt_get_momentum
elemental function phs_prt_get_msq (prt) result (p2)
real(default) :: p2
type(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: public>>=
public :: phs_prt_combine
<<PHS trees: procedures>>=
elemental subroutine phs_prt_combine (prt, prt1, prt2)
type(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: public>>=
public :: phs_prt_write
<<PHS trees: procedures>>=
subroutine phs_prt_write (prt, unit)
type(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: public>>=
public :: phs_prt_check
<<PHS trees: procedures>>=
elemental subroutine phs_prt_check (prt)
type(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$.
<<PHS trees: public>>=
public :: phs_tree_init
public :: phs_tree_final
@ 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: procedures>>=
elemental 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 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: public>>=
public :: phs_tree_write
<<PHS trees: phs tree: TBP>>=
procedure :: write => phs_tree_write
<<PHS trees: procedures>>=
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 mapping_write (tree%mapping (k), 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: procedures>>=
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: public>>=
public :: phs_tree_flip_t_to_s_channel
<<PHS trees: procedures>>=
subroutine phs_tree_flip_t_to_s_channel (tree)
type(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: public>>=
public :: phs_tree_canonicalize
<<PHS trees: procedures>>=
subroutine phs_tree_canonicalize (tree)
type(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: public>>=
public :: phs_tree_init_mapping
<<PHS trees: phs tree: TBP>>=
procedure :: init_mapping => phs_tree_init_mapping
<<PHS trees: procedures>>=
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 mapping_init (tree%mapping(kk), 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: public>>=
public :: phs_tree_set_mapping_parameters
<<PHS trees: phs tree: TBP>>=
procedure :: set_mapping_parameters => phs_tree_set_mapping_parameters
<<PHS trees: procedures>>=
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 mapping_set_parameters &
(tree%mapping(k), 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: public>>=
public :: phs_tree_assign_s_mapping
<<PHS trees: procedures>>=
subroutine phs_tree_assign_s_mapping (tree, mapping)
type(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: public>>=
public :: phs_tree_set_mass_sum
<<PHS trees: phs tree: TBP>>=
procedure :: set_mass_sum => phs_tree_set_mass_sum
<<PHS trees: procedures>>=
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: public>>=
public :: phs_tree_set_effective_masses
<<PHS trees: phs tree: TBP>>=
procedure :: set_effective_masses => phs_tree_set_effective_masses
<<PHS trees: procedures>>=
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 (mapping_is_s_channel (tree%mapping(k))) then
tree%effective_mass(k) = mapping_get_mass (tree%mapping(k))
tree%effective_width(k) = mapping_get_width (tree%mapping(k))
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: public>>=
public :: phs_tree_set_step_mappings
<<PHS trees: procedures>>=
subroutine phs_tree_set_step_mappings (tree, exp_type, variable_limits)
type(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. mapping_is_set (tree%mapping(k))) then
call mapping_init (tree%mapping(k), k, map_str)
call mapping_set_step_mapping_parameters (tree%mapping(k), &
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 (mapping_is_s_channel (tree%mapping(k))) then
call set_step_mappings_x (kk(1), &
mapping_get_mass (tree%mapping(k)) - m(2), &
mapping_get_width (tree%mapping(k)) + w(2))
call set_step_mappings_x (kk(2), &
mapping_get_mass (tree%mapping(k)) - m(1), &
mapping_get_width (tree%mapping(k)) + 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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: public>>=
public :: phs_tree_compute_volume
<<PHS trees: procedures>>=
subroutine phs_tree_compute_volume (tree, sqrts, volume)
type(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: public>>=
public :: phs_tree_compute_momenta_from_x
<<PHS trees: procedures>>=
subroutine phs_tree_compute_momenta_from_x &
(tree, prt, factor, volume, 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), 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 mapping_compute_msq_from_x &
(tree%mapping(k), 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 phs_prt_set_msq (prt(k), msq)
call phs_prt_set_defined (prt(k))
else
ok = .false.
end if
end if
if (ok) then
msq1 = phs_prt_get_msq (prt(k1)); m1 = sqrt (msq1)
msq2 = phs_prt_get_msq (prt(k2)); 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 = phs_prt_get_msq (prt(k)); m = sqrt (msq)
E = sqrt (msq + p**2)
if (present (L0)) then
call phs_prt_set_momentum (prt(k), L0 * vector4_moving (E,p,3))
else
call phs_prt_set_momentum (prt(k), vector4_moving (E,p,3))
end if
call phs_prt_set_defined (prt(k))
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 mapping_compute_ct_from_x &
(tree%mapping(k), 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 * phs_prt_get_momentum (prt(tree%branch(k)%friend)) )
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: public>>=
public :: phs_tree_compute_x_from_momenta
<<PHS trees: procedures>>=
subroutine phs_tree_compute_x_from_momenta (tree, prt, factor, sqrts, x)
type(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 = phs_prt_get_msq (prt(k)); m = sqrt (msq)
if (initial) then
factor = f1 * f2
else
call mapping_compute_x_from_msq &
(tree%mapping(k), sqrts**2, m_min**2, m_max**2, msq, factor, &
x(ix)); ix = ix + 1
factor = f1 * f2 * factor
end if
msq1 = phs_prt_get_msq (prt(k1))
msq2 = phs_prt_get_msq (prt(k2))
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 * phs_prt_get_momentum (prt(k1))
if (has_friend) pf = L0 * phs_prt_get_momentum (prt(kf))
else
p1 = phs_prt_get_momentum (prt(k1))
if (has_friend) pf = phs_prt_get_momentum (prt(kf))
end if
if (present(phi0)) then
cp0 = cos (phi0)
sp0 = sin (phi0)
end if
msq = phs_prt_get_msq (prt(k)); 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 mapping_compute_x_from_ct (tree%mapping(k), 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: procedures>>=
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 phs_prt_combine (prt(k), 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: procedures>>=
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
@
<<PHS trees: public>>=
public :: phs_tree_reshuffle_mappings
<<PHS trees: procedures>>=
subroutine phs_tree_reshuffle_mappings (tree)
type(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: procedures>>=
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 io_units
use format_defs, only: FMT_19
use diagnostics
use lorentz
use numeric_utils
use permutations
use ifiles
use syntax_rules
use lexers
use parser
use model_data
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>>
contains
<<PHS forests: procedures>>
end module phs_forests
@ %def phs_forests
@
\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.
end type phs_parameters_t
@ %def phs_parameters_t
@ Write phase-space parameters to file.
<<PHS forests: public>>=
public :: phs_parameters_write
<<PHS forests: procedures>>=
subroutine phs_parameters_write (phs_par, unit)
type(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: public>>=
public :: phs_parameters_read
<<PHS forests: procedures>>=
subroutine phs_parameters_read (phs_par, unit)
type(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: procedures>>=
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
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: 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 phs_tree_init (grove%tree, 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.
<<PHS forests: interfaces>>=
interface assignment(=)
module procedure phs_grove_assign0
module procedure phs_grove_assign1
end interface
<<PHS forests: 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 phs_tree_assign_s_mapping (grove%tree(i), 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: public>>=
public :: phs_forest_init
<<PHS forests: procedures>>=
subroutine phs_forest_init (forest, n_tree, n_in, n_out)
type(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: public>>=
public :: phs_forest_set_s_mappings
<<PHS forests: procedures>>=
subroutine phs_forest_set_s_mappings (forest)
type(phs_forest_t), intent(inout) :: forest
integer :: g, i0, i1, n
do g = 1, size (forest%grove)
call phs_forest_get_grove_bounds (forest, 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: public>>=
public :: phs_forest_final
<<PHS forests: procedures>>=
subroutine phs_forest_final (forest)
type(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: public>>=
public :: phs_forest_write
<<PHS forests: phs forest: TBP>>=
procedure :: write => phs_forest_write
<<PHS forests: procedures>>=
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 (mapping) &
.or. mapping_is_on_shell (mapping)) then
write (u, "(1x,I0,':',1x)", advance="no") i
call mapping_write (forest%s_mapping(i), 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 (phs_prt_is_defined (forest%prt_in))) then
do i = 1, size (forest%prt_in)
if (phs_prt_is_defined (forest%prt_in(i))) then
write (u, "(1x,A,1x,I0)") "Particle", i
call phs_prt_write (forest%prt_in(i), 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 (phs_prt_is_defined (forest%prt_out))) then
do i = 1, size (forest%prt_out)
if (phs_prt_is_defined (forest%prt_out(i))) then
write (u, "(1x,A,1x,I0)") "Particle", i
call phs_prt_write (forest%prt_out(i), 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 (phs_prt_is_defined (forest%prt))) then
do i = 1, size (forest%prt)
if (phs_prt_is_defined (forest%prt(i))) then
write (u, "(1x,A,1x,I0)") "Particle", i
call phs_prt_write (forest%prt(i), 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 phs_tree_write (grove%tree(t), 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: procedures>>=
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: public>>=
public :: phs_forest_get_n_parameters
<<PHS forests: procedures>>=
function phs_forest_get_n_parameters (forest) result (n)
integer :: n
type(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: public>>=
public :: phs_forest_get_n_channels
<<PHS forests: procedures>>=
function phs_forest_get_n_channels (forest) result (n)
integer :: n
type(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: public>>=
public :: phs_forest_get_n_groves
<<PHS forests: procedures>>=
function phs_forest_get_n_groves (forest) result (n)
integer :: n
type(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: public>>=
public :: phs_forest_get_grove_bounds
<<PHS forests: procedures>>=
subroutine phs_forest_get_grove_bounds (forest, g, i0, i1, n)
type(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: public>>=
public :: phs_forest_get_n_equivalences
<<PHS forests: procedures>>=
function phs_forest_get_n_equivalences (forest) result (n)
integer :: n
type(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: public>>=
public :: phs_forest_get_s_mapping
public :: phs_forest_get_on_shell
<<PHS forests: procedures>>=
subroutine phs_forest_get_s_mapping (forest, channel, flag, mass, width)
type(phs_forest_t), intent(in) :: forest
integer, intent(in) :: channel
logical, intent(out) :: flag
real(default), intent(out) :: mass, width
flag = mapping_is_s_channel (forest%s_mapping(channel))
if (flag) then
mass = mapping_get_mass (forest%s_mapping(channel))
width = mapping_get_width (forest%s_mapping(channel))
else
mass = 0
width = 0
end if
end subroutine phs_forest_get_s_mapping
subroutine phs_forest_get_on_shell (forest, channel, flag, mass)
type(phs_forest_t), intent(in) :: forest
integer, intent(in) :: channel
logical, intent(out) :: flag
real(default), intent(out) :: mass
flag = mapping_is_on_shell (forest%s_mapping(channel))
if (flag) then
mass = mapping_get_mass (forest%s_mapping(channel))
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: public>>=
public :: phs_forest_read
<<PHS forests: interfaces>>=
interface phs_forest_read
module procedure phs_forest_read_file
module procedure phs_forest_read_unit
module procedure phs_forest_read_parse_tree
end interface
<<PHS forests: procedures>>=
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)
type(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 (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
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)
type(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 (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
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)
type(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 phs_forest_init (forest, 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 phs_tree_flip_t_to_s_channel (tree)
call phs_tree_canonicalize (tree)
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 phs_tree_init_mapping (tree, 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: public>>=
public :: phs_forest_set_flavors
<<PHS forests: procedures>>=
subroutine phs_forest_set_flavors (forest, flv, reshuffle, flv_extra)
type(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: public>>=
public :: phs_forest_set_momentum_links
<<PHS forests: procedures>>=
subroutine phs_forest_set_momentum_links (forest, list)
type(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 phs_tree_reshuffle_mappings (tree)
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: public>>=
public :: phs_forest_set_parameters
<<PHS forests: procedures>>=
subroutine phs_forest_set_parameters &
(forest, mapping_defaults, variable_limits)
type(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 phs_tree_set_mass_sum &
(forest%grove(g)%tree(t), forest%flv(forest%n_in+1:))
call phs_tree_set_mapping_parameters (forest%grove(g)%tree(t), &
mapping_defaults, variable_limits)
call phs_tree_set_effective_masses (forest%grove(g)%tree(t))
if (mapping_defaults%step_mapping) then
call phs_tree_set_step_mappings (forest%grove(g)%tree(t), &
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: public>>=
public :: phs_forest_setup_prt_combinations
<<PHS forests: procedures>>=
subroutine phs_forest_setup_prt_combinations (forest)
type(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: public>>=
public :: phs_forest_set_prt_in
<<PHS forests: interfaces>>=
interface phs_forest_set_prt_in
module procedure phs_forest_set_prt_in_int, phs_forest_set_prt_in_mom
end interface phs_forest_set_prt_in
<<PHS forests: procedures>>=
subroutine phs_forest_set_prt_in_int (forest, int, lt_cm_to_lab)
type(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 phs_prt_set_momentum (forest%prt_in, &
inverse (lt_cm_to_lab) * &
int%get_momenta (outgoing=.false.))
else
call phs_prt_set_momentum (forest%prt_in, &
int%get_momenta (outgoing=.false.))
end if
associate (m_in => forest%flv(:forest%n_in)%get_mass ())
call phs_prt_set_msq (forest%prt_in, m_in ** 2)
end associate
call phs_prt_set_defined (forest%prt_in)
end subroutine phs_forest_set_prt_in_int
subroutine phs_forest_set_prt_in_mom (forest, mom, lt_cm_to_lab)
type(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 phs_prt_set_momentum (forest%prt_in, &
inverse (lt_cm_to_lab) * mom)
else
call phs_prt_set_momentum (forest%prt_in, mom)
end if
associate (m_in => forest%flv(:forest%n_in)%get_mass ())
call phs_prt_set_msq (forest%prt_in, m_in ** 2)
end associate
call phs_prt_set_defined (forest%prt_in)
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: public>>=
public :: phs_forest_set_prt_out
<<PHS forests: interfaces>>=
interface phs_forest_set_prt_out
module procedure phs_forest_set_prt_out_int, phs_forest_set_prt_out_mom
end interface phs_forest_set_prt_out
<<PHS forests: procedures>>=
subroutine phs_forest_set_prt_out_int (forest, int, lt_cm_to_lab)
type(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 phs_prt_set_momentum (forest%prt_out, &
inverse (lt_cm_to_lab) * &
int%get_momenta (outgoing=.true.))
else
call phs_prt_set_momentum (forest%prt_out, &
int%get_momenta (outgoing=.true.))
end if
associate (m_out => forest%flv(forest%n_in+1:)%get_mass ())
call phs_prt_set_msq (forest%prt_out, m_out ** 2)
end associate
call phs_prt_set_defined (forest%prt_out)
end subroutine phs_forest_set_prt_out_int
subroutine phs_forest_set_prt_out_mom (forest, mom, lt_cm_to_lab)
type(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 phs_prt_set_momentum (forest%prt_out, &
inverse (lt_cm_to_lab) * mom)
else
call phs_prt_set_momentum (forest%prt_out, mom)
end if
associate (m_out => forest%flv(forest%n_in+1:)%get_mass ())
call phs_prt_set_msq (forest%prt_out, m_out ** 2)
end associate
call phs_prt_set_defined (forest%prt_out)
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: public>>=
public :: phs_forest_combine_particles
<<PHS forests: procedures>>=
subroutine phs_forest_combine_particles (forest)
type(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 phs_prt_combine (forest%prt(k), &
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: public>>=
public :: phs_forest_get_prt_out
<<PHS forests: procedures>>=
subroutine phs_forest_get_prt_out (forest, int, lt_cm_to_lab)
type(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 * &
phs_prt_get_momentum (forest%prt_out), outgoing=.true.)
else
call int%set_momenta (phs_prt_get_momentum (forest%prt_out), &
outgoing=.true.)
end if
end subroutine phs_forest_get_prt_out
@ %def phs_forest_get_prt_out
@ Extract the outgoing particle momenta
<<PHS forests: public>>=
public :: phs_forest_get_momenta_out
<<PHS forests: procedures>>=
function phs_forest_get_momenta_out (forest, lt_cm_to_lab) result (p)
type(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 = phs_prt_get_momentum (forest%prt_out)
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: public>>=
public :: phs_forest_set_equivalences
<<PHS forests: procedures>>=
subroutine phs_forest_set_equivalences (forest)
type(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: public>>=
public :: phs_forest_get_equivalences
<<PHS forests: procedures>>=
subroutine phs_forest_get_equivalences (forest, channel, azimuthal_dependence)
type(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: public>>=
public :: phs_forest_evaluate_selected_channel
<<PHS forests: procedures>>=
subroutine phs_forest_evaluate_selected_channel &
(forest, channel, active, sqrts, x, phs_factor, volume, ok)
type(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 phs_prt_set_undefined (forest%prt)
call phs_prt_set_undefined (forest%prt_out)
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 phs_prt_set_msq (forest%prt(ibset(0,k-1)), &
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 phs_prt_combine &
(forest%prt(k_root), forest%prt_in(1), forest%prt_in(2))
end select
call phs_tree_compute_momenta_from_x (forest%grove(g)%tree(t), &
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: public>>=
public :: phs_forest_evaluate_other_channels
<<PHS forests: procedures>>=
subroutine phs_forest_evaluate_other_channels &
(forest, channel, active, sqrts, x, phs_factor, combine)
type(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 phs_tree_compute_x_from_momenta &
(forest%grove(g)%tree(t), &
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: public>>=
public :: phs_forest_recover_channel
<<PHS forests: procedures>>=
subroutine phs_forest_recover_channel &
(forest, channel, sqrts, x, phs_factor, volume)
type(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 phs_prt_set_undefined (forest%prt)
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 phs_forest_combine_particles (forest)
call phs_tree_compute_volume &
(forest%grove(g)%tree(t), sqrts, volume)
call phs_tree_compute_x_from_momenta &
(forest%grove(g)%tree(t), &
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 phs_forest_read &
(forest, filename, process_id, 2, 3, model, found_process)
write (u, "(A)")
write (u, "(A)") "* Set parameters, flavors, equiv, momenta"
write (u, "(A)")
call phs_forest_set_flavors (forest, flv)
call phs_forest_set_parameters (forest, mapping_defaults, .false.)
call phs_forest_setup_prt_combinations (forest)
call phs_forest_set_equivalences (forest)
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 phs_forest_set_prt_in (forest, 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 phs_forest_evaluate_selected_channel (forest, &
n_channel, active, sqrts, x, factor, volume, ok)
call phs_forest_evaluate_other_channels (forest, &
n_channel, active, sqrts, x, factor, combine=.true.)
call phs_forest_get_prt_out (forest, 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 phs_forest_write (forest, u)
write (u, "(A)")
write (u, "(A)") "* Compute equivalences"
n_channel = 4
allocate (channel (n_channel))
call phs_forest_get_equivalences (forest, &
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 phs_forest_final (forest)
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 phs_forest_read &
(forest, 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 phs_forest_final (forest)
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 io_units
use constants, only: one
use format_defs, only: FMT_12, FMT_19
use numeric_utils
use diagnostics
use hashes
use sorting
use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
use physics_defs, only: UNDEFINED
use model_data
use flavors
use lorentz
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>>
contains
<<Cascades: procedures>>
end module cascades
@ %def cascades
@
\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: procedures>>=
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: procedures>>=
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: procedures>>=
elemental 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: procedures>>=
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: procedures>>=
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.
Note: the explicit initialization loop might be avoided (ELEMENTAL),
but a bug in nagfor 5.3.2 prevents this.
<<Cascades: parameters>>=
real, parameter, public :: CASCADE_SET_FILL_RATIO = 0.1
<<Cascades: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
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: procedures>>=
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
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
call msg_debug2 (D_PHASESPACE, "cascade_extract_resonance_history")
if (cascade%n_resonances > 0) then
if (cascade%has_children) then
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: procedures>>=
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
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
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: procedures>>=
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
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
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{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 io_units
use constants
use numeric_utils
use diagnostics
use os_interface
use md5
use physics_defs
use lorentz
use model_data
use flavors
use process_constants
use sf_mappings
use sf_base
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: parameters>>
<<PHS wood: types>>
contains
<<PHS wood: procedures>>
end module phs_wood
@ %def phs_wood
@
\subsection{Configuration}
<<PHS wood: parameters>>=
integer, parameter, public :: EXTENSION_NONE = 0
integer, parameter, public :: EXTENSION_DEFAULT = 1
integer, parameter, public :: EXTENSION_DGLAP = 2
<<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
integer :: extension_mode = EXTENSION_NONE
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: procedures>>=
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 phs_forest_final (object%forest)
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: procedures>>=
subroutine phs_wood_config_increase_n_par (phs_config)
class(phs_wood_config_t), intent(inout) :: phs_config
select case (phs_config%extension_mode)
case (EXTENSION_DEFAULT)
phs_config%n_par = phs_config%n_par + 3
case (EXTENSION_DGLAP)
phs_config%n_par = phs_config%n_par + 4
end select
end subroutine phs_wood_config_increase_n_par
@ %def phs_wood_config_increase_n_par
@
<<PHS wood: phs wood config: TBP>>=
procedure :: set_extension_mode => phs_wood_config_set_extension_mode
<<PHS wood: procedures>>=
subroutine phs_wood_config_set_extension_mode (phs_config, mode)
class(phs_wood_config_t), intent(inout) :: phs_config
integer, intent(in) :: mode
phs_config%extension_mode = mode
end subroutine phs_wood_config_set_extension_mode
@ %def phs_wood_config_set_extension_mode
@ 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: procedures>>=
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 phs_parameters_write (object%par, 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: procedures>>=
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 phs_forest_write (object%forest, 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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
endif
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)
endif
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: procedures>>=
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)
endif
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_parameters_write (phs_config%par, 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)
endif
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)
endif
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: procedures>>=
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)
endif
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: procedures>>=
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: procedures>>=
subroutine phs_wood_config_configure (phs_config, sqrts, &
sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
- nlo_type)
+ 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 :: cm_frame
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 (cm_frame)) &
phs_config%cm_frame = cm_frame
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 ()
- filename_vis = phs_config%make_phs_filename () // "-vis"
+ 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)
+ 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)
+ 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_forest_read (phs_config%forest, 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_forest_set_flavors (phs_config%forest, phs_config%flv(:,1))
variable_limits = .not. phs_config%cm_frame
call phs_forest_set_parameters &
(phs_config%forest, phs_config%mapping_defaults, variable_limits)
call phs_forest_setup_prt_combinations (phs_config%forest)
phs_config%n_channel = phs_forest_get_n_channels (phs_config%forest)
phs_config%n_par = phs_forest_get_n_parameters (phs_config%forest)
allocate (phs_config%channel (phs_config%n_channel))
if (phs_config%use_equivalences) then
call phs_forest_set_equivalences (phs_config%forest)
call phs_forest_get_equivalences (phs_config%forest, &
phs_config%channel, phs_config%azimuthal_dependence)
phs_config%provides_equivalences = .true.
end if
call phs_forest_set_s_mappings (phs_config%forest)
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_forest_get_n_groves (phs_config%forest)
call phs_forest_get_grove_bounds (phs_config%forest, 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: procedures>>=
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: procedures>>=
- function phs_wood_make_phs_filename (phs_config) result (filename)
+ 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: procedures>>=
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_forest_set_flavors (phs_config%forest, 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: procedures>>=
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_forest_set_momentum_links (phs_config%forest, 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: procedures>>=
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_forest_get_s_mapping (phs_config%forest, 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: procedures>>=
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_forest_get_on_shell (phs_config%forest, 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: procedures>>=
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: procedures>>=
- subroutine phs_wood_read_phs_file (phs_config, exist, found, match)
+ 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 ()
+ 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_forest_read (phs_config%forest, 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: procedures>>=
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_forest_get_n_groves (phs_config%forest)
n_eq = phs_forest_get_n_equivalences (phs_config%forest)
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 ", &
phs_forest_get_n_groves (phs_config%forest), &
" 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.
<<PHS wood: phs wood config: TBP>>=
procedure, nopass :: allocate_instance => phs_wood_config_allocate_instance
<<PHS wood: 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: procedures>>=
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: procedures>>=
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 phs_forest_write (object%forest, 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: procedures>>=
subroutine phs_wood_final (object)
class(phs_wood_t), intent(inout) :: object
call phs_forest_final (object%forest)
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: procedures>>=
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
select case (phs_config%extension_mode)
case (EXTENSION_DEFAULT)
phs%n_r_born = phs_config%n_par - 3
case (EXTENSION_DGLAP)
phs%n_r_born = phs_config%n_par - 4
end select
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: procedures>>=
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%forest, phs%p)
phs%r(:,c_in) = r_in
call phs_forest_evaluate_selected_channel (phs%forest, &
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%extension_mode > EXTENSION_NONE) 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%forest)
phs%q_defined = .true.
end if
end if
end subroutine phs_wood_evaluate_selected_channel
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 (phs%forest, &
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%extension_mode > EXTENSION_NONE) 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: procedures>>=
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%forest, phs%p)
call phs_forest_set_prt_out (phs%forest, phs%q)
call phs_forest_recover_channel (phs%forest, &
1, &
phs%sqrts_hat, phs%r, phs%f, phs%volume)
call phs_forest_evaluate_other_channels (phs%forest, &
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 (os_data)
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 diagnostics
use io_units, only: given_output_unit, free_unit
use format_utils, only: write_separator
use lorentz
use physics_defs
use flavors
use pdg_arrays, only: is_colored
use models, only: model_t
use sf_mappings
use sf_base
use phs_base
use resonances, only: resonance_contributors_t, resonance_history_t
use phs_forests, only: phs_forest_final
use phs_wood
use cascades
use cascades2
use process_constants
use process_libraries
use ttv_formfactors, only: generate_on_shell_decay_threshold, m1s_to_mpole
<<Standard module head>>
<<phs fks: public>>
<<phs fks: parameters>>
<<phs fks: types>>
<<phs fks: interfaces>>
contains
<<phs fks: procedures>>
end module phs_fks
@ %def phs_fks
@
@ 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), dimension(2) :: z_coll = zero
real(default) :: sqrts_born = zero
real(default) :: beam_energy = zero
real(default) :: fac_scale = zero
real(default), dimension(2) :: jacobian = one
integer :: isr_mode = SQRTS_FIXED
end type isr_kinematics_t
@ %def type isr_kinematics_t
@
<<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: procedures>>=
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: procedures>>=
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
p_sum = vector4_null
call msg_debug (D_SUBTRACTION, "Invariant masses for real emission: ")
associate (p => phs_point_set%phs_point(i_phs)%p)
do i = 1, size (contributors)
p_sum = p_sum + p(contributors(i))
end do
p_sum = p_sum + p(size(p))
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: procedures>>=
elemental 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 = phs_point_set%phs_point(i_res)%n_momenta
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: procedures>>=
pure 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
if (present (n_in)) then
allocate (p (n_in), source = phs_point_set%phs_point(i_phs)%p(1:n_in))
else
allocate (p (phs_point_set%phs_point(i_phs)%n_momenta), &
source = phs_point_set%phs_point(i_phs)%p)
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: procedures>>=
pure 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)%p(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: procedures>>=
pure 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 = phs_point_set%phs_point(i_phs)%p(i_mom)%p(0)
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: procedures>>=
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
associate (p => phs_point_set%phs_point(i_phs)%p)
sqrts = (p(1) + p(2))**1
end associate
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: procedures>>=
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 = 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: procedures>>=
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: procedures>>=
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)%p)
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: procedures>>=
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: procedures>>=
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
type(vector4_t) :: p
integer :: i
p = vector4_null
do i = 1, size (i_part)
p = p + phs_point_set%phs_point(i_phs)%p(i_part(i))
end do
m2 = p**2
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: procedures>>=
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: procedures>>=
subroutine phs_point_set_final (phs_point_set)
class(phs_point_set_t), intent(inout) :: phs_point_set
integer :: i
do i = 1, size (phs_point_set%phs_point)
call phs_point_set%phs_point(i)%final ()
end do
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: procedures>>=
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: procedures>>=
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: procedures>>=
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,F5.3)") "xi_tilde: ", r%xi_tilde
write (u,"(A,F5.3)") "phi: ", r%phi
do i = 1, size (r%xi_max)
write (u,"(A,I1,1X)") "i_phs: ", i
write (u,"(A,100F5.3,1X)") "xi_max: ", r%xi_max(i)
write (u,"(A,100F5.3,1X)") "y: ", r%y(i)
write (u,"(A,100F5.3,1X)") "jac_rand: ", r%jac_rand(i)
write (u,"(A,100F5.3,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: procedures>>=
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, 0, 1]
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: procedures>>=
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(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
associate (p_real => r%p_real_cms%phs_point(i_phs)%p, &
p_real_onshell => r%p_real_onshell(leg)%phs_point(i_phs)%p)
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
end associate
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: procedures>>=
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, see below.
It is also used by [[Powheg]], so the routine is public.
The input parameter [[m2]] corresponds to the squared mass of the emitter and [[p]] is the
four-momentum of the emitter.
<<phs fks: public>>=
public :: compute_dalitz_bounds
<<phs fks: procedures>>=
pure 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: procedures>>=
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 (FSR_SIMPLE)
kt2 = real_kinematics%cms_energy2 / two * xii**2 * (1 - yy)
case (FSR_MASSIVE)
q = sqrt (real_kinematics%cms_energy2)
p_emitter = real_kinematics%p_born_cms%phs_point(1)%p(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 (FSR_MASSLESS_RECOILER)
kt2 = real_kinematics%cms_energy2 / two * xii**2 * (1 - yy**2) / two
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
@
<<phs fks: parameters>>=
integer, parameter, public :: FSR_SIMPLE = 1
integer, parameter, public :: FSR_MASSIVE = 2
integer, parameter, public :: FSR_MASSLESS_RECOILER = 3
@ %def FSR_SIMPLE FSR_MASSIVE FSR_MASSLESS_RECOILER
@
<<phs fks: real kinematics: TBP>>=
procedure :: final => real_kinematics_final
<<phs fks: procedures>>=
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 :: 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: procedures>>=
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: procedures>>=
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, "(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: procedures>>=
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: procedures>>=
subroutine phs_fks_config_configure (phs_config, sqrts, &
sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, &
- ignore_mismatch, nlo_type)
+ 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 :: cm_frame
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 (phs_config%extension_mode == EXTENSION_NONE) then
select case (phs_config%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
phs_config%n_par = phs_config%n_par + 3
case (PHS_MODE_COLLINEAR_REMNANT)
phs_config%n_par = phs_config%n_par + 1
end select
end if
!!! Channel equivalences not accessible yet
phs_config%provides_equivalences = .false.
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: procedures>>=
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
@
<<phs fks: fks config: TBP>>=
procedure, nopass :: allocate_instance => phs_fks_config_allocate_instance
<<phs fks: 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: procedures>>=
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)
endif
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')
endif
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
endif
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)
endif
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: procedures>>=
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
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%cm_frame = phs_cfg_born%cm_frame
phs_config%vis_channels = phs_cfg_born%vis_channels
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
endif
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: procedures>>=
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
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)
endif
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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.0001_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.999999_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.
<<phs fks: public>>=
public :: check_scalar_products
<<phs fks: procedures>>=
function check_scalar_products (p) result (valid)
logical :: valid
type(vector4_t), intent(in), dimension(:) :: p
real(default), parameter :: tolerance = 1E-6_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 = tiny_07
real(default) :: y_max = one
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: procedures>>=
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: procedures>>=
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)%p(1:2)
end if
associate (isr => generator%isr_kinematics)
do em = 1, 2
isr%x(em) = p(em)%p(0) / isr%beam_energy
isr%z(em) = one - (one - isr%x(em)) * r
isr%jacobian(em) = one - isr%x(em)
end do
isr%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: procedures>>=
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: procedures>>=
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
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
logical :: perform_generation = .true.
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: procedures>>=
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: procedures>>=
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
@
<<phs fks: phs fks: TBP>>=
procedure :: allocate_momenta => phs_fks_allocate_momenta
<<phs fks: procedures>>=
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: procedures>>=
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
if (phs%perform_generation) then
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 if
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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%cm_frame) 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: procedures>>=
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: procedures>>=
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: procedures>>=
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)%p(1:2)
else
p = phs%generator%real_kinematics%p_born_lab%phs_point(1)%p(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: procedures>>=
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%is_cm_frame ()) &
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: procedures>>=
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: procedures>>=
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: procedures>>=
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 beamnstrahlung or
QCD 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: procedures>>=
subroutine phs_fks_set_reference_frames (phs, is_cms)
class(phs_fks_t), intent(inout) :: phs
logical, intent(in) :: is_cms
type(lorentz_transformation_t) :: lt
associate (real_kinematics => phs%generator%real_kinematics)
if (phs%config%cm_frame) then
real_kinematics%p_born_cms%phs_point(1)%p = phs%p_born_tot
real_kinematics%p_born_lab%phs_point(1)%p = phs%p_born_tot
else
if (is_cms) then
real_kinematics%p_born_cms%phs_point(1)%p = phs%p_born_tot
lt = phs%lt_cm_to_lab
real_kinematics%p_born_lab%phs_point(1)%p = &
lt * phs%p_born_tot
else
real_kinematics%p_born_lab%phs_point(1)%p = phs%p_born_tot
lt = inverse (phs%lt_cm_to_lab)
real_kinematics%p_born_cms%phs_point(1)%p = &
lt * 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: procedures>>=
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: procedures>>=
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: procedures>>=
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
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: procedures>>=
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
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: procedures>>=
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: procedures>>=
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
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)
uk_rec = sqrt (k_rec0**2 - generator%mrec2)
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: procedures>>=
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: procedures>>=
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)
allocate (p (1:generator%real_kinematics%p_born_cms%get_n_particles()), &
source = generator%real_kinematics%p_born_cms%phs_point(1)%p)
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 = p_real
if (.not. phs%config%cm_frame) p_real = phs%lt_cm_to_lab * p_real
generator%real_kinematics%p_real_lab%phs_point(i_phs)%p = 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: procedures>>=
pure 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)%p
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
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
@
<<phs fks: procedures>>=
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))
end function get_xi_max_isr
@ %def get_xi_max_isr
@
<<phs fks: procedures>>=
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
@ %def xi_max_isr_plus, xi_max_isr_minus
@
<<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: procedures>>=
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)
allocate (p_work (1:generator%real_kinematics%p_born_cms%get_n_particles()), &
source = generator%real_kinematics%p_born_cms%phs_point(1)%p)
call generator%generate_isr_fixed_beam_energy (i_phs, p_work, p_real)
phs%config%cm_frame = .true.
case (2)
select case (generator%isr_kinematics%isr_mode)
case (SQRTS_FIXED)
allocate (p_work (1:generator%real_kinematics%p_born_cms%get_n_particles()), &
source = generator%real_kinematics%p_born_cms%phs_point(1)%p)
call generator%generate_isr_fixed_beam_energy (i_phs, p_work, p_real)
case (SQRTS_VAR)
allocate (p_work (1:generator%real_kinematics%p_born_lab%get_n_particles()), &
source = generator%real_kinematics%p_born_lab%phs_point(1)%p)
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 = p_real
if (.not. phs%config%cm_frame) 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)%p = &
inverse (lt) * p_real
else
phs%generator%real_kinematics%p_real_cms%phs_point(i_phs)%p = 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: procedures>>=
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: procedures>>=
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
@
<<phs fks: phs fks generator: TBP>>=
procedure :: generate_isr => phs_fks_generator_generate_isr
<<phs fks: procedures>>=
subroutine phs_fks_generator_generate_isr (generator, i_phs, p_born, p_real)
!!! Important: Import 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)
generator%isr_kinematics%z(I_PLUS) = x_plus / xb_plus
generator%isr_kinematics%z(I_MINUS) = x_minus / xb_minus
generator%isr_kinematics%z_coll(I_PLUS) = one / (one - xi_plus)
generator%isr_kinematics%z_coll(I_MINUS) = one / (one - xi_minus)
!!! Create radiation momentum
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
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 the real component
!!! The reweighting factor is s_born / s_real, cancelling the (1-x) 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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
subroutine phs_fks_generator_set_xi_and_y_bounds (generator, xi_min, y_max)
class(phs_fks_generator_t), intent(inout) :: generator
real(default), intent(in) :: xi_min, y_max
generator%xi_min = xi_min
generator%y_max = y_max
end subroutine phs_fks_generator_set_xi_and_y_bounds
@ %def phs_fks_generator_set_xi_and_y_bounds
@
<<phs fks: phs fks generator: TBP>>=
procedure :: set_isr_kinematics => phs_fks_generator_set_isr_kinematics
<<phs fks: procedures>>=
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
generator%isr_kinematics%x = p%p(0) / generator%isr_kinematics%beam_energy
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
@
<<phs fks: phs fks generator: TBP>>=
procedure :: compute_cms_energy => phs_fks_generator_compute_cms_energy
<<phs fks: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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: procedures>>=
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 = 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: procedures>>=
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: procedures>>=
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)
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: procedures>>=
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: procedures>>=
pure 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: procedures>>=
pure 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: procedures>>=
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 (p_born, 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: procedures>>=
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(inout), 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
@
<<phs fks: phs fks generator: TBP>>=
procedure :: get_radiation_variables => &
phs_fks_generator_get_radiation_variables
<<phs fks: procedures>>=
pure 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: procedures>>=
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,F5.3)") "sqrts: ", generator%sqrts
write (u, "(A,F5.3)") "E_gluon: ", generator%E_gluon
write (u, "(A,F5.3)") "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: procedures>>=
subroutine phs_fks_compute_isr_kinematics (phs, r)
class(phs_fks_t), intent(inout) :: phs
real(default), intent(in) :: r
if (.not. phs%config%cm_frame) 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: procedures>>=
subroutine phs_fks_final (object)
class(phs_fks_t), intent(inout) :: object
call phs_forest_final (object%forest)
call object%generator%final ()
end subroutine phs_fks_final
@ %def phs_fks_final
@
<<phs fks: public>>=
public :: get_filtered_resonance_histories
<<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
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: procedures>>=
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 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_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
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
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
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_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
type(vector4_t), dimension(:), allocatable :: p_born_onshell
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
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 = 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:"
associate (p_born => generator%real_kinematics%p_born_cms%phs_point(1)%p, &
p_born_onshell => generator%real_kinematics%p_born_onshell%phs_point(1)%p)
call threshold_projection_born (mtop, L_to_cms, p_born, p_born_onshell)
end associate
call generator%real_kinematics%p_born_onshell%write (1, unit = u, testflag = .true., &
ultra = .true.)
associate (p => generator%real_kinematics%p_born_onshell%phs_point(1)%p)
p_born_onshell = p
call check_phsp (p, 0)
end associate
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
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
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 io_units, only: free_unit
use variables, only: var_list_t
use os_interface, only: os_data_t
use diagnostics
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
use phs_none
use phs_single
use phs_wood
use phs_fks
<<Standard module head>>
<<Dispatch phs: public>>
contains
<<Dispatch phs: procedures>>
end module dispatch_phase_space
@ %def dispatch_phase_space
Allocate a phase-space object according to the variable [[$phs_method]].
<<Dispatch phs: public>>=
public :: dispatch_phs
<<Dispatch phs: procedures>>=
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 ("fks")
allocate (phs_fks_config_t :: phs)
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: procedures>>=
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%write ()
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, os_data_init
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 (os_data)
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
@%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\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>>
contains
<<Cascades2 lexer: procedures>>
end module cascades2_lexer
@ %def cascades2_lexer
@ 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 allocated 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 bincare 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, the 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 introduce the output
[[<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 (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
daigrams 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 meainingful 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: procedures>>=
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
enddo
end function integer_n_dec_digits
end subroutine dag_token_init_dag_object_token
@ %def dag_token_init_dag_object_token
<<Cascades2 lexer: procedures>>=
elemental 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)
enddo
endif
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)
endif
end select
if (dag_token%type /= NODE_TK) exit
enddo
endif
end subroutine dag_token_assign_from_char_string
@ %def dag_token_assign_from_char_string
<<Cascades2 lexer: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
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: procedures>>=
elemental 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
endif
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
enddo
if (node_char_len > 0) then
token_pos = token_pos + 1
token(token_pos) = node_char(:node_char_len)
endif
if (token_pos > 0) then
allocate (dag_string%t(token_pos))
dag_string%t = token(:token_pos)
deallocate (token)
endif
end if
end subroutine dag_string_assign_from_char_string
@ %def dag_string_assign_from_char_string
<<Cascades2 lexer: procedures>>=
elemental 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
endif
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: procedures>>=
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
res_string = token2
else if (token2%type == EMPTY_TK) then
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
endif
end function concat_dag_token_dag_token
@ %def concat_dag_token_dag_token
<<Cascades2 lexer: procedures>>=
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
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
endif
end function concat_dag_string_dag_token
@ %def concat_dag_string_dag_token
<<Cascades2 lexer: procedures>>=
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
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
endif
end function concat_dag_token_dag_string
@ %def concat_dag_token_dag_string
<<Cascades2 lexer: procedures>>=
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
endif
endif
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 confuse 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: procedures>>=
elemental 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: procedures>>=
elemental 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)
endif
end function dag_string_eq_dag_string
@ %def dag_string_eq_dag_string
<<Cascades2 lexer: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
elemental 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: procedures>>=
pure 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)"
endif
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)") "/"
endif
endif
enddo
end select
end function char_dag_token
@ %def char_dag_token
<<Cascades2 lexer: procedures>>=
pure 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
enddo
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: procedures>>=
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
enddo
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: procedures>>=
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
enddo
endif
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: procedures>>=
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
endif
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
@ Produce a single [[dag_string]] object from a given [[dag_chain]].
<<Cascades2 lexer: dag chain: TBP>>=
procedure :: compress => dag_chain_compress
<<Cascades2 lexer: procedures>>=
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)
enddo
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: procedures>>=
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: procedures>>=
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
enddo
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)
enddo
if (fail) then
write (u, "(A)") "* Test result: Test failed!"
else
write (u, "(A)") "* Test result: Test passed"
endif
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 Feyman 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
is 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 kinds>>
use kinds, only: TC, i8
use cascades2_lexer
use sorting
use flavors
use model_data
use iso_varying_string, string_t => varying_string
use io_units
use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
use phs_forests, only: phs_parameters_t
use diagnostics
use hashes
use cascades, only: phase_space_vanishes, MAX_WARN_RESONANCE
use, intrinsic :: iso_fortran_env, only : input_unit, output_unit, error_unit
use resonances, only: resonance_info_t
use resonances, only: resonance_history_t
use resonances, only: resonance_history_set_t
<<Standard module head>>
<<Cascades2: public>>
<<Cascades2: parameters>>
<<Cascades2: types>>
<<Cascades2: interfaces>>
contains
<<Cascades2: procedures>>
end module cascades2
@ %def cascades2
@
\subsection{Particle properties}
We define a type holding the properties of theparticles which are needed
for parsing and finding the phase space parametrizations as well as the
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 (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: procedures>>=
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 describes 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, which are given in the process definition, with
different integers, 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 particle to a third one, the bincode is the number which one
obtains by setting all the bits which are also set for the two particles.
The [[pdg]] and [[mapping]] are simply the pdg-code and mapping at the
position 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: procedures>>=
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: procedures>>=
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
endif
if (allocated (tree2%pdg)) then
allocate (tree1%pdg(size(tree2%pdg)))
tree1%pdg = tree2%pdg
endif
if (allocated (tree2%mapping)) then
allocate (tree1%mapping(size(tree2%mapping)))
tree1%mapping = tree2%mapping
endif
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 be
used for external particles.
<<Cascades2: procedures>>=
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.
endif
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
tree_size = tree1%n_entries + tree2%n_entries + 1
allocate (tree%bc (tree_size))
allocate (tree%pdg (tree_size))
allocate (tree%mapping (tree_size))
tree%bc(:i1) = tree1%bc
tree%pdg(:i1) = tree1%pdg
tree%mapping(:i1) = tree1%mapping
tree%bc(i1+1:i2) = tree2%bc
tree%pdg(i1+1:i2) = tree2%pdg
tree%mapping(i1+1:i2) = tree2%mapping
tree%bc(tree_size) = bc
tree%pdg(tree_size) = pdg
tree%mapping(tree_size) = mapping
tree%n_entries = tree_size
tree%empty = .false.
endif
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: procedures>>=
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
endif
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)
endif
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: procedures>>=
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 set 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
[[k_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 become 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: procedures>>=
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)
enddo
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 du 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: procedures>>=
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]] is the number of nodes (including the
node itself) of the subtree, where 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 reuuse
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: procedures>>=
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: procedures>>=
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: procedures>>=
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)
enddo
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: procedures>>=
recursive 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
@ Finalise f entry.
<<Cascades2: f node entry: TBP>>=
procedure :: final => f_node_entry_final
<<Cascades2: procedures>>=
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: procedures>>=
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
endif
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 is needed 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: procedures>>=
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: procedures>>=
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: procedures>>=
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 nullifies all pointers to nodes, since they are all
deallocated with the finalizer of the list by which the were allocated.
[[f_node_list]].
<<Cascades2: k node: TBP>>=
procedure :: final => k_node_final
<<Cascades2: procedures>>=
recursive 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: procedures>>=
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
endif
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. 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: procedures>>=
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: procedures>>=
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 node. If the node can be reused, We check first
using the [[subtree_string]] if there is already a node in the list which
is the root of exactly this subtree. Otherwise we add an entry to the
list and allocate the node. In both cases we return a pointer to the node
so that the node can be used.
<<Cascades2: f node list: TBP>>=
procedure :: add_entry => f_node_list_add_entry
<<Cascades2: procedures>>=
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
endif
if (current%string_len == subtree_len) then
if (trim (current%subtree_string) == trim (subtree_string)) then
ptr_to_node => current%node
exit
endif
endif
current => current%next
enddo
endif
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
endif
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: procedures>>=
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
enddo
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: procedures>>=
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 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: procedures>>=
recursive 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
endif
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 [[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: procedures>>=
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.
endif
if (list%n_entries == 0) then
allocate (list%first)
list%last => list%first
else
allocate (list%last%next)
list%last => list%last%next
endif
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 be used to collect [[k_nodes]] which belong to
different [[f_nodes]] and 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 [[.false.]]) using the subroutine
[[subtree_select]]. If it turns out that two nodes are equivalent, we
keep only one of them. The term equivalent in the context of subtrees
will be explained in the description of [[subtree_select]].
<<Cascades2: k node list: TBP>>=
procedure :: check_subtree_equivalences => k_node_list_check_subtree_equivalences
<<Cascades2: procedures>>=
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
enddo
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.
endif
endif
endif
enddo
endif
enddo
deallocate (set)
end subroutine k_node_list_check_subtree_equivalences
@ %def k_node_list_check_subtree_equivalences
@ This subroutine is use to obtain all [[k_nodes]] of a [[k_node_list]]
which can be recycled and are not disabled for any 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: procedures>>=
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
enddo
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)
enddo
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
endif
enddo
if (current%recycle .and. current%node%keep) then
nodes(pos)%node => current%node
pos = pos + 1
endif
current => current%next
enddo
endif
end subroutine k_node_list_get_nodes
@ %def k_node_list_get_nodes
<<Cascades2: f node list: TBP>>=
procedure :: final => f_node_list_final
<<Cascades2: 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)
enddo
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 to large for reasons of
memory.
This is a corresponding 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: procedures>>=
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
endif
end subroutine compare_tree_final
@ %def compare_tree_final
<<Cascades2: compare tree entry: TBP>>=
procedure :: final => compare_tree_entry_final
<<Cascades2: procedures>>=
recursive 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 ()
enddo
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: procedures>>=
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))
enddo
if (sz > 0) then
allocate (ctree%entry (sz))
else
call msg_bug ("Compare tree could not be created")
endif
endif
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
endif
enddo
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)
endif
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: procedures>>=
recursive 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)
endif
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
endif
endif
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.
endif
endif
endif
enddo
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
enddo
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
enddo
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]] is 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: procedures>>=
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
<<Cascades2: grove list: TBP>>=
procedure :: final => grove_list_final
<<Cascades2: 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.
<<Cascades2: feyngraph set: TBP>>=
procedure :: final => feyngraph_set_final
<<Cascades2: 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 ()
enddo
deallocate (set%fset)
else
set%particle => null ()
set%grove_list => null ()
endif
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)
endif
if (associated (set%grove_list)) then
call msg_debug (D_PHASESPACE, "grove_list: final")
call set%grove_list%final ()
deallocate (set%grove_list)
endif
call msg_debug (D_PHASESPACE, "f_node_list: final")
call set%f_node_list%final ()
if (associated (set%dag)) then
call msg_debug (D_PHASESPACE, "dag: final")
if (associated (set%dag)) then
call set%dag%final ()
deallocate (set%dag)
endif
endif
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 [[fengraph_set_build]]. The parsing subroutines are chosen
depending on the value of [[use_dag]]. In the DAG output, 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 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
cases the all processes will have the form of 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: procedures>>=
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)
endif
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")
endif
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
endif
endif
compare_graph => compare_graph%next
enddo
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
endif
read (unit=u_in, fmt='(A)', iostat=stat, advance='yes') omega_feyngraph_output
else
exit
endif
enddo
current_graph => feyngraph_set%first
do while (associated (current_graph))
call feyngraph_construct (feyngraph_set, current_graph)
current_graph => current_graph%next
enddo
feyngraph_set%f_node_list%max_tree_size = feyngraph_set%first%n_nodes
endif
endif
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: procedures>>=
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)
endif
else if (.not. rewound) then
rewind (u_in)
rewound = .true.
else
call msg_bug ("Process string not found in O'Mega input file.")
endif
enddo
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 (so the backslash
means that the next line to be read 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
endif
call chain%append (buffer(:fragment_len))
if (buffer(fragment_len+1:fragment_len+1) /= BACKSLASH_CHAR) exit
enddo
if (associated (chain%first)) then
call chain%compress ()
string = chain%first
call chain%final ()
endif
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
endif
enddo
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 used only in the unit tests and may disappear if the
processes chosen for the unit tests are simple enough that they can
be tested with the subroutine [[init_sm_test]] of [[model_data]].
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: procedures>>=
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: procedures>>=
recursive 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
endif
enddo
endif
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 array.
<<Cascades2: parameters>>=
integer, parameter :: PRT_ARRAY_SIZE = 200
<<Cascades2: f node: TBP>>=
procedure :: assign_particle_properties => f_node_assign_particle_properties
<<Cascades2: procedures>>=
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))
endif
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
endif
enddo
!!! 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. In particular, we want to make sure to 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 apprear 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)
endif
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
endif
if (associated (mother_node%daughter1)) then
if (.not. mother_node%daughter1%keep) then
mother_node%keep = .false.
endif
endif
if (associated (mother_node%daughter2)) then
if (.not. mother_node%daughter2%keep) then
mother_node%keep = .false.
endif
endif
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
endif
if (.not. mother_node%keep) then
feyngraph%keep = .false.
endif
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 charater
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 most [[f_nodes]] 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: procedures>>=
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)
endif
enddo
deallocate (dag_node%f_node)
endif
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: procedures>>=
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 ()
enddo
deallocate (dag_options%f_node_ptr1)
endif
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 ()
enddo
deallocate (dag_options%f_node_ptr2)
endif
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: procedures>>=
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 ()
enddo
deallocate (dag_combination%f_node_ptr1)
endif
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 ()
enddo
deallocate (dag_combination%f_node_ptr2)
endif
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: procedures>>=
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 ()
enddo
deallocate (dag%node)
endif
if (allocated (dag%options)) then
do i=1, size (dag%options)
call dag%options(i)%final ()
enddo
deallocate (dag%options)
endif
if (allocated (dag%combination)) then
do i=1, size (dag%combination)
call dag%combination(i)%final ()
enddo
deallocate (dag%combination)
endif
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
the corresponding object to the array, which can still 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 corressponds 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: procedures>>=
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)
enddo
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)
enddo
subtree_size = subtree_size + 2
endif
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)
enddo
!$OMP END PARALLEL DO
endif
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)
enddo
!$OMP END PARALLEL DO
endif
if (n_nodes == dag%n_nodes .and. n_options == dag%n_options &
.and. n_combinations == dag%n_combinations) then
continue_loop = .false.
endif
enddo
!!! 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)
endif
!!! 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 ()
enddo
endif
enddo
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: procedures>>=
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)
endif
endif
enddo
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)
endif
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
enddo
else
new_size = new_size + 1
new_string%t(new_size) = dag%string%t(i)
i = i + 1
endif
enddo
dag%string = new_string%t(:new_size)
call dag%string%update_char_len ()
endif
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: procedures>>=
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
enddo
else
new_size = new_size + 1
new_string%t(new_size) = dag%string%t(i)
i = i + 1
endif
enddo
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: procedures>>=
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)
endif
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
endif
endif
endif
enddo
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: procedures>>=
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)
endif
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
endif
endif
endif
enddo
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: procedures>>=
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)
endif
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
endif
endif
endif
enddo
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 optionss 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: procedures>>=
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
endif
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
enddo
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
enddo
endif
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
enddo
endif
endif
!!! 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
enddo
endif
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
enddo
endif
endif
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
enddo
endif
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
enddo
endif
endif
!!! 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
endif
endif
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.
endif
deallocate (match)
else
dag_node%f_node(pos)%node%keep = .false.
endif
endif
enddo
endif
enddo
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 sets of ([[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: procedures>>=
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
enddo
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
endif
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)
endif
enddo
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
endif
enddo
endif
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)
endif
enddo
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
endif
enddo
endif
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_nodes]] 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: procedures>>=
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
enddo
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)
endif
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)
endif
!!! 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)
enddo
enddo
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)
enddo
enddo
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)
enddo
enddo
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)
enddo
enddo
end select
end select
endif
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_nodes]] 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. The incoming particle(s) on the other hand should
appear many times (due to copies of the graph when a node can be
resonant or not). In O'Mega's output the first incoming particle
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: procedures>>=
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
endif
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
enddo
feyngraph_set%f_node_list%max_tree_size = feyngraph_set%first%n_nodes
endif
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: procedures>>=
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)
enddo
write (u,fmt='(A)') 'options'
do i=1, dag%n_options
write (u,fmt='(I5,3X,A)') i, char (dag%options(i)%string)
enddo
write (u,fmt='(A)') 'combination'
do i=1, dag%n_combinations
write (u,fmt='(I5,3X,A)') i, char (dag%combination(i)%string)
enddo
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. 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 [[k_nodes]] in the [[k_node_list]] of the [[f_node]] which
will be kept. 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: procedures>>=
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)
endif
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
endif
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)
endif
enddo
deallocate (kingraph_root)
endif
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 and belongs 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
endif
endif
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
endif
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.)
endif
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
enddo
enddo
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.)
endif
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)
endif
endif
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 problematic 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
endif
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
endif
ref_daughter => new_daughter
endif
enddo
else
return
endif
enddo
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 another subroutine.
<<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
endif
t_daughter%inverse_daughter1 => mother
t_daughter%inverse_daughter2 => s_daughter
mother => t_daughter
else
exit
endif
enddo
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
endif
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
enddo
else
n_prt = end_pos - start_pos + 1
endif
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)
endif
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)
endif
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
endif
case ('2')
if (process_type == SCATTERING) then
number_int = n_out_decay + 2
else
number_int = 2
endif
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 result 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
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
endif
if (associated (node%daughter1) .and. associated (node%daughter2)) then
if (.not. (node%daughter1%keep .and. node%daughter2%keep)) then
node%keep = .false.; return
endif
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.
endif
else
call warn_decay (node%particle)
endif
!!! 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
endif
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
endif
endif
!!! 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
endif
endif
!!! 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
endif
endif
endif
!!! 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)
endif
node%ext_mass_sum = node%particle%mass
endif
endif
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
endif
endif
else if (node%is_nonresonant_copy) then
call node_assign_bincode (node)
call node%subtree%add_entry (node)
node%is_nonresonant_copy = .false.
endif
call node_count_specific_properties (node)
if (node%n_off_shell > feyngraph_set%phs_par%off_shell) then
node%keep = .false.
endif
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
endif
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
endif
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
endif
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
endif
endif
endif
end subroutine node_count_specific_properties
@ %def node_count_specific_properties
@ The subroutine [[kingraph_assign_mappings_s]] completes kinematical
calculations for a decay process, which is done by looking at 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 ()
endif
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
endif
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
endif
kingraph%tree = kingraph%root%subtree
endif
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 ()
endif
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
endif
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
endif
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
endif
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
endif
call t_node%subtree%add_entry (t_node)
endif
!!! 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
endif
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
endif
!!! 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
endif
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
endif
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
endif
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
endif
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
endif
where (new_s_node%subtree%bc == new_s_node%bincode)
new_s_node%subtree%mapping = ON_SHELL
endwhere
endif
endif
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
endif
endif
endif
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
kind for decay and scattering processes. In a scattering proces 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
have to be done here.
<<Cascades2: feyngraph: TBP>>=
procedure :: make_inverse_kingraphs => feyngraph_make_inverse_kingraphs
<<Cascades2: procedures>>=
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
enddo
end subroutine feyngraph_make_inverse_kingraphs
@ %def feyngraph_make_inverse_kingraphs
<<Cascades2: feyngraph: TBP>>=
procedure :: compute_mappings => feyngraph_compute_mappings
<<Cascades2: procedures>>=
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)
endif
current => current%next
enddo
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 get 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
because 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
endif
endif
enddo
endif
enddo
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
endif
current => current%next
enddo
endif
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
endif
endif
enddo
endif
enddo
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
endif
current => current%next
enddo
endif
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)
enddo
!$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
enddo
enddo
!$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)
endif
endif
k_entry => k_entry%next
enddo
enddo
deallocate (set)
call compare_list%check_subtree_equivalences(feyngraph_set%model)
call compare_list%final
deallocate (compare_list)
enddo
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 [[feyngraph]] for
which the kinematical calculations 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: procedures>>=
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
endif
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
endif
if (associated (current_grove%next)) then
current_grove => current_grove%next
endif
enddo
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: procedures>>=
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
endif
endif
call grove_list%get_grove (kingraph, grove, preliminary)
if (check) then
call grove%compare_tree%check_kingraph (kingraph, model, preliminary)
endif
if (kingraph%keep) then
if (associated (grove%first)) then
grove%last%grove_next => kingraph
grove%last => kingraph
else
grove%first => kingraph
grove%last => kingraph
endif
endif
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: procedures>>=
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
endif
enddo
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
endif
enddo
endif
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: procedures>>=
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: procedures>>=
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 [[mapping]]s 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
enddo
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
enddo
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
endif
enddo
if (equal) then
kingraph2%keep = .false.
call kingraph2%tree%final ()
else
eqv = .true.
endif
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 ony which would be return 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
endif
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
endif
enddo
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
enddo
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)
endif
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
endif
enddo
deallocate (tmp_bc, tmp_pdg, daughter_bc, daughter_pdg, pdg_match)
if (.not. (kingraph1%keep .and. kingraph2%keep)) exit
endif
endif
enddo
endif
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: procedures>>=
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)
endif
enddo
current_grove => current_grove%next
enddo
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: procedures>>=
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.)
endif
current_graph => next_graph
enddo
current_grove => current_grove%next
enddo
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: procedures>>=
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
enddo
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: procedures>>=
recursive 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)
endif
current => current%grove_next
enddo
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: procedures>>=
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)
endif
enddo
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
enddo
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
endif
enddo
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 has also to be 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: procedures>>=
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)
endif
endif
endif
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.
endif
endif
else
pos = index (node%particle_label, '[') + 1
if (node%particle_label(pos:pos) == '2') then
node%incoming = .true.
t_line_found = .true.
endif
endif
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: procedures>>=
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
endif
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
endif
enddo
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
endif
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)
endif
endif
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: procedures>>=
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
call msg_debug (D_PHASESPACE, "Construct relevant Feynman diagrams from Omega output")
call feyngraph_set%build (u_in)
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. It turns out that the computation for the t-channel
nodes (or t-line) are ways faster than for the s-channel nodes as soon
as the diagrams become big enough. Therefore this part is not
parallelized at all.
<<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
enddo
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 ()
endif
enddo
!$OMP END PARALLEL DO
endif
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)
endif
enddo
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 ()
endif
enddo
endif
do i=1, feyngraph_set%n_graphs
if (set(i)%graph%keep) then
call set(i)%graph%compute_mappings (feyngraph_set)
endif
enddo
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)
endif
enddo
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: procedures>>=
elemental 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.
endif
else
flag = .false.
endif
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: procedures>>=
pure 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
enddo
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
endif
enddo
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
endif
enddo
if (.not. equal) eqv = .true.
endif
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
enddo
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)
endif
endif
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
endif
enddo
deallocate (tmp_bc, tmp_pdg, daughter_bc, daughter_pdg, pdg_match)
if (.not. (subtree1%keep .and. subtree2%keep)) exit
endif
enddo
endif
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: procedures>>=
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: procedures>>=
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: procedures>>=
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
enddo
grove => grove%next
enddo
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)
endif
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 grove list is shared
between the subsets [[fset]] of the [[feyngraph_set]].
<<Cascades2: public>>=
public :: feyngraph_set_generate
<<Cascades2: procedures>>=
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()
enddo
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: procedures>>=
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
endif
kingraph => kingraph%next
enddo
grove => grove%next
enddo
endif
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: procedures>>=
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
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
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: procedures>>=
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
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
enddo
grove => grove%next
enddo
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: procedures>>=
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
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
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
Index: trunk/src/process_integration/process_integration.nw
===================================================================
--- trunk/src/process_integration/process_integration.nw (revision 8157)
+++ trunk/src/process_integration/process_integration.nw (revision 8158)
@@ -1,17773 +1,17843 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: integration and process objects and such
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Integration and Process Objects}
\includemodulegraph{process_integration}
This is the central part of the \whizard\ package. It provides the
functionality for evaluating structure functions, kinematics and matrix
elements, integration and event generation. It combines the various
parts that deal with those tasks individually and organizes the data
transfer between them.
\begin{description}
\item[subevt\_expr]
This enables process observables as (abstract) expressions, to be
evaluated for each process call.
\item[parton\_states]
A [[parton_state_t]] object represents an elementary partonic
interaction. There are two versions: one for the isolated
elementary process, one for the elementary process convoluted with
the structure-function chain. The parton state is an effective
state. It needs not coincide with the seed-kinematics state which is
used in evaluating phase space.
\item[process]
Here, all pieces are combined for the purpose of evaluating the
elementary processes. The whole algorithm is coded in terms of
abstract data types as defined in the appropriate modules: [[prc_core]]
for matrix-element evaluation, [[prc_core_def]] for the associated
configuration and driver, [[sf_base]] for beams and structure-functions,
[[phs_base]] for phase space, and [[mci_base]] for integration and event
generation.
\item[process\_config]
\item[process\_counter]
Very simple object for statistics
\item[process\_mci]
\item[pcm]
\item[kinematics]
\item[instances]
While the above modules set up all static information, the instances
have the changing event data. There are term and process instances but
no component instances.
\item[process\_stacks]
Process stacks collect process objects.
\end{description}
We combine here hard interactions, phase space, and (for scatterings)
structure functions and interfaces them to the integration module.
The process object implements the combination of a fixed beam and
structure-function setup with a number of elementary processes. The
latter are called process components. The process object
represents an entity which is supposedly observable. It should
be meaningful to talk about the cross section of a process.
The individual components of a process are, technically, processes
themselves, but they may have unphysical cross sections which have to
be added for a physical result. Process components may be exclusive
tree-level elementary processes, dipole subtraction term, loop
corrections, etc.
The beam and structure function setup is common to all process
components. Thus, there is only one instance of this part.
The process may be a scattering process or a decay process. In the
latter case, there are no structure functions, and the beam setup
consists of a single particle. Otherwise, the two classes are treated
on the same footing.
Once a sampling point has been chosen, a process determines a set of
partons with a correlated density matrix of quantum numbers. In
general, each sampling point will generate, for each process component,
one or more distinct parton configurations. This is the [[computed]]
state. The computed state is the subject of the multi-channel
integration algorithm.
For NLO computations, it is necessary to project the computed states
onto another set of parton configurations (e.g., by recombining
certain pairs). This is the [[observed]] state. When computing
partonic observables, the information is taken from the observed
state.
For the purpose of event generation, we will later select one parton
configuration from the observed state and collapse the correlated
quantum state. This configuration is then dressed by applying parton
shower, decays and hadronization. The decay chain, in particular,
combines a scattering process with possible subsequent decay processes
on the parton level, which are full-fledged process objects themselves.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process observables}
We define an abstract [[subevt_expr_t]] object as an extension of the
[[subevt_t]] type. The object contains a local variable list, variable
instances (as targets for pointers in the variable list), and evaluation
trees. The evaluation trees reference both the variables and the [[subevt]].
There are two instances of the abstract type: one for process instances, one
for physical events. Both have a common logical expression [[selection]]
which determines whether the object passes user-defined cuts.
The intention is that we fill the [[subevt_t]] base object and compute the
variables once we have evaluated a kinematical phase space point (or a
complete event). We then evaluate the expressions and can use the results in
further calculations.
The [[process_expr_t]] extension contains furthermore scale and weight
expressions. The [[event_expr_t]] extension contains a reweighting-factor
expression and a logical expression for event analysis. In practice, we will
link the variable list of the [[event_obs]] object to the variable list of the
currently active [[process_obs]] object, such that the process variables are
available to both objects. Event variables are meaningful only for physical
events.
Note that there are unit tests, but they are deferred to the
[[expr_tests]] module.
<<[[subevt_expr.f90]]>>=
<<File header>>
module subevt_expr
<<Use kinds>>
<<Use strings>>
use constants, only: zero, one
use io_units
use format_utils, only: write_separator
use diagnostics
use lorentz
use subevents
use variables
use flavors
use quantum_numbers
use interactions
use particles
use expr_base
<<Standard module head>>
<<Subevt expr: public>>
<<Subevt expr: types>>
<<Subevt expr: interfaces>>
contains
<<Subevt expr: procedures>>
end module subevt_expr
@ %def subevt_expr
@
\subsection{Abstract base type}
<<Subevt expr: types>>=
type, extends (subevt_t), abstract :: subevt_expr_t
logical :: subevt_filled = .false.
type(var_list_t) :: var_list
real(default) :: sqrts_hat = 0
integer :: n_in = 0
integer :: n_out = 0
integer :: n_tot = 0
logical :: has_selection = .false.
class(expr_t), allocatable :: selection
contains
<<Subevt expr: subevt expr: TBP>>
end type subevt_expr_t
@ %def subevt_expr_t
@ Output: Base and extended version. We already have a [[write]] routine for
the [[subevt_t]] parent type.
<<Subevt expr: subevt expr: TBP>>=
procedure :: base_write => subevt_expr_write
<<Subevt expr: procedures>>=
subroutine subevt_expr_write (object, unit, pacified)
class(subevt_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Local variables:"
call write_separator (u)
call var_list_write (object%var_list, u, follow_link=.false., &
pacified = pacified)
call write_separator (u)
if (object%subevt_filled) then
call object%subevt_t%write (u, pacified = pacified)
if (object%has_selection) then
call write_separator (u)
write (u, "(1x,A)") "Selection expression:"
call write_separator (u)
call object%selection%write (u)
end if
else
write (u, "(1x,A)") "subevt: [undefined]"
end if
end subroutine subevt_expr_write
@ %def subevt_expr_write
@ Finalizer.
<<Subevt expr: subevt expr: TBP>>=
procedure (subevt_expr_final), deferred :: final
procedure :: base_final => subevt_expr_final
<<Subevt expr: procedures>>=
subroutine subevt_expr_final (object)
class(subevt_expr_t), intent(inout) :: object
call object%var_list%final ()
if (object%has_selection) then
call object%selection%final ()
end if
end subroutine subevt_expr_final
@ %def subevt_expr_final
@
\subsection{Initialization}
Initialization: define local variables and establish pointers.
The common variables are [[sqrts]] (the nominal beam energy, fixed),
[[sqrts_hat]] (the actual energy), [[n_in]], [[n_out]], and [[n_tot]] for
the [[subevt]]. With the exception of [[sqrts]], all are implemented as
pointers to subobjects.
<<Subevt expr: subevt expr: TBP>>=
procedure (subevt_expr_setup_vars), deferred :: setup_vars
procedure :: base_setup_vars => subevt_expr_setup_vars
<<Subevt expr: procedures>>=
subroutine subevt_expr_setup_vars (expr, sqrts)
class(subevt_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%var_list%final ()
call var_list_append_real (expr%var_list, &
var_str ("sqrts"), sqrts, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("sqrts_hat"), expr%sqrts_hat, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("n_in"), expr%n_in, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("n_out"), expr%n_out, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("n_tot"), expr%n_tot, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic = .true.)
end subroutine subevt_expr_setup_vars
@ %def subevt_expr_setup_vars
@ Append the subevent expr (its base-type core) itself to the variable
list, if it is not yet present.
<<Subevt expr: subevt expr: TBP>>=
procedure :: setup_var_self => subevt_expr_setup_var_self
<<Subevt expr: procedures>>=
subroutine subevt_expr_setup_var_self (expr)
class(subevt_expr_t), intent(inout), target :: expr
if (.not. expr%var_list%contains (var_str ("@evt"))) then
call var_list_append_subevt_ptr &
(expr%var_list, &
var_str ("@evt"), expr%subevt_t, &
is_known = expr%subevt_filled, &
locked = .true., verbose = .false., intrinsic=.true.)
end if
end subroutine subevt_expr_setup_var_self
@ %def subevt_expr_setup_var_self
@ Link a variable list to the local one. This could be done event by event,
but before evaluating expressions.
<<Subevt expr: subevt expr: TBP>>=
procedure :: link_var_list => subevt_expr_link_var_list
<<Subevt expr: procedures>>=
subroutine subevt_expr_link_var_list (expr, var_list)
class(subevt_expr_t), intent(inout) :: expr
type(var_list_t), intent(in), target :: var_list
call expr%var_list%link (var_list)
end subroutine subevt_expr_link_var_list
@ %def subevt_expr_link_var_list
@ Compile the selection expression. If there is no expression, the build
method won't allocate the expression object.
<<Subevt expr: subevt expr: TBP>>=
procedure :: setup_selection => subevt_expr_setup_selection
<<Subevt expr: procedures>>=
subroutine subevt_expr_setup_selection (expr, ef_cuts)
class(subevt_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_cuts
call ef_cuts%build (expr%selection)
if (allocated (expr%selection)) then
call expr%setup_var_self ()
call expr%selection%setup_lexpr (expr%var_list)
expr%has_selection = .true.
end if
end subroutine subevt_expr_setup_selection
@ %def subevt_expr_setup_selection
@
\subsection{Evaluation}
Reset to initial state, i.e., mark the [[subevt]] as invalid.
<<Subevt expr: subevt expr: TBP>>=
procedure :: reset_contents => subevt_expr_reset_contents
procedure :: base_reset_contents => subevt_expr_reset_contents
<<Subevt expr: procedures>>=
subroutine subevt_expr_reset_contents (expr)
class(subevt_expr_t), intent(inout) :: expr
expr%subevt_filled = .false.
end subroutine subevt_expr_reset_contents
@ %def subevt_expr_reset_contents
@ Evaluate the selection expression and return the result. There is also a
deferred version: this should evaluate the remaining expressions if the event
has passed.
<<Subevt expr: subevt expr: TBP>>=
procedure :: base_evaluate => subevt_expr_evaluate
<<Subevt expr: procedures>>=
subroutine subevt_expr_evaluate (expr, passed)
class(subevt_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
if (expr%has_selection) then
call expr%selection%evaluate ()
if (expr%selection%is_known ()) then
passed = expr%selection%get_log ()
else
call msg_error ("Evaluate selection expression: result undefined")
passed = .false.
end if
else
passed = .true.
end if
end subroutine subevt_expr_evaluate
@ %def subevt_expr_evaluate
@
\subsection{Implementation for partonic events}
This implementation contains the expressions that we can evaluate for the
partonic process during integration.
<<Subevt expr: public>>=
public :: parton_expr_t
<<Subevt expr: types>>=
type, extends (subevt_expr_t) :: parton_expr_t
integer, dimension(:), allocatable :: i_beam
integer, dimension(:), allocatable :: i_in
integer, dimension(:), allocatable :: i_out
logical :: has_scale = .false.
logical :: has_fac_scale = .false.
logical :: has_ren_scale = .false.
logical :: has_weight = .false.
class(expr_t), allocatable :: scale
class(expr_t), allocatable :: fac_scale
class(expr_t), allocatable :: ren_scale
class(expr_t), allocatable :: weight
contains
<<Subevt expr: parton expr: TBP>>
end type parton_expr_t
@ %def parton_expr_t
@ Finalizer.
<<Subevt expr: parton expr: TBP>>=
procedure :: final => parton_expr_final
<<Subevt expr: procedures>>=
subroutine parton_expr_final (object)
class(parton_expr_t), intent(inout) :: object
call object%base_final ()
if (object%has_scale) then
call object%scale%final ()
end if
if (object%has_fac_scale) then
call object%fac_scale%final ()
end if
if (object%has_ren_scale) then
call object%ren_scale%final ()
end if
if (object%has_weight) then
call object%weight%final ()
end if
end subroutine parton_expr_final
@ %def parton_expr_final
@ Output: continue writing the active expressions, after the common selection
expression.
Note: the [[prefix]] argument is declared in the [[write]] method of the
[[subevt_t]] base type. Here, it is unused.
<<Subevt expr: parton expr: TBP>>=
procedure :: write => parton_expr_write
<<Subevt expr: procedures>>=
subroutine parton_expr_write (object, unit, prefix, pacified)
class(parton_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
character(*), intent(in), optional :: prefix
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
call object%base_write (u, pacified = pacified)
if (object%subevt_filled) then
if (object%has_scale) then
call write_separator (u)
write (u, "(1x,A)") "Scale expression:"
call write_separator (u)
call object%scale%write (u)
end if
if (object%has_fac_scale) then
call write_separator (u)
write (u, "(1x,A)") "Factorization scale expression:"
call write_separator (u)
call object%fac_scale%write (u)
end if
if (object%has_ren_scale) then
call write_separator (u)
write (u, "(1x,A)") "Renormalization scale expression:"
call write_separator (u)
call object%ren_scale%write (u)
end if
if (object%has_weight) then
call write_separator (u)
write (u, "(1x,A)") "Weight expression:"
call write_separator (u)
call object%weight%write (u)
end if
end if
end subroutine parton_expr_write
@ %def parton_expr_write
@ Define variables.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_vars => parton_expr_setup_vars
<<Subevt expr: procedures>>=
subroutine parton_expr_setup_vars (expr, sqrts)
class(parton_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%base_setup_vars (sqrts)
end subroutine parton_expr_setup_vars
@ %def parton_expr_setup_vars
@ Compile the scale expressions. If a pointer is disassociated, there is
no expression.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_scale => parton_expr_setup_scale
procedure :: setup_fac_scale => parton_expr_setup_fac_scale
procedure :: setup_ren_scale => parton_expr_setup_ren_scale
<<Subevt expr: procedures>>=
subroutine parton_expr_setup_scale (expr, ef_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_scale
call ef_scale%build (expr%scale)
if (allocated (expr%scale)) then
call expr%setup_var_self ()
call expr%scale%setup_expr (expr%var_list)
expr%has_scale = .true.
end if
end subroutine parton_expr_setup_scale
subroutine parton_expr_setup_fac_scale (expr, ef_fac_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_fac_scale
call ef_fac_scale%build (expr%fac_scale)
if (allocated (expr%fac_scale)) then
call expr%setup_var_self ()
call expr%fac_scale%setup_expr (expr%var_list)
expr%has_fac_scale = .true.
end if
end subroutine parton_expr_setup_fac_scale
subroutine parton_expr_setup_ren_scale (expr, ef_ren_scale)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_ren_scale
call ef_ren_scale%build (expr%ren_scale)
if (allocated (expr%ren_scale)) then
call expr%setup_var_self ()
call expr%ren_scale%setup_expr (expr%var_list)
expr%has_ren_scale = .true.
end if
end subroutine parton_expr_setup_ren_scale
@ %def parton_expr_setup_scale
@ %def parton_expr_setup_fac_scale
@ %def parton_expr_setup_ren_scale
@ Compile the weight expression.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_weight => parton_expr_setup_weight
<<Subevt expr: procedures>>=
subroutine parton_expr_setup_weight (expr, ef_weight)
class(parton_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_weight
call ef_weight%build (expr%weight)
if (allocated (expr%weight)) then
call expr%setup_var_self ()
call expr%weight%setup_expr (expr%var_list)
expr%has_weight = .true.
end if
end subroutine parton_expr_setup_weight
@ %def parton_expr_setup_weight
@ Filling the partonic state consists of two parts. The first routine
prepares the subevt without assigning momenta. It takes the particles from an
[[interaction_t]]. It needs the indices and flavors for the beam,
incoming, and outgoing particles.
We can assume that the particle content of the subevt does not change.
Therefore, we set the event variables [[n_in]], [[n_out]], [[n_tot]] already
in this initialization step.
<<Subevt expr: parton expr: TBP>>=
procedure :: setup_subevt => parton_expr_setup_subevt
<<Subevt expr: procedures>>=
subroutine parton_expr_setup_subevt (expr, int, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: i_beam, i_in, i_out
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
allocate (expr%i_beam (size (i_beam)))
allocate (expr%i_in (size (i_in)))
allocate (expr%i_out (size (i_out)))
expr%i_beam = i_beam
expr%i_in = i_in
expr%i_out = i_out
call interaction_to_subevt (int, &
expr%i_beam, expr%i_in, expr%i_out, expr%subevt_t)
call subevt_set_pdg_beam (expr%subevt_t, f_beam%get_pdg ())
call subevt_set_pdg_incoming (expr%subevt_t, f_in%get_pdg ())
call subevt_set_pdg_outgoing (expr%subevt_t, f_out%get_pdg ())
call subevt_set_p2_beam (expr%subevt_t, f_beam%get_mass () ** 2)
call subevt_set_p2_incoming (expr%subevt_t, f_in%get_mass () ** 2)
call subevt_set_p2_outgoing (expr%subevt_t, f_out%get_mass () ** 2)
expr%n_in = size (i_in)
expr%n_out = size (i_out)
expr%n_tot = expr%n_in + expr%n_out
end subroutine parton_expr_setup_subevt
@ %def parton_expr_setup_subevt
@ Transfer PDG codes, masses (initalization) and momenta to a
predefined subevent. We use the flavor assignment of the first
branch in the interaction state matrix. Only incoming and outgoing
particles are transferred. Switch momentum sign for incoming
particles.
<<Subevt expr: interfaces>>=
interface interaction_momenta_to_subevt
module procedure interaction_momenta_to_subevt_id
module procedure interaction_momenta_to_subevt_tr
end interface
<<Subevt expr: procedures>>=
subroutine interaction_to_subevt (int, j_beam, j_in, j_out, subevt)
type(interaction_t), intent(in), target :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(out) :: subevt
type(flavor_t), dimension(:), allocatable :: flv
integer :: n_beam, n_in, n_out, i, j
allocate (flv (int%get_n_tot ()))
flv = quantum_numbers_get_flavor (int%get_quantum_numbers (1))
n_beam = size (j_beam)
n_in = size (j_in)
n_out = size (j_out)
call subevt_init (subevt, n_beam + n_in + n_out)
do i = 1, n_beam
j = j_beam(i)
call subevt_set_beam (subevt, i, &
flv(j)%get_pdg (), &
vector4_null, &
flv(j)%get_mass () ** 2)
end do
do i = 1, n_in
j = j_in(i)
call subevt_set_incoming (subevt, n_beam + i, &
flv(j)%get_pdg (), &
vector4_null, &
flv(j)%get_mass () ** 2)
end do
do i = 1, n_out
j = j_out(i)
call subevt_set_outgoing (subevt, n_beam + n_in + i, &
flv(j)%get_pdg (), &
vector4_null, &
flv(j)%get_mass () ** 2)
end do
end subroutine interaction_to_subevt
subroutine interaction_momenta_to_subevt_id (int, j_beam, j_in, j_out, subevt)
type(interaction_t), intent(in) :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(inout) :: subevt
call subevt_set_p_beam (subevt, - int%get_momenta (j_beam))
call subevt_set_p_incoming (subevt, - int%get_momenta (j_in))
call subevt_set_p_outgoing (subevt, int%get_momenta (j_out))
end subroutine interaction_momenta_to_subevt_id
subroutine interaction_momenta_to_subevt_tr &
(int, j_beam, j_in, j_out, lt, subevt)
type(interaction_t), intent(in) :: int
integer, dimension(:), intent(in) :: j_beam, j_in, j_out
type(subevt_t), intent(inout) :: subevt
type(lorentz_transformation_t), intent(in) :: lt
call subevt_set_p_beam &
(subevt, - lt * int%get_momenta (j_beam))
call subevt_set_p_incoming &
(subevt, - lt * int%get_momenta (j_in))
call subevt_set_p_outgoing &
(subevt, lt * int%get_momenta (j_out))
end subroutine interaction_momenta_to_subevt_tr
@ %def interaction_momenta_to_subevt
@ The second part takes the momenta from the interaction object and thus
completes the subevt. The partonic energy can then be computed.
<<Subevt expr: parton expr: TBP>>=
procedure :: fill_subevt => parton_expr_fill_subevt
<<Subevt expr: procedures>>=
subroutine parton_expr_fill_subevt (expr, int)
class(parton_expr_t), intent(inout) :: expr
type(interaction_t), intent(in), target :: int
call interaction_momenta_to_subevt (int, &
expr%i_beam, expr%i_in, expr%i_out, expr%subevt_t)
expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
expr%subevt_filled = .true.
end subroutine parton_expr_fill_subevt
@ %def parton_expr_fill_subevt
@ Evaluate, if the event passes the selection. For absent expressions we take
default values.
<<Subevt expr: parton expr: TBP>>=
procedure :: evaluate => parton_expr_evaluate
<<Subevt expr: procedures>>=
subroutine parton_expr_evaluate &
(expr, passed, scale, fac_scale, ren_scale, weight, scale_forced, force_evaluation)
class(parton_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
real(default), intent(out) :: scale
real(default), intent(out) :: fac_scale
real(default), intent(out) :: ren_scale
real(default), intent(out) :: weight
real(default), intent(in), allocatable, optional :: scale_forced
logical, intent(in), optional :: force_evaluation
logical :: force_scale, force_eval
force_scale = .false.; force_eval = .false.
if (present (scale_forced)) force_scale = allocated (scale_forced)
if (present (force_evaluation)) force_eval = force_evaluation
call expr%base_evaluate (passed)
if (passed .or. force_eval) then
if (force_scale) then
scale = scale_forced
else if (expr%has_scale) then
call expr%scale%evaluate ()
if (expr%scale%is_known ()) then
scale = expr%scale%get_real ()
else
call msg_error ("Evaluate scale expression: result undefined")
scale = zero
end if
else
scale = expr%sqrts_hat
end if
if (force_scale) then
fac_scale = scale_forced
else if (expr%has_fac_scale) then
call expr%fac_scale%evaluate ()
if (expr%fac_scale%is_known ()) then
fac_scale = expr%fac_scale%get_real ()
else
call msg_error ("Evaluate factorization scale expression: &
&result undefined")
fac_scale = zero
end if
else
fac_scale = scale
end if
if (force_scale) then
ren_scale = scale_forced
else if (expr%has_ren_scale) then
call expr%ren_scale%evaluate ()
if (expr%ren_scale%is_known ()) then
ren_scale = expr%ren_scale%get_real ()
else
call msg_error ("Evaluate renormalization scale expression: &
&result undefined")
ren_scale = zero
end if
else
ren_scale = scale
end if
if (expr%has_weight) then
call expr%weight%evaluate ()
if (expr%weight%is_known ()) then
weight = expr%weight%get_real ()
else
call msg_error ("Evaluate weight expression: result undefined")
weight = zero
end if
else
weight = one
end if
else
weight = zero
end if
end subroutine parton_expr_evaluate
@ %def parton_expr_evaluate
@ Return the beam/incoming parton indices.
<<Subevt expr: parton expr: TBP>>=
procedure :: get_beam_index => parton_expr_get_beam_index
procedure :: get_in_index => parton_expr_get_in_index
<<Subevt expr: procedures>>=
subroutine parton_expr_get_beam_index (expr, i_beam)
class(parton_expr_t), intent(in) :: expr
integer, dimension(:), intent(out) :: i_beam
i_beam = expr%i_beam
end subroutine parton_expr_get_beam_index
subroutine parton_expr_get_in_index (expr, i_in)
class(parton_expr_t), intent(in) :: expr
integer, dimension(:), intent(out) :: i_in
i_in = expr%i_in
end subroutine parton_expr_get_in_index
@ %def parton_expr_get_beam_index
@ %def parton_expr_get_in_index
@
\subsection{Implementation for full events}
This implementation contains the expressions that we can evaluate for the
full event. It also contains data that pertain to the event, suitable
for communication with external event formats. These data
simultaneously serve as pointer targets for the variable lists hidden
in the expressions (eval trees).
Squared matrix element and weight values: when reading events from
file, the [[ref]] value is the number in the file, while the [[prc]]
value is the number that we calculate from the momenta in the file,
possibly with different parameters. When generating events the first
time, or if we do not recalculate, the numbers should coincide.
Furthermore, the array of [[alt]] values is copied from an array of
alternative event records. These values should represent calculated
values.
<<Subevt expr: public>>=
public :: event_expr_t
<<Subevt expr: types>>=
type, extends (subevt_expr_t) :: event_expr_t
logical :: has_reweight = .false.
logical :: has_analysis = .false.
class(expr_t), allocatable :: reweight
class(expr_t), allocatable :: analysis
logical :: has_id = .false.
type(string_t) :: id
logical :: has_num_id = .false.
integer :: num_id = 0
logical :: has_index = .false.
integer :: index = 0
logical :: has_sqme_ref = .false.
real(default) :: sqme_ref = 0
logical :: has_sqme_prc = .false.
real(default) :: sqme_prc = 0
logical :: has_weight_ref = .false.
real(default) :: weight_ref = 0
logical :: has_weight_prc = .false.
real(default) :: weight_prc = 0
logical :: has_excess_prc = .false.
real(default) :: excess_prc = 0
integer :: n_alt = 0
logical :: has_sqme_alt = .false.
real(default), dimension(:), allocatable :: sqme_alt
logical :: has_weight_alt = .false.
real(default), dimension(:), allocatable :: weight_alt
contains
<<Subevt expr: event expr: TBP>>
end type event_expr_t
@ %def event_expr_t
@ Finalizer for the expressions.
<<Subevt expr: event expr: TBP>>=
procedure :: final => event_expr_final
<<Subevt expr: procedures>>=
subroutine event_expr_final (object)
class(event_expr_t), intent(inout) :: object
call object%base_final ()
if (object%has_reweight) then
call object%reweight%final ()
end if
if (object%has_analysis) then
call object%analysis%final ()
end if
end subroutine event_expr_final
@ %def event_expr_final
@ Output: continue writing the active expressions, after the common selection
expression.
Note: the [[prefix]] argument is declared in the [[write]] method of the
[[subevt_t]] base type. Here, it is unused.
<<Subevt expr: event expr: TBP>>=
procedure :: write => event_expr_write
<<Subevt expr: procedures>>=
subroutine event_expr_write (object, unit, prefix, pacified)
class(event_expr_t), intent(in) :: object
integer, intent(in), optional :: unit
character(*), intent(in), optional :: prefix
logical, intent(in), optional :: pacified
integer :: u
u = given_output_unit (unit)
call object%base_write (u, pacified = pacified)
if (object%subevt_filled) then
if (object%has_reweight) then
call write_separator (u)
write (u, "(1x,A)") "Reweighting expression:"
call write_separator (u)
call object%reweight%write (u)
end if
if (object%has_analysis) then
call write_separator (u)
write (u, "(1x,A)") "Analysis expression:"
call write_separator (u)
call object%analysis%write (u)
end if
end if
end subroutine event_expr_write
@ %def event_expr_write
@ Initializer. This is required only for the [[sqme_alt]] and
[[weight_alt]] arrays.
<<Subevt expr: event expr: TBP>>=
procedure :: init => event_expr_init
<<Subevt expr: procedures>>=
subroutine event_expr_init (expr, n_alt)
class(event_expr_t), intent(out) :: expr
integer, intent(in), optional :: n_alt
if (present (n_alt)) then
expr%n_alt = n_alt
allocate (expr%sqme_alt (n_alt), source = 0._default)
allocate (expr%weight_alt (n_alt), source = 0._default)
end if
end subroutine event_expr_init
@ %def event_expr_init
@ Define variables. We have the variables of the base type plus
specific variables for full events. There is the event index.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_vars => event_expr_setup_vars
<<Subevt expr: procedures>>=
subroutine event_expr_setup_vars (expr, sqrts)
class(event_expr_t), intent(inout), target :: expr
real(default), intent(in) :: sqrts
call expr%base_setup_vars (sqrts)
call var_list_append_string_ptr (expr%var_list, &
var_str ("$process_id"), expr%id, &
is_known = expr%has_id, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("process_num_id"), expr%num_id, &
is_known = expr%has_num_id, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("sqme"), expr%sqme_prc, &
is_known = expr%has_sqme_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("sqme_ref"), expr%sqme_ref, &
is_known = expr%has_sqme_ref, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_int_ptr (expr%var_list, &
var_str ("event_index"), expr%index, &
is_known = expr%has_index, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("event_weight"), expr%weight_prc, &
is_known = expr%has_weight_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("event_weight_ref"), expr%weight_ref, &
is_known = expr%has_weight_ref, &
locked = .true., verbose = .false., intrinsic = .true.)
call var_list_append_real_ptr (expr%var_list, &
var_str ("event_excess"), expr%excess_prc, &
is_known = expr%has_excess_prc, &
locked = .true., verbose = .false., intrinsic = .true.)
end subroutine event_expr_setup_vars
@ %def event_expr_setup_vars
@ Compile the analysis expression. If the pointer is disassociated, there is
no expression.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_analysis => event_expr_setup_analysis
<<Subevt expr: procedures>>=
subroutine event_expr_setup_analysis (expr, ef_analysis)
class(event_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_analysis
call ef_analysis%build (expr%analysis)
if (allocated (expr%analysis)) then
call expr%setup_var_self ()
call expr%analysis%setup_lexpr (expr%var_list)
expr%has_analysis = .true.
end if
end subroutine event_expr_setup_analysis
@ %def event_expr_setup_analysis
@ Compile the reweight expression.
<<Subevt expr: event expr: TBP>>=
procedure :: setup_reweight => event_expr_setup_reweight
<<Subevt expr: procedures>>=
subroutine event_expr_setup_reweight (expr, ef_reweight)
class(event_expr_t), intent(inout), target :: expr
class(expr_factory_t), intent(in) :: ef_reweight
call ef_reweight%build (expr%reweight)
if (allocated (expr%reweight)) then
call expr%setup_var_self ()
call expr%reweight%setup_expr (expr%var_list)
expr%has_reweight = .true.
end if
end subroutine event_expr_setup_reweight
@ %def event_expr_setup_reweight
@ Store the string or numeric process ID. This should be done during
initialization.
<<Subevt expr: event expr: TBP>>=
procedure :: set_process_id => event_expr_set_process_id
procedure :: set_process_num_id => event_expr_set_process_num_id
<<Subevt expr: procedures>>=
subroutine event_expr_set_process_id (expr, id)
class(event_expr_t), intent(inout) :: expr
type(string_t), intent(in) :: id
expr%id = id
expr%has_id = .true.
end subroutine event_expr_set_process_id
subroutine event_expr_set_process_num_id (expr, num_id)
class(event_expr_t), intent(inout) :: expr
integer, intent(in) :: num_id
expr%num_id = num_id
expr%has_num_id = .true.
end subroutine event_expr_set_process_num_id
@ %def event_expr_set_process_id
@ %def event_expr_set_process_num_id
@ Reset / set the data that pertain to a particular event. The event
index is reset unless explicitly told to keep it.
<<Subevt expr: event expr: TBP>>=
procedure :: reset_contents => event_expr_reset_contents
procedure :: set => event_expr_set
<<Subevt expr: procedures>>=
subroutine event_expr_reset_contents (expr)
class(event_expr_t), intent(inout) :: expr
call expr%base_reset_contents ()
expr%has_sqme_ref = .false.
expr%has_sqme_prc = .false.
expr%has_sqme_alt = .false.
expr%has_weight_ref = .false.
expr%has_weight_prc = .false.
expr%has_weight_alt = .false.
expr%has_excess_prc = .false.
end subroutine event_expr_reset_contents
subroutine event_expr_set (expr, &
weight_ref, weight_prc, weight_alt, &
excess_prc, &
sqme_ref, sqme_prc, sqme_alt)
class(event_expr_t), intent(inout) :: expr
real(default), intent(in), optional :: weight_ref, weight_prc
real(default), intent(in), optional :: excess_prc
real(default), intent(in), optional :: sqme_ref, sqme_prc
real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
if (present (sqme_ref)) then
expr%has_sqme_ref = .true.
expr%sqme_ref = sqme_ref
end if
if (present (sqme_prc)) then
expr%has_sqme_prc = .true.
expr%sqme_prc = sqme_prc
end if
if (present (sqme_alt)) then
expr%has_sqme_alt = .true.
expr%sqme_alt = sqme_alt
end if
if (present (weight_ref)) then
expr%has_weight_ref = .true.
expr%weight_ref = weight_ref
end if
if (present (weight_prc)) then
expr%has_weight_prc = .true.
expr%weight_prc = weight_prc
end if
if (present (weight_alt)) then
expr%has_weight_alt = .true.
expr%weight_alt = weight_alt
end if
if (present (excess_prc)) then
expr%has_excess_prc = .true.
expr%excess_prc = excess_prc
end if
end subroutine event_expr_set
@ %def event_expr_reset_contents event_expr_set
@ Access the subevent index.
<<Subevt expr: event expr: TBP>>=
procedure :: has_event_index => event_expr_has_event_index
procedure :: get_event_index => event_expr_get_event_index
<<Subevt expr: procedures>>=
function event_expr_has_event_index (expr) result (flag)
class(event_expr_t), intent(in) :: expr
logical :: flag
flag = expr%has_index
end function event_expr_has_event_index
function event_expr_get_event_index (expr) result (index)
class(event_expr_t), intent(in) :: expr
integer :: index
if (expr%has_index) then
index = expr%index
else
index = 0
end if
end function event_expr_get_event_index
@ %def event_expr_has_event_index
@ %def event_expr_get_event_index
@ Set/increment the subevent index. Initialize it if necessary.
<<Subevt expr: event expr: TBP>>=
procedure :: set_event_index => event_expr_set_event_index
procedure :: reset_event_index => event_expr_reset_event_index
procedure :: increment_event_index => event_expr_increment_event_index
<<Subevt expr: procedures>>=
subroutine event_expr_set_event_index (expr, index)
class(event_expr_t), intent(inout) :: expr
integer, intent(in) :: index
expr%index = index
expr%has_index = .true.
end subroutine event_expr_set_event_index
subroutine event_expr_reset_event_index (expr)
class(event_expr_t), intent(inout) :: expr
expr%has_index = .false.
end subroutine event_expr_reset_event_index
subroutine event_expr_increment_event_index (expr, offset)
class(event_expr_t), intent(inout) :: expr
integer, intent(in), optional :: offset
if (expr%has_index) then
expr%index = expr%index + 1
else if (present (offset)) then
call expr%set_event_index (offset + 1)
else
call expr%set_event_index (1)
end if
end subroutine event_expr_increment_event_index
@ %def event_expr_set_event_index
@ %def event_expr_increment_event_index
@ Fill the event expression: take the particle data and kinematics
from a [[particle_set]] object.
We allow the particle content to change for each event. Therefore, we set the
event variables each time.
Also increment the event index; initialize it if necessary.
<<Subevt expr: event expr: TBP>>=
procedure :: fill_subevt => event_expr_fill_subevt
<<Subevt expr: procedures>>=
subroutine event_expr_fill_subevt (expr, particle_set)
class(event_expr_t), intent(inout) :: expr
type(particle_set_t), intent(in) :: particle_set
call particle_set%to_subevt (expr%subevt_t)
expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
expr%n_in = subevt_get_n_in (expr%subevt_t)
expr%n_out = subevt_get_n_out (expr%subevt_t)
expr%n_tot = expr%n_in + expr%n_out
expr%subevt_filled = .true.
end subroutine event_expr_fill_subevt
@ %def event_expr_fill_subevt
@ Evaluate, if the event passes the selection. For absent expressions we take
default values.
<<Subevt expr: event expr: TBP>>=
procedure :: evaluate => event_expr_evaluate
<<Subevt expr: procedures>>=
subroutine event_expr_evaluate (expr, passed, reweight, analysis_flag)
class(event_expr_t), intent(inout) :: expr
logical, intent(out) :: passed
real(default), intent(out) :: reweight
logical, intent(out) :: analysis_flag
call expr%base_evaluate (passed)
if (passed) then
if (expr%has_reweight) then
call expr%reweight%evaluate ()
if (expr%reweight%is_known ()) then
reweight = expr%reweight%get_real ()
else
call msg_error ("Evaluate reweight expression: &
&result undefined")
reweight = 0
end if
else
reweight = 1
end if
if (expr%has_analysis) then
call expr%analysis%evaluate ()
if (expr%analysis%is_known ()) then
analysis_flag = expr%analysis%get_log ()
else
call msg_error ("Evaluate analysis expression: &
&result undefined")
analysis_flag = .false.
end if
else
analysis_flag = .true.
end if
end if
end subroutine event_expr_evaluate
@ %def event_expr_evaluate
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Parton states}
A [[parton_state_t]] object contains the effective kinematics and
dynamics of an elementary partonic interaction, with or without the
beam/structure function state included. The type is abstract and has
two distinct extensions. The [[isolated_state_t]] extension describes
the isolated elementary interaction where the [[int_eff]] subobject
contains the complex transition amplitude, exclusive in all quantum
numbers. The particle content and kinematics describe the effective
partonic state. The [[connected_state_t]] extension contains the
partonic [[subevt]] and the expressions for cuts and scales which use
it.
In the isolated state, the effective partonic interaction may either
be identical to the hard interaction, in which case it is just a
pointer to the latter. Or it may involve a rearrangement of partons,
in which case we allocate it explicitly and flag this by
[[int_is_allocated]].
The [[trace]] evaluator contains the absolute square of the effective
transition amplitude matrix, summed over final states. It is also summed over
initial states, depending on the the beam setup allows. The result is used for
integration.
The [[matrix]] evaluator is the counterpart of [[trace]] which is kept
exclusive in all observable quantum numbers. The [[flows]] evaluator is
furthermore exclusive in colors, but neglecting all color interference. The
[[matrix]] and [[flows]] evaluators are filled only for sampling points that
become part of physical events.
Note: It would be natural to make the evaluators allocatable.
However, this causes memory corruption in gfortran 4.6.3. 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 io_units
use format_utils, only: write_separator
use diagnostics
use lorentz
use subevents
use variables
use expr_base
use model_data
use flavors
use helicities
use colors
use quantum_numbers
use state_matrices
use polarizations
use interactions
use evaluators
use beams
use sf_base
use process_constants
use prc_core
use subevt_expr
<<Standard module head>>
<<Parton states: public>>
<<Parton states: types>>
contains
<<Parton states: procedures>>
end module parton_states
@ %def parton_states
@
\subsection{Abstract base type}
The common part are the evaluators, one for the trace (summed over all
quantum numbers), one for the transition matrix (summed only over
unobservable quantum numbers), and one for the flow distribution
(transition matrix without interferences, exclusive in color flow).
<<Parton states: types>>=
type, abstract :: parton_state_t
logical :: has_trace = .false.
logical :: has_matrix = .false.
logical :: has_flows = .false.
type(evaluator_t) :: trace
type(evaluator_t) :: matrix
type(evaluator_t) :: flows
contains
<<Parton states: parton state: TBP>>
end type parton_state_t
@ %def parton_state_t
@ The [[isolated_state_t]] extension contains the [[sf_chain_eff]] object
and the (hard) effective interaction [[int_eff]], separately, both
implemented as a pointer. The evaluators (trace, matrix, flows) apply
to the hard interaction only.
If the effective interaction differs from the hard interaction, the
pointer is allocated explicitly. Analogously for [[sf_chain_eff]].
<<Parton states: public>>=
public :: isolated_state_t
<<Parton states: types>>=
type, extends (parton_state_t) :: isolated_state_t
logical :: sf_chain_is_allocated = .false.
type(sf_chain_instance_t), pointer :: sf_chain_eff => null ()
logical :: int_is_allocated = .false.
type(interaction_t), pointer :: int_eff => null ()
contains
<<Parton states: isolated state: TBP>>
end type isolated_state_t
@ %def isolated_state_t
@ The [[connected_state_t]] extension contains all data that enable
the evaluation of observables for the effective connected state. The
evaluators connect the (effective) structure-function chain and hard
interaction that were kept separate in the [[isolated_state_t]].
The [[flows_sf]] evaluator is an extended copy of the
structure-function
The [[expr]] subobject consists of the [[subevt]], a simple event record,
expressions for cuts etc.\ which refer to this record, and a [[var_list]]
which contains event-specific variables, linked to the process variable
list. Variables used within the expressions are looked up in [[var_list]].
<<Parton states: public>>=
public :: connected_state_t
<<Parton states: types>>=
type, extends (parton_state_t) :: connected_state_t
type(state_flv_content_t) :: state_flv
logical :: has_flows_sf = .false.
type(evaluator_t) :: flows_sf
logical :: has_expr = .false.
type(parton_expr_t) :: expr
contains
<<Parton states: connected state: TBP>>
end type connected_state_t
@ %def connected_state_t
@ Output: each evaluator is written only when it is active. The
[[sf_chain]] is only written if it is explicitly allocated.
<<Parton states: parton state: TBP>>=
procedure :: write => parton_state_write
<<Parton states: procedures>>=
subroutine parton_state_write (state, unit, testflag)
class(parton_state_t), intent(in) :: state
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
select type (state)
class is (isolated_state_t)
if (state%sf_chain_is_allocated) then
call write_separator (u)
call state%sf_chain_eff%write (u)
end if
if (state%int_is_allocated) then
call write_separator (u)
write (u, "(1x,A)") &
"Effective interaction:"
call write_separator (u)
call state%int_eff%basic_write (u, testflag = testflag)
end if
class is (connected_state_t)
if (state%has_flows_sf) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (extension of the beam evaluator &
&with color contractions):"
call write_separator (u)
call state%flows_sf%write (u, testflag = testflag)
end if
end select
if (state%has_trace) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (trace of the squared transition matrix):"
call write_separator (u)
call state%trace%write (u, testflag = testflag)
end if
if (state%has_matrix) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (squared transition matrix):"
call write_separator (u)
call state%matrix%write (u, testflag = testflag)
end if
if (state%has_flows) then
call write_separator (u)
write (u, "(1x,A)") &
"Evaluator (squared color-flow matrix):"
call write_separator (u)
call state%flows%write (u, testflag = testflag)
end if
select type (state)
class is (connected_state_t)
if (state%has_expr) then
call write_separator (u)
call state%expr%write (u)
end if
end select
end subroutine parton_state_write
@ %def parton_state_write
@ Finalize interaction and evaluators, but only if allocated.
<<Parton states: parton state: TBP>>=
procedure :: final => parton_state_final
<<Parton states: procedures>>=
subroutine parton_state_final (state)
class(parton_state_t), intent(inout) :: state
if (state%has_flows) then
call state%flows%final ()
state%has_flows = .false.
end if
if (state%has_matrix) then
call state%matrix%final ()
state%has_matrix = .false.
end if
if (state%has_trace) then
call state%trace%final ()
state%has_trace = .false.
end if
select type (state)
class is (connected_state_t)
if (state%has_flows_sf) then
call state%flows_sf%final ()
state%has_flows_sf = .false.
end if
call state%expr%final ()
class is (isolated_state_t)
if (state%int_is_allocated) then
call state%int_eff%final ()
deallocate (state%int_eff)
state%int_is_allocated = .false.
end if
if (state%sf_chain_is_allocated) then
call state%sf_chain_eff%final ()
end if
end select
end subroutine parton_state_final
@ %def parton_state_final
@
\subsection{Common Initialization}
Initialize the isolated parton state. In this version, the
effective structure-function chain [[sf_chain_eff]] and the effective
interaction [[int_eff]] both are trivial pointers to the seed
structure-function chain and to the hard interaction, respectively.
<<Parton states: isolated state: TBP>>=
procedure :: init => isolated_state_init
<<Parton states: procedures>>=
subroutine isolated_state_init (state, sf_chain, int)
class(isolated_state_t), intent(out) :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(interaction_t), intent(in), target :: int
state%sf_chain_eff => sf_chain
state%int_eff => int
end subroutine isolated_state_init
@ %def isolated_state_init
@
\subsection{Evaluator initialization: isolated state}
Create an evaluator for the trace of the squared transition matrix.
The trace goes over all outgoing quantum numbers. Whether we trace
over incoming quantum numbers other than color, depends on the given
[[qn_mask_in]].
There are two options: explicitly computing the color factor table
([[use_cf]] false; [[nc]] defined), or taking the color factor
table from the hard matrix element data.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_trace => isolated_state_setup_square_trace
<<Parton states: procedures>>=
subroutine isolated_state_setup_square_trace (state, core, &
qn_mask_in, col, keep_fs_flavor)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
!!! Actually need allocatable attribute here fore once because col might
!!! enter the subroutine non-allocated.
integer, intent(in), dimension(:), allocatable :: col
logical, intent(in) :: keep_fs_flavor
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
qn_mask( : data%n_in) = &
quantum_numbers_mask (.false., .true., .false.) &
.or. qn_mask_in
qn_mask(data%n_in + 1 : ) = &
quantum_numbers_mask (.not. keep_fs_flavor, .true., .true.)
if (core%use_color_factors) then
call state%trace%init_square (state%int_eff, qn_mask, &
col_flow_index = data%cf_index, &
col_factor = data%color_factors, &
col_index_hi = col, &
nc = core%nc)
else
call state%trace%init_square (state%int_eff, qn_mask, nc = core%nc)
end if
end associate
state%has_trace = .true.
end subroutine isolated_state_setup_square_trace
@ %def isolated_state_setup_square_trace
@ Setup an identity-evaluator for the trace. This implies that [[me]]
is considered to be a squared amplitude, as for example for BLHA matrix
elements.
<<Parton states: isolated state: TBP>>=
procedure :: setup_identity_trace => isolated_state_setup_identity_trace
<<Parton states: procedures>>=
subroutine isolated_state_setup_identity_trace (state, core, qn_mask_in, &
keep_fs_flavors, keep_colors)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
logical, intent(in), optional :: keep_fs_flavors, keep_colors
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
logical :: fs_flv_flag, col_flag
fs_flv_flag = .true.; col_flag = .true.
if (present(keep_fs_flavors)) fs_flv_flag = .not. keep_fs_flavors
if (present(keep_colors)) col_flag = .not. keep_colors
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
qn_mask( : data%n_in) = &
quantum_numbers_mask (.false., col_flag, .false.) .or. qn_mask_in
qn_mask(data%n_in + 1 : ) = &
quantum_numbers_mask (fs_flv_flag, col_flag, .true.)
end associate
call state%int_eff%set_mask (qn_mask)
call state%trace%init_identity (state%int_eff)
state%has_trace = .true.
end subroutine isolated_state_setup_identity_trace
@ %def isolated_state_setup_identity_trace
@ Setup the evaluator for the transition matrix, exclusive in
helicities where this is requested.
For all unstable final-state particles we keep polarization according to the
applicable decay options. If the process is a decay itself, this applies also
to the initial state.
For all polarized final-state particles, we keep polarization including
off-diagonal entries. We drop helicity completely for unpolarized final-state
particles.
For the initial state, if the particle has not been handled yet, we
apply the provided [[qn_mask_in]] which communicates the beam properties.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_matrix => isolated_state_setup_square_matrix
<<Parton states: procedures>>=
subroutine isolated_state_setup_square_matrix &
(state, core, model, qn_mask_in, col)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
integer, dimension(:), intent(in) :: col
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
logical :: helmask, helmask_hd
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
allocate (flv (data%n_flv))
do i = 1, data%n_in + data%n_out
call flv%init (data%flv_state(i,:), model)
if ((data%n_in == 1 .or. i > data%n_in) &
.and. any (.not. flv%is_stable ())) then
helmask = all (flv%decays_isotropically ())
helmask_hd = all (flv%decays_diagonal ())
qn_mask(i) = quantum_numbers_mask (.false., .true., helmask, &
mask_hd = helmask_hd)
else if (i > data%n_in) then
helmask = all (.not. flv%is_polarized ())
qn_mask(i) = quantum_numbers_mask (.false., .true., helmask)
else
qn_mask(i) = quantum_numbers_mask (.false., .true., .false.) &
.or. qn_mask_in(i)
end if
end do
if (core%use_color_factors) then
call state%matrix%init_square (state%int_eff, qn_mask, &
col_flow_index = data%cf_index, &
col_factor = data%color_factors, &
col_index_hi = col, &
nc = core%nc)
else
call state%matrix%init_square (state%int_eff, &
qn_mask, &
nc = core%nc)
end if
end associate
state%has_matrix = .true.
end subroutine isolated_state_setup_square_matrix
@ %def isolated_state_setup_square_matrix
@ This procedure initializes the evaluator that computes the
contributions to color flows, neglecting color interference.
The incoming-particle mask can be used to sum over incoming flavor.
Helicity handling: see above.
<<Parton states: isolated state: TBP>>=
procedure :: setup_square_flows => isolated_state_setup_square_flows
<<Parton states: procedures>>=
subroutine isolated_state_setup_square_flows (state, core, model, qn_mask_in)
class(isolated_state_t), intent(inout), target :: state
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
logical :: helmask, helmask_hd
associate (data => core%data)
allocate (qn_mask (data%n_in + data%n_out))
allocate (flv (data%n_flv))
do i = 1, data%n_in + data%n_out
call flv%init (data%flv_state(i,:), model)
if ((data%n_in == 1 .or. i > data%n_in) &
.and. any (.not. flv%is_stable ())) then
helmask = all (flv%decays_isotropically ())
helmask_hd = all (flv%decays_diagonal ())
qn_mask(i) = quantum_numbers_mask (.false., .false., helmask, &
mask_hd = helmask_hd)
else if (i > data%n_in) then
helmask = all (.not. flv%is_polarized ())
qn_mask(i) = quantum_numbers_mask (.false., .false., helmask)
else
qn_mask(i) = quantum_numbers_mask (.false., .false., .false.) &
.or. qn_mask_in(i)
end if
end do
call state%flows%init_square (state%int_eff, qn_mask, &
expand_color_flows = .true.)
end associate
state%has_flows = .true.
end subroutine isolated_state_setup_square_flows
@ %def isolated_state_setup_square_flows
@
\subsection{Evaluator initialization: connected state}
Setup 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.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_trace => connected_state_setup_connected_trace
<<Parton states: procedures>>=
subroutine connected_state_setup_connected_trace &
(state, isolated, int, resonant, undo_helicities, &
keep_fs_flavors, 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 :: extended_sf
type(quantum_numbers_mask_t) :: mask
type(interaction_t), pointer :: src_int, beam_int
logical :: reduce, fs_flv_flag
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 = 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 beam_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
@ Setup a matrix evaluator as a product of two evaluators (incoming
state, effective interation). In the intermediate state, color and
helicity is summed over. In the final state, we keep the quantum
numbers which are present in the original evaluators.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_matrix => connected_state_setup_connected_matrix
<<Parton states: procedures>>=
subroutine connected_state_setup_connected_matrix &
(state, isolated, int, resonant, qn_filter_conn)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
type(quantum_numbers_mask_t) :: mask
type(interaction_t), pointer :: src_int
mask = quantum_numbers_mask (.false., .true., .true.)
if (present (int)) then
src_int => int
else
src_int => isolated%sf_chain_eff%get_out_int_ptr ()
end if
call state%matrix%init_product &
(src_int, isolated%matrix, mask, &
qn_filter_conn = qn_filter_conn, &
connections_are_resonant = resonant)
state%has_matrix = .true.
end subroutine connected_state_setup_connected_matrix
@ %def connected_state_setup_connected_matrix
@ Setup a matrix evaluator as a product of two evaluators (incoming
state, effective interation). In the intermediate state, only
helicity is summed over. In the final state, we keep the quantum
numbers which are present in the original evaluators.
If the optional [[int]] interaction is provided, use this for the
first factor in the convolution. Otherwise, use the final interaction
of the stored [[sf_chain]], after creating an intermediate interaction
that includes a correlated color state. We assume that for a
caller-provided [[int]], this is not necessary.
<<Parton states: connected state: TBP>>=
procedure :: setup_connected_flows => connected_state_setup_connected_flows
<<Parton states: procedures>>=
subroutine connected_state_setup_connected_flows &
(state, isolated, int, resonant, qn_filter_conn)
class(connected_state_t), intent(inout), target :: state
type(isolated_state_t), intent(in), target :: isolated
type(interaction_t), intent(in), optional, target :: int
logical, intent(in), optional :: resonant
type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
type(quantum_numbers_mask_t) :: mask
type(interaction_t), pointer :: src_int
mask = quantum_numbers_mask (.false., .false., .true.)
if (present (int)) then
src_int => int
else
src_int => isolated%sf_chain_eff%get_out_int_ptr ()
call state%flows_sf%init_color_contractions (src_int)
state%has_flows_sf = .true.
src_int => state%flows_sf%interaction_t
end if
call state%flows%init_product (src_int, isolated%flows, mask, &
qn_filter_conn = qn_filter_conn, &
connections_are_resonant = resonant)
state%has_flows = .true.
end subroutine connected_state_setup_connected_flows
@ %def connected_state_setup_connected_flows
@ Determine and store the flavor content for the connected state.
This queries the [[matrix]] evaluator component, which should hold the
requested flavor information.
<<Parton states: connected state: TBP>>=
procedure :: setup_state_flv => connected_state_setup_state_flv
<<Parton states: procedures>>=
subroutine connected_state_setup_state_flv (state, n_out_hard)
class(connected_state_t), intent(inout), target :: state
integer, intent(in) :: n_out_hard
call interaction_get_flv_content &
(state%matrix%interaction_t, state%state_flv, n_out_hard)
end subroutine connected_state_setup_state_flv
@ %def connected_state_setup_state_flv
@ Return the current flavor state object.
<<Parton states: connected state: TBP>>=
procedure :: get_state_flv => connected_state_get_state_flv
<<Parton states: procedures>>=
function connected_state_get_state_flv (state) result (state_flv)
class(connected_state_t), intent(in) :: state
type(state_flv_content_t) :: state_flv
state_flv = state%state_flv
end function connected_state_get_state_flv
@ %def connected_state_get_state_flv
@
\subsection{Cuts and expressions}
Set up the [[subevt]] that corresponds to the connected interaction.
The index arrays refer to the interaction.
We assign the particles as follows: the beam particles are the first
two (decay process: one) entries in the trace evaluator. The incoming
partons are identified by their link to the outgoing partons of the
structure-function chain. The outgoing partons are those of the trace
evaluator, which include radiated partons during the
structure-function chain.
<<Parton states: connected state: TBP>>=
procedure :: setup_subevt => connected_state_setup_subevt
<<Parton states: procedures>>=
subroutine connected_state_setup_subevt (state, sf_chain, f_beam, f_in, f_out)
class(connected_state_t), intent(inout), target :: state
type(sf_chain_instance_t), intent(in), target :: sf_chain
type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
integer :: n_beam, n_in, n_out, n_vir, n_tot, i, j
integer, dimension(:), allocatable :: i_beam, i_in, i_out
integer :: sf_out_i
type(interaction_t), pointer :: sf_int
sf_int => sf_chain%get_out_int_ptr ()
n_beam = size (f_beam)
n_in = size (f_in)
n_out = size (f_out)
n_vir = state%trace%get_n_vir ()
n_tot = state%trace%get_n_tot ()
allocate (i_beam (n_beam), i_in (n_in), i_out (n_out))
i_beam = [(i, i = 1, n_beam)]
do j = 1, n_in
sf_out_i = sf_chain%get_out_i (j)
i_in(j) = interaction_find_link &
(state%trace%interaction_t, sf_int, sf_out_i)
end do
i_out = [(i, i = n_vir + 1, n_tot)]
call state%expr%setup_subevt (state%trace%interaction_t, &
i_beam, i_in, i_out, f_beam, f_in, f_out)
state%has_expr = .true.
end subroutine connected_state_setup_subevt
@ %def connected_state_setup_subevt
@ Initialize the variable list specific for this state/term. We insert event
variables ([[sqrts_hat]]) and link the process variable list. The variable
list acquires pointers to subobjects of [[state]], which must therefore have a
[[target]] attribute.
<<Parton states: connected state: TBP>>=
procedure :: setup_var_list => connected_state_setup_var_list
<<Parton states: procedures>>=
subroutine connected_state_setup_var_list (state, process_var_list, beam_data)
class(connected_state_t), intent(inout), target :: state
type(var_list_t), intent(in), target :: process_var_list
type(beam_data_t), intent(in) :: beam_data
call state%expr%setup_vars (beam_data%get_sqrts ())
call state%expr%link_var_list (process_var_list)
end subroutine connected_state_setup_var_list
@ %def connected_state_setup_var_list
@ Allocate the cut expression etc.
<<Parton states: connected state: TBP>>=
procedure :: setup_cuts => connected_state_setup_cuts
procedure :: setup_scale => connected_state_setup_scale
procedure :: setup_fac_scale => connected_state_setup_fac_scale
procedure :: setup_ren_scale => connected_state_setup_ren_scale
procedure :: setup_weight => connected_state_setup_weight
<<Parton states: procedures>>=
subroutine connected_state_setup_cuts (state, ef_cuts)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_cuts
call state%expr%setup_selection (ef_cuts)
end subroutine connected_state_setup_cuts
subroutine connected_state_setup_scale (state, ef_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_scale
call state%expr%setup_scale (ef_scale)
end subroutine connected_state_setup_scale
subroutine connected_state_setup_fac_scale (state, ef_fac_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_fac_scale
call state%expr%setup_fac_scale (ef_fac_scale)
end subroutine connected_state_setup_fac_scale
subroutine connected_state_setup_ren_scale (state, ef_ren_scale)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_ren_scale
call state%expr%setup_ren_scale (ef_ren_scale)
end subroutine connected_state_setup_ren_scale
subroutine connected_state_setup_weight (state, ef_weight)
class(connected_state_t), intent(inout), target :: state
class(expr_factory_t), intent(in) :: ef_weight
call state%expr%setup_weight (ef_weight)
end subroutine connected_state_setup_weight
@ %def connected_state_setup_expressions
@ Reset the expression object: invalidate the subevt.
<<Parton states: connected state: TBP>>=
procedure :: reset_expressions => connected_state_reset_expressions
<<Parton states: procedures>>=
subroutine connected_state_reset_expressions (state)
class(connected_state_t), intent(inout) :: state
if (state%has_expr) call state%expr%reset_contents ()
end subroutine connected_state_reset_expressions
@ %def connected_state_reset_expressions
@
\subsection{Evaluation}
Transfer momenta to the trace evaluator and fill the [[subevt]] with
this effective kinematics, if applicable.
Note: we may want to apply a boost for the [[subevt]].
<<Parton states: parton state: TBP>>=
procedure :: receive_kinematics => parton_state_receive_kinematics
<<Parton states: procedures>>=
subroutine parton_state_receive_kinematics (state)
class(parton_state_t), intent(inout), target :: state
if (state%has_trace) then
call state%trace%receive_momenta ()
select type (state)
class is (connected_state_t)
if (state%has_expr) then
call state%expr%fill_subevt (state%trace%interaction_t)
end if
end select
end if
end subroutine parton_state_receive_kinematics
@ %def parton_state_receive_kinematics
@ Recover kinematics: We assume that the trace evaluator is filled
with momenta. Send those momenta back to the sources, then fill the
variables and subevent as above.
The incoming momenta of the connected state are not connected to the
isolated state but to the beam interaction. Therefore, the incoming
momenta within the isolated state do not become defined, yet.
Instead, we reconstruct the beam (and ISR) momentum configuration.
<<Parton states: parton state: TBP>>=
procedure :: send_kinematics => parton_state_send_kinematics
<<Parton states: procedures>>=
subroutine parton_state_send_kinematics (state)
class(parton_state_t), intent(inout), target :: state
if (state%has_trace) then
call interaction_send_momenta (state%trace%interaction_t)
select type (state)
class is (connected_state_t)
call state%expr%fill_subevt (state%trace%interaction_t)
end select
end if
end subroutine parton_state_send_kinematics
@ %def parton_state_send_kinematics
@ Evaluate the expressions. The routine evaluates first the cut expression.
If the event passes, it evaluates the other expressions. Where no expressions
are defined, default values are inserted.
<<Parton states: connected state: TBP>>=
procedure :: evaluate_expressions => connected_state_evaluate_expressions
<<Parton states: procedures>>=
subroutine connected_state_evaluate_expressions (state, passed, &
scale, fac_scale, ren_scale, weight, scale_forced, force_evaluation)
class(connected_state_t), intent(inout) :: state
logical, intent(out) :: passed
real(default), intent(out) :: scale, fac_scale, ren_scale, weight
real(default), intent(in), allocatable, optional :: scale_forced
logical, intent(in), optional :: force_evaluation
if (state%has_expr) then
call state%expr%evaluate (passed, scale, fac_scale, ren_scale, weight, &
scale_forced, force_evaluation)
end if
end subroutine connected_state_evaluate_expressions
@ %def connected_state_evaluate_expressions
@ Evaluate the structure-function chain, if it is allocated
explicitly. The argument is the factorization scale.
If the chain is merely a pointer, the chain should already be
evaluated at this point.
<<Parton states: isolated state: TBP>>=
procedure :: evaluate_sf_chain => isolated_state_evaluate_sf_chain
<<Parton states: procedures>>=
subroutine isolated_state_evaluate_sf_chain (state, fac_scale)
class(isolated_state_t), intent(inout) :: state
real(default), intent(in) :: fac_scale
if (state%sf_chain_is_allocated) call state%sf_chain_eff%evaluate (fac_scale)
end subroutine isolated_state_evaluate_sf_chain
@ %def isolated_state_evaluate_sf_chain
@ Evaluate the trace.
<<Parton states: parton state: TBP>>=
procedure :: evaluate_trace => parton_state_evaluate_trace
<<Parton states: procedures>>=
subroutine parton_state_evaluate_trace (state)
class(parton_state_t), intent(inout) :: state
if (state%has_trace) call state%trace%evaluate ()
end subroutine parton_state_evaluate_trace
@ %def parton_state_evaluate_trace
<<Parton states: parton state: TBP>>=
procedure :: evaluate_matrix => parton_state_evaluate_matrix
<<Parton states: procedures>>=
subroutine parton_state_evaluate_matrix (state)
class(parton_state_t), intent(inout) :: state
if (state%has_matrix) call state%matrix%evaluate ()
end subroutine parton_state_evaluate_matrix
@ %def parton_state_evaluate_matrix
@ Evaluate the extra evaluators that we need for physical events.
<<Parton states: parton state: TBP>>=
procedure :: evaluate_event_data => parton_state_evaluate_event_data
<<Parton states: procedures>>=
subroutine parton_state_evaluate_event_data (state, only_momenta)
class(parton_state_t), intent(inout) :: state
logical, intent(in), optional :: only_momenta
logical :: only_mom
only_mom = .false.; if (present (only_momenta)) only_mom = only_momenta
select type (state)
type is (connected_state_t)
if (state%has_flows_sf) then
call state%flows_sf%receive_momenta ()
if (.not. only_mom) call state%flows_sf%evaluate ()
end if
end select
if (state%has_matrix) then
call state%matrix%receive_momenta ()
if (.not. only_mom) call state%matrix%evaluate ()
end if
if (state%has_flows) then
call state%flows%receive_momenta ()
if (.not. only_mom) call state%flows%evaluate ()
end if
end subroutine parton_state_evaluate_event_data
@ %def parton_state_evaluate_event_data
@ Normalize the helicity density matrix by its trace, i.e., factor out
the trace and put it into an overall normalization factor. The trace
and flow evaluators are unchanged.
<<Parton states: parton state: TBP>>=
procedure :: normalize_matrix_by_trace => &
parton_state_normalize_matrix_by_trace
<<Parton states: procedures>>=
subroutine parton_state_normalize_matrix_by_trace (state)
class(parton_state_t), intent(inout) :: state
if (state%has_matrix) call state%matrix%normalize_by_trace ()
end subroutine parton_state_normalize_matrix_by_trace
@ %def parton_state_normalize_matrix_by_trace
@
\subsection{Accessing the state}
Three functions return a pointer to the event-relevant interactions.
<<Parton states: parton state: TBP>>=
procedure :: get_trace_int_ptr => parton_state_get_trace_int_ptr
procedure :: get_matrix_int_ptr => parton_state_get_matrix_int_ptr
procedure :: get_flows_int_ptr => parton_state_get_flows_int_ptr
<<Parton states: procedures>>=
function parton_state_get_trace_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_trace) then
ptr => state%trace%interaction_t
else
ptr => null ()
end if
end function parton_state_get_trace_int_ptr
function parton_state_get_matrix_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_matrix) then
ptr => state%matrix%interaction_t
else
ptr => null ()
end if
end function parton_state_get_matrix_int_ptr
function parton_state_get_flows_int_ptr (state) result (ptr)
class(parton_state_t), intent(in), target :: state
type(interaction_t), pointer :: ptr
if (state%has_flows) then
ptr => state%flows%interaction_t
else
ptr => null ()
end if
end function parton_state_get_flows_int_ptr
@ %def parton_state_get_trace_int_ptr
@ %def parton_state_get_matrix_int_ptr
@ %def parton_state_get_flows_int_ptr
@ Return the indices of the beam particles and the outgoing particles within
the trace (and thus, matrix and flows) evaluator, respectively.
<<Parton states: connected state: TBP>>=
procedure :: get_beam_index => connected_state_get_beam_index
procedure :: get_in_index => connected_state_get_in_index
<<Parton states: procedures>>=
subroutine connected_state_get_beam_index (state, i_beam)
class(connected_state_t), intent(in) :: state
integer, dimension(:), intent(out) :: i_beam
call state%expr%get_beam_index (i_beam)
end subroutine connected_state_get_beam_index
subroutine connected_state_get_in_index (state, i_in)
class(connected_state_t), intent(in) :: state
integer, dimension(:), intent(out) :: i_in
call state%expr%get_in_index (i_in)
end subroutine connected_state_get_in_index
@ %def connected_state_get_beam_index
@ %def connected_state_get_in_index
@
<<Parton states: public>>=
public :: refill_evaluator
<<Parton states: procedures>>=
subroutine refill_evaluator (sqme, qn, flv_index, evaluator)
complex(default), intent(in), dimension(:) :: sqme
type(quantum_numbers_t), intent(in), dimension(:,:) :: qn
integer, intent(in), dimension(:), optional :: flv_index
type(evaluator_t), intent(inout) :: evaluator
integer :: i, i_flv
do i = 1, size (sqme)
if (present (flv_index)) then
i_flv = flv_index(i)
else
i_flv = i
end if
call evaluator%add_to_matrix_element (qn(:,i_flv), sqme(i), &
match_only_flavor = .true.)
end do
end subroutine refill_evaluator
@ %def refill_evaluator
@ Return the number of outgoing (hard) particles for the state.
<<Parton states: parton state: TBP>>=
procedure :: get_n_out => parton_state_get_n_out
<<Parton states: procedures>>=
function parton_state_get_n_out (state) result (n)
class(parton_state_t), intent(in), target :: state
integer :: n
n = state%trace%get_n_out ()
end function parton_state_get_n_out
@ %def parton_state_get_n_out
@
\subsection{Unit tests}
<<[[parton_states_ut.f90]]>>=
<<File header>>
module parton_states_ut
use unit_tests
use parton_states_uti
<<Standard module head>>
<<Parton states: public test>>
contains
<<Parton states: test driver>>
end module parton_states_ut
@ %def parton_states_ut
<<[[parton_states_uti.f90]]>>=
<<File header>>
module parton_states_uti
<<Use kinds>>
<<Use strings>>
use constants, only: zero
use numeric_utils
use flavors
use colors
use helicities
use quantum_numbers
use sf_base, only: sf_chain_instance_t
use state_matrices, only: state_matrix_t
use prc_template_me, only: prc_template_me_t
use interactions, only: interaction_t
use models, only: model_t, create_test_model
use parton_states
<<Standard module head>>
<<Parton states: test declarations>>
contains
<<Parton states: tests>>
end module parton_states_uti
@ %def parton_states_uti
@
<<Parton states: public test>>=
public :: parton_states_test
<<Parton states: test driver>>=
subroutine parton_states_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Parton states: execute tests>>
end subroutine parton_states_test
@ %def parton_states_test
@
\subsubsection{Test a simple isolated state}
<<Parton states: execute tests>>=
call test (parton_states_1, "parton_states_1", &
"Create a 2 -> 2 isolated state and compute trace", &
u, results)
<<Parton states: test declarations>>=
public :: parton_states_1
<<Parton states: tests>>=
subroutine parton_states_1 (u)
integer, intent(in) :: u
type(state_matrix_t), allocatable :: state
type(flavor_t), dimension(2) :: flv_in
type(flavor_t), dimension(2) :: flv_out1, flv_out2
type(flavor_t), dimension(4) :: flv_tot
type(helicity_t), dimension(4) :: hel
type(color_t), dimension(4) :: col
integer :: h1, h2, h3, h4
integer :: f
integer :: i
type(quantum_numbers_t), dimension(4) :: qn
type(prc_template_me_t) :: core
type(sf_chain_instance_t), target :: sf_chain
type(interaction_t), target :: int
type(isolated_state_t) :: isolated_state
integer :: n_states = 0
integer, dimension(:), allocatable :: col_flow_index
type(quantum_numbers_mask_t), dimension(2) :: qn_mask
integer, dimension(8) :: i_allowed_states
complex(default), dimension(8) :: me
complex(default) :: me_check_tot, me_check_1, me_check_2, me2
logical :: tmp1, tmp2
type(model_t), pointer :: test_model => null ()
write (u, "(A)") "* Test output: parton_states_1"
write (u, "(A)") "* Purpose: Test the standard parton states"
write (u, "(A)")
call flv_in%init ([11, -11])
call flv_out1%init ([1, -1])
call flv_out2%init ([2, -2])
write (u, "(A)") "* Using incoming flavors: "
call flavor_write_array (flv_in, u)
write (u, "(A)") "* Two outgoing flavor structures: "
call flavor_write_array (flv_out1, u)
call flavor_write_array (flv_out2, u)
write (u, "(A)") "* Initialize state matrix"
allocate (state)
call state%init ()
write (u, "(A)") "* Fill state matrix"
call col(3)%init ([1])
call col(4)%init ([-1])
do f = 1, 2
do h1 = -1, 1, 2
do h2 = -1, 1, 2
do h3 = -1, 1, 2
do h4 = -1, 1, 2
n_states = n_states + 1
call hel%init ([h1, h2, h3, h4], [h1, h2, h3, h4])
if (f == 1) then
flv_tot = [flv_in, flv_out1]
else
flv_tot = [flv_in, flv_out2]
end if
call qn%init (flv_tot, col, hel)
call state%add_state (qn)
end do
end do
end do
end do
end do
!!! Two flavors, one color flow, 2 x 2 x 2 x 2 helicity configurations
!!! -> 32 states.
write (u, "(A)")
write (u, "(A,I2)") "* Generated number of states: ", n_states
call state%freeze ()
!!! Indices of the helicity configurations which are non-zero
i_allowed_states = [6, 7, 10, 11, 22, 23, 26, 27]
me = [cmplx (-1.89448E-5_default, 9.94456E-7_default, default), &
cmplx (-8.37887E-2_default, 4.30842E-3_default, default), &
cmplx (-1.99997E-1_default, -1.01985E-2_default, default), &
cmplx ( 1.79717E-5_default, 9.27038E-7_default, default), &
cmplx (-1.74859E-5_default, 8.78819E-7_default, default), &
cmplx ( 1.67577E-1_default, -8.61683E-3_default, default), &
cmplx ( 2.41331E-1_default, 1.23306E-2_default, default), &
cmplx (-3.59435E-5_default, -1.85407E-6_default, default)]
me_check_tot = cmplx (zero, zero, default)
me_check_1 = cmplx (zero, zero, default)
me_check_2 = cmplx (zero, zero, default)
do i = 1, 8
me2 = me(i) * conjg (me(i))
me_check_tot = me_check_tot + me2
if (i < 5) then
me_check_1 = me_check_1 + me2
else
me_check_2 = me_check_2 + me2
end if
call state%set_matrix_element (i_allowed_states(i), me(i))
end do
!!! Don't forget the color factor
me_check_tot = 3._default * me_check_tot
me_check_1 = 3._default * me_check_1
me_check_2 = 3._default * me_check_2
write (u, "(A)")
write (u, "(A)") "* Setup interaction"
call int%basic_init (2, 0, 2, set_relations = .true.)
call int%set_state_matrix (state)
core%data%n_in = 2; core%data%n_out = 2
core%data%n_flv = 2
allocate (core%data%flv_state (4, 2))
core%data%flv_state (1, :) = [11, 11]
core%data%flv_state (2, :) = [-11, -11]
core%data%flv_state (3, :) = [1, 2]
core%data%flv_state (4, :) = [-1, -2]
core%use_color_factors = .false.
core%nc = 3
write (u, "(A)") "* Init isolated state"
call isolated_state%init (sf_chain, int)
!!! There is only one color flow.
allocate (col_flow_index (n_states)); col_flow_index = 1
call qn_mask%init (.false., .false., .true., mask_cg = .false.)
write (u, "(A)") "* Give a trace to the isolated state"
call isolated_state%setup_square_trace (core, qn_mask, col_flow_index, .false.)
call isolated_state%evaluate_trace ()
write (u, "(A)")
write (u, "(A)", advance = "no") "* Squared matrix element correct: "
write (u, "(L1)") nearly_equal (me_check_tot, &
isolated_state%trace%get_matrix_element (1), rel_smallness = 0.00001_default)
write (u, "(A)") "* Give a matrix to the isolated state"
call create_test_model (var_str ("SM"), test_model)
call isolated_state%setup_square_matrix (core, test_model, qn_mask, col_flow_index)
call isolated_state%evaluate_matrix ()
write (u, "(A)") "* Sub-matrixelements correct: "
tmp1 = nearly_equal (me_check_1, &
isolated_state%matrix%get_matrix_element (1), rel_smallness = 0.00001_default)
tmp2 = nearly_equal (me_check_2, &
isolated_state%matrix%get_matrix_element (2), rel_smallness = 0.00001_default)
write (u, "(A,L1,A,L1)") "* 1: ", tmp1, ", 2: ", tmp2
write (u, "(A)") "* Test output end: parton_states_1"
end subroutine parton_states_1
@ %def parton_states_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process component management}
This module contains tools for managing and combining process
components and matrix-element code and values, acting at a level below
the actual process definition.
\subsection{Abstract base type}
The types introduced here are abstract base types.
<<[[pcm_base.f90]]>>=
<<File header>>
module pcm_base
use diagnostics
use prc_core_def
use prc_core
<<Standard module head>>
<<PCM base: public>>
<<PCM base: types>>
<<PCM base: interfaces>>
contains
<<PCM base: procedures>>
end module pcm_base
@ %def pcm_base
@ This object may hold process and method-specific data, and it should
allocate the corresponding manager instance.
<<PCM base: public>>=
public :: pcm_t
<<PCM base: types>>=
type, abstract :: pcm_t
logical :: initialized = .false.
logical :: has_pdfs = .false.
contains
<<PCM base: pcm: TBP>>
end type pcm_t
@ %def pcm_t
@ The factory method. We use the [[inout]] intent, so calling this
again is an error.
<<PCM base: pcm: TBP>>=
procedure(pcm_allocate_instance), deferred :: allocate_instance
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_allocate_instance (pcm, instance)
import
class(pcm_t), intent(in) :: pcm
class(pcm_instance_t), intent(inout), allocatable :: instance
end subroutine pcm_allocate_instance
end interface
@ %def pcm_allocate_instance
@
<<PCM base: pcm: TBP>>=
procedure(pcm_is_nlo), deferred :: is_nlo
<<PCM base: interfaces>>=
abstract interface
function pcm_is_nlo (pcm) result (is_nlo)
import
logical :: is_nlo
class(pcm_t), intent(in) :: pcm
end function pcm_is_nlo
end interface
@ %def pcm_is_nlo
@
<<PCM base: pcm: TBP>>=
procedure(pcm_final), deferred :: final
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_final (pcm)
import
class(pcm_t), intent(inout) :: pcm
end subroutine pcm_final
end interface
@ %def pcm_final
@
\subsection{Manager instance}
This object deals with the actual (squared) matrix element values.
<<PCM base: public>>=
public :: pcm_instance_t
<<PCM base: types>>=
type, abstract :: pcm_instance_t
class(pcm_t), pointer :: config => null ()
logical :: bad_point = .false.
contains
<<PCM base: pcm instance: TBP>>
end type pcm_instance_t
@ %def pcm_instance_t
@
<<PCM base: pcm instance: TBP>>=
procedure(pcm_instance_final), deferred :: final
<<PCM base: interfaces>>=
abstract interface
subroutine pcm_instance_final (pcm_instance)
import
class(pcm_instance_t), intent(inout) :: pcm_instance
end subroutine pcm_instance_final
end interface
@ %def pcm_instance_final
@
<<PCM base: pcm instance: TBP>>=
procedure :: link_config => pcm_instance_link_config
<<PCM base: procedures>>=
subroutine pcm_instance_link_config (pcm_instance, config)
class(pcm_instance_t), intent(inout) :: pcm_instance
class(pcm_t), intent(in), target :: config
pcm_instance%config => config
end subroutine pcm_instance_link_config
@ %def pcm_instance_link_config
@
<<PCM base: pcm instance: TBP>>=
procedure :: is_valid => pcm_instance_is_valid
<<PCM base: procedures>>=
function pcm_instance_is_valid (pcm_instance) result (valid)
logical :: valid
class(pcm_instance_t), intent(in) :: pcm_instance
valid = .not. pcm_instance%bad_point
end function pcm_instance_is_valid
@ %def pcm_instance_is_valid
@
<<PCM base: pcm instance: TBP>>=
procedure :: set_bad_point => pcm_instance_set_bad_point
<<PCM base: procedures>>=
pure subroutine pcm_instance_set_bad_point (pcm_instance, bad_point)
class(pcm_instance_t), intent(inout) :: pcm_instance
logical, intent(in) :: bad_point
pcm_instance%bad_point = pcm_instance%bad_point .or. bad_point
end subroutine pcm_instance_set_bad_point
@ %def pcm_instance_set_bad_point
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Manager configuration}
This object holds information about the cores used by the components
and allocates the corresponding manager instance.
<<[[core_manager.f90]]>>=
<<File header>>
module core_manager
use format_utils, only: write_integer_array, write_separator
use physics_defs, only: BORN, NLO_REAL
use io_units
use prc_core
<<Standard module head>>
<<Core manager: public>>
<<Core manager: parameters>>
<<Core manager: types>>
contains
<<Core manager: procedures>>
end module core_manager
@ %def core_manager
@ Auxilliary container for polymorphic cores.
<<Core manager: types>>=
type :: generic_core_t
class(prc_core_t), allocatable :: core
end type generic_core_t
@ %def generic_core_t
@
<<Core manager: parameters>>=
integer, parameter, public :: N_MAX_CORES = 100
@
<<Core manager: public>>=
public :: core_manager_t
<<Core manager: types>>=
type :: core_manager_t
integer, dimension(N_MAX_CORES) :: i_component_to_i_core = 0
integer, dimension(N_MAX_CORES) :: i_core = 0
logical, dimension(N_MAX_CORES) :: sub = .false.
character(32), dimension(N_MAX_CORES) :: md5s = ""
integer, dimension(N_MAX_CORES) :: nlo_type
integer :: n_cores = 0
integer, dimension(:), allocatable :: i_core_to_first_i_component
type(generic_core_t), dimension(:), allocatable :: cores
integer :: current_index = 1
contains
<<Core manager: cm: TBP>>
end type core_manager_t
@ %def core_manager_t
@
<<Core manager: cm: TBP>>=
procedure :: register_new => cm_register_new
<<Core manager: procedures>>=
subroutine cm_register_new (cm, nlo_type, i_component, md5sum)
class(core_manager_t), intent(inout) :: cm
integer, intent(in) :: nlo_type, i_component
character(32), intent(in) :: md5sum
cm%nlo_type(cm%current_index) = nlo_type
cm%md5s(cm%current_index) = md5sum
cm%i_component_to_i_core(i_component) = cm%current_index
cm%i_core(cm%current_index) = cm%current_index
cm%current_index = cm%current_index + 1
end subroutine cm_register_new
@ %def cm_register_new
@
<<Core manager: cm: TBP>>=
procedure :: register_existing => cm_register_existing
<<Core manager: procedures>>=
subroutine cm_register_existing (cm, i_existing, i_component)
class(core_manager_t), intent(inout) :: cm
integer, intent(in) :: i_existing, i_component
integer :: i_core
i_core = cm%i_component_to_i_core(i_existing)
cm%i_component_to_i_core(i_component) = i_core
end subroutine cm_register_existing
@ %def cm_register_existing
@
<<Core manager: cm: TBP>>=
procedure :: allocate_core_array => cm_allocate_core_array
<<Core manager: procedures>>=
subroutine cm_allocate_core_array (cm)
class(core_manager_t), intent(inout) :: cm
cm%n_cores = count (cm%i_core > 0)
allocate (cm%cores (cm%n_cores))
end subroutine cm_allocate_core_array
@ %def cm_allocate_core_array
@
<<Core manager: cm: TBP>>=
procedure :: create_i_core_to_first_i_component &
=> core_manager_create_i_core_to_first_i_component
<<Core manager: procedures>>=
subroutine core_manager_create_i_core_to_first_i_component (cm, n_components)
class(core_manager_t), intent(inout) :: cm
integer, intent(in) :: n_components
integer :: i, i_core
allocate (cm%i_core_to_first_i_component (cm%n_cores))
cm%i_core_to_first_i_component = 0
do i = 1, n_components
if (.not. any (cm%i_core_to_first_i_component == i)) then
i_core = cm%i_component_to_i_core (i)
cm%i_core_to_first_i_component(i_core) = i
end if
end do
end subroutine core_manager_create_i_core_to_first_i_component
@ %def core_manager_create_i_core_to_first_i_component
@
<<Core manager: cm: TBP>>=
procedure :: allocate_core => cm_allocate_core
<<Core manager: procedures>>=
subroutine cm_allocate_core (cm, i_core, core_template)
class(core_manager_t), intent(inout) :: cm
integer, intent(in) :: i_core
class(prc_core_t), intent(in) :: core_template
allocate (cm%cores(i_core)%core, source = core_template)
end subroutine cm_allocate_core
@ %def cm_allocate_core
@
<<Core manager: cm: TBP>>=
procedure :: get_core => cm_get_core
<<Core manager: procedures>>=
function cm_get_core (cm, i_core) result (core)
class(prc_core_t), pointer :: core
class(core_manager_t), intent(in), target :: cm
integer, intent(in) :: i_core
core => cm%cores(i_core)%core
end function cm_get_core
@ %def cm_get_core
@
<<Core manager: cm: TBP>>=
procedure :: get_subtraction_core => cm_get_subtraction_core
<<Core manager: procedures>>=
function cm_get_subtraction_core (cm) result (core)
class(prc_core_t), pointer :: core
class(core_manager_t), intent(in), target :: cm
integer :: i
core => null ()
do i = 1, cm%n_cores
if (cm%sub(i)) then
core => cm%cores(i)%core
exit
end if
end do
end function cm_get_subtraction_core
@ %def cm_get_subtraction_core
@
<<Core manager: cm: TBP>>=
procedure :: get_flv_states => cm_get_flv_states
<<Core manager: procedures>>=
pure subroutine cm_get_flv_states (cm, flv_born, flv_real, n_in)
class(core_manager_t), intent(in) :: cm
integer, dimension(:,:), allocatable, intent(out) :: flv_born, flv_real
integer, intent(out) :: n_in
integer :: i
do i = 1, cm%n_cores
if (cm%nlo_type(i) == BORN) then
if (.not. allocated (flv_born)) &
allocate (flv_born (size (cm%cores(i)%core%data%flv_state, 1), &
size (cm%cores(i)%core%data%flv_state, 2)))
flv_born = cm%cores(i)%core%data%flv_state
n_in = cm%cores(i)%core%data%n_in
else if (cm%nlo_type(i) == NLO_REAL) then
if (.not. allocated (flv_real)) &
allocate (flv_real (size (cm%cores(i)%core%data%flv_state, 1), &
size (cm%cores(i)%core%data%flv_state, 2)))
flv_real = cm%cores(i)%core%data%flv_state
n_in = cm%cores(i)%core%data%n_in
end if
end do
end subroutine cm_get_flv_states
@ %def cm_get_flv_states
@
<<Core manager: cm: TBP>>=
procedure :: core_is_radiation => cm_core_is_radiation
<<Core manager: procedures>>=
elemental function cm_core_is_radiation (cm, i_core) result (is_rad)
logical :: is_rad
class(core_manager_t), intent(in) :: cm
integer, intent(in) :: i_core
is_rad = cm%nlo_type(i_core) == NLO_REAL .and. .not. cm%sub(i_core)
end function cm_core_is_radiation
@ %def cm_core_is_radiation
@ Asterisks denote the subtraction components
<<Core manager: cm: TBP>>=
procedure :: write => cm_write
<<Core manager: procedures>>=
subroutine cm_write (cm, unit)
class(core_manager_t), intent(in) :: cm
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
write (u,"(1x,A,I1,A)") "component manager instance with ", cm%n_cores, " cores: "
write (u,"(1x,A)") "(* denotes subtraction cores)"
write (u,"(1x,A,L1)") 'Cores allocated? ', allocated (cm%cores)
do i = 1, cm%n_cores
write (u,"(1x,A,I1,A)", advance = "no") "Core nr. ", i, ": "
if (cm%sub(i)) write (u,"(A)", advance = "no") "*"
call cm%cores(i)%core%write_name (u)
end do
call write_separator (u, 1)
write (u,"(1x,A)") "i_component -> i_core: "
do i = 1, N_MAX_CORES
if (cm%i_component_to_i_core(i) > 0) then
write (u, "(I0, A)", advance = "no") cm%i_component_to_i_core(i), ", "
else
write (u, "(A)") ""
exit
end if
end do
call write_separator (u, 1)
if (allocated (cm%i_core_to_first_i_component)) then
write (u, "(1x,A)") "i_core -> i_component_first: "
call write_integer_array (cm%i_core_to_first_i_component, &
unit = u, n_max = cm%n_cores)
else
write (u, "(1X,A)") "cm%i_core_to_first_i_component: Not allocated."
end if
call write_separator (u, 1)
write (u,"(1x,A)") "nlo type -> i_core: "
call write_integer_array (cm%i_core, unit = u, n_max = cm%n_cores)
call write_separator (u, 1)
write (u, "(1x,A)") "Md5 sums: "
do i = 1, cm%n_cores
write (u, "(A,A)") cm%md5s(i)
end do
call write_separator (u, 1)
end subroutine cm_write
@ %def cm_write
@
<<Core manager: cm: TBP>>=
procedure :: final => cm_final
<<Core manager: procedures>>=
subroutine cm_final (cm)
class(core_manager_t), intent(inout) :: cm
cm%i_component_to_i_core = 0
cm%n_cores = 0
cm%i_core = 0
cm%nlo_type = 0
cm%md5s = ""
cm%current_index = 1
if (allocated (cm%cores)) deallocate (cm%cores)
if (allocated (cm%i_core_to_first_i_component)) &
deallocate (cm%i_core_to_first_i_component)
end subroutine cm_final
@ %def cm_final
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{The process object}
<<[[process.f90]]>>=
<<File header>>
module process
<<Use kinds>>
<<Use strings>>
use io_units
use format_utils, only: write_separator
use constants
use diagnostics
use numeric_utils
use lorentz
use cputime
use md5
use rng_base
use os_interface
use sm_qcd
use integration_results
use mci_base
use flavors
use model_data
use models
use physics_defs
use process_libraries
use process_constants
use particles
use variables
use beam_structures
use beams
use interactions
use pdg_arrays
use expr_base
use sf_base
use sf_mappings
use resonances, only: resonance_history_t, resonance_history_set_t
use prc_test_core, only: test_t
use prc_core, only: prc_core_t
use prc_user_defined, only: prc_user_defined_base_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_base
use phs_wood, only: phs_wood_config_t
use phs_wood, only: EXTENSION_DEFAULT, EXTENSION_DGLAP
use phs_fks, only: phs_fks_config_t, get_filtered_resonance_histories
use blha_config, only: blha_master_t
use nlo_data, only: FKS_DEFAULT, FKS_RESONANCES
use nlo_data, only: fks_template_t
use parton_states, only: connected_state_t
use pcm_base
use pcm
use process_counter
use core_manager
use process_config
use process_mci
<<Standard module head>>
<<Process: public>>
<<Process: types>>
contains
<<Process: procedures>>
end module process
@ %def process
A process object is the workspace for the process instance.
After initialization, its contents are filled by
integration passes which shape the integration grids and compute cross
sections. Processes are set up initially from user-level
configuration data. After calculating integrals and thus developing
integration grid data, the program may use a process
object or a copy of it for the purpose of generating events.
The process object consists of several subobjects with their specific
purposes. The corresponding types are defined below. (Technically,
the subobject type definitions have to come before the process type
definition, but with NOWEB magic we reverse this order here.)
The [[type]] determines whether we are considering a decay or a
scattering process.
The [[meta]] object describes the process and its environment. All
contents become fixed when the object is initialized.
The [[config]] object holds physical and technical configuration data
that have been obtained during process initialization, and which are
common to all process components.
The individual process components are configured in the [[component]]
objects. These objects contain more configuration parameters and
workspace, as needed for the specific process variant.
The [[term]] objects describe parton configurations which are
technically used as phase-space points. Each process component may
split into several terms with distinct kinematics and particle
content. Furthermore, each term may project on a different physical
state, e.g., by particle recombination. The [[term]] object provides
the framework for this projection, for applying cuts, weight, and thus
completing the process calculation.
The [[beam_config]] object describes the incoming particles, either the
decay mother or the scattering beams. It also contains the structure-function
information.
The [[mci_entry]] objects configure a MC input parameter set and integrator,
each. The number of parameters depends on the process component and on the
beam and structure-function setup.
The [[pcm]] component is the process-component manager. This
polymorphic object manages and hides the details of dealing with NLO
processes where several components have to be combined in a
non-trivial way. It also acts as an abstract factory for the
corresponding object in [[process_instance]], which does the actual
work for this matter.
<<Process: public>>=
public :: process_t
<<Process: types>>=
type :: process_t
private
type(process_metadata_t) :: &
meta
type(process_config_data_t) :: &
config
type(process_counter_t) :: &
counter
type(process_component_t), dimension(:), allocatable :: &
component
type(process_term_t), dimension(:), allocatable :: &
term
type(process_beam_config_t) :: &
beam_config
type(process_mci_entry_t), dimension(:), allocatable :: &
mci_entry
class(pcm_t), allocatable :: &
pcm
type(core_manager_t) :: cm
logical, dimension(:), allocatable :: component_selected
contains
<<Process: process: TBP>>
end type process_t
@ %def process_t
@
\subsection{Set of resonant subprocesses}
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
@
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.
<<Process: process: TBP>>=
procedure :: write => process_write
<<Process: procedures>>=
subroutine process_write (process, screen, unit, &
show_all, show_var_list, &
show_os_data, &
show_rng_factory, show_model, show_expressions, &
show_sfchain, &
show_equivalences, show_history, show_histories, &
show_forest, show_x, &
show_subevt, show_evaluators, pacify)
class(process_t), intent(in) :: process
logical, intent(in) :: screen
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_all
logical, intent(in), optional :: show_var_list
logical, intent(in), optional :: show_os_data
logical, intent(in), optional :: show_rng_factory
logical, intent(in), optional :: show_model, show_expressions
logical, intent(in), optional :: show_sfchain
logical, intent(in), optional :: show_equivalences
logical, intent(in), optional :: show_history, show_histories
logical, intent(in), optional :: show_forest, show_x
logical, intent(in), optional :: show_subevt, show_evaluators
logical, intent(in), optional :: pacify
logical :: all
logical :: var_list
logical :: counters
logical :: os_data
logical :: rng_factory, model, expressions
integer :: u, i
u = given_output_unit (unit)
if (present (show_all)) then
all = show_all
else
all = .false.
end if
var_list = .false.
counters = .true.
os_data = .false.
model = .false.
rng_factory = .true.
expressions = .false.
if (present (show_var_list)) then
all = .false.; var_list = show_var_list
end if
if (present (show_os_data)) then
all = .false.; os_data = show_os_data
end if
if (present (show_rng_factory)) then
all = .false.; rng_factory = show_rng_factory
end if
if (present (show_model)) then
all = .false.; model = show_model
end if
if (present (show_expressions)) then
all = .false.; expressions = show_expressions
end if
if (all) then
var_list = .true.
rng_factory = .true.
model = .true.
expressions = .true.
end if
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, var_list, screen)
if (process%meta%type == PRC_UNKNOWN) then
call write_separator (u, 2)
return
else
if (.not. screen) call write_separator (u)
end if
if (screen) return
call process%config%write &
(u, counters, os_data, rng_factory, model, expressions)
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 subroutine process_write
@ %def process_write
@
<<Process: process: TBP>>=
procedure :: write_meta => process_write_meta
<<Process: procedures>>=
subroutine process_write_meta (process, unit, testflag)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
select case (process%meta%type)
case (PRC_UNKNOWN)
write (u, "(1x,A)") "Process instance [undefined]"
return
case (PRC_DECAY)
write (u, "(1x,A)", advance="no") "Process instance [decay]:"
case (PRC_SCATTERING)
write (u, "(1x,A)", advance="no") "Process instance [scattering]:"
case default
call msg_bug ("process_instance_write: undefined process type")
end select
write (u, "(1x,A,A,A)") "'", char (process%meta%id), "'"
write (u, "(3x,A,A,A)") "Run ID = '", char (process%meta%run_id), "'"
if (allocated (process%meta%component_id)) then
write (u, "(3x,A)") "Process components:"
do i = 1, size (process%meta%component_id)
if (process%component_selected (i)) then
write (u, "(3x,'*')", advance="no")
else
write (u, "(4x)", advance="no")
end if
write (u, "(1x,I0,9A)") i, ": '", &
char (process%meta%component_id (i)), "': ", &
char (process%meta%component_description (i))
end do
end if
end subroutine process_write_meta
@ %def process_write_meta
@ Screen output. Write a short account of the process configuration
and the current results. The verbose version lists the components,
the short version just the results.
<<Process: process: TBP>>=
procedure :: show => process_show
<<Process: procedures>>=
subroutine process_show (object, unit, verbose)
class(process_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u
logical :: verb
+ real(default) :: err_percent
u = given_output_unit (unit)
verb = .true.; if (present (verbose)) verb = verbose
if (verb) then
call object%meta%show (u, object%config%model%get_name ())
select case (object%meta%type)
case (PRC_DECAY)
write (u, "(2x,A)", advance="no") "Computed width ="
case (PRC_SCATTERING)
write (u, "(2x,A)", advance="no") "Computed cross section ="
case default; return
end select
else
+ if (object%meta%run_id /= "") then
+ write (u, "('Run',1x,A,':',1x)", advance="no") &
+ char (object%meta%run_id)
+ end if
write (u, "(A)", advance="no") char (object%meta%id)
select case (object%meta%num_id)
case (0)
write (u, "(':')")
case default
write (u, "(1x,'(',I0,')',':')") object%meta%num_id
end select
write (u, "(2x)", advance="no")
end if
if (object%has_integral_tot ()) then
write (u, "(ES14.7,1x,'+-',ES9.2)", advance="no") &
object%get_integral_tot (), object%get_error_tot ()
select case (object%meta%type)
case (PRC_DECAY)
- write (u, "(1x,A)") "GeV"
+ write (u, "(1x,A)", advance="no") "GeV"
case (PRC_SCATTERING)
- write (u, "(1x,A)") "fb"
+ write (u, "(1x,A)", advance="no") "fb "
case default
- write (u, *)
+ 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 (workaround): The finalizer for the [[config_data]] component is not
called. The reason is that this deletes model data local to the process,
but these could be referenced by pointers (flavor objects) from some
persistent event record. Obviously, such side effects should be avoided, but
this requires refactoring the event-handling procedures.
<<Process: process: TBP>>=
procedure :: final => process_final
<<Process: procedures>>=
subroutine process_final (process)
class(process_t), intent(inout) :: process
integer :: i
call process%meta%final ()
! call process%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
call process%cm%final ()
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, the name of the process,
and a run ID. The model is imported via its pointer, and the original pointer
freed.
<<Process: process: TBP>>=
procedure :: init => process_init
<<Process: procedures>>=
subroutine process_init (process, proc_id, run_id, &
lib, os_data, qcd, rng_factory, model)
class(process_t), intent(out) :: process
type(string_t), intent(in) :: proc_id
type(string_t), intent(in) :: run_id
type(process_library_t), intent(in), target :: lib
type(os_data_t), intent(in) :: os_data
type(qcd_t), intent(in) :: qcd
class(rng_factory_t), intent(inout), allocatable :: rng_factory
class(model_data_t), intent(inout), pointer :: model
call msg_debug (D_PROCESS_INTEGRATION, "process_init")
if (.not. lib%is_active ()) then
call msg_bug ("Process init: inactive library not handled yet")
end if
if (.not. lib%contains (proc_id)) then
call msg_fatal ("Process library doesn't contain process '" &
// char (proc_id) // "'")
return
end if
associate (meta => process%meta)
call meta%init (proc_id, run_id, lib)
call process%config%init &
(meta, os_data, qcd, rng_factory, model)
allocate (process%component (meta%n_components))
allocate (process%component_selected (meta%n_components))
process%component_selected = .false.
end associate
if (.not. lib%get_nlo_process (proc_id)) then
allocate (pcm_default_t :: process%pcm)
else
allocate (pcm_nlo_t :: process%pcm)
end if
end subroutine process_init
@ %def process_init
@ Store a snapshot of the common variable list.
<<Process: process: TBP>>=
procedure :: set_var_list => process_set_var_list
<<Process: procedures>>=
subroutine process_set_var_list (process, var_list)
class(process_t), intent(inout) :: process
type(var_list_t), intent(in) :: var_list
call var_list_init_snapshot &
(process%meta%var_list, var_list, follow_link=.true.)
end subroutine process_set_var_list
@ %def process_set_var_list
@
<<Process: process: TBP>>=
procedure :: core_manager_register => process_core_manager_register
procedure :: core_manager_register_default => process_core_manager_register_default
procedure :: core_manager_register_sub => process_core_manager_register_sub
<<Process: procedures>>=
subroutine process_core_manager_register (process, &
nlo_type, i_component, type_string)
class(process_t), intent(inout) :: process
integer, intent(in) :: nlo_type, i_component
type(string_t), intent(in), optional :: type_string
select case (nlo_type)
case (NLO_SUBTRACTION)
call process%core_manager_register_sub (nlo_type, i_component, type_string)
case (NLO_MISMATCH)
process%cm%i_component_to_i_core(i_component) = &
process%get_i_core_nlo_type (NLO_SUBTRACTION, .true.)
case default
call process%core_manager_register_default (nlo_type, i_component, type_string)
end select
end subroutine process_core_manager_register
subroutine process_core_manager_register_sub (process, nlo_type, i_component, type_string)
class(process_t), intent(inout) :: process
integer, intent(in) :: nlo_type, i_component
type(string_t), intent(in), optional :: type_string
character(32) :: md5sum
integer :: i
md5sum = process%get_md5sum_constants (i_component, type_string, nlo_type)
if (any (process%cm%md5s == md5sum)) then
do i = 1, N_MAX_CORES
if (process%cm%i_core(i) == 0) exit
if (md5sum == process%cm%md5s(i)) then
process%cm%sub(i) = .true.
end if
end do
else
process%cm%sub(process%cm%current_index) = .true.
call process%cm%register_new (nlo_type, i_component, md5sum)
end if
end subroutine process_core_manager_register_sub
subroutine process_core_manager_register_default &
(process, nlo_type, i_component, type_string)
class(process_t), intent(inout) :: process
integer, intent(in) :: nlo_type, i_component
type(string_t), intent(in), optional :: type_string
character(32) :: md5sum
integer :: i
logical :: check
md5sum = process%get_md5sum_constants (i_component, type_string, nlo_type)
check = .false.
associate (cm => process%cm)
if (.not. any (cm%md5s == md5sum)) then
call cm%register_new (nlo_type, i_component, md5sum)
else
do i = 1, N_MAX_CORES
if (cm%md5s(i) == md5sum) then
call cm%register_existing (i, i_component)
check = .true.
exit
end if
end do
if (.not. check) call msg_fatal ("Register core: Inconsistency encountered!")
end if
end associate
end subroutine process_core_manager_register_default
@ %def process_core_manager_register
@
<<Process: process: TBP>>=
procedure :: allocate_cm_arrays => process_allocate_cm_arrays
<<Process: procedures>>=
subroutine process_allocate_cm_arrays (process, n_components)
class(process_t), intent(inout) :: process
integer, intent(in) :: n_components
call process%cm%allocate_core_array ()
call process%cm%create_i_core_to_first_i_component (n_components)
end subroutine process_allocate_cm_arrays
@ %def process_allocate_cm_arrays
@
<<Process: process: TBP>>=
procedure :: allocate_core => process_allocate_core
<<Process: procedures>>=
subroutine process_allocate_core (process, i_core, core_template)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_core
class(prc_core_t), intent(in) :: core_template
call process%cm%allocate_core (i_core, core_template)
end subroutine process_allocate_core
@ %def process_allocate_core
@ Initialize the process components, one by one, using a template for
the process core object. The template is taken only for allocating
the correct type; the contents are set by extracting the process entry
from the library.
<<Process: process: TBP>>=
procedure :: init_component => process_init_component
<<Process: procedures>>=
subroutine process_init_component &
(process, index, active, mci_template, phs_config_template)
class(process_t), intent(inout), target :: process
integer, intent(in) :: index
logical, intent(in) :: active
class(mci_t), intent(in), allocatable :: mci_template
class(phs_config_t), intent(in), allocatable :: phs_config_template
type(process_constants_t) :: data
call process%meta%lib%fill_constants (process%meta%id, index, data)
associate (component => process%component(index))
call component%init (index, &
process%meta, process%config, &
active, data, &
mci_template, phs_config_template)
if (.not. component%active .and. &
component%config%get_nlo_type () /= NLO_SUBTRACTION) &
call process%meta%deactivate_component(index)
end associate
end subroutine process_init_component
@ %def process_init_component
@ Determine the process terms for each process component.
<<Process: process: TBP>>=
procedure :: setup_terms => process_setup_terms
<<Process: procedures>>=
subroutine process_setup_terms (process, with_beams)
class(process_t), intent(inout), target :: process
logical, intent(in), optional :: with_beams
class(model_data_t), pointer :: model
integer :: i, j, k, i_term
integer, dimension(:), allocatable :: n_entry
integer :: n_components, n_tot
integer :: i_sub
type(string_t) :: subtraction_method
class(prc_core_t), pointer :: core => null ()
logical :: setup_subtraction_component, singular_real
integer :: nlo_type_to_fetch
i_sub = 0
model => process%config%model
n_components = process%meta%n_components
allocate (n_entry (n_components), source = 0)
do i = 1, n_components
associate (component => process%component(i))
if (component%active) then
n_entry(i) = 1
if (component%get_nlo_type () == NLO_REAL) then
select type (pcm => process%pcm)
type is (pcm_nlo_t)
if (component%component_type /= COMP_REAL_FIN) &
n_entry(i) = n_entry(i) + pcm%region_data%get_n_phs ()
end select
end if
end if
end associate
end do
n_tot = sum (n_entry)
allocate (process%term (n_tot))
k = 0
if (process%is_nlo_calculation ()) then
i_sub = process%component(1)%config%get_associated_subtraction ()
subtraction_method = process%component(i_sub)%config%get_me_method ()
call msg_debug2 (D_PROCESS_INTEGRATION, "process_setup_terms: ", &
subtraction_method)
end if
do i = 1, n_components
associate (component => process%component(i))
if (.not. component%active) cycle
allocate (component%i_term (n_entry(i)))
do j = 1, n_entry(i)
singular_real = component%get_nlo_type () == NLO_REAL &
.and. component%component_type /= COMP_REAL_FIN
setup_subtraction_component = singular_real .and. j == n_entry(i)
i_term = k + j
component%i_term(j) = i_term
if (singular_real) then
process%term(i_term)%i_sub = k + n_entry(i)
else
process%term(i_term)%i_sub = 0
end if
nlo_type_to_fetch = component%get_nlo_type ()
if (nlo_type_to_fetch == NLO_MISMATCH) nlo_type_to_fetch = NLO_SUBTRACTION
process%term(i_term)%i_core = set_i_core (i, nlo_type_to_fetch, &
setup_subtraction_component, component%config%get_def_type_string ())
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)
process%term(i_term)%pcm => process%pcm
if (i_sub > 0) then
select type (pcm => process%pcm)
type is (pcm_nlo_t)
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)
class default
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)
end select
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)
end if
end do
end associate
k = k + n_entry(i)
end do
process%config%n_terms = n_tot
contains
function set_i_core (i_component, nlo_type, sub, type_string) result (i_core)
integer :: i_core
integer, intent(in) :: i_component, nlo_type
logical, intent(in) :: sub
type(string_t), intent(in) :: type_string
character(32) :: md5sum
integer :: index
i_core = 0
md5sum = process%get_md5sum_constants (i_component, type_string, nlo_type)
do index = 1, N_MAX_CORES
if (sub) then
if (process%cm%sub(index)) then
i_core = index
exit
end if
else
i_core = process%cm%i_core(index)
if (process%cm%md5s(index) == md5sum) then
i_core = index
exit
end if
end if
end do
end function set_i_core
end subroutine process_setup_terms
@ %def process_setup_terms
@ Initialize the beam setup. This is the trivial version where the
incoming state of the matrix element coincides with the initial state
of the process. For a scattering process, we need the c.m. energy,
all other variables are set to their default values (no polarization,
lab frame and c.m.\ frame coincide, etc.)
We assume that all components consistently describe a scattering
process, i.e., two incoming particles.
Note: The current layout of the [[beam_data_t]] record requires that the
flavor for each beam is unique. For processes with multiple
flavors in the initial state, one has to set up beams explicitly.
This restriction could be removed by extending the code in the
[[beams]] module.
<<Process: process: TBP>>=
procedure :: setup_beams_sqrts => process_setup_beams_sqrts
<<Process: procedures>>=
subroutine process_setup_beams_sqrts (process, sqrts, beam_structure, i_core)
class(process_t), intent(inout) :: process
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in), optional :: beam_structure
integer, intent(in), optional :: i_core
type(pdg_array_t), dimension(:,:), allocatable :: pdg_in
integer, dimension(2) :: pdg_scattering
type(flavor_t), dimension(2) :: flv_in
integer :: i, i0, ic
class(prc_core_t), pointer :: core => null ()
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%cm%i_component_to_i_core (i)
end if
core => process%cm%get_core (ic)
pdg_in(:,i) = core%data%get_pdg_in ()
if (i0 == 0) i0 = i
end if
end do
do i = 1, process%meta%n_components
if (.not. process%component(i)%active) then
pdg_in(:,i) = pdg_in(:,i0)
end if
end do
if (all (pdg_array_get_length (pdg_in) == 1) .and. &
all (pdg_in(1,:) == pdg_in(1,i0)) .and. &
all (pdg_in(2,:) == pdg_in(2,i0))) then
pdg_scattering = pdg_array_get (pdg_in(:,i0), 1)
call flv_in%init (pdg_scattering, process%config%model)
call process%beam_config%init_scattering (flv_in, sqrts, beam_structure)
else
call msg_fatal ("Setting up process '" // char (process%meta%id) // "':", &
[var_str (" --------------------------------------------"), &
var_str ("Inconsistent initial state. This happens if either "), &
var_str ("several processes with non-matching initial states "), &
var_str ("have been added, or for a single process with an "), &
var_str ("initial state flavor sum. In that case, please set beams "), &
var_str ("explicitly [singling out a flavor / structure function.]")])
end if
end subroutine process_setup_beams_sqrts
@ %def process_setup_beams_sqrts
@ This is the version that applies to decay processes. The energy is the
particle mass, hence no extra argument.
<<Process: process: TBP>>=
procedure :: setup_beams_decay => process_setup_beams_decay
<<Process: procedures>>=
subroutine process_setup_beams_decay (process, rest_frame, beam_structure, i_core)
class(process_t), intent(inout) :: 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
class(prc_core_t), pointer :: core => null ()
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%cm%i_component_to_i_core (i)
end if
core => process%cm%get_core (ic)
pdg_in(:,i) = core%data%get_pdg_in ()
if (i0 == 0) i0 = i
end if
end do
do i = 1, process%meta%n_components
if (.not. process%component(i)%active) then
pdg_in(:,i) = pdg_in(:,i0)
end if
end do
if (all (pdg_array_get_length (pdg_in) == 1) &
.and. all (pdg_in(1,:) == pdg_in(1,i0))) then
pdg_decay = pdg_array_get (pdg_in(:,i0), 1)
call flv_in%init (pdg_decay, process%config%model)
call process%beam_config%init_decay (flv_in, rest_frame, beam_structure)
else
call msg_fatal ("Setting up decay '" &
// char (process%meta%id) // "': decaying particle not unique")
end if
end subroutine process_setup_beams_decay
@ %def process_setup_beams_decay
@ We have to make sure that the masses of the various flavors
in a given position in the particle string coincide.
<<Process: process: TBP>>=
procedure :: check_masses => process_check_masses
<<Process: procedures>>=
subroutine process_check_masses (process)
class(process_t), intent(in) :: process
type(flavor_t), dimension(:), allocatable :: flv
real(default), dimension(:), allocatable :: mass
integer :: i, j
integer :: i_component
class(prc_core_t), pointer :: core => null ()
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
@ For some structure functions we need to get the list of initial
state flavors. This is a two-dimensional array. The first index is
the beam index, the second index is the component index. Each array
element is itself a PDG array object, which consists of the list of
incoming PDG values for this beam and component.
<<Process: process: TBP>>=
procedure :: get_pdg_in => process_get_pdg_in
<<Process: procedures>>=
subroutine process_get_pdg_in (process, pdg_in)
class(process_t), intent(in) :: process
type(pdg_array_t), dimension(:,:), allocatable, intent(out) :: pdg_in
integer :: i, i_core
class(prc_core_t), pointer :: core => null ()
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%cm%i_component_to_i_core (i)
core => process%cm%get_core (i_core)
pdg_in(:,i) = core%data%get_pdg_in ()
end if
end do
core => null ()
end subroutine process_get_pdg_in
@ %def process_get_pdg_in
@ The phase-space configuration object, in case we need it separately.
<<Process: process: TBP>>=
procedure :: get_phs_config => process_get_phs_config
<<Process: procedures>>=
function process_get_phs_config (process, i_component) result (phs_config)
class(phs_config_t), pointer :: phs_config
class(process_t), intent(in), target :: process
integer, intent(in) :: i_component
if (allocated (process%component)) then
phs_config => process%component(i_component)%phs_config
else
phs_config => null ()
end if
end function process_get_phs_config
@ %def process_get_phs_config
@ The resonance history set can be extracted from the phase-space
configuration. However, this is only possible if the default phase-space
method (wood) has been chosen. If [[include_trivial]] is set, we include the
resonance history with no resonances in the set.
<<Process: process: TBP>>=
procedure :: extract_resonance_history_set &
=> process_extract_resonance_history_set
<<Process: procedures>>=
subroutine process_extract_resonance_history_set &
(process, res_set, include_trivial, i_component)
class(process_t), intent(in), target :: process
type(resonance_history_set_t), intent(out) :: res_set
logical, intent(in), optional :: include_trivial
integer, intent(in), optional :: i_component
integer :: i
i = 1; if (present (i_component)) i = i_component
select type (phs_config => process%get_phs_config (i))
class is (phs_wood_config_t)
call phs_config%extract_resonance_history_set (res_set, include_trivial)
class default
call msg_error ("process '" // char (process%get_id ()) &
// "': extract resonance histories: phase-space method must be &
&'wood'. No resonances can be determined.")
end select
end subroutine process_extract_resonance_history_set
@ %def process_extract_resonance_history_set
@ Initialize from a complete beam setup. If the beam setup doesn't
apply directly to the process, choose a fallback option as a straight
scattering or decay process.
<<Process: process: TBP>>=
procedure :: setup_beams_beam_structure => process_setup_beams_beam_structure
<<Process: procedures>>=
subroutine process_setup_beams_beam_structure &
(process, beam_structure, sqrts, decay_rest_frame)
class(process_t), intent(inout) :: process
type(beam_structure_t), intent(in) :: beam_structure
real(default), intent(in) :: sqrts
logical, intent(in), optional :: decay_rest_frame
integer :: n_in
logical :: applies
n_in = process%get_n_in ()
call beam_structure%check_against_n_in (process%get_n_in (), applies)
if (applies) then
call process%beam_config%init_beam_structure &
(beam_structure, sqrts, process%get_model_ptr (), decay_rest_frame)
else if (n_in == 2) then
call process%setup_beams_sqrts (sqrts, beam_structure)
else
call process%setup_beams_decay (decay_rest_frame, beam_structure)
end if
end subroutine process_setup_beams_beam_structure
@ %def process_setup_beams_beam_structure
@ Notify the user about beam setup.
<<Process: process: TBP>>=
procedure :: beams_startup_message => process_beams_startup_message
<<Process: procedures>>=
subroutine process_beams_startup_message (process, unit, beam_structure)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
type(beam_structure_t), intent(in), optional :: beam_structure
call process%beam_config%startup_message (unit, beam_structure)
end subroutine process_beams_startup_message
@ %def process_beams_startup_message
@ We complete the kinematics configuration after the beam setup, but before we
configure the chain of structure functions. The reason is that we need the
total energy [[sqrts]] for the kinematics, but the structure-function setup
requires the number of channels, which depends on the kinematics
configuration. For instance, the kinematics module may return the need for
parameterizing an s-channel resonance.
<<Process: process: TBP>>=
procedure :: configure_phs => process_configure_phs
<<Process: procedures>>=
subroutine process_configure_phs (process, rebuild, ignore_mismatch, &
- combined_integration)
+ 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
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)
+ rebuild, ignore_mismatch, subdir)
class is (pcm_nlo_t)
select case (component%config%get_nlo_type ())
case (BORN, NLO_VIRTUAL, NLO_SUBTRACTION)
call component%configure_phs (sqrts, process%beam_config, &
- rebuild, ignore_mismatch)
+ rebuild, ignore_mismatch, subdir)
call check_and_extend_phs (component)
case (NLO_REAL, NLO_MISMATCH, NLO_DGLAP)
i_born = component%config%get_associated_born ()
if (component%component_type /= COMP_REAL_FIN) &
call check_and_extend_phs (component)
call process%component(i_born)%get_phs_config (phs_config_born)
select type (config => component%phs_config)
type is (phs_fks_config_t)
select type (phs_config_born)
type is (phs_wood_config_t)
config%md5sum_born_config = phs_config_born%md5sum_phs_config
call config%set_born_config (phs_config_born)
call config%set_mode (component%config%get_nlo_type ())
end select
end select
call component%configure_phs (sqrts, &
- process%beam_config, rebuild, ignore_mismatch)
+ 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
logical :: requires_dglap_random_number
if (combined_integration) then
requires_dglap_random_number = any (process%component%get_nlo_type () == NLO_DGLAP)
select type (phs_config => component%phs_config)
class is (phs_wood_config_t)
if (requires_dglap_random_number) then
call phs_config%set_extension_mode (EXTENSION_DGLAP)
else
call phs_config%set_extension_mode (EXTENSION_DEFAULT)
end if
call phs_config%increase_n_par ()
end select
end if
end subroutine check_and_extend_phs
end subroutine process_configure_phs
@ %def process_configure_phs
@
<<Process: process: TBP>>=
procedure :: print_phs_startup_message => process_print_phs_startup_message
<<Process: procedures>>=
subroutine process_print_phs_startup_message (process)
class(process_t), intent(in) :: process
integer :: i_component
do i_component = 1, process%meta%n_components
associate (component => process%component(i_component))
if (component%active) then
call component%phs_config%startup_message ()
end if
end associate
end do
end subroutine process_print_phs_startup_message
@ %def process_print_phs_startup_message
@ Insert the structure-function configuration data. First allocate the
storage, then insert data one by one. The third procedure declares a
mapping (of the MC input parameters) for a specific channel and
structure-function combination.
We take the number of channels from the corresponding entry in the
[[config_data]] section.
Otherwise, these a simple wrapper routines. The extra level in the
call tree may allow for simple addressing of multiple concurrent beam
configurations, not implemented currently.
If we do not want structure functions, we simply do not call those procedures.
<<Process: process: TBP>>=
procedure :: init_sf_chain => process_init_sf_chain
generic :: set_sf_channel => set_sf_channel_single
procedure :: set_sf_channel_single => process_set_sf_channel
generic :: set_sf_channel => set_sf_channel_array
procedure :: set_sf_channel_array => process_set_sf_channel_array
<<Process: procedures>>=
subroutine process_init_sf_chain (process, sf_config, sf_trace_file)
class(process_t), intent(inout) :: process
type(sf_config_t), dimension(:), intent(in) :: sf_config
type(string_t), intent(in), optional :: sf_trace_file
type(string_t) :: file
if (present (sf_trace_file)) then
if (sf_trace_file /= "") then
file = sf_trace_file
else
file = process%get_id () // "_sftrace.dat"
end if
call process%beam_config%init_sf_chain (sf_config, file)
else
call process%beam_config%init_sf_chain (sf_config)
end if
end subroutine process_init_sf_chain
subroutine process_set_sf_channel (process, c, sf_channel)
class(process_t), intent(inout) :: process
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: sf_channel
call process%beam_config%set_sf_channel (c, sf_channel)
end subroutine process_set_sf_channel
subroutine process_set_sf_channel_array (process, sf_channel)
class(process_t), intent(inout) :: process
type(sf_channel_t), dimension(:), intent(in) :: sf_channel
integer :: c
call process%beam_config%allocate_sf_channels (size (sf_channel))
do c = 1, size (sf_channel)
call process%beam_config%set_sf_channel (c, sf_channel(c))
end do
end subroutine process_set_sf_channel_array
@ %def process_init_sf_chain
@ %def process_set_sf_channel
@ Notify about the structure-function setup.
<<Process: process: TBP>>=
procedure :: sf_startup_message => process_sf_startup_message
<<Process: procedures>>=
subroutine process_sf_startup_message (process, sf_string, unit)
class(process_t), intent(in) :: process
type(string_t), intent(in) :: sf_string
integer, intent(in), optional :: unit
call process%beam_config%sf_startup_message (sf_string, unit)
end subroutine process_sf_startup_message
@ %def process_sf_startup_message
@ As soon as both the kinematics configuration and the
structure-function setup are complete, we match parameterizations
(channels) for both. The matching entries are (re)set in the
[[component]] phase-space configuration, while the structure-function
configuration is left intact.
<<Process: process: TBP>>=
procedure :: collect_channels => process_collect_channels
<<Process: procedures>>=
subroutine process_collect_channels (process, coll)
class(process_t), intent(inout) :: process
type(phs_channel_collection_t), intent(inout) :: coll
integer :: i
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%active) &
call component%collect_channels (coll)
end associate
end do
end subroutine process_collect_channels
@ %def process_collect_channels
@ Independently, we should be able to check if any component doesn't
contain phase-space parameters. Such a process can only be integrated
if there are structure functions.
<<Process: process: TBP>>=
procedure :: contains_trivial_component => process_contains_trivial_component
<<Process: procedures>>=
function process_contains_trivial_component (process) result (flag)
class(process_t), intent(in) :: process
logical :: flag
integer :: i
flag = .true.
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%active) then
if (component%get_n_phs_par () == 0) return
end if
end associate
end do
flag = .false.
end function process_contains_trivial_component
@ %def process_contains_trivial_component
@
<<Process: process: TBP>>=
procedure :: get_master_component => process_get_master_component
<<Process: procedures>>=
function process_get_master_component (process, i_mci) result (i_component)
integer :: i_component
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer :: i
i_component = 0
do i = 1, size (process%component)
if (process%component(i)%i_mci == i_mci) then
i_component = i
return
end if
end do
end function process_get_master_component
@ %def process_get_master_component
@ Determine the MC parameter set structure and the MCI configuration for each
process component. We need data from the structure-function and phase-space
setup, so those should be complete before this is called. We also
make a random-number generator instance for each MCI group.
<<Process: process: TBP>>=
procedure :: setup_mci => process_setup_mci
<<Process: procedures>>=
subroutine process_setup_mci (process, combined_integration)
class(process_t), intent(inout) :: process
logical, intent(in), optional :: combined_integration
integer :: n_mci, i_mci
integer :: i
logical :: uses_real_partition
call msg_debug (D_PROCESS_INTEGRATION, "process_setup_mci")
n_mci = 0
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%needs_mci_entry (combined_integration) .and. &
component%config%get_nlo_type () /= NLO_SUBTRACTION) then
n_mci = n_mci + 1
component%i_mci = n_mci
end if
call msg_debug (D_PROCESS_INTEGRATION, &
"component%component_type", component%component_type)
end associate
end do
process%config%n_mci = n_mci
if (.not. allocated (process%config%rng_factory)) &
call msg_bug ("Process setup: rng factory not allocated")
allocate (process%mci_entry (n_mci))
i_mci = 0
uses_real_partition = &
any (process%component%component_type == COMP_REAL_FIN)
call msg_debug (D_PROCESS_INTEGRATION, "uses_real_partition", &
uses_real_partition)
do i = 1, process%meta%n_components
associate (component => process%component(i))
if (component%needs_mci_entry (combined_integration) .and. &
component%config%get_nlo_type () /= NLO_SUBTRACTION) then
i_mci = i_mci + 1
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%set_combined_integration (combined_integration)
if (uses_real_partition) then
if (component%component_type == COMP_REAL_FIN) then
mci_entry%real_partition_type = REAL_FINITE
else
mci_entry%real_partition_type = REAL_SINGULAR
end if
end if
call mci_entry%init (process%meta%type, &
i_mci, i, component, process%beam_config%n_sfpar, &
process%config%rng_factory)
end associate
end if
end associate
end do
do i_mci = 1, size (process%mci_entry)
call process%mci_entry(i_mci)%set_parameters (process%meta%var_list)
end do
end subroutine process_setup_mci
@ %def process_setup_mci
@ Set cuts. This is a parse node, namely the right-hand side of the [[cut]]
assignment. When creating an instance, we compile this into an evaluation
tree. The parse node may be null.
<<Process: process: TBP>>=
procedure :: set_cuts => process_set_cuts
<<Process: procedures>>=
subroutine process_set_cuts (process, ef_cuts)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_cuts
allocate (process%config%ef_cuts, source = ef_cuts)
end subroutine process_set_cuts
@ %def process_set_cuts
@ Analogously for the other expressions.
<<Process: process: TBP>>=
procedure :: set_scale => process_set_scale
procedure :: set_fac_scale => process_set_fac_scale
procedure :: set_ren_scale => process_set_ren_scale
procedure :: set_weight => process_set_weight
<<Process: procedures>>=
subroutine process_set_scale (process, ef_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_scale
allocate (process%config%ef_scale, source = ef_scale)
end subroutine process_set_scale
subroutine process_set_fac_scale (process, ef_fac_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_fac_scale
allocate (process%config%ef_fac_scale, source = ef_fac_scale)
end subroutine process_set_fac_scale
subroutine process_set_ren_scale (process, ef_ren_scale)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_ren_scale
allocate (process%config%ef_ren_scale, source = ef_ren_scale)
end subroutine process_set_ren_scale
subroutine process_set_weight (process, ef_weight)
class(process_t), intent(inout) :: process
class(expr_factory_t), intent(in) :: ef_weight
allocate (process%config%ef_weight, source = ef_weight)
end subroutine process_set_weight
@ %def process_set_scale
@ %def process_set_fac_scale
@ %def process_set_ren_scale
@ %def process_set_weight
@
\subsubsection{MD5 sum}
The MD5 sum of the process object should reflect the state completely,
including integration results. It is used for checking the integrity
of event files. This global checksum includes checksums for the
various parts. In particular, the MCI object receives a checksum that
includes the configuration of all configuration parts relevant for an
individual integration. This checksum is used for checking the
integrity of integration grids.
We do not need MD5 sums for the process terms, since these are
generated from the component definitions.
<<Process: process: TBP>>=
procedure :: compute_md5sum => process_compute_md5sum
<<Process: procedures>>=
subroutine process_compute_md5sum (process)
class(process_t), intent(inout) :: process
integer :: i
call process%config%compute_md5sum ()
do i = 1, process%config%n_components
associate (component => process%component(i))
if (component%active) then
call component%compute_md5sum ()
end if
end associate
end do
call process%beam_config%compute_md5sum ()
do i = 1, process%config%n_mci
call process%mci_entry(i)%compute_md5sum &
(process%config, process%component, process%beam_config)
end do
end subroutine process_compute_md5sum
@ %def process_compute_md5sum
@
<<Process: process: TBP>>=
procedure :: sampler_test => process_sampler_test
<<Process: procedures>>=
subroutine process_sampler_test (process, sampler, n_calls, i_mci)
class(process_t), intent(inout) :: process
class(mci_sampler_t), intent(inout) :: sampler
integer, intent(in) :: n_calls, i_mci
call process%mci_entry(i_mci)%sampler_test (sampler, n_calls)
end subroutine process_sampler_test
@ %def process_sampler_test
@ The finalizer should be called after all integration passes have been
completed. It will, for instance, write a summary of the integration
results.
[[integrate_dummy]] does a ``dummy'' integration in the sense that
nothing is done but just empty integration results appended.
<<Process: process: TBP>>=
procedure :: final_integration => process_final_integration
procedure :: integrate_dummy => process_integrate_dummy
<<Process: procedures>>=
subroutine process_final_integration (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
call process%mci_entry(i_mci)%final_integration ()
end subroutine process_final_integration
subroutine process_integrate_dummy (process)
class(process_t), intent(inout) :: process
type(integration_results_t) :: results
integer :: u_log
u_log = logfile_unit ()
call results%init (process%meta%type)
call results%display_init (screen = .true., unit = u_log)
call results%new_pass ()
call results%record (1, 0, 0._default, 0._default, 0._default)
call results%display_final ()
end subroutine process_integrate_dummy
@ %def process_final_integration
@ %def process_integrate_dummy
@
<<Process: process: TBP>>=
procedure :: integrate => process_integrate
<<Process: procedures>>=
subroutine process_integrate (process, i_mci, mci_work, &
mci_sampler, n_it, n_calls, adapt_grids, adapt_weights, final, &
pacify, nlo_type)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
integer, intent(in) :: n_it, n_calls
logical, intent(in), optional :: adapt_grids, adapt_weights
logical, intent(in), optional :: final
logical, intent(in), optional :: pacify
integer, intent(in), optional :: nlo_type
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%integrate (mci_work%mci, mci_sampler, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify, &
nlo_type = nlo_type)
call mci_entry%results%display_pass (pacify)
end associate
end subroutine process_integrate
@ %def process_integrate
@
<<Process: process: TBP>>=
procedure :: generate_weighted_event => process_generate_weighted_event
<<Process: procedures>>=
subroutine process_generate_weighted_event (process, i_mci, mci_work, &
mci_sampler, keep_failed_events)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
logical, intent(in) :: keep_failed_events
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%generate_weighted_event (mci_work%mci, &
mci_sampler, keep_failed_events)
end associate
end subroutine process_generate_weighted_event
@ %def process_generate_weighted_event
<<Process: process: TBP>>=
procedure :: generate_unweighted_event => process_generate_unweighted_event
<<Process: procedures>>=
subroutine process_generate_unweighted_event (process, i_mci, &
mci_work, mci_sampler)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(mci_work_t), intent(inout) :: mci_work
class(mci_sampler_t), intent(inout) :: mci_sampler
associate (mci_entry => process%mci_entry(i_mci))
call mci_entry%generate_unweighted_event &
(mci_work%mci, mci_sampler)
end associate
end subroutine process_generate_unweighted_event
@ %def process_generate_unweighted_event
@ Display the final results for the sum of all components. (This is useful,
obviously, only if there is more than one component.)
<<Process: process: TBP>>=
procedure :: display_summed_results => process_display_summed_results
<<Process: procedures>>=
subroutine process_display_summed_results (process, pacify)
class(process_t), intent(inout) :: process
logical, intent(in) :: pacify
type(integration_results_t) :: results
integer :: u_log
u_log = logfile_unit ()
call results%init (process%meta%type)
call results%display_init (screen = .true., unit = u_log)
call results%new_pass ()
call results%record (1, 0, &
process%get_integral (), &
process%get_error (), &
process%get_efficiency (), suppress = pacify)
select type (pcm => process%pcm)
class is (pcm_nlo_t)
!!! Check that Born integral is there
if (process%component_can_be_integrated (1)) then
call results%record_correction (process%get_correction (), &
process%get_correction_error ())
end if
end select
call results%display_final ()
end subroutine process_display_summed_results
@ %def process_display_summed_results
@ Run LaTeX/Metapost to generate a ps/pdf file for the integration
history. We (re)write the driver file -- just in case it has been
missed before -- then we compile it.
<<Process: process: TBP>>=
procedure :: display_integration_history => &
process_display_integration_history
<<Process: procedures>>=
subroutine process_display_integration_history &
(process, i_mci, filename, os_data, eff_reset)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(string_t), intent(in) :: filename
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: eff_reset
call integration_results_write_driver &
(process%mci_entry(i_mci)%results, filename, eff_reset)
call integration_results_compile_driver &
(process%mci_entry(i_mci)%results, filename, os_data)
end subroutine process_display_integration_history
@ %def subroutine process_display_integration_history
@ Write a complete logfile (with hardcoded name based on the process ID).
We do not write internal data.
<<Process: process: TBP>>=
procedure :: write_logfile => process_write_logfile
<<Process: procedures>>=
subroutine process_write_logfile (process, i_mci, filename)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(string_t), intent(in) :: filename
type(time_t) :: time
integer :: unit, u
unit = free_unit ()
open (unit = unit, file = char (filename), action = "write", &
status = "replace")
u = given_output_unit (unit)
write (u, "(A)") repeat ("#", 79)
call process%meta%write (u, .false., .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)
write (u, "(A)") "Variable list:"
call var_list_write (process%meta%var_list, u)
write (u, "(A)") repeat ("#", 79)
close (u)
end subroutine process_write_logfile
@ %def process_write_logfile
@ Display the quantum-number combinations of the process components, and their
current status (allowed or switched off).
<<Process: process: TBP>>=
procedure :: write_state_summary => process_write_state_summary
<<Process: procedures>>=
subroutine process_write_state_summary (process, unit)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
integer :: i, i_component, u
u = given_output_unit (unit)
do i = 1, size (process%term)
call write_separator (u)
i_component = process%term(i)%i_component
if (i_component /= 0) then
call process%term(i)%write_state_summary &
(process%get_core_term(i), unit)
end if
end do
end subroutine process_write_state_summary
@ %def process_write_state_summary
@ Prepare event generation for the specified MCI entry. This implies, in
particular, checking the phase-space file.
<<Process: process: TBP>>=
procedure :: prepare_simulation => process_prepare_simulation
<<Process: procedures>>=
subroutine process_prepare_simulation (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
call process%mci_entry(i_mci)%prepare_simulation ()
end subroutine process_prepare_simulation
@ %def process_prepare_simulation
@
\subsubsection{Retrieve process data}
Tell whether integral (and error) are known.
<<Process: process: TBP>>=
generic :: has_integral => has_integral_tot, has_integral_mci
procedure :: has_integral_tot => process_has_integral_tot
procedure :: has_integral_mci => process_has_integral_mci
<<Process: procedures>>=
function process_has_integral_mci (process, i_mci) result (flag)
logical :: flag
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
if (allocated (process%mci_entry)) then
flag = process%mci_entry(i_mci)%has_integral ()
else
flag = .false.
end if
end function process_has_integral_mci
function process_has_integral_tot (process) result (flag)
logical :: flag
class(process_t), intent(in) :: process
integer :: i, j, i_component
if (allocated (process%mci_entry)) then
flag = .true.
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated (i_component)) &
flag = flag .and. process%mci_entry(i)%has_integral ()
end do
end do
else
flag = .false.
end if
end function process_has_integral_tot
@ %def process_has_integral
@
Return the current integral and error obtained by the integrator [[i_mci]].
<<Process: process: TBP>>=
generic :: get_integral => get_integral_tot, get_integral_mci
generic :: get_error => get_error_tot, get_error_mci
generic :: get_efficiency => get_efficiency_tot, get_efficiency_mci
procedure :: get_integral_tot => process_get_integral_tot
procedure :: get_integral_mci => process_get_integral_mci
procedure :: get_error_tot => process_get_error_tot
procedure :: get_error_mci => process_get_error_mci
procedure :: get_efficiency_tot => process_get_efficiency_tot
procedure :: get_efficiency_mci => process_get_efficiency_mci
<<Process: procedures>>=
function process_get_integral_mci (process, i_mci) result (integral)
real(default) :: integral
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integral = process%mci_entry(i_mci)%get_integral ()
end function process_get_integral_mci
function process_get_error_mci (process, i_mci) result (error)
real(default) :: error
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
error = process%mci_entry(i_mci)%get_error ()
end function process_get_error_mci
function process_get_efficiency_mci (process, i_mci) result (efficiency)
real(default) :: efficiency
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
efficiency = process%mci_entry(i_mci)%get_efficiency ()
end function process_get_efficiency_mci
function process_get_integral_tot (process) result (integral)
real(default) :: integral
class(process_t), intent(in) :: process
integer :: i, j, i_component
integral = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) &
integral = integral + process%mci_entry(i)%get_integral ()
end do
end do
end if
end function process_get_integral_tot
function process_get_error_tot (process) result (error)
real(default) :: variance
class(process_t), intent(in) :: process
real(default) :: error
integer :: i, j, i_component
variance = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) &
variance = variance + process%mci_entry(i)%get_error () ** 2
end do
end do
end if
error = sqrt (variance)
end function process_get_error_tot
function process_get_efficiency_tot (process) result (efficiency)
real(default) :: efficiency
class(process_t), intent(in) :: process
real(default) :: den, eff, int
integer :: i, j, i_component
den = zero
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
do j = 1, size (process%mci_entry(i)%i_component)
i_component = process%mci_entry(i)%i_component(j)
if (process%component_can_be_integrated(i_component)) then
int = process%get_integral (i)
if (int > 0) then
eff = process%mci_entry(i)%get_efficiency ()
if (eff > 0) then
den = den + int / eff
else
efficiency = 0
return
end if
end if
end if
end do
end do
end if
if (den > 0) then
efficiency = process%get_integral () / den
else
efficiency = 0
end if
end function process_get_efficiency_tot
@ %def process_get_integral process_get_efficiency
@ Let us call the ratio of the LO and the NLO result $\iota = I_{LO} / I_{NLO}$. Then
usual error propagation gives
\begin{equation*}
\sigma_{\iota}^2 = \left(\frac{\partial \iota}{\partial I_{LO}}\right)^2 \sigma_{I_{LO}}^2
+ \left(\frac{\partial \iota}{\partial I_{NLO}}\right)^2 \sigma_{I_{NLO}}^2
= \frac{I_{NLO}^2\sigma_{I_{LO}}^2}{I_{LO}^4} + \frac{\sigma_{I_{NLO}}^2}{I_{LO}^2}.
\end{equation*}
<<Process: process: TBP>>=
procedure :: get_correction => process_get_correction
procedure :: get_correction_error => process_get_correction_error
<<Process: procedures>>=
function process_get_correction (process) result (ratio)
real(default) :: ratio
class(process_t), intent(in) :: process
integer :: i_mci
real(default) :: int_born, int_nlo
int_nlo = zero
int_born = process%mci_entry(1)%get_integral ()
do i_mci = 2, size (process%mci_entry)
if (process%component_can_be_integrated (i_mci)) &
int_nlo = int_nlo + process%mci_entry(i_mci)%get_integral ()
end do
ratio = int_nlo / int_born * 100
end function process_get_correction
function process_get_correction_error (process) result (error)
real(default) :: error
class(process_t), intent(in) :: process
real(default) :: int_born, sum_int_nlo
real(default) :: err_born, err2
integer :: i_mci
sum_int_nlo = zero; err2 = zero
int_born = process%mci_entry(1)%get_integral ()
err_born = process%mci_entry(1)%get_error ()
do i_mci = 2, size (process%mci_entry)
if (process%component_can_be_integrated (i_mci)) then
sum_int_nlo = sum_int_nlo + process%mci_entry(i_mci)%get_integral ()
err2 = err2 + process%mci_entry(i_mci)%get_error()**2
end if
end do
error = sqrt (err2 / int_born**2 + sum_int_nlo**2 * err_born**2 / int_born**4) * 100
end function process_get_correction_error
@ %def process_get_correction process_get_correction_error
@
<<Process: process: TBP>>=
procedure :: lab_is_cm_frame => process_lab_is_cm_frame
<<Process: procedures>>=
pure function process_lab_is_cm_frame (process) result (cm_frame)
logical :: cm_frame
class(process_t), intent(in) :: process
cm_frame = process%beam_config%lab_is_cm_frame
end function process_lab_is_cm_frame
@ %def process_lab_is_cm_frame
@
<<Process: process: TBP>>=
procedure :: get_component_ptr => process_get_component_ptr
<<Process: procedures>>=
function process_get_component_ptr (process, i) result (component)
type(process_component_t), pointer :: component
class(process_t), intent(in), target :: process
integer, intent(in) :: i
component => process%component(i)
end function process_get_component_ptr
@ %def process_get_component_ptr
@
<<Process: process: TBP>>=
procedure :: get_qcd_ptr => process_get_qcd_ptr
<<Process: procedures>>=
function process_get_qcd_ptr (process) result (qcd)
type(qcd_t), pointer :: qcd
class(process_t), intent(in), target :: process
qcd => process%config%qcd
end function process_get_qcd_ptr
@ %def process_get_qcd_ptr
@
<<Process: process: TBP>>=
generic :: get_component_type => get_component_type_single
procedure :: get_component_type_single => process_get_component_type_single
<<Process: procedures>>=
elemental function process_get_component_type_single &
(process, i_component) result (comp_type)
integer :: comp_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
comp_type = process%component(i_component)%component_type
end function process_get_component_type_single
@ %def process_get_component_type_single
@
<<Process: process: TBP>>=
generic :: get_component_type => get_component_type_all
procedure :: get_component_type_all => process_get_component_type_all
<<Process: procedures>>=
function process_get_component_type_all &
(process) result (comp_type)
integer, dimension(:), allocatable :: comp_type
class(process_t), intent(in) :: process
allocate (comp_type (size (process%component)))
comp_type = process%component%component_type
end function process_get_component_type_all
@ %def process_get_component_type_all
@
<<Process: process: TBP>>=
procedure :: get_component_i_terms => process_get_component_i_terms
<<Process: procedures>>=
function process_get_component_i_terms (process, i_component) result (i_term)
integer, dimension(:), allocatable :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
allocate (i_term (size (process%component(i_component)%i_term)))
i_term = process%component(i_component)%i_term
end function process_get_component_i_terms
@ %def process_get_component_i_terms
@
<<Process: process: TBP>>=
procedure :: get_n_allowed_born => process_get_n_allowed_born
<<Process: procedures>>=
function process_get_n_allowed_born (process, i_born) result (n_born)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_born
integer :: n_born
n_born = process%term(i_born)%n_allowed
end function process_get_n_allowed_born
@ %def process_get_n_allowed_born
@ Workaround getter. Would be better to remove this.
<<Process: process: TBP>>=
procedure :: get_pcm_ptr => process_get_pcm_ptr
<<Process: procedures>>=
function process_get_pcm_ptr (process) result (pcm)
class(pcm_t), pointer :: pcm
class(process_t), intent(in), target :: process
pcm => process%pcm
end function process_get_pcm_ptr
@ %def process_get_pcm_ptr
<<Process: process: TBP>>=
generic :: component_can_be_integrated => component_can_be_integrated_single
generic :: component_can_be_integrated => component_can_be_integrated_all
procedure :: component_can_be_integrated_single => process_component_can_be_integrated_single
<<Process: procedures>>=
function process_component_can_be_integrated_single (process, i_component) &
result (active)
logical :: active
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
logical :: combined_integration
select type (pcm => process%pcm)
type is (pcm_nlo_t)
combined_integration = pcm%settings%combined_integration
class default
combined_integration = .false.
end select
associate (component => process%component(i_component))
active = component%can_be_integrated ()
if (combined_integration) &
active = active .and. component%component_type <= COMP_MASTER
end associate
end function process_component_can_be_integrated_single
@ %def process_component_can_be_integrated_single
@
<<Process: process: TBP>>=
procedure :: component_can_be_integrated_all => process_component_can_be_integrated_all
<<Process: procedures>>=
function process_component_can_be_integrated_all (process) result (val)
logical, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
integer :: i
allocate (val (size (process%component)))
do i = 1, size (process%component)
val(i) = process%component_can_be_integrated (i)
end do
end function process_component_can_be_integrated_all
@ %def process_component_can_be_integrated_all
@
<<Process: process: TBP>>=
procedure :: reset_selected_cores => process_reset_selected_cores
<<Process: procedures>>=
pure subroutine process_reset_selected_cores (process)
class(process_t), intent(inout) :: process
process%component_selected = .false.
end subroutine process_reset_selected_cores
@ %def process_reset_selected_cores
@
<<Process: process: TBP>>=
procedure :: select_components => process_select_components
<<Process: procedures>>=
pure subroutine process_select_components (process, indices)
class(process_t), intent(inout) :: process
integer, dimension(:), intent(in) :: indices
process%component_selected(indices) = .true.
end subroutine process_select_components
@ %def process_select_components
@
<<Process: process: TBP>>=
procedure :: component_is_selected => process_component_is_selected
<<Process: procedures>>=
pure function process_component_is_selected (process, index) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: index
val = process%component_selected(index)
end function process_component_is_selected
@ %def process_component_is_selected
@
<<Process: process: TBP>>=
procedure :: get_coupling_powers => process_get_coupling_powers
<<Process: procedures>>=
pure subroutine process_get_coupling_powers (process, alpha_power, alphas_power)
class(process_t), intent(in) :: process
integer, intent(out) :: alpha_power, alphas_power
call process%component(1)%config%get_coupling_powers (alpha_power, alphas_power)
end subroutine process_get_coupling_powers
@ %def process_get_coupling_powers
@
<<Process: process: TBP>>=
procedure :: get_real_component => process_get_real_component
<<Process: procedures>>=
function process_get_real_component (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer :: i_component
type(process_component_def_t), pointer :: config => null ()
i_real = 0
do i_component = 1, size (process%component)
config => process%get_component_def_ptr (i_component)
if (config%get_nlo_type () == NLO_REAL) then
i_real = i_component
exit
end if
end do
end function process_get_real_component
@ %def process_get_real_component
@
<<Process: process: TBP>>=
procedure :: extract_active_component_mci => process_extract_active_component_mci
<<Process: procedures>>=
function process_extract_active_component_mci (process) result (i_active)
integer :: i_active
class(process_t), intent(in) :: process
integer :: i_mci, j, i_component, n_active
call count_n_active ()
if (n_active /= 1) i_active = 0
contains
subroutine count_n_active ()
n_active = 0
do i_mci = 1, size (process%mci_entry)
associate (mci_entry => process%mci_entry(i_mci))
do j = 1, size (mci_entry%i_component)
i_component = mci_entry%i_component(j)
associate (component => process%component (i_component))
if (component%can_be_integrated ()) then
i_active = i_mci
n_active = n_active + 1
end if
end associate
end do
end associate
end do
end subroutine count_n_active
end function process_extract_active_component_mci
@ %def process_extract_active_component_mci
@
<<Process: process: TBP>>=
procedure :: needs_extra_code => process_needs_extra_code
<<Process: procedures>>=
function process_needs_extra_code (process, only_blha) result (val)
logical :: val
class(process_t), intent(in) :: process
logical, intent(in), optional :: only_blha
integer :: i
logical :: skip_other
type(process_component_def_t), pointer :: config => null ()
val = .false.; skip_other = .false.
if (present (only_blha)) skip_other = only_blha
associate (cm => process%cm)
do i = 1, cm%n_cores
config => process%get_component_def_ptr &
(cm%i_core_to_first_i_component(i))
if (config%can_be_integrated () .or. cm%sub(i)) then
select type (core => cm%cores(i)%core)
type is (prc_recola_t)
if (skip_other) cycle
val = .true.
exit
class is (prc_blha_t)
val = .true.
exit
class is (prc_threshold_t)
if (skip_other) cycle
val = .true.
exit
end select
end if
end do
end associate
end function process_needs_extra_code
@ %def process_needs_extra_code
@
<<Process: process: TBP>>=
procedure :: uses_real_partition => process_uses_real_partition
<<Process: procedures>>=
function process_uses_real_partition (process) result (val)
logical :: val
class(process_t), intent(in) :: process
val = any (process%mci_entry%real_partition_type /= REAL_FULL)
end function process_uses_real_partition
@ %def process_uses_real_partition
@ Return the MD5 sums that summarize the process component
definitions. These values should be independent of parameters, beam
details, expressions, etc. They can be used for checking the
integrity of a process when reusing an old event file.
<<Process: process: TBP>>=
procedure :: get_md5sum_prc => process_get_md5sum_prc
<<Process: procedures>>=
function process_get_md5sum_prc (process, i_component) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
if (process%component(i_component)%active) then
md5sum = process%component(i_component)%config%get_md5sum ()
else
md5sum = ""
end if
end function process_get_md5sum_prc
@ %def process_get_md5sum_prc
@ Return the MD5 sums that summarize the state of the MCI integrators.
These values should encode all process data, integration and phase
space configuration, etc., and the integration results. They can thus
be used for checking the integrity of an event-generation setup when
reusing an old event file.
<<Process: process: TBP>>=
procedure :: get_md5sum_mci => process_get_md5sum_mci
<<Process: procedures>>=
function process_get_md5sum_mci (process, i_mci) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
md5sum = process%mci_entry(i_mci)%get_md5sum ()
end function process_get_md5sum_mci
@ %def process_get_md5sum_mci
@ Return the MD5 sum of the process configuration. This should encode
the process setup, data, and expressions, but no integration results.
<<Process: process: TBP>>=
procedure :: get_md5sum_cfg => process_get_md5sum_cfg
<<Process: procedures>>=
function process_get_md5sum_cfg (process) result (md5sum)
character(32) :: md5sum
class(process_t), intent(in) :: process
md5sum = process%config%md5sum
end function process_get_md5sum_cfg
@ %def process_get_md5sum_cfg
@ Initialize the [[i_core]]th core.
<<Process: process: TBP>>=
procedure :: init_cores => process_init_cores
<<Process: procedures>>=
subroutine process_init_cores (process)
class(process_t), intent(inout) :: process
integer :: i_core, i_component
type(process_component_def_t), pointer :: config
do i_core = 1, process%get_n_cores ()
i_component = process%cm%i_core_to_first_i_component (i_core)
config => process%meta%lib%get_component_def_ptr (process%meta%id, i_component)
associate (core => process%cm%cores(i_core)%core)
call core%init (config%get_core_def_ptr (), &
process%meta%lib, process%meta%id, i_component)
end associate
end do
end subroutine process_init_cores
@ %def process_init_core
@
<<Process: process: TBP>>=
procedure :: init_blha_cores => process_init_blha_cores
<<Process: procedures>>=
subroutine process_init_blha_cores (process, blha_template, var_list)
class(process_t), intent(inout) :: process
type(blha_template_t), intent(inout) :: blha_template
type(var_list_t), intent(in), pointer :: var_list
integer :: i_core, n_in, n_legs, n_flv, n_hel, f
type(flavor_t) :: flv_in
do i_core = 1, process%get_n_cores ()
call fill_blha_template (process%get_nlo_type (i_core))
select type (core => process%cm%cores(i_core)%core)
class is (prc_blha_t)
select type (pcm => process%pcm)
type is (pcm_nlo_t)
n_in = pcm%region_data%get_n_in ()
if (process%cm%core_is_radiation(i_core)) then
n_legs = pcm%region_data%get_n_legs_real ()
n_flv = pcm%region_data%get_n_flv_real ()
else
n_legs = pcm%region_data%get_n_legs_born ()
n_flv = pcm%region_data%get_n_flv_born ()
end if
class default
n_in = core%data%n_in
n_legs = core%data%get_n_tot ()
n_flv = core%data%n_flv
end select
n_hel = 1
if (blha_template%include_polarizations) then
do f = 1, core%data%n_in
call flv_in%init (core%data%flv_state (f, 1), process%config%model)
n_hel = n_hel * flv_in%get_multiplicity ()
end do
end if
call core%init_blha (blha_template, n_in, n_legs, n_flv, n_hel)
call core%init_driver (process%config%os_data)
end select
call blha_template%reset ()
end do
contains
function needs_entry (me_method) result (val)
logical :: val
type(string_t), intent(in) :: me_method
val = char (me_method) == 'gosam' .or. char (me_method) == 'openloops'
end function needs_entry
subroutine fill_blha_template (nlo_type)
integer, intent(in) :: nlo_type
type(string_t) :: method, born_me_method, real_tree_me_method, &
loop_me_method, correlation_me_method, dglap_me_method
method = var_list%get_sval (var_str ("$method"))
born_me_method = var_list%get_sval (var_str ("$born_me_method"))
if (born_me_method == "") born_me_method = method
real_tree_me_method = var_list%get_sval (var_str ("$real_tree_me_method"))
if (real_tree_me_method == "") real_tree_me_method = method
loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
if (loop_me_method == "") loop_me_method = method
correlation_me_method = var_list%get_sval (var_str ("$correlation_me_method"))
if (correlation_me_method == "") correlation_me_method = method
dglap_me_method = var_list%get_sval (var_str ("$dglap_me_method"))
if (dglap_me_method == "") dglap_me_method = method
call msg_debug2 (D_PROCESS_INTEGRATION, &
"process_init_blha_cores: method = ", method)
call msg_debug2 (D_PROCESS_INTEGRATION, &
"process_init_blha_cores: method = ", born_me_method)
call msg_debug2 (D_PROCESS_INTEGRATION, &
"process_init_blha_cores: method = ", loop_me_method)
call msg_debug2 (D_PROCESS_INTEGRATION, &
"process_init_blha_cores: method = ", correlation_me_method)
call msg_debug2 (D_PROCESS_INTEGRATION, &
"process_init_blha_cores: method = ", dglap_me_method)
select case (nlo_type)
case (BORN)
if (needs_entry (method) .or. needs_entry (born_me_method)) &
call blha_template%set_born ()
case (NLO_REAL)
if (needs_entry (real_tree_me_method)) &
call blha_template%set_real_trees ()
case (NLO_VIRTUAL)
if (needs_entry (loop_me_method)) &
call blha_template%set_loop ()
case (NLO_SUBTRACTION)
if (needs_entry (correlation_me_method)) then
call blha_template%set_subtraction ()
call blha_template%set_internal_color_correlations ()
end if
case (NLO_DGLAP)
if (needs_entry (dglap_me_method)) then
call blha_template%set_dglap ()
end if
end select
end subroutine fill_blha_template
end subroutine process_init_blha_cores
@ %def process_init_blha_cores
@
<<Process: process: TBP>>=
procedure :: get_n_cores => process_get_n_cores
<<Process: procedures>>=
function process_get_n_cores (process) result (n)
integer :: n
class(process_t), intent(in) :: process
n = process%cm%n_cores
end function process_get_n_cores
@ %def process_get_n_cores
@
<<Process: process: TBP>>=
procedure :: get_core_manager_index => process_get_core_manager_index
<<Process: procedures>>=
function process_get_core_manager_index (process, i_core) result (i)
integer :: i
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
i = process%cm%i_core_to_first_i_component (i_core)
end function process_get_core_manager_index
@ %def process_get_core_manager_index
@
<<Process: process: TBP>>=
procedure :: get_core_manager => process_get_core_manager
<<Process: procedures>>=
function process_get_core_manager (process) result (cm)
type(core_manager_t) :: cm
class(process_t), intent(in) :: process
cm = process%cm
end function process_get_core_manager
@ %def process_get_core_manager
@
<<Process: process: TBP>>=
procedure :: get_core_manager_ptr => process_get_core_manager_ptr
<<Process: procedures>>=
function process_get_core_manager_ptr (process) result (cm)
type(core_manager_t), pointer :: cm
class(process_t), intent(in), target :: process
cm => process%cm
end function process_get_core_manager_ptr
@ %def process_get_core_manager_ptr
@
<<Process: process: TBP>>=
procedure :: get_base_i_term => process_get_base_i_term
<<Process: procedures>>=
function process_get_base_i_term (process, i_component) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
i_term = process%component(i_component)%i_term(1)
end function process_get_base_i_term
@ %def process_get_base_i_term
@
<<Process: process: TBP>>=
procedure :: get_core_term => process_get_core_term
<<Process: procedures>>=
function process_get_core_term (process, i_term) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
integer, intent(in) :: i_term
integer :: i_core
i_core = process%term(i_term)%i_core
core => process%cm%cores(i_core)%core
end function process_get_core_term
@ %def process_get_core_term
@
<<Process: process: TBP>>=
procedure :: get_subtraction_core => process_get_subtraction_core
<<Process: procedures>>=
function process_get_subtraction_core (process) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
core => process%cm%get_subtraction_core ()
end function process_get_subtraction_core
@ %def process_get_subtraction_core
@
<<Process: process: TBP>>=
procedure :: get_term_ptr => process_get_term_ptr
<<Process: procedures>>=
function process_get_term_ptr (process, i) result (term)
type(process_term_t), pointer :: term
class(process_t), intent(in), target :: process
integer, intent(in) :: i
term => process%term(i)
end function process_get_term_ptr
@ %def process_get_term_ptr
@
<<Process: process: TBP>>=
procedure :: get_core_from_md5sum => process_get_core_from_md5sum
<<Process: procedures>>=
function process_get_core_from_md5sum (process, md5sum) result (core)
class(prc_core_t), pointer :: core
class(process_t), intent(in), target :: process
character(32), intent(in) :: md5sum
integer :: i_core
associate (cm => process%cm)
do i_core = 1, N_MAX_CORES
if (cm%md5s(i_core) == md5sum) exit
end do
core => cm%cores(i_core)%core
end associate
end function process_get_core_from_md5sum
@ %def process_get_core_from_md5sum
@
<<Process: process: TBP>>=
procedure :: get_i_core_nlo_type => process_get_i_core_nlo_type
<<Process: procedures>>=
function process_get_i_core_nlo_type (process, nlo_type, include_sub) result (i_core)
integer :: i_core
class(process_t), intent(in) :: process
integer, intent(in) :: nlo_type
logical, intent(in), optional :: include_sub
logical :: skip_sub
skip_sub = .false.
if (present (include_sub)) skip_sub = .not. include_sub
do i_core = 1, N_MAX_CORES
if (skip_sub) then
if (process%cm%sub(i_core)) cycle
end if
if (process%cm%nlo_type (i_core) == nlo_type) return
end do
i_core = -1
end function process_get_i_core_nlo_type
@ %def process_get_i_core_nlo_type
@
<<Process: process: TBP>>=
procedure :: get_i_term => process_get_i_term
<<Process: procedures>>=
function process_get_i_term (process, i_core) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
do i_term = 1, process%get_n_terms ()
if (process%term(i_term)%i_core == i_core) return
end do
i_term = -1
end function process_get_i_term
@ %def process_get_i_term
@
<<Process: process: TBP>>=
procedure :: set_i_mci_work => process_set_i_mci_work
<<Process: procedures>>=
subroutine process_set_i_mci_work (process, i_mci)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
process%mci_entry(i_mci)%i_mci = i_mci
end subroutine process_set_i_mci_work
@ %def process_set_i_mci_work
@
<<Process: process: TBP>>=
procedure :: get_i_mci_work => process_get_i_mci_work
<<Process: procedures>>=
pure function process_get_i_mci_work (process, i_mci) result (i_mci_work)
integer :: i_mci_work
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
i_mci_work = process%mci_entry(i_mci)%i_mci
end function process_get_i_mci_work
@ %def process_get_i_mci_work
@
<<Process: process: TBP>>=
procedure :: get_i_sub => process_get_i_sub
<<Process: procedures>>=
elemental function process_get_i_sub (process, i_term) result (i_sub)
integer :: i_sub
class(process_t), intent(in) :: process
integer, intent(in) :: i_term
i_sub = process%term(i_term)%i_sub
end function process_get_i_sub
@ %def process_get_i_sub
@
<<Process: process: TBP>>=
procedure :: get_i_term_virtual => process_get_i_term_virtual
<<Process: procedures>>=
elemental function process_get_i_term_virtual (process) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer :: i_component
i_term = 0
do i_component = 1, size (process%component)
if (process%component(i_component)%get_nlo_type () == NLO_VIRTUAL) &
i_term = process%component(i_component)%i_term(1)
end do
end function process_get_i_term_virtual
@ %def process_get_i_term_virtual
@
<<Process: process: TBP>>=
generic :: component_is_active => component_is_active_single
procedure :: component_is_active_single => process_component_is_active_single
<<Process: procedures>>=
elemental function process_component_is_active_single (process, i_comp) result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_comp
val = process%component(i_comp)%is_active ()
end function process_component_is_active_single
@ %def process_component_is_active_single
@
<<Process: process: TBP>>=
generic :: component_is_active => component_is_active_all
procedure :: component_is_active_all => process_component_is_active_all
<<Process: procedures>>=
pure function process_component_is_active_all (process) result (val)
logical, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
allocate (val (size (process%component)))
val = process%component%is_active ()
end function process_component_is_active_all
@ %def process_component_is_active_all
@
\subsection{Default iterations}
If the user does not specify the passes and iterations for
integration, we should be able to give reasonable defaults. These
depend on the process, therefore we implement the following procedures
as methods of the process object. The algorithm is not very
sophisticated yet, it may be improved by looking at the process in
more detail.
We investigate only the first process component, assuming that it
characterizes the complexity of the process reasonable well.
The number of passes is limited to two: one for adaption, one for
integration.
<<Process: process: TBP>>=
procedure :: get_n_pass_default => process_get_n_pass_default
procedure :: adapt_grids_default => process_adapt_grids_default
procedure :: adapt_weights_default => process_adapt_weights_default
<<Process: procedures>>=
function process_get_n_pass_default (process) result (n_pass)
class(process_t), intent(in) :: process
integer :: n_pass
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
n_pass = 1
case default
n_pass = 2
end select
end function process_get_n_pass_default
function process_adapt_grids_default (process, pass) result (flag)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
logical :: flag
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
flag = .false.
case default
select case (pass)
case (1); flag = .true.
case (2); flag = .false.
case default
call msg_bug ("adapt grids default: impossible pass index")
end select
end select
end function process_adapt_grids_default
function process_adapt_weights_default (process, pass) result (flag)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
logical :: flag
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (n_eff)
case (1)
flag = .false.
case default
select case (pass)
case (1); flag = .true.
case (2); flag = .false.
case default
call msg_bug ("adapt weights default: impossible pass index")
end select
end select
end function process_adapt_weights_default
@ %def process_get_n_pass_default
@ %def process_adapt_grids_default
@ %def process_adapt_weights_default
@ The number of iterations and calls per iteration depends on the
number of outgoing particles.
<<Process: process: TBP>>=
procedure :: get_n_it_default => process_get_n_it_default
procedure :: get_n_calls_default => process_get_n_calls_default
<<Process: procedures>>=
function process_get_n_it_default (process, pass) result (n_it)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
integer :: n_it
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (pass)
case (1)
select case (n_eff)
case (1); n_it = 1
case (2); n_it = 3
case (3); n_it = 5
case (4:5); n_it = 10
case (6); n_it = 15
case (7:); n_it = 20
end select
case (2)
select case (n_eff)
case (:3); n_it = 3
case (4:); n_it = 5
end select
end select
end function process_get_n_it_default
function process_get_n_calls_default (process, pass) result (n_calls)
class(process_t), intent(in) :: process
integer, intent(in) :: pass
integer :: n_calls
integer :: n_eff
type(process_component_def_t), pointer :: config
config => process%component(1)%config
n_eff = config%get_n_tot () - 2
select case (pass)
case (1)
select case (n_eff)
case (1); n_calls = 100
case (2); n_calls = 1000
case (3); n_calls = 5000
case (4); n_calls = 10000
case (5); n_calls = 20000
case (6:); n_calls = 50000
end select
case (2)
select case (n_eff)
case (:3); n_calls = 10000
case (4); n_calls = 20000
case (5); n_calls = 50000
case (6); n_calls = 100000
case (7:); n_calls = 200000
end select
end select
end function process_get_n_calls_default
@ %def process_get_n_it_default
@ %def process_get_n_calls_default
@
\subsection{Constant process data}
The following methods return basic process data that stay constant
after initialization.
The process and IDs.
<<Process: process: TBP>>=
procedure :: get_id => process_get_id
procedure :: get_num_id => process_get_num_id
procedure :: get_run_id => process_get_run_id
procedure :: get_library_name => process_get_library_name
<<Process: procedures>>=
function process_get_id (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%id
end function process_get_id
function process_get_num_id (process) result (id)
class(process_t), intent(in) :: process
integer :: id
id = process%meta%num_id
end function process_get_num_id
function process_get_run_id (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%run_id
end function process_get_run_id
function process_get_library_name (process) result (id)
class(process_t), intent(in) :: process
type(string_t) :: id
id = process%meta%lib%get_name ()
end function process_get_library_name
@ %def process_get_id process_get_num_id
@ %def process_get_run_id process_get_library_name
@ The number of incoming particles.
<<Process: process: TBP>>=
procedure :: get_n_in => process_get_n_in
<<Process: procedures>>=
function process_get_n_in (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_in
end function process_get_n_in
@ %def process_get_n_in
@ The number of MCI data sets.
<<Process: process: TBP>>=
procedure :: get_n_mci => process_get_n_mci
<<Process: procedures>>=
function process_get_n_mci (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_mci
end function process_get_n_mci
@ %def process_get_n_mci
@ The number of process components, total.
<<Process: process: TBP>>=
procedure :: get_n_components => process_get_n_components
<<Process: procedures>>=
function process_get_n_components (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%meta%n_components
end function process_get_n_components
@ %def process_get_n_components
@ The number of process terms, total.
<<Process: process: TBP>>=
procedure :: get_n_terms => process_get_n_terms
<<Process: procedures>>=
function process_get_n_terms (process) result (n)
class(process_t), intent(in) :: process
integer :: n
n = process%config%n_terms
end function process_get_n_terms
@ %def process_get_n_terms
@ Return the indices of the components that belong to a
specific MCI entry.
<<Process: process: TBP>>=
procedure :: get_i_component => process_get_i_component
<<Process: procedures>>=
subroutine process_get_i_component (process, i_mci, i_component)
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer, dimension(:), intent(out), allocatable :: i_component
associate (mci_entry => process%mci_entry(i_mci))
allocate (i_component (size (mci_entry%i_component)))
i_component = mci_entry%i_component
end associate
end subroutine process_get_i_component
@ %def process_get_i_component
@ Return the ID of a specific component.
<<Process: process: TBP>>=
procedure :: get_component_id => process_get_component_id
<<Process: procedures>>=
function process_get_component_id (process, i_component) result (id)
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(string_t) :: id
id = process%meta%component_id(i_component)
end function process_get_component_id
@ %def process_get_component_id
@ Return a pointer to the definition of a specific component.
<<Process: process: TBP>>=
procedure :: get_component_def_ptr => process_get_component_def_ptr
<<Process: procedures>>=
function process_get_component_def_ptr (process, i_component) result (ptr)
type(process_component_def_t), pointer :: ptr
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
ptr => process%meta%lib%get_component_def_ptr (process%meta%id, i_component)
end function process_get_component_def_ptr
@ %def process_get_component_def_ptr
@ These procedures extract and restore (by transferring the
allocation) the process core. This is useful for changing process
parameters from outside this module.
<<Process: process: TBP>>=
procedure :: extract_core => process_extract_core
procedure :: restore_core => process_restore_core
<<Process: procedures>>=
subroutine process_extract_core (process, i_term, core)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_term
class(prc_core_t), intent(inout), allocatable :: core
integer :: i_core
i_core = process%term(i_term)%i_core
call move_alloc (from = process%cm%cores(i_core)%core, to = core)
end subroutine process_extract_core
subroutine process_restore_core (process, i_term, core)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_term
class(prc_core_t), intent(inout), allocatable :: core
integer :: i_core
i_core = process%term(i_term)%i_core
call move_alloc (from = core, to = process%cm%cores(i_core)%core)
end subroutine process_restore_core
@ %def process_extract_core
@ %def process_restore_core
@ The block of process constants.
<<Process: process: TBP>>=
procedure :: get_constants => process_get_constants
<<Process: procedures>>=
function process_get_constants (process, i_core) result (data)
type(process_constants_t) :: data
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
data = process%cm%cores(i_core)%core%data
end function process_get_constants
@ %def process_get_constants
@
<<Process: process: TBP>>=
procedure :: get_config => process_get_config
<<Process: procedures>>=
function process_get_config (process) result (config)
type(process_config_data_t) :: config
class(process_t), intent(in) :: process
config = process%config
end function process_get_config
@ %def process_get_config
@
<<Process: process: TBP>>=
procedure :: get_md5sum_constants => process_get_md5sum_constants
<<Process: procedures>>=
function process_get_md5sum_constants (process, i_component, &
type_string, nlo_type) result (this_md5sum)
character(32) :: this_md5sum
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(string_t), intent(in) :: type_string
integer, intent(in) :: nlo_type
type(process_constants_t) :: data
integer :: unit
call process%meta%lib%fill_constants (process%meta%id, i_component, data)
unit = data%fill_unit_for_md5sum (.false.)
write (unit, '(A)') char(type_string)
write (unit, '(I0)') nlo_type
rewind (unit)
this_md5sum = md5sum (unit)
close (unit)
end function process_get_md5sum_constants
@ %def process_get_md5sum_constants
@ Return the set of outgoing flavors that are associated with a particular
term. We deduce this from the effective interaction.
<<Process: process: TBP>>=
procedure :: get_term_flv_out => process_get_term_flv_out
<<Process: procedures>>=
subroutine process_get_term_flv_out (process, i_term, flv)
class(process_t), intent(in), target :: process
integer, intent(in) :: i_term
type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
type(interaction_t), pointer :: int
int => process%term(i_term)%int_eff
if (.not. associated (int)) int => process%term(i_term)%int
call interaction_get_flv_out (int, flv)
end subroutine process_get_term_flv_out
@ %def process_get_term_flv_out
@ Return true if there is any unstable particle in any of the process
terms. We decide this based on the provided model instance, not the
one that is stored in the process object.
<<Process: process: TBP>>=
procedure :: contains_unstable => process_contains_unstable
<<Process: procedures>>=
function process_contains_unstable (process, model) result (flag)
class(process_t), intent(in) :: process
class(model_data_t), intent(in), target :: model
logical :: flag
integer :: i_term
type(flavor_t), dimension(:,:), allocatable :: flv
flag = .false.
do i_term = 1, process%get_n_terms ()
call process%get_term_flv_out (i_term, flv)
call flv%set_model (model)
flag = .not. all (flv%is_stable ())
deallocate (flv)
if (flag) return
end do
end function process_contains_unstable
@ %def process_contains_unstable
@ The nominal process energy.
<<Process: process: TBP>>=
procedure :: get_sqrts => process_get_sqrts
<<Process: procedures>>=
function process_get_sqrts (process) result (sqrts)
class(process_t), intent(in) :: process
real(default) :: sqrts
sqrts = process%beam_config%data%get_sqrts ()
end function process_get_sqrts
@ %def process_get_sqrts
@ The beam polarization in case of simple degrees.
<<Process: process: TBP>>=
procedure :: get_polarization => process_get_polarization
<<Process: procedures>>=
function process_get_polarization (process) result (pol)
class(process_t), intent(in) :: process
real(default), dimension(2) :: pol
pol = process%beam_config%data%get_polarization ()
end function process_get_polarization
@ %def process_get_polarization
@
<<Process: process: TBP>>=
procedure :: get_meta => process_get_meta
<<Process: procedures>>=
function process_get_meta (process) result (meta)
type(process_metadata_t) :: meta
class(process_t), intent(in) :: process
meta = process%meta
end function process_get_meta
@ %def process_get_meta
<<Process: process: TBP>>=
procedure :: has_matrix_element => process_has_matrix_element
<<Process: procedures>>=
function process_has_matrix_element (process, i, is_term_index) result (active)
logical :: active
class(process_t), intent(in) :: process
integer, intent(in), optional :: i
logical, intent(in), optional :: is_term_index
integer :: i_component
logical :: is_term
is_term = .false.
if (present (i)) then
if (present (is_term_index)) is_term = is_term_index
if (is_term) then
i_component = process%term(i)%i_component
else
i_component = i
end if
active = process%component(i_component)%active
else
active = any (process%component%active)
end if
end function process_has_matrix_element
@ %def process_has_matrix_element
@ Pointer to the beam data object.
<<Process: process: TBP>>=
procedure :: get_beam_data_ptr => process_get_beam_data_ptr
<<Process: procedures>>=
function process_get_beam_data_ptr (process) result (beam_data)
class(process_t), intent(in), target :: process
type(beam_data_t), pointer :: beam_data
beam_data => process%beam_config%data
end function process_get_beam_data_ptr
@ %def process_get_beam_data_ptr
@
<<Process: process: TBP>>=
procedure :: get_beam_config => process_get_beam_config
<<Process: procedures>>=
function process_get_beam_config (process) result (beam_config)
type(process_beam_config_t) :: beam_config
class(process_t), intent(in) :: process
beam_config = process%beam_config
end function process_get_beam_config
@ %def process_get_beam_config
@
<<Process: process: TBP>>=
procedure :: get_beam_config_ptr => process_get_beam_config_ptr
<<Process: procedures>>=
function process_get_beam_config_ptr (process) result (beam_config)
type(process_beam_config_t), pointer :: beam_config
class(process_t), intent(in), target :: process
beam_config => process%beam_config
end function process_get_beam_config_ptr
@ %def process_get_beam_config_ptr
@ Return true if lab and c.m.\ frame coincide for this process.
<<Process: process: TBP>>=
procedure :: cm_frame => process_cm_frame
<<Process: procedures>>=
function process_cm_frame (process) result (flag)
class(process_t), intent(in), target :: process
logical :: flag
type(beam_data_t), pointer :: beam_data
beam_data => process%beam_config%data
flag = beam_data%cm_frame ()
end function process_cm_frame
@ %def process_cm_frame
@ Get the PDF set currently in use, if any.
<<Process: process: TBP>>=
procedure :: get_pdf_set => process_get_pdf_set
<<Process: procedures>>=
function process_get_pdf_set (process) result (pdf_set)
class(process_t), intent(in) :: process
integer :: pdf_set
pdf_set = process%beam_config%get_pdf_set ()
end function process_get_pdf_set
@ %def process_get_pdf_set
@
<<Process: process: TBP>>=
procedure :: pcm_contains_pdfs => process_pcm_contains_pdfs
<<Process: procedures>>=
function process_pcm_contains_pdfs (process) result (has_pdfs)
logical :: has_pdfs
class(process_t), intent(in) :: process
has_pdfs = process%pcm%has_pdfs
end function process_pcm_contains_pdfs
@ %def process_pcm_contains_pdfs
@ Get the beam spectrum file currently in use, if any.
<<Process: process: TBP>>=
procedure :: get_beam_file => process_get_beam_file
<<Process: procedures>>=
function process_get_beam_file (process) result (file)
class(process_t), intent(in) :: process
type(string_t) :: file
file = process%beam_config%get_beam_file ()
end function process_get_beam_file
@ %def process_get_beam_file
@ Pointer to the process variable list.
<<Process: process: TBP>>=
procedure :: get_var_list_ptr => process_get_var_list_ptr
<<Process: procedures>>=
function process_get_var_list_ptr (process) result (ptr)
class(process_t), intent(in), target :: process
type(var_list_t), pointer :: ptr
ptr => process%meta%var_list
end function process_get_var_list_ptr
@ %def process_get_var_list_ptr
@ Pointer to the common model.
<<Process: process: TBP>>=
procedure :: get_model_ptr => process_get_model_ptr
<<Process: procedures>>=
function process_get_model_ptr (process) result (ptr)
class(process_t), intent(in) :: process
class(model_data_t), pointer :: ptr
ptr => process%config%model
end function process_get_model_ptr
@ %def process_get_model_ptr
@ Use the embedded RNG factory to spawn a new random-number generator
instance. (This modifies the state of the factory.)
<<Process: process: TBP>>=
procedure :: make_rng => process_make_rng
<<Process: procedures>>=
subroutine process_make_rng (process, rng)
class(process_t), intent(inout) :: process
class(rng_t), intent(out), allocatable :: rng
if (allocated (process%config%rng_factory)) then
call process%config%rng_factory%make (rng)
else
call msg_bug ("Process: make rng: factory not allocated")
end if
end subroutine process_make_rng
@ %def process_make_rng
@
\subsection{Compute an amplitude}
Each process variant should allow for computing an amplitude value
directly, without generating a process instance.
The process component is selected by the index [[i]]. The term within the
process component is selected by [[j]]. The momentum
combination is transferred as the array [[p]]. The function sets the specific
quantum state via the indices of a flavor [[f]], helicity [[h]], and color
[[c]] combination. Each index refers to the list of flavor, helicity, and
color states, respectively, as stored in the process data.
Optionally, we may set factorization and renormalization scale. If unset, the
partonic c.m.\ energy is inserted.
The function checks arguments for validity.
For invalid arguments (quantum states), we return zero.
<<Process: process: TBP>>=
procedure :: compute_amplitude => process_compute_amplitude
<<Process: procedures>>=
function process_compute_amplitude &
(process, i_core, i, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced) &
result (amp)
class(process_t), intent(in) :: 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
class(prc_core_t), pointer :: core => null ()
real(default) :: fscale, rscale
real(default), allocatable :: aqcd_forced
complex(default) :: amp
amp = 0
if (0 < i .and. i <= process%meta%n_components) then
core => process%cm%get_core(i_core)
if (process%component(i)%active) then
!associate (data => process%component(i)%core%data)
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
else
amp = 0
end if
end if
end function process_compute_amplitude
@ %def process_compute_amplitude
@ Sanity check for the process library. We abort the program if it
has changed after process initialization.
<<Process: process: TBP>>=
procedure :: check_library_sanity => process_check_library_sanity
<<Process: procedures>>=
subroutine process_check_library_sanity (process)
class(process_t), intent(in) :: process
if (associated (process%meta%lib)) then
if (process%meta%lib%get_update_counter () /= process%meta%lib_update_counter) then
call msg_fatal ("Process '" // char (process%get_id ()) &
// "': library has been recompiled after integration")
end if
end if
end subroutine process_check_library_sanity
@ %def process_check_library_sanity
@ Execute this for testing purposes, to avoid a dangling pointer in the above
sanity check. Effectively switches off the sanity check.
<<Process: process: TBP>>=
procedure :: nullify_library_pointer => process_nullify_library_pointer
<<Process: procedures>>=
subroutine process_nullify_library_pointer (process)
class(process_t), intent(inout) :: process
process%meta%lib => null ()
end subroutine process_nullify_library_pointer
@ %def process_nullify_library_pointer
@
<<Process: process: TBP>>=
procedure :: set_component_type => process_set_component_type
<<Process: procedures>>=
subroutine process_set_component_type (process, i_component, i_type)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_component, i_type
process%component(i_component)%component_type = i_type
end subroutine process_set_component_type
@ %def process_set_component_type
@
<<Process: process: TBP>>=
procedure :: set_counter_mci_entry => process_set_counter_mci_entry
<<Process: procedures>>=
subroutine process_set_counter_mci_entry (process, i_mci, counter)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_mci
type(process_counter_t), intent(in) :: counter
process%mci_entry(i_mci)%counter = counter
end subroutine process_set_counter_mci_entry
@ %def process_set_counter_mci_entry
@ This is for suppression of numerical noise in the integration results
stored in the [[process_mci_entry]] type. As the error and efficiency
enter the MD5 sum, we recompute it.
<<Process: process: TBP>>=
procedure :: pacify => process_pacify
<<Process: procedures>>=
subroutine process_pacify (process, efficiency_reset, error_reset)
class(process_t), intent(inout) :: process
logical, intent(in), optional :: efficiency_reset, error_reset
logical :: eff_reset, err_reset
integer :: i
eff_reset = .false.
err_reset = .false.
if (present (efficiency_reset)) eff_reset = efficiency_reset
if (present (error_reset)) err_reset = error_reset
if (allocated (process%mci_entry)) then
do i = 1, size (process%mci_entry)
call process%mci_entry(i)%results%pacify (efficiency_reset)
if (allocated (process%mci_entry(i)%mci)) then
associate (mci => process%mci_entry(i)%mci)
if (process%mci_entry(i)%mci%error_known &
.and. err_reset) &
mci%error = 0
if (process%mci_entry(i)%mci%efficiency_known &
.and. eff_reset) &
mci%efficiency = 1
call mci%pacify (efficiency_reset, error_reset)
call mci%compute_md5sum ()
end associate
end if
end do
end if
end subroutine process_pacify
@ %def process_pacify
@ The following methods are used only in the unit tests; the access
process internals directly that would otherwise be hidden.
<<Process: process: TBP>>=
procedure :: test_allocate_sf_channels
procedure :: test_set_component_sf_channel
procedure :: test_get_mci_ptr
<<Process: procedures>>=
subroutine test_allocate_sf_channels (process, n)
class(process_t), intent(inout) :: process
integer, intent(in) :: n
call process%beam_config%allocate_sf_channels (n)
end subroutine test_allocate_sf_channels
subroutine test_set_component_sf_channel (process, c)
class(process_t), intent(inout) :: process
integer, dimension(:), intent(in) :: c
call process%component(1)%phs_config%set_sf_channel (c)
end subroutine test_set_component_sf_channel
subroutine test_get_mci_ptr (process, mci)
class(process_t), intent(in), target :: process
class(mci_t), intent(out), pointer :: mci
mci => process%mci_entry(1)%mci
end subroutine test_get_mci_ptr
@ %def test_allocate_sf_channels
@ %def test_set_component_sf_channel
@ %def test_get_mci_ptr
@
<<Process: process: TBP>>=
procedure :: init_mci_work => process_init_mci_work
<<Process: procedures>>=
subroutine process_init_mci_work (process, mci_work, i)
class(process_t), intent(in), target :: process
type(mci_work_t), intent(out) :: mci_work
integer, intent(in) :: i
call mci_work%init (process%mci_entry(i))
end subroutine process_init_mci_work
@ %def process_init_mci_work
@
<<Process: process: TBP>>=
procedure :: setup_test_cores => process_setup_test_cores
<<Process: procedures>>=
subroutine process_setup_test_cores (process, type_string)
class(process_t), intent(inout) :: process
class(prc_core_t), allocatable :: core
type(string_t), intent(in), optional :: type_string
allocate (test_t :: core)
if (present (type_string)) then
call process%core_manager_register (BORN, 1, type_string)
else
call process%core_manager_register (BORN, 1, var_str ("test_me"))
end if
call process%allocate_cm_arrays (1)
call process%allocate_core (1, core)
call process%init_cores ()
end subroutine process_setup_test_cores
@ %def process_setup_test_cores
@
<<Process: process: TBP>>=
procedure :: write_cm => process_write_cm
<<Process: procedures>>=
subroutine process_write_cm (process, unit)
class(process_t), intent(in) :: process
integer, intent(in), optional :: unit
call process%cm%write (unit)
end subroutine process_write_cm
@ %def process_write_cm
<<Process: process: TBP>>=
procedure :: get_connected_states => process_get_connected_states
<<Process: procedures>>=
function process_get_connected_states (process, i_component, &
connected_terms) result (connected)
type(connected_state_t), dimension(:), allocatable :: connected
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
type(connected_state_t), dimension(:), intent(in) :: connected_terms
integer :: i, i_conn
integer :: n_conn
n_conn = 0
do i = 1, process%get_n_terms ()
if (process%term(i)%i_component == i_component) then
n_conn = n_conn + 1
end if
end do
allocate (connected (n_conn))
i_conn = 1
do i = 1, process%get_n_terms ()
if (process%term(i)%i_component == i_component) then
connected (i_conn) = connected_terms(i)
i_conn = i_conn + 1
end if
end do
end function process_get_connected_states
@ %def process_get_connected_states
@
\subsection{NLO specifics}
These subroutines (and the NLO specific properties they work on) could
potentially be moved to [[pcm_nlo_t]] and used more generically in
[[process_t]] with an appropriate interface in [[pcm_t]]
<<Process: process: TBP>>=
procedure :: init_nlo_settings => process_init_nlo_settings
<<Process: procedures>>=
subroutine process_init_nlo_settings (process, var_list, fks_template)
class(process_t), intent(inout) :: process
type(var_list_t), intent(in), target :: var_list
type(fks_template_t), intent(in), optional :: fks_template
select type (pcm => process%pcm)
type is (pcm_nlo_t)
call pcm%settings%init (var_list, fks_template)
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>>=
procedure :: get_nlo_type => process_get_nlo_type
<<Process: procedures>>=
elemental function process_get_nlo_type (process, i_core) result (nlo_type)
integer :: nlo_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_core
nlo_type = process%cm%nlo_type(i_core)
end function process_get_nlo_type
@ %def process_get_nlo_type
@
<<Process: process: TBP>>=
generic :: get_nlo_type_component => get_nlo_type_component_single
procedure :: get_nlo_type_component_single => process_get_nlo_type_component_single
<<Process: procedures>>=
elemental function process_get_nlo_type_component_single (process, i_component) result (val)
integer :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
val = process%component(i_component)%get_nlo_type ()
end function process_get_nlo_type_component_single
@ %def process_get_nlo_type_component_single
@
<<Process: process: TBP>>=
generic :: get_nlo_type_component => get_nlo_type_component_all
procedure :: get_nlo_type_component_all => process_get_nlo_type_component_all
<<Process: procedures>>=
pure function process_get_nlo_type_component_all (process) result (val)
integer, dimension(:), allocatable :: val
class(process_t), intent(in) :: process
allocate (val (size (process%component)))
val = process%component%get_nlo_type ()
end function process_get_nlo_type_component_all
@ %def process_get_nlo_type_component_all
@
<<Process: process: TBP>>=
procedure :: is_nlo_calculation => process_is_nlo_calculation
<<Process: procedures>>=
function process_is_nlo_calculation (process) result (nlo)
logical :: nlo
class(process_t), intent(in) :: process
select type (pcm => process%pcm)
type is (pcm_nlo_t)
nlo = .true.
class default
nlo = .false.
end select
end function process_is_nlo_calculation
@ %def process_is_nlo_calculation
@
<<Process: process: TBP>>=
procedure :: is_combined_nlo_integration &
=> process_is_combined_nlo_integration
<<Process: procedures>>=
function process_is_combined_nlo_integration (process) result (combined)
logical :: combined
class(process_t), intent(in) :: process
select type (pcm => process%pcm)
type is (pcm_nlo_t)
combined = pcm%settings%combined_integration
class default
combined = .false.
end select
end function process_is_combined_nlo_integration
@ %def process_is_combined_nlo_integration
@
<<Process: process: TBP>>=
procedure :: component_is_real_finite => process_component_is_real_finite
<<Process: procedures>>=
pure function process_component_is_real_finite (process, i_component) &
result (val)
logical :: val
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
val = process%component(i_component)%component_type == COMP_REAL_FIN
end function process_component_is_real_finite
@ %def process_component_is_real_finite
@ Return nlo data of a process component
<<Process: process: TBP>>=
procedure :: get_component_nlo_type => process_get_component_nlo_type
<<Process: procedures>>=
elemental function process_get_component_nlo_type (process, i_component) &
result (nlo_type)
integer :: nlo_type
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
nlo_type = process%component(i_component)%config%get_nlo_type ()
end function process_get_component_nlo_type
@ %def process_get_component_nlo_type
<<Process: process: TBP>>=
procedure :: get_component_associated_born &
=> process_get_component_associated_born
<<Process: procedures>>=
function process_get_component_associated_born (process, i_component) &
result (i_born)
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
integer :: i_born
i_born = process%component(i_component)%config%get_associated_born ()
end function process_get_component_associated_born
@ %def process_get_component_associated_born
@
<<Process: process: TBP>>=
procedure :: get_first_real_component => process_get_first_real_component
<<Process: procedures>>=
function process_get_first_real_component (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
i_real = process%component(1)%config%get_associated_real ()
end function process_get_first_real_component
@ %def process_get_first_real_component
@
<<Process: process: TBP>>=
procedure :: get_first_real_term => process_get_first_real_term
<<Process: procedures>>=
function process_get_first_real_term (process) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer :: i_component, i_term
i_component = process%component(1)%config%get_associated_real ()
i_real = 0
do i_term = 1, size (process%term)
if (process%term(i_term)%i_component == i_component) then
i_real = i_term
exit
end if
end do
if (i_real == 0) call msg_fatal ("Did not find associated real term!")
end function process_get_first_real_term
@ %def process_get_first_real_term
@
<<Process: process: TBP>>=
procedure :: get_associated_real_fin => process_get_associated_real_fin
<<Process: procedures>>=
elemental function process_get_associated_real_fin (process, i_component) result (i_real)
integer :: i_real
class(process_t), intent(in) :: process
integer, intent(in) :: i_component
i_real = process%component(i_component)%config%get_associated_real_fin ()
end function process_get_associated_real_fin
@ %def process_get_associated_real_fin
@
<<Process: process: TBP>>=
procedure :: setup_region_data => process_setup_region_data
<<Process: procedures>>=
subroutine process_setup_region_data (process, i_real, data_born, data_real)
class(process_t), intent(inout) :: process
integer, intent(in) :: i_real
type(process_constants_t), intent(in) :: data_born, data_real
integer, dimension (:,:), allocatable :: flavor_born, flavor_real
type(resonance_history_t), dimension(:), allocatable :: resonance_histories
logical :: success
select type (pcm => process%pcm)
type is (pcm_nlo_t)
call data_born%get_flv_state (flavor_born)
call data_real%get_flv_state (flavor_real)
select type (model => process%config%model)
type is (model_t)
call pcm%region_data%init (data_born%n_in, model, &
flavor_born, flavor_real, pcm%settings%nlo_correction_type)
associate (template => pcm%settings%fks_template)
if (template%mapping_type == FKS_RESONANCES) then
select type (phs_config => process%component(i_real)%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 &
(pcm%settings%fks_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
end select
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 ()
associate (var_list => process%meta%var_list)
call pcm%region_data%write_to_file (process%meta%id, &
var_list%get_lval (var_str ("?vis_fks_regions")), &
process%config%os_data)
end associate
if (debug_active (D_SUBTRACTION)) call pcm%region_data%check_consistency (.true.)
end select
end subroutine process_setup_region_data
@ %def process_setup_region_data
@
<<Process: process: TBP>>=
procedure :: setup_real_partition => process_setup_real_partition
<<Process: procedures>>=
subroutine process_setup_real_partition (process, partition_scale)
class(process_t), intent(inout) :: process
real(default), intent(in) :: partition_scale
select type (pcm => process%pcm)
type is (pcm_nlo_t)
call pcm%setup_real_partition (partition_scale)
end select
end subroutine process_setup_real_partition
@ %def process_setup_real_partition
@
<<Process: process: TBP>>=
procedure :: check_if_threshold_method => process_check_if_threshold_method
<<Process: procedures>>=
subroutine process_check_if_threshold_method (process)
class(process_t), intent(inout) :: process
integer :: i_core
associate (cm => process%cm)
do i_core = 1, cm%n_cores
select type (core => cm%cores(i_core)%core)
type is (prc_threshold_t)
select type (pcm => process%pcm)
type is (pcm_nlo_t)
pcm%settings%factorization_mode = FACTORIZATION_THRESHOLD
end select
end select
end do
end associate
end subroutine process_check_if_threshold_method
@ %def process_check_if_threshold_method
<<Process: process: TBP>>=
procedure :: select_i_term => process_select_i_term
<<Process: procedures>>=
pure function process_select_i_term (process, i_mci) result (i_term)
integer :: i_term
class(process_t), intent(in) :: process
integer, intent(in) :: i_mci
integer :: i_component, i_sub
i_component = process%mci_entry(i_mci)%i_component(1)
i_term = process%component(i_component)%i_term(1)
i_sub = process%term(i_term)%i_sub
if (i_sub > 0) &
i_term = process%term(i_sub)%i_term_global
end function process_select_i_term
@ %def process_select_i_term
@
<<Process: process: TBP>>=
procedure :: create_blha_interface => process_create_blha_interface
<<Process: procedures>>=
subroutine process_create_blha_interface (process, flv_born, flv_real, n_in, beam_structure)
class(process_t), intent(inout) :: process
integer, intent(in), dimension(:,:), allocatable :: flv_born, flv_real
integer, intent(in) :: n_in
type(beam_structure_t), intent(in) :: beam_structure
integer :: alpha_power, alphas_power
type(blha_master_t) :: blha_master
integer :: openloops_phs_tolerance, openloops_stability_log
logical :: use_cms, use_collier
type(string_t) :: openloops_extra_cmd
type(string_t) :: ew_scheme, correction_type
type(process_component_def_t), pointer :: config => null ()
config => process%meta%lib%get_component_def_ptr (process%meta%id, 1)
call config%get_coupling_powers (alpha_power, alphas_power)
associate (cm => process%cm)
associate (var_list => process%meta%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"))
openloops_extra_cmd = var_list%get_sval (var_str ("$openloops_extra_cmd"))
use_cms = var_list%get_lval (var_str ("?openloops_use_cms"))
use_collier = var_list%get_lval (var_str ("?openloops_use_collier"))
ew_scheme = var_list%get_sval (var_str ("$blha_ew_scheme"))
correction_type = var_list%get_sval (var_str ("$nlo_correction_type"))
call blha_master%set_ew_scheme (ew_scheme)
end associate
call blha_master%set_methods &
(process%is_nlo_calculation (), process%meta%var_list)
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, &
use_collier, &
extra_cmd = openloops_extra_cmd, &
beam_structure = beam_structure)
call blha_master%generate (process%meta%id, process%config%model, &
n_in, alpha_power, alphas_power, flv_born, flv_real)
call blha_master%write_olp (process%meta%id)
end associate
end subroutine process_create_blha_interface
@ %def process_create_blha_interface
@ Would be better to do this at the level of the writer of the core but
one has to bring NLO information there.
Could also be moved to the [[core_manager_t]].
<<Process: process: TBP>>=
procedure :: create_and_load_extra_libraries &
=> process_create_and_load_extra_libraries
<<Process: procedures>>=
subroutine process_create_and_load_extra_libraries &
(process, beam_structure, var_list, os_data)
class(process_t), intent(inout), target :: process
type(beam_structure_t), intent(in) :: beam_structure
type(var_list_t), intent(in) :: var_list
type(os_data_t), intent(in) :: os_data
type(string_t) :: libname
integer :: i_component, i_core
logical, dimension(process%cm%n_cores) :: loaded
logical :: give_warning, is_nlo
integer :: n_in
integer, dimension(:,:), allocatable :: flv_born, flv_real
type(process_component_def_t), pointer :: config => null ()
integer :: nlo_type_fetched
loaded = .false.
call msg_debug2 (D_PROCESS_INTEGRATION, &
"process_create_and_load_extra_libraries")
select type (pcm => process%pcm)
type is (pcm_nlo_t)
call pcm%region_data%get_all_flv_states (flv_born, flv_real)
n_in = pcm%region_data%get_n_in ()
is_nlo = .true.
class default
i_core = process%get_i_core_nlo_type (BORN)
is_nlo = .false.
associate (core => process%cm%cores(i_core)%core)
allocate (flv_born (core%data%get_n_tot (), core%data%n_flv))
flv_born = core%data%flv_state
n_in = core%data%n_in
end associate
end select
if (process%needs_extra_code (only_blha = .true.)) &
call process%create_blha_interface &
(flv_born, flv_real, n_in, beam_structure)
give_warning = .false.
do i_component = 1, process%meta%n_components
config => process%meta%lib%get_component_def_ptr &
(process%meta%id, i_component)
nlo_type_fetched = config%get_nlo_type ()
if (nlo_type_fetched == NLO_MISMATCH) nlo_type_fetched = NLO_SUBTRACTION
i_core = process%get_i_core_nlo_type (nlo_type_fetched)
if (config%can_be_integrated () .or. &
process%get_nlo_type (i_core) == NLO_SUBTRACTION .or. &
process%get_nlo_type (i_core) == NLO_REAL) then
if (.not. loaded (i_core)) then
select type (core => process%cm%cores(i_core)%core)
class is (prc_user_defined_base_t)
libname = process%get_library_name ()
if (process%cm%core_is_radiation(i_core)) then
if (allocated (flv_real)) then
call core%data%set_flv_state (flv_real)
else
give_warning = .true.
end if
call msg_debug2 (D_PROCESS_INTEGRATION, &
"create and load radiation libraries")
call core%create_and_load_extra_libraries &
(flv_real, var_list, os_data, libname, &
process%config%model, i_core, is_nlo)
else
if (allocated (flv_born)) then
call core%data%set_flv_state (flv_born)
else
give_warning = .true.
end if
call msg_debug2 (D_PROCESS_INTEGRATION, &
"create and load Born libraries")
call core%create_and_load_extra_libraries &
(flv_born, var_list, os_data, libname, &
process%config%model, i_core, is_nlo)
end if
end select
select type (core => process%cm%cores(i_core)%core)
type is (prc_threshold_t)
core%has_beam_pol = beam_structure%has_polarized_beams ()
end select
loaded(i_core) = .true.
end if
end if
end do
if (give_warning) call msg_warning ("Some flavor structures ", &
[var_str ("are not allocated. This is totally fine if "), &
var_str ("$method = 'threshold' is used, but you should "), &
var_str ("have a closer look if this is not the case.")])
end subroutine process_create_and_load_extra_libraries
@ %def process_create_and_load_extra_libraries
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process config}
<<[[process_config.f90]]>>=
<<File header>>
module process_config
<<Use kinds>>
<<Use strings>>
use format_utils, only: write_separator
use io_units
use md5
use os_interface
use diagnostics
use sf_base
use sf_mappings
use sm_qcd
use physics_defs
use integration_results
use model_data
use interactions
use quantum_numbers
use flavors
use helicities
use colors
use rng_base
use state_matrices
use process_libraries
use process_constants
use prc_core
use prc_user_defined
use prc_openloops, only: prc_openloops_t
use prc_threshold, only: prc_threshold_t
use beams
use mci_base
use beam_structures
use phs_base
use variables
use expr_base
use pcm_base, only: pcm_t
use pcm, only: pcm_nlo_t
<<Standard module head>>
<<Process config: public>>
<<Process config: parameters>>
<<Process config: types>>
contains
<<Process config: procedures>>
end module process_config
@ %def process_config
@
<<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{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.
The [[rng_factory]] component spawns independent random-number generators for
use in integration, event generation, and event postprocessing.
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
integer :: n_in = 0
integer :: n_components = 0
integer :: n_terms = 0
integer :: n_mci = 0
type(os_data_t) :: os_data
class(rng_factory_t), allocatable :: rng_factory
type(string_t) :: model_name
class(model_data_t), pointer :: model => null ()
type(qcd_t) :: qcd
class(expr_factory_t), allocatable :: ef_cuts
class(expr_factory_t), allocatable :: ef_scale
class(expr_factory_t), allocatable :: ef_fac_scale
class(expr_factory_t), allocatable :: ef_ren_scale
class(expr_factory_t), allocatable :: ef_weight
character(32) :: md5sum = ""
contains
<<Process config: process config data: TBP>>
end type process_config_data_t
@ %def process_config_data_t
@ Here, we may compress the expressions for cuts etc.
<<Process config: process config data: TBP>>=
procedure :: write => process_config_data_write
<<Process config: procedures>>=
subroutine process_config_data_write (config, u, &
counters, os_data, rng_factory, model, expressions)
class(process_config_data_t), intent(in) :: config
integer, intent(in) :: u
logical, intent(in) :: counters
logical, intent(in) :: os_data
logical, intent(in) :: rng_factory
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 (os_data) then
call os_data_write (config%os_data, u)
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.)
if (rng_factory) then
if (allocated (config%rng_factory)) then
write (u, "(2x)", advance = "no")
call config%rng_factory%write (u)
end if
end if
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 that we import here should be an instance of the global model. If we
create the instance outside, we can make it an extension of the basic
[[model_data_t]]. This will allow us to synchronize the variable list with
the model. Using a pointer instead of an allocatable, we can guarantee the
[[target]] attribute.
The RNG factory object is imported by moving the allocation.
<<Process config: process config data: TBP>>=
procedure :: init => process_config_data_init
<<Process config: procedures>>=
subroutine process_config_data_init &
(config, meta, os_data, qcd, rng_factory, model)
class(process_config_data_t), intent(out) :: config
type(process_metadata_t), intent(in) :: meta
type(os_data_t), intent(in) :: os_data
type(qcd_t), intent(in) :: qcd
class(rng_factory_t), intent(inout), allocatable :: rng_factory
class(model_data_t), intent(inout), pointer :: model
config%n_in = meta%lib%get_n_in (meta%id)
config%n_components = size (meta%component_id)
config%os_data = os_data
config%qcd = qcd
call move_alloc (from = rng_factory, to = config%rng_factory)
config%model_name = model%get_name ()
config%model => model
model => null ()
end subroutine process_config_data_init
@ %def process_config_data_init
@ Since the captured model is a separate object allocated via a
pointer, we need a finalizer.
<<Process config: process config data: TBP>>=
procedure :: final => process_config_data_final
<<Process config: procedures>>=
subroutine process_config_data_final (config)
class(process_config_data_t), intent(inout) :: config
if (associated (config%model)) then
call config%model%final ()
deallocate (config%model)
end if
end subroutine process_config_data_final
@ %def process_config_data_final
@ Compute the MD5 sum of the configuration data. This encodes, in
particular, the model and the expressions for cut, scales, weight,
etc. It should not contain the IDs and number of components, etc.,
since the MD5 sum should be useful for integrating individual
components.
This is done only once. If the MD5 sum is nonempty, the calculation
is skipped.
<<Process config: process config data: TBP>>=
procedure :: compute_md5sum => process_config_data_compute_md5sum
<<Process config: procedures>>=
subroutine process_config_data_compute_md5sum (config)
class(process_config_data_t), intent(inout) :: config
integer :: u
if (config%md5sum == "") then
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
call config%write (u, counters = .false., os_data = .false., &
rng_factory = .false., model = .true., expressions = .true.)
rewind (u)
config%md5sum = md5sum (u)
close (u)
end if
end subroutine process_config_data_compute_md5sum
@ %def process_config_data_compute_md5sum
@
<<Process config: process config data: TBP>>=
procedure :: get_md5sum => process_config_data_get_md5sum
<<Process config: procedures>>=
pure function process_config_data_get_md5sum (config) result (md5)
character(32) :: md5
class(process_config_data_t), intent(in) :: config
md5 = config%md5sum
end function process_config_data_get_md5sum
@ %def process_config_data_get_md5sum
@
\subsection{Metadata}
This information describes the process and its environment. 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 [[var_list]] is a snapshot of the variable list, taken at the
point where the process was initialized.
The [[lib]] pointer accesses 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(var_list_t) :: var_list
type(process_library_t), pointer :: lib => null ()
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
@ The local var list is a snapshot and needs a finalizer.
<<Process config: process metadata: TBP>>=
procedure :: final => process_metadata_final
<<Process config: procedures>>=
subroutine process_metadata_final (meta)
class(process_metadata_t), intent(inout) :: meta
call meta%var_list%final (follow_link=.true.)
end subroutine process_metadata_final
@ %def process_metadata_final
@ Output: ID and run ID.
We write the variable list only upon request.
<<Process config: process metadata: TBP>>=
procedure :: write => process_metadata_write
<<Process config: procedures>>=
subroutine process_metadata_write (meta, u, var_list, screen)
class(process_metadata_t), intent(in) :: meta
integer, intent(in) :: u
logical, intent(in) :: var_list, 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 (associated (meta%lib)) then
if (screen) then
write (msg_buffer, "(2x,A,A,A)") "Library name = '", &
char (meta%lib%get_name ()), "'"
call msg_message ()
else
write (u, "(3x,A,A,A)") "Library name = '", &
char (meta%lib%get_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
if (screen) return
if (var_list) then
write (u, "(1x,A)") "Variable list:"
call write_separator (u)
call var_list_write (meta%var_list, u)
else
write (u, "(1x,A)") "Variable list: [not shown]"
end if
end subroutine process_metadata_write
@ %def process_metadata_write
@ Short output: list components.
<<Process config: process metadata: TBP>>=
procedure :: show => process_metadata_show
<<Process config: procedures>>=
subroutine process_metadata_show (meta, u, model_name)
class(process_metadata_t), intent(in) :: meta
integer, intent(in) :: u
type(string_t), intent(in) :: model_name
integer :: i
select case (meta%type)
case (PRC_UNKNOWN)
write (u, "(A)") "Process: [undefined]"
return
case default
write (u, "(A)", advance="no") "Process:"
end select
write (u, "(1x,A)", advance="no") char (meta%id)
select case (meta%num_id)
case (0)
case default
write (u, "(1x,'(',I0,')')", advance="no") meta%num_id
end select
select case (char (model_name))
case ("")
case default
write (u, "(1x,'[',A,']')", advance="no") char (model_name)
end select
write (u, *)
if (allocated (meta%component_id)) then
do i = 1, size (meta%component_id)
if (meta%active(i)) then
write (u, "(2x,I0,':',1x,A)") i, &
char (meta%component_description (i))
end if
end do
end if
end subroutine process_metadata_show
@ %def process_metadata_show
@ Initialize.
<<Process config: process metadata: TBP>>=
procedure :: init => process_metadata_init
<<Process config: procedures>>=
subroutine process_metadata_init (meta, id, run_id, lib)
class(process_metadata_t), intent(out) :: meta
type(string_t), intent(in) :: id
type(string_t), intent(in) :: run_id
type(process_library_t), intent(in), target :: lib
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 = run_id
meta%lib => lib
meta%lib_update_counter = lib%get_update_counter ()
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.)
end subroutine process_metadata_init
@ %def process_metadata_init
@ Mark a component as inactive.
<<Process config: process metadata: TBP>>=
procedure :: deactivate_component => process_metadata_deactivate_component
<<Process config: procedures>>=
subroutine process_metadata_deactivate_component (meta, i)
class(process_metadata_t), intent(inout) :: meta
integer, intent(in) :: i
call msg_message ("Process component '" &
// char (meta%component_id(i)) // "': matrix element vanishes")
meta%active(i) = .false.
end subroutine process_metadata_deactivate_component
@ %def process_metadata_deactivate_component
@
\subsection{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_frame]] 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_frame = .true.
character(32) :: md5sum = ""
logical :: sf_trace = .false.
type(string_t) :: sf_trace_file
contains
<<Process config: process beam config: TBP>>
end type process_beam_config_t
@ %def process_beam_config_t
@ Here we write beam data only if they are actually used.
The [[verbose]] flag is passed to the beam-data writer.
<<Process config: process beam config: TBP>>=
procedure :: write => process_beam_config_write
<<Process config: procedures>>=
subroutine process_beam_config_write (object, unit, verbose)
class(process_beam_config_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer :: u, i, c
u = given_output_unit (unit)
call object%data%write (u, verbose = verbose)
if (object%data%initialized) then
write (u, "(3x,A,L1)") "Azimuthal dependence = ", &
object%azimuthal_dependence
write (u, "(3x,A,L1)") "Lab frame is c.m. frame = ", &
object%lab_is_cm_frame
if (object%md5sum /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (beams/strf) = '", &
object%md5sum, "'"
end if
if (allocated (object%sf)) then
do i = 1, size (object%sf)
call object%sf(i)%write (u)
end do
if (any_sf_channel_has_mapping (object%sf_channel)) then
write (u, "(1x,A,L1)") "Structure-function mappings per channel:"
do c = 1, object%n_channel
write (u, "(3x,I0,':')", advance="no") c
call object%sf_channel(c)%write (u)
end do
end if
end if
end if
end subroutine process_beam_config_write
@ %def process_beam_config_write
@ The beam data have a finalizer. We assume that there is none for the
structure-function data.
<<Process config: process beam config: TBP>>=
procedure :: final => process_beam_config_final
<<Process config: procedures>>=
subroutine process_beam_config_final (object)
class(process_beam_config_t), intent(inout) :: object
call object%data%final ()
end subroutine process_beam_config_final
@ %def process_beam_config_final
@ Initialize the beam setup with a given beam structure object.
<<Process config: process beam config: TBP>>=
procedure :: init_beam_structure => process_beam_config_init_beam_structure
<<Process config: procedures>>=
subroutine process_beam_config_init_beam_structure &
(beam_config, beam_structure, sqrts, model, decay_rest_frame)
class(process_beam_config_t), intent(out) :: beam_config
type(beam_structure_t), intent(in) :: beam_structure
logical, intent(in), optional :: decay_rest_frame
real(default), intent(in) :: sqrts
class(model_data_t), intent(in), target :: model
call beam_config%data%init_structure (beam_structure, &
sqrts, model, decay_rest_frame)
beam_config%lab_is_cm_frame = beam_config%data%cm_frame ()
end subroutine process_beam_config_init_beam_structure
@ %def process_beam_config_init_beam_structure
@ Initialize the beam setup for a scattering process with specified
flavor combination, other properties taken from the beam structure
object (if any).
<<Process config: process beam config: TBP>>=
procedure :: init_scattering => process_beam_config_init_scattering
<<Process config: procedures>>=
subroutine process_beam_config_init_scattering &
(beam_config, flv_in, sqrts, beam_structure)
class(process_beam_config_t), intent(out) :: beam_config
type(flavor_t), dimension(2), intent(in) :: flv_in
real(default), intent(in) :: sqrts
type(beam_structure_t), intent(in), optional :: beam_structure
if (present (beam_structure)) then
if (beam_structure%polarized ()) then
call beam_config%data%init_sqrts (sqrts, flv_in, &
beam_structure%get_smatrix (), beam_structure%get_pol_f ())
else
call beam_config%data%init_sqrts (sqrts, flv_in)
end if
else
call beam_config%data%init_sqrts (sqrts, flv_in)
end if
end subroutine process_beam_config_init_scattering
@ %def process_beam_config_init_scattering
@ Initialize the beam setup for a decay process with specified flavor,
other properties taken from the beam structure object (if present).
For a cascade decay, we set
[[rest_frame]] to false, indicating a event-wise varying momentum.
The beam data itself are initialized for the particle at rest.
<<Process config: process beam config: TBP>>=
procedure :: init_decay => process_beam_config_init_decay
<<Process config: procedures>>=
subroutine process_beam_config_init_decay &
(beam_config, flv_in, rest_frame, beam_structure)
class(process_beam_config_t), intent(out) :: beam_config
type(flavor_t), dimension(1), intent(in) :: flv_in
logical, intent(in), optional :: rest_frame
type(beam_structure_t), intent(in), optional :: beam_structure
if (present (beam_structure)) then
if (beam_structure%polarized ()) then
call beam_config%data%init_decay (flv_in, &
beam_structure%get_smatrix (), beam_structure%get_pol_f (), &
rest_frame = rest_frame)
else
call beam_config%data%init_decay (flv_in, rest_frame = rest_frame)
end if
else
call beam_config%data%init_decay (flv_in, &
rest_frame = rest_frame)
end if
beam_config%lab_is_cm_frame = beam_config%data%cm_frame ()
end subroutine process_beam_config_init_decay
@ %def process_beam_config_init_decay
@ Print an informative message.
<<Process config: process beam config: TBP>>=
procedure :: startup_message => process_beam_config_startup_message
<<Process config: procedures>>=
subroutine process_beam_config_startup_message &
(beam_config, unit, beam_structure)
class(process_beam_config_t), intent(in) :: beam_config
integer, intent(in), optional :: unit
type(beam_structure_t), intent(in), optional :: beam_structure
integer :: u
u = free_unit ()
open (u, status="scratch", action="readwrite")
if (present (beam_structure)) then
call beam_structure%write (u)
end if
call beam_config%data%write (u)
rewind (u)
do
read (u, "(1x,A)", end=1) msg_buffer
call msg_message ()
end do
1 continue
close (u)
end subroutine process_beam_config_startup_message
@ %def process_beam_config_startup_message
@ Allocate the structure-function array.
<<Process config: process beam config: TBP>>=
procedure :: init_sf_chain => process_beam_config_init_sf_chain
<<Process config: procedures>>=
subroutine process_beam_config_init_sf_chain &
(beam_config, sf_config, sf_trace_file)
class(process_beam_config_t), intent(inout) :: beam_config
type(sf_config_t), dimension(:), intent(in) :: sf_config
type(string_t), intent(in), optional :: sf_trace_file
integer :: i
beam_config%n_strfun = size (sf_config)
allocate (beam_config%sf (beam_config%n_strfun))
do i = 1, beam_config%n_strfun
associate (sf => sf_config(i))
call beam_config%sf(i)%init (sf%i, sf%data)
if (.not. sf%data%is_generator ()) then
beam_config%n_sfpar = beam_config%n_sfpar + sf%data%get_n_par ()
end if
end associate
end do
if (present (sf_trace_file)) then
beam_config%sf_trace = .true.
beam_config%sf_trace_file = sf_trace_file
end if
end subroutine process_beam_config_init_sf_chain
@ %def process_beam_config_init_sf_chain
@ Allocate the structure-function mapping channel array, given the
requested number of channels.
<<Process config: process beam config: TBP>>=
procedure :: allocate_sf_channels => process_beam_config_allocate_sf_channels
<<Process config: procedures>>=
subroutine process_beam_config_allocate_sf_channels (beam_config, n_channel)
class(process_beam_config_t), intent(inout) :: beam_config
integer, intent(in) :: n_channel
beam_config%n_channel = n_channel
call allocate_sf_channels (beam_config%sf_channel, &
n_channel = n_channel, &
n_strfun = beam_config%n_strfun)
end subroutine process_beam_config_allocate_sf_channels
@ %def process_beam_config_allocate_sf_channels
@ Set a structure-function mapping channel for an array of
structure-function entries, for a single channel. (The default is no mapping.)
<<Process config: process beam config: TBP>>=
procedure :: set_sf_channel => process_beam_config_set_sf_channel
<<Process config: procedures>>=
subroutine process_beam_config_set_sf_channel (beam_config, c, sf_channel)
class(process_beam_config_t), intent(inout) :: beam_config
integer, intent(in) :: c
type(sf_channel_t), intent(in) :: sf_channel
beam_config%sf_channel(c) = sf_channel
end subroutine process_beam_config_set_sf_channel
@ %def process_beam_config_set_sf_channel
@ Print an informative startup message.
<<Process config: process beam config: TBP>>=
procedure :: sf_startup_message => process_beam_config_sf_startup_message
<<Process config: procedures>>=
subroutine process_beam_config_sf_startup_message &
(beam_config, sf_string, unit)
class(process_beam_config_t), intent(in) :: beam_config
type(string_t), intent(in) :: sf_string
integer, intent(in), optional :: unit
if (beam_config%n_strfun > 0) then
call msg_message ("Beam structure: " // char (sf_string), unit = unit)
write (msg_buffer, "(A,3(1x,I0,1x,A))") &
"Beam structure:", &
beam_config%n_channel, "channels,", &
beam_config%n_sfpar, "dimensions"
call msg_message (unit = unit)
if (beam_config%sf_trace) then
call msg_message ("Beam structure: tracing &
&values in '" // char (beam_config%sf_trace_file) // "'")
end if
end if
end subroutine process_beam_config_sf_startup_message
@ %def process_beam_config_startup_message
@ Return the PDF set currently in use, if any. This should be unique,
so we scan the structure functions until we get a nonzero number.
(This implies that if the PDF set is not unique (e.g., proton and
photon structure used together), this doesn't work correctly.)
<<Process config: process beam config: TBP>>=
procedure :: get_pdf_set => process_beam_config_get_pdf_set
<<Process config: procedures>>=
function process_beam_config_get_pdf_set (beam_config) result (pdf_set)
class(process_beam_config_t), intent(in) :: beam_config
integer :: pdf_set
integer :: i
pdf_set = 0
if (allocated (beam_config%sf)) then
do i = 1, size (beam_config%sf)
pdf_set = beam_config%sf(i)%get_pdf_set ()
if (pdf_set /= 0) return
end do
end if
end function process_beam_config_get_pdf_set
@ %def process_beam_config_get_pdf_set
@ Return the beam file.
<<Process config: process beam config: TBP>>=
procedure :: get_beam_file => process_beam_config_get_beam_file
<<Process config: procedures>>=
function process_beam_config_get_beam_file (beam_config) result (file)
class(process_beam_config_t), intent(in) :: beam_config
type(string_t) :: file
integer :: i
file = ""
if (allocated (beam_config%sf)) then
do i = 1, size (beam_config%sf)
file = beam_config%sf(i)%get_beam_file ()
if (file /= "") return
end do
end if
end function process_beam_config_get_beam_file
@ %def process_beam_config_get_beam_file
@ Compute the MD5 sum for the complete beam setup. We rely on the
default output of [[write]] to contain all relevant data.
This is done only once, when the MD5 sum is still empty.
<<Process config: process beam config: TBP>>=
procedure :: compute_md5sum => process_beam_config_compute_md5sum
<<Process config: procedures>>=
subroutine process_beam_config_compute_md5sum (beam_config)
class(process_beam_config_t), intent(inout) :: beam_config
integer :: u
if (beam_config%md5sum == "") then
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
call beam_config%write (u, verbose=.true.)
rewind (u)
beam_config%md5sum = md5sum (u)
close (u)
end if
end subroutine process_beam_config_compute_md5sum
@ %def process_beam_config_compute_md5sum
@
<<Process config: process beam config: TBP>>=
procedure :: get_md5sum => process_beam_config_get_md5sum
<<Process config: procedures>>=
pure function process_beam_config_get_md5sum (beam_config) result (md5)
character(32) :: md5
class(process_beam_config_t), intent(in) :: beam_config
md5 = beam_config%md5sum
end function process_beam_config_get_md5sum
@ %def process_beam_config_get_md5sum
@
<<Process config: process beam config: TBP>>=
procedure :: has_structure_function => process_beam_config_has_structure_function
<<Process config: procedures>>=
pure function process_beam_config_has_structure_function (beam_config) result (has_sf)
logical :: has_sf
class(process_beam_config_t), intent(in) :: beam_config
has_sf = beam_config%n_strfun > 0
end function process_beam_config_has_structure_function
@ %def process_beam_config_has_structure_function
@
\subsection{Process components}
A process component is an individual contribution to a process
(scattering or decay) which needs not be physical. The sum over all
components should be physical.
The [[index]] indentifies this component within its parent process.
The actual process component is stored in the [[core]] subobject. We
use a polymorphic subobject instead of an extension of
[[process_component_t]], because the individual entries in the array
of process components can have different types. In short,
[[process_component_t]] is a wrapper for the actual process variants.
If the [[active]] flag is false, we should skip this component. This happens
if the associated process has vanishing matrix element.
The index array [[i_term]] points to the individual terms generated by
this component. The indices refer to the parent process.
The index [[i_mci]] is the index of the MC integrator and parameter set which
are associated to this process component.
<<Process config: public>>=
public :: process_component_t
<<Process config: types>>=
type :: process_component_t
type(process_component_def_t), pointer :: config => null ()
integer :: index = 0
logical :: active = .false.
class(mci_t), allocatable :: mci_template
integer, dimension(:), allocatable :: i_term
integer :: i_mci = 0
class(phs_config_t), allocatable :: phs_config
character(32) :: md5sum_phs = ""
integer :: component_type = COMP_DEFAULT
contains
<<Process config: process component: TBP>>
end type process_component_t
@ %def process_component_t
@ Finalizer. The MCI template may (potentially) need a finalizer. The process
configuration finalizer may include closing an open scratch file.
<<Process config: process component: TBP>>=
procedure :: final => process_component_final
<<Process config: procedures>>=
subroutine process_component_final (object)
class(process_component_t), intent(inout) :: object
if (allocated (object%mci_template)) then
call object%mci_template%final ()
end if
if (allocated (object%phs_config)) then
call object%phs_config%final ()
end if
end subroutine process_component_final
@ %def process_component_final
@ The meaning of [[verbose]] depends on the process variant.
<<Process config: process component: TBP>>=
procedure :: write => process_component_write
<<Process config: procedures>>=
subroutine process_component_write (object, unit)
class(process_component_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (associated (object%config)) then
write (u, "(1x,A,I0)") "Component #", object%index
call object%config%write (u)
if (object%md5sum_phs /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (phs) = '", &
object%md5sum_phs, "'"
end if
else
write (u, "(1x,A)") "Process component: [not allocated]"
end if
if (.not. object%active) then
write (u, "(1x,A)") "[Inactive]"
return
end if
write (u, "(1x,A)") "Referenced data:"
if (allocated (object%i_term)) then
write (u, "(3x,A,999(1x,I0))") "Terms =", &
object%i_term
else
write (u, "(3x,A)") "Terms = [undefined]"
end if
if (object%i_mci /= 0) then
write (u, "(3x,A,I0)") "MC dataset = ", object%i_mci
else
write (u, "(3x,A)") "MC dataset = [undefined]"
end if
if (allocated (object%phs_config)) then
call object%phs_config%write (u)
end if
end subroutine process_component_write
@ %def process_component_write
@ Initialize the component.
WK 2018-04-05: the call to [[set_component_index]] appears to be redundant,
disabled.
<<Process config: process component: TBP>>=
procedure :: init => process_component_init
<<Process config: procedures>>=
subroutine process_component_init (component, &
i_component, meta, config, &
active, data, &
mci_template, phs_config_template)
class(process_component_t), intent(out) :: component
integer, intent(in) :: i_component
type(process_metadata_t), intent(in), target :: meta
type(process_config_data_t), intent(in) :: config
logical, intent(in) :: active
type(process_constants_t), intent(in) :: data
class(mci_t), intent(in), allocatable :: mci_template
class(phs_config_t), intent(in), allocatable :: phs_config_template
component%index = i_component
component%config => meta%lib%get_component_def_ptr (meta%id, i_component)
component%active = active
if (component%active) then
if (allocated (mci_template)) &
allocate (component%mci_template, source = mci_template)
allocate (component%phs_config, source = phs_config_template)
call component%phs_config%init (data, config%model)
!!! call component%phs_config%set_component_index (component%index)
end if
end subroutine process_component_init
@ %def process_component_init
@
<<Process config: process component: TBP>>=
procedure :: is_active => process_component_is_active
<<Process config: procedures>>=
elemental function process_component_is_active (component) result (active)
logical :: active
class(process_component_t), intent(in) :: component
active = component%active
end function process_component_is_active
@ %def process_component_is_active
@
<<Process config: process component: TBP>>=
procedure :: has_mci_template => process_component_has_mci_template
<<Process config: procedures>>=
pure function process_component_has_mci_template (component) &
result (is_allocated)
logical :: is_allocated
class(process_component_t), intent(in) :: component
is_allocated = allocated (component%mci_template)
end function process_component_has_mci_template
@ %def process_component_has_mci_template
@
<<Process config: process component: TBP>>=
procedure :: extract_mci_template => process_component_extract_mci_template
<<Process config: procedures>>=
function process_component_extract_mci_template (component) &
result (mci_template)
class(mci_t), allocatable :: mci_template
class(process_component_t), intent(in) :: component
if (allocated (component%mci_template)) &
allocate (mci_template, source = component%mci_template)
end function process_component_extract_mci_template
@ %def process_component_extract_mci_template
@ Finalize the phase-space configuration.
<<Process config: process component: TBP>>=
procedure :: configure_phs => process_component_configure_phs
<<Process config: procedures>>=
subroutine process_component_configure_phs &
(component, sqrts, beam_config, rebuild, &
- ignore_mismatch)
+ 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, &
cm_frame = beam_config%lab_is_cm_frame .and. no_strfun, &
rebuild = rebuild, ignore_mismatch = ignore_mismatch, &
- nlo_type = nlo_type)
+ nlo_type = nlo_type, &
+ subdir = subdir)
end subroutine process_component_configure_phs
@ %def process_component_configure_phs
@ The process component possesses two MD5 sums: the checksum of the
component definition, which should be available when the component is
initialized, and the phase-space MD5 sum, which is available after
configuration.
<<Process config: process component: TBP>>=
procedure :: compute_md5sum => process_component_compute_md5sum
<<Process config: procedures>>=
subroutine process_component_compute_md5sum (component)
class(process_component_t), intent(inout) :: component
component%md5sum_phs = component%phs_config%get_md5sum ()
end subroutine process_component_compute_md5sum
@ %def process_component_compute_md5sum
@ Match phase-space channels with structure-function channels, where
applicable.
This calls a method of the [[phs_config]] phase-space implementation.
<<Process config: process component: TBP>>=
procedure :: collect_channels => process_component_collect_channels
<<Process config: procedures>>=
subroutine process_component_collect_channels (component, coll)
class(process_component_t), intent(inout) :: component
type(phs_channel_collection_t), intent(inout) :: coll
call component%phs_config%collect_channels (coll)
end subroutine process_component_collect_channels
@ %def process_component_collect_channels
@
<<Process config: process component: TBP>>=
procedure :: get_config => process_component_get_config
<<Process config: procedures>>=
function process_component_get_config (component) &
result (config)
type(process_component_def_t) :: config
class(process_component_t), intent(in) :: component
config = component%config
end function process_component_get_config
@ %def process_component_get_config
@
<<Process config: process component: TBP>>=
procedure :: get_md5sum => process_component_get_md5sum
<<Process config: procedures>>=
pure function process_component_get_md5sum (component) result (md5)
type(string_t) :: md5
class(process_component_t), intent(in) :: component
md5 = component%config%get_md5sum () // component%md5sum_phs
end function process_component_get_md5sum
@ %def process_component_get_md5sum
@ Return the number of phase-space parameters.
<<Process config: process component: TBP>>=
procedure :: get_n_phs_par => process_component_get_n_phs_par
<<Process config: procedures>>=
function process_component_get_n_phs_par (component) result (n_par)
class(process_component_t), intent(in) :: component
integer :: n_par
n_par = component%phs_config%get_n_par ()
end function process_component_get_n_phs_par
@ %def process_component_get_n_phs_par
@
<<Process config: process component: TBP>>=
procedure :: get_phs_config => process_component_get_phs_config
<<Process config: procedures>>=
subroutine process_component_get_phs_config (component, phs_config)
class(process_component_t), intent(in), target :: component
class(phs_config_t), intent(out), pointer :: phs_config
phs_config => component%phs_config
end subroutine process_component_get_phs_config
@ %def process_component_get_phs_config
@
<<Process config: process component: TBP>>=
procedure :: get_nlo_type => process_component_get_nlo_type
<<Process config: procedures>>=
elemental function process_component_get_nlo_type (component) result (nlo_type)
integer :: nlo_type
class(process_component_t), intent(in) :: component
nlo_type = component%config%get_nlo_type ()
end function process_component_get_nlo_type
@ %def process_component_get_nlo_type
@
<<Process config: process component: TBP>>=
procedure :: needs_mci_entry => process_component_needs_mci_entry
<<Process config: procedures>>=
function process_component_needs_mci_entry (component, combined_integration) result (value)
logical :: value
class(process_component_t), intent(in) :: component
logical, intent(in), optional :: combined_integration
value = component%active
if (present (combined_integration)) then
if (combined_integration) &
value = value .and. component%component_type <= COMP_MASTER
end if
end function process_component_needs_mci_entry
@ %def process_component_needs_mci_entry
@
<<Process config: process component: TBP>>=
procedure :: can_be_integrated => process_component_can_be_integrated
<<Process config: procedures>>=
elemental function process_component_can_be_integrated (component) result (active)
logical :: active
class(process_component_t), intent(in) :: component
active = component%config%can_be_integrated ()
end function process_component_can_be_integrated
@ %def process_component_can_be_integrated
@
\subsection{Process terms}
For straightforward tree-level calculations, each process component
corresponds to a unique elementary interaction. However, in the case
of NLO calculations with subtraction terms, a process component may
split into several separate contributions to the scattering, which are
qualified by interactions with distinct kinematics and particle
content. We represent their configuration as [[process_term_t]]
objects, the actual instances will be introduced below as
[[term_instance_t]]. In any case, the process term contains an
elementary interaction with a definite quantum-number and momentum
content.
The index [[i_term_global]] identifies the term relative to the
process.
The index [[i_component]] identifies the process component which
generates this term, relative to the parent process.
The index [[i_term]] identifies the term relative to the process
component (not the process).
The [[data]] subobject holds all process constants.
The number of allowed flavor/helicity/color combinations is stored as
[[n_allowed]]. This is the total number of independent entries in the
density matrix. For each combination, the index of the flavor,
helicity, and color state is stored in the arrays [[flv]], [[hel]],
and [[col]], respectively.
The flag [[rearrange]] is true if we need to rearrange the particles of the
hard interaction, to obtain the effective parton state.
The interaction [[int]] holds the quantum state for the (resolved) hard
interaction, the parent-child relations of the particles, and their momenta.
The momenta are not filled yet; this is postponed to copies of [[int]] which
go into the process instances.
If recombination is in effect, we should allocate [[int_eff]] to describe the
rearranged partonic state.
This type is public only for use in a unit test.
<<Process config: public>>=
public :: process_term_t
<<Process config: types>>=
type :: process_term_t
integer :: i_term_global = 0
integer :: i_component = 0
integer :: i_term = 0
integer :: i_sub = 0
integer :: i_core = 0
integer :: n_allowed = 0
type(process_constants_t) :: data
real(default) :: alpha_s = 0
integer, dimension(:), allocatable :: flv, hel, col
integer :: n_sub, n_sub_color, n_sub_spin
type(interaction_t) :: int
type(interaction_t), pointer :: int_eff => null ()
class(pcm_t), pointer :: pcm => null ()
contains
<<Process config: process term: TBP>>
end type process_term_t
@ %def process_term_t
@ For the output, we skip the process constants and the tables of
allowed quantum numbers. Those can also be read off from the
interaction object.
<<Process config: process term: TBP>>=
procedure :: write => process_term_write
<<Process config: procedures>>=
subroutine process_term_write (term, unit)
class(process_term_t), intent(in) :: term
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A,I0)") "Term #", term%i_term_global
write (u, "(3x,A,I0)") "Process component index = ", &
term%i_component
write (u, "(3x,A,I0)") "Term index w.r.t. component = ", &
term%i_term
call write_separator (u)
write (u, "(1x,A)") "Hard interaction:"
call write_separator (u)
call term%int%basic_write (u)
end subroutine process_term_write
@ %def process_term_write
@ Write an account of all quantum number states and their current status.
<<Process config: process term: TBP>>=
procedure :: write_state_summary => process_term_write_state_summary
<<Process config: procedures>>=
subroutine process_term_write_state_summary (term, core, unit)
class(process_term_t), intent(in) :: term
class(prc_core_t), intent(in) :: core
integer, intent(in), optional :: unit
integer :: u, i, f, h, c
type(state_iterator_t) :: it
character :: sgn
u = given_output_unit (unit)
write (u, "(1x,A,I0)") "Term #", term%i_term_global
call it%init (term%int%get_state_matrix_ptr ())
do while (it%is_valid ())
i = it%get_me_index ()
f = term%flv(i)
h = term%hel(i)
if (allocated (term%col)) then
c = term%col(i)
else
c = 1
end if
if (core%is_allowed (term%i_term, f, h, c)) then
sgn = "+"
else
sgn = " "
end if
write (u, "(1x,A1,1x,I0,2x)", advance="no") sgn, i
call quantum_numbers_write (it%get_quantum_numbers (), u)
write (u, *)
call it%advance ()
end do
end subroutine process_term_write_state_summary
@ %def process_term_write_state_summary
@ Finalizer: the [[int]] and potentially [[int_eff]] components have a
finalizer that we must call.
<<Process config: process term: TBP>>=
procedure :: final => process_term_final
<<Process config: procedures>>=
subroutine process_term_final (term)
class(process_term_t), intent(inout) :: term
call term%int%final ()
end subroutine process_term_final
@ %def process_term_final
@ Initialize the term. We copy the process constants from the [[core]]
object and set up the [[int]] hard interaction accordingly.
The [[alpha_s]] value is useful for writing external event records. This is
the constant value which may be overridden by a event-specific running value.
If the model does not contain the strong coupling, the value is zero.
The [[rearrange]] part is commented out; this or something equivalent
could become relevant for NLO algorithms.
<<Process config: process term: TBP>>=
procedure :: init => process_term_init
<<Process config: procedures>>=
subroutine process_term_init &
(term, i_term_global, i_component, i_term, core, model, &
nlo_type, use_beam_pol, subtraction_method)
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
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)
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 \-o -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)$.
<<Process config: process term: TBP>>=
procedure :: setup_interaction => process_term_setup_interaction
<<Process config: procedures>>=
subroutine process_term_setup_interaction (term, core, model, &
nlo_type, pol_beams, use_internal_color)
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
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: use_internal_color
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 ()
call fill_quantum_numbers ()
call term%int%basic_init &
(term%data%n_in, 0, term%data%n_out, set_relations = .true.)
select type (core)
type is (prc_openloops_t)
call setup_states_openloops ()
type is (prc_threshold_t)
call setup_states_threshold ()
class is (prc_user_defined_base_t)
call setup_states_other_user_defined ()
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_user_defined_base_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 ()
logical :: can_have_sub
integer :: n_sub_color, n_sub_spin
use_color = .false.; if (present (use_internal_color)) &
use_color = use_internal_color
can_have_sub = nlo_t == NLO_VIRTUAL .or. &
(nlo_t == NLO_REAL .and. term%i_term_global == term%i_sub) .or. &
nlo_t == NLO_MISMATCH
n_sub_color = 0; n_sub_spin = 0
if (can_have_sub) then
if (.not. use_color) n_sub_color = n_tot * (n_tot - 1) / 2
if (nlo_t == NLO_REAL) then
select type (pcm_nlo => term%pcm)
class is (pcm_nlo_t)
if (pcm_nlo%region_data%requires_spin_correlations ()) &
n_sub_spin = 16 * pcm_nlo%region_data%n_emitters
end select
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 (associated (term%pcm)) then
if (term%pcm%has_pdfs .and. ((nlo_t == NLO_REAL .and. can_have_sub) &
.or. nlo_t == NLO_DGLAP)) n_sub = n_sub + n_beam_structure_int
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_user_defined_base_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_openloops ()
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
call hel%init (data%hel_state (:,h))
call qn%init (flv, hel, col, s)
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_openloops
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_user_defined ()
integer :: s, f, i
integer :: n_sub
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
do s = 0, n_sub
do f = 1, term%data%n_flv
i = i + 1
term%flv(i) = f
term%hel(i) = 1
term%col(i) = 1
call flv%init (term%data%flv_state (:,f), model)
call qn%init (flv, s)
call qn%tag_hard_process ()
call term%int%add_state (qn)
end do
end do
end subroutine setup_states_other_user_defined
subroutine setup_states_omega ()
integer :: f, h, c, i
i = 0
associate (data => term%data)
do f = 1, data%n_flv
do h = 1, data%n_hel
do c = 1, data%n_col
if (core%is_allowed (term%i_term, f, h, c)) then
i = i + 1
term%flv(i) = f
term%hel(i) = h
term%col(i) = c
call flv%init (data%flv_state(:,f), model)
call color_init_from_array (col, &
data%col_state(:,:,c), &
data%ghost_flag(:,c))
call col(:data%n_in)%invert ()
call hel%init (data%hel_state(:,h))
call qn%init (flv, col, hel)
call qn%tag_hard_process ()
call term%int%add_state (qn)
end if
end do
end do
end do
end associate
end subroutine setup_states_omega
end subroutine process_term_setup_interaction
@ %def process_term_setup_interaction
@
<<Process config: process term: TBP>>=
procedure :: get_process_constants => process_term_get_process_constants
<<Process config: procedures>>=
subroutine process_term_get_process_constants &
(term, prc_constants)
class(process_term_t), intent(inout) :: term
type(process_constants_t), intent(out) :: prc_constants
prc_constants = term%data
end subroutine process_term_get_process_constants
@ %def process_term_get_process_constants
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process call statistics}
Very simple object for statistics. Could be moved to a more basic chapter.
<<[[process_counter.f90]]>>=
<<File header>>
module process_counter
use io_units
<<Standard module head>>
<<Process counter: public>>
<<Process counter: parameters>>
<<Process counter: types>>
contains
<<Process counter: procedures>>
end module process_counter
@ %def process_counter
@ This object can record process calls, categorized by evaluation
status. It is a part of the [[mci_entry]] component below.
<<Process counter: public>>=
public :: process_counter_t
<<Process counter: types>>=
type :: process_counter_t
integer :: total = 0
integer :: failed_kinematics = 0
integer :: failed_cuts = 0
integer :: has_passed = 0
integer :: evaluated = 0
integer :: complete = 0
contains
<<Process counter: process counter: TBP>>
end type process_counter_t
@ %def process_counter_t
@ Here are the corresponding numeric codes:
<<Process counter: parameters>>=
integer, parameter, public :: STAT_UNDEFINED = 0
integer, parameter, public :: STAT_INITIAL = 1
integer, parameter, public :: STAT_ACTIVATED = 2
integer, parameter, public :: STAT_BEAM_MOMENTA = 3
integer, parameter, public :: STAT_FAILED_KINEMATICS = 4
integer, parameter, public :: STAT_SEED_KINEMATICS = 5
integer, parameter, public :: STAT_HARD_KINEMATICS = 6
integer, parameter, public :: STAT_EFF_KINEMATICS = 7
integer, parameter, public :: STAT_FAILED_CUTS = 8
integer, parameter, public :: STAT_PASSED_CUTS = 9
integer, parameter, public :: STAT_EVALUATED_TRACE = 10
integer, parameter, public :: STAT_EVENT_COMPLETE = 11
@ %def STAT_UNDEFINED STAT_INITIAL STAT_ACTIVATED
@ %def STAT_BEAM_MOMENTA STAT_FAILED_KINEMATICS
@ %def STAT_SEED_KINEMATICS STAT_HARD_KINEMATICS STAT_EFF_KINEMATICS
@ %def STAT_EVALUATED_TRACE STAT_EVENT_COMPLETE
@ Output.
<<Process counter: process counter: TBP>>=
procedure :: write => process_counter_write
<<Process counter: procedures>>=
subroutine process_counter_write (object, unit)
class(process_counter_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (object%total > 0) then
write (u, "(1x,A)") "Call statistics (current run):"
write (u, "(3x,A,I0)") "total = ", object%total
write (u, "(3x,A,I0)") "failed kin. = ", object%failed_kinematics
write (u, "(3x,A,I0)") "failed cuts = ", object%failed_cuts
write (u, "(3x,A,I0)") "passed cuts = ", object%has_passed
write (u, "(3x,A,I0)") "evaluated = ", object%evaluated
else
write (u, "(1x,A)") "Call statistics (current run): [no calls]"
end if
end subroutine process_counter_write
@ %def process_counter_write
@ Reset. Just enforce default initialization.
<<Process counter: process counter: TBP>>=
procedure :: reset => process_counter_reset
<<Process counter: procedures>>=
subroutine process_counter_reset (counter)
class(process_counter_t), intent(out) :: counter
counter%total = 0
counter%failed_kinematics = 0
counter%failed_cuts = 0
counter%has_passed = 0
counter%evaluated = 0
counter%complete = 0
end subroutine process_counter_reset
@ %def process_counter_reset
@ We record an event according to the lowest status code greater or
equal to the actual status. This is actually done by the process
instance; the process object just copies the instance counter.
<<Process counter: process counter: TBP>>=
procedure :: record => process_counter_record
<<Process counter: procedures>>=
subroutine process_counter_record (counter, status)
class(process_counter_t), intent(inout) :: counter
integer, intent(in) :: status
if (status <= STAT_FAILED_KINEMATICS) then
counter%failed_kinematics = counter%failed_kinematics + 1
else if (status <= STAT_FAILED_CUTS) then
counter%failed_cuts = counter%failed_cuts + 1
else if (status <= STAT_PASSED_CUTS) then
counter%has_passed = counter%has_passed + 1
else
counter%evaluated = counter%evaluated + 1
end if
counter%total = counter%total + 1
end subroutine process_counter_record
@ %def process_counter_record
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Multi-channel integration}
<<[[process_mci.f90]]>>=
<<File header>>
module process_mci
<<Use kinds>>
<<Use strings>>
use io_units
use diagnostics
use physics_defs
use md5
use cputime
use rng_base
use mci_base
use variables
use integration_results
use process_libraries
use phs_base
use process_counter
use process_config
<<Standard module head>>
<<Process mci: public>>
<<Process mci: parameters>>
<<Process mci: types>>
contains
<<Process mci: procedures>>
end module process_mci
@ %def process_mci
\subsection{Process MCI entry}
The [[process_mci_entry_t]] block contains, for each process component that is
integrated independently, the configuration data for its MC input parameters.
Each input parameter set is handled by a [[mci_t]] integrator.
The MC input parameter set is broken down into the parameters required by the
structure-function chain and the parameters required by the phase space of the
elementary process.
The MD5 sum collects all information about the associated processes
that may affect the integration. It does not contain the MCI object
itself or integration results.
MC integration is organized in passes. Each pass may consist of
several iterations, and for each iteration there is a number of
calls. We store explicitly the values that apply to the current
pass. Previous values are archived in the [[results]] object.
The [[counter]] receives the counter statistics from the associated
process instance, for diagnostics.
The [[results]] object records results, broken down in passes and iterations.
<<Process mci: public>>=
public :: process_mci_entry_t
<<Process mci: types>>=
type :: process_mci_entry_t
integer :: i_mci = 0
integer, dimension(:), allocatable :: i_component
integer :: process_type = PRC_UNKNOWN
integer :: n_par = 0
integer :: n_par_sf = 0
integer :: n_par_phs = 0
character(32) :: md5sum = ""
integer :: pass = 0
integer :: n_it = 0
integer :: n_calls = 0
logical :: activate_timer = .false.
real(default) :: error_threshold = 0
class(mci_t), allocatable :: mci
type(process_counter_t) :: counter
type(integration_results_t) :: results
logical :: negative_weights
logical :: combined_integration = .false.
integer :: real_partition_type = REAL_FULL
integer :: associated_real_component = 0
contains
<<Process mci: process mci entry: TBP>>
end type process_mci_entry_t
@ %def process_mci_entry_t
@ Finalizer for the [[mci]] component.
<<Process mci: process mci entry: TBP>>=
procedure :: final => process_mci_entry_final
<<Process mci: procedures>>=
subroutine process_mci_entry_final (object)
class(process_mci_entry_t), intent(inout) :: object
if (allocated (object%mci)) call object%mci%final ()
end subroutine process_mci_entry_final
@ %def process_mci_entry_final
@ Output. Write pass/iteration information only if set (the pass
index is nonzero). Write the MCI block only if it exists (for some
self-tests it does not). Write results only if there are any.
<<Process mci: process mci entry: TBP>>=
procedure :: write => process_mci_entry_write
<<Process mci: procedures>>=
subroutine process_mci_entry_write (object, unit, pacify)
class(process_mci_entry_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,I0)") "Associated components = ", object%i_component
write (u, "(3x,A,I0)") "MC input parameters = ", object%n_par
write (u, "(3x,A,I0)") "MC parameters (SF) = ", object%n_par_sf
write (u, "(3x,A,I0)") "MC parameters (PHS) = ", object%n_par_phs
if (object%pass > 0) then
write (u, "(3x,A,I0)") "Current pass = ", object%pass
write (u, "(3x,A,I0)") "Number of iterations = ", object%n_it
write (u, "(3x,A,I0)") "Number of calls = ", object%n_calls
end if
if (object%md5sum /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (components) = '", object%md5sum, "'"
end if
if (allocated (object%mci)) then
call object%mci%write (u)
end if
call object%counter%write (u)
if (object%results%exist ()) then
call object%results%write (u, suppress = pacify)
call object%results%write_chain_weights (u)
end if
end subroutine process_mci_entry_write
@ %def process_mci_entry_write
@ Initialize. From the existing configuration, 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.
The allocation of the MCI integrator with the appropriate concrete type is the
duty of the process core.
We assume that there is only one component associated with a MCI entry. This
restriction should be relaxed.
<<Process mci: process mci entry: TBP>>=
procedure :: init => process_mci_entry_init
<<Process mci: procedures>>=
subroutine process_mci_entry_init (mci_entry, &
process_type, i_mci, i_component, component, &
n_sfpar, rng_factory)
class(process_mci_entry_t), intent(inout) :: mci_entry
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 (component%has_mci_template ()) then
allocate (mci_entry%mci, source=component%extract_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_init
@ %def process_mci_entry_init
@
<<Process mci: parameters>>=
integer, parameter, public :: REAL_FULL = 0
integer, parameter, public :: REAL_SINGULAR = 1
integer, parameter, public :: REAL_FINITE = 2
@
<<Process mci: process mci entry: TBP>>=
procedure :: create_component_list => &
process_mci_entry_create_component_list
<<Process mci: procedures>>=
subroutine process_mci_entry_create_component_list (mci_entry, &
i_component, component_config)
class (process_mci_entry_t), intent(inout) :: mci_entry
integer, intent(in) :: i_component
type(process_component_def_t), intent(in) :: component_config
integer, dimension(:), allocatable :: i_list
integer :: n
integer, save :: i_rfin_offset = 0
call msg_debug (D_PROCESS_INTEGRATION, "process_mci_entry_create_component_list")
if (mci_entry%combined_integration) then
n = get_n_components (mci_entry%real_partition_type)
allocate (i_list (n))
call msg_debug (D_PROCESS_INTEGRATION, &
"mci_entry%real_partition_type", mci_entry%real_partition_type)
select case (mci_entry%real_partition_type)
case (REAL_FULL)
i_list = component_config%get_association_list ()
allocate (mci_entry%i_component (size (i_list)))
mci_entry%i_component = i_list
case (REAL_SINGULAR)
i_list = component_config%get_association_list (ASSOCIATED_REAL_FIN)
allocate (mci_entry%i_component (size(i_list)))
mci_entry%i_component = i_list
case (REAL_FINITE)
allocate (mci_entry%i_component (1))
mci_entry%i_component(1) = &
component_config%get_associated_real_fin () + i_rfin_offset
i_rfin_offset = i_rfin_offset + 1
end select
else
allocate (mci_entry%i_component (1))
mci_entry%i_component(1) = i_component
end if
contains
function get_n_components (damping_type) result (n_components)
integer :: n_components
integer, intent(in) :: damping_type
select case (damping_type)
case (REAL_FULL)
n_components = size (component_config%get_association_list ())
case (REAL_SINGULAR)
n_components = size (component_config%get_association_list &
(ASSOCIATED_REAL_FIN))
end select
call msg_debug (D_PROCESS_INTEGRATION, "n_components", n_components)
end function get_n_components
end subroutine process_mci_entry_create_component_list
@ %def process_mci_entry_create_component_list
@
<<Process mci: process mci entry: TBP>>=
procedure :: set_combined_integration => &
process_mci_entry_set_combined_integration
<<Process mci: procedures>>=
subroutine process_mci_entry_set_combined_integration (mci_entry, value)
class(process_mci_entry_t), intent(inout) :: mci_entry
logical, intent(in), optional :: value
if (present (value)) &
mci_entry%combined_integration = value
end subroutine process_mci_entry_set_combined_integration
@ %def process_mci_entry_set_combined_integration
@
<<Process mci: process mci entry: TBP>>=
procedure :: set_associated_real_component &
=> process_mci_entry_set_associated_real_component
<<Process mci: procedures>>=
subroutine process_mci_entry_set_associated_real_component (mci_entry, i)
class(process_mci_entry_t), intent(inout) :: mci_entry
integer, intent(in) :: i
mci_entry%associated_real_component = i
end subroutine process_mci_entry_set_associated_real_component
@ %def process_mci_entry_set_associated_real_component
@ Set some additional parameters.
<<Process mci: process mci entry: TBP>>=
procedure :: set_parameters => process_mci_entry_set_parameters
<<Process mci: procedures>>=
subroutine process_mci_entry_set_parameters (mci_entry, var_list)
class(process_mci_entry_t), intent(inout) :: mci_entry
type(var_list_t), intent(in) :: var_list
integer :: integration_results_verbosity
real(default) :: error_threshold
integration_results_verbosity = &
var_list%get_ival (var_str ("integration_results_verbosity"))
error_threshold = &
var_list%get_rval (var_str ("error_threshold"))
mci_entry%activate_timer = &
var_list%get_lval (var_str ("?integration_timer"))
call mci_entry%results%set_verbosity (integration_results_verbosity)
call mci_entry%results%set_error_threshold (error_threshold)
end subroutine process_mci_entry_set_parameters
@ %def process_mci_entry_set_parameters
@ Compute an MD5 sum that summarizes all information that could
influence integration results, for the associated process components.
We take the process-configuration MD5 sum which represents parameters,
cuts, etc., the MD5 sums for the process component definitions and
their phase space objects (which should be configured), and the beam
configuration MD5 sum. (The QCD setup is included in the process
configuration data MD5 sum.)
Done only once, when the MD5 sum is still empty.
<<Process mci: process mci entry: TBP>>=
procedure :: compute_md5sum => process_mci_entry_compute_md5sum
<<Process mci: procedures>>=
subroutine process_mci_entry_compute_md5sum (mci_entry, &
config, component, beam_config)
class(process_mci_entry_t), intent(inout) :: mci_entry
type(process_config_data_t), intent(in) :: config
type(process_component_t), dimension(:), intent(in) :: component
type(process_beam_config_t), intent(in) :: beam_config
type(string_t) :: buffer
integer :: i
if (mci_entry%md5sum == "") then
buffer = config%get_md5sum () // beam_config%get_md5sum ()
do i = 1, size (component)
if (component(i)%is_active ()) then
buffer = buffer // component(i)%get_md5sum ()
end if
end do
mci_entry%md5sum = md5sum (char (buffer))
end if
if (allocated (mci_entry%mci)) then
call mci_entry%mci%set_md5sum (mci_entry%md5sum)
end if
end subroutine process_mci_entry_compute_md5sum
@ %def process_mci_entry_compute_md5sum
@ Test the MCI sampler by calling it a given number of time, discarding the
results. The instance should be initialized.
The [[mci_entry]] is [[intent(inout)]] because the integrator contains
the random-number state.
<<Process mci: process mci entry: TBP>>=
procedure :: sampler_test => process_mci_entry_sampler_test
<<Process mci: procedures>>=
subroutine process_mci_entry_sampler_test (mci_entry, mci_sampler, n_calls)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_sampler_t), intent(inout), target :: mci_sampler
integer, intent(in) :: n_calls
call mci_entry%mci%sampler_test (mci_sampler, n_calls)
end subroutine process_mci_entry_sampler_test
@ %def process_mci_entry_sampler_test
@ Integrate.
The [[integrate]] method counts as an integration pass; the pass count is
increased by one. We transfer the pass parameters (number of iterations and
number of calls) to the actual integration routine.
The [[mci_entry]] is [[intent(inout)]] because the integrator contains
the random-number state.
Note: The results are written to screen and to logfile. This behavior
is hardcoded.
<<Process mci: process mci entry: TBP>>=
procedure :: integrate => process_mci_entry_integrate
procedure :: final_integration => process_mci_entry_final_integration
<<Process mci: procedures>>=
subroutine process_mci_entry_integrate (mci_entry, mci_instance, &
mci_sampler, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify, &
nlo_type)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final, pacify
integer, intent(in), optional :: nlo_type
integer :: u_log
u_log = logfile_unit ()
mci_entry%pass = mci_entry%pass + 1
mci_entry%n_it = n_it
mci_entry%n_calls = n_calls
if (mci_entry%pass == 1) &
call mci_entry%mci%startup_message (n_calls = n_calls)
call mci_entry%mci%set_timer (active = mci_entry%activate_timer)
call mci_entry%results%display_init (screen = .true., unit = u_log)
call mci_entry%results%new_pass ()
if (present (nlo_type)) then
select case (nlo_type)
case (NLO_VIRTUAL, NLO_REAL, NLO_MISMATCH, NLO_DGLAP)
mci_instance%negative_weights = .true.
end select
end if
call mci_entry%mci%add_pass (adapt_grids, adapt_weights, final)
call mci_entry%mci%start_timer ()
call mci_entry%mci%integrate (mci_instance, mci_sampler, n_it, &
n_calls, mci_entry%results, pacify = pacify)
call mci_entry%mci%stop_timer ()
if (signal_is_pending ()) return
end subroutine process_mci_entry_integrate
subroutine process_mci_entry_final_integration (mci_entry)
class(process_mci_entry_t), intent(inout) :: mci_entry
call mci_entry%results%display_final ()
call mci_entry%time_message ()
end subroutine process_mci_entry_final_integration
@ %def process_mci_entry_integrate
@ %def process_mci_entry_final_integration
@ If appropriate, issue an informative message about the expected time
for an event sample.
<<Process mci: process mci entry: TBP>>=
procedure :: get_time => process_mci_entry_get_time
procedure :: time_message => process_mci_entry_time_message
<<Process mci: procedures>>=
subroutine process_mci_entry_get_time (mci_entry, time, sample)
class(process_mci_entry_t), intent(in) :: mci_entry
type(time_t), intent(out) :: time
integer, intent(in) :: sample
real(default) :: time_last_pass, efficiency, calls
time_last_pass = mci_entry%mci%get_time ()
calls = mci_entry%results%get_n_calls ()
efficiency = mci_entry%mci%get_efficiency ()
if (time_last_pass > 0 .and. calls > 0 .and. efficiency > 0) then
time = nint (time_last_pass / calls / efficiency * sample)
end if
end subroutine process_mci_entry_get_time
subroutine process_mci_entry_time_message (mci_entry)
class(process_mci_entry_t), intent(in) :: mci_entry
type(time_t) :: time
integer :: sample
sample = 10000
call mci_entry%get_time (time, sample)
if (time%is_known ()) then
call msg_message ("Time estimate for generating 10000 events: " &
// char (time%to_string_dhms ()))
end if
end subroutine process_mci_entry_time_message
@ %def process_mci_entry_time_message
@ Prepare event generation. (For the test integrator, this does nothing. It
is relevant for the VAMP integrator.)
<<Process mci: process mci entry: TBP>>=
procedure :: prepare_simulation => process_mci_entry_prepare_simulation
<<Process mci: procedures>>=
subroutine process_mci_entry_prepare_simulation (mci_entry)
class(process_mci_entry_t), intent(inout) :: mci_entry
call mci_entry%mci%prepare_simulation ()
end subroutine process_mci_entry_prepare_simulation
@ %def process_mci_entry_prepare_simulation
@ Generate an event. The instance should be initialized,
otherwise event generation is directed by the [[mci]] integrator
subobject. The integrator instance is contained in a [[mci_work]]
subobject of the process instance, which simultaneously serves as the
sampler object. (We avoid the anti-aliasing rules if we assume that
the sampling itself does not involve the integrator instance contained in the
process instance.)
Regarding weighted events, we only take events which are valid, which
means that they have valid kinematics and have passed cuts.
Therefore, we have a rejection loop. For unweighted events, the
unweighting routine should already take care of this.
<<Process mci: process mci entry: TBP>>=
procedure :: generate_weighted_event => &
process_mci_entry_generate_weighted_event
procedure :: generate_unweighted_event => &
process_mci_entry_generate_unweighted_event
<<Process mci: procedures>>=
subroutine process_mci_entry_generate_weighted_event (mci_entry, &
mci_instance, mci_sampler, keep_failed)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
logical, intent(in) :: keep_failed
logical :: generate_new
generate_new = .true.
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
generate_new = .true.
end if
else
generate_new = .false.
end if
end do REJECTION
end subroutine process_mci_entry_generate_weighted_event
subroutine process_mci_entry_generate_unweighted_event (mci_entry, mci_instance, mci_sampler)
class(process_mci_entry_t), intent(inout) :: mci_entry
class(mci_instance_t), intent(inout) :: mci_instance
class(mci_sampler_t), intent(inout) :: mci_sampler
call mci_entry%mci%generate_unweighted_event (mci_instance, mci_sampler)
end subroutine process_mci_entry_generate_unweighted_event
@ %def process_mci_entry_generate_weighted_event
@ %def process_mci_entry_generate_unweighted_event
@ Extract results.
<<Process mci: process mci entry: TBP>>=
procedure :: has_integral => process_mci_entry_has_integral
procedure :: get_integral => process_mci_entry_get_integral
procedure :: get_error => process_mci_entry_get_error
procedure :: get_accuracy => process_mci_entry_get_accuracy
procedure :: get_chi2 => process_mci_entry_get_chi2
procedure :: get_efficiency => process_mci_entry_get_efficiency
<<Process mci: procedures>>=
function process_mci_entry_has_integral (mci_entry) result (flag)
class(process_mci_entry_t), intent(in) :: mci_entry
logical :: flag
flag = mci_entry%results%exist ()
end function process_mci_entry_has_integral
function process_mci_entry_get_integral (mci_entry) result (integral)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: integral
integral = mci_entry%results%get_integral ()
end function process_mci_entry_get_integral
function process_mci_entry_get_error (mci_entry) result (error)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: error
error = mci_entry%results%get_error ()
end function process_mci_entry_get_error
function process_mci_entry_get_accuracy (mci_entry) result (accuracy)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: accuracy
accuracy = mci_entry%results%get_accuracy ()
end function process_mci_entry_get_accuracy
function process_mci_entry_get_chi2 (mci_entry) result (chi2)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: chi2
chi2 = mci_entry%results%get_chi2 ()
end function process_mci_entry_get_chi2
function process_mci_entry_get_efficiency (mci_entry) result (efficiency)
class(process_mci_entry_t), intent(in) :: mci_entry
real(default) :: efficiency
efficiency = mci_entry%results%get_efficiency ()
end function process_mci_entry_get_efficiency
@ %def process_mci_entry_get_integral process_mci_entry_get_error
@ %def process_mci_entry_get_accuracy process_mci_entry_get_chi2
@ %def process_mci_entry_get_efficiency
@ Return the MCI checksum. This may be the one used for
configuration, but may also incorporate results, if they change the
state of the integrator (adaptation).
<<Process mci: process mci entry: TBP>>=
procedure :: get_md5sum => process_mci_entry_get_md5sum
<<Process mci: procedures>>=
pure function process_mci_entry_get_md5sum (entry) result (md5sum)
class(process_mci_entry_t), intent(in) :: entry
character(32) :: md5sum
md5sum = entry%mci%get_md5sum ()
end function process_mci_entry_get_md5sum
@ %def process_mci_entry_get_md5sum
@
\subsection{MC parameter set and MCI instance}
For each process component that is associated with a multi-channel integration
(MCI) object, the [[mci_work_t]] object contains the currently active
parameter set. It also holds the implementation of the [[mci_instance_t]]
that the integrator needs for doing its work.
<<Process mci: public>>=
public :: mci_work_t
<<Process mci: types>>=
type :: mci_work_t
type(process_mci_entry_t), pointer :: config => null ()
real(default), dimension(:), allocatable :: x
class(mci_instance_t), pointer :: mci => null ()
type(process_counter_t) :: counter
logical :: keep_failed_events = .false.
contains
<<Process mci: mci work: TBP>>
end type mci_work_t
@ %def mci_work_t
@ First write configuration data, then the current values.
<<Process mci: mci work: TBP>>=
procedure :: write => mci_work_write
<<Process mci: procedures>>=
subroutine mci_work_write (mci_work, unit, testflag)
class(mci_work_t), intent(in) :: mci_work
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A,I0,A)") "Active MCI instance #", &
mci_work%config%i_mci, " ="
write (u, "(2x)", advance="no")
do i = 1, mci_work%config%n_par
write (u, "(1x,F7.5)", advance="no") mci_work%x(i)
if (i == mci_work%config%n_par_sf) &
write (u, "(1x,'|')", advance="no")
end do
write (u, *)
if (associated (mci_work%mci)) then
call mci_work%mci%write (u, pacify = testflag)
call mci_work%counter%write (u)
end if
end subroutine mci_work_write
@ %def mci_work_write
@ The [[mci]] component may require finalization.
<<Process mci: mci work: TBP>>=
procedure :: final => mci_work_final
<<Process mci: procedures>>=
subroutine mci_work_final (mci_work)
class(mci_work_t), intent(inout) :: mci_work
if (associated (mci_work%mci)) then
call mci_work%mci%final ()
deallocate (mci_work%mci)
end if
end subroutine mci_work_final
@ %def mci_work_final
@ Initialize with the maximum length that we will need. Contents are
not initialized.
The integrator inside the [[mci_entry]] object is responsible for
allocating and initializing its own instance, which is referred to by
a pointer in the [[mci_work]] object.
<<Process mci: mci work: TBP>>=
procedure :: init => mci_work_init
<<Process mci: procedures>>=
subroutine mci_work_init (mci_work, mci_entry)
class(mci_work_t), intent(out) :: mci_work
type(process_mci_entry_t), intent(in), target :: mci_entry
mci_work%config => mci_entry
allocate (mci_work%x (mci_entry%n_par))
if (allocated (mci_entry%mci)) then
call mci_entry%mci%allocate_instance (mci_work%mci)
call mci_work%mci%init (mci_entry%mci)
end if
end subroutine mci_work_init
@ %def mci_work_init
@ Set parameters explicitly, either all at once, or separately for the
structure-function and process parts.
<<Process mci: mci work: TBP>>=
procedure :: set => mci_work_set
procedure :: set_x_strfun => mci_work_set_x_strfun
procedure :: set_x_process => mci_work_set_x_process
<<Process mci: procedures>>=
subroutine mci_work_set (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x = x
end subroutine mci_work_set
subroutine mci_work_set_x_strfun (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x(1 : mci_work%config%n_par_sf) = x
end subroutine mci_work_set_x_strfun
subroutine mci_work_set_x_process (mci_work, x)
class(mci_work_t), intent(inout) :: mci_work
real(default), dimension(:), intent(in) :: x
mci_work%x(mci_work%config%n_par_sf + 1 : mci_work%config%n_par) = x
end subroutine mci_work_set_x_process
@ %def mci_work_set
@ %def mci_work_set_x_strfun
@ %def mci_work_set_x_process
@ Return the array of active components, i.e., those that correspond
to the currently selected MC parameter set.
<<Process mci: mci work: TBP>>=
procedure :: get_active_components => mci_work_get_active_components
<<Process mci: procedures>>=
function mci_work_get_active_components (mci_work) result (i_component)
class(mci_work_t), intent(in) :: mci_work
integer, dimension(:), allocatable :: i_component
allocate (i_component (size (mci_work%config%i_component)))
i_component = mci_work%config%i_component
end function mci_work_get_active_components
@ %def mci_work_get_active_components
@ Return the active parameters as a simple array with correct length.
Do this separately for the structure-function parameters and the
process parameters.
<<Process mci: mci work: TBP>>=
procedure :: get_x_strfun => mci_work_get_x_strfun
procedure :: get_x_process => mci_work_get_x_process
<<Process mci: procedures>>=
pure function mci_work_get_x_strfun (mci_work) result (x)
class(mci_work_t), intent(in) :: mci_work
real(default), dimension(mci_work%config%n_par_sf) :: x
x = mci_work%x(1 : mci_work%config%n_par_sf)
end function mci_work_get_x_strfun
pure function mci_work_get_x_process (mci_work) result (x)
class(mci_work_t), intent(in) :: mci_work
real(default), dimension(mci_work%config%n_par_phs) :: x
x = mci_work%x(mci_work%config%n_par_sf + 1 : mci_work%config%n_par)
end function mci_work_get_x_process
@ %def mci_work_get_x_strfun
@ %def mci_work_get_x_process
@ Initialize and finalize event generation for the specified MCI
entry. This also resets the counter.
<<Process mci: mci work: TBP>>=
procedure :: init_simulation => mci_work_init_simulation
procedure :: final_simulation => mci_work_final_simulation
<<Process mci: procedures>>=
subroutine mci_work_init_simulation (mci_work, safety_factor, keep_failed_events)
class(mci_work_t), intent(inout) :: mci_work
real(default), intent(in), optional :: safety_factor
logical, intent(in), optional :: keep_failed_events
call mci_work%mci%init_simulation (safety_factor)
call mci_work%counter%reset ()
if (present (keep_failed_events)) &
mci_work%keep_failed_events = keep_failed_events
end subroutine mci_work_init_simulation
subroutine mci_work_final_simulation (mci_work)
class(mci_work_t), intent(inout) :: mci_work
call mci_work%mci%final_simulation ()
end subroutine mci_work_final_simulation
@ %def mci_work_init_simulation
@ %def mci_work_final_simulation
@ Counter.
<<Process mci: mci work: TBP>>=
procedure :: reset_counter => mci_work_reset_counter
procedure :: record_call => mci_work_record_call
procedure :: get_counter => mci_work_get_counter
<<Process mci: procedures>>=
subroutine mci_work_reset_counter (mci_work)
class(mci_work_t), intent(inout) :: mci_work
call mci_work%counter%reset ()
end subroutine mci_work_reset_counter
subroutine mci_work_record_call (mci_work, status)
class(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: status
call mci_work%counter%record (status)
end subroutine mci_work_record_call
pure function mci_work_get_counter (mci_work) result (counter)
class(mci_work_t), intent(in) :: mci_work
type(process_counter_t) :: counter
counter = mci_work%counter
end function mci_work_get_counter
@ %def mci_work_reset_counter
@ %def mci_work_record_call
@ %def mci_work_get_counter
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process component manager}
<<[[pcm.f90]]>>=
<<File header>>
module pcm
<<Use kinds>>
<<Use strings>>
use constants, only: zero, two
use diagnostics
use lorentz
use io_units, only: free_unit
use process_constants, only: process_constants_t
use physics_defs
use model_data, only: model_data_t
use interactions, only: interaction_t
use quantum_numbers, only: quantum_numbers_t, quantum_numbers_mask_t
use flavors, only: flavor_t
use nlo_data, only: nlo_settings_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 real_subtraction, only: real_subtraction_t, soft_mismatch_t
use real_subtraction, only: FIXED_ORDER_EVENTS, POWHEG
use real_subtraction, only: real_partition_t, powheg_damping_simple_t
use real_subtraction, only: real_partition_fixed_order_t
use virtual, only: virtual_t
use dglap_remnant, only: dglap_remnant_t
use pcm_base
<<Standard module head>>
<<Pcm: public>>
<<Pcm: types>>
contains
<<Pcm: procedures>>
end module pcm
@ %def pcm
\subsection{Default process component manager}
This is the configuration object which has the duty of allocating the
corresponding instance. The default version is trivial.
<<Pcm: public>>=
public :: pcm_default_t
<<Pcm: types>>=
type, extends (pcm_t) :: pcm_default_t
contains
<<Pcm: pcm default: TBP>>
end type pcm_default_t
@ %def pcm_default_t
<<Pcm: pcm default: TBP>>=
procedure :: allocate_instance => pcm_default_allocate_instance
<<Pcm: procedures>>=
subroutine pcm_default_allocate_instance (pcm, instance)
class(pcm_default_t), intent(in) :: pcm
class(pcm_instance_t), intent(inout), allocatable :: instance
allocate (pcm_instance_default_t :: instance)
end subroutine pcm_default_allocate_instance
@ %def pcm_default_allocate_instance
@
<<Pcm: pcm default: TBP>>=
procedure :: final => pcm_default_final
<<Pcm: procedures>>=
subroutine pcm_default_final (pcm)
class(pcm_default_t), intent(inout) :: pcm
end subroutine pcm_default_final
@ %def pcm_default_final
@
<<Pcm: pcm default: TBP>>=
procedure :: is_nlo => pcm_default_is_nlo
<<Pcm: procedures>>=
function pcm_default_is_nlo (pcm) result (is_nlo)
logical :: is_nlo
class(pcm_default_t), intent(in) :: pcm
is_nlo = .false.
end function pcm_default_is_nlo
@ %def pcm_default_is_nlo
@
<<Pcm: types>>=
type, extends (pcm_instance_t) :: pcm_instance_default_t
contains
<<Pcm: pcm instance default: TBP>>
end type pcm_instance_default_t
@ %def pcm_instance_default_t
@
<<Pcm: pcm instance default: TBP>>=
procedure :: final => pcm_instance_default_final
<<Pcm: procedures>>=
subroutine pcm_instance_default_final (pcm_instance)
class(pcm_instance_default_t), intent(inout) :: pcm_instance
end subroutine pcm_instance_default_final
@ %def pcm_instance_default_final
@
\subsection{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(nlo_settings_t) :: settings
type(region_data_t) :: region_data
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
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_n_flv_born => pcm_nlo_get_n_flv_born
<<Pcm: procedures>>=
function pcm_nlo_get_n_flv_born (pcm_nlo) result (n_flv)
integer :: n_flv
class(pcm_nlo_t), intent(in) :: pcm_nlo
n_flv = pcm_nlo%region_data%n_flv_born
end function pcm_nlo_get_n_flv_born
@ %def pcm_nlo_get_n_flv_born
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_n_flv_real => pcm_nlo_get_n_flv_real
<<Pcm: procedures>>=
function pcm_nlo_get_n_flv_real (pcm_nlo) result (n_flv)
integer :: n_flv
class(pcm_nlo_t), intent(in) :: pcm_nlo
n_flv = pcm_nlo%region_data%n_flv_real
end function pcm_nlo_get_n_flv_real
@ %def pcm_nlo_get_n_flv_real
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_n_alr => pcm_nlo_get_n_alr
<<Pcm: procedures>>=
function pcm_nlo_get_n_alr (pcm) result (n_alr)
integer :: n_alr
class(pcm_nlo_t), intent(in) :: pcm
n_alr = pcm%region_data%n_regions
end function pcm_nlo_get_n_alr
@ %def pcm_nlo_get_n_alr
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_flv_states => pcm_nlo_get_flv_states
<<Pcm: procedures>>=
function pcm_nlo_get_flv_states (pcm, born) result (flv)
integer, dimension(:,:), allocatable :: flv
class(pcm_nlo_t), intent(in) :: pcm
logical, intent(in) :: born
if (born) then
flv = pcm%region_data%get_flv_states_born ()
else
flv = pcm%region_data%get_flv_states_real ()
end if
end function pcm_nlo_get_flv_states
@ %def pcm_nlo_get_flv_states
@
<<Pcm: pcm nlo: TBP>>=
procedure :: get_qn => pcm_nlo_get_qn
<<Pcm: procedures>>=
function pcm_nlo_get_qn (pcm, born) result (qn)
type(quantum_numbers_t), dimension(:,:), allocatable :: qn
class(pcm_nlo_t), intent(in) :: pcm
logical, intent(in) :: born
if (born) then
qn = pcm%qn_born
else
qn = pcm%qn_real
end if
end function pcm_nlo_get_qn
@ %def pcm_nlo_get_qn
@ Check if there are massive emitters. Since the mass-structure of all
underlying Born configurations have to be the same (\textbf{This does
not have to be the case when different components are generated at LO})
, we just use the first one to determine this.
<<Pcm: pcm nlo: TBP>>=
procedure :: has_massive_emitter => pcm_nlo_has_massive_emitter
<<Pcm: procedures>>=
function pcm_nlo_has_massive_emitter (pcm) result (val)
logical :: val
class(pcm_nlo_t), intent(in) :: pcm
integer :: i
val = .false.
associate (reg_data => pcm%region_data)
do i = reg_data%n_in + 1, reg_data%n_legs_born
if (any (i == reg_data%emitters)) &
val = val .or. reg_data%flv_born(1)%massive(i)
end do
end associate
end function pcm_nlo_has_massive_emitter
@ %def pcm_nlo_has_massive_emitter
@ Returns an array which specifies if the particle at position [[i]] is massive.
<<Pcm: pcm nlo: TBP>>=
procedure :: get_mass_info => pcm_nlo_get_mass_info
<<Pcm: procedures>>=
function pcm_nlo_get_mass_info (pcm, i_flv) result (massive)
class(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
logical, dimension(:), allocatable :: massive
allocate (massive (size (pcm%region_data%flv_born(i_flv)%massive)))
massive = pcm%region_data%flv_born(i_flv)%massive
end function pcm_nlo_get_mass_info
@ %def pcm_nlo_get_mass_info
@
<<Pcm: pcm nlo: TBP>>=
procedure :: allocate_instance => pcm_nlo_allocate_instance
<<Pcm: procedures>>=
subroutine pcm_nlo_allocate_instance (pcm, instance)
class(pcm_nlo_t), intent(in) :: pcm
class(pcm_instance_t), intent(inout), allocatable :: instance
allocate (pcm_instance_nlo_t :: instance)
end subroutine pcm_nlo_allocate_instance
@ %def pcm_nlo_allocate_instance
@
<<Pcm: pcm nlo: TBP>>=
procedure :: init_qn => pcm_nlo_init_qn
<<Pcm: procedures>>=
subroutine pcm_nlo_init_qn (pcm, model)
class(pcm_nlo_t), intent(inout) :: pcm
class(model_data_t), intent(in) :: model
integer, dimension(:,:), allocatable :: flv_states
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
type(quantum_numbers_t), dimension(:), allocatable :: qn
allocate (flv_states (pcm%region_data%n_legs_born, pcm%region_data%n_flv_born))
flv_states = pcm%get_flv_states (.true.)
allocate (pcm%qn_born (size (flv_states, dim = 1), size (flv_states, dim = 2)))
allocate (flv (size (flv_states, dim = 1)))
allocate (qn (size (flv_states, dim = 1)))
do i = 1, pcm%get_n_flv_born ()
call flv%init (flv_states (:,i), model)
call qn%init (flv)
pcm%qn_born(:,i) = qn
end do
deallocate (flv); deallocate (qn)
deallocate (flv_states)
allocate (flv_states (pcm%region_data%n_legs_real, pcm%region_data%n_flv_real))
flv_states = pcm%get_flv_states (.false.)
allocate (pcm%qn_real (size (flv_states, dim = 1), size (flv_states, dim = 2)))
allocate (flv (size (flv_states, dim = 1)))
allocate (qn (size (flv_states, dim = 1)))
do i = 1, pcm%get_n_flv_real ()
call flv%init (flv_states (:,i), model)
call qn%init (flv)
pcm%qn_real(:,i) = qn
end do
end subroutine pcm_nlo_init_qn
@ %def pcm_nlo_init_qn
@
<<Pcm: pcm nlo: TBP>>=
procedure :: allocate_ps_matching => pcm_nlo_allocate_ps_matching
<<Pcm: procedures>>=
subroutine pcm_nlo_allocate_ps_matching (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
if (.not. allocated (pcm%real_partition)) then
allocate (powheg_damping_simple_t :: pcm%real_partition)
end if
end subroutine pcm_nlo_allocate_ps_matching
@ %def pcm_nlo_allocate_ps_matching
@
<<Pcm: pcm nlo: TBP>>=
procedure :: activate_dalitz_plot => pcm_nlo_activate_dalitz_plot
<<Pcm: procedures>>=
subroutine pcm_nlo_activate_dalitz_plot (pcm, filename)
class(pcm_nlo_t), intent(inout) :: pcm
type(string_t), intent(in) :: filename
call pcm%dalitz_plot%init (free_unit (), filename, .false.)
call pcm%dalitz_plot%write_header ()
end subroutine pcm_nlo_activate_dalitz_plot
@ %def pcm_nlo_activate_dalitz_plot
@
<<Pcm: pcm nlo: TBP>>=
procedure :: setup_real_partition => pcm_nlo_setup_real_partition
<<Pcm: procedures>>=
subroutine pcm_nlo_setup_real_partition (pcm, scale)
class(pcm_nlo_t), intent(inout) :: pcm
real(default), intent(in) :: scale
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 = scale
end select
end if
end subroutine pcm_nlo_setup_real_partition
@ %def pcm_nlo_setup_real_partition
@
<<Pcm: pcm nlo: TBP>>=
procedure :: register_dalitz_plot => pcm_nlo_register_dalitz_plot
<<Pcm: procedures>>=
subroutine pcm_nlo_register_dalitz_plot (pcm, emitter, p)
class(pcm_nlo_t), intent(inout) :: pcm
integer, intent(in) :: emitter
type(vector4_t), intent(in), dimension(:) :: p
real(default) :: k0_n, k0_np1
k0_n = p(emitter)%p(0)
k0_np1 = p(size(p))%p(0)
call pcm%dalitz_plot%register (k0_n, k0_np1)
end subroutine pcm_nlo_register_dalitz_plot
@ %def pcm_nlo_register_dalitz_plot
@
<<Pcm: pcm nlo: TBP>>=
procedure :: setup_phs_generator => pcm_nlo_setup_phs_generator
<<Pcm: procedures>>=
subroutine pcm_nlo_setup_phs_generator (pcm, pcm_instance, generator, &
sqrts, mode, singular_jacobian)
class(pcm_nlo_t), intent(in) :: pcm
type(phs_fks_generator_t), intent(inout) :: generator
type(pcm_instance_nlo_t), intent(in), target :: pcm_instance
real(default), intent(in) :: sqrts
integer, intent(in), optional:: mode
logical, intent(in), optional :: singular_jacobian
logical :: yorn
yorn = .false.; if (present (singular_jacobian)) yorn = singular_jacobian
call generator%connect_kinematics (pcm_instance%isr_kinematics, &
pcm_instance%real_kinematics, pcm%has_massive_emitter ())
generator%n_in = pcm%region_data%n_in
call generator%set_sqrts_hat (sqrts)
call generator%set_emitters (pcm%region_data%emitters)
call generator%setup_masses (pcm%region_data%n_legs_born)
generator%is_massive = pcm%get_mass_info (1)
generator%singular_jacobian = yorn
if (present (mode)) generator%mode = mode
end subroutine pcm_nlo_setup_phs_generator
@ %def pcm_nlo_setup_phs_generator
@
<<Pcm: pcm nlo: TBP>>=
procedure :: final => pcm_nlo_final
<<Pcm: procedures>>=
subroutine pcm_nlo_final (pcm)
class(pcm_nlo_t), intent(inout) :: pcm
if (allocated (pcm%real_partition)) deallocate (pcm%real_partition)
call pcm%dalitz_plot%final ()
end subroutine pcm_nlo_final
@ %def pcm_nlo_final
@
<<Pcm: pcm nlo: TBP>>=
procedure :: is_nlo => pcm_nlo_is_nlo
<<Pcm: procedures>>=
function pcm_nlo_is_nlo (pcm) result (is_nlo)
logical :: is_nlo
class(pcm_nlo_t), intent(in) :: pcm
is_nlo = .true.
end function pcm_nlo_is_nlo
@ %def pcm_nlo_is_nlo
@ As a first implementation, it acts as a wrapper for the NLO controller
object and the squared matrix-element collector.
<<Pcm: public>>=
public :: pcm_instance_nlo_t
<<Pcm: types>>=
type, extends (pcm_instance_t) :: pcm_instance_nlo_t
logical :: use_internal_color_correlation = .true.
type(real_kinematics_t), pointer :: real_kinematics => null ()
type(isr_kinematics_t), pointer :: isr_kinematics => null ()
type(real_subtraction_t) :: real_sub
type(virtual_t) :: virtual
type(soft_mismatch_t) :: soft_mismatch
type(dglap_remnant_t) :: dglap_remnant
integer, dimension(:), allocatable :: i_mci_to_real_component
contains
<<Pcm: pcm instance: TBP>>
end type pcm_instance_nlo_t
@ %def pcm_instance_nlo_t
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_radiation_event => pcm_instance_nlo_set_radiation_event
procedure :: set_subtraction_event => pcm_instance_nlo_set_subtraction_event
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_radiation_event (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%radiation_event = .true.
pcm_instance%real_sub%subtraction_event = .false.
end subroutine pcm_instance_nlo_set_radiation_event
subroutine pcm_instance_nlo_set_subtraction_event (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%radiation_event = .false.
pcm_instance%real_sub%subtraction_event = .true.
end subroutine pcm_instance_nlo_set_subtraction_event
@ %def pcm_instance_nlo_set_radiation_event
@ %def pcm_instance_nlo_set_subtraction_event
<<Pcm: pcm instance: TBP>>=
procedure :: disable_subtraction => pcm_instance_nlo_disable_subtraction
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_disable_subtraction (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%subtraction_deactivated = .true.
end subroutine pcm_instance_nlo_disable_subtraction
@ %def pcm_instance_nlo_disable_subtraction
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_config => pcm_instance_nlo_init_config
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_config (pcm_instance, active_components, &
nlo_types, sqrts, i_real_fin, model)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
logical, intent(in), dimension(:) :: active_components
integer, intent(in), dimension(:) :: nlo_types
real(default), intent(in) :: sqrts
integer, intent(in) :: i_real_fin
class(model_data_t), intent(in) :: model
integer :: i_component
call msg_debug (D_PROCESS_INTEGRATION, "pcm_instance_nlo_init_config")
call pcm_instance%init_real_and_isr_kinematics (sqrts)
select type (pcm => pcm_instance%config)
type is (pcm_nlo_t)
do i_component = 1, size (active_components)
if (active_components(i_component) .or. pcm%settings%combined_integration) then
select case (nlo_types(i_component))
case (NLO_REAL)
if (i_component /= i_real_fin) then
call pcm_instance%setup_real_component &
(pcm%settings%fks_template%subtraction_disabled)
end if
case (NLO_VIRTUAL)
call pcm_instance%init_virtual (model)
case (NLO_MISMATCH)
call pcm_instance%init_soft_mismatch ()
case (NLO_DGLAP)
call pcm_instance%init_dglap_remnant ()
end select
end if
end do
end select
end subroutine pcm_instance_nlo_init_config
@ %def pcm_instance_nlo_init_config
@
<<Pcm: pcm instance: TBP>>=
procedure :: setup_real_component => pcm_instance_nlo_setup_real_component
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_setup_real_component (pcm_instance, &
subtraction_disabled)
class(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
logical, intent(in) :: subtraction_disabled
call pcm_instance%init_real_subtraction ()
if (subtraction_disabled) call pcm_instance%disable_subtraction ()
end subroutine pcm_instance_nlo_setup_real_component
@ %def pcm_instance_nlo_setup_real_component
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_real_and_isr_kinematics => &
pcm_instance_nlo_init_real_and_isr_kinematics
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_real_and_isr_kinematics (pcm_instance, sqrts)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default) :: sqrts
integer :: n_contr
allocate (pcm_instance%real_kinematics)
allocate (pcm_instance%isr_kinematics)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
associate (region_data => config%region_data)
if (allocated (region_data%alr_contributors)) then
n_contr = size (region_data%alr_contributors)
else if (config%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
n_contr = 2
else
n_contr = 1
end if
call pcm_instance%real_kinematics%init &
(region_data%n_legs_real, region_data%n_phs, &
region_data%n_regions, n_contr)
if (config%settings%factorization_mode == FACTORIZATION_THRESHOLD) &
call pcm_instance%real_kinematics%init_onshell &
(region_data%n_legs_real, region_data%n_phs)
pcm_instance%isr_kinematics%n_in = region_data%n_in
end associate
end select
pcm_instance%isr_kinematics%beam_energy = sqrts / two
end subroutine pcm_instance_nlo_init_real_and_isr_kinematics
@ %def pcm_instance_nlo_init_real_and_isr_kinematics
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_real_and_isr_kinematics => &
pcm_instance_nlo_set_real_and_isr_kinematics
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_real_and_isr_kinematics (pcm_instance, phs_identifiers, sqrts)
class(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
real(default), intent(in) :: sqrts
call pcm_instance%real_sub%set_real_kinematics &
(pcm_instance%real_kinematics)
call pcm_instance%real_sub%set_isr_kinematics &
(pcm_instance%isr_kinematics)
end subroutine pcm_instance_nlo_set_real_and_isr_kinematics
@ %def pcm_instance_nlo_set_real_and_isr_kinematics
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_real_subtraction => pcm_instance_nlo_init_real_subtraction
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_real_subtraction (pcm_instance)
class(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
associate (region_data => config%region_data)
call pcm_instance%real_sub%init (region_data, config%settings)
if (allocated (config%settings%selected_alr)) then
associate (selected_alr => config%settings%selected_alr)
if (any (selected_alr < 0)) then
call msg_fatal ("Fixed alpha region must be non-negative!")
else if (any (selected_alr > region_data%n_regions)) then
call msg_fatal ("Fixed alpha region is larger than the total"&
&" number of singular regions!")
else
allocate (pcm_instance%real_sub%selected_alr (size (selected_alr)))
pcm_instance%real_sub%selected_alr = selected_alr
end if
end associate
end if
end associate
end select
end subroutine pcm_instance_nlo_init_real_subtraction
@ %def pcm_instance_nlo_init_real_subtraction
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_momenta_and_scales_virtual => &
pcm_instance_nlo_set_momenta_and_scales_virtual
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_momenta_and_scales_virtual (pcm_instance, p, &
ren_scale, fac_scale)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in) :: ren_scale, fac_scale
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
associate (virtual => pcm_instance%virtual)
call virtual%set_ren_scale (p, ren_scale)
call virtual%set_fac_scale (p, fac_scale)
call virtual%set_ellis_sexton_scale ()
end associate
end select
end subroutine pcm_instance_nlo_set_momenta_and_scales_virtual
@ %def pcm_instance_nlo_set_momenta_and_scales_virtual
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_fac_scale => pcm_instance_nlo_set_fac_scale
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_fac_scale (pcm_instance, fac_scale)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default), intent(in) :: fac_scale
pcm_instance%isr_kinematics%fac_scale = fac_scale
end subroutine pcm_instance_nlo_set_fac_scale
@ %def pcm_instance_nlo_set_fac_scale
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_momenta => pcm_instance_nlo_set_momenta
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_momenta (pcm_instance, p_born, p_real, i_phs, cms)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
type(vector4_t), dimension(:), intent(in) :: p_born, p_real
integer, intent(in) :: i_phs
logical, intent(in), optional :: cms
logical :: yorn
yorn = .false.; if (present (cms)) yorn = cms
associate (kinematics => pcm_instance%real_kinematics)
if (yorn) then
if (.not. kinematics%p_born_cms%initialized) &
call kinematics%p_born_cms%init (size (p_born), 1)
if (.not. kinematics%p_real_cms%initialized) &
call kinematics%p_real_cms%init (size (p_real), 1)
kinematics%p_born_cms%phs_point(1)%p = p_born
kinematics%p_real_cms%phs_point(i_phs)%p = p_real
else
if (.not. kinematics%p_born_lab%initialized) &
call kinematics%p_born_lab%init (size (p_born), 1)
if (.not. kinematics%p_real_lab%initialized) &
call kinematics%p_real_lab%init (size (p_real), 1)
kinematics%p_born_lab%phs_point(1)%p = p_born
kinematics%p_real_lab%phs_point(i_phs)%p = p_real
end if
end associate
end subroutine pcm_instance_nlo_set_momenta
@ %def pcm_instance_nlo_set_momenta
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_momenta => pcm_instance_nlo_get_momenta
<<Pcm: procedures>>=
function pcm_instance_nlo_get_momenta (pcm_instance, i_phs, born_phsp, cms) result (p)
type(vector4_t), dimension(:), allocatable :: p
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
integer, intent(in) :: i_phs
logical, intent(in) :: born_phsp
logical, intent(in), optional :: cms
logical :: yorn
yorn = .false.; if (present (cms)) yorn = cms
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (born_phsp) then
if (yorn) then
allocate (p (1 : config%region_data%n_legs_born), &
source = pcm_instance%real_kinematics%p_born_cms%phs_point(1)%p)
else
allocate (p (1 : config%region_data%n_legs_born), &
source = pcm_instance%real_kinematics%p_born_lab%phs_point(1)%p)
end if
else
if (yorn) then
allocate (p (1 : config%region_data%n_legs_real), &
source = pcm_instance%real_kinematics%p_real_cms%phs_point(i_phs)%p)
else
allocate (p ( 1 : config%region_data%n_legs_real), &
source = pcm_instance%real_kinematics%p_real_lab%phs_point(i_phs)%p)
end if
end if
end select
end function pcm_instance_nlo_get_momenta
@ %def pcm_instance_nlo_get_momenta
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_xi_max => pcm_instance_nlo_get_xi_max
<<Pcm: procedures>>=
function pcm_instance_nlo_get_xi_max (pcm_instance, alr) result (xi_max)
real(default) :: xi_max
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
integer, intent(in) :: alr
integer :: i_phs
i_phs = pcm_instance%real_kinematics%alr_to_i_phs (alr)
xi_max = pcm_instance%real_kinematics%xi_max (i_phs)
end function pcm_instance_nlo_get_xi_max
@ %def pcm_instance_nlo_get_xi_max
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_n_born => pcm_instance_nlo_get_n_born
<<Pcm: procedures>>=
function pcm_instance_nlo_get_n_born (pcm_instance) result (n_born)
integer :: n_born
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
n_born = config%region_data%n_legs_born
end select
end function pcm_instance_nlo_get_n_born
@ %def pcm_instance_nlo_get_n_born
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_n_real => pcm_instance_nlo_get_n_real
<<Pcm: procedures>>=
function pcm_instance_nlo_get_n_real (pcm_instance) result (n_real)
integer :: n_real
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
n_real = config%region_data%n_legs_real
end select
end function pcm_instance_nlo_get_n_real
@ %def pcm_instance_nlo_get_n_real
@
<<Pcm: pcm instance: TBP>>=
procedure :: get_n_regions => pcm_instance_nlo_get_n_regions
<<Pcm: procedures>>=
function pcm_instance_nlo_get_n_regions (pcm_instance) result (n_regions)
integer :: n_regions
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
n_regions = config%region_data%n_regions
end select
end function pcm_instance_nlo_get_n_regions
@ %def pcm_instance_nlo_get_n_regions
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_x_rad => pcm_instance_nlo_set_x_rad
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_x_rad (pcm_instance, x_tot)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default), intent(in), dimension(:) :: x_tot
integer :: n_par
n_par = size (x_tot)
if (n_par < 3) then
pcm_instance%real_kinematics%x_rad = zero
else
pcm_instance%real_kinematics%x_rad = x_tot (n_par - 2 : n_par)
end if
end subroutine pcm_instance_nlo_set_x_rad
@ %def pcm_instance_nlo_set_x_rad
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_virtual => pcm_instance_nlo_init_virtual
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_virtual (pcm_instance, model)
class(pcm_instance_nlo_t), intent(inout), target :: pcm_instance
class(model_data_t), intent(in) :: model
type(nlo_settings_t), pointer :: settings
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
associate (region_data => config%region_data)
settings => config%settings
call pcm_instance%virtual%init (region_data%get_flv_states_born (), &
region_data%n_in, settings, &
region_data%regions(1)%nlo_correction_type, model, config%has_pdfs)
end associate
end select
end subroutine pcm_instance_nlo_init_virtual
@ %def pcm_instance_nlo_init_virtual
@
<<Pcm: pcm instance: TBP>>=
procedure :: disable_virtual_subtraction => pcm_instance_nlo_disable_virtual_subtraction
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_disable_virtual_subtraction (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
end subroutine pcm_instance_nlo_disable_virtual_subtraction
@ %def pcm_instance_nlo_disable_virtual_subtraction
@
<<Pcm: pcm instance: TBP>>=
procedure :: compute_sqme_virt => pcm_instance_nlo_compute_sqme_virt
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_compute_sqme_virt (pcm_instance, p, &
alpha_coupling, separate_alrs, sqme_virt)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
type(vector4_t), intent(in), dimension(:) :: p
real(default), intent(in) :: alpha_coupling
logical, intent(in) :: separate_alrs
real(default), dimension(:), allocatable, intent(inout) :: sqme_virt
type(vector4_t), dimension(:), allocatable :: pp
associate (virtual => pcm_instance%virtual)
allocate (pp (size (p)))
if (virtual%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
pp = pcm_instance%real_kinematics%p_born_onshell%get_momenta (1)
else
pp = p
end if
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (separate_alrs) then
allocate (sqme_virt (config%get_n_flv_born ()))
else
allocate (sqme_virt (1))
end if
sqme_virt = zero
call virtual%evaluate (config%region_data, &
alpha_coupling, pp, separate_alrs, sqme_virt)
end select
end associate
end subroutine pcm_instance_nlo_compute_sqme_virt
@ %def pcm_instance_nlo_compute_sqme_virt
@
<<Pcm: pcm instance: TBP>>=
procedure :: compute_sqme_mismatch => pcm_instance_nlo_compute_sqme_mismatch
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_compute_sqme_mismatch (pcm_instance, &
alpha_s, separate_alrs, sqme_mism)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default), intent(in) :: alpha_s
logical, intent(in) :: separate_alrs
real(default), dimension(:), allocatable, intent(inout) :: sqme_mism
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (separate_alrs) then
allocate (sqme_mism (config%get_n_flv_born ()))
else
allocate (sqme_mism (1))
end if
sqme_mism = zero
sqme_mism = pcm_instance%soft_mismatch%evaluate (alpha_s)
end select
end subroutine pcm_instance_nlo_compute_sqme_mismatch
@ %def pcm_instance_nlo_compute_sqme_mismatch
@
<<Pcm: pcm instance: TBP>>=
procedure :: compute_sqme_dglap_remnant => pcm_instance_nlo_compute_sqme_dglap_remnant
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_compute_sqme_dglap_remnant (pcm_instance, &
alpha_s, separate_alrs, sqme_dglap)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
real(default), intent(in) :: alpha_s
logical, intent(in) :: separate_alrs
real(default), dimension(:), allocatable, intent(inout) :: sqme_dglap
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (separate_alrs) then
allocate (sqme_dglap (config%get_n_flv_born ()))
else
allocate (sqme_dglap (1))
end if
end select
sqme_dglap = zero
call pcm_instance%dglap_remnant%evaluate (alpha_s, separate_alrs, sqme_dglap)
end subroutine pcm_instance_nlo_compute_sqme_dglap_remnant
@ %def pcm_instance_nlo_compute_sqme_dglap_remnant
@
<<Pcm: pcm instance: TBP>>=
procedure :: set_fixed_order_event_mode => pcm_instance_nlo_set_fixed_order_event_mode
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_fixed_order_event_mode (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%purpose = FIXED_ORDER_EVENTS
end subroutine pcm_instance_nlo_set_fixed_order_event_mode
<<Pcm: pcm instance: TBP>>=
procedure :: set_powheg_mode => pcm_instance_nlo_set_powheg_mode
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_set_powheg_mode (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
pcm_instance%real_sub%purpose = POWHEG
end subroutine pcm_instance_nlo_set_powheg_mode
@ %def pcm_instance_nlo_set_fixed_order_event_mode
@ %def pcm_instance_nlo_set_powheg_mode
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_soft_mismatch => pcm_instance_nlo_init_soft_mismatch
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_soft_mismatch (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
call pcm_instance%soft_mismatch%init (config%region_data, &
pcm_instance%real_kinematics, config%settings%factorization_mode)
end select
end subroutine pcm_instance_nlo_init_soft_mismatch
@ %def pcm_instance_nlo_init_soft_mismatch
@
<<Pcm: pcm instance: TBP>>=
procedure :: init_dglap_remnant => pcm_instance_nlo_init_dglap_remnant
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_init_dglap_remnant (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
call pcm_instance%dglap_remnant%init ( &
config%settings, &
config%region_data%n_flv_born, &
pcm_instance%isr_kinematics, &
config%region_data%get_flv_states_born (), config%get_n_alr ())
end select
end subroutine pcm_instance_nlo_init_dglap_remnant
@ %def pcm_instance_nlo_init_dglap_remnant
@
<<Pcm: pcm instance: TBP>>=
procedure :: is_fixed_order_nlo_events &
=> pcm_instance_nlo_is_fixed_order_nlo_events
<<Pcm: procedures>>=
function pcm_instance_nlo_is_fixed_order_nlo_events (pcm_instance) result (is_nlo)
logical :: is_nlo
class(pcm_instance_nlo_t), intent(in) :: pcm_instance
is_nlo = pcm_instance%real_sub%purpose == FIXED_ORDER_EVENTS
end function pcm_instance_nlo_is_fixed_order_nlo_events
@ %def pcm_instance_nlo_is_fixed_order_nlo_events
@
<<Pcm: pcm instance: TBP>>=
procedure :: final => pcm_instance_nlo_final
<<Pcm: procedures>>=
subroutine pcm_instance_nlo_final (pcm_instance)
class(pcm_instance_nlo_t), intent(inout) :: pcm_instance
call pcm_instance%real_sub%final ()
call pcm_instance%virtual%final ()
call pcm_instance%soft_mismatch%final ()
call pcm_instance%dglap_remnant%final ()
if (associated (pcm_instance%real_kinematics)) then
call pcm_instance%real_kinematics%final ()
nullify (pcm_instance%real_kinematics)
end if
if (associated (pcm_instance%isr_kinematics)) then
nullify (pcm_instance%isr_kinematics)
end if
end subroutine pcm_instance_nlo_final
@ %def pcm_instance_nlo_final
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Kinematics instance}
In this data type we combine all objects (instances) necessary for
generating (or recovering) a kinematical configuration. The
components work together as an implementation of multi-channel phase
space.
[[sf_chain]] is an instance of the structure-function chain. It is
used both for generating kinematics and, after the proper scale has
been determined, evaluating the structure function entries.
[[phs]] is an instance of the phase space for the elementary process.
The array [[f]] contains the products of the Jacobians that originate
from parameter mappings in the structure-function chain or in the
phase space. We allocate this explicitly if either [[sf_chain]] or
[[phs]] are explicitly allocated, otherwise we can take over a pointer.
All components are implemented as pointers to (anonymous) targets.
For each component, there is a flag that tells whether this component
is to be regarded as a proper component (`owned' by the object) or as
a pointer.
@
<<[[kinematics.f90]]>>=
<<File header>>
module kinematics
<<Use kinds>>
use format_utils, only: write_separator
use diagnostics
use io_units
use lorentz
use physics_defs
use sf_base
use phs_base
use interactions
use mci_base
use phs_fks
use fks_regions
use process_config
use process_mci
use pcm, only: pcm_instance_nlo_t
use ttv_formfactors, only: m1s_to_mpole
<<Standard module head>>
<<Kinematics: public>>
<<Kinematics: types>>
contains
<<Kinematics: procedures>>
end module kinematics
@ %def kinematics
<<Kinematics: public>>=
public :: kinematics_t
<<Kinematics: types>>=
type :: kinematics_t
integer :: n_in = 0
integer :: n_channel = 0
integer :: selected_channel = 0
type(sf_chain_instance_t), pointer :: sf_chain => null ()
class(phs_t), pointer :: phs => null ()
real(default), dimension(:), pointer :: f => null ()
real(default) :: phs_factor
logical :: sf_chain_allocated = .false.
logical :: phs_allocated = .false.
logical :: f_allocated = .false.
integer :: emitter = -1
integer :: i_phs = 0
integer :: i_con = 0
logical :: only_cm_frame = .false.
logical :: new_seed = .true.
logical :: threshold = .false.
contains
<<Kinematics: kinematics: TBP>>
end type kinematics_t
@ %def kinematics_t
@ Output. Show only those components which are marked as owned.
<<Kinematics: kinematics: TBP>>=
procedure :: write => kinematics_write
<<Kinematics: procedures>>=
subroutine kinematics_write (object, unit)
class(kinematics_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, c
u = given_output_unit (unit)
if (object%f_allocated) then
write (u, "(1x,A)") "Flux * PHS volume:"
write (u, "(2x,ES19.12)") object%phs_factor
write (u, "(1x,A)") "Jacobian factors per channel:"
do c = 1, size (object%f)
write (u, "(3x,I0,':',1x,ES14.7)", advance="no") c, object%f(c)
if (c == object%selected_channel) then
write (u, "(1x,A)") "[selected]"
else
write (u, *)
end if
end do
end if
if (object%sf_chain_allocated) then
call write_separator (u)
call object%sf_chain%write (u)
end if
if (object%phs_allocated) then
call write_separator (u)
call object%phs%write (u)
end if
end subroutine kinematics_write
@ %def kinematics_write
@ Finalizer. Delete only those components which are marked as owned.
<<Kinematics: kinematics: TBP>>=
procedure :: final => kinematics_final
<<Kinematics: procedures>>=
subroutine kinematics_final (object)
class(kinematics_t), intent(inout) :: object
if (object%sf_chain_allocated) then
call object%sf_chain%final ()
deallocate (object%sf_chain)
object%sf_chain_allocated = .false.
end if
if (object%phs_allocated) then
call object%phs%final ()
deallocate (object%phs)
object%phs_allocated = .false.
end if
if (object%f_allocated) then
deallocate (object%f)
object%f_allocated = .false.
end if
end subroutine kinematics_final
@ %def kinematics_final
@ Set the flags indicating whether the phase space shall be set up for the calculation of the real contribution. For this case, also set the emitter.
<<Kinematics: kinematics: TBP>>=
procedure :: set_nlo_info => kinematics_set_nlo_info
<<Kinematics: procedures>>=
subroutine kinematics_set_nlo_info (k, nlo_type)
class(kinematics_t), intent(inout) :: k
integer, intent(in) :: nlo_type
if (nlo_type == NLO_VIRTUAL) k%only_cm_frame = .true.
end subroutine kinematics_set_nlo_info
@ %def kinematics_set_nlo_info
@ Allocate the structure-function chain instance, initialize it as a
copy of the [[sf_chain]] template, and prepare it for evaluation.
The [[sf_chain]] remains a target because the (usually constant) beam momenta
are taken from there.
<<Kinematics: kinematics: TBP>>=
procedure :: init_sf_chain => kinematics_init_sf_chain
<<Kinematics: procedures>>=
subroutine kinematics_init_sf_chain (k, sf_chain, config, extended_sf)
class(kinematics_t), intent(inout) :: k
type(sf_chain_t), intent(in), target :: sf_chain
type(process_beam_config_t), intent(in) :: config
logical, intent(in), optional :: extended_sf
integer :: n_strfun, n_channel
integer :: c
k%n_in = config%data%get_n_in ()
n_strfun = config%n_strfun
n_channel = config%n_channel
allocate (k%sf_chain)
k%sf_chain_allocated = .true.
call k%sf_chain%init (sf_chain, n_channel)
if (n_strfun /= 0) then
do c = 1, n_channel
call k%sf_chain%set_channel (c, config%sf_channel(c))
end do
end if
call k%sf_chain%link_interactions ()
call k%sf_chain%exchange_mask ()
call k%sf_chain%init_evaluators (extended_sf = extended_sf)
end subroutine kinematics_init_sf_chain
@ %def kinematics_init_sf_chain
@ Allocate and initialize the phase-space part and the array of
Jacobian factors.
<<Kinematics: kinematics: TBP>>=
procedure :: init_phs => kinematics_init_phs
<<Kinematics: procedures>>=
subroutine kinematics_init_phs (k, config)
class(kinematics_t), intent(inout) :: k
class(phs_config_t), intent(in), target :: config
k%n_channel = config%get_n_channel ()
call config%allocate_instance (k%phs)
call k%phs%init (config)
k%phs_allocated = .true.
allocate (k%f (k%n_channel))
k%f = 0
k%f_allocated = .true.
end subroutine kinematics_init_phs
@ %def kinematics_init_phs
@
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_radiation_kinematics => kinematics_evaluate_radiation_kinematics
<<Kinematics: procedures>>=
subroutine kinematics_evaluate_radiation_kinematics (k, r_in)
class(kinematics_t), intent(inout) :: k
real(default), intent(in), dimension(:) :: r_in
select type (phs => k%phs)
type is (phs_fks_t)
call phs%generate_radiation_variables &
(r_in(phs%n_r_born + 1 : phs%n_r_born + 3), k%threshold)
call phs%compute_cms_energy ()
end select
end subroutine kinematics_evaluate_radiation_kinematics
@ %def kinematics_evaluate_radiation_kinematics
@
<<Kinematics: kinematics: TBP>>=
procedure :: compute_xi_ref_momenta => kinematics_compute_xi_ref_momenta
<<Kinematics: procedures>>=
subroutine kinematics_compute_xi_ref_momenta (k, reg_data, nlo_type)
class(kinematics_t), intent(inout) :: k
type(region_data_t), intent(in) :: reg_data
integer, intent(in) :: nlo_type
logical :: use_contributors
use_contributors = allocated (reg_data%alr_contributors)
select type (phs => k%phs)
type is (phs_fks_t)
if (use_contributors) then
call phs%compute_xi_ref_momenta (contributors = reg_data%alr_contributors)
else if (k%threshold) then
if (.not. is_subtraction_component (k%emitter, nlo_type)) &
call phs%compute_xi_ref_momenta_threshold ()
else
call phs%compute_xi_ref_momenta ()
end if
end select
end subroutine kinematics_compute_xi_ref_momenta
@ %def kinematics_compute_xi_ref_momenta
@ Generate kinematics, given a phase-space channel and a MC
parameter set. The main result is the momentum array [[p]], but we
also fill the momentum entries in the structure-function chain and the
Jacobian-factor array [[f]]. Regarding phase space, We fill only the
parameter arrays for the selected channel.
<<Kinematics: kinematics: TBP>>=
procedure :: compute_selected_channel => kinematics_compute_selected_channel
<<Kinematics: procedures>>=
subroutine kinematics_compute_selected_channel &
(k, mci_work, phs_channel, p, success)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
type(vector4_t), dimension(:), intent(out) :: p
logical, intent(out) :: success
integer :: sf_channel
k%selected_channel = phs_channel
sf_channel = k%phs%config%get_sf_channel (phs_channel)
call k%sf_chain%compute_kinematics (sf_channel, mci_work%get_x_strfun ())
call k%sf_chain%get_out_momenta (p(1:k%n_in))
call k%phs%set_incoming_momenta (p(1:k%n_in))
call k%phs%compute_flux ()
call k%phs%select_channel (phs_channel)
call k%phs%evaluate_selected_channel (phs_channel, &
mci_work%get_x_process ())
select type (phs => k%phs)
type is (phs_fks_t)
if (phs%q_defined) then
call phs%get_born_momenta (p)
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.
if (k%only_cm_frame) then
if (.not. k%lab_is_cm_frame()) &
call k%boost_to_cm_frame (p)
end if
else
k%phs_factor = 0
success = .false.
end if
end select
end subroutine kinematics_compute_selected_channel
@ %def kinematics_compute_selected_channel
@ Complete kinematics by filling the non-selected phase-space parameter
arrays.
<<Kinematics: kinematics: TBP>>=
procedure :: compute_other_channels => kinematics_compute_other_channels
<<Kinematics: procedures>>=
subroutine kinematics_compute_other_channels (k, mci_work, phs_channel)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
integer :: c, c_sf
call k%phs%evaluate_other_channels (phs_channel)
do c = 1, k%n_channel
c_sf = k%phs%config%get_sf_channel (c)
k%f(c) = k%sf_chain%get_f (c_sf) * k%phs%get_f (c)
end do
end subroutine kinematics_compute_other_channels
@ %def kinematics_compute_other_channels
@ Just fetch the outgoing momenta of the [[sf_chain]] subobject, which
become the incoming (seed) momenta of the hard interaction.
This is a stripped down-version of the above which we use when
recovering kinematics. Momenta are known, but no MC parameters yet.
(We do not use the [[get_out_momenta]] method of the chain, since this
relies on the structure-function interactions, which are not necessary
filled here. We do rely on the momenta of the last evaluator in the
chain, however.)
<<Kinematics: kinematics: TBP>>=
procedure :: get_incoming_momenta => kinematics_get_incoming_momenta
<<Kinematics: procedures>>=
subroutine kinematics_get_incoming_momenta (k, p)
class(kinematics_t), intent(in) :: k
type(vector4_t), dimension(:), intent(out) :: p
type(interaction_t), pointer :: int
integer :: i
int => k%sf_chain%get_out_int_ptr ()
do i = 1, k%n_in
p(i) = int%get_momentum (k%sf_chain%get_out_i (i))
end do
end subroutine kinematics_get_incoming_momenta
@ %def kinematics_get_incoming_momenta
@ This inverts the remainder of the above [[compute]] method. We know
the momenta and recover the rest, as far as needed. If we select a
channel, we can complete the inversion and reconstruct the
MC parameter set.
<<Kinematics: kinematics: TBP>>=
procedure :: recover_mcpar => kinematics_recover_mcpar
<<Kinematics: procedures>>=
subroutine kinematics_recover_mcpar (k, mci_work, phs_channel, p)
class(kinematics_t), intent(inout) :: k
type(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: phs_channel
type(vector4_t), dimension(:), intent(in) :: p
integer :: c, c_sf
real(default), dimension(:), allocatable :: x_sf, x_phs
c = phs_channel
c_sf = k%phs%config%get_sf_channel (c)
k%selected_channel = c
call k%sf_chain%recover_kinematics (c_sf)
call k%phs%set_incoming_momenta (p(1:k%n_in))
call k%phs%compute_flux ()
call k%phs%set_outgoing_momenta (p(k%n_in+1:))
call k%phs%inverse ()
do c = 1, k%n_channel
c_sf = k%phs%config%get_sf_channel (c)
k%f(c) = k%sf_chain%get_f (c_sf) * k%phs%get_f (c)
end do
k%phs_factor = k%phs%get_overall_factor ()
c = phs_channel
c_sf = k%phs%config%get_sf_channel (c)
allocate (x_sf (k%sf_chain%config%get_n_bound ()))
allocate (x_phs (k%phs%config%get_n_par ()))
call k%phs%select_channel (c)
call k%sf_chain%get_mcpar (c_sf, x_sf)
call k%phs%get_mcpar (c, x_phs)
call mci_work%set_x_strfun (x_sf)
call mci_work%set_x_process (x_phs)
end subroutine kinematics_recover_mcpar
@ %def kinematics_recover_mcpar
@ This first part of [[recover_mcpar]]: just handle the sfchain.
<<Kinematics: kinematics: TBP>>=
procedure :: recover_sfchain => kinematics_recover_sfchain
<<Kinematics: procedures>>=
subroutine kinematics_recover_sfchain (k, channel, p)
class(kinematics_t), intent(inout) :: k
integer, intent(in) :: channel
type(vector4_t), dimension(:), intent(in) :: p
k%selected_channel = channel
call k%sf_chain%recover_kinematics (channel)
end subroutine kinematics_recover_sfchain
@ %def kinematics_recover_sfchain
@ Retrieve the MC input parameter array for a specific channel. We assume
that the kinematics is complete, so this is known for all channels.
<<Kinematics: kinematics: TBP>>=
procedure :: get_mcpar => kinematics_get_mcpar
<<Kinematics: procedures>>=
subroutine kinematics_get_mcpar (k, phs_channel, r)
class(kinematics_t), intent(in) :: k
integer, intent(in) :: phs_channel
real(default), dimension(:), intent(out) :: r
integer :: sf_channel, n_par_sf, n_par_phs
sf_channel = k%phs%config%get_sf_channel (phs_channel)
n_par_phs = k%phs%config%get_n_par ()
n_par_sf = k%sf_chain%config%get_n_bound ()
if (n_par_sf > 0) then
call k%sf_chain%get_mcpar (sf_channel, r(1:n_par_sf))
end if
if (n_par_phs > 0) then
call k%phs%get_mcpar (phs_channel, r(n_par_sf+1:))
end if
end subroutine kinematics_get_mcpar
@ %def kinematics_get_mcpar
@ Evaluate the structure function chain, assuming that kinematics is known.
The status must be precisely [[SF_DONE_KINEMATICS]]. We thus avoid
evaluating the chain twice via different pointers to the same target.
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_sf_chain => kinematics_evaluate_sf_chain
<<Kinematics: procedures>>=
subroutine kinematics_evaluate_sf_chain (k, fac_scale, sf_rescale)
class(kinematics_t), intent(inout) :: k
real(default), intent(in) :: fac_scale
class(sf_rescale_t), intent(inout), optional :: sf_rescale
select case (k%sf_chain%get_status ())
case (SF_DONE_KINEMATICS)
call k%sf_chain%evaluate (fac_scale, sf_rescale)
end select
end subroutine kinematics_evaluate_sf_chain
@ %def kinematics_evaluate_sf_chain
@ Recover beam momenta, i.e., return the beam momenta stored in the
current [[sf_chain]] to their source. This is a side effect.
<<Kinematics: kinematics: TBP>>=
procedure :: return_beam_momenta => kinematics_return_beam_momenta
<<Kinematics: procedures>>=
subroutine kinematics_return_beam_momenta (k)
class(kinematics_t), intent(in) :: k
call k%sf_chain%return_beam_momenta ()
end subroutine kinematics_return_beam_momenta
@ %def kinematics_return_beam_momenta
@ Check wether the phase space is configured in the center-of-mass frame.
Relevant for using the proper momenta input for BLHA matrix elements.
<<Kinematics: kinematics: TBP>>=
procedure :: lab_is_cm_frame => kinematics_lab_is_cm_frame
<<Kinematics: procedures>>=
function kinematics_lab_is_cm_frame (k) result (cm_frame)
logical :: cm_frame
class(kinematics_t), intent(in) :: k
cm_frame = k%phs%config%cm_frame
end function kinematics_lab_is_cm_frame
@ %def kinematics_lab_is_cm_frame
@ Boost to center-of-mass frame
<<Kinematics: kinematics: TBP>>=
procedure :: boost_to_cm_frame => kinematics_boost_to_cm_frame
<<Kinematics: procedures>>=
subroutine kinematics_boost_to_cm_frame (k, p)
class(kinematics_t), intent(in) :: k
type(vector4_t), intent(inout), dimension(:) :: p
p = inverse (k%phs%lt_cm_to_lab) * p
end subroutine kinematics_boost_to_cm_frame
@ %def kinematics_boost_to_cm_frame
@
<<Kinematics: kinematics: TBP>>=
procedure :: modify_momenta_for_subtraction => kinematics_modify_momenta_for_subtraction
<<Kinematics: procedures>>=
subroutine kinematics_modify_momenta_for_subtraction (k, p_in, p_out)
class(kinematics_t), intent(inout) :: k
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:), allocatable :: p_out
allocate (p_out (size (p_in)))
if (k%threshold) then
select type (phs => k%phs)
type is (phs_fks_t)
p_out = phs%get_onshell_projected_momenta ()
end select
else
p_out = p_in
end if
end subroutine kinematics_modify_momenta_for_subtraction
@ %def kinematics_modify_momenta_for_subtraction
@
<<Kinematics: kinematics: TBP>>=
procedure :: threshold_projection => kinematics_threshold_projection
<<Kinematics: procedures>>=
subroutine kinematics_threshold_projection (k, pcm_instance, nlo_type)
class(kinematics_t), intent(inout) :: k
type(pcm_instance_nlo_t), intent(inout) :: pcm_instance
integer, intent(in) :: nlo_type
real(default) :: sqrts, mtop
type(lorentz_transformation_t) :: L_to_cms
type(vector4_t), dimension(:), allocatable :: p_tot
integer :: n_tot
n_tot = k%phs%get_n_tot ()
allocate (p_tot (size (pcm_instance%real_kinematics%p_born_cms%phs_point(1)%p)))
select type (phs => k%phs)
type is (phs_fks_t)
p_tot = pcm_instance%real_kinematics%p_born_cms%phs_point(1)%p
class default
p_tot(1 : k%n_in) = phs%p
p_tot(k%n_in + 1 : n_tot) = phs%q
end select
sqrts = sum (p_tot (1:k%n_in))**1
mtop = m1s_to_mpole (sqrts)
L_to_cms = get_boost_for_threshold_projection (p_tot, sqrts, mtop)
call pcm_instance%real_kinematics%p_born_cms%set_momenta (1, p_tot)
associate (p_onshell => pcm_instance%real_kinematics%p_born_onshell%phs_point(1)%p)
call threshold_projection_born (mtop, L_to_cms, p_tot, p_onshell)
if (debug2_active (D_THRESHOLD)) then
print *, 'On-shell projected Born: '
call vector4_write_set (p_onshell)
end if
end associate
end subroutine kinematics_threshold_projection
@ %def kinematics_threshold_projection
@
<<Kinematics: kinematics: TBP>>=
procedure :: evaluate_radiation => kinematics_evaluate_radiation
<<Kinematics: procedures>>=
subroutine kinematics_evaluate_radiation (k, p_in, p_out, success)
class(kinematics_t), intent(inout) :: k
type(vector4_t), intent(in), dimension(:) :: p_in
type(vector4_t), intent(out), dimension(:), allocatable :: p_out
logical, intent(out) :: success
type(vector4_t), dimension(:), allocatable :: p_real
type(vector4_t), dimension(:), allocatable :: p_born
real(default) :: xi_max_offshell, xi_offshell, y_offshell, jac_rand_dummy, phi
select type (phs => k%phs)
type is (phs_fks_t)
allocate (p_born (size (p_in)))
if (k%threshold) then
p_born = phs%get_onshell_projected_momenta ()
else
p_born = p_in
end if
if (.not. k%phs%is_cm_frame () .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 io_units
use format_utils, only: write_separator
use constants
use diagnostics
use os_interface
use numeric_utils
use lorentz
use mci_base
use particles
use sm_qcd, only: qcd_t
use interactions
use quantum_numbers
use model_data
use helicities
use flavors
use beam_structures
use variables
use pdg_arrays, only: is_quark
use sf_base
use isr_collinear
use physics_defs
use process_constants
use process_libraries
use state_matrices
use integration_results
use phs_base
use prc_core, only: prc_core_t, prc_core_state_t
!!! We should depend less on these modules (move it to pcm_nlo_t e.g.)
use phs_wood, only: phs_wood_t
use phs_fks
use blha_olp_interfaces, only: prc_blha_t
use blha_config, only: BLHA_AMP_COLOR_C
use prc_user_defined, only: prc_user_defined_base_t, user_defined_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 blha_olp_interfaces, only: blha_color_c_fill_offdiag, blha_color_c_fill_diag
use ttv_formfactors, only: m1s_to_mpole
!!! local modules
use parton_states
use process_counter
use pcm_base
use pcm
use core_manager
use process_config
use process_mci
use process
use kinematics
<<Standard module head>>
<<Instances: public>>
<<Instances: types>>
<<Instances: interfaces>>
contains
<<Instances: procedures>>
end module instances
@ %def instances
@
\subsection{Term instance}
A [[term_instance_t]] object contains all data that describe a term. Each
process component consists of one or more distinct terms which may differ in
kinematics, but whose squared transition matrices have to be added pointwise.
The [[active]] flag is set when this term is connected to an active
process component. Inactive terms are skipped for kinematics and evaluation.
The [[k_term]] object is the instance of the kinematics setup
(structure-function chain, phase space, etc.) that applies
specifically to this term. In ordinary cases, it consists of straight
pointers to the seed kinematics.
The [[amp]] array stores the amplitude values when we get them from evaluating
the associated matrix-element code.
The [[int_hard]] interaction describes the elementary hard process.
It receives the momenta and the amplitude entries for each sampling point.
The [[isolated]] object holds the effective parton state for the
elementary interaction. The amplitude entries are
computed from [[int_hard]].
The [[connected]] evaluator set
convolutes this scattering matrix with the beam (and possibly
structure-function) density matrix.
The [[checked]] flag is set once we have applied cuts on this term.
The result of this is stored in the [[passed]] flag. Once the term
has passed cuts, we calculate the various scale and weight expressions.
<<Instances: types>>=
type :: term_instance_t
type(process_term_t), pointer :: config => null ()
logical :: active = .false.
type(kinematics_t) :: k_term
complex(default), dimension(:), allocatable :: amp
type(interaction_t) :: int_hard
type(isolated_state_t) :: isolated
type(connected_state_t) :: connected
class(prc_core_state_t), allocatable :: core_state
logical :: checked = .false.
logical :: passed = .false.
real(default) :: scale = 0
real(default) :: fac_scale = 0
real(default) :: ren_scale = 0
real(default), allocatable :: alpha_qcd_forced
real(default) :: weight = 1
type(vector4_t), dimension(:), allocatable :: p_seed
type(vector4_t), dimension(:), allocatable :: p_hard
class(pcm_instance_t), pointer :: pcm_instance => null ()
integer :: nlo_type = BORN
integer, dimension(:), allocatable :: same_kinematics
type(qn_index_map_t) :: connected_qn_index
type(qn_index_map_t) :: hard_qn_index
contains
<<Instances: term instance: TBP>>
end type term_instance_t
@ %def term_instance_t
@
<<Instances: term instance: TBP>>=
procedure :: write => term_instance_write
<<Instances: procedures>>=
subroutine term_instance_write (term, unit, show_eff_state, testflag)
class(term_instance_t), intent(in) :: term
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_eff_state
logical, intent(in), optional :: testflag
integer :: u
logical :: state
u = given_output_unit (unit)
state = .true.; if (present (show_eff_state)) state = show_eff_state
if (term%active) then
if (associated (term%config)) then
write (u, "(1x,A,I0,A,I0,A)") "Term #", term%config%i_term, &
" (component #", term%config%i_component, ")"
else
write (u, "(1x,A)") "Term [undefined]"
end if
else
write (u, "(1x,A,I0,A)") "Term #", term%config%i_term, &
" [inactive]"
end if
if (term%checked) then
write (u, "(3x,A,L1)") "passed cuts = ", term%passed
end if
if (term%passed) then
write (u, "(3x,A,ES19.12)") "overall scale = ", term%scale
write (u, "(3x,A,ES19.12)") "factorization scale = ", term%fac_scale
write (u, "(3x,A,ES19.12)") "renormalization scale = ", term%ren_scale
if (allocated (term%alpha_qcd_forced)) then
write (u, "(3x,A,ES19.12)") "alpha(QCD) forced = ", &
term%alpha_qcd_forced
end if
write (u, "(3x,A,ES19.12)") "reweighting factor = ", term%weight
end if
call term%k_term%write (u)
call write_separator (u)
write (u, "(1x,A)") "Amplitude (transition matrix of the &
&hard interaction):"
call write_separator (u)
call term%int_hard%basic_write (u, testflag = testflag)
if (state .and. term%isolated%has_trace) then
call write_separator (u)
write (u, "(1x,A)") "Evaluators for the hard interaction:"
call term%isolated%write (u, testflag = testflag)
end if
if (state .and. term%connected%has_trace) then
call write_separator (u)
write (u, "(1x,A)") "Evaluators for the connected process:"
call term%connected%write (u, testflag = testflag)
end if
end subroutine term_instance_write
@ %def term_instance_write
@ The interactions and evaluators must be finalized.
<<Instances: term instance: TBP>>=
procedure :: final => term_instance_final
<<Instances: procedures>>=
subroutine term_instance_final (term)
class(term_instance_t), intent(inout) :: term
if (allocated (term%amp)) deallocate (term%amp)
if (allocated (term%core_state)) deallocate (term%core_state)
if (allocated (term%alpha_qcd_forced)) &
deallocate (term%alpha_qcd_forced)
if (allocated (term%p_seed)) deallocate(term%p_seed)
if (allocated (term%p_hard)) deallocate (term%p_hard)
call term%k_term%final ()
call term%connected%final ()
call term%isolated%final ()
call term%int_hard%final ()
term%pcm_instance => null ()
end subroutine term_instance_final
@ %def term_instance_final
@ For initialization, we make use of defined assignment for the
[[interaction_t]] type. This creates a deep copy.
The hard interaction (incoming momenta) is linked to the structure
function instance. In the isolated state, we either set pointers to
both, or we create modified copies ([[rearrange]]) as effective
structure-function chain and interaction, respectively.
Finally, we set up the [[subevt]] component that will be used for
evaluating observables, collecting particles from the trace evaluator
in the effective connected state. Their quantum numbers must be
determined by following back source links and set explicitly, since
they are already eliminated in that trace.
The [[rearrange]] parts are still commented out; they could become
relevant for a NLO algorithm.
<<Instances: term instance: TBP>>=
procedure :: init => term_instance_init
<<Instances: procedures>>=
subroutine term_instance_init (term, process, i_term, real_finite)
class(term_instance_t), intent(inout), target :: term
type(process_t), intent(in), target:: process
integer, intent(in) :: i_term
logical, intent(in), optional :: real_finite
class(prc_core_t), pointer :: core => null ()
type(process_beam_config_t) :: beam_config
type(interaction_t), pointer :: sf_chain_int
type(interaction_t), pointer :: src_int
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_in
type(state_matrix_t), pointer :: state_matrix
type(flavor_t), dimension(:), allocatable :: flv_int, flv_src, f_in, f_out
integer :: n_in, n_vir, n_out, n_tot, n_sub
integer :: i, j
logical :: me_already_squared, keep_fs_flavors
logical :: decrease_n_tot
logical :: requires_extended_sf
me_already_squared = .false.
keep_fs_flavors = .false.
term%config => process%get_term_ptr (i_term)
term%int_hard = term%config%int
core => process%get_core_term (i_term)
call core%allocate_workspace (term%core_state)
select type (core)
class is (prc_user_defined_base_t)
call reduce_interaction (term%int_hard, &
core%includes_polarization (), .true., .false.)
me_already_squared = .true.
allocate (term%amp (term%int_hard%get_n_matrix_elements ()))
class default
allocate (term%amp (term%config%n_allowed))
end select
if (allocated (term%core_state)) then
select type (core_state => term%core_state)
type is (openloops_state_t)
call core_state%init_threshold (process%get_model_ptr ())
end select
end if
term%amp = cmplx (0, 0, default)
decrease_n_tot = term%nlo_type == NLO_REAL .and. &
term%config%i_term_global /= term%config%i_sub
if (present (real_finite)) then
if (real_finite) decrease_n_tot = .false.
end if
if (decrease_n_tot) then
allocate (term%p_seed (term%int_hard%get_n_tot () - 1))
else
allocate (term%p_seed (term%int_hard%get_n_tot ()))
end if
allocate (term%p_hard (term%int_hard%get_n_tot ()))
sf_chain_int => term%k_term%sf_chain%get_out_int_ptr ()
n_in = term%int_hard%get_n_in ()
do j = 1, n_in
i = term%k_term%sf_chain%get_out_i (j)
call term%int_hard%set_source_link (j, sf_chain_int, i)
end do
call term%isolated%init (term%k_term%sf_chain, term%int_hard)
allocate (mask_in (n_in))
mask_in = term%k_term%sf_chain%get_out_mask ()
select type (phs => term%k_term%phs)
type is (phs_wood_t)
if (me_already_squared) then
call term%isolated%setup_identity_trace (core, mask_in, .true., .false.)
else
call term%isolated%setup_square_trace (core, mask_in, term%config%col, .false.)
end if
type is (phs_fks_t)
select case (phs%mode)
case (PHS_MODE_ADDITIONAL_PARTICLE)
if (me_already_squared) then
call term%isolated%setup_identity_trace (core, mask_in, .true., .false.)
else
keep_fs_flavors = term%config%data%n_flv > 1
call term%isolated%setup_square_trace (core, mask_in, term%config%col, &
keep_fs_flavors)
end if
case (PHS_MODE_COLLINEAR_REMNANT)
if (me_already_squared) then
call term%isolated%setup_identity_trace (core, mask_in, .true., .false.)
else
call term%isolated%setup_square_trace (core, mask_in, term%config%col, .false.)
end if
end select
class default
call term%isolated%setup_square_trace (core, mask_in, term%config%col, .false.)
end select
if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL .and. &
term%config%i_term_global == term%config%i_sub) .or. &
term%nlo_type == NLO_MISMATCH) then
n_sub = term%get_n_sub ()
else if (term%nlo_type == NLO_DGLAP) then
n_sub = n_beam_structure_int
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, &
extended_sf = requires_extended_sf)
associate (int_eff => term%isolated%int_eff)
state_matrix => int_eff%get_state_matrix_ptr ()
n_tot = int_eff%get_n_tot ()
flv_int = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (1))
allocate (f_in (n_in))
f_in = flv_int(1:n_in)
deallocate (flv_int)
end associate
n_in = term%connected%trace%get_n_in ()
n_vir = term%connected%trace%get_n_vir ()
n_out = term%connected%trace%get_n_out ()
allocate (f_out (n_out))
do j = 1, n_out
call term%connected%trace%find_source &
(n_in + n_vir + j, src_int, i)
if (associated (src_int)) then
state_matrix => src_int%get_state_matrix_ptr ()
flv_src = quantum_numbers_get_flavor &
(state_matrix%get_quantum_number (1))
f_out(j) = flv_src(i)
deallocate (flv_src)
end if
end do
beam_config = process%get_beam_config ()
call term%connected%setup_subevt (term%isolated%sf_chain_eff, &
beam_config%data%flv, f_in, f_out)
call term%connected%setup_var_list &
(process%get_var_list_ptr (), beam_config%data)
select type (core)
class is (prc_user_defined_base_t)
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
associate (is_born => .not. (term%nlo_type == NLO_REAL .and. .not. term%is_subtraction ()))
! Does connected%trace never have any helicity qn?
call setup_qn_index (term%connected_qn_index, term%connected%trace, pcm_instance, &
n_sub = n_sub, is_born = is_born, is_polarized = .false.)
call setup_qn_index (term%hard_qn_index, term%int_hard, pcm_instance, &
n_sub = n_sub, is_born = is_born, is_polarized = core%includes_polarization ())
end associate
class default
call term%connected_qn_index%init (term%connected%trace)
call term%hard_qn_index%init (term%int_hard)
end select
class default
call term%connected_qn_index%init (term%connected%trace)
call term%hard_qn_index%init (term%int_hard)
end select
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_user_defined_base_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
<<Instances: term instance init: procedures>>
end subroutine term_instance_init
@ %def term_instance_init
@ Setup index mapping from state matrix to index pair [[i_flv]], [[i_sub]].
<<Instances: term instance init: procedures>>=
subroutine setup_qn_index (qn_index, int, pcm_instance, n_sub, is_born, is_polarized)
type(qn_index_map_t), intent(out) :: qn_index
class(interaction_t), intent(in) :: int
class(pcm_instance_t), intent(in) :: pcm_instance
integer, intent(in) :: n_sub
logical, intent(in) :: is_born
logical, intent(in) :: is_polarized
integer :: i
type(quantum_numbers_t), dimension(:, :), allocatable :: qn_config
type(quantum_numbers_t), dimension(:, :), allocatable :: qn_hel
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
qn_config = config%get_qn (is_born)
end select
if (is_polarized) then
! term%config%data from higher scope
call setup_qn_hel (int, term%config%data, qn_hel)
call qn_index%init (int, qn_config, n_sub, qn_hel)
call qn_index%set_helicity_flip (.true.)
else
call qn_index%init (int, qn_config, n_sub)
end if
end subroutine setup_qn_index
@ %def setup_qn_index
@ Setup beam polarisation quantum numbers, iff 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 a 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: term instance init: procedures>>=
subroutine setup_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_qn_hel
@ %def setup_qn_hel
@
<<Instances: term instance: TBP>>=
procedure :: init_from_process => term_instance_init_from_process
<<Instances: procedures>>=
subroutine term_instance_init_from_process (term_instance, &
process, i, pcm_instance, sf_chain)
class(term_instance_t), intent(inout), target :: term_instance
type(process_t), intent(in), target :: process
integer, intent(in) :: i
class(pcm_instance_t), intent(in), target :: pcm_instance
type(sf_chain_t), intent(in), target :: sf_chain
type(process_term_t) :: term
integer :: i_component
logical :: requires_extended_sf
term = process%get_term_ptr (i)
i_component = term%i_component
if (i_component /= 0) then
term_instance%pcm_instance => pcm_instance
term_instance%nlo_type = process%get_nlo_type_component (i_component)
requires_extended_sf = term_instance%nlo_type == NLO_DGLAP .or. &
(term_instance%nlo_type == NLO_REAL .and. process%get_i_sub (i) == i)
call term_instance%setup_kinematics (sf_chain, &
process%get_beam_config_ptr (), &
process%get_phs_config (i_component), &
requires_extended_sf)
call term_instance%init (process, i, &
real_finite = process%component_is_real_finite (i_component))
select type (phs => term_instance%k_term%phs)
type is (phs_fks_t)
call term_instance%set_emitter (process%get_pcm_ptr ())
call term_instance%setup_fks_kinematics (process%get_var_list_ptr (), &
process%get_beam_config_ptr ())
end select
call term_instance%set_threshold (process%get_pcm_ptr ())
call term_instance%setup_expressions (process%get_meta (), process%get_config ())
end if
end subroutine term_instance_init_from_process
@ %def term_instance_init_from_process
@ Initialize the seed-kinematics configuration. All subobjects are
allocated explicitly.
<<Instances: term instance: TBP>>=
procedure :: setup_kinematics => term_instance_setup_kinematics
<<Instances: procedures>>=
subroutine term_instance_setup_kinematics (term, sf_chain, &
beam_config, phs_config, extended_sf)
class(term_instance_t), intent(inout) :: term
type(sf_chain_t), intent(in), target :: sf_chain
type(process_beam_config_t), intent(in), target :: beam_config
class(phs_config_t), intent(in), target :: phs_config
logical, intent(in) :: extended_sf
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
call term%k_term%init_sf_chain (sf_chain, beam_config, &
extended_sf = config%has_pdfs .and. extended_sf)
class default
call term%k_term%init_sf_chain (sf_chain, beam_config)
end select
!!! Add one for additional Born matrix element
call term%k_term%init_phs (phs_config)
call term%k_term%set_nlo_info (term%nlo_type)
select type (phs => term%k_term%phs)
type is (phs_fks_t)
call phs%allocate_momenta (phs_config, &
.not. (term%nlo_type == NLO_REAL))
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
call config%region_data%init_phs_identifiers (phs%phs_identifiers)
!!! The triple select type pyramid of doom
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (allocated (pcm_instance%real_kinematics%alr_to_i_phs)) &
call config%region_data%set_alr_to_i_phs (phs%phs_identifiers, &
pcm_instance%real_kinematics%alr_to_i_phs)
end select
end select
end select
end subroutine term_instance_setup_kinematics
@ %def term_instance_setup_kinematics
@
<<Instances: term instance: TBP>>=
procedure :: setup_fks_kinematics => term_instance_setup_fks_kinematics
<<Instances: procedures>>=
subroutine term_instance_setup_fks_kinematics (term, var_list, beam_config)
class(term_instance_t), intent(inout), target :: term
type(var_list_t), intent(in) :: var_list
type(process_beam_config_t), intent(in) :: beam_config
integer :: mode
logical :: singular_jacobian
if (.not. (term%nlo_type == NLO_REAL .or. term%nlo_type == NLO_DGLAP .or. &
term%nlo_type == NLO_MISMATCH)) return
singular_jacobian = var_list%get_lval (var_str ("?powheg_use_singular_jacobian"))
if (term%nlo_type == NLO_REAL) then
mode = check_generator_mode (GEN_REAL_PHASE_SPACE)
else if (term%nlo_type == NLO_MISMATCH) then
mode = check_generator_mode (GEN_SOFT_MISMATCH)
else
mode = PHS_MODE_UNDEFINED
end if
select type (phs => term%k_term%phs)
type is (phs_fks_t)
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call config%setup_phs_generator (pcm_instance, &
phs%generator, phs%config%sqrts, mode, singular_jacobian)
if (beam_config%has_structure_function ()) then
pcm_instance%isr_kinematics%isr_mode = SQRTS_VAR
else
pcm_instance%isr_kinematics%isr_mode = SQRTS_FIXED
end if
call msg_debug (D_PHASESPACE, "isr_mode: ", pcm_instance%isr_kinematics%isr_mode)
end select
end select
class default
call msg_fatal ("Phase space should be an FKS phase space!")
end select
contains
function check_generator_mode (gen_mode_default) result (gen_mode)
integer :: gen_mode
integer, intent(in) :: gen_mode_default
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
associate (settings => config%settings)
if (settings%test_coll_limit .and. settings%test_anti_coll_limit) &
call msg_fatal ("You cannot check the collinear and anti-collinear limit "&
&"at the same time!")
if (settings%test_soft_limit .and. .not. settings%test_coll_limit &
.and. .not. settings%test_anti_coll_limit) then
gen_mode = GEN_SOFT_LIMIT_TEST
else if (.not. settings%test_soft_limit .and. settings%test_coll_limit) then
gen_mode = GEN_COLL_LIMIT_TEST
else if (.not. settings%test_soft_limit .and. settings%test_anti_coll_limit) then
gen_mode = GEN_ANTI_COLL_LIMIT_TEST
else if (settings%test_soft_limit .and. settings%test_coll_limit) then
gen_mode = GEN_SOFT_COLL_LIMIT_TEST
else if (settings%test_soft_limit .and. settings%test_anti_coll_limit) then
gen_mode = GEN_SOFT_ANTI_COLL_LIMIT_TEST
else
gen_mode = gen_mode_default
end if
end associate
end select
end function check_generator_mode
end subroutine term_instance_setup_fks_kinematics
@ %def term_instance_setup_fks_kinematics
@ Setup seed kinematics, starting from the MC parameter set given as
argument. As a result, the [[k_seed]] kinematics object is evaluated
(except for the structure-function matrix-element evaluation, which we
postpone until we know the factorization scale), and we have a valid
[[p_seed]] momentum array.
<<Instances: term instance: TBP>>=
procedure :: compute_seed_kinematics => term_instance_compute_seed_kinematics
<<Instances: procedures>>=
subroutine term_instance_compute_seed_kinematics &
(term, mci_work, phs_channel, success)
class(term_instance_t), intent(inout), target :: term
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
logical, intent(out) :: success
call term%k_term%compute_selected_channel &
(mci_work, phs_channel, term%p_seed, success)
end subroutine term_instance_compute_seed_kinematics
@ %def term_instance_compute_seed_kinematics
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_radiation_kinematics => term_instance_evaluate_radiation_kinematics
<<Instances: procedures>>=
subroutine term_instance_evaluate_radiation_kinematics (term, x)
class(term_instance_t), intent(inout) :: term
real(default), dimension(:), intent(in) :: x
select type (phs => term%k_term%phs)
type is (phs_fks_t)
if (phs%mode == PHS_MODE_ADDITIONAL_PARTICLE) &
call term%k_term%evaluate_radiation_kinematics (x)
end select
end subroutine term_instance_evaluate_radiation_kinematics
@ %def term_instance_evaluate_radiation_kinematics
@
<<Instances: term instance: TBP>>=
procedure :: compute_xi_ref_momenta => term_instance_compute_xi_ref_momenta
<<Instances: procedures>>=
subroutine term_instance_compute_xi_ref_momenta (term)
class(term_instance_t), intent(inout) :: term
select type (pcm => term%pcm_instance%config)
type is (pcm_nlo_t)
call term%k_term%compute_xi_ref_momenta (pcm%region_data, term%nlo_type)
end select
end subroutine term_instance_compute_xi_ref_momenta
@ %def term_instance_compute_xi_ref_momenta
@
<<Instances: term instance: TBP>>=
procedure :: generate_fsr_in => term_instance_generate_fsr_in
<<Instances: procedures>>=
subroutine term_instance_generate_fsr_in (term)
class(term_instance_t), intent(inout) :: term
select type (phs => term%k_term%phs)
type is (phs_fks_t)
call phs%generate_fsr_in ()
end select
end subroutine term_instance_generate_fsr_in
@ %def term_instance_generate_fsr_in
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_projections => term_instance_evaluate_projections
<<Instances: procedures>>=
subroutine term_instance_evaluate_projections (term)
class(term_instance_t), intent(inout) :: term
if (term%k_term%threshold .and. term%nlo_type > BORN) then
if (debug2_active (D_THRESHOLD)) &
print *, 'Evaluate on-shell projection: ', &
char (component_status (term%nlo_type))
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call term%k_term%threshold_projection (pcm_instance, term%nlo_type)
end select
end if
end subroutine term_instance_evaluate_projections
@ %def term_instance_evaluate_projections
@
<<Instances: term instance: TBP>>=
procedure :: redo_sf_chain => term_instance_redo_sf_chain
<<Instances: procedures>>=
subroutine term_instance_redo_sf_chain (term, mci_work, phs_channel)
class(term_instance_t), intent(inout) :: term
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
real(default), dimension(:), allocatable :: x
integer :: sf_channel, n
real(default) :: xi, y
n = size (mci_work%get_x_strfun ())
if (n > 0) then
allocate (x(n))
x = mci_work%get_x_strfun ()
associate (k => term%k_term)
sf_channel = k%phs%config%get_sf_channel (phs_channel)
call k%sf_chain%compute_kinematics (sf_channel, x)
deallocate (x)
end associate
end if
end subroutine term_instance_redo_sf_chain
@ %def term_instance_redo_sf_chain
@ Inverse: recover missing parts of the kinematics, given a complete
set of seed momenta. Select a channel and reconstruct the MC parameter set.
<<Instances: term instance: TBP>>=
procedure :: recover_mcpar => term_instance_recover_mcpar
<<Instances: procedures>>=
subroutine term_instance_recover_mcpar (term, mci_work, phs_channel)
class(term_instance_t), intent(inout), target :: term
type(mci_work_t), intent(inout) :: mci_work
integer, intent(in) :: phs_channel
call term%k_term%recover_mcpar (mci_work, phs_channel, term%p_seed)
end subroutine term_instance_recover_mcpar
@ %def term_instance_recover_mcpar
@ Part of [[recover_mcpar]], separately accessible. Reconstruct all
kinematics data in the structure-function chain instance.
<<Instances: term instance: TBP>>=
procedure :: recover_sfchain => term_instance_recover_sfchain
<<Instances: procedures>>=
subroutine term_instance_recover_sfchain (term, channel)
class(term_instance_t), intent(inout), target :: term
integer, intent(in) :: channel
call term%k_term%recover_sfchain (channel, term%p_seed)
end subroutine term_instance_recover_sfchain
@ %def term_instance_recover_sfchain
@ Compute the momenta in the hard interactions, one for each term that
constitutes this process component. In simple cases this amounts to
just copying momenta. In more advanced cases, we may generate
distinct sets of momenta from the seed kinematics.
The interactions in the term instances are accessed individually. We may
choose to calculate all terms at once together with the seed kinematics, use
[[component%core_state]] for storage, and just fill the interactions here.
<<Instances: term instance: TBP>>=
procedure :: compute_hard_kinematics => &
term_instance_compute_hard_kinematics
<<Instances: procedures>>=
subroutine term_instance_compute_hard_kinematics (term, skip_term, success)
class(term_instance_t), intent(inout) :: term
integer, intent(in), optional :: skip_term
logical, intent(out) :: success
type(vector4_t), dimension(:), allocatable :: p
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
if (present (skip_term)) then
if (term%config%i_term_global == skip_term) return
end if
if (term%nlo_type == NLO_REAL .and. term%k_term%emitter >= 0) then
call term%k_term%evaluate_radiation (term%p_seed, p, success)
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (config%dalitz_plot%active) then
if (term%k_term%emitter > term%k_term%n_in) then
if (p(term%k_term%emitter)**2 > tiny_07) &
call config%register_dalitz_plot (term%k_term%emitter, p)
end if
end if
end select
else if (is_subtraction_component (term%k_term%emitter, term%nlo_type)) then
call term%k_term%modify_momenta_for_subtraction (term%p_seed, p)
success = .true.
else
allocate (p (size (term%p_seed))); p = term%p_seed
success = .true.
end if
call term%int_hard%set_momenta (p)
end subroutine term_instance_compute_hard_kinematics
@ %def term_instance_compute_hard_kinematics
@ Here, we invert this. We fetch the incoming momenta which reside
in the appropriate [[sf_chain]] object, stored within the [[k_seed]]
subobject. On the other hand, we have the outgoing momenta of the
effective interaction. We rely on the process core to compute the
remaining seed momenta and to fill the momenta within the hard
interaction. (The latter is trivial if hard and effective interaction
coincide.)
After this is done, the incoming momenta in the trace evaluator that
corresponds to the hard (effective) interaction, are still
left undefined. We remedy this by calling [[receive_kinematics]] once.
<<Instances: term instance: TBP>>=
procedure :: recover_seed_kinematics => &
term_instance_recover_seed_kinematics
<<Instances: procedures>>=
subroutine term_instance_recover_seed_kinematics (term)
class(term_instance_t), intent(inout) :: term
integer :: n_in
n_in = term%k_term%n_in
call term%k_term%get_incoming_momenta (term%p_seed(1:n_in))
associate (int_eff => term%isolated%int_eff)
call int_eff%set_momenta (term%p_seed(1:n_in), outgoing = .false.)
term%p_seed(n_in + 1 : ) = int_eff%get_momenta (outgoing = .true.)
end associate
call term%isolated%receive_kinematics ()
end subroutine term_instance_recover_seed_kinematics
@ %def term_instance_recover_seed_kinematics
@ Compute the integration parameters for all channels except the selected
one.
<<Instances: term instance: TBP>>=
procedure :: compute_other_channels => &
term_instance_compute_other_channels
<<Instances: procedures>>=
subroutine term_instance_compute_other_channels &
(term, mci_work, phs_channel)
class(term_instance_t), intent(inout), target :: term
type(mci_work_t), intent(in) :: mci_work
integer, intent(in) :: phs_channel
call term%k_term%compute_other_channels (mci_work, phs_channel)
end subroutine term_instance_compute_other_channels
@ %def term_instance_compute_other_channels
@ Recover beam momenta, i.e., return the beam momenta as currently
stored in the kinematics subobject to their source. This is a side effect.
<<Instances: term instance: TBP>>=
procedure :: return_beam_momenta => term_instance_return_beam_momenta
<<Instances: procedures>>=
subroutine term_instance_return_beam_momenta (term)
class(term_instance_t), intent(in) :: term
call term%k_term%return_beam_momenta ()
end subroutine term_instance_return_beam_momenta
@ %def term_instance_return_beam_momenta
@
<<Instances: term instance: TBP>>=
procedure :: apply_real_partition => term_instance_apply_real_partition
<<Instances: procedures>>=
subroutine term_instance_apply_real_partition (term, process)
class(term_instance_t), intent(inout) :: term
type(process_t), intent(in) :: process
real(default) :: f, sqme
integer :: i_component
integer :: i_amp, n_amps
logical :: is_subtraction
i_component = term%config%i_component
if (process%component_is_selected (i_component) .and. &
process%get_component_nlo_type (i_component) == NLO_REAL) then
is_subtraction = process%get_component_type (i_component) == COMP_REAL_SING &
.and. term%k_term%emitter < 0
if (is_subtraction) return
select type (pcm => process%get_pcm_ptr ())
type is (pcm_nlo_t)
f = pcm%real_partition%get_f (term%p_hard)
end select
n_amps = term%connected%trace%get_n_matrix_elements ()
do i_amp = 1, n_amps
sqme = real (term%connected%trace%get_matrix_element ( &
term%connected_qn_index%get_index (i_amp, i_sub = 0)))
call msg_debug2 (D_PROCESS_INTEGRATION, "term_instance_apply_real_partition")
select type (pcm => term%pcm_instance%config)
type is (pcm_nlo_t)
select case (process%get_component_type (i_component))
case (COMP_REAL_FIN, COMP_REAL_SING)
select case (process%get_component_type (i_component))
case (COMP_REAL_FIN)
call msg_debug2 (D_PROCESS_INTEGRATION, "Real finite")
sqme = sqme * (one - f)
case (COMP_REAL_SING)
call msg_debug2 (D_PROCESS_INTEGRATION, "Real singular")
sqme = sqme * f
end select
end select
end select
call msg_debug2 (D_PROCESS_INTEGRATION, "apply_damping: sqme", sqme)
call term%connected%trace%set_matrix_element (i_amp, cmplx (sqme, zero, default))
end do
end if
end subroutine term_instance_apply_real_partition
@ %def term_instance_apply_real_partition
@
<<Instances: term instance: TBP>>=
procedure :: get_lorentz_transformation => term_instance_get_lorentz_transformation
<<Instances: procedures>>=
function term_instance_get_lorentz_transformation (term) result (lt)
type(lorentz_transformation_t) :: lt
class(term_instance_t), intent(in) :: term
lt = term%k_term%phs%get_lorentz_transformation ()
end function term_instance_get_lorentz_transformation
@ %def term_instance_get_lorentz_transformation
@
<<Instances: term instance: TBP>>=
procedure :: get_p_hard => term_instance_get_p_hard
<<Instances: procedures>>=
pure function term_instance_get_p_hard (term_instance) result (p_hard)
type(vector4_t), dimension(:), allocatable :: p_hard
class(term_instance_t), intent(in) :: term_instance
allocate (p_hard (size (term_instance%p_hard)))
p_hard = term_instance%p_hard
end function term_instance_get_p_hard
@ %def term_instance_get_p_hard
@
<<Instances: term instance: TBP>>=
procedure :: set_emitter => term_instance_set_emitter
<<Instances: procedures>>=
subroutine term_instance_set_emitter (term, pcm)
class(term_instance_t), intent(inout) :: term
class(pcm_t), intent(in) :: pcm
integer :: i_phs
logical :: set_emitter
select type (pcm)
type is (pcm_nlo_t)
!!! Without resonances, i_alr = i_phs
i_phs = term%config%i_term
term%k_term%i_phs = term%config%i_term
select type (phs => term%k_term%phs)
type is (phs_fks_t)
set_emitter = i_phs <= pcm%region_data%n_phs .and. term%nlo_type == NLO_REAL
if (set_emitter) then
term%k_term%emitter = phs%phs_identifiers(i_phs)%emitter
select type (pcm => term%pcm_instance%config)
type is (pcm_nlo_t)
if (allocated (pcm%region_data%i_phs_to_i_con)) &
term%k_term%i_con = pcm%region_data%i_phs_to_i_con (i_phs)
end select
end if
end select
end select
end subroutine term_instance_set_emitter
@ %def term_instance_set_emitter
@
<<Instances: term instance: TBP>>=
procedure :: set_threshold => term_instance_set_threshold
<<Instances: procedures>>=
subroutine term_instance_set_threshold (term, pcm)
class(term_instance_t), intent(inout) :: term
class(pcm_t), intent(in) :: pcm
select type (pcm)
type is (pcm_nlo_t)
term%k_term%threshold = pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD
class default
term%k_term%threshold = .false.
end select
end subroutine term_instance_set_threshold
@ %def term_instance_set_threshold
@ For initializing the expressions, we need the local variable list and the
parse trees.
<<Instances: term instance: TBP>>=
procedure :: setup_expressions => term_instance_setup_expressions
<<Instances: procedures>>=
subroutine term_instance_setup_expressions (term, meta, config)
class(term_instance_t), intent(inout), target :: term
type(process_metadata_t), intent(in), target :: meta
type(process_config_data_t), intent(in) :: config
if (allocated (config%ef_cuts)) &
call term%connected%setup_cuts (config%ef_cuts)
if (allocated (config%ef_scale)) &
call term%connected%setup_scale (config%ef_scale)
if (allocated (config%ef_fac_scale)) &
call term%connected%setup_fac_scale (config%ef_fac_scale)
if (allocated (config%ef_ren_scale)) &
call term%connected%setup_ren_scale (config%ef_ren_scale)
if (allocated (config%ef_weight)) &
call term%connected%setup_weight (config%ef_weight)
end subroutine term_instance_setup_expressions
@ %def term_instance_setup_expressions
@ Prepare the extra evaluators that we need for processing events.
The quantum numbers mask of the incoming particle
<<Instances: term instance: TBP>>=
procedure :: setup_event_data => term_instance_setup_event_data
<<Instances: procedures>>=
subroutine term_instance_setup_event_data (term, core, model)
class(term_instance_t), intent(inout), target :: term
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
integer :: n_in
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_in
n_in = term%int_hard%get_n_in ()
allocate (mask_in (n_in))
mask_in = term%k_term%sf_chain%get_out_mask ()
call setup_isolated (term%isolated, core, model, mask_in, term%config%col)
call setup_connected (term%connected, term%isolated, term%nlo_type)
contains
subroutine setup_isolated (isolated, core, model, mask, color)
type(isolated_state_t), intent(inout), target :: isolated
class(prc_core_t), intent(in) :: core
class(model_data_t), intent(in), target :: model
type(quantum_numbers_mask_t), intent(in), dimension(:) :: mask
integer, intent(in), dimension(:) :: color
call isolated%setup_square_matrix (core, model, mask, color)
call isolated%setup_square_flows (core, model, mask)
end subroutine setup_isolated
subroutine setup_connected (connected, isolated, nlo_type)
type(connected_state_t), intent(inout), target :: connected
type(isolated_state_t), intent(in), target :: isolated
integer :: nlo_type
type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
call connected%setup_connected_matrix (isolated)
if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL &
.and. term%config%i_term_global == term%config%i_sub) &
.or. term%nlo_type == NLO_DGLAP) then
!!! We don't care about the subtraction matrix elements in
!!! connected%matrix, because all entries there are supposed
!!! to be squared. To be able to match with flavor quantum numbers,
!!! we remove the subtraction quantum entries from the state matrix.
allocate (mask (connected%matrix%get_n_tot()))
call mask%set_sub (1)
call connected%matrix%reduce_state_matrix (mask, keep_order = .true.)
end if
call connected%setup_connected_flows (isolated)
call connected%setup_state_flv (isolated%get_n_out ())
end subroutine setup_connected
end subroutine term_instance_setup_event_data
@ %def term_instance_setup_event_data
@ Color-correlated matrix elements should be obtained from
the external BLHA provider. According to the standard, the
matrix elements output is a one-dimensional array. For FKS
subtraction, we require the matrix $B_{ij}$. BLHA prescribes
a mapping $(i, j) \to k$, where $k$ is the index of the matrix
element in the output array. It focusses on the off-diagonal entries,
i.e. $i \neq j$. The subroutine [[blha_color_c_fill_offdiag]] realizes
this mapping. The diagonal entries can simply be obtained as
the product of the Born matrix element and either $C_A$ or $C_F$,
which is achieved by [[blha_color_c_fill_diag]].
For simple processes, i.e. those with only one color line, it is
$B_{ij} = C_F \cdot B$. For those, we keep the possibility of computing
color correlations by a multiplication of the Born matrix element with $C_F$.
It is triggered by the [[use_internal_color_correlations]] flag and should
be used only for testing purposes. However, it is also used for
the threshold computation where the process is well-defined and fixed.
<<Instances: term instance: TBP>>=
procedure :: evaluate_color_correlations => &
term_instance_evaluate_color_correlations
<<Instances: procedures>>=
subroutine term_instance_evaluate_color_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv_born
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
call msg_debug2 (D_SUBTRACTION, &
"term_instance_evaluate_color_correlations: " // &
"use_internal_color_correlations:", &
config%settings%use_internal_color_correlations)
call msg_debug2 (D_SUBTRACTION, "fac_scale", term%fac_scale)
do i_flv_born = 1, config%region_data%n_flv_born
select case (term%nlo_type)
case (NLO_REAL)
call transfer_me_array_to_bij (config, i_flv_born, &
pcm_instance%real_sub%sqme_born (i_flv_born), &
pcm_instance%real_sub%sqme_born_color_c (:, :, i_flv_born))
case (NLO_MISMATCH)
call transfer_me_array_to_bij (config, i_flv_born, &
pcm_instance%soft_mismatch%sqme_born (i_flv_born), &
pcm_instance%soft_mismatch%sqme_born_color_c (:, :, i_flv_born))
case (NLO_VIRTUAL)
!!! This is just a copy of the above with a different offset and can for sure be unified
call transfer_me_array_to_bij (config, i_flv_born, &
-one, pcm_instance%virtual%sqme_color_c (:, :, i_flv_born))
end select
end do
end select
end select
contains
function get_trivial_cf_factors (n_tot, flv, factorization_mode) result (beta_ij)
integer, intent(in) :: n_tot, factorization_mode
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
if (factorization_mode == NO_FACTORIZATION) then
beta_ij = get_trivial_cf_factors_default (n_tot, flv)
else
beta_ij = get_trivial_cf_factors_threshold (n_tot, flv)
end if
end function get_trivial_cf_factors
function get_trivial_cf_factors_default (n_tot, flv) result (beta_ij)
integer, intent(in) :: n_tot
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
integer :: i, j
beta_ij = zero
if (count (is_quark (flv)) == 2) then
do i = 1, n_tot
do j = 1, n_tot
if (is_quark(flv(i)) .and. is_quark(flv(j))) then
if (i == j) then
beta_ij(i,j)= -cf
else
beta_ij(i,j) = cf
end if
end if
end do
end do
end if
end function get_trivial_cf_factors_default
function get_trivial_cf_factors_threshold (n_tot, flv) result (beta_ij)
integer, intent(in) :: n_tot
integer, intent(in), dimension(:) :: flv
real(default), dimension(n_tot, n_tot) :: beta_ij
integer :: i
beta_ij = zero
do i = 1, 4
beta_ij(i,i) = -cf
end do
beta_ij(1,2) = cf; beta_ij(2,1) = cf
beta_ij(3,4) = cf; beta_ij(4,3) = cf
end function get_trivial_cf_factors_threshold
subroutine transfer_me_array_to_bij (pcm, i_flv, &
sqme_born, sqme_color_c)
type(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
real(default), intent(in) :: sqme_born
real(default), dimension(:,:), intent(inout) :: sqme_color_c
integer :: i_color_c, i_sub, n_pdf_off, virt_off, n_offset
real(default), dimension(:), allocatable :: sqme
call msg_debug2 (D_PROCESS_INTEGRATION, "transfer_me_array_to_bij")
if (pcm%settings%use_internal_color_correlations) then
!!! A negative value for sqme_born indicates that the Born matrix
!!! element is multiplied at a different place, e.g. in the case
!!! of the virtual component
sqme_color_c = get_trivial_cf_factors &
(pcm%region_data%get_n_legs_born (), &
pcm%region_data%get_flv_states_born (i_flv), &
pcm%settings%factorization_mode)
if (sqme_born > zero) then
sqme_color_c = sqme_born * sqme_color_c
else if (sqme_born == zero) then
sqme_color_c = zero
end if
else
n_offset = 0
if (term%nlo_type == NLO_VIRTUAL) then
n_offset = 1
else if (pcm%has_pdfs .and. term%is_subtraction ()) then
n_offset = n_beam_structure_int
end if
allocate (sqme (term%get_n_sub_color ()), source = zero)
do i_sub = 1, term%get_n_sub_color ()
sqme(i_sub) = real(term%connected%trace%get_matrix_element ( &
term%connected_qn_index%get_index (i_flv, i_sub = i_sub + n_offset)), default)
end do
call blha_color_c_fill_offdiag (pcm%region_data%n_legs_born, &
sqme, sqme_color_c)
call blha_color_c_fill_diag (real(term%connected%trace%get_matrix_element ( &
term%connected_qn_index%get_index (i_flv, i_sub = 0)), default), &
pcm%region_data%get_flv_states_born (i_flv), &
sqme_color_c)
end if
end subroutine transfer_me_array_to_bij
end subroutine term_instance_evaluate_color_correlations
@ %def term_instance_evaluate_color_correlations
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_charge_correlations => &
term_instance_evaluate_charge_correlations
<<Instances: procedures>>=
subroutine term_instance_evaluate_charge_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv_born
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
do i_flv_born = 1, config%region_data%n_flv_born
select case (term%nlo_type)
case (NLO_REAL)
call transfer_me_array_to_bij (config, i_flv_born, &
pcm_instance%real_sub%sqme_born (i_flv_born), &
pcm_instance%real_sub%sqme_born_charge_c (:, :, i_flv_born))
case (NLO_MISMATCH)
call transfer_me_array_to_bij (config, i_flv_born, &
pcm_instance%soft_mismatch%sqme_born (i_flv_born), &
pcm_instance%soft_mismatch%sqme_born_charge_c (:, :, i_flv_born))
case (NLO_VIRTUAL)
call transfer_me_array_to_bij (config, i_flv_born, &
-one, pcm_instance%virtual%sqme_charge_c (:, :, i_flv_born))
end select
end do
end select
end select
contains
subroutine transfer_me_array_to_bij (pcm, i_flv, sqme_born, sqme_charge_c)
type(pcm_nlo_t), intent(in) :: pcm
integer, intent(in) :: i_flv
real(default), intent(in) :: sqme_born
real(default), dimension(:,:), intent(inout) :: sqme_charge_c
integer :: n_legs_born, i, j
integer, dimension(:), allocatable :: sigma
real(default), dimension(:), allocatable :: Q
n_legs_born = pcm%region_data%n_legs_born
associate (flv_born => pcm%region_data%flv_born(i_flv))
allocate (sigma (n_legs_born), Q (size (flv_born%charge)))
Q = flv_born%charge
sigma(1:flv_born%n_in) = sign (1, flv_born%flst(1:flv_born%n_in))
sigma(flv_born%n_in + 1: ) = -sign (1, flv_born%flst(flv_born%n_in + 1: ))
end associate
do i = 1, n_legs_born
do j = 1, n_legs_born
sqme_charge_c(i, j) = sigma(i) * sigma(j) * Q(i) * Q(j) * (-one)
end do
end do
sqme_charge_c = sqme_charge_c * sqme_born
end subroutine transfer_me_array_to_bij
end subroutine term_instance_evaluate_charge_correlations
@ %def term_instance_evaluate_charge_correlations
@ The information about spin correlations is not stored in the [[nlo_settings]] because
it is only available after the [[fks_regions]] have been created.
<<Instances: term instance: TBP>>=
procedure :: evaluate_spin_correlations => term_instance_evaluate_spin_correlations
<<Instances: procedures>>=
subroutine term_instance_evaluate_spin_correlations (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
integer :: i_flv, i_hel, i_sub, i_emitter, emitter
integer :: n_flv, n_sub_color, n_sub_spin, n_offset
real(default), dimension(0:3, 0:3) :: sqme_spin_c
real(default), dimension(:), allocatable :: sqme_spin_c_all
real(default), dimension(:), allocatable :: sqme_spin_c_arr
call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_spin_correlations")
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (pcm_instance%real_sub%requires_spin_correlations () &
.and. term%nlo_type == NLO_REAL) then
select type (core)
type is (prc_openloops_t)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
n_flv = term%connected_qn_index%get_n_flv ()
n_sub_color = term%get_n_sub_color ()
n_sub_spin = term%get_n_sub_spin ()
n_offset = 0; if(config%has_pdfs) n_offset = n_beam_structure_int
allocate (sqme_spin_c_arr(16))
do i_flv = 1, n_flv
allocate (sqme_spin_c_all(n_sub_spin))
do i_sub = 1, n_sub_spin
sqme_spin_c_all(i_sub) = real(term%connected%trace%get_matrix_element &
(term%connected_qn_index%get_index (i_flv, &
i_sub = i_sub + n_offset + n_sub_color)), default)
end do
do i_emitter = 1, config%region_data%n_emitters
emitter = config%region_data%emitters(i_emitter)
if (emitter > 0) then
call split_array (sqme_spin_c_all, sqme_spin_c_arr)
sqme_spin_c = reshape (sqme_spin_c_arr, (/4,4/))
pcm_instance%real_sub%sqme_born_spin_c(:,:,emitter,i_flv) = sqme_spin_c
end if
end do
deallocate (sqme_spin_c_all)
end do
end select
class default
call msg_fatal ("Spin correlations so far only supported by OpenLoops.")
end select
end if
end select
end subroutine term_instance_evaluate_spin_correlations
@ %def term_instance_evaluate_spin_correlations
@ Compute collinear ISR from interactions, real component and DLGAP remnant are
handled accordingly.
<<Instances: term instance: TBP>>=
procedure :: compute_sqme_coll_isr => term_instance_compute_sqme_coll_isr
<<Instances: procedures>>=
subroutine term_instance_compute_sqme_coll_isr (term)
class(term_instance_t), intent(in) :: term
integer :: i_flv
integer, parameter :: BEAM_PLUS = 1, BEAM_MINUS = 2, &
PDF = 1, PDF_SINGLET = 2
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (pcm => term%pcm_instance%config)
type is (pcm_nlo_t)
associate (me => term%connected%trace%get_matrix_element ())
do i_flv = 1, pcm%region_data%n_flv_born
call set_sqme_coll_isr (BEAM_PLUS, PDF, i_flv, &
real(me(term%connected_qn_index%get_index (i_flv, i_sub = 1))))
call set_sqme_coll_isr (BEAM_MINUS, PDF, i_flv, &
real(me(term%connected_qn_index%get_index (i_flv, i_sub = 2))))
if (pcm%settings%nlo_correction_type == "QCD" .or. &
pcm%settings%nlo_correction_type == "Full") then
call set_sqme_coll_isr (BEAM_PLUS, PDF_SINGLET, i_flv, &
real(me(term%connected_qn_index%get_index (i_flv, i_sub = 3))))
call set_sqme_coll_isr (BEAM_MINUS, PDF_SINGLET, i_flv, &
real(me(term%connected_qn_index%get_index (i_flv, i_sub = 4))))
end if
end do
end associate
if (debug2_active (D_BEAMS)) then
call msg_debug2 (D_BEAMS, "term_instance_compute_sqme_coll_isr")
if (term%nlo_type == NLO_REAL) then
print *, "nlo_type: REAL"
print *, "n_flv: ", pcm%region_data%n_flv_born
print *, "i_flv: ", i_flv
print *, "Beam 1: "
print *, " quarks: ", pcm_instance%real_sub%sqme_coll_isr (BEAM_PLUS, PDF, :)
print *, " gluon: ", pcm_instance%real_sub%sqme_coll_isr (BEAM_PLUS, PDF_SINGLET, :)
print *, "Beam 2: "
print *, " quarks: ", pcm_instance%real_sub%sqme_coll_isr (BEAM_MINUS, PDF, :)
print *, " gluon: ", pcm_instance%real_sub%sqme_coll_isr (BEAM_MINUS, PDF_SINGLET, :)
else if (term%nlo_type == NLO_DGLAP) then
print *, "nlo_type: DGLAP"
print *, "n_flv: ", pcm%region_data%n_flv_born
print *, "i_flv: ", i_flv
print *, "Beam 1: "
print *, " quarks: ", pcm_instance%dglap_remnant%sqme_coll_isr (BEAM_PLUS, PDF, :)
print *, " gluon: ", pcm_instance%dglap_remnant%sqme_coll_isr (BEAM_PLUS, PDF_SINGLET, :)
print *, "Beam 2: "
print *, " quarks: ", pcm_instance%dglap_remnant%sqme_coll_isr (BEAM_MINUS, PDF, :)
print *, " gluon: ", pcm_instance%dglap_remnant%sqme_coll_isr (BEAM_MINUS, PDF_SINGLET, :)
end if
end if
end select
end select
contains
subroutine set_sqme_coll_isr (i_beam, i_type, i_flv, me)
integer, intent(in) :: i_beam, i_type, i_flv
real(default), intent(in) :: me
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select case (term%nlo_type)
case (NLO_REAL)
pcm_instance%real_sub%sqme_coll_isr (i_beam, i_type, i_flv) = me
case (NLO_DGLAP)
pcm_instance%dglap_remnant%sqme_coll_isr (i_beam, i_type, i_flv) = me
end select
end select
end subroutine set_sqme_coll_isr
end subroutine term_instance_compute_sqme_coll_isr
@ %def term_instance_compute_sqme_coll_isr
@
<<Instances: term instance: TBP>>=
procedure :: apply_fks => term_instance_apply_fks
<<Instances: procedures>>=
subroutine term_instance_apply_fks (term, alpha_s_sub, alpha_qed_sub)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s_sub, alpha_qed_sub
real(default), dimension(:), allocatable :: sqme
integer :: i, i_phs, emitter
logical :: is_subtraction
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (config => pcm_instance%config)
type is (pcm_nlo_t)
if (term%connected%has_matrix) then
allocate (sqme (config%get_n_alr ()))
else
allocate (sqme (1))
end if
sqme = zero
select type (phs => term%k_term%phs)
type is (phs_fks_t)
call pcm_instance%set_real_and_isr_kinematics &
(phs%phs_identifiers, term%k_term%phs%get_sqrts ())
if (term%k_term%emitter < 0) then
call pcm_instance%set_subtraction_event ()
do i_phs = 1, config%region_data%n_phs
emitter = phs%phs_identifiers(i_phs)%emitter
call pcm_instance%real_sub%compute (emitter, &
i_phs, alpha_s_sub, alpha_qed_sub, term%connected%has_matrix, sqme)
end do
else
call pcm_instance%set_radiation_event ()
emitter = term%k_term%emitter; i_phs = term%k_term%i_phs
do i = 1, term%connected_qn_index%get_n_flv ()
pcm_instance%real_sub%sqme_real_non_sub (i, i_phs) = &
real (term%connected%trace%get_matrix_element ( &
term%connected_qn_index%get_index (i)))
end do
call pcm_instance%real_sub%compute (emitter, i_phs, alpha_s_sub, &
alpha_qed_sub, term%connected%has_matrix, sqme)
end if
end select
end select
end select
if (term%connected%has_trace) &
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum(sqme), 0, default))
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
is_subtraction = term%k_term%emitter < 0
if (term%connected%has_matrix) &
call refill_evaluator (cmplx (sqme, 0, default), &
config%get_qn (is_subtraction), &
config%region_data%get_flavor_indices (is_subtraction), &
term%connected%matrix)
if (term%connected%has_flows) &
call refill_evaluator (cmplx (sqme, 0, default), &
config%get_qn (is_subtraction), &
config%region_data%get_flavor_indices (is_subtraction), &
term%connected%flows)
end select
end subroutine term_instance_apply_fks
@ %def term_instance_apply_fks
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_virt => term_instance_evaluate_sqme_virt
<<Instances: procedures>>=
subroutine term_instance_evaluate_sqme_virt (term, alpha_s, alpha_qed)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s, alpha_qed
real(default) :: alpha_coupling
type(vector4_t), dimension(:), allocatable :: p_born
real(default), dimension(:), allocatable :: sqme_virt
integer :: i_flv
if (term%nlo_type /= NLO_VIRTUAL) call msg_fatal &
("Trying to evaluate virtual matrix element with unsuited term_instance.")
if (debug2_active (D_VIRTUAL)) then
call msg_debug2 (D_VIRTUAL, "Evaluating virtual-subtracted matrix elements")
print *, 'ren_scale: ', term%ren_scale
print *, 'fac_scale: ', term%fac_scale
end if
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
associate (nlo_corr_type => config%region_data%regions(1)%nlo_correction_type)
if (nlo_corr_type == "QCD") then
alpha_coupling = alpha_s
if (debug2_active (D_VIRTUAL)) print *, 'alpha_s: ', alpha_coupling
else if (nlo_corr_type == "QED") then
alpha_coupling = alpha_qed
if (debug2_active (D_VIRTUAL)) print *, 'alpha_qed: ', alpha_coupling
end if
end associate
allocate (p_born (config%region_data%n_legs_born))
if (config%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
p_born = pcm_instance%real_kinematics%p_born_onshell%get_momenta(1)
else
p_born = term%int_hard%get_momenta ()
end if
call pcm_instance%set_momenta_and_scales_virtual &
(p_born, term%ren_scale, term%fac_scale)
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
associate (virtual => pcm_instance%virtual)
do i_flv = 1, term%connected_qn_index%get_n_flv ()
virtual%sqme_born(i_flv) = &
real (term%connected%trace%get_matrix_element ( &
term%connected_qn_index%get_index (i_flv, i_sub = 0)))
virtual%sqme_virt_fin(i_flv) = &
real (term%connected%trace%get_matrix_element ( &
term%connected_qn_index%get_index (i_flv, i_sub = 1)))
end do
end associate
end select
call pcm_instance%compute_sqme_virt (term%p_hard, alpha_coupling, &
term%connected%has_matrix, sqme_virt)
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum(sqme_virt) * term%weight, 0, default))
if (term%connected%has_matrix) then
call refill_evaluator (cmplx (sqme_virt * term%weight, 0, default), &
config%get_qn (.true.), &
config%region_data%get_flavor_indices (.true.), &
term%connected%matrix)
end if
end select
end select
end subroutine term_instance_evaluate_sqme_virt
@ %def term_instance_evaluate_sqme_virt
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_mismatch => term_instance_evaluate_sqme_mismatch
<<Instances: procedures>>=
subroutine term_instance_evaluate_sqme_mismatch (term, alpha_s)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s
real(default), dimension(:), allocatable :: sqme_mism
if (term%nlo_type /= NLO_MISMATCH) call msg_fatal &
("Trying to evaluate soft mismatch with unsuited term_instance.")
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call pcm_instance%compute_sqme_mismatch &
(alpha_s, term%connected%has_matrix, sqme_mism)
end select
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum (sqme_mism) * term%weight, 0, default))
if (term%connected%has_matrix) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
call refill_evaluator (cmplx (sqme_mism * term%weight, 0, default), &
config%get_qn (.true.), config%region_data%get_flavor_indices (.true.), &
term%connected%matrix)
end select
end if
end subroutine term_instance_evaluate_sqme_mismatch
@ %def term_instance_evaluate_sqme_mismatch
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_sqme_dglap => term_instance_evaluate_sqme_dglap
<<Instances: procedures>>=
subroutine term_instance_evaluate_sqme_dglap (term, alpha_s)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_s
real(default), dimension(:), allocatable :: sqme_dglap
integer :: i_flv
if (term%nlo_type /= NLO_DGLAP) call msg_fatal &
("Trying to evaluate DGLAP remnant with unsuited term_instance.")
call msg_debug2 (D_PROCESS_INTEGRATION, "term_instance_evaluate_sqme_dglap")
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (debug2_active (D_PROCESS_INTEGRATION)) then
associate (n_flv => pcm_instance%dglap_remnant%n_flv)
print *, "size(sqme_born) = ", size (pcm_instance%dglap_remnant%sqme_born)
call term%connected%trace%write ()
do i_flv = 1, n_flv
print *, "i_flv = ", i_flv, ", n_flv = ", n_flv
print *, "sqme_born(i_flv) = ", pcm_instance%dglap_remnant%sqme_born(i_flv)
end do
end associate
end if
call pcm_instance%compute_sqme_dglap_remnant (alpha_s, &
term%connected%has_matrix, sqme_dglap)
end select
call term%connected%trace%set_only_matrix_element &
(1, cmplx (sum (sqme_dglap) * term%weight, 0, default))
if (term%connected%has_matrix) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
call refill_evaluator (cmplx (sqme_dglap * term%weight, 0, default), &
config%get_qn (.true.), &
config%region_data%get_flavor_indices (.true.), &
term%connected%matrix)
end select
end if
end subroutine term_instance_evaluate_sqme_dglap
@ %def term_instance_evaluate_sqme_dglap
@ Reset the term instance: clear the parton-state expressions and deactivate.
<<Instances: term instance: TBP>>=
procedure :: reset => term_instance_reset
<<Instances: procedures>>=
subroutine term_instance_reset (term)
class(term_instance_t), intent(inout) :: term
call term%connected%reset_expressions ()
if (allocated (term%alpha_qcd_forced)) deallocate (term%alpha_qcd_forced)
term%active = .false.
end subroutine term_instance_reset
@ %def term_instance_reset
@ Force an $\alpha_s$ value that should be used in the matrix-element
calculation.
<<Instances: term instance: TBP>>=
procedure :: set_alpha_qcd_forced => term_instance_set_alpha_qcd_forced
<<Instances: procedures>>=
subroutine term_instance_set_alpha_qcd_forced (term, alpha_qcd)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: alpha_qcd
if (allocated (term%alpha_qcd_forced)) then
term%alpha_qcd_forced = alpha_qcd
else
allocate (term%alpha_qcd_forced, source = alpha_qcd)
end if
end subroutine term_instance_set_alpha_qcd_forced
@ %def term_instance_set_alpha_qcd_forced
@ Complete the kinematics computation for the effective parton states.
We assume that the [[compute_hard_kinematics]] method of the process
component instance has already been called, so the [[int_hard]]
contains the correct hard kinematics. The duty of this procedure is
first to compute the effective kinematics and store this in the
[[int_eff]] effective interaction inside the [[isolated]] parton
state. The effective kinematics may differ from the kinematics in the hard
interaction. It may involve parton recombination or parton splitting.
The [[rearrange_partons]] method is responsible for this part.
We may also call a method to compute the effective structure-function
chain at this point. This is not implemented yet.
In the simple case that no rearrangement is necessary, as indicated by
the [[rearrange]] flag, the effective interaction is a pointer to the
hard interaction, and we can skip the rearrangement method. Similarly
for the effective structure-function chain. (If we have an algorithm
that uses rarrangement, it should evaluate [[k_term]] explicitly.)
The final step of kinematics setup is to transfer the effective
kinematics to the evaluators and to the [[subevt]].
<<Instances: term instance: TBP>>=
procedure :: compute_eff_kinematics => &
term_instance_compute_eff_kinematics
<<Instances: procedures>>=
subroutine term_instance_compute_eff_kinematics (term)
class(term_instance_t), intent(inout) :: term
term%checked = .false.
term%passed = .false.
call term%isolated%receive_kinematics ()
call term%connected%receive_kinematics ()
end subroutine term_instance_compute_eff_kinematics
@ %def term_instance_compute_eff_kinematics
@ Inverse. Reconstruct the connected state from the momenta in the
trace evaluator (which we assume to be set), then reconstruct the
isolated state as far as possible. The second part finalizes the
momentum configuration, using the incoming seed momenta
<<Instances: term instance: TBP>>=
procedure :: recover_hard_kinematics => &
term_instance_recover_hard_kinematics
<<Instances: procedures>>=
subroutine term_instance_recover_hard_kinematics (term)
class(term_instance_t), intent(inout) :: term
term%checked = .false.
term%passed = .false.
call term%connected%send_kinematics ()
call term%isolated%send_kinematics ()
end subroutine term_instance_recover_hard_kinematics
@ %def term_instance_recover_hard_kinematics
@ Check the term whether it passes cuts and, if successful, evaluate
scales and weights. The factorization scale is also given to the term
kinematics, enabling structure-function evaluation.
<<Instances: term instance: TBP>>=
procedure :: evaluate_expressions => &
term_instance_evaluate_expressions
<<Instances: procedures>>=
subroutine term_instance_evaluate_expressions (term, scale_forced)
class(term_instance_t), intent(inout) :: term
real(default), intent(in), allocatable, optional :: scale_forced
call term%connected%evaluate_expressions (term%passed, &
term%scale, term%fac_scale, term%ren_scale, term%weight, &
scale_forced, force_evaluation = .true.)
term%checked = .true.
end subroutine term_instance_evaluate_expressions
@ %def term_instance_evaluate_expressions
@ Evaluate the trace: first evaluate the hard interaction, then the trace
evaluator. We use the [[evaluate_interaction]] method of the process
component which generated this term. The [[subevt]] and cut expressions are
not yet filled.
The [[component]] argument is intent(inout) because the [[compute_amplitude]]
method may modify the [[core_state]] workspace object.
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction => term_instance_evaluate_interaction
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in), pointer :: core
call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction")
term%p_hard = term%int_hard%get_momenta ()
select type (core)
class is (prc_user_defined_base_t)
call term%evaluate_interaction_userdef (core)
class default
call term%evaluate_interaction_default (core)
end select
call term%int_hard%set_matrix_element (term%amp)
end subroutine term_instance_evaluate_interaction
@ %def term_instance_evaluate_interaction
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_default &
=> term_instance_evaluate_interaction_default
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction_default (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
integer :: i
do i = 1, term%config%n_allowed
term%amp(i) = core%compute_amplitude (term%config%i_term, term%p_hard, &
term%config%flv(i), term%config%hel(i), term%config%col(i), &
term%fac_scale, term%ren_scale, term%alpha_qcd_forced, &
term%core_state)
end do
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call pcm_instance%set_fac_scale (term%fac_scale)
end select
end subroutine term_instance_evaluate_interaction_default
@ %def term_instance_evaluate_interaction_default
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_userdef &
=> term_instance_evaluate_interaction_userdef
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction_userdef (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_userdef")
select type (core_state => term%core_state)
type is (openloops_state_t)
select type (core)
type is (prc_openloops_t)
call core%compute_alpha_s (core_state, term%ren_scale)
if (allocated (core_state%threshold_data)) &
call evaluate_threshold_parameters (core_state, core, term%k_term%phs%get_sqrts ())
end select
class is (user_defined_state_t)
select type (core)
class is (prc_user_defined_base_t)
call core%compute_alpha_s (core_state, term%ren_scale)
end select
end select
call evaluate_threshold_interaction ()
if (term%nlo_type == NLO_VIRTUAL) then
call term%evaluate_interaction_userdef_loop (core)
else
call term%evaluate_interaction_userdef_tree (core)
end if
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
call pcm_instance%set_fac_scale (term%fac_scale)
end select
contains
subroutine evaluate_threshold_parameters (core_state, core, sqrts)
type(openloops_state_t), intent(inout) :: core_state
type(prc_openloops_t), intent(inout) :: core
real(default), intent(in) :: sqrts
real(default) :: mtop, wtop
mtop = m1s_to_mpole (sqrts)
wtop = core_state%threshold_data%compute_top_width &
(mtop, core_state%alpha_qcd)
call core%set_mass_and_width (6, mtop, wtop)
end subroutine
subroutine evaluate_threshold_interaction ()
integer :: leg
select type (core)
type is (prc_threshold_t)
if (term%nlo_type > BORN) then
select type (pcm => term%pcm_instance)
type is (pcm_instance_nlo_t)
if (term%k_term%emitter >= 0) then
call core%set_offshell_momenta &
(pcm%real_kinematics%p_real_cms%get_momenta(term%config%i_term))
leg = thr_leg (term%k_term%emitter)
call core%set_leg (leg)
call core%set_onshell_momenta &
(pcm%real_kinematics%p_real_onshell(leg)%get_momenta(term%config%i_term))
else
call core%set_leg (0)
call core%set_offshell_momenta &
(pcm%real_kinematics%p_born_cms%get_momenta(1))
end if
end select
else
call core%set_leg (-1)
call core%set_offshell_momenta (term%p_hard)
end if
end select
end subroutine evaluate_threshold_interaction
end subroutine term_instance_evaluate_interaction_userdef
@ %def term_instance_evaluate_interaction_userdef
@ Retrieve the matrix elements from a matrix element provider and place them
into [[term%amp]].
For the handling of NLO calculations, FKS applies a book keeping handling
flavor and/or particle type (e.g. for QCD: quark/gluon and quark flavor) in
order to calculate the subtraction terms. Therefore, we have to insert the
calculated matrix elements correctly into the state matrix where each entry
corresponds to a set of quantum numbers. We apply a mapping [[hard_qn_ind]] from a list of
quantum numbers provided by FKS to the hard process [[int_hard]].
The calculated matrix elements are insert into [[term%amp]] in the following
way. The first [[n_born]] particles are the matrix element of the hard process.
In non-trivial beams, we store another [[n_beam_structure_int]] copies of these
matrix elements as the first [[n_beam_structure_int]] subtractions.
The next $n_{\text{born}}\times n_{sub}$ are color-correlated born matrix elements.
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_userdef_tree &
=> term_instance_evaluate_interaction_userdef_tree
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction_userdef_tree (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(inout) :: core
real(default) :: sqme
real(default), dimension(:), allocatable :: sqme_color_c
real(default), dimension(:), allocatable :: sqme_spin_c
real(default), dimension(16) :: 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_spin_c, i_emitter
integer :: emitter
logical :: bad_point, bp
call msg_debug2 (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_userdef_tree")
allocate (sqme_color_c (blha_result_array_size &
(term%int_hard%get_n_tot (), BLHA_AMP_COLOR_C)))
n_flv = term%hard_qn_index%get_n_flv ()
n_hel = term%hard_qn_index%get_n_hel ()
n_sub_color = term%get_n_sub_color ()
n_sub_spin = term%get_n_sub_spin ()
do i_flv = 1, n_flv
do i_hel = 1, n_hel
select type (core)
class is (prc_user_defined_base_t)
call core%update_alpha_s (term%core_state, term%fac_scale)
call core%compute_sqme (i_flv, i_hel, term%p_hard, term%ren_scale, &
sqme, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
associate (i_int => term%hard_qn_index%get_index (i_flv = i_flv, i_hel = i_hel, i_sub = 0))
term%amp(i_int) = cmplx (sqme, 0, default)
end associate
end select
n_pdf_off = 0
if (term%pcm_instance%config%has_pdfs .and. &
(term%is_subtraction () .or. term%nlo_type == NLO_DGLAP)) then
n_pdf_off = n_pdf_off + n_beam_structure_int
do i_sub = 1, n_pdf_off
term%amp(term%hard_qn_index%get_index (i_flv, i_hel, i_sub)) = &
term%amp(term%hard_qn_index%get_index (i_flv, i_hel, i_sub = 0))
end do
end if
if ((term%nlo_type == NLO_REAL .and. term%is_subtraction ()) .or. &
term%nlo_type == NLO_MISMATCH) then
sqme_color_c = zero
select type (core)
class is (prc_blha_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, term%p_hard, term%ren_scale, &
sqme_color_c, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
end select
do i_sub = 1, n_sub_color
i_color_c = term%hard_qn_index%get_index (i_flv, i_hel, i_sub + n_pdf_off)
term%amp(i_color_c) = cmplx (sqme_color_c(i_sub), 0, default)
end do
if (n_sub_spin > 0) then
bad_point = .false.
allocate (sqme_spin_c(0))
select type (core)
type is (prc_openloops_t)
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
do i_emitter = 1, config%region_data%n_emitters
emitter = config%region_data%emitters(i_emitter)
if (emitter > 0) then
call core%compute_sqme_spin_c (i_flv, i_hel, emitter, &
term%p_hard, term%ren_scale, sqme_spin_c_tmp, bp)
sqme_spin_c = [sqme_spin_c, sqme_spin_c_tmp]
bad_point = bad_point .or. bp
end if
end do
end select
do i_sub = 1, n_sub_spin
i_spin_c = term%hard_qn_index%get_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
end do
end do
end subroutine term_instance_evaluate_interaction_userdef_tree
@ %def term_instance_evaluate_interaction_userdef_tree
@
<<Instances: term instance: TBP>>=
procedure :: evaluate_interaction_userdef_loop &
=> term_instance_evaluate_interaction_userdef_loop
<<Instances: procedures>>=
subroutine term_instance_evaluate_interaction_userdef_loop (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
integer :: n_hel, n_sub, n_flv
integer :: i, i_flv, i_hel, i_sub, i_virt, i_color_c
real(default), dimension(4) :: sqme_virt
real(default), dimension(:), allocatable :: sqme_color_c
logical :: bad_point
call msg_debug (D_PROCESS_INTEGRATION, &
"term_instance_evaluate_interaction_userdef_loop")
allocate (sqme_color_c (blha_result_array_size &
(term%int_hard%get_n_tot (), BLHA_AMP_COLOR_C)))
n_flv = term%hard_qn_index%get_n_flv ()
n_hel = term%hard_qn_index%get_n_hel ()
n_sub = term%hard_qn_index%get_n_sub ()
i_virt = 1
do i_flv = 1, n_flv
do i_hel = 1, n_hel
select type (core)
class is (prc_user_defined_base_t)
call core%compute_sqme_virt (i_flv, i_hel, term%p_hard, &
term%ren_scale, sqme_virt, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
end select
associate (i_born => term%hard_qn_index%get_index (i_flv, i_hel = i_hel, i_sub = 0), &
i_loop => term%hard_qn_index%get_index (i_flv, i_hel = i_hel, i_sub = i_virt))
term%amp(i_loop) = cmplx (sqme_virt(3), 0, default)
term%amp(i_born) = cmplx (sqme_virt(4), 0, default)
end associate
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
select type (core)
class is (prc_blha_t)
call core%compute_sqme_color_c_raw (i_flv, i_hel, term%p_hard, term%ren_scale, &
sqme_color_c, bad_point)
call term%pcm_instance%set_bad_point (bad_point)
do i_sub = 1 + i_virt, n_sub
i_color_c = term%hard_qn_index%get_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
end do
end do
end subroutine term_instance_evaluate_interaction_userdef_loop
@ %def term_instance_evaluate_interaction_userdef_loop
@ Evaluate the trace. First evaluate the
structure-function chain (i.e., the density matrix of the incoming
partons). Do this twice, in case the sf-chain instances within
[[k_term]] and [[isolated]] differ. Next, evaluate the hard
interaction, then compute the convolution with the initial state.
<<Instances: term instance: TBP>>=
procedure :: evaluate_trace => term_instance_evaluate_trace
<<Instances: procedures>>=
subroutine term_instance_evaluate_trace (term)
class(term_instance_t), intent(inout) :: term
class(sf_rescale_t), allocatable :: func
call term%k_term%evaluate_sf_chain (term%fac_scale)
call term%evaluate_scaled_sf_chains ()
call term%isolated%evaluate_sf_chain (term%fac_scale)
call term%isolated%evaluate_trace ()
call term%connected%evaluate_trace ()
end subroutine term_instance_evaluate_trace
@ %def term_instance_evaluate_trace
@ Include rescaled structure functions due to NLO calculation.
We rescale the structure function for the real subtraction [[sf_rescale_collinear]], the collinear
counter terms [[sf_rescale_dglap_t]] and for the case, we have an emitter in the initial state,
rescale the kinematics for it using [[sf_rescale_real_t]].
References: arXiv:0709.2092, (2.35)-(2.42).
<<Instances: term instance: TBP>>=
procedure :: evaluate_scaled_sf_chains => term_instance_evaluate_scaled_sf_chains
<<Instances: procedures>>=
subroutine term_instance_evaluate_scaled_sf_chains (term)
class(term_instance_t), intent(inout) :: term
class(sf_rescale_t), allocatable :: func
integer :: i_sub
if (.not. term%pcm_instance%config%has_pdfs) return
if (term%nlo_type == NLO_REAL) then
if (term%is_subtraction ()) then
allocate (sf_rescale_collinear_t :: func)
select type (pcm => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (func)
type is (sf_rescale_collinear_t)
call func%set (pcm%real_kinematics%xi_tilde)
call func%set_gluons (.true.)
end select
end select
call term%k_term%sf_chain%evaluate (term%fac_scale, func)
deallocate (func)
else if (term%k_term%emitter >= 0 .and. term%k_term%emitter <= term%k_term%n_in) then
allocate (sf_rescale_real_t :: func)
select type (pcm => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (func)
type is (sf_rescale_real_t)
call func%set (pcm%real_kinematics%xi_tilde * &
pcm%real_kinematics%xi_max (term%k_term%i_phs), &
pcm%real_kinematics%y (term%k_term%i_phs))
! TODO sbrass Obviously, it is completely irrelevant,
! TODO sbrass which beam is treated for hadronic beams. It becomes
! TODO sbrass problematic when handling "e, p"-beams.
call func%restrict_to_beam (term%k_term%emitter)
end select
end select
call term%k_term%sf_chain%evaluate (term%fac_scale, func)
deallocate (func)
else
call term%k_term%sf_chain%evaluate (term%fac_scale)
end if
else if (term%nlo_type == NLO_DGLAP) then
allocate (sf_rescale_dglap_t :: func)
select type (pcm => term%pcm_instance)
type is (pcm_instance_nlo_t)
select type (func)
type is (sf_rescale_dglap_t)
call func%set (pcm%isr_kinematics%z)
call func%set_gluons (.true.)
end select
end select
call term%k_term%sf_chain%evaluate (term%fac_scale, func)
deallocate (func)
end if
end subroutine term_instance_evaluate_scaled_sf_chains
@ %def term_instance_evaluate_scaled_sf_chains
@ Evaluate the extra data that we need for processing the object as a
physical event.
<<Instances: term instance: TBP>>=
procedure :: evaluate_event_data => term_instance_evaluate_event_data
<<Instances: procedures>>=
subroutine term_instance_evaluate_event_data (term)
class(term_instance_t), intent(inout) :: term
logical :: only_momenta
only_momenta = term%nlo_type > BORN
call term%isolated%evaluate_event_data (only_momenta)
call term%connected%evaluate_event_data (only_momenta)
end subroutine term_instance_evaluate_event_data
@ %def term_instance_evaluate_event_data
@
<<Instances: term instance: TBP>>=
procedure :: set_fac_scale => term_instance_set_fac_scale
<<Instances: procedures>>=
subroutine term_instance_set_fac_scale (term, fac_scale)
class(term_instance_t), intent(inout) :: term
real(default), intent(in) :: fac_scale
term%fac_scale = fac_scale
end subroutine term_instance_set_fac_scale
@ %def term_instance_set_fac_scale
@ Return data that might be useful for external processing. The
factorization scale:
<<Instances: term instance: TBP>>=
procedure :: get_fac_scale => term_instance_get_fac_scale
<<Instances: procedures>>=
function term_instance_get_fac_scale (term) result (fac_scale)
class(term_instance_t), intent(in) :: term
real(default) :: fac_scale
fac_scale = term%fac_scale
end function term_instance_get_fac_scale
@ %def term_instance_get_fac_scale
@ We take the strong coupling from the process core. The value is calculated
when a new event is requested, so we should call it only after the event has
been evaluated. If it is not available there (a negative number is returned),
we take the value stored in the term configuration, which should be determined
by the model. If the model does not provide a value, the result is zero.
<<Instances: term instance: TBP>>=
procedure :: get_alpha_s => term_instance_get_alpha_s
<<Instances: procedures>>=
function term_instance_get_alpha_s (term, core) result (alpha_s)
class(term_instance_t), intent(in) :: term
class(prc_core_t), intent(in) :: core
real(default) :: alpha_s
alpha_s = core%get_alpha_s (term%core_state)
if (alpha_s < zero) alpha_s = term%config%alpha_s
end function term_instance_get_alpha_s
@ %def term_instance_get_alpha_s
@
<<Instances: term instance: TBP>>=
procedure :: reset_phs_identifiers => term_instance_reset_phs_identifiers
<<Instances: procedures>>=
subroutine term_instance_reset_phs_identifiers (term)
class(term_instance_t), intent(inout) :: term
select type (phs => term%k_term%phs)
type is (phs_fks_t)
phs%phs_identifiers%evaluated = .false.
end select
end subroutine term_instance_reset_phs_identifiers
@ %def term_instance_reset_phs_identifiers
@ The second helicity for [[helicities]] comes with a minus sign
because OpenLoops inverts the helicity index of antiparticles.
<<Instances: term instance: TBP>>=
procedure :: get_helicities_for_openloops => term_instance_get_helicities_for_openloops
<<Instances: procedures>>=
subroutine term_instance_get_helicities_for_openloops (term, helicities)
class(term_instance_t), intent(in) :: term
integer, dimension(:,:), allocatable, intent(out) :: helicities
type(helicity_t), dimension(:), allocatable :: hel
type(quantum_numbers_t), dimension(:,:), allocatable :: qn
type(quantum_numbers_mask_t) :: qn_mask
integer :: h, i, j, n_in
call qn_mask%set_sub (1)
call term%isolated%trace%get_quantum_numbers_mask (qn_mask, qn)
n_in = term%int_hard%get_n_in ()
allocate (helicities (size (qn, dim=1), n_in))
allocate (hel (n_in))
do i = 1, size (qn, dim=1)
do j = 1, n_in
hel(j) = qn(i, j)%get_helicity ()
call hel(j)%diagonalize ()
call hel(j)%get_indices (h, h)
helicities (i, j) = h
end do
end do
end subroutine term_instance_get_helicities_for_openloops
@ %def term_instance_get_helicities_for_openloops
@
<<Instances: term instance: TBP>>=
procedure :: get_boost_to_lab => term_instance_get_boost_to_lab
<<Instances: procedures>>=
function term_instance_get_boost_to_lab (term) result (lt)
type(lorentz_transformation_t) :: lt
class(term_instance_t), intent(in) :: term
lt = term%k_term%phs%get_lorentz_transformation ()
end function term_instance_get_boost_to_lab
@ %def term_instance_get_boost_to_lab
@
<<Instances: term instance: TBP>>=
procedure :: get_boost_to_cms => term_instance_get_boost_to_cms
<<Instances: procedures>>=
function term_instance_get_boost_to_cms (term) result (lt)
type(lorentz_transformation_t) :: lt
class(term_instance_t), intent(in) :: term
lt = inverse (term%k_term%phs%get_lorentz_transformation ())
end function term_instance_get_boost_to_cms
@ %def term_instance_get_boost_to_cms
@
<<Instances: term instance: TBP>>=
procedure :: get_i_term_global => term_instance_get_i_term_global
<<Instances: procedures>>=
elemental function term_instance_get_i_term_global (term) result (i_term)
integer :: i_term
class(term_instance_t), intent(in) :: term
i_term = term%config%i_term_global
end function term_instance_get_i_term_global
@ %def term_instance_get_i_term_global
@
<<Instances: term instance: TBP>>=
procedure :: is_subtraction => term_instance_is_subtraction
<<Instances: procedures>>=
elemental function term_instance_is_subtraction (term) result (sub)
logical :: sub
class(term_instance_t), intent(in) :: term
sub = term%config%i_term_global == term%config%i_sub
end function term_instance_is_subtraction
@ %def term_instance_is_subtraction
@ Retrieve [[n_sub]] which was calculated in [[process_term_setup_interaction]].
<<Instances: term instance: TBP>>=
procedure :: get_n_sub => term_instance_get_n_sub
procedure :: get_n_sub_color => term_instance_get_n_sub_color
procedure :: get_n_sub_spin => term_instance_get_n_sub_spin
<<Instances: procedures>>=
function term_instance_get_n_sub (term) result (n_sub)
integer :: n_sub
class(term_instance_t), intent(in) :: term
n_sub = term%config%n_sub
end function term_instance_get_n_sub
function term_instance_get_n_sub_color (term) result (n_sub_color)
integer :: n_sub_color
class(term_instance_t), intent(in) :: term
n_sub_color = term%config%n_sub_color
end function term_instance_get_n_sub_color
function term_instance_get_n_sub_spin (term) result (n_sub_spin)
integer :: n_sub_spin
class(term_instance_t), intent(in) :: term
n_sub_spin = term%config%n_sub_spin
end function term_instance_get_n_sub_spin
@ %def term_instance_get_n_sub
@ %def term_instance_get_n_sub_color
@ %def term_instance_get_n_sub_spin
@
\subsection{The process instance}
A process instance contains all process data that depend on the
sampling point and thus change often. In essence, it is an event
record at the elementary (parton) level. We do not call it such, to
avoid confusion with the actual event records. If decays are
involved, the latter are compositions of several elementary processes
(i.e., their instances).
We implement the process instance as an extension of the
[[mci_sampler_t]] that we need for computing integrals and generate
events.
The base type contains: the [[integrand]], the [[selected_channel]],
the two-dimensional array [[x]] of parameters, and the one-dimensional
array [[f]] of Jacobians. These subobjects are public and used for
communicating with the multi-channel integrator.
The [[process]] pointer accesses the process of which this record is
an instance. It is required whenever the calculation needs invariant
configuration data, therefore the process should stay in memory for
the whole lifetime of its instances.
The [[evaluation_status]] code is used to check the current status.
In particular, failure at various stages is recorded there.
The [[count]] object records process evaluations, broken down
according to status.
The [[sqme]] value is the single real number that results from
evaluating and tracing the kinematics and matrix elements. This
is the number that is handed over to an integration routine.
The [[weight]] value is the event weight. It is defined when an event
has been generated from the process instance, either weighted or
unweighted. The value is the [[sqme]] value times Jacobian weights
from the integration, or unity, respectively.
The [[i_mci]] index chooses a subset of components that are associated with
a common parameter set and integrator, i.e., that are added coherently.
The [[sf_chain]] subobject is a realization of the beam and
structure-function configuration in the [[process]] object. It is not
used for calculation directly but serves as the template for the
sf-chain instances that are contained in the [[component]] objects.
The [[component]] subobjects determine the state of each component.
The [[term]] subobjects are workspace for evaluating kinematics,
matrix elements, cuts etc.
The [[mci_work]] subobject contains the array of real input parameters (random
numbers) that generates the kinematical point. It also contains the workspace
for the MC integrators. The active entry of the [[mci_work]] array is
selected by the [[i_mci]] index above.
The [[hook]] pointer accesses a list of after evaluate objects which are
evalutated after the matrix element.
<<Instances: public>>=
public :: process_instance_t
<<Instances: types>>=
type, extends (mci_sampler_t) :: process_instance_t
type(process_t), pointer :: process => null ()
integer :: evaluation_status = STAT_UNDEFINED
real(default) :: sqme = 0
real(default) :: weight = 0
real(default) :: excess = 0
integer :: i_mci = 0
integer :: selected_channel = 0
type(sf_chain_t) :: sf_chain
type(term_instance_t), dimension(:), allocatable :: term
type(mci_work_t), dimension(:), allocatable :: mci_work
class(pcm_instance_t), allocatable :: pcm
class(process_instance_hook_t), pointer :: hook => null ()
contains
<<Instances: process instance: TBP>>
end type process_instance_t
@ %def process_instance
@
Wrapper type for storing pointers to process instance objects in arrays.
<<Instances: public>>=
public :: process_instance_ptr_t
<<Instances: types>>=
type :: process_instance_ptr_t
type(process_instance_t), pointer :: p => null ()
end type process_instance_ptr_t
@ %def process_instance_ptr_t
@ The process hooks are first-in-last-out list of objects which are evalutaed
after the phase space and matrixelement are evaluated. It is possible to
retrieve the sampler object and read the sampler information.
The hook object are part of the [[process_instance]] and therefore, share a
common lifetime. A data transfer, after the usual lifetime of the
[[process_instance]], is not provided, as such the finalisation procedure has to take care
of this! E.g. write the object to file from which later the collected
information can then be retrieved.
<<Instances: public>>=
public :: process_instance_hook_t
<<Instances: types>>=
type, abstract :: process_instance_hook_t
class(process_instance_hook_t), pointer :: next => null ()
contains
procedure(process_instance_hook_init), deferred :: init
procedure(process_instance_hook_final), deferred :: final
procedure(process_instance_hook_evaluate), deferred :: evaluate
end type process_instance_hook_t
@ %def process_instance_hook_t
@ We have to provide a [[init]], a [[final]] procedure and, for after evaluation, the
[[evaluate]] procedure.
The [[init]] procedures accesses [[var_list]] and current [[instance]] object.
<<Instances: public>>=
public :: process_instance_hook_final, process_instance_hook_evaluate
<<Instances: interfaces>>=
abstract interface
subroutine process_instance_hook_init (hook, var_list, instance)
import :: process_instance_hook_t, var_list_t, process_instance_t
class(process_instance_hook_t), intent(inout), target :: hook
type(var_list_t), intent(in) :: var_list
class(process_instance_t), intent(in), target :: instance
end subroutine process_instance_hook_init
subroutine process_instance_hook_final (hook)
import :: process_instance_hook_t
class(process_instance_hook_t), intent(inout) :: hook
end subroutine process_instance_hook_final
subroutine process_instance_hook_evaluate (hook, instance)
import :: process_instance_hook_t, process_instance_t
class(process_instance_hook_t), intent(inout) :: hook
class(process_instance_t), intent(in), target :: instance
end subroutine process_instance_hook_evaluate
end interface
@ %def process_instance_hook_final, process_instance_hook_evaluate
@ The output routine contains a header with the most relevant
information about the process, copied from
[[process_metadata_write]]. We mark the active components by an asterisk.
The next section is the MC parameter input. The following sections
are written only if the evaluation status is beyond setting the
parameters, or if the [[verbose]] option is set.
<<Instances: process instance: TBP>>=
procedure :: write_header => process_instance_write_header
procedure :: write => process_instance_write
<<Instances: procedures>>=
subroutine process_instance_write_header (object, unit, testflag)
class(process_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
if (associated (object%process)) then
call object%process%write_meta (u, testflag)
else
write (u, "(1x,A)") "Process instance [undefined process]"
return
end if
write (u, "(3x,A)", advance = "no") "status = "
select case (object%evaluation_status)
case (STAT_INITIAL); write (u, "(A)") "initialized"
case (STAT_ACTIVATED); write (u, "(A)") "activated"
case (STAT_BEAM_MOMENTA); write (u, "(A)") "beam momenta set"
case (STAT_FAILED_KINEMATICS); write (u, "(A)") "failed kinematics"
case (STAT_SEED_KINEMATICS); write (u, "(A)") "seed kinematics"
case (STAT_HARD_KINEMATICS); write (u, "(A)") "hard kinematics"
case (STAT_EFF_KINEMATICS); write (u, "(A)") "effective kinematics"
case (STAT_FAILED_CUTS); write (u, "(A)") "failed cuts"
case (STAT_PASSED_CUTS); write (u, "(A)") "passed cuts"
case (STAT_EVALUATED_TRACE); write (u, "(A)") "evaluated trace"
call write_separator (u)
write (u, "(3x,A,ES19.12)") "sqme = ", object%sqme
case (STAT_EVENT_COMPLETE); write (u, "(A)") "event complete"
call write_separator (u)
write (u, "(3x,A,ES19.12)") "sqme = ", object%sqme
write (u, "(3x,A,ES19.12)") "weight = ", object%weight
if (.not. vanishes (object%excess)) &
write (u, "(3x,A,ES19.12)") "excess = ", object%excess
case default; write (u, "(A)") "undefined"
end select
if (object%i_mci /= 0) then
call write_separator (u)
call object%mci_work(object%i_mci)%write (u, testflag)
end if
call write_separator (u, 2)
end subroutine process_instance_write_header
subroutine process_instance_write (object, unit, testflag)
class(process_instance_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: u, i
u = given_output_unit (unit)
call object%write_header (u)
if (object%evaluation_status >= STAT_BEAM_MOMENTA) then
call object%sf_chain%write (u)
call write_separator (u, 2)
if (object%evaluation_status >= STAT_SEED_KINEMATICS) then
if (object%evaluation_status >= STAT_HARD_KINEMATICS) then
call write_separator (u, 2)
write (u, "(1x,A)") "Active terms:"
if (any (object%term%active)) then
do i = 1, size (object%term)
if (object%term(i)%active) then
call write_separator (u)
call object%term(i)%write (u, &
show_eff_state = &
object%evaluation_status >= STAT_EFF_KINEMATICS, &
testflag = testflag)
end if
end do
end if
end if
call write_separator (u, 2)
end if
end if
end subroutine process_instance_write
@ %def process_instance_write_header
@ %def process_instance_write
@ Initialization connects the instance with a process. All initial
information is transferred from the process object. The process
object contains templates for the interaction subobjects (beam and
term), but no evaluators. The initialization routine
creates evaluators for the matrix element trace, other evaluators
are left untouched.
Before we start generating, we double-check if the process library
has been updated after the process was initializated
([[check_library_sanity]]). This may happen if between integration
and event generation the library has been recompiled, so all links
become broken.
The [[instance]] object must have the [[target]] attribute (also in
any caller) since the initialization routine assigns various pointers
to subobject of [[instance]].
<<Instances: process instance: TBP>>=
procedure :: init => process_instance_init
<<Instances: procedures>>=
subroutine process_instance_init (instance, process)
class(process_instance_t), intent(out), target :: instance
type(process_t), intent(inout), target :: process
integer :: i
class(pcm_t), pointer :: pcm
type(process_term_t) :: term
integer :: i_born, i_real, i_real_fin
call msg_debug (D_PROCESS_INTEGRATION, "process_instance_init")
instance%process => process
call instance%process%check_library_sanity ()
call instance%setup_sf_chain (process%get_beam_config_ptr ())
allocate (instance%mci_work (process%get_n_mci ()))
do i = 1, size (instance%mci_work)
call instance%process%init_mci_work (instance%mci_work(i), i)
end do
call instance%process%reset_selected_cores ()
pcm => instance%process%get_pcm_ptr ()
call pcm%allocate_instance (instance%pcm)
call instance%pcm%link_config (pcm)
select type (pcm)
type is (pcm_nlo_t)
!!! The process is kept when the integration is finalized, but not the
!!! process_instance. Thus, we check whether pcm has been initialized
!!! but set up the pcm_instance each time.
i_real_fin = process%get_associated_real_fin (1)
if (.not. pcm%initialized) then
i_born = process%get_i_core_nlo_type (BORN)
i_real = process%get_i_core_nlo_type (NLO_REAL, include_sub = .false.)
term = process%get_term_ptr (process%get_i_term (i_real))
call pcm%init_qn (process%get_model_ptr ())
if (i_real_fin > 0) call pcm%allocate_ps_matching ()
associate (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 associate
end if
pcm%initialized = .true.
select type (pcm_instance => instance%pcm)
type is (pcm_instance_nlo_t)
call pcm_instance%init_config (process%component_can_be_integrated (), &
process%get_nlo_type_component (), process%get_sqrts (), i_real_fin, &
process%get_model_ptr ())
end select
end select
allocate (instance%term (process%get_n_terms ()))
do i = 1, process%get_n_terms ()
call instance%term(i)%init_from_process (process, i, instance%pcm, &
instance%sf_chain)
end do
call instance%set_i_mci_to_real_component ()
call instance%find_same_kinematics ()
instance%evaluation_status = STAT_INITIAL
end subroutine process_instance_init
@ %def process_instance_init
@
@ Finalize all subobjects that may contain allocated pointers.
<<Instances: process instance: TBP>>=
procedure :: final => process_instance_final
<<Instances: procedures>>=
subroutine process_instance_final (instance)
class(process_instance_t), intent(inout) :: instance
class(process_instance_hook_t), pointer :: current
integer :: i
instance%process => null ()
if (allocated (instance%mci_work)) then
do i = 1, size (instance%mci_work)
call instance%mci_work(i)%final ()
end do
deallocate (instance%mci_work)
end if
call instance%sf_chain%final ()
if (allocated (instance%term)) then
do i = 1, size (instance%term)
call instance%term(i)%final ()
end do
deallocate (instance%term)
end if
call instance%pcm%final ()
instance%evaluation_status = STAT_UNDEFINED
do while (associated (instance%hook))
current => instance%hook
call current%final ()
instance%hook => current%next
deallocate (current)
end do
instance%hook => null ()
end subroutine process_instance_final
@ %def process_instance_final
@ Revert the process instance to initial state. We do not deallocate
anything, just reset the state index and deactivate all components and
terms.
We do not reset the choice of the MCI set [[i_mci]] unless this is
required explicitly.
<<Instances: process instance: TBP>>=
procedure :: reset => process_instance_reset
<<Instances: procedures>>=
subroutine process_instance_reset (instance, reset_mci)
class(process_instance_t), intent(inout) :: instance
logical, intent(in), optional :: reset_mci
integer :: i
call instance%process%reset_selected_cores ()
do i = 1, size (instance%term)
call instance%term(i)%reset ()
end do
instance%term%checked = .false.
instance%term%passed = .false.
instance%term%k_term%new_seed = .true.
if (present (reset_mci)) then
if (reset_mci) instance%i_mci = 0
end if
instance%selected_channel = 0
instance%evaluation_status = STAT_INITIAL
end subroutine process_instance_reset
@ %def process_instance_reset
@
\subsubsection{Integration and event generation}
The sampler test should just evaluate the squared matrix element [[n_calls]]
times, discarding the results, and return. This can be done before
integration, e.g., for timing estimates.
<<Instances: process instance: TBP>>=
procedure :: sampler_test => process_instance_sampler_test
<<Instances: procedures>>=
subroutine process_instance_sampler_test (instance, i_mci, n_calls)
class(process_instance_t), intent(inout), target :: instance
integer, intent(in) :: i_mci
integer, intent(in) :: n_calls
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
call instance%reset_counter ()
call instance%process%sampler_test (instance, n_calls, i_mci_work)
call instance%process%set_counter_mci_entry (i_mci_work, instance%get_counter ())
end subroutine process_instance_sampler_test
@ %def process_instance_sampler_test
@ Generate a weighted event. We select one of the available MCI
integrators by its index [[i_mci]] and thus generate an event for the
associated (group of) process component(s). The arguments exactly
correspond to the initializer and finalizer above.
The resulting event is stored in the [[process_instance]] object,
which also holds the workspace of the integrator.
Note: The [[process]] object contains the random-number state, which
changes for each event.
Otherwise, all volatile data are inside the [[instance]] object.
<<Instances: process instance: TBP>>=
procedure :: generate_weighted_event => process_instance_generate_weighted_event
<<Instances: procedures>>=
subroutine process_instance_generate_weighted_event (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
associate (mci_work => instance%mci_work(i_mci_work))
call instance%process%generate_weighted_event &
(i_mci_work, mci_work, instance, &
instance%keep_failed_events ())
end associate
end subroutine process_instance_generate_weighted_event
@ %def process_instance_generate_weighted_event
@
<<Instances: process instance: TBP>>=
procedure :: generate_unweighted_event => process_instance_generate_unweighted_event
<<Instances: procedures>>=
subroutine process_instance_generate_unweighted_event (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer :: i_mci_work
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
associate (mci_work => instance%mci_work(i_mci_work))
call instance%process%generate_unweighted_event &
(i_mci_work, mci_work, instance)
end associate
end subroutine process_instance_generate_unweighted_event
@ %def process_instance_generate_unweighted_event
@
This replaces the event generation methods for the situation that the
process instance object has been filled by other means (i.e., reading
and/or recalculating its contents). We just have to fill in missing
MCI data, especially the event weight.
<<Instances: process instance: TBP>>=
procedure :: recover_event => process_instance_recover_event
<<Instances: procedures>>=
subroutine process_instance_recover_event (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_mci
i_mci = instance%i_mci
call instance%process%set_i_mci_work (i_mci)
associate (mci_instance => instance%mci_work(i_mci)%mci)
call mci_instance%fetch (instance, instance%selected_channel)
end associate
end subroutine process_instance_recover_event
@ %def process_instance_recover_event
@
@ Activate the components and terms that correspond to a currently
selected MCI parameter set.
<<Instances: process instance: TBP>>=
procedure :: activate => process_instance_activate
<<Instances: procedures>>=
subroutine process_instance_activate (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i, j
integer, dimension(:), allocatable :: i_term
associate (mci_work => instance%mci_work(instance%i_mci))
call instance%process%select_components (mci_work%get_active_components ())
end associate
associate (process => instance%process)
do i = 1, instance%process%get_n_components ()
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (process%get_component_i_terms (i))))
i_term = process%get_component_i_terms (i)
do j = 1, size (i_term)
instance%term(i_term(j))%active = .true.
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
end associate
instance%evaluation_status = STAT_ACTIVATED
end subroutine process_instance_activate
@ %def process_instance_activate
@
<<Instances: process instance: TBP>>=
procedure :: find_same_kinematics => process_instance_find_same_kinematics
<<Instances: procedures>>=
subroutine process_instance_find_same_kinematics (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_term1, i_term2, k, n_same
do i_term1 = 1, size (instance%term)
if (.not. allocated (instance%term(i_term1)%same_kinematics)) then
n_same = 1 !!! Index group includes the index of its term_instance
do i_term2 = 1, size (instance%term)
if (i_term1 == i_term2) cycle
if (compare_md5s (i_term1, i_term2)) n_same = n_same + 1
end do
allocate (instance%term(i_term1)%same_kinematics (n_same))
associate (same_kinematics1 => instance%term(i_term1)%same_kinematics)
same_kinematics1 = 0
k = 1
do i_term2 = 1, size (instance%term)
if (compare_md5s (i_term1, i_term2)) then
same_kinematics1(k) = i_term2
k = k + 1
end if
end do
do k = 1, size (same_kinematics1)
if (same_kinematics1(k) == i_term1) cycle
i_term2 = same_kinematics1(k)
allocate (instance%term(i_term2)%same_kinematics (n_same))
instance%term(i_term2)%same_kinematics = same_kinematics1
end do
end associate
end if
end do
contains
function compare_md5s (i, j) result (same)
logical :: same
integer, intent(in) :: i, j
character(32) :: md5sum_1, md5sum_2
integer :: mode_1, mode_2
mode_1 = 0; mode_2 = 0
select type (phs => instance%term(i)%k_term%phs%config)
type is (phs_fks_config_t)
md5sum_1 = phs%md5sum_born_config
mode_1 = phs%mode
class default
md5sum_1 = phs%md5sum_phs_config
end select
select type (phs => instance%term(j)%k_term%phs%config)
type is (phs_fks_config_t)
md5sum_2 = phs%md5sum_born_config
mode_2 = phs%mode
class default
md5sum_2 = phs%md5sum_phs_config
end select
same = (md5sum_1 == md5sum_2) .and. (mode_1 == mode_2)
end function compare_md5s
end subroutine process_instance_find_same_kinematics
@ %def process_instance_find_same_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: transfer_same_kinematics => process_instance_transfer_same_kinematics
<<Instances: procedures>>=
subroutine process_instance_transfer_same_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: i, i_term_same
associate (same_kinematics => instance%term(i_term)%same_kinematics)
do i = 1, size (same_kinematics)
i_term_same = same_kinematics(i)
if (i_term_same /= i_term) then
instance%term(i_term_same)%p_seed = instance%term(i_term)%p_seed
associate (phs => instance%term(i_term_same)%k_term%phs)
call phs%set_lorentz_transformation &
(instance%term(i_term)%k_term%phs%get_lorentz_transformation ())
select type (phs)
type is (phs_fks_t)
call phs%set_momenta (instance%term(i_term_same)%p_seed)
call phs%set_reference_frames (.false.)
end select
end associate
end if
instance%term(i_term_same)%k_term%new_seed = .false.
end do
end associate
end subroutine process_instance_transfer_same_kinematics
@ %def process_instance_transfer_same_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: redo_sf_chains => process_instance_redo_sf_chains
<<Instances: procedures>>=
subroutine process_instance_redo_sf_chains (instance, i_term, phs_channel)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), dimension(:) :: i_term
integer, intent(in) :: phs_channel
integer :: i
do i = 1, size (i_term)
call instance%term(i_term(i))%redo_sf_chain &
(instance%mci_work(instance%i_mci), phs_channel)
end do
end subroutine process_instance_redo_sf_chains
@ %def process_instance_redo_sf_chains
@ Integrate the process, using a previously initialized process
instance. We select one of the available MCI integrators by its index
[[i_mci]] and thus integrate over (structure functions and) phase
space for the associated (group of) process component(s).
<<Instances: process instance: TBP>>=
procedure :: integrate => process_instance_integrate
<<Instances: procedures>>=
subroutine process_instance_integrate (instance, i_mci, n_it, n_calls, &
adapt_grids, adapt_weights, final, pacify)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
integer, intent(in) :: n_it
integer, intent(in) :: n_calls
logical, intent(in), optional :: adapt_grids
logical, intent(in), optional :: adapt_weights
logical, intent(in), optional :: final, pacify
integer :: nlo_type, i_mci_work
nlo_type = instance%process%get_component_nlo_type (i_mci)
i_mci_work = instance%process%get_i_mci_work (i_mci)
call instance%choose_mci (i_mci_work)
call instance%reset_counter ()
associate (mci_work => instance%mci_work(i_mci_work), &
process => instance%process)
call process%integrate (i_mci_work, mci_work, &
instance, n_it, n_calls, adapt_grids, adapt_weights, &
final, pacify, nlo_type = nlo_type)
call process%set_counter_mci_entry (i_mci_work, instance%get_counter ())
end associate
end subroutine process_instance_integrate
@ %def process_instance_integrate
@ Subroutine of the initialization above: initialize the beam and
structure-function chain template. We establish pointers to the
configuration data, so [[beam_config]] must have a [[target]]
attribute.
The resulting chain is not used directly for calculation. It will
acquire instances which are stored in the process-component instance
objects.
<<Instances: process instance: TBP>>=
procedure :: setup_sf_chain => process_instance_setup_sf_chain
<<Instances: procedures>>=
subroutine process_instance_setup_sf_chain (instance, config)
class(process_instance_t), intent(inout) :: instance
type(process_beam_config_t), intent(in), target :: config
integer :: n_strfun
n_strfun = config%n_strfun
if (n_strfun /= 0) then
call instance%sf_chain%init (config%data, config%sf)
else
call instance%sf_chain%init (config%data)
end if
if (config%sf_trace) then
call instance%sf_chain%setup_tracing (config%sf_trace_file)
end if
end subroutine process_instance_setup_sf_chain
@ %def process_instance_setup_sf_chain
@ This initialization routine should be called only for process
instances which we intend as a source for physical events. It
initializes the evaluators in the parton states of the terms. They
describe the (semi-)exclusive transition matrix and the distribution
of color flow for the partonic process, convoluted with the beam and
structure-function chain.
If the model is not provided explicitly, we may use the model instance that
belongs to the process. However, an explicit model allows us to override
particle settings.
<<Instances: process instance: TBP>>=
procedure :: setup_event_data => process_instance_setup_event_data
<<Instances: procedures>>=
subroutine process_instance_setup_event_data (instance, model, i_core)
class(process_instance_t), intent(inout), target :: instance
class(model_data_t), intent(in), optional, target :: model
integer, intent(in), optional :: i_core
class(model_data_t), pointer :: current_model
integer :: i
class(prc_core_t), pointer :: core => null ()
if (present (model)) then
current_model => model
else
current_model => instance%process%get_model_ptr ()
end if
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (associated (term%config)) then
core => instance%process%get_core_term (i)
call term%setup_event_data (core, current_model)
end if
end associate
end do
core => null ()
end subroutine process_instance_setup_event_data
@ %def process_instance_setup_event_data
@ Choose a MC parameter set and the corresponding integrator.
The choice persists beyond calls of the [[reset]] method above. This method
is automatically called here.
<<Instances: process instance: TBP>>=
procedure :: choose_mci => process_instance_choose_mci
<<Instances: procedures>>=
subroutine process_instance_choose_mci (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
instance%i_mci = i_mci
call instance%reset ()
end subroutine process_instance_choose_mci
@ %def process_instance_choose_mci
@ Explicitly set a MC parameter set. Works only if we are in initial
state. We assume that the length of the parameter set is correct.
After setting the parameters, activate the components and terms that
correspond to the chosen MC parameter set.
The [[warmup_flag]] is used when a dummy phase-space point is computed
for the warmup of e.g. OpenLoops helicities. The setting of the
the [[evaluation_status]] has to be avoided then.
<<Instances: process instance: TBP>>=
procedure :: set_mcpar => process_instance_set_mcpar
<<Instances: procedures>>=
subroutine process_instance_set_mcpar (instance, x, warmup_flag)
class(process_instance_t), intent(inout) :: instance
real(default), dimension(:), intent(in) :: x
logical, intent(in), optional :: warmup_flag
logical :: activate
activate = .true.; if (present (warmup_flag)) activate = .not. warmup_flag
if (instance%evaluation_status == STAT_INITIAL) then
associate (mci_work => instance%mci_work(instance%i_mci))
call mci_work%set (x)
end associate
if (activate) call instance%activate ()
end if
end subroutine process_instance_set_mcpar
@ %def process_instance_set_mcpar
@ Receive the beam momentum/momenta from a source interaction. This
applies to a cascade decay process instance, where the `beam' momentum
varies event by event.
The master beam momentum array is contained in the main structure
function chain subobject [[sf_chain]]. The sf-chain instance that
reside in the components will take their beam momenta from there.
The procedure transforms the instance status into
[[STAT_BEAM_MOMENTA]]. For process instance with fixed beam, this
intermediate status is skipped.
<<Instances: process instance: TBP>>=
procedure :: receive_beam_momenta => process_instance_receive_beam_momenta
<<Instances: procedures>>=
subroutine process_instance_receive_beam_momenta (instance)
class(process_instance_t), intent(inout) :: instance
if (instance%evaluation_status >= STAT_INITIAL) then
call instance%sf_chain%receive_beam_momenta ()
instance%evaluation_status = STAT_BEAM_MOMENTA
end if
end subroutine process_instance_receive_beam_momenta
@ %def process_instance_receive_beam_momenta
@ Set the beam momentum/momenta explicitly. Otherwise, analogous to
the previous procedure.
<<Instances: process instance: TBP>>=
procedure :: set_beam_momenta => process_instance_set_beam_momenta
<<Instances: procedures>>=
subroutine process_instance_set_beam_momenta (instance, p)
class(process_instance_t), intent(inout) :: instance
type(vector4_t), dimension(:), intent(in) :: p
if (instance%evaluation_status >= STAT_INITIAL) then
call instance%sf_chain%set_beam_momenta (p)
instance%evaluation_status = STAT_BEAM_MOMENTA
end if
end subroutine process_instance_set_beam_momenta
@ %def process_instance_set_beam_momenta
@ Recover the initial beam momenta (those in the [[sf_chain]]
component), given a valid (recovered) [[sf_chain_instance]] in one of
the active components. We need to do this only if the lab frame is
not the c.m.\ frame, otherwise those beams would be fixed anyway.
<<Instances: process instance: TBP>>=
procedure :: recover_beam_momenta => process_instance_recover_beam_momenta
<<Instances: procedures>>=
subroutine process_instance_recover_beam_momenta (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
if (.not. instance%process%lab_is_cm_frame ()) then
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
call instance%term(i_term)%return_beam_momenta ()
end if
end if
end subroutine process_instance_recover_beam_momenta
@ %def process_instance_recover_beam_momenta
@ Explicitly choose MC integration channel. We assume here that the channel
count is identical for all active components.
<<Instances: process instance: TBP>>=
procedure :: select_channel => process_instance_select_channel
<<Instances: procedures>>=
subroutine process_instance_select_channel (instance, channel)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
instance%selected_channel = channel
end subroutine process_instance_select_channel
@ %def process_instance_select_channel
@ First step of process evaluation: set up seed kinematics. That is, for each
active process component, compute a momentum array from the MC input
parameters.
If [[skip_term]] is set, we skip the component that accesses this
term. We can assume that the associated data have already been
recovered, and we are just computing the rest.
<<Instances: process instance: TBP>>=
procedure :: compute_seed_kinematics => &
process_instance_compute_seed_kinematics
<<Instances: procedures>>=
subroutine process_instance_compute_seed_kinematics (instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: channel, skip_component, i, j
logical :: success
integer, dimension(:), allocatable :: i_term
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Compute seed kinematics: undefined integration channel")
end if
if (present (skip_term)) then
skip_component = instance%term(skip_term)%config%i_component
else
skip_component = 0
end if
if (instance%evaluation_status >= STAT_ACTIVATED) then
success = .true.
do i = 1, instance%process%get_n_components ()
if (i == skip_component) cycle
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (instance%process%get_component_i_terms (i))))
i_term = instance%process%get_component_i_terms (i)
do j = 1, size (i_term)
if (instance%term(i_term(j))%k_term%new_seed) then
call instance%term(i_term(j))%compute_seed_kinematics &
(instance%mci_work(instance%i_mci), channel, success)
call instance%transfer_same_kinematics (i_term(j))
end if
if (.not. success) exit
call instance%term(i_term(j))%evaluate_projections ()
call instance%term(i_term(j))%evaluate_radiation_kinematics &
(instance%mci_work(instance%i_mci)%get_x_process ())
call instance%term(i_term(j))%generate_fsr_in ()
call instance%term(i_term(j))%compute_xi_ref_momenta ()
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
if (success) then
instance%evaluation_status = STAT_SEED_KINEMATICS
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
end if
associate (mci_work => instance%mci_work(instance%i_mci))
select type (pcm => instance%pcm)
class is (pcm_instance_nlo_t)
call pcm%set_x_rad (mci_work%get_x_process ())
end select
end associate
end subroutine process_instance_compute_seed_kinematics
@ %def process_instance_compute_seed_kinematics
@
<<Instances: process instance: TBP>>=
procedure :: get_x_process => process_instance_get_x_process
<<Instances: procedures>>=
pure function process_instance_get_x_process (instance) result (x)
real(default), dimension(:), allocatable :: x
class(process_instance_t), intent(in) :: instance
allocate (x(size (instance%mci_work(instance%i_mci)%get_x_process ())))
x = instance%mci_work(instance%i_mci)%get_x_process ()
end function process_instance_get_x_process
@ %def process_instance_get_x_process
@
<<Instances: process instance: TBP>>=
procedure :: get_active_component_type => process_instance_get_active_component_type
<<Instances: procedures>>=
pure function process_instance_get_active_component_type (instance) &
result (nlo_type)
integer :: nlo_type
class(process_instance_t), intent(in) :: instance
nlo_type = instance%process%get_component_nlo_type (instance%i_mci)
end function process_instance_get_active_component_type
@ %def process_instance_get_active_component_type
@ Inverse: recover missing parts of the kinematics from the momentum
configuration, which we know for a single term and component. Given
a channel, reconstruct the MC parameter set.
<<Instances: process instance: TBP>>=
procedure :: recover_mcpar => process_instance_recover_mcpar
<<Instances: procedures>>=
subroutine process_instance_recover_mcpar (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: channel
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Recover MC parameters: undefined integration channel")
end if
call instance%term(i_term)%recover_mcpar &
(instance%mci_work(instance%i_mci), channel)
end if
end subroutine process_instance_recover_mcpar
@ %def process_instance_recover_mcpar
@ This is part of [[recover_mcpar]], extracted for the case when there is
no phase space and parameters to recover, but we still need the structure
function kinematics for evaluation.
<<Instances: process instance: TBP>>=
procedure :: recover_sfchain => process_instance_recover_sfchain
<<Instances: procedures>>=
subroutine process_instance_recover_sfchain (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: channel
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Recover sfchain: undefined integration channel")
end if
call instance%term(i_term)%recover_sfchain (channel)
end if
end subroutine process_instance_recover_sfchain
@ %def process_instance_recover_sfchain
@ Second step of process evaluation: compute all momenta, for all active
components, from the seed kinematics.
<<Instances: process instance: TBP>>=
procedure :: compute_hard_kinematics => &
process_instance_compute_hard_kinematics
<<Instances: procedures>>=
subroutine process_instance_compute_hard_kinematics (instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: i
logical :: success
success = .true.
if (instance%evaluation_status >= STAT_SEED_KINEMATICS) then
do i = 1, size (instance%term)
if (instance%term(i)%active) then
call instance%term(i)%compute_hard_kinematics (skip_term, success)
if (.not. success) exit
!!! Ren scale is zero when this is commented out! Understand!
if (instance%term(i)%nlo_type == NLO_REAL) &
call instance%term(i)%redo_sf_chain (instance%mci_work(instance%i_mci), &
instance%selected_channel)
end if
end do
if (success) then
instance%evaluation_status = STAT_HARD_KINEMATICS
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
end if
end subroutine process_instance_compute_hard_kinematics
@ %def process_instance_setup_compute_hard_kinematics
@ Inverse: recover seed kinematics. We know the beam momentum
configuration and the outgoing momenta of the effective interaction,
for one specific term.
<<Instances: process instance: TBP>>=
procedure :: recover_seed_kinematics => &
process_instance_recover_seed_kinematics
<<Instances: procedures>>=
subroutine process_instance_recover_seed_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) &
call instance%term(i_term)%recover_seed_kinematics ()
end subroutine process_instance_recover_seed_kinematics
@ %def process_instance_recover_seed_kinematics
@ Third step of process evaluation: compute the effective momentum
configurations, for all active terms, from the hard kinematics.
<<Instances: process instance: TBP>>=
procedure :: compute_eff_kinematics => &
process_instance_compute_eff_kinematics
<<Instances: procedures>>=
subroutine process_instance_compute_eff_kinematics (instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: i
if (instance%evaluation_status >= STAT_HARD_KINEMATICS) then
do i = 1, size (instance%term)
if (present (skip_term)) then
if (i == skip_term) cycle
end if
if (instance%term(i)%active) then
call instance%term(i)%compute_eff_kinematics ()
end if
end do
instance%evaluation_status = STAT_EFF_KINEMATICS
end if
end subroutine process_instance_compute_eff_kinematics
@ %def process_instance_setup_compute_eff_kinematics
@ Inverse: recover the hard kinematics from effective kinematics for
one term, then compute effective kinematics for the other terms.
<<Instances: process instance: TBP>>=
procedure :: recover_hard_kinematics => &
process_instance_recover_hard_kinematics
<<Instances: procedures>>=
subroutine process_instance_recover_hard_kinematics (instance, i_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
integer :: i
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
call instance%term(i_term)%recover_hard_kinematics ()
do i = 1, size (instance%term)
if (i /= i_term) then
if (instance%term(i)%active) then
call instance%term(i)%compute_eff_kinematics ()
end if
end if
end do
instance%evaluation_status = STAT_EFF_KINEMATICS
end if
end subroutine process_instance_recover_hard_kinematics
@ %def recover_hard_kinematics
@ Fourth step of process evaluation: check cuts for all terms. Where
sucessful, compute any scales and weights. Otherwise, deactive the term.
If any of the terms has passed, set the state to [[STAT_PASSED_CUTS]].
The argument [[scale_forced]], if present, will override the scale calculation
in the term expressions.
<<Instances: process instance: TBP>>=
procedure :: evaluate_expressions => &
process_instance_evaluate_expressions
<<Instances: procedures>>=
subroutine process_instance_evaluate_expressions (instance, scale_forced)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in), allocatable, optional :: scale_forced
integer :: i
logical :: passed_real
if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
do i = 1, size (instance%term)
if (instance%term(i)%active) then
call instance%term(i)%evaluate_expressions (scale_forced)
end if
end do
call evaluate_real_scales_and_cuts ()
if (.not. passed_real) then
instance%evaluation_status = STAT_FAILED_CUTS
else
if (any (instance%term%passed)) then
instance%evaluation_status = STAT_PASSED_CUTS
else
instance%evaluation_status = STAT_FAILED_CUTS
end if
end if
end if
contains
subroutine evaluate_real_scales_and_cuts ()
integer :: i
passed_real = .true.
select type (config => instance%pcm%config)
type is (pcm_nlo_t)
do i = 1, size (instance%term)
if (instance%term(i)%active .and. instance%term(i)%nlo_type == NLO_REAL) then
if (config%settings%cut_all_sqmes) &
passed_real = passed_real .and. instance%term(i)%passed
if (config%settings%use_born_scale) &
call replace_scales (instance%term(i))
end if
end do
end select
end subroutine evaluate_real_scales_and_cuts
subroutine replace_scales (this_term)
type(term_instance_t), intent(inout) :: this_term
integer :: i_sub
i_sub = this_term%config%i_sub
if (this_term%config%i_term_global /= i_sub .and. i_sub > 0) then
this_term%ren_scale = instance%term(i_sub)%ren_scale
this_term%fac_scale = instance%term(i_sub)%fac_scale
end if
end subroutine replace_scales
end subroutine process_instance_evaluate_expressions
@ %def process_instance_evaluate_expressions
@ Fifth step of process evaluation: fill the parameters for the non-selected
,channels, that have not been used for seeding. We should do this after
evaluating cuts, since we may save some expensive calculations if the phase
space point fails the cuts.
If [[skip_term]] is set, we skip the component that accesses this
term. We can assume that the associated data have already been
recovered, and we are just computing the rest.
<<Instances: process instance: TBP>>=
procedure :: compute_other_channels => &
process_instance_compute_other_channels
<<Instances: procedures>>=
subroutine process_instance_compute_other_channels (instance, skip_term)
class(process_instance_t), intent(inout) :: instance
integer, intent(in), optional :: skip_term
integer :: channel, skip_component, i, j
integer, dimension(:), allocatable :: i_term
channel = instance%selected_channel
if (channel == 0) then
call msg_bug ("Compute other channels: undefined integration channel")
end if
if (present (skip_term)) then
skip_component = instance%term(skip_term)%config%i_component
else
skip_component = 0
end if
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, instance%process%get_n_components ()
if (i == skip_component) cycle
if (instance%process%component_is_selected (i)) then
allocate (i_term (size (instance%process%get_component_i_terms (i))))
i_term = instance%process%get_component_i_terms (i)
do j = 1, size (i_term)
call instance%term(i_term(j))%compute_other_channels &
(instance%mci_work(instance%i_mci), channel)
end do
end if
if (allocated (i_term)) deallocate (i_term)
end do
end if
end subroutine process_instance_compute_other_channels
@ %def process_instance_compute_other_channels
@ If not done otherwise, we an flag the kinematics as new for the core state,
such that the routine below will actually compute the matrix element and not
just look it up.
<<Instances: process instance: TBP>>=
procedure :: reset_core_kinematics => process_instance_reset_core_kinematics
<<Instances: procedures>>=
subroutine process_instance_reset_core_kinematics (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active .and. term%passed) then
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
end if
end associate
end do
end if
end subroutine process_instance_reset_core_kinematics
@ %def process_instance_reset_core_kinematics
@ Sixth step of process evaluation: evaluate the matrix elements, and compute
the trace (summed over quantum numbers) for all terms. Finally, sum up the
terms, iterating over all active process components.
<<Instances: process instance: TBP>>=
procedure :: evaluate_trace => process_instance_evaluate_trace
<<Instances: procedures>>=
subroutine process_instance_evaluate_trace (instance)
class(process_instance_t), intent(inout) :: instance
class(prc_core_t), pointer :: core => null ()
integer :: i, i_real_fin
real(default) :: alpha_s, alpha_qed
class(prc_core_t), pointer :: core_sub => null ()
class(model_data_t), pointer :: model => null ()
call msg_debug2 (D_PROCESS_INTEGRATION, "process_instance_evaluate_trace")
instance%sqme = zero
call instance%reset_matrix_elements ()
if (instance%evaluation_status >= STAT_PASSED_CUTS) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active .and. term%passed) then
core => instance%process%get_core_term (i)
if (instance%pcm%config%is_nlo ()) &
core_sub => instance%process%get_subtraction_core ()
call term%evaluate_interaction (core)
call term%evaluate_trace ()
i_real_fin = instance%process%get_associated_real_fin (1)
if (instance%process%uses_real_partition ()) &
call term%apply_real_partition (instance%process)
if (term%config%i_component /= i_real_fin) then
if ((term%nlo_type == NLO_REAL .and. term%k_term%emitter < 0) &
.or. term%nlo_type == NLO_MISMATCH &
.or. term%nlo_type == NLO_DGLAP) &
call term%set_born_sqmes (core)
if (term%nlo_type > BORN) then
if (.not. (term%nlo_type == NLO_REAL .and. term%k_term%emitter >= 0)) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (char (config%settings%nlo_correction_type) == "QCD" .or. &
char (config%settings%nlo_correction_type) == "Full") &
call term%evaluate_color_correlations (core_sub)
if (char (config%settings%nlo_correction_type) == "QED" .or. &
char (config%settings%nlo_correction_type) == "Full") &
call term%evaluate_charge_correlations (core_sub)
end select
end if
if (term%is_subtraction ()) then
call term%evaluate_spin_correlations (core_sub)
end if
if ((term%is_subtraction () .or. term%nlo_type == NLO_DGLAP) &
.and. term%pcm_instance%config%has_pdfs) &
call term%compute_sqme_coll_isr ()
end if
alpha_s = core%get_alpha_s (term%core_state)
if (associated (instance%process%get_model_ptr ())) then
model => instance%process%get_model_ptr ()
if (associated (model%get_par_data_ptr (var_str ('alpha_em_i')))) &
alpha_qed = one / model%get_real (var_str ('alpha_em_i'))
model => null ()
end if
select case (term%nlo_type)
case (NLO_REAL)
call term%apply_fks (alpha_s, alpha_qed)
case (NLO_VIRTUAL)
call term%evaluate_sqme_virt (alpha_s, alpha_qed)
case (NLO_MISMATCH)
call term%evaluate_sqme_mismatch (alpha_s)
case (NLO_DGLAP)
call term%evaluate_sqme_dglap (alpha_s)
end select
end if
end if
core_sub => null ()
instance%sqme = instance%sqme + real (sum (&
term%connected%trace%get_matrix_element () * &
term%weight))
end associate
end do
core => null ()
if (instance%pcm%is_valid ()) then
instance%evaluation_status = STAT_EVALUATED_TRACE
else
instance%evaluation_status = STAT_FAILED_KINEMATICS
end if
else
!!! Failed kinematics or failed cuts: set sqme to zero
instance%sqme = zero
end if
end subroutine process_instance_evaluate_trace
@ %def process_instance_evaluate_trace
<<Instances: term instance: TBP>>=
procedure :: set_born_sqmes => term_instance_set_born_sqmes
<<Instances: procedures>>=
subroutine term_instance_set_born_sqmes (term, core)
class(term_instance_t), intent(inout) :: term
class(prc_core_t), intent(in) :: core
integer :: i_flv, ii_flv
real(default) :: sqme
select type (pcm_instance => term%pcm_instance)
type is (pcm_instance_nlo_t)
do i_flv = 1, term%connected_qn_index%get_n_flv ()
ii_flv = term%connected_qn_index%get_index (i_flv, i_sub = 0)
sqme = real (term%connected%trace%get_matrix_element (ii_flv))
select case (term%nlo_type)
case (NLO_REAL)
pcm_instance%real_sub%sqme_born(i_flv) = sqme
case (NLO_MISMATCH)
pcm_instance%soft_mismatch%sqme_born(i_flv) = sqme
case (NLO_DGLAP)
pcm_instance%dglap_remnant%sqme_born(i_flv) = sqme
end select
end do
end select
end subroutine term_instance_set_born_sqmes
@
<<Instances: process instance: TBP>>=
procedure :: apply_real_partition => process_instance_apply_real_partition
<<Instances: procedures>>=
subroutine process_instance_apply_real_partition (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_component, i_term
integer, dimension(:), allocatable :: i_terms
associate (process => instance%process)
i_component = process%get_first_real_component ()
if (process%component_is_selected (i_component) .and. &
process%get_component_nlo_type (i_component) == NLO_REAL) then
allocate (i_terms (size (process%get_component_i_terms (i_component))))
i_terms = process%get_component_i_terms (i_component)
do i_term = 1, size (i_terms)
call instance%term(i_terms(i_term))%apply_real_partition (process)
end do
end if
if (allocated (i_terms)) deallocate (i_terms)
end associate
end subroutine process_instance_apply_real_partition
@ %def process_instance_apply_real_partition
@
<<Instances: process instance: TBP>>=
procedure :: set_i_mci_to_real_component => process_instance_set_i_mci_to_real_component
<<Instances: procedures>>=
subroutine process_instance_set_i_mci_to_real_component (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_mci, i_component
type(process_component_t), pointer :: component => null ()
select type (pcm_instance => instance%pcm)
type is (pcm_instance_nlo_t)
if (allocated (pcm_instance%i_mci_to_real_component)) then
call msg_warning ("i_mci_to_real_component already allocated - replace it")
deallocate (pcm_instance%i_mci_to_real_component)
end if
allocate (pcm_instance%i_mci_to_real_component (size (instance%mci_work)))
do i_mci = 1, size (instance%mci_work)
do i_component = 1, instance%process%get_n_components ()
component => instance%process%get_component_ptr (i_component)
if (component%i_mci /= i_mci) cycle
select case (component%component_type)
case (COMP_MASTER, COMP_REAL)
pcm_instance%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real ()
case (COMP_REAL_FIN)
pcm_instance%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real_fin ()
case (COMP_REAL_SING)
pcm_instance%i_mci_to_real_component (i_mci) = &
component%config%get_associated_real_sing ()
end select
end do
end do
component => null ()
end select
end subroutine process_instance_set_i_mci_to_real_component
@ %def process_instance_set_i_mci_to_real_component
@ Final step of process evaluation: evaluate the matrix elements, and compute
the trace (summed over quantum numbers) for all terms. Finally, sum up the
terms, iterating over all active process components.
If [[weight]] is provided, we already know the kinematical event
weight (the MCI weight which depends on the kinematics sampling
algorithm, but not on the matrix element), so we do not need to take
it from the MCI record.
<<Instances: process instance: TBP>>=
procedure :: evaluate_event_data => process_instance_evaluate_event_data
<<Instances: procedures>>=
subroutine process_instance_evaluate_event_data (instance, weight)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in), optional :: weight
integer :: i
if (instance%evaluation_status >= STAT_EVALUATED_TRACE) then
do i = 1, size (instance%term)
associate (term => instance%term(i))
if (term%active .and. term%passed) 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%evaluation_status = STAT_EVENT_COMPLETE
else
!!! failed kinematics etc.: set weight to zero
instance%weight = zero
!!! Maybe we want to keep the event nevertheless
if (instance%keep_failed_events ()) then
!!! Force factorization scale, otherwise writing to event output fails
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. Also,
e.g. for Powheg, there is the possibility to supply an external $\alpha_s$
<<Instances: process instance: TBP>>=
procedure :: compute_sqme_rad => process_instance_compute_sqme_rad
<<Instances: procedures>>=
subroutine process_instance_compute_sqme_rad &
(instance, i_term, i_phs, is_subtraction, alpha_s_external)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term, i_phs
logical, intent(in) :: is_subtraction
real(default), intent(in), optional :: alpha_s_external
class(prc_core_t), pointer :: core
integer :: i_real_fin
call msg_debug2 (D_PROCESS_INTEGRATION, "process_instance_compute_sqme_rad")
select type (pcm => instance%pcm)
type is (pcm_instance_nlo_t)
associate (term => instance%term(i_term))
core => instance%process%get_core_term (i_term)
if (is_subtraction) then
call pcm%set_subtraction_event ()
else
call pcm%set_radiation_event ()
end if
call term%int_hard%set_momenta (pcm%get_momenta &
(i_phs = i_phs, born_phsp = is_subtraction))
if (allocated (term%core_state)) &
call term%core_state%reset_new_kinematics ()
if (present (alpha_s_external)) &
call term%set_alpha_qcd_forced (alpha_s_external)
call term%compute_eff_kinematics ()
call term%evaluate_expressions ()
call term%evaluate_interaction (core)
call term%evaluate_trace ()
pcm%real_sub%sqme_born (1) = &
real (term%connected%trace%get_matrix_element (1))
if (term%is_subtraction ()) then
select type (config => term%pcm_instance%config)
type is (pcm_nlo_t)
if (char (config%settings%nlo_correction_type) == "QCD" .or. &
char (config%settings%nlo_correction_type) == "Full") &
call term%evaluate_color_correlations (core)
if (char (config%settings%nlo_correction_type) == "QED" .or. &
char (config%settings%nlo_correction_type) == "Full") &
call term%evaluate_charge_correlations (core)
end select
call term%evaluate_spin_correlations (core)
if (term%pcm_instance%config%has_pdfs) &
call term%compute_sqme_coll_isr ()
else if (term%nlo_type == NLO_DGLAP) then
call term%compute_sqme_coll_isr ()
end if
i_real_fin = instance%process%get_associated_real_fin (1)
if (term%config%i_component /= i_real_fin) &
call term%apply_fks (core%get_alpha_s (term%core_state), 0._default)
if (instance%process%uses_real_partition ()) &
call instance%apply_real_partition ()
end associate
end select
core => null ()
end subroutine process_instance_compute_sqme_rad
@ %def process_instance_compute_sqme_rad
@ For unweighted event generation, we should reset the reported event
weight to unity (signed) or zero. The latter case is appropriate for
an event which failed for whatever reason.
<<Instances: process instance: TBP>>=
procedure :: normalize_weight => process_instance_normalize_weight
<<Instances: procedures>>=
subroutine process_instance_normalize_weight (instance)
class(process_instance_t), intent(inout) :: instance
if (.not. vanishes (instance%weight)) then
instance%weight = sign (1._default, instance%weight)
end if
end subroutine process_instance_normalize_weight
@ %def process_instance_normalize_weight
@ This is a convenience routine that performs the computations of the
steps 1 to 5 in a single step. The arguments are the input for
[[set_mcpar]]. After this, the evaluation status should be either
[[STAT_FAILED_KINEMATICS]], [[STAT_FAILED_CUTS]] or [[STAT_EVALUATED_TRACE]].
Before calling this, we should call [[choose_mci]].
<<Instances: process instance: TBP>>=
procedure :: evaluate_sqme => process_instance_evaluate_sqme
<<Instances: procedures>>=
subroutine process_instance_evaluate_sqme (instance, channel, x)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
real(default), dimension(:), intent(in) :: x
call instance%reset ()
call instance%set_mcpar (x)
call instance%select_channel (channel)
call instance%compute_seed_kinematics ()
call instance%compute_hard_kinematics ()
call instance%compute_eff_kinematics ()
call instance%evaluate_expressions ()
call instance%compute_other_channels ()
call instance%evaluate_trace ()
end subroutine process_instance_evaluate_sqme
@ %def process_instance_evaluate_sqme
@ This is the inverse. Assuming that the final trace evaluator
contains a valid momentum configuration, recover kinematics
and recalculate the matrix elements and their trace.
To be precise, we first recover kinematics for the given term and
associated component, then recalculate from that all other terms and
active components. The [[channel]] is not really required to obtain
the matrix element, but it allows us to reconstruct the exact MC
parameter set that corresponds to the given phase space point.
Before calling this, we should call [[choose_mci]].
<<Instances: process instance: TBP>>=
procedure :: recover => process_instance_recover
<<Instances: procedures>>=
subroutine process_instance_recover &
(instance, channel, i_term, update_sqme, recover_phs, scale_forced)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
integer, intent(in) :: i_term
logical, intent(in) :: update_sqme
logical, intent(in) :: recover_phs
real(default), intent(in), allocatable, optional :: scale_forced
logical :: skip_phs
call instance%activate ()
instance%evaluation_status = STAT_EFF_KINEMATICS
call instance%recover_hard_kinematics (i_term)
call instance%recover_seed_kinematics (i_term)
call instance%select_channel (channel)
if (recover_phs) then
call instance%recover_mcpar (i_term)
call instance%recover_beam_momenta (i_term)
call instance%compute_seed_kinematics (i_term)
call instance%compute_hard_kinematics (i_term)
call instance%compute_eff_kinematics (i_term)
call instance%compute_other_channels (i_term)
else
call instance%recover_sfchain (i_term)
end if
call instance%evaluate_expressions (scale_forced)
if (update_sqme) then
call instance%reset_core_kinematics ()
call instance%evaluate_trace ()
end if
end subroutine process_instance_recover
@ %def process_instance_recover
@ The [[evaluate]] method is required by the [[sampler_t]] base type of which
the process instance is an extension.
The requirement is that after the process instance is evaluated, the
integrand, the selected channel, the $x$ array, and the $f$ Jacobian array are
exposed by the [[sampler_t]] object.
We allow for the additional [[hook]] to be called, if associated, for outlying
object to access information from the current state of the [[sampler]].
<<Instances: process instance: TBP>>=
procedure :: evaluate => process_instance_evaluate
<<Instances: procedures>>=
subroutine process_instance_evaluate (sampler, c, x_in, val, x, f)
class(process_instance_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call sampler%evaluate_sqme (c, x_in)
if (sampler%is_valid ()) then
call sampler%fetch (val, x, f)
end if
call sampler%record_call ()
call sampler%evaluate_after_hook ()
end subroutine process_instance_evaluate
@ %def process_instance_evaluate
@ The phase-space point is valid if the event has valid kinematics and
has passed the cuts.
<<Instances: process instance: TBP>>=
procedure :: is_valid => process_instance_is_valid
<<Instances: procedures>>=
function process_instance_is_valid (sampler) result (valid)
class(process_instance_t), intent(in) :: sampler
logical :: valid
valid = sampler%evaluation_status >= STAT_PASSED_CUTS
end function process_instance_is_valid
@ %def process_instance_is_valid
@ Add a [[process_instance_hook]] object..
<<Instances: process instance: TBP>>=
procedure :: append_after_hook => process_instance_append_after_hook
<<Instances: procedures>>=
subroutine process_instance_append_after_hook (sampler, new_hook)
class(process_instance_t), intent(inout), target :: sampler
class(process_instance_hook_t), intent(inout), target :: new_hook
class(process_instance_hook_t), pointer :: last
if (associated (new_hook%next)) then
call msg_bug ("process_instance_append_after_hook: reuse of SAME hook object is forbidden.")
end if
if (associated (sampler%hook)) then
last => sampler%hook
do while (associated (last%next))
last => last%next
end do
last%next => new_hook
else
sampler%hook => new_hook
end if
end subroutine process_instance_append_after_hook
@ %def process_instance_append_after_evaluate_hook
@ Evaluate the after hook as first in, last out.
<<Instances: process instance: TBP>>=
procedure :: evaluate_after_hook => process_instance_evaluate_after_hook
<<Instances: procedures>>=
subroutine process_instance_evaluate_after_hook (sampler)
class(process_instance_t), intent(in) :: sampler
class(process_instance_hook_t), pointer :: current
current => sampler%hook
do while (associated(current))
call current%evaluate (sampler)
current => current%next
end do
end subroutine process_instance_evaluate_after_hook
@ %def process_instance_evaluate_after_hook
@ The [[rebuild]] method should rebuild the kinematics section out of
the [[x_in]] parameter set. The integrand value [[val]] should not be
computed, but is provided as input.
<<Instances: process instance: TBP>>=
procedure :: rebuild => process_instance_rebuild
<<Instances: procedures>>=
subroutine process_instance_rebuild (sampler, c, x_in, val, x, f)
class(process_instance_t), intent(inout) :: sampler
integer, intent(in) :: c
real(default), dimension(:), intent(in) :: x_in
real(default), intent(in) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
call msg_bug ("process_instance_rebuild not implemented yet")
x = 0
f = 0
end subroutine process_instance_rebuild
@ %def process_instance_rebuild
@ This is another method required by the [[sampler_t]] base type:
fetch the data that are relevant for the MCI record.
<<Instances: process instance: TBP>>=
procedure :: fetch => process_instance_fetch
<<Instances: procedures>>=
subroutine process_instance_fetch (sampler, val, x, f)
class(process_instance_t), intent(in) :: sampler
real(default), intent(out) :: val
real(default), dimension(:,:), intent(out) :: x
real(default), dimension(:), intent(out) :: f
integer, dimension(:), allocatable :: i_terms
integer :: i, i_term_base, cc
integer :: n_channel
val = 0
associate (process => sampler%process)
FIND_COMPONENT: do i = 1, process%get_n_components ()
if (sampler%process%component_is_selected (i)) then
allocate (i_terms (size (process%get_component_i_terms (i))))
i_terms = process%get_component_i_terms (i)
i_term_base = i_terms(1)
associate (k => sampler%term(i_term_base)%k_term)
n_channel = k%n_channel
do cc = 1, n_channel
call k%get_mcpar (cc, x(:,cc))
end do
f = k%f
val = sampler%sqme * k%phs_factor
end associate
if (allocated (i_terms)) deallocate (i_terms)
exit FIND_COMPONENT
end if
end do FIND_COMPONENT
end associate
end subroutine process_instance_fetch
@ %def process_instance_fetch
@ Initialize and finalize event generation for the specified MCI
entry.
<<Instances: process instance: TBP>>=
procedure :: init_simulation => process_instance_init_simulation
procedure :: final_simulation => process_instance_final_simulation
<<Instances: procedures>>=
subroutine process_instance_init_simulation (instance, i_mci, &
safety_factor, keep_failed_events)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
real(default), intent(in), optional :: safety_factor
logical, intent(in), optional :: keep_failed_events
call instance%mci_work(i_mci)%init_simulation (safety_factor, keep_failed_events)
end subroutine process_instance_init_simulation
subroutine process_instance_final_simulation (instance, i_mci)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_mci
call instance%mci_work(i_mci)%final_simulation ()
end subroutine process_instance_final_simulation
@ %def process_instance_init_simulation
@ %def process_instance_final_simulation
@
\subsubsection{Accessing the process instance}
Once the seed kinematics is complete, we can retrieve the MC input parameters
for all channels, not just the seed channel.
Note: We choose the first active component. This makes sense only if the seed
kinematics is identical for all active components.
<<Instances: process instance: TBP>>=
procedure :: get_mcpar => process_instance_get_mcpar
<<Instances: procedures>>=
subroutine process_instance_get_mcpar (instance, channel, x)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: channel
real(default), dimension(:), intent(out) :: x
integer :: i
if (instance%evaluation_status >= STAT_SEED_KINEMATICS) then
do i = 1, size (instance%term)
if (instance%term(i)%active) then
call instance%term(i)%k_term%get_mcpar (channel, x)
return
end if
end do
call msg_bug ("Process instance: get_mcpar: no active channels")
else
call msg_bug ("Process instance: get_mcpar: no seed kinematics")
end if
end subroutine process_instance_get_mcpar
@ %def process_instance_get_mcpar
@ Return true if the [[sqme]] value is known. This also implies that the
event is kinematically valid and has passed all cuts.
<<Instances: process instance: TBP>>=
procedure :: has_evaluated_trace => process_instance_has_evaluated_trace
<<Instances: procedures>>=
function process_instance_has_evaluated_trace (instance) result (flag)
class(process_instance_t), intent(in) :: instance
logical :: flag
flag = instance%evaluation_status >= STAT_EVALUATED_TRACE
end function process_instance_has_evaluated_trace
@ %def process_instance_has_evaluated_trace
@ Return true if the event is complete. In particular, the event must
be kinematically valid, passed all cuts, and the event data have been
computed.
<<Instances: process instance: TBP>>=
procedure :: is_complete_event => process_instance_is_complete_event
<<Instances: procedures>>=
function process_instance_is_complete_event (instance) result (flag)
class(process_instance_t), intent(in) :: instance
logical :: flag
flag = instance%evaluation_status >= STAT_EVENT_COMPLETE
end function process_instance_is_complete_event
@ %def process_instance_is_complete_event
@ Select the term for the process instance that will provide the basic
event record (used in [[evt_trivial_make_particle_set]]). It might be
necessary to write out additional events corresponding to other terms
(done in [[evt_nlo]]).
<<Instances: process instance: TBP>>=
procedure :: select_i_term => process_instance_select_i_term
<<Instances: procedures>>=
function process_instance_select_i_term (instance) result (i_term)
integer :: i_term
class(process_instance_t), intent(in) :: instance
integer :: i_mci
i_mci = instance%i_mci
i_term = instance%process%select_i_term (i_mci)
end function process_instance_select_i_term
@ %def process_instance_select_i_term
@ Return pointer to the master beam interaction.
<<Instances: process instance: TBP>>=
procedure :: get_beam_int_ptr => process_instance_get_beam_int_ptr
<<Instances: procedures>>=
function process_instance_get_beam_int_ptr (instance) result (ptr)
class(process_instance_t), intent(in), target :: instance
type(interaction_t), pointer :: ptr
ptr => instance%sf_chain%get_beam_int_ptr ()
end function process_instance_get_beam_int_ptr
@ %def process_instance_get_beam_int_ptr
@ Return pointers to the matrix and flows interactions, given a term index.
<<Instances: process instance: TBP>>=
procedure :: get_trace_int_ptr => process_instance_get_trace_int_ptr
procedure :: get_matrix_int_ptr => process_instance_get_matrix_int_ptr
procedure :: get_flows_int_ptr => process_instance_get_flows_int_ptr
<<Instances: procedures>>=
function process_instance_get_trace_int_ptr (instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_trace_int_ptr ()
end function process_instance_get_trace_int_ptr
function process_instance_get_matrix_int_ptr (instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_matrix_int_ptr ()
end function process_instance_get_matrix_int_ptr
function process_instance_get_flows_int_ptr (instance, i_term) result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(interaction_t), pointer :: ptr
ptr => instance%term(i_term)%connected%get_flows_int_ptr ()
end function process_instance_get_flows_int_ptr
@ %def process_instance_get_trace_int_ptr
@ %def process_instance_get_matrix_int_ptr
@ %def process_instance_get_flows_int_ptr
@ Return the complete account of flavor combinations in the underlying
interaction object, including beams, radiation, and hard interaction.
<<Instances: process instance: TBP>>=
procedure :: get_state_flv => process_instance_get_state_flv
<<Instances: procedures>>=
function process_instance_get_state_flv (instance, i_term) result (state_flv)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
type(state_flv_content_t) :: state_flv
state_flv = instance%term(i_term)%connected%get_state_flv ()
end function process_instance_get_state_flv
@ %def process_instance_get_state_flv
@ Return pointers to the parton states of a selected term.
<<Instances: process instance: TBP>>=
procedure :: get_isolated_state_ptr => &
process_instance_get_isolated_state_ptr
procedure :: get_connected_state_ptr => &
process_instance_get_connected_state_ptr
<<Instances: procedures>>=
function process_instance_get_isolated_state_ptr (instance, i_term) &
result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(isolated_state_t), pointer :: ptr
ptr => instance%term(i_term)%isolated
end function process_instance_get_isolated_state_ptr
function process_instance_get_connected_state_ptr (instance, i_term) &
result (ptr)
class(process_instance_t), intent(in), target :: instance
integer, intent(in) :: i_term
type(connected_state_t), pointer :: ptr
ptr => instance%term(i_term)%connected
end function process_instance_get_connected_state_ptr
@ %def process_instance_get_isolated_state_ptr
@ %def process_instance_get_connected_state_ptr
@ Return the indices of the beam particles and incoming partons within the
currently active state matrix, respectively.
<<Instances: process instance: TBP>>=
procedure :: get_beam_index => process_instance_get_beam_index
procedure :: get_in_index => process_instance_get_in_index
<<Instances: procedures>>=
subroutine process_instance_get_beam_index (instance, i_term, i_beam)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
integer, dimension(:), intent(out) :: i_beam
call instance%term(i_term)%connected%get_beam_index (i_beam)
end subroutine process_instance_get_beam_index
subroutine process_instance_get_in_index (instance, i_term, i_in)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
integer, dimension(:), intent(out) :: i_in
call instance%term(i_term)%connected%get_in_index (i_in)
end subroutine process_instance_get_in_index
@ %def process_instance_get_beam_index
@ %def process_instance_get_in_index
@ Return squared matrix element and event weight, and event weight
excess where applicable.
<<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
<<Instances: procedures>>=
function process_instance_get_sqme (instance, i_term) result (sqme)
real(default) :: sqme
class(process_instance_t), intent(in) :: instance
integer, intent(in), optional :: i_term
if (instance%evaluation_status >= STAT_EVALUATED_TRACE) then
if (present (i_term)) then
sqme = instance%term(i_term)%connected%trace%get_matrix_element (1)
else
sqme = instance%sqme
end if
else
sqme = 0
end if
end function process_instance_get_sqme
function process_instance_get_weight (instance) result (weight)
real(default) :: weight
class(process_instance_t), intent(in) :: instance
if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
weight = instance%weight
else
weight = 0
end if
end function process_instance_get_weight
function process_instance_get_excess (instance) result (excess)
real(default) :: excess
class(process_instance_t), intent(in) :: instance
if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
excess = instance%excess
else
excess = 0
end if
end function process_instance_get_excess
@ %def process_instance_get_sqme
@ %def process_instance_get_weight
@ %def process_instance_get_excess
@ Return the currently selected MCI channel.
<<Instances: process instance: TBP>>=
procedure :: get_channel => process_instance_get_channel
<<Instances: procedures>>=
function process_instance_get_channel (instance) result (channel)
integer :: channel
class(process_instance_t), intent(in) :: instance
channel = instance%selected_channel
end function process_instance_get_channel
@ %def process_instance_get_channel
@
<<Instances: process instance: TBP>>=
procedure :: set_fac_scale => process_instance_set_fac_scale
<<Instances: procedures>>=
subroutine process_instance_set_fac_scale (instance, fac_scale)
class(process_instance_t), intent(inout) :: instance
real(default), intent(in) :: fac_scale
integer :: i_term
i_term = 1
call instance%term(i_term)%set_fac_scale (fac_scale)
end subroutine process_instance_set_fac_scale
@ %def process_instance_set_fac_scale
@ Return factorization scale and strong coupling. We have to select a
term instance.
<<Instances: process instance: TBP>>=
procedure :: get_fac_scale => process_instance_get_fac_scale
procedure :: get_alpha_s => process_instance_get_alpha_s
<<Instances: procedures>>=
function process_instance_get_fac_scale (instance, i_term) result (fac_scale)
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
real(default) :: fac_scale
fac_scale = instance%term(i_term)%get_fac_scale ()
end function process_instance_get_fac_scale
function process_instance_get_alpha_s (instance, i_term) result (alpha_s)
real(default) :: alpha_s
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
class(prc_core_t), pointer :: core => null ()
core => instance%process%get_core_term (i_term)
alpha_s = instance%term(i_term)%get_alpha_s (core)
core => null ()
end function process_instance_get_alpha_s
@ %def process_instance_get_fac_scale
@ %def process_instance_get_alpha_s
@
<<Instances: process instance: TBP>>=
procedure :: get_qcd_ptr => process_instance_get_qcd_ptr
<<Instances: procedures>>=
function process_instance_get_qcd_ptr (process_instance) result (qcd)
type(qcd_t), pointer :: qcd
class(process_instance_t), intent(in), target :: process_instance
qcd => process_instance%process%get_qcd_ptr ()
end function process_instance_get_qcd_ptr
@ %def process_instance_get_qcd_ptr
@ Counter.
<<Instances: process instance: TBP>>=
procedure :: reset_counter => process_instance_reset_counter
procedure :: record_call => process_instance_record_call
procedure :: get_counter => process_instance_get_counter
<<Instances: procedures>>=
subroutine process_instance_reset_counter (process_instance)
class(process_instance_t), intent(inout) :: process_instance
call process_instance%mci_work(process_instance%i_mci)%reset_counter ()
end subroutine process_instance_reset_counter
subroutine process_instance_record_call (process_instance)
class(process_instance_t), intent(inout) :: process_instance
call process_instance%mci_work(process_instance%i_mci)%record_call &
(process_instance%evaluation_status)
end subroutine process_instance_record_call
pure function process_instance_get_counter (process_instance) result (counter)
class(process_instance_t), intent(in) :: process_instance
type(process_counter_t) :: counter
counter = process_instance%mci_work(process_instance%i_mci)%get_counter ()
end function process_instance_get_counter
@ %def process_instance_reset_counter
@ %def process_instance_record_call
@ %def process_instance_get_counter
@ Sum up the total number of calls for all MCI records.
<<Instances: process instance: TBP>>=
procedure :: get_actual_calls_total => process_instance_get_actual_calls_total
<<Instances: procedures>>=
pure function process_instance_get_actual_calls_total (process_instance) &
result (n)
class(process_instance_t), intent(in) :: process_instance
integer :: n
integer :: i
type(process_counter_t) :: counter
n = 0
do i = 1, size (process_instance%mci_work)
counter = process_instance%mci_work(i)%get_counter ()
n = n + counter%total
end do
end function process_instance_get_actual_calls_total
@ %def process_instance_get_actual_calls_total
@
<<Instances: process instance: TBP>>=
procedure :: reset_matrix_elements => process_instance_reset_matrix_elements
<<Instances: procedures>>=
subroutine process_instance_reset_matrix_elements (instance)
class(process_instance_t), intent(inout) :: instance
integer :: i_term
do i_term = 1, size (instance%term)
call instance%term(i_term)%connected%trace%set_matrix_element (cmplx (0, 0, default))
call instance%term(i_term)%connected%matrix%set_matrix_element (cmplx (0, 0, default))
end do
end subroutine process_instance_reset_matrix_elements
@ %def process_instance_reset_matrix_elements
@
<<Instances: process instance: TBP>>=
procedure :: get_test_phase_space_point &
=> process_instance_get_test_phase_space_point
<<Instances: procedures>>=
subroutine process_instance_get_test_phase_space_point (instance, &
i_component, i_core, p)
type(vector4_t), dimension(:), allocatable, intent(out) :: p
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_component, i_core
real(default), dimension(:), allocatable :: x
logical :: success
integer :: i_term
instance%i_mci = i_component
i_term = instance%process%get_i_term (i_core)
associate (term => instance%term(i_term))
allocate (x (instance%mci_work(i_component)%config%n_par))
x = 0.5_default
call instance%set_mcpar (x, .true.)
call instance%select_channel (1)
call term%compute_seed_kinematics &
(instance%mci_work(i_component), 1, success)
call instance%term(i_term)%evaluate_radiation_kinematics &
(instance%mci_work(instance%i_mci)%get_x_process ())
call instance%term(i_term)%compute_hard_kinematics (success = success)
allocate (p (size (term%p_hard)))
p = term%int_hard%get_momenta ()
end associate
end subroutine process_instance_get_test_phase_space_point
@ %def process_instance_get_test_phase_space_point
@
<<Instances: process instance: TBP>>=
procedure :: get_p_hard => process_instance_get_p_hard
<<Instances: procedures>>=
pure function process_instance_get_p_hard (process_instance, i_term) &
result (p_hard)
type(vector4_t), dimension(:), allocatable :: p_hard
class(process_instance_t), intent(in) :: process_instance
integer, intent(in) :: i_term
allocate (p_hard (size (process_instance%term(i_term)%get_p_hard ())))
p_hard = process_instance%term(i_term)%get_p_hard ()
end function process_instance_get_p_hard
@ %def process_instance_get_p_hard
@
<<Instances: process instance: TBP>>=
procedure :: get_first_active_i_term => process_instance_get_first_active_i_term
<<Instances: procedures>>=
function process_instance_get_first_active_i_term (instance) result (i_term)
integer :: i_term
class(process_instance_t), intent(in) :: instance
integer :: i
i_term = 0
do i = 1, size (instance%term)
if (instance%term(i)%active) then
i_term = i
exit
end if
end do
end function process_instance_get_first_active_i_term
@ %def process_instance_get_first_active_i_term
@
<<Instances: process instance: TBP>>=
procedure :: get_real_of_mci => process_instance_get_real_of_mci
<<Instances: procedures>>=
function process_instance_get_real_of_mci (instance) result (i_real)
integer :: i_real
class(process_instance_t), intent(in) :: instance
select type (pcm => instance%pcm)
type is (pcm_instance_nlo_t)
i_real = pcm%i_mci_to_real_component (instance%i_mci)
end select
end function process_instance_get_real_of_mci
@ %def process_instance_get_real_of_mci
@
<<Instances: process instance: TBP>>=
procedure :: get_connected_states => process_instance_get_connected_states
<<Instances: procedures>>=
function process_instance_get_connected_states (instance, i_component) result (connected)
type(connected_state_t), dimension(:), allocatable :: connected
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_component
connected = instance%process%get_connected_states (i_component, &
instance%term(:)%connected)
end function process_instance_get_connected_states
@ %def process_instance_get_connected_states
@ Get the hadronic center-of-mass energy
<<Instances: process instance: TBP>>=
procedure :: get_sqrts => process_instance_get_sqrts
<<Instances: procedures>>=
function process_instance_get_sqrts (instance) result (sqrts)
class(process_instance_t), intent(in) :: instance
real(default) :: sqrts
sqrts = instance%process%get_sqrts ()
end function process_instance_get_sqrts
@ %def process_instance_get_sqrts
@ Get the polarizations
<<Instances: process instance: TBP>>=
procedure :: get_polarization => process_instance_get_polarization
<<Instances: procedures>>=
function process_instance_get_polarization (instance) result (pol)
class(process_instance_t), intent(in) :: instance
real(default), dimension(2) :: pol
pol = instance%process%get_polarization ()
end function process_instance_get_polarization
@ %def process_instance_get_polarization
@ Get the beam spectrum
<<Instances: process instance: TBP>>=
procedure :: get_beam_file => process_instance_get_beam_file
<<Instances: procedures>>=
function process_instance_get_beam_file (instance) result (file)
class(process_instance_t), intent(in) :: instance
type(string_t) :: file
file = instance%process%get_beam_file ()
end function process_instance_get_beam_file
@ %def process_instance_get_beam_file
@ Get the process name
<<Instances: process instance: TBP>>=
procedure :: get_process_name => process_instance_get_process_name
<<Instances: procedures>>=
function process_instance_get_process_name (instance) result (name)
class(process_instance_t), intent(in) :: instance
type(string_t) :: name
name = instance%process%get_id ()
end function process_instance_get_process_name
@ %def process_instance_get_process_name
@
\subsubsection{Particle sets}
Here we provide two procedures that convert the process instance
from/to a particle set. The conversion applies to the trace evaluator
which has no quantum-number information, thus it involves only the
momenta and the parent-child relations. We keep virtual particles.
If [[n_incoming]] is provided, the status code of the first
[[n_incoming]] particles will be reset to incoming. Otherwise, they
would be classified as virtual.
Nevertheless, it is possible to reconstruct the complete structure
from a particle set. The reconstruction implies a re-evaluation of
the structure function and matrix-element codes.
The [[i_term]] index is needed for both input and output, to select
among different active trace evaluators.
In both cases, the [[instance]] object must be properly initialized.
NB: The [[recover_beams]] option should be used only when the particle
set originates from an external event file, and the user has asked for
it. It should be switched off when reading from raw event file.
<<Instances: process instance: TBP>>=
procedure :: get_trace => process_instance_get_trace
procedure :: set_trace => process_instance_set_trace
<<Instances: procedures>>=
subroutine process_instance_get_trace (instance, pset, i_term, n_incoming)
class(process_instance_t), intent(in), target :: instance
type(particle_set_t), intent(out) :: pset
integer, intent(in) :: i_term
integer, intent(in), optional :: n_incoming
type(interaction_t), pointer :: int
logical :: ok
int => instance%get_trace_int_ptr (i_term)
call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
[0._default, 0._default], .false., .true., n_incoming)
end subroutine process_instance_get_trace
subroutine process_instance_set_trace &
(instance, pset, i_term, recover_beams, check_match)
class(process_instance_t), intent(inout), target :: instance
type(particle_set_t), intent(in) :: pset
integer, intent(in) :: i_term
logical, intent(in), optional :: recover_beams, check_match
type(interaction_t), pointer :: int
integer :: n_in
int => instance%get_trace_int_ptr (i_term)
n_in = instance%process%get_n_in ()
call pset%fill_interaction (int, n_in, &
recover_beams = recover_beams, &
check_match = check_match, &
state_flv = instance%get_state_flv (i_term))
end subroutine process_instance_set_trace
@ %def process_instance_get_trace
@ %def process_instance_set_trace
@ This procedure allows us to override any QCD setting of the WHIZARD process
and directly set the coupling value that comes together with a particle set.
<<Instances: process instance: TBP>>=
procedure :: set_alpha_qcd_forced => process_instance_set_alpha_qcd_forced
<<Instances: procedures>>=
subroutine process_instance_set_alpha_qcd_forced (instance, i_term, alpha_qcd)
class(process_instance_t), intent(inout) :: instance
integer, intent(in) :: i_term
real(default), intent(in) :: alpha_qcd
call instance%term(i_term)%set_alpha_qcd_forced (alpha_qcd)
end subroutine process_instance_set_alpha_qcd_forced
@ %def process_instance_set_alpha_qcd_forced
@
<<Instances: process instance: TBP>>=
procedure :: has_nlo_component => process_instance_has_nlo_component
<<Instances: procedures>>=
function process_instance_has_nlo_component (instance) result (nlo)
class(process_instance_t), intent(in) :: instance
logical :: nlo
nlo = instance%process%is_nlo_calculation ()
end function process_instance_has_nlo_component
@ %def process_instance_has_nlo_component
@
<<Instances: process instance: TBP>>=
procedure :: keep_failed_events => process_instance_keep_failed_events
<<Instances: procedures>>=
function process_instance_keep_failed_events (instance) result (keep)
logical :: keep
class(process_instance_t), intent(in) :: instance
keep = instance%mci_work(instance%i_mci)%keep_failed_events
end function process_instance_keep_failed_events
@ %def process_instance_keep_failed_events
@
<<Instances: process instance: TBP>>=
procedure :: get_term_indices => process_instance_get_term_indices
<<Instances: procedures>>=
function process_instance_get_term_indices (instance, nlo_type) result (i_term)
integer, dimension(:), allocatable :: i_term
class(process_instance_t), intent(in) :: instance
integer :: nlo_type
allocate (i_term (count (instance%term%nlo_type == nlo_type)))
i_term = pack (instance%term%get_i_term_global (), instance%term%nlo_type == nlo_type)
end function process_instance_get_term_indices
@ %def process_instance_get_term_indices
@
<<Instances: process instance: TBP>>=
procedure :: get_boost_to_lab => process_instance_get_boost_to_lab
<<Instances: procedures>>=
function process_instance_get_boost_to_lab (instance, i_term) result (lt)
type(lorentz_transformation_t) :: lt
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
lt = instance%term(i_term)%get_boost_to_lab ()
end function process_instance_get_boost_to_lab
@ %def process_instance_get_boost_to_lab
@
<<Instances: process instance: TBP>>=
procedure :: get_boost_to_cms => process_instance_get_boost_to_cms
<<Instances: procedures>>=
function process_instance_get_boost_to_cms (instance, i_term) result (lt)
type(lorentz_transformation_t) :: lt
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
lt = instance%term(i_term)%get_boost_to_cms ()
end function process_instance_get_boost_to_cms
@ %def process_instance_get_boost_to_cms
@
<<Instances: process instance: TBP>>=
procedure :: is_cm_frame => process_instance_is_cm_frame
<<Instances: procedures>>=
function process_instance_is_cm_frame (instance, i_term) result (cm_frame)
logical :: cm_frame
class(process_instance_t), intent(in) :: instance
integer, intent(in) :: i_term
cm_frame = instance%term(i_term)%k_term%phs%is_cm_frame ()
end function process_instance_is_cm_frame
@ %def protcess_instance_is_cm_frame
@
The [[pacify]] subroutine has the purpose of setting numbers to zero
which are (by comparing with a [[tolerance]] parameter) considered
equivalent with zero. We do this in some unit tests. Here, we a
apply this to the phase space subobject of the process instance.
<<Instances: public>>=
public :: pacify
<<Instances: interfaces>>=
interface pacify
module procedure pacify_process_instance
end interface pacify
<<Instances: procedures>>=
subroutine pacify_process_instance (instance)
type(process_instance_t), intent(inout) :: instance
integer :: i
do i = 1, size (instance%term)
call pacify (instance%term(i)%k_term%phs)
end do
end subroutine pacify_process_instance
@ %def pacify
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[processes_ut.f90]]>>=
<<File header>>
module processes_ut
use unit_tests
use processes_uti
<<Standard module head>>
<<Processes: public test>>
<<Processes: public test auxiliary>>
contains
<<Processes: test driver>>
end module processes_ut
@ %def processes_ut
@
<<[[processes_uti.f90]]>>=
<<File header>>
module processes_uti
<<Use kinds>>
<<Use strings>>
use format_utils, only: write_separator
use constants, only: TWOPI4
use physics_defs, only: CONV
use os_interface
use sm_qcd
use lorentz
use pdg_arrays
use model_data
use var_base, only: vars_t
use variables, only: var_list_t
use model_testbed, only: prepare_model
use particle_specifiers, only: new_prt_spec
use flavors
use interactions, only: reset_interaction_counter
use particles
use rng_base
use mci_base
use mci_none, only: mci_none_t
use mci_midpoint
use sf_mappings
use sf_base
use phs_base
use phs_single
use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
use phs_wood, only: phs_wood_config_t
use resonances, only: resonance_history_set_t
use process_constants
use prc_core_def, only: prc_core_def_t
use prc_core
use prc_test, only: prc_test_create_library
use prc_template_me, only: template_me_def_t
use process_libraries
use prc_test_core
use process_counter
use process_config, only: process_term_t
use process, only: process_t
use instances, only: process_instance_t, process_instance_hook_t
use rng_base_ut, only: rng_test_factory_t
use sf_base_ut, only: sf_test_data_t
use mci_base_ut, only: mci_test_t
use phs_base_ut, only: phs_test_config_t
<<Standard module head>>
<<Processes: public test auxiliary>>
<<Processes: test declarations>>
<<Processes: test types>>
contains
<<Processes: tests>>
<<Processes: test auxiliary>>
end module processes_uti
@ %def processes_uti
@ API: driver for the unit tests below.
<<Processes: public test>>=
public :: processes_test
<<Processes: test driver>>=
subroutine processes_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Processes: execute tests>>
end subroutine processes_test
@ %def processes_test
\subsubsection{Write an empty process object}
The most trivial test is to write an uninitialized process object.
<<Processes: execute tests>>=
call test (processes_1, "processes_1", &
"write an empty process object", &
u, results)
<<Processes: test declarations>>=
public :: processes_1
<<Processes: tests>>=
subroutine processes_1 (u)
integer, intent(in) :: u
type(process_t) :: process
write (u, "(A)") "* Test output: processes_1"
write (u, "(A)") "* Purpose: display an empty process object"
write (u, "(A)")
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_1"
end subroutine processes_1
@ %def processes_1
@
\subsubsection{Initialize a process object}
Initialize a process and display it.
<<Processes: execute tests>>=
call test (processes_2, "processes_2", &
"initialize a simple process object", &
u, results)
<<Processes: test declarations>>=
public :: processes_2
<<Processes: tests>>=
subroutine processes_2 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: 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
run_id = "run2"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
write (u, "(A)") "* Initialize a process object"
write (u, "(A)")
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, phs_config_template)
call process%setup_mci ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_2"
end subroutine processes_2
@ %def processes_2
@
\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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: model
type(process_t), allocatable :: process
class(mci_t), allocatable :: mci_template
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
run_id = "run3"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (mci_test_t :: mci_template)
select type (mci_template)
type is (mci_test_t)
call mci_template%set_dimensions (2, 2)
call mci_template%set_divisions (100)
end select
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, phs_config_template)
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)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_3"
end subroutine processes_3
@ %def processes_3
@
\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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: 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
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
run_id = "run4"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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 ()
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)
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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: 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(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
run_id = "run7"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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)
model => process%get_model_ptr ()
call data%init (model, 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 ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: 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
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
run_id = "run8"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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)
model => process%get_model_ptr ()
call data%init (model, 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 ()
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)
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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: 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
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
run_id = "run9"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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)
model => process%get_model_ptr ()
call data%init (model, 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 ()
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)
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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: model
type(process_t), allocatable, target :: process
class(mci_t), allocatable :: mci_template
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
run_id = "run10"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (mci_test_t :: mci_template)
select type (mci_template)
type is (mci_test_t); call mci_template%set_divisions (100)
end select
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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 ()
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)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_10"
end subroutine processes_10
@ %def processes_10
@
\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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: 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
run_id = "run11"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
call reset_interaction_counter ()
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (mci_test_t :: mci_template)
select type (mci_template)
type is (mci_test_t)
call mci_template%set_divisions (100)
end select
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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 ()
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Integrate with default test parameters"
write (u, "(A)")
call process_instance%integrate (1, n_it=1, n_calls=10000)
call process%final_integration (1)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A,ES13.7)") " Integral divided by phs factor = ", &
process%get_integral (1) &
/ process_instance%term(1)%k_term%phs_factor
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
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)
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(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(string_t) :: run_id
type(os_data_t) :: os_data
class(model_data_t), pointer :: process_model
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(mci_t), allocatable :: mci_template
class(mci_t), pointer :: mci
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
libname = "processes_test"
procname = libname
run_id = "run_test"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
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, run_id, &
lib, os_data, qcd, rng_factory, process_model)
call process%setup_test_cores ()
allocate (mci_test_t :: mci_template)
select type (mci_template)
type is (mci_test_t); call mci_template%set_divisions (100)
end select
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, phs_config_template)
sqrts = 1000
call process%setup_beams_sqrts (sqrts, i_core = 1)
call process%configure_phs ()
call process%setup_mci ()
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%nullify_library_pointer () ! avoid dangling pointer
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)
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 (os_data)
call model%init_sm_test ()
! call model_list%read_model (var_str ("QCD"), var_str ("QCD.mdl"), &
! os_data, model)
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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: 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(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
run_id = "run7"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
call lib%compute_md5sum ()
allocate (model)
call model%init_test ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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)
model => process%get_model_ptr ()
call data%init (model, 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 ()
call process%compute_md5sum ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process%final ()
deallocate (process)
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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: model
type(process_t), allocatable, target :: process
class(mci_t), allocatable :: mci_template
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
run_id = "run15"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
allocate (model)
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, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (phs_single_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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 ()
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)
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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: model
type(process_t), allocatable, target :: process
class(mci_t), allocatable :: mci_template
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
run_id = "run16"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
call reset_interaction_counter ()
allocate (model)
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, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (mci_midpoint_t :: mci_template)
allocate (phs_single_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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 ()
write (u, "(A)") "* Complete process initialization"
write (u, "(A)")
call process%setup_terms ()
call process%write (.false., u)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
write (u, "(A)") "* Integrate with default test parameters"
write (u, "(A)")
call process_instance%integrate (1, n_it=1, n_calls=10000)
call process%final_integration (1)
call process%write (.false., u)
write (u, "(A)")
write (u, "(A,ES13.7)") " Integral divided by phs factor = ", &
process%get_integral (1) &
/ process_instance%term(1)%k_term%phs_factor
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_16"
end subroutine processes_16
@ %def processes_16
@
\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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: model
type(process_t), allocatable, target :: process
class(mci_t), allocatable :: mci_template
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
run_id = "run17"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib, scattering = .false., &
decay = .true.)
write (u, "(A)") "* Initialize a process object"
write (u, "(A)")
allocate (model)
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, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%setup_test_cores ()
allocate (phs_single_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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 ()
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])
model => process%get_model_ptr ()
call flv_beam%init (25, model)
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)
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 (os_data)
call syntax_phs_forest_init ()
model_name = "SM"
call prepare_model (model, model_name, vars)
write (u, "(A)") "* Initialize a process library with one process"
write (u, "(A)")
call prepare_resonance_test_library (lib, libname, procname, model, os_data, u)
write (u, "(A)")
write (u, "(A)") "* Initialize a process object with phase space"
allocate (process)
call prepare_resonance_test_process (process, lib, procname, model, os_data)
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 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
class(model_data_t), intent(in), pointer :: 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
class(model_data_t), intent(inout), pointer :: model
type(os_data_t), intent(in) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(mci_t), allocatable :: mci_template
class(phs_config_t), allocatable :: phs_config_template
real(default) :: sqrts
allocate (rng_test_factory_t :: rng_factory)
call process%init (procname, var_str (""), &
lib, os_data, qcd, rng_factory, model)
allocate (phs_wood_config_t :: phs_config_template)
allocate (mci_none_t :: mci_template)
call process%init_component &
(1, .true., mci_template, 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 ()
call process%setup_terms ()
end subroutine prepare_resonance_test_process
@ %def prepare_resonance_test_process
@
\subsubsection{Add after evaluate hook(s)}
Initialize a process and process instance, add a trivial process hook,
choose a sampling point and fill the process instance.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Processes: test types>>=
type, extends(process_instance_hook_t) :: process_instance_hook_test_t
integer :: unit
character(len=15) :: name
contains
procedure :: init => process_instance_hook_test_init
procedure :: final => process_instance_hook_test_final
procedure :: evaluate => process_instance_hook_test_evaluate
end type process_instance_hook_test_t
@
<<Processes: test auxiliary>>=
subroutine process_instance_hook_test_init (hook, var_list, instance)
class(process_instance_hook_test_t), intent(inout), target :: hook
type(var_list_t), intent(in) :: var_list
class(process_instance_t), intent(in), target :: instance
end subroutine process_instance_hook_test_init
subroutine process_instance_hook_test_final (hook)
class(process_instance_hook_test_t), intent(inout) :: hook
end subroutine process_instance_hook_test_final
subroutine process_instance_hook_test_evaluate (hook, instance)
class(process_instance_hook_test_t), intent(inout) :: hook
class(process_instance_t), intent(in), target :: instance
write (hook%unit, "(A)") "Execute hook:"
write (hook%unit, "(2X,A,1X,A,I0,A)") hook%name, "(", len (trim (hook%name)), ")"
end subroutine process_instance_hook_test_evaluate
@
<<Processes: execute tests>>=
call test (processes_19, "processes_19", &
"add trivial hooks to a process instance ", &
u, results)
<<Processes: test declarations>>=
public :: processes_19
<<Processes: tests>>=
subroutine processes_19 (u)
integer, intent(in) :: u
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: 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) :: process_instance
class(process_instance_hook_t), allocatable, target :: process_instance_hook, process_instance_hook2
type(particle_set_t) :: pset
write (u, "(A)") "* Test output: processes_19"
write (u, "(A)") "* Purpose: allocate process instance &
&and add an after evaluate hook"
write (u, "(A)")
write (u, "(A)")
write (u, "(A)") "* Allocate a process instance"
write (u, "(A)")
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Allocate hook and add to process instance"
write (u, "(A)")
allocate (process_instance_hook_test_t :: process_instance_hook)
call process_instance%append_after_hook (process_instance_hook)
allocate (process_instance_hook_test_t :: process_instance_hook2)
call process_instance%append_after_hook (process_instance_hook2)
select type (process_instance_hook)
type is (process_instance_hook_test_t)
process_instance_hook%unit = u
process_instance_hook%name = "Hook 1"
end select
select type (process_instance_hook2)
type is (process_instance_hook_test_t)
process_instance_hook2%unit = u
process_instance_hook2%name = "Hook 2"
end select
write (u, "(A)") "* Evaluate matrix element and square"
write (u, "(A)")
call process_instance%evaluate_after_hook ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance_hook%final ()
deallocate (process_instance_hook)
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_19"
end subroutine processes_19
@ %def processes_19
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process Stacks}
For storing and handling multiple processes, we define process stacks.
These are ordinary stacks where new process entries are pushed onto
the top. We allow for multiple entries with identical process ID, but
distinct run ID.
The implementation is essentially identical to the [[prclib_stacks]] module
above. Unfortunately, Fortran supports no generic programming, so we do not
make use of this fact.
When searching for a specific process ID, we will get (a pointer to)
the topmost process entry with that ID on the stack, which was entered
last. Usually, this is the best version of the process (in terms of
integral, etc.) Thus the stack terminology makes sense.
<<[[process_stacks.f90]]>>=
<<File header>>
module process_stacks
<<Use kinds>>
<<Use strings>>
use io_units
use format_utils, only: write_separator
use diagnostics
use os_interface
use sm_qcd
use model_data
use rng_base
use variables
use observables
use process_libraries
use process
<<Standard module head>>
<<Process stacks: public>>
<<Process stacks: types>>
contains
<<Process stacks: procedures>>
end module process_stacks
@ %def process_stacks
@
\subsection{The process entry type}
A process entry is a process object, augmented by a pointer to the
next entry. We do not need specific methods, all relevant methods are
inherited.
On higher level, processes should be prepared as process entry objects.
<<Process stacks: public>>=
public :: process_entry_t
<<Process stacks: types>>=
type, extends (process_t) :: process_entry_t
type(process_entry_t), pointer :: next => null ()
end type process_entry_t
@ %def process_entry_t
@
\subsection{The process stack type}
For easy conversion and lookup it is useful to store the filling
number in the object. The content is stored as a linked list.
The [[var_list]] component stores process-specific results, so they
can be retrieved as (pseudo) variables.
The process stack can be linked to another one. This allows us to
work with stacks of local scope.
<<Process stacks: public>>=
public :: process_stack_t
<<Process stacks: types>>=
type :: process_stack_t
integer :: n = 0
type(process_entry_t), pointer :: first => null ()
type(var_list_t), pointer :: var_list => null ()
type(process_stack_t), pointer :: next => null ()
contains
<<Process stacks: process stack: TBP>>
end type process_stack_t
@ %def process_stack_t
@ Finalize partly: deallocate the process stack and variable list
entries, but keep the variable list as an empty object. This way, the
variable list links are kept.
<<Process stacks: process stack: TBP>>=
procedure :: clear => process_stack_clear
<<Process stacks: procedures>>=
subroutine process_stack_clear (stack)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), pointer :: process
if (associated (stack%var_list)) then
call stack%var_list%final ()
end if
do while (associated (stack%first))
process => stack%first
stack%first => process%next
call process%final ()
deallocate (process)
end do
stack%n = 0
end subroutine process_stack_clear
@ %def process_stack_clear
@ Finalizer. Clear and deallocate the variable list.
<<Process stacks: process stack: TBP>>=
procedure :: final => process_stack_final
<<Process stacks: procedures>>=
subroutine process_stack_final (object)
class(process_stack_t), intent(inout) :: object
call object%clear ()
if (associated (object%var_list)) then
deallocate (object%var_list)
end if
end subroutine process_stack_final
@ %def process_stack_final
@ Output. The processes on the stack will be ordered LIFO, i.e.,
backwards.
<<Process stacks: process stack: TBP>>=
procedure :: write => process_stack_write
<<Process stacks: procedures>>=
recursive subroutine process_stack_write (object, unit, pacify)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacify
type(process_entry_t), pointer :: process
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
select case (object%n)
case (0)
write (u, "(1x,A)") "Process stack: [empty]"
call write_separator (u, 2)
case default
write (u, "(1x,A)") "Process stack:"
process => object%first
do while (associated (process))
call process%write (.false., u, pacify = pacify)
process => process%next
end do
end select
if (associated (object%next)) then
write (u, "(1x,A)") "[Processes from context environment:]"
call object%next%write (u, pacify)
end if
end subroutine process_stack_write
@ %def process_stack_write
@ The variable list is printed by a separate routine, since
it should be linked to the global variable list, anyway.
<<Process stacks: process stack: TBP>>=
procedure :: write_var_list => process_stack_write_var_list
<<Process stacks: procedures>>=
subroutine process_stack_write_var_list (object, unit)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
if (associated (object%var_list)) then
call var_list_write (object%var_list, unit)
end if
end subroutine process_stack_write_var_list
@ %def process_stack_write_var_list
@ Short output.
+
+Since this is a stack, the default output ordering for each stack will be
+last-in, first-out. To enable first-in, first-out, which is more likely to be
+requested, there is an optional [[fifo]] argument.
<<Process stacks: process stack: TBP>>=
procedure :: show => process_stack_show
<<Process stacks: procedures>>=
- recursive subroutine process_stack_show (object, unit)
+ recursive subroutine process_stack_show (object, unit, fifo)
class(process_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
+ logical, intent(in), optional :: fifo
type(process_entry_t), pointer :: process
- integer :: u
+ 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
- process => object%first
- do while (associated (process))
- call process%show (u, verbose=.false.)
- process => process%next
- end do
+ if (.not. reverse) then
+ process => object%first
+ do while (associated (process))
+ call process%show (u, verbose=.false.)
+ process => process%next
+ end do
+ else
+ do i = 1, object%n
+ process => object%first
+ do j = 1, object%n - i
+ process => process%next
+ end do
+ call process%show (u, verbose=.false.)
+ end do
+ end if
end select
if (associated (object%next)) call object%next%show ()
end subroutine process_stack_show
@ %def process_stack_show
@
\subsection{Link}
Link the current process stack to a global one.
<<Process stacks: process stack: TBP>>=
procedure :: link => process_stack_link
<<Process stacks: procedures>>=
subroutine process_stack_link (local_stack, global_stack)
class(process_stack_t), intent(inout) :: local_stack
type(process_stack_t), intent(in), target :: global_stack
local_stack%next => global_stack
end subroutine process_stack_link
@ %def process_stack_link
@ Initialize the process variable list and link the main variable list
to it.
<<Process stacks: process stack: TBP>>=
procedure :: init_var_list => process_stack_init_var_list
<<Process stacks: procedures>>=
subroutine process_stack_init_var_list (stack, var_list)
class(process_stack_t), intent(inout) :: stack
type(var_list_t), intent(inout), optional :: var_list
allocate (stack%var_list)
if (present (var_list)) call var_list%link (stack%var_list)
end subroutine process_stack_init_var_list
@ %def process_stack_init_var_list
@ Link the process variable list to a global
variable list.
<<Process stacks: process stack: TBP>>=
procedure :: link_var_list => process_stack_link_var_list
<<Process stacks: procedures>>=
subroutine process_stack_link_var_list (stack, var_list)
class(process_stack_t), intent(inout) :: stack
type(var_list_t), intent(in), target :: var_list
call stack%var_list%link (var_list)
end subroutine process_stack_link_var_list
@ %def process_stack_link_var_list
@
\subsection{Push}
We take a process pointer and push it onto the stack. The previous
pointer is nullified. Subsequently, the process is `owned' by the
stack and will be finalized when the stack is deleted.
<<Process stacks: process stack: TBP>>=
procedure :: push => process_stack_push
<<Process stacks: procedures>>=
subroutine process_stack_push (stack, process)
class(process_stack_t), intent(inout) :: stack
type(process_entry_t), intent(inout), pointer :: process
process%next => stack%first
stack%first => process
process => null ()
stack%n = stack%n + 1
end subroutine process_stack_push
@ %def process_stack_push
+@ Inverse: Remove the last process pointer in the list and return it.
+<<Process stacks: process stack: TBP>>=
+ procedure :: pop_last => process_stack_pop_last
+<<Process stacks: procedures>>=
+ subroutine process_stack_pop_last (stack, process)
+ class(process_stack_t), intent(inout) :: stack
+ type(process_entry_t), intent(inout), pointer :: process
+ type(process_entry_t), pointer :: previous
+ integer :: i
+ select case (stack%n)
+ case (:0)
+ process => null ()
+ case (1)
+ process => stack%first
+ stack%first => null ()
+ stack%n = 0
+ case (2:)
+ process => stack%first
+ do i = 2, stack%n
+ previous => process
+ process => process%next
+ end do
+ previous%next => null ()
+ stack%n = stack%n - 1
+ end select
+ end subroutine process_stack_pop_last
+
+@ %def process_stack_pop_last
@ Initialize process variables for a given process ID, without setting
values.
<<Process stacks: process stack: TBP>>=
procedure :: init_result_vars => process_stack_init_result_vars
<<Process stacks: procedures>>=
subroutine process_stack_init_result_vars (stack, id)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
call var_list_init_num_id (stack%var_list, id)
call var_list_init_process_results (stack%var_list, id)
end subroutine process_stack_init_result_vars
@ %def process_stack_init_result_vars
@ Fill process variables with values. This is executed after the
integration pass.
Note: We set only integral and error. With multiple MCI records
possible, the results for [[n_calls]], [[chi2]] etc. are not
necessarily unique. (We might set the efficiency, though.)
<<Process stacks: process stack: TBP>>=
procedure :: fill_result_vars => process_stack_fill_result_vars
<<Process stacks: procedures>>=
subroutine process_stack_fill_result_vars (stack, id)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
type(process_t), pointer :: process
process => stack%get_process_ptr (id)
if (associated (process)) then
call var_list_init_num_id (stack%var_list, id, process%get_num_id ())
if (process%has_integral ()) then
call var_list_init_process_results (stack%var_list, id, &
integral = process%get_integral (), &
error = process%get_error ())
end if
else
call msg_bug ("process_stack_fill_result_vars: unknown process ID")
end if
end subroutine process_stack_fill_result_vars
@ %def process_stack_fill_result_vars
@ If one of the result variables has a local image in [[var_list_local]],
update the value there as well.
<<Process stacks: process stack: TBP>>=
procedure :: update_result_vars => process_stack_update_result_vars
<<Process stacks: procedures>>=
subroutine process_stack_update_result_vars (stack, id, var_list_local)
class(process_stack_t), intent(inout) :: stack
type(string_t), intent(in) :: id
type(var_list_t), intent(inout) :: var_list_local
call update ("integral(" // id // ")")
call update ("error(" // id // ")")
contains
subroutine update (var_name)
type(string_t), intent(in) :: var_name
real(default) :: value
if (var_list_local%contains (var_name, follow_link = .false.)) then
value = stack%var_list%get_rval (var_name)
call var_list_local%set_real (var_name, value, is_known = .true.)
end if
end subroutine update
end subroutine process_stack_update_result_vars
@ %def process_stack_update_result_vars
@
\subsection{Data Access}
Tell if a process exists.
<<Process stacks: process stack: TBP>>=
procedure :: exists => process_stack_exists
<<Process stacks: procedures>>=
function process_stack_exists (stack, id) result (flag)
class(process_stack_t), intent(in) :: stack
type(string_t), intent(in) :: id
logical :: flag
type(process_t), pointer :: process
process => stack%get_process_ptr (id)
flag = associated (process)
end function process_stack_exists
@ %def process_stack_exists
@ Return a pointer to a process with specific ID. Look also at a
linked stack, if necessary.
<<Process stacks: process stack: TBP>>=
procedure :: get_process_ptr => process_stack_get_process_ptr
<<Process stacks: procedures>>=
recursive function process_stack_get_process_ptr (stack, id) result (ptr)
class(process_stack_t), intent(in) :: stack
type(string_t), intent(in) :: id
type(process_t), pointer :: ptr
type(process_entry_t), pointer :: entry
ptr => null ()
entry => stack%first
do while (associated (entry))
if (entry%get_id () == id) then
ptr => entry%process_t
return
end if
entry => entry%next
end do
if (associated (stack%next)) ptr => stack%next%get_process_ptr (id)
end function process_stack_get_process_ptr
@ %def process_stack_get_process_ptr
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[process_stacks_ut.f90]]>>=
<<File header>>
module process_stacks_ut
use unit_tests
use process_stacks_uti
<<Standard module head>>
<<Process stacks: public test>>
contains
<<Process stacks: test driver>>
end module process_stacks_ut
@ %def process_stacks_ut
@
<<[[process_stacks_uti.f90]]>>=
<<File header>>
module process_stacks_uti
<<Use strings>>
use os_interface
use sm_qcd
use model_data
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(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
class(model_data_t), pointer :: model
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 (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
allocate (model)
call model%init_test ()
allocate (process)
run_id = "run1"
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call stack%push (process)
allocate (model)
call model%init_test ()
allocate (process)
run_id = "run2"
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call stack%push (process)
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack%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_data_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
class(model_data_t), pointer :: model
type(string_t) :: libname
type(string_t) :: procname
type(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
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"
procname = "process_stacks_4a"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
write (u, "(A)") "* Initialize first process"
write (u, "(A)")
call prc_test_create_library (procname, lib)
allocate (model)
call model%init_test ()
allocate (process)
run_id = "run1"
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call stack1%push (process)
write (u, "(A)") "* Initialize second process"
write (u, "(A)")
call stack2%link (stack1)
procname = "process_stacks_4b"
call prc_test_create_library (procname, lib)
allocate (model)
call model%init_test ()
allocate (process)
run_id = "run2"
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, 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 ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_stacks_4"
end subroutine process_stacks_4
@ %def process_stacks_4
@
Index: trunk/src/system/system.nw
===================================================================
--- trunk/src/system/system.nw (revision 8157)
+++ trunk/src/system/system.nw (revision 8158)
@@ -1,4126 +1,4163 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: system interfaces
\chapter{System: Interfaces and Handlers}
\includemodulegraph{system}
Here, we collect modules that deal with the ``system'':
operating-system interfaces, error handlers and diagnostics.
\begin{description}
\item[system\_defs]
Constants relevant for the modules in this set.
\item[diagnostics]
Error and diagnostic message handling. Any
messages and errors issued by WHIZARD functions are handled by the
subroutines in this module, if possible.
\item[os\_interface]
Execute system calls, build and link external object files and libraries.
\item[cputime]
Timer data type and methods, for measuring performance.
\end{description}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Constants}
The parameters here are used in various parts of the program,
starting from the modules in the current chapter. Some of them may be
modified if the need arises.
<<[[system_defs.f90]]>>=
<<File header>>
module system_defs
use, intrinsic :: iso_fortran_env, only: iostat_end, iostat_eor !NODEP!
<<Standard module head>>
<<System defs: public parameters>>
end module system_defs
@ %def system_defs
@
\subsection{Version}
The version string is used for checking files. Note that the string
length MUST NOT be changed, because reading binary files relies on it.
<<System defs: public parameters>>=
integer, parameter, public :: VERSION_STRLEN = 255
character(len=VERSION_STRLEN), parameter, public :: &
& VERSION_STRING = "WHIZARD version <<Version>> (<<Date>>)"
@ %def VERSION_STRLEN VERSION_STRING
@
\subsection{Text Buffer}
There is a hard limit on the line length which we should export. This
buffer size is used both by the message handler, the lexer, and some
further modules.
<<System defs: public parameters>>=
integer, parameter, public :: BUFFER_SIZE = 1000
@ %def BUFFER_SIZE
@
\subsection{IOSTAT Codes}
Defined in [[iso_fortran_env]], but we would like to use shorthands.
<<System defs: public parameters>>=
integer, parameter, public :: EOF = iostat_end, EOR = iostat_eor
@ %def EOF EOR
@
\subsection{Character Codes}
Single-character constants.
<<System defs: public parameters>>=
character, parameter, public :: BLANK = ' '
character, parameter, public :: TAB = achar(9)
character, parameter, public :: CR = achar(13)
character, parameter, public :: LF = achar(10)
character, parameter, public :: BACKSLASH = achar(92)
@ %def BLANK TAB CR NL
@ Character strings that indicate character classes.
<<System defs: public parameters>>=
character(*), parameter, public :: WHITESPACE_CHARS = BLANK// TAB // CR // LF
character(*), parameter, public :: LCLETTERS = "abcdefghijklmnopqrstuvwxyz"
character(*), parameter, public :: UCLETTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
character(*), parameter, public :: DIGITS = "0123456789"
@ %def WHITESPACE_CHARS LCLETTERS UCLETTERS DIGITS
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{C wrapper for sigaction}
This implements calls to [[sigaction]] and the appropriate signal handlers in
C. The functionality is needed for the [[diagnostics]] module.
<<[[signal_interface.c]]>>=
/*
<<File header>>
*/
#include <signal.h>
#include <stdlib.h>
extern int wo_sigint;
extern int wo_sigterm;
extern int wo_sigxcpu;
extern int wo_sigxfsz;
static void wo_handler_sigint (int sig) {
wo_sigint = sig;
}
static void wo_handler_sigterm (int sig) {
wo_sigterm = sig;
}
static void wo_handler_sigxcpu (int sig) {
wo_sigxcpu = sig;
}
static void wo_handler_sigxfsz (int sig) {
wo_sigxfsz = sig;
}
int wo_mask_sigint () {
struct sigaction sa;
sigset_t blocks;
sigfillset (&blocks);
sa.sa_flags = 0;
sa.sa_mask = blocks;
sa.sa_handler = wo_handler_sigint;
return sigaction(SIGINT, &sa, NULL);
}
int wo_mask_sigterm () {
struct sigaction sa;
sigset_t blocks;
sigfillset (&blocks);
sa.sa_flags = 0;
sa.sa_mask = blocks;
sa.sa_handler = wo_handler_sigterm;
return sigaction(SIGTERM, &sa, NULL);
}
int wo_mask_sigxcpu () {
struct sigaction sa;
sigset_t blocks;
sigfillset (&blocks);
sa.sa_flags = 0;
sa.sa_mask = blocks;
sa.sa_handler = wo_handler_sigxcpu;
return sigaction(SIGXCPU, &sa, NULL);
}
int wo_mask_sigxfsz () {
struct sigaction sa;
sigset_t blocks;
sigfillset (&blocks);
sa.sa_flags = 0;
sa.sa_mask = blocks;
sa.sa_handler = wo_handler_sigxfsz;
return sigaction(SIGXFSZ, &sa, NULL);
}
int wo_release_sigint () {
struct sigaction sa;
sigset_t blocks;
sigfillset (&blocks);
sa.sa_flags = 0;
sa.sa_mask = blocks;
sa.sa_handler = SIG_DFL;
return sigaction(SIGINT, &sa, NULL);
}
int wo_release_sigterm () {
struct sigaction sa;
sigset_t blocks;
sigfillset (&blocks);
sa.sa_flags = 0;
sa.sa_mask = blocks;
sa.sa_handler = SIG_DFL;
return sigaction(SIGTERM, &sa, NULL);
}
int wo_release_sigxcpu () {
struct sigaction sa;
sigset_t blocks;
sigfillset (&blocks);
sa.sa_flags = 0;
sa.sa_mask = blocks;
sa.sa_handler = SIG_DFL;
return sigaction(SIGXCPU, &sa, NULL);
}
int wo_release_sigxfsz () {
struct sigaction sa;
sigset_t blocks;
sigfillset (&blocks);
sa.sa_flags = 0;
sa.sa_mask = blocks;
sa.sa_handler = SIG_DFL;
return sigaction(SIGXFSZ, &sa, NULL);
}
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{C wrapper for printf}
The [[printf]] family of functions is implemented in C with an undefined
number of arguments. This is not supported by the [[bind(C)]] interface. We
therefore write wrappers for the versions of [[sprintf]] that
we will actually use.
This is used by the [[formats]] module.
<<[[sprintf_interface.c]]>>=
/*
<<File header>>
*/
#include <stdio.h>
int sprintf_none(char* str, const char* format) {
return sprintf(str, format);
}
int sprintf_int(char* str, const char* format, int val) {
return sprintf(str, format, val);
}
int sprintf_double(char* str, const char* format, double val) {
return sprintf(str, format, val);
}
int sprintf_str(char* str, const char* format, const char* val) {
return sprintf(str, format, val);
}
<<sprintf interfaces>>=
interface
function sprintf_none (str, fmt) result (stat) bind(C)
use iso_c_binding !NODEP!
integer(c_int) :: stat
character(c_char), dimension(*), intent(inout) :: str
character(c_char), dimension(*), intent(in) :: fmt
end function sprintf_none
end interface
interface
function sprintf_int (str, fmt, val) result (stat) bind(C)
use iso_c_binding !NODEP!
integer(c_int) :: stat
character(c_char), dimension(*), intent(inout) :: str
character(c_char), dimension(*), intent(in) :: fmt
integer(c_int), value :: val
end function sprintf_int
end interface
interface
function sprintf_double (str, fmt, val) result (stat) bind(C)
use iso_c_binding !NODEP!
integer(c_int) :: stat
character(c_char), dimension(*), intent(inout) :: str
character(c_char), dimension(*), intent(in) :: fmt
real(c_double), value :: val
end function sprintf_double
end interface
interface
function sprintf_str(str, fmt, val) result (stat) bind(C)
use iso_c_binding !NODEP!
integer(c_int) :: stat
character(c_char), dimension(*), intent(inout) :: str
character(c_char), dimension(*), intent(in) :: fmt
character(c_char), dimension(*), intent(in) :: val
end function sprintf_str
end interface
@ %def sprintf_int sprintf_double sprintf_str
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Error, Message and Signal Handling}
We are not so ambitious as to do proper exception handling in
[[WHIZARD]], but at least it may be useful to have a common interface
for diagnostics: Results, messages, warnings, and such. As module
variables we keep a buffer where the current message may be written to
and a level indicator which tells which messages should be written on
screen and which ones should be skipped. Alternatively, a string may
be directly supplied to the message routine: this overrides the
buffer, avoiding the necessety of formatted I/O in trivial cases.
<<[[diagnostics.f90]]>>=
<<File header>>
module diagnostics
use, intrinsic :: iso_c_binding !NODEP!
use, intrinsic :: iso_fortran_env, only: output_unit !NODEP!
<<Use kinds>>
<<Use strings>>
use string_utils, only: str
use io_units
use system_dependencies
use system_defs, only: BUFFER_SIZE, MAX_ERRORS
<<Standard module head>>
<<Diagnostics: public>>
<<Diagnostics: parameters>>
<<Diagnostics: types>>
<<Diagnostics: variables>>
<<Diagnostics: interfaces>>
contains
<<Diagnostics: procedures>>
end module diagnostics
<<Diagnostics: external procedures>>
@ %def diagnostics
@
Diagnostics levels:
<<Diagnostics: public>>=
public :: RESULT, DEBUG, DEBUG2
<<Diagnostics: parameters>>=
integer, parameter :: TERMINATE=-2, BUG=-1, FATAL=1, &
ERROR=2, WARNING=3, MESSAGE=4, RESULT=5, &
DEBUG=6, DEBUG2=7
@ %def FATAL ERROR WARNING MESSAGE RESULT DEBUG DEBUG2
Diagnostics areas:
<<Diagnostics: public>>=
public :: d_area
<<Diagnostics: interfaces>>=
interface d_area
module procedure d_area_of_string
module procedure d_area_to_string
end interface
<<Diagnostics: procedures>>=
function d_area_of_string (string) result (i)
integer :: i
type(string_t), intent(in) :: string
select case (char (string))
case ("particles")
i = D_PARTICLES
case ("events")
i = D_EVENTS
case ("shower")
i = D_SHOWER
case ("model_features")
i = D_MODEL_F
case ("matching")
i = D_MATCHING
case ("transforms")
i = D_TRANSFORMS
case ("subtraction")
i = D_SUBTRACTION
case ("virtual")
i = D_VIRTUAL
case ("threshold")
i = D_THRESHOLD
case ("phasespace")
i = D_PHASESPACE
case ("mismatch")
i = D_MISMATCH
case ("me_methods")
i = D_ME_METHODS
case ("process_integration")
i = D_PROCESS_INTEGRATION
case ("tauola")
i = D_TAUOLA
case ("core")
i = D_CORE
case ("vamp2")
i = D_VAMP2
case ("mpi")
i = D_MPI
case ("qft")
i = D_QFT
case ("beams")
i = D_BEAMS
case ("all")
i = D_ALL
case default
print "(A)", "Possible values for --debug are:"
do i = 0, D_LAST
print "(A)", char (' ' // d_area_to_string(i))
end do
call msg_fatal ("Please use one of the listed areas")
end select
end function d_area_of_string
elemental function d_area_to_string (i) result (string)
type(string_t) :: string
integer, intent(in) :: i
select case (i)
case (D_PARTICLES)
string = "particles"
case (D_EVENTS)
string = "events"
case (D_SHOWER)
string = "shower"
case (D_MODEL_F)
string = "model_features"
case (D_MATCHING)
string = "matching"
case (D_TRANSFORMS)
string = "transforms"
case (D_SUBTRACTION)
string = "subtraction"
case (D_VIRTUAL)
string = "virtual"
case (D_THRESHOLD)
string = "threshold"
case (D_PHASESPACE)
string = "phasespace"
case (D_MISMATCH)
string = "mismatch"
case (D_ME_METHODS)
string = "me_methods"
case (D_PROCESS_INTEGRATION)
string = "process_integration"
case (D_TAUOLA)
string = "tauola"
case (D_CORE)
string = "core"
case (D_VAMP2)
string = "vamp2"
case (D_MPI)
string = "mpi"
case (D_QFT)
string = "qft"
case (D_BEAMS)
string = "beams"
case (D_ALL)
string = "all"
case default
string = "undefined"
end select
end function d_area_to_string
@ %def d_area
@
<<Diagnostics: public>>=
public :: D_PARTICLES, D_EVENTS, D_SHOWER, D_MODEL_F, &
D_MATCHING, D_TRANSFORMS, D_SUBTRACTION, D_VIRTUAL, D_THRESHOLD, &
D_PHASESPACE, D_MISMATCH, D_ME_METHODS, D_PROCESS_INTEGRATION, &
D_TAUOLA, D_CORE, D_VAMP2, D_MPI, D_QFT, D_BEAMS
<<Diagnostics: parameters>>=
integer, parameter :: D_ALL=0, D_PARTICLES=1, D_EVENTS=2, &
D_SHOWER=3, D_MODEL_F=4, &
D_MATCHING=5, D_TRANSFORMS=6, &
D_SUBTRACTION=7, D_VIRTUAL=8, D_THRESHOLD=9, D_PHASESPACE=10, &
D_MISMATCH=11, D_ME_METHODS=12, D_PROCESS_INTEGRATION=13, &
D_TAUOLA=14, D_CORE=15, D_VAMP2 = 16, D_MPI = 17, D_QFT = 18, &
D_BEAMS=19, D_LAST=19
@ %def D_ALL D_PARTICLES D_EVENTS
@ %def D_SHOWER D_MODEL_F D_MATCHING D_TRANSFORMS
@ %def D_SUBTRACTION D_VIRTUAL D_THRESHOLD D_PHASESPACE
@ %def D_MISMATCH D_ME_METHODS D_PROCESS_INTEGRATION
@ %def D_TAUOLA D_CORE D_VAMP2 D_MPI D_QFT
@
<<Diagnostics: public>>=
public :: msg_level
<<Diagnostics: variables>>=
integer, save, dimension(D_ALL:D_LAST) :: msg_level = RESULT
@ %def msg_level
@
<<Diagnostics: parameters>>=
integer, parameter, public :: COL_UNDEFINED = -1
integer, parameter, public :: COL_GREY = 90, COL_PEACH = 91, COL_LIGHT_GREEN = 92, &
COL_LIGHT_YELLOW = 93, COL_LIGHT_BLUE = 94, COL_PINK = 95, &
COL_LIGHT_AQUA = 96, COL_PEARL_WHITE = 97, COL_BLACK = 30, &
COL_RED = 31, COL_GREEN = 32, COL_YELLOW = 33, COL_BLUE = 34, &
COL_PURPLE = 35, COL_AQUA = 36
@ %def COLORS
@
<<Diagnostics: public>>=
public :: set_debug_levels
<<Diagnostics: procedures>>=
subroutine set_debug_levels (area_str)
type(string_t), intent(in) :: area_str
integer :: area
area = d_area (area_str)
if (area == D_ALL) then
msg_level = DEBUG
else
msg_level(area) = DEBUG
end if
end subroutine set_debug_levels
@ %def set_debug_levels
@
<<Diagnostics: public>>=
public :: set_debug2_levels
<<Diagnostics: procedures>>=
subroutine set_debug2_levels (area_str)
type(string_t), intent(in) :: area_str
integer :: area
area = d_area (area_str)
if (area == D_ALL) then
msg_level = DEBUG2
else
msg_level(area) = DEBUG2
end if
end subroutine set_debug2_levels
@ %def set_debug2_levels
@
<<Diagnostics: types>>=
type :: terminal_color_t
integer :: color = COL_UNDEFINED
contains
<<Diagnostics: terminal color: TBP>>
end type terminal_color_t
@ %def terminal_color_t
@
<<Diagnostics: public>>=
public :: term_col
<<Diagnostics: interfaces>>=
interface term_col
module procedure term_col_int
module procedure term_col_char
end interface term_col
@ %def term_col
@
<<Diagnostics: procedures>>=
function term_col_int (col_int) result (color)
type(terminal_color_t) :: color
integer, intent(in) :: col_int
color%color = col_int
end function term_col_int
function term_col_char (col_char) result (color)
type(terminal_color_t) :: color
character(len=*), intent(in) :: col_char
type(string_t) :: buf
select case (col_char)
case ('Grey')
color%color = COL_GREY
case ('Peach')
color%color = COL_PEACH
case ('Light Green')
color%color = COL_LIGHT_GREEN
case ('Light Yellow')
color%color = COL_LIGHT_YELLOW
case ('Light Blue')
color%color = COL_LIGHT_BLUE
case ('Pink')
color%color = COL_PINK
case ('Light Aqua')
color%color = COL_LIGHT_AQUA
case ('Pearl White')
color%color = COL_PEARL_WHITE
case ('Black')
color%color = COL_BLACK
case ('Red')
color%color = COL_RED
case ('Green')
color%color = COL_GREEN
case ('Yellow')
color%color = COL_YELLOW
case ('Blue')
color%color = COL_BLUE
case ('Purple')
color%color = COL_PURPLE
case ('Aqua')
color%color = COL_AQUA
case default
buf = var_str ('Color ') // var_str (col_char) // var_str (' is not defined')
call msg_warning (char (buf))
color%color = COL_UNDEFINED
end select
end function term_col_char
@
Mask fatal errors so that are treated as normal errors. Useful for
interactive mode.
<<Diagnostics: public>>=
public :: mask_fatal_errors
<<Diagnostics: variables>>=
logical, save :: mask_fatal_errors = .false.
@ %def mask_fatal_errors
@
How to handle bugs and unmasked fatal errors. Either execute a normal
stop statement, or call the C [[exit()]] function, or try to cause a
program crash by dereferencing a null pointer.
These procedures are appended to the [[diagnostics]] source code, but
not as module procedures but as external procedures. This avoids a
circular module dependency across source directories.
<<Diagnostics: parameters>>=
integer, parameter, public :: TERM_STOP = 0, TERM_EXIT = 1, TERM_CRASH = 2
@ %def TERM_STOP TERM_EXIT TERM_CRASH
<<Diagnostics: public>>=
public :: handle_fatal_errors
<<Diagnostics: variables>>=
integer, save :: handle_fatal_errors = TERM_EXIT
<<Diagnostics: external procedures>>=
subroutine fatal_force_crash ()
use diagnostics, only: handle_fatal_errors, TERM_CRASH !NODEP!
implicit none
handle_fatal_errors = TERM_CRASH
end subroutine fatal_force_crash
subroutine fatal_force_exit ()
use diagnostics, only: handle_fatal_errors, TERM_EXIT !NODEP!
implicit none
handle_fatal_errors = TERM_EXIT
end subroutine fatal_force_exit
subroutine fatal_force_stop ()
use diagnostics, only: handle_fatal_errors, TERM_STOP !NODEP!
implicit none
handle_fatal_errors = TERM_STOP
end subroutine fatal_force_stop
@ %def fatal_force_crash
@ %def fatal_force_exit
@ %def fatal_force_stop
@
Keep track of errors. This might be used for exception handling,
later. The counter is incremented only for screen messages, to avoid
double counting.
<<Diagnostics: public>>=
public :: msg_count
<<Diagnostics: variables>>=
integer, dimension(TERMINATE:WARNING), save :: msg_count = 0
@ %def msg_count
@ Keep a list of all errors and warnings. Since we do not know the number of
entries beforehand, we use a linked list.
<<Diagnostics: types>>=
type :: string_list
character(len=BUFFER_SIZE) :: string
type(string_list), pointer :: next
end type string_list
type :: string_list_pointer
type(string_list), pointer :: first, last
end type string_list_pointer
@ %def string_list string_list_pointer
<<Diagnostics: variables>>=
type(string_list_pointer), dimension(TERMINATE:WARNING), save :: &
& msg_list = string_list_pointer (null(), null())
@ %def msg_list
@ Create a format string indicating color
@ Add the current message buffer contents to the internal list.
<<Diagnostics: procedures>>=
subroutine msg_add (level)
integer, intent(in) :: level
type(string_list), pointer :: message
select case (level)
case (TERMINATE:WARNING)
allocate (message)
message%string = msg_buffer
nullify (message%next)
if (.not.associated (msg_list(level)%first)) &
& msg_list(level)%first => message
if (associated (msg_list(level)%last)) &
& msg_list(level)%last%next => message
msg_list(level)%last => message
msg_count(level) = msg_count(level) + 1
end select
end subroutine msg_add
@ %def msg_add
@
Initialization:
<<Diagnostics: public>>=
public :: msg_list_clear
<<Diagnostics: procedures>>=
subroutine msg_list_clear
integer :: level
type(string_list), pointer :: message
do level = TERMINATE, WARNING
do while (associated (msg_list(level)%first))
message => msg_list(level)%first
msg_list(level)%first => message%next
deallocate (message)
end do
nullify (msg_list(level)%last)
end do
msg_count = 0
end subroutine msg_list_clear
@ %def msg_list_clear
@ Display the summary of errors and warnings (no need to count
fatals\ldots)
<<Diagnostics: public>>=
public :: msg_summary
<<Diagnostics: procedures>>=
subroutine msg_summary (unit)
integer, intent(in), optional :: unit
call expect_summary (unit)
1 format (A,1x,I2,1x,A,I2,1x,A)
if (msg_count(ERROR) > 0 .and. msg_count(WARNING) > 0) then
write (msg_buffer, 1) "There were", &
& msg_count(ERROR), "error(s) and ", &
& msg_count(WARNING), "warning(s)."
call msg_message (unit=unit)
else if (msg_count(ERROR) > 0) then
write (msg_buffer, 1) "There were", &
& msg_count(ERROR), "error(s) and no warnings."
call msg_message (unit=unit)
else if (msg_count(WARNING) > 0) then
write (msg_buffer, 1) "There were no errors and ", &
& msg_count(WARNING), "warning(s)."
call msg_message (unit=unit)
end if
end subroutine msg_summary
@ %def msg_summary
@ Print the list of all messages of a given level.
<<Diagnostics: public>>=
public :: msg_listing
<<Diagnostics: procedures>>=
subroutine msg_listing (level, unit, prefix)
integer, intent(in) :: level
integer, intent(in), optional :: unit
character(len=*), intent(in), optional :: prefix
type(string_list), pointer :: message
integer :: u
u = given_output_unit (unit); if (u < 0) return
if (present (unit)) u = unit
message => msg_list(level)%first
do while (associated (message))
if (present (prefix)) then
write (u, "(A)") prefix // trim (message%string)
else
write (u, "(A)") trim (message%string)
end if
message => message%next
end do
flush (u)
end subroutine msg_listing
@ %def msg_listing
@ The message buffer:
<<Diagnostics: public>>=
public :: msg_buffer
<<Diagnostics: variables>>=
character(len=BUFFER_SIZE), save :: msg_buffer = " "
@ %def msg_buffer
@
After a message is issued, the buffer should be cleared:
<<Diagnostics: procedures>>=
subroutine buffer_clear
msg_buffer = " "
end subroutine buffer_clear
@ %def buffer_clear
<<Diagnostics: public>>=
public :: create_col_string
<<Diagnostics: procedures>>=
function create_col_string (color) result (col_string)
type(string_t) :: col_string
integer, intent(in) :: color
character(2) :: buf
write (buf, '(I2)') color
col_string = var_str ("[") // var_str (buf) // var_str ("m")
end function create_col_string
@ %def create_col_string
@ The generic handler for messages. If the unit is omitted (or $=6$), the
message is written to standard output if the precedence if
sufficiently high (as determined by the value of
[[msg_level]]). If the string is omitted, the buffer is used.
In any case, the buffer is cleared after printing. In accordance with
FORTRAN custom, the first column in the output is left blank. For
messages and warnings, an additional exclamation mark and a blank is
prepended. Furthermore, each message is appended to the internal
message list (without prepending anything).
<<Diagnostics: procedures>>=
subroutine message_print (level, string, str_arr, unit, logfile, area, color)
integer, intent(in) :: level
character(len=*), intent(in), optional :: string
type(string_t), dimension(:), intent(in), optional :: str_arr
integer, intent(in), optional :: unit
logical, intent(in), optional :: logfile
integer, intent(in), optional :: area
integer, intent(in), optional :: color
type(string_t) :: col_string, prep_string, aux_string, head_footer, app_string
integer :: lu, i, ar
logical :: severe, is_error
ar = D_ALL; if (present (area)) ar = area
severe = .false.
head_footer = "******************************************************************************"
aux_string = ""
is_error = .false.
app_string = ""
select case (level)
case (TERMINATE)
prep_string = ""
case (BUG)
prep_string = "*** WHIZARD BUG: "
aux_string = "*** "
severe = .true.
is_error = .true.
case (FATAL)
prep_string = "*** FATAL ERROR: "
aux_string = "*** "
severe = .true.
is_error = .true.
case (ERROR)
prep_string = "*** ERROR: "
aux_string = "*** "
is_error = .true.
case (WARNING)
prep_string = "Warning: "
case (MESSAGE)
prep_string = "| "
case (DEBUG, DEBUG2)
prep_string = "D: "
case default
prep_string = ""
end select
if (present (color)) then
if (color > COL_UNDEFINED) then
col_string = create_col_string (color)
prep_string = achar(27) // col_string // prep_string
app_string = app_string // achar(27) // "[0m"
end if
end if
if (present(string)) msg_buffer = string
lu = log_unit
if (present(unit)) then
if (unit /= output_unit) then
if (severe) write (unit, "(A)") char(head_footer)
if (is_error) write (unit, "(A)") char(head_footer)
write (unit, "(A,A,A)") char(prep_string), trim(msg_buffer), &
char(app_string)
if (present (str_arr)) then
do i = 1, size(str_arr)
write (unit, "(A,A)") char(aux_string), char(trim(str_arr(i)))
end do
end if
if (is_error) write (unit, "(A)") char(head_footer)
if (severe) write (unit, "(A)") char(head_footer)
flush (unit)
lu = -1
else if (level <= msg_level(ar)) then
if (severe) print "(A)", char(head_footer)
if (is_error) print "(A)", char(head_footer)
print "(A,A,A)", char(prep_string), trim(msg_buffer), &
char(app_string)
if (present (str_arr)) then
do i = 1, size(str_arr)
print "(A,A)", char(aux_string), char(trim(str_arr(i)))
end do
end if
if (is_error) print "(A)", char(head_footer)
if (severe) print "(A)", char(head_footer)
flush (output_unit)
if (unit == log_unit) lu = -1
end if
else if (level <= msg_level(ar)) then
if (severe) print "(A)", char(head_footer)
if (is_error) print "(A)", char(head_footer)
print "(A,A,A)", char(prep_string), trim(msg_buffer), &
char(app_string)
if (present (str_arr)) then
do i = 1, size(str_arr)
print "(A,A)", char(aux_string), char(trim(str_arr(i)))
end do
end if
if (is_error) print "(A)", char(head_footer)
if (severe) print "(A)", char(head_footer)
flush (output_unit)
end if
if (present (logfile)) then
if (.not. logfile) lu = -1
end if
if (logging .and. lu >= 0) then
if (severe) write (lu, "(A)") char(head_footer)
if (is_error) write (lu, "(A)") char(head_footer)
write (lu, "(A,A,A)") char(prep_string), trim(msg_buffer), &
char(app_string)
if (present (str_arr)) then
do i = 1, size(str_arr)
write (lu, "(A,A)") char(aux_string), char(trim(str_arr(i)))
end do
end if
if (is_error) write (lu, "(A)") char(head_footer)
if (severe) write (lu, "(A)") char(head_footer)
flush (lu)
end if
call msg_add (level)
call buffer_clear
end subroutine message_print
@ %def message_print
@
The number of non-fatal errors that we allow before stopping the
program. We might trade this later for an adjustable number.
<<System defs: public parameters>>=
integer, parameter, public :: MAX_ERRORS = 10
@ %def MAX_ERRORS
@ The specific handlers. In the case of fatal errors, bugs (failed
assertions) and normal termination execution is stopped. For
non-fatal errors a message is printed to standard output if no unit is
given. Only if the number of [[MAX_ERRORS]] errors is reached, we
abort the program. There are no further actions in the other cases,
but this may change.
<<Diagnostics: public>>=
public :: msg_terminate
public :: msg_bug, msg_fatal, msg_error, msg_warning
public :: msg_message, msg_result
<<Diagnostics: procedures>>=
subroutine msg_terminate (string, unit, quit_code)
integer, intent(in), optional :: unit
character(len=*), intent(in), optional :: string
integer, intent(in), optional :: quit_code
integer(c_int) :: return_code
call release_term_signals ()
if (present (quit_code)) then
return_code = quit_code
else
return_code = 0
end if
if (present (string)) &
call message_print (MESSAGE, string, unit=unit)
call msg_summary (unit)
if (return_code == 0 .and. expect_failures /= 0) then
return_code = 5
call message_print (MESSAGE, &
"WHIZARD run finished with 'expect' failure(s).", unit=unit)
else if (return_code == 7) then
call message_print (MESSAGE, &
"WHIZARD run finished with failed self-test.", unit=unit)
else
call message_print (MESSAGE, "WHIZARD run finished.", unit=unit)
end if
call message_print (0, &
"|=============================================================================|", unit=unit)
call logfile_final ()
call msg_list_clear ()
if (return_code /= 0) then
call exit (return_code)
else
!!! Should implement WHIZARD exit code (currently only via C)
call exit (0)
end if
end subroutine msg_terminate
subroutine msg_bug (string, arr, unit)
integer, intent(in), optional :: unit
character(len=*), intent(in), optional :: string
type(string_t), dimension(:), intent(in), optional :: arr
logical, pointer :: crash_ptr
call message_print (BUG, string, arr, unit)
call msg_summary (unit)
select case (handle_fatal_errors)
case (TERM_EXIT)
call message_print (TERMINATE, "WHIZARD run aborted.", unit=unit)
call exit (-1_c_int)
case (TERM_CRASH)
print *, "*** Intentional crash ***"
crash_ptr => null ()
print *, crash_ptr
end select
stop "WHIZARD run aborted."
end subroutine msg_bug
recursive subroutine msg_fatal (string, arr, unit)
integer, intent(in), optional :: unit
character(len=*), intent(in), optional :: string
type(string_t), dimension(:), intent(in), optional :: arr
logical, pointer :: crash_ptr
if (mask_fatal_errors) then
call msg_error (string, arr, unit)
else
call message_print (FATAL, string, arr, unit)
call msg_summary (unit)
select case (handle_fatal_errors)
case (TERM_EXIT)
call message_print (TERMINATE, "WHIZARD run aborted.", unit=unit)
call exit (1_c_int)
case (TERM_CRASH)
print *, "*** Intentional crash ***"
crash_ptr => null ()
print *, crash_ptr
end select
stop "WHIZARD run aborted."
end if
end subroutine msg_fatal
subroutine msg_error (string, arr, unit)
integer, intent(in), optional :: unit
character(len=*), intent(in), optional :: string
type(string_t), dimension(:), intent(in), optional :: arr
call message_print (ERROR, string, arr, unit)
if (msg_count(ERROR) >= MAX_ERRORS) then
mask_fatal_errors = .false.
call msg_fatal (" Too many errors encountered.")
else if (.not.present(unit) .and. .not.mask_fatal_errors) then
call message_print (MESSAGE, " (WHIZARD run continues)")
end if
end subroutine msg_error
subroutine msg_warning (string, arr, unit, color)
integer, intent(in), optional :: unit
character(len=*), intent(in), optional :: string
type(string_t), dimension(:), intent(in), optional :: arr
type(terminal_color_t), intent(in), optional :: color
integer :: cl
cl = COL_UNDEFINED; if (present (color)) cl = color%color
call message_print (level = WARNING, string = string, &
str_arr = arr, unit = unit, color = cl)
end subroutine msg_warning
subroutine msg_message (string, unit, arr, logfile, color)
integer, intent(in), optional :: unit
character(len=*), intent(in), optional :: string
type(string_t), dimension(:), intent(in), optional :: arr
logical, intent(in), optional :: logfile
type(terminal_color_t), intent(in), optional :: color
integer :: cl
cl = COL_UNDEFINED; if (present (color)) cl = color%color
call message_print (level = MESSAGE, &
string = string, str_arr = arr, unit = unit, &
logfile = logfile, color = cl)
end subroutine msg_message
subroutine msg_result (string, arr, unit, logfile, color)
integer, intent(in), optional :: unit
character(len=*), intent(in), optional :: string
type(string_t), dimension(:), intent(in), optional :: arr
logical, intent(in), optional :: logfile
type(terminal_color_t), intent(in), optional :: color
integer :: cl
cl = COL_UNDEFINED; if (present (color)) cl = color%color
call message_print (level = RESULT, string = string, &
str_arr = arr, unit = unit, logfile = logfile, color = cl)
end subroutine msg_result
@ %def msg_warning msg_message msg_result
@
<<Diagnostics: public>>=
public :: msg_debug
<<Diagnostics: interfaces>>=
interface msg_debug
module procedure msg_debug_none
module procedure msg_debug_logical
module procedure msg_debug_integer
module procedure msg_debug_real
module procedure msg_debug_complex
module procedure msg_debug_string
end interface
<<Diagnostics: procedures>>=
subroutine msg_debug_none (area, string, color)
integer, intent(in) :: area
character(len=*), intent(in), optional :: string
type(terminal_color_t), intent(in), optional :: color
integer :: cl
cl = COL_BLUE; if (present (color)) cl = color%color
call message_print (DEBUG, string, unit = output_unit, &
area = area, logfile = .false., color = cl)
end subroutine msg_debug_none
subroutine msg_debug_logical (area, string, value, color)
logical, intent(in) :: value
<<msg debug implementation>>
end subroutine msg_debug_logical
subroutine msg_debug_integer (area, string, value, color)
integer, intent(in) :: value
<<msg debug implementation>>
end subroutine msg_debug_integer
subroutine msg_debug_real (area, string, value, color)
real(default), intent(in) :: value
<<msg debug implementation>>
end subroutine msg_debug_real
subroutine msg_debug_complex (area, string, value, color)
complex(default), intent(in) :: value
<<msg debug implementation>>
end subroutine msg_debug_complex
subroutine msg_debug_string (area, string, value, color)
type(string_t), intent(in) :: value
integer, intent(in) :: area
character(len=*), intent(in) :: string
type(terminal_color_t), intent(in), optional :: color
call msg_debug_none (area, char (string // " = " // value), &
color = color)
end subroutine msg_debug_string
@ %def msg_debug
<<msg debug implementation>>=
integer, intent(in) :: area
character(len=*), intent(in) :: string
type(terminal_color_t), intent(in), optional :: color
call msg_debug_none (area, char (string // " = " // str (value)), &
color = color)
@
<<Diagnostics: public>>=
public :: msg_print_color
<<Diagnostics: interfaces>>=
interface msg_print_color
module procedure msg_print_color_none
module procedure msg_print_color_logical
module procedure msg_print_color_integer
module procedure msg_print_color_real
end interface
<<Diagnostics: procedures>>=
subroutine msg_print_color_none (string, color)
character(len=*), intent(in) :: string
!!!type(terminal_color_t), intent(in) :: color
integer, intent(in) :: color
call message_print (0, string, color = color)
end subroutine msg_print_color_none
subroutine msg_print_color_logical (string, value, color)
character(len=*), intent(in) :: string
logical, intent(in) :: value
integer, intent(in) :: color
call msg_print_color_none (char (string // " = " // str (value)), &
color = color)
end subroutine msg_print_color_logical
subroutine msg_print_color_integer (string, value, color)
character(len=*), intent(in) :: string
integer, intent(in) :: value
integer, intent(in) :: color
call msg_print_color_none (char (string // " = " // str (value)), &
color = color)
end subroutine msg_print_color_integer
subroutine msg_print_color_real (string, value, color)
character(len=*), intent(in) :: string
real(default), intent(in) :: value
integer, intent(in) :: color
call msg_print_color_none (char (string // " = " // str (value)), &
color = color)
end subroutine msg_print_color_real
@ %def msg_print_color_none, msg_print_color_logical
@ %def msg_print_color_integer, msg_print_color_real
@
<<Diagnostics: public>>=
public :: msg_debug2
<<Diagnostics: interfaces>>=
interface msg_debug2
module procedure msg_debug2_none
module procedure msg_debug2_logical
module procedure msg_debug2_integer
module procedure msg_debug2_real
module procedure msg_debug2_complex
module procedure msg_debug2_string
end interface
<<Diagnostics: procedures>>=
subroutine msg_debug2_none (area, string, color)
integer, intent(in) :: area
character(len=*), intent(in), optional :: string
type(terminal_color_t), intent(in), optional :: color
integer :: cl
cl = COL_BLUE; if (present (color)) cl = color%color
call message_print (DEBUG2, string, unit = output_unit, &
area = area, logfile = .false., color = cl)
end subroutine msg_debug2_none
subroutine msg_debug2_logical (area, string, value, color)
logical, intent(in) :: value
<<msg debug2 implementation>>
end subroutine msg_debug2_logical
subroutine msg_debug2_integer (area, string, value, color)
integer, intent(in) :: value
<<msg debug2 implementation>>
end subroutine msg_debug2_integer
subroutine msg_debug2_real (area, string, value, color)
real(default), intent(in) :: value
<<msg debug2 implementation>>
end subroutine msg_debug2_real
subroutine msg_debug2_complex (area, string, value, color)
complex(default), intent(in) :: value
<<msg debug2 implementation>>
end subroutine msg_debug2_complex
subroutine msg_debug2_string (area, string, value, color)
type(string_t), intent(in) :: value
integer, intent(in) :: area
character(len=*), intent(in) :: string
type(terminal_color_t), intent(in), optional :: color
call msg_debug2_none (area, char (string // " = " // value), &
color = color)
end subroutine msg_debug2_string
@ %def msg_debug2
<<msg debug2 implementation>>=
integer, intent(in) :: area
character(len=*), intent(in) :: string
type(terminal_color_t), intent(in), optional :: color
call msg_debug2_none (area, char (string // " = " // str (value)), &
color = color)
@
<<Diagnostics: public>>=
public :: debug_active
<<Diagnostics: procedures>>=
elemental function debug_active (area) result (active)
logical :: active
integer, intent(in) :: area
active = msg_level(area) >= DEBUG
end function debug_active
@ %def debug_active
@
<<Diagnostics: public>>=
public :: debug2_active
<<Diagnostics: procedures>>=
elemental function debug2_active (area) result (active)
logical :: active
integer, intent(in) :: area
active = msg_level(area) >= DEBUG2
end function debug2_active
@ %def debug2_active
@ Show the progress of a loop in steps of 10 \%. Could be generalized
to other step sizes with an optional argument.
<<Diagnostics: public>>=
public :: msg_show_progress
<<Diagnostics: procedures>>=
subroutine msg_show_progress (i_call, n_calls)
integer, intent(in) :: i_call, n_calls
real(default) :: progress
integer, save :: next_check
if (i_call == 1) next_check = 10
progress = (i_call * 100._default) / n_calls
if (progress >= next_check) then
write (msg_buffer, "(F5.1,A)") progress, "%"
call msg_message ()
next_check = next_check + 10
end if
end subroutine msg_show_progress
@ %def msg_show_progress
@ Interface to the standard clib exit function
<<Diagnostics: public>>=
public :: exit
<<Diagnostics: interfaces>>=
interface
subroutine exit (status) bind (C)
use iso_c_binding !NODEP!
integer(c_int), value :: status
end subroutine exit
end interface
@ %def exit
@ Print the WHIZARD banner:
<<Diagnostics: public>>=
public :: msg_banner
<<Diagnostics: procedures>>=
subroutine msg_banner (unit)
integer, intent(in), optional :: unit
call message_print (0, "|=============================================================================|", unit=unit)
call message_print (0, "| |", unit=unit)
call message_print (0, "| WW WW WW WW WW WWWWWW WW WWWWW WWWW |", unit=unit)
call message_print (0, "| WW WW WW WW WW WW WW WWWW WW WW WW WW |", unit=unit)
call message_print (0, "| WW WW WW WW WWWWWWW WW WW WW WW WWWWW WW WW |", unit=unit)
call message_print (0, "| WWWW WWWW WW WW WW WW WWWWWWWW WW WW WW WW |", unit=unit)
call message_print (0, "| WW WW WW WW WW WWWWWW WW WW WW WW WWWW |", unit=unit)
call message_print (0, "| |", unit=unit)
call message_print (0, "| |", unit=unit)
call message_print (0, "| W |", unit=unit)
call message_print (0, "| sW |", unit=unit)
call message_print (0, "| WW |", unit=unit)
call message_print (0, "| sWW |", unit=unit)
call message_print (0, "| WWW |", unit=unit)
call message_print (0, "| wWWW |", unit=unit)
call message_print (0, "| wWWWW |", unit=unit)
call message_print (0, "| WW WW |", unit=unit)
call message_print (0, "| WW WW |", unit=unit)
call message_print (0, "| wWW WW |", unit=unit)
call message_print (0, "| wWW WW |", unit=unit)
call message_print (0, "| WW WW |", unit=unit)
call message_print (0, "| WW WW |", unit=unit)
call message_print (0, "| WW WW |", unit=unit)
call message_print (0, "| WW WW |", unit=unit)
call message_print (0, "| WW WW |", unit=unit)
call message_print (0, "| WW WW |", unit=unit)
call message_print (0, "| wwwwww WW WW |", unit=unit)
call message_print (0, "| WWWWWww WW WW |", unit=unit)
call message_print (0, "| WWWWWwwwww WW WW |", unit=unit)
call message_print (0, "| wWWWwwwwwWW WW |", unit=unit)
call message_print (0, "| wWWWWWWWWWWwWWW WW |", unit=unit)
call message_print (0, "| wWWWWW wW WWWWWWW |", unit=unit)
call message_print (0, "| WWWW wW WW wWWWWWWWwww |", unit=unit)
call message_print (0, "| WWWW wWWWWWWWwwww |", unit=unit)
call message_print (0, "| WWWW WWWW WWw |", unit=unit)
call message_print (0, "| WWWWww WWWW |", unit=unit)
call message_print (0, "| WWWwwww WWWW |", unit=unit)
call message_print (0, "| wWWWWwww wWWWWW |", unit=unit)
call message_print (0, "| WwwwwwwwwWWW |", unit=unit)
call message_print (0, "| |", unit=unit)
call message_print (0, "| |", unit=unit)
call message_print (0, "| |", unit=unit)
call message_print (0, "| by: Wolfgang Kilian, Thorsten Ohl, Juergen Reuter |", unit=unit)
call message_print (0, "| with contributions from Christian Speckner |", unit=unit)
call message_print (0, "| Contact: <whizard@desy.de> |", unit=unit)
call message_print (0, "| |", unit=unit)
call message_print (0, "| if you use WHIZARD please cite: |", unit=unit)
call message_print (0, "| W. Kilian, T. Ohl, J. Reuter, Eur.Phys.J.C71 (2011) 1742 |", unit=unit)
call message_print (0, "| [arXiv: 0708.4233 [hep-ph]] |", unit=unit)
call message_print (0, "| M. Moretti, T. Ohl, J. Reuter, arXiv: hep-ph/0102195 |", unit=unit)
call message_print (0, "| |", unit=unit)
call message_print (0, "|=============================================================================|", unit=unit)
call message_print (0, "| WHIZARD " // WHIZARD_VERSION, unit=unit)
call message_print (0, "|=============================================================================|", unit=unit)
end subroutine msg_banner
@ %def msg_banner
@
\subsection{Logfile}
All screen output should be duplicated in the logfile, unless
requested otherwise.
<<Diagnostics: public>>=
public :: logging
<<Diagnostics: variables>>=
integer, save :: log_unit = -1
logical, target, save :: logging = .false.
<<Diagnostics: public>>=
public :: logfile_init
<<Diagnostics: procedures>>=
subroutine logfile_init (filename)
type(string_t), intent(in) :: filename
call msg_message ("Writing log to '" // char (filename) // "'")
if (.not. logging) call msg_message ("(Logging turned off.)")
log_unit = free_unit ()
open (file = char (filename), unit = log_unit, &
action = "write", status = "replace")
end subroutine logfile_init
@ %def logfile_init
<<Diagnostics: public>>=
public :: logfile_final
<<Diagnostics: procedures>>=
subroutine logfile_final ()
if (log_unit >= 0) then
close (log_unit)
log_unit = -1
end if
end subroutine logfile_final
@ %def logfile_final
@ This returns the valid logfile unit only if the default is write to
screen, and if [[logfile]] is not set false.
<<Diagnostics: public>>=
public :: logfile_unit
<<Diagnostics: procedures>>=
function logfile_unit (unit, logfile)
integer :: logfile_unit
integer, intent(in), optional :: unit
logical, intent(in), optional :: logfile
if (logging) then
if (present (unit)) then
if (unit == output_unit) then
logfile_unit = log_unit
else
logfile_unit = -1
end if
else if (present (logfile)) then
if (logfile) then
logfile_unit = log_unit
else
logfile_unit = -1
end if
else
logfile_unit = log_unit
end if
else
logfile_unit = -1
end if
end function logfile_unit
@ %def logfile_unit
@
\subsection{Checking values}
The [[expect]] function does not just check a value for correctness
(actually, it checks if a logical expression is true); it records its
result here. If failures are present when the program terminates, the
exit code is nonzero.
<<Diagnostics: variables>>=
integer, save :: expect_total = 0
integer, save :: expect_failures = 0
@ %def expect_total expect_failures
<<Diagnostics: public>>=
public :: expect_record
<<Diagnostics: procedures>>=
subroutine expect_record (success)
logical, intent(in) :: success
expect_total = expect_total + 1
if (.not. success) expect_failures = expect_failures + 1
end subroutine expect_record
@ %def expect_record
<<Diagnostics: public>>=
public :: expect_clear
<<Diagnostics: procedures>>=
subroutine expect_clear ()
expect_total = 0
expect_failures = 0
end subroutine expect_clear
@ %def expect_clear
<<Diagnostics: public>>=
public :: expect_summary
<<Diagnostics: procedures>>=
subroutine expect_summary (unit, force)
integer, intent(in), optional :: unit
logical, intent(in), optional :: force
logical :: force_output
force_output = .false.; if (present (force)) force_output = force
if (expect_total /= 0 .or. force_output) then
call msg_message ("Summary of value checks:", unit)
write (msg_buffer, "(2x,A,1x,I0,1x,A,1x,A,1x,I0)") &
"Failures:", expect_failures, "/", "Total:", expect_total
call msg_message (unit=unit)
end if
end subroutine expect_summary
@ %def expect_summary
@ Helpers for converting integers into strings with minimal length.
<<Diagnostics: public>>=
public :: int2string
public :: int2char
public :: int2fixed
<<Diagnostics: procedures>>=
pure function int2fixed (i) result (c)
integer, intent(in) :: i
character(200) :: c
c = ""
write (c, *) i
c = adjustl (c)
end function int2fixed
pure function int2string (i) result (s)
integer, intent(in) :: i
type (string_t) :: s
s = trim (int2fixed (i))
end function int2string
pure function int2char (i) result (c)
integer, intent(in) :: i
character(len (trim (int2fixed (i)))) :: c
c = int2fixed (i)
end function int2char
@ %def int2fixed int2string int2char
@ Dito for reals.
<<Diagnostics: public>>=
public :: real2string
public :: real2char
public :: real2fixed
<<Diagnostics: interfaces>>=
interface real2string
module procedure real2string_list, real2string_fmt
end interface
interface real2char
module procedure real2char_list, real2char_fmt
end interface
<<Diagnostics: procedures>>=
pure function real2fixed (x, fmt) result (c)
real(default), intent(in) :: x
character(*), intent(in), optional :: fmt
character(200) :: c
c = ""
write (c, *) x
c = adjustl (c)
end function real2fixed
pure function real2fixed_fmt (x, fmt) result (c)
real(default), intent(in) :: x
character(*), intent(in) :: fmt
character(200) :: c
c = ""
write (c, fmt) x
c = adjustl (c)
end function real2fixed_fmt
pure function real2string_list (x) result (s)
real(default), intent(in) :: x
type(string_t) :: s
s = trim (real2fixed (x))
end function real2string_list
pure function real2string_fmt (x, fmt) result (s)
real(default), intent(in) :: x
character(*), intent(in) :: fmt
type(string_t) :: s
s = trim (real2fixed_fmt (x, fmt))
end function real2string_fmt
pure function real2char_list (x) result (c)
real(default), intent(in) :: x
character(len_trim (real2fixed (x))) :: c
c = real2fixed (x)
end function real2char_list
pure function real2char_fmt (x, fmt) result (c)
real(default), intent(in) :: x
character(*), intent(in) :: fmt
character(len_trim (real2fixed_fmt (x, fmt))) :: c
c = real2fixed_fmt (x, fmt)
end function real2char_fmt
@ %def real2fixed real2string real2char
@ Dito for complex values; we do not use the slightly ugly FORTRAN output form
here but instead introduce our own. Ifort and Portland seem to have problems
with this, therefore temporarily disable it.
%
<<CCC Diagnostics: public>>=
public :: cmplx2string
public :: cmplx2char
<<CCC Diagnostics: procedures>>=
pure function cmplx2string (x) result (s)
complex(default), intent(in) :: x
type(string_t) :: s
s = real2string (real (x, default))
if (aimag (x) /= 0) s = s // " + " // real2string (aimag (x)) // " I"
end function cmplx2string
pure function cmplx2char (x) result (c)
complex(default), intent(in) :: x
character(len (char (cmplx2string (x)))) :: c
c = char (cmplx2string (x))
end function cmplx2char
@ %def cmplx2string cmplx2char
@
\subsection{Suppression of numerical noise}
<<Diagnostics: public>>=
public :: pacify
<<Diagnostics: interfaces>>=
interface pacify
module procedure pacify_real_default
module procedure pacify_complex_default
end interface pacify
@
<<Diagnostics: procedures>>=
elemental subroutine pacify_real_default (x, tolerance)
real(default), intent(inout) :: x
real(default), intent(in) :: tolerance
if (abs (x) < tolerance) x = 0._default
end subroutine pacify_real_default
elemental subroutine pacify_complex_default (x, tolerance)
complex(default), intent(inout) :: x
real(default), intent(in) :: tolerance
if (abs (real (x)) < tolerance) &
x = cmplx (0._default, aimag (x), kind=default)
if (abs (aimag (x)) < tolerance) &
x = cmplx (real (x), 0._default, kind=default)
end subroutine pacify_complex_default
@ %def pacify
@
\subsection{Signal handling}
Killing the program by external signals may leave the files written by it in
an undefined state. This can be avoided by catching signals and deferring
program termination. Instead of masking only critical sections, we choose
to mask signals globally (done in the main program) and terminate the program
at predefined checkpoints only. Checkpoints are after each command, within
the sampling function (so the program can be terminated after each event),
and after each iteration in the phase-space generation algorithm.
Signal handling is done via a C interface to the [[sigaction]] system call.
When a signal is raised that has been masked by the handler, the corresponding
variable is set to the value of the signal. The variables are visible from
the C signal handler.
The signal SIGINT is for keyboard interrupt (ctrl-C), SIGTERM is for system
interrupt, e.g., at shutdown. The SIGXCPU and SIGXFSZ signals may be issued
by batch systems.
<<Diagnostics: public>>=
public :: wo_sigint
public :: wo_sigterm
public :: wo_sigxcpu
public :: wo_sigxfsz
<<Diagnostics: variables>>=
integer(c_int), bind(C), volatile :: wo_sigint = 0
integer(c_int), bind(C), volatile :: wo_sigterm = 0
integer(c_int), bind(C), volatile :: wo_sigxcpu = 0
integer(c_int), bind(C), volatile :: wo_sigxfsz = 0
@ %def wo_sigint wo_sigterm wo_sigxcpu wo_sigxfsz
@ Here are the interfaces to the C functions. The routine
[[mask_term_signals]] forces termination signals to be delayed.
[[release_term_signals]] restores normal behavior. However, the program can be
terminated anytime by calling [[terminate_now_if_signal]] which inspects the
signals and terminates the program if requested..
<<Diagnostics: public>>=
public :: mask_term_signals
<<Diagnostics: procedures>>=
subroutine mask_term_signals ()
logical :: ok
wo_sigint = 0
ok = wo_mask_sigint () == 0
if (.not. ok) call msg_error ("Masking SIGINT failed")
wo_sigterm = 0
ok = wo_mask_sigterm () == 0
if (.not. ok) call msg_error ("Masking SIGTERM failed")
wo_sigxcpu = 0
ok = wo_mask_sigxcpu () == 0
if (.not. ok) call msg_error ("Masking SIGXCPU failed")
wo_sigxfsz = 0
ok = wo_mask_sigxfsz () == 0
if (.not. ok) call msg_error ("Masking SIGXFSZ failed")
end subroutine mask_term_signals
@ %def mask_term_signals
<<Diagnostics: interfaces>>=
interface
integer(c_int) function wo_mask_sigint () bind(C)
import
end function wo_mask_sigint
end interface
interface
integer(c_int) function wo_mask_sigterm () bind(C)
import
end function wo_mask_sigterm
end interface
interface
integer(c_int) function wo_mask_sigxcpu () bind(C)
import
end function wo_mask_sigxcpu
end interface
interface
integer(c_int) function wo_mask_sigxfsz () bind(C)
import
end function wo_mask_sigxfsz
end interface
@ %def wo_mask_sigint wo_mask_sigterm wo_mask_sigxcpu wo_mask_sigxfsz
<<Diagnostics: public>>=
public :: release_term_signals
<<Diagnostics: procedures>>=
subroutine release_term_signals ()
logical :: ok
ok = wo_release_sigint () == 0
if (.not. ok) call msg_error ("Releasing SIGINT failed")
ok = wo_release_sigterm () == 0
if (.not. ok) call msg_error ("Releasing SIGTERM failed")
ok = wo_release_sigxcpu () == 0
if (.not. ok) call msg_error ("Releasing SIGXCPU failed")
ok = wo_release_sigxfsz () == 0
if (.not. ok) call msg_error ("Releasing SIGXFSZ failed")
end subroutine release_term_signals
@ %def release_term_signals
<<Diagnostics: interfaces>>=
interface
integer(c_int) function wo_release_sigint () bind(C)
import
end function wo_release_sigint
end interface
interface
integer(c_int) function wo_release_sigterm () bind(C)
import
end function wo_release_sigterm
end interface
interface
integer(c_int) function wo_release_sigxcpu () bind(C)
import
end function wo_release_sigxcpu
end interface
interface
integer(c_int) function wo_release_sigxfsz () bind(C)
import
end function wo_release_sigxfsz
end interface
@ %def wo_release_sigint wo_release_sigterm
@ %def wo_release_sigxcpu wo_release_sigxfsz
<<Diagnostics: public>>=
public :: signal_is_pending
<<Diagnostics: procedures>>=
function signal_is_pending () result (flag)
logical :: flag
flag = &
wo_sigint /= 0 .or. &
wo_sigterm /= 0 .or. &
wo_sigxcpu /= 0 .or. &
wo_sigxfsz /= 0
end function signal_is_pending
@ %def signal_is_pending
<<Diagnostics: public>>=
public :: terminate_now_if_signal
<<Diagnostics: procedures>>=
subroutine terminate_now_if_signal ()
if (wo_sigint /= 0) then
call msg_terminate ("Signal SIGINT (keyboard interrupt) received.", &
quit_code=int (wo_sigint))
else if (wo_sigterm /= 0) then
call msg_terminate ("Signal SIGTERM (termination signal) received.", &
quit_code=int (wo_sigterm))
else if (wo_sigxcpu /= 0) then
call msg_terminate ("Signal SIGXCPU (CPU time limit exceeded) received.", &
quit_code=int (wo_sigxcpu))
else if (wo_sigxfsz /= 0) then
call msg_terminate ("Signal SIGXFSZ (file size limit exceeded) received.", &
quit_code=int (wo_sigxfsz))
end if
end subroutine terminate_now_if_signal
@ %def terminate_now_if_signal
@
<<Diagnostics: public>>=
public :: single_event
<<Diagnostics: variables>>=
logical :: single_event = .false.
@
<<Diagnostics: public>>=
public :: terminate_now_if_single_event
<<Diagnostics: procedures>>=
subroutine terminate_now_if_single_event ()
integer, save :: n_calls = 0
n_calls = n_calls + 1
if (single_event .and. n_calls > 1) then
call msg_terminate ("Stopping after one event", quit_code=0)
end if
end subroutine terminate_now_if_single_event
@ %def terminate_now_if_single_event
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Operating-system interface}
For specific purposes, we need direct access to the OS (system
calls). This is, of course, system dependent. The current version is
valid for GNU/Linux; we expect to use a preprocessor for this module
if different OSs are to be supported.
The current implementation lacks error handling.
<<[[os_interface.f90]]>>=
<<File header>>
module os_interface
use, intrinsic :: iso_c_binding !NODEP!
<<Use strings>>
use io_units
use diagnostics
use system_defs, only: DLERROR_LEN, ENVVAR_LEN
use system_dependencies
<<Use mpi f08>>
<<Standard module head>>
<<OS interface: public>>
<<OS interface: types>>
<<OS interface: interfaces>>
contains
<<OS interface: procedures>>
end module os_interface
@ %def os_interface
@
\subsection{Path variables}
This is a transparent container for storing user-defined path variables.
<<OS interface: public>>=
public :: paths_t
<<OS interface: types>>=
type :: paths_t
type(string_t) :: prefix
type(string_t) :: exec_prefix
type(string_t) :: bindir
type(string_t) :: libdir
type(string_t) :: includedir
type(string_t) :: datarootdir
type(string_t) :: localprefix
type(string_t) :: libtool
type(string_t) :: lhapdfdir
end type paths_t
@ %def paths_t
<<OS interface: public>>=
public :: paths_init
<<OS interface: procedures>>=
subroutine paths_init (paths)
type(paths_t), intent(out) :: paths
paths%prefix = ""
paths%exec_prefix = ""
paths%bindir = ""
paths%libdir = ""
paths%includedir = ""
paths%datarootdir = ""
paths%localprefix = ""
paths%libtool = ""
paths%lhapdfdir = ""
end subroutine paths_init
@ %def paths_init
@
\subsection{System dependencies}
We store all potentially system- and user/run-dependent data in a
transparent container. This includes compiler/linker names and flags,
file extensions, etc. There are actually two different possibilities
for extensions of shared libraries, depending on whether the Fortran
compiler or the system linker (usually the C compiler) has been used
for linking. The default for the Fortran compiler on most systems is
[[.so]].
<<OS interface: public>>=
public :: os_data_t
<<OS interface: types>>=
type :: os_data_t
logical :: use_libtool
logical :: use_testfiles
type(string_t) :: fc
type(string_t) :: fcflags
type(string_t) :: fcflags_pic
type(string_t) :: fc_src_ext
type(string_t) :: cc
type(string_t) :: cflags
type(string_t) :: cflags_pic
type(string_t) :: obj_ext
type(string_t) :: ld
type(string_t) :: ldflags
type(string_t) :: ldflags_so
type(string_t) :: ldflags_static
type(string_t) :: ldflags_hepmc
type(string_t) :: ldflags_lcio
type(string_t) :: ldflags_hoppet
type(string_t) :: ldflags_looptools
type(string_t) :: shrlib_ext
type(string_t) :: fc_shrlib_ext
+ type(string_t) :: pack_cmd
+ type(string_t) :: unpack_cmd
+ type(string_t) :: pack_ext
type(string_t) :: makeflags
type(string_t) :: prefix
type(string_t) :: exec_prefix
type(string_t) :: bindir
type(string_t) :: libdir
type(string_t) :: includedir
type(string_t) :: datarootdir
type(string_t) :: whizard_omega_binpath
type(string_t) :: whizard_includes
type(string_t) :: whizard_ldflags
type(string_t) :: whizard_libtool
type(string_t) :: whizard_modelpath
type(string_t) :: whizard_modelpath_ufo
type(string_t) :: whizard_models_libpath
type(string_t) :: whizard_susypath
type(string_t) :: whizard_gmlpath
type(string_t) :: whizard_cutspath
type(string_t) :: whizard_texpath
type(string_t) :: whizard_sharepath
type(string_t) :: whizard_testdatapath
type(string_t) :: whizard_modelpath_local
type(string_t) :: whizard_models_libpath_local
type(string_t) :: whizard_omega_binpath_local
type(string_t) :: whizard_circe2path
type(string_t) :: whizard_beamsimpath
type(string_t) :: whizard_mulipath
type(string_t) :: pdf_builtin_datapath
logical :: event_analysis = .false.
logical :: event_analysis_ps = .false.
logical :: event_analysis_pdf = .false.
type(string_t) :: latex
type(string_t) :: mpost
type(string_t) :: gml
type(string_t) :: dvips
type(string_t) :: ps2pdf
type(string_t) :: gosampath
type(string_t) :: golempath
type(string_t) :: formpath
type(string_t) :: qgrafpath
type(string_t) :: ninjapath
type(string_t) :: samuraipath
end type os_data_t
@ %def os_data_t
@ Since all are allocatable strings, explicit initialization is
necessary.
<<System defs: public parameters>>=
integer, parameter, public :: ENVVAR_LEN = 1000
@ %def ENVVAR_LEN
<<OS interface: public>>=
public :: os_data_init
<<OS interface: procedures>>=
subroutine os_data_init (os_data, paths)
type(os_data_t), intent(out) :: os_data
type(paths_t), intent(in), optional :: paths
character(len=ENVVAR_LEN) :: home
type(string_t) :: localprefix, local_includes
os_data%use_libtool = .true.
inquire (file = "TESTFLAG", exist = os_data%use_testfiles)
call get_environment_variable ("HOME", home)
if (present(paths)) then
if (paths%localprefix == "") then
localprefix = trim (home) // "/.whizard"
else
localprefix = paths%localprefix
end if
else
localprefix = trim (home) // "/.whizard"
end if
local_includes = localprefix // "/lib/whizard/mod/models"
os_data%whizard_modelpath_local = localprefix // "/share/whizard/models"
os_data%whizard_models_libpath_local = localprefix // "/lib/whizard/models"
os_data%whizard_omega_binpath_local = localprefix // "/bin"
os_data%fc = DEFAULT_FC
os_data%fcflags = DEFAULT_FCFLAGS
os_data%fcflags_pic = DEFAULT_FCFLAGS_PIC
os_data%fc_src_ext = DEFAULT_FC_SRC_EXT
os_data%cc = DEFAULT_CC
os_data%cflags = DEFAULT_CFLAGS
os_data%cflags_pic = DEFAULT_CFLAGS_PIC
os_data%obj_ext = DEFAULT_OBJ_EXT
os_data%ld = DEFAULT_LD
os_data%ldflags = DEFAULT_LDFLAGS
os_data%ldflags_so = DEFAULT_LDFLAGS_SO
os_data%ldflags_static = DEFAULT_LDFLAGS_STATIC
os_data%ldflags_hepmc = DEFAULT_LDFLAGS_HEPMC
os_data%ldflags_lcio = DEFAULT_LDFLAGS_LCIO
os_data%ldflags_hoppet = DEFAULT_LDFLAGS_HOPPET
os_data%ldflags_looptools = DEFAULT_LDFLAGS_LOOPTOOLS
os_data%shrlib_ext = DEFAULT_SHRLIB_EXT
os_data%fc_shrlib_ext = DEFAULT_FC_SHRLIB_EXT
+ os_data%pack_cmd = DEFAULT_PACK_CMD
+ os_data%unpack_cmd = DEFAULT_UNPACK_CMD
+ os_data%pack_ext = DEFAULT_PACK_EXT
os_data%makeflags = DEFAULT_MAKEFLAGS
os_data%prefix = PREFIX
os_data%exec_prefix = EXEC_PREFIX
os_data%bindir = BINDIR
os_data%libdir = LIBDIR
os_data%includedir = INCLUDEDIR
os_data%datarootdir = DATAROOTDIR
if (present (paths)) then
if (paths%prefix /= "") os_data%prefix = paths%prefix
if (paths%exec_prefix /= "") os_data%exec_prefix = paths%exec_prefix
if (paths%bindir /= "") os_data%bindir = paths%bindir
if (paths%libdir /= "") os_data%libdir = paths%libdir
if (paths%includedir /= "") os_data%includedir = paths%includedir
if (paths%datarootdir /= "") os_data%datarootdir = paths%datarootdir
end if
if (os_data%use_testfiles) then
os_data%whizard_omega_binpath = WHIZARD_TEST_OMEGA_BINPATH
os_data%whizard_includes = WHIZARD_TEST_INCLUDES
os_data%whizard_ldflags = WHIZARD_TEST_LDFLAGS
os_data%whizard_libtool = WHIZARD_LIBTOOL_TEST
os_data%whizard_modelpath = WHIZARD_TEST_MODELPATH
os_data%whizard_modelpath_ufo = WHIZARD_TEST_MODELPATH_UFO
os_data%whizard_models_libpath = WHIZARD_TEST_MODELS_LIBPATH
os_data%whizard_susypath = WHIZARD_TEST_SUSYPATH
os_data%whizard_gmlpath = WHIZARD_TEST_GMLPATH
os_data%whizard_cutspath = WHIZARD_TEST_CUTSPATH
os_data%whizard_texpath = WHIZARD_TEST_TEXPATH
os_data%whizard_sharepath = WHIZARD_TEST_SHAREPATH
os_data%whizard_testdatapath = WHIZARD_TEST_TESTDATAPATH
os_data%whizard_circe2path = WHIZARD_TEST_CIRCE2PATH
os_data%whizard_beamsimpath = WHIZARD_TEST_BEAMSIMPATH
os_data%whizard_mulipath = WHIZARD_TEST_MULIPATH
os_data%pdf_builtin_datapath = PDF_BUILTIN_TEST_DATAPATH
else
if (os_dir_exist (local_includes)) then
os_data%whizard_includes = "-I" // local_includes // " "// &
WHIZARD_INCLUDES
else
os_data%whizard_includes = WHIZARD_INCLUDES
end if
os_data%whizard_omega_binpath = WHIZARD_OMEGA_BINPATH
os_data%whizard_ldflags = WHIZARD_LDFLAGS
os_data%whizard_libtool = WHIZARD_LIBTOOL
if(present(paths)) then
if (paths%libtool /= "") os_data%whizard_libtool = paths%libtool
end if
os_data%whizard_modelpath = WHIZARD_MODELPATH
os_data%whizard_modelpath_ufo = WHIZARD_MODELPATH_UFO
os_data%whizard_models_libpath = WHIZARD_MODELS_LIBPATH
os_data%whizard_susypath = WHIZARD_SUSYPATH
os_data%whizard_gmlpath = WHIZARD_GMLPATH
os_data%whizard_cutspath = WHIZARD_CUTSPATH
os_data%whizard_texpath = WHIZARD_TEXPATH
os_data%whizard_sharepath = WHIZARD_SHAREPATH
os_data%whizard_testdatapath = WHIZARD_TESTDATAPATH
os_data%whizard_circe2path = WHIZARD_CIRCE2PATH
os_data%whizard_beamsimpath = WHIZARD_BEAMSIMPATH
os_data%whizard_mulipath = WHIZARD_MULIPATH
os_data%pdf_builtin_datapath = PDF_BUILTIN_DATAPATH
end if
os_data%event_analysis = EVENT_ANALYSIS == "yes"
os_data%event_analysis_ps = EVENT_ANALYSIS_PS == "yes"
os_data%event_analysis_pdf = EVENT_ANALYSIS_PDF == "yes"
os_data%latex = PRG_LATEX // " " // OPT_LATEX
os_data%mpost = PRG_MPOST // " " // OPT_MPOST
if (os_data%use_testfiles) then
os_data%gml = os_data%whizard_gmlpath // "/whizard-gml" // " " // &
OPT_MPOST // " " // "--gmldir " // os_data%whizard_gmlpath
else
os_data%gml = os_data%bindir // "/whizard-gml" // " " // OPT_MPOST &
// " " // "--gmldir " // os_data%whizard_gmlpath
end if
os_data%dvips = PRG_DVIPS
os_data%ps2pdf = PRG_PS2PDF
call os_data_expand_paths (os_data)
os_data%gosampath = GOSAM_DIR
os_data%golempath = GOLEM_DIR
os_data%formpath = FORM_DIR
os_data%qgrafpath = QGRAF_DIR
os_data%ninjapath = NINJA_DIR
os_data%samuraipath = SAMURAI_DIR
end subroutine os_data_init
@ %def os_data_init
@ Replace occurences of GNU path variables (such as [[${prefix}]]) by their
values. Do this for all strings that could depend on them, and do the
replacement in reverse order, since the path variables may be defined in terms
of each other. %% Fooling Noweb Emacs mode: $
<<OS interface: procedures>>=
subroutine os_data_expand_paths (os_data)
type(os_data_t), intent(inout) :: os_data
integer, parameter :: N_VARIABLES = 6
type(string_t), dimension(N_VARIABLES) :: variable, value
variable(1) = "${prefix}"; value(1) = os_data%prefix
variable(2) = "${exec_prefix}"; value(2) = os_data%exec_prefix
variable(3) = "${bindir}"; value(3) = os_data%bindir
variable(4) = "${libdir}"; value(4) = os_data%libdir
variable(5) = "${includedir}"; value(5) = os_data%includedir
variable(6) = "${datarootdir}"; value(6) = os_data%datarootdir
call expand_paths (os_data%whizard_omega_binpath)
call expand_paths (os_data%whizard_includes)
call expand_paths (os_data%whizard_ldflags)
call expand_paths (os_data%whizard_libtool)
call expand_paths (os_data%whizard_modelpath)
call expand_paths (os_data%whizard_modelpath_ufo)
call expand_paths (os_data%whizard_models_libpath)
call expand_paths (os_data%whizard_susypath)
call expand_paths (os_data%whizard_gmlpath)
call expand_paths (os_data%whizard_cutspath)
call expand_paths (os_data%whizard_texpath)
call expand_paths (os_data%whizard_sharepath)
call expand_paths (os_data%whizard_testdatapath)
call expand_paths (os_data%whizard_circe2path)
call expand_paths (os_data%whizard_beamsimpath)
call expand_paths (os_data%whizard_mulipath)
call expand_paths (os_data%whizard_models_libpath_local)
call expand_paths (os_data%whizard_modelpath_local)
call expand_paths (os_data%whizard_omega_binpath_local)
call expand_paths (os_data%pdf_builtin_datapath)
call expand_paths (os_data%latex)
call expand_paths (os_data%mpost)
call expand_paths (os_data%gml)
call expand_paths (os_data%dvips)
call expand_paths (os_data%ps2pdf)
contains
subroutine expand_paths (string)
type(string_t), intent(inout) :: string
integer :: i
do i = N_VARIABLES, 1, -1
string = replace (string, variable(i), value(i), every=.true.)
end do
end subroutine expand_paths
end subroutine os_data_expand_paths
@ %def os_data_update_paths
@ Write contents
<<OS interface: public>>=
public :: os_data_write
<<OS interface: procedures>>=
subroutine os_data_write (os_data, unit)
type(os_data_t), intent(in) :: os_data
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit); if (u < 0) return
write (u, "(A)") "OS data:"
write (u, *) "use_libtool = ", os_data%use_libtool
write (u, *) "use_testfiles = ", os_data%use_testfiles
write (u, *) "fc = ", char (os_data%fc)
write (u, *) "fcflags = ", char (os_data%fcflags)
write (u, *) "fcflags_pic = ", char (os_data%fcflags_pic)
write (u, *) "fc_src_ext = ", char (os_data%fc_src_ext)
write (u, *) "cc = ", char (os_data%cc)
write (u, *) "cflags = ", char (os_data%cflags)
write (u, *) "cflags_pic = ", char (os_data%cflags_pic)
write (u, *) "obj_ext = ", char (os_data%obj_ext)
write (u, *) "ld = ", char (os_data%ld)
write (u, *) "ldflags = ", char (os_data%ldflags)
write (u, *) "ldflags_so = ", char (os_data%ldflags_so)
write (u, *) "ldflags_static = ", char (os_data%ldflags_static)
write (u, *) "ldflags_hepmc = ", char (os_data%ldflags_hepmc)
write (u, *) "ldflags_lcio = ", char (os_data%ldflags_lcio)
write (u, *) "ldflags_hoppet = ", char (os_data%ldflags_hoppet)
write (u, *) "ldflags_looptools = ", char (os_data%ldflags_looptools)
write (u, *) "shrlib_ext = ", char (os_data%shrlib_ext)
write (u, *) "fc_shrlib_ext = ", char (os_data%fc_shrlib_ext)
write (u, *) "makeflags = ", char (os_data%makeflags)
write (u, *) "prefix = ", char (os_data%prefix)
write (u, *) "exec_prefix = ", char (os_data%exec_prefix)
write (u, *) "bindir = ", char (os_data%bindir)
write (u, *) "libdir = ", char (os_data%libdir)
write (u, *) "includedir = ", char (os_data%includedir)
write (u, *) "datarootdir = ", char (os_data%datarootdir)
write (u, *) "whizard_omega_binpath = ", &
char (os_data%whizard_omega_binpath)
write (u, *) "whizard_includes = ", char (os_data%whizard_includes)
write (u, *) "whizard_ldflags = ", char (os_data%whizard_ldflags)
write (u, *) "whizard_libtool = ", char (os_data%whizard_libtool)
write (u, *) "whizard_modelpath = ", &
char (os_data%whizard_modelpath)
write (u, *) "whizard_modelpath_ufo = ", &
char (os_data%whizard_modelpath_ufo)
write (u, *) "whizard_models_libpath = ", &
char (os_data%whizard_models_libpath)
write (u, *) "whizard_susypath = ", char (os_data%whizard_susypath)
write (u, *) "whizard_gmlpath = ", char (os_data%whizard_gmlpath)
write (u, *) "whizard_cutspath = ", char (os_data%whizard_cutspath)
write (u, *) "whizard_texpath = ", char (os_data%whizard_texpath)
write (u, *) "whizard_circe2path = ", char (os_data%whizard_circe2path)
write (u, *) "whizard_beamsimpath = ", char (os_data%whizard_beamsimpath)
write (u, *) "whizard_mulipath = ", char (os_data%whizard_mulipath)
write (u, *) "whizard_sharepath = ", &
char (os_data%whizard_sharepath)
write (u, *) "whizard_testdatapath = ", &
char (os_data%whizard_testdatapath)
write (u, *) "whizard_modelpath_local = ", &
char (os_data%whizard_modelpath_local)
write (u, *) "whizard_models_libpath_local = ", &
char (os_data%whizard_models_libpath_local)
write (u, *) "whizard_omega_binpath_local = ", &
char (os_data%whizard_omega_binpath_local)
write (u, *) "event_analysis = ", os_data%event_analysis
write (u, *) "event_analysis_ps = ", os_data%event_analysis_ps
write (u, *) "event_analysis_pdf = ", os_data%event_analysis_pdf
write (u, *) "latex = ", char (os_data%latex)
write (u, *) "mpost = ", char (os_data%mpost)
write (u, *) "gml = ", char (os_data%gml)
write (u, *) "dvips = ", char (os_data%dvips)
write (u, *) "ps2pdf = ", char (os_data%ps2pdf)
if (os_data%gosampath /= "") then
write (u, *) "gosam = ", char (os_data%gosampath)
write (u, *) "golem = ", char (os_data%golempath)
write (u, *) "form = ", char (os_data%formpath)
write (u, *) "qgraf = ", char (os_data%qgrafpath)
write (u, *) "ninja = ", char (os_data%ninjapath)
write (u, *) "samurai = ", char (os_data%samuraipath)
end if
end subroutine os_data_write
@ %def os_data_write
@
<<OS interface: public>>=
public :: os_data_build_latex_file
<<OS interface: procedures>>=
subroutine os_data_build_latex_file (os_data, filename, stat_out)
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in) :: filename
integer, intent(out), optional :: stat_out
type(string_t) :: setenv_tex, pipe, pipe_dvi
integer :: unit_dev, status
status = -1
if (os_data%event_analysis_ps) then
!!! Check if our OS has a /dev/null
unit_dev = free_unit ()
open (file = "/dev/null", unit = unit_dev, &
action = "write", iostat = status)
close (unit_dev)
if (status /= 0) then
pipe = ""
pipe_dvi = ""
else
pipe = " > /dev/null"
pipe_dvi = " 2>/dev/null 1>/dev/null"
end if
if (os_data%whizard_texpath /= "") then
setenv_tex = "TEXINPUTS=" // &
os_data%whizard_texpath // ":$TEXINPUTS "
else
setenv_tex = ""
end if
call os_system_call (setenv_tex // &
os_data%latex // " " // filename // ".tex " // pipe, &
verbose = .true., status = status)
call os_system_call (os_data%dvips // " -o " // filename // &
".ps " // filename // ".dvi" // pipe_dvi, verbose = .true., &
status = status)
call os_system_call (os_data%ps2pdf // " " // filename // ".ps", &
verbose = .true., status = status)
end if
if (present (stat_out)) stat_out = status
end subroutine os_data_build_latex_file
@ %def os_data_build_latex_file
@
\subsection{Dynamic linking}
We define a type that holds the filehandle for a dynamically linked
library (shared object), together with functions to open and close the
library, and to access functions in this library.
<<OS interface: public>>=
public :: dlaccess_t
<<OS interface: types>>=
type :: dlaccess_t
private
type(string_t) :: filename
type(c_ptr) :: handle = c_null_ptr
logical :: is_open = .false.
logical :: has_error = .false.
type(string_t) :: error
contains
<<OS interface: dlaccess: TBP>>
end type dlaccess_t
@ %def dlaccess_t
@ Output. This is called by the output routine for the process
library.
<<OS interface: dlaccess: TBP>>=
procedure :: write => dlaccess_write
<<OS interface: procedures>>=
subroutine dlaccess_write (object, unit)
class(dlaccess_t), intent(in) :: object
integer, intent(in) :: unit
write (unit, "(1x,A)") "DL access info:"
write (unit, "(3x,A,L1)") "is open = ", object%is_open
if (object%has_error) then
write (unit, "(3x,A,A,A)") "error = '", char (object%error), "'"
else
write (unit, "(3x,A)") "error = [none]"
end if
end subroutine dlaccess_write
@ %def dlaccess_write
@ The interface to the library functions:
<<OS interface: interfaces>>=
interface
function dlopen (filename, flag) result (handle) bind(C)
import
character(c_char), dimension(*) :: filename
integer(c_int), value :: flag
type(c_ptr) :: handle
end function dlopen
end interface
interface
function dlclose (handle) result (status) bind(C)
import
type(c_ptr), value :: handle
integer(c_int) :: status
end function dlclose
end interface
interface
function dlerror () result (str) bind(C)
import
type(c_ptr) :: str
end function dlerror
end interface
interface
function dlsym (handle, symbol) result (fptr) bind(C)
import
type(c_ptr), value :: handle
character(c_char), dimension(*) :: symbol
type(c_funptr) :: fptr
end function dlsym
end interface
@ %def dlopen dlclose dlsym
@ This reads an error string and transforms it into a [[string_t]]
object, if an error has occured. If not, set the error flag to false
and return an empty string.
<<System defs: public parameters>>=
integer, parameter, public :: DLERROR_LEN = 160
<<OS interface: procedures>>=
subroutine read_dlerror (has_error, error)
logical, intent(out) :: has_error
type(string_t), intent(out) :: error
type(c_ptr) :: err_cptr
character(len=DLERROR_LEN, kind=c_char), pointer :: err_fptr
integer :: str_end
err_cptr = dlerror ()
if (c_associated (err_cptr)) then
call c_f_pointer (err_cptr, err_fptr)
has_error = .true.
str_end = scan (err_fptr, c_null_char)
if (str_end > 0) then
error = err_fptr(1:str_end-1)
else
error = err_fptr
end if
else
has_error = .false.
error = ""
end if
end subroutine read_dlerror
@ %def read_dlerror
@ This is the Fortran API. Init/final open and close the file,
i.e., load and unload the library.
Note that a library can be opened more than once, and that for an
ultimate close as many [[dlclose]] calls as [[dlopen]] calls are
necessary. However, we assume that it is opened and closed only once.
<<OS interface: public>>=
public :: dlaccess_init
public :: dlaccess_final
<<OS interface: dlaccess: TBP>>=
procedure :: init => dlaccess_init
procedure :: final => dlaccess_final
<<OS interface: procedures>>=
subroutine dlaccess_init (dlaccess, prefix, libname, os_data)
class(dlaccess_t), intent(out) :: dlaccess
type(string_t), intent(in) :: prefix, libname
type(os_data_t), intent(in), optional :: os_data
type(string_t) :: filename
logical :: exist
dlaccess%filename = libname
filename = prefix // "/" // libname
inquire (file=char(filename), exist=exist)
if (.not. exist) then
filename = prefix // "/.libs/" // libname
inquire (file=char(filename), exist=exist)
if (.not. exist) then
dlaccess%has_error = .true.
dlaccess%error = "Library '" // filename // "' not found"
return
end if
end if
dlaccess%handle = dlopen (char (filename) // c_null_char, ior ( &
RTLD_LAZY, RTLD_LOCAL))
dlaccess%is_open = c_associated (dlaccess%handle)
call read_dlerror (dlaccess%has_error, dlaccess%error)
end subroutine dlaccess_init
subroutine dlaccess_final (dlaccess)
class(dlaccess_t), intent(inout) :: dlaccess
integer(c_int) :: status
if (dlaccess%is_open) then
status = dlclose (dlaccess%handle)
dlaccess%is_open = .false.
call read_dlerror (dlaccess%has_error, dlaccess%error)
end if
end subroutine dlaccess_final
@ %def dlaccess_init dlaccess_final
@ Return true if an error has occured.
<<OS interface: public>>=
public :: dlaccess_has_error
<<OS interface: procedures>>=
function dlaccess_has_error (dlaccess) result (flag)
logical :: flag
type(dlaccess_t), intent(in) :: dlaccess
flag = dlaccess%has_error
end function dlaccess_has_error
@ %def dlaccess_has_error
@ Return the error string currently stored in the [[dlaccess]] object.
<<OS interface: public>>=
public :: dlaccess_get_error
<<OS interface: procedures>>=
function dlaccess_get_error (dlaccess) result (error)
type(string_t) :: error
type(dlaccess_t), intent(in) :: dlaccess
error = dlaccess%error
end function dlaccess_get_error
@ %def dlaccess_get_error
@ The symbol handler returns the C address of the function with the
given string name. (It is a good idea to use [[bind(C)]] for all
functions accessed by this, such that the name string is
well-defined.) Call [[c_f_procpointer]] to cast this into a Fortran
procedure pointer with an appropriate interface.
<<OS interface: public>>=
public :: dlaccess_get_c_funptr
<<OS interface: procedures>>=
function dlaccess_get_c_funptr (dlaccess, fname) result (fptr)
type(c_funptr) :: fptr
type(dlaccess_t), intent(inout) :: dlaccess
type(string_t), intent(in) :: fname
fptr = dlsym (dlaccess%handle, char (fname) // c_null_char)
call read_dlerror (dlaccess%has_error, dlaccess%error)
end function dlaccess_get_c_funptr
@ %def dlaccess_get_c_funptr
@
\subsection{Predicates}
Return true if the library is loaded. In particular, this is false if
loading was unsuccessful.
<<OS interface: public>>=
public :: dlaccess_is_open
<<OS interface: procedures>>=
function dlaccess_is_open (dlaccess) result (flag)
logical :: flag
type(dlaccess_t), intent(in) :: dlaccess
flag = dlaccess%is_open
end function dlaccess_is_open
@ %def dlaccess_is_open
@
\subsection{Shell access}
This is the standard system call for executing a shell command, such
as invoking a compiler.
In F2008 there will be the equivalent built-in command
[[execute_command_line]].
<<OS interface: public>>=
public :: os_system_call
<<OS interface: procedures>>=
subroutine os_system_call (command_string, status, verbose)
type(string_t), intent(in) :: command_string
integer, intent(out), optional :: status
logical, intent(in), optional :: verbose
logical :: verb
integer :: stat
verb = .false.; if (present (verbose)) verb = verbose
if (verb) &
call msg_message ("command: " // char (command_string))
stat = system (char (command_string) // c_null_char)
if (present (status)) then
status = stat
else if (stat /= 0) then
if (.not. verb) &
call msg_message ("command: " // char (command_string))
write (msg_buffer, "(A,I0)") "Return code = ", stat
call msg_message ()
call msg_fatal ("System command returned with nonzero status code")
end if
end subroutine os_system_call
@ %def os_system_call
<<OS interface: interfaces>>=
interface
function system (command) result (status) bind(C)
import
integer(c_int) :: status
character(c_char), dimension(*) :: command
end function system
end interface
@ %def system
@
\subsection{Querying for a directory}
This queries for the existence of a directory. There is no standard way to
achieve this in FORTRAN, and if we were to call into [[libc]], we would need access
to C macros for evaluating the result, so we resort to calling [[test]] as a
system call.
<<OS interface: public>>=
public :: os_dir_exist
<<OS interface: procedures>>=
function os_dir_exist (name) result (res)
type(string_t), intent(in) :: name
logical :: res
integer :: status
call os_system_call ('test -d "' // name // '"', status=status)
res = status == 0
end function os_dir_exist
@ %def os_dir_exist
@
<<OS interface: public>>=
public :: os_file_exist
<<OS interface: procedures>>=
function os_file_exist (name) result (exist)
type(string_t), intent(in) :: name
! logical, intent(in), optional :: verb
logical :: exist
! integer :: status
! call os_system_call ('test -f "' // name // '"', status=status, verbose=verb)
! res = (status == 0)
inquire (file = char (name), exist=exist)
end function os_file_exist
@ %def os_file_exist
@
+\subsection{Pack/unpack}
+The argument to [[pack]] may be a file or a directory. The name of the packed
+file will get the [[pack_ext]] extension appended. The argument to [[unpack]]
+must be a file, with the extension already included in the file name.
+<<OS interface: public>>=
+ public :: os_pack_file
+ public :: os_unpack_file
+<<OS interface: procedures>>=
+ subroutine os_pack_file (file, os_data, status)
+ type(string_t), intent(in) :: file
+ type(os_data_t), intent(in) :: os_data
+ integer, intent(out), optional :: status
+ type(string_t) :: command_string
+ command_string = os_data%pack_cmd // " " &
+ // file // os_data%pack_ext // " " // file
+ call os_system_call (command_string, status)
+ end subroutine os_pack_file
+
+ subroutine os_unpack_file (file, os_data, status)
+ type(string_t), intent(in) :: file
+ type(os_data_t), intent(in) :: os_data
+ integer, intent(out), optional :: status
+ type(string_t) :: command_string
+ command_string = os_data%unpack_cmd // " " // file
+ call os_system_call (command_string, status)
+ end subroutine os_unpack_file
+
+@ %def os_pack_file
+@ %def os_unpack_file
+@
\subsection{Fortran compiler and linker}
Compile a single module for use in a shared library, but without
linking.
<<OS interface: public>>=
public :: os_compile_shared
<<OS interface: procedures>>=
subroutine os_compile_shared (src, os_data, status)
type(string_t), intent(in) :: src
type(os_data_t), intent(in) :: os_data
integer, intent(out), optional :: status
type(string_t) :: command_string
if (os_data%use_libtool) then
command_string = &
os_data%whizard_libtool // " --mode=compile " // &
os_data%fc // " " // &
"-c " // &
os_data%whizard_includes // " " // &
os_data%fcflags // " " // &
"'" // src // os_data%fc_src_ext // "'"
else
command_string = &
os_data%fc // " " // &
"-c " // &
os_data%fcflags_pic // " " // &
os_data%whizard_includes // " " // &
os_data%fcflags // " " // &
"'" // src // os_data%fc_src_ext // "'"
end if
call os_system_call (command_string, status)
end subroutine os_compile_shared
@ %def os_compile_shared
@ Link an array of object files to build a shared object library. In
the libtool case, we have to specify a [[-rpath]], otherwise only a
static library can be built. However, since the library is never
installed, this rpath is irrelevant.
<<OS interface: public>>=
public :: os_link_shared
<<OS interface: procedures>>=
subroutine os_link_shared (objlist, lib, os_data, status)
type(string_t), intent(in) :: objlist, lib
type(os_data_t), intent(in) :: os_data
integer, intent(out), optional :: status
type(string_t) :: command_string
if (os_data%use_libtool) then
command_string = &
os_data%whizard_libtool // " --mode=link " // &
os_data%fc // " " // &
"-module " // &
"-rpath /usr/local/lib" // " " // &
os_data%fcflags // " " // &
os_data%whizard_ldflags // " " // &
os_data%ldflags // " " // &
"-o '" // lib // ".la' " // &
objlist
else
command_string = &
os_data%ld // " " // &
os_data%ldflags_so // " " // &
os_data%fcflags // " " // &
os_data%whizard_ldflags // " " // &
os_data%ldflags // " " // &
"-o '" // lib // "." // os_data%fc_shrlib_ext // "' " // &
objlist
end if
call os_system_call (command_string, status)
end subroutine os_link_shared
@ %def os_link_shared
@ Link an array of object files / libraries to build a static executable.
<<OS interface: public>>=
public :: os_link_static
<<OS interface: procedures>>=
subroutine os_link_static (objlist, exec_name, os_data, status)
type(string_t), intent(in) :: objlist, exec_name
type(os_data_t), intent(in) :: os_data
integer, intent(out), optional :: status
type(string_t) :: command_string
if (os_data%use_libtool) then
command_string = &
os_data%whizard_libtool // " --mode=link " // &
os_data%fc // " " // &
"-static-libtool-libs " // &
os_data%fcflags // " " // &
os_data%whizard_ldflags // " " // &
os_data%ldflags // " " // &
os_data%ldflags_static // " " // &
"-o '" // exec_name // "' " // &
objlist // " " // &
os_data%ldflags_hepmc // " " // &
os_data%ldflags_lcio // " " // &
os_data%ldflags_hoppet // " " // &
os_data%ldflags_looptools
else
command_string = &
os_data%ld // " " // &
os_data%ldflags_so // " " // &
os_data%fcflags // " " // &
os_data%whizard_ldflags // " " // &
os_data%ldflags // " " // &
os_data%ldflags_static // " " // &
"-o '" // exec_name // "' " // &
objlist // " " // &
os_data%ldflags_hepmc // " " // &
os_data%ldflags_lcio // " " // &
os_data%ldflags_hoppet // " " // &
os_data%ldflags_looptools
end if
call os_system_call (command_string, status)
end subroutine os_link_static
@ %def os_link_static
@ Determine the name of the shared library to link. If libtool is
used, this is encoded in the [[.la]] file which resides in place of
the library itself.
<<OS interface: public>>=
public :: os_get_dlname
<<OS interface: procedures>>=
function os_get_dlname (lib, os_data, ignore, silent) result (dlname)
type(string_t) :: dlname
type(string_t), intent(in) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: ignore, silent
type(string_t) :: filename
type(string_t) :: buffer
logical :: exist, required, quiet
integer :: u
u = free_unit ()
if (present (ignore)) then
required = .not. ignore
else
required = .true.
end if
if (present (silent)) then
quiet = silent
else
quiet = .false.
end if
if (os_data%use_libtool) then
filename = lib // ".la"
inquire (file=char(filename), exist=exist)
if (exist) then
open (unit=u, file=char(filename), action="read", status="old")
SCAN_LTFILE: do
call get (u, buffer)
if (extract (buffer, 1, 7) == "dlname=") then
dlname = extract (buffer, 9)
dlname = remove (dlname, len (dlname))
exit SCAN_LTFILE
end if
end do SCAN_LTFILE
close (u)
else if (required) then
if (.not. quiet) call msg_fatal (" Library '" // char (lib) &
// "': libtool archive not found")
dlname = ""
else
if (.not. quiet) call msg_message ("[No compiled library '" &
// char (lib) // "']")
dlname = ""
end if
else
dlname = lib // "." // os_data%fc_shrlib_ext
inquire (file=char(dlname), exist=exist)
if (.not. exist) then
if (required) then
if (.not. quiet) call msg_fatal (" Library '" // char (lib) &
// "' not found")
else
if (.not. quiet) call msg_message &
("[No compiled process library '" // char (lib) // "']")
dlname = ""
end if
end if
end if
end function os_get_dlname
@ %def os_get_dlname
@
\subsection{Controlling OpenMP}
OpenMP is handled automatically by the library for the most part. Here
is a convenience routine for setting the number of threads, with some
diagnostics.
<<OS interface: public>>=
public :: openmp_set_num_threads_verbose
<<OS interface: procedures>>=
subroutine openmp_set_num_threads_verbose (num_threads, openmp_logging)
integer, intent(in) :: num_threads
integer :: n_threads
logical, intent(in), optional :: openmp_logging
logical :: logging
if (present (openmp_logging)) then
logging = openmp_logging
else
logging = .true.
end if
n_threads = num_threads
if (openmp_is_active ()) then
if (num_threads == 1) then
if (logging) then
write (msg_buffer, "(A,I0,A)") "OpenMP: Using ", num_threads, &
" thread"
call msg_message
end if
n_threads = num_threads
else if (num_threads > 1) then
if (logging) then
write (msg_buffer, "(A,I0,A)") "OpenMP: Using ", num_threads, &
" threads"
call msg_message
end if
n_threads = num_threads
else
if (logging) then
write (msg_buffer, "(A,I0,A)") "OpenMP: " &
// "Illegal value of openmp_num_threads (", num_threads, &
") ignored"
call msg_error
end if
n_threads = openmp_get_default_max_threads ()
if (logging) then
write (msg_buffer, "(A,I0,A)") "OpenMP: Using ", &
n_threads, " threads"
call msg_message
end if
end if
if (n_threads > openmp_get_default_max_threads ()) then
if (logging) then
write (msg_buffer, "(A,I0)") "OpenMP: " &
// "Number of threads is greater than library default of ", &
openmp_get_default_max_threads ()
call msg_warning
end if
end if
call openmp_set_num_threads (n_threads)
else if (num_threads /= 1) then
if (logging) then
write (msg_buffer, "(A,I0,A)") "openmp_num_threads set to ", &
num_threads, ", but OpenMP is not active: ignored"
call msg_warning
end if
end if
end subroutine openmp_set_num_threads_verbose
@ %def openmp_set_num_threads_verbose
@
\subsection{Controlling MPI}
The overall MPI handling has to be defined a context specific way,
but we can simplify things like logging or receiving [[n_size]] or [[rank]].
<<OS interface: public>>=
public :: mpi_set_logging
<<OS interface: procedures>>=
subroutine mpi_set_logging (mpi_logging)
logical, intent(in) :: mpi_logging
integer :: n_size, rank
call mpi_get_comm_id (n_size, rank)
if (mpi_logging .and. n_size > 1) then
write (msg_buffer, "(A,I0,A)") "MPI: Using ", n_size, " processes."
call msg_message ()
if (rank == 0) then
call msg_message ("MPI: master worker")
else
write (msg_buffer, "(A,I0)") "MPI: slave worker #", rank
call msg_message ()
end if
end if
end subroutine mpi_set_logging
@ %def mpi_set_logging
@ Receive communicator size and rank inside communicator. The subroutine is a stub, if not compiled with [[MPI]].
<<OS interface: public>>=
public :: mpi_get_comm_id
<<OS interface: procedures>>=
subroutine mpi_get_comm_id (n_size, rank)
integer, intent(out) :: n_size
integer, intent(out) :: rank
n_size = 1
rank = 0
<<OS interface: mpi get comm id>>
end subroutine mpi_get_comm_id
@ %def mpi_get_comm_id
<<OS interface: mpi get comm id>>=
@
<<MPI: OS interface: mpi get comm id>>=
call MPI_Comm_size (MPI_COMM_WORLD, n_size)
call MPI_Comm_rank (MPI_COMM_WORLD, rank)
@
<<OS interface: public>>=
public :: mpi_is_comm_master
<<OS interface: procedures>>=
logical function mpi_is_comm_master () result (flag)
integer :: n_size, rank
call mpi_get_comm_id (n_size, rank)
flag = (rank == 0)
end function mpi_is_comm_master
@ %def mpi_is_comm_master
+@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[os_interface_ut.f90]]>>=
<<File header>>
module os_interface_ut
use unit_tests
use os_interface_uti
<<Standard module head>>
<<OS interface: public test>>
contains
<<OS interface: test driver>>
end module os_interface_ut
@ %def os_interface_ut
@
<<[[os_interface_uti.f90]]>>=
<<File header>>
module os_interface_uti
use, intrinsic :: iso_c_binding !NODEP!
<<Use strings>>
use io_units
use os_interface
<<Standard module head>>
<<OS interface: test declarations>>
contains
<<OS interface: tests>>
end module os_interface_uti
@ %def os_interface_ut
@ API: driver for the unit tests below.
<<OS interface: public test>>=
public :: os_interface_test
<<OS interface: test driver>>=
subroutine os_interface_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<OS interface: execute tests>>
end subroutine os_interface_test
@ %def os_interface_test
@ Write a Fortran source file, compile it to a shared library, load
it, and execute the contained function.
<<OS interface: execute tests>>=
call test (os_interface_1, "os_interface_1", &
"check OS interface routines", &
u, results)
<<OS interface: test declarations>>=
public :: os_interface_1
<<OS interface: tests>>=
subroutine os_interface_1 (u)
integer, intent(in) :: u
type(dlaccess_t) :: dlaccess
type(string_t) :: fname, libname, ext
type(os_data_t) :: os_data
type(string_t) :: filename_src, filename_obj
abstract interface
function so_test_proc (i) result (j) bind(C)
import c_int
integer(c_int), intent(in) :: i
integer(c_int) :: j
end function so_test_proc
end interface
procedure(so_test_proc), pointer :: so_test => null ()
type(c_funptr) :: c_fptr
integer :: unit
integer(c_int) :: i
call os_data_init (os_data)
fname = "so_test"
filename_src = fname // os_data%fc_src_ext
if (os_data%use_libtool) then
ext = ".lo"
else
ext = os_data%obj_ext
end if
filename_obj = fname // ext
libname = fname // '.' // os_data%fc_shrlib_ext
write (u, "(A)") "* Test output: OS interface"
write (u, "(A)") "* Purpose: check os_interface routines"
write (u, "(A)")
write (u, "(A)") "* write source file 'so_test.f90'"
write (u, "(A)")
unit = free_unit ()
open (unit=unit, file=char(filename_src), action="write")
write (unit, "(A)") "function so_test (i) result (j) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " integer(c_int) :: j"
write (unit, "(A)") " j = 2 * i"
write (unit, "(A)") "end function so_test"
close (unit)
write (u, "(A)") "* compile and link as 'so_test.so/dylib'"
write (u, "(A)")
call os_compile_shared (fname, os_data)
call os_link_shared (filename_obj, fname, os_data)
write (u, "(A)") "* load library 'so_test.so/dylib'"
write (u, "(A)")
call dlaccess_init (dlaccess, var_str ("."), libname, os_data)
if (dlaccess_is_open (dlaccess)) then
write (u, "(A)") " success"
else
write (u, "(A)") " failure"
end if
write (u, "(A)") "* load symbol 'so_test'"
write (u, "(A)")
c_fptr = dlaccess_get_c_funptr (dlaccess, fname)
if (c_associated (c_fptr)) then
write (u, "(A)") " success"
else
write (u, "(A)") " failure"
end if
call c_f_procpointer (c_fptr, so_test)
write (u, "(A)") "* Execute function from 'so_test.so/dylib'"
i = 7
write (u, "(A,1x,I1)") " input = ", i
write (u, "(A,1x,I1)") " result = ", so_test(i)
if (so_test(i) / i .ne. 2) then
write (u, "(A)") "* Compiling and linking ISO C functions failed."
else
write (u, "(A)") "* Successful."
end if
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call dlaccess_final (dlaccess)
end subroutine os_interface_1
@ %def os_interface_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Interface for formatted I/O}
For access to formatted printing (possibly input), we interface the C
[[printf]] family of functions. There are two important issues here:
\begin{enumerate}
\item
[[printf]] takes an arbitrary number of arguments, relying on the C stack.
This is not interoperable. We interface it with C wrappers that output a
single integer, real or string and restrict the allowed formats accordingly.
\item
Restricting format strings is essential also for preventing format string
attacks. Allowing arbitrary format string would create a real security hole
in a Fortran program.
\item
The string returned by [[sprintf]] must be allocated to the right size.
\end{enumerate}
<<[[formats.f90]]>>=
<<File header>>
module formats
use, intrinsic :: iso_c_binding
<<Use kinds>>
<<Use strings>>
use io_units
use diagnostics
<<Standard module head>>
<<Formats: public>>
<<Formats: parameters>>
<<Formats: types>>
<<Formats: interfaces>>
contains
<<Formats: procedures>>
end module formats
@ %def formats
@
\subsection{Parsing a C format string}
The C format string contains characters and format conversion specifications.
The latter are initiated by a [[%]] sign. If the next letter is also a [[%]],
a percent sign is printed and no conversion is done. Otherwise, a conversion
is done and applied to the next argument in the argument list. First comes an
optional flag ([[#]], [[0]], [[-]], [[+]], or space), an optional field width
(decimal digits starting not with zero), an optional precision (period, then
another decimal digit string), a length modifier (irrelevant for us, therefore
not supported), and a conversion specifier: [[d]] or [[i]] for integer; [[e]],
[[f]], [[g]] (also upper case) for double-precision real, [[s]] for a string.
We explicitly exclude all other conversion specifiers, and we check the
specifiers against the actual arguments.
\subsubsection{A type for passing arguments}
This is a polymorphic type that can hold integer, real (double), and string
arguments.
<<Formats: parameters>>=
integer, parameter, public :: ARGTYPE_NONE = 0
integer, parameter, public :: ARGTYPE_LOG = 1
integer, parameter, public :: ARGTYPE_INT = 2
integer, parameter, public :: ARGTYPE_REAL = 3
integer, parameter, public :: ARGTYPE_STR = 4
@ %def ARGTYPE_NONE ARGTYPE_LOG ARGTYPE_INT ARGTYPE_REAL ARGTYPE_STRING
@ The integer and real entries are actually scalars, but we avoid relying on
the allocatable-scalar feature and make them one-entry arrays. The character
entry is a real array which is a copy of the string.
Logical values are mapped to strings (true or false), so this type parameter
value is mostly unused.
<<Formats: public>>=
public :: sprintf_arg_t
<<Formats: types>>=
type :: sprintf_arg_t
private
integer :: type = ARGTYPE_NONE
integer(c_int), dimension(:), allocatable :: ival
real(c_double), dimension(:), allocatable :: rval
character(c_char), dimension(:), allocatable :: sval
end type sprintf_arg_t
@ %def sprintf_arg_t
<<Formats: public>>=
public :: sprintf_arg_init
<<Formats: interfaces>>=
interface sprintf_arg_init
module procedure sprintf_arg_init_log
module procedure sprintf_arg_init_int
module procedure sprintf_arg_init_real
module procedure sprintf_arg_init_str
end interface
<<Formats: procedures>>=
subroutine sprintf_arg_init_log (arg, lval)
type(sprintf_arg_t), intent(out) :: arg
logical, intent(in) :: lval
arg%type = ARGTYPE_STR
if (lval) then
allocate (arg%sval (5))
arg%sval = ['t', 'r', 'u', 'e', c_null_char]
else
allocate (arg%sval (6))
arg%sval = ['f', 'a', 'l', 's', 'e', c_null_char]
end if
end subroutine sprintf_arg_init_log
subroutine sprintf_arg_init_int (arg, ival)
type(sprintf_arg_t), intent(out) :: arg
integer, intent(in) :: ival
arg%type = ARGTYPE_INT
allocate (arg%ival (1))
arg%ival = ival
end subroutine sprintf_arg_init_int
subroutine sprintf_arg_init_real (arg, rval)
type(sprintf_arg_t), intent(out) :: arg
real(default), intent(in) :: rval
arg%type = ARGTYPE_REAL
allocate (arg%rval (1))
arg%rval = rval
end subroutine sprintf_arg_init_real
subroutine sprintf_arg_init_str (arg, sval)
type(sprintf_arg_t), intent(out) :: arg
type(string_t), intent(in) :: sval
integer :: i
arg%type = ARGTYPE_STR
allocate (arg%sval (len (sval) + 1))
do i = 1, len (sval)
arg%sval(i) = extract (sval, i, i)
end do
arg%sval(len (sval) + 1) = c_null_char
end subroutine sprintf_arg_init_str
@ %def sprintf_arg_init
<<Formats: procedures>>=
subroutine sprintf_arg_write (arg, unit)
type(sprintf_arg_t), intent(in) :: arg
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
select case (arg%type)
case (ARGTYPE_NONE)
write (u, *) "[none]"
case (ARGTYPE_INT)
write (u, "(1x,A,1x)", advance = "no") "[int]"
write (u, *) arg%ival
case (ARGTYPE_REAL)
write (u, "(1x,A,1x)", advance = "no") "[real]"
write (u, *) arg%rval
case (ARGTYPE_STR)
write (u, "(1x,A,1x,A)", advance = "no") "[string]", '"'
write (u, *) arg%rval, '"'
end select
end subroutine sprintf_arg_write
@ %def sprintf_arg_write
@ Return an upper bound for the length of the printed version; in case of
strings the result is exact.
<<Formats: procedures>>=
elemental function sprintf_arg_get_length (arg) result (length)
integer :: length
type(sprintf_arg_t), intent(in) :: arg
select case (arg%type)
case (ARGTYPE_INT)
length = log10 (real (huge (arg%ival(1)))) + 2
case (ARGTYPE_REAL)
length = log10 (real (radix (arg%rval(1))) ** digits (arg%rval(1))) + 8
case (ARGTYPE_STR)
length = size (arg%sval)
case default
length = 0
end select
end function sprintf_arg_get_length
@ %def sprintf_arg_get_length
<<Formats: procedures>>=
subroutine sprintf_arg_apply_sprintf (arg, fmt, result, actual_length)
type(sprintf_arg_t), intent(in) :: arg
character(c_char), dimension(:), intent(in) :: fmt
character(c_char), dimension(:), intent(inout) :: result
integer, intent(out) :: actual_length
integer(c_int) :: ival
real(c_double) :: rval
select case (arg%type)
case (ARGTYPE_NONE)
actual_length = sprintf_none (result, fmt)
case (ARGTYPE_INT)
ival = arg%ival(1)
actual_length = sprintf_int (result, fmt, ival)
case (ARGTYPE_REAL)
rval = arg%rval(1)
actual_length = sprintf_double (result, fmt, rval)
case (ARGTYPE_STR)
actual_length = sprintf_str (result, fmt, arg%sval)
case default
call msg_bug ("sprintf_arg_apply_sprintf called with illegal type")
end select
if (actual_length < 0) then
write (msg_buffer, *) "Format: '", fmt, "'"
call msg_message ()
write (msg_buffer, *) "Output: '", result, "'"
call msg_message ()
call msg_error ("I/O error in sprintf call")
actual_length = 0
end if
end subroutine sprintf_arg_apply_sprintf
@ %def sprintf_arg_apply_sprintf
@
\subsubsection{Container type for the output}
There is a procedure which chops the format string into pieces that contain at
most one conversion specifier. Pairing this with a [[sprintf_arg]] object, we
get the actual input to the [[sprintf]] interface. The type below holds this
input and can allocate the output string.
<<Formats: types>>=
type :: sprintf_interface_t
private
character(c_char), dimension(:), allocatable :: input_fmt
type(sprintf_arg_t) :: arg
character(c_char), dimension(:), allocatable :: output_str
integer :: output_str_len = 0
end type sprintf_interface_t
@ %def sprintf_fmt_t
<<Formats: procedures>>=
subroutine sprintf_interface_init (intf, fmt, arg)
type(sprintf_interface_t), intent(out) :: intf
type(string_t), intent(in) :: fmt
type(sprintf_arg_t), intent(in) :: arg
integer :: fmt_len, i
fmt_len = len (fmt)
allocate (intf%input_fmt (fmt_len + 1))
do i = 1, fmt_len
intf%input_fmt(i) = extract (fmt, i, i)
end do
intf%input_fmt(fmt_len+1) = c_null_char
intf%arg = arg
allocate (intf%output_str (len (fmt) + sprintf_arg_get_length (arg) + 1))
end subroutine sprintf_interface_init
@ %def sprintf_interface_init
<<Formats: procedures>>=
subroutine sprintf_interface_write (intf, unit)
type(sprintf_interface_t), intent(in) :: intf
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, *) "Format string = ", '"', intf%input_fmt, '"'
write (u, "(1x,A,1x)", advance = "no") "Argument = "
call sprintf_arg_write (intf%arg, unit)
if (intf%output_str_len > 0) then
write (u, *) "Result string = ", &
'"', intf%output_str (1:intf%output_str_len), '"'
end if
end subroutine sprintf_interface_write
@ %def sprintf_interface_write
@ Return the output string:
<<Formats: procedures>>=
function sprintf_interface_get_result (intf) result (string)
type(string_t) :: string
type(sprintf_interface_t), intent(in) :: intf
character(kind = c_char, len = max (intf%output_str_len, 0)) :: buffer
integer :: i
if (intf%output_str_len > 0) then
do i = 1, intf%output_str_len
buffer(i:i) = intf%output_str(i)
end do
string = buffer(1:intf%output_str_len)
else
string = ""
end if
end function sprintf_interface_get_result
@ %def sprintf_interface_get_result
<<Formats: procedures>>=
subroutine sprintf_interface_apply_sprintf (intf)
type(sprintf_interface_t), intent(inout) :: intf
call sprintf_arg_apply_sprintf &
(intf%arg, intf%input_fmt, intf%output_str, intf%output_str_len)
end subroutine sprintf_interface_apply_sprintf
@ %def sprintf_interface_apply_sprintf
@ Import the interfaces defined in the previous section:
<<Formats: interfaces>>=
<<sprintf interfaces>>
@
\subsubsection{Scan the format string}
Chop it into pieces that contain one conversion
specifier each. The zero-th piece contains the part before the first
specifier. Check the specifiers and allow only the subset that we support.
Also check for an exact match between conversion specifiers and input
arguments. The result is an allocated array of [[sprintf_interface]] object;
each one contains a piece of the format string and the corresponding
argument.
<<Formats: procedures>>=
subroutine chop_and_check_format_string (fmt, arg, intf)
type(string_t), intent(in) :: fmt
type(sprintf_arg_t), dimension(:), intent(in) :: arg
type(sprintf_interface_t), dimension(:), intent(out), allocatable :: intf
integer :: n_args, i
type(string_t), dimension(:), allocatable :: split_fmt
type(string_t) :: word, buffer, separator
integer :: pos, length, l
logical :: ok
type(sprintf_arg_t) :: arg_null
ok = .true.
length = 0
n_args = size (arg)
allocate (split_fmt (0:n_args))
split_fmt = ""
buffer = fmt
SCAN_ARGS: do i = 1, n_args
FIND_CONVERSION: do
call split (buffer, word, "%", separator=separator)
if (separator == "") then
call msg_message ('"' // char (fmt) // '"')
call msg_error ("C-formatting string: " &
// "too few conversion specifiers in format string")
ok = .false.; exit SCAN_ARGS
end if
split_fmt(i-1) = split_fmt(i-1) // word
if (extract (buffer, 1, 1) /= "%") then
split_fmt(i) = "%"
exit FIND_CONVERSION
else
split_fmt(i-1) = split_fmt(i-1) // "%"
end if
end do FIND_CONVERSION
pos = verify (buffer, "#0-+ ") ! Flag characters (zero or more)
split_fmt(i) = split_fmt(i) // extract (buffer, 1, pos-1)
buffer = remove (buffer, 1, pos-1)
pos = verify (buffer, "123456890") ! Field width
word = extract (buffer, 1, pos-1)
if (len (word) /= 0) then
call read_int_from_string (word, len (word), l)
length = length + l
end if
split_fmt(i) = split_fmt(i) // word
buffer = remove (buffer, 1, pos-1)
if (extract (buffer, 1, 1) == ".") then
buffer = remove (buffer, 1, 1)
pos = verify (buffer, "1234567890") ! Precision
split_fmt(i) = split_fmt(i) // "." // extract (buffer, 1, pos-1)
buffer = remove (buffer, 1, pos-1)
end if
! Length modifier would come here, but is not allowed
select case (char (extract (buffer, 1, 1))) ! conversion specifier
case ("d", "i")
if (arg(i)%type /= ARGTYPE_INT) then
call msg_message ('"' // char (fmt) // '"')
call msg_error ("C-formatting string: " &
// "argument type mismatch: integer value expected")
ok = .false.; exit SCAN_ARGS
end if
case ("e", "E", "f", "F", "g", "G")
if (arg(i)%type /= ARGTYPE_REAL) then
call msg_message ('"' // char (fmt) // '"')
call msg_error ("C-formatting string: " &
// "argument type mismatch: real value expected")
ok = .false.; exit SCAN_ARGS
end if
case ("s")
if (arg(i)%type /= ARGTYPE_STR) then
call msg_message ('"' // char (fmt) // '"')
call msg_error ("C-formatting string: " &
// "argument type mismatch: logical or string value expected")
ok = .false.; exit SCAN_ARGS
end if
case default
call msg_message ('"' // char (fmt) // '"')
call msg_error ("C-formatting string: " &
// "illegal or incomprehensible conversion specifier")
ok = .false.; exit SCAN_ARGS
end select
split_fmt(i) = split_fmt(i) // extract (buffer, 1, 1)
buffer = remove (buffer, 1, 1)
end do SCAN_ARGS
if (ok) then
FIND_EXTRA_CONVERSION: do
call split (buffer, word, "%", separator=separator)
split_fmt(n_args) = split_fmt(n_args) // word // separator
if (separator == "") exit FIND_EXTRA_CONVERSION
if (extract (buffer, 1, 1) == "%") then
split_fmt(n_args) = split_fmt(n_args) // "%"
buffer = remove (buffer, 1, 1)
else
call msg_message ('"' // char (fmt) // '"')
call msg_error ("C-formatting string: " &
// "too many conversion specifiers in format string")
ok = .false.; exit FIND_EXTRA_CONVERSION
end if
end do FIND_EXTRA_CONVERSION
split_fmt(n_args) = split_fmt(n_args) // buffer
allocate (intf (0:n_args))
call sprintf_interface_init (intf(0), split_fmt(0), arg_null)
do i = 1, n_args
call sprintf_interface_init (intf(i), split_fmt(i), arg(i))
end do
else
allocate (intf (0))
end if
contains
subroutine read_int_from_string (word, length, l)
type(string_t), intent(in) :: word
integer, intent(in) :: length
integer, intent(out) :: l
character(len=length) :: buffer
buffer = word
read (buffer, *) l
end subroutine read_int_from_string
end subroutine chop_and_check_format_string
@ %def chop_and_check_format_string
@
\subsection{API}
<<Formats: public>>=
public :: sprintf
<<Formats: procedures>>=
function sprintf (fmt, arg) result (string)
type(string_t) :: string
type(string_t), intent(in) :: fmt
type(sprintf_arg_t), dimension(:), intent(in) :: arg
type(sprintf_interface_t), dimension(:), allocatable :: intf
integer :: i
string = ""
call chop_and_check_format_string (fmt, arg, intf)
if (size (intf) > 0) then
do i = 0, ubound (intf, 1)
call sprintf_interface_apply_sprintf (intf(i))
string = string // sprintf_interface_get_result (intf(i))
end do
end if
end function sprintf
@ %def sprintf
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[formats_ut.f90]]>>=
<<File header>>
module formats_ut
use unit_tests
use formats_uti
<<Standard module head>>
<<Formats: public test>>
contains
<<Formats: test driver>>
end module formats_ut
@ %def formats_ut
@
<<[[formats_uti.f90]]>>=
<<File header>>
module formats_uti
<<Use kinds>>
<<Use strings>>
use formats
<<Standard module head>>
<<Formats: test declarations>>
<<Formats: test types>>
contains
<<Formats: tests>>
end module formats_uti
@ %def formats_ut
@ API: driver for the unit tests below.
<<Formats: public test>>=
public :: format_test
<<Formats: test driver>>=
subroutine format_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Formats: execute tests>>
end subroutine format_test
@ %def format_test
<<Formats: execute tests>>=
call test (format_1, "format_1", &
"check formatting routines", &
u, results)
<<Formats: test declarations>>=
public :: format_1
<<Formats: tests>>=
subroutine format_1 (u)
integer, intent(in) :: u
write (u, "(A)") "*** Test 1: a string ***"
write (u, "(A)")
call test_run (var_str("%s"), 1, [4], ['abcdefghij'], u)
write (u, "(A)") "*** Test 2: two integers ***"
write (u, "(A)")
call test_run (var_str("%d,%d"), 2, [2, 2], ['42', '13'], u)
write (u, "(A)") "*** Test 3: floating point number ***"
write (u, "(A)")
call test_run (var_str("%8.4f"), 1, [3], ['42567.12345'], u)
write (u, "(A)") "*** Test 4: general expression ***"
call test_run (var_str("%g"), 1, [3], ['3.1415'], u)
contains
subroutine test_run (fmt, n_args, type, buffer, unit)
type(string_t), intent(in) :: fmt
integer, intent(in) :: n_args, unit
logical :: lval
integer :: ival
real(default) :: rval
integer :: i
type(string_t) :: string
type(sprintf_arg_t), dimension(:), allocatable :: arg
integer, dimension(n_args), intent(in) :: type
character(*), dimension(n_args), intent(in) :: buffer
write (unit, "(A,A)") "Format string :", char(fmt)
write (unit, "(A,I1)") "Number of args:", n_args
allocate (arg (n_args))
do i = 1, n_args
write (unit, "(A,I1)") "Argument (type ) = ", type(i)
select case (type(i))
case (ARGTYPE_LOG)
read (buffer(i), *) lval
call sprintf_arg_init (arg(i), lval)
case (ARGTYPE_INT)
read (buffer(i), *) ival
call sprintf_arg_init (arg(i), ival)
case (ARGTYPE_REAL)
read (buffer(i), *) rval
call sprintf_arg_init (arg(i), rval)
case (ARGTYPE_STR)
call sprintf_arg_init (arg(i), var_str (trim (buffer(i))))
end select
end do
string = sprintf (fmt, arg)
write (unit, "(A,A,A)") "Result: '", char (string), "'"
deallocate (arg)
end subroutine test_run
end subroutine format_1
@ %def format_1
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{CPU timing}
The time is stored in a simple derived type which just holds a
floating-point number.
<<[[cputime.f90]]>>=
<<File header>>
module cputime
<<Use kinds>>
use io_units
<<Use strings>>
use diagnostics
<<Standard module head>>
<<CPU time: public>>
<<CPU time: types>>
<<CPU time: interfaces>>
contains
<<CPU time: procedures>>
end module cputime
@ %def cputime
@ The CPU time is a floating-point number with an arbitrary reference time.
It is single precision (default real, not [[real(default)]]).
It is measured in seconds.
<<CPU time: public>>=
public :: time_t
<<CPU time: types>>=
type :: time_t
private
logical :: known = .false.
real :: value = 0
contains
<<CPU time: time: TBP>>
end type time_t
@ %def time_t
<<CPU time: time: TBP>>=
procedure :: write => time_write
<<CPU time: procedures>>=
subroutine time_write (object, unit)
class(time_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)", advance="no") "Time in seconds ="
if (object%known) then
write (u, "(1x,ES10.3)") object%value
else
write (u, "(1x,A)") "[unknown]"
end if
end subroutine time_write
@ %def time_write
@ Set the current time
<<CPU time: time: TBP>>=
procedure :: set_current => time_set_current
<<CPU time: procedures>>=
subroutine time_set_current (time)
class(time_t), intent(out) :: time
integer :: msecs
call system_clock (msecs)
time%value = real (msecs) / 1000.
time%known = time%value > 0
end subroutine time_set_current
@ %def time_set_current
@ Assign to a [[real(default]] value. If the time is undefined, return zero.
<<CPU time: public>>=
public :: assignment(=)
<<CPU time: interfaces>>=
interface assignment(=)
module procedure real_assign_time
module procedure real_default_assign_time
end interface
<<CPU time: procedures>>=
pure subroutine real_assign_time (r, time)
real, intent(out) :: r
class(time_t), intent(in) :: time
if (time%known) then
r = time%value
else
r = 0
end if
end subroutine real_assign_time
pure subroutine real_default_assign_time (r, time)
real(default), intent(out) :: r
class(time_t), intent(in) :: time
if (time%known) then
r = time%value
else
r = 0
end if
end subroutine real_default_assign_time
@ %def real_assign_time
@ Assign an integer or (single precision) real value to the time object.
<<CPU time: time: TBP>>=
generic :: assignment(=) => time_assign_from_integer, time_assign_from_real
procedure, private :: time_assign_from_integer
procedure, private :: time_assign_from_real
<<CPU time: procedures>>=
subroutine time_assign_from_integer (time, ival)
class(time_t), intent(out) :: time
integer, intent(in) :: ival
time%value = ival
time%known = .true.
end subroutine time_assign_from_integer
subroutine time_assign_from_real (time, rval)
class(time_t), intent(out) :: time
real, intent(in) :: rval
time%value = rval
time%known = .true.
end subroutine time_assign_from_real
@ %def time_assign_from_real
@ Add times and compute time differences. If any input value is undefined,
the result is undefined.
<<CPU time: time: TBP>>=
generic :: operator(-) => subtract_times
generic :: operator(+) => add_times
procedure, private :: subtract_times
procedure, private :: add_times
<<CPU time: procedures>>=
pure function subtract_times (t_end, t_begin) result (time)
type(time_t) :: time
class(time_t), intent(in) :: t_end, t_begin
if (t_end%known .and. t_begin%known) then
time%known = .true.
time%value = t_end%value - t_begin%value
end if
end function subtract_times
pure function add_times (t1, t2) result (time)
type(time_t) :: time
class(time_t), intent(in) :: t1, t2
if (t1%known .and. t2%known) then
time%known = .true.
time%value = t1%value + t2%value
end if
end function add_times
@ %def subtract_times
@ %def add_times
@ Check if a time is known, so we can use it:
<<CPU time: time: TBP>>=
procedure :: is_known => time_is_known
<<CPU time: procedures>>=
function time_is_known (time) result (flag)
class(time_t), intent(in) :: time
logical :: flag
flag = time%known
end function time_is_known
@ %def time_is_known
@ We define functions for converting the time into ss / mm:ss / hh:mm:ss
/ dd:mm:hh:ss.
<<CPU time: time: TBP>>=
generic :: expand => time_expand_s, time_expand_ms, &
time_expand_hms, time_expand_dhms
procedure, private :: time_expand_s
procedure, private :: time_expand_ms
procedure, private :: time_expand_hms
procedure, private :: time_expand_dhms
<<CPU time: procedures>>=
subroutine time_expand_s (time, sec)
class(time_t), intent(in) :: time
integer, intent(out) :: sec
if (time%known) then
sec = time%value
else
call msg_bug ("Time: attempt to expand undefined value")
end if
end subroutine time_expand_s
subroutine time_expand_ms (time, min, sec)
class(time_t), intent(in) :: time
integer, intent(out) :: min, sec
if (time%known) then
if (time%value >= 0) then
sec = mod (int (time%value), 60)
else
sec = - mod (int (- time%value), 60)
end if
min = time%value / 60
else
call msg_bug ("Time: attempt to expand undefined value")
end if
end subroutine time_expand_ms
subroutine time_expand_hms (time, hour, min, sec)
class(time_t), intent(in) :: time
integer, intent(out) :: hour, min, sec
call time%expand (min, sec)
hour = min / 60
if (min >= 0) then
min = mod (min, 60)
else
min = - mod (-min, 60)
end if
end subroutine time_expand_hms
subroutine time_expand_dhms (time, day, hour, min, sec)
class(time_t), intent(in) :: time
integer, intent(out) :: day, hour, min, sec
call time%expand (hour, min, sec)
day = hour / 24
if (hour >= 0) then
hour = mod (hour, 24)
else
hour = - mod (- hour, 24)
end if
end subroutine time_expand_dhms
@ %def time_expand
@ Use the above expansions to generate a time string.
<<CPU time: time: TBP>>=
procedure :: to_string_s => time_to_string_s
procedure :: to_string_ms => time_to_string_ms
procedure :: to_string_hms => time_to_string_hms
procedure :: to_string_dhms => time_to_string_dhms
<<CPU time: procedures>>=
function time_to_string_s (time) result (str)
class(time_t), intent(in) :: time
type(string_t) :: str
character(256) :: buffer
integer :: s
call time%expand (s)
write (buffer, "(I0,'s')") s
str = trim (buffer)
end function time_to_string_s
function time_to_string_ms (time, blank) result (str)
class(time_t), intent(in) :: time
logical, intent(in), optional :: blank
type(string_t) :: str
character(256) :: buffer
integer :: s, m
logical :: x_out
x_out = .false.
if (present (blank)) x_out = blank
call time%expand (m, s)
write (buffer, "(I0,'m:',I2.2,'s')") m, abs (s)
str = trim (buffer)
if (x_out) then
str = replace (str, len(str)-1, "X")
end if
end function time_to_string_ms
function time_to_string_hms (time) result (str)
class(time_t), intent(in) :: time
type(string_t) :: str
character(256) :: buffer
integer :: s, m, h
call time%expand (h, m, s)
write (buffer, "(I0,'h:',I2.2,'m:',I2.2,'s')") h, abs (m), abs (s)
str = trim (buffer)
end function time_to_string_hms
function time_to_string_dhms (time) result (str)
class(time_t), intent(in) :: time
type(string_t) :: str
character(256) :: buffer
integer :: s, m, h, d
call time%expand (d, h, m, s)
write (buffer, "(I0,'d:',I2.2,'h:',I2.2,'m:',I2.2,'s')") &
d, abs (h), abs (m), abs (s)
str = trim (buffer)
end function time_to_string_dhms
@ %def time_to_string
@
\subsection{Timer}
A timer can measure real (wallclock) time differences. The base type
corresponds to the result, i.e., time difference. The object contains
two further times for start and stop time.
<<CPU time: public>>=
public :: timer_t
<<CPU time: types>>=
type, extends (time_t) :: timer_t
private
logical :: running = .false.
type(time_t) :: t1, t2
contains
<<CPU time: timer: TBP>>
end type timer_t
@ %def timer_t
@ Output. If the timer is running, we indicate this, otherwise write
just the result.
<<CPU time: timer: TBP>>=
procedure :: write => timer_write
<<CPU time: procedures>>=
subroutine timer_write (object, unit)
class(timer_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
if (object%running) then
write (u, "(1x,A)") "Time in seconds = [running]"
else
call object%time_t%write (u)
end if
end subroutine timer_write
@ %def timer_write
@ Start the timer: store the current time in the first entry and adapt
the status. We forget any previous values.
<<CPU time: timer: TBP>>=
procedure :: start => timer_start
<<CPU time: procedures>>=
subroutine timer_start (timer)
class(timer_t), intent(out) :: timer
call timer%t1%set_current ()
timer%running = .true.
end subroutine timer_start
@ %def timer_start
@ Restart the timer: simply adapt the status, keeping the start time.
<<CPU time: timer: TBP>>=
procedure :: restart => timer_restart
<<CPU time: procedures>>=
subroutine timer_restart (timer)
class(timer_t), intent(inout) :: timer
if (timer%t1%known .and. .not. timer%running) then
timer%running = .true.
else
call msg_bug ("Timer: restart attempt from wrong status")
end if
end subroutine timer_restart
@ %def timer_start
@ Stop the timer: store the current time in the second entry, adapt
the status, and compute the elapsed time.
<<CPU time: timer: TBP>>=
procedure :: stop => timer_stop
<<CPU time: procedures>>=
subroutine timer_stop (timer)
class(timer_t), intent(inout) :: timer
call timer%t2%set_current ()
timer%running = .false.
call timer%evaluate ()
end subroutine timer_stop
@ %def timer_stop
@ Manually set the time (for unit test)
<<CPU time: timer: TBP>>=
procedure :: set_test_time1 => timer_set_test_time1
procedure :: set_test_time2 => timer_set_test_time2
<<CPU time: procedures>>=
subroutine timer_set_test_time1 (timer, t)
class(timer_t), intent(inout) :: timer
integer, intent(in) :: t
timer%t1 = t
end subroutine timer_set_test_time1
subroutine timer_set_test_time2 (timer, t)
class(timer_t), intent(inout) :: timer
integer, intent(in) :: t
timer%t2 = t
end subroutine timer_set_test_time2
@ %def timer_set_test_time1
@ %def timer_set_test_time2
@ This is separate, available for the unit test.
<<CPU time: timer: TBP>>=
procedure :: evaluate => timer_evaluate
<<CPU time: procedures>>=
subroutine timer_evaluate (timer)
class(timer_t), intent(inout) :: timer
timer%time_t = timer%t2 - timer%t1
end subroutine timer_evaluate
@ %def timer_evaluate
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[cputime_ut.f90]]>>=
<<File header>>
module cputime_ut
use unit_tests
use cputime_uti
<<Standard module head>>
<<CPU time: public test>>
contains
<<CPU time: test driver>>
end module cputime_ut
@ %def cputime_ut
@
<<[[cputime_uti.f90]]>>=
<<File header>>
module cputime_uti
<<Use strings>>
use cputime
<<Standard module head>>
<<CPU time: test declarations>>
contains
<<CPU time: tests>>
end module cputime_uti
@ %def cputime_ut
@ API: driver for the unit tests below.
<<CPU time: public test>>=
public :: cputime_test
<<CPU time: test driver>>=
subroutine cputime_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<CPU time: execute tests>>
end subroutine cputime_test
@ %def cputime_test
@
\subsubsection{Basic tests}
Check basic functions of the time object. The part which we can't
check is getting the actual time from the system clock, since the
output will not be reproducible. However, we can check time formats
and operations.
<<CPU time: execute tests>>=
call test (cputime_1, "cputime_1", &
"time operations", &
u, results)
<<CPU time: test declarations>>=
public :: cputime_1
<<CPU time: tests>>=
subroutine cputime_1 (u)
integer, intent(in) :: u
type(time_t) :: time, time1, time2
real :: t
integer :: d, h, m, s
write (u, "(A)") "* Test output: cputime_1"
write (u, "(A)") "* Purpose: check time operations"
write (u, "(A)")
write (u, "(A)") "* Undefined time"
write (u, *)
call time%write (u)
write (u, *)
write (u, "(A)") "* Set time to zero"
write (u, *)
time = 0
call time%write (u)
write (u, *)
write (u, "(A)") "* Set time to 1.234 s"
write (u, *)
time = 1.234
call time%write (u)
t = time
write (u, "(1x,A,F6.3)") "Time as real =", t
write (u, *)
write (u, "(A)") "* Compute time difference"
write (u, *)
time1 = 5.33
time2 = 7.55
time = time2 - time1
call time1%write (u)
call time2%write (u)
call time%write (u)
write (u, *)
write (u, "(A)") "* Compute time sum"
write (u, *)
time = time2 + time1
call time1%write (u)
call time2%write (u)
call time%write (u)
write (u, *)
write (u, "(A)") "* Expand time"
write (u, *)
time1 = ((24 + 1) * 60 + 1) * 60 + 1
time2 = ((3 * 24 + 23) * 60 + 59) * 60 + 59
call time1%expand (s)
write (u, 1) "s =", s
call time1%expand (m,s)
write (u, 1) "ms =", m, s
call time1%expand (h,m,s)
write (u, 1) "hms =", h, m, s
call time1%expand (d,h,m,s)
write (u, 1) "dhms =", d, h, m, s
call time2%expand (s)
write (u, 1) "s =", s
call time2%expand (m,s)
write (u, 1) "ms =", m, s
call time2%expand (h,m,s)
write (u, 1) "hms =", h, m, s
call time2%expand (d,h,m,s)
write (u, 1) "dhms =", d, h, m, s
write (u, *)
write (u, "(A)") "* Expand negative time"
write (u, *)
time1 = - (((24 + 1) * 60 + 1) * 60 + 1)
time2 = - (((3 * 24 + 23) * 60 + 59) * 60 + 59)
call time1%expand (s)
write (u, 1) "s =", s
call time1%expand (m,s)
write (u, 1) "ms =", m, s
call time1%expand (h,m,s)
write (u, 1) "hms =", h, m, s
call time1%expand (d,h,m,s)
write (u, 1) "dhms =", d, h, m, s
call time2%expand (s)
write (u, 1) "s =", s
call time2%expand (m,s)
write (u, 1) "ms =", m, s
call time2%expand (h,m,s)
write (u, 1) "hms =", h, m, s
call time2%expand (d,h,m,s)
write (u, 1) "dhms =", d, h, m, s
1 format (1x,A,1x,4(I0,:,':'))
write (u, *)
write (u, "(A)") "* String from time"
write (u, *)
time1 = ((24 + 1) * 60 + 1) * 60 + 1
time2 = ((3 * 24 + 23) * 60 + 59) * 60 + 59
write (u, "(A)") char (time1%to_string_s ())
write (u, "(A)") char (time1%to_string_ms ())
write (u, "(A)") char (time1%to_string_hms ())
write (u, "(A)") char (time1%to_string_dhms ())
write (u, "(A)") char (time2%to_string_s ())
write (u, "(A)") char (time2%to_string_ms ())
write (u, "(A)") char (time2%to_string_hms ())
write (u, "(A)") char (time2%to_string_dhms ())
write (u, "(A)")
write (u, "(A)") "* Blanking out the last second entry"
write (u, "(A)")
write (u, "(A)") char (time1%to_string_ms ())
write (u, "(A)") char (time1%to_string_ms (.true.))
write (u, *)
write (u, "(A)") "* String from negative time"
write (u, *)
time1 = -(((24 + 1) * 60 + 1) * 60 + 1)
time2 = -(((3 * 24 + 23) * 60 + 59) * 60 + 59)
write (u, "(A)") char (time1%to_string_s ())
write (u, "(A)") char (time1%to_string_ms ())
write (u, "(A)") char (time1%to_string_hms ())
write (u, "(A)") char (time1%to_string_dhms ())
write (u, "(A)") char (time2%to_string_s ())
write (u, "(A)") char (time2%to_string_ms ())
write (u, "(A)") char (time2%to_string_hms ())
write (u, "(A)") char (time2%to_string_dhms ())
write (u, "(A)")
write (u, "(A)") "* Test output end: cputime_1"
end subroutine cputime_1
@ %def cputime_1
@
\subsubsection{Timer tests}
Check a timer object.
<<CPU time: execute tests>>=
call test (cputime_2, "cputime_2", &
"timer", &
u, results)
<<CPU time: test declarations>>=
public :: cputime_2
<<CPU time: tests>>=
subroutine cputime_2 (u)
integer, intent(in) :: u
type(timer_t) :: timer
write (u, "(A)") "* Test output: cputime_2"
write (u, "(A)") "* Purpose: check timer"
write (u, "(A)")
write (u, "(A)") "* Undefined timer"
write (u, *)
call timer%write (u)
write (u, *)
write (u, "(A)") "* Start timer"
write (u, *)
call timer%start ()
call timer%write (u)
write (u, *)
write (u, "(A)") "* Stop timer (injecting fake timings)"
write (u, *)
call timer%stop ()
call timer%set_test_time1 (2)
call timer%set_test_time2 (5)
call timer%evaluate ()
call timer%write (u)
write (u, *)
write (u, "(A)") "* Restart timer"
write (u, *)
call timer%restart ()
call timer%write (u)
write (u, *)
write (u, "(A)") "* Stop timer again (injecting fake timing)"
write (u, *)
call timer%stop ()
call timer%set_test_time2 (10)
call timer%evaluate ()
call timer%write (u)
write (u, *)
write (u, "(A)") "* Test output end: cputime_2"
end subroutine cputime_2
@ %def cputime_2
Index: trunk/src/system/system_dependencies.f90.in
===================================================================
--- trunk/src/system/system_dependencies.f90.in (revision 8157)
+++ trunk/src/system/system_dependencies.f90.in (revision 8158)
@@ -1,379 +1,384 @@
! WHIZARD <<Version>> <<Date>>
!
! Copyright (C) 1999-2018 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.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module system_dependencies
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! All character strings indented by 7 blanks will be automatically
! split into chunks respecting the FORTRAN line length constraint by
! configure.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@FC_OPENMP_HEADER@
implicit none
public
! Program version
character(*), parameter :: WHIZARD_VERSION = "@PACKAGE_VERSION@"
character(*), parameter :: WHIZARD_DATE = "@PACKAGE_DATE@"
! System paths
! These are used for testing without existing installation
character(*), parameter :: WHIZARD_TEST_BASICS_MODPATH = &
"@BUILDDIR@/src/basics"
character(*), parameter :: WHIZARD_TEST_UTILITIES_MODPATH = &
"@BUILDDIR@/src/utilities"
character(*), parameter :: WHIZARD_TEST_COMBINATORICS_MODPATH = &
"@BUILDDIR@/src/combinatorics"
character(*), parameter :: WHIZARD_TEST_SYSTEM_MODPATH = &
"@BUILDDIR@/src/system"
character(*), parameter :: WHIZARD_TEST_PHYSICS_MODPATH = &
"@BUILDDIR@/src/physics"
character(*), parameter :: WHIZARD_TEST_ME_MODPATH = &
"@BUILDDIR@/src/matrix_elements"
character(*), parameter :: WHIZARD_TEST_MODELS_MODPATH = &
"@BUILDDIR@/src/models"
character(*), parameter :: WHIZARD_TEST_THRESHOLD_MODPATH = &
"@BUILDDIR@/src/threshold"
character(*), parameter :: WHIZARD_TEST_OMEGA_MODPATH = &
"@BUILDDIR@/omega/src"
character(*), parameter :: WHIZARD_TEST_CORE_LIBPATH = &
"@BUILDDIR@/src/whizard-core"
character(*), parameter :: WHIZARD_TEST_OMEGA_BINPATH = &
"@BUILDDIR@/omega/bin"
character(*), parameter :: WHIZARD_TEST_SRC_LIBPATH = &
"@BUILDDIR@/src"
character(*), parameter :: WHIZARD_TEST_HEPMC_LIBPATH = &
"@BUILDDIR@/src/hepmc"
character(*), parameter :: WHIZARD_TEST_LCIO_LIBPATH = &
"@BUILDDIR@/src/lcio"
character(*), parameter :: WHIZARD_TEST_HOPPET_LIBPATH = &
"@BUILDDIR@/src/hoppet"
character(*), parameter :: WHIZARD_TEST_LOOPTOOLS_LIBPATH = &
"@BUILDDIR@/src/looptools"
character(*), parameter :: WHIZARD_TEST_MODELPATH = &
"@SRCDIR@/share/models"
character(*), parameter :: WHIZARD_TEST_MODELPATH_UFO = &
"@SRCDIR@/share/models/UFO"
character(*), parameter :: WHIZARD_TEST_MODELS_LIBPATH = &
"@BUILDDIR@/src/models"
character(*), parameter :: WHIZARD_TEST_SUSYPATH = &
"@SRCDIR@/share/susy"
character(*), parameter :: WHIZARD_TEST_GMLPATH= &
"@BUILDDIR@/src/gamelan"
character(*), parameter :: WHIZARD_TEST_CUTSPATH = &
"@SRCDIR@/share/cuts"
character(*), parameter :: WHIZARD_TEST_SHAREPATH = &
"@SRCDIR@/share"
character(*), parameter :: WHIZARD_TEST_TESTDATAPATH = &
"@SRCDIR@/share/test"
character(*), parameter :: WHIZARD_TEST_TEXPATH = &
"@SRCDIR@/src/feynmf"
character(*), parameter :: WHIZARD_TEST_CIRCE2PATH = &
"@SRCDIR@/circe2/share/data"
character(*), parameter :: WHIZARD_TEST_BEAMSIMPATH = &
"@SRCDIR@/share/beam-sim"
character(*), parameter :: WHIZARD_TEST_MULIPATH = &
"@SRCDIR@/share/muli"
character(*), parameter :: PDF_BUILTIN_TEST_DATAPATH = &
"@SRCDIR@/share/pdf_builtin"
! WHIZARD-specific include flags
character(*), parameter :: WHIZARD_TEST_INCLUDES = &
"-I" // WHIZARD_TEST_MODELS_MODPATH // " " // &
"-I" // WHIZARD_TEST_THRESHOLD_MODPATH // " " // &
"-I" // WHIZARD_TEST_OMEGA_MODPATH // " " // &
"-I" // WHIZARD_TEST_ME_MODPATH // " " // &
"-I" // WHIZARD_TEST_PHYSICS_MODPATH // " " // &
"-I" // WHIZARD_TEST_SYSTEM_MODPATH // " " // &
"-I" // WHIZARD_TEST_COMBINATORICS_MODPATH // " " // &
"-I" // WHIZARD_TEST_UTILITIES_MODPATH // " " // &
"-I" // WHIZARD_TEST_BASICS_MODPATH // " " // &
"@OPENLOOPS_INCLUDES@ @RECOLA_INCLUDES@"
! WHIZARD-specific link flags
character(*), parameter :: WHIZARD_TEST_LDFLAGS = &
"-L" // WHIZARD_TEST_CORE_LIBPATH // " " // &
"-L" // WHIZARD_TEST_SRC_LIBPATH // " " // &
"-L" // WHIZARD_TEST_HEPMC_LIBPATH // " " // &
"-L" // WHIZARD_TEST_LCIO_LIBPATH // " " // &
"-L" // WHIZARD_TEST_HOPPET_LIBPATH // " " // &
"-L" // WHIZARD_TEST_LOOPTOOLS_LIBPATH // " " // &
"-lwhizard_main -lwhizard -lomega " // &
"@LDFLAGS_HEPMC@ @LDFLAGS_LCIO@ @LDFLAGS_HOPPET@ " // &
"@LDFLAGS_LOOPTOOLS@ @LDFLAGS_OPENLOOPS@ " // &
"@LDFLAGS_RECOLA@"
! Libtool
character(*), parameter :: WHIZARD_LIBTOOL_TEST = &
"@BUILDDIR@/libtool"
! System paths
! These are used for the installed version
character(*), parameter :: PREFIX = &
"@prefix@"
character(*), parameter :: EXEC_PREFIX = &
"@exec_prefix@"
character(*), parameter :: BINDIR = &
"@bindir@"
character(*), parameter :: LIBDIR = &
"@libdir@"
character(*), parameter :: INCLUDEDIR = &
"@includedir@"
character(*), parameter :: DATAROOTDIR = &
"@datarootdir@"
character(*), parameter :: PKGLIBDIR = LIBDIR // "/whizard"
character(*), parameter :: PKGDATADIR = DATAROOTDIR // "/whizard"
character(*), parameter :: PKGTEXDIR = DATAROOTDIR // "/texmf/whizard"
character(*), parameter :: PKGCIRCE2DIR = DATAROOTDIR // "/circe2"
character(*), parameter :: WHIZARD_BASICS_MODPATH = &
PKGLIBDIR // "/mod/basics"
character(*), parameter :: WHIZARD_UTILITIES_MODPATH = &
PKGLIBDIR // "/mod/utilities"
character(*), parameter :: WHIZARD_COMBINATORICS_MODPATH = &
PKGLIBDIR // "/mod/combinatorics"
character(*), parameter :: WHIZARD_SYSTEM_MODPATH = &
PKGLIBDIR // "/mod/system"
character(*), parameter :: WHIZARD_PHYSICS_MODPATH = &
PKGLIBDIR // "/mod/physics"
character(*), parameter :: WHIZARD_ME_MODPATH = &
PKGLIBDIR // "/mod/matrix_elements"
character(*), parameter :: WHIZARD_MODELS_MODPATH = &
PKGLIBDIR // "/mod/models"
character(*), parameter :: WHIZARD_THRESHOLD_MODPATH = &
PKGLIBDIR // "/mod/threshold"
character(*), parameter :: WHIZARD_OMEGA_MODPATH = &
INCLUDEDIR // "/omega"
character(*), parameter :: WHIZARD_OMEGA_BINPATH = &
BINDIR
character(*), parameter :: WHIZARD_OMEGA_LIBPATH = &
LIBDIR
character(*), parameter :: WHIZARD_MODELPATH = &
PKGDATADIR // "/models"
character(*), parameter :: WHIZARD_MODELPATH_UFO = &
PKGDATADIR // "/models/UFO"
character(*), parameter :: WHIZARD_MODELS_LIBPATH = &
PKGLIBDIR // "/models"
character(*), parameter :: WHIZARD_SUSYPATH = &
PKGDATADIR // "/susy"
character(*), parameter :: WHIZARD_GMLPATH= &
PKGLIBDIR // "/gamelan"
character(*), parameter :: WHIZARD_SHAREPATH = &
PKGDATADIR
character(*), parameter :: WHIZARD_TESTDATAPATH = &
PKGDATADIR // "/test"
character(*), parameter :: WHIZARD_CUTSPATH = &
PKGDATADIR // "/cuts"
character(*), parameter :: WHIZARD_TEXPATH = &
PKGTEXDIR
character(*), parameter :: WHIZARD_CIRCE2PATH = &
PKGCIRCE2DIR // "/data"
character(*), parameter :: WHIZARD_BEAMSIMPATH = &
PKGDATADIR // "/beam-sim"
character(*), parameter :: WHIZARD_MULIPATH = &
PKGDATADIR // "/muli"
character(*), parameter :: PDF_BUILTIN_DATAPATH = &
PKGDATADIR // "/pdf_builtin"
! WHIZARD-specific include flags
character(*), parameter :: WHIZARD_INCLUDES = &
"-I" // WHIZARD_MODELS_MODPATH // " " // &
"-I" // WHIZARD_THRESHOLD_MODPATH // " " // &
"-I" // WHIZARD_OMEGA_MODPATH // " " // &
"-I" // WHIZARD_ME_MODPATH // " " // &
"-I" // WHIZARD_PHYSICS_MODPATH // " " // &
"-I" // WHIZARD_SYSTEM_MODPATH // " " // &
"-I" // WHIZARD_COMBINATORICS_MODPATH // " " // &
"-I" // WHIZARD_UTILITIES_MODPATH // " " // &
"-I" // WHIZARD_BASICS_MODPATH // " " // &
"@OPENLOOPS_INCLUDES@ @RECOLA_INCLUDES@"
! WHIZARD-specific link flags
character(*), parameter :: WHIZARD_LDFLAGS = &
"-L" // WHIZARD_OMEGA_LIBPATH // " " // &
"-lwhizard_main -lwhizard -lomega " // &
"@LDFLAGS_HEPMC@ @LDFLAGS_LCIO@ @LDFLAGS_HOPPET@ " // &
"@LDFLAGS_LOOPTOOLS@ @LDFLAGS_OPENLOOPS@ " // &
"@LDFLAGS_RECOLA@"
! Libtool
character(*), parameter :: WHIZARD_LIBTOOL = &
PKGLIBDIR // "/libtool"
! Fortran compiler
character(*), parameter :: DEFAULT_FC = &
"@FC@"
character(*), parameter :: DEFAULT_FCFLAGS = &
"@FCFLAGS_PROFILING@ @FCFLAGS_OPENMP@ @FCFLAGS_MPI@ @FCFLAGS@"
character(*), parameter :: DEFAULT_FCFLAGS_PIC = &
"@FCFLAGS_PIC@"
character(*), parameter :: DEFAULT_FC_SRC_EXT = &
".@FC_SRC_EXT@"
character(*), parameter :: DEFAULT_FC_PRECISION = &
"@FC_PRECISION@"
! Fortran compiler
character(*), parameter :: DEFAULT_CC = &
"@CC@"
character(*), parameter :: DEFAULT_CFLAGS = &
"@CFLAGS@"
character(*), parameter :: DEFAULT_CFLAGS_PIC = &
"@CFLAGS_PIC@"
logical, parameter :: CC_IS_GNU = @CC_IS_GNU@
logical, parameter :: CC_HAS_QUADMATH = @CC_HAS_QUADMATH@
! Object files
character(*), parameter :: DEFAULT_OBJ_EXT = &
".@OBJ_EXT@"
! Linker
character(*), parameter :: DEFAULT_LD = &
"@LD@"
character(*), parameter :: DEFAULT_LDFLAGS = &
""
character(*), parameter :: DEFAULT_LDFLAGS_SO = "-shared"
character(*), parameter :: DEFAULT_LDFLAGS_STATIC = &
"@LDFLAGS_STATIC@"
character(*), parameter :: DEFAULT_LDFLAGS_HEPMC = &
"@LDFLAGS_HEPMC@"
character(*), parameter :: DEFAULT_LDFLAGS_LCIO = &
"@LDFLAGS_LCIO@"
character(*), parameter :: DEFAULT_LDFLAGS_HOPPET = &
"@LDFLAGS_HOPPET@"
character(*), parameter :: DEFAULT_LDFLAGS_LOOPTOOLS = &
"@LDFLAGS_LOOPTOOLS@"
character(*), parameter :: DEFAULT_SHRLIB_EXT = "@SHRLIB_EXT@"
character(*), parameter :: DEFAULT_FC_SHRLIB_EXT = "so"
+ ! Pack/unpack
+ character(*), parameter :: DEFAULT_PACK_CMD = "tar -czf"
+ character(*), parameter :: DEFAULT_UNPACK_CMD = "tar -xzf"
+ character(*), parameter :: DEFAULT_PACK_EXT = ".tgz"
+
! Make
character(*), parameter :: DEFAULT_MAKEFLAGS = &
"@DEFAULT_MAKEFLAGS@"
! LHAPDF library
character(*), parameter :: LHAPDF_PDFSETS_PATH = &
"@LHAPDF_PDFSETS_PATH@"
! Available methods for event analysis display
character(*), parameter :: EVENT_ANALYSIS = &
"@EVENT_ANALYSIS@"
character(*), parameter :: EVENT_ANALYSIS_PS = &
"@EVENT_ANALYSIS_PS@"
character(*), parameter :: EVENT_ANALYSIS_PDF = &
"@EVENT_ANALYSIS_PDF@"
! Programs used for event analysis display
character(*), parameter :: PRG_LATEX = &
"@LATEX@"
character(*), parameter :: PRG_MPOST = &
"@MPOST@"
character(*), parameter :: PRG_DVIPS = &
"@DVIPS@"
character(*), parameter :: PRG_PS2PDF = &
"@PS2PDF@"
! Programs and libraries used for NLO calculations
! GoSam
character(*), parameter :: GOSAM_DIR = &
"@GOSAM_DIR@"
character(*), parameter :: GOLEM_DIR = &
"@GOLEM_DIR@"
character(*), parameter :: FORM_DIR = &
"@FORM_DIR@"
character(*), parameter :: QGRAF_DIR = &
"@QGRAF_DIR@"
character(*), parameter :: NINJA_DIR = &
"@NINJA_DIR@"
character(*), parameter :: SAMURAI_DIR = &
"@SAMURAI_DIR@"
! OpenLoops
character(*), parameter :: OPENLOOPS_DIR = &
"@OPENLOOPS_DIR@"
character(*), parameter :: RECOLA_DIR = &
"@RECOLA_DIR@"
! Hardwired options for batch-mode processing
character(*), parameter :: OPT_LATEX = &
"-halt-on-error"
character(*), parameter :: OPT_MPOST = &
"@MPOSTFLAG@ -halt-on-error"
! dlopen parameters
integer, parameter :: &
RTLD_LAZY = @RTLD_LAZY_VALUE@ , &
RTLD_NOW = @RTLD_NOW_VALUE@ , &
RTLD_GLOBAL = @RTLD_GLOBAL_VALUE@ , &
RTLD_LOCAL = @RTLD_LOCAL_VALUE@
! Misc
logical, parameter :: LHAPDF5_AVAILABLE = @LHAPDF5_AVAILABLE_FLAG@
logical, parameter :: LHAPDF6_AVAILABLE = @LHAPDF6_AVAILABLE_FLAG@
logical, parameter :: HOPPET_AVAILABLE = @HOPPET_AVAILABLE_FLAG@
logical, parameter :: PYTHIA6_AVAILABLE = @PYTHIA6_AVAILABLE_FLAG@
logical, parameter :: PYTHIA8_AVAILABLE = @PYTHIA8_AVAILABLE_FLAG@
logical, parameter :: GOSAM_AVAILABLE = @GOSAM_AVAILABLE_FLAG@
logical, parameter :: OPENLOOPS_AVAILABLE = @OPENLOOPS_AVAILABLE_FLAG@
logical, parameter :: RECOLA_AVAILABLE = @RECOLA_AVAILABLE_FLAG@
contains
! Subroutines that depend on configure settings
! OpenMP wrapper routines, work independent of OpenMP status
function openmp_is_active () result (flag)
logical :: flag
@FC_OPENMP_ON@ flag = .true.
@FC_OPENMP_OFF@ flag = .false.
end function openmp_is_active
subroutine openmp_set_num_threads (num)
integer, intent(in) :: num
@FC_OPENMP_ON@ call omp_set_num_threads (num)
end subroutine openmp_set_num_threads
function openmp_get_num_threads () result (num)
integer :: num
@FC_OPENMP_ON@ num = omp_get_num_threads ()
@FC_OPENMP_OFF@ num = 1
end function openmp_get_num_threads
function openmp_get_max_threads () result (num)
integer :: num
@FC_OPENMP_ON@ num = omp_get_max_threads ()
@FC_OPENMP_OFF@ num = 1
end function openmp_get_max_threads
function openmp_get_default_max_threads () result (num)
integer :: num
num = @FC_OPENMP_DEFAULT_MAX_THREADS@
end function openmp_get_default_max_threads
end module system_dependencies
Index: trunk/src/whizard-core/whizard.nw
===================================================================
--- trunk/src/whizard-core/whizard.nw (revision 8157)
+++ trunk/src/whizard-core/whizard.nw (revision 8158)
@@ -1,30916 +1,31406 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD main code as NOWEB source
\includemodulegraph{whizard-core}
\chapter{Integration and Simulation}
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{User-controlled File I/O}
The SINDARIN language includes commands that write output to file (input may
be added later). We identify files by their name, and manage the unit
internally. We need procedures for opening, closing, and printing files.
<<[[user_files.f90]]>>=
<<File header>>
module user_files
<<Use strings>>
use io_units
use diagnostics
use ifiles
use analysis
<<Standard module head>>
<<User files: public>>
<<User files: types>>
<<User files: interfaces>>
contains
<<User files: procedures>>
end module user_files
@ %def user_files
@
\subsection{The file type}
This is a type that describes an open user file and its properties. The entry
is part of a doubly-linked list.
<<User files: types>>=
type :: file_t
private
type(string_t) :: name
integer :: unit = -1
logical :: reading = .false.
logical :: writing = .false.
type(file_t), pointer :: prev => null ()
type(file_t), pointer :: next => null ()
end type file_t
@ %def file_t
@ The initializer opens the file.
<<User files: procedures>>=
subroutine file_init (file, name, action, status, position)
type(file_t), intent(out) :: file
type(string_t), intent(in) :: name
character(len=*), intent(in) :: action, status, position
file%unit = free_unit ()
file%name = name
open (unit = file%unit, file = char (file%name), &
action = action, status = status, position = position)
select case (action)
case ("read")
file%reading = .true.
case ("write")
file%writing = .true.
case ("readwrite")
file%reading = .true.
file%writing = .true.
end select
end subroutine file_init
@ %def file_init
@ The finalizer closes it.
<<User files: procedures>>=
subroutine file_final (file)
type(file_t), intent(inout) :: file
close (unit = file%unit)
file%unit = -1
end subroutine file_final
@ %def file_final
@ Check if a file is open with correct status.
<<User files: procedures>>=
function file_is_open (file, action) result (flag)
logical :: flag
type(file_t), intent(in) :: file
character(*), intent(in) :: action
select case (action)
case ("read")
flag = file%reading
case ("write")
flag = file%writing
case ("readwrite")
flag = file%reading .and. file%writing
case default
call msg_bug ("Checking file '" // char (file%name) &
// "': illegal action specifier")
end select
end function file_is_open
@ %def file_is_open
+@ Return the unit number of a file for direct access. It should be checked
+first whether the file is open.
+<<User files: procedures>>=
+ function file_get_unit (file) result (unit)
+ integer :: unit
+ type(file_t), intent(in) :: file
+ unit = file%unit
+ end function file_get_unit
+
+@ %def file_get_unit
@ Write to the file. Error if in wrong mode. If there is no string, just
write an empty record. If there is a string, respect the [[advancing]]
option.
<<User files: procedures>>=
subroutine file_write_string (file, string, advancing)
type(file_t), intent(in) :: file
type(string_t), intent(in), optional :: string
logical, intent(in), optional :: advancing
if (file%writing) then
if (present (string)) then
if (present (advancing)) then
if (advancing) then
write (file%unit, "(A)") char (string)
else
write (file%unit, "(A)", advance="no") char (string)
end if
else
write (file%unit, "(A)") char (string)
end if
else
write (file%unit, *)
end if
else
call msg_error ("Writing to file: File '" // char (file%name) &
// "' is not open for writing.")
end if
end subroutine file_write_string
@ %def file_write
@ Write a whole ifile, line by line.
<<User files: procedures>>=
subroutine file_write_ifile (file, ifile)
type(file_t), intent(in) :: file
type(ifile_t), intent(in) :: ifile
type(line_p) :: line
call line_init (line, ifile)
do while (line_is_associated (line))
call file_write_string (file, line_get_string_advance (line))
end do
end subroutine file_write_ifile
@ %def file_write_ifile
@ Write an analysis object (or all objects) to an open file.
<<User files: procedures>>=
subroutine file_write_analysis (file, tag)
type(file_t), intent(in) :: file
type(string_t), intent(in), optional :: tag
if (file%writing) then
if (present (tag)) then
call analysis_write (tag, unit = file%unit)
else
call analysis_write (unit = file%unit)
end if
else
call msg_error ("Writing analysis to file: File '" // char (file%name) &
// "' is not open for writing.")
end if
end subroutine file_write_analysis
@ %def file_write_analysis
@
\subsection{The file list}
We maintain a list of all open files and their attributes. The list must be
doubly-linked because we may delete entries.
<<User files: public>>=
public :: file_list_t
<<User files: types>>=
type :: file_list_t
type(file_t), pointer :: first => null ()
type(file_t), pointer :: last => null ()
end type file_list_t
@ %def file_list_t
@ There is no initialization routine, but a finalizer which deletes all:
<<User files: public>>=
public :: file_list_final
<<User files: procedures>>=
subroutine file_list_final (file_list)
type(file_list_t), intent(inout) :: file_list
type(file_t), pointer :: current
do while (associated (file_list%first))
current => file_list%first
file_list%first => current%next
call file_final (current)
deallocate (current)
end do
file_list%last => null ()
end subroutine file_list_final
@ %def file_list_final
@ Find an entry in the list. Return null pointer on failure.
<<User files: procedures>>=
function file_list_get_file_ptr (file_list, name) result (current)
type(file_t), pointer :: current
type(file_list_t), intent(in) :: file_list
type(string_t), intent(in) :: name
current => file_list%first
do while (associated (current))
if (current%name == name) return
current => current%next
end do
end function file_list_get_file_ptr
@ %def file_list_get_file_ptr
@ Check if a file is open, public version:
<<User files: public>>=
public :: file_list_is_open
<<User files: procedures>>=
function file_list_is_open (file_list, name, action) result (flag)
logical :: flag
type(file_list_t), intent(in) :: file_list
type(string_t), intent(in) :: name
character(len=*), intent(in) :: action
type(file_t), pointer :: current
current => file_list_get_file_ptr (file_list, name)
if (associated (current)) then
flag = file_is_open (current, action)
else
flag = .false.
end if
end function file_list_is_open
@ %def file_list_is_open
+@ Return the unit number for a file. It should be checked first whether the
+file is open.
+<<User files: public>>=
+ public :: file_list_get_unit
+<<User files: procedures>>=
+ function file_list_get_unit (file_list, name) result (unit)
+ integer :: unit
+ type(file_list_t), intent(in) :: file_list
+ type(string_t), intent(in) :: name
+ type(file_t), pointer :: current
+ current => file_list_get_file_ptr (file_list, name)
+ if (associated (current)) then
+ unit = file_get_unit (current)
+ else
+ unit = -1
+ end if
+ end function file_list_get_unit
+
+@ %def file_list_get_unit
@ Append a new file entry, i.e., open this file. Error if it is
already open.
<<User files: public>>=
public :: file_list_open
<<User files: procedures>>=
subroutine file_list_open (file_list, name, action, status, position)
type(file_list_t), intent(inout) :: file_list
type(string_t), intent(in) :: name
character(len=*), intent(in) :: action, status, position
type(file_t), pointer :: current
if (.not. associated (file_list_get_file_ptr (file_list, name))) then
allocate (current)
call msg_message ("Opening file '" // char (name) // "' for output")
call file_init (current, name, action, status, position)
if (associated (file_list%last)) then
file_list%last%next => current
current%prev => file_list%last
else
file_list%first => current
end if
file_list%last => current
else
call msg_error ("Opening file: File '" // char (name) &
// "' is already open.")
end if
end subroutine file_list_open
@ %def file_list_open
@ Delete a file entry, i.e., close this file. Error if it is not open.
<<User files: public>>=
public :: file_list_close
<<User files: procedures>>=
subroutine file_list_close (file_list, name)
type(file_list_t), intent(inout) :: file_list
type(string_t), intent(in) :: name
type(file_t), pointer :: current
current => file_list_get_file_ptr (file_list, name)
if (associated (current)) then
if (associated (current%prev)) then
current%prev%next => current%next
else
file_list%first => current%next
end if
if (associated (current%next)) then
current%next%prev => current%prev
else
file_list%last => current%prev
end if
call msg_message ("Closing file '" // char (name) // "' for output")
call file_final (current)
deallocate (current)
else
call msg_error ("Closing file: File '" // char (name) &
// "' is not open.")
end if
end subroutine file_list_close
@ %def file_list_close
@ Write a string to file. Error if it is not open.
<<User files: public>>=
public :: file_list_write
<<User files: interfaces>>=
interface file_list_write
module procedure file_list_write_string
module procedure file_list_write_ifile
end interface
<<User files: procedures>>=
subroutine file_list_write_string (file_list, name, string, advancing)
type(file_list_t), intent(in) :: file_list
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: string
logical, intent(in), optional :: advancing
type(file_t), pointer :: current
current => file_list_get_file_ptr (file_list, name)
if (associated (current)) then
call file_write_string (current, string, advancing)
else
call msg_error ("Writing to file: File '" // char (name) &
// "'is not open.")
end if
end subroutine file_list_write_string
subroutine file_list_write_ifile (file_list, name, ifile)
type(file_list_t), intent(in) :: file_list
type(string_t), intent(in) :: name
type(ifile_t), intent(in) :: ifile
type(file_t), pointer :: current
current => file_list_get_file_ptr (file_list, name)
if (associated (current)) then
call file_write_ifile (current, ifile)
else
call msg_error ("Writing to file: File '" // char (name) &
// "'is not open.")
end if
end subroutine file_list_write_ifile
@ %def file_list_write
@ Write an analysis object or all objects to data file. Error if it is not
open. If the file name is empty, write to standard output.
<<User files: public>>=
public :: file_list_write_analysis
<<User files: procedures>>=
subroutine file_list_write_analysis (file_list, name, tag)
type(file_list_t), intent(in) :: file_list
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: tag
type(file_t), pointer :: current
if (name == "") then
if (present (tag)) then
call analysis_write (tag)
else
call analysis_write
end if
else
current => file_list_get_file_ptr (file_list, name)
if (associated (current)) then
call file_write_analysis (current, tag)
else
call msg_error ("Writing analysis to file: File '" // char (name) &
// "' is not open.")
end if
end if
end subroutine file_list_write_analysis
@ %def file_list_write_analysis
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Runtime data}
<<[[rt_data.f90]]>>=
<<File header>>
module rt_data
<<Use kinds>>
<<Use strings>>
use io_units
use format_utils, only: write_separator
use format_defs, only: FMT_19, FMT_12
use system_dependencies
use diagnostics
use os_interface
use lexers
use parser
use models
use subevents
use pdg_arrays
use variables, only: var_list_t
use process_libraries
use prclib_stacks
use prc_core, only: helicity_selection_t
use beam_structures
use event_base, only: event_callback_t
use user_files
use process_stacks
use iterations
<<Standard module head>>
<<RT data: public>>
<<RT data: types>>
contains
<<RT data: procedures>>
end module rt_data
@ %def rt_data
@
\subsection{Strategy for models and variables}
The program manages its data via a main [[rt_data_t]] object. During program
flow, various commands create and use local [[rt_data_t]] objects. Those
transient blocks contain either pointers to global object or local copies
which are deleted after use.
Each [[rt_data_t]] object contains a variable list component. This lists
holds (local copies of) all kinds of intrinsic or user-defined variables. The
variable list is linked to the variable list contained in the local process
library. This, in turn, is linked to the variable list of the [[rt_data_t]]
context, and so on.
A variable lookup will thus be recursively delegated to the linked variable
lists, until a match is found. When modifying a variable which is not yet
local, the program creates a local copy and uses this afterwards. Thus, when
the local [[rt_data_t]] object is deleted, the context value is recovered.
Models are kept in a model list which is separate from the variable list.
Otherwise, they are treated in a similar manner: the local list is linked to
the context model list. Model lookup is thus recursively delegated. When a
model or any part of it is modified, the model is copied to the local
[[rt_data_t]] object, so the context model is not modified. Commands such as
[[integrate]] will create their own copy of the current model (and of the
current variable list) at the point where they are executed.
When a model is encountered for the first time, it is read from file. The
reading is automatically delegated to the global context. Thus, this master
copy survives until the main [[rt_data_t]] object is deleted, at program
completion.
If there is a currently active model, its variable list is linked to the main
variable list. Variable lookups will then start from the model variable
list. When the current model is switched, the new active model will get this
link instead. Consequently, a change to the current model is kept as long as
this model has a local copy; it survives local model switches. On the other
hand, a parameter change in the current model doesn't affect any other model,
even if the parameter name is identical.
@
\subsection{Container for parse nodes}
The runtime data set contains a bunch of parse nodes (chunks of code
that have not been compiled into evaluation trees but saved for later
use). We collect them here.
This implementation has the useful effect that an assignment between two
objects of this type will establish a pointer-target relationship for
all components.
<<RT data: types>>=
type :: rt_parse_nodes_t
type(parse_node_t), pointer :: cuts_lexpr => null ()
type(parse_node_t), pointer :: scale_expr => null ()
type(parse_node_t), pointer :: fac_scale_expr => null ()
type(parse_node_t), pointer :: ren_scale_expr => null ()
type(parse_node_t), pointer :: weight_expr => null ()
type(parse_node_t), pointer :: selection_lexpr => null ()
type(parse_node_t), pointer :: reweight_expr => null ()
type(parse_node_t), pointer :: analysis_lexpr => null ()
type(parse_node_p), dimension(:), allocatable :: alt_setup
contains
<<RT data: rt parse nodes: TBP>>
end type rt_parse_nodes_t
@ %def rt_parse_nodes_t
@ Clear individual components. The parse nodes are nullified. No
finalization needed since the pointer targets are part of the global
parse tree.
<<RT data: rt parse nodes: TBP>>=
procedure :: clear => rt_parse_nodes_clear
<<RT data: procedures>>=
subroutine rt_parse_nodes_clear (rt_pn, name)
class(rt_parse_nodes_t), intent(inout) :: rt_pn
type(string_t), intent(in) :: name
select case (char (name))
case ("cuts")
rt_pn%cuts_lexpr => null ()
case ("scale")
rt_pn%scale_expr => null ()
case ("factorization_scale")
rt_pn%fac_scale_expr => null ()
case ("renormalization_scale")
rt_pn%ren_scale_expr => null ()
case ("weight")
rt_pn%weight_expr => null ()
case ("selection")
rt_pn%selection_lexpr => null ()
case ("reweight")
rt_pn%reweight_expr => null ()
case ("analysis")
rt_pn%analysis_lexpr => null ()
end select
end subroutine rt_parse_nodes_clear
@ %def rt_parse_nodes_clear
@ Output for the parse nodes.
<<RT data: rt parse nodes: TBP>>=
procedure :: write => rt_parse_nodes_write
<<RT data: procedures>>=
subroutine rt_parse_nodes_write (object, unit)
class(rt_parse_nodes_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
call wrt ("Cuts", object%cuts_lexpr)
call write_separator (u)
call wrt ("Scale", object%scale_expr)
call write_separator (u)
call wrt ("Factorization scale", object%fac_scale_expr)
call write_separator (u)
call wrt ("Renormalization scale", object%ren_scale_expr)
call write_separator (u)
call wrt ("Weight", object%weight_expr)
call write_separator (u, 2)
call wrt ("Event selection", object%selection_lexpr)
call write_separator (u)
call wrt ("Event reweighting factor", object%reweight_expr)
call write_separator (u)
call wrt ("Event analysis", object%analysis_lexpr)
if (allocated (object%alt_setup)) then
call write_separator (u, 2)
write (u, "(1x,A,':')") "Alternative setups"
do i = 1, size (object%alt_setup)
call write_separator (u)
call wrt ("Commands", object%alt_setup(i)%ptr)
end do
end if
contains
subroutine wrt (title, pn)
character(*), intent(in) :: title
type(parse_node_t), intent(in), pointer :: pn
if (associated (pn)) then
write (u, "(1x,A,':')") title
call write_separator (u)
call parse_node_write_rec (pn, u)
else
write (u, "(1x,A,':',1x,A)") title, "[undefined]"
end if
end subroutine wrt
end subroutine rt_parse_nodes_write
@ %def rt_parse_nodes_write
@ Screen output for individual components. (This should eventually be more
condensed, currently we print the internal representation tree.)
<<RT data: rt parse nodes: TBP>>=
procedure :: show => rt_parse_nodes_show
<<RT data: procedures>>=
subroutine rt_parse_nodes_show (rt_pn, name, unit)
class(rt_parse_nodes_t), intent(in) :: rt_pn
type(string_t), intent(in) :: name
integer, intent(in), optional :: unit
type(parse_node_t), pointer :: pn
integer :: u
u = given_output_unit (unit)
select case (char (name))
case ("cuts")
pn => rt_pn%cuts_lexpr
case ("scale")
pn => rt_pn%scale_expr
case ("factorization_scale")
pn => rt_pn%fac_scale_expr
case ("renormalization_scale")
pn => rt_pn%ren_scale_expr
case ("weight")
pn => rt_pn%weight_expr
case ("selection")
pn => rt_pn%selection_lexpr
case ("reweight")
pn => rt_pn%reweight_expr
case ("analysis")
pn => rt_pn%analysis_lexpr
end select
if (associated (pn)) then
write (u, "(A,1x,A,1x,A)") "Expression:", char (name), "(parse tree):"
call parse_node_write_rec (pn, u)
else
write (u, "(A,1x,A,A)") "Expression:", char (name), ": [undefined]"
end if
end subroutine rt_parse_nodes_show
@ %def rt_parse_nodes_show
@
\subsection{The data type}
This is a big data container which contains everything that is used and
modified during the command flow. A local copy of this can be used to
temporarily override defaults. The data set is transparent.
<<RT data: public>>=
public :: rt_data_t
<<RT data: types>>=
type :: rt_data_t
type(lexer_t), pointer :: lexer => null ()
type(rt_data_t), pointer :: context => null ()
+ type(string_t), dimension(:), allocatable :: export
type(var_list_t) :: var_list
type(iterations_list_t) :: it_list
type(os_data_t) :: os_data
type(model_list_t) :: model_list
type(model_t), pointer :: model => null ()
logical :: model_is_copy = .false.
type(model_t), pointer :: preload_model => null ()
type(model_t), pointer :: fallback_model => null ()
type(prclib_stack_t) :: prclib_stack
type(process_library_t), pointer :: prclib => null ()
type(beam_structure_t) :: beam_structure
type(rt_parse_nodes_t) :: pn
type(process_stack_t) :: process_stack
type(string_t), dimension(:), allocatable :: sample_fmt
class(event_callback_t), allocatable :: event_callback
type(file_list_t), pointer :: out_files => null ()
logical :: quit = .false.
integer :: quit_code = 0
type(string_t) :: logfile
logical :: nlo_fixed_order = .false.
logical, dimension(0:5) :: selected_nlo_parts = .false.
integer, dimension(:), allocatable :: nlo_component
contains
<<RT data: rt data: TBP>>
end type rt_data_t
@ %def rt_data_t
@
\subsection{Output}
<<RT data: rt data: TBP>>=
procedure :: write => rt_data_write
<<RT data: procedures>>=
subroutine rt_data_write (object, unit, vars, pacify)
class(rt_data_t), intent(in) :: object
integer, intent(in), optional :: unit
type(string_t), dimension(:), intent(in), optional :: vars
logical, intent(in), optional :: pacify
integer :: u, i
u = given_output_unit (unit)
call write_separator (u, 2)
write (u, "(1x,A)") "Runtime data:"
+ if (object%get_n_export () > 0) then
+ call write_separator (u, 2)
+ write (u, "(1x,A)") "Exported objects and variables:"
+ call write_separator (u)
+ call object%write_exports (u)
+ end if
if (present (vars)) then
if (size (vars) /= 0) then
call write_separator (u, 2)
write (u, "(1x,A)") "Selected variables:"
call write_separator (u)
call object%write_vars (u, vars)
end if
else
call write_separator (u, 2)
if (associated (object%model)) then
call object%model%write_var_list (u, follow_link=.true.)
else
call object%var_list%write (u, follow_link=.true.)
end if
end if
if (object%it_list%get_n_pass () > 0) then
call write_separator (u, 2)
write (u, "(1x)", advance="no")
call object%it_list%write (u)
end if
if (associated (object%model)) then
call write_separator (u, 2)
call object%model%write (u)
end if
call object%prclib_stack%write (u)
call object%beam_structure%write (u)
call write_separator (u, 2)
call object%pn%write (u)
if (allocated (object%sample_fmt)) then
call write_separator (u)
write (u, "(1x,A)", advance="no") "Event sample formats = "
do i = 1, size (object%sample_fmt)
if (i > 1) write (u, "(A,1x)", advance="no") ","
write (u, "(A)", advance="no") char (object%sample_fmt(i))
end do
write (u, "(A)")
end if
call write_separator (u)
write (u, "(1x,A)", advance="no") "Event callback:"
if (allocated (object%event_callback)) then
call object%event_callback%write (u)
else
write (u, "(1x,A)") "[undefined]"
end if
call object%process_stack%write (u, pacify)
write (u, "(1x,A,1x,L1)") "quit :", object%quit
write (u, "(1x,A,1x,I0)") "quit_code:", object%quit_code
call write_separator (u, 2)
write (u, "(1x,A,1x,A)") "Logfile :", "'" // trim (char (object%logfile)) // "'"
call write_separator (u, 2)
end subroutine rt_data_write
@ %def rt_data_write
@ Write only selected variables.
<<RT data: rt data: TBP>>=
procedure :: write_vars => rt_data_write_vars
<<RT data: procedures>>=
subroutine rt_data_write_vars (object, unit, vars)
class(rt_data_t), intent(in), target :: object
integer, intent(in), optional :: unit
type(string_t), dimension(:), intent(in) :: vars
type(var_list_t), pointer :: var_list
integer :: u, i
u = given_output_unit (unit)
var_list => object%get_var_list_ptr ()
do i = 1, size (vars)
associate (var => vars(i))
if (var_list%contains (var, follow_link=.true.)) then
call var_list%write_var (var, unit = u, &
follow_link = .true., defined=.true.)
end if
end associate
end do
end subroutine rt_data_write_vars
@ %def rt_data_write_vars
@ Write only the model list.
<<RT data: rt data: TBP>>=
procedure :: write_model_list => rt_data_write_model_list
<<RT data: procedures>>=
subroutine rt_data_write_model_list (object, unit)
class(rt_data_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
call object%model_list%write (u)
end subroutine rt_data_write_model_list
@ %def rt_data_write_model_list
@ Write only the library stack.
<<RT data: rt data: TBP>>=
procedure :: write_libraries => rt_data_write_libraries
<<RT data: procedures>>=
subroutine rt_data_write_libraries (object, unit, libpath)
class(rt_data_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: libpath
integer :: u
u = given_output_unit (unit)
call object%prclib_stack%write (u, libpath)
end subroutine rt_data_write_libraries
@ %def rt_data_write_libraries
@ Write only the beam data.
<<RT data: rt data: TBP>>=
procedure :: write_beams => rt_data_write_beams
<<RT data: procedures>>=
subroutine rt_data_write_beams (object, unit)
class(rt_data_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
call object%beam_structure%write (u)
call write_separator (u, 2)
end subroutine rt_data_write_beams
@ %def rt_data_write_beams
@ Write only the process and event expressions.
<<RT data: rt data: TBP>>=
procedure :: write_expr => rt_data_write_expr
<<RT data: procedures>>=
subroutine rt_data_write_expr (object, unit)
class(rt_data_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
call object%pn%write (u)
call write_separator (u, 2)
end subroutine rt_data_write_expr
@ %def rt_data_write_expr
@ Write only the process stack.
<<RT data: rt data: TBP>>=
procedure :: write_process_stack => rt_data_write_process_stack
<<RT data: procedures>>=
subroutine rt_data_write_process_stack (object, unit)
class(rt_data_t), intent(in) :: object
integer, intent(in), optional :: unit
call object%process_stack%write (unit)
end subroutine rt_data_write_process_stack
@ %def rt_data_write_process_stack
@
<<RT data: rt data: TBP>>=
procedure :: write_var_descriptions => rt_data_write_var_descriptions
<<RT data: procedures>>=
subroutine rt_data_write_var_descriptions (rt_data, unit, ascii_output)
class(rt_data_t), intent(in) :: rt_data
integer, intent(in), optional :: unit
logical, intent(in), optional :: ascii_output
integer :: u
logical :: ao
u = given_output_unit (unit)
ao = .false.; if (present (ascii_output)) ao = ascii_output
call rt_data%var_list%write (u, follow_link=.true., &
descriptions=.true., ascii_output=ao)
end subroutine rt_data_write_var_descriptions
@ %def rt_data_write_var_descriptions
@
<<RT data: rt data: TBP>>=
procedure :: show_description_of_string => rt_data_show_description_of_string
<<RT data: procedures>>=
subroutine rt_data_show_description_of_string (rt_data, string, &
unit, ascii_output)
class(rt_data_t), intent(in) :: rt_data
type(string_t), intent(in) :: string
integer, intent(in), optional :: unit
logical, intent(in), optional :: ascii_output
integer :: u
logical :: ao
u = given_output_unit (unit)
ao = .false.; if (present (ascii_output)) ao = ascii_output
call rt_data%var_list%write_var (string, unit=u, follow_link=.true., &
defined=.false., descriptions=.true., ascii_output=ao)
end subroutine rt_data_show_description_of_string
@ %def rt_data_show_description_of_string
@
\subsection{Clear}
The [[clear]] command can remove the contents of various subobjects.
The objects themselves should stay.
<<RT data: rt data: TBP>>=
procedure :: clear_beams => rt_data_clear_beams
<<RT data: procedures>>=
subroutine rt_data_clear_beams (global)
class(rt_data_t), intent(inout) :: global
call global%beam_structure%final_sf ()
call global%beam_structure%final_pol ()
call global%beam_structure%final_mom ()
end subroutine rt_data_clear_beams
@ %def rt_data_clear_beams
@
\subsection{Initialization}
Initialize runtime data. This defines special variables such as
[[sqrts]], and should be done only for the instance that is actually
global. Local copies will inherit the special variables.
We link the global variable list to the process stack variable list,
so the latter is always available (and kept global).
<<RT data: rt data: TBP>>=
procedure :: global_init => rt_data_global_init
<<RT data: procedures>>=
subroutine rt_data_global_init (global, paths, logfile)
class(rt_data_t), intent(out), target :: global
type(paths_t), intent(in), optional :: paths
type(string_t), intent(in), optional :: logfile
integer :: seed
call os_data_init (global%os_data, paths)
if (present (logfile)) then
global%logfile = logfile
else
global%logfile = ""
end if
allocate (global%out_files)
call system_clock (seed)
call global%var_list%init_defaults (seed, paths)
call global%init_pointer_variables ()
call global%process_stack%init_var_list (global%var_list)
end subroutine rt_data_global_init
@ %def rt_data_global_init
@
\subsection{Local copies}
This is done at compile time when a local copy of runtime data is
needed: Link the variable list and initialize all derived parameters.
This allows for synchronizing them with local variable changes without
affecting global data.
Also re-initialize pointer variables, so they point to local copies of
their targets.
<<RT data: rt data: TBP>>=
procedure :: local_init => rt_data_local_init
<<RT data: procedures>>=
subroutine rt_data_local_init (local, global, env)
class(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(in), target :: global
integer, intent(in), optional :: env
local%context => global
call local%process_stack%link (global%process_stack)
call local%process_stack%init_var_list (local%var_list)
call local%process_stack%link_var_list (global%var_list)
call local%var_list%append_string (var_str ("$model_name"), &
var_str (""), intrinsic=.true.)
call local%init_pointer_variables ()
local%fallback_model => global%fallback_model
local%os_data = global%os_data
local%logfile = global%logfile
call local%model_list%link (global%model_list)
local%model => global%model
if (associated (local%model)) then
call local%model%link_var_list (local%var_list)
end if
if (allocated (global%event_callback)) then
allocate (local%event_callback, source = global%event_callback)
end if
end subroutine rt_data_local_init
@ %def rt_data_local_init
@ These variables point to objects which get local copies:
<<RT data: rt data: TBP>>=
procedure :: init_pointer_variables => rt_data_init_pointer_variables
<<RT data: procedures>>=
subroutine rt_data_init_pointer_variables (local)
class(rt_data_t), intent(inout), target :: local
logical, target, save :: known = .true.
call local%var_list%append_string_ptr (var_str ("$fc"), &
local%os_data%fc, known, intrinsic=.true., &
description=var_str('This string variable gives the ' // &
'\ttt{Fortran} compiler used within \whizard. It can ' // &
'only be accessed, not set by the user. (cf. also ' // &
'\ttt{\$fcflags})'))
call local%var_list%append_string_ptr (var_str ("$fcflags"), &
local%os_data%fcflags, known, intrinsic=.true., &
description=var_str('This string variable gives the ' // &
'compiler flags for the \ttt{Fortran} compiler used ' // &
'within \whizard. It can only be accessed, not set by ' // &
'the user. (cf. also \ttt{\$fc})'))
end subroutine rt_data_init_pointer_variables
@ %def rt_data_init_pointer_variables
@ This is done at execution time: Copy data, transfer pointers.
[[local]] has intent(inout) because its local variable list has
already been prepared by the previous routine.
To be pedantic, the local pointers to model and library should point
to the entries in the local copies. (However, as long as these are
just shallow copies with identical content, this is actually
irrelevant.)
The process library and process stacks behave as global objects. The
copies of the process library and process stacks should be shallow
copies, so the contents stay identical. Since objects may be pushed
on the stack in the local environment, upon restoring the global
environment, we should reverse the assignment. Then the added stack
elements will end up on the global stack. (This should be
reconsidered in a parallel environment.)
<<RT data: rt data: TBP>>=
procedure :: activate => rt_data_activate
<<RT data: procedures>>=
subroutine rt_data_activate (local)
class(rt_data_t), intent(inout), target :: local
class(rt_data_t), pointer :: global
global => local%context
if (associated (global)) then
local%lexer => global%lexer
call global%copy_globals (local)
local%os_data = global%os_data
local%logfile = global%logfile
if (associated (global%prclib)) then
local%prclib => &
local%prclib_stack%get_library_ptr (global%prclib%get_name ())
end if
call local%import_values ()
call local%process_stack%link (global%process_stack)
local%it_list = global%it_list
local%beam_structure = global%beam_structure
local%pn = global%pn
if (allocated (local%sample_fmt)) deallocate (local%sample_fmt)
if (allocated (global%sample_fmt)) then
allocate (local%sample_fmt (size (global%sample_fmt)), &
source = global%sample_fmt)
end if
local%out_files => global%out_files
local%model => global%model
local%model_is_copy = .false.
else if (.not. associated (local%model)) then
local%model => local%preload_model
local%model_is_copy = .false.
end if
if (associated (local%model)) then
call local%model%link_var_list (local%var_list)
call local%var_list%set_string (var_str ("$model_name"), &
local%model%get_name (), is_known = .true.)
else
call local%var_list%set_string (var_str ("$model_name"), &
var_str (""), is_known = .false.)
end if
end subroutine rt_data_activate
@ %def rt_data_activate
@ Restore the previous state of data, without actually finalizing the local
environment. We also clear the local process stack. Some local modifications
(model list and process library stack) are communicated to the global context,
if there is any.
If the [[keep_local]] flag is set, we want to retain current settings in
the local environment. In particular, we create an instance of the currently
selected model (which thus becomes separated from the model library!).
The local variables are also kept.
<<RT data: rt data: TBP>>=
procedure :: deactivate => rt_data_deactivate
<<RT data: procedures>>=
subroutine rt_data_deactivate (local, global, keep_local)
class(rt_data_t), intent(inout), target :: local
class(rt_data_t), intent(inout), optional, target :: global
logical, intent(in), optional :: keep_local
type(string_t) :: local_model, local_scheme
logical :: same_model, delete
delete = .true.; if (present (keep_local)) delete = .not. keep_local
if (present (global)) then
if (associated (global%model) .and. associated (local%model)) then
local_model = local%model%get_name ()
if (global%model%has_schemes ()) then
local_scheme = local%model%get_scheme ()
same_model = &
global%model%matches (local_model, local_scheme)
else
same_model = global%model%matches (local_model)
end if
else
same_model = .false.
end if
if (delete) then
call local%process_stack%clear ()
call local%unselect_model ()
call local%unset_values ()
else if (associated (local%model)) then
call local%ensure_model_copy ()
end if
if (.not. same_model .and. associated (global%model)) then
if (global%model%has_schemes ()) then
call msg_message ("Restoring model '" // &
char (global%model%get_name ()) // "', scheme '" // &
char (global%model%get_scheme ()) // "'")
else
call msg_message ("Restoring model '" // &
char (global%model%get_name ()) // "'")
end if
end if
if (associated (global%model)) then
call global%model%link_var_list (global%var_list)
end if
call global%restore_globals (local)
else
call local%unselect_model ()
end if
end subroutine rt_data_deactivate
@ %def rt_data_deactivate
@ This imports the global objects for which local modifications
should be kept. Currently, this is only the process library stack.
<<RT data: rt data: TBP>>=
procedure :: copy_globals => rt_data_copy_globals
<<RT data: procedures>>=
subroutine rt_data_copy_globals (global, local)
class(rt_data_t), intent(in) :: global
class(rt_data_t), intent(inout) :: local
local%prclib_stack = global%prclib_stack
end subroutine rt_data_copy_globals
@ %def rt_data_copy_globals
-@ This restores global objects, for which local modifications
-should be kept.
+@ This restores global objects for which local modifications
+should be kept. May also modify (remove) the local objects.
<<RT data: rt data: TBP>>=
procedure :: restore_globals => rt_data_restore_globals
<<RT data: procedures>>=
subroutine rt_data_restore_globals (global, local)
class(rt_data_t), intent(inout) :: global
- class(rt_data_t), intent(in) :: local
+ class(rt_data_t), intent(inout) :: local
global%prclib_stack = local%prclib_stack
+ call local%handle_exports (global)
end subroutine rt_data_restore_globals
@ %def rt_data_restore_globals
@
+\subsection{Exported objects}
+Exported objects are transferred to the global state when a local environment
+is closed. (For the top-level global data set, there is no effect.)
+
+The current implementation handles only the [[results]] object, which resolves
+to the local process stack. The stack elements are appended to the global
+stack without modification, the local stack becomes empty.
+
+Write names of objects to be exported:
+<<RT data: rt data: TBP>>=
+ procedure :: write_exports => rt_data_write_exports
+<<RT data: procedures>>=
+ subroutine rt_data_write_exports (rt_data, unit)
+ class(rt_data_t), intent(in) :: rt_data
+ integer, intent(in), optional :: unit
+ integer :: u, i
+ u = given_output_unit (unit)
+ do i = 1, rt_data%get_n_export ()
+ write (u, "(A)") char (rt_data%export(i))
+ end do
+ end subroutine rt_data_write_exports
+
+@ %def rt_data_write_exports
+@ The number of entries in the export list.
+<<RT data: rt data: TBP>>=
+ procedure :: get_n_export => rt_data_get_n_export
+<<RT data: procedures>>=
+ function rt_data_get_n_export (rt_data) result (n)
+ class(rt_data_t), intent(in) :: rt_data
+ integer :: n
+ if (allocated (rt_data%export)) then
+ n = size (rt_data%export)
+ else
+ n = 0
+ end if
+ end function rt_data_get_n_export
+
+@ %def rt_data_get_n_export
+@ Return a specific export
+@ Append new names to the export list. If a duplicate occurs, do not transfer
+it.
+<<RT data: rt data: TBP>>=
+ procedure :: append_exports => rt_data_append_exports
+<<RT data: procedures>>=
+ subroutine rt_data_append_exports (rt_data, export)
+ class(rt_data_t), intent(inout) :: rt_data
+ type(string_t), dimension(:), intent(in) :: export
+ logical, dimension(:), allocatable :: mask
+ type(string_t), dimension(:), allocatable :: tmp
+ integer :: i, j, n
+ if (.not. allocated (rt_data%export)) allocate (rt_data%export (0))
+ n = size (rt_data%export)
+ allocate (mask (size (export)), source=.false.)
+ do i = 1, size (export)
+ mask(i) = all (export(i) /= rt_data%export) &
+ .and. all (export(i) /= export(:i-1))
+ end do
+ if (count (mask) > 0) then
+ allocate (tmp (n + count (mask)))
+ tmp(1:n) = rt_data%export(:)
+ j = n
+ do i = 1, size (export)
+ if (mask(i)) then
+ j = j + 1
+ tmp(j) = export(i)
+ end if
+ end do
+ call move_alloc (from=tmp, to=rt_data%export)
+ end if
+ end subroutine rt_data_append_exports
+
+@ %def rt_data_append_exports
+@ Transfer export-objects from the [[local]] rt data to the [[global]] rt
+data, as far as supported.
+<<RT data: rt data: TBP>>=
+ procedure :: handle_exports => rt_data_handle_exports
+<<RT data: procedures>>=
+ subroutine rt_data_handle_exports (local, global)
+ class(rt_data_t), intent(inout), target :: local
+ class(rt_data_t), intent(inout), target :: global
+ type(string_t) :: export
+ integer :: i
+ if (local%get_n_export () > 0) then
+ do i = 1, local%get_n_export ()
+ export = local%export(i)
+ select case (char (export))
+ case ("results")
+ call msg_message ("Exporting integration results &
+ &to outer environment")
+ call local%transfer_process_stack (global)
+ case default
+ call msg_bug ("handle exports: '" &
+ // char (export) // "' unsupported")
+ end select
+ end do
+ end if
+ end subroutine rt_data_handle_exports
+
+@ %def rt_data_handle_exports
+@ Export the process stack. One-by-one, take the last process from the local
+stack and push it on the global stack. Also handle the corresponding result
+variables: append if the process did not exist yet in the global stack,
+otherwise update.
+
+TODO: result variables don't work that way yet, require initialization in the
+global variable list.
+<<RT data: rt data: TBP>>=
+ procedure :: transfer_process_stack => rt_data_transfer_process_stack
+<<RT data: procedures>>=
+ subroutine rt_data_transfer_process_stack (local, global)
+ class(rt_data_t), intent(inout), target :: local
+ class(rt_data_t), intent(inout), target :: global
+ type(process_entry_t), pointer :: process
+ type(string_t) :: process_id
+ do
+ call local%process_stack%pop_last (process)
+ if (.not. associated (process)) exit
+ process_id = process%get_id ()
+ call global%process_stack%push (process)
+ call global%process_stack%fill_result_vars (process_id)
+ call global%process_stack%update_result_vars &
+ (process_id, global%var_list)
+ end do
+ end subroutine rt_data_transfer_process_stack
+
+@ %def rt_data_transfer_process_stack
+@
\subsection{Finalization}
Finalizer for the variable list and the structure-function list.
This is done only for the global RT dataset; local copies contain
pointers to this and do not need a finalizer.
<<RT data: rt data: TBP>>=
procedure :: final => rt_data_global_final
<<RT data: procedures>>=
subroutine rt_data_global_final (global)
class(rt_data_t), intent(inout) :: global
call global%process_stack%final ()
call global%prclib_stack%final ()
call global%model_list%final ()
call global%var_list%final (follow_link=.false.)
if (associated (global%out_files)) then
call file_list_final (global%out_files)
deallocate (global%out_files)
end if
end subroutine rt_data_global_final
@ %def rt_data_global_final
@ The local copy needs a finalizer for the variable list, which consists
of local copies. This finalizer is called only when the local
environment is finally discarded. (Note that the process stack should
already have been cleared after execution, which can occur many times
for the same local environment.)
<<RT data: rt data: TBP>>=
procedure :: local_final => rt_data_local_final
<<RT data: procedures>>=
subroutine rt_data_local_final (local)
class(rt_data_t), intent(inout) :: local
call local%process_stack%clear ()
call local%model_list%final ()
call local%var_list%final (follow_link=.false.)
end subroutine rt_data_local_final
@ %def rt_data_local_final
@
\subsection{Model Management}
Read a model, so it becomes available for activation. No variables or model
copies, this is just initialization.
If this is a local environment, the model will be automatically read into the
global context.
<<RT data: rt data: TBP>>=
procedure :: read_model => rt_data_read_model
<<RT data: procedures>>=
subroutine rt_data_read_model (global, name, model, scheme)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: scheme
type(model_t), pointer, intent(out) :: model
type(string_t) :: filename
filename = name // ".mdl"
call global%model_list%read_model &
(name, filename, global%os_data, model, scheme)
end subroutine rt_data_read_model
@ %def rt_data_read_model
@ Read a UFO model. Create it on the fly if necessary.
<<RT data: rt data: TBP>>=
procedure :: read_ufo_model => rt_data_read_ufo_model
<<RT data: procedures>>=
subroutine rt_data_read_ufo_model (global, name, model, ufo_path)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
type(model_t), pointer, intent(out) :: model
type(string_t), intent(in), optional :: ufo_path
type(string_t) :: filename
filename = name // ".ufo.mdl"
call global%model_list%read_model &
(name, filename, global%os_data, model, ufo=.true., ufo_path=ufo_path)
end subroutine rt_data_read_ufo_model
@ %def rt_data_read_ufo_model
@ Initialize the fallback model. This model is used
whenever the current model does not describe all physical particles
(hadrons, mainly). It is not supposed to be modified, and the pointer
should remain linked to this model.
<<RT data: rt data: TBP>>=
procedure :: init_fallback_model => rt_data_init_fallback_model
<<RT data: procedures>>=
subroutine rt_data_init_fallback_model (global, name, filename)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name, filename
call global%model_list%read_model &
(name, filename, global%os_data, global%fallback_model)
end subroutine rt_data_init_fallback_model
@ %def rt_data_init_fallback_model
@
Activate a model: assign the current-model pointer and set the model name in
the variable list. If necessary, read the model from file. Link the global
variable list to the model variable list.
<<RT data: rt data: TBP>>=
procedure :: select_model => rt_data_select_model
<<RT data: procedures>>=
subroutine rt_data_select_model (global, name, scheme, ufo, ufo_path)
class(rt_data_t), intent(inout), target :: global
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: scheme
logical, intent(in), optional :: ufo
type(string_t), intent(in), optional :: ufo_path
logical :: same_model, ufo_model
ufo_model = .false.; if (present (ufo)) ufo_model = ufo
if (associated (global%model)) then
same_model = global%model%matches (name, scheme, ufo)
else
same_model = .false.
end if
if (.not. same_model) then
global%model => global%model_list%get_model_ptr (name, scheme, ufo)
if (.not. associated (global%model)) then
if (ufo_model) then
call global%read_ufo_model (name, global%model, ufo_path)
else
call global%read_model (name, global%model)
end if
global%model_is_copy = .false.
else if (associated (global%context)) then
global%model_is_copy = &
global%model_list%model_exists (name, scheme, ufo, &
follow_link=.false.)
else
global%model_is_copy = .false.
end if
end if
if (associated (global%model)) then
call global%model%link_var_list (global%var_list)
call global%var_list%set_string (var_str ("$model_name"), &
name, is_known = .true.)
if (global%model%is_ufo_model ()) then
call msg_message ("Switching to model '" // char (name) // "' " &
// "(generated from UFO source)")
else if (global%model%has_schemes ()) then
call msg_message ("Switching to model '" // char (name) // "', " &
// "scheme '" // char (global%model%get_scheme ()) // "'")
else
call msg_message ("Switching to model '" // char (name) // "'")
end if
else
call global%var_list%set_string (var_str ("$model_name"), &
var_str (""), is_known = .false.)
end if
end subroutine rt_data_select_model
@ %def rt_data_select_model
@
Remove the model link and unset the model name variable.
<<RT data: rt data: TBP>>=
procedure :: unselect_model => rt_data_unselect_model
<<RT data: procedures>>=
subroutine rt_data_unselect_model (global)
class(rt_data_t), intent(inout), target :: global
if (associated (global%model)) then
global%model => null ()
global%model_is_copy = .false.
call global%var_list%set_string (var_str ("$model_name"), &
var_str (""), is_known = .false.)
end if
end subroutine rt_data_unselect_model
@ %def rt_data_unselect_model
@
Create a copy of the currently selected model and append it to the local model
list. The model pointer is redirected to the copy.
(Not applicable for the global model list, those models will be
modified in-place.)
<<RT data: rt data: TBP>>=
procedure :: ensure_model_copy => rt_data_ensure_model_copy
<<RT data: procedures>>=
subroutine rt_data_ensure_model_copy (global)
class(rt_data_t), intent(inout), target :: global
if (associated (global%context)) then
if (.not. global%model_is_copy) then
call global%model_list%append_copy (global%model, global%model)
global%model_is_copy = .true.
call global%model%link_var_list (global%var_list)
end if
end if
end subroutine rt_data_ensure_model_copy
@ %def rt_data_ensure_model_copy
@
Modify a model variable. The update mechanism will ensure that the model
parameter set remains consistent. This has to take place in a local copy
of the current model. If there is none yet, create one.
<<RT data: rt data: TBP>>=
procedure :: model_set_real => rt_data_model_set_real
<<RT data: procedures>>=
subroutine rt_data_model_set_real (global, name, rval, verbose, pacified)
class(rt_data_t), intent(inout), target :: global
type(string_t), intent(in) :: name
real(default), intent(in) :: rval
logical, intent(in), optional :: verbose, pacified
call global%ensure_model_copy ()
call global%model%set_real (name, rval, verbose, pacified)
end subroutine rt_data_model_set_real
@ %def rt_data_model_set_real
@
Modify particle properties. This has to take place in a local copy
of the current model. If there is none yet, create one.
<<RT data: rt data: TBP>>=
procedure :: modify_particle => rt_data_modify_particle
<<RT data: procedures>>=
subroutine rt_data_modify_particle &
(global, pdg, polarized, stable, decay, &
isotropic_decay, diagonal_decay, decay_helicity)
class(rt_data_t), intent(inout), target :: global
integer, intent(in) :: pdg
logical, intent(in), optional :: polarized, stable
logical, intent(in), optional :: isotropic_decay, diagonal_decay
integer, intent(in), optional :: decay_helicity
type(string_t), dimension(:), intent(in), optional :: decay
call global%ensure_model_copy ()
if (present (polarized)) then
if (polarized) then
call global%model%set_polarized (pdg)
else
call global%model%set_unpolarized (pdg)
end if
end if
if (present (stable)) then
if (stable) then
call global%model%set_stable (pdg)
else if (present (decay)) then
call global%model%set_unstable &
(pdg, decay, isotropic_decay, diagonal_decay, decay_helicity)
else
call msg_bug ("Setting particle unstable: missing decay processes")
end if
end if
end subroutine rt_data_modify_particle
@ %def rt_data_modify_particle
@
\subsection{Managing Variables}
Return a pointer to the currently active variable list. If there is no model,
this is the global variable list. If there is one, it is the model variable
list, which should be linked to the former.
<<RT data: rt data: TBP>>=
procedure :: get_var_list_ptr => rt_data_get_var_list_ptr
<<RT data: procedures>>=
function rt_data_get_var_list_ptr (global) result (var_list)
class(rt_data_t), intent(in), target :: global
type(var_list_t), pointer :: var_list
if (associated (global%model)) then
var_list => global%model%get_var_list_ptr ()
else
var_list => global%var_list
end if
end function rt_data_get_var_list_ptr
@ %def rt_data_get_var_list_ptr
@ Initialize a local variable: append it to the current variable list. No
initial value, yet.
<<RT data: rt data: TBP>>=
procedure :: append_log => rt_data_append_log
procedure :: append_int => rt_data_append_int
procedure :: append_real => rt_data_append_real
procedure :: append_cmplx => rt_data_append_cmplx
procedure :: append_subevt => rt_data_append_subevt
procedure :: append_pdg_array => rt_data_append_pdg_array
procedure :: append_string => rt_data_append_string
<<RT data: procedures>>=
subroutine rt_data_append_log (local, name, lval, intrinsic, user)
class(rt_data_t), intent(inout) :: local
type(string_t), intent(in) :: name
logical, intent(in), optional :: lval
logical, intent(in), optional :: intrinsic, user
call local%var_list%append_log (name, lval, &
intrinsic = intrinsic, user = user)
end subroutine rt_data_append_log
subroutine rt_data_append_int (local, name, ival, intrinsic, user)
class(rt_data_t), intent(inout) :: local
type(string_t), intent(in) :: name
integer, intent(in), optional :: ival
logical, intent(in), optional :: intrinsic, user
call local%var_list%append_int (name, ival, &
intrinsic = intrinsic, user = user)
end subroutine rt_data_append_int
subroutine rt_data_append_real (local, name, rval, intrinsic, user)
class(rt_data_t), intent(inout) :: local
type(string_t), intent(in) :: name
real(default), intent(in), optional :: rval
logical, intent(in), optional :: intrinsic, user
call local%var_list%append_real (name, rval, &
intrinsic = intrinsic, user = user)
end subroutine rt_data_append_real
subroutine rt_data_append_cmplx (local, name, cval, intrinsic, user)
class(rt_data_t), intent(inout) :: local
type(string_t), intent(in) :: name
complex(default), intent(in), optional :: cval
logical, intent(in), optional :: intrinsic, user
call local%var_list%append_cmplx (name, cval, &
intrinsic = intrinsic, user = user)
end subroutine rt_data_append_cmplx
subroutine rt_data_append_subevt (local, name, pval, intrinsic, user)
class(rt_data_t), intent(inout) :: local
type(string_t), intent(in) :: name
type(subevt_t), intent(in), optional :: pval
logical, intent(in) :: intrinsic, user
call local%var_list%append_subevt (name, &
intrinsic = intrinsic, user = user)
end subroutine rt_data_append_subevt
subroutine rt_data_append_pdg_array (local, name, aval, intrinsic, user)
class(rt_data_t), intent(inout) :: local
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in), optional :: aval
logical, intent(in), optional :: intrinsic, user
call local%var_list%append_pdg_array (name, aval, &
intrinsic = intrinsic, user = user)
end subroutine rt_data_append_pdg_array
subroutine rt_data_append_string (local, name, sval, intrinsic, user)
class(rt_data_t), intent(inout) :: local
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: sval
logical, intent(in), optional :: intrinsic, user
call local%var_list%append_string (name, sval, &
intrinsic = intrinsic, user = user)
end subroutine rt_data_append_string
@ %def rt_data_append_log
@ %def rt_data_append_int
@ %def rt_data_append_real
@ %def rt_data_append_cmplx
@ %def rt_data_append_subevt
@ %def rt_data_append_pdg_array
@ %def rt_data_append_string
@ Import values for all local variables, given a global context environment
where these variables are defined.
<<RT data: rt data: TBP>>=
procedure :: import_values => rt_data_import_values
<<RT data: procedures>>=
subroutine rt_data_import_values (local)
class(rt_data_t), intent(inout) :: local
type(rt_data_t), pointer :: global
global => local%context
if (associated (global)) then
call local%var_list%import (global%var_list)
end if
end subroutine rt_data_import_values
@ %def rt_data_import_values
@ Unset all variable values.
<<RT data: rt data: TBP>>=
procedure :: unset_values => rt_data_unset_values
<<RT data: procedures>>=
subroutine rt_data_unset_values (global)
class(rt_data_t), intent(inout) :: global
call global%var_list%undefine (follow_link=.false.)
end subroutine rt_data_unset_values
@ %def rt_data_unset_values
@ Set a variable. (Not a model variable, these are handled separately.) We
can assume that the variable has been initialized.
<<RT data: rt data: TBP>>=
procedure :: set_log => rt_data_set_log
procedure :: set_int => rt_data_set_int
procedure :: set_real => rt_data_set_real
procedure :: set_cmplx => rt_data_set_cmplx
procedure :: set_subevt => rt_data_set_subevt
procedure :: set_pdg_array => rt_data_set_pdg_array
procedure :: set_string => rt_data_set_string
<<RT data: procedures>>=
subroutine rt_data_set_log &
(global, name, lval, is_known, force, verbose)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
logical, intent(in) :: lval
logical, intent(in) :: is_known
logical, intent(in), optional :: force, verbose
call global%var_list%set_log (name, lval, is_known, &
force=force, verbose=verbose)
end subroutine rt_data_set_log
subroutine rt_data_set_int &
(global, name, ival, is_known, force, verbose)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
integer, intent(in) :: ival
logical, intent(in) :: is_known
logical, intent(in), optional :: force, verbose
call global%var_list%set_int (name, ival, is_known, &
force=force, verbose=verbose)
end subroutine rt_data_set_int
subroutine rt_data_set_real &
(global, name, rval, is_known, force, verbose, pacified)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
real(default), intent(in) :: rval
logical, intent(in) :: is_known
logical, intent(in), optional :: force, verbose, pacified
call global%var_list%set_real (name, rval, is_known, &
force=force, verbose=verbose, pacified=pacified)
end subroutine rt_data_set_real
subroutine rt_data_set_cmplx &
(global, name, cval, is_known, force, verbose, pacified)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
complex(default), intent(in) :: cval
logical, intent(in) :: is_known
logical, intent(in), optional :: force, verbose, pacified
call global%var_list%set_cmplx (name, cval, is_known, &
force=force, verbose=verbose, pacified=pacified)
end subroutine rt_data_set_cmplx
subroutine rt_data_set_subevt &
(global, name, pval, is_known, force, verbose)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
type(subevt_t), intent(in) :: pval
logical, intent(in) :: is_known
logical, intent(in), optional :: force, verbose
call global%var_list%set_subevt (name, pval, is_known, &
force=force, verbose=verbose)
end subroutine rt_data_set_subevt
subroutine rt_data_set_pdg_array &
(global, name, aval, is_known, force, verbose)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
type(pdg_array_t), intent(in) :: aval
logical, intent(in) :: is_known
logical, intent(in), optional :: force, verbose
call global%var_list%set_pdg_array (name, aval, is_known, &
force=force, verbose=verbose)
end subroutine rt_data_set_pdg_array
subroutine rt_data_set_string &
(global, name, sval, is_known, force, verbose)
class(rt_data_t), intent(inout) :: global
type(string_t), intent(in) :: name
type(string_t), intent(in) :: sval
logical, intent(in) :: is_known
logical, intent(in), optional :: force, verbose
call global%var_list%set_string (name, sval, is_known, &
force=force, verbose=verbose)
end subroutine rt_data_set_string
@ %def rt_data_set_log
@ %def rt_data_set_int
@ %def rt_data_set_real
@ %def rt_data_set_cmplx
@ %def rt_data_set_subevt
@ %def rt_data_set_pdg_array
@ %def rt_data_set_string
@ Return the value of a variable, assuming that the type is correct.
<<RT data: rt data: TBP>>=
procedure :: get_lval => rt_data_get_lval
procedure :: get_ival => rt_data_get_ival
procedure :: get_rval => rt_data_get_rval
procedure :: get_cval => rt_data_get_cval
procedure :: get_pval => rt_data_get_pval
procedure :: get_aval => rt_data_get_aval
procedure :: get_sval => rt_data_get_sval
<<RT data: procedures>>=
function rt_data_get_lval (global, name) result (lval)
logical :: lval
class(rt_data_t), intent(in), target :: global
type(string_t), intent(in) :: name
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
lval = var_list%get_lval (name)
end function rt_data_get_lval
function rt_data_get_ival (global, name) result (ival)
integer :: ival
class(rt_data_t), intent(in), target :: global
type(string_t), intent(in) :: name
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
ival = var_list%get_ival (name)
end function rt_data_get_ival
function rt_data_get_rval (global, name) result (rval)
real(default) :: rval
class(rt_data_t), intent(in), target :: global
type(string_t), intent(in) :: name
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
rval = var_list%get_rval (name)
end function rt_data_get_rval
function rt_data_get_cval (global, name) result (cval)
complex(default) :: cval
class(rt_data_t), intent(in), target :: global
type(string_t), intent(in) :: name
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
cval = var_list%get_cval (name)
end function rt_data_get_cval
function rt_data_get_aval (global, name) result (aval)
type(pdg_array_t) :: aval
class(rt_data_t), intent(in), target :: global
type(string_t), intent(in) :: name
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
aval = var_list%get_aval (name)
end function rt_data_get_aval
function rt_data_get_pval (global, name) result (pval)
type(subevt_t) :: pval
class(rt_data_t), intent(in), target :: global
type(string_t), intent(in) :: name
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
pval = var_list%get_pval (name)
end function rt_data_get_pval
function rt_data_get_sval (global, name) result (sval)
type(string_t) :: sval
class(rt_data_t), intent(in), target :: global
type(string_t), intent(in) :: name
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
sval = var_list%get_sval (name)
end function rt_data_get_sval
@ %def rt_data_get_lval
@ %def rt_data_get_ival
@ %def rt_data_get_rval
@ %def rt_data_get_cval
@ %def rt_data_get_pval
@ %def rt_data_get_aval
@ %def rt_data_get_sval
@ Return true if the variable exists in the global list.
<<RT data: rt data: TBP>>=
procedure :: contains => rt_data_contains
<<RT data: procedures>>=
function rt_data_contains (global, name) result (lval)
logical :: lval
class(rt_data_t), intent(in) :: global
type(string_t), intent(in) :: name
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
lval = var_list%contains (name)
end function rt_data_contains
@ %def rt_data_contains
@
\subsection{Further Content}
Add a library (available via a pointer of type [[prclib_entry_t]]) to
the stack and update the pointer and variable list to the current
library. The pointer association of [[prclib_entry]] will be discarded.
<<RT data: rt data: TBP>>=
procedure :: add_prclib => rt_data_add_prclib
<<RT data: procedures>>=
subroutine rt_data_add_prclib (global, prclib_entry)
class(rt_data_t), intent(inout) :: global
type(prclib_entry_t), intent(inout), pointer :: prclib_entry
call global%prclib_stack%push (prclib_entry)
call global%update_prclib (global%prclib_stack%get_first_ptr ())
end subroutine rt_data_add_prclib
@ %def rt_data_add_prclib
@ Given a pointer to a process library, make this the currently active
library.
<<RT data: rt data: TBP>>=
procedure :: update_prclib => rt_data_update_prclib
<<RT data: procedures>>=
subroutine rt_data_update_prclib (global, lib)
class(rt_data_t), intent(inout) :: global
type(process_library_t), intent(in), target :: lib
global%prclib => lib
if (global%var_list%contains (&
var_str ("$library_name"), follow_link = .false.)) then
call global%var_list%set_string (var_str ("$library_name"), &
global%prclib%get_name (), is_known=.true.)
else
call global%var_list%append_string ( &
var_str ("$library_name"), global%prclib%get_name (), &
intrinsic = .true.)
end if
end subroutine rt_data_update_prclib
@ %def rt_data_update_prclib
@
\subsection{Miscellaneous}
The helicity selection data are distributed among several parameters. Here,
we collect them in a single record.
<<RT data: rt data: TBP>>=
procedure :: get_helicity_selection => rt_data_get_helicity_selection
<<RT data: procedures>>=
function rt_data_get_helicity_selection (rt_data) result (helicity_selection)
class(rt_data_t), intent(in) :: rt_data
type(helicity_selection_t) :: helicity_selection
associate (var_list => rt_data%var_list)
helicity_selection%active = var_list%get_lval (&
var_str ("?helicity_selection_active"))
if (helicity_selection%active) then
helicity_selection%threshold = var_list%get_rval (&
var_str ("helicity_selection_threshold"))
helicity_selection%cutoff = var_list%get_ival (&
var_str ("helicity_selection_cutoff"))
end if
end associate
end function rt_data_get_helicity_selection
@ %def rt_data_get_helicity_selection
@ Show the beam setup: beam structure and relevant global variables.
<<RT data: rt data: TBP>>=
procedure :: show_beams => rt_data_show_beams
<<RT data: procedures>>=
subroutine rt_data_show_beams (rt_data, unit)
class(rt_data_t), intent(in) :: rt_data
integer, intent(in), optional :: unit
type(string_t) :: s
integer :: u
u = given_output_unit (unit)
associate (beams => rt_data%beam_structure, var_list => rt_data%var_list)
call beams%write (u)
if (.not. beams%asymmetric () .and. beams%get_n_beam () == 2) then
write (u, "(2x,A," // FMT_19 // ",1x,'GeV')") "sqrts =", &
var_list%get_rval (var_str ("sqrts"))
end if
if (beams%contains ("pdf_builtin")) then
s = var_list%get_sval (var_str ("$pdf_builtin_set"))
if (s /= "") then
write (u, "(2x,A,1x,3A)") "PDF set =", '"', char (s), '"'
else
write (u, "(2x,A,1x,A)") "PDF set =", "[undefined]"
end if
end if
if (beams%contains ("lhapdf")) then
s = var_list%get_sval (var_str ("$lhapdf_dir"))
if (s /= "") then
write (u, "(2x,A,1x,3A)") "LHAPDF dir =", '"', char (s), '"'
end if
s = var_list%get_sval (var_str ("$lhapdf_file"))
if (s /= "") then
write (u, "(2x,A,1x,3A)") "LHAPDF file =", '"', char (s), '"'
write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
var_list%get_ival (var_str ("lhapdf_member"))
else
write (u, "(2x,A,1x,A)") "LHAPDF file =", "[undefined]"
end if
end if
if (beams%contains ("lhapdf_photon")) then
s = var_list%get_sval (var_str ("$lhapdf_dir"))
if (s /= "") then
write (u, "(2x,A,1x,3A)") "LHAPDF dir =", '"', char (s), '"'
end if
s = var_list%get_sval (var_str ("$lhapdf_photon_file"))
if (s /= "") then
write (u, "(2x,A,1x,3A)") "LHAPDF file =", '"', char (s), '"'
write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
var_list%get_ival (var_str ("lhapdf_member"))
write (u, "(2x,A,1x,I0)") "LHAPDF scheme =", &
var_list%get_ival (&
var_str ("lhapdf_photon_scheme"))
else
write (u, "(2x,A,1x,A)") "LHAPDF file =", "[undefined]"
end if
end if
if (beams%contains ("isr")) then
write (u, "(2x,A," // FMT_19 // ")") "ISR alpha =", &
var_list%get_rval (var_str ("isr_alpha"))
write (u, "(2x,A," // FMT_19 // ")") "ISR Q max =", &
var_list%get_rval (var_str ("isr_q_max"))
write (u, "(2x,A," // FMT_19 // ")") "ISR mass =", &
var_list%get_rval (var_str ("isr_mass"))
write (u, "(2x,A,1x,I0)") "ISR order =", &
var_list%get_ival (var_str ("isr_order"))
write (u, "(2x,A,1x,L1)") "ISR recoil =", &
var_list%get_lval (var_str ("?isr_recoil"))
write (u, "(2x,A,1x,L1)") "ISR energy cons. =", &
var_list%get_lval (var_str ("?isr_keep_energy"))
end if
if (beams%contains ("epa")) then
write (u, "(2x,A," // FMT_19 // ")") "EPA alpha =", &
var_list%get_rval (var_str ("epa_alpha"))
write (u, "(2x,A," // FMT_19 // ")") "EPA x min =", &
var_list%get_rval (var_str ("epa_x_min"))
write (u, "(2x,A," // FMT_19 // ")") "EPA Q min =", &
var_list%get_rval (var_str ("epa_q_min"))
write (u, "(2x,A," // FMT_19 // ")") "EPA E max =", &
var_list%get_rval (var_str ("epa_e_max"))
write (u, "(2x,A," // FMT_19 // ")") "EPA mass =", &
var_list%get_rval (var_str ("epa_mass"))
write (u, "(2x,A,1x,L1)") "EPA recoil =", &
var_list%get_lval (var_str ("?epa_recoil"))
write (u, "(2x,A,1x,L1)") "EPA energy cons. =", &
var_list%get_lval (var_str ("?epa_keep_energy"))
end if
if (beams%contains ("ewa")) then
write (u, "(2x,A," // FMT_19 // ")") "EWA x min =", &
var_list%get_rval (var_str ("ewa_x_min"))
write (u, "(2x,A," // FMT_19 // ")") "EWA Pt max =", &
var_list%get_rval (var_str ("ewa_pt_max"))
write (u, "(2x,A," // FMT_19 // ")") "EWA mass =", &
var_list%get_rval (var_str ("ewa_mass"))
write (u, "(2x,A,1x,L1)") "EWA recoil =", &
var_list%get_lval (var_str ("?ewa_recoil"))
write (u, "(2x,A,1x,L1)") "EWA energy cons. =", &
var_list%get_lval (var_str ("ewa_keep_energy"))
end if
if (beams%contains ("circe1")) then
write (u, "(2x,A,1x,I0)") "CIRCE1 version =", &
var_list%get_ival (var_str ("circe1_ver"))
write (u, "(2x,A,1x,I0)") "CIRCE1 revision =", &
var_list%get_ival (var_str ("circe1_rev"))
s = var_list%get_sval (var_str ("$circe1_acc"))
write (u, "(2x,A,1x,A)") "CIRCE1 acceler. =", char (s)
write (u, "(2x,A,1x,I0)") "CIRCE1 chattin. =", &
var_list%get_ival (var_str ("circe1_chat"))
write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 sqrts =", &
var_list%get_rval (var_str ("circe1_sqrts"))
write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 epsil. =", &
var_list%get_rval (var_str ("circe1_eps"))
write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 1 =", &
var_list%get_lval (var_str ("?circe1_photon1"))
write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 2 =", &
var_list%get_lval (var_str ("?circe1_photon2"))
write (u, "(2x,A,1x,L1)") "CIRCE1 generat. =", &
var_list%get_lval (var_str ("?circe1_generate"))
write (u, "(2x,A,1x,L1)") "CIRCE1 mapping =", &
var_list%get_lval (var_str ("?circe1_map"))
write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 map. slope =", &
var_list%get_rval (var_str ("circe1_mapping_slope"))
write (u, "(2x,A,1x,L1)") "CIRCE recoil photon =", &
var_list%get_lval (var_str ("?circe1_with_radiation"))
end if
if (beams%contains ("circe2")) then
s = var_list%get_sval (var_str ("$circe2_design"))
write (u, "(2x,A,1x,A)") "CIRCE2 design =", char (s)
s = var_list%get_sval (var_str ("$circe2_file"))
write (u, "(2x,A,1x,A)") "CIRCE2 file =", char (s)
write (u, "(2x,A,1x,L1)") "CIRCE2 polarized =", &
var_list%get_lval (var_str ("?circe2_polarized"))
end if
if (beams%contains ("gaussian")) then
write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 1 =", &
var_list%get_rval (var_str ("gaussian_spread1"))
write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 2 =", &
var_list%get_rval (var_str ("gaussian_spread2"))
end if
if (beams%contains ("beam_events")) then
s = var_list%get_sval (var_str ("$beam_events_file"))
write (u, "(2x,A,1x,A)") "Beam events file =", char (s)
write (u, "(2x,A,1x,L1)") "Beam events EOF warn =", &
var_list%get_lval (var_str ("?beam_events_warn_eof"))
end if
end associate
end subroutine rt_data_show_beams
@ %def rt_data_show_beams
@ Return the collision energy as determined by the current beam
settings. Without beam setup, this is the [[sqrts]] variable.
If the value is meaningless for a setup, the function returns zero.
<<RT data: rt data: TBP>>=
procedure :: get_sqrts => rt_data_get_sqrts
<<RT data: procedures>>=
function rt_data_get_sqrts (rt_data) result (sqrts)
class(rt_data_t), intent(in) :: rt_data
real(default) :: sqrts
sqrts = rt_data%var_list%get_rval (var_str ("sqrts"))
end function rt_data_get_sqrts
@ %def rt_data_get_sqrts
@ For testing purposes, the [[rt_data_t]] contents can be pacified to
suppress numerical fluctuations in (constant) test matrix elements.
<<RT data: rt data: TBP>>=
procedure :: pacify => rt_data_pacify
<<RT data: procedures>>=
subroutine rt_data_pacify (rt_data, efficiency_reset, error_reset)
class(rt_data_t), intent(inout) :: rt_data
logical, intent(in), optional :: efficiency_reset, error_reset
type(process_entry_t), pointer :: process
process => rt_data%process_stack%first
do while (associated (process))
call process%pacify (efficiency_reset, error_reset)
process => process%next
end do
end subroutine rt_data_pacify
@ %def rt_data_pacify
@
<<RT data: rt data: TBP>>=
procedure :: set_event_callback => rt_data_set_event_callback
<<RT data: procedures>>=
subroutine rt_data_set_event_callback (global, callback)
class(rt_data_t), intent(inout) :: global
class(event_callback_t), intent(in) :: callback
if (allocated (global%event_callback)) deallocate (global%event_callback)
allocate (global%event_callback, source = callback)
end subroutine rt_data_set_event_callback
@ %def rt_data_set_event_callback
@
<<RT data: rt data: TBP>>=
procedure :: has_event_callback => rt_data_has_event_callback
procedure :: get_event_callback => rt_data_get_event_callback
<<RT data: procedures>>=
function rt_data_has_event_callback (global) result (flag)
class(rt_data_t), intent(in) :: global
logical :: flag
flag = allocated (global%event_callback)
end function rt_data_has_event_callback
function rt_data_get_event_callback (global) result (callback)
class(rt_data_t), intent(in) :: global
class(event_callback_t), allocatable :: callback
if (allocated (global%event_callback)) then
allocate (callback, source = global%event_callback)
end if
end function rt_data_get_event_callback
@ %def rt_data_has_event_callback
@ %def rt_data_get_event_callback
@ Force system-dependent objects to well-defined values. Some of the
variables are locked and therefore must be addressed directly.
This is, of course, only required for testing purposes. In principle,
the [[real_specimen]] variables could be set to their values in
[[rt_data_t]], but this depends on the precision again, so we set
them to some dummy values.
<<RT data: public>>=
public :: fix_system_dependencies
<<RT data: procedures>>=
subroutine fix_system_dependencies (global)
class(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
call var_list%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true., force=.true.)
call var_list%set_log (var_str ("?openmp_is_active"), &
.false., is_known = .true., force=.true.)
call var_list%set_int (var_str ("openmp_num_threads_default"), &
1, is_known = .true., force=.true.)
call var_list%set_int (var_str ("openmp_num_threads"), &
1, is_known = .true., force=.true.)
call var_list%set_int (var_str ("real_range"), &
307, is_known = .true., force=.true.)
call var_list%set_int (var_str ("real_precision"), &
15, is_known = .true., force=.true.)
call var_list%set_real (var_str ("real_epsilon"), &
1.e-16_default, is_known = .true., force=.true.)
call var_list%set_real (var_str ("real_tiny"), &
1.e-300_default, is_known = .true., force=.true.)
global%os_data%fc = "Fortran-compiler"
global%os_data%fcflags = "Fortran-flags"
end subroutine fix_system_dependencies
@ %def fix_system_dependencies
@
<<RT data: public>>=
public :: show_description_of_string
<<RT data: procedures>>=
subroutine show_description_of_string (string)
type(string_t), intent(in) :: string
type(rt_data_t), target :: global
call global%global_init ()
call global%show_description_of_string (string, ascii_output=.true.)
end subroutine show_description_of_string
@ %def show_description_of_string
@
<<RT data: public>>=
public :: show_tex_descriptions
<<RT data: procedures>>=
subroutine show_tex_descriptions ()
type(rt_data_t), target :: global
call global%global_init ()
call fix_system_dependencies (global)
call global%set_int (var_str ("seed"), 0, is_known=.true.)
call global%var_list%sort ()
call global%write_var_descriptions ()
end subroutine show_tex_descriptions
@ %def show_tex_descriptions
@
\subsection{Unit Tests}
Test module, followed by the corresponding implementation module.
<<[[rt_data_ut.f90]]>>=
<<File header>>
module rt_data_ut
use unit_tests
use rt_data_uti
<<Standard module head>>
<<RT data: public test>>
contains
<<RT data: test driver>>
end module rt_data_ut
@ %def rt_data_ut
@
<<[[rt_data_uti.f90]]>>=
<<File header>>
module rt_data_uti
<<Use kinds>>
<<Use strings>>
use format_defs, only: FMT_19
use ifiles
use lexers
use parser
use flavors
use variables, only: var_list_t, var_entry_t, var_entry_init_int
use eval_trees
use models
use prclib_stacks
use rt_data
<<Standard module head>>
<<RT data: test declarations>>
contains
<<RT data: test auxiliary>>
<<RT data: tests>>
end module rt_data_uti
@ %def rt_data_ut
@ API: driver for the unit tests below.
<<RT data: public test>>=
public :: rt_data_test
<<RT data: test driver>>=
subroutine rt_data_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<RT data: execute tests>>
end subroutine rt_data_test
@ %def rt_data_test
@
\subsubsection{Initial content}
@
Display the RT data in the state just after (global) initialization.
<<RT data: execute tests>>=
call test (rt_data_1, "rt_data_1", &
"initialize", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_1
<<RT data: tests>>=
subroutine rt_data_1 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: rt_data_1"
write (u, "(A)") "* Purpose: initialize global runtime data"
write (u, "(A)")
call global%global_init (logfile = var_str ("rt_data.log"))
call fix_system_dependencies (global)
call global%set_int (var_str ("seed"), 0, is_known=.true.)
call global%it_list%init ([2, 3], [5000, 20000])
call global%write (u)
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_1"
end subroutine rt_data_1
@ %def rt_data_1
@
\subsubsection{Fill values}
Fill in empty slots in the runtime data block.
<<RT data: execute tests>>=
call test (rt_data_2, "rt_data_2", &
"fill", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_2
<<RT data: tests>>=
subroutine rt_data_2 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
type(flavor_t), dimension(2) :: flv
type(string_t) :: cut_expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: parse_tree
write (u, "(A)") "* Test output: rt_data_2"
write (u, "(A)") "* Purpose: initialize global runtime data &
&and fill contents"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call fix_system_dependencies (global)
call global%select_model (var_str ("Test"))
call global%set_real (var_str ("sqrts"), &
1000._default, is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call flv%init ([25,25], global%model)
call global%set_string (var_str ("$run_id"), &
var_str ("run1"), is_known = .true.)
call global%set_real (var_str ("luminosity"), &
33._default, is_known = .true.)
call syntax_pexpr_init ()
cut_expr_text = "all Pt > 100 [s]"
call ifile_append (ifile, cut_expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (parse_tree, stream, .true.)
global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
allocate (global%sample_fmt (2))
global%sample_fmt(1) = "foo_fmt"
global%sample_fmt(2) = "bar_fmt"
call global%write (u)
call parse_tree_final (parse_tree)
call stream_final (stream)
call ifile_final (ifile)
call syntax_pexpr_final ()
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_2"
end subroutine rt_data_2
@ %def rt_data_2
@
\subsubsection{Save and restore}
Set up a local runtime data block, change some contents, restore the
global block.
<<RT data: execute tests>>=
call test (rt_data_3, "rt_data_3", &
"save/restore", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_3
<<RT data: tests>>=
subroutine rt_data_3 (u)
use event_base, only: event_callback_nop_t
integer, intent(in) :: u
type(rt_data_t), target :: global, local
type(flavor_t), dimension(2) :: flv
type(string_t) :: cut_expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: parse_tree
type(prclib_entry_t), pointer :: lib
type(event_callback_nop_t) :: event_callback_nop
write (u, "(A)") "* Test output: rt_data_3"
write (u, "(A)") "* Purpose: initialize global runtime data &
&and fill contents;"
write (u, "(A)") "* copy to local block and back"
write (u, "(A)")
write (u, "(A)") "* Init global data"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call fix_system_dependencies (global)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%select_model (var_str ("Test"))
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call flv%init ([25,25], global%model)
call global%beam_structure%init_sf (flv%get_name (), [1])
call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))
call global%set_string (var_str ("$run_id"), &
var_str ("run1"), is_known = .true.)
call global%set_real (var_str ("luminosity"), &
33._default, is_known = .true.)
call syntax_pexpr_init ()
cut_expr_text = "all Pt > 100 [s]"
call ifile_append (ifile, cut_expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (parse_tree, stream, .true.)
global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
allocate (global%sample_fmt (2))
global%sample_fmt(1) = "foo_fmt"
global%sample_fmt(2) = "bar_fmt"
allocate (lib)
call lib%init (var_str ("library_1"))
call global%add_prclib (lib)
write (u, "(A)") "* Init and modify local data"
write (u, "(A)")
call local%local_init (global)
call local%append_string (var_str ("$integration_method"), intrinsic=.true.)
call local%append_string (var_str ("$phs_method"), intrinsic=.true.)
call local%activate ()
write (u, "(1x,A,L1)") "model associated = ", associated (local%model)
write (u, "(1x,A,L1)") "library associated = ", associated (local%prclib)
write (u, *)
call local%model_set_real (var_str ("ms"), 150._default)
call local%set_string (var_str ("$integration_method"), &
var_str ("midpoint"), is_known = .true.)
call local%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
local%os_data%fc = "Local compiler"
allocate (lib)
call lib%init (var_str ("library_2"))
call local%add_prclib (lib)
call local%set_event_callback (event_callback_nop)
call local%write (u)
write (u, "(A)")
write (u, "(A)") "* Restore global data"
write (u, "(A)")
call local%deactivate (global)
write (u, "(1x,A,L1)") "model associated = ", associated (global%model)
write (u, "(1x,A,L1)") "library associated = ", associated (global%prclib)
write (u, *)
call global%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call parse_tree_final (parse_tree)
call stream_final (stream)
call ifile_final (ifile)
call syntax_pexpr_final ()
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_3"
end subroutine rt_data_3
@ %def rt_data_3
@
\subsubsection{Show variables}
Display selected variables in the global record.
<<RT data: execute tests>>=
call test (rt_data_4, "rt_data_4", &
"show variables", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_4
<<RT data: tests>>=
subroutine rt_data_4 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
type(string_t), dimension(0) :: empty_string_array
write (u, "(A)") "* Test output: rt_data_4"
write (u, "(A)") "* Purpose: display selected variables"
write (u, "(A)")
call global%global_init ()
write (u, "(A)") "* No variables:"
write (u, "(A)")
call global%write_vars (u, empty_string_array)
write (u, "(A)") "* Two variables:"
write (u, "(A)")
call global%write_vars (u, &
[var_str ("?unweighted"), var_str ("$phs_method")])
write (u, "(A)")
write (u, "(A)") "* Display whole record with selected variables"
write (u, "(A)")
call global%write (u, &
vars = [var_str ("?unweighted"), var_str ("$phs_method")])
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_4"
end subroutine rt_data_4
@ %def rt_data_4
@
\subsubsection{Show parts}
Display only selected parts in the state just after (global) initialization.
<<RT data: execute tests>>=
call test (rt_data_5, "rt_data_5", &
"show parts", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_5
<<RT data: tests>>=
subroutine rt_data_5 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: rt_data_5"
write (u, "(A)") "* Purpose: display parts of rt data"
write (u, "(A)")
call global%global_init ()
call global%write_libraries (u)
write (u, "(A)")
call global%write_beams (u)
write (u, "(A)")
call global%write_process_stack (u)
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_5"
end subroutine rt_data_5
@ %def rt_data_5
@
\subsubsection{Local Model}
Locally modify a model and restore the global one. We need an auxiliary
function to determine the status of a model particle:
<<RT data: test auxiliary>>=
function is_stable (pdg, global) result (flag)
integer, intent(in) :: pdg
type(rt_data_t), intent(in) :: global
logical :: flag
type(flavor_t) :: flv
call flv%init (pdg, global%model)
flag = flv%is_stable ()
end function is_stable
function is_polarized (pdg, global) result (flag)
integer, intent(in) :: pdg
type(rt_data_t), intent(in) :: global
logical :: flag
type(flavor_t) :: flv
call flv%init (pdg, global%model)
flag = flv%is_polarized ()
end function is_polarized
@ %def is_stable is_polarized
<<RT data: execute tests>>=
call test (rt_data_6, "rt_data_6", &
"local model", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_6
<<RT data: tests>>=
subroutine rt_data_6 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global, local
type(var_list_t), pointer :: model_vars
type(string_t) :: var_name
write (u, "(A)") "* Test output: rt_data_6"
write (u, "(A)") "* Purpose: apply and keep local modifications to model"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%select_model (var_str ("Test"))
write (u, "(A)") "* Original model"
write (u, "(A)")
call global%write_model_list (u)
write (u, *)
write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)
write (u, *)
var_name = "ff"
write (u, "(A)", advance="no") "Global model variable: "
model_vars => global%model%get_var_list_ptr ()
call model_vars%write_var (var_name, u)
write (u, "(A)")
write (u, "(A)") "* Apply local modifications: unstable"
write (u, "(A)")
call local%local_init (global)
call local%activate ()
call local%model_set_real (var_name, 0.4_default)
call local%modify_particle (25, stable = .false., decay = [var_str ("d1")])
call local%modify_particle (6, stable = .false., &
decay = [var_str ("f1")], isotropic_decay = .true.)
call local%modify_particle (-6, stable = .false., &
decay = [var_str ("f2"), var_str ("f3")], diagonal_decay = .true.)
call local%model%write (u)
write (u, "(A)")
write (u, "(A)") "* Further modifications"
write (u, "(A)")
call local%modify_particle (6, stable = .false., &
decay = [var_str ("f1")], &
diagonal_decay = .true., isotropic_decay = .false.)
call local%modify_particle (-6, stable = .false., &
decay = [var_str ("f2"), var_str ("f3")], &
diagonal_decay = .false., isotropic_decay = .true.)
call local%model%write (u)
write (u, "(A)")
write (u, "(A)") "* Further modifications: f stable but polarized"
write (u, "(A)")
call local%modify_particle (6, stable = .true., polarized = .true.)
call local%modify_particle (-6, stable = .true.)
call local%model%write (u)
write (u, "(A)")
write (u, "(A)") "* Global model"
write (u, "(A)")
call global%model%write (u)
write (u, *)
write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)
write (u, "(A)")
write (u, "(A)") "* Local model"
write (u, "(A)")
call local%model%write (u)
write (u, *)
write (u, "(A,L1)") "s is stable = ", is_stable (25, local)
write (u, "(A,L1)") "f is polarized = ", is_polarized (6, local)
write (u, *)
write (u, "(A)", advance="no") "Global model variable: "
model_vars => global%model%get_var_list_ptr ()
call model_vars%write_var (var_name, u)
write (u, "(A)", advance="no") "Local model variable: "
associate (model_var_list_ptr => local%model%get_var_list_ptr())
call model_var_list_ptr%write_var (var_name, u)
end associate
write (u, "(A)")
write (u, "(A)") "* Restore global"
call local%deactivate (global, keep_local = .true.)
write (u, "(A)")
write (u, "(A)") "* Global model"
write (u, "(A)")
call global%model%write (u)
write (u, *)
write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)
write (u, "(A)")
write (u, "(A)") "* Local model"
write (u, "(A)")
call local%model%write (u)
write (u, *)
write (u, "(A,L1)") "s is stable = ", is_stable (25, local)
write (u, "(A,L1)") "f is polarized = ", is_polarized (6, local)
write (u, *)
write (u, "(A)", advance="no") "Global model variable: "
model_vars => global%model%get_var_list_ptr ()
call model_vars%write_var (var_name, u)
write (u, "(A)", advance="no") "Local model variable: "
associate (model_var_list_ptr => local%model%get_var_list_ptr())
call model_var_list_ptr%write_var (var_name, u)
end associate
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call local%model%final ()
deallocate (local%model)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_6"
end subroutine rt_data_6
@ %def rt_data_6
@
\subsubsection{Result variables}
Initialize result variables and check that they are accessible via the
global variable list.
<<RT data: execute tests>>=
call test (rt_data_7, "rt_data_7", &
"result variables", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_7
<<RT data: tests>>=
subroutine rt_data_7 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: rt_data_7"
write (u, "(A)") "* Purpose: set and access result variables"
write (u, "(A)")
write (u, "(A)") "* Initialize process variables"
write (u, "(A)")
call global%global_init ()
call global%process_stack%init_result_vars (var_str ("testproc"))
call global%var_list%write_var (&
var_str ("integral(testproc)"), u, defined=.true.)
call global%var_list%write_var (&
var_str ("error(testproc)"), u, defined=.true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_7"
end subroutine rt_data_7
@ %def rt_data_7
@
\subsubsection{Beam energy}
If beam parameters are set, the variable [[sqrts]] is not necessarily
the collision energy. The method [[get_sqrts]] fetches the correct value.
<<RT data: execute tests>>=
call test (rt_data_8, "rt_data_8", &
"beam energy", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_8
<<RT data: tests>>=
subroutine rt_data_8 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: rt_data_8"
write (u, "(A)") "* Purpose: get correct collision energy"
write (u, "(A)")
write (u, "(A)") "* Initialize"
write (u, "(A)")
call global%global_init ()
write (u, "(A)") "* Set sqrts"
write (u, "(A)")
call global%set_real (var_str ("sqrts"), &
1000._default, is_known = .true.)
write (u, "(1x,A," // FMT_19 // ")") "sqrts =", global%get_sqrts ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_8"
end subroutine rt_data_8
@ %def rt_data_8
@
\subsubsection{Local variable modifications}
<<RT data: execute tests>>=
call test (rt_data_9, "rt_data_9", &
"local variables", &
u, results)
<<RT data: test declarations>>=
public :: rt_data_9
<<RT data: tests>>=
subroutine rt_data_9 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global, local
type(var_list_t), pointer :: var_list
write (u, "(A)") "* Test output: rt_data_9"
write (u, "(A)") "* Purpose: handle local variables"
write (u, "(A)")
call syntax_model_file_init ()
write (u, "(A)") "* Initialize global record and set some variables"
write (u, "(A)")
call global%global_init ()
call global%select_model (var_str ("Test"))
call global%set_real (var_str ("sqrts"), 17._default, is_known = .true.)
call global%set_real (var_str ("luminosity"), 2._default, is_known = .true.)
call global%model_set_real (var_str ("ff"), 0.5_default)
call global%model_set_real (var_str ("gy"), 1.2_default)
var_list => global%get_var_list_ptr ()
call var_list%write_var (var_str ("sqrts"), u, defined=.true.)
call var_list%write_var (var_str ("luminosity"), u, defined=.true.)
call var_list%write_var (var_str ("ff"), u, defined=.true.)
call var_list%write_var (var_str ("gy"), u, defined=.true.)
call var_list%write_var (var_str ("mf"), u, defined=.true.)
call var_list%write_var (var_str ("x"), u, defined=.true.)
write (u, "(A)")
write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
global%get_rval (var_str ("sqrts"))
write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
global%get_rval (var_str ("luminosity"))
write (u, "(1x,A,1x,F5.2)") "ff = ", &
global%get_rval (var_str ("ff"))
write (u, "(1x,A,1x,F5.2)") "gy = ", &
global%get_rval (var_str ("gy"))
write (u, "(1x,A,1x,F5.2)") "mf = ", &
global%get_rval (var_str ("mf"))
write (u, "(1x,A,1x,F5.2)") "x = ", &
global%get_rval (var_str ("x"))
write (u, "(A)")
write (u, "(A)") "* Create local record with local variables"
write (u, "(A)")
call local%local_init (global)
call local%append_real (var_str ("luminosity"), intrinsic = .true.)
call local%append_real (var_str ("x"), user = .true.)
call local%activate ()
var_list => local%get_var_list_ptr ()
call var_list%write_var (var_str ("sqrts"), u)
call var_list%write_var (var_str ("luminosity"), u)
call var_list%write_var (var_str ("ff"), u)
call var_list%write_var (var_str ("gy"), u)
call var_list%write_var (var_str ("mf"), u)
call var_list%write_var (var_str ("x"), u, defined=.true.)
write (u, "(A)")
write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
local%get_rval (var_str ("sqrts"))
write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
local%get_rval (var_str ("luminosity"))
write (u, "(1x,A,1x,F5.2)") "ff = ", &
local%get_rval (var_str ("ff"))
write (u, "(1x,A,1x,F5.2)") "gy = ", &
local%get_rval (var_str ("gy"))
write (u, "(1x,A,1x,F5.2)") "mf = ", &
local%get_rval (var_str ("mf"))
write (u, "(1x,A,1x,F5.2)") "x = ", &
local%get_rval (var_str ("x"))
write (u, "(A)")
write (u, "(A)") "* Modify some local variables"
write (u, "(A)")
call local%set_real (var_str ("luminosity"), 42._default, is_known=.true.)
call local%set_real (var_str ("x"), 6.66_default, is_known=.true.)
call local%model_set_real (var_str ("ff"), 0.7_default)
var_list => local%get_var_list_ptr ()
call var_list%write_var (var_str ("sqrts"), u)
call var_list%write_var (var_str ("luminosity"), u)
call var_list%write_var (var_str ("ff"), u)
call var_list%write_var (var_str ("gy"), u)
call var_list%write_var (var_str ("mf"), u)
call var_list%write_var (var_str ("x"), u, defined=.true.)
write (u, "(A)")
write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
local%get_rval (var_str ("sqrts"))
write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
local%get_rval (var_str ("luminosity"))
write (u, "(1x,A,1x,F5.2)") "ff = ", &
local%get_rval (var_str ("ff"))
write (u, "(1x,A,1x,F5.2)") "gy = ", &
local%get_rval (var_str ("gy"))
write (u, "(1x,A,1x,F5.2)") "mf = ", &
local%get_rval (var_str ("mf"))
write (u, "(1x,A,1x,F5.2)") "x = ", &
local%get_rval (var_str ("x"))
write (u, "(A)")
write (u, "(A)") "* Restore globals"
write (u, "(A)")
call local%deactivate (global)
var_list => global%get_var_list_ptr ()
call var_list%write_var (var_str ("sqrts"), u)
call var_list%write_var (var_str ("luminosity"), u)
call var_list%write_var (var_str ("ff"), u)
call var_list%write_var (var_str ("gy"), u)
call var_list%write_var (var_str ("mf"), u)
call var_list%write_var (var_str ("x"), u, defined=.true.)
write (u, "(A)")
write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
global%get_rval (var_str ("sqrts"))
write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
global%get_rval (var_str ("luminosity"))
write (u, "(1x,A,1x,F5.2)") "ff = ", &
global%get_rval (var_str ("ff"))
write (u, "(1x,A,1x,F5.2)") "gy = ", &
global%get_rval (var_str ("gy"))
write (u, "(1x,A,1x,F5.2)") "mf = ", &
global%get_rval (var_str ("mf"))
write (u, "(1x,A,1x,F5.2)") "x = ", &
global%get_rval (var_str ("x"))
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call local%local_final ()
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_9"
end subroutine rt_data_9
@ %def rt_data_9
+@
\subsubsection{Descriptions}
<<RT data: execute tests>>=
call test(rt_data_10, "rt_data_10", &
"descriptions", u, results)
<<RT data: test declarations>>=
public :: rt_data_10
<<RT data: tests>>=
subroutine rt_data_10 (u)
integer, intent(in) :: u
type(rt_data_t) :: global
! type(var_list_t) :: var_list
write (u, "(A)") "* Test output: rt_data_10"
write (u, "(A)") "* Purpose: display descriptions"
write (u, "(A)")
call global%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.'))
call global%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.'))
call global%var_list%append_int (var_str ("seed"), 1234, &
intrinsic=.true., &
description=var_str ('Integer variable \ttt{seed = {\em <num>}} ' // &
'that allows to set a specific random seed \ttt{num}.'))
call global%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.'))
call global%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 global%var_list%sort ()
call global%write_var_descriptions (u)
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: rt_data_10"
end subroutine rt_data_10
@ %def rt_data_10
@
+\subsubsection{Export objects}
+Export objects are variables or other data that should be copied or otherwise
+applied to corresponding objects in the outer scope.
+
+We test appending and retrieval for the export list.
+<<RT data: execute tests>>=
+ call test(rt_data_11, "rt_data_11", &
+ "export objects", u, results)
+<<RT data: test declarations>>=
+ public :: rt_data_11
+<<RT data: tests>>=
+ subroutine rt_data_11 (u)
+ integer, intent(in) :: u
+ type(rt_data_t) :: global
+ type(string_t), dimension(:), allocatable :: exports
+ integer :: i
+
+ write (u, "(A)") "* Test output: rt_data_11"
+ write (u, "(A)") "* Purpose: handle export object list"
+ write (u, "(A)")
+
+ write (u, "(A)") "* Empty export list"
+ write (u, "(A)")
+
+ call global%write_exports (u)
+
+ write (u, "(A)") "* Add an entry"
+ write (u, "(A)")
+
+ allocate (exports (1))
+ exports(1) = var_str ("results")
+ do i = 1, size (exports)
+ write (u, "('+ ',A)") char (exports(i))
+ end do
+ write (u, *)
+
+ call global%append_exports (exports)
+ call global%write_exports (u)
+
+ write (u, "(A)")
+ write (u, "(A)") "* Add more entries, including doubler"
+ write (u, "(A)")
+
+ deallocate (exports)
+ allocate (exports (3))
+ exports(1) = var_str ("foo")
+ exports(2) = var_str ("results")
+ exports(3) = var_str ("bar")
+ do i = 1, size (exports)
+ write (u, "('+ ',A)") char (exports(i))
+ end do
+ write (u, *)
+
+ call global%append_exports (exports)
+ call global%write_exports (u)
+
+ write (u, "(A)")
+ write (u, "(A)") "* Cleanup"
+
+ call global%final ()
+
+ write (u, "(A)")
+ write (u, "(A)") "* Test output end: rt_data_11"
+ end subroutine rt_data_11
+
+@ %def rt_data_11
+@
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Select implementations}
For abstract types (process core, integrator, phase space, etc.), we need a
way to dynamically select a concrete type, using either data given by the user
or a previous selection of a concrete type. This is done by subroutines in
the current module.
We would like to put this in the [[me_methods]] folder but it also
depends on [[gosam]] and [[openloops]], so it is unclear where to put
it.
<<[[dispatch_me_methods.f90]]>>=
<<File header>>
module dispatch_me_methods
<<Use strings>>
use physics_defs, only: BORN
use diagnostics
use sm_qcd
use variables, only: var_list_t
use models
use model_data
use prc_core_def
use prc_core
use prc_test_core
use prc_template_me
use prc_test
use prc_omega
use prc_user_defined
use prc_gosam
use prc_openloops
use prc_recola
use prc_threshold
<<Standard module head>>
<<Dispatch me methods: public>>
contains
<<Dispatch me methods: procedures>>
end module dispatch_me_methods
@ %def dispatch_me_methods
\subsection{Process Core Definition}
The [[prc_core_def_t]] abstract type can be instantiated by providing a
[[$method]] string variable.
Note: [[core_def]] has intent(inout) because gfortran 4.7.1 crashes for
intent(out).
<<Dispatch me methods: public>>=
public :: dispatch_core_def
<<Dispatch me methods: procedures>>=
subroutine dispatch_core_def (core_def, prt_in, prt_out, &
model, var_list, id, nlo_type, method)
class(prc_core_def_t), allocatable, intent(inout) :: core_def
type(string_t), dimension(:), intent(in) :: prt_in
type(string_t), dimension(:), intent(in) :: prt_out
type(model_t), pointer, intent(in) :: model
type(var_list_t), intent(in) :: var_list
type(string_t), intent(in), optional :: id
integer, intent(in), optional :: nlo_type
type(string_t), intent(in), optional :: method
type(string_t) :: model_name, meth
type(string_t) :: ufo_path
type(string_t) :: restrictions
logical :: ufo
logical :: cms_scheme
logical :: openmp_support
logical :: report_progress
logical :: diags, diags_color
logical :: write_phs_output
type(string_t) :: extra_options
integer :: nlo
integer :: alpha_power
integer :: alphas_power
if (present (method)) then
meth = method
else
meth = var_list%get_sval (var_str ("$method"))
end if
call msg_debug2 (D_CORE, "dispatch_core_def")
if (associated (model)) then
model_name = model%get_name ()
cms_scheme = model%get_scheme () == "Complex_Mass_Scheme"
ufo = model%is_ufo_model ()
ufo_path = model%get_ufo_path ()
else
model_name = ""
cms_scheme = .false.
ufo = .false.
end if
restrictions = var_list%get_sval (&
var_str ("$restrictions"))
diags = var_list%get_lval (&
var_str ("?vis_diags"))
diags_color = var_list%get_lval (&
var_str ("?vis_diags_color"))
openmp_support = var_list%get_lval (&
var_str ("?omega_openmp"))
report_progress = var_list%get_lval (&
var_str ("?report_progress"))
write_phs_output = var_list%get_lval (&
var_str ("?omega_write_phs_output"))
extra_options = var_list%get_sval (&
var_str ("$omega_flags"))
nlo = BORN; if (present (nlo_type)) nlo = nlo_type
alpha_power = var_list%get_ival (var_str ("alpha_power"))
alphas_power = var_list%get_ival (var_str ("alphas_power"))
call msg_debug2 (D_CORE, "dispatching core method: ", meth)
select case (char (meth))
case ("unit_test")
allocate (prc_test_def_t :: core_def)
select type (core_def)
type is (prc_test_def_t)
call core_def%init (model_name, prt_in, prt_out)
end select
case ("template")
allocate (template_me_def_t :: core_def)
select type (core_def)
type is (template_me_def_t)
call core_def%init (model, prt_in, prt_out, unity = .false.)
end select
case ("template_unity")
allocate (template_me_def_t :: core_def)
select type (core_def)
type is (template_me_def_t)
call core_def%init (model, prt_in, prt_out, unity = .true.)
end select
case ("omega")
allocate (omega_def_t :: core_def)
select type (core_def)
type is (omega_def_t)
call core_def%init (model_name, prt_in, prt_out, &
.false., ufo, ufo_path, &
restrictions, cms_scheme, &
openmp_support, report_progress, write_phs_output, &
extra_options, diags, diags_color)
end select
case ("ovm")
allocate (omega_def_t :: core_def)
select type (core_def)
type is (omega_def_t)
call core_def%init (model_name, prt_in, prt_out, &
.true., .false., var_str (""), &
restrictions, cms_scheme, &
openmp_support, report_progress, write_phs_output, &
extra_options, diags, diags_color)
end select
case ("gosam")
allocate (gosam_def_t :: core_def)
select type (core_def)
type is (gosam_def_t)
if (present (id)) then
call core_def%init (id, model_name, prt_in, &
prt_out, nlo, var_list)
else
call msg_fatal ("Dispatch GoSam def: No id!")
end if
end select
case ("openloops")
allocate (openloops_def_t :: core_def)
select type (core_def)
type is (openloops_def_t)
if (present (id)) then
call core_def%init (id, model_name, prt_in, &
prt_out, nlo, var_list)
else
call msg_fatal ("Dispatch OpenLoops def: No id!")
end if
end select
case ("recola")
call abort_if_recola_not_active ()
allocate (recola_def_t :: core_def)
select type (core_def)
type is (recola_def_t)
if (present (id)) then
call core_def%init (id, model_name, prt_in, &
prt_out, nlo, alpha_power, alphas_power)
else
call msg_fatal ("Dispatch RECOLA def: No id!")
end if
end select
case ("dummy")
allocate (user_defined_test_def_t :: core_def)
select type (core_def)
type is (user_defined_test_def_t)
if (present (id)) then
call core_def%init (id, model_name, prt_in, prt_out)
else
call msg_fatal ("Dispatch User-Defined Test def: No id!")
end if
end select
case ("threshold")
allocate (threshold_def_t :: core_def)
select type (core_def)
type is (threshold_def_t)
if (present (id)) then
call core_def%init (id, model_name, prt_in, prt_out, &
nlo, restrictions)
else
call msg_fatal ("Dispatch Threshold def: No id!")
end if
end select
case default
call msg_fatal ("Process configuration: method '" &
// char (meth) // "' not implemented")
end select
end subroutine dispatch_core_def
@ %def dispatch_core_def
@
\subsection{Process core allocation}
Here we allocate an object of abstract type [[prc_core_t]] with a concrete
type that matches a process definition. The [[prc_omega_t]] extension
will require the current parameter set, so we take the opportunity to
grab it from the model.
<<Dispatch me methods: public>>=
public :: dispatch_core
<<Dispatch me methods: procedures>>=
subroutine dispatch_core (core, core_def, model, &
helicity_selection, qcd, use_color_factors)
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
select type (core_def)
type is (prc_test_def_t)
allocate (test_t :: core)
type is (template_me_def_t)
allocate (prc_template_me_t :: core)
select type (core)
type is (prc_template_me_t)
call core%set_parameters (model)
end select
class is (omega_def_t)
if (.not. allocated (core)) allocate (prc_omega_t :: core)
select type (core)
type is (prc_omega_t)
call core%set_parameters (model, &
helicity_selection, qcd, use_color_factors)
end select
type is (gosam_def_t)
if (.not. allocated (core)) allocate (prc_gosam_t :: core)
select type (core)
type is (prc_gosam_t)
call core%set_parameters (qcd)
end select
type is (openloops_def_t)
if (.not. allocated (core)) allocate (prc_openloops_t :: core)
select type (core)
type is (prc_openloops_t)
call core%set_parameters (qcd)
end select
type is (recola_def_t)
if (.not. allocated (core)) allocate (prc_recola_t :: core)
select type (core)
type is (prc_recola_t)
call core%set_parameters (qcd, model)
end select
type is (user_defined_test_def_t)
if (.not. allocated (core)) allocate (prc_user_defined_test_t :: core)
select type (core)
type is (prc_user_defined_test_t)
call core%set_parameters (qcd, model)
end select
type is (threshold_def_t)
if (.not. allocated (core)) allocate (prc_threshold_t :: core)
select type (core)
type is (prc_threshold_t)
call core%set_parameters (qcd, model)
end select
class default
call msg_bug ("Process core: unexpected process definition type")
end select
end subroutine dispatch_core
@ %def dispatch_core
@
\subsection{Process core update and restoration}
Here we take an existing object of abstract type [[prc_core_t]] and
update the parameters as given by the current state of [[model]].
Optionally, we can save the previous state as [[saved_core]]. The
second routine restores the original from the save.
(In the test case, there is no possible update.)
<<Dispatch me methods: public>>=
public :: dispatch_core_update
public :: dispatch_core_restore
<<Dispatch me methods: procedures>>=
subroutine dispatch_core_update &
(core, model, helicity_selection, qcd, saved_core)
class(prc_core_t), allocatable, intent(inout) :: core
class(model_data_t), intent(in), optional, target :: model
type(helicity_selection_t), intent(in), optional :: helicity_selection
type(qcd_t), intent(in), optional :: qcd
class(prc_core_t), allocatable, intent(inout), optional :: saved_core
if (present (saved_core)) then
allocate (saved_core, source = core)
end if
select type (core)
type is (test_t)
type is (prc_omega_t)
call core%set_parameters (model, helicity_selection, qcd)
call core%activate_parameters ()
class is (prc_user_defined_base_t)
call msg_message ("Updating user defined cores is not implemented yet.")
class default
call msg_bug ("Process core update: unexpected process definition type")
end select
end subroutine dispatch_core_update
subroutine dispatch_core_restore (core, saved_core)
class(prc_core_t), allocatable, intent(inout) :: core
class(prc_core_t), allocatable, intent(inout) :: saved_core
call move_alloc (from = saved_core, to = core)
select type (core)
type is (test_t)
type is (prc_omega_t)
call core%activate_parameters ()
class default
call msg_bug ("Process core restore: unexpected process definition type")
end select
end subroutine dispatch_core_restore
@ %def dispatch_core_update dispatch_core_restore
@
\subsection{Unit Tests}
Test module, followed by the corresponding implementation module.
<<[[dispatch_ut.f90]]>>=
<<File header>>
module dispatch_ut
use unit_tests
use dispatch_uti
<<Standard module head>>
<<Dispatch: public test>>
<<Dispatch: public test auxiliary>>
contains
<<Dispatch: test driver>>
end module dispatch_ut
@ %def dispatch_ut
@
<<[[dispatch_uti.f90]]>>=
<<File header>>
module dispatch_uti
<<Use kinds>>
<<Use strings>>
use os_interface, only: os_data_t, os_data_init
use physics_defs, only: ELECTRON, PROTON
use sm_qcd, only: qcd_t
use flavors, only: flavor_t
use interactions, only: reset_interaction_counter
use pdg_arrays, only: pdg_array_t, assignment(=)
use prc_core_def, only: prc_core_def_t
use prc_test_core, only: test_t
use prc_core, only: prc_core_t
use prc_test, only: prc_test_def_t
use prc_omega, only: omega_def_t, prc_omega_t
use sf_mappings, only: sf_channel_t
use sf_base, only: sf_data_t, sf_config_t
use phs_base, only: phs_channel_collection_t
use variables, only: var_list_t
use model_data, only: model_data_t
use models, only: syntax_model_file_init, syntax_model_file_final
use rt_data, only: rt_data_t
use dispatch_phase_space, only: dispatch_sf_channels
use dispatch_beams, only: sf_prop_t, dispatch_qcd
use dispatch_beams, only: dispatch_sf_config, dispatch_sf_data
use dispatch_me_methods, only: dispatch_core_def, dispatch_core
use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore
use sf_base_ut, only: sf_test_data_t
<<Standard module head>>
<<Dispatch: public test auxiliary>>
<<Dispatch: test declarations>>
contains
<<Dispatch: tests>>
<<Dispatch: test auxiliary>>
end module dispatch_uti
@ %def dispatch_uti
@ API: driver for the unit tests below.
<<Dispatch: public test>>=
public :: dispatch_test
<<Dispatch: test driver>>=
subroutine dispatch_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Dispatch: execute tests>>
end subroutine dispatch_test
@ %def dispatch_test
@
\subsubsection{Select type: process definition}
<<Dispatch: execute tests>>=
call test (dispatch_1, "dispatch_1", &
"process configuration method", &
u, results)
<<Dispatch: test declarations>>=
public :: dispatch_1
<<Dispatch: tests>>=
subroutine dispatch_1 (u)
integer, intent(in) :: u
type(string_t), dimension(2) :: prt_in, prt_out
type(rt_data_t), target :: global
class(prc_core_def_t), allocatable :: core_def
write (u, "(A)") "* Test output: dispatch_1"
write (u, "(A)") "* Purpose: select process configuration method"
write (u, "(A)")
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
prt_in = [var_str ("a"), var_str ("b")]
prt_out = [var_str ("c"), var_str ("d")]
write (u, "(A)") "* Allocate core_def as prc_test_def"
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
select type (core_def)
type is (prc_test_def_t)
call core_def%write (u)
end select
deallocate (core_def)
write (u, "(A)")
write (u, "(A)") "* Allocate core_def as omega_def"
write (u, "(A)")
call global%set_string (var_str ("$method"), &
var_str ("omega"), is_known = .true.)
call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
select type (core_def)
type is (omega_def_t)
call core_def%write (u)
end select
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_1"
end subroutine dispatch_1
@ %def dispatch_1
@
\subsubsection{Select type: process core}
<<Dispatch: execute tests>>=
call test (dispatch_2, "dispatch_2", &
"process core", &
u, results)
<<Dispatch: test declarations>>=
public :: dispatch_2
<<Dispatch: tests>>=
subroutine dispatch_2 (u)
integer, intent(in) :: u
type(string_t), dimension(2) :: prt_in, prt_out
type(rt_data_t), target :: global
class(prc_core_def_t), allocatable :: core_def
class(prc_core_t), allocatable :: core
write (u, "(A)") "* Test output: dispatch_2"
write (u, "(A)") "* Purpose: select process configuration method"
write (u, "(A)") " and allocate process core"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
prt_in = [var_str ("a"), var_str ("b")]
prt_out = [var_str ("c"), var_str ("d")]
write (u, "(A)") "* Allocate core as test_t"
write (u, "(A)")
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
call dispatch_core (core, core_def)
select type (core)
type is (test_t)
call core%write (u)
end select
deallocate (core)
deallocate (core_def)
write (u, "(A)")
write (u, "(A)") "* Allocate core as prc_omega_t"
write (u, "(A)")
call global%set_string (var_str ("$method"), &
var_str ("omega"), is_known = .true.)
call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
call global%select_model (var_str ("Test"))
call global%set_log (&
var_str ("?helicity_selection_active"), &
.true., is_known = .true.)
call global%set_real (&
var_str ("helicity_selection_threshold"), &
1e9_default, is_known = .true.)
call global%set_int (&
var_str ("helicity_selection_cutoff"), &
10, is_known = .true.)
call dispatch_core (core, core_def, &
global%model, &
global%get_helicity_selection ())
call core_def%allocate_driver (core%driver, var_str (""))
select type (core)
type is (prc_omega_t)
call core%write (u)
end select
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_2"
end subroutine dispatch_2
@ %def dispatch_2
@
\subsubsection{Select type: structure-function data}
This is an extra dispatcher that enables the test structure
functions. This procedure should be assigned to the
[[dispatch_sf_data_extra]] hook before any tests are executed.
<<Dispatch: public test auxiliary>>=
public :: dispatch_sf_data_test
<<Dispatch: test auxiliary>>=
subroutine dispatch_sf_data_test (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(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
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
logical, intent(in) :: polarized
select case (char (sf_method))
case ("sf_test_0", "sf_test_1")
allocate (sf_test_data_t :: data)
select type (data)
type is (sf_test_data_t)
select case (char (sf_method))
case ("sf_test_0"); call data%init (model, pdg_in(i_beam(1)))
case ("sf_test_1"); call data%init (model, pdg_in(i_beam(1)),&
mode = 1)
end select
end select
end select
end subroutine dispatch_sf_data_test
@ %def dispatch_sf_data_test
@ The actual test. We can't move this to [[beams]] as it depends on
[[model_features]] for the [[model_list_t]].
<<Dispatch: execute tests>>=
call test (dispatch_7, "dispatch_7", &
"structure-function data", &
u, results)
<<Dispatch: test declarations>>=
public :: dispatch_7
<<Dispatch: tests>>=
subroutine dispatch_7 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
type(os_data_t) :: os_data
type(string_t) :: prt, sf_method
type(sf_prop_t) :: sf_prop
class(sf_data_t), allocatable :: data
type(pdg_array_t), dimension(1) :: pdg_in
type(pdg_array_t), dimension(1,1) :: pdg_prc
type(pdg_array_t), dimension(1) :: pdg_out
integer, dimension(:), allocatable :: pdg1
write (u, "(A)") "* Test output: dispatch_7"
write (u, "(A)") "* Purpose: select and configure &
&structure function data"
write (u, "(A)")
call global%global_init ()
call os_data_init (os_data)
call syntax_model_file_init ()
call global%select_model (var_str ("QCD"))
call reset_interaction_counter ()
call global%set_real (var_str ("sqrts"), &
14000._default, is_known = .true.)
prt = "p"
call global%beam_structure%init_sf ([prt, prt], [1])
pdg_in = 2212
write (u, "(A)") "* Allocate data as sf_pdf_builtin_t"
write (u, "(A)")
sf_method = "pdf_builtin"
call dispatch_sf_data (data, sf_method, [1], sf_prop, &
global%get_var_list_ptr (), global%var_list, &
global%model, global%os_data, global%get_sqrts (), &
pdg_in, pdg_prc, .false.)
call data%write (u)
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(A)")
write (u, "(1x,A,99(1x,I0))") "PDG(out) = ", pdg1
deallocate (data)
write (u, "(A)")
write (u, "(A)") "* Allocate data for different PDF set"
write (u, "(A)")
pdg_in = 2212
call global%set_string (var_str ("$pdf_builtin_set"), &
var_str ("CTEQ6M"), is_known = .true.)
sf_method = "pdf_builtin"
call dispatch_sf_data (data, sf_method, [1], sf_prop, &
global%get_var_list_ptr (), global%var_list, &
global%model, global%os_data, global%get_sqrts (), &
pdg_in, pdg_prc, .false.)
call data%write (u)
call data%get_pdg_out (pdg_out)
pdg1 = pdg_out(1)
write (u, "(A)")
write (u, "(1x,A,99(1x,I0))") "PDG(out) = ", pdg1
deallocate (data)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_7"
end subroutine dispatch_7
@ %def dispatch_7
@
\subsubsection{Beam structure}
The actual test. We can't move this to [[beams]] as it depends on
[[model_features]] for the [[model_list_t]].
<<Dispatch: execute tests>>=
call test (dispatch_8, "dispatch_8", &
"beam structure", &
u, results)
<<Dispatch: test declarations>>=
public :: dispatch_8
<<Dispatch: tests>>=
subroutine dispatch_8 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
type(os_data_t) :: os_data
type(flavor_t), dimension(2) :: flv
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_prop_t) :: sf_prop
type(sf_channel_t), dimension(:), allocatable :: sf_channel
type(phs_channel_collection_t) :: coll
type(string_t) :: sf_string
integer :: i
type(pdg_array_t), dimension (2,1) :: pdg_prc
write (u, "(A)") "* Test output: dispatch_8"
write (u, "(A)") "* Purpose: configure a structure-function chain"
write (u, "(A)")
call global%global_init ()
call os_data_init (os_data)
call syntax_model_file_init ()
call global%select_model (var_str ("QCD"))
write (u, "(A)") "* Allocate LHC beams with PDF builtin"
write (u, "(A)")
call flv(1)%init (PROTON, global%model)
call flv(2)%init (PROTON, global%model)
call reset_interaction_counter ()
call global%set_real (var_str ("sqrts"), &
14000._default, is_known = .true.)
call global%beam_structure%init_sf (flv%get_name (), [1])
call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))
call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
global%get_var_list_ptr (), global%var_list, &
global%model, global%os_data, global%get_sqrts (), pdg_prc)
do i = 1, size (sf_config)
call sf_config(i)%write (u)
end do
call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
global%var_list, global%get_sqrts(), global%beam_structure)
write (u, "(1x,A)") "Mapping configuration:"
do i = 1, size (sf_channel)
write (u, "(2x)", advance = "no")
call sf_channel(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Allocate ILC beams with CIRCE1"
write (u, "(A)")
call global%select_model (var_str ("QED"))
call flv(1)%init ( ELECTRON, global%model)
call flv(2)%init (-ELECTRON, global%model)
call reset_interaction_counter ()
call global%set_real (var_str ("sqrts"), &
500._default, is_known = .true.)
call global%set_log (var_str ("?circe1_generate"), &
.false., is_known = .true.)
call global%beam_structure%init_sf (flv%get_name (), [1])
call global%beam_structure%set_sf (1, 1, var_str ("circe1"))
call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
global%get_var_list_ptr (), global%var_list, &
global%model, global%os_data, global%get_sqrts (), pdg_prc)
do i = 1, size (sf_config)
call sf_config(i)%write (u)
end do
call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
global%var_list, global%get_sqrts(), global%beam_structure)
write (u, "(1x,A)") "Mapping configuration:"
do i = 1, size (sf_channel)
write (u, "(2x)", advance = "no")
call sf_channel(i)%write (u)
end do
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_8"
end subroutine dispatch_8
@ %def dispatch_8
@
\subsubsection{Update process core parameters}
This test dispatches a process core, temporarily modifies parameters,
then restores the original.
<<Dispatch: execute tests>>=
call test (dispatch_10, "dispatch_10", &
"process core update", &
u, results)
<<Dispatch: test declarations>>=
public :: dispatch_10
<<Dispatch: tests>>=
subroutine dispatch_10 (u)
integer, intent(in) :: u
type(string_t), dimension(2) :: prt_in, prt_out
type(rt_data_t), target :: global
class(prc_core_def_t), allocatable :: core_def
class(prc_core_t), allocatable :: core, saved_core
type(var_list_t), pointer :: model_vars
write (u, "(A)") "* Test output: dispatch_10"
write (u, "(A)") "* Purpose: select process configuration method,"
write (u, "(A)") " allocate process core,"
write (u, "(A)") " temporarily reset parameters"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
prt_in = [var_str ("a"), var_str ("b")]
prt_out = [var_str ("c"), var_str ("d")]
write (u, "(A)") "* Allocate core as prc_omega_t"
write (u, "(A)")
call global%set_string (var_str ("$method"), &
var_str ("omega"), is_known = .true.)
call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
call global%select_model (var_str ("Test"))
call dispatch_core (core, core_def, global%model)
call core_def%allocate_driver (core%driver, var_str (""))
select type (core)
type is (prc_omega_t)
call core%write (u)
end select
write (u, "(A)")
write (u, "(A)") "* Update core with modified model and helicity selection"
write (u, "(A)")
model_vars => global%model%get_var_list_ptr ()
call model_vars%set_real (var_str ("gy"), 2._default, &
is_known = .true.)
call global%model%update_parameters ()
call global%set_log (&
var_str ("?helicity_selection_active"), &
.true., is_known = .true.)
call global%set_real (&
var_str ("helicity_selection_threshold"), &
2e10_default, is_known = .true.)
call global%set_int (&
var_str ("helicity_selection_cutoff"), &
5, is_known = .true.)
call dispatch_core_update (core, &
global%model, &
global%get_helicity_selection (), &
saved_core = saved_core)
select type (core)
type is (prc_omega_t)
call core%write (u)
end select
write (u, "(A)")
write (u, "(A)") "* Restore core from save"
write (u, "(A)")
call dispatch_core_restore (core, saved_core)
select type (core)
type is (prc_omega_t)
call core%write (u)
end select
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_10"
end subroutine dispatch_10
@ %def dispatch_10
@
\subsubsection{QCD Coupling}
This test dispatches an [[qcd]] object, which is used to compute the
(running) coupling by one of several possible methods.
We can't move this to [[beams]] as it depends on
[[model_features]] for the [[model_list_t]].
<<Dispatch: execute tests>>=
call test (dispatch_11, "dispatch_11", &
"QCD coupling", &
u, results)
<<Dispatch: test declarations>>=
public :: dispatch_11
<<Dispatch: tests>>=
subroutine dispatch_11 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
type(qcd_t) :: qcd
type(var_list_t), pointer :: model_vars
write (u, "(A)") "* Test output: dispatch_11"
write (u, "(A)") "* Purpose: select QCD coupling formula"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%select_model (var_str ("SM"))
model_vars => global%get_var_list_ptr ()
write (u, "(A)") "* Allocate alpha_s as fixed"
write (u, "(A)")
call global%set_log (var_str ("?alphas_is_fixed"), &
.true., is_known = .true.)
call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
call qcd%write (u)
write (u, "(A)")
write (u, "(A)") "* Allocate alpha_s as running (built-in)"
write (u, "(A)")
call global%set_log (var_str ("?alphas_is_fixed"), &
.false., is_known = .true.)
call global%set_log (var_str ("?alphas_from_mz"), &
.true., is_known = .true.)
call global%set_int &
(var_str ("alphas_order"), 1, is_known = .true.)
call model_vars%set_real (var_str ("alphas"), 0.1234_default, &
is_known=.true.)
call model_vars%set_real (var_str ("mZ"), 91.234_default, &
is_known=.true.)
call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
call qcd%write (u)
write (u, "(A)")
write (u, "(A)") "* Allocate alpha_s as running (built-in, Lambda defined)"
write (u, "(A)")
call global%set_log (var_str ("?alphas_from_mz"), &
.false., is_known = .true.)
call global%set_log (&
var_str ("?alphas_from_lambda_qcd"), &
.true., is_known = .true.)
call global%set_real &
(var_str ("lambda_qcd"), 250.e-3_default, &
is_known=.true.)
call global%set_int &
(var_str ("alphas_order"), 2, is_known = .true.)
call global%set_int &
(var_str ("alphas_nf"), 4, is_known = .true.)
call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
call qcd%write (u)
write (u, "(A)")
write (u, "(A)") "* Allocate alpha_s as running (using builtin PDF set)"
write (u, "(A)")
call global%set_log (&
var_str ("?alphas_from_lambda_qcd"), &
.false., is_known = .true.)
call global%set_log &
(var_str ("?alphas_from_pdf_builtin"), &
.true., is_known = .true.)
call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
call qcd%write (u)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: dispatch_11"
end subroutine dispatch_11
@ %def dispatch_11
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process Configuration}
This module communicates between the toplevel command structure with
its runtime data set and the process-library handling modules which
collect the definition of individual processes. Its primary purpose
is to select from the available matrix-element generating methods and
configure the entry in the process library accordingly.
<<[[process_configurations.f90]]>>=
<<File header>>
module process_configurations
<<Use strings>>
use diagnostics
use io_units
use physics_defs, only: BORN, NLO_VIRTUAL, NLO_REAL, NLO_DGLAP, &
NLO_SUBTRACTION, NLO_MISMATCH
use models
use prc_core_def
use particle_specifiers
use process_libraries
use rt_data
use variables, only: var_list_t
use dispatch_me_methods, only: dispatch_core_def
use prc_user_defined, only: user_defined_def_t
<<Standard module head>>
<<Process configurations: public>>
<<Process configurations: types>>
contains
<<Process configurations: procedures>>
end module process_configurations
@ %def process_configurations
@
\subsection{Data Type}
<<Process configurations: public>>=
public :: process_configuration_t
<<Process configurations: types>>=
type :: process_configuration_t
type(process_def_entry_t), pointer :: entry => null ()
type(string_t) :: id
integer :: num_id = 0
contains
<<Process configurations: process configuration: TBP>>
end type process_configuration_t
@ %def process_configuration_t
@ Output (for unit tests).
<<Process configurations: process configuration: TBP>>=
procedure :: write => process_configuration_write
<<Process configurations: procedures>>=
subroutine process_configuration_write (config, unit)
class(process_configuration_t), intent(in) :: config
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(A)") "Process configuration:"
if (associated (config%entry)) then
call config%entry%write (u)
else
write (u, "(1x,3A)") "ID = '", char (config%id), "'"
write (u, "(1x,A,1x,I0)") "num ID =", config%num_id
write (u, "(2x,A)") "[no entry]"
end if
end subroutine process_configuration_write
@ %def process_configuration_write
@ Initialize a process. We only need the name, the number of incoming
particles, and the number of components.
<<Process configurations: process configuration: TBP>>=
procedure :: init => process_configuration_init
<<Process configurations: procedures>>=
subroutine process_configuration_init &
(config, prc_name, n_in, n_components, model, var_list, nlo_process)
class(process_configuration_t), intent(out) :: config
type(string_t), intent(in) :: prc_name
integer, intent(in) :: n_in
integer, intent(in) :: n_components
type(model_t), intent(in), pointer :: model
type(var_list_t), intent(in) :: var_list
logical, intent(in), optional :: nlo_process
logical :: nlo_proc
logical :: requires_resonances
call msg_debug (D_CORE, "process_configuration_init")
config%id = prc_name
if (present (nlo_process)) then
nlo_proc = nlo_process
else
nlo_proc = .false.
end if
requires_resonances = var_list%get_lval (var_str ("?resonance_history"))
call msg_debug (D_CORE, "nlo_process", nlo_proc)
allocate (config%entry)
if (var_list%is_known (var_str ("process_num_id"))) then
config%num_id = &
var_list%get_ival (var_str ("process_num_id"))
call config%entry%init (prc_name, &
model = model, n_in = n_in, n_components = n_components, &
num_id = config%num_id, &
nlo_process = nlo_proc, &
requires_resonances = requires_resonances)
else
call config%entry%init (prc_name, &
model = model, n_in = n_in, n_components = n_components, &
nlo_process = nlo_proc, &
requires_resonances = requires_resonances)
end if
end subroutine process_configuration_init
@ %def process_configuration_init
@ Initialize a process component. The details depend on the process method,
which determines the type of the process component core. We set the incoming
and outgoing particles (as strings, to be interpreted by the process driver).
All other information is taken from the variable list.
The dispatcher gets only the names of the particles. The process
component definition gets the complete specifiers which contains a
polarization flag and names of decay processes, where applicable.
<<Process configurations: process configuration: TBP>>=
procedure :: setup_component => process_configuration_setup_component
<<Process configurations: procedures>>=
subroutine process_configuration_setup_component &
(config, i_component, prt_in, prt_out, model, var_list, &
nlo_type, can_be_integrated)
class(process_configuration_t), intent(inout) :: config
integer, intent(in) :: i_component
type(prt_spec_t), dimension(:), intent(in) :: prt_in
type(prt_spec_t), dimension(:), intent(in) :: prt_out
type(model_t), pointer, intent(in) :: model
type(var_list_t), intent(in) :: var_list
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: can_be_integrated
type(string_t), dimension(:), allocatable :: prt_str_in
type(string_t), dimension(:), allocatable :: prt_str_out
class(prc_core_def_t), allocatable :: core_def
type(string_t) :: method
type(string_t) :: born_me_method
type(string_t) :: real_tree_me_method
type(string_t) :: loop_me_method
type(string_t) :: correlation_me_method
type(string_t) :: dglap_me_method
integer :: i
call msg_debug2 (D_CORE, "process_configuration_setup_component")
allocate (prt_str_in (size (prt_in)))
allocate (prt_str_out (size (prt_out)))
forall (i = 1:size (prt_in)) prt_str_in(i) = prt_in(i)% get_name ()
forall (i = 1:size (prt_out)) prt_str_out(i) = prt_out(i)%get_name ()
method = var_list%get_sval (var_str ("$method"))
if (present (nlo_type)) then
select case (nlo_type)
case (BORN)
born_me_method = var_list%get_sval (var_str ("$born_me_method"))
if (born_me_method /= var_str ("")) then
method = born_me_method
end if
case (NLO_VIRTUAL)
loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
if (loop_me_method /= var_str ("")) then
method = loop_me_method
end if
case (NLO_REAL)
real_tree_me_method = &
var_list%get_sval (var_str ("$real_tree_me_method"))
if (real_tree_me_method /= var_str ("")) then
method = real_tree_me_method
end if
case (NLO_DGLAP)
dglap_me_method = &
var_list%get_sval (var_str ("$dglap_me_method"))
if (dglap_me_method /= var_str ("")) then
method = dglap_me_method
end if
case (NLO_SUBTRACTION,NLO_MISMATCH)
correlation_me_method = &
var_list%get_sval (var_str ("$correlation_me_method"))
if (correlation_me_method /= var_str ("")) then
method = correlation_me_method
end if
case default
end select
end if
call dispatch_core_def (core_def, prt_str_in, prt_str_out, &
model, var_list, config%id, nlo_type, method)
select type (core_def)
class is (user_defined_def_t)
if (present (can_be_integrated)) then
call core_def%set_active_writer (can_be_integrated)
else
call msg_fatal ("Cannot decide if user-defined core is integrated!")
end if
end select
call msg_debug2 (D_CORE, "import_component with method ", method)
call config%entry%import_component (i_component, &
n_out = size (prt_out), &
prt_in = prt_in, &
prt_out = prt_out, &
method = method, &
variant = core_def, &
nlo_type = nlo_type, &
can_be_integrated = can_be_integrated)
end subroutine process_configuration_setup_component
@ %def process_configuration_setup_component
@
<<Process configurations: process configuration: TBP>>=
procedure :: set_fixed_emitter => process_configuration_set_fixed_emitter
<<Process configurations: procedures>>=
subroutine process_configuration_set_fixed_emitter (config, i, emitter)
class(process_configuration_t), intent(inout) :: config
integer, intent(in) :: i, emitter
call config%entry%set_fixed_emitter (i, emitter)
end subroutine process_configuration_set_fixed_emitter
@ %def process_configuration_set_fixed_emitter
@
<<Process configurations: process configuration: TBP>>=
procedure :: set_coupling_powers => process_configuration_set_coupling_powers
<<Process configurations: procedures>>=
subroutine process_configuration_set_coupling_powers (config, alpha_power, alphas_power)
class(process_configuration_t), intent(inout) :: config
integer, intent(in) :: alpha_power, alphas_power
call config%entry%set_coupling_powers (alpha_power, alphas_power)
end subroutine process_configuration_set_coupling_powers
@ %def process_configuration_set_coupling_powers
@
<<Process configurations: process configuration: TBP>>=
procedure :: set_component_associations => &
process_configuration_set_component_associations
<<Process configurations: procedures>>=
subroutine process_configuration_set_component_associations &
(config, i_list, remnant, use_real_finite, mismatch)
class(process_configuration_t), intent(inout) :: config
integer, dimension(:), intent(in) :: i_list
logical, intent(in) :: remnant, use_real_finite, mismatch
integer :: i_component
do i_component = 1, config%entry%get_n_components ()
if (any (i_list == i_component)) then
call config%entry%set_associated_components (i_component, &
i_list, remnant, use_real_finite, mismatch)
end if
end do
end subroutine process_configuration_set_component_associations
@ %def process_configuration_set_component_associations
@ Record a process configuration: append it to the currently selected process
definition library.
<<Process configurations: process configuration: TBP>>=
procedure :: record => process_configuration_record
<<Process configurations: procedures>>=
subroutine process_configuration_record (config, global)
class(process_configuration_t), intent(inout) :: config
type(rt_data_t), intent(inout) :: global
if (associated (global%prclib)) then
call global%prclib%open ()
call global%prclib%append (config%entry)
if (config%num_id /= 0) then
write (msg_buffer, "(5A,I0,A)") "Process library '", &
char (global%prclib%get_name ()), &
"': recorded process '", char (config%id), "' (", &
config%num_id, ")"
else
write (msg_buffer, "(5A)") "Process library '", &
char (global%prclib%get_name ()), &
"': recorded process '", char (config%id), "'"
end if
call msg_message ()
else
call msg_fatal ("Recording process '" // char (config%id) &
// "': active process library undefined")
end if
end subroutine process_configuration_record
@ %def process_configuration_record
@
\subsection{Unit Tests}
Test module, followed by the corresponding implementation module.
<<[[process_configurations_ut.f90]]>>=
<<File header>>
module process_configurations_ut
use unit_tests
use process_configurations_uti
<<Standard module head>>
<<Process configurations: public test>>
<<Process configurations: public test auxiliary>>
contains
<<Process configurations: test driver>>
end module process_configurations_ut
@ %def process_configurations_ut
@
<<[[process_configurations_uti.f90]]>>=
<<File header>>
module process_configurations_uti
<<Use strings>>
use particle_specifiers, only: new_prt_spec
use prclib_stacks
use models
use rt_data
use process_configurations
<<Standard module head>>
<<Process configurations: test declarations>>
<<Process configurations: public test auxiliary>>
contains
<<Process configurations: test auxiliary>>
<<Process configurations: tests>>
end module process_configurations_uti
@ %def process_configurations_uti
@ API: driver for the unit tests below.
<<Process configurations: public test>>=
public :: process_configurations_test
<<Process configurations: test driver>>=
subroutine process_configurations_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Process configurations: execute tests>>
end subroutine process_configurations_test
@ %def process_configurations_test
@
\subsubsection{Minimal setup}
The workflow for setting up a minimal process configuration with the
test matrix element method.
We wrap this in a public procedure, so we can reuse it in later modules.
The procedure prepares a process definition list for two processes
(one [[prc_test]] and one [[omega]] type) and appends this to the
process library stack in the global data set.
The [[mode]] argument determines which processes to build.
The [[procname]] argument replaces the predefined procname(s).
This is re-exported by the UT module.
<<Process configurations: public test auxiliary>>=
public :: prepare_test_library
<<Process configurations: test auxiliary>>=
subroutine prepare_test_library (global, libname, mode, procname)
type(rt_data_t), intent(inout), target :: global
type(string_t), intent(in) :: libname
integer, intent(in) :: mode
type(string_t), intent(in), dimension(:), optional :: procname
type(prclib_entry_t), pointer :: lib
type(string_t) :: prc_name
type(string_t), dimension(:), allocatable :: prt_in, prt_out
integer :: n_components
type(process_configuration_t) :: prc_config
if (.not. associated (global%prclib_stack%get_first_ptr ())) then
allocate (lib)
call lib%init (libname)
call global%add_prclib (lib)
end if
if (btest (mode, 0)) then
call global%select_model (var_str ("Test"))
if (present (procname)) then
prc_name = procname(1)
else
prc_name = "prc_config_a"
end if
n_components = 1
allocate (prt_in (2), prt_out (2))
prt_in = [var_str ("s"), var_str ("s")]
prt_out = [var_str ("s"), var_str ("s")]
call global%set_string (var_str ("$method"),&
var_str ("unit_test"), is_known = .true.)
call prc_config%init (prc_name, &
size (prt_in), n_components, &
global%model, global%var_list)
call prc_config%setup_component (1, &
new_prt_spec (prt_in), new_prt_spec (prt_out), &
global%model, global%var_list)
call prc_config%record (global)
deallocate (prt_in, prt_out)
end if
if (btest (mode, 1)) then
call global%select_model (var_str ("QED"))
if (present (procname)) then
prc_name = procname(2)
else
prc_name = "prc_config_b"
end if
n_components = 1
allocate (prt_in (2), prt_out (2))
prt_in = [var_str ("e+"), var_str ("e-")]
prt_out = [var_str ("m+"), var_str ("m-")]
call global%set_string (var_str ("$method"),&
var_str ("omega"), is_known = .true.)
call prc_config%init (prc_name, &
size (prt_in), n_components, &
global%model, global%var_list)
call prc_config%setup_component (1, &
new_prt_spec (prt_in), new_prt_spec (prt_out), &
global%model, global%var_list)
call prc_config%record (global)
deallocate (prt_in, prt_out)
end if
if (btest (mode, 2)) then
call global%select_model (var_str ("Test"))
if (present (procname)) then
prc_name = procname(1)
else
prc_name = "prc_config_a"
end if
n_components = 1
allocate (prt_in (1), prt_out (2))
prt_in = [var_str ("s")]
prt_out = [var_str ("f"), var_str ("fbar")]
call global%set_string (var_str ("$method"),&
var_str ("unit_test"), is_known = .true.)
call prc_config%init (prc_name, &
size (prt_in), n_components, &
global%model, global%var_list)
call prc_config%setup_component (1, &
new_prt_spec (prt_in), new_prt_spec (prt_out), &
global%model, global%var_list)
call prc_config%record (global)
deallocate (prt_in, prt_out)
end if
end subroutine prepare_test_library
@ %def prepare_test_library
@ The actual test: the previous procedure with some prelude and postlude.
In the global variable list, just before printing we reset the
variables where the value may depend on the system and run environment.
<<Process configurations: execute tests>>=
call test (process_configurations_1, "process_configurations_1", &
"test processes", &
u, results)
<<Process configurations: test declarations>>=
public :: process_configurations_1
<<Process configurations: tests>>=
subroutine process_configurations_1 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: process_configurations_1"
write (u, "(A)") "* Purpose: configure test processes"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
write (u, "(A)") "* Configure processes as prc_test, model Test"
write (u, "(A)") "* and omega, model QED"
write (u, *)
call global%set_int (var_str ("process_num_id"), &
42, is_known = .true.)
call prepare_test_library (global, var_str ("prc_config_lib_1"), 3)
global%os_data%fc = "Fortran-compiler"
global%os_data%fcflags = "Fortran-flags"
call global%write_libraries (u)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_configurations_1"
end subroutine process_configurations_1
@ %def process_configurations_1
@
\subsubsection{\oMega\ options}
Slightly extended example where we pass \oMega\ options to the
library. The [[prepare_test_library]] contents are spelled out.
<<Process configurations: execute tests>>=
call test (process_configurations_2, "process_configurations_2", &
"omega options", &
u, results)
<<Process configurations: test declarations>>=
public :: process_configurations_2
<<Process configurations: tests>>=
subroutine process_configurations_2 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
type(string_t) :: libname
type(prclib_entry_t), pointer :: lib
type(string_t) :: prc_name
type(string_t), dimension(:), allocatable :: prt_in, prt_out
integer :: n_components
type(process_configuration_t) :: prc_config
write (u, "(A)") "* Test output: process_configurations_2"
write (u, "(A)") "* Purpose: configure test processes with options"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
write (u, "(A)") "* Configure processes as omega, model QED"
write (u, *)
libname = "prc_config_lib_2"
allocate (lib)
call lib%init (libname)
call global%add_prclib (lib)
call global%select_model (var_str ("QED"))
prc_name = "prc_config_c"
n_components = 2
allocate (prt_in (2), prt_out (2))
prt_in = [var_str ("e+"), var_str ("e-")]
prt_out = [var_str ("m+"), var_str ("m-")]
call global%set_string (var_str ("$method"),&
var_str ("omega"), is_known = .true.)
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call prc_config%init (prc_name, size (prt_in), n_components, &
global%model, global%var_list)
call global%set_log (var_str ("?report_progress"), &
.true., is_known = .true.)
call prc_config%setup_component (1, &
new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
call global%set_log (var_str ("?report_progress"), &
.false., is_known = .true.)
call global%set_log (var_str ("?omega_openmp"), &
.true., is_known = .true.)
call global%set_string (var_str ("$restrictions"),&
var_str ("3+4~A"), is_known = .true.)
call global%set_string (var_str ("$omega_flags"), &
var_str ("-fusion:progress_file omega_prc_config.log"), &
is_known = .true.)
call prc_config%setup_component (2, &
new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
call prc_config%record (global)
deallocate (prt_in, prt_out)
global%os_data%fc = "Fortran-compiler"
global%os_data%fcflags = "Fortran-flags"
call global%write_vars (u, [ &
var_str ("$model_name"), &
var_str ("$method"), &
var_str ("?report_progress"), &
var_str ("$restrictions"), &
var_str ("$omega_flags")])
write (u, "(A)")
call global%write_libraries (u)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_configurations_2"
end subroutine process_configurations_2
@ %def process_configurations_2
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Compilation}
This module manages compilation and loading of of process libraries. It is
needed as a separate module because integration depends on it.
<<[[compilations.f90]]>>=
<<File header>>
module compilations
<<Use strings>>
use io_units
use system_defs, only: TAB
use diagnostics
use os_interface
use variables, only: var_list_t
use model_data
use process_libraries
use prclib_stacks
use rt_data
<<Standard module head>>
<<Compilations: public>>
<<Compilations: types>>
<<Compilations: parameters>>
contains
<<Compilations: procedures>>
end module compilations
@ %def compilations
@
\subsection{The data type}
The compilation item handles the compilation and loading of a single
process library.
<<Compilations: public>>=
public :: compilation_item_t
<<Compilations: types>>=
type :: compilation_item_t
private
type(string_t) :: libname
type(string_t) :: static_external_tag
type(process_library_t), pointer :: lib => null ()
logical :: recompile_library = .false.
logical :: verbose = .false.
logical :: use_workspace = .false.
type(string_t) :: workspace
contains
<<Compilations: compilation item: TBP>>
end type compilation_item_t
@ %def compilation_item_t
@ Initialize.
Set flags and global properties of the library. Establish the workspace name,
if defined.
<<Compilations: compilation item: TBP>>=
procedure :: init => compilation_item_init
<<Compilations: procedures>>=
subroutine compilation_item_init (comp, libname, stack, var_list)
class(compilation_item_t), intent(out) :: comp
type(string_t), intent(in) :: libname
type(prclib_stack_t), intent(inout) :: stack
type(var_list_t), intent(in) :: var_list
comp%libname = libname
comp%lib => stack%get_library_ptr (comp%libname)
if (.not. associated (comp%lib)) then
call msg_fatal ("Process library '" // char (comp%libname) &
// "' has not been declared.")
end if
comp%recompile_library = &
var_list%get_lval (var_str ("?recompile_library"))
comp%verbose = &
var_list%get_lval (var_str ("?me_verbose"))
comp%use_workspace = &
var_list%is_known (var_str ("$compile_workspace"))
if (comp%use_workspace) then
comp%workspace = &
var_list%get_sval (var_str ("$compile_workspace"))
if (comp%workspace == "") comp%use_workspace = .false.
else
comp%workspace = ""
end if
end subroutine compilation_item_init
@ %def compilation_item_init
@ Compile the current library. The [[force]] flag has the
effect that we first delete any previous files, as far as accessible
by the current makefile. It also guarantees that previous files not
accessible by a makefile will be overwritten.
<<Compilations: compilation item: TBP>>=
procedure :: compile => compilation_item_compile
<<Compilations: procedures>>=
subroutine compilation_item_compile (comp, model, os_data, force, recompile)
class(compilation_item_t), intent(inout) :: comp
class(model_data_t), intent(in), target :: model
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: force, recompile
if (associated (comp%lib)) then
if (comp%use_workspace) call setup_workspace (comp%workspace, os_data)
call msg_message ("Process library '" &
// char (comp%libname) // "': compiling ...")
call comp%lib%configure (os_data)
if (signal_is_pending ()) return
call comp%lib%compute_md5sum (model)
call comp%lib%write_makefile &
(os_data, force, verbose=comp%verbose, workspace=comp%workspace)
if (signal_is_pending ()) return
if (force) then
call comp%lib%clean &
(os_data, distclean = .false., workspace=comp%workspace)
if (signal_is_pending ()) return
end if
call comp%lib%write_driver (force, workspace=comp%workspace)
if (signal_is_pending ()) return
if (recompile) then
call comp%lib%load &
(os_data, keep_old_source = .true., workspace=comp%workspace)
if (signal_is_pending ()) return
end if
call comp%lib%update_status (os_data, workspace=comp%workspace)
end if
end subroutine compilation_item_compile
@ %def compilation_item_compile
@ The workspace directory is created if it does not exist. (Applies only if
the use has set the workspace directory.)
<<Compilations: parameters>>=
character(*), parameter :: ALLOWED_IN_DIRNAME = &
"abcdefghijklmnopqrstuvwxyz&
&ABCDEFGHIJKLMNOPQRSTUVWXYZ&
&1234567890&
&.,_-+="
@ %def ALLOWED_IN_DIRNAME
<<Compilations: procedures>>=
subroutine setup_workspace (workspace, os_data)
type(string_t), intent(in) :: workspace
type(os_data_t), intent(in) :: os_data
if (verify (workspace, ALLOWED_IN_DIRNAME) == 0) then
call msg_message ("Compile: preparing workspace directory '" &
// char (workspace) // "'")
call os_system_call ("mkdir -p '" // workspace // "'")
else
call msg_fatal ("compile: workspace name '" &
// char (workspace) // "' contains illegal characters")
end if
end subroutine setup_workspace
@ %def setup_workspace
@ Load the current library, just after compiling it.
<<Compilations: compilation item: TBP>>=
procedure :: load => compilation_item_load
<<Compilations: procedures>>=
subroutine compilation_item_load (comp, os_data)
class(compilation_item_t), intent(inout) :: comp
type(os_data_t), intent(in) :: os_data
if (associated (comp%lib)) then
call comp%lib%load (os_data, workspace=comp%workspace)
end if
end subroutine compilation_item_load
@ %def compilation_item_load
@ Message as a separate call:
<<Compilations: compilation item: TBP>>=
procedure :: success => compilation_item_success
<<Compilations: procedures>>=
subroutine compilation_item_success (comp)
class(compilation_item_t), intent(in) :: comp
if (associated (comp%lib)) then
call msg_message ("Process library '" // char (comp%libname) &
// "': ... success.")
else
call msg_fatal ("Process library '" // char (comp%libname) &
// "': ... failure.")
end if
end subroutine compilation_item_success
@ %def compilation_item_success
@ %def compilation_item_failure
@
\subsection{API for library compilation and loading}
This is a shorthand for compiling and loading a single library. The
[[compilation_item]] object is used only internally.
The [[global]] data set may actually be local to the caller. The
compilation affects the library specified by its name if it is on the
stack, but it does not reset the currently selected library.
<<Compilations: public>>=
public :: compile_library
<<Compilations: procedures>>=
subroutine compile_library (libname, global)
type(string_t), intent(in) :: libname
type(rt_data_t), intent(inout), target :: global
type(compilation_item_t) :: comp
logical :: force, recompile
force = &
global%var_list%get_lval (var_str ("?rebuild_library"))
recompile = &
global%var_list%get_lval (var_str ("?recompile_library"))
if (associated (global%model)) then
call comp%init (libname, global%prclib_stack, global%var_list)
call comp%compile (global%model, global%os_data, force, recompile)
if (signal_is_pending ()) return
call comp%load (global%os_data)
if (signal_is_pending ()) return
else
call msg_fatal ("Process library compilation: " &
// " model is undefined.")
end if
call comp%success ()
end subroutine compile_library
@ %def compile_library
@
\subsection{Compiling static executable}
This object handles the creation of a static executable which should
contain a set of static process libraries.
<<Compilations: public>>=
public :: compilation_t
<<Compilations: types>>=
type :: compilation_t
private
type(string_t) :: exe_name
type(string_t), dimension(:), allocatable :: lib_name
contains
<<Compilations: compilation: TBP>>
end type compilation_t
@ %def compilation_t
@ Output.
<<Compilations: compilation: TBP>>=
procedure :: write => compilation_write
<<Compilations: procedures>>=
subroutine compilation_write (object, unit)
class(compilation_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "Compilation object:"
write (u, "(3x,3A)") "executable = '", &
char (object%exe_name), "'"
write (u, "(3x,A)", advance="no") "process libraries ="
do i = 1, size (object%lib_name)
write (u, "(1x,3A)", advance="no") "'", char (object%lib_name(i)), "'"
end do
write (u, *)
end subroutine compilation_write
@ %def compilation_write
@ Initialize: we know the names of the executable and of the libraries.
Optionally, we may provide a workspace directory.
<<Compilations: compilation: TBP>>=
procedure :: init => compilation_init
<<Compilations: procedures>>=
subroutine compilation_init (compilation, exe_name, lib_name)
class(compilation_t), intent(out) :: compilation
type(string_t), intent(in) :: exe_name
type(string_t), dimension(:), intent(in) :: lib_name
compilation%exe_name = exe_name
allocate (compilation%lib_name (size (lib_name)))
compilation%lib_name = lib_name
end subroutine compilation_init
@ %def compilation_init
@ Write the dispatcher subroutine for the compiled libraries. Also
write a subroutine which returns the names of the compiled libraries.
<<Compilations: compilation: TBP>>=
procedure :: write_dispatcher => compilation_write_dispatcher
<<Compilations: procedures>>=
subroutine compilation_write_dispatcher (compilation)
class(compilation_t), intent(in) :: compilation
type(string_t) :: file
integer :: u, i
file = compilation%exe_name // "_prclib_dispatcher.f90"
call msg_message ("Static executable '" // char (compilation%exe_name) &
// "': writing library dispatcher")
u = free_unit ()
open (u, file = char (file), status="replace", action="write")
write (u, "(3A)") "! Whizard: process libraries for executable '", &
char (compilation%exe_name), "'"
write (u, "(A)") "! Automatically generated file, do not edit"
write (u, "(A)") "subroutine dispatch_prclib_static " // &
"(driver, basename, modellibs_ldflags)"
write (u, "(A)") " use iso_varying_string, string_t => varying_string"
write (u, "(A)") " use prclib_interfaces"
do i = 1, size (compilation%lib_name)
associate (lib_name => compilation%lib_name(i))
write (u, "(A)") " use " // char (lib_name) // "_driver"
end associate
end do
write (u, "(A)") " implicit none"
write (u, "(A)") " class(prclib_driver_t), intent(inout), allocatable &
&:: driver"
write (u, "(A)") " type(string_t), intent(in) :: basename"
write (u, "(A)") " logical, intent(in), optional :: " // &
"modellibs_ldflags"
write (u, "(A)") " select case (char (basename))"
do i = 1, size (compilation%lib_name)
associate (lib_name => compilation%lib_name(i))
write (u, "(3A)") " case ('", char (lib_name), "')"
write (u, "(3A)") " allocate (", char (lib_name), "_driver_t &
&:: driver)"
end associate
end do
write (u, "(A)") " end select"
write (u, "(A)") "end subroutine dispatch_prclib_static"
write (u, *)
write (u, "(A)") "subroutine get_prclib_static (libname)"
write (u, "(A)") " use iso_varying_string, string_t => varying_string"
write (u, "(A)") " implicit none"
write (u, "(A)") " type(string_t), dimension(:), intent(inout), &
&allocatable :: libname"
write (u, "(A,I0,A)") " allocate (libname (", &
size (compilation%lib_name), "))"
do i = 1, size (compilation%lib_name)
associate (lib_name => compilation%lib_name(i))
write (u, "(A,I0,A,A,A)") " libname(", i, ") = '", &
char (lib_name), "'"
end associate
end do
write (u, "(A)") "end subroutine get_prclib_static"
close (u)
end subroutine compilation_write_dispatcher
@ %def compilation_write_dispatcher
@ Write the Makefile subroutine for the compiled libraries.
<<Compilations: compilation: TBP>>=
procedure :: write_makefile => compilation_write_makefile
<<Compilations: procedures>>=
subroutine compilation_write_makefile &
(compilation, os_data, ext_libtag, verbose)
class(compilation_t), intent(in) :: compilation
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
type(string_t), intent(in), optional :: ext_libtag
type(string_t) :: file, ext_tag
integer :: u, i
if (present (ext_libtag)) then
ext_tag = ext_libtag
else
ext_tag = ""
end if
file = compilation%exe_name // ".makefile"
call msg_message ("Static executable '" // char (compilation%exe_name) &
// "': writing makefile")
u = free_unit ()
open (u, file = char (file), status="replace", action="write")
write (u, "(3A)") "# WHIZARD: Makefile for executable '", &
char (compilation%exe_name), "'"
write (u, "(A)") "# Automatically generated file, do not edit"
write (u, "(A)") ""
write (u, "(A)") "# Executable name"
write (u, "(A)") "EXE = " // char (compilation%exe_name)
write (u, "(A)") ""
write (u, "(A)") "# Compiler"
write (u, "(A)") "FC = " // char (os_data%fc)
write (u, "(A)") ""
write (u, "(A)") "# Included libraries"
write (u, "(A)") "FCINCL = " // char (os_data%whizard_includes)
write (u, "(A)") ""
write (u, "(A)") "# Compiler flags"
write (u, "(A)") "FCFLAGS = " // char (os_data%fcflags)
write (u, "(A)") "LDFLAGS = " // char (os_data%ldflags)
write (u, "(A)") "LDFLAGS_STATIC = " // char (os_data%ldflags_static)
write (u, "(A)") "LDFLAGS_HEPMC = " // char (os_data%ldflags_hepmc)
write (u, "(A)") "LDFLAGS_LCIO = " // char (os_data%ldflags_lcio)
write (u, "(A)") "LDFLAGS_HOPPET = " // char (os_data%ldflags_hoppet)
write (u, "(A)") "LDFLAGS_LOOPTOOLS = " // char (os_data%ldflags_looptools)
write (u, "(A)") "LDWHIZARD = " // char (os_data%whizard_ldflags)
write (u, "(A)") ""
write (u, "(A)") "# Libtool"
write (u, "(A)") "LIBTOOL = " // char (os_data%whizard_libtool)
if (verbose) then
write (u, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
write (u, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
else
write (u, "(A)") "FCOMPILE = @$(LIBTOOL) --silent --tag=FC --mode=compile"
write (u, "(A)") "LINK = @$(LIBTOOL) --silent --tag=FC --mode=link"
end if
write (u, "(A)") ""
write (u, "(A)") "# Compile commands (default)"
write (u, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c $(FCINCL) $(FCFLAGS)"
write (u, "(A)") ""
write (u, "(A)") "# Default target"
write (u, "(A)") "all: link"
write (u, "(A)") ""
write (u, "(A)") "# Libraries"
do i = 1, size (compilation%lib_name)
associate (lib_name => compilation%lib_name(i))
write (u, "(A)") "LIBRARIES += " // char (lib_name) // ".la"
write (u, "(A)") char (lib_name) // ".la:"
write (u, "(A)") TAB // "$(MAKE) -f " // char (lib_name) // ".makefile"
end associate
end do
write (u, "(A)") ""
write (u, "(A)") "# Library dispatcher"
write (u, "(A)") "DISP = $(EXE)_prclib_dispatcher"
write (u, "(A)") "$(DISP).lo: $(DISP).f90 $(LIBRARIES)"
if (.not. verbose) then
write (u, "(A)") TAB // '@echo " FC " $@'
end if
write (u, "(A)") TAB // "$(LTFCOMPILE) $<"
write (u, "(A)") ""
write (u, "(A)") "# Executable"
write (u, "(A)") "$(EXE): $(DISP).lo $(LIBRARIES)"
if (.not. verbose) then
write (u, "(A)") TAB // '@echo " FCLD " $@'
end if
write (u, "(A)") TAB // "$(LINK) $(FC) -static-libtool-libs $(FCFLAGS) \"
write (u, "(A)") TAB // " $(LDWHIZARD) $(LDFLAGS) \"
write (u, "(A)") TAB // " -o $(EXE) $^ \"
write (u, "(A)") TAB // " $(LDFLAGS_HEPMC) $(LDFLAGS_LCIO) $(LDFLAGS_HOPPET) \"
write (u, "(A)") TAB // " $(LDFLAGS_LOOPTOOLS) $(LDFLAGS_STATIC)" // char (ext_tag)
write (u, "(A)") ""
write (u, "(A)") "# Main targets"
write (u, "(A)") "link: compile $(EXE)"
write (u, "(A)") "compile: $(LIBRARIES) $(DISP).lo"
write (u, "(A)") ".PHONY: link compile"
write (u, "(A)") ""
write (u, "(A)") "# Cleanup targets"
write (u, "(A)") "clean-exe:"
write (u, "(A)") TAB // "rm -f $(EXE)"
write (u, "(A)") "clean-objects:"
write (u, "(A)") TAB // "rm -f $(DISP).lo"
write (u, "(A)") "clean-source:"
write (u, "(A)") TAB // "rm -f $(DISP).f90"
write (u, "(A)") "clean-makefile:"
write (u, "(A)") TAB // "rm -f $(EXE).makefile"
write (u, "(A)") ""
write (u, "(A)") "clean: clean-exe clean-objects clean-source"
write (u, "(A)") "distclean: clean clean-makefile"
write (u, "(A)") ".PHONY: clean distclean"
close (u)
end subroutine compilation_write_makefile
@ %def compilation_write_makefile
@ Compile the dispatcher source code.
<<Compilations: compilation: TBP>>=
procedure :: make_compile => compilation_make_compile
<<Compilations: procedures>>=
subroutine compilation_make_compile (compilation, os_data)
class(compilation_t), intent(in) :: compilation
type(os_data_t), intent(in) :: os_data
call os_system_call ("make compile " // os_data%makeflags &
// " -f " // compilation%exe_name // ".makefile")
end subroutine compilation_make_compile
@ %def compilation_make_compile
@ Link the dispatcher together with all matrix-element code and the
\whizard\ and \oMega\ main libraries, to generate a static executable.
<<Compilations: compilation: TBP>>=
procedure :: make_link => compilation_make_link
<<Compilations: procedures>>=
subroutine compilation_make_link (compilation, os_data)
class(compilation_t), intent(in) :: compilation
type(os_data_t), intent(in) :: os_data
call os_system_call ("make link " // os_data%makeflags &
// " -f " // compilation%exe_name // ".makefile")
end subroutine compilation_make_link
@ %def compilation_make_link
@ Cleanup.
<<Compilations: compilation: TBP>>=
procedure :: make_clean_exe => compilation_make_clean_exe
<<Compilations: procedures>>=
subroutine compilation_make_clean_exe (compilation, os_data)
class(compilation_t), intent(in) :: compilation
type(os_data_t), intent(in) :: os_data
call os_system_call ("make clean-exe " // os_data%makeflags &
// " -f " // compilation%exe_name // ".makefile")
end subroutine compilation_make_clean_exe
@ %def compilation_make_clean_exe
@
\subsection{API for executable compilation}
This is a shorthand for compiling and loading an executable, including
the enclosed libraries. The [[compilation]] object is used only internally.
The [[global]] data set may actually be local to the caller. The
compilation affects the library specified by its name if it is on the
stack, but it does not reset the currently selected library.
<<Compilations: public>>=
public :: compile_executable
<<Compilations: procedures>>=
subroutine compile_executable (exename, libname, global)
type(string_t), intent(in) :: exename
type(string_t), dimension(:), intent(in) :: libname
type(rt_data_t), intent(inout), target :: global
type(compilation_t) :: compilation
type(compilation_item_t) :: item
type(string_t) :: ext_libtag
logical :: force, recompile, verbose
integer :: i
ext_libtag = ""
force = &
global%var_list%get_lval (var_str ("?rebuild_library"))
recompile = &
global%var_list%get_lval (var_str ("?recompile_library"))
verbose = &
global%var_list%get_lval (var_str ("?me_verbose"))
call compilation%init (exename, [libname])
if (signal_is_pending ()) return
call compilation%write_dispatcher ()
if (signal_is_pending ()) return
do i = 1, size (libname)
call item%init (libname(i), global%prclib_stack, global%var_list)
call item%compile (global%model, global%os_data, &
force=force, recompile=recompile)
ext_libtag = "" // item%lib%get_static_modelname (global%os_data)
if (signal_is_pending ()) return
call item%success ()
end do
call compilation%write_makefile &
(global%os_data, ext_libtag=ext_libtag, verbose=verbose)
if (signal_is_pending ()) return
call compilation%make_compile (global%os_data)
if (signal_is_pending ()) return
call compilation%make_link (global%os_data)
end subroutine compile_executable
@ %def compile_executable
@
\subsection{Unit Tests}
Test module, followed by the stand-alone unit-test procedures.
<<[[compilations_ut.f90]]>>=
<<File header>>
module compilations_ut
use unit_tests
use compilations_uti
<<Standard module head>>
<<Compilations: public test>>
contains
<<Compilations: test driver>>
end module compilations_ut
@ %def compilations_ut
@
<<[[compilations_uti.f90]]>>=
<<File header>>
module compilations_uti
<<Use strings>>
use io_units
use models
use rt_data
use process_configurations_ut, only: prepare_test_library
use compilations
<<Standard module head>>
<<Compilations: test declarations>>
contains
<<Compilations: tests>>
end module compilations_uti
@ %def compilations_uti
@ API: driver for the unit tests below.
<<Compilations: public test>>=
public :: compilations_test
<<Compilations: test driver>>=
subroutine compilations_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Compilations: execute tests>>
end subroutine compilations_test
@ %def compilations_test
@
\subsubsection{Intrinsic Matrix Element}
Compile an intrinsic test matrix element ([[prc_test]] type).
Note: In this and the following test, we reset the Fortran compiler and flag
variables immediately before they are printed, so the test is portable.
<<Compilations: execute tests>>=
call test (compilations_1, "compilations_1", &
"intrinsic test processes", &
u, results)
<<Compilations: test declarations>>=
public :: compilations_1
<<Compilations: tests>>=
subroutine compilations_1 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: compilations_1"
write (u, "(A)") "* Purpose: configure and compile test process"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
libname = "compilation_1"
procname = "prc_comp_1"
call prepare_test_library (global, libname, 1, [procname])
call compile_library (libname, global)
call global%write_libraries (u)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: compilations_1"
end subroutine compilations_1
@ %def compilations_1
@
\subsubsection{External Matrix Element}
Compile an external test matrix element ([[omega]] type)
<<Compilations: execute tests>>=
call test (compilations_2, "compilations_2", &
"external process (omega)", &
u, results)
<<Compilations: test declarations>>=
public :: compilations_2
<<Compilations: tests>>=
subroutine compilations_2 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: compilations_2"
write (u, "(A)") "* Purpose: configure and compile test process"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
libname = "compilation_2"
procname = "prc_comp_2"
call prepare_test_library (global, libname, 2, [procname,procname])
call compile_library (libname, global)
call global%write_libraries (u, libpath = .false.)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: compilations_2"
end subroutine compilations_2
@ %def compilations_2
@
\subsubsection{External Matrix Element}
Compile an external test matrix element ([[omega]] type) and
create driver files for a static executable.
<<Compilations: execute tests>>=
call test (compilations_3, "compilations_3", &
"static executable: driver", &
u, results)
<<Compilations: test declarations>>=
public :: compilations_3
<<Compilations: tests>>=
subroutine compilations_3 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname, exename
type(rt_data_t), target :: global
type(compilation_t) :: compilation
integer :: u_file
character(80) :: buffer
write (u, "(A)") "* Test output: compilations_3"
write (u, "(A)") "* Purpose: make static executable"
write (u, "(A)")
write (u, "(A)") "* Initialize library"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
libname = "compilations_3_lib"
procname = "prc_comp_3"
exename = "compilations_3"
call prepare_test_library (global, libname, 2, [procname,procname])
call compilation%init (exename, [libname])
call compilation%write (u)
write (u, "(A)")
write (u, "(A)") "* Write dispatcher"
write (u, "(A)")
call compilation%write_dispatcher ()
u_file = free_unit ()
open (u_file, file = char (exename) // "_prclib_dispatcher.f90", &
status = "old", action = "read")
do
read (u_file, "(A)", end = 1) buffer
write (u, "(A)") trim (buffer)
end do
1 close (u_file)
write (u, "(A)")
write (u, "(A)") "* Write Makefile"
write (u, "(A)")
associate (os_data => global%os_data)
os_data%fc = "fortran-compiler"
os_data%whizard_includes = "my-includes"
os_data%fcflags = "my-fcflags"
os_data%ldflags = "my-ldflags"
os_data%ldflags_static = "my-ldflags-static"
os_data%ldflags_hepmc = "my-ldflags-hepmc"
os_data%ldflags_lcio = "my-ldflags-lcio"
os_data%ldflags_hoppet = "my-ldflags-hoppet"
os_data%ldflags_looptools = "my-ldflags-looptools"
os_data%whizard_ldflags = "my-ldwhizard"
os_data%whizard_libtool = "my-libtool"
end associate
call compilation%write_makefile (global%os_data, verbose = .true.)
open (u_file, file = char (exename) // ".makefile", &
status = "old", action = "read")
do
read (u_file, "(A)", end = 2) buffer
write (u, "(A)") trim (buffer)
end do
2 close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: compilations_3"
end subroutine compilations_3
@ %def compilations_3
@
\subsection{Test static build}
The tests for building a static executable are separate, since they
should be skipped if the \whizard\ build itself has static libraries
disabled.
<<Compilations: public test>>=
public :: compilations_static_test
<<Compilations: test driver>>=
subroutine compilations_static_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Compilations: static tests>>
end subroutine compilations_static_test
@ %def compilations_static_test
@
\subsubsection{External Matrix Element}
Compile an external test matrix element ([[omega]] type) and
incorporate this in a new static WHIZARD executable.
<<Compilations: static tests>>=
call test (compilations_static_1, "compilations_static_1", &
"static executable: compilation", &
u, results)
<<Compilations: test declarations>>=
public :: compilations_static_1
<<Compilations: tests>>=
subroutine compilations_static_1 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname, exename
type(rt_data_t), target :: global
type(compilation_item_t) :: item
type(compilation_t) :: compilation
logical :: exist
write (u, "(A)") "* Test output: compilations_static_1"
write (u, "(A)") "* Purpose: make static executable"
write (u, "(A)")
write (u, "(A)") "* Initialize library"
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
libname = "compilations_static_1_lib"
procname = "prc_comp_stat_1"
exename = "compilations_static_1"
call prepare_test_library (global, libname, 2, [procname,procname])
call compilation%init (exename, [libname])
write (u, "(A)")
write (u, "(A)") "* Write dispatcher"
call compilation%write_dispatcher ()
write (u, "(A)")
write (u, "(A)") "* Write Makefile"
call compilation%write_makefile (global%os_data, verbose = .true.)
write (u, "(A)")
write (u, "(A)") "* Build libraries"
call item%init (libname, global%prclib_stack, global%var_list)
call item%compile &
(global%model, global%os_data, force=.true., recompile=.false.)
call item%success ()
write (u, "(A)")
write (u, "(A)") "* Check executable (should be absent)"
write (u, "(A)")
call compilation%make_clean_exe (global%os_data)
inquire (file = char (exename), exist = exist)
write (u, "(A,A,L1)") char (exename), " exists = ", exist
write (u, "(A)")
write (u, "(A)") "* Build executable"
write (u, "(A)")
call compilation%make_compile (global%os_data)
call compilation%make_link (global%os_data)
write (u, "(A)") "* Check executable (should be present)"
write (u, "(A)")
inquire (file = char (exename), exist = exist)
write (u, "(A,A,L1)") char (exename), " exists = ", exist
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call compilation%make_clean_exe (global%os_data)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: compilations_static_1"
end subroutine compilations_static_1
@ %def compilations_static_1
@
\subsubsection{External Matrix Element}
Compile an external test matrix element ([[omega]] type) and
incorporate this in a new static WHIZARD executable. In this version,
we use the wrapper [[compile_executable]] procedure.
<<Compilations: static tests>>=
call test (compilations_static_2, "compilations_static_2", &
"static executable: shortcut", &
u, results)
<<Compilations: test declarations>>=
public :: compilations_static_2
<<Compilations: tests>>=
subroutine compilations_static_2 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname, exename
type(rt_data_t), target :: global
logical :: exist
integer :: u_file
write (u, "(A)") "* Test output: compilations_static_2"
write (u, "(A)") "* Purpose: make static executable"
write (u, "(A)")
write (u, "(A)") "* Initialize library and compile"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
libname = "compilations_static_2_lib"
procname = "prc_comp_stat_2"
exename = "compilations_static_2"
call prepare_test_library (global, libname, 2, [procname,procname])
call compile_executable (exename, [libname], global)
write (u, "(A)") "* Check executable (should be present)"
write (u, "(A)")
inquire (file = char (exename), exist = exist)
write (u, "(A,A,L1)") char (exename), " exists = ", exist
write (u, "(A)")
write (u, "(A)") "* Cleanup"
u_file = free_unit ()
open (u_file, file = char (exename), status = "old", action = "write")
close (u_file, status = "delete")
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: compilations_static_2"
end subroutine compilations_static_2
@ %def compilations_static_2
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Integration}
This module manages phase space setup, matrix-element evaluation and
integration, as far as it is not done by lower-level routines, in particular
in the [[processes]] module.
<<[[integrations.f90]]>>=
<<File header>>
module integrations
<<Use kinds>>
<<Use strings>>
use io_units
use diagnostics
use os_interface
use cputime
use sm_qcd
use physics_defs
use model_data
use pdg_arrays
use variables, only: var_list_t
use eval_trees
use sf_mappings
use sf_base
use phs_base
use mappings
use phs_forests, only: phs_parameters_t
use rng_base
use mci_base
use process_libraries
use prc_core
use process_config, only: COMP_MASTER, COMP_REAL_FIN, &
COMP_MISMATCH, COMP_PDF, COMP_REAL, COMP_SUB, COMP_VIRT, &
COMP_REAL_SING
use process
use pcm_base, only: pcm_t
use instances
use process_stacks
use models
use iterations
use rt_data
use dispatch_rng, only: dispatch_rng_factory
use dispatch_me_methods, only: dispatch_core
use dispatch_beams, only: dispatch_qcd, sf_prop_t, dispatch_sf_config
use dispatch_phase_space, only: dispatch_sf_channels
use dispatch_phase_space, only: dispatch_phs
use dispatch_mci, only: dispatch_mci_s
use dispatch_transforms, only: dispatch_evt_shower_hook
use compilations, only: compile_library
use dispatch_fks, only: dispatch_fks_s
use blha_olp_interfaces
use nlo_data
<<Use mpi f08>>
<<Standard module head>>
<<Integrations: public>>
<<Integrations: types>>
contains
<<Integrations: procedures>>
end module integrations
@ %def integrations
@
\subsection{The integration type}
This type holds all relevant data, the integration methods operates on this.
In contrast to the [[simulation_t]] introduced later, the [[integration_t]]
applies to a single process.
<<Integrations: public>>=
public :: integration_t
<<Integrations: types>>=
type :: integration_t
private
type(string_t) :: process_id
type(string_t) :: run_id
type(process_t), pointer :: process => null ()
type(var_list_t), pointer :: model_vars => null ()
type(qcd_t) :: qcd
logical :: rebuild_phs = .false.
logical :: ignore_phs_mismatch = .false.
logical :: phs_only = .false.
logical :: process_has_me = .true.
integer :: n_calls_test = 0
logical :: vis_history = .true.
type(string_t) :: history_filename
type(string_t) :: log_filename
logical :: combined_integration = .false.
type(iteration_multipliers_t) :: iteration_multipliers
type(nlo_settings_t) :: nlo_settings
contains
<<Integrations: integration: TBP>>
end type integration_t
@ %def integration_t
@
@
\subsection{Initialization}
Initialization, first part: Create a process entry.
Push it on the stack if the [[global]] environment is supplied.
<<Integrations: integration: TBP>>=
procedure :: create_process => integration_create_process
<<Integrations: procedures>>=
subroutine integration_create_process (intg, process_id, global)
class(integration_t), intent(out) :: intg
type(rt_data_t), intent(inout), optional, target :: global
type(string_t), intent(in) :: process_id
type(process_entry_t), pointer :: process_entry
call msg_debug (D_CORE, "integration_create_process")
intg%process_id = process_id
if (present (global)) then
allocate (process_entry)
intg%process => process_entry%process_t
call global%process_stack%push (process_entry)
else
allocate (process_t :: intg%process)
end if
intg%model_vars => null ()
end subroutine integration_create_process
@ %def integration_create_process
@ Initialization, second part: Initialize the process object, using the local
environment. We allocate a RNG factory and a QCD object.
We also fetch a pointer to the model that the process uses. The
process initializer will create a snapshot of that model.
This procedure
does not modify the [[local]] stack directly. The intent(inout) attribute for
the [[local]] data set is due to the random generator seed which may be
incremented during initialization.
NOTE: Changes to model parameters within the current context are respected
only if the process model coincides with the current model. This is the usual
case. If not, we read
the model from the global model library, which has default parameters. To
become more flexible, we should implement a local model library which records
local changes to currently inactive models.
<<Integrations: integration: TBP>>=
procedure :: init_process => integration_init_process
<<Integrations: procedures>>=
subroutine integration_init_process (intg, local)
class(integration_t), intent(inout) :: intg
type(rt_data_t), intent(inout), target :: local
type(string_t) :: model_name
type(model_t), pointer :: model
class(model_data_t), pointer :: model_instance
class(rng_factory_t), allocatable :: rng_factory
call msg_debug (D_CORE, "integration_init_process")
if (.not. local%prclib%contains (intg%process_id)) then
call msg_fatal ("Process '" // char (intg%process_id) // "' not found" &
// " in library '" // char (local%prclib%get_name ()) // "'")
return
end if
intg%run_id = local%var_list%get_sval (var_str ("$run_id"))
call dispatch_qcd (intg%qcd, local%get_var_list_ptr (), local%os_data)
call dispatch_rng_factory (rng_factory, local%var_list)
model_name = local%prclib%get_model_name (intg%process_id)
if (local%get_sval (var_str ("$model_name")) == model_name) then
model => local%model
else
model => local%model_list%get_model_ptr (model_name)
end if
allocate (model_t :: model_instance)
select type (model_instance)
type is (model_t)
call model_instance%init_instance (model)
intg%model_vars => model_instance%get_var_list_ptr ()
end select
call intg%process%init (intg%process_id, intg%run_id, &
local%prclib, &
local%os_data, intg%qcd, rng_factory, model_instance)
end subroutine integration_init_process
@ %def integration_init_process
@ Initialization, third part: complete process configuration.
<<Integrations: integration: TBP>>=
procedure :: setup_process => integration_setup_process
<<Integrations: procedures>>=
subroutine integration_setup_process (intg, local, verbose, init_only)
class(integration_t), intent(inout) :: intg
type(rt_data_t), intent(inout), target :: local
logical, intent(in), optional :: verbose
logical, intent(in), optional :: init_only
type(var_list_t), pointer :: var_list
class(prc_core_t), allocatable :: core_template
class(prc_core_t), pointer :: core => null ()
class(phs_config_t), allocatable :: phs_config_template
type(phs_parameters_t) :: phs_par
type(mapping_defaults_t) :: mapping_defs
class(mci_t), allocatable :: mci_template
integer :: n_components, i_component
type(process_component_def_t), pointer :: config
type(helicity_selection_t) :: helicity_selection
logical :: use_color_factors
type(sf_config_t), dimension(:), allocatable :: sf_config
type(sf_prop_t) :: sf_prop
type(sf_channel_t), dimension(:), allocatable :: sf_channel
type(phs_channel_collection_t) :: phs_channel_collection
logical :: sf_trace
logical :: verb, initialize_only
type(blha_template_t) :: blha_template
type(fks_template_t) :: fks_template
type(string_t) :: sf_string
class(phs_config_t), allocatable :: phs_config_template_other
+ type(string_t) :: workspace
integer :: i_real
integer :: i_core
integer :: i_core_born, i_core_real
logical :: first_real_component, has_pdfs
integer :: nlo_type_fetched
class(pcm_t), pointer :: pcm => null ()
i_real = 0
verb = .true.; if (present (verbose)) verb = verbose
initialize_only = .false.; if (present (init_only)) initialize_only = init_only
call intg%process%set_var_list (local%get_var_list_ptr ())
var_list => intg%process%get_var_list_ptr ()
call setup_phase_space ()
intg%n_calls_test = &
var_list%get_ival (var_str ("n_calls_test"))
call setup_log_and_history ()
call dispatch_mci_s (mci_template, local%get_var_list_ptr (), &
intg%process_id, &
intg%process%is_nlo_calculation ())
call display_init_message (verb)
n_components = intg%process%get_n_components ()
intg%combined_integration = var_list%get_lval &
(var_str ('?combined_nlo_integration')) .and. &
intg%process%is_nlo_calculation ()
helicity_selection = local%get_helicity_selection ()
use_color_factors = var_list%get_lval &
(var_str ("?read_color_factors"))
do i_component = 1, n_components
config => intg%process%get_component_def_ptr (i_component)
call intg%process%core_manager_register &
(config%get_nlo_type (), i_component, &
config%get_def_type_string ())
end do
call intg%process%allocate_cm_arrays (n_components)
do i_core = 1, intg%process%get_n_cores ()
i_component = intg%process%get_core_manager_index (i_core)
config => intg%process%get_component_def_ptr (i_component)
call dispatch_core (core_template, config%get_core_def_ptr (), &
intg%process%get_model_ptr (), &
helicity_selection, intg%qcd, &
use_color_factors)
call intg%process%allocate_core (i_core, core_template)
deallocate (core_template)
end do
call intg%process%init_cores ()
first_real_component = .true.
pcm => intg%process%get_pcm_ptr ()
pcm%has_pdfs = local%beam_structure%has_pdf ()
do i_component = 1, n_components
config => intg%process%get_component_def_ptr (i_component)
nlo_type_fetched = config%get_nlo_type ()
if (nlo_type_fetched == NLO_MISMATCH) nlo_type_fetched = NLO_SUBTRACTION
core => intg%process%get_core_from_md5sum ( &
intg%process%get_md5sum_constants (i_component, &
config%get_def_type_string (), nlo_type_fetched))
select case (config%get_nlo_type ())
case (NLO_VIRTUAL)
call setup_virtual_component ()
case (NLO_REAL)
call setup_real_component ()
if (intg%process%get_component_type (i_component) /= COMP_REAL_FIN) &
i_real = i_component
case (NLO_MISMATCH)
call setup_mismatch_component ()
case (NLO_DGLAP)
call setup_dglap_component ()
case (BORN)
call setup_born_component ()
case (NLO_SUBTRACTION)
call setup_subtraction_component ()
case (GKS)
call intg%process%init_component (i_component, &
core%has_matrix_element (), mci_template, &
phs_config_template)
case default
call msg_fatal ("setup_process: NLO type not implemented!")
end select
if (allocated (phs_config_template_other)) &
deallocate (phs_config_template_other)
end do
intg%process_has_me = intg%process%has_matrix_element ()
if (.not. intg%process_has_me) then
call msg_warning ("Process '" &
// char (intg%process_id) // "': matrix element vanishes")
end if
call setup_beams ()
call setup_structure_functions ()
- call intg%process%configure_phs &
- (intg%rebuild_phs, intg%ignore_phs_mismatch, &
- combined_integration = intg%combined_integration)
+ workspace = var_list%get_sval (var_str ("$integrate_workspace"))
+ if (workspace == "") then
+ call intg%process%configure_phs &
+ (intg%rebuild_phs, intg%ignore_phs_mismatch, &
+ combined_integration = intg%combined_integration)
+ else
+ call intg%process%configure_phs &
+ (intg%rebuild_phs, intg%ignore_phs_mismatch, &
+ combined_integration = intg%combined_integration, &
+ subdir = workspace)
+ end if
if (intg%process%is_nlo_calculation ()) then
call dispatch_fks_s (fks_template, local%var_list)
call intg%process%init_nlo_settings (var_list, fks_template)
call intg%process%check_if_threshold_method ()
i_core_real = intg%process%get_i_core_nlo_type (NLO_REAL)
i_core_born = intg%process%get_i_core_nlo_type (BORN)
call intg%process%setup_region_data (i_real, &
intg%process%get_constants(i_core_born), &
intg%process%get_constants(i_core_real))
if (var_list%get_lval (var_str ("?nlo_use_real_partition"))) then
call intg%process%setup_real_partition &
(var_list%get_rval (var_str ("real_partition_scale")))
end if
end if
if (intg%process%needs_extra_code ()) then
call blha_template%init (local%beam_structure%has_polarized_beams(), &
var_list%get_lval (var_str ("?openloops_switch_off_muon_yukawa")), &
var_list%get_rval (var_str ("blha_top_yukawa")), &
var_list%get_sval (var_str ("$blha_ew_scheme")))
call intg%process%init_blha_cores (blha_template, var_list)
call intg%process%create_and_load_extra_libraries &
(local%beam_structure, var_list, local%os_data)
end if
call intg%process%setup_terms (with_beams = local%beam_structure%has_polarized_beams ())
if (verb) then
call intg%process%write (screen = .true.)
call intg%process%print_phs_startup_message ()
end if
if (intg%process_has_me) then
if (size (sf_config) > 0) then
call intg%process%collect_channels (phs_channel_collection)
else if (.not. initialize_only &
.and. intg%process%contains_trivial_component ()) then
call msg_fatal ("Integrate: 2 -> 1 process can't be handled &
&with fixed-energy beams")
end if
call dispatch_sf_channels &
(sf_channel, sf_string, sf_prop, phs_channel_collection, &
local%var_list, local%get_sqrts(), local%beam_structure)
if (allocated (sf_channel)) then
if (size (sf_channel) > 0) then
call intg%process%set_sf_channel (sf_channel)
end if
end if
call phs_channel_collection%final ()
if (verb) call intg%process%sf_startup_message (sf_string)
end if
call intg%setup_process_mci ()
call setup_expressions ()
call intg%process%compute_md5sum ()
contains
subroutine setup_phase_space ()
intg%rebuild_phs = &
var_list%get_lval (var_str ("?rebuild_phase_space"))
intg%ignore_phs_mismatch = &
.not. var_list%get_lval (var_str ("?check_phs_file"))
intg%phs_only = &
var_list%get_lval (var_str ("?phs_only"))
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"))
call dispatch_phs (phs_config_template, local%var_list, &
local%os_data, intg%process_id, mapping_defs, phs_par)
end subroutine setup_phase_space
subroutine setup_log_and_history ()
!!! We avoid two dots in the filename due to a bug in certain MetaPost versions.
if (intg%run_id /= "") then
intg%history_filename = intg%process_id // "." // intg%run_id &
// ".history"
intg%log_filename = intg%process_id // "." // intg%run_id // ".log"
else
intg%history_filename = intg%process_id // ".history"
intg%log_filename = intg%process_id // ".log"
end if
intg%vis_history = &
var_list%get_lval (var_str ("?vis_history"))
end subroutine setup_log_and_history
subroutine display_init_message (verb)
logical, intent(in) :: verb
if (verb) then
call msg_message ("Initializing integration for process " &
// char (intg%process_id) // ":")
if (intg%run_id /= "") &
call msg_message ("Run ID = " // '"' // char (intg%run_id) // '"')
end if
end subroutine display_init_message
subroutine setup_born_component ()
call intg%process%init_component (i_component, &
core%has_matrix_element (), mci_template, phs_config_template)
call intg%process%set_component_type (i_component, COMP_MASTER)
end subroutine setup_born_component
subroutine setup_virtual_component ()
call intg%process%init_component (i_component, &
core%has_matrix_element (), mci_template, phs_config_template)
call intg%process%set_component_type (i_component, COMP_VIRT)
end subroutine setup_virtual_component
subroutine setup_real_component ()
logical :: use_finite_real
use_finite_real = var_list%get_lval (var_str ("?nlo_use_real_partition"))
if (first_real_component) then
call dispatch_phs (phs_config_template_other, local%var_list, &
local%os_data, intg%process_id, mapping_defs, phs_par, &
var_str ('fks'))
else
call dispatch_phs (phs_config_template_other, local%var_list, &
local%os_data, intg%process_id, mapping_defs, phs_par, &
var_str ('wood'))
end if
call intg%process%init_component (i_component, &
core%has_matrix_element (), mci_template, phs_config_template_other)
if (use_finite_real) then
if (first_real_component) then
call intg%process%set_component_type (i_component, COMP_REAL_SING)
first_real_component = .false.
else
call intg%process%set_component_type (i_component, COMP_REAL_FIN)
end if
else
call intg%process%set_component_type (i_component, COMP_REAL)
end if
end subroutine setup_real_component
subroutine setup_mismatch_component ()
call dispatch_phs (phs_config_template_other, local%var_list, &
local%os_data, intg%process_id, mapping_defs, phs_par, var_str ('fks'))
call intg%process%init_component (i_component, &
core%has_matrix_element (), mci_template, phs_config_template_other)
if (intg%combined_integration) &
call intg%process%set_component_type (i_component, COMP_MISMATCH)
end subroutine setup_mismatch_component
subroutine setup_dglap_component ()
call dispatch_phs (phs_config_template_other, local%var_list, local%os_data, &
intg%process_id, mapping_defs, phs_par, var_str ('fks'))
call intg%process%init_component (i_component, &
core%has_matrix_element (), mci_template, phs_config_template_other)
if (intg%combined_integration) &
call intg%process%set_component_type (i_component, COMP_PDF)
end subroutine setup_dglap_component
subroutine setup_subtraction_component ()
call intg%process%init_component (i_component, .false., &
mci_template, phs_config_template)
if (intg%combined_integration) &
call intg%process%set_component_type (i_component, COMP_SUB)
end subroutine setup_subtraction_component
subroutine setup_beams ()
real(default) :: sqrts
logical :: decay_rest_frame
sqrts = local%get_sqrts ()
decay_rest_frame = &
var_list%get_lval (var_str ("?decay_rest_frame"))
if (intg%process_has_me) then
call intg%process%setup_beams_beam_structure &
(local%beam_structure, sqrts, decay_rest_frame)
end if
call intg%process%check_masses ()
if (verb .and. intg%process_has_me) then
call intg%process%beams_startup_message &
(beam_structure = local%beam_structure)
end if
end subroutine setup_beams
subroutine setup_structure_functions ()
integer :: n_in
type(pdg_array_t), dimension(:,:), allocatable :: pdg_prc
type(string_t) :: sf_trace_file
if (intg%process_has_me) then
call intg%process%get_pdg_in (pdg_prc)
else
n_in = intg%process%get_n_in ()
allocate (pdg_prc (n_in, n_components))
pdg_prc = 0
end if
call dispatch_sf_config (sf_config, sf_prop, local%beam_structure, &
local%get_var_list_ptr (), local%var_list, &
local%model, local%os_data, local%get_sqrts (), pdg_prc)
sf_trace = &
var_list%get_lval (var_str ("?sf_trace"))
sf_trace_file = &
var_list%get_sval (var_str ("$sf_trace_file"))
if (sf_trace) then
call intg%process%init_sf_chain (sf_config, sf_trace_file)
else
call intg%process%init_sf_chain (sf_config)
end if
end subroutine setup_structure_functions
subroutine setup_expressions ()
type(eval_tree_factory_t) :: expr_factory
if (associated (local%pn%cuts_lexpr)) then
if (verb) call msg_message ("Applying user-defined cuts.")
call expr_factory%init (local%pn%cuts_lexpr)
call intg%process%set_cuts (expr_factory)
else
if (verb) call msg_warning ("No cuts have been defined.")
end if
if (associated (local%pn%scale_expr)) then
if (verb) call msg_message ("Using user-defined general scale.")
call expr_factory%init (local%pn%scale_expr)
call intg%process%set_scale (expr_factory)
end if
if (associated (local%pn%fac_scale_expr)) then
if (verb) call msg_message ("Using user-defined factorization scale.")
call expr_factory%init (local%pn%fac_scale_expr)
call intg%process%set_fac_scale (expr_factory)
end if
if (associated (local%pn%ren_scale_expr)) then
if (verb) call msg_message ("Using user-defined renormalization scale.")
call expr_factory%init (local%pn%ren_scale_expr)
call intg%process%set_ren_scale (expr_factory)
end if
if (associated (local%pn%weight_expr)) then
if (verb) call msg_message ("Using user-defined reweighting factor.")
call expr_factory%init (local%pn%weight_expr)
call intg%process%set_weight (expr_factory)
end if
end subroutine setup_expressions
end subroutine integration_setup_process
@ %def integration_setup_process
@
\subsection{Integration}
Integrate: do the final integration. Here, we do a multi-iteration
integration. Again, we skip iterations that are already on file.
Record the results in the global variable list.
<<Integrations: integration: TBP>>=
procedure :: evaluate => integration_evaluate
<<Integrations: procedures>>=
subroutine integration_evaluate &
(intg, process_instance, i_mci, pass, it_list, pacify)
class(integration_t), intent(inout) :: intg
type(process_instance_t), intent(inout), target :: process_instance
integer, intent(in) :: i_mci
integer, intent(in) :: pass
type(iterations_list_t), intent(in) :: it_list
logical, intent(in), optional :: pacify
integer :: n_calls, n_it
logical :: adapt_grids, adapt_weights, final
n_it = it_list%get_n_it (pass)
n_calls = it_list%get_n_calls (pass)
adapt_grids = it_list%adapt_grids (pass)
adapt_weights = it_list%adapt_weights (pass)
final = pass == it_list%get_n_pass ()
call process_instance%integrate ( &
i_mci, n_it, n_calls, adapt_grids, adapt_weights, &
final, pacify)
end subroutine integration_evaluate
@ %def integration_evaluate
@ In case the user has not provided a list of iterations, make a
reasonable default. This can depend on the process. The usual
approach is to define two distinct passes, one for adaptation and one
for integration.
<<Integrations: integration: TBP>>=
procedure :: make_iterations_list => integration_make_iterations_list
<<Integrations: procedures>>=
subroutine integration_make_iterations_list (intg, it_list)
class(integration_t), intent(in) :: intg
type(iterations_list_t), intent(out) :: it_list
integer :: pass, n_pass
integer, dimension(:), allocatable :: n_it, n_calls
logical, dimension(:), allocatable :: adapt_grids, adapt_weights
n_pass = intg%process%get_n_pass_default ()
allocate (n_it (n_pass), n_calls (n_pass))
allocate (adapt_grids (n_pass), adapt_weights (n_pass))
do pass = 1, n_pass
n_it(pass) = intg%process%get_n_it_default (pass)
n_calls(pass) = intg%process%get_n_calls_default (pass)
adapt_grids(pass) = intg%process%adapt_grids_default (pass)
adapt_weights(pass) = intg%process%adapt_weights_default (pass)
end do
call it_list%init (n_it, n_calls, &
adapt_grids = adapt_grids, adapt_weights = adapt_weights)
end subroutine integration_make_iterations_list
@ %def integration_make_iterations_list
@ In NLO calculations, the individual components might scale very differently
with the number of calls. This especially applies to the real-subtracted
component, which usually fluctuates more than the Born and virtual
component, making it a bottleneck of the calculation. Thus, the calculation
is throttled twice, first by the number of calls for the real component,
second by the number of surplus calls of computation-intense virtual
matrix elements. Therefore, we want to set a different number of calls
for each component, which is done by the subroutine [[integration_apply_call_multipliers]].
<<Integrations: integration: TBP>>=
procedure :: init_iteration_multipliers => integration_init_iteration_multipliers
<<Integrations: procedures>>=
subroutine integration_init_iteration_multipliers (intg, local)
class(integration_t), intent(inout) :: intg
type(rt_data_t), intent(in) :: local
integer :: n_pass, pass
type(iterations_list_t) :: it_list
n_pass = local%it_list%get_n_pass ()
if (n_pass == 0) then
call intg%make_iterations_list (it_list)
n_pass = it_list%get_n_pass ()
end if
associate (it_multipliers => intg%iteration_multipliers)
allocate (it_multipliers%n_calls0 (n_pass))
do pass = 1, n_pass
it_multipliers%n_calls0(pass) = local%it_list%get_n_calls (pass)
end do
it_multipliers%mult_real = local%var_list%get_rval &
(var_str ("mult_call_real"))
it_multipliers%mult_virt = local%var_list%get_rval &
(var_str ("mult_call_virt"))
it_multipliers%mult_dglap = local%var_list%get_rval &
(var_str ("mult_call_dglap"))
end associate
end subroutine integration_init_iteration_multipliers
@ %def integration_init_iteration_multipliers
@
<<Integrations: integration: TBP>>=
procedure :: apply_call_multipliers => integration_apply_call_multipliers
<<Integrations: procedures>>=
subroutine integration_apply_call_multipliers (intg, n_pass, i_component, it_list)
class(integration_t), intent(in) :: intg
integer, intent(in) :: n_pass, i_component
type(iterations_list_t), intent(inout) :: it_list
integer :: nlo_type
integer :: n_calls0, n_calls
integer :: pass
real(default) :: multiplier
nlo_type = intg%process%get_component_nlo_type (i_component)
do pass = 1, n_pass
associate (multipliers => intg%iteration_multipliers)
select case (nlo_type)
case (NLO_REAL)
multiplier = multipliers%mult_real
case (NLO_VIRTUAL)
multiplier = multipliers%mult_virt
case (NLO_DGLAP)
multiplier = multipliers%mult_dglap
case default
return
end select
end associate
if (n_pass <= size (intg%iteration_multipliers%n_calls0)) then
n_calls0 = intg%iteration_multipliers%n_calls0 (pass)
n_calls = floor (multiplier * n_calls0)
call it_list%set_n_calls (pass, n_calls)
end if
end do
end subroutine integration_apply_call_multipliers
@ %def integration_apply_call_multipliers
@
\subsection{API for integration objects}
This initializer does everything except assigning cuts/scale/weight
expressions.
<<Integrations: integration: TBP>>=
procedure :: init => integration_init
<<Integrations: procedures>>=
subroutine integration_init &
(intg, process_id, local, global, local_stack, init_only)
class(integration_t), intent(out) :: intg
type(string_t), intent(in) :: process_id
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), optional, target :: global
logical, intent(in), optional :: init_only
logical, intent(in), optional :: local_stack
logical :: use_local
use_local = .false.; if (present (local_stack)) use_local = local_stack
if (present (global)) then
call intg%create_process (process_id, global)
else if (use_local) then
call intg%create_process (process_id, local)
else
call intg%create_process (process_id)
end if
call intg%init_process (local)
call intg%setup_process (local, init_only = init_only)
call intg%init_iteration_multipliers (local)
end subroutine integration_init
@ %def integration_init
@ Do the integration for a single process, both warmup and final evaluation.
The [[eff_reset]] flag is to suppress numerical noise in the graphical output
of the integration history.
<<Integrations: integration: TBP>>=
procedure :: integrate => integration_integrate
<<Integrations: procedures>>=
subroutine integration_integrate (intg, local, eff_reset)
class(integration_t), intent(inout) :: intg
type(rt_data_t), intent(in), target :: local
logical, intent(in), optional :: eff_reset
type(string_t) :: log_filename
type(var_list_t), pointer :: var_list
type(process_instance_t), allocatable, target :: process_instance
type(iterations_list_t) :: it_list
logical :: pacify
integer :: pass, i_mci, n_mci, n_pass
integer :: i_component
integer :: nlo_type
logical :: display_summed
logical :: nlo_active
type(string_t) :: component_output
allocate (process_instance)
call process_instance%init (intg%process)
var_list => intg%process%get_var_list_ptr ()
call openmp_set_num_threads_verbose &
(var_list%get_ival (var_str ("openmp_num_threads")), &
var_list%get_lval (var_str ("?openmp_logging")))
pacify = var_list%get_lval (var_str ("?pacify"))
display_summed = .true.
n_mci = intg%process%get_n_mci ()
if (n_mci == 1) then
write (msg_buffer, "(A,A,A)") &
"Starting integration for process '", &
char (intg%process%get_id ()), "'"
call msg_message ()
end if
call setup_hooks ()
nlo_active = any (intg%process%get_component_nlo_type &
([(i_mci, i_mci = 1, n_mci)]) /= BORN)
do i_mci = 1, n_mci
i_component = intg%process%get_master_component (i_mci)
nlo_type = intg%process%get_component_nlo_type (i_component)
if (intg%process%component_can_be_integrated (i_component)) then
if (n_mci > 1) then
if (nlo_active) then
if (intg%combined_integration .and. nlo_type == BORN) then
component_output = var_str ("Combined")
else
component_output = component_status (nlo_type)
end if
write (msg_buffer, "(A,A,A,A,A)") &
"Starting integration for process '", &
char (intg%process%get_id ()), "' part '", &
char (component_output), "'"
else
write (msg_buffer, "(A,A,A,I0)") &
"Starting integration for process '", &
char (intg%process%get_id ()), "' part ", i_mci
end if
call msg_message ()
end if
n_pass = local%it_list%get_n_pass ()
if (n_pass == 0) then
call msg_message ("Integrate: iterations not specified, &
&using default")
call intg%make_iterations_list (it_list)
n_pass = it_list%get_n_pass ()
else
it_list = local%it_list
end if
call intg%apply_call_multipliers (n_pass, i_mci, it_list)
call msg_message ("Integrate: " // char (it_list%to_string ()))
do pass = 1, n_pass
call intg%evaluate (process_instance, i_mci, pass, it_list, pacify)
if (signal_is_pending ()) return
end do
call intg%process%final_integration (i_mci)
if (intg%vis_history) then
call intg%process%display_integration_history &
(i_mci, intg%history_filename, local%os_data, eff_reset)
end if
if (local%logfile == intg%log_filename) then
if (intg%run_id /= "") then
log_filename = intg%process_id // "." // intg%run_id // &
".var.log"
else
log_filename = intg%process_id // ".var.log"
end if
call msg_message ("Name clash for global logfile and process log: ", &
arr =[var_str ("| Renaming log file from ") // local%logfile, &
var_str ("| to ") // log_filename // var_str (" .")])
else
log_filename = intg%log_filename
end if
call intg%process%write_logfile (i_mci, log_filename)
end if
end do
if (n_mci > 1 .and. display_summed) then
call msg_message ("Integrate: sum of all components")
call intg%process%display_summed_results (pacify)
end if
call process_instance%final ()
deallocate (process_instance)
contains
subroutine setup_hooks ()
class(process_instance_hook_t), pointer :: hook
call dispatch_evt_shower_hook (hook, var_list, process_instance)
if (associated (hook)) then
call process_instance%append_after_hook (hook)
end if
end subroutine setup_hooks
end subroutine integration_integrate
@ %def integration_integrate
@
<<Integrations: integration: TBP>>=
procedure :: setup_process_mci => integration_setup_process_mci
<<Integrations: procedures>>=
subroutine integration_setup_process_mci (intg)
class(integration_t), intent(inout) :: intg
call intg%process%setup_mci (intg%combined_integration)
end subroutine integration_setup_process_mci
@ %def integration_setup_process_mci@
@ Do a dummy integration for a process which could not be initialized (e.g.,
has no matrix element). The result is zero.
<<Integrations: integration: TBP>>=
procedure :: integrate_dummy => integration_integrate_dummy
<<Integrations: procedures>>=
subroutine integration_integrate_dummy (intg)
class(integration_t), intent(inout) :: intg
call intg%process%integrate_dummy ()
end subroutine integration_integrate_dummy
@ %def integration_integrate_dummy
@ Just sample the matrix element under realistic conditions (but no
cuts); throw away the results.
<<Integrations: integration: TBP>>=
procedure :: sampler_test => integration_sampler_test
<<Integrations: procedures>>=
subroutine integration_sampler_test (intg)
class(integration_t), intent(inout) :: intg
type(process_instance_t), allocatable, target :: process_instance
integer :: n_mci, i_mci
type(timer_t) :: timer_mci, timer_tot
real(default) :: t_mci, t_tot
allocate (process_instance)
call process_instance%init (intg%process)
n_mci = intg%process%get_n_mci ()
if (n_mci == 1) then
write (msg_buffer, "(A,A,A)") &
"Test: probing process '", &
char (intg%process%get_id ()), "'"
call msg_message ()
end if
call timer_tot%start ()
do i_mci = 1, n_mci
if (n_mci > 1) then
write (msg_buffer, "(A,A,A,I0)") &
"Test: probing process '", &
char (intg%process%get_id ()), "' part ", i_mci
call msg_message ()
end if
call timer_mci%start ()
call process_instance%sampler_test (i_mci, intg%n_calls_test)
call timer_mci%stop ()
t_mci = timer_mci
write (msg_buffer, "(A,ES12.5)") "Test: " &
// "time in seconds (wallclock): ", t_mci
call msg_message ()
end do
call timer_tot%stop ()
t_tot = timer_tot
if (n_mci > 1) then
write (msg_buffer, "(A,ES12.5)") "Test: " &
// "total time (wallclock): ", t_tot
call msg_message ()
end if
call process_instance%final ()
end subroutine integration_sampler_test
@ %def integration_sampler_test
@ Return the process pointer (needed by simulate):
<<Integrations: integration: TBP>>=
procedure :: get_process_ptr => integration_get_process_ptr
<<Integrations: procedures>>=
function integration_get_process_ptr (intg) result (ptr)
class(integration_t), intent(in) :: intg
type(process_t), pointer :: ptr
ptr => intg%process
end function integration_get_process_ptr
@ %def integration_get_process_ptr
@ Simply integrate, do a dummy integration if necessary. The [[integration]]
object exists only internally.
If the [[global]] environment is provided, the process object is appended to
the global stack. Otherwise, if [[local_stack]] is set, we append to the
local process stack. If this is unset, the [[process]] object is not recorded
permanently.
The [[init_only]] flag can be used to skip the actual integration part. We
will end up with a process object that is completely initialized, including
phase space configuration.
The [[eff_reset]] flag is to suppress numerical noise in the visualization
of the integration history.
<<Integrations: public>>=
public :: integrate_process
<<Integrations: procedures>>=
subroutine integrate_process (process_id, local, global, local_stack, init_only, eff_reset)
type(string_t), intent(in) :: process_id
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), optional, target :: global
logical, intent(in), optional :: local_stack, init_only, eff_reset
type(string_t) :: prclib_name
type(integration_t) :: intg
character(32) :: buffer
<<Integrations: integrate process: variables>>
<<Integrations: integrate process: init>>
if (.not. associated (local%prclib)) then
call msg_fatal ("Integrate: current process library is undefined")
return
end if
if (.not. local%prclib%is_active ()) then
call msg_message ("Integrate: current process library needs compilation")
prclib_name = local%prclib%get_name ()
call compile_library (prclib_name, local)
if (signal_is_pending ()) return
call msg_message ("Integrate: compilation done")
end if
call intg%init (process_id, local, global, local_stack, init_only)
if (signal_is_pending ()) return
if (present (init_only)) then
if (init_only) return
end if
if (intg%n_calls_test > 0) then
write (buffer, "(I0)") intg%n_calls_test
call msg_message ("Integrate: test (" // trim (buffer) // " calls) ...")
call intg%sampler_test ()
call msg_message ("Integrate: ... test complete.")
if (signal_is_pending ()) return
end if
<<Integrations: integrate process: end init>>
if (intg%phs_only) then
call msg_message ("Integrate: phase space only, skipping integration")
else
if (intg%process_has_me) then
call intg%integrate (local, eff_reset)
else
call intg%integrate_dummy ()
end if
end if
end subroutine integrate_process
@ %def integrate_process
<<Integrations: integrate process: variables>>=
@
<<Integrations: integrate process: init>>=
@
<<Integrations: integrate process: end init>>=
@
@ The parallelization leads to undefined behavior while writing simultaneously to one file.
The master worker has to initialize single-handed the corresponding library files and the phase space file.
The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
<<MPI: Integrations: integrate process: variables>>=
type(var_list_t), pointer :: var_list
logical :: mpi_logging, process_init
integer :: rank, n_size
<<MPI: Integrations: integrate process: init>>=
call msg_debug (D_MPI, "integrate_process")
var_list => local%get_var_list_ptr ()
process_init = .false.
call mpi_get_comm_id (n_size, rank)
mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) .and. &
& (n_size > 1)) .or. var_list%get_lval (var_str ("?mpi_logging")))
call msg_debug (D_MPI, "n_size", rank)
call msg_debug (D_MPI, "rank", rank)
call msg_debug (D_MPI, "mpi_logging", mpi_logging)
if (rank /= 0) then
if (mpi_logging) then
call msg_message ("MPI: wait for master to finish process initialization ...")
end if
call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
else
process_init = .true.
end if
if (process_init) then
<<MPI: Integrations: integrate process: end init>>=
if (rank == 0) then
if (mpi_logging) then
call msg_message ("MPI: finish process initialization, load slaves ...")
end if
call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
end if
end if
call MPI_barrier (MPI_COMM_WORLD)
call mpi_set_logging (mpi_logging)
@ %def integrate_process_mpi
@
\subsection{Unit Tests}
Test module, followed by the stand-alone unit-test procedures.
<<[[integrations_ut.f90]]>>=
<<File header>>
module integrations_ut
use unit_tests
use integrations_uti
<<Standard module head>>
<<Integrations: public test>>
contains
<<Integrations: test driver>>
end module integrations_ut
@ %def integrations_ut
@
<<[[integrations_uti.f90]]>>=
<<File header>>
module integrations_uti
<<Use kinds>>
<<Use strings>>
use io_units
use ifiles
use lexers
use parser
use io_units
use flavors
use interactions, only: reset_interaction_counter
use phs_forests
use eval_trees
use models
use rt_data
use process_configurations_ut, only: prepare_test_library
use compilations, only: compile_library
use integrations
use phs_wood_ut, only: write_test_phs_file
<<Standard module head>>
<<Integrations: test declarations>>
contains
<<Integrations: tests>>
end module integrations_uti
@ %def integrations_uti
@ API: driver for the unit tests below.
<<Integrations: public test>>=
public :: integrations_test
<<Integrations: test driver>>=
subroutine integrations_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Integrations: execute tests>>
end subroutine integrations_test
@ %def integrations_test
@
<<Integrations: public test>>=
public :: integrations_history_test
<<Integrations: test driver>>=
subroutine integrations_history_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Integrations: execute history tests>>
end subroutine integrations_history_test
@ %def integrations_history_test
@
\subsubsection{Integration of test process}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type). The phase-space implementation is [[phs_single]]
(single-particle phase space), the integrator is [[mci_midpoint]].
The cross section for the $2\to 2$ process $ss\to ss$ with its
constant matrix element is given by
\begin{equation}
\sigma = c\times f\times \Phi_2 \times |M|^2.
\end{equation}
$c$ is the conversion constant
\begin{equation}
c = 0.3894\times 10^{12}\;\mathrm{fb}\,\mathrm{GeV}^2.
\end{equation}
$f$ is the flux of the incoming particles with mass
$m=125\,\mathrm{GeV}$ and energy $\sqrt{s}=1000\,\mathrm{GeV}$
\begin{equation}
f = \frac{(2\pi)^4}{2\lambda^{1/2}(s,m^2,m^2)}
= \frac{(2\pi)^4}{2\sqrt{s}\,\sqrt{s - 4m^2}}
= 8.048\times 10^{-4}\;\mathrm{GeV}^{-2}
\end{equation}
$\Phi_2$ is the volume of the two-particle phase space
\begin{equation}
\Phi_2 = \frac{1}{4(2\pi)^5} = 2.5529\times 10^{-5}.
\end{equation}
The squared matrix element $|M|^2$ is unity.
Combining everything, we obtain
\begin{equation}
\sigma = 8000\;\mathrm{fb}
\end{equation}
This number should appear as the final result.
Note: In this and the following test, we reset the Fortran compiler and flag
variables immediately before they are printed, so the test is portable.
<<Integrations: execute tests>>=
call test (integrations_1, "integrations_1", &
"intrinsic test process", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_1
<<Integrations: tests>>=
subroutine integrations_1 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: integrations_1"
write (u, "(A)") "* Purpose: integrate test process"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
libname = "integration_1"
procname = "prc_config_a"
call prepare_test_library (global, libname, 1)
call compile_library (libname, global)
call global%set_string (var_str ("$run_id"), &
var_str ("integrations1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true.)
call global%write (u, vars = [ &
var_str ("$method"), &
var_str ("sqrts"), &
var_str ("$integration_method"), &
var_str ("$phs_method"), &
var_str ("$run_id")])
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_1"
end subroutine integrations_1
@ %def integrations_1
@
\subsubsection{Integration with cuts}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type) with cuts set.
<<Integrations: execute tests>>=
call test (integrations_2, "integrations_2", &
"intrinsic test process with cut", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_2
<<Integrations: tests>>=
subroutine integrations_2 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
type(string_t) :: cut_expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: parse_tree
type(string_t), dimension(0) :: empty_string_array
write (u, "(A)") "* Test output: integrations_2"
write (u, "(A)") "* Purpose: integrate test process with cut"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
write (u, "(A)") "* Prepare a cut expression"
write (u, "(A)")
call syntax_pexpr_init ()
cut_expr_text = "all Pt > 100 [s]"
call ifile_append (ifile, cut_expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (parse_tree, stream, .true.)
global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
write (u, "(A)") "* Build and initialize a test process"
write (u, "(A)")
libname = "integration_3"
procname = "prc_config_a"
call prepare_test_library (global, libname, 1)
call compile_library (libname, global)
call global%set_string (var_str ("$run_id"), &
var_str ("integrations1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true.)
call global%write (u, vars = empty_string_array)
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_2"
end subroutine integrations_2
@ %def integrations_2
@
\subsubsection{Standard phase space}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type) using the default ([[phs_wood]]) phase-space implementation. We
use an explicit phase-space configuration file with a single channel
and integrate by [[mci_midpoint]].
<<Integrations: execute tests>>=
call test (integrations_3, "integrations_3", &
"standard phase space", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_3
<<Integrations: tests>>=
subroutine integrations_3 (u)
<<Use kinds>>
<<Use strings>>
use interactions, only: reset_interaction_counter
use models
use rt_data
use process_configurations_ut, only: prepare_test_library
use compilations, only: compile_library
use integrations
implicit none
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
integer :: u_phs
write (u, "(A)") "* Test output: integrations_3"
write (u, "(A)") "* Purpose: integrate test process"
write (u, "(A)")
write (u, "(A)") "* Initialize process and parameters"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
libname = "integration_3"
procname = "prc_config_a"
call prepare_test_library (global, libname, 1)
call compile_library (libname, global)
call global%set_string (var_str ("$run_id"), &
var_str ("integrations1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("default"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?phs_s_mapping"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
write (u, "(A)") "* Create a scratch phase-space file"
write (u, "(A)")
u_phs = free_unit ()
open (u_phs, file = "integrations_3.phs", &
status = "replace", action = "write")
call write_test_phs_file (u_phs, var_str ("prc_config_a_i1"))
close (u_phs)
call global%set_string (var_str ("$phs_file"),&
var_str ("integrations_3.phs"), is_known = .true.)
call global%it_list%init ([1], [1000])
write (u, "(A)") "* Integrate"
write (u, "(A)")
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true.)
call global%write (u, vars = [ &
var_str ("$phs_method"), &
var_str ("$phs_file")])
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_phs_forest_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_3"
end subroutine integrations_3
@ %def integrations_3
@
\subsubsection{VAMP integration}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type) using the single-channel ([[phs_single]]) phase-space
implementation. The integration method is [[vamp]].
<<Integrations: execute tests>>=
call test (integrations_4, "integrations_4", &
"VAMP integration (one iteration)", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_4
<<Integrations: tests>>=
subroutine integrations_4 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: integrations_4"
write (u, "(A)") "* Purpose: integrate test process using VAMP"
write (u, "(A)")
write (u, "(A)") "* Initialize process and parameters"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
libname = "integrations_4_lib"
procname = "integrations_4"
call prepare_test_library (global, libname, 1, [procname])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.false., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
write (u, "(A)") "* Integrate"
write (u, "(A)")
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true.)
call global%pacify (efficiency_reset = .true., error_reset = .true.)
call global%write (u, vars = [var_str ("$integration_method")], &
pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_4"
end subroutine integrations_4
@ %def integrations_4
@
\subsubsection{Multiple iterations integration}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type) using the single-channel ([[phs_single]]) phase-space
implementation. The integration method is [[vamp]]. We launch three
iterations.
<<Integrations: execute tests>>=
call test (integrations_5, "integrations_5", &
"VAMP integration (three iterations)", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_5
<<Integrations: tests>>=
subroutine integrations_5 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
write (u, "(A)") "* Test output: integrations_5"
write (u, "(A)") "* Purpose: integrate test process using VAMP"
write (u, "(A)")
write (u, "(A)") "* Initialize process and parameters"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
libname = "integrations_5_lib"
procname = "integrations_5"
call prepare_test_library (global, libname, 1, [procname])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.false., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([3], [1000])
write (u, "(A)") "* Integrate"
write (u, "(A)")
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true.)
call global%pacify (efficiency_reset = .true., error_reset = .true.)
call global%write (u, vars = [var_str ("$integration_method")], &
pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_5"
end subroutine integrations_5
@ %def integrations_5
@
\subsubsection{Multiple passes integration}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type) using the single-channel ([[phs_single]]) phase-space
implementation. The integration method is [[vamp]]. We launch three
passes with three iterations each.
<<Integrations: execute tests>>=
call test (integrations_6, "integrations_6", &
"VAMP integration (three passes)", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_6
<<Integrations: tests>>=
subroutine integrations_6 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
type(string_t), dimension(0) :: no_vars
write (u, "(A)") "* Test output: integrations_6"
write (u, "(A)") "* Purpose: integrate test process using VAMP"
write (u, "(A)")
write (u, "(A)") "* Initialize process and parameters"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
libname = "integrations_6_lib"
procname = "integrations_6"
call prepare_test_library (global, libname, 1, [procname])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.false., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
adapt = [.true., .true., .false.], &
adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
write (u, "(A)") "* Integrate"
write (u, "(A)")
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true.)
call global%pacify (efficiency_reset = .true., error_reset = .true.)
call global%write (u, vars = no_vars, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_6"
end subroutine integrations_6
@ %def integrations_6
@
\subsubsection{VAMP and default phase space}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type) using the default ([[phs_wood]]) phase-space
implementation. The integration method is [[vamp]]. We launch three
passes with three iterations each. We enable channel equivalences and
groves.
<<Integrations: execute tests>>=
call test (integrations_7, "integrations_7", &
"VAMP integration with wood phase space", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_7
<<Integrations: tests>>=
subroutine integrations_7 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
type(string_t), dimension(0) :: no_vars
integer :: iostat, u_phs
character(95) :: buffer
type(string_t) :: phs_file
logical :: exist
write (u, "(A)") "* Test output: integrations_7"
write (u, "(A)") "* Purpose: integrate test process using VAMP"
write (u, "(A)")
write (u, "(A)") "* Initialize process and parameters"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
libname = "integrations_7_lib"
procname = "integrations_7"
call prepare_test_library (global, libname, 1, [procname])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.true., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?phs_s_mapping"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
adapt = [.true., .true., .false.], &
adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
write (u, "(A)") "* Integrate"
write (u, "(A)")
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true.)
call global%pacify (efficiency_reset = .true., error_reset = .true.)
call global%write (u, vars = no_vars, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_phs_forest_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Generated phase-space file"
write (u, "(A)")
phs_file = procname // ".r1.i1.phs"
inquire (file = char (phs_file), exist = exist)
if (exist) then
u_phs = free_unit ()
open (u_phs, file = char (phs_file), action = "read", status = "old")
iostat = 0
do while (iostat == 0)
read (u_phs, "(A)", iostat = iostat) buffer
if (iostat == 0) write (u, "(A)") trim (buffer)
end do
close (u_phs)
else
write (u, "(A)") "[file is missing]"
end if
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_7"
end subroutine integrations_7
@ %def integrations_7
@
\subsubsection{Structure functions}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type) using the default ([[phs_wood]]) phase-space
implementation. The integration method is [[vamp]]. There is a structure
function of type [[unit_test]].
We use a test structure function $f(x)=x$ for both beams. Together with the
$1/x_1x_2$ factor from the phase-space flux and a unit matrix element, we
should get the same result as previously for the process without structure
functions. There is a slight correction due to the $m_s$ mass which we set to
zero here.
<<Integrations: execute tests>>=
call test (integrations_8, "integrations_8", &
"integration with structure function", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_8
<<Integrations: tests>>=
subroutine integrations_8 (u)
<<Use kinds>>
<<Use strings>>
use interactions, only: reset_interaction_counter
use phs_forests
use models
use rt_data
use process_configurations_ut, only: prepare_test_library
use compilations, only: compile_library
use integrations
implicit none
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
type(flavor_t) :: flv
type(string_t) :: name
write (u, "(A)") "* Test output: integrations_8"
write (u, "(A)") "* Purpose: integrate test process using VAMP &
&with structure function"
write (u, "(A)")
write (u, "(A)") "* Initialize process and parameters"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
libname = "integrations_8_lib"
procname = "integrations_8"
call prepare_test_library (global, libname, 1, [procname])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.true., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?phs_s_mapping"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%model_set_real (var_str ("ms"), 0._default)
call reset_interaction_counter ()
call flv%init (25, global%model)
name = flv%get_name ()
call global%beam_structure%init_sf ([name, name], [1])
call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
write (u, "(A)") "* Integrate"
write (u, "(A)")
call global%it_list%init ([1], [1000])
call integrate_process (procname, global, local_stack=.true.)
call global%write (u, vars = [var_str ("ms")])
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_phs_forest_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_8"
end subroutine integrations_8
@ %def integrations_8
@
\subsubsection{Integration with sign change}
Compile and integrate an intrinsic test matrix element ([[prc_test]]
type). The phase-space implementation is [[phs_single]]
(single-particle phase space), the integrator is [[mci_midpoint]].
The weight that is applied changes the sign in half of phase space.
The weight is $-3$ and $1$, respectively, so the total result is equal
to the original, but negative sign.
The efficiency should (approximately) become the average of $1$ and
$1/3$, that is $2/3$.
<<Integrations: execute tests>>=
call test (integrations_9, "integrations_9", &
"handle sign change", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_9
<<Integrations: tests>>=
subroutine integrations_9 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
type(string_t) :: wgt_expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: parse_tree
write (u, "(A)") "* Test output: integrations_9"
write (u, "(A)") "* Purpose: integrate test process"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
write (u, "(A)") "* Prepare a weight expression"
write (u, "(A)")
call syntax_pexpr_init ()
wgt_expr_text = "eval 2 * sgn (Pz) - 1 [s]"
call ifile_append (ifile, wgt_expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (parse_tree, stream, .true.)
global%pn%weight_expr => parse_tree%get_root_ptr ()
write (u, "(A)") "* Build and evaluate a test process"
write (u, "(A)")
libname = "integration_9"
procname = "prc_config_a"
call prepare_test_library (global, libname, 1)
call compile_library (libname, global)
call global%set_string (var_str ("$run_id"), &
var_str ("integrations1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true.)
call global%write (u, vars = [ &
var_str ("$method"), &
var_str ("sqrts"), &
var_str ("$integration_method"), &
var_str ("$phs_method"), &
var_str ("$run_id")])
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_9"
end subroutine integrations_9
@ %def integrations_9
@
\subsubsection{Integration history for VAMP integration with default
phase space}
This test is only run when event analysis can be done.
<<Integrations: execute history tests>>=
call test (integrations_history_1, "integrations_history_1", &
"Test integration history files", &
u, results)
<<Integrations: test declarations>>=
public :: integrations_history_1
<<Integrations: tests>>=
subroutine integrations_history_1 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname
type(rt_data_t), target :: global
type(string_t), dimension(0) :: no_vars
integer :: iostat, u_his
character(91) :: buffer
type(string_t) :: his_file, ps_file, pdf_file
logical :: exist, exist_ps, exist_pdf
write (u, "(A)") "* Test output: integrations_history_1"
write (u, "(A)") "* Purpose: test integration history files"
write (u, "(A)")
write (u, "(A)") "* Initialize process and parameters"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
libname = "integrations_history_1_lib"
procname = "integrations_history_1"
call global%set_log (var_str ("?vis_history"), &
.true., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?phs_s_mapping"),&
.false., is_known = .true.)
call prepare_test_library (global, libname, 1, [procname])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.true., is_known = .true.)
call global%set_real (var_str ("error_threshold"),&
5E-6_default, is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known=.true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([2, 2, 2], [1000, 1000, 1000], &
adapt = [.true., .true., .false.], &
adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
write (u, "(A)") "* Integrate"
write (u, "(A)")
call reset_interaction_counter ()
call integrate_process (procname, global, local_stack=.true., &
eff_reset = .true.)
call global%pacify (efficiency_reset = .true., error_reset = .true.)
call global%write (u, vars = no_vars, pacify = .true.)
write (u, "(A)")
write (u, "(A)") "* Generated history files"
write (u, "(A)")
his_file = procname // ".r1.history.tex"
ps_file = procname // ".r1.history.ps"
pdf_file = procname // ".r1.history.pdf"
inquire (file = char (his_file), exist = exist)
if (exist) then
u_his = free_unit ()
open (u_his, file = char (his_file), action = "read", status = "old")
iostat = 0
do while (iostat == 0)
read (u_his, "(A)", iostat = iostat) buffer
if (iostat == 0) write (u, "(A)") trim (buffer)
end do
close (u_his)
else
write (u, "(A)") "[History LaTeX file is missing]"
end if
inquire (file = char (ps_file), exist = exist_ps)
if (exist_ps) then
write (u, "(A)") "[History Postscript file exists and is nonempty]"
else
write (u, "(A)") "[History Postscript file is missing/non-regular]"
end if
inquire (file = char (pdf_file), exist = exist_pdf)
if (exist_pdf) then
write (u, "(A)") "[History PDF file exists and is nonempty]"
else
write (u, "(A)") "[History PDF file is missing/non-regular]"
end if
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_phs_forest_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: integrations_history_1"
end subroutine integrations_history_1
@ %def integrations_history_1
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Event Streams}
This module manages I/O from/to multiple concurrent event streams.
Usually, there is at most one input stream, but several output
streams. For the latter, we set up an array which can hold [[eio_t]]
(event I/O) objects of different dynamic types simultaneously. One of
them may be marked as an input channel.
<<[[event_streams.f90]]>>=
<<File header>>
module event_streams
<<Use strings>>
use io_units
use diagnostics
use events
use eio_data
use eio_base
use rt_data
use dispatch_transforms, only: dispatch_eio
<<Standard module head>>
<<Event streams: public>>
<<Event streams: types>>
contains
<<Event streams: procedures>>
end module event_streams
@ %def event_streams
@
\subsection{Event Stream Array}
Each entry is an [[eio_t]] object. Since the type is dynamic, we need
a wrapper:
<<Event streams: types>>=
type :: event_stream_entry_t
class(eio_t), allocatable :: eio
end type event_stream_entry_t
@ %def event_stream_entry_t
@ An array of event-stream entry objects. If one of the entries is an
input channel, [[i_in]] is the corresponding index.
<<Event streams: public>>=
public :: event_stream_array_t
<<Event streams: types>>=
type :: event_stream_array_t
type(event_stream_entry_t), dimension(:), allocatable :: entry
integer :: i_in = 0
contains
<<Event streams: event stream array: TBP>>
end type event_stream_array_t
@ %def event_stream_array_t
@ Output.
<<Event streams: event stream array: TBP>>=
procedure :: write => event_stream_array_write
<<Event streams: procedures>>=
subroutine event_stream_array_write (object, unit)
class(event_stream_array_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A)") "Event stream array:"
if (allocated (object%entry)) then
select case (size (object%entry))
case (0)
write (u, "(3x,A)") "[empty]"
case default
do i = 1, size (object%entry)
if (i == object%i_in) write (u, "(1x,A)") "Input stream:"
call object%entry(i)%eio%write (u)
end do
end select
else
write (u, "(3x,A)") "[undefined]"
end if
end subroutine event_stream_array_write
@ %def event_stream_array_write
@ Finalize all streams.
<<Event streams: event stream array: TBP>>=
procedure :: final => event_stream_array_final
<<Event streams: procedures>>=
subroutine event_stream_array_final (es_array)
class(event_stream_array_t), intent(inout) :: es_array
integer :: i
do i = 1, size (es_array%entry)
call es_array%entry(i)%eio%final ()
end do
end subroutine event_stream_array_final
@ %def event_stream_array_final
@ Initialization. We use a generic [[sample]] name, open event I/O
objects for all provided stream types (using the [[dispatch_eio]]
routine), and initialize for the given list of process pointers. If
there is an [[input]] argument, this channel is initialized as an input
channel and appended to the array.
The [[input_data]] or, if not present, [[data]] may be modified. This
happens if we open a stream for reading and get new information there.
<<Event streams: event stream array: TBP>>=
procedure :: init => event_stream_array_init
<<Event streams: procedures>>=
subroutine event_stream_array_init &
(es_array, sample, stream_fmt, global, &
data, input, input_sample, input_data, allow_switch, &
checkpoint, callback, &
error)
class(event_stream_array_t), intent(out) :: es_array
type(string_t), intent(in) :: sample
type(string_t), dimension(:), intent(in) :: stream_fmt
type(rt_data_t), intent(in) :: global
type(event_sample_data_t), intent(inout), optional :: data
type(string_t), intent(in), optional :: input
type(string_t), intent(in), optional :: input_sample
type(event_sample_data_t), intent(inout), optional :: input_data
logical, intent(in), optional :: allow_switch
integer, intent(in), optional :: checkpoint
integer, intent(in), optional :: callback
logical, intent(out), optional :: error
type(string_t) :: sample_in
integer :: n, i, n_output, i_input, i_checkpoint, i_callback
logical :: success, switch
if (present (input_sample)) then
sample_in = input_sample
else
sample_in = sample
end if
if (present (allow_switch)) then
switch = allow_switch
else
switch = .true.
end if
if (present (error)) then
error = .false.
end if
n = size (stream_fmt)
n_output = n
if (present (input)) then
n = n + 1
i_input = n
else
i_input = 0
end if
if (present (checkpoint)) then
n = n + 1
i_checkpoint = n
else
i_checkpoint = 0
end if
if (present (callback)) then
n = n + 1
i_callback = n
else
i_callback = 0
end if
allocate (es_array%entry (n))
if (i_checkpoint > 0) then
call dispatch_eio &
(es_array%entry(i_checkpoint)%eio, var_str ("checkpoint"), &
global%var_list, global%fallback_model, &
global%event_callback)
call es_array%entry(i_checkpoint)%eio%init_out (sample, data)
end if
if (i_callback > 0) then
call dispatch_eio &
(es_array%entry(i_callback)%eio, var_str ("callback"), &
global%var_list, global%fallback_model, &
global%event_callback)
call es_array%entry(i_callback)%eio%init_out (sample, data)
end if
if (i_input > 0) then
call dispatch_eio (es_array%entry(i_input)%eio, input, &
global%var_list, global%fallback_model, &
global%event_callback)
if (present (input_data)) then
call es_array%entry(i_input)%eio%init_in &
(sample_in, input_data, success)
else
call es_array%entry(i_input)%eio%init_in &
(sample_in, data, success)
end if
if (success) then
es_array%i_in = i_input
else if (present (input_sample)) then
if (present (error)) then
error = .true.
else
call msg_fatal ("Events: &
&parameter mismatch in input, aborting")
end if
else
call msg_message ("Events: &
&parameter mismatch, discarding old event set")
call es_array%entry(i_input)%eio%final ()
if (switch) then
call msg_message ("Events: generating new events")
call es_array%entry(i_input)%eio%init_out (sample, data)
end if
end if
end if
do i = 1, n_output
call dispatch_eio (es_array%entry(i)%eio, stream_fmt(i), &
global%var_list, global%fallback_model, &
global%event_callback)
call es_array%entry(i)%eio%init_out (sample, data)
end do
end subroutine event_stream_array_init
@ %def event_stream_array_init
@ Switch the (only) input channel to an output channel, so further
events are appended to the respective stream.
<<Event streams: event stream array: TBP>>=
procedure :: switch_inout => event_stream_array_switch_inout
<<Event streams: procedures>>=
subroutine event_stream_array_switch_inout (es_array)
class(event_stream_array_t), intent(inout) :: es_array
integer :: n
if (es_array%has_input ()) then
n = es_array%i_in
call es_array%entry(n)%eio%switch_inout ()
es_array%i_in = 0
else
call msg_bug ("Reading events: switch_inout: no input stream selected")
end if
end subroutine event_stream_array_switch_inout
@ %def event_stream_array_switch_inout
@ Output an event (with given process number) to all output streams.
If there is no output stream, do nothing.
<<Event streams: event stream array: TBP>>=
procedure :: output => event_stream_array_output
<<Event streams: procedures>>=
subroutine event_stream_array_output (es_array, event, i_prc, &
event_index, passed, pacify)
class(event_stream_array_t), intent(inout) :: es_array
type(event_t), intent(in), target :: event
integer, intent(in) :: i_prc, event_index
logical, intent(in), optional :: passed, pacify
logical :: increased
integer :: i
do i = 1, size (es_array%entry)
if (i /= es_array%i_in) then
associate (eio => es_array%entry(i)%eio)
if (eio%split) then
if (eio%split_n_evt > 0 &
.and. event_index > 1 &
.and. mod (event_index, eio%split_n_evt) == 1) then
call eio%split_out ()
else if (eio%split_n_kbytes > 0) then
call eio%update_split_count (increased)
if (increased) call eio%split_out ()
end if
end if
call eio%output (event, i_prc, reading = es_array%i_in /= 0, &
passed = passed, &
pacify = pacify)
end associate
end if
end do
end subroutine event_stream_array_output
@ %def event_stream_array_output
@ Input the [[i_prc]] index which selects the process for the current
event. This is separated from reading the event, because it
determines which event record to read. [[iostat]] may indicate an
error or an EOF condition, as usual.
<<Event streams: event stream array: TBP>>=
procedure :: input_i_prc => event_stream_array_input_i_prc
<<Event streams: procedures>>=
subroutine event_stream_array_input_i_prc (es_array, i_prc, iostat)
class(event_stream_array_t), intent(inout) :: es_array
integer, intent(out) :: i_prc
integer, intent(out) :: iostat
integer :: n
if (es_array%has_input ()) then
n = es_array%i_in
call es_array%entry(n)%eio%input_i_prc (i_prc, iostat)
else
call msg_fatal ("Reading events: no input stream selected")
end if
end subroutine event_stream_array_input_i_prc
@ %def event_stream_array_input_i_prc
@ Input an event from the selected input stream. [[iostat]] may indicate an
error or an EOF condition, as usual.
<<Event streams: event stream array: TBP>>=
procedure :: input_event => event_stream_array_input_event
<<Event streams: procedures>>=
subroutine event_stream_array_input_event (es_array, event, iostat)
class(event_stream_array_t), intent(inout) :: es_array
type(event_t), intent(inout), target :: event
integer, intent(out) :: iostat
integer :: n
if (es_array%has_input ()) then
n = es_array%i_in
call es_array%entry(n)%eio%input_event (event, iostat)
else
call msg_fatal ("Reading events: no input stream selected")
end if
end subroutine event_stream_array_input_event
@ %def event_stream_array_input_event
@ Skip an entry of eio\_t. Used to synchronize the event read-in for
NLO events.
<<Event streams: event stream array: TBP>>=
procedure :: skip_eio_entry => event_stream_array_skip_eio_entry
<<Event streams: procedures>>=
subroutine event_stream_array_skip_eio_entry (es_array, iostat)
class(event_stream_array_t), intent(inout) :: es_array
integer, intent(out) :: iostat
integer :: n
if (es_array%has_input ()) then
n = es_array%i_in
call es_array%entry(n)%eio%skip (iostat)
else
call msg_fatal ("Reading events: no input stream selected")
end if
end subroutine event_stream_array_skip_eio_entry
@ %def event_stream_array_skip_eio_entry
@ Return true if there is an input channel among the event streams.
<<Event streams: event stream array: TBP>>=
procedure :: has_input => event_stream_array_has_input
<<Event streams: procedures>>=
function event_stream_array_has_input (es_array) result (flag)
class(event_stream_array_t), intent(in) :: es_array
logical :: flag
flag = es_array%i_in /= 0
end function event_stream_array_has_input
@ %def event_stream_array_has_input
@
\subsection{Unit Tests}
Test module, followed by the stand-alone unit-test procedures.
<<[[event_streams_ut.f90]]>>=
<<File header>>
module event_streams_ut
use unit_tests
use event_streams_uti
<<Standard module head>>
<<Event streams: public test>>
contains
<<Event streams: test driver>>
end module event_streams_ut
@
<<[[event_streams_uti.f90]]>>=
<<File header>>
module event_streams_uti
<<Use kinds>>
<<Use strings>>
use model_data
use eio_data
use process, only: process_t
use instances, only: process_instance_t
use models
use rt_data
use events
use event_streams
<<Standard module head>>
<<Event streams: test declarations>>
contains
<<Event streams: tests>>
end module event_streams_uti
@ %def event_streams_uti
@ API: driver for the unit tests below.
<<Event streams: public test>>=
public :: event_streams_test
<<Event streams: test driver>>=
subroutine event_streams_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Event streams: execute tests>>
end subroutine event_streams_test
@ %def event_streams_test
@
\subsubsection{Empty event stream}
This should set up an empty event output stream array, including
initialization, output, and finalization (which are all no-ops).
<<Event streams: execute tests>>=
call test (event_streams_1, "event_streams_1", &
"empty event stream array", &
u, results)
<<Event streams: test declarations>>=
public :: event_streams_1
<<Event streams: tests>>=
subroutine event_streams_1 (u)
integer, intent(in) :: u
type(event_stream_array_t) :: es_array
type(rt_data_t) :: global
type(event_t) :: event
type(string_t) :: sample
type(string_t), dimension(0) :: empty_string_array
write (u, "(A)") "* Test output: event_streams_1"
write (u, "(A)") "* Purpose: handle empty event stream array"
write (u, "(A)")
sample = "event_streams_1"
call es_array%init (sample, empty_string_array, global)
call es_array%output (event, 42, 1)
call es_array%write (u)
call es_array%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: event_streams_1"
end subroutine event_streams_1
@ %def event_streams_1
@
\subsubsection{Nontrivial event stream}
Here we generate a trivial event and choose [[raw]] output as an entry in
the stream array.
<<Event streams: execute tests>>=
call test (event_streams_2, "event_streams_2", &
"nontrivial event stream array", &
u, results)
<<Event streams: test declarations>>=
public :: event_streams_2
<<Event streams: tests>>=
subroutine event_streams_2 (u)
use processes_ut, only: prepare_test_process
integer, intent(in) :: u
type(event_stream_array_t) :: es_array
type(rt_data_t) :: global
type(model_data_t), target :: model
type(event_t), allocatable, target :: event
type(process_t), allocatable, target :: process
type(process_instance_t), allocatable, target :: process_instance
type(string_t) :: sample
type(string_t), dimension(0) :: empty_string_array
integer :: i_prc, iostat
write (u, "(A)") "* Test output: event_streams_2"
write (u, "(A)") "* Purpose: handle empty event stream array"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call model%init_test ()
write (u, "(A)") "* Generate test process event"
write (u, "(A)")
allocate (process)
allocate (process_instance)
call prepare_test_process (process, process_instance, model)
call process_instance%setup_event_data ()
allocate (event)
call event%basic_init ()
call event%connect (process_instance, process%get_model_ptr ())
call event%generate (1, [0.4_default, 0.4_default])
call event%set_index (42)
call event%evaluate_expressions ()
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Allocate raw eio stream and write event to file"
write (u, "(A)")
sample = "event_streams_2"
call es_array%init (sample, [var_str ("raw")], global)
call es_array%output (event, 1, 1)
call es_array%write (u)
call es_array%final ()
write (u, "(A)")
write (u, "(A)") "* Reallocate raw eio stream for reading"
write (u, "(A)")
sample = "foo"
call es_array%init (sample, empty_string_array, global, &
input = var_str ("raw"), input_sample = var_str ("event_streams_2"))
call es_array%write (u)
write (u, "(A)")
write (u, "(A)") "* Reread event"
write (u, "(A)")
call es_array%input_i_prc (i_prc, iostat)
write (u, "(1x,A,I0)") "i_prc = ", i_prc
write (u, "(A)")
call es_array%input_event (event, iostat)
call es_array%final ()
call event%write (u)
call global%final ()
call model%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: event_streams_2"
end subroutine event_streams_2
@ %def event_streams_2
@
\subsubsection{Switch in/out}
Here we generate an event file and test switching from writing to
reading when the file is exhausted.
<<Event streams: execute tests>>=
call test (event_streams_3, "event_streams_3", &
"switch input/output", &
u, results)
<<Event streams: test declarations>>=
public :: event_streams_3
<<Event streams: tests>>=
subroutine event_streams_3 (u)
use processes_ut, only: prepare_test_process
integer, intent(in) :: u
type(event_stream_array_t) :: es_array
type(rt_data_t) :: global
type(model_data_t), target :: model
type(event_t), allocatable, target :: event
type(process_t), allocatable, target :: process
type(process_instance_t), allocatable, target :: process_instance
type(string_t) :: sample
type(string_t), dimension(0) :: empty_string_array
integer :: i_prc, iostat
write (u, "(A)") "* Test output: event_streams_3"
write (u, "(A)") "* Purpose: handle in/out switching"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call model%init_test ()
write (u, "(A)") "* Generate test process event"
write (u, "(A)")
allocate (process)
allocate (process_instance)
call prepare_test_process (process, process_instance, model)
call process_instance%setup_event_data ()
allocate (event)
call event%basic_init ()
call event%connect (process_instance, process%get_model_ptr ())
call event%generate (1, [0.4_default, 0.4_default])
call event%increment_index ()
call event%evaluate_expressions ()
write (u, "(A)") "* Allocate raw eio stream and write event to file"
write (u, "(A)")
sample = "event_streams_3"
call es_array%init (sample, [var_str ("raw")], global)
call es_array%output (event, 1, 1)
call es_array%write (u)
call es_array%final ()
write (u, "(A)")
write (u, "(A)") "* Reallocate raw eio stream for reading"
write (u, "(A)")
call es_array%init (sample, empty_string_array, global, &
input = var_str ("raw"))
call es_array%write (u)
write (u, "(A)")
write (u, "(A)") "* Reread event"
write (u, "(A)")
call es_array%input_i_prc (i_prc, iostat)
call es_array%input_event (event, iostat)
write (u, "(A)") "* Attempt to read another event (fail), then generate"
write (u, "(A)")
call es_array%input_i_prc (i_prc, iostat)
if (iostat < 0) then
call es_array%switch_inout ()
call event%generate (1, [0.3_default, 0.3_default])
call event%increment_index ()
call event%evaluate_expressions ()
call es_array%output (event, 1, 2)
end if
call es_array%write (u)
call es_array%final ()
write (u, "(A)")
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Reallocate raw eio stream for reading"
write (u, "(A)")
call es_array%init (sample, empty_string_array, global, &
input = var_str ("raw"))
call es_array%write (u)
write (u, "(A)")
write (u, "(A)") "* Reread two events and display 2nd event"
write (u, "(A)")
call es_array%input_i_prc (i_prc, iostat)
call es_array%input_event (event, iostat)
call es_array%input_i_prc (i_prc, iostat)
call es_array%input_event (event, iostat)
call es_array%final ()
call event%write (u)
call global%final ()
call model%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: event_streams_3"
end subroutine event_streams_3
@ %def event_streams_3
@
\subsubsection{Checksum}
Here we generate an event file and repeat twice, once with identical
parameters and once with modified parameters.
<<Event streams: execute tests>>=
call test (event_streams_4, "event_streams_4", &
"check MD5 sum", &
u, results)
<<Event streams: test declarations>>=
public :: event_streams_4
<<Event streams: tests>>=
subroutine event_streams_4 (u)
integer, intent(in) :: u
type(event_stream_array_t) :: es_array
type(rt_data_t) :: global
type(process_t), allocatable, target :: process
type(string_t) :: sample
type(string_t), dimension(0) :: empty_string_array
type(event_sample_data_t) :: data
write (u, "(A)") "* Test output: event_streams_4"
write (u, "(A)") "* Purpose: handle in/out switching"
write (u, "(A)")
write (u, "(A)") "* Generate test process event"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%set_log (var_str ("?check_event_file"), &
.true., is_known = .true.)
allocate (process)
write (u, "(A)") "* Allocate raw eio stream for writing"
write (u, "(A)")
sample = "event_streams_4"
data%md5sum_cfg = "1234567890abcdef1234567890abcdef"
call es_array%init (sample, [var_str ("raw")], global, data)
call es_array%write (u)
call es_array%final ()
write (u, "(A)")
write (u, "(A)") "* Reallocate raw eio stream for reading"
write (u, "(A)")
call es_array%init (sample, empty_string_array, global, &
data, input = var_str ("raw"))
call es_array%write (u)
call es_array%final ()
write (u, "(A)")
write (u, "(A)") "* Reallocate modified raw eio stream for reading (fail)"
write (u, "(A)")
data%md5sum_cfg = "1234567890______1234567890______"
call es_array%init (sample, empty_string_array, global, &
data, input = var_str ("raw"))
call es_array%write (u)
call es_array%final ()
write (u, "(A)")
write (u, "(A)") "* Repeat ignoring checksum"
write (u, "(A)")
call global%set_log (var_str ("?check_event_file"), &
.false., is_known = .true.)
call es_array%init (sample, empty_string_array, global, &
data, input = var_str ("raw"))
call es_array%write (u)
call es_array%final ()
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: event_streams_4"
end subroutine event_streams_4
@ %def event_streams_4
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Restricted Subprocesses}
This module provides an automatic means to construct restricted subprocesses
of a current process object. A restricted subprocess has the same initial and
final state as the current process, but a restricted set of Feynman graphs.
The actual application extracts the set of resonance histories that apply to
the process and uses this to construct subprocesses that are restricted to one
of those histories, respectively. The resonance histories are derived from
the phase-space setup. This implies that the method is tied to the OMega
matrix element generator and to the wood phase space method.
The processes are collected in a new process library that is generated
on-the-fly.
The [[resonant_subprocess_t]] object is intended as a component of the event
record, which manages all operations regarding resonance handling.
The run-time calculations are delegated to an event transform
([[evt_resonance_t]]), as a part of the event transform chain. The transform
selects one (or none) of the resonance histories, given the momentum
configuration, computes matrix elements and inserts resonances into the
particle set.
<<[[restricted_subprocesses.f90]]>>=
<<File header>>
module restricted_subprocesses
<<Use kinds>>
<<Use strings>>
use diagnostics, only: msg_message, msg_fatal, msg_bug
use diagnostics, only: signal_is_pending
use io_units, only: given_output_unit
use format_defs, only: FMT_14, FMT_19
use string_utils, only: str
use lorentz, only: vector4_t
use particle_specifiers, only: prt_spec_t
use particles, only: particle_set_t
use resonances, only: resonance_history_t, resonance_history_set_t
use variables, only: var_list_t
use models, only: model_t
use process_libraries, only: process_component_def_t
use process_libraries, only: process_library_t
use process_libraries, only: STAT_ACTIVE
use prclib_stacks, only: prclib_entry_t
use event_transforms, only: evt_t
use resonance_insertion, only: evt_resonance_t
use rt_data, only: rt_data_t
use compilations, only: compile_library
use process_configurations, only: process_configuration_t
use process, only: process_t, process_ptr_t
use instances, only: process_instance_t, process_instance_ptr_t
use integrations, only: integrate_process
<<Use mpi f08>>
<<Standard module head>>
<<Restricted subprocesses: public>>
<<Restricted subprocesses: types>>
<<Restricted subprocesses: interfaces>>
contains
<<Restricted subprocesses: procedures>>
end module restricted_subprocesses
@ %def restricted_subprocesses
@
\subsection{Process configuration}
We extend the [[process_configuration_t]] by another method for initialization
that takes into account a resonance history.
<<Restricted subprocesses: public>>=
public :: restricted_process_configuration_t
<<Restricted subprocesses: types>>=
type, extends (process_configuration_t) :: restricted_process_configuration_t
private
contains
<<Restricted subprocesses: restricted process configuration: TBP>>
end type restricted_process_configuration_t
@ %def restricted_process_configuration_t
@
Resonance history as an argument. We use it to override the [[restrictions]]
setting in a local variable list. Since we can construct the restricted
process only by using OMega, we enforce it as the ME method. Other settings
are taken from the variable list. The model will most likely be set, but we
insert a safeguard just in case.
Also, the resonant subprocess should not itself spawn resonant
subprocesses, so we unset [[?resonance_history]].
We have to create a local copy of the model here, via pointer
allocation. The reason is that the model as stored (via pointer) in
the base type will be finalized and deallocated.
The current implementation will generate a LO process, the optional
[[nlo_process]] is unset. (It is not obvious
whether the construction makes sense beyond LO.)
<<Restricted subprocesses: restricted process configuration: TBP>>=
procedure :: init_resonant_process
<<Restricted subprocesses: procedures>>=
subroutine init_resonant_process &
(prc_config, prc_name, prt_in, prt_out, res_history, model, var_list)
class(restricted_process_configuration_t), intent(out) :: prc_config
type(string_t), intent(in) :: prc_name
type(prt_spec_t), dimension(:), intent(in) :: prt_in
type(prt_spec_t), dimension(:), intent(in) :: prt_out
type(resonance_history_t), intent(in) :: res_history
type(model_t), intent(in), target :: model
type(var_list_t), intent(in), target :: var_list
type(model_t), pointer :: local_model
type(var_list_t) :: local_var_list
allocate (local_model)
call local_model%init_instance (model)
call local_var_list%link (var_list)
call local_var_list%append_string (var_str ("$model_name"), &
sval = local_model%get_name (), &
intrinsic=.true.)
call local_var_list%append_string (var_str ("$method"), &
sval = var_str ("omega"), &
intrinsic=.true.)
call local_var_list%append_string (var_str ("$restrictions"), &
sval = res_history%as_omega_string (size (prt_in)), &
intrinsic = .true.)
call local_var_list%append_log (var_str ("?resonance_history"), &
lval = .false., &
intrinsic = .true.)
call prc_config%init (prc_name, size (prt_in), 1, &
local_model, local_var_list)
call prc_config%setup_component (1, &
prt_in, prt_out, &
local_model, local_var_list)
end subroutine init_resonant_process
@ %def init_resonant_process
@
\subsection{Resonant-subprocess set manager}
This data type enables generation of a library of resonant subprocesses for a
given master process, and it allows for convenient access. The matrix
elements from the subprocesses can be used as channel weights to activate a
selector, which then returns a preferred channel via some random number
generator.
<<Restricted subprocesses: public>>=
public :: resonant_subprocess_set_t
<<Restricted subprocesses: types>>=
type :: resonant_subprocess_set_t
private
integer, dimension(:), allocatable :: n_history
type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
logical :: lib_active = .false.
type(string_t) :: libname
type(string_t), dimension(:), allocatable :: proc_id
type(process_ptr_t), dimension(:), allocatable :: subprocess
type(process_instance_ptr_t), dimension(:), allocatable :: instance
logical :: filled = .false.
type(evt_resonance_t), pointer :: evt => null ()
contains
<<Restricted subprocesses: resonant subprocess set: TBP>>
end type resonant_subprocess_set_t
@ %def resonant_subprocess_set_t
@ Output
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: write => resonant_subprocess_set_write
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_write (prc_set, unit, testflag)
class(resonant_subprocess_set_t), intent(in) :: prc_set
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
logical :: truncate
integer :: u, i
u = given_output_unit (unit)
truncate = .false.; if (present (testflag)) truncate = testflag
write (u, "(1x,A)") "Resonant subprocess set:"
if (allocated (prc_set%n_history)) then
if (any (prc_set%n_history > 0)) then
do i = 1, size (prc_set%n_history)
if (prc_set%n_history(i) > 0) then
write (u, "(1x,A,I0)") "Component #", i
call prc_set%res_history_set(i)%write (u, indent=1)
end if
end do
if (prc_set%lib_active) then
write (u, "(3x,A,A,A)") "Process library = '", &
char (prc_set%libname), "'"
else
write (u, "(3x,A)") "Process library: [inactive]"
end if
if (associated (prc_set%evt)) then
if (truncate) then
write (u, "(3x,A,1x," // FMT_14 // ")") &
"Process sqme =", prc_set%get_master_sqme ()
else
write (u, "(3x,A,1x," // FMT_19 // ")") &
"Process sqme =", prc_set%get_master_sqme ()
end if
end if
if (associated (prc_set%evt)) then
write (u, "(3x,A)") "Event transform: associated"
write (u, "(2x)", advance="no")
call prc_set%evt%write_selector (u, testflag)
else
write (u, "(3x,A)") "Event transform: not associated"
end if
else
write (u, "(2x,A)") "[empty]"
end if
else
write (u, "(3x,A)") "[not allocated]"
end if
end subroutine resonant_subprocess_set_write
@ %def resonant_subprocess_set_write
@
\subsection{Resonance history set}
Initialize subprocess set with an array of pre-created resonance
history sets.
Safeguard: if there are no resonances in the input, initialize the local set
as empty, but complete.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: init => resonant_subprocess_set_init
procedure :: fill_resonances => resonant_subprocess_set_fill_resonances
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_init (prc_set, n_component)
class(resonant_subprocess_set_t), intent(out) :: prc_set
integer, intent(in) :: n_component
allocate (prc_set%res_history_set (n_component))
allocate (prc_set%n_history (n_component), source = 0)
end subroutine resonant_subprocess_set_init
subroutine resonant_subprocess_set_fill_resonances (prc_set, &
res_history_set, i_component)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
type(resonance_history_set_t), intent(in) :: res_history_set
integer, intent(in) :: i_component
prc_set%n_history(i_component) = res_history_set%get_n_history ()
if (prc_set%n_history(i_component) > 0) then
prc_set%res_history_set(i_component) = res_history_set
else
call prc_set%res_history_set(i_component)%init (initial_size = 0)
call prc_set%res_history_set(i_component)%freeze ()
end if
end subroutine resonant_subprocess_set_fill_resonances
@ %def resonant_subprocess_set_init
@ %def resonant_subprocess_set_fill_resonances
@ Return the resonance history set.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: get_resonance_history_set &
=> resonant_subprocess_set_get_resonance_history_set
<<Restricted subprocesses: procedures>>=
function resonant_subprocess_set_get_resonance_history_set (prc_set) &
result (res_history_set)
class(resonant_subprocess_set_t), intent(in) :: prc_set
type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
res_history_set = prc_set%res_history_set
end function resonant_subprocess_set_get_resonance_history_set
@ %def resonant_subprocess_set_get_resonance_history_set
@
\subsection{Library for the resonance history set}
The recommended library name: append [[_R]] to the process name.
<<Restricted subprocesses: public>>=
public :: get_libname_res
<<Restricted subprocesses: procedures>>=
elemental function get_libname_res (proc_id) result (libname)
type(string_t), intent(in) :: proc_id
type(string_t) :: libname
libname = proc_id // "_R"
end function get_libname_res
@ %def get_libname_res
@ Here we scan the global process library whether any
processes require resonant subprocesses to be constructed. If yes,
create process objects with phase space and construct the process
libraries as usual. Then append the library names to the array.
The temporary integration objects should carry the [[phs_only]]
flag. We set this in the local environment.
Once a process object with resonance histories (derived from phase
space) has been created, we extract the resonance histories and use
them, together with the process definition, to create the new library.
Finally, compile the library.
<<Restricted subprocesses: public>>=
public :: spawn_resonant_subprocess_libraries
<<Restricted subprocesses: procedures>>=
subroutine spawn_resonant_subprocess_libraries &
(libname, local, global, libname_res)
type(string_t), intent(in) :: libname
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), target :: global
type(string_t), dimension(:), allocatable, intent(inout) :: libname_res
type(process_library_t), pointer :: lib
type(string_t), dimension(:), allocatable :: process_id_res
type(process_t), pointer :: process
type(resonance_history_set_t) :: res_history_set
type(process_component_def_t), pointer :: process_component_def
logical :: phs_only_saved, exist
integer :: i_proc, i_component
lib => global%prclib_stack%get_library_ptr (libname)
call lib%get_process_id_req_resonant (process_id_res)
if (size (process_id_res) > 0) then
call msg_message ("Creating resonant-subprocess libraries &
&for library '" // char (libname) // "'")
libname_res = get_libname_res (process_id_res)
phs_only_saved = local%var_list%get_lval (var_str ("?phs_only"))
call local%var_list%set_log &
(var_str ("?phs_only"), .true., is_known=.true.)
do i_proc = 1, size (process_id_res)
associate (proc_id => process_id_res (i_proc))
call msg_message ("Process '" // char (proc_id) // "': &
&constructing phase space for resonance structure")
call integrate_process (proc_id, local, global)
process => global%process_stack%get_process_ptr (proc_id)
call create_library (libname_res(i_proc), global, exist)
if (.not. exist) then
do i_component = 1, process%get_n_components ()
call process%extract_resonance_history_set &
(res_history_set, i_component = i_component)
process_component_def &
=> process%get_component_def_ptr (i_component)
call add_to_library (libname_res(i_proc), &
res_history_set, &
process_component_def%get_prt_spec_in (), &
process_component_def%get_prt_spec_out (), &
global)
end do
call msg_message ("Process library '" &
// char (libname_res(i_proc)) &
// "': created")
end if
call global%update_prclib (lib)
end associate
end do
call local%var_list%set_log &
(var_str ("?phs_only"), phs_only_saved, is_known=.true.)
end if
end subroutine spawn_resonant_subprocess_libraries
@ %def spawn_resonant_subprocess_libraries
@ This is another version of the library constructor, bound to a
restricted-subprocess set object. Create the appropriate
process library, add processes, and close the library.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: create_library => resonant_subprocess_set_create_library
procedure :: add_to_library => resonant_subprocess_set_add_to_library
procedure :: freeze_library => resonant_subprocess_set_freeze_library
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_create_library (prc_set, &
libname, global, exist)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
type(string_t), intent(in) :: libname
type(rt_data_t), intent(inout), target :: global
logical, intent(out) :: exist
prc_set%libname = libname
call create_library (prc_set%libname, global, exist)
end subroutine resonant_subprocess_set_create_library
subroutine resonant_subprocess_set_add_to_library (prc_set, &
i_component, prt_in, prt_out, global)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
integer, intent(in) :: i_component
type(prt_spec_t), dimension(:), intent(in) :: prt_in
type(prt_spec_t), dimension(:), intent(in) :: prt_out
type(rt_data_t), intent(inout), target :: global
call add_to_library (prc_set%libname, &
prc_set%res_history_set(i_component), &
prt_in, prt_out, global)
end subroutine resonant_subprocess_set_add_to_library
subroutine resonant_subprocess_set_freeze_library (prc_set, global)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
type(rt_data_t), intent(inout), target :: global
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
lib => global%prclib_stack%get_library_ptr (prc_set%libname)
call lib%get_process_id_list (prc_set%proc_id)
prc_set%lib_active = .true.
end subroutine resonant_subprocess_set_freeze_library
@ %def resonant_subprocess_set_create_library
@ %def resonant_subprocess_set_add_to_library
@ %def resonant_subprocess_set_freeze_library
@ The common parts of the procedures above: (i) create a new process
library or recover it, (ii) for each history, create a
process configuration and record it.
<<Restricted subprocesses: procedures>>=
subroutine create_library (libname, global, exist)
type(string_t), intent(in) :: libname
type(rt_data_t), intent(inout), target :: global
logical, intent(out) :: exist
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
type(resonance_history_t) :: res_history
type(string_t), dimension(:), allocatable :: proc_id
type(restricted_process_configuration_t) :: prc_config
integer :: i
lib => global%prclib_stack%get_library_ptr (libname)
exist = associated (lib)
if (.not. exist) then
call msg_message ("Creating library for resonant subprocesses '" &
// char (libname) // "'")
allocate (lib_entry)
call lib_entry%init (libname)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
else
call msg_message ("Using library for resonant subprocesses '" &
// char (libname) // "'")
call global%update_prclib (lib)
end if
end subroutine create_library
subroutine add_to_library (libname, res_history_set, prt_in, prt_out, global)
type(string_t), intent(in) :: libname
type(resonance_history_set_t), intent(in) :: res_history_set
type(prt_spec_t), dimension(:), intent(in) :: prt_in
type(prt_spec_t), dimension(:), intent(in) :: prt_out
type(rt_data_t), intent(inout), target :: global
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
type(resonance_history_t) :: res_history
type(string_t), dimension(:), allocatable :: proc_id
type(restricted_process_configuration_t) :: prc_config
integer :: n0, i
lib => global%prclib_stack%get_library_ptr (libname)
if (associated (lib)) then
n0 = lib%get_n_processes ()
allocate (proc_id (res_history_set%get_n_history ()))
do i = 1, size (proc_id)
proc_id(i) = libname // str (n0 + i)
res_history = res_history_set%get_history(i)
call prc_config%init_resonant_process (proc_id(i), &
prt_in, prt_out, &
res_history, &
global%model, global%var_list)
call msg_message ("Resonant subprocess #" &
// char (str(n0+i)) // ": " &
// char (res_history%as_omega_string (size (prt_in))))
call prc_config%record (global)
if (signal_is_pending ()) return
end do
else
call msg_bug ("Adding subprocesses: library '" &
// char (libname) // "' not found")
end if
end subroutine add_to_library
@ %def create_library
@ %def add_to_library
@ Compile the generated library, required settings taken from the
[[global]] data set.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: compile_library => resonant_subprocess_set_compile_library
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_compile_library (prc_set, global)
class(resonant_subprocess_set_t), intent(in) :: prc_set
type(rt_data_t), intent(inout), target :: global
type(process_library_t), pointer :: lib
lib => global%prclib_stack%get_library_ptr (prc_set%libname)
if (lib%get_status () < STAT_ACTIVE) then
call compile_library (prc_set%libname, global)
end if
end subroutine resonant_subprocess_set_compile_library
@ %def resonant_subprocess_set_compile_library
@ Check if the library has been created / the process has been evaluated.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: is_active => resonant_subprocess_set_is_active
<<Restricted subprocesses: procedures>>=
function resonant_subprocess_set_is_active (prc_set) result (flag)
class(resonant_subprocess_set_t), intent(in) :: prc_set
logical :: flag
flag = prc_set%lib_active
end function resonant_subprocess_set_is_active
@ %def resonant_subprocess_set_is_active
@ Return number of generated process objects, library, and process IDs.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: get_n_process => resonant_subprocess_set_get_n_process
procedure :: get_libname => resonant_subprocess_set_get_libname
procedure :: get_proc_id => resonant_subprocess_set_get_proc_id
<<Restricted subprocesses: procedures>>=
function resonant_subprocess_set_get_n_process (prc_set) result (n)
class(resonant_subprocess_set_t), intent(in) :: prc_set
integer :: n
if (prc_set%lib_active) then
n = size (prc_set%proc_id)
else
n = 0
end if
end function resonant_subprocess_set_get_n_process
function resonant_subprocess_set_get_libname (prc_set) result (libname)
class(resonant_subprocess_set_t), intent(in) :: prc_set
type(string_t) :: libname
if (prc_set%lib_active) then
libname = prc_set%libname
else
libname = ""
end if
end function resonant_subprocess_set_get_libname
function resonant_subprocess_set_get_proc_id (prc_set, i) result (proc_id)
class(resonant_subprocess_set_t), intent(in) :: prc_set
integer, intent(in) :: i
type(string_t) :: proc_id
if (allocated (prc_set%proc_id)) then
proc_id = prc_set%proc_id(i)
else
proc_id = ""
end if
end function resonant_subprocess_set_get_proc_id
@ %def resonant_subprocess_set_get_n_process
@ %def resonant_subprocess_set_get_libname
@ %def resonant_subprocess_set_get_proc_id
@
\subsection{Process objects and instances}
Prepare process objects for all entries in the resonant-subprocesses
library. The process objects are appended to the global process
stack. A local environment can be used where we place temporary
variable settings that affect process-object generation. We
initialize the processes, such that we can evaluate matrix elements,
but we do not need to integrate them.
The internal procedure [[prepare_process]] is an abridged version of
the procedure with this name in the [[simulations]] module.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: prepare_process_objects &
=> resonant_subprocess_set_prepare_process_objects
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_prepare_process_objects &
(prc_set, local, global)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), optional, target :: global
type(rt_data_t), pointer :: current
type(process_library_t), pointer :: lib
type(string_t) :: proc_id, libname_cur, libname_res
integer :: i, n
if (.not. prc_set%is_active ()) return
if (present (global)) then
current => global
else
current => local
end if
libname_cur = current%prclib%get_name ()
libname_res = prc_set%get_libname ()
lib => current%prclib_stack%get_library_ptr (libname_res)
if (associated (lib)) call current%update_prclib (lib)
call local%set_string (var_str ("$phs_method"), &
var_str ("none"), is_known = .true.)
call local%set_string (var_str ("$integration_method"), &
var_str ("none"), is_known = .true.)
n = prc_set%get_n_process ()
allocate (prc_set%subprocess (n))
do i = 1, n
proc_id = prc_set%get_proc_id (i)
call prepare_process (prc_set%subprocess(i)%p, proc_id)
if (signal_is_pending ()) return
end do
lib => current%prclib_stack%get_library_ptr (libname_cur)
if (associated (lib)) call current%update_prclib (lib)
contains
subroutine prepare_process (process, process_id)
type(process_t), pointer, intent(out) :: process
type(string_t), intent(in) :: process_id
call msg_message ("Simulate: initializing resonant subprocess '" &
// char (process_id) // "'")
if (present (global)) then
call integrate_process (process_id, local, global, &
init_only = .true.)
else
call integrate_process (process_id, local, local_stack = .true., &
init_only = .true.)
end if
process => current%process_stack%get_process_ptr (process_id)
if (.not. associated (process)) then
call msg_fatal ("Simulate: resonant subprocess '" &
// char (process_id) // "' could not be initialized: aborting")
end if
end subroutine prepare_process
end subroutine resonant_subprocess_set_prepare_process_objects
@ %def resonant_subprocess_set_prepare_process_objects
@ Workspace for the resonant subprocesses.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: prepare_process_instances &
=> resonant_subprocess_set_prepare_process_instances
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_prepare_process_instances (prc_set, global)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
type(rt_data_t), intent(in), target :: global
integer :: i, n
if (.not. prc_set%is_active ()) return
n = size (prc_set%subprocess)
allocate (prc_set%instance (n))
do i = 1, n
allocate (prc_set%instance(i)%p)
call prc_set%instance(i)%p%init (prc_set%subprocess(i)%p)
call prc_set%instance(i)%p%setup_event_data (global%model)
end do
end subroutine resonant_subprocess_set_prepare_process_instances
@ %def resonant_subprocess_set_prepare_process_instances
@
\subsection{Event transform connection}
The idea is that the resonance-insertion event transform has been
allocated somewhere (namely, in the standard event-transform chain),
but we maintain a link such that we can inject matrix-element results
event by event. The event transform holds a selector, to choose one
of the resonance histories (or none), and it manages resonance
insertion for the particle set.
The data that the event transform requires can be provided here. The
resonance history set has already been assigned with the [[dispatch]]
initializer. Here, we supply the set of subprocess instances that we
have generated (see above). The master-process instance is set
when we [[connect]] the transform by the standard method.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: connect_transform => &
resonant_subprocess_set_connect_transform
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_connect_transform (prc_set, evt)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
class(evt_t), intent(in), target :: evt
select type (evt)
type is (evt_resonance_t)
prc_set%evt => evt
call prc_set%evt%set_subprocess_instances (prc_set%instance)
class default
call msg_bug ("Resonant subprocess set: event transform has wrong type")
end select
end subroutine resonant_subprocess_set_connect_transform
@ %def resonant_subprocess_set_connect_transform
@ Set the on-shell limit value in the connected transform.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: set_on_shell_limit => resonant_subprocess_set_on_shell_limit
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_on_shell_limit (prc_set, on_shell_limit)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
real(default), intent(in) :: on_shell_limit
call prc_set%evt%set_on_shell_limit (on_shell_limit)
end subroutine resonant_subprocess_set_on_shell_limit
@ %def resonant_subprocess_set_on_shell_limit
@ Set the Gaussian turnoff parameter in the connected transform.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: set_on_shell_turnoff => resonant_subprocess_set_on_shell_turnoff
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_on_shell_turnoff &
(prc_set, on_shell_turnoff)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
real(default), intent(in) :: on_shell_turnoff
call prc_set%evt%set_on_shell_turnoff (on_shell_turnoff)
end subroutine resonant_subprocess_set_on_shell_turnoff
@ %def resonant_subprocess_set_on_shell_turnoff
@ Reweight (suppress) the background contribution probability, for the
kinematics where a resonance history is active.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: set_background_factor &
=> resonant_subprocess_set_background_factor
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_background_factor &
(prc_set, background_factor)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
real(default), intent(in) :: background_factor
call prc_set%evt%set_background_factor (background_factor)
end subroutine resonant_subprocess_set_background_factor
@ %def resonant_subprocess_set_background_factor
@
\subsection{Wrappers for runtime calculations}
All runtime calculations are delegated to the event transform. The
following procedures are essentially redundant wrappers. We retain
them for a unit test below.
Debugging aid:
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: dump_instances => resonant_subprocess_set_dump_instances
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_dump_instances (prc_set, unit, testflag)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
integer :: i, n, u
u = given_output_unit (unit)
write (u, "(A)") "*** Process instances of resonant subprocesses"
write (u, *)
n = size (prc_set%subprocess)
do i = 1, n
associate (instance => prc_set%instance(i)%p)
call instance%write (u, testflag)
write (u, *)
write (u, *)
end associate
end do
end subroutine resonant_subprocess_set_dump_instances
@ %def resonant_subprocess_set_dump_instances
@ Inject the current kinematics configuration, reading from the
previous event transform or from the process instance.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: fill_momenta => resonant_subprocess_set_fill_momenta
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_fill_momenta (prc_set)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
integer :: i, n
call prc_set%evt%fill_momenta ()
end subroutine resonant_subprocess_set_fill_momenta
@ %def resonant_subprocess_set_fill_momenta
@ Determine the indices of the resonance histories that can be
considered on-shell for the current kinematics.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: determine_on_shell_histories &
=> resonant_subprocess_set_determine_on_shell_histories
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_determine_on_shell_histories &
(prc_set, i_component, index_array)
class(resonant_subprocess_set_t), intent(in) :: prc_set
integer, intent(in) :: i_component
integer, dimension(:), allocatable, intent(out) :: index_array
call prc_set%evt%determine_on_shell_histories (index_array)
end subroutine resonant_subprocess_set_determine_on_shell_histories
@ %def resonant_subprocess_set_determine_on_shell_histories
@ Evaluate selected subprocesses. (In actual operation, the ones that
have been tagged as on-shell.)
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: evaluate_subprocess &
=> resonant_subprocess_set_evaluate_subprocess
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_evaluate_subprocess (prc_set, index_array)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
integer, dimension(:), intent(in) :: index_array
call prc_set%evt%evaluate_subprocess (index_array)
end subroutine resonant_subprocess_set_evaluate_subprocess
@ %def resonant_subprocess_set_evaluate_subprocess
@ Extract the matrix elements of the master process / the resonant
subprocesses. After the previous routine has been executed, they
should be available and stored in the corresponding process instances.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: get_master_sqme &
=> resonant_subprocess_set_get_master_sqme
procedure :: get_subprocess_sqme &
=> resonant_subprocess_set_get_subprocess_sqme
<<Restricted subprocesses: procedures>>=
function resonant_subprocess_set_get_master_sqme (prc_set) result (sqme)
class(resonant_subprocess_set_t), intent(in) :: prc_set
real(default) :: sqme
sqme = prc_set%evt%get_master_sqme ()
end function resonant_subprocess_set_get_master_sqme
subroutine resonant_subprocess_set_get_subprocess_sqme (prc_set, sqme)
class(resonant_subprocess_set_t), intent(in) :: prc_set
real(default), dimension(:), intent(inout) :: sqme
integer :: i
call prc_set%evt%get_subprocess_sqme (sqme)
end subroutine resonant_subprocess_set_get_subprocess_sqme
@ %def resonant_subprocess_set_get_master_sqme
@ %def resonant_subprocess_set_get_subprocess_sqme
@ We use the calculations of resonant matrix elements to determine
probabilities for all resonance configurations.
<<Restricted subprocesses: resonant subprocess set: TBP>>=
procedure :: compute_probabilities &
=> resonant_subprocess_set_compute_probabilities
<<Restricted subprocesses: procedures>>=
subroutine resonant_subprocess_set_compute_probabilities (prc_set, prob_array)
class(resonant_subprocess_set_t), intent(inout) :: prc_set
real(default), dimension(:), allocatable, intent(out) :: prob_array
integer, dimension(:), allocatable :: index_array
real(default) :: sqme, sqme_sum, sqme_bg
real(default), dimension(:), allocatable :: sqme_res
integer :: n
n = size (prc_set%subprocess)
allocate (prob_array (0:n), source = 0._default)
call prc_set%evt%compute_probabilities ()
call prc_set%evt%get_selector_weights (prob_array)
end subroutine resonant_subprocess_set_compute_probabilities
@ %def resonant_subprocess_set_compute_probabilities
@
\subsection{Unit tests}
Test module, followed by the stand-alone unit-test procedures.
<<[[restricted_subprocesses_ut.f90]]>>=
<<File header>>
module restricted_subprocesses_ut
use unit_tests
use restricted_subprocesses_uti
<<Standard module head>>
<<Restricted subprocesses: public test>>
contains
<<Restricted subprocesses: test driver>>
end module restricted_subprocesses_ut
@ %def restricted_subprocesses_ut
@
<<[[restricted_subprocesses_uti.f90]]>>=
<<File header>>
module restricted_subprocesses_uti
<<Use kinds>>
<<Use strings>>
use io_units, only: free_unit
use format_defs, only: FMT_10, FMT_12
use lorentz, only: vector4_t, vector3_moving, vector4_moving
use particle_specifiers, only: new_prt_spec
use process_libraries, only: process_library_t
use resonances, only: resonance_info_t
use resonances, only: resonance_history_t
use resonances, only: resonance_history_set_t
use sm_qcd, only: qcd_t
use state_matrices, only: FM_IGNORE_HELICITY
use particles, only: particle_set_t
use model_data, only: model_data_t
use models, only: syntax_model_file_init, syntax_model_file_final
use models, only: model_t
use rng_base, only: rng_factory_t
use rng_base_ut, only: rng_test_factory_t
use mci_base, only: mci_t
use mci_none, only: mci_none_t
use phs_base, only: phs_config_t
use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
use phs_wood, only: phs_wood_config_t
use process_libraries, only: process_def_entry_t
use process_libraries, only: process_component_def_t
use prclib_stacks, only: prclib_entry_t
use prc_core_def, only: prc_core_def_t
use prc_omega, only: omega_def_t
use process, only: process_t
use instances, only: process_instance_t
use process_stacks, only: process_entry_t
use event_transforms, only: evt_trivial_t
use resonance_insertion, only: evt_resonance_t
use integrations, only: integrate_process
use rt_data, only: rt_data_t
use restricted_subprocesses
<<Standard module head>>
<<Restricted subprocesses: test declarations>>
<<Restricted subprocesses: test auxiliary types>>
<<Restricted subprocesses: public test auxiliary>>
contains
<<Restricted subprocesses: tests>>
<<Restricted subprocesses: test auxiliary>>
end module restricted_subprocesses_uti
@ %def restricted_subprocesses_uti
@ API: driver for the unit tests below.
<<Restricted subprocesses: public test>>=
public :: restricted_subprocesses_test
<<Restricted subprocesses: test driver>>=
subroutine restricted_subprocesses_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Restricted subprocesses: execute tests>>
end subroutine restricted_subprocesses_test
@ %def restricted_subprocesses_test
@
\subsubsection{subprocess configuration}
Initialize a [[restricted_subprocess_configuration_t]] object which represents
a given process with a defined resonance history.
<<Restricted subprocesses: execute tests>>=
call test (restricted_subprocesses_1, "restricted_subprocesses_1", &
"single subprocess", &
u, results)
<<Restricted subprocesses: test declarations>>=
public :: restricted_subprocesses_1
<<Restricted subprocesses: tests>>=
subroutine restricted_subprocesses_1 (u)
integer, intent(in) :: u
type(rt_data_t) :: global
type(resonance_info_t) :: res_info
type(resonance_history_t) :: res_history
type(string_t) :: prc_name
type(string_t), dimension(2) :: prt_in
type(string_t), dimension(3) :: prt_out
type(restricted_process_configuration_t) :: prc_config
write (u, "(A)") "* Test output: restricted_subprocesses_1"
write (u, "(A)") "* Purpose: create subprocess list from resonances"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%select_model (var_str ("SM"))
write (u, "(A)") "* Create resonance history"
write (u, "(A)")
call res_info%init (3, -24, global%model, 5)
call res_history%add_resonance (res_info)
call res_history%write (u)
write (u, "(A)")
write (u, "(A)") "* Create process configuration"
write (u, "(A)")
prc_name = "restricted_subprocesses_1_p"
prt_in(1) = "e-"
prt_in(2) = "e+"
prt_out(1) = "d"
prt_out(2) = "u"
prt_out(3) = "W+"
call prc_config%init_resonant_process (prc_name, &
new_prt_spec (prt_in), new_prt_spec (prt_out), &
res_history, global%model, global%var_list)
call prc_config%write (u)
write (u, *)
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: restricted_subprocesses_1"
end subroutine restricted_subprocesses_1
@ %def restricted_subprocesses_1
@
\subsubsection{Subprocess library configuration}
Create a process library that represents restricted subprocesses for a given
set of resonance histories
<<Restricted subprocesses: execute tests>>=
call test (restricted_subprocesses_2, "restricted_subprocesses_2", &
"subprocess library", &
u, results)
<<Restricted subprocesses: test declarations>>=
public :: restricted_subprocesses_2
<<Restricted subprocesses: tests>>=
subroutine restricted_subprocesses_2 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
type(resonance_info_t) :: res_info
type(resonance_history_t), dimension(2) :: res_history
type(resonance_history_set_t) :: res_history_set
type(string_t) :: libname
type(string_t), dimension(2) :: prt_in
type(string_t), dimension(3) :: prt_out
type(resonant_subprocess_set_t) :: prc_set
type(process_library_t), pointer :: lib
logical :: exist
write (u, "(A)") "* Test output: restricted_subprocesses_2"
write (u, "(A)") "* Purpose: create subprocess library from resonances"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%select_model (var_str ("SM"))
write (u, "(A)") "* Create resonance histories"
write (u, "(A)")
call res_info%init (3, -24, global%model, 5)
call res_history(1)%add_resonance (res_info)
call res_history(1)%write (u)
call res_info%init (7, 23, global%model, 5)
call res_history(2)%add_resonance (res_info)
call res_history(2)%write (u)
call res_history_set%init ()
call res_history_set%enter (res_history(1))
call res_history_set%enter (res_history(2))
call res_history_set%freeze ()
write (u, "(A)")
write (u, "(A)") "* Empty restricted subprocess set"
write (u, "(A)")
write (u, "(A,1x,L1)") "active =", prc_set%is_active ()
write (u, "(A)")
call prc_set%write (u, testflag=.true.)
write (u, "(A)")
write (u, "(A)") "* Fill restricted subprocess set"
write (u, "(A)")
libname = "restricted_subprocesses_2_p_R"
prt_in(1) = "e-"
prt_in(2) = "e+"
prt_out(1) = "d"
prt_out(2) = "u"
prt_out(3) = "W+"
call prc_set%init (1)
call prc_set%fill_resonances (res_history_set, 1)
call prc_set%create_library (libname, global, exist)
if (.not. exist) then
call prc_set%add_to_library (1, &
new_prt_spec (prt_in), new_prt_spec (prt_out), &
global)
end if
call prc_set%freeze_library (global)
write (u, "(A,1x,L1)") "active =", prc_set%is_active ()
write (u, "(A)")
call prc_set%write (u, testflag=.true.)
write (u, "(A)")
write (u, "(A)") "* Queries"
write (u, "(A)")
write (u, "(A,1x,I0)") "n_process =", prc_set%get_n_process ()
write (u, "(A)")
write (u, "(A,A,A)") "libname = '", char (prc_set%get_libname ()), "'"
write (u, "(A)")
write (u, "(A,A,A)") "proc_id(1) = '", char (prc_set%get_proc_id (1)), "'"
write (u, "(A,A,A)") "proc_id(2) = '", char (prc_set%get_proc_id (2)), "'"
write (u, "(A)")
write (u, "(A)") "* Process library"
write (u, "(A)")
call prc_set%compile_library (global)
lib => global%prclib_stack%get_library_ptr (libname)
if (associated (lib)) call lib%write (u, libpath=.false.)
write (u, *)
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: restricted_subprocesses_2"
end subroutine restricted_subprocesses_2
@ %def restricted_subprocesses_2
@
\subsubsection{Auxiliary: Test processes}
Auxiliary subroutine that constructs the process library for the above test.
This parallels a similar subroutine in [[processes_uti]], but this time we
want an \oMega\ process.
<<Restricted subprocesses: public test auxiliary>>=
public :: prepare_resonance_test_library
<<Restricted subprocesses: test auxiliary>>=
subroutine prepare_resonance_test_library &
(lib, libname, procname, model, global, u)
type(process_library_t), target, intent(out) :: lib
type(string_t), intent(in) :: libname
type(string_t), intent(in) :: procname
class(model_data_t), intent(in), pointer :: model
type(rt_data_t), intent(in), target :: global
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 (omega_def_t :: def)
select type (def)
type is (omega_def_t)
call def%init (model%get_name (), prt_in, prt_out, &
ovm=.false., ufo=.false.)
end select
allocate (entry)
call entry%init (procname, &
model_name = model%get_name (), &
n_in = 2, n_components = 1, &
requires_resonances = .true.)
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 ("omega"), &
variant = def)
call entry%write (u)
call lib%append (entry)
call lib%configure (global%os_data)
call lib%write_makefile (global%os_data, force = .true., verbose = .false.)
call lib%clean (global%os_data, distclean = .false.)
call lib%write_driver (force = .true.)
call lib%load (global%os_data)
end subroutine prepare_resonance_test_library
@ %def prepare_resonance_test_library
@
\subsubsection{Kinematics and resonance selection}
Prepare an actual process with resonant subprocesses. Insert
kinematics and apply the resonance selector in an associated event
transform.
<<Restricted subprocesses: execute tests>>=
call test (restricted_subprocesses_3, "restricted_subprocesses_3", &
"resonance kinematics and probability", &
u, results)
<<Restricted subprocesses: test declarations>>=
public :: restricted_subprocesses_3
<<Restricted subprocesses: tests>>=
subroutine restricted_subprocesses_3 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
class(model_t), pointer :: model
class(model_data_t), pointer :: model_data
type(string_t) :: libname, libname_res
type(string_t) :: procname
type(process_component_def_t), pointer :: process_component_def
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
logical :: exist
type(process_t), pointer :: process
type(process_instance_t), target :: process_instance
type(resonance_history_set_t), dimension(1) :: res_history_set
type(resonant_subprocess_set_t) :: prc_set
type(particle_set_t) :: pset
real(default) :: sqrts, mw, pp
real(default), dimension(3) :: p3
type(vector4_t), dimension(:), allocatable :: p
real(default), dimension(:), allocatable :: m
integer, dimension(:), allocatable :: pdg
real(default), dimension(:), allocatable :: sqme
logical, dimension(:), allocatable :: mask
real(default) :: on_shell_limit
integer, dimension(:), allocatable :: i_array
real(default), dimension(:), allocatable :: prob_array
type(evt_resonance_t), target :: evt_resonance
integer :: i, u_dump
write (u, "(A)") "* Test output: restricted_subprocesses_3"
write (u, "(A)") "* Purpose: handle process and resonance kinematics"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%set_log (var_str ("?resonance_history"), &
.true., is_known = .true.)
call global%select_model (var_str ("SM"))
allocate (model)
call model%init_instance (global%model)
model_data => model
libname = "restricted_subprocesses_3_lib"
libname_res = "restricted_subprocesses_3_lib_res"
procname = "restricted_subprocesses_3_p"
write (u, "(A)") "* Initialize process library and process"
write (u, "(A)")
allocate (lib_entry)
call lib_entry%init (libname)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
call prepare_resonance_test_library &
(lib, libname, procname, model_data, global, u)
call integrate_process (procname, global, &
local_stack = .true., init_only = .true.)
process => global%process_stack%get_process_ptr (procname)
call process_instance%init (process)
call process_instance%setup_event_data ()
write (u, "(A)")
write (u, "(A)") "* Extract resonance history set"
write (u, "(A)")
call process%extract_resonance_history_set &
(res_history_set(1), include_trivial=.true., i_component=1)
call res_history_set(1)%write (u)
write (u, "(A)")
write (u, "(A)") "* Build resonant-subprocess library"
write (u, "(A)")
call prc_set%init (1)
call prc_set%fill_resonances (res_history_set(1), 1)
process_component_def => process%get_component_def_ptr (1)
call prc_set%create_library (libname_res, global, exist)
if (.not. exist) then
call prc_set%add_to_library (1, &
process_component_def%get_prt_spec_in (), &
process_component_def%get_prt_spec_out (), &
global)
end if
call prc_set%freeze_library (global)
call prc_set%compile_library (global)
call prc_set%write (u, testflag=.true.)
write (u, "(A)")
write (u, "(A)") "* Build particle set"
write (u, "(A)")
sqrts = global%get_rval (var_str ("sqrts"))
mw = 80._default ! deliberately slightly different from true mw
pp = sqrt (sqrts**2 - 4 * mw**2) / 2
allocate (pdg (5), p (5), m (5))
pdg(1) = -11
p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
m(1) = 0
pdg(2) = 11
p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
m(2) = 0
pdg(3) = 1
p3(1) = pp/2
p3(2) = mw/2
p3(3) = 0
p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
m(3) = 0
p3(2) = -mw/2
pdg(4) = -2
p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
m(4) = 0
pdg(5) = 24
p(5) = vector4_moving (sqrts/2,-pp, 1)
m(5) = mw
call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
call pset%set_momentum (p, m**2)
call pset%write (u, testflag=.true.)
write (u, "(A)")
write (u, "(A)") "* Fill process instance"
! workflow from event_recalculate
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1)
call process_instance%recover &
(1, 1, update_sqme=.true., recover_phs=.false.)
call process_instance%evaluate_event_data (weight = 1._default)
write (u, "(A)")
write (u, "(A)") "* Prepare resonant subprocesses"
call prc_set%prepare_process_objects (global)
call prc_set%prepare_process_instances (global)
call evt_resonance%set_resonance_data (res_history_set)
call evt_resonance%select_component (1)
call prc_set%connect_transform (evt_resonance)
call evt_resonance%connect (process_instance, model)
call prc_set%fill_momenta ()
write (u, "(A)")
write (u, "(A)") "* Show squared matrix element of master process,"
write (u, "(A)") " should coincide with 2nd subprocess sqme"
write (u, "(A)")
write (u, "(1x,I0,1x," // FMT_12 // ")") 0, prc_set%get_master_sqme ()
write (u, "(A)")
write (u, "(A)") "* Compute squared matrix elements &
&of selected resonant subprocesses [1,2]"
write (u, "(A)")
call prc_set%evaluate_subprocess ([1,2])
allocate (sqme (3), source = 0._default)
call prc_set%get_subprocess_sqme (sqme)
do i = 1, size (sqme)
write (u, "(1x,I0,1x," // FMT_12 // ")") i, sqme(i)
end do
deallocate (sqme)
write (u, "(A)")
write (u, "(A)") "* Compute squared matrix elements &
&of all resonant subprocesses"
write (u, "(A)")
call prc_set%evaluate_subprocess ([1,2,3])
allocate (sqme (3), source = 0._default)
call prc_set%get_subprocess_sqme (sqme)
do i = 1, size (sqme)
write (u, "(1x,I0,1x," // FMT_12 // ")") i, sqme(i)
end do
deallocate (sqme)
write (u, "(A)")
write (u, "(A)") "* Write process instances to file &
&restricted_subprocesses_3_lib_res.dat"
u_dump = free_unit ()
open (unit = u_dump, file = "restricted_subprocesses_3_lib_res.dat", &
action = "write", status = "replace")
call prc_set%dump_instances (u_dump)
close (u_dump)
write (u, "(A)")
write (u, "(A)") "* Determine on-shell resonant subprocesses"
write (u, "(A)")
on_shell_limit = 0
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
call prc_set%set_on_shell_limit (on_shell_limit)
call prc_set%determine_on_shell_histories (1, i_array)
write (u, "(1x,A,9(1x,I0))") "resonant =", i_array
on_shell_limit = 0.1_default
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
call prc_set%set_on_shell_limit (on_shell_limit)
call prc_set%determine_on_shell_histories (1, i_array)
write (u, "(1x,A,9(1x,I0))") "resonant =", i_array
on_shell_limit = 10._default
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
call prc_set%set_on_shell_limit (on_shell_limit)
call prc_set%determine_on_shell_histories (1, i_array)
write (u, "(1x,A,9(1x,I0))") "resonant =", i_array
on_shell_limit = 10000._default
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
call prc_set%set_on_shell_limit (on_shell_limit)
call prc_set%determine_on_shell_histories (1, i_array)
write (u, "(1x,A,9(1x,I0))") "resonant =", i_array
write (u, "(A)")
write (u, "(A)") "* Compute probabilities for applicable resonances"
write (u, "(A)") " and initialize the process selector"
write (u, "(A)") " (The first number is the probability for background)"
write (u, "(A)")
on_shell_limit = 0
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
call prc_set%set_on_shell_limit (on_shell_limit)
call prc_set%determine_on_shell_histories (1, i_array)
call prc_set%compute_probabilities (prob_array)
write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
call prc_set%write (u, testflag=.true.)
write (u, *)
on_shell_limit = 10._default
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
call prc_set%set_on_shell_limit (on_shell_limit)
call prc_set%determine_on_shell_histories (1, i_array)
call prc_set%compute_probabilities (prob_array)
write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
call prc_set%write (u, testflag=.true.)
write (u, *)
on_shell_limit = 10000._default
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
call prc_set%set_on_shell_limit (on_shell_limit)
call prc_set%determine_on_shell_histories (1, i_array)
call prc_set%compute_probabilities (prob_array)
write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
write (u, *)
call prc_set%write (u, testflag=.true.)
write (u, *)
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_phs_forest_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: restricted_subprocesses_3"
end subroutine restricted_subprocesses_3
@ %def restricted_subprocesses_3
@
\subsubsection{Event transform}
Prepare an actual process with resonant subprocesses. Prepare the
resonance selector for a fixed event and apply the resonance-insertion
event transform.
<<Restricted subprocesses: execute tests>>=
call test (restricted_subprocesses_4, "restricted_subprocesses_4", &
"event transform", &
u, results)
<<Restricted subprocesses: test declarations>>=
public :: restricted_subprocesses_4
<<Restricted subprocesses: tests>>=
subroutine restricted_subprocesses_4 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
class(model_t), pointer :: model
class(model_data_t), pointer :: model_data
type(string_t) :: libname, libname_res
type(string_t) :: procname
type(process_component_def_t), pointer :: process_component_def
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
logical :: exist
type(process_t), pointer :: process
type(process_instance_t), target :: process_instance
type(resonance_history_set_t), dimension(1) :: res_history_set
type(resonant_subprocess_set_t) :: prc_set
type(particle_set_t) :: pset
real(default) :: sqrts, mw, pp
real(default), dimension(3) :: p3
type(vector4_t), dimension(:), allocatable :: p
real(default), dimension(:), allocatable :: m
integer, dimension(:), allocatable :: pdg
real(default) :: on_shell_limit
type(evt_trivial_t), target :: evt_trivial
type(evt_resonance_t), target :: evt_resonance
real(default) :: probability
integer :: i
write (u, "(A)") "* Test output: restricted_subprocesses_4"
write (u, "(A)") "* Purpose: employ event transform"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%set_log (var_str ("?resonance_history"), &
.true., is_known = .true.)
call global%select_model (var_str ("SM"))
allocate (model)
call model%init_instance (global%model)
model_data => model
libname = "restricted_subprocesses_4_lib"
libname_res = "restricted_subprocesses_4_lib_res"
procname = "restricted_subprocesses_4_p"
write (u, "(A)") "* Initialize process library and process"
write (u, "(A)")
allocate (lib_entry)
call lib_entry%init (libname)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
call prepare_resonance_test_library &
(lib, libname, procname, model_data, global, u)
call integrate_process (procname, global, &
local_stack = .true., init_only = .true.)
process => global%process_stack%get_process_ptr (procname)
call process_instance%init (process)
call process_instance%setup_event_data ()
write (u, "(A)")
write (u, "(A)") "* Extract resonance history set"
call process%extract_resonance_history_set &
(res_history_set(1), include_trivial=.false., i_component=1)
write (u, "(A)")
write (u, "(A)") "* Build resonant-subprocess library"
call prc_set%init (1)
call prc_set%fill_resonances (res_history_set(1), 1)
process_component_def => process%get_component_def_ptr (1)
call prc_set%create_library (libname_res, global, exist)
if (.not. exist) then
call prc_set%add_to_library (1, &
process_component_def%get_prt_spec_in (), &
process_component_def%get_prt_spec_out (), &
global)
end if
call prc_set%freeze_library (global)
call prc_set%compile_library (global)
write (u, "(A)")
write (u, "(A)") "* Build particle set"
write (u, "(A)")
sqrts = global%get_rval (var_str ("sqrts"))
mw = 80._default ! deliberately slightly different from true mw
pp = sqrt (sqrts**2 - 4 * mw**2) / 2
allocate (pdg (5), p (5), m (5))
pdg(1) = -11
p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
m(1) = 0
pdg(2) = 11
p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
m(2) = 0
pdg(3) = 1
p3(1) = pp/2
p3(2) = mw/2
p3(3) = 0
p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
m(3) = 0
p3(2) = -mw/2
pdg(4) = -2
p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
m(4) = 0
pdg(5) = 24
p(5) = vector4_moving (sqrts/2,-pp, 1)
m(5) = mw
call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
call pset%set_momentum (p, m**2)
write (u, "(A)") "* Fill process instance"
write (u, "(A)")
! workflow from event_recalculate
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1)
call process_instance%recover &
(1, 1, update_sqme=.true., recover_phs=.false.)
call process_instance%evaluate_event_data (weight = 1._default)
write (u, "(A)") "* Prepare resonant subprocesses"
write (u, "(A)")
call prc_set%prepare_process_objects (global)
call prc_set%prepare_process_instances (global)
write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
write (u, "(A)")
call evt_trivial%connect (process_instance, model)
call evt_trivial%set_particle_set (pset, 1, 1)
call evt_trivial%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize resonance-insertion event transform"
write (u, "(A)")
evt_trivial%next => evt_resonance
evt_resonance%previous => evt_trivial
call evt_resonance%set_resonance_data (res_history_set)
call evt_resonance%select_component (1)
call evt_resonance%connect (process_instance, model)
call prc_set%connect_transform (evt_resonance)
call evt_resonance%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute probabilities for applicable resonances"
write (u, "(A)") " and initialize the process selector"
write (u, "(A)")
on_shell_limit = 10._default
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
call evt_resonance%set_on_shell_limit (on_shell_limit)
write (u, "(A)")
write (u, "(A)") "* Evaluate resonance-insertion event transform"
write (u, "(A)")
call evt_resonance%prepare_new_event (1, 1)
call evt_resonance%generate_weighted (probability)
call evt_resonance%make_particle_set (1, .false.)
call evt_resonance%write (u, testflag=.true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_phs_forest_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: restricted_subprocesses_4"
end subroutine restricted_subprocesses_4
@ %def restricted_subprocesses_4
@
\subsubsection{Gaussian turnoff}
Identical to the previous process, except that we apply a Gaussian
turnoff to the resonance kinematics, which affects the subprocess selector.
<<Restricted subprocesses: execute tests>>=
call test (restricted_subprocesses_5, "restricted_subprocesses_5", &
"event transform with gaussian turnoff", &
u, results)
<<Restricted subprocesses: test declarations>>=
public :: restricted_subprocesses_5
<<Restricted subprocesses: tests>>=
subroutine restricted_subprocesses_5 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
class(model_t), pointer :: model
class(model_data_t), pointer :: model_data
type(string_t) :: libname, libname_res
type(string_t) :: procname
type(process_component_def_t), pointer :: process_component_def
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
logical :: exist
type(process_t), pointer :: process
type(process_instance_t), target :: process_instance
type(resonance_history_set_t), dimension(1) :: res_history_set
type(resonant_subprocess_set_t) :: prc_set
type(particle_set_t) :: pset
real(default) :: sqrts, mw, pp
real(default), dimension(3) :: p3
type(vector4_t), dimension(:), allocatable :: p
real(default), dimension(:), allocatable :: m
integer, dimension(:), allocatable :: pdg
real(default) :: on_shell_limit
real(default) :: on_shell_turnoff
type(evt_trivial_t), target :: evt_trivial
type(evt_resonance_t), target :: evt_resonance
real(default) :: probability
integer :: i
write (u, "(A)") "* Test output: restricted_subprocesses_5"
write (u, "(A)") "* Purpose: employ event transform &
&with gaussian turnoff"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%set_log (var_str ("?resonance_history"), &
.true., is_known = .true.)
call global%select_model (var_str ("SM"))
allocate (model)
call model%init_instance (global%model)
model_data => model
libname = "restricted_subprocesses_5_lib"
libname_res = "restricted_subprocesses_5_lib_res"
procname = "restricted_subprocesses_5_p"
write (u, "(A)") "* Initialize process library and process"
write (u, "(A)")
allocate (lib_entry)
call lib_entry%init (libname)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
call prepare_resonance_test_library &
(lib, libname, procname, model_data, global, u)
call integrate_process (procname, global, &
local_stack = .true., init_only = .true.)
process => global%process_stack%get_process_ptr (procname)
call process_instance%init (process)
call process_instance%setup_event_data ()
write (u, "(A)")
write (u, "(A)") "* Extract resonance history set"
call process%extract_resonance_history_set &
(res_history_set(1), include_trivial=.false., i_component=1)
write (u, "(A)")
write (u, "(A)") "* Build resonant-subprocess library"
call prc_set%init (1)
call prc_set%fill_resonances (res_history_set(1), 1)
process_component_def => process%get_component_def_ptr (1)
call prc_set%create_library (libname_res, global, exist)
if (.not. exist) then
call prc_set%add_to_library (1, &
process_component_def%get_prt_spec_in (), &
process_component_def%get_prt_spec_out (), &
global)
end if
call prc_set%freeze_library (global)
call prc_set%compile_library (global)
write (u, "(A)")
write (u, "(A)") "* Build particle set"
write (u, "(A)")
sqrts = global%get_rval (var_str ("sqrts"))
mw = 80._default ! deliberately slightly different from true mw
pp = sqrt (sqrts**2 - 4 * mw**2) / 2
allocate (pdg (5), p (5), m (5))
pdg(1) = -11
p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
m(1) = 0
pdg(2) = 11
p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
m(2) = 0
pdg(3) = 1
p3(1) = pp/2
p3(2) = mw/2
p3(3) = 0
p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
m(3) = 0
p3(2) = -mw/2
pdg(4) = -2
p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
m(4) = 0
pdg(5) = 24
p(5) = vector4_moving (sqrts/2,-pp, 1)
m(5) = mw
call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
call pset%set_momentum (p, m**2)
write (u, "(A)") "* Fill process instance"
write (u, "(A)")
! workflow from event_recalculate
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1)
call process_instance%recover &
(1, 1, update_sqme=.true., recover_phs=.false.)
call process_instance%evaluate_event_data (weight = 1._default)
write (u, "(A)") "* Prepare resonant subprocesses"
write (u, "(A)")
call prc_set%prepare_process_objects (global)
call prc_set%prepare_process_instances (global)
write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
write (u, "(A)")
call evt_trivial%connect (process_instance, model)
call evt_trivial%set_particle_set (pset, 1, 1)
call evt_trivial%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize resonance-insertion event transform"
write (u, "(A)")
evt_trivial%next => evt_resonance
evt_resonance%previous => evt_trivial
call evt_resonance%set_resonance_data (res_history_set)
call evt_resonance%select_component (1)
call evt_resonance%connect (process_instance, model)
call prc_set%connect_transform (evt_resonance)
call evt_resonance%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute probabilities for applicable resonances"
write (u, "(A)") " and initialize the process selector"
write (u, "(A)")
on_shell_limit = 10._default
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", &
on_shell_limit
call evt_resonance%set_on_shell_limit (on_shell_limit)
on_shell_turnoff = 1._default
write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_turnoff =", &
on_shell_turnoff
call evt_resonance%set_on_shell_turnoff (on_shell_turnoff)
write (u, "(A)")
write (u, "(A)") "* Evaluate resonance-insertion event transform"
write (u, "(A)")
call evt_resonance%prepare_new_event (1, 1)
call evt_resonance%generate_weighted (probability)
call evt_resonance%make_particle_set (1, .false.)
call evt_resonance%write (u, testflag=.true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_phs_forest_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: restricted_subprocesses_5"
end subroutine restricted_subprocesses_5
@ %def restricted_subprocesses_5
@
\subsubsection{Event transform}
The same process and event again. This time, switch off the background
contribution, so the selector becomes trivial.
<<Restricted subprocesses: execute tests>>=
call test (restricted_subprocesses_6, "restricted_subprocesses_6", &
"event transform with background switched off", &
u, results)
<<Restricted subprocesses: test declarations>>=
public :: restricted_subprocesses_6
<<Restricted subprocesses: tests>>=
subroutine restricted_subprocesses_6 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
class(model_t), pointer :: model
class(model_data_t), pointer :: model_data
type(string_t) :: libname, libname_res
type(string_t) :: procname
type(process_component_def_t), pointer :: process_component_def
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
logical :: exist
type(process_t), pointer :: process
type(process_instance_t), target :: process_instance
type(resonance_history_set_t), dimension(1) :: res_history_set
type(resonant_subprocess_set_t) :: prc_set
type(particle_set_t) :: pset
real(default) :: sqrts, mw, pp
real(default), dimension(3) :: p3
type(vector4_t), dimension(:), allocatable :: p
real(default), dimension(:), allocatable :: m
integer, dimension(:), allocatable :: pdg
real(default) :: on_shell_limit
real(default) :: background_factor
type(evt_trivial_t), target :: evt_trivial
type(evt_resonance_t), target :: evt_resonance
real(default) :: probability
integer :: i
write (u, "(A)") "* Test output: restricted_subprocesses_6"
write (u, "(A)") "* Purpose: employ event transform &
&with background switched off"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%set_log (var_str ("?resonance_history"), &
.true., is_known = .true.)
call global%select_model (var_str ("SM"))
allocate (model)
call model%init_instance (global%model)
model_data => model
libname = "restricted_subprocesses_6_lib"
libname_res = "restricted_subprocesses_6_lib_res"
procname = "restricted_subprocesses_6_p"
write (u, "(A)") "* Initialize process library and process"
write (u, "(A)")
allocate (lib_entry)
call lib_entry%init (libname)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
call prepare_resonance_test_library &
(lib, libname, procname, model_data, global, u)
call integrate_process (procname, global, &
local_stack = .true., init_only = .true.)
process => global%process_stack%get_process_ptr (procname)
call process_instance%init (process)
call process_instance%setup_event_data ()
write (u, "(A)")
write (u, "(A)") "* Extract resonance history set"
call process%extract_resonance_history_set &
(res_history_set(1), include_trivial=.false., i_component=1)
write (u, "(A)")
write (u, "(A)") "* Build resonant-subprocess library"
call prc_set%init (1)
call prc_set%fill_resonances (res_history_set(1), 1)
process_component_def => process%get_component_def_ptr (1)
call prc_set%create_library (libname_res, global, exist)
if (.not. exist) then
call prc_set%add_to_library (1, &
process_component_def%get_prt_spec_in (), &
process_component_def%get_prt_spec_out (), &
global)
end if
call prc_set%freeze_library (global)
call prc_set%compile_library (global)
write (u, "(A)")
write (u, "(A)") "* Build particle set"
write (u, "(A)")
sqrts = global%get_rval (var_str ("sqrts"))
mw = 80._default ! deliberately slightly different from true mw
pp = sqrt (sqrts**2 - 4 * mw**2) / 2
allocate (pdg (5), p (5), m (5))
pdg(1) = -11
p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
m(1) = 0
pdg(2) = 11
p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
m(2) = 0
pdg(3) = 1
p3(1) = pp/2
p3(2) = mw/2
p3(3) = 0
p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
m(3) = 0
p3(2) = -mw/2
pdg(4) = -2
p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
m(4) = 0
pdg(5) = 24
p(5) = vector4_moving (sqrts/2,-pp, 1)
m(5) = mw
call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
call pset%set_momentum (p, m**2)
write (u, "(A)") "* Fill process instance"
write (u, "(A)")
! workflow from event_recalculate
call process_instance%choose_mci (1)
call process_instance%set_trace (pset, 1)
call process_instance%recover &
(1, 1, update_sqme=.true., recover_phs=.false.)
call process_instance%evaluate_event_data (weight = 1._default)
write (u, "(A)") "* Prepare resonant subprocesses"
write (u, "(A)")
call prc_set%prepare_process_objects (global)
call prc_set%prepare_process_instances (global)
write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
write (u, "(A)")
call evt_trivial%connect (process_instance, model)
call evt_trivial%set_particle_set (pset, 1, 1)
call evt_trivial%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize resonance-insertion event transform"
write (u, "(A)")
evt_trivial%next => evt_resonance
evt_resonance%previous => evt_trivial
call evt_resonance%set_resonance_data (res_history_set)
call evt_resonance%select_component (1)
call evt_resonance%connect (process_instance, model)
call prc_set%connect_transform (evt_resonance)
call evt_resonance%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute probabilities for applicable resonances"
write (u, "(A)") " and initialize the process selector"
write (u, "(A)")
on_shell_limit = 10._default
write (u, "(1x,A,1x," // FMT_10 // ")") &
"on_shell_limit =", on_shell_limit
call evt_resonance%set_on_shell_limit (on_shell_limit)
background_factor = 0
write (u, "(1x,A,1x," // FMT_10 // ")") &
"background_factor =", background_factor
call evt_resonance%set_background_factor (background_factor)
write (u, "(A)")
write (u, "(A)") "* Evaluate resonance-insertion event transform"
write (u, "(A)")
call evt_resonance%prepare_new_event (1, 1)
call evt_resonance%generate_weighted (probability)
call evt_resonance%make_particle_set (1, .false.)
call evt_resonance%write (u, testflag=.true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
call syntax_phs_forest_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: restricted_subprocesses_6"
end subroutine restricted_subprocesses_6
@ %def restricted_subprocesses_6
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Simulation}
This module manages simulation: event generation and reading/writing of event
files. The [[simulation]] object is intended to be used (via a pointer)
outside of \whizard, if events are generated individually by an external
driver.
<<[[simulations.f90]]>>=
<<File header>>
module simulations
<<Use kinds>>
<<Use strings>>
use io_units
use format_utils, only: write_separator
use format_defs, only: FMT_15, FMT_19
use os_interface
use numeric_utils
use string_utils, only: str
use diagnostics
use lorentz, only: vector4_t
use sm_qcd
use md5
use variables, only: var_list_t
use eval_trees
use model_data
use flavors
use particles
use state_matrices, only: FM_IGNORE_HELICITY
use beam_structures, only: beam_structure_t
use beams
use rng_base
use rng_stream, only: rng_stream_t
use selectors
use resonances, only: resonance_history_set_t
use process_libraries, only: process_library_t
use process_libraries, only: process_component_def_t
use prc_core
! TODO: (bcn 2016-09-13) should be ideally only pcm_base
use pcm, only: pcm_nlo_t, pcm_instance_nlo_t
! TODO: (bcn 2016-09-13) details of process config should not be necessary here
use process_config, only: COMP_REAL_FIN
use process
use instances
use event_base
use events
use event_transforms
use shower
use eio_data
use eio_base
use rt_data
use dispatch_beams, only: dispatch_qcd
use dispatch_rng, only: dispatch_rng_factory
use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore
use dispatch_transforms, only: dispatch_evt_isr_epa_handler
use dispatch_transforms, only: dispatch_evt_resonance
use dispatch_transforms, only: dispatch_evt_decay
use dispatch_transforms, only: dispatch_evt_shower
use dispatch_transforms, only: dispatch_evt_hadrons
use dispatch_transforms, only: dispatch_evt_nlo
use integrations
use event_streams
use restricted_subprocesses, only: resonant_subprocess_set_t
use restricted_subprocesses, only: get_libname_res
use evt_nlo
<<Use mpi f08>>
<<Standard module head>>
<<Simulations: public>>
<<Simulations: types>>
<<Simulations: interfaces>>
contains
<<Simulations: procedures>>
end module simulations
@ %def simulations
@
\subsection{Event counting}
In this object we collect statistical information about an event
sample or sub-sample.
<<Simulations: types>>=
type :: counter_t
integer :: total = 0
integer :: generated = 0
integer :: read = 0
integer :: positive = 0
integer :: negative = 0
integer :: zero = 0
integer :: excess = 0
real(default) :: max_excess = 0
real(default) :: sum_excess = 0
logical :: reproduce_xsection = .false.
real(default) :: mean = 0
real(default) :: varsq = 0
integer :: nlo_weight_counter = 0
contains
<<Simulations: counter: TBP>>
end type counter_t
@ %def simulation_counter_t
@ Output.
<<Simulations: counter: TBP>>=
procedure :: write => counter_write
<<Simulations: procedures>>=
subroutine counter_write (counter, unit)
class(counter_t), intent(in) :: counter
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
1 format (3x,A,I0)
2 format (5x,A,I0)
3 format (5x,A,ES19.12)
write (u, 1) "Events total = ", counter%total
write (u, 2) "generated = ", counter%generated
write (u, 2) "read = ", counter%read
write (u, 2) "positive weight = ", counter%positive
write (u, 2) "negative weight = ", counter%negative
write (u, 2) "zero weight = ", counter%zero
write (u, 2) "excess weight = ", counter%excess
if (counter%excess /= 0) then
write (u, 3) "max excess = ", counter%max_excess
write (u, 3) "avg excess = ", counter%sum_excess / counter%total
end if
end subroutine counter_write
@ %def counter_write
@ This is a screen message: if there was an excess, display statistics.
<<Simulations: counter: TBP>>=
procedure :: show_excess => counter_show_excess
<<Simulations: procedures>>=
subroutine counter_show_excess (counter)
class(counter_t), intent(in) :: counter
if (counter%excess > 0) then
write (msg_buffer, "(A,1x,I0,1x,A,1x,'(',F7.3,' %)')") &
"Encountered events with excess weight:", counter%excess, &
"events", 100 * counter%excess / real (counter%total)
call msg_warning ()
write (msg_buffer, "(A,ES10.3)") &
"Maximum excess weight =", counter%max_excess
call msg_message ()
write (msg_buffer, "(A,ES10.3)") &
"Average excess weight =", counter%sum_excess / counter%total
call msg_message ()
end if
end subroutine counter_show_excess
@ %def counter_show_excess
@
<<Simulations: counter: TBP>>=
procedure :: show_mean_and_variance => counter_show_mean_and_variance
<<Simulations: procedures>>=
subroutine counter_show_mean_and_variance (counter)
class(counter_t), intent(in) :: counter
if (counter%reproduce_xsection .and. counter%nlo_weight_counter > 1) then
print *, "Reconstructed cross-section from event weights: "
print *, counter%mean, '+-', sqrt (counter%varsq / (counter%nlo_weight_counter - 1))
end if
end subroutine counter_show_mean_and_variance
@ %def counter_show_mean_and_variance
@ Count an event. The weight and event source are optional; by
default we assume that the event has been generated and has positive
weight.
<<Simulations: counter: TBP>>=
procedure :: record => counter_record
<<Simulations: procedures>>=
subroutine counter_record (counter, weight, excess, from_file)
class(counter_t), intent(inout) :: counter
real(default), intent(in), optional :: weight, excess
logical, intent(in), optional :: from_file
counter%total = counter%total + 1
if (present (from_file)) then
if (from_file) then
counter%read = counter%read + 1
else
counter%generated = counter%generated + 1
end if
else
counter%generated = counter%generated + 1
end if
if (present (weight)) then
if (weight > 0) then
counter%positive = counter%positive + 1
else if (weight < 0) then
counter%negative = counter%negative + 1
else
counter%zero = counter%zero + 1
end if
else
counter%positive = counter%positive + 1
end if
if (present (excess)) then
if (excess > 0) then
counter%excess = counter%excess + 1
counter%max_excess = max (counter%max_excess, excess)
counter%sum_excess = counter%sum_excess + excess
end if
end if
end subroutine counter_record
@ %def counter_record
@
<<Simulations: counter: TBP>>=
procedure :: record_mean_and_variance => &
counter_record_mean_and_variance
<<Simulations: procedures>>=
subroutine counter_record_mean_and_variance (counter, weight, i_nlo)
class(counter_t), intent(inout) :: counter
real(default), intent(in) :: weight
integer, intent(in) :: i_nlo
real(default), save :: weight_buffer = 0._default
integer, save :: nlo_count = 1
if (.not. counter%reproduce_xsection) return
if (i_nlo == 1) then
call flush_weight_buffer (weight_buffer, nlo_count)
weight_buffer = weight
nlo_count = 1
else
weight_buffer = weight_buffer + weight
nlo_count = nlo_count + 1
end if
contains
subroutine flush_weight_buffer (w, n_nlo)
real(default), intent(in) :: w
integer, intent(in) :: n_nlo
integer :: n
real(default) :: mean_new
counter%nlo_weight_counter = counter%nlo_weight_counter + 1
!!! Minus 1 to take into account offset from initialization
n = counter%nlo_weight_counter - 1
if (n > 0) then
mean_new = counter%mean + (w / n_nlo - counter%mean) / n
if (n > 1) &
counter%varsq = counter%varsq - counter%varsq / (n - 1) + &
n * (mean_new - counter%mean)**2
counter%mean = mean_new
end if
end subroutine flush_weight_buffer
end subroutine counter_record_mean_and_variance
@ %def counter_record_mean_and_variance
@
\subsection{Simulation: component sets}
For each set of process components that share a MCI entry in the
process configuration, we keep a separate event record.
<<Simulations: types>>=
type :: mci_set_t
private
integer :: n_components = 0
integer, dimension(:), allocatable :: i_component
type(string_t), dimension(:), allocatable :: component_id
logical :: has_integral = .false.
real(default) :: integral = 0
real(default) :: error = 0
real(default) :: weight_mci = 0
type(counter_t) :: counter
contains
<<Simulations: mci set: TBP>>
end type mci_set_t
@ %def mci_set_t
@ Output.
<<Simulations: mci set: TBP>>=
procedure :: write => mci_set_write
<<Simulations: procedures>>=
subroutine mci_set_write (object, unit, pacified)
class(mci_set_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacified
logical :: pacify
integer :: u, i
u = given_output_unit (unit)
pacify = .false.; if (present (pacified)) pacify = pacified
write (u, "(3x,A)") "Components:"
do i = 1, object%n_components
write (u, "(5x,I0,A,A,A)") object%i_component(i), &
": '", char (object%component_id(i)), "'"
end do
if (object%has_integral) then
if (pacify) then
write (u, "(3x,A," // FMT_15 // ")") "Integral = ", object%integral
write (u, "(3x,A," // FMT_15 // ")") "Error = ", object%error
write (u, "(3x,A,F9.6)") "Weight =", object%weight_mci
else
write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
write (u, "(3x,A,F13.10)") "Weight =", object%weight_mci
end if
else
write (u, "(3x,A)") "Integral = [undefined]"
end if
call object%counter%write (u)
end subroutine mci_set_write
@ %def mci_set_write
@ Initialize: Get the indices and names for the process components
that will contribute to this set.
<<Simulations: mci set: TBP>>=
procedure :: init => mci_set_init
<<Simulations: procedures>>=
subroutine mci_set_init (object, i_mci, process)
class(mci_set_t), intent(out) :: object
integer, intent(in) :: i_mci
type(process_t), intent(in), target :: process
integer :: i
call process%get_i_component (i_mci, object%i_component)
object%n_components = size (object%i_component)
allocate (object%component_id (object%n_components))
do i = 1, size (object%component_id)
object%component_id(i) = &
process%get_component_id (object%i_component(i))
end do
if (process%has_integral (i_mci)) then
object%integral = process%get_integral (i_mci)
object%error = process%get_error (i_mci)
object%has_integral = .true.
end if
end subroutine mci_set_init
@ %def mci_set_init
@
\subsection{Process-core Safe}
This is an object that temporarily holds a process core object. We
need this while rescanning a process with modified parameters. After
the rescan, we want to restore the original state.
<<Simulations: types>>=
type :: core_safe_t
class(prc_core_t), allocatable :: core
end type core_safe_t
@ %def core_safe_t
@
\subsection{Process Object}
The simulation works on process objects. This subroutine makes a
process object available for simulation. The process is in the
process stack. [[use_process]] implies that the process should
already exist as an object in the process stack. If integration is
not yet done, do it. Any generated process object should be put on
the global stack, if it is separate from the local one.
<<Simulations: procedures>>=
subroutine prepare_process &
(process, process_id, use_process, integrate, local, global)
type(process_t), pointer, intent(out) :: process
type(string_t), intent(in) :: process_id
logical, intent(in) :: use_process, integrate
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), optional, target :: global
type(rt_data_t), pointer :: current
call msg_debug (D_CORE, "prepare_process")
call msg_debug (D_CORE, "global present", present (global))
if (present (global)) then
current => global
else
current => local
end if
process => current%process_stack%get_process_ptr (process_id)
call msg_debug (D_CORE, "use_process", use_process)
call msg_debug (D_CORE, "associated process", associated (process))
if (use_process .and. .not. associated (process)) then
if (integrate) then
call msg_message ("Simulate: process '" &
// char (process_id) // "' needs integration")
else
call msg_message ("Simulate: process '" &
// char (process_id) // "' needs initialization")
end if
if (present (global)) then
call integrate_process (process_id, local, global, &
init_only = .not. integrate)
else
call integrate_process (process_id, local, &
local_stack = .true., init_only = .not. integrate)
end if
if (signal_is_pending ()) return
process => current%process_stack%get_process_ptr (process_id)
if (associated (process)) then
if (integrate) then
call msg_message ("Simulate: integration done")
call current%process_stack%fill_result_vars (process_id)
else
call msg_message ("Simulate: process initialization done")
end if
else
call msg_fatal ("Simulate: process '" &
// char (process_id) // "' could not be initialized: aborting")
end if
else if (.not. associated (process)) then
if (present (global)) then
call integrate_process (process_id, local, global, &
init_only = .true.)
else
call integrate_process (process_id, local, &
local_stack = .true., init_only = .true.)
end if
process => current%process_stack%get_process_ptr (process_id)
call msg_message &
("Simulate: process '" &
// char (process_id) // "': enabled for rescan only")
end if
end subroutine prepare_process
@ %def prepare_process
@
\subsection{Simulation entry}
For each process that we consider for event generation, we need a
separate entry. The entry separately records the process ID and run ID. The
[[weight_mci]] array is used for selecting a component set (which
shares a MCI record inside the process container) when generating an
event for the current process.
The simulation entry is an extension of the [[event_t]] event record.
This core object contains configuration data, pointers to the process
and process instance, the expressions, flags and values that are
evaluated at runtime, and the resulting particle set.
The entry explicitly allocate the [[process_instance]], which becomes
the process-specific workspace for the event record.
If entries with differing environments are present simultaneously, we
may need to switch QCD parameters and/or the model event by event. In
this case, the [[qcd]] and/or [[model]] components are present.\\
For the puropose of NLO events, [[entry_t]] contains a pointer list
to other simulation-entries. This is due to the fact that we have to
associate an event for each component of the fixed order simulation,
i.e. one $N$-particle event and $N_\alpha$ $N+1$-particle events.
However, all entries share the same event transforms.
<<Simulations: types>>=
type, extends (event_t) :: entry_t
private
type(string_t) :: process_id
type(string_t) :: library
type(string_t) :: run_id
logical :: has_integral = .false.
real(default) :: integral = 0
real(default) :: error = 0
real(default) :: process_weight = 0
logical :: valid = .false.
type(counter_t) :: counter
integer :: n_in = 0
integer :: n_mci = 0
type(mci_set_t), dimension(:), allocatable :: mci_sets
type(selector_t) :: mci_selector
logical :: has_resonant_subprocess_set = .false.
type(resonant_subprocess_set_t) :: resonant_subprocess_set
type(core_safe_t), dimension(:), allocatable :: core_safe
class(model_data_t), pointer :: model => null ()
type(qcd_t) :: qcd
type(entry_t), pointer :: first => null ()
type(entry_t), pointer :: next => null ()
class(evt_t), pointer :: evt_powheg => null ()
contains
<<Simulations: entry: TBP>>
end type entry_t
@ %def entry_t
@ Output. Write just the configuration, the event is written by a
separate routine.
The [[verbose]] option is unused, it is required by the interface of
the base-object method.
<<Simulations: entry: TBP>>=
procedure :: write_config => entry_write_config
<<Simulations: procedures>>=
subroutine entry_write_config (object, unit, pacified)
class(entry_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: pacified
logical :: pacify
integer :: u, i
u = given_output_unit (unit)
pacify = .false.; if (present (pacified)) pacify = pacified
write (u, "(3x,A,A,A)") "Process = '", char (object%process_id), "'"
write (u, "(3x,A,A,A)") "Library = '", char (object%library), "'"
write (u, "(3x,A,A,A)") "Run = '", char (object%run_id), "'"
write (u, "(3x,A,L1)") "is valid = ", object%valid
if (object%has_integral) then
if (pacify) then
write (u, "(3x,A," // FMT_15 // ")") "Integral = ", object%integral
write (u, "(3x,A," // FMT_15 // ")") "Error = ", object%error
write (u, "(3x,A,F9.6)") "Weight =", object%process_weight
else
write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
write (u, "(3x,A,F13.10)") "Weight =", object%process_weight
end if
else
write (u, "(3x,A)") "Integral = [undefined]"
end if
write (u, "(3x,A,I0)") "MCI sets = ", object%n_mci
call object%counter%write (u)
do i = 1, size (object%mci_sets)
write (u, "(A)")
write (u, "(1x,A,I0,A)") "MCI set #", i, ":"
call object%mci_sets(i)%write (u, pacified)
end do
if (object%resonant_subprocess_set%is_active ()) then
write (u, "(A)")
call object%write_resonant_subprocess_data (u)
end if
if (allocated (object%core_safe)) then
do i = 1, size (object%core_safe)
write (u, "(1x,A,I0,A)") "Saved process-component core #", i, ":"
call object%core_safe(i)%core%write (u)
end do
end if
end subroutine entry_write_config
@ %def entry_write_config
@ Finalizer. The [[instance]] pointer component of the [[event_t]]
base type points to a target which we did explicitly allocate in the
[[entry_init]] procedure. Therefore, we finalize and explicitly
deallocate it here. Then we call the finalizer of the base type.
<<Simulations: entry: TBP>>=
procedure :: final => entry_final
<<Simulations: procedures>>=
subroutine entry_final (object)
class(entry_t), intent(inout) :: object
integer :: i
if (associated (object%instance)) then
do i = 1, object%n_mci
call object%instance%final_simulation (i)
end do
call object%instance%final ()
deallocate (object%instance)
end if
call object%event_t%final ()
end subroutine entry_final
@ %def entry_final
@ Copy the content of an entry into another one, except for the next-pointer
<<Simulations: entry: TBP>>=
procedure :: copy_entry => entry_copy_entry
<<Simulations: procedures>>=
subroutine entry_copy_entry (entry1, entry2)
class(entry_t), intent(in), target :: entry1
type(entry_t), intent(inout), target :: entry2
call entry1%event_t%clone (entry2%event_t)
entry2%process_id = entry1%process_id
entry2%library = entry1%library
entry2%run_id = entry1%run_id
entry2%has_integral = entry1%has_integral
entry2%integral = entry1%integral
entry2%error = entry1%error
entry2%process_weight = entry1%process_weight
entry2%valid = entry1%valid
entry2%counter = entry1%counter
entry2%n_in = entry1%n_in
entry2%n_mci = entry1%n_mci
if (allocated (entry1%mci_sets)) then
allocate (entry2%mci_sets (size (entry1%mci_sets)))
entry2%mci_sets = entry1%mci_sets
end if
entry2%mci_selector = entry1%mci_selector
if (allocated (entry1%core_safe)) then
allocate (entry2%core_safe (size (entry1%core_safe)))
entry2%core_safe = entry1%core_safe
end if
entry2%model => entry1%model
entry2%qcd = entry1%qcd
end subroutine entry_copy_entry
@ %def entry_copy_entry
@ Initialization. Search for a process entry and allocate a process
instance as an anonymous object, temporarily accessible via the
[[process_instance]] pointer. Assign data by looking at the process
object and at the environment.
If [[n_alt]] is set, we prepare for additional alternate sqme and weight
entries.
The [[compile]] flag is only false if we don't need the Whizard
process at all, just its definition. In that case, we skip process
initialization.
Otherwise, and if the process object is not found initially: if
[[integrate]] is set, attempt an integration pass and try again.
Otherwise, just initialize the object.
If [[generate]] is set, prepare the MCI objects for generating new events.
For pure rescanning, this is not necessary.
If [[resonance_history]] is set, we create a separate process library
which contains all possible restricted subprocesses with distinct
resonance histories. These processes will not be integrated, but
their matrix element codes are used for determining probabilities of
resonance histories. Note that this can work only if the process
method is OMega, and the phase-space method is 'wood'.
When done, we assign the [[instance]] and [[process]] pointers of the
base type by the [[connect]] method, so we can reference them later.
<<Simulations: entry: TBP>>=
procedure :: init => entry_init
<<Simulations: procedures>>=
subroutine entry_init &
(entry, process_id, &
use_process, integrate, generate, update_sqme, &
support_resonance_history, &
local, global, n_alt)
class(entry_t), intent(inout), target :: entry
type(string_t), intent(in) :: process_id
logical, intent(in) :: use_process, integrate, generate, update_sqme
logical, intent(in) :: support_resonance_history
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), optional, target :: global
integer, intent(in), optional :: n_alt
type(process_t), pointer :: process, master_process
type(process_instance_t), pointer :: process_instance
type(process_library_t), pointer :: prclib_saved
integer :: i
logical :: res_include_trivial
logical :: combined_integration
integer :: selected_mci
selected_mci = 0
call msg_debug (D_CORE, "entry_init")
call msg_debug (D_CORE, "process_id", process_id)
call prepare_process &
(master_process, process_id, use_process, integrate, local, global)
if (signal_is_pending ()) return
if (associated (master_process)) then
if (.not. master_process%has_matrix_element ()) then
entry%has_integral = .true.
entry%process_id = process_id
entry%valid = .false.
return
end if
else
call entry%basic_init (local%var_list)
entry%has_integral = .false.
entry%process_id = process_id
call entry%import_process_def_characteristics (local%prclib, process_id)
entry%valid = .true.
return
end if
call entry%basic_init (local%var_list, n_alt)
entry%process_id = process_id
if (generate .or. integrate) then
entry%run_id = master_process%get_run_id ()
process => master_process
else
call local%set_log (var_str ("?rebuild_phase_space"), &
.false., is_known = .true.)
call local%set_log (var_str ("?check_phs_file"), &
.false., is_known = .true.)
call local%set_log (var_str ("?rebuild_grids"), &
.false., is_known = .true.)
entry%run_id = &
local%var_list%get_sval (var_str ("$run_id"))
if (update_sqme) then
call prepare_local_process (process, process_id, local)
else
process => master_process
end if
end if
call entry%import_process_characteristics (process)
allocate (entry%mci_sets (entry%n_mci))
do i = 1, size (entry%mci_sets)
call entry%mci_sets(i)%init (i, master_process)
end do
call entry%import_process_results (master_process)
call entry%prepare_expressions (local)
if (process%is_nlo_calculation ()) call process%init_nlo_settings (global%var_list)
combined_integration = local%get_lval (var_str ("?combined_nlo_integration"))
if (.not. combined_integration &
.and. local%get_lval (var_str ("?fixed_order_nlo_events"))) &
selected_mci = process%extract_active_component_mci ()
call prepare_process_instance (process_instance, process, local%model, &
local = local)
if (generate) then
if (selected_mci > 0) then
call process%prepare_simulation (selected_mci)
call process_instance%init_simulation (selected_mci, entry%config%safety_factor, &
local%get_lval (var_str ("?keep_failed_events")))
else
do i = 1, entry%n_mci
call process%prepare_simulation (i)
call process_instance%init_simulation (i, entry%config%safety_factor, &
local%get_lval (var_str ("?keep_failed_events")))
end do
end if
end if
if (support_resonance_history) then
prclib_saved => local%prclib
call entry%setup_resonant_subprocesses (local, process)
if (entry%has_resonant_subprocess_set) then
if (signal_is_pending ()) return
call entry%compile_resonant_subprocesses (local)
if (signal_is_pending ()) return
call entry%prepare_resonant_subprocesses (local, global)
if (signal_is_pending ()) return
call entry%prepare_resonant_subprocess_instances (local)
end if
if (signal_is_pending ()) return
if (associated (prclib_saved)) call local%update_prclib (prclib_saved)
end if
call entry%setup_event_transforms (process, local)
call dispatch_qcd (entry%qcd, local%get_var_list_ptr (), local%os_data)
call entry%connect_qcd ()
select type (pcm => process_instance%pcm)
class is (pcm_instance_nlo_t)
select type (config => pcm%config)
type is (pcm_nlo_t)
if (config%settings%fixed_order_nlo) &
call pcm%set_fixed_order_event_mode ()
end select
end select
if (present (global)) then
call entry%connect (process_instance, local%model, global%process_stack)
else
call entry%connect (process_instance, local%model, local%process_stack)
end if
call entry%setup_expressions ()
entry%model => process%get_model_ptr ()
entry%valid = .true.
end subroutine entry_init
@ %def entry_init
@
<<Simulations: entry: TBP>>=
procedure :: set_active_real_components => entry_set_active_real_components
<<Simulations: procedures>>=
subroutine entry_set_active_real_components (entry)
class(entry_t), intent(inout) :: entry
integer :: i_active_real
select type (pcm => entry%instance%pcm)
class is (pcm_instance_nlo_t)
i_active_real = entry%instance%get_real_of_mci ()
call msg_debug2 (D_CORE, "i_active_real", i_active_real)
if (associated (entry%evt_powheg)) then
select type (evt => entry%evt_powheg)
type is (evt_shower_t)
if (entry%process%get_component_type(i_active_real) == COMP_REAL_FIN) then
call msg_debug (D_CORE, "Disabling Powheg matching for ", i_active_real)
call evt%disable_powheg_matching ()
else
call msg_debug (D_CORE, "Enabling Powheg matching for ", i_active_real)
call evt%enable_powheg_matching ()
end if
class default
call msg_fatal ("powheg-evt should be evt_shower_t!")
end select
end if
end select
end subroutine entry_set_active_real_components
@ %def entry_set_active_real_components
@ Part of simulation-entry initialization: set up a process object for
local use.
<<Simulations: procedures>>=
subroutine prepare_local_process (process, process_id, local)
type(process_t), pointer, intent(inout) :: process
type(string_t), intent(in) :: process_id
type(rt_data_t), intent(inout), target :: local
type(integration_t) :: intg
call intg%create_process (process_id)
call intg%init_process (local)
call intg%setup_process (local, verbose=.false.)
process => intg%get_process_ptr ()
end subroutine prepare_local_process
@ %def prepare_local_process
@ Part of simulation-entry initialization: set up a process instance
matching the selected process object.
The model that we can provide as an extra argument can modify particle
settings (polarization) in the density matrices that will be constructed. It
does not affect parameters.
<<Simulations: procedures>>=
subroutine prepare_process_instance &
(process_instance, process, model, local)
type(process_instance_t), pointer, intent(inout) :: process_instance
type(process_t), intent(inout), target :: process
class(model_data_t), intent(in), optional :: model
type(rt_data_t), intent(in), optional, target :: local
allocate (process_instance)
call process_instance%init (process)
if (process%is_nlo_calculation ()) then
select type (pcm => process_instance%pcm)
type is (pcm_instance_nlo_t)
select type (config => pcm%config)
type is (pcm_nlo_t)
if (.not. config%settings%combined_integration) &
call pcm%set_radiation_event ()
end select
end select
if (process%needs_extra_code () .and. present (local)) then
call process%create_and_load_extra_libraries &
(local%beam_structure, process%get_var_list_ptr (), &
local%os_data)
end if
end if
call process_instance%setup_event_data (model)
end subroutine prepare_process_instance
@ %def prepare_process_instance
@ Part of simulation-entry initialization: query the
process for basic information.
<<Simulations: entry: TBP>>=
procedure, private :: import_process_characteristics &
=> entry_import_process_characteristics
<<Simulations: procedures>>=
subroutine entry_import_process_characteristics (entry, process)
class(entry_t), intent(inout) :: entry
type(process_t), intent(in), target :: process
entry%library = process%get_library_name ()
entry%n_in = process%get_n_in ()
entry%n_mci = process%get_n_mci ()
end subroutine entry_import_process_characteristics
@ %def entry_import_process_characteristics
@ This is the alternative form which applies if there is no process
entry, but just a process definition which we take from the provided
[[prclib]] definition library.
<<Simulations: entry: TBP>>=
procedure, private :: import_process_def_characteristics &
=> entry_import_process_def_characteristics
<<Simulations: procedures>>=
subroutine entry_import_process_def_characteristics (entry, prclib, id)
class(entry_t), intent(inout) :: entry
type(process_library_t), intent(in), target :: prclib
type(string_t), intent(in) :: id
entry%library = prclib%get_name ()
entry%n_in = prclib%get_n_in (id)
end subroutine entry_import_process_def_characteristics
@ %def entry_import_process_def_characteristics
@ Part of simulation-entry initialization: query the
process for integration results.
<<Simulations: entry: TBP>>=
procedure, private :: import_process_results &
=> entry_import_process_results
<<Simulations: procedures>>=
subroutine entry_import_process_results (entry, process)
class(entry_t), intent(inout) :: entry
type(process_t), intent(in), target :: process
if (process%has_integral ()) then
entry%integral = process%get_integral ()
entry%error = process%get_error ()
call entry%set_sigma (entry%integral)
entry%has_integral = .true.
end if
end subroutine entry_import_process_results
@ %def entry_import_process_characteristics
@ Part of simulation-entry initialization: create expression factory
objects and store them.
<<Simulations: entry: TBP>>=
procedure, private :: prepare_expressions &
=> entry_prepare_expressions
<<Simulations: procedures>>=
subroutine entry_prepare_expressions (entry, local)
class(entry_t), intent(inout) :: entry
type(rt_data_t), intent(in), target :: local
type(eval_tree_factory_t) :: expr_factory
call expr_factory%init (local%pn%selection_lexpr)
call entry%set_selection (expr_factory)
call expr_factory%init (local%pn%reweight_expr)
call entry%set_reweight (expr_factory)
call expr_factory%init (local%pn%analysis_lexpr)
call entry%set_analysis (expr_factory)
end subroutine entry_prepare_expressions
@ %def entry_prepare_expressions
@ Initializes the list of additional NLO entries. The routine gets the
information about how many entries to associate from [[region_data]].
<<Simulations: entry: TBP>>=
procedure :: setup_additional_entries => entry_setup_additional_entries
<<Simulations: procedures>>=
subroutine entry_setup_additional_entries (entry)
class(entry_t), intent(inout), target :: entry
type(entry_t), pointer :: current_entry
integer :: i, n_phs
type(evt_nlo_t), pointer :: evt
integer :: mode
evt => null ()
select type (pcm => entry%instance%pcm)
class is (pcm_instance_nlo_t)
select type (config => pcm%config)
type is (pcm_nlo_t)
n_phs = config%region_data%n_phs
end select
end select
select type (entry)
type is (entry_t)
current_entry => entry
current_entry%first => entry
call get_nlo_evt_ptr (current_entry, evt, mode)
if (mode > EVT_NLO_SEPARATE_BORNLIKE) then
allocate (evt%particle_set_radiated (n_phs + 1))
evt%event_deps%n_phs = n_phs
evt%qcd => entry%qcd
do i = 1, n_phs
allocate (current_entry%next)
current_entry%next%first => current_entry%first
current_entry => current_entry%next
call entry%copy_entry (current_entry)
current_entry%i_event = i
end do
else
allocate (evt%particle_set_radiated (1))
end if
end select
contains
subroutine get_nlo_evt_ptr (entry, evt, mode)
type(entry_t), intent(in), target :: entry
type(evt_nlo_t), intent(out), pointer :: evt
integer, intent(out) :: mode
class(evt_t), pointer :: current_evt
evt => null ()
current_evt => entry%transform_first
do
select type (current_evt)
type is (evt_nlo_t)
evt => current_evt
mode = evt%mode
exit
end select
if (associated (current_evt%next)) then
current_evt => current_evt%next
else
call msg_fatal ("evt_nlo not in list of event transforms")
end if
end do
end subroutine get_nlo_evt_ptr
end subroutine entry_setup_additional_entries
@ %def entry_setup_additional_entries
@
<<Simulations: entry: TBP>>=
procedure :: get_first => entry_get_first
<<Simulations: procedures>>=
function entry_get_first (entry) result (entry_out)
class(entry_t), intent(in), target :: entry
type(entry_t), pointer :: entry_out
entry_out => null ()
select type (entry)
type is (entry_t)
if (entry%is_nlo ()) then
entry_out => entry%first
else
entry_out => entry
end if
end select
end function entry_get_first
@ %def entry_get_first
@
<<Simulations: entry: TBP>>=
procedure :: get_next => entry_get_next
<<Simulations: procedures>>=
function entry_get_next (entry) result (next_entry)
class(entry_t), intent(in) :: entry
type(entry_t), pointer :: next_entry
next_entry => null ()
if (associated (entry%next)) then
next_entry => entry%next
else
call msg_fatal ("Get next entry: No next entry")
end if
end function entry_get_next
@ %def entry_get_next
@
<<Simulations: entry: TBP>>=
procedure :: count_nlo_entries => entry_count_nlo_entries
<<Simulations: procedures>>=
function entry_count_nlo_entries (entry) result (n)
class(entry_t), intent(in), target :: entry
integer :: n
type(entry_t), pointer :: current_entry
n = 1
if (.not. associated (entry%next)) then
return
else
current_entry => entry%next
do
n = n + 1
if (.not. associated (current_entry%next)) exit
current_entry => current_entry%next
end do
end if
end function entry_count_nlo_entries
@ %def entry_count_nlo_entries
@
<<Simulations: entry: TBP>>=
procedure :: reset_nlo_counter => entry_reset_nlo_counter
<<Simulations: procedures>>=
subroutine entry_reset_nlo_counter (entry)
class(entry_t), intent(inout) :: entry
class(evt_t), pointer :: evt
evt => entry%transform_first
do
select type (evt)
type is (evt_nlo_t)
evt%i_evaluation = 0
exit
end select
if (associated (evt%next)) evt => evt%next
end do
end subroutine entry_reset_nlo_counter
@ %def entry_reset_nlo_counter
@
<<Simulations: entry: TBP>>=
procedure :: determine_if_powheg_matching => entry_determine_if_powheg_matching
<<Simulations: procedures>>=
subroutine entry_determine_if_powheg_matching (entry)
class(entry_t), intent(inout) :: entry
class(evt_t), pointer :: current_transform
if (associated (entry%transform_first)) then
current_transform => entry%transform_first
do
select type (current_transform)
type is (evt_shower_t)
if (current_transform%contains_powheg_matching ()) &
entry%evt_powheg => current_transform
exit
end select
if (associated (current_transform%next)) then
current_transform => current_transform%next
else
exit
end if
end do
end if
end subroutine entry_determine_if_powheg_matching
@ %def entry_determine_if_powheg_matching
@ Part of simulation-entry initialization: dispatch event transforms
(decay, shower) as requested. If a transform is not applicable or
switched off via some variable, it will be skipped.
Regarding resonances/decays: these two transforms are currently mutually
exclusive. Resonance insertion will not be applied if there is an
unstable particle in the game.
<<Simulations: entry: TBP>>=
procedure, private :: setup_event_transforms &
=> entry_setup_event_transforms
<<Simulations: procedures>>=
subroutine entry_setup_event_transforms (entry, process, local)
class(entry_t), intent(inout) :: entry
type(process_t), intent(inout), target :: process
type(rt_data_t), intent(in), target :: local
class(evt_t), pointer :: evt
type(var_list_t), pointer :: var_list
logical :: enable_isr_handler
logical :: enable_epa_handler
logical :: enable_fixed_order
logical :: enable_shower
var_list => local%get_var_list_ptr ()
enable_isr_handler = local%get_lval (var_str ("?isr_handler"))
enable_epa_handler = local%get_lval (var_str ("?epa_handler"))
if (enable_isr_handler .or. enable_epa_handler) then
call dispatch_evt_isr_epa_handler (evt, local%var_list)
if (associated (evt)) call entry%import_transform (evt)
end if
if (process%contains_unstable (local%model)) then
call dispatch_evt_decay (evt, local%var_list)
if (associated (evt)) call entry%import_transform (evt)
else if (entry%resonant_subprocess_set%is_active ()) then
call dispatch_evt_resonance (evt, local%var_list, &
entry%resonant_subprocess_set%get_resonance_history_set (), &
entry%resonant_subprocess_set%get_libname ())
if (associated (evt)) then
call entry%resonant_subprocess_set%connect_transform (evt)
call entry%resonant_subprocess_set%set_on_shell_limit &
(local%get_rval (var_str ("resonance_on_shell_limit")))
call entry%resonant_subprocess_set%set_on_shell_turnoff &
(local%get_rval (var_str ("resonance_on_shell_turnoff")))
call entry%resonant_subprocess_set%set_background_factor &
(local%get_rval (var_str ("resonance_background_factor")))
call entry%import_transform (evt)
end if
end if
enable_fixed_order = local%get_lval (var_str ("?fixed_order_nlo_events"))
if (enable_fixed_order) then
if (local%get_lval (var_str ("?unweighted"))) &
call msg_fatal ("NLO Fixed Order events have to be generated with &
&?unweighted = false")
call dispatch_evt_nlo (evt, local%get_lval (var_str ("?keep_failed_events")))
call entry%import_transform (evt)
end if
enable_shower = local%get_lval (var_str ("?allow_shower")) .and. &
(local%get_lval (var_str ("?ps_isr_active")) &
.or. local%get_lval (var_str ("?ps_fsr_active")) &
.or. local%get_lval (var_str ("?muli_active")) &
.or. local%get_lval (var_str ("?mlm_matching")) &
.or. local%get_lval (var_str ("?ckkw_matching")) &
.or. local%get_lval (var_str ("?powheg_matching")))
if (enable_shower) then
call dispatch_evt_shower (evt, var_list, local%model, &
local%fallback_model, local%os_data, local%beam_structure, &
process)
call entry%import_transform (evt)
end if
if (local%get_lval (var_str ("?hadronization_active"))) then
call dispatch_evt_hadrons (evt, var_list, local%fallback_model)
call entry%import_transform (evt)
end if
end subroutine entry_setup_event_transforms
@ %def entry_setup_event_transforms
@ Compute weights. The integral in the argument is the sum of integrals for
all processes in the sample. After computing the process weights, we repeat
the normalization procedure for the process components.
<<Simulations: entry: TBP>>=
procedure :: init_mci_selector => entry_init_mci_selector
<<Simulations: procedures>>=
subroutine entry_init_mci_selector (entry, negative_weights)
class(entry_t), intent(inout), target :: entry
logical, intent(in), optional :: negative_weights
type(entry_t), pointer :: current_entry
integer :: i, j, k
call msg_debug (D_CORE, "entry_init_mci_selector")
if (entry%has_integral) then
select type (entry)
type is (entry_t)
current_entry => entry
do j = 1, current_entry%count_nlo_entries ()
if (j > 1) current_entry => current_entry%get_next ()
do k = 1, size(current_entry%mci_sets%integral)
call msg_debug (D_CORE, "current_entry%mci_sets(k)%integral", &
current_entry%mci_sets(k)%integral)
end do
call current_entry%mci_selector%init &
(current_entry%mci_sets%integral, negative_weights)
do i = 1, current_entry%n_mci
current_entry%mci_sets(i)%weight_mci = &
current_entry%mci_selector%get_weight (i)
end do
end do
end select
end if
end subroutine entry_init_mci_selector
@ %def entry_init_mci_selector
@ Select a MCI entry, using the embedded random-number generator.
<<Simulations: entry: TBP>>=
procedure :: select_mci => entry_select_mci
<<Simulations: procedures>>=
function entry_select_mci (entry) result (i_mci)
class(entry_t), intent(inout) :: entry
integer :: i_mci
call msg_debug2 (D_CORE, "entry_select_mci")
i_mci = entry%process%extract_active_component_mci ()
if (i_mci == 0) call entry%mci_selector%generate (entry%rng, i_mci)
call msg_debug2 (D_CORE, "i_mci", i_mci)
end function entry_select_mci
@ %def entry_select_mci
@ Record an event for this entry, i.e., increment the appropriate counters.
<<Simulations: entry: TBP>>=
procedure :: record => entry_record
<<Simulations: procedures>>=
subroutine entry_record (entry, i_mci, from_file)
class(entry_t), intent(inout) :: entry
integer, intent(in) :: i_mci
logical, intent(in), optional :: from_file
real(default) :: weight, excess
weight = entry%get_weight_prc ()
excess = entry%get_excess_prc ()
call entry%counter%record (weight, excess, from_file)
if (i_mci > 0) then
call entry%mci_sets(i_mci)%counter%record (weight, excess)
end if
end subroutine entry_record
@ %def entry_record
@ Update and restore the process core that this entry accesses, when
parameters change. If explicit arguments [[model]], [[qcd]], or
[[helicity_selection]] are provided, use those. Otherwise use the
parameters stored in the process object.
<<Simulations: entry: TBP>>=
procedure :: update_process => entry_update_process
procedure :: restore_process => entry_restore_process
<<Simulations: procedures>>=
subroutine entry_update_process &
(entry, model, qcd, helicity_selection)
class(entry_t), intent(inout) :: entry
class(model_data_t), intent(in), optional, target :: model
type(qcd_t), intent(in), optional :: qcd
type(helicity_selection_t), intent(in), optional :: helicity_selection
type(process_t), pointer :: process
class(prc_core_t), allocatable :: core
integer :: i, n_terms
class(model_data_t), pointer :: model_local
type(qcd_t) :: qcd_local
if (present (model)) then
model_local => model
else
model_local => entry%model
end if
if (present (qcd)) then
qcd_local = qcd
else
qcd_local = entry%qcd
end if
process => entry%get_process_ptr ()
n_terms = process%get_n_terms ()
allocate (entry%core_safe (n_terms))
do i = 1, n_terms
if (process%has_matrix_element (i, is_term_index = .true.)) then
call process%extract_core (i, core)
call dispatch_core_update (core, &
model_local, helicity_selection, qcd_local, &
entry%core_safe(i)%core)
call process%restore_core (i, core)
end if
end do
end subroutine entry_update_process
subroutine entry_restore_process (entry)
class(entry_t), intent(inout) :: entry
type(process_t), pointer :: process
class(prc_core_t), allocatable :: core
integer :: i, n_terms
process => entry%get_process_ptr ()
n_terms = process%get_n_terms ()
do i = 1, n_terms
if (process%has_matrix_element (i, is_term_index = .true.)) then
call process%extract_core (i, core)
call dispatch_core_restore (core, entry%core_safe(i)%core)
call process%restore_core (i, core)
end if
end do
deallocate (entry%core_safe)
end subroutine entry_restore_process
@ %def entry_update_process
@ %def entry_restore_process
<<Simulations: entry: TBP>>=
procedure :: connect_qcd => entry_connect_qcd
<<Simulations: procedures>>=
subroutine entry_connect_qcd (entry)
class(entry_t), intent(inout), target :: entry
class(evt_t), pointer :: evt
evt => entry%transform_first
do while (associated (evt))
select type (evt)
type is (evt_shower_t)
evt%qcd => entry%qcd
if (allocated (evt%matching)) then
evt%matching%qcd => entry%qcd
end if
end select
evt => evt%next
end do
end subroutine entry_connect_qcd
@ %def entry_connect_qcd
@
\subsection{Handling resonant subprocesses}
Resonant subprocesses are required if we want to determine resonance histories
when generating events. The feature is optional, to be switched on by
the user.
This procedure initializes a new, separate process library that
contains copies of the current process, restricted to the relevant
resonance histories. (If this library exists already, it is just
kept.) The histories can be extracted from the process object.
The code has to match the assignments in
[[create_resonant_subprocess_library]]. The library may already
exist -- in that case, here it will be recovered without recompilation.
<<Simulations: entry: TBP>>=
procedure :: setup_resonant_subprocesses &
=> entry_setup_resonant_subprocesses
<<Simulations: procedures>>=
subroutine entry_setup_resonant_subprocesses (entry, global, process)
class(entry_t), intent(inout) :: entry
type(rt_data_t), intent(inout), target :: global
type(process_t), intent(in), target :: process
type(string_t) :: libname
type(resonance_history_set_t) :: res_history_set
type(process_library_t), pointer :: lib
type(process_component_def_t), pointer :: process_component_def
logical :: req_resonant, library_exist
integer :: i_component
libname = process%get_library_name ()
lib => global%prclib_stack%get_library_ptr (libname)
entry%has_resonant_subprocess_set = lib%req_resonant (process%get_id ())
if (entry%has_resonant_subprocess_set) then
libname = get_libname_res (process%get_id ())
call entry%resonant_subprocess_set%init (process%get_n_components ())
call entry%resonant_subprocess_set%create_library &
(libname, global, library_exist)
do i_component = 1, process%get_n_components ()
call process%extract_resonance_history_set &
(res_history_set, i_component = i_component)
call entry%resonant_subprocess_set%fill_resonances &
(res_history_set, i_component)
if (.not. library_exist) then
process_component_def &
=> process%get_component_def_ptr (i_component)
call entry%resonant_subprocess_set%add_to_library &
(i_component, &
process_component_def%get_prt_spec_in (), &
process_component_def%get_prt_spec_out (), &
global)
end if
end do
call entry%resonant_subprocess_set%freeze_library (global)
end if
end subroutine entry_setup_resonant_subprocesses
@ %def entry_setup_resonant_subprocesses
@ Compile the resonant-subprocesses library. The library is assumed
to be the current library in the [[global]] object. This is a simple wrapper.
<<Simulations: entry: TBP>>=
procedure :: compile_resonant_subprocesses &
=> entry_compile_resonant_subprocesses
<<Simulations: procedures>>=
subroutine entry_compile_resonant_subprocesses (entry, global)
class(entry_t), intent(inout) :: entry
type(rt_data_t), intent(inout), target :: global
call entry%resonant_subprocess_set%compile_library (global)
end subroutine entry_compile_resonant_subprocesses
@ %def entry_compile_resonant_subprocesses
@ Prepare process objects for the resonant-subprocesses library. The
process objects are appended to the global process stack. We
initialize the processes, such that we can evaluate matrix elements,
but we do not need to integrate them.
<<Simulations: entry: TBP>>=
procedure :: prepare_resonant_subprocesses &
=> entry_prepare_resonant_subprocesses
<<Simulations: procedures>>=
subroutine entry_prepare_resonant_subprocesses (entry, local, global)
class(entry_t), intent(inout) :: entry
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), optional, target :: global
call entry%resonant_subprocess_set%prepare_process_objects (local, global)
end subroutine entry_prepare_resonant_subprocesses
@ %def entry_prepare_resonant_subprocesses
@ Prepare process instances. They are linked to their corresponding process
objects. Both, process and instance objects, are allocated as anonymous
targets inside the [[resonant_subprocess_set]] component.
NOTE: those anonymous object are likely forgotten during finalization of the
parent [[event_t]] (extended as [[entry_t]]) object. This should be checked!
The memory leak is probably harmless as long as the event object is created
once per run, not once per event.
<<Simulations: entry: TBP>>=
procedure :: prepare_resonant_subprocess_instances &
=> entry_prepare_resonant_subprocess_instances
<<Simulations: procedures>>=
subroutine entry_prepare_resonant_subprocess_instances (entry, global)
class(entry_t), intent(inout) :: entry
type(rt_data_t), intent(in), target :: global
call entry%resonant_subprocess_set%prepare_process_instances (global)
end subroutine entry_prepare_resonant_subprocess_instances
@ %def entry_prepare_resonant_subprocess_instances
@ Display the resonant subprocesses. This includes, upon request, the
resonance set that defines those subprocess, and a short or long account of the
process objects themselves.
<<Simulations: entry: TBP>>=
procedure :: write_resonant_subprocess_data &
=> entry_write_resonant_subprocess_data
<<Simulations: procedures>>=
subroutine entry_write_resonant_subprocess_data (entry, unit)
class(entry_t), intent(in) :: entry
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
call entry%resonant_subprocess_set%write (unit)
write (u, "(1x,A,I0)") "Resonant subprocesses refer to &
&process component #", 1
end subroutine entry_write_resonant_subprocess_data
@ %def entry_write_resonant_subprocess_data
@ Display of the master process for the current event, for diagnostics.
<<Simulations: entry: TBP>>=
procedure :: write_process_data => entry_write_process_data
<<Simulations: procedures>>=
subroutine entry_write_process_data &
(entry, unit, show_process, show_instance, verbose)
class(entry_t), intent(in) :: entry
integer, intent(in), optional :: unit
logical, intent(in), optional :: show_process
logical, intent(in), optional :: show_instance
logical, intent(in), optional :: verbose
integer :: u, i
logical :: s_proc, s_inst, verb
type(process_t), pointer :: process
type(process_instance_t), pointer :: instance
u = given_output_unit (unit)
s_proc = .false.; if (present (show_process)) s_proc = show_process
s_inst = .false.; if (present (show_instance)) s_inst = show_instance
verb = .false.; if (present (verbose)) verb = verbose
if (s_proc .or. s_inst) then
write (u, "(1x,A,':')") "Process data"
if (s_proc) then
process => entry%process
if (associated (process)) then
if (verb) then
call write_separator (u, 2)
call process%write (.false., u)
else
call process%show (u, verbose=.false.)
end if
else
write (u, "(3x,A)") "[not associated]"
end if
end if
if (s_inst) then
instance => entry%instance
if (associated (instance)) then
if (verb) then
call instance%write (u)
else
call instance%write_header (u)
end if
else
write (u, "(3x,A)") "Process instance: [not associated]"
end if
end if
end if
end subroutine entry_write_process_data
@ %def entry_write_process_data
@
\subsection{Entries for alternative environment}
Entries for alternate environments. [No additional components
anymore, so somewhat redundant.]
<<Simulations: types>>=
type, extends (entry_t) :: alt_entry_t
contains
<<Simulations: alt entry: TBP>>
end type alt_entry_t
@ %def alt_entry_t
The alternative entries are there to re-evaluate the event, given
momenta, in a different context.
Therefore, we allocate a local process object and use this as the
reference for the local process instance, when initializing the entry.
We temporarily import the [[process]] object into an [[integration_t]]
wrapper, to take advantage of the associated methods. The local
process object is built in the context of the current environment,
here called [[global]]. Then, we initialize the process instance.
The [[master_process]] object contains the integration results to which we
refer when recalculating an event. Therefore, we use this object instead of
the locally built [[process]] when we extract the integration results.
The locally built [[process]] object should be finalized when done. It
remains accessible via the [[event_t]] base object of [[entry]], which
contains pointers to the process and instance.
<<Simulations: alt entry: TBP>>=
procedure :: init_alt => alt_entry_init
<<Simulations: procedures>>=
subroutine alt_entry_init (entry, process_id, master_process, local)
class(alt_entry_t), intent(inout), target :: entry
type(string_t), intent(in) :: process_id
type(process_t), intent(in), target :: master_process
type(rt_data_t), intent(inout), target :: local
type(process_t), pointer :: process
type(process_instance_t), pointer :: process_instance
type(string_t) :: run_id
integer :: i
call msg_message ("Simulate: initializing alternate process setup ...")
run_id = &
local%var_list%get_sval (var_str ("$run_id"))
call local%set_log (var_str ("?rebuild_phase_space"), &
.false., is_known = .true.)
call local%set_log (var_str ("?check_phs_file"), &
.false., is_known = .true.)
call local%set_log (var_str ("?rebuild_grids"), &
.false., is_known = .true.)
call entry%basic_init (local%var_list)
call prepare_local_process (process, process_id, local)
entry%process_id = process_id
entry%run_id = run_id
call entry%import_process_characteristics (process)
allocate (entry%mci_sets (entry%n_mci))
do i = 1, size (entry%mci_sets)
call entry%mci_sets(i)%init (i, master_process)
end do
call entry%import_process_results (master_process)
call entry%prepare_expressions (local)
call prepare_process_instance (process_instance, process, local%model)
call entry%setup_event_transforms (process, local)
call entry%connect (process_instance, local%model, local%process_stack)
call entry%setup_expressions ()
entry%model => process%get_model_ptr ()
call msg_message ("... alternate process setup complete.")
end subroutine alt_entry_init
@ %def alt_entry_init
@ Copy the particle set from the master entry to the alternate entry.
This is the particle set of the hard process.
<<Simulations: alt entry: TBP>>=
procedure :: fill_particle_set => entry_fill_particle_set
<<Simulations: procedures>>=
subroutine entry_fill_particle_set (alt_entry, entry)
class(alt_entry_t), intent(inout) :: alt_entry
class(entry_t), intent(in), target :: entry
type(particle_set_t) :: pset
call entry%get_hard_particle_set (pset)
call alt_entry%set_hard_particle_set (pset)
call pset%final ()
end subroutine entry_fill_particle_set
@ %def particle_set_copy_prt
@
\subsection{The simulation type}
Each simulation object corresponds to an event sample, identified by
the [[sample_id]].
The simulation may cover several processes simultaneously. All
process-specific data, including the event records, are stored in the
[[entry]] subobjects. The [[current]] index indicates which record
was selected last. [[version]] is foreseen to contain a tag on the \whizard\
event file version. It can be
<<Simulations: public>>=
public :: simulation_t
<<Simulations: types>>=
type :: simulation_t
private
type(rt_data_t), pointer :: local => null ()
type(string_t) :: sample_id
logical :: unweighted = .true.
logical :: negative_weights = .false.
logical :: support_resonance_history = .false.
logical :: respect_selection = .true.
integer :: norm_mode = NORM_UNDEFINED
logical :: update_sqme = .false.
logical :: update_weight = .false.
logical :: update_event = .false.
logical :: recover_beams = .false.
logical :: pacify = .false.
integer :: n_max_tries = 10000
integer :: n_prc = 0
integer :: n_alt = 0
logical :: has_integral = .false.
logical :: valid = .false.
real(default) :: integral = 0
real(default) :: error = 0
integer :: version = 1
character(32) :: md5sum_prc = ""
character(32) :: md5sum_cfg = ""
character(32), dimension(:), allocatable :: md5sum_alt
type(entry_t), dimension(:), allocatable :: entry
type(alt_entry_t), dimension(:,:), allocatable :: alt_entry
type(selector_t) :: process_selector
integer :: n_evt_requested = 0
integer :: event_index_offset = 0
logical :: event_index_set = .false.
integer :: event_index = 0
integer :: split_n_evt = 0
integer :: split_n_kbytes = 0
integer :: split_index = 0
type(counter_t) :: counter
class(rng_t), allocatable :: rng
integer :: i_prc = 0
integer :: i_mci = 0
real(default) :: weight = 0
real(default) :: excess = 0
contains
<<Simulations: simulation: TBP>>
end type simulation_t
@ %def simulation_t
@ Output. [[write_config]] writes just the configuration. [[write]]
as a method of the base type [[event_t]]
writes the current event and process instance, depending on options.
<<Simulations: simulation: TBP>>=
procedure :: write => simulation_write
<<Simulations: procedures>>=
subroutine simulation_write (object, unit, testflag)
class(simulation_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: testflag
logical :: pacified
integer :: u, i
u = given_output_unit (unit)
pacified = object%pacify; if (present (testflag)) pacified = testflag
call write_separator (u, 2)
write (u, "(1x,A,A,A)") "Event sample: '", char (object%sample_id), "'"
write (u, "(3x,A,I0)") "Processes = ", object%n_prc
if (object%n_alt > 0) then
write (u, "(3x,A,I0)") "Alt.wgts = ", object%n_alt
end if
write (u, "(3x,A,L1)") "Unweighted = ", object%unweighted
write (u, "(3x,A,A)") "Event norm = ", &
char (event_normalization_string (object%norm_mode))
write (u, "(3x,A,L1)") "Neg. weights = ", object%negative_weights
write (u, "(3x,A,L1)") "Res. history = ", object%support_resonance_history
write (u, "(3x,A,L1)") "Respect sel. = ", object%respect_selection
write (u, "(3x,A,L1)") "Update sqme = ", object%update_sqme
write (u, "(3x,A,L1)") "Update wgt = ", object%update_weight
write (u, "(3x,A,L1)") "Update event = ", object%update_event
write (u, "(3x,A,L1)") "Recov. beams = ", object%recover_beams
write (u, "(3x,A,L1)") "Pacify = ", object%pacify
write (u, "(3x,A,I0)") "Max. tries = ", object%n_max_tries
if (object%has_integral) then
if (pacified) then
write (u, "(3x,A," // FMT_15 // ")") &
"Integral = ", object%integral
write (u, "(3x,A," // FMT_15 // ")") &
"Error = ", object%error
else
write (u, "(3x,A," // FMT_19 // ")") &
"Integral = ", object%integral
write (u, "(3x,A," // FMT_19 // ")") &
"Error = ", object%error
end if
else
write (u, "(3x,A)") "Integral = [undefined]"
end if
write (u, "(3x,A,L1)") "Sim. valid = ", object%valid
write (u, "(3x,A,I0)") "Ev.file ver. = ", object%version
if (object%md5sum_prc /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (proc) = '", object%md5sum_prc, "'"
end if
if (object%md5sum_cfg /= "") then
write (u, "(3x,A,A,A)") "MD5 sum (config) = '", object%md5sum_cfg, "'"
end if
write (u, "(3x,A,I0)") "Events requested = ", object%n_evt_requested
if (object%event_index_offset /= 0) then
write (u, "(3x,A,I0)") "Event index offset= ", object%event_index_offset
end if
if (object%event_index_set) then
write (u, "(3x,A,I0)") "Event index = ", object%event_index
end if
if (object%split_n_evt > 0 .or. object%split_n_kbytes > 0) then
write (u, "(3x,A,I0)") "Events per file = ", object%split_n_evt
write (u, "(3x,A,I0)") "KBytes per file = ", object%split_n_kbytes
write (u, "(3x,A,I0)") "First file index = ", object%split_index
end if
call object%counter%write (u)
call write_separator (u)
if (object%i_prc /= 0) then
write (u, "(1x,A)") "Current event:"
write (u, "(3x,A,I0,A,A)") "Process #", &
object%i_prc, ": ", &
char (object%entry(object%i_prc)%process_id)
write (u, "(3x,A,I0)") "MCI set #", object%i_mci
write (u, "(3x,A," // FMT_19 // ")") "Weight = ", object%weight
if (.not. vanishes (object%excess)) &
write (u, "(3x,A," // FMT_19 // ")") "Excess = ", object%excess
else
write (u, "(1x,A,I0,A,A)") "Current event: [undefined]"
end if
call write_separator (u)
if (allocated (object%rng)) then
call object%rng%write (u)
else
write (u, "(3x,A)") "Random-number generator: [undefined]"
end if
if (allocated (object%entry)) then
do i = 1, size (object%entry)
if (i == 1) then
call write_separator (u, 2)
else
call write_separator (u)
end if
write (u, "(1x,A,I0,A)") "Process #", i, ":"
call object%entry(i)%write_config (u, pacified)
end do
end if
call write_separator (u, 2)
end subroutine simulation_write
@ %def simulation_write
@ Write the current event record. If an explicit index is given,
write that event record.
We implement writing to [[unit]] (event contents / debugging format)
and writing to an [[eio]] event stream (storage). We include a [[testflag]]
in order to suppress numerical noise in the testsuite.
<<Simulations: simulation: TBP>>=
generic :: write_event => write_event_unit
procedure :: write_event_unit => simulation_write_event_unit
<<Simulations: procedures>>=
subroutine simulation_write_event_unit &
(object, unit, i_prc, verbose, testflag)
class(simulation_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: verbose
integer, intent(in), optional :: i_prc
logical, intent(in), optional :: testflag
logical :: pacified
integer :: current
pacified = .false.; if (present(testflag)) pacified = testflag
pacified = pacified .or. object%pacify
if (present (i_prc)) then
current = i_prc
else
current = object%i_prc
end if
if (current > 0) then
call object%entry(current)%write (unit, verbose = verbose, &
testflag = pacified)
else
call msg_fatal ("Simulation: write event: no process selected")
end if
end subroutine simulation_write_event_unit
@ %def simulation_write_event
@ This writes one of the alternate events, if allocated.
<<Simulations: simulation: TBP>>=
procedure :: write_alt_event => simulation_write_alt_event
<<Simulations: procedures>>=
subroutine simulation_write_alt_event (object, unit, j_alt, i_prc, &
verbose, testflag)
class(simulation_t), intent(in) :: object
integer, intent(in), optional :: unit
integer, intent(in), optional :: j_alt
integer, intent(in), optional :: i_prc
logical, intent(in), optional :: verbose
logical, intent(in), optional :: testflag
integer :: i, j
if (present (j_alt)) then
j = j_alt
else
j = 1
end if
if (present (i_prc)) then
i = i_prc
else
i = object%i_prc
end if
if (i > 0) then
if (j> 0 .and. j <= object%n_alt) then
call object%alt_entry(i,j)%write (unit, verbose = verbose, &
testflag = testflag)
else
call msg_fatal ("Simulation: write alternate event: out of range")
end if
else
call msg_fatal ("Simulation: write alternate event: no process selected")
end if
end subroutine simulation_write_alt_event
@ %def simulation_write_alt_event
@ This writes the contents of the resonant subprocess set in the current event
record.
<<Simulations: simulation: TBP>>=
procedure :: write_resonant_subprocess_data &
=> simulation_write_resonant_subprocess_data
<<Simulations: procedures>>=
subroutine simulation_write_resonant_subprocess_data (object, unit, i_prc)
class(simulation_t), intent(in) :: object
integer, intent(in), optional :: unit
integer, intent(in), optional :: i_prc
integer :: i
if (present (i_prc)) then
i = i_prc
else
i = object%i_prc
end if
call object%entry(i)%write_resonant_subprocess_data (unit)
end subroutine simulation_write_resonant_subprocess_data
@ %def simulation_write_resonant_subprocess_data
@ The same for the master process, as an additional debugging aid.
<<Simulations: simulation: TBP>>=
procedure :: write_process_data &
=> simulation_write_process_data
<<Simulations: procedures>>=
subroutine simulation_write_process_data &
(object, unit, i_prc, &
show_process, show_instance, verbose)
class(simulation_t), intent(in) :: object
integer, intent(in), optional :: unit
integer, intent(in), optional :: i_prc
logical, intent(in), optional :: show_process
logical, intent(in), optional :: show_instance
logical, intent(in), optional :: verbose
integer :: i
if (present (i_prc)) then
i = i_prc
else
i = object%i_prc
end if
call object%entry(i)%write_process_data &
(unit, show_process, show_instance, verbose)
end subroutine simulation_write_process_data
@ %def simulation_write_process_data
@ Finalizer.
<<Simulations: simulation: TBP>>=
procedure :: final => simulation_final
<<Simulations: procedures>>=
subroutine simulation_final (object)
class(simulation_t), intent(inout) :: object
integer :: i, j
if (allocated (object%entry)) then
do i = 1, size (object%entry)
call object%entry(i)%final ()
end do
end if
if (allocated (object%alt_entry)) then
do j = 1, size (object%alt_entry, 2)
do i = 1, size (object%alt_entry, 1)
call object%alt_entry(i,j)%final ()
end do
end do
end if
if (allocated (object%rng)) call object%rng%final ()
end subroutine simulation_final
@ %def simulation_final
@ Initialization. We can deduce all data from the given list of
process IDs and the global data set. The process objects are taken
from the stack. Once the individual integrals are known, we add them (and the
errors), to get the sample integral.
If there are alternative environments, we suspend initialization for
setting up alternative process objects, then restore the master
process and its parameters. The generator or rescanner can then
switch rapidly between processes.
If [[integrate]] is set, we make sure that all affected processes are
integrated before simulation. This is necessary if we want to actually
generate events. If [[integrate]] is unset, we don't need the integral
because we just rescan existing events. In that case, we just need compiled
matrix elements.
If [[generate]] is set, we prepare for actually generating events. Otherwise,
we may only read and rescan events.
<<Simulations: simulation: TBP>>=
procedure :: init => simulation_init
<<Simulations: procedures>>=
subroutine simulation_init (simulation, &
process_id, integrate, generate, local, global, alt_env)
class(simulation_t), intent(out), target :: simulation
type(string_t), dimension(:), intent(in) :: process_id
logical, intent(in) :: integrate, generate
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), optional, target :: global
type(rt_data_t), dimension(:), intent(inout), optional, target :: alt_env
class(rng_factory_t), allocatable :: rng_factory
type(string_t) :: norm_string, version_string
logical :: use_process
integer :: i, j
type(string_t) :: sample_suffix
<<Simulations: simulation init: variables>>
sample_suffix = ""
<<Simulations: simulation init: init>>
simulation%local => local
simulation%sample_id = &
local%get_sval (var_str ("$sample")) // sample_suffix
simulation%unweighted = &
local%get_lval (var_str ("?unweighted"))
simulation%negative_weights = &
local%get_lval (var_str ("?negative_weights"))
simulation%support_resonance_history = &
local%get_lval (var_str ("?resonance_history"))
simulation%respect_selection = &
local%get_lval (var_str ("?sample_select"))
version_string = &
local%get_sval (var_str ("$event_file_version"))
norm_string = &
local%get_sval (var_str ("$sample_normalization"))
simulation%norm_mode = &
event_normalization_mode (norm_string, simulation%unweighted)
simulation%pacify = &
local%get_lval (var_str ("?sample_pacify"))
simulation%event_index_offset = &
local%get_ival (var_str ("event_index_offset"))
simulation%n_max_tries = &
local%get_ival (var_str ("sample_max_tries"))
simulation%split_n_evt = &
local%get_ival (var_str ("sample_split_n_evt"))
simulation%split_n_kbytes = &
local%get_ival (var_str ("sample_split_n_kbytes"))
simulation%split_index = &
local%get_ival (var_str ("sample_split_index"))
simulation%update_sqme = &
local%get_lval (var_str ("?update_sqme"))
simulation%update_weight = &
local%get_lval (var_str ("?update_weight"))
simulation%update_event = &
local%get_lval (var_str ("?update_event"))
simulation%recover_beams = &
local%get_lval (var_str ("?recover_beams"))
simulation%counter%reproduce_xsection = &
local%get_lval (var_str ("?check_event_weights_against_xsection"))
use_process = &
integrate .or. generate &
.or. simulation%update_sqme &
.or. simulation%update_weight &
.or. simulation%update_event &
.or. present (alt_env)
select case (size (process_id))
case (0)
call msg_error ("Simulation: no process selected")
case (1)
write (msg_buffer, "(A,A,A)") &
"Starting simulation for process '", &
char (process_id(1)), "'"
call msg_message ()
case default
write (msg_buffer, "(A,A,A)") &
"Starting simulation for processes '", &
char (process_id(1)), "' etc."
call msg_message ()
end select
select case (char (version_string))
case ("", "2.2.4")
simulation%version = 2
case ("2.2")
simulation%version = 1
case default
simulation%version = 0
end select
if (simulation%version == 0) then
call msg_fatal ("Event file format '" &
// char (version_string) &
// "' is not compatible with this version.")
end if
simulation%n_prc = size (process_id)
allocate (simulation%entry (simulation%n_prc))
if (present (alt_env)) then
simulation%n_alt = size (alt_env)
do i = 1, simulation%n_prc
call simulation%entry(i)%init (process_id(i), &
use_process, integrate, generate, &
simulation%update_sqme, &
simulation%support_resonance_history, &
local, global, simulation%n_alt)
if (signal_is_pending ()) return
end do
simulation%valid = any (simulation%entry%valid)
if (.not. simulation%valid) then
call msg_error ("Simulate: no process has a valid matrix element.")
return
end if
call simulation%update_processes ()
allocate (simulation%alt_entry (simulation%n_prc, simulation%n_alt))
allocate (simulation%md5sum_alt (simulation%n_alt))
simulation%md5sum_alt = ""
do j = 1, simulation%n_alt
do i = 1, simulation%n_prc
call simulation%alt_entry(i,j)%init_alt (process_id(i), &
simulation%entry(i)%get_process_ptr (), alt_env(j))
if (signal_is_pending ()) return
end do
end do
call simulation%restore_processes ()
else
do i = 1, simulation%n_prc
call simulation%entry(i)%init &
(process_id(i), &
use_process, integrate, generate, &
simulation%update_sqme, &
simulation%support_resonance_history, &
local, global)
call simulation%entry(i)%determine_if_powheg_matching ()
if (signal_is_pending ()) return
if (simulation%entry(i)%is_nlo ()) &
call simulation%entry(i)%setup_additional_entries ()
end do
simulation%valid = any (simulation%entry%valid)
if (.not. simulation%valid) then
call msg_error ("Simulate: " &
// "no process has a valid matrix element.")
return
end if
end if
!!! if this becomes conditional, some ref files will need update (seed change)
! if (generate) then
call dispatch_rng_factory (rng_factory, local%var_list)
call rng_factory%make (simulation%rng)
! end if
if (all (simulation%entry%has_integral)) then
simulation%integral = sum (simulation%entry%integral)
simulation%error = sqrt (sum (simulation%entry%error ** 2))
simulation%has_integral = .true.
if (integrate .and. generate) then
do i = 1, simulation%n_prc
if (simulation%entry(i)%integral < 0 .and. .not. &
simulation%negative_weights) then
call msg_fatal ("Integral of process '" // &
char (process_id (i)) // "'is negative.")
end if
end do
end if
else
if (integrate .and. generate) &
call msg_error ("Simulation contains undefined integrals.")
end if
if (simulation%integral > 0 .or. &
(simulation%integral < 0 .and. simulation%negative_weights)) then
simulation%valid = .true.
else if (generate) then
call msg_error ("Simulate: " &
// "sum of process integrals must be positive; skipping.")
simulation%valid = .false.
else
simulation%valid = .true.
end if
if (simulation%valid) call simulation%compute_md5sum ()
end subroutine simulation_init
@ %def simulation_init
@
<<MPI: Simulations: simulation init: variables>>=
integer :: rank, n_size
@
<<MPI: Simulations: simulation init: init>>=
call mpi_get_comm_id (n_size, rank)
if (n_size > 1) then
sample_suffix = var_str ("_") // str (rank)
end if
@
@ The number of events that we want to simulate is determined by the
settings of [[n_events]], [[luminosity]], and [[?unweighted]]. For
weighted events, we take [[n_events]] at face value as the number of
matrix element calls. For unweighted events, if the process is a
decay, [[n_events]] is the number of unweighted events. In these
cases, the luminosity setting is ignored.
For unweighted events with a scattering process, we calculate the
event number that corresponds to the luminosity, given the current
value of the integral. We then compare this with [[n_events]] and
choose the larger number.
<<Simulations: simulation: TBP>>=
procedure :: compute_n_events => simulation_compute_n_events
<<Simulations: procedures>>=
subroutine simulation_compute_n_events (simulation, n_events, var_list)
class(simulation_t), intent(in) :: simulation
integer, intent(out) :: n_events
type(var_list_t) :: var_list
real(default) :: lumi, x_events_lumi
integer :: n_events_lumi
logical :: is_scattering
n_events = &
var_list%get_ival (var_str ("n_events"))
lumi = &
var_list%get_rval (var_str ("luminosity"))
if (simulation%unweighted) then
is_scattering = simulation%entry(1)%n_in == 2
if (is_scattering) then
x_events_lumi = abs (simulation%integral * lumi)
if (x_events_lumi < huge (n_events)) then
n_events_lumi = nint (x_events_lumi)
else
call msg_message ("Simulation: luminosity too large, &
&limiting number of events")
n_events_lumi = huge (n_events)
end if
if (n_events_lumi > n_events) then
call msg_message ("Simulation: using n_events as computed from &
&luminosity value")
n_events = n_events_lumi
else
write (msg_buffer, "(A,1x,I0)") &
"Simulation: requested number of events =", n_events
call msg_message ()
if (.not. vanishes (simulation%integral)) then
write (msg_buffer, "(A,1x,ES11.4)") &
" corr. to luminosity [fb-1] = ", &
n_events / simulation%integral
call msg_message ()
end if
end if
end if
end if
end subroutine simulation_compute_n_events
@ %def simulation_compute_n_events
@ Write the actual efficiency of the simulation run. We get the total
number of events stored in the simulation counter and compare this
with the total number of calls stored in the event entries.
In order not to miscount samples that are partly read from file, use
the [[generated]] counter, not the [[total]] counter.
<<Simulations: simulation: TBP>>=
procedure :: show_efficiency => simulation_show_efficiency
<<Simulations: procedures>>=
subroutine simulation_show_efficiency (simulation)
class(simulation_t), intent(inout) :: simulation
integer :: n_events, n_calls
real(default) :: eff
n_events = simulation%counter%generated
n_calls = sum (simulation%entry%get_actual_calls_total ())
if (n_calls > 0) then
eff = real (n_events, kind=default) / n_calls
write (msg_buffer, "(A,1x,F6.2,1x,A)") &
"Events: actual unweighting efficiency =", 100 * eff, "%"
call msg_message ()
end if
end subroutine simulation_show_efficiency
@ %def simulation_show_efficiency
@
<<Simulations: simulation: TBP>>=
procedure :: get_n_nlo_entries => simulation_get_n_nlo_entries
<<Simulations: procedures>>=
function simulation_get_n_nlo_entries (simulation, i_prc) result (n_extra)
class(simulation_t), intent(in) :: simulation
integer, intent(in) :: i_prc
integer :: n_extra
n_extra = simulation%entry(i_prc)%count_nlo_entries ()
end function simulation_get_n_nlo_entries
@ %def simulation_get_n_nlo_entries
@ Compute the checksum of the process set. We retrieve the MD5 sums
of all processes. This depends only on the process definitions, while
parameters are not considered. The configuration checksum is
retrieved from the MCI records in the process objects and furthermore
includes beams, parameters, integration results, etc., so matching the
latter should guarantee identical physics.
<<Simulations: simulation: TBP>>=
procedure :: compute_md5sum => simulation_compute_md5sum
<<Simulations: procedures>>=
subroutine simulation_compute_md5sum (simulation)
class(simulation_t), intent(inout) :: simulation
type(process_t), pointer :: process
type(string_t) :: buffer
integer :: j, i, n_mci, i_mci, n_component, i_component
if (simulation%md5sum_prc == "") then
buffer = ""
do i = 1, simulation%n_prc
if (.not. simulation%entry(i)%valid) cycle
process => simulation%entry(i)%get_process_ptr ()
if (associated (process)) then
n_component = process%get_n_components ()
do i_component = 1, n_component
if (process%has_matrix_element (i_component)) then
buffer = buffer // process%get_md5sum_prc (i_component)
end if
end do
end if
end do
simulation%md5sum_prc = md5sum (char (buffer))
end if
if (simulation%md5sum_cfg == "") then
buffer = ""
do i = 1, simulation%n_prc
if (.not. simulation%entry(i)%valid) cycle
process => simulation%entry(i)%get_process_ptr ()
if (associated (process)) then
n_mci = process%get_n_mci ()
do i_mci = 1, n_mci
buffer = buffer // process%get_md5sum_mci (i_mci)
end do
end if
end do
simulation%md5sum_cfg = md5sum (char (buffer))
end if
do j = 1, simulation%n_alt
if (simulation%md5sum_alt(j) == "") then
buffer = ""
do i = 1, simulation%n_prc
process => simulation%alt_entry(i,j)%get_process_ptr ()
if (associated (process)) then
buffer = buffer // process%get_md5sum_cfg ()
end if
end do
simulation%md5sum_alt(j) = md5sum (char (buffer))
end if
end do
end subroutine simulation_compute_md5sum
@ %def simulation_compute_md5sum
@ Initialize the process selector, using the entry integrals as process
weights.
<<Simulations: simulation: TBP>>=
procedure :: init_process_selector => simulation_init_process_selector
<<Simulations: procedures>>=
subroutine simulation_init_process_selector (simulation)
class(simulation_t), intent(inout) :: simulation
integer :: i
if (simulation%has_integral) then
call simulation%process_selector%init (simulation%entry%integral, &
negative_weights = simulation%negative_weights)
do i = 1, simulation%n_prc
associate (entry => simulation%entry(i))
if (.not. entry%valid) then
call msg_warning ("Process '" // char (entry%process_id) // &
"': matrix element vanishes, no events can be generated.")
cycle
end if
call entry%init_mci_selector (simulation%negative_weights)
entry%process_weight = simulation%process_selector%get_weight (i)
end associate
end do
end if
end subroutine simulation_init_process_selector
@ %def simulation_init_process_selector
@ Select a process, using the random-number generator.
<<Simulations: simulation: TBP>>=
procedure :: select_prc => simulation_select_prc
<<Simulations: procedures>>=
function simulation_select_prc (simulation) result (i_prc)
class(simulation_t), intent(inout) :: simulation
integer :: i_prc
call simulation%process_selector%generate (simulation%rng, i_prc)
end function simulation_select_prc
@ %def simulation_select_prc
@ Select a MCI set for the selected process.
<<Simulations: simulation: TBP>>=
procedure :: select_mci => simulation_select_mci
<<Simulations: procedures>>=
function simulation_select_mci (simulation) result (i_mci)
class(simulation_t), intent(inout) :: simulation
integer :: i_mci
i_mci = 0
if (simulation%i_prc /= 0) then
i_mci = simulation%entry(simulation%i_prc)%select_mci ()
end if
end function simulation_select_mci
@ %def simulation_select_mci
@ Generate a predefined number of events. First select a process and
a component set, then generate an event for that process and factorize
the quantum state. The pair of random numbers can be used for
factorization.
When generating events, we drop all configurations where the event is
marked as incomplete. This happens if the event fails cuts. In fact,
such events are dropped already by the sampler if unweighting is in
effect, so this can happen only for weighted events. By setting a
limit given by [[sample_max_tries]] (user parameter), we can avoid an
endless loop.
NB: When reading from file, event transforms can't be applied because the
process instance will not be complete. This should be fixed.
<<Simulations: simulation: TBP>>=
procedure :: generate => simulation_generate
<<Simulations: procedures>>=
subroutine simulation_generate (simulation, n, es_array)
class(simulation_t), intent(inout), target :: simulation
integer, intent(in) :: n
type(event_stream_array_t), intent(inout), optional :: es_array
type(string_t) :: str1, str2, str3
logical :: generate_new, passed
integer :: i, j, k
type(entry_t), pointer :: current_entry
integer :: n_events
<<Simulations: simulation generate: variables>>
simulation%n_evt_requested = n
n_events = n * simulation%get_n_nlo_entries (1)
call simulation%entry%set_n (n)
if (simulation%n_alt > 0) call simulation%alt_entry%set_n (n)
str1 = "Events: generating"
if (present (es_array)) then
if (es_array%has_input ()) str1 = "Events: reading"
end if
if (simulation%entry(1)%config%unweighted) then
str2 = "unweighted"
else
str2 = "weighted"
end if
if (simulation%entry(1)%config%factorization_mode == &
FM_IGNORE_HELICITY) then
str3 = ", unpolarized"
else
str3 = ", polarized"
end if
if (n_events == n) then
write (msg_buffer, "(A,1x,I0,1x,A,1x,A)") char (str1), n, &
char (str2) // char(str3), "events ..."
else
write (msg_buffer, "(A,1x,I0,1x,A,1x,A)") char (str1), n_events, &
char (str2) // char(str3), "NLO events ..."
end if
call msg_message ()
write (msg_buffer, "(A,1x,A)") "Events: event normalization mode", &
char (event_normalization_string (simulation%norm_mode))
call msg_message ()
call simulation%init_event_index ()
<<Simulations: simulation generate: init>>
do i = start_it, end_it
call simulation%increment_event_index ()
if (present (es_array)) then
call simulation%read_event (es_array, .true., generate_new)
else
generate_new = .true.
end if
if (generate_new) then
simulation%i_prc = simulation%select_prc ()
simulation%i_mci = simulation%select_mci ()
associate (entry => simulation%entry(simulation%i_prc))
entry%instance%i_mci = simulation%i_mci
call entry%set_active_real_components ()
current_entry => entry%get_first ()
do k = 1, current_entry%count_nlo_entries ()
if (k > 1) then
current_entry => current_entry%get_next ()
current_entry%particle_set => current_entry%first%particle_set
current_entry%particle_set_is_valid &
= current_entry%first%particle_set_is_valid
end if
do j = 1, simulation%n_max_tries
if (.not. current_entry%valid) call msg_warning &
("Process '" // char (current_entry%process_id) // "': " // &
"matrix element vanishes, no events can be generated.")
call current_entry%generate (simulation%i_mci, i_nlo = k)
if (signal_is_pending ()) return
call simulation%counter%record_mean_and_variance &
(current_entry%weight_prc, k)
if (current_entry%has_valid_particle_set ()) exit
end do
end do
if (entry%is_nlo ()) call entry%reset_nlo_counter ()
if (.not. entry%has_valid_particle_set ()) then
write (msg_buffer, "(A,I0,A)") "Simulation: failed to &
&generate valid event after ", &
simulation%n_max_tries, " tries (sample_max_tries)"
call msg_fatal ()
end if
current_entry => entry%get_first ()
do k = 1, current_entry%count_nlo_entries ()
if (k > 1) current_entry => current_entry%get_next ()
call current_entry%set_index (simulation%get_event_index ())
call current_entry%evaluate_expressions ()
end do
if (signal_is_pending ()) return
if (entry%passed_selection ()) then
simulation%weight = entry%get_weight_ref ()
simulation%excess = entry%get_excess_prc ()
end if
call simulation%counter%record &
(simulation%weight, simulation%excess)
call entry%record (simulation%i_mci)
end associate
else
associate (entry => simulation%entry(simulation%i_prc))
call simulation%set_event_index (entry%get_index ())
call entry%accept_sqme_ref ()
call entry%accept_weight_ref ()
call entry%check ()
call entry%evaluate_expressions ()
if (signal_is_pending ()) return
if (entry%passed_selection ()) then
simulation%weight = entry%get_weight_ref ()
simulation%excess = entry%get_excess_prc ()
end if
call simulation%counter%record &
(simulation%weight, simulation%excess, from_file=.true.)
call entry%record (simulation%i_mci, from_file=.true.)
end associate
end if
call simulation%calculate_alt_entries ()
if (signal_is_pending ()) return
if (simulation%pacify) call pacify (simulation)
if (simulation%respect_selection) then
passed = simulation%entry(simulation%i_prc)%passed_selection ()
else
passed = .true.
end if
if (present (es_array)) then
call simulation%write_event (es_array, passed)
end if
end do
<<Simulations: simulation generate: finalize>>
call msg_message (" ... event sample complete.")
if (simulation%unweighted) call simulation%show_efficiency ()
call simulation%counter%show_excess ()
call simulation%counter%show_mean_and_variance ()
end subroutine simulation_generate
@ %def simulation_generate
@
<<Simulations: simulation generate: variables>>=
integer :: start_it, end_it
@
<<Simulations: simulation generate: init>>=
start_it = 1
end_it = n
@
<<Simulations: simulation generate: finalize>>=
@
<<MPI: Simulations: simulation generate: variables>>=
integer :: n_size, rank
integer :: worker_n_events, root_n_events
<<MPI: Simulations: simulation generate: init>>=
call mpi_get_comm_id (n_size, rank)
if (n_size > 1) then
start_it = start_it + nint (rank * (real (n) / n_size))
end_it = min (nint ((rank + 1) * (real (n) / n_size)), n)
write (msg_buffer, "(A,I0,A,I0,A)") &
& "MPI: generate events [", start_it, ":", end_it, "]"
call msg_message ()
do i = 1, rank + 1
select type (rng => simulation%rng)
type is (rng_stream_t)
call rng%next_substream ()
end select
end do
end if
@
<<MPI: Simulations: simulation generate: finalize>>=
call MPI_Barrier (MPI_COMM_WORLD)
if (n_size > 1) then
worker_n_events = end_it - start_it + 1
call MPI_Reduce (worker_n_events, root_n_events, 1, MPI_INTEGER, MPI_SUM,&
& 0, MPI_COMM_WORLD)
if (rank == 0) then
write (msg_buffer, "(A,I0)") "MPI: Number of generated events in world = ", root_n_events
call msg_message ()
end if
end if
@
@ Compute the event matrix element and weight for all alternative
environments, given the current event and selected process. We first
copy the particle set, then temporarily update the process core with
local parameters, recalculate everything, and restore the process
core.
The event weight is obtained by rescaling the original event weight with the
ratio of the new and old [[sqme]] values. (In particular, if the old
value was zero, the weight will stay zero.)
Note: this may turn out to be inefficient because we always replace
all parameters and recalculate everything, once for each event and
environment. However, a more fine-grained control requires more
code. In any case, while we may keep multiple process cores (which
stay constant for a simulation run), we still have to update the
external matrix element parameters event by event. The matrix element
``object'' is present only once.
<<Simulations: simulation: TBP>>=
procedure :: calculate_alt_entries => simulation_calculate_alt_entries
<<Simulations: procedures>>=
subroutine simulation_calculate_alt_entries (simulation)
class(simulation_t), intent(inout) :: simulation
real(default) :: factor
real(default), dimension(:), allocatable :: sqme_alt, weight_alt
integer :: n_alt, i, j
i = simulation%i_prc
n_alt = simulation%n_alt
if (n_alt == 0) return
allocate (sqme_alt (n_alt), weight_alt (n_alt))
associate (entry => simulation%entry(i))
do j = 1, n_alt
if (signal_is_pending ()) return
factor = entry%get_kinematical_weight ()
associate (alt_entry => simulation%alt_entry(i,j))
call alt_entry%update_process ()
call alt_entry%select &
(entry%get_i_mci (), entry%get_i_term (), entry%get_channel ())
call alt_entry%fill_particle_set (entry)
call alt_entry%recalculate &
(update_sqme = .true., weight_factor = factor)
if (signal_is_pending ()) return
call alt_entry%accept_sqme_prc ()
call alt_entry%update_normalization ()
call alt_entry%accept_weight_prc ()
call alt_entry%check ()
call alt_entry%set_index (simulation%get_event_index ())
call alt_entry%evaluate_expressions ()
if (signal_is_pending ()) return
call alt_entry%restore_process ()
sqme_alt(j) = alt_entry%get_sqme_ref ()
if (alt_entry%passed_selection ()) then
weight_alt(j) = alt_entry%get_weight_ref ()
end if
end associate
end do
call entry%set (sqme_alt = sqme_alt, weight_alt = weight_alt)
call entry%check ()
call entry%store_alt_values ()
end associate
end subroutine simulation_calculate_alt_entries
@ %def simulation_calculate_alt_entries
@ Rescan an undefined number of events.
If [[update_event]] or [[update_sqme]] is set, we have to recalculate the
event, starting from the particle set. If the latter is set, this includes
the squared matrix element (i.e., the amplitude is evaluated). Otherwise,
only kinematics and observables derived from it are recovered.
If any of the update flags is set, we will come up with separate
[[sqme_prc]] and [[weight_prc]] values. (The latter is only distinct
if [[update_weight]] is set.) Otherwise, we accept the reference values.
<<Simulations: simulation: TBP>>=
procedure :: rescan => simulation_rescan
<<Simulations: procedures>>=
subroutine simulation_rescan (simulation, n, es_array, global)
class(simulation_t), intent(inout) :: simulation
integer, intent(in) :: n
type(event_stream_array_t), intent(inout) :: es_array
type(rt_data_t), intent(inout) :: global
type(qcd_t) :: qcd
type(string_t) :: str1, str2, str3
logical :: complete
str1 = "Rescanning"
if (simulation%entry(1)%config%unweighted) then
str2 = "unweighted"
else
str2 = "weighted"
end if
simulation%n_evt_requested = n
call simulation%entry%set_n (n)
if (simulation%update_sqme .or. simulation%update_weight) then
call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
call simulation%update_processes &
(global%model, qcd, global%get_helicity_selection ())
str3 = "(process parameters updated) "
else
str3 = ""
end if
write (msg_buffer, "(A,1x,A,1x,A,A,A)") char (str1), char (str2), &
"events ", char (str3), "..."
call msg_message ()
call simulation%init_event_index ()
do
call simulation%increment_event_index ()
call simulation%read_event (es_array, .false., complete)
if (complete) exit
if (simulation%update_event &
.or. simulation%update_sqme &
.or. simulation%update_weight) then
call simulation%recalculate ()
if (signal_is_pending ()) return
associate (entry => simulation%entry(simulation%i_prc))
call entry%update_normalization ()
if (simulation%update_event) then
call entry%evaluate_transforms ()
end if
call entry%check ()
call entry%evaluate_expressions ()
if (signal_is_pending ()) return
simulation%weight = entry%get_weight_prc ()
call simulation%counter%record (simulation%weight, from_file=.true.)
call entry%record (simulation%i_mci, from_file=.true.)
end associate
else
associate (entry => simulation%entry(simulation%i_prc))
call entry%accept_sqme_ref ()
call entry%accept_weight_ref ()
call entry%check ()
call entry%evaluate_expressions ()
if (signal_is_pending ()) return
simulation%weight = entry%get_weight_ref ()
call simulation%counter%record (simulation%weight, from_file=.true.)
call entry%record (simulation%i_mci, from_file=.true.)
end associate
end if
call simulation%calculate_alt_entries ()
if (signal_is_pending ()) return
call simulation%write_event (es_array)
end do
if (simulation%update_sqme .or. simulation%update_weight) then
call simulation%restore_processes ()
end if
end subroutine simulation_rescan
@ %def simulation_rescan
@ Here we handle the event index that is kept in the simulation record. The
event index is valid for the current sample. When generating or reading
events, we initialize the index with the offset that the user provides (if any)
and increment it for each event that is generated or read from file. The event
index is stored in the event-entry that is current for the event. If an
event on file comes with its own index, that index overwrites the predefined
one and also resets the index within the simulation record.
The event index is not connected to the [[counter]] object. The counter is
supposed to collect statistical information. The event index is a user-level
object that is visible in event records and analysis expressions.
<<Simulations: simulation: TBP>>=
procedure :: init_event_index => simulation_init_event_index
procedure :: increment_event_index => simulation_increment_event_index
procedure :: set_event_index => simulation_set_event_index
procedure :: get_event_index => simulation_get_event_index
<<Simulations: procedures>>=
subroutine simulation_init_event_index (simulation)
class(simulation_t), intent(inout) :: simulation
call simulation%set_event_index (simulation%event_index_offset)
end subroutine simulation_init_event_index
subroutine simulation_increment_event_index (simulation)
class(simulation_t), intent(inout) :: simulation
if (simulation%event_index_set) then
simulation%event_index = simulation%event_index + 1
end if
end subroutine simulation_increment_event_index
subroutine simulation_set_event_index (simulation, i)
class(simulation_t), intent(inout) :: simulation
integer, intent(in) :: i
simulation%event_index = i
simulation%event_index_set = .true.
end subroutine simulation_set_event_index
function simulation_get_event_index (simulation) result (i)
class(simulation_t), intent(in) :: simulation
integer :: i
if (simulation%event_index_set) then
i = simulation%event_index
else
i = 0
end if
end function simulation_get_event_index
@ %def simulation_init_event_index
@ %def simulation_increment_event_index
@ %def simulation_set_event_index
@ %def simulation_get_event_index
@
@ These routines take care of temporary parameter redefinitions that
we want to take effect while recalculating the matrix elements. We
extract the core(s) of the processes that we are simulating, apply the
changes, and make sure that the changes are actually used. This is
the duty of [[dispatch_core_update]]. When done, we restore the
original versions using [[dispatch_core_restore]].
<<Simulations: simulation: TBP>>=
procedure :: update_processes => simulation_update_processes
procedure :: restore_processes => simulation_restore_processes
<<Simulations: procedures>>=
subroutine simulation_update_processes (simulation, &
model, qcd, helicity_selection)
class(simulation_t), intent(inout) :: simulation
class(model_data_t), intent(in), optional, target :: model
type(qcd_t), intent(in), optional :: qcd
type(helicity_selection_t), intent(in), optional :: helicity_selection
integer :: i
do i = 1, simulation%n_prc
call simulation%entry(i)%update_process &
(model, qcd, helicity_selection)
end do
end subroutine simulation_update_processes
subroutine simulation_restore_processes (simulation)
class(simulation_t), intent(inout) :: simulation
integer :: i
do i = 1, simulation%n_prc
call simulation%entry(i)%restore_process ()
end do
end subroutine simulation_restore_processes
@ %def simulation_update_processes
@ %def simulation_restore_processes
@
\subsection{Event Stream I/O}
Write an event to a generic [[eio]] event stream. The process index
must be selected, or the current index must be available.
<<Simulations: simulation: TBP>>=
generic :: write_event => write_event_eio
procedure :: write_event_eio => simulation_write_event_eio
<<Simulations: procedures>>=
subroutine simulation_write_event_eio (object, eio, i_prc)
class(simulation_t), intent(in) :: object
class(eio_t), intent(inout) :: eio
integer, intent(in), optional :: i_prc
logical :: increased
integer :: current
if (present (i_prc)) then
current = i_prc
else
current = object%i_prc
end if
if (current > 0) then
if (object%split_n_evt > 0 &
.and. object%counter%total > 1 &
.and. mod (object%counter%total, object%split_n_evt) == 1) then
call eio%split_out ()
else if (object%split_n_kbytes > 0) then
call eio%update_split_count (increased)
if (increased) call eio%split_out ()
end if
call eio%output (object%entry(current)%event_t, current, pacify = object%pacify)
else
call msg_fatal ("Simulation: write event: no process selected")
end if
end subroutine simulation_write_event_eio
@ %def simulation_write_event
@
Read an event from a generic [[eio]] event stream. The event stream element
must specify the process within the sample ([[i_prc]]), the MC group for this
process ([[i_mci]]), the selected term ([[i_term]]), the selected MC
integration [[channel]], and the particle set of the event.
We may encounter EOF, which we indicate by storing 0 for the process index
[[i_prc]]. An I/O error will be reported, and we also abort reading.
<<Simulations: simulation: TBP>>=
generic :: read_event => read_event_eio
procedure :: read_event_eio => simulation_read_event_eio
<<Simulations: procedures>>=
subroutine simulation_read_event_eio (object, eio)
class(simulation_t), intent(inout) :: object
class(eio_t), intent(inout) :: eio
integer :: iostat, current
call eio%input_i_prc (current, iostat)
select case (iostat)
case (0)
object%i_prc = current
call eio%input_event (object%entry(current)%event_t, iostat)
end select
select case (iostat)
case (:-1)
object%i_prc = 0
object%i_mci = 0
case (1:)
call msg_error ("Reading events: I/O error, aborting read")
object%i_prc = 0
object%i_mci = 0
case default
object%i_mci = object%entry(current)%get_i_mci ()
end select
end subroutine simulation_read_event_eio
@ %def simulation_read_event
@
\subsection{Event Stream Array}
Write an event using an array of event I/O streams.
The process index must be selected, or the current index must be
available.
<<Simulations: simulation: TBP>>=
generic :: write_event => write_event_es_array
procedure :: write_event_es_array => simulation_write_event_es_array
<<Simulations: procedures>>=
subroutine simulation_write_event_es_array (object, es_array, passed)
class(simulation_t), intent(in), target :: object
class(event_stream_array_t), intent(inout) :: es_array
logical, intent(in), optional :: passed
integer :: i_prc, event_index
integer :: i
type(entry_t), pointer :: current_entry
i_prc = object%i_prc
if (i_prc > 0) then
event_index = object%counter%total
current_entry => object%entry(i_prc)%get_first ()
do i = 1, current_entry%count_nlo_entries ()
if (i > 1) current_entry => current_entry%get_next ()
call es_array%output (current_entry%event_t, i_prc, &
event_index, passed = passed, pacify = object%pacify)
end do
else
call msg_fatal ("Simulation: write event: no process selected")
end if
end subroutine simulation_write_event_es_array
@ %def simulation_write_event
@ Read an event using an array of event I/O streams. Reading is
successful if there is an input stream within the array, and if a
valid event can be read from that stream. If there is a stream, but
EOF is passed when reading the first item, we switch the channel to
output and return failure but no error message, such that new events
can be appended to that stream.
<<Simulations: simulation: TBP>>=
generic :: read_event => read_event_es_array
procedure :: read_event_es_array => simulation_read_event_es_array
<<Simulations: procedures>>=
subroutine simulation_read_event_es_array (object, es_array, enable_switch, &
fail)
class(simulation_t), intent(inout), target :: object
class(event_stream_array_t), intent(inout), target :: es_array
logical, intent(in) :: enable_switch
logical, intent(out) :: fail
integer :: iostat, i_prc
type(entry_t), pointer :: current_entry => null ()
integer :: i
if (es_array%has_input ()) then
fail = .false.
call es_array%input_i_prc (i_prc, iostat)
select case (iostat)
case (0)
object%i_prc = i_prc
current_entry => object%entry(i_prc)
do i = 1, current_entry%count_nlo_entries ()
if (i > 1) then
call es_array%skip_eio_entry (iostat)
current_entry => current_entry%get_next ()
end if
call current_entry%set_index (object%get_event_index ())
call es_array%input_event (current_entry%event_t, iostat)
end do
case (:-1)
write (msg_buffer, "(A,1x,I0,1x,A)") &
"... event file terminates after", &
object%counter%read, "events."
call msg_message ()
if (enable_switch) then
call es_array%switch_inout ()
write (msg_buffer, "(A,1x,I0,1x,A)") &
"Generating remaining ", &
object%n_evt_requested - object%counter%read, "events ..."
call msg_message ()
end if
fail = .true.
return
end select
select case (iostat)
case (0)
object%i_mci = object%entry(i_prc)%get_i_mci ()
case default
write (msg_buffer, "(A,1x,I0,1x,A)") &
"Reading events: I/O error, aborting read after", &
object%counter%read, "events."
call msg_error ()
object%i_prc = 0
object%i_mci = 0
fail = .true.
end select
else
fail = .true.
end if
end subroutine simulation_read_event_es_array
@ %def simulation_read_event
@
\subsection{Recover event}
Recalculate the process instance contents, given an event with known particle
set. The indices for MC, term, and channel must be already set. The
[[recalculate]] method of the selected entry will import the result
into [[sqme_prc]] and [[weight_prc]].
If [[recover_phs]] is set (and false), do not attempt any phase-space
calculation. Useful if we need only matrix elements (esp. testing); this flag
is not stored in the simulation record.
<<Simulations: simulation: TBP>>=
procedure :: recalculate => simulation_recalculate
<<Simulations: procedures>>=
subroutine simulation_recalculate (simulation, recover_phs)
class(simulation_t), intent(inout) :: simulation
logical, intent(in), optional :: recover_phs
integer :: i_prc
i_prc = simulation%i_prc
associate (entry => simulation%entry(i_prc))
if (simulation%update_weight) then
call entry%recalculate &
(update_sqme = simulation%update_sqme, &
recover_beams = simulation%recover_beams, &
recover_phs = recover_phs, &
weight_factor = entry%get_kinematical_weight ())
else
call entry%recalculate &
(update_sqme = simulation%update_sqme, &
recover_beams = simulation%recover_beams, &
recover_phs = recover_phs)
end if
end associate
end subroutine simulation_recalculate
@ %def simulation_recalculate
@
\subsection{Extract contents}
Return the MD5 sum that summarizes configuration and integration
(but not the event file). Used for initializing the event streams.
<<Simulations: simulation: TBP>>=
procedure :: get_md5sum_prc => simulation_get_md5sum_prc
procedure :: get_md5sum_cfg => simulation_get_md5sum_cfg
procedure :: get_md5sum_alt => simulation_get_md5sum_alt
<<Simulations: procedures>>=
function simulation_get_md5sum_prc (simulation) result (md5sum)
class(simulation_t), intent(in) :: simulation
character(32) :: md5sum
md5sum = simulation%md5sum_prc
end function simulation_get_md5sum_prc
function simulation_get_md5sum_cfg (simulation) result (md5sum)
class(simulation_t), intent(in) :: simulation
character(32) :: md5sum
md5sum = simulation%md5sum_cfg
end function simulation_get_md5sum_cfg
function simulation_get_md5sum_alt (simulation, i) result (md5sum)
class(simulation_t), intent(in) :: simulation
integer, intent(in) :: i
character(32) :: md5sum
md5sum = simulation%md5sum_alt(i)
end function simulation_get_md5sum_alt
@ %def simulation_get_md5sum_prc
@ %def simulation_get_md5sum_cfg
@ Return data that may be useful for writing event files.
Usually we can refer to a previously integrated process, for which we
can fetch a process pointer. Occasionally, we don't have this because
we're just rescanning an externally generated file without
calculation. For that situation, we generate our local beam data object
using the current enviroment, or, in simple cases, just fetch the
necessary data from the process definition and environment.
<<Simulations: simulation: TBP>>=
procedure :: get_data => simulation_get_data
<<Simulations: procedures>>=
function simulation_get_data (simulation, alt) result (sdata)
class(simulation_t), intent(in) :: simulation
logical, intent(in), optional :: alt
type(event_sample_data_t) :: sdata
type(process_t), pointer :: process
type(beam_data_t), pointer :: beam_data
type(beam_structure_t), pointer :: beam_structure
type(flavor_t), dimension(:), allocatable :: flv
integer :: n, i
logical :: enable_alt, construct_beam_data
real(default) :: sqrts
class(model_data_t), pointer :: model
logical :: decay_rest_frame
type(string_t) :: process_id
enable_alt = .true.; if (present (alt)) enable_alt = alt
call msg_debug (D_CORE, "simulation_get_data")
call msg_debug (D_CORE, "alternative setup", enable_alt)
if (enable_alt) then
call sdata%init (simulation%n_prc, simulation%n_alt)
do i = 1, simulation%n_alt
sdata%md5sum_alt(i) = simulation%get_md5sum_alt (i)
end do
else
call sdata%init (simulation%n_prc)
end if
sdata%unweighted = simulation%unweighted
sdata%negative_weights = simulation%negative_weights
sdata%norm_mode = simulation%norm_mode
process => simulation%entry(1)%get_process_ptr ()
if (associated (process)) then
beam_data => process%get_beam_data_ptr ()
construct_beam_data = .false.
else
n = simulation%entry(1)%n_in
sqrts = simulation%local%get_sqrts ()
beam_structure => simulation%local%beam_structure
call beam_structure%check_against_n_in (n, construct_beam_data)
if (construct_beam_data) then
allocate (beam_data)
model => simulation%local%model
decay_rest_frame = &
simulation%local%get_lval (var_str ("?decay_rest_frame"))
call beam_data%init_structure (beam_structure, &
sqrts, model, decay_rest_frame)
else
beam_data => null ()
end if
end if
if (associated (beam_data)) then
n = beam_data%get_n_in ()
sdata%n_beam = n
allocate (flv (n))
flv = beam_data%get_flavor ()
sdata%pdg_beam(:n) = flv%get_pdg ()
sdata%energy_beam(:n) = beam_data%get_energy ()
if (construct_beam_data) deallocate (beam_data)
else
n = simulation%entry(1)%n_in
sdata%n_beam = n
process_id = simulation%entry(1)%process_id
call simulation%local%prclib%get_pdg_in_1 &
(process_id, sdata%pdg_beam(:n))
sdata%energy_beam(:n) = sqrts / n
end if
do i = 1, simulation%n_prc
if (.not. simulation%entry(i)%valid) cycle
process => simulation%entry(i)%get_process_ptr ()
if (associated (process)) then
sdata%proc_num_id(i) = process%get_num_id ()
else
process_id = simulation%entry(i)%process_id
sdata%proc_num_id(i) = simulation%local%prclib%get_num_id (process_id)
end if
if (sdata%proc_num_id(i) == 0) sdata%proc_num_id(i) = i
if (simulation%entry(i)%has_integral) then
sdata%cross_section(i) = simulation%entry(i)%integral
sdata%error(i) = simulation%entry(i)%error
end if
end do
sdata%total_cross_section = sum (sdata%cross_section)
sdata%md5sum_prc = simulation%get_md5sum_prc ()
sdata%md5sum_cfg = simulation%get_md5sum_cfg ()
if (simulation%split_n_evt > 0 .or. simulation%split_n_kbytes > 0) then
sdata%split_n_evt = simulation%split_n_evt
sdata%split_n_kbytes = simulation%split_n_kbytes
sdata%split_index = simulation%split_index
end if
end function simulation_get_data
@ %def simulation_get_data
@ Return a default name for the current event sample. This is the
process ID of the first process.
<<Simulations: simulation: TBP>>=
procedure :: get_default_sample_name => simulation_get_default_sample_name
<<Simulations: procedures>>=
function simulation_get_default_sample_name (simulation) result (sample)
class(simulation_t), intent(in) :: simulation
type(string_t) :: sample
type(process_t), pointer :: process
sample = "whizard"
if (simulation%n_prc > 0) then
process => simulation%entry(1)%get_process_ptr ()
if (associated (process)) then
sample = process%get_id ()
end if
end if
end function simulation_get_default_sample_name
@ %def simulation_get_default_sample_name
@
<<Simulations: simulation: TBP>>=
procedure :: is_valid => simulation_is_valid
<<Simulations: procedures>>=
function simulation_is_valid (simulation) result (valid)
class(simulation_t), intent(inout) :: simulation
logical :: valid
valid = simulation%valid
end function simulation_is_valid
@ %def simulation_is_valid
@
Return the hard-interaction particle set for event entry [[i_prc]].
<<Simulations: simulation: TBP>>=
procedure :: get_hard_particle_set => simulation_get_hard_particle_set
<<Simulations: procedures>>=
function simulation_get_hard_particle_set (simulation, i_prc) result (pset)
class(simulation_t), intent(in) :: simulation
integer, intent(in) :: i_prc
type(particle_set_t) :: pset
call simulation%entry(i_prc)%get_hard_particle_set (pset)
end function simulation_get_hard_particle_set
@ %def simulation_get_hard_particle_set
@
\subsection{Auxiliary}
Call pacify: eliminate numerical noise.
<<Simulations: public>>=
public :: pacify
<<Simulations: interfaces>>=
interface pacify
module procedure pacify_simulation
end interface
<<Simulations: procedures>>=
subroutine pacify_simulation (simulation)
class(simulation_t), intent(inout) :: simulation
integer :: i, j
i = simulation%i_prc
if (i > 0) then
call pacify (simulation%entry(i))
do j = 1, simulation%n_alt
call pacify (simulation%alt_entry(i,j))
end do
end if
end subroutine pacify_simulation
@ %def pacify_simulation
@ Manually evaluate expressions for the currently selected process.
This is used only in the unit tests.
<<Simulations: simulation: TBP>>=
procedure :: evaluate_expressions => simulation_evaluate_expressions
<<Simulations: procedures>>=
subroutine simulation_evaluate_expressions (simulation)
class(simulation_t), intent(inout) :: simulation
call simulation%entry(simulation%i_prc)%evaluate_expressions ()
end subroutine simulation_evaluate_expressions
@ %def simulation_evaluate_expressions
@ Manually evaluate event transforms for the currently selected
process. This is used only in the unit tests.
<<Simulations: simulation: TBP>>=
procedure :: evaluate_transforms => simulation_evaluate_transforms
<<Simulations: procedures>>=
subroutine simulation_evaluate_transforms (simulation)
class(simulation_t), intent(inout) :: simulation
associate (entry => simulation%entry(simulation%i_prc))
call entry%evaluate_transforms ()
end associate
end subroutine simulation_evaluate_transforms
@ %def simulation_evaluate_transforms
@
\subsection{Unit tests}
Test module, followed by the stand-alone unit-test procedures.
<<[[simulations_ut.f90]]>>=
<<File header>>
module simulations_ut
use unit_tests
use simulations_uti
<<Standard module head>>
<<Simulations: public test>>
contains
<<Simulations: test driver>>
end module simulations_ut
@ %def simulations_ut
@
<<[[simulations_uti.f90]]>>=
<<File header>>
module simulations_uti
<<Use kinds>>
use kinds, only: i64
<<Use strings>>
use io_units
use format_defs, only: FMT_10, FMT_12
use ifiles
use lexers
use parser
use lorentz
use flavors
use interactions, only: reset_interaction_counter
use process_libraries, only: process_library_t
use prclib_stacks
use phs_forests
use event_base, only: generic_event_t
use event_base, only: event_callback_t
use particles, only: particle_set_t
use eio_data
use eio_base
use eio_direct, only: eio_direct_t
use eio_raw
use eio_ascii
use eio_dump
use eio_callback
use eval_trees
use model_data, only: model_data_t
use models
use rt_data
use event_streams
use decays_ut, only: prepare_testbed
use process, only: process_t
use process_stacks, only: process_entry_t
use process_configurations_ut, only: prepare_test_library
use compilations, only: compile_library
use integrations, only: integrate_process
use simulations
use restricted_subprocesses_uti, only: prepare_resonance_test_library
<<Standard module head>>
<<Simulations: test declarations>>
<<Simulations: test auxiliary types>>
contains
<<Simulations: tests>>
<<Simulations: test auxiliary>>
end module simulations_uti
@ %def simulations_uti
@ API: driver for the unit tests below.
<<Simulations: public test>>=
public :: simulations_test
<<Simulations: test driver>>=
subroutine simulations_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Simulations: execute tests>>
end subroutine simulations_test
@ %def simulations_test
@
\subsubsection{Initialization}
Initialize a [[simulation_t]] object, including the embedded event records.
<<Simulations: execute tests>>=
call test (simulations_1, "simulations_1", &
"initialization", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_1
<<Simulations: tests>>=
subroutine simulations_1 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, procname2
type(rt_data_t), target :: global
type(simulation_t), target :: simulation
write (u, "(A)") "* Test output: simulations_1"
write (u, "(A)") "* Purpose: initialize simulation"
write (u, "(A)")
write (u, "(A)") "* Initialize processes"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_1a"
procname1 = "simulation_1p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("simulations1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
procname2 = "sim_extra"
call prepare_test_library (global, libname, 1, [procname2])
call compile_library (libname, global)
call global%set_string (var_str ("$run_id"), &
var_str ("simulations2"), is_known = .true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call global%set_string (var_str ("$sample"), &
var_str ("sim1"), is_known = .true.)
call integrate_process (procname2, global, local_stack=.true.)
call simulation%init ([procname1, procname2], .false., .true., global)
call simulation%init_process_selector ()
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Write the event record for the first process"
write (u, "(A)")
call simulation%write_event (u, i_prc = 1)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_1"
end subroutine simulations_1
@ %def simulations_1
@
\subsubsection{Weighted events}
Generate events for a single process.
<<Simulations: execute tests>>=
call test (simulations_2, "simulations_2", &
"weighted events", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_2
<<Simulations: tests>>=
subroutine simulations_2 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1
type(rt_data_t), target :: global
type(simulation_t), target :: simulation
type(event_sample_data_t) :: data
write (u, "(A)") "* Test output: simulations_2"
write (u, "(A)") "* Purpose: generate events for a single process"
write (u, "(A)")
write (u, "(A)") "* Initialize processes"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_2a"
procname1 = "simulation_2p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("simulations1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
data = simulation%get_data ()
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate three events"
write (u, "(A)")
call simulation%generate (3)
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Write the event record for the last event"
write (u, "(A)")
call simulation%write_event (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_2"
end subroutine simulations_2
@ %def simulations_2
@
\subsubsection{Unweighted events}
Generate events for a single process.
<<Simulations: execute tests>>=
call test (simulations_3, "simulations_3", &
"unweighted events", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_3
<<Simulations: tests>>=
subroutine simulations_3 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1
type(rt_data_t), target :: global
type(simulation_t), target :: simulation
type(event_sample_data_t) :: data
write (u, "(A)") "* Test output: simulations_3"
write (u, "(A)") "* Purpose: generate unweighted events &
&for a single process"
write (u, "(A)")
write (u, "(A)") "* Initialize processes"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_3a"
procname1 = "simulation_3p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("simulations1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
data = simulation%get_data ()
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate three events"
write (u, "(A)")
call simulation%generate (3)
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Write the event record for the last event"
write (u, "(A)")
call simulation%write_event (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_3"
end subroutine simulations_3
@ %def simulations_3
@
\subsubsection{Simulating process with structure functions}
Generate events for a single process.
<<Simulations: execute tests>>=
call test (simulations_4, "simulations_4", &
"process with structure functions", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_4
<<Simulations: tests>>=
subroutine simulations_4 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1
type(rt_data_t), target :: global
type(flavor_t) :: flv
type(string_t) :: name
type(simulation_t), target :: simulation
type(event_sample_data_t) :: data
write (u, "(A)") "* Test output: simulations_4"
write (u, "(A)") "* Purpose: generate events for a single process &
&with structure functions"
write (u, "(A)")
write (u, "(A)") "* Initialize processes"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_4a"
procname1 = "simulation_4p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.true., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%model_set_real (var_str ("ms"), &
0._default)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call reset_interaction_counter ()
call flv%init (25, global%model)
name = flv%get_name ()
call global%beam_structure%init_sf ([name, name], [1])
call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
write (u, "(A)") "* Integrate"
write (u, "(A)")
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
call global%set_string (var_str ("$sample"), &
var_str ("simulations4"), is_known = .true.)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
data = simulation%get_data ()
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate three events"
write (u, "(A)")
call simulation%generate (3)
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Write the event record for the last event"
write (u, "(A)")
call simulation%write_event (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_4"
end subroutine simulations_4
@ %def simulations_4
@
\subsubsection{Event I/O}
Generate event for a test process, write to file and reread.
<<Simulations: execute tests>>=
call test (simulations_5, "simulations_5", &
"raw event I/O", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_5
<<Simulations: tests>>=
subroutine simulations_5 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, sample
type(rt_data_t), target :: global
class(eio_t), allocatable :: eio
type(simulation_t), allocatable, target :: simulation
write (u, "(A)") "* Test output: simulations_5"
write (u, "(A)") "* Purpose: generate events for a single process"
write (u, "(A)") "* write to file and reread"
write (u, "(A)")
write (u, "(A)") "* Initialize processes"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_5a"
procname1 = "simulation_5p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("simulations5"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
sample = "simulations5"
call global%set_string (var_str ("$sample"), &
sample, is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
write (u, "(A)") "* Initialize raw event file"
write (u, "(A)")
allocate (eio_raw_t :: eio)
call eio%init_out (sample)
write (u, "(A)") "* Generate an event"
write (u, "(A)")
call simulation%generate (1)
call simulation%write_event (u)
call simulation%write_event (eio)
call eio%final ()
deallocate (eio)
call simulation%final ()
deallocate (simulation)
write (u, "(A)")
write (u, "(A)") "* Re-read the event from file"
write (u, "(A)")
call global%set_log (var_str ("?update_sqme"), &
.true., is_known = .true.)
call global%set_log (var_str ("?update_weight"), &
.true., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
allocate (eio_raw_t :: eio)
call eio%init_in (sample)
call simulation%read_event (eio)
call simulation%write_event (u)
write (u, "(A)")
write (u, "(A)") "* Recalculate process instance"
write (u, "(A)")
call simulation%recalculate ()
call simulation%evaluate_expressions ()
call simulation%write_event (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_5"
end subroutine simulations_5
@ %def simulations_5
@
\subsubsection{Event I/O}
Generate event for a real process with structure functions, write to file and
reread.
<<Simulations: execute tests>>=
call test (simulations_6, "simulations_6", &
"raw event I/O with structure functions", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_6
<<Simulations: tests>>=
subroutine simulations_6 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, sample
type(rt_data_t), target :: global
class(eio_t), allocatable :: eio
type(simulation_t), allocatable, target :: simulation
type(flavor_t) :: flv
type(string_t) :: name
write (u, "(A)") "* Test output: simulations_6"
write (u, "(A)") "* Purpose: generate events for a single process"
write (u, "(A)") "* write to file and reread"
write (u, "(A)")
write (u, "(A)") "* Initialize process and integrate"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_6"
procname1 = "simulation_6p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.true., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%model_set_real (var_str ("ms"), &
0._default)
call flv%init (25, global%model)
name = flv%get_name ()
call global%beam_structure%init_sf ([name, name], [1])
call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call reset_interaction_counter ()
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
sample = "simulations6"
call global%set_string (var_str ("$sample"), &
sample, is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
write (u, "(A)") "* Initialize raw event file"
write (u, "(A)")
allocate (eio_raw_t :: eio)
call eio%init_out (sample)
write (u, "(A)") "* Generate an event"
write (u, "(A)")
call simulation%generate (1)
call pacify (simulation)
call simulation%write_event (u, verbose = .true., testflag = .true.)
call simulation%write_event (eio)
call eio%final ()
deallocate (eio)
call simulation%final ()
deallocate (simulation)
write (u, "(A)")
write (u, "(A)") "* Re-read the event from file"
write (u, "(A)")
call reset_interaction_counter ()
call global%set_log (var_str ("?update_sqme"), &
.true., is_known = .true.)
call global%set_log (var_str ("?update_weight"), &
.true., is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
allocate (eio_raw_t :: eio)
call eio%init_in (sample)
call simulation%read_event (eio)
call simulation%write_event (u, verbose = .true., testflag = .true.)
write (u, "(A)")
write (u, "(A)") "* Recalculate process instance"
write (u, "(A)")
call simulation%recalculate ()
call simulation%evaluate_expressions ()
call simulation%write_event (u, verbose = .true., testflag = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call eio%final ()
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_6"
end subroutine simulations_6
@ %def simulations_6
@
\subsubsection{Automatic Event I/O}
Generate events with raw-format event file as cache: generate, reread,
append.
<<Simulations: execute tests>>=
call test (simulations_7, "simulations_7", &
"automatic raw event I/O", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_7
<<Simulations: tests>>=
subroutine simulations_7 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, sample
type(rt_data_t), target :: global
type(string_t), dimension(0) :: empty_string_array
type(event_sample_data_t) :: data
type(event_stream_array_t) :: es_array
type(simulation_t), allocatable, target :: simulation
type(flavor_t) :: flv
type(string_t) :: name
write (u, "(A)") "* Test output: simulations_7"
write (u, "(A)") "* Purpose: generate events for a single process"
write (u, "(A)") "* write to file and reread"
write (u, "(A)")
write (u, "(A)") "* Initialize process and integrate"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_7"
procname1 = "simulation_7p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.true., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%model_set_real (var_str ("ms"), &
0._default)
call flv%init (25, global%model)
name = flv%get_name ()
call global%beam_structure%init_sf ([name, name], [1])
call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call reset_interaction_counter ()
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
sample = "simulations7"
call global%set_string (var_str ("$sample"), &
sample, is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
write (u, "(A)") "* Initialize raw event file"
write (u, "(A)")
data%md5sum_prc = simulation%get_md5sum_prc ()
data%md5sum_cfg = simulation%get_md5sum_cfg ()
call es_array%init (sample, [var_str ("raw")], global, data)
write (u, "(A)") "* Generate an event"
write (u, "(A)")
call simulation%generate (1, es_array)
call es_array%final ()
call simulation%final ()
deallocate (simulation)
write (u, "(A)") "* Re-read the event from file and generate another one"
write (u, "(A)")
call global%set_log (&
var_str ("?rebuild_events"), .false., is_known = .true.)
call reset_interaction_counter ()
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
data%md5sum_prc = simulation%get_md5sum_prc ()
data%md5sum_cfg = simulation%get_md5sum_cfg ()
call es_array%init (sample, empty_string_array, global, data, &
input = var_str ("raw"))
call simulation%generate (2, es_array)
call pacify (simulation)
call simulation%write_event (u, verbose = .true.)
call es_array%final ()
call simulation%final ()
deallocate (simulation)
write (u, "(A)")
write (u, "(A)") "* Re-read both events from file"
write (u, "(A)")
call reset_interaction_counter ()
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
data%md5sum_prc = simulation%get_md5sum_prc ()
data%md5sum_cfg = simulation%get_md5sum_cfg ()
call es_array%init (sample, empty_string_array, global, data, &
input = var_str ("raw"))
call simulation%generate (2, es_array)
call pacify (simulation)
call simulation%write_event (u, verbose = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call es_array%final ()
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_7"
end subroutine simulations_7
@ %def simulations_7
@
\subsubsection{Rescanning Events}
Generate events and rescan the resulting raw event file.
<<Simulations: execute tests>>=
call test (simulations_8, "simulations_8", &
"rescan raw event file", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_8
<<Simulations: tests>>=
subroutine simulations_8 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, sample
type(rt_data_t), target :: global
type(string_t), dimension(0) :: empty_string_array
type(event_sample_data_t) :: data
type(event_stream_array_t) :: es_array
type(simulation_t), allocatable, target :: simulation
type(flavor_t) :: flv
type(string_t) :: name
write (u, "(A)") "* Test output: simulations_8"
write (u, "(A)") "* Purpose: generate events for a single process"
write (u, "(A)") "* write to file and rescan"
write (u, "(A)")
write (u, "(A)") "* Initialize process and integrate"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_8"
procname1 = "simulation_8p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.true., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%model_set_real (var_str ("ms"), &
0._default)
call flv%init (25, global%model)
name = flv%get_name ()
call global%beam_structure%init_sf ([name, name], [1])
call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call reset_interaction_counter ()
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
sample = "simulations8"
call global%set_string (var_str ("$sample"), &
sample, is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
write (u, "(A)") "* Initialize raw event file"
write (u, "(A)")
data%md5sum_prc = simulation%get_md5sum_prc ()
data%md5sum_cfg = simulation%get_md5sum_cfg ()
write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
call es_array%init (sample, [var_str ("raw")], global, &
data)
write (u, "(A)")
write (u, "(A)") "* Generate an event"
write (u, "(A)")
call simulation%generate (1, es_array)
call pacify (simulation)
call simulation%write_event (u, verbose = .true., testflag = .true.)
call es_array%final ()
call simulation%final ()
deallocate (simulation)
write (u, "(A)")
write (u, "(A)") "* Re-read the event from file"
write (u, "(A)")
call reset_interaction_counter ()
allocate (simulation)
call simulation%init ([procname1], .false., .false., global)
call simulation%init_process_selector ()
data%md5sum_prc = simulation%get_md5sum_prc ()
data%md5sum_cfg = ""
write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
call es_array%init (sample, empty_string_array, global, data, &
input = var_str ("raw"), input_sample = sample, allow_switch = .false.)
call simulation%rescan (1, es_array, global = global)
write (u, "(A)")
call pacify (simulation)
call simulation%write_event (u, verbose = .true., testflag = .true.)
call es_array%final ()
call simulation%final ()
deallocate (simulation)
write (u, "(A)")
write (u, "(A)") "* Re-read again and recalculate"
write (u, "(A)")
call reset_interaction_counter ()
call global%set_log (var_str ("?update_sqme"), &
.true., is_known = .true.)
call global%set_log (var_str ("?update_event"), &
.true., is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .false., .false., global)
call simulation%init_process_selector ()
data%md5sum_prc = simulation%get_md5sum_prc ()
data%md5sum_cfg = ""
write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
call es_array%init (sample, empty_string_array, global, data, &
input = var_str ("raw"), input_sample = sample, allow_switch = .false.)
call simulation%rescan (1, es_array, global = global)
write (u, "(A)")
call pacify (simulation)
call simulation%write_event (u, verbose = .true., testflag = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call es_array%final ()
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_8"
end subroutine simulations_8
@ %def simulations_8
@
\subsubsection{Rescanning Check}
Generate events and rescan with process mismatch.
<<Simulations: execute tests>>=
call test (simulations_9, "simulations_9", &
"rescan mismatch", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_9
<<Simulations: tests>>=
subroutine simulations_9 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, sample
type(rt_data_t), target :: global
type(string_t), dimension(0) :: empty_string_array
type(event_sample_data_t) :: data
type(event_stream_array_t) :: es_array
type(simulation_t), allocatable, target :: simulation
type(flavor_t) :: flv
type(string_t) :: name
logical :: error
write (u, "(A)") "* Test output: simulations_9"
write (u, "(A)") "* Purpose: generate events for a single process"
write (u, "(A)") "* write to file and rescan"
write (u, "(A)")
write (u, "(A)") "* Initialize process and integrate"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_9"
procname1 = "simulation_9p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("wood"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("vamp"), is_known = .true.)
call global%set_log (var_str ("?use_vamp_equivalences"),&
.true., is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%model_set_real (var_str ("ms"), &
0._default)
call flv%init (25, global%model)
name = flv%get_name ()
call global%beam_structure%init_sf ([name, name], [1])
call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call reset_interaction_counter ()
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
sample = "simulations9"
call global%set_string (var_str ("$sample"), &
sample, is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize raw event file"
write (u, "(A)")
data%md5sum_prc = simulation%get_md5sum_prc ()
data%md5sum_cfg = simulation%get_md5sum_cfg ()
write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
call es_array%init (sample, [var_str ("raw")], global, &
data)
write (u, "(A)")
write (u, "(A)") "* Generate an event"
write (u, "(A)")
call simulation%generate (1, es_array)
call es_array%final ()
call simulation%final ()
deallocate (simulation)
write (u, "(A)") "* Initialize event generation for different parameters"
write (u, "(A)")
call reset_interaction_counter ()
allocate (simulation)
call simulation%init ([procname1, procname1], .false., .false., global)
call simulation%init_process_selector ()
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Attempt to re-read the events (should fail)"
write (u, "(A)")
data%md5sum_prc = simulation%get_md5sum_prc ()
data%md5sum_cfg = ""
write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
call es_array%init (sample, empty_string_array, global, data, &
input = var_str ("raw"), input_sample = sample, &
allow_switch = .false., error = error)
write (u, "(1x,A,L1)") "error = ", error
call simulation%rescan (1, es_array, global = global)
call es_array%final ()
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_9"
end subroutine simulations_9
@ %def simulations_9
@
\subsubsection{Alternative weights}
Generate an event for a single process and reweight it in a
simultaneous calculation.
<<Simulations: execute tests>>=
call test (simulations_10, "simulations_10", &
"alternative weight", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_10
<<Simulations: tests>>=
subroutine simulations_10 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, expr_text
type(rt_data_t), target :: global
type(rt_data_t), dimension(1), target :: alt_env
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: pt_weight
type(simulation_t), target :: simulation
type(event_sample_data_t) :: data
write (u, "(A)") "* Test output: simulations_10"
write (u, "(A)") "* Purpose: reweight event"
write (u, "(A)")
write (u, "(A)") "* Initialize processes"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_pexpr_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_10a"
procname1 = "simulation_10p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("simulations1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize alternative environment with custom weight"
write (u, "(A)")
call alt_env(1)%local_init (global)
call alt_env(1)%activate ()
expr_text = "2"
write (u, "(A,A)") "weight = ", char (expr_text)
write (u, *)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_weight, stream, .true.)
call stream_final (stream)
alt_env(1)%pn%weight_expr => pt_weight%get_root_ptr ()
call alt_env(1)%write_expr (u)
write (u, "(A)")
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
call simulation%init ([procname1], .true., .true., global, alt_env=alt_env)
call simulation%init_process_selector ()
data = simulation%get_data ()
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate an event"
write (u, "(A)")
call simulation%generate (1)
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Write the event record for the last event"
write (u, "(A)")
call simulation%write_event (u)
write (u, "(A)")
write (u, "(A)") "* Write the event record for the alternative setup"
write (u, "(A)")
call simulation%write_alt_event (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call simulation%final ()
call global%final ()
call syntax_model_file_final ()
call syntax_pexpr_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_10"
end subroutine simulations_10
@ %def simulations_10
@
\subsubsection{Decays}
Generate an event with subsequent partonic decays.
<<Simulations: execute tests>>=
call test (simulations_11, "simulations_11", &
"decay", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_11
<<Simulations: tests>>=
subroutine simulations_11 (u)
integer, intent(in) :: u
type(rt_data_t), target :: global
type(prclib_entry_t), pointer :: lib
type(string_t) :: prefix, procname1, procname2
type(simulation_t), target :: simulation
write (u, "(A)") "* Test output: simulations_11"
write (u, "(A)") "* Purpose: apply decay"
write (u, "(A)")
write (u, "(A)") "* Initialize processes"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
allocate (lib)
call global%add_prclib (lib)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
prefix = "simulation_11"
procname1 = prefix // "_p"
procname2 = prefix // "_d"
call prepare_testbed &
(global%prclib, global%process_stack, &
prefix, global%os_data, &
scattering=.true., decay=.true.)
call global%select_model (var_str ("Test"))
call global%model%set_par (var_str ("ff"), 0.4_default)
call global%model%set_par (var_str ("mf"), &
global%model%get_real (var_str ("ff")) &
* global%model%get_real (var_str ("ms")))
call global%model%set_unstable (25, [procname2])
write (u, "(A)") "* Initialize simulation object"
write (u, "(A)")
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
write (u, "(A)") "* Generate event"
write (u, "(A)")
call simulation%generate (1)
call simulation%write (u)
write (u, *)
call simulation%write_event (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
write (u, "(A)")
call simulation%final ()
call global%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_11"
end subroutine simulations_11
@ %def simulations_11
@
\subsubsection{Split Event Files}
Generate event for a real process with structure functions and write to file,
accepting a limit for the number of events per file.
<<Simulations: execute tests>>=
call test (simulations_12, "simulations_12", &
"split event files", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_12
<<Simulations: tests>>=
subroutine simulations_12 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, sample
type(rt_data_t), target :: global
class(eio_t), allocatable :: eio
type(simulation_t), allocatable, target :: simulation
type(flavor_t) :: flv
integer :: i_evt
write (u, "(A)") "* Test output: simulations_12"
write (u, "(A)") "* Purpose: generate events for a single process"
write (u, "(A)") "* and write to split event files"
write (u, "(A)")
write (u, "(A)") "* Initialize process and integrate"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_12"
procname1 = "simulation_12p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%model_set_real (var_str ("ms"), &
0._default)
call flv%init (25, global%model)
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
sample = "simulations_12"
call global%set_string (var_str ("$sample"), &
sample, is_known = .true.)
call global%set_int (var_str ("sample_split_n_evt"), &
2, is_known = .true.)
call global%set_int (var_str ("sample_split_index"), &
42, is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize ASCII event file"
write (u, "(A)")
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 = simulation%get_data ())
write (u, "(A)") "* Generate 5 events, distributed among three files"
do i_evt = 1, 5
call simulation%generate (1)
call simulation%write_event (eio)
end do
call eio%final ()
deallocate (eio)
call simulation%final ()
deallocate (simulation)
write (u, *)
call display_file ("simulations_12.42.short.evt", u)
write (u, *)
call display_file ("simulations_12.43.short.evt", u)
write (u, *)
call display_file ("simulations_12.44.short.evt", u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_12"
end subroutine simulations_12
@ %def simulations_12
@ Auxiliary: display file contents.
<<Simulations: public test auxiliary>>=
public :: display_file
<<Simulations: test auxiliary>>=
subroutine display_file (file, u)
use io_units, only: free_unit
character(*), intent(in) :: file
integer, intent(in) :: u
character(256) :: buffer
integer :: u_file
write (u, "(3A)") "* Contents of file '", file, "':"
write (u, *)
u_file = free_unit ()
open (u_file, file = file, action = "read", status = "old")
do
read (u_file, "(A)", end = 1) buffer
write (u, "(A)") trim (buffer)
end do
1 continue
end subroutine display_file
@ %def display_file
@
\subsubsection{Callback}
Generate events and execute a callback in place of event I/O.
<<Simulations: execute tests>>=
call test (simulations_13, "simulations_13", &
"callback", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_13
<<Simulations: tests>>=
subroutine simulations_13 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, sample
type(rt_data_t), target :: global
class(eio_t), allocatable :: eio
type(simulation_t), allocatable, target :: simulation
type(flavor_t) :: flv
integer :: i_evt
type(simulations_13_callback_t) :: event_callback
write (u, "(A)") "* Test output: simulations_13"
write (u, "(A)") "* Purpose: generate events for a single process"
write (u, "(A)") "* and execute callback"
write (u, "(A)")
write (u, "(A)") "* Initialize process and integrate"
write (u, "(A)")
call syntax_model_file_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_13"
procname1 = "simulation_13p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call flv%init (25, global%model)
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("r1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
sample = "simulations_13"
call global%set_string (var_str ("$sample"), &
sample, is_known = .true.)
allocate (simulation)
call simulation%init ([procname1], .true., .true., global)
call simulation%init_process_selector ()
write (u, "(A)") "* Prepare callback object"
write (u, "(A)")
event_callback%u = u
call global%set_event_callback (event_callback)
write (u, "(A)") "* Initialize callback I/O object"
write (u, "(A)")
allocate (eio_callback_t :: eio)
select type (eio)
class is (eio_callback_t)
call eio%set_parameters (callback = event_callback, &
count_interval = 3)
end select
call eio%init_out (sample, data = simulation%get_data ())
write (u, "(A)") "* Generate 7 events, with callback every 3 events"
write (u, "(A)")
do i_evt = 1, 7
call simulation%generate (1)
call simulation%write_event (eio)
end do
call eio%final ()
deallocate (eio)
call simulation%final ()
deallocate (simulation)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_13"
end subroutine simulations_13
@ %def simulations_13
@ The callback object and procedure. In the type extension, we can
store the output channel [[u]] so we know where to write into.
<<Simulations: test auxiliary types>>=
type, extends (event_callback_t) :: simulations_13_callback_t
integer :: u
contains
procedure :: write => simulations_13_callback_write
procedure :: proc => simulations_13_callback
end type simulations_13_callback_t
@ %def simulations_13_callback_t
<<Simulations: test auxiliary>>=
subroutine simulations_13_callback_write (event_callback, unit)
class(simulations_13_callback_t), intent(in) :: event_callback
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Hello"
end subroutine simulations_13_callback_write
subroutine simulations_13_callback (event_callback, i, event)
class(simulations_13_callback_t), intent(in) :: event_callback
integer(i64), intent(in) :: i
class(generic_event_t), intent(in) :: event
write (event_callback%u, "(A,I0)") "hello event #", i
end subroutine simulations_13_callback
@ %def simulations_13_callback_write
@ %def simulations_13_callback
@
\subsubsection{Resonant subprocess setup}
Prepare a process with resonances and enter resonant subprocesses in
the simulation object. Select a kinematics configuration and compute
probabilities for resonant subprocesses.
The process and its initialization is taken from [[processes_18]], but
we need a complete \oMega\ matrix element here.
<<Simulations: execute tests>>=
call test (simulations_14, "simulations_14", &
"resonant subprocesses evaluation", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_14
<<Simulations: tests>>=
subroutine simulations_14 (u)
integer, intent(in) :: u
type(string_t) :: libname, libname_generated
type(string_t) :: procname
type(string_t) :: model_name
type(rt_data_t), target :: global
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
class(model_t), pointer :: model
class(model_data_t), pointer :: model_data
type(simulation_t), target :: simulation
type(particle_set_t) :: pset
type(eio_direct_t) :: eio_in
type(eio_dump_t) :: eio_out
real(default) :: sqrts, mw, pp
real(default), dimension(3) :: p3
type(vector4_t), dimension(:), allocatable :: p
real(default), dimension(:), allocatable :: m
integer :: u_verbose, i
real(default) :: sqme_proc
real(default), dimension(:), allocatable :: sqme
real(default) :: on_shell_limit
integer, dimension(:), allocatable :: i_array
real(default), dimension(:), allocatable :: prob_array
write (u, "(A)") "* Test output: simulations_14"
write (u, "(A)") "* Purpose: construct resonant subprocesses &
&in the simulation object"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
libname = "simulations_14_lib"
procname = "simulations_14_p"
call global%global_init ()
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_log (var_str ("?update_sqme"), &
.true., is_known = .true.)
call global%set_log (var_str ("?update_weight"), &
.true., is_known = .true.)
call global%set_log (var_str ("?update_event"), &
.true., is_known = .true.)
model_name = "SM"
call global%select_model (model_name)
allocate (model)
call model%init_instance (global%model)
model_data => model
write (u, "(A)") "* Initialize process library and process"
write (u, "(A)")
allocate (lib_entry)
call lib_entry%init (libname)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
call prepare_resonance_test_library &
(lib, libname, procname, model_data, global, u)
write (u, "(A)")
write (u, "(A)") "* Initialize simulation object &
&with resonant subprocesses"
write (u, "(A)")
call global%set_log (var_str ("?resonance_history"), &
.true., is_known = .true.)
call global%set_real (var_str ("resonance_on_shell_limit"), &
10._default, is_known = .true.)
call simulation%init ([procname], &
integrate=.false., generate=.false., local=global)
call simulation%write_resonant_subprocess_data (u, 1)
write (u, "(A)")
write (u, "(A)") "* Resonant subprocesses: generated library"
write (u, "(A)")
libname_generated = procname // "_R"
lib => global%prclib_stack%get_library_ptr (libname_generated)
if (associated (lib)) call lib%write (u, libpath=.false.)
write (u, "(A)")
write (u, "(A)") "* Generated process stack"
write (u, "(A)")
call global%process_stack%show (u)
write (u, "(A)")
write (u, "(A)") "* Particle set"
write (u, "(A)")
pset = simulation%get_hard_particle_set (1)
call pset%write (u)
write (u, "(A)")
write (u, "(A)") "* Initialize object for direct access"
write (u, "(A)")
call eio_in%init_direct &
(n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
pdg = [-11, 11, 1, -2, 24], model=global%model)
call eio_in%set_selection_indices (1, 1, 1, 1)
sqrts = global%get_rval (var_str ("sqrts"))
mw = 80._default ! deliberately slightly different from true mw
pp = sqrt (sqrts**2 - 4 * mw**2) / 2
allocate (p (5), m (5))
p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
m(1) = 0
p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
m(2) = 0
p3(1) = pp/2
p3(2) = mw/2
p3(3) = 0
p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
m(3) = 0
p3(2) = -mw/2
p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
m(4) = 0
p(5) = vector4_moving (sqrts/2,-pp, 1)
m(5) = mw
call eio_in%set_momentum (p, m**2)
call eio_in%write (u)
write (u, "(A)")
write (u, "(A)") "* Transfer and show particle set"
write (u, "(A)")
call simulation%read_event (eio_in)
pset = simulation%get_hard_particle_set (1)
call pset%write (u)
write (u, "(A)")
write (u, "(A)") "* (Re)calculate matrix element"
write (u, "(A)")
call simulation%recalculate (recover_phs = .false.)
call simulation%evaluate_transforms ()
write (u, "(A)") "* Show event with sqme"
write (u, "(A)")
call eio_out%set_parameters (unit = u, &
weights = .true., pacify = .true., compressed = .true.)
call eio_out%init_out (var_str (""))
call simulation%write_event (eio_out)
write (u, "(A)")
write (u, "(A)") "* Write event to separate file &
&'simulations_14_event_verbose.log'"
u_verbose = free_unit ()
open (unit = u_verbose, file = "simulations_14_event_verbose.log", &
status = "replace", action = "write")
call simulation%write (u_verbose)
write (u_verbose, *)
call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
close (u_verbose)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_14"
end subroutine simulations_14
@ %def simulations_14
@
\subsubsection{Resonant subprocess simulation}
Prepare a process with resonances and enter resonant subprocesses in
the simulation object. Simulate events with selection of resonance
histories.
The process and its initialization is taken from [[processes_18]], but
we need a complete \oMega\ matrix element here.
<<Simulations: execute tests>>=
call test (simulations_15, "simulations_15", &
"resonant subprocesses in simulation", &
u, results)
<<Simulations: test declarations>>=
public :: simulations_15
<<Simulations: tests>>=
subroutine simulations_15 (u)
integer, intent(in) :: u
type(string_t) :: libname, libname_generated
type(string_t) :: procname
type(string_t) :: model_name
type(rt_data_t), target :: global
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
class(model_t), pointer :: model
class(model_data_t), pointer :: model_data
type(simulation_t), target :: simulation
real(default) :: sqrts
type(eio_dump_t) :: eio_out
integer :: u_verbose
write (u, "(A)") "* Test output: simulations_15"
write (u, "(A)") "* Purpose: generate event with resonant subprocess"
write (u, "(A)")
write (u, "(A)") "* Build and load a test library with one process"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_phs_forest_init ()
libname = "simulations_15_lib"
procname = "simulations_15_p"
call global%global_init ()
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_log (var_str ("?update_sqme"), &
.true., is_known = .true.)
call global%set_log (var_str ("?update_weight"), &
.true., is_known = .true.)
call global%set_log (var_str ("?update_event"), &
.true., is_known = .true.)
call global%set_log (var_str ("?resonance_history"), &
.true., is_known = .true.)
call global%set_real (var_str ("resonance_on_shell_limit"), &
10._default, is_known = .true.)
model_name = "SM"
call global%select_model (model_name)
allocate (model)
call model%init_instance (global%model)
model_data => model
write (u, "(A)") "* Initialize process library and process"
write (u, "(A)")
allocate (lib_entry)
call lib_entry%init (libname)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
call prepare_resonance_test_library &
(lib, libname, procname, model_data, global, u)
write (u, "(A)")
write (u, "(A)") "* Initialize simulation object &
&with resonant subprocesses"
write (u, "(A)")
call global%it_list%init ([1], [1000])
call simulation%init ([procname], &
integrate=.true., generate=.true., local=global)
call simulation%write_resonant_subprocess_data (u, 1)
write (u, "(A)")
write (u, "(A)") "* Generate event"
write (u, "(A)")
call simulation%init_process_selector ()
call simulation%generate (1)
call eio_out%set_parameters (unit = u, &
weights = .true., pacify = .true., compressed = .true.)
call eio_out%init_out (var_str (""))
call simulation%write_event (eio_out)
write (u, "(A)")
write (u, "(A)") "* Write event to separate file &
&'simulations_15_event_verbose.log'"
u_verbose = free_unit ()
open (unit = u_verbose, file = "simulations_15_event_verbose.log", &
status = "replace", action = "write")
call simulation%write (u_verbose)
write (u_verbose, *)
call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
close (u_verbose)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call simulation%final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_15"
end subroutine simulations_15
@ %def simulations_15
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{More Unit Tests}
This chapter collects some procedures for testing that can't be
provided at the point where the corresponding modules are defined,
because they use other modules of a different level.
(We should move them back, collecting the high-level functionality in
init/final hooks that we can set at runtime.)
\section{Expression Testing}
Expression objects are part of process and event objects, but the
process and event object modules should not depend on the
implementation of expressions. Here, we collect unit tests that
depend on expression implementation.
<<[[expr_tests_ut.f90]]>>=
<<File header>>
module expr_tests_ut
use unit_tests
use expr_tests_uti
<<Standard module head>>
<<Expr tests: public test>>
contains
<<Expr tests: test driver>>
end module expr_tests_ut
@ %def expr_tests_ut
@
<<[[expr_tests_uti.f90]]>>=
<<File header>>
module expr_tests_uti
<<Use kinds>>
<<Use strings>>
use format_defs, only: FMT_12
use format_utils, only: write_separator
use os_interface
use sm_qcd
use lorentz
use ifiles
use lexers
use parser
use model_data
use interactions, only: reset_interaction_counter
use process_libraries
use subevents
use subevt_expr
use rng_base
use mci_base
use phs_base
use variables, only: var_list_t
use eval_trees
use models
use prc_core
use prc_test
use process, only: process_t
use instances, only: process_instance_t
use events
use rng_base_ut, only: rng_test_factory_t
use phs_base_ut, only: phs_test_config_t
<<Standard module head>>
<<Expr tests: test declarations>>
contains
<<Expr tests: tests>>
end module expr_tests_uti
@ %def expr_tests_uti
@
\subsection{Test}
This is the master for calling self-test procedures.
<<Expr tests: public test>>=
public :: subevt_expr_test
<<Expr tests: test driver>>=
subroutine subevt_expr_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Expr tests: execute tests>>
end subroutine subevt_expr_test
@ %def subevt_expr_test
@
\subsubsection{Parton-event expressions}
<<Expr tests: execute tests>>=
call test (subevt_expr_1, "subevt_expr_1", &
"parton-event expressions", &
u, results)
<<Expr tests: test declarations>>=
public :: subevt_expr_1
<<Expr tests: tests>>=
subroutine subevt_expr_1 (u)
integer, intent(in) :: u
type(string_t) :: expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: pt_cuts, pt_scale, pt_fac_scale, pt_ren_scale
type(parse_tree_t) :: pt_weight
type(parse_node_t), pointer :: pn_cuts, pn_scale, pn_fac_scale, pn_ren_scale
type(parse_node_t), pointer :: pn_weight
type(eval_tree_factory_t) :: expr_factory
type(os_data_t) :: os_data
type(model_t), target :: model
type(parton_expr_t), target :: expr
real(default) :: E, Ex, m
type(vector4_t), dimension(6) :: p
integer :: i, pdg
logical :: passed
real(default) :: scale, fac_scale, ren_scale, weight
write (u, "(A)") "* Test output: subevt_expr_1"
write (u, "(A)") "* Purpose: Set up a subevt and associated &
&process-specific expressions"
write (u, "(A)")
call syntax_pexpr_init ()
call syntax_model_file_init ()
call os_data_init (os_data)
call model%read (var_str ("Test.mdl"), os_data)
write (u, "(A)") "* Expression texts"
write (u, "(A)")
expr_text = "all Pt > 100 [s]"
write (u, "(A,A)") "cuts = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (pt_cuts, stream, .true.)
call stream_final (stream)
pn_cuts => pt_cuts%get_root_ptr ()
expr_text = "sqrts"
write (u, "(A,A)") "scale = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_scale, stream, .true.)
call stream_final (stream)
pn_scale => pt_scale%get_root_ptr ()
expr_text = "sqrts_hat"
write (u, "(A,A)") "fac_scale = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_fac_scale, stream, .true.)
call stream_final (stream)
pn_fac_scale => pt_fac_scale%get_root_ptr ()
expr_text = "100"
write (u, "(A,A)") "ren_scale = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_ren_scale, stream, .true.)
call stream_final (stream)
pn_ren_scale => pt_ren_scale%get_root_ptr ()
expr_text = "n_tot - n_in - n_out"
write (u, "(A,A)") "weight = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_weight, stream, .true.)
call stream_final (stream)
pn_weight => pt_weight%get_root_ptr ()
call ifile_final (ifile)
write (u, "(A)")
write (u, "(A)") "* Initialize process expr"
write (u, "(A)")
call expr%setup_vars (1000._default)
call expr%var_list%append_real (var_str ("tolerance"), 0._default)
call expr%link_var_list (model%get_var_list_ptr ())
call expr_factory%init (pn_cuts)
call expr%setup_selection (expr_factory)
call expr_factory%init (pn_scale)
call expr%setup_scale (expr_factory)
call expr_factory%init (pn_fac_scale)
call expr%setup_fac_scale (expr_factory)
call expr_factory%init (pn_ren_scale)
call expr%setup_ren_scale (expr_factory)
call expr_factory%init (pn_weight)
call expr%setup_weight (expr_factory)
call write_separator (u)
call expr%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Fill subevt and evaluate expressions"
write (u, "(A)")
call subevt_init (expr%subevt_t, 6)
E = 500._default
Ex = 400._default
m = 125._default
pdg = 25
p(1) = vector4_moving (E, sqrt (E**2 - m**2), 3)
p(2) = vector4_moving (E, -sqrt (E**2 - m**2), 3)
p(3) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 3)
p(4) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 3)
p(5) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 1)
p(6) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 1)
call expr%reset_contents ()
do i = 1, 2
call subevt_set_beam (expr%subevt_t, i, pdg, p(i), m**2)
end do
do i = 3, 4
call subevt_set_incoming (expr%subevt_t, i, pdg, p(i), m**2)
end do
do i = 5, 6
call subevt_set_outgoing (expr%subevt_t, i, pdg, p(i), m**2)
end do
expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
expr%n_in = 2
expr%n_out = 2
expr%n_tot = 4
expr%subevt_filled = .true.
call expr%evaluate (passed, scale, fac_scale, ren_scale, weight)
write (u, "(A,L1)") "Event has passed = ", passed
write (u, "(A," // FMT_12 // ")") "Scale = ", scale
write (u, "(A," // FMT_12 // ")") "Factorization scale = ", fac_scale
write (u, "(A," // FMT_12 // ")") "Renormalization scale = ", ren_scale
write (u, "(A," // FMT_12 // ")") "Weight = ", weight
write (u, "(A)")
call write_separator (u)
call expr%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call expr%final ()
call model%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: subevt_expr_1"
end subroutine subevt_expr_1
@ %def subevt_expr_1
@
\subsubsection{Parton-event expressions}
<<Expr tests: execute tests>>=
call test (subevt_expr_2, "subevt_expr_2", &
"parton-event expressions", &
u, results)
<<Expr tests: test declarations>>=
public :: subevt_expr_2
<<Expr tests: tests>>=
subroutine subevt_expr_2 (u)
integer, intent(in) :: u
type(string_t) :: expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: pt_selection
type(parse_tree_t) :: pt_reweight, pt_analysis
type(parse_node_t), pointer :: pn_selection
type(parse_node_t), pointer :: pn_reweight, pn_analysis
type(os_data_t) :: os_data
type(model_t), target :: model
type(eval_tree_factory_t) :: expr_factory
type(event_expr_t), target :: expr
real(default) :: E, Ex, m
type(vector4_t), dimension(6) :: p
integer :: i, pdg
logical :: passed
real(default) :: reweight
logical :: analysis_flag
write (u, "(A)") "* Test output: subevt_expr_2"
write (u, "(A)") "* Purpose: Set up a subevt and associated &
&process-specific expressions"
write (u, "(A)")
call syntax_pexpr_init ()
call syntax_model_file_init ()
call os_data_init (os_data)
call model%read (var_str ("Test.mdl"), os_data)
write (u, "(A)") "* Expression texts"
write (u, "(A)")
expr_text = "all Pt > 100 [s]"
write (u, "(A,A)") "selection = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (pt_selection, stream, .true.)
call stream_final (stream)
pn_selection => pt_selection%get_root_ptr ()
expr_text = "n_tot - n_in - n_out"
write (u, "(A,A)") "reweight = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_reweight, stream, .true.)
call stream_final (stream)
pn_reweight => pt_reweight%get_root_ptr ()
expr_text = "true"
write (u, "(A,A)") "analysis = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (pt_analysis, stream, .true.)
call stream_final (stream)
pn_analysis => pt_analysis%get_root_ptr ()
call ifile_final (ifile)
write (u, "(A)")
write (u, "(A)") "* Initialize process expr"
write (u, "(A)")
call expr%setup_vars (1000._default)
call expr%link_var_list (model%get_var_list_ptr ())
call expr%var_list%append_real (var_str ("tolerance"), 0._default)
call expr_factory%init (pn_selection)
call expr%setup_selection (expr_factory)
call expr_factory%init (pn_analysis)
call expr%setup_analysis (expr_factory)
call expr_factory%init (pn_reweight)
call expr%setup_reweight (expr_factory)
call write_separator (u)
call expr%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Fill subevt and evaluate expressions"
write (u, "(A)")
call subevt_init (expr%subevt_t, 6)
E = 500._default
Ex = 400._default
m = 125._default
pdg = 25
p(1) = vector4_moving (E, sqrt (E**2 - m**2), 3)
p(2) = vector4_moving (E, -sqrt (E**2 - m**2), 3)
p(3) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 3)
p(4) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 3)
p(5) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 1)
p(6) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 1)
call expr%reset_contents ()
do i = 1, 2
call subevt_set_beam (expr%subevt_t, i, pdg, p(i), m**2)
end do
do i = 3, 4
call subevt_set_incoming (expr%subevt_t, i, pdg, p(i), m**2)
end do
do i = 5, 6
call subevt_set_outgoing (expr%subevt_t, i, pdg, p(i), m**2)
end do
expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
expr%n_in = 2
expr%n_out = 2
expr%n_tot = 4
expr%subevt_filled = .true.
call expr%evaluate (passed, reweight, analysis_flag)
write (u, "(A,L1)") "Event has passed = ", passed
write (u, "(A," // FMT_12 // ")") "Reweighting factor = ", reweight
write (u, "(A,L1)") "Analysis flag = ", analysis_flag
write (u, "(A)")
call write_separator (u)
call expr%write (u)
call write_separator (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call expr%final ()
call model%final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: subevt_expr_2"
end subroutine subevt_expr_2
@ %def subevt_expr_2
@
\subsubsection{Processes: handle partonic cuts}
Initialize a process and process instance, choose a sampling point and
fill the process instance, evaluating a given cut configuration.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Expr tests: execute tests>>=
call test (processes_5, "processes_5", &
"handle cuts (partonic event)", &
u, results)
<<Expr tests: test declarations>>=
public :: processes_5
<<Expr tests: tests>>=
subroutine processes_5 (u)
integer, intent(in) :: u
type(string_t) :: cut_expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: parse_tree
type(eval_tree_factory_t) :: expr_factory
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
type(model_t), pointer :: model_tmp
class(model_data_t), pointer :: model
type(var_list_t), target :: var_list
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_5"
write (u, "(A)") "* Purpose: create a process &
&and fill a process instance"
write (u, "(A)")
write (u, "(A)") "* Prepare a cut expression"
write (u, "(A)")
call syntax_pexpr_init ()
cut_expr_text = "all Pt > 100 [s]"
call ifile_append (ifile, cut_expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (parse_tree, stream, .true.)
write (u, "(A)") "* Build and initialize a test process"
write (u, "(A)")
libname = "processes5"
procname = libname
run_id = "run5"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
call syntax_model_file_init ()
allocate (model_tmp)
call model_tmp%read (var_str ("Test.mdl"), os_data)
call var_list%init_snapshot (model_tmp%get_var_list_ptr ())
model => model_tmp
call reset_interaction_counter ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call var_list%append_real (var_str ("tolerance"), 0._default)
call process%set_var_list (var_list)
call var_list%final ()
allocate (phs_test_config_t :: phs_config_template)
call process%setup_test_cores ()
call process%init_component &
(1, .true., mci_template, 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 ()
write (u, "(A)") "* Complete process initialization and set cuts"
write (u, "(A)")
call process%setup_terms ()
call expr_factory%init (parse_tree%get_root_ptr ())
call process%set_cuts (expr_factory)
call process%write (.false., u, show_var_list=.true., show_expressions=.true.)
write (u, "(A)")
write (u, "(A)") "* Create a process instance"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
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])
write (u, "(A)")
write (u, "(A)") "* Set up kinematics and subevt, check cuts (should fail)"
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 ()
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for another set (should succeed)"
write (u, "(A)")
call process_instance%reset ()
call process_instance%set_mcpar ([0.5_default, 0.125_default])
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 ()
call process_instance%evaluate_trace ()
call process_instance%write (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for another set using convenience procedure &
&(failure)"
write (u, "(A)")
call process_instance%evaluate_sqme (1, [0.0_default, 0.2_default])
call process_instance%write_header (u)
write (u, "(A)")
write (u, "(A)") "* Evaluate for another set using convenience procedure &
&(success)"
write (u, "(A)")
call process_instance%evaluate_sqme (1, [0.1_default, 0.2_default])
call process_instance%write_header (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call process_instance%final ()
deallocate (process_instance)
call process%final ()
deallocate (process)
call parse_tree_final (parse_tree)
call stream_final (stream)
call ifile_final (ifile)
call syntax_pexpr_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_5"
end subroutine processes_5
@ %def processes_5
@
\subsubsection{Processes: scales and such}
Initialize a process and process instance, choose a sampling point and
fill the process instance, evaluating a given cut configuration.
We use the same trivial process as for the previous test. All
momentum and state dependence is trivial, so we just test basic
functionality.
<<Expr tests: execute tests>>=
call test (processes_6, "processes_6", &
"handle scales and weight (partonic event)", &
u, results)
<<Expr tests: test declarations>>=
public :: processes_6
<<Expr tests: tests>>=
subroutine processes_6 (u)
integer, intent(in) :: u
type(string_t) :: expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: pt_scale, pt_fac_scale, pt_ren_scale, pt_weight
type(process_library_t), target :: lib
type(string_t) :: libname
type(string_t) :: procname
type(string_t) :: run_id
type(os_data_t) :: os_data
type(qcd_t) :: qcd
class(rng_factory_t), allocatable :: rng_factory
type(model_t), pointer :: model_tmp
class(model_data_t), pointer :: model
type(var_list_t), target :: var_list
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
type(eval_tree_factory_t) :: expr_factory
write (u, "(A)") "* Test output: processes_6"
write (u, "(A)") "* Purpose: create a process &
&and fill a process instance"
write (u, "(A)")
write (u, "(A)") "* Prepare expressions"
write (u, "(A)")
call syntax_pexpr_init ()
expr_text = "sqrts - 100 GeV"
write (u, "(A,A)") "scale = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_scale, stream, .true.)
call stream_final (stream)
expr_text = "sqrts_hat"
write (u, "(A,A)") "fac_scale = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_fac_scale, stream, .true.)
call stream_final (stream)
expr_text = "eval sqrt (M2) [collect [s]]"
write (u, "(A,A)") "ren_scale = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_ren_scale, stream, .true.)
call stream_final (stream)
expr_text = "n_tot * n_in * n_out * (eval Phi / pi [s])"
write (u, "(A,A)") "weight = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_weight, stream, .true.)
call stream_final (stream)
call ifile_final (ifile)
write (u, "(A)")
write (u, "(A)") "* Build and initialize a test process"
write (u, "(A)")
libname = "processes4"
procname = libname
run_id = "run4"
call os_data_init (os_data)
allocate (rng_test_factory_t :: rng_factory)
call prc_test_create_library (libname, lib)
call syntax_model_file_init ()
allocate (model_tmp)
call model_tmp%read (var_str ("Test.mdl"), os_data)
call var_list%init_snapshot (model_tmp%get_var_list_ptr ())
model => model_tmp
call reset_interaction_counter ()
allocate (process)
call process%init (procname, run_id, &
lib, os_data, qcd, rng_factory, model)
call process%set_var_list (var_list)
call var_list%final ()
call process%setup_test_cores ()
allocate (phs_test_config_t :: phs_config_template)
call process%init_component &
(1, .true., mci_template, 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 ()
write (u, "(A)") "* Complete process initialization and set cuts"
write (u, "(A)")
call process%setup_terms ()
call expr_factory%init (pt_scale%get_root_ptr ())
call process%set_scale (expr_factory)
call expr_factory%init (pt_fac_scale%get_root_ptr ())
call process%set_fac_scale (expr_factory)
call expr_factory%init (pt_ren_scale%get_root_ptr ())
call process%set_ren_scale (expr_factory)
call expr_factory%init (pt_weight%get_root_ptr ())
call process%set_weight (expr_factory)
call process%write (.false., u, show_expressions=.true.)
write (u, "(A)")
write (u, "(A)") "* Create a process instance and evaluate"
write (u, "(A)")
allocate (process_instance)
call process_instance%init (process)
call process_instance%choose_mci (1)
call process_instance%evaluate_sqme (1, [0.5_default, 0.125_default])
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 parse_tree_final (pt_scale)
call parse_tree_final (pt_fac_scale)
call parse_tree_final (pt_ren_scale)
call parse_tree_final (pt_weight)
call syntax_pexpr_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: processes_6"
end subroutine processes_6
@ %def processes_6
@
\subsubsection{Event expressions}
After generating an event, fill the [[subevt]] and evaluate expressions for
selection, reweighting, and analysis.
<<Expr tests: execute tests>>=
call test (events_3, "events_3", &
"expression evaluation", &
u, results)
<<Expr tests: test declarations>>=
public :: events_3
<<Expr tests: tests>>=
subroutine events_3 (u)
use processes_ut, only: prepare_test_process, cleanup_test_process
integer, intent(in) :: u
type(string_t) :: expr_text
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: pt_selection, pt_reweight, pt_analysis
type(eval_tree_factory_t) :: expr_factory
type(event_t), allocatable, target :: event
type(process_t), allocatable, target :: process
type(process_instance_t), allocatable, target :: process_instance
type(os_data_t) :: os_data
type(model_t), pointer :: model
type(var_list_t), target :: var_list
write (u, "(A)") "* Test output: events_3"
write (u, "(A)") "* Purpose: generate an event and evaluate expressions"
write (u, "(A)")
call syntax_pexpr_init ()
write (u, "(A)") "* Expression texts"
write (u, "(A)")
expr_text = "all Pt > 100 [s]"
write (u, "(A,A)") "selection = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (pt_selection, stream, .true.)
call stream_final (stream)
expr_text = "1 + sqrts_hat / sqrts"
write (u, "(A,A)") "reweight = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_reweight, stream, .true.)
call stream_final (stream)
expr_text = "true"
write (u, "(A,A)") "analysis = ", char (expr_text)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_lexpr (pt_analysis, stream, .true.)
call stream_final (stream)
call ifile_final (ifile)
write (u, "(A)")
write (u, "(A)") "* Initialize test process event"
call os_data_init (os_data)
call syntax_model_file_init ()
allocate (model)
call model%read (var_str ("Test.mdl"), os_data)
call var_list%init_snapshot (model%get_var_list_ptr ())
allocate (process)
allocate (process_instance)
call prepare_test_process (process, process_instance, model)
call process%set_var_list (var_list)
call var_list%final ()
call process_instance%setup_event_data ()
write (u, "(A)")
write (u, "(A)") "* Initialize event object and set expressions"
allocate (event)
call event%basic_init ()
call expr_factory%init (pt_selection%get_root_ptr ())
call event%set_selection (expr_factory)
call expr_factory%init (pt_reweight%get_root_ptr ())
call event%set_reweight (expr_factory)
call expr_factory%init (pt_analysis%get_root_ptr ())
call event%set_analysis (expr_factory)
call event%connect (process_instance, process%get_model_ptr ())
call event%expr%var_list%append_real (var_str ("tolerance"), 0._default)
call event%setup_expressions ()
write (u, "(A)")
write (u, "(A)") "* Generate test process event"
call process_instance%generate_weighted_event (1)
write (u, "(A)")
write (u, "(A)") "* Fill event object and evaluate expressions"
write (u, "(A)")
call event%generate (1, [0.4_default, 0.4_default])
call event%set_index (42)
call event%evaluate_expressions ()
call event%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call event%final ()
deallocate (event)
call cleanup_test_process (process, process_instance)
deallocate (process_instance)
deallocate (process)
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: events_3"
end subroutine events_3
@ %def events_3
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Top Level}
The top level consists of
\begin{description}
\item[commands]
Defines generic command-list and command objects, and all specific
implementations. Each command type provides a specific
functionality. Together with the modules that provide expressions
and variables, this module defines the Sindarin language.
\item[whizard]
This module interprets streams of various kind in terms of the
command language. It also contains the unit-test feature. We also
define the externally visible procedures here, for the \whizard\ as
a library.
\item[main]
The driver for \whizard\ as a stand-alone program. Contains the
command-line interpreter.
\item[whizard\_c\_interface]
Alternative top-level procedures, for use in the context of a
C-compatible caller program.
\end{description}
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Commands}
This module defines the command language of the main input file.
<<[[commands.f90]]>>=
<<File header>>
module commands
<<Use kinds>>
<<Use strings>>
use io_units
use string_utils, only: lower_case, split_string, str
use format_utils, only: write_indent
use format_defs, only: FMT_14, FMT_19
use diagnostics
use physics_defs
use sorting
use sf_lhapdf, only: lhapdf_global_reset
use os_interface
use ifiles
use lexers
use syntax_rules
use parser
use analysis
use pdg_arrays
use variables, only: var_list_t, V_NONE, V_LOG, V_INT, V_REAL, V_CMPLX, V_STR, V_PDG
use observables, only: var_list_check_observable
use observables, only: var_list_check_result_var
use eval_trees
use models
use auto_components
use flavors
use polarizations
use particle_specifiers
use process_libraries
use process
use instances
use prclib_stacks
use slha_interface
use user_files
use eio_data
use rt_data
use process_configurations
use compilations, only: compile_library, compile_executable
use integrations, only: integrate_process
use restricted_subprocesses, only: get_libname_res
use restricted_subprocesses, only: spawn_resonant_subprocess_libraries
use event_streams
use simulations
use radiation_generator
<<Use mpi f08>>
<<Standard module head>>
<<Commands: public>>
<<Commands: types>>
<<Commands: variables>>
<<Commands: parameters>>
<<Commands: interfaces>>
contains
<<Commands: procedures>>
end module commands
@ %def commands
@
\subsection{The command type}
The command type is a generic type that holds any command, compiled
for execution.
Each command may come with its own local environment. The command list that
determines this environment is allocated as [[options]], if necessary. (It
has to be allocated as a pointer because the type definition is recursive.) The
local environment is available as a pointer which either points to the global
environment, or is explicitly allocated and initialized.
<<Commands: types>>=
type, abstract :: command_t
type(parse_node_t), pointer :: pn => null ()
class(command_t), pointer :: next => null ()
type(parse_node_t), pointer :: pn_opt => null ()
type(command_list_t), pointer :: options => null ()
type(rt_data_t), pointer :: local => null ()
contains
<<Commands: command: TBP>>
end type command_t
@ %def command_t
@ Finalizer: If there is an option list, finalize the option list and
deallocate. If not, the local environment is just a pointer.
<<Commands: command: TBP>>=
procedure :: final => command_final
<<Commands: procedures>>=
recursive subroutine command_final (cmd)
class(command_t), intent(inout) :: cmd
if (associated (cmd%options)) then
call cmd%options%final ()
deallocate (cmd%options)
call cmd%local%local_final ()
deallocate (cmd%local)
else
cmd%local => null ()
end if
end subroutine command_final
@ %def command_final
@ Allocate a command with the appropriate concrete type. Store the
parse node pointer in the command object, so we can reference to it
when compiling.
<<Commands: procedures>>=
subroutine dispatch_command (command, pn)
class(command_t), intent(inout), pointer :: command
type(parse_node_t), intent(in), target :: pn
select case (char (parse_node_get_rule_key (pn)))
case ("cmd_model")
allocate (cmd_model_t :: command)
case ("cmd_library")
allocate (cmd_library_t :: command)
case ("cmd_process")
allocate (cmd_process_t :: command)
case ("cmd_nlo")
allocate (cmd_nlo_t :: command)
case ("cmd_compile")
allocate (cmd_compile_t :: command)
case ("cmd_exec")
allocate (cmd_exec_t :: command)
case ("cmd_num", "cmd_complex", "cmd_real", "cmd_int", &
"cmd_log_decl", "cmd_log", "cmd_string", "cmd_string_decl", &
"cmd_alias", "cmd_result")
allocate (cmd_var_t :: command)
case ("cmd_slha")
allocate (cmd_slha_t :: command)
case ("cmd_show")
allocate (cmd_show_t :: command)
case ("cmd_clear")
allocate (cmd_clear_t :: command)
case ("cmd_expect")
allocate (cmd_expect_t :: command)
case ("cmd_beams")
allocate (cmd_beams_t :: command)
case ("cmd_beams_pol_density")
allocate (cmd_beams_pol_density_t :: command)
case ("cmd_beams_pol_fraction")
allocate (cmd_beams_pol_fraction_t :: command)
case ("cmd_beams_momentum")
allocate (cmd_beams_momentum_t :: command)
case ("cmd_beams_theta")
allocate (cmd_beams_theta_t :: command)
case ("cmd_beams_phi")
allocate (cmd_beams_phi_t :: command)
case ("cmd_cuts")
allocate (cmd_cuts_t :: command)
case ("cmd_scale")
allocate (cmd_scale_t :: command)
case ("cmd_fac_scale")
allocate (cmd_fac_scale_t :: command)
case ("cmd_ren_scale")
allocate (cmd_ren_scale_t :: command)
case ("cmd_weight")
allocate (cmd_weight_t :: command)
case ("cmd_selection")
allocate (cmd_selection_t :: command)
case ("cmd_reweight")
allocate (cmd_reweight_t :: command)
case ("cmd_iterations")
allocate (cmd_iterations_t :: command)
case ("cmd_integrate")
allocate (cmd_integrate_t :: command)
case ("cmd_observable")
allocate (cmd_observable_t :: command)
case ("cmd_histogram")
allocate (cmd_histogram_t :: command)
case ("cmd_plot")
allocate (cmd_plot_t :: command)
case ("cmd_graph")
allocate (cmd_graph_t :: command)
case ("cmd_record")
allocate (cmd_record_t :: command)
case ("cmd_analysis")
allocate (cmd_analysis_t :: command)
case ("cmd_alt_setup")
allocate (cmd_alt_setup_t :: command)
case ("cmd_unstable")
allocate (cmd_unstable_t :: command)
case ("cmd_stable")
allocate (cmd_stable_t :: command)
case ("cmd_polarized")
allocate (cmd_polarized_t :: command)
case ("cmd_unpolarized")
allocate (cmd_unpolarized_t :: command)
case ("cmd_sample_format")
allocate (cmd_sample_format_t :: command)
case ("cmd_simulate")
allocate (cmd_simulate_t :: command)
case ("cmd_rescan")
allocate (cmd_rescan_t :: command)
case ("cmd_write_analysis")
allocate (cmd_write_analysis_t :: command)
case ("cmd_compile_analysis")
allocate (cmd_compile_analysis_t :: command)
case ("cmd_open_out")
allocate (cmd_open_out_t :: command)
case ("cmd_close_out")
allocate (cmd_close_out_t :: command)
case ("cmd_printf")
allocate (cmd_printf_t :: command)
case ("cmd_scan")
allocate (cmd_scan_t :: command)
case ("cmd_if")
allocate (cmd_if_t :: command)
case ("cmd_include")
allocate (cmd_include_t :: command)
+ case ("cmd_export")
+ allocate (cmd_export_t :: command)
case ("cmd_quit")
allocate (cmd_quit_t :: command)
case default
print *, char (parse_node_get_rule_key (pn))
call msg_bug ("Command not implemented")
end select
command%pn => pn
end subroutine dispatch_command
@ %def dispatch_command
@ Output. We allow for indentation so we can display a command tree.
<<Commands: command: TBP>>=
procedure (command_write), deferred :: write
<<Commands: interfaces>>=
abstract interface
subroutine command_write (cmd, unit, indent)
import
class(command_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
end subroutine command_write
end interface
@ %def command_write
@ Compile a command. The command type is already fixed, so this is a
deferred type-bound procedure.
<<Commands: command: TBP>>=
procedure (command_compile), deferred :: compile
<<Commands: interfaces>>=
abstract interface
subroutine command_compile (cmd, global)
import
class(command_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
end subroutine command_compile
end interface
@ %def command_compile
@ Execute a command. This will use and/or modify the runtime data
set. If the [[quit]] flag is set, the caller should terminate command
execution.
<<Commands: command: TBP>>=
procedure (command_execute), deferred :: execute
<<Commands: interfaces>>=
abstract interface
subroutine command_execute (cmd, global)
import
class(command_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
end subroutine command_execute
end interface
@ %def command_execute
@
\subsection{Options}
The [[options]] command list is allocated, initialized, and executed, if the
command is associated with an option text in curly braces. If present, a
separate local runtime data set [[local]] will be allocated and initialized;
otherwise, [[local]] becomes a pointer to the global dataset.
For output, we indent the options list.
<<Commands: command: TBP>>=
procedure :: write_options => command_write_options
<<Commands: procedures>>=
recursive subroutine command_write_options (cmd, unit, indent)
class(command_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: ind
ind = 1; if (present (indent)) ind = indent + 1
if (associated (cmd%options)) call cmd%options%write (unit, ind)
end subroutine command_write_options
@ %def command_write_options
@ Compile the options list, if any. This implies initialization of the local
environment. Should be done once the [[pn_opt]] node has been assigned (if
applicable), but before the actual command compilation.
<<Commands: command: TBP>>=
procedure :: compile_options => command_compile_options
<<Commands: procedures>>=
recursive subroutine command_compile_options (cmd, global)
class(command_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
if (associated (cmd%pn_opt)) then
allocate (cmd%local)
call cmd%local%local_init (global)
call global%copy_globals (cmd%local)
allocate (cmd%options)
call cmd%options%compile (cmd%pn_opt, cmd%local)
call global%restore_globals (cmd%local)
call cmd%local%deactivate ()
else
cmd%local => global
end if
end subroutine command_compile_options
@ %def command_compile_options
@ Execute options. First prepare the local environment, then execute the
command list.
<<Commands: command: TBP>>=
procedure :: execute_options => cmd_execute_options
<<Commands: procedures>>=
recursive subroutine cmd_execute_options (cmd, global)
class(command_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
if (associated (cmd%options)) then
call cmd%local%activate ()
call cmd%options%execute (cmd%local)
end if
end subroutine cmd_execute_options
@ %def cmd_execute_options
@ This must be called after the parent command has been executed, to undo
temporary modifications to the environment. Note that some modifications to
[[global]] can become permanent.
<<Commands: command: TBP>>=
procedure :: reset_options => cmd_reset_options
<<Commands: procedures>>=
subroutine cmd_reset_options (cmd, global)
class(command_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
if (associated (cmd%options)) then
call cmd%local%deactivate (global)
end if
end subroutine cmd_reset_options
@ %def cmd_reset_options
@
\subsection{Specific command types}
\subsubsection{Model configuration}
The command declares a model, looks for the specified file and loads
it.
<<Commands: types>>=
type, extends (command_t) :: cmd_model_t
private
type(string_t) :: name
type(string_t) :: scheme
logical :: ufo_model = .false.
logical :: ufo_path_set = .false.
type(string_t) :: ufo_path
contains
<<Commands: cmd model: TBP>>
end type cmd_model_t
@ %def cmd_model_t
@ Output
<<Commands: cmd model: TBP>>=
procedure :: write => cmd_model_write
<<Commands: procedures>>=
subroutine cmd_model_write (cmd, unit, indent)
class(cmd_model_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,1x,'""',A,'""')", advance="no") "model =", char (cmd%name)
if (cmd%ufo_model) then
if (cmd%ufo_path_set) then
write (u, "(1x,A,A,A)") "(ufo (", char (cmd%ufo_path), "))"
else
write (u, "(1x,A)") "(ufo)"
end if
else if (cmd%scheme /= "") then
write (u, "(1x,'(',A,')')") char (cmd%scheme)
else
write (u, *)
end if
end subroutine cmd_model_write
@ %def cmd_model_write
@ Compile. Get the model name and read the model from file, so it is
readily available when the command list is executed. If the model has a
scheme argument, take this into account.
Assign the model pointer in the [[global]] record, so it can be used for
(read-only) variable lookup while compiling further commands.
<<Commands: cmd model: TBP>>=
procedure :: compile => cmd_model_compile
<<Commands: procedures>>=
subroutine cmd_model_compile (cmd, global)
class(cmd_model_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_name, pn_arg, pn_scheme
type(parse_node_t), pointer :: pn_ufo_arg, pn_path
type(model_t), pointer :: model
type(string_t) :: scheme
pn_name => cmd%pn%get_sub_ptr (3)
pn_arg => pn_name%get_next_ptr ()
if (associated (pn_arg)) then
pn_scheme => pn_arg%get_sub_ptr ()
else
pn_scheme => null ()
end if
cmd%name = pn_name%get_string ()
if (associated (pn_scheme)) then
select case (char (pn_scheme%get_rule_key ()))
case ("ufo_spec")
cmd%ufo_model = .true.
pn_ufo_arg => pn_scheme%get_sub_ptr (2)
if (associated (pn_ufo_arg)) then
pn_path => pn_ufo_arg%get_sub_ptr ()
cmd%ufo_path_set = .true.
cmd%ufo_path = pn_path%get_string ()
end if
case default
scheme = pn_scheme%get_string ()
select case (char (lower_case (scheme)))
case ("ufo"); cmd%ufo_model = .true.
case default; cmd%scheme = scheme
end select
end select
if (cmd%ufo_model) then
if (cmd%ufo_path_set) then
call preload_ufo_model (model, cmd%name, cmd%ufo_path)
else
call preload_ufo_model (model, cmd%name)
end if
else
call preload_model (model, cmd%name, cmd%scheme)
end if
else
cmd%scheme = ""
call preload_model (model, cmd%name)
end if
global%model => model
if (associated (global%model)) then
call global%model%link_var_list (global%var_list)
end if
contains
subroutine preload_model (model, name, scheme)
type(model_t), pointer, intent(out) :: model
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: scheme
model => null ()
if (associated (global%model)) then
if (global%model%matches (name, scheme)) then
model => global%model
end if
end if
if (.not. associated (model)) then
if (global%model_list%model_exists (name, scheme)) then
model => global%model_list%get_model_ptr (name, scheme)
else
call global%read_model (name, model, scheme)
end if
end if
end subroutine preload_model
subroutine preload_ufo_model (model, name, ufo_path)
type(model_t), pointer, intent(out) :: model
type(string_t), intent(in) :: name
type(string_t), intent(in), optional :: ufo_path
model => null ()
if (associated (global%model)) then
if (global%model%matches (name, ufo=.true., ufo_path=ufo_path)) then
model => global%model
end if
end if
if (.not. associated (model)) then
if (global%model_list%model_exists (name, &
ufo=.true., ufo_path=ufo_path)) then
model => global%model_list%get_model_ptr (name, &
ufo=.true., ufo_path=ufo_path)
else
call global%read_ufo_model (name, model, ufo_path=ufo_path)
end if
end if
end subroutine preload_ufo_model
end subroutine cmd_model_compile
@ %def cmd_model_compile
@ Execute: Insert a pointer into the global data record and reassign
the variable list.
<<Commands: cmd model: TBP>>=
procedure :: execute => cmd_model_execute
<<Commands: procedures>>=
subroutine cmd_model_execute (cmd, global)
class(cmd_model_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
if (cmd%ufo_model) then
if (cmd%ufo_path_set) then
call global%select_model (cmd%name, ufo=.true., ufo_path=cmd%ufo_path)
else
call global%select_model (cmd%name, ufo=.true.)
end if
else if (cmd%scheme /= "") then
call global%select_model (cmd%name, cmd%scheme)
else
call global%select_model (cmd%name)
end if
if (.not. associated (global%model)) &
call msg_fatal ("Switching to model '" &
// char (cmd%name) // "': model not found")
end subroutine cmd_model_execute
@ %def cmd_model_execute
@
\subsubsection{Library configuration}
We configure a process library that should hold the subsequently
defined processes. If the referenced library exists already, just
make it the currently active one.
<<Commands: types>>=
type, extends (command_t) :: cmd_library_t
private
type(string_t) :: name
contains
<<Commands: cmd library: TBP>>
end type cmd_library_t
@ %def cmd_library_t
@ Output.
<<Commands: cmd library: TBP>>=
procedure :: write => cmd_library_write
<<Commands: procedures>>=
subroutine cmd_library_write (cmd, unit, indent)
class(cmd_library_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit)
call write_indent (u, indent)
write (u, "(1x,A,1x,'""',A,'""')") "library =", char (cmd%name)
end subroutine cmd_library_write
@ %def cmd_library_write
@ Compile. Get the library name.
<<Commands: cmd library: TBP>>=
procedure :: compile => cmd_library_compile
<<Commands: procedures>>=
subroutine cmd_library_compile (cmd, global)
class(cmd_library_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_name
pn_name => parse_node_get_sub_ptr (cmd%pn, 3)
cmd%name = parse_node_get_string (pn_name)
end subroutine cmd_library_compile
@ %def cmd_library_compile
@ Execute: Initialize a new library and push it on the library stack
(if it does not yet exist). Insert a pointer to the library into the
global data record. Then, try to load the library unless the
[[rebuild]] flag is set.
<<Commands: cmd library: TBP>>=
procedure :: execute => cmd_library_execute
<<Commands: procedures>>=
subroutine cmd_library_execute (cmd, global)
class(cmd_library_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
logical :: rebuild_library
lib => global%prclib_stack%get_library_ptr (cmd%name)
rebuild_library = &
global%var_list%get_lval (var_str ("?rebuild_library"))
if (.not. (associated (lib))) then
allocate (lib_entry)
call lib_entry%init (cmd%name)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
else
call global%update_prclib (lib)
end if
if (associated (lib) .and. .not. rebuild_library) then
call lib%update_status (global%os_data)
end if
end subroutine cmd_library_execute
@ %def cmd_library_execute
@
\subsubsection{Process configuration}
We define a process-configuration command as a specific type. The
incoming and outgoing particles are given evaluation-trees which we
transform to PDG-code arrays. For transferring to \oMega, they are
reconverted to strings.
For the incoming particles, we store parse nodes individually. We do
not yet resolve the outgoing state, so we store just a single parse
node.
This also includes the choice of method for the corresponding process:
[[omega]] for \oMega\ matrix elements as Fortran code, [[ovm]] for
\oMega\ matrix elements as a bytecode virtual machine, [[test]] for
special processes, [[unit_test]] for internal test matrix elements
generated by \whizard, [[template]] and [[template_unity]] for test
matrix elements generated by \whizard\ as Fortran code similar to the
\oMega\ code. If the one-loop program (OLP) \gosam\ is linked, also
matrix elements from there (at leading and next-to-leading order) can
be generated via [[gosam]].
<<Commands: types>>=
type, extends (command_t) :: cmd_process_t
private
type(string_t) :: id
integer :: n_in = 0
type(parse_node_p), dimension(:), allocatable :: pn_pdg_in
type(parse_node_t), pointer :: pn_out => null ()
contains
<<Commands: cmd process: TBP>>
end type cmd_process_t
@ %def cmd_process_t
@ Output. The particle expressions are not resolved, so we just list the
number of incoming particles.
<<Commands: cmd process: TBP>>=
procedure :: write => cmd_process_write
<<Commands: procedures>>=
subroutine cmd_process_write (cmd, unit, indent)
class(cmd_process_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,A,A,I0,A)") "process: ", char (cmd%id), " (", &
size (cmd%pn_pdg_in), " -> X)"
call cmd%write_options (u, indent)
end subroutine cmd_process_write
@ %def cmd_process_write
@ Compile. Find and assign the parse nodes.
<<Commands: cmd process: TBP>>=
procedure :: compile => cmd_process_compile
<<Commands: procedures>>=
subroutine cmd_process_compile (cmd, global)
class(cmd_process_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_id, pn_in, pn_codes
integer :: i
pn_id => parse_node_get_sub_ptr (cmd%pn, 2)
pn_in => parse_node_get_next_ptr (pn_id, 2)
cmd%pn_out => parse_node_get_next_ptr (pn_in, 2)
cmd%pn_opt => parse_node_get_next_ptr (cmd%pn_out)
call cmd%compile_options (global)
cmd%id = parse_node_get_string (pn_id)
cmd%n_in = parse_node_get_n_sub (pn_in)
pn_codes => parse_node_get_sub_ptr (pn_in)
allocate (cmd%pn_pdg_in (cmd%n_in))
do i = 1, cmd%n_in
cmd%pn_pdg_in(i)%ptr => pn_codes
pn_codes => parse_node_get_next_ptr (pn_codes)
end do
end subroutine cmd_process_compile
@ %def cmd_process_compile
@ Command execution. Evaluate the subevents, transform PDG codes
into strings, and add the current process configuration to the
process library.
The initial state will be unique (one or two particles). For the final state,
we allow for expressions. The expressions will be expanded until we have a
sum of final states. Each distinct final state will get its own process
component.
To identify equivalent final states, we transform the final state into
an array of PDG codes, which we sort and compare. If a particle entry
is actually a PDG array, only the first entry in the array is used for
the comparison. The user should make sure that there is no overlap
between different particles or arrays which would make the expansion
ambiguous.
There are two possibilities that a process contains more than
component: by an explicit component statement by the user for
inclusive processes, or by having one process at NLO level. The first
option is determined in the routine [[scan_components]], and
determines [[n_components]].
<<Commands: cmd process: TBP>>=
procedure :: execute => cmd_process_execute
<<Commands: procedures>>=
subroutine cmd_process_execute (cmd, global)
class(cmd_process_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(pdg_array_t) :: pdg_in, pdg_out
type(pdg_array_t), dimension(:), allocatable :: pdg_out_tab
type(string_t), dimension(:), allocatable :: prt_in
type(string_t) :: prt_out, prt_out1
type(process_configuration_t) :: prc_config
type(prt_expr_t) :: prt_expr_out
type(prt_spec_t), dimension(:), allocatable :: prt_spec_in
type(prt_spec_t), dimension(:), allocatable :: prt_spec_out
type(var_list_t), pointer :: var_list
integer, dimension(:), allocatable :: pdg
integer, dimension(:), allocatable :: i_term
integer, dimension(:), allocatable :: nlo_comp
integer :: i, j, n_in, n_out, n_terms, n_components
logical :: nlo_fixed_order
logical :: qcd_corr, qed_corr
type(string_t), dimension(:), allocatable :: prt_in_nlo, prt_out_nlo
type(radiation_generator_t) :: radiation_generator
type(pdg_list_t) :: pl_in, pl_out, pl_excluded_gauge_splittings
type(string_t) :: method, born_me_method, loop_me_method, &
correlation_me_method, real_tree_me_method, dglap_me_method
integer, dimension(:), allocatable :: i_list
logical :: use_real_finite
logical :: gks_active
logical :: initial_state_colored
integer :: comp_mult
integer :: gks_multiplicity
integer :: n_components_init
integer :: alpha_power, alphas_power
logical :: requires_soft_mismatch, requires_dglap_remnants
call msg_debug (D_CORE, "cmd_process_execute")
var_list => cmd%local%get_var_list_ptr ()
n_in = size (cmd%pn_pdg_in)
allocate (prt_in (n_in), prt_spec_in (n_in))
do i = 1, n_in
pdg_in = &
eval_pdg_array (cmd%pn_pdg_in(i)%ptr, var_list)
prt_in(i) = make_flavor_string (pdg_in, cmd%local%model)
prt_spec_in(i) = new_prt_spec (prt_in(i))
end do
call compile_prt_expr &
(prt_expr_out, cmd%pn_out, var_list, cmd%local%model)
call prt_expr_out%expand ()
call scan_components ()
allocate (nlo_comp (n_components))
nlo_fixed_order = cmd%local%nlo_fixed_order
gks_multiplicity = var_list%get_ival (var_str ('gks_multiplicity'))
gks_active = gks_multiplicity > 2
call check_for_nlo_corrections ()
method = var_list%get_sval (var_str ("$method"))
born_me_method = var_list%get_sval (var_str ("$born_me_method"))
if (born_me_method == var_str ("")) born_me_method = method
use_real_finite = var_list%get_lval (var_str ('?nlo_use_real_partition'))
if (nlo_fixed_order) then
real_tree_me_method = &
var_list%get_sval (var_str ("$real_tree_me_method"))
if (real_tree_me_method == var_str ("")) &
real_tree_me_method = method
loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
if (loop_me_method == var_str ("")) &
loop_me_method = method
correlation_me_method = &
var_list%get_sval (var_str ("$correlation_me_method"))
if (correlation_me_method == var_str ("")) &
correlation_me_method = method
dglap_me_method = var_list%get_sval (var_str ("$dglap_me_method"))
if (dglap_me_method == var_str ("")) &
dglap_me_method = method
call check_nlo_options (cmd%local)
end if
call determine_needed_components ()
call prc_config%init (cmd%id, n_in, n_components_init, &
cmd%local%model, cmd%local%var_list, &
nlo_process = nlo_fixed_order)
alpha_power = var_list%get_ival (var_str ("alpha_power"))
alphas_power = var_list%get_ival (var_str ("alphas_power"))
call prc_config%set_coupling_powers (alpha_power, alphas_power)
call setup_components ()
call prc_config%record (cmd%local)
contains
<<Commands: cmd process execute procedures>>
end subroutine cmd_process_execute
@ %def cmd_process_execute
@
<<Commands: cmd process execute procedures>>=
elemental function is_threshold (method)
logical :: is_threshold
type(string_t), intent(in) :: method
is_threshold = method == var_str ("threshold")
end function is_threshold
subroutine check_threshold_consistency ()
if (nlo_fixed_order .and. is_threshold (born_me_method)) then
if (.not. (is_threshold (real_tree_me_method) .and. is_threshold (loop_me_method) &
.and. is_threshold (correlation_me_method))) then
print *, 'born: ', char (born_me_method)
print *, 'real: ', char (real_tree_me_method)
print *, 'loop: ', char (loop_me_method)
print *, 'correlation: ', char (correlation_me_method)
call msg_fatal ("Inconsistent methods: All components need to be threshold")
end if
end if
end subroutine check_threshold_consistency
@ %def check_threshold_consistency
<<Commands: cmd process execute procedures>>=
subroutine check_for_nlo_corrections ()
type(string_t) :: nlo_correction_type
type(pdg_array_t), dimension(:), allocatable :: pdg
if (nlo_fixed_order .or. gks_active) then
nlo_correction_type = &
var_list%get_sval (var_str ('$nlo_correction_type'))
select case (char(nlo_correction_type))
case ("QCD")
qcd_corr = .true.; qed_corr = .false.
case ("QED")
qcd_corr = .false.; qed_corr = .true.
case ("Full")
qcd_corr =.true.; qed_corr = .true.
case default
call msg_fatal ("Invalid NLO correction type! " // &
"Valid inputs are: QCD, QED, Full (default: QCD)")
end select
call check_for_excluded_gauge_boson_splitting_partners ()
call setup_radiation_generator ()
end if
if (nlo_fixed_order) then
call radiation_generator%find_splittings ()
if (debug2_active (D_CORE)) then
print *, ''
print *, 'Found (pdg) splittings: '
do i = 1, radiation_generator%if_table%get_length ()
call radiation_generator%if_table%get_pdg_out (i, pdg)
call pdg_array_write_set (pdg)
print *, '----------------'
end do
end if
nlo_fixed_order = radiation_generator%contains_emissions ()
if (.not. nlo_fixed_order) call msg_warning &
(arr = [var_str ("No NLO corrections found for process ") // &
cmd%id // var_str("."), var_str ("Proceed with usual " // &
"leading-order integration and simulation")])
end if
end subroutine check_for_nlo_corrections
@ %def check_for_nlo_corrections
@
<<Commands: cmd process execute procedures>>=
subroutine check_for_excluded_gauge_boson_splitting_partners ()
type(string_t) :: str_excluded_partners
type(string_t), dimension(:), allocatable :: excluded_partners
type(pdg_list_t) :: pl_tmp, pl_anti
integer :: i, n_anti
str_excluded_partners = var_list%get_sval &
(var_str ("$exclude_gauge_splittings"))
if (str_excluded_partners == "") then
return
else
call split_string (str_excluded_partners, &
var_str (":"), excluded_partners)
call pl_tmp%init (size (excluded_partners))
do i = 1, size (excluded_partners)
call pl_tmp%set (i, &
cmd%local%model%get_pdg (excluded_partners(i), .true.))
end do
call pl_tmp%create_antiparticles (pl_anti, n_anti)
call pl_excluded_gauge_splittings%init (pl_tmp%get_size () + n_anti)
do i = 1, pl_tmp%get_size ()
call pl_excluded_gauge_splittings%set (i, pl_tmp%get(i))
end do
do i = 1, n_anti
j = i + pl_tmp%get_size ()
call pl_excluded_gauge_splittings%set (j, pl_anti%get(i))
end do
end if
end subroutine check_for_excluded_gauge_boson_splitting_partners
@ %def check_for_excluded_gauge_boson_splitting_partners
@
<<Commands: cmd process execute procedures>>=
subroutine determine_needed_components ()
type(string_t) :: fks_method
comp_mult = 1
if (nlo_fixed_order) then
fks_method = var_list%get_sval (var_str ('$fks_mapping_type'))
call check_threshold_consistency ()
requires_soft_mismatch = fks_method == var_str ('resonances')
comp_mult = needed_extra_components (requires_dglap_remnants, &
use_real_finite, requires_soft_mismatch)
allocate (i_list (comp_mult))
else if (gks_active) then
call radiation_generator%generate_multiple &
(gks_multiplicity, cmd%local%model)
comp_mult = radiation_generator%get_n_gks_states () + 1
end if
n_components_init = n_components * comp_mult
end subroutine determine_needed_components
@ %def determine_needed_components
@
<<Commands: cmd process execute procedures>>=
subroutine setup_radiation_generator ()
call split_prt (prt_spec_in, n_in, pl_in)
call split_prt (prt_spec_out, n_out, pl_out)
call radiation_generator%init (pl_in, pl_out, &
pl_excluded_gauge_splittings, qcd = qcd_corr, qed = qed_corr)
call radiation_generator%set_n (n_in, n_out, 0)
initial_state_colored = pdg_in%has_colored_particles ()
if ((n_in == 2 .and. initial_state_colored) .or. qed_corr) then
requires_dglap_remnants = n_in == 2 .and. initial_state_colored
call radiation_generator%set_initial_state_emissions ()
else
requires_dglap_remnants = .false.
end if
call radiation_generator%set_constraints (.false., .false., .true., .true.)
call radiation_generator%setup_if_table (cmd%local%model)
end subroutine setup_radiation_generator
@ %def setup_radiation_generator
@
<<Commands: cmd process execute procedures>>=
subroutine scan_components ()
n_terms = prt_expr_out%get_n_terms ()
allocate (pdg_out_tab (n_terms))
allocate (i_term (n_terms), source = 0)
n_components = 0
SCAN: do i = 1, n_terms
if (allocated (pdg)) deallocate (pdg)
call prt_expr_out%term_to_array (prt_spec_out, i)
n_out = size (prt_spec_out)
allocate (pdg (n_out))
do j = 1, n_out
prt_out = prt_spec_out(j)%to_string ()
call split (prt_out, prt_out1, ":")
pdg(j) = cmd%local%model%get_pdg (prt_out1)
end do
pdg_out = sort (pdg)
do j = 1, n_components
if (pdg_out == pdg_out_tab(j)) cycle SCAN
end do
n_components = n_components + 1
i_term(n_components) = i
pdg_out_tab(n_components) = pdg_out
end do SCAN
end subroutine scan_components
@
<<Commands: cmd process execute procedures>>=
subroutine split_prt (prt, n_out, pl)
type(prt_spec_t), intent(in), dimension(:), allocatable :: prt
integer, intent(in) :: n_out
type(pdg_list_t), intent(out) :: pl
type(pdg_array_t) :: pdg
type(string_t) :: prt_string, prt_tmp
integer, parameter :: max_particle_number = 25
integer, dimension(max_particle_number) :: i_particle
integer :: i, j, n
i_particle = 0
call pl%init (n_out)
do i = 1, n_out
n = 1
prt_string = prt(i)%to_string ()
do
call split (prt_string, prt_tmp, ":")
if (prt_tmp /= "") then
i_particle(n) = cmd%local%model%get_pdg (prt_tmp)
n = n + 1
else
exit
end if
end do
call pdg_array_init (pdg, n - 1)
do j = 1, n - 1
call pdg%set (j, i_particle(j))
end do
call pl%set (i, pdg)
call pdg_array_delete (pdg)
end do
end subroutine split_prt
@ %def split_prt
@
<<Commands: cmd process execute procedures>>=
subroutine setup_components()
integer :: k, i_comp, add_index
i_comp = 0
add_index = 0
call msg_debug (D_CORE, "setup_components")
do i = 1, n_components
call prt_expr_out%term_to_array (prt_spec_out, i_term(i))
if (nlo_fixed_order) then
associate (selected_nlo_parts => cmd%local%selected_nlo_parts)
call msg_debug (D_CORE, "Setting up this NLO component:", &
i_comp + 1)
call prc_config%setup_component (i_comp + 1, &
prt_spec_in, prt_spec_out, &
cmd%local%model, var_list, BORN, &
can_be_integrated = selected_nlo_parts (BORN))
call radiation_generator%generate_real_particle_strings &
(prt_in_nlo, prt_out_nlo)
call msg_debug (D_CORE, "Setting up this NLO component:", &
i_comp + 2)
call prc_config%setup_component (i_comp + 2, &
new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
cmd%local%model, var_list, NLO_REAL, &
can_be_integrated = selected_nlo_parts (NLO_REAL))
call msg_debug (D_CORE, "Setting up this NLO component:", &
i_comp + 3)
call prc_config%setup_component (i_comp + 3, &
prt_spec_in, prt_spec_out, &
cmd%local%model, var_list, NLO_VIRTUAL, &
can_be_integrated = selected_nlo_parts (NLO_VIRTUAL))
call msg_debug (D_CORE, "Setting up this NLO component:", &
i_comp + 4)
call prc_config%setup_component (i_comp + 4, &
prt_spec_in, prt_spec_out, &
cmd%local%model, var_list, NLO_SUBTRACTION, &
can_be_integrated = selected_nlo_parts (NLO_SUBTRACTION))
do k = 1, 4
i_list(k) = i_comp + k
end do
if (requires_dglap_remnants) then
call msg_debug (D_CORE, "Setting up this NLO component:", &
i_comp + 5)
call prc_config%setup_component (i_comp + 5, &
prt_spec_in, prt_spec_out, &
cmd%local%model, var_list, NLO_DGLAP, &
can_be_integrated = selected_nlo_parts (NLO_DGLAP))
i_list(5) = i_comp + 5
add_index = add_index + 1
end if
if (use_real_finite) then
call msg_debug (D_CORE, "Setting up this NLO component:", &
i_comp + 5 + add_index)
call prc_config%setup_component (i_comp + 5 + add_index, &
new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
cmd%local%model, var_list, NLO_REAL, &
can_be_integrated = selected_nlo_parts (NLO_REAL))
i_list(5 + add_index) = i_comp + 5 + add_index
add_index = add_index + 1
end if
if (requires_soft_mismatch) then
call msg_debug (D_CORE, "Setting up this NLO component:", &
i_comp + 5 + add_index)
call prc_config%setup_component (i_comp + 5 + add_index, &
prt_spec_in, prt_spec_out, &
cmd%local%model, var_list, NLO_MISMATCH, &
can_be_integrated = selected_nlo_parts (NLO_MISMATCH))
i_list(5 + add_index) = i_comp + 5 + add_index
end if
call prc_config%set_component_associations (i_list, &
requires_dglap_remnants, use_real_finite, &
requires_soft_mismatch)
end associate
else if (gks_active) then
call prc_config%setup_component (i_comp + 1, prt_spec_in, &
prt_spec_out, cmd%local%model, var_list, BORN, &
can_be_integrated = .true.)
call radiation_generator%reset_queue ()
do j = 1, comp_mult
prt_out_nlo = radiation_generator%get_next_state ()
call prc_config%setup_component (i_comp + 1 + j, &
new_prt_spec (prt_in), new_prt_spec (prt_out_nlo), &
cmd%local%model, var_list, GKS, can_be_integrated = .false.)
end do
else
call prc_config%setup_component (i, &
prt_spec_in, prt_spec_out, &
cmd%local%model, var_list, can_be_integrated = .true.)
end if
i_comp = i_comp + comp_mult
end do
end subroutine setup_components
@
@ These three functions should be bundled with the logicals they depend
on into an object (the pcm?).
<<Commands: procedures>>=
subroutine check_nlo_options (local)
type(rt_data_t), intent(in) :: local
type(var_list_t), pointer :: var_list => null ()
logical :: nlo, combined, powheg
logical :: case_lo_but_any_other
logical :: case_nlo_powheg_but_not_combined
logical :: vamp_equivalences_enabled
logical :: fixed_order_nlo_events
var_list => local%get_var_list_ptr ()
nlo = local%nlo_fixed_order
combined = var_list%get_lval (var_str ('?combined_nlo_integration'))
powheg = var_list%get_lval (var_str ('?powheg_matching'))
case_lo_but_any_other = .not. nlo .and. any ([combined, powheg])
case_nlo_powheg_but_not_combined = &
nlo .and. powheg .and. .not. combined
if (case_lo_but_any_other) then
call msg_fatal ("Option mismatch: Leading order process is selected &
&but either powheg_matching or combined_nlo_integration &
&is set to true.")
else if (case_nlo_powheg_but_not_combined) then
call msg_fatal ("POWHEG requires the 'combined_nlo_integration'-option &
&to be set to true.")
end if
fixed_order_nlo_events = &
var_list%get_lval (var_str ('?fixed_order_nlo_events'))
if (fixed_order_nlo_events .and. .not. combined .and. &
all (local%selected_nlo_parts)) &
call msg_fatal ("Option mismatch: Fixed order NLO events of the full ", &
[var_str ("process are requested, but ?combined_nlo_integration"), &
var_str ("is false. You can either switch to the combined NLO"), &
var_str ("integration mode or choose one individual NLO component"), &
var_str ("to generate events with.")])
vamp_equivalences_enabled = var_list%get_lval &
(var_str ('?use_vamp_equivalences'))
if (nlo .and. vamp_equivalences_enabled) &
call msg_warning ("You have not disabled VAMP equivalences. ", &
[var_str (" Note that they are automatically switched off "), &
var_str (" for NLO calculations.")])
end subroutine check_nlo_options
@ %def check_nlo_options
@ There are four components for a general NLO process, namely Born,
real, virtual and subtraction. There will be additional components for
DGLAP remnant, in case real contributions are split into singular and
finite pieces, and for resonance-aware FKS subtraction for the needed
soft mismatch component.
<<Commands: procedures>>=
pure function needed_extra_components (requires_dglap_remnant, &
use_real_finite, requires_soft_mismatch) result (n)
integer :: n
logical, intent(in) :: requires_dglap_remnant, &
use_real_finite, requires_soft_mismatch
n = 4
if (requires_dglap_remnant) n = n + 1
if (use_real_finite) n = n + 1
if (requires_soft_mismatch) n = n + 1
end function needed_extra_components
@ %def needed_extra_components
@ This is a method of the eval tree, but cannot be coded inside the
[[expressions]] module since it uses the [[model]] and [[flv]] types
which are not available there.
<<Commands: procedures>>=
function make_flavor_string (aval, model) result (prt)
type(string_t) :: prt
type(pdg_array_t), intent(in) :: aval
type(model_t), intent(in), target :: model
integer, dimension(:), allocatable :: pdg
type(flavor_t), dimension(:), allocatable :: flv
integer :: i
pdg = aval
allocate (flv (size (pdg)))
call flv%init (pdg, model)
if (size (pdg) /= 0) then
prt = flv(1)%get_name ()
do i = 2, size (flv)
prt = prt // ":" // flv(i)%get_name ()
end do
else
prt = "?"
end if
end function make_flavor_string
@ %def make_flavor_string
@ Create a pdg array from a particle-specification array
<<Commands: procedures>>=
function make_pdg_array (prt, model) result (pdg_array)
type(prt_spec_t), intent(in), dimension(:) :: prt
type(model_t), intent(in) :: model
integer, dimension(:), allocatable :: aval
type(pdg_array_t) :: pdg_array
type(flavor_t) :: flv
integer :: k
allocate (aval (size (prt)))
do k = 1, size (prt)
call flv%init (prt(k)%to_string (), model)
aval (k) = flv%get_pdg ()
end do
pdg_array = aval
end function make_pdg_array
@ %def make_pdg_array
@ Compile a (possible nested) expression, to obtain a
particle-specifier expression which we can process further.
<<Commands: procedures>>=
recursive subroutine compile_prt_expr (prt_expr, pn, var_list, model)
type(prt_expr_t), intent(out) :: prt_expr
type(parse_node_t), intent(in), target :: pn
type(var_list_t), intent(in), target :: var_list
type(model_t), intent(in), target :: model
type(parse_node_t), pointer :: pn_entry, pn_term, pn_addition
type(pdg_array_t) :: pdg
type(string_t) :: prt_string
integer :: n_entry, n_term, i
select case (char (parse_node_get_rule_key (pn)))
case ("prt_state_list")
n_entry = parse_node_get_n_sub (pn)
pn_entry => parse_node_get_sub_ptr (pn)
if (n_entry == 1) then
call compile_prt_expr (prt_expr, pn_entry, var_list, model)
else
call prt_expr%init_list (n_entry)
select type (x => prt_expr%x)
type is (prt_spec_list_t)
do i = 1, n_entry
call compile_prt_expr (x%expr(i), pn_entry, var_list, model)
pn_entry => parse_node_get_next_ptr (pn_entry)
end do
end select
end if
case ("prt_state_sum")
n_term = parse_node_get_n_sub (pn)
pn_term => parse_node_get_sub_ptr (pn)
pn_addition => pn_term
if (n_term == 1) then
call compile_prt_expr (prt_expr, pn_term, var_list, model)
else
call prt_expr%init_sum (n_term)
select type (x => prt_expr%x)
type is (prt_spec_sum_t)
do i = 1, n_term
call compile_prt_expr (x%expr(i), pn_term, var_list, model)
pn_addition => parse_node_get_next_ptr (pn_addition)
if (associated (pn_addition)) &
pn_term => parse_node_get_sub_ptr (pn_addition, 2)
end do
end select
end if
case ("cexpr")
pdg = eval_pdg_array (pn, var_list)
prt_string = make_flavor_string (pdg, model)
call prt_expr%init_spec (new_prt_spec (prt_string))
case default
call parse_node_write_rec (pn)
call msg_bug ("compile prt expr: impossible syntax rule")
end select
end subroutine compile_prt_expr
@ %def compile_prt_expr
@
\subsubsection{Initiating a NLO calculation}
<<Commands: types>>=
type, extends (command_t) :: cmd_nlo_t
private
integer, dimension(:), allocatable :: nlo_component
contains
<<Commands: cmd nlo: TBP>>
end type cmd_nlo_t
@ %def cmd_nlo_t
@
<<Commands: cmd nlo: TBP>>=
procedure :: write => cmd_nlo_write
<<Commands: procedures>>=
subroutine cmd_nlo_write (cmd, unit, indent)
class(cmd_nlo_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
end subroutine cmd_nlo_write
@ %def cmd_nlo_write
@ As it is, the NLO calculation is switched on by putting {nlo} behind the process definition. This should be made nicer in the future.
<<Commands: cmd nlo: TBP>>=
procedure :: compile => cmd_nlo_compile
<<Commands: procedures>>=
subroutine cmd_nlo_compile (cmd, global)
class(cmd_nlo_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg, pn_comp
integer :: i, n_comp
pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
if (associated (pn_arg)) then
n_comp = parse_node_get_n_sub (pn_arg)
allocate (cmd%nlo_component (n_comp))
pn_comp => parse_node_get_sub_ptr (pn_arg)
i = 0
do while (associated (pn_comp))
i = i + 1
cmd%nlo_component(i) = component_status &
(parse_node_get_rule_key (pn_comp))
pn_comp => parse_node_get_next_ptr (pn_comp)
end do
else
allocate (cmd%nlo_component (0))
end if
end subroutine cmd_nlo_compile
@ %def cmd_nlo_compile
@
<<Commands: cmd nlo: TBP>>=
procedure :: execute => cmd_nlo_execute
<<Commands: procedures>>=
subroutine cmd_nlo_execute (cmd, global)
class(cmd_nlo_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(string_t) :: string
integer :: n, i, j
logical, dimension(0:5) :: selected_nlo_parts
call msg_debug (D_CORE, "cmd_nlo_execute")
selected_nlo_parts = .false.
if (allocated (cmd%nlo_component)) then
n = size (cmd%nlo_component)
else
n = 0
end if
do i = 1, n
select case (cmd%nlo_component (i))
case (BORN, NLO_VIRTUAL, NLO_MISMATCH, NLO_DGLAP, NLO_REAL)
selected_nlo_parts(cmd%nlo_component (i)) = .true.
case (NLO_FULL)
selected_nlo_parts = .true.
selected_nlo_parts (NLO_SUBTRACTION) = .false.
case default
string = var_str ("")
do j = BORN, NLO_DGLAP
string = string // component_status (j) // ", "
end do
string = string // component_status (NLO_FULL)
call msg_fatal ("Invalid NLO mode. Valid modes are: " // &
char (string))
end select
end do
global%nlo_fixed_order = any (selected_nlo_parts)
global%selected_nlo_parts = selected_nlo_parts
allocate (global%nlo_component (size (cmd%nlo_component)))
global%nlo_component = cmd%nlo_component
end subroutine cmd_nlo_execute
@ %def cmd_nlo_execute
@
\subsubsection{Process compilation}
<<Commands: types>>=
type, extends (command_t) :: cmd_compile_t
private
type(string_t), dimension(:), allocatable :: libname
logical :: make_executable = .false.
type(string_t) :: exec_name
contains
<<Commands: cmd compile: TBP>>
end type cmd_compile_t
@ %def cmd_compile_t
@ Output: list all libraries to be compiled.
<<Commands: cmd compile: TBP>>=
procedure :: write => cmd_compile_write
<<Commands: procedures>>=
subroutine cmd_compile_write (cmd, unit, indent)
class(cmd_compile_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)", advance="no") "compile ("
if (allocated (cmd%libname)) then
do i = 1, size (cmd%libname)
if (i > 1) write (u, "(A,1x)", advance="no") ","
write (u, "('""',A,'""')", advance="no") char (cmd%libname(i))
end do
end if
write (u, "(A)") ")"
end subroutine cmd_compile_write
@ %def cmd_compile_write
@ Compile the libraries specified in the argument. If the argument is
empty, compile all libraries which can be found in the process library stack.
<<Commands: cmd compile: TBP>>=
procedure :: compile => cmd_compile_compile
<<Commands: procedures>>=
subroutine cmd_compile_compile (cmd, global)
class(cmd_compile_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_arg, pn_lib
type(parse_node_t), pointer :: pn_exec_name_spec, pn_exec_name
integer :: n_lib, i
pn_cmd => parse_node_get_sub_ptr (cmd%pn)
pn_clause => parse_node_get_sub_ptr (pn_cmd)
pn_exec_name_spec => parse_node_get_sub_ptr (pn_clause, 2)
if (associated (pn_exec_name_spec)) then
pn_exec_name => parse_node_get_sub_ptr (pn_exec_name_spec, 2)
else
pn_exec_name => null ()
end if
pn_arg => parse_node_get_next_ptr (pn_clause)
cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
call cmd%compile_options (global)
if (associated (pn_arg)) then
n_lib = parse_node_get_n_sub (pn_arg)
else
n_lib = 0
end if
if (n_lib > 0) then
allocate (cmd%libname (n_lib))
pn_lib => parse_node_get_sub_ptr (pn_arg)
do i = 1, n_lib
cmd%libname(i) = parse_node_get_string (pn_lib)
pn_lib => parse_node_get_next_ptr (pn_lib)
end do
end if
if (associated (pn_exec_name)) then
cmd%make_executable = .true.
cmd%exec_name = parse_node_get_string (pn_exec_name)
end if
end subroutine cmd_compile_compile
@ %def cmd_compile_compile
@ Command execution. Generate code, write driver, compile and link.
Do this for all libraries in the list.
If no library names have been given and stored while compiling this
command, we collect all libraries from the current stack and compile
those.
As a bonus, a compiled library may be able to spawn new process
libraries. For instance, a processes may ask for a set of resonant
subprocesses which go into their own library, but this can be
determined only after the process is available as a compiled object.
Therefore, the compilation loop is implemented as a recursive internal
subroutine.
We can compile static libraries (which actually just loads them). However, we
can't incorporate in a generated executable.
<<Commands: cmd compile: TBP>>=
procedure :: execute => cmd_compile_execute
<<Commands: procedures>>=
subroutine cmd_compile_execute (cmd, global)
class(cmd_compile_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(string_t), dimension(:), allocatable :: libname, libname_static
integer :: i, n_lib
<<Commands: cmd compile execute: variables>>
<<Commands: cmd compile execute: init>>
if (allocated (cmd%libname)) then
allocate (libname (size (cmd%libname)))
libname = cmd%libname
else
call cmd%local%prclib_stack%get_names (libname)
end if
n_lib = size (libname)
if (cmd%make_executable) then
call get_prclib_static (libname_static)
do i = 1, n_lib
if (any (libname_static == libname(i))) then
call msg_fatal ("Compile: can't include static library '" &
// char (libname(i)) // "'")
end if
end do
call compile_executable (cmd%exec_name, libname, cmd%local)
else
call compile_libraries (libname)
call global%update_prclib &
(global%prclib_stack%get_library_ptr (libname(n_lib)))
end if
<<Commands: cmd compile execute: end init>>
contains
recursive subroutine compile_libraries (libname)
type(string_t), dimension(:), intent(in) :: libname
integer :: i
type(string_t), dimension(:), allocatable :: libname_extra
type(process_library_t), pointer :: lib_saved
do i = 1, size (libname)
call compile_library (libname(i), cmd%local)
lib_saved => global%prclib
call spawn_extra_libraries &
(libname(i), cmd%local, global, libname_extra)
call compile_libraries (libname_extra)
call global%update_prclib (lib_saved)
end do
end subroutine compile_libraries
end subroutine cmd_compile_execute
@ %def cmd_compile_execute
<<Commands: cmd compile execute: variables>>=
@
<<Commands: cmd compile execute: init>>=
@
<<Commands: cmd compile execute: end init>>=
@
@ The parallelization leads to undefined behavior while writing simultaneously to one file.
The master worker has to initialize single-handed the corresponding library files.
The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
<<MPI: Commands: cmd compile execute: variables>>=
logical :: compile_init
integer :: rank, n_size
<<MPI: Commands: cmd compile execute: init>>=
call msg_debug (D_MPI, "cmd_compile_execute")
compile_init = .false.
call mpi_get_comm_id (n_size, rank)
call msg_debug (D_MPI, "n_size", rank)
call msg_debug (D_MPI, "rank", rank)
if (rank /= 0) then
call msg_debug (D_MPI, "wait for master")
call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
else
compile_init = .true.
end if
if (compile_init) then
<<MPI: Commands: cmd compile execute: end init>>=
if (rank == 0) then
call msg_debug (D_MPI, "load slaves")
call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
end if
end if
call MPI_barrier (MPI_COMM_WORLD)
@ %def cmd_compile_execute_mpi
@
This is the interface to the external procedure which returns the
names of all static libraries which are part of the executable. (The
default is none.) The routine must allocate the array.
<<Commands: public>>=
public :: get_prclib_static
<<Commands: interfaces>>=
interface
subroutine get_prclib_static (libname)
import
type(string_t), dimension(:), intent(inout), allocatable :: libname
end subroutine get_prclib_static
end interface
@ %def get_prclib_static
@
Spawn extra libraries. We can ask the processes within a compiled
library, which we have available at this point, whether they need additional
processes which should go into their own libraries.
The current implementation only concerns resonant subprocesses.
Note that the libraries should be created (source code), but not be
compiled here. This is done afterwards.
<<Commands: procedures>>=
subroutine spawn_extra_libraries (libname, local, global, libname_extra)
type(string_t), intent(in) :: libname
type(rt_data_t), intent(inout), target :: local
type(rt_data_t), intent(inout), target :: global
type(string_t), dimension(:), allocatable, intent(out) :: libname_extra
type(string_t), dimension(:), allocatable :: libname_res
allocate (libname_extra (0))
call spawn_resonant_subprocess_libraries &
(libname, local, global, libname_res)
if (allocated (libname_res)) libname_extra = [libname_extra, libname_res]
end subroutine spawn_extra_libraries
@ %def spawn_extra_libraries
@
\subsubsection{Execute a shell command}
The argument is a string expression.
<<Commands: types>>=
type, extends (command_t) :: cmd_exec_t
private
type(parse_node_t), pointer :: pn_command => null ()
contains
<<Commands: cmd exec: TBP>>
end type cmd_exec_t
@ %def cmd_exec_t
@ Simply tell the status.
<<Commands: cmd exec: TBP>>=
procedure :: write => cmd_exec_write
<<Commands: procedures>>=
subroutine cmd_exec_write (cmd, unit, indent)
class(cmd_exec_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
if (associated (cmd%pn_command)) then
write (u, "(1x,A)") "exec: [command associated]"
else
write (u, "(1x,A)") "exec: [undefined]"
end if
end subroutine cmd_exec_write
@ %def cmd_exec_write
@ Compile the exec command.
<<Commands: cmd exec: TBP>>=
procedure :: compile => cmd_exec_compile
<<Commands: procedures>>=
subroutine cmd_exec_compile (cmd, global)
class(cmd_exec_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg, pn_command
pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
pn_command => parse_node_get_sub_ptr (pn_arg)
cmd%pn_command => pn_command
end subroutine cmd_exec_compile
@ %def cmd_exec_compile
@ Execute the specified shell command.
<<Commands: cmd exec: TBP>>=
procedure :: execute => cmd_exec_execute
<<Commands: procedures>>=
subroutine cmd_exec_execute (cmd, global)
class(cmd_exec_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(string_t) :: command
logical :: is_known
integer :: status
command = eval_string (cmd%pn_command, global%var_list, is_known=is_known)
if (is_known) then
if (command /= "") then
call os_system_call (command, status, verbose=.true.)
if (status /= 0) then
write (msg_buffer, "(A,I0)") "Return code = ", status
call msg_message ()
call msg_error ("System command returned with nonzero status code")
end if
end if
end if
end subroutine cmd_exec_execute
@ %def cmd_exec_execute
@
\subsubsection{Variable declaration}
A variable can have various types. Hold the definition as an eval
tree.
There are intrinsic variables, user variables, and model variables.
The latter are further divided in independent variables and dependent
variables.
Regarding model variables: When dealing with them, we always look at
two variable lists in parallel. The global (or local) variable list
contains the user-visible values. It includes variables that
correspond to variables in the current model's list. These, in turn,
are pointers to the model's parameter list, so the model is always in
sync, internally. To keep the global variable list in sync with the
model, the global variables carry the [[is_copy]] property and contain
a separate pointer to the model variable. (The pointer is reassigned
whenever the model changes.) Modifying the global variable changes
two values simultaneously: the visible value and the model variable,
via this extra pointer. After each modification, we update dependent
parameters in the model variable list and re-synchronize the global
variable list (again, using these pointers) with the model variable
this. In the last step, modifications in the derived parameters
become visible.
When we integrate a process, we capture the current variable list of
the current model in a separate model instance, which is stored in the
process object. Thus, the model parameters associated to this process
at this time are preserved for the lifetime of the process object.
When we generate or rescan events, we can again capture a local model
variable list in a model instance. This allows us to reweight event
by event with different parameter sets simultaneously.
<<Commands: types>>=
type, extends (command_t) :: cmd_var_t
private
type(string_t) :: name
integer :: type = V_NONE
type(parse_node_t), pointer :: pn_value => null ()
logical :: is_intrinsic = .false.
logical :: is_model_var = .false.
contains
<<Commands: cmd var: TBP>>
end type cmd_var_t
@ %def cmd_var_t
@ Output. We know name, type, and properties, but not the value.
<<Commands: cmd var: TBP>>=
procedure :: write => cmd_var_write
<<Commands: procedures>>=
subroutine cmd_var_write (cmd, unit, indent)
class(cmd_var_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,A,A)", advance="no") "var: ", char (cmd%name), " ("
select case (cmd%type)
case (V_NONE)
write (u, "(A)", advance="no") "[unknown]"
case (V_LOG)
write (u, "(A)", advance="no") "logical"
case (V_INT)
write (u, "(A)", advance="no") "int"
case (V_REAL)
write (u, "(A)", advance="no") "real"
case (V_CMPLX)
write (u, "(A)", advance="no") "complex"
case (V_STR)
write (u, "(A)", advance="no") "string"
case (V_PDG)
write (u, "(A)", advance="no") "alias"
end select
if (cmd%is_intrinsic) then
write (u, "(A)", advance="no") ", intrinsic"
end if
if (cmd%is_model_var) then
write (u, "(A)", advance="no") ", model"
end if
write (u, "(A)") ")"
end subroutine cmd_var_write
@ %def cmd_var_write
@ Compile the lhs and determine the variable name and type. Check whether
this variable can be created or modified as requested, and append the value to
the variable list, if appropriate. The value is initially undefined.
The rhs is assigned to a pointer, to be compiled and evaluated when the
command is executed.
<<Commands: cmd var: TBP>>=
procedure :: compile => cmd_var_compile
<<Commands: procedures>>=
subroutine cmd_var_compile (cmd, global)
class(cmd_var_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_var, pn_name
type(parse_node_t), pointer :: pn_result, pn_proc
type(string_t) :: var_name
type(var_list_t), pointer :: model_vars
integer :: type
logical :: new
pn_result => null ()
new = .false.
select case (char (parse_node_get_rule_key (cmd%pn)))
case ("cmd_log_decl"); type = V_LOG
pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
if (.not. associated (pn_var)) then ! handle masked syntax error
cmd%type = V_NONE; return
end if
pn_name => parse_node_get_sub_ptr (pn_var, 2)
new = .true.
case ("cmd_log"); type = V_LOG
pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
case ("cmd_int"); type = V_INT
pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
new = .true.
case ("cmd_real"); type = V_REAL
pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
new = .true.
case ("cmd_complex"); type = V_CMPLX
pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
new = .true.
case ("cmd_num"); type = V_NONE
pn_name => parse_node_get_sub_ptr (cmd%pn)
case ("cmd_string_decl"); type = V_STR
pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
if (.not. associated (pn_var)) then ! handle masked syntax error
cmd%type = V_NONE; return
end if
pn_name => parse_node_get_sub_ptr (pn_var, 2)
new = .true.
case ("cmd_string"); type = V_STR
pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
case ("cmd_alias"); type = V_PDG
pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
new = .true.
case ("cmd_result"); type = V_REAL
pn_name => parse_node_get_sub_ptr (cmd%pn)
pn_result => parse_node_get_sub_ptr (pn_name)
pn_proc => parse_node_get_next_ptr (pn_result)
case default
call parse_node_mismatch &
("logical|int|real|complex|?|$|alias|var_name", cmd%pn) ! $
end select
if (.not. associated (pn_name)) then ! handle masked syntax error
cmd%type = V_NONE; return
end if
if (.not. associated (pn_result)) then
var_name = parse_node_get_string (pn_name)
else
var_name = parse_node_get_key (pn_result) &
// "(" // parse_node_get_string (pn_proc) // ")"
end if
select case (type)
case (V_LOG); var_name = "?" // var_name
case (V_STR); var_name = "$" // var_name ! $
end select
if (associated (global%model)) then
model_vars => global%model%get_var_list_ptr ()
else
model_vars => null ()
end if
call var_list_check_observable (global%var_list, var_name, type)
call var_list_check_result_var (global%var_list, var_name, type)
call global%var_list%check_user_var (var_name, type, new)
cmd%name = var_name
cmd%pn_value => parse_node_get_next_ptr (pn_name, 2)
if (global%var_list%contains (cmd%name, follow_link = .false.)) then
! local variable
cmd%is_intrinsic = &
global%var_list%is_intrinsic (cmd%name, follow_link = .false.)
cmd%type = &
global%var_list%get_type (cmd%name, follow_link = .false.)
else
if (new) cmd%type = type
if (global%var_list%contains (cmd%name, follow_link = .true.)) then
! global variable
cmd%is_intrinsic = &
global%var_list%is_intrinsic (cmd%name, follow_link = .true.)
if (cmd%type == V_NONE) then
cmd%type = &
global%var_list%get_type (cmd%name, follow_link = .true.)
end if
else if (associated (model_vars)) then ! check model variable
cmd%is_model_var = &
model_vars%contains (cmd%name)
if (cmd%type == V_NONE) then
cmd%type = &
model_vars%get_type (cmd%name)
end if
end if
if (cmd%type == V_NONE) then
call msg_fatal ("Variable '" // char (cmd%name) // "' " &
// "set without declaration")
cmd%type = V_NONE; return
end if
if (cmd%is_model_var) then
if (new) then
call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
// "redeclared")
else if (model_vars%is_locked (cmd%name)) then
call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
// "is locked")
end if
else
select case (cmd%type)
case (V_LOG)
call global%var_list%append_log (cmd%name, &
intrinsic=cmd%is_intrinsic, user=.true.)
case (V_INT)
call global%var_list%append_int (cmd%name, &
intrinsic=cmd%is_intrinsic, user=.true.)
case (V_REAL)
call global%var_list%append_real (cmd%name, &
intrinsic=cmd%is_intrinsic, user=.true.)
case (V_CMPLX)
call global%var_list%append_cmplx (cmd%name, &
intrinsic=cmd%is_intrinsic, user=.true.)
case (V_PDG)
call global%var_list%append_pdg_array (cmd%name, &
intrinsic=cmd%is_intrinsic, user=.true.)
case (V_STR)
call global%var_list%append_string (cmd%name, &
intrinsic=cmd%is_intrinsic, user=.true.)
end select
end if
end if
end subroutine cmd_var_compile
@ %def cmd_var_compile
@ Execute. Evaluate the definition and assign the variable value.
If the variable is a model variable, take a snapshot of the model if necessary
and set the variable in the local model.
<<Commands: cmd var: TBP>>=
procedure :: execute => cmd_var_execute
<<Commands: procedures>>=
subroutine cmd_var_execute (cmd, global)
class(cmd_var_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
real(default) :: rval
logical :: is_known, pacified
var_list => global%get_var_list_ptr ()
if (cmd%is_model_var) then
pacified = var_list%get_lval (var_str ("?pacify"))
rval = eval_real (cmd%pn_value, var_list, is_known=is_known)
call global%model_set_real &
(cmd%name, rval, verbose=.true., pacified=pacified)
else if (cmd%type /= V_NONE) then
call cmd%set_value (var_list, verbose=.true.)
end if
end subroutine cmd_var_execute
@ %def cmd_var_execute
@ Copy the value to the variable list, where the variable should already exist.
<<Commands: cmd var: TBP>>=
procedure :: set_value => cmd_var_set_value
<<Commands: procedures>>=
subroutine cmd_var_set_value (var, var_list, verbose, model_name)
class(cmd_var_t), intent(inout) :: var
type(var_list_t), intent(inout), target :: var_list
logical, intent(in), optional :: verbose
type(string_t), intent(in), optional :: model_name
logical :: lval, pacified
integer :: ival
real(default) :: rval
complex(default) :: cval
type(pdg_array_t) :: aval
type(string_t) :: sval
logical :: is_known
pacified = var_list%get_lval (var_str ("?pacify"))
select case (var%type)
case (V_LOG)
lval = eval_log (var%pn_value, var_list, is_known=is_known)
call var_list%set_log (var%name, &
lval, is_known, verbose=verbose, model_name=model_name)
case (V_INT)
ival = eval_int (var%pn_value, var_list, is_known=is_known)
call var_list%set_int (var%name, &
ival, is_known, verbose=verbose, model_name=model_name)
case (V_REAL)
rval = eval_real (var%pn_value, var_list, is_known=is_known)
call var_list%set_real (var%name, &
rval, is_known, verbose=verbose, &
model_name=model_name, pacified = pacified)
case (V_CMPLX)
cval = eval_cmplx (var%pn_value, var_list, is_known=is_known)
call var_list%set_cmplx (var%name, &
cval, is_known, verbose=verbose, &
model_name=model_name, pacified = pacified)
case (V_PDG)
aval = eval_pdg_array (var%pn_value, var_list, is_known=is_known)
call var_list%set_pdg_array (var%name, &
aval, is_known, verbose=verbose, model_name=model_name)
case (V_STR)
sval = eval_string (var%pn_value, var_list, is_known=is_known)
call var_list%set_string (var%name, &
sval, is_known, verbose=verbose, model_name=model_name)
end select
end subroutine cmd_var_set_value
@ %def cmd_var_set_value
@
\subsubsection{SLHA}
Read a SLHA (SUSY Les Houches Accord) file to fill the appropriate
model parameters. We do not access the current variable record, but
directly work on the appropriate SUSY model, which is loaded if
necessary.
We may be in read or write mode. In the latter case, we may write
just input parameters, or the complete spectrum, or the spectrum with
all decays.
<<Commands: types>>=
type, extends (command_t) :: cmd_slha_t
private
type(string_t) :: file
logical :: write_mode = .false.
contains
<<Commands: cmd slha: TBP>>
end type cmd_slha_t
@ %def cmd_slha_t
@ Output.
<<Commands: cmd slha: TBP>>=
procedure :: write => cmd_slha_write
<<Commands: procedures>>=
subroutine cmd_slha_write (cmd, unit, indent)
class(cmd_slha_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,A)") "slha: file name = ", char (cmd%file)
write (u, "(1x,A,L1)") "slha: write mode = ", cmd%write_mode
end subroutine cmd_slha_write
@ %def cmd_slha_write
@ Compile. Read the filename and store it.
<<Commands: cmd slha: TBP>>=
procedure :: compile => cmd_slha_compile
<<Commands: procedures>>=
subroutine cmd_slha_compile (cmd, global)
class(cmd_slha_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_key, pn_arg, pn_file
pn_key => parse_node_get_sub_ptr (cmd%pn)
pn_arg => parse_node_get_next_ptr (pn_key)
pn_file => parse_node_get_sub_ptr (pn_arg)
call cmd%compile_options (global)
cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
select case (char (parse_node_get_key (pn_key)))
case ("read_slha")
cmd%write_mode = .false.
case ("write_slha")
cmd%write_mode = .true.
case default
call parse_node_mismatch ("read_slha|write_slha", cmd%pn)
end select
cmd%file = parse_node_get_string (pn_file)
end subroutine cmd_slha_compile
@ %def cmd_slha_compile
@ Execute. Read or write the specified SLHA file. Behind the scenes,
this will first read the WHIZARD model file, then read the SLHA file
and assign the SLHA parameters as far as determined by
[[dispatch_slha]]. Finally, the global variables are synchronized
with the model. This is similar to executing [[cmd_model]].
<<Commands: cmd slha: TBP>>=
procedure :: execute => cmd_slha_execute
<<Commands: procedures>>=
subroutine cmd_slha_execute (cmd, global)
class(cmd_slha_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
logical :: input, spectrum, decays
if (cmd%write_mode) then
input = .true.
spectrum = .false.
decays = .false.
if (.not. associated (cmd%local%model)) then
call msg_fatal ("SLHA: local model not associated")
return
end if
call slha_write_file &
(cmd%file, cmd%local%model, &
input = input, spectrum = spectrum, decays = decays)
else
if (.not. associated (global%model)) then
call msg_fatal ("SLHA: global model not associated")
return
end if
call dispatch_slha (cmd%local%var_list, &
input = input, spectrum = spectrum, decays = decays)
call global%ensure_model_copy ()
call slha_read_file &
(cmd%file, cmd%local%os_data, global%model, &
input = input, spectrum = spectrum, decays = decays)
end if
end subroutine cmd_slha_execute
@ %def cmd_slha_execute
@
\subsubsection{Show values}
This command shows the current values of variables or other objects,
in a suitably condensed form.
<<Commands: types>>=
type, extends (command_t) :: cmd_show_t
private
type(string_t), dimension(:), allocatable :: name
contains
<<Commands: cmd show: TBP>>
end type cmd_show_t
@ %def cmd_show_t
@ Output: list the object names, not values.
<<Commands: cmd show: TBP>>=
procedure :: write => cmd_show_write
<<Commands: procedures>>=
subroutine cmd_show_write (cmd, unit, indent)
class(cmd_show_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)", advance="no") "show: "
if (allocated (cmd%name)) then
do i = 1, size (cmd%name)
write (u, "(1x,A)", advance="no") char (cmd%name(i))
end do
write (u, *)
else
write (u, "(5x,A)") "[undefined]"
end if
end subroutine cmd_show_write
@ %def cmd_show_write
@ Compile. Allocate an array which is filled with the names of the
variables to show.
<<Commands: cmd show: TBP>>=
procedure :: compile => cmd_show_compile
<<Commands: procedures>>=
subroutine cmd_show_compile (cmd, global)
class(cmd_show_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
type(string_t) :: key
integer :: i, n_args
pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
if (associated (pn_arg)) then
select case (char (parse_node_get_rule_key (pn_arg)))
case ("show_arg")
cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
case default
cmd%pn_opt => pn_arg
pn_arg => null ()
end select
end if
call cmd%compile_options (global)
if (associated (pn_arg)) then
n_args = parse_node_get_n_sub (pn_arg)
allocate (cmd%name (n_args))
pn_var => parse_node_get_sub_ptr (pn_arg)
i = 0
do while (associated (pn_var))
i = i + 1
select case (char (parse_node_get_rule_key (pn_var)))
case ("model", "library", "beams", "iterations", &
"cuts", "weight", "int", "real", "complex", &
"scale", "factorization_scale", "renormalization_scale", &
"selection", "reweight", "analysis", "pdg", &
"stable", "unstable", "polarized", "unpolarized", &
"results", "expect", "intrinsic", "string", "logical")
cmd%name(i) = parse_node_get_key (pn_var)
case ("result_var")
pn_prefix => parse_node_get_sub_ptr (pn_var)
pn_name => parse_node_get_next_ptr (pn_prefix)
if (associated (pn_name)) then
cmd%name(i) = parse_node_get_key (pn_prefix) &
// "(" // parse_node_get_string (pn_name) // ")"
else
cmd%name(i) = parse_node_get_key (pn_prefix)
end if
case ("log_var", "string_var", "alias_var")
pn_prefix => parse_node_get_sub_ptr (pn_var)
pn_name => parse_node_get_next_ptr (pn_prefix)
key = parse_node_get_key (pn_prefix)
if (associated (pn_name)) then
select case (char (parse_node_get_rule_key (pn_name)))
case ("var_name")
select case (char (key))
case ("?", "$") ! $ sign
cmd%name(i) = key // parse_node_get_string (pn_name)
case ("alias")
cmd%name(i) = parse_node_get_string (pn_name)
end select
case default
call parse_node_mismatch &
("var_name", pn_name)
end select
else
cmd%name(i) = key
end if
case default
cmd%name(i) = parse_node_get_string (pn_var)
end select
pn_var => parse_node_get_next_ptr (pn_var)
end do
else
allocate (cmd%name (0))
end if
end subroutine cmd_show_compile
@ %def cmd_show_compile
@ Execute. Scan the list of objects to show.
<<Commands: parameters>>=
integer, parameter, public :: SHOW_BUFFER_SIZE = 4096
<<Commands: cmd show: TBP>>=
procedure :: execute => cmd_show_execute
<<Commands: procedures>>=
subroutine cmd_show_execute (cmd, global)
class(cmd_show_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list, model_vars
type(model_t), pointer :: model
type(string_t) :: name
integer :: n, pdg
type(flavor_t) :: flv
type(process_library_t), pointer :: prc_lib
type(process_t), pointer :: process
logical :: pacified
character(SHOW_BUFFER_SIZE) :: buffer
- integer :: i, j, u, u_log, u_out
+ type(string_t) :: out_file
+ integer :: i, j, u, u_log, u_out, u_ext
u = free_unit ()
var_list => cmd%local%var_list
if (associated (cmd%local%model)) then
model_vars => cmd%local%model%get_var_list_ptr ()
else
model_vars => null ()
end if
pacified = var_list%get_lval (var_str ("?pacify"))
+ out_file = var_list%get_sval (var_str ("$out_file"))
+ if (file_list_is_open (global%out_files, out_file, action="write")) then
+ call msg_message ("show: copying output to file '" &
+ // char (out_file) // "'")
+ u_ext = file_list_get_unit (global%out_files, out_file)
+ else
+ u_ext = -1
+ end if
open (u, status = "scratch", action = "readwrite")
if (associated (cmd%local%model)) then
name = cmd%local%model%get_name ()
end if
if (size (cmd%name) == 0) then
if (associated (model_vars)) then
call model_vars%write (model_name = name, &
unit = u, pacified = pacified, follow_link = .false.)
end if
call var_list%write (unit = u, pacified = pacified)
else
do i = 1, size (cmd%name)
select case (char (cmd%name(i)))
case ("model")
if (associated (cmd%local%model)) then
call cmd%local%model%show (u)
else
write (u, "(A)") "Model: [undefined]"
end if
case ("library")
if (associated (cmd%local%prclib)) then
call cmd%local%prclib%show (u)
else
write (u, "(A)") "Process library: [undefined]"
end if
case ("beams")
call cmd%local%show_beams (u)
case ("iterations")
call cmd%local%it_list%write (u)
case ("results")
- call cmd%local%process_stack%show (u)
+ call cmd%local%process_stack%show (u, fifo=.true.)
case ("stable")
call cmd%local%model%show_stable (u)
case ("polarized")
call cmd%local%model%show_polarized (u)
case ("unpolarized")
call cmd%local%model%show_unpolarized (u)
case ("unstable")
model => cmd%local%model
call model%show_unstable (u)
n = model%get_n_field ()
do j = 1, n
pdg = model%get_pdg (j)
call flv%init (pdg, model)
if (.not. flv%is_stable ()) &
call show_unstable (cmd%local, pdg, u)
if (flv%has_antiparticle ()) then
associate (anti => flv%anti ())
if (.not. anti%is_stable ()) &
call show_unstable (cmd%local, -pdg, u)
end associate
end if
end do
case ("cuts", "weight", "scale", &
"factorization_scale", "renormalization_scale", &
"selection", "reweight", "analysis")
call cmd%local%pn%show (cmd%name(i), u)
case ("expect")
call expect_summary (force = .true.)
case ("intrinsic")
call var_list%write (intrinsic=.true., unit=u, &
pacified = pacified)
case ("logical")
if (associated (model_vars)) then
call model_vars%write (only_type=V_LOG, &
model_name = name, unit=u, pacified = pacified, &
follow_link=.false.)
end if
call var_list%write (&
only_type=V_LOG, unit=u, pacified = pacified)
case ("int")
if (associated (model_vars)) then
call model_vars%write (only_type=V_INT, &
model_name = name, unit=u, pacified = pacified, &
follow_link=.false.)
end if
call var_list%write (only_type=V_INT, &
unit=u, pacified = pacified)
case ("real")
if (associated (model_vars)) then
call model_vars%write (only_type=V_REAL, &
model_name = name, unit=u, pacified = pacified, &
follow_link=.false.)
end if
call var_list%write (only_type=V_REAL, &
unit=u, pacified = pacified)
case ("complex")
if (associated (model_vars)) then
call model_vars%write (only_type=V_CMPLX, &
model_name = name, unit=u, pacified = pacified, &
follow_link=.false.)
end if
call var_list%write (only_type=V_CMPLX, &
unit=u, pacified = pacified)
case ("pdg")
if (associated (model_vars)) then
call model_vars%write (only_type=V_PDG, &
model_name = name, unit=u, pacified = pacified, &
follow_link=.false.)
end if
call var_list%write (only_type=V_PDG, &
unit=u, pacified = pacified)
case ("string")
if (associated (model_vars)) then
call model_vars%write (only_type=V_STR, &
model_name = name, unit=u, pacified = pacified, &
follow_link=.false.)
end if
call var_list%write (only_type=V_STR, &
unit=u, pacified = pacified)
case default
if (analysis_exists (cmd%name(i))) then
call analysis_write (cmd%name(i), u)
else if (cmd%local%process_stack%exists (cmd%name(i))) then
process => cmd%local%process_stack%get_process_ptr (cmd%name(i))
call process%show (u)
else if (associated (cmd%local%prclib_stack%get_library_ptr &
(cmd%name(i)))) then
prc_lib => cmd%local%prclib_stack%get_library_ptr (cmd%name(i))
call prc_lib%show (u)
else if (associated (model_vars)) then
if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
call model_vars%write_var (cmd%name(i), &
unit = u, model_name = name, pacified = pacified)
else if (var_list%contains (cmd%name(i))) then
call var_list%write_var (cmd%name(i), &
unit = u, pacified = pacified)
else
call msg_error ("show: object '" // char (cmd%name(i)) &
// "' not found")
end if
else if (var_list%contains (cmd%name(i))) then
call var_list%write_var (cmd%name(i), &
unit = u, pacified = pacified)
else
call msg_error ("show: object '" // char (cmd%name(i)) &
// "' not found")
end if
end select
end do
end if
rewind (u)
u_log = logfile_unit ()
u_out = given_output_unit ()
do
read (u, "(A)", end = 1) buffer
if (u_log > 0) write (u_log, "(A)") trim (buffer)
if (u_out > 0) write (u_out, "(A)") trim (buffer)
+ if (u_ext > 0) write (u_ext, "(A)") trim (buffer)
end do
1 close (u)
if (u_log > 0) flush (u_log)
if (u_out > 0) flush (u_out)
+ if (u_ext > 0) flush (u_ext)
end subroutine cmd_show_execute
@ %def cmd_show_execute
@
\subsubsection{Clear values}
This command clears the current values of variables or other objects,
where this makes sense. It parallels the [[show]] command. The
objects are cleared, but not deleted.
<<Commands: types>>=
type, extends (command_t) :: cmd_clear_t
private
type(string_t), dimension(:), allocatable :: name
contains
<<Commands: cmd clear: TBP>>
end type cmd_clear_t
@ %def cmd_clear_t
@ Output: list the names of the objects to be cleared.
<<Commands: cmd clear: TBP>>=
procedure :: write => cmd_clear_write
<<Commands: procedures>>=
subroutine cmd_clear_write (cmd, unit, indent)
class(cmd_clear_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)", advance="no") "clear: "
if (allocated (cmd%name)) then
do i = 1, size (cmd%name)
write (u, "(1x,A)", advance="no") char (cmd%name(i))
end do
write (u, *)
else
write (u, "(5x,A)") "[undefined]"
end if
end subroutine cmd_clear_write
@ %def cmd_clear_write
@ Compile. Allocate an array which is filled with the names of the
objects to be cleared.
Note: there is currently no need to account for options, but we
prepare for that possibility.
<<Commands: cmd clear: TBP>>=
procedure :: compile => cmd_clear_compile
<<Commands: procedures>>=
subroutine cmd_clear_compile (cmd, global)
class(cmd_clear_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
type(string_t) :: key
integer :: i, n_args
pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
if (associated (pn_arg)) then
select case (char (parse_node_get_rule_key (pn_arg)))
case ("clear_arg")
cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
case default
cmd%pn_opt => pn_arg
pn_arg => null ()
end select
end if
call cmd%compile_options (global)
if (associated (pn_arg)) then
n_args = parse_node_get_n_sub (pn_arg)
allocate (cmd%name (n_args))
pn_var => parse_node_get_sub_ptr (pn_arg)
i = 0
do while (associated (pn_var))
i = i + 1
select case (char (parse_node_get_rule_key (pn_var)))
case ("beams", "iterations", &
"cuts", "weight", &
"scale", "factorization_scale", "renormalization_scale", &
"selection", "reweight", "analysis", &
"unstable", "polarized", &
"expect")
cmd%name(i) = parse_node_get_key (pn_var)
case ("log_var", "string_var")
pn_prefix => parse_node_get_sub_ptr (pn_var)
pn_name => parse_node_get_next_ptr (pn_prefix)
key = parse_node_get_key (pn_prefix)
if (associated (pn_name)) then
select case (char (parse_node_get_rule_key (pn_name)))
case ("var_name")
select case (char (key))
case ("?", "$") ! $ sign
cmd%name(i) = key // parse_node_get_string (pn_name)
end select
case default
call parse_node_mismatch &
("var_name", pn_name)
end select
else
cmd%name(i) = key
end if
case default
cmd%name(i) = parse_node_get_string (pn_var)
end select
pn_var => parse_node_get_next_ptr (pn_var)
end do
else
allocate (cmd%name (0))
end if
end subroutine cmd_clear_compile
@ %def cmd_clear_compile
@ Execute. Scan the list of objects to clear.
Objects that can be shown but not cleared: model, library, results
<<Commands: cmd clear: TBP>>=
procedure :: execute => cmd_clear_execute
<<Commands: procedures>>=
subroutine cmd_clear_execute (cmd, global)
class(cmd_clear_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
integer :: i
logical :: success
type(var_list_t), pointer :: model_vars
if (size (cmd%name) == 0) then
call msg_warning ("clear: no object specified")
else
do i = 1, size (cmd%name)
success = .true.
select case (char (cmd%name(i)))
case ("beams")
call cmd%local%clear_beams ()
case ("iterations")
call cmd%local%it_list%clear ()
case ("polarized")
call cmd%local%model%clear_polarized ()
case ("unstable")
call cmd%local%model%clear_unstable ()
case ("cuts", "weight", "scale", &
"factorization_scale", "renormalization_scale", &
"selection", "reweight", "analysis")
call cmd%local%pn%clear (cmd%name(i))
case ("expect")
call expect_clear ()
case default
if (analysis_exists (cmd%name(i))) then
call analysis_clear (cmd%name(i))
else if (cmd%local%var_list%contains (cmd%name(i))) then
if (.not. cmd%local%var_list%is_locked (cmd%name(i))) then
call cmd%local%var_list%unset (cmd%name(i))
else
call msg_error ("clear: variable '" // char (cmd%name(i)) &
// "' is locked and can't be cleared")
success = .false.
end if
else if (associated (cmd%local%model)) then
model_vars => cmd%local%model%get_var_list_ptr ()
if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
call msg_error ("clear: variable '" // char (cmd%name(i)) &
// "' is a model variable and can't be cleared")
else
call msg_error ("clear: object '" // char (cmd%name(i)) &
// "' not found")
end if
success = .false.
else
call msg_error ("clear: object '" // char (cmd%name(i)) &
// "' not found")
success = .false.
end if
end select
if (success) call msg_message ("cleared: " // char (cmd%name(i)))
end do
end if
end subroutine cmd_clear_execute
@ %def cmd_clear_execute
@
\subsubsection{Compare values of variables to expectation}
The implementation is similar to the [[show]] command. There are just
two arguments: two values that should be compared. For providing
local values for the numerical tolerance, the command has a local
argument list.
If the expectation fails, an error condition is recorded.
<<Commands: types>>=
type, extends (command_t) :: cmd_expect_t
private
type(parse_node_t), pointer :: pn_lexpr => null ()
contains
<<Commands: cmd expect: TBP>>
end type cmd_expect_t
@ %def cmd_expect_t
@ Simply tell the status.
<<Commands: cmd expect: TBP>>=
procedure :: write => cmd_expect_write
<<Commands: procedures>>=
subroutine cmd_expect_write (cmd, unit, indent)
class(cmd_expect_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
if (associated (cmd%pn_lexpr)) then
write (u, "(1x,A)") "expect: [expression associated]"
else
write (u, "(1x,A)") "expect: [undefined]"
end if
end subroutine cmd_expect_write
@ %def cmd_expect_write
@ Compile. This merely assigns the parse node, the actual compilation is done
at execution. This is necessary because the origin of variables
(local/global) may change during execution.
<<Commands: cmd expect: TBP>>=
procedure :: compile => cmd_expect_compile
<<Commands: procedures>>=
subroutine cmd_expect_compile (cmd, global)
class(cmd_expect_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg
pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
cmd%pn_lexpr => parse_node_get_sub_ptr (pn_arg)
call cmd%compile_options (global)
end subroutine cmd_expect_compile
@ %def cmd_expect_compile
@ Execute. Evaluate both arguments, print them and their difference
(if numerical), and whether they agree. Record the result.
<<Commands: cmd expect: TBP>>=
procedure :: execute => cmd_expect_execute
<<Commands: procedures>>=
subroutine cmd_expect_execute (cmd, global)
class(cmd_expect_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
logical :: success, is_known
var_list => cmd%local%get_var_list_ptr ()
success = eval_log (cmd%pn_lexpr, var_list, is_known=is_known)
if (is_known) then
if (success) then
call msg_message ("expect: success")
else
call msg_error ("expect: failure")
end if
else
call msg_error ("expect: undefined result")
success = .false.
end if
call expect_record (success)
end subroutine cmd_expect_execute
@ %def cmd_expect_execute
@
\subsubsection{Beams}
The beam command includes both beam and structure-function
definition.
<<Commands: types>>=
type, extends (command_t) :: cmd_beams_t
private
integer :: n_in = 0
type(parse_node_p), dimension(:), allocatable :: pn_pdg
integer :: n_sf_record = 0
integer, dimension(:), allocatable :: n_entry
type(parse_node_p), dimension(:,:), allocatable :: pn_sf_entry
contains
<<Commands: cmd beams: TBP>>
end type cmd_beams_t
@ %def cmd_beams_t
@ Output. The particle expressions are not resolved.
<<Commands: cmd beams: TBP>>=
procedure :: write => cmd_beams_write
<<Commands: procedures>>=
subroutine cmd_beams_write (cmd, unit, indent)
class(cmd_beams_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
select case (cmd%n_in)
case (1)
write (u, "(1x,A)") "beams: 1 [decay]"
case (2)
write (u, "(1x,A)") "beams: 2 [scattering]"
case default
write (u, "(1x,A)") "beams: [undefined]"
end select
if (allocated (cmd%n_entry)) then
if (cmd%n_sf_record > 0) then
write (u, "(1x,A,99(1x,I0))") "structure function entries:", &
cmd%n_entry
end if
end if
end subroutine cmd_beams_write
@ %def cmd_beams_write
@ Compile. Find and assign the parse nodes.
Note: local environments are not yet supported.
<<Commands: cmd beams: TBP>>=
procedure :: compile => cmd_beams_compile
<<Commands: procedures>>=
subroutine cmd_beams_compile (cmd, global)
class(cmd_beams_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_beam_def, pn_beam_spec
type(parse_node_t), pointer :: pn_beam_list
type(parse_node_t), pointer :: pn_codes
type(parse_node_t), pointer :: pn_strfun_seq, pn_strfun_pair
type(parse_node_t), pointer :: pn_strfun_def
integer :: i
pn_beam_def => parse_node_get_sub_ptr (cmd%pn, 3)
pn_beam_spec => parse_node_get_sub_ptr (pn_beam_def)
pn_strfun_seq => parse_node_get_next_ptr (pn_beam_spec)
pn_beam_list => parse_node_get_sub_ptr (pn_beam_spec)
call cmd%compile_options (global)
cmd%n_in = parse_node_get_n_sub (pn_beam_list)
allocate (cmd%pn_pdg (cmd%n_in))
pn_codes => parse_node_get_sub_ptr (pn_beam_list)
do i = 1, cmd%n_in
cmd%pn_pdg(i)%ptr => pn_codes
pn_codes => parse_node_get_next_ptr (pn_codes)
end do
if (associated (pn_strfun_seq)) then
cmd%n_sf_record = parse_node_get_n_sub (pn_beam_def) - 1
allocate (cmd%n_entry (cmd%n_sf_record), source = 1)
allocate (cmd%pn_sf_entry (2, cmd%n_sf_record))
do i = 1, cmd%n_sf_record
pn_strfun_pair => parse_node_get_sub_ptr (pn_strfun_seq, 2)
pn_strfun_def => parse_node_get_sub_ptr (pn_strfun_pair)
cmd%pn_sf_entry(1,i)%ptr => pn_strfun_def
pn_strfun_def => parse_node_get_next_ptr (pn_strfun_def)
cmd%pn_sf_entry(2,i)%ptr => pn_strfun_def
if (associated (pn_strfun_def)) cmd%n_entry(i) = 2
pn_strfun_seq => parse_node_get_next_ptr (pn_strfun_seq)
end do
else
allocate (cmd%n_entry (0))
allocate (cmd%pn_sf_entry (0, 0))
end if
end subroutine cmd_beams_compile
@ %def cmd_beams_compile
@ Command execution: Determine beam particles and structure-function
names, if any. The results are stored in the [[beam_structure]]
component of the [[global]] data block.
<<Commands: cmd beams: TBP>>=
procedure :: execute => cmd_beams_execute
<<Commands: procedures>>=
subroutine cmd_beams_execute (cmd, global)
class(cmd_beams_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(pdg_array_t) :: pdg_array
integer, dimension(:), allocatable :: pdg
type(flavor_t), dimension(:), allocatable :: flv
type(parse_node_t), pointer :: pn_key
type(string_t) :: sf_name
integer :: i, j
call lhapdf_global_reset ()
var_list => cmd%local%get_var_list_ptr ()
allocate (flv (cmd%n_in))
do i = 1, cmd%n_in
pdg_array = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
pdg = pdg_array
select case (size (pdg))
case (1)
call flv(i)%init ( pdg(1), cmd%local%model)
case default
call msg_fatal ("Beams: beam particles must be unique")
end select
end do
select case (cmd%n_in)
case (1)
if (cmd%n_sf_record > 0) then
call msg_fatal ("Beam setup: no structure functions allowed &
&for decay")
end if
call global%beam_structure%init_sf (flv%get_name ())
case (2)
call global%beam_structure%init_sf (flv%get_name (), cmd%n_entry)
do i = 1, cmd%n_sf_record
do j = 1, cmd%n_entry(i)
pn_key => parse_node_get_sub_ptr (cmd%pn_sf_entry(j,i)%ptr)
sf_name = parse_node_get_key (pn_key)
call global%beam_structure%set_sf (i, j, sf_name)
end do
end do
end select
end subroutine cmd_beams_execute
@ %def cmd_beams_execute
@
\subsubsection{Density matrices for beam polarization}
For holding beam polarization, we define a notation and a data
structure for sparse matrices. The entries (and the index
expressions) are numerical expressions, so we use evaluation trees.
Each entry in the sparse matrix is an n-tuple of expressions. The first
tuple elements represent index values, the last one is an arbitrary
(complex) number. Absent expressions are replaced by default-value rules.
Note: Here, and in some other commands, we would like to store an evaluation
tree, not just a parse node pointer. However, the current expression handler
wants all variables defined, so the evaluation tree can only be built by
[[evaluate]], i.e., compiled just-in-time and evaluated immediately.
<<Commands: types>>=
type :: sentry_expr_t
type(parse_node_p), dimension(:), allocatable :: expr
contains
<<Commands: sentry expr: TBP>>
end type sentry_expr_t
@ %def sentry_expr_t
@ Compile parse nodes into evaluation trees.
<<Commands: sentry expr: TBP>>=
procedure :: compile => sentry_expr_compile
<<Commands: procedures>>=
subroutine sentry_expr_compile (sentry, pn)
class(sentry_expr_t), intent(out) :: sentry
type(parse_node_t), intent(in), target :: pn
type(parse_node_t), pointer :: pn_expr, pn_extra
integer :: n_expr, i
n_expr = parse_node_get_n_sub (pn)
allocate (sentry%expr (n_expr))
if (n_expr > 0) then
i = 0
pn_expr => parse_node_get_sub_ptr (pn)
pn_extra => parse_node_get_next_ptr (pn_expr)
do i = 1, n_expr
sentry%expr(i)%ptr => pn_expr
if (associated (pn_extra)) then
pn_expr => parse_node_get_sub_ptr (pn_extra, 2)
pn_extra => parse_node_get_next_ptr (pn_extra)
end if
end do
end if
end subroutine sentry_expr_compile
@ %def sentry_expr_compile
@ Evaluate the expressions and return an index array of predefined
length together with a complex value. If the value (as the last expression)
is undefined, set it to unity. If index values are undefined, repeat
the previous index value.
<<Commands: sentry expr: TBP>>=
procedure :: evaluate => sentry_expr_evaluate
<<Commands: procedures>>=
subroutine sentry_expr_evaluate (sentry, index, value, global)
class(sentry_expr_t), intent(inout) :: sentry
integer, dimension(:), intent(out) :: index
complex(default), intent(out) :: value
type(rt_data_t), intent(in), target :: global
type(var_list_t), pointer :: var_list
integer :: i, n_expr, n_index
type(eval_tree_t) :: eval_tree
var_list => global%get_var_list_ptr ()
n_expr = size (sentry%expr)
n_index = size (index)
if (n_expr <= n_index + 1) then
do i = 1, min (n_expr, n_index)
associate (expr => sentry%expr(i))
call eval_tree%init_expr (expr%ptr, var_list)
call eval_tree%evaluate ()
if (eval_tree%is_known ()) then
index(i) = eval_tree%get_int ()
else
call msg_fatal ("Evaluating density matrix: undefined index")
end if
end associate
end do
do i = n_expr + 1, n_index
index(i) = index(n_expr)
end do
if (n_expr == n_index + 1) then
associate (expr => sentry%expr(n_expr))
call eval_tree%init_expr (expr%ptr, var_list)
call eval_tree%evaluate ()
if (eval_tree%is_known ()) then
value = eval_tree%get_cmplx ()
else
call msg_fatal ("Evaluating density matrix: undefined index")
end if
call eval_tree%final ()
end associate
else
value = 1
end if
else
call msg_fatal ("Evaluating density matrix: index expression too long")
end if
end subroutine sentry_expr_evaluate
@ %def sentry_expr_evaluate
@ The sparse matrix itself consists of an arbitrary number of entries.
<<Commands: types>>=
type :: smatrix_expr_t
type(sentry_expr_t), dimension(:), allocatable :: entry
contains
<<Commands: smatrix expr: TBP>>
end type smatrix_expr_t
@ %def smatrix_expr_t
@ Compile: assign sub-nodes to sentry-expressions and compile those.
<<Commands: smatrix expr: TBP>>=
procedure :: compile => smatrix_expr_compile
<<Commands: procedures>>=
subroutine smatrix_expr_compile (smatrix_expr, pn)
class(smatrix_expr_t), intent(out) :: smatrix_expr
type(parse_node_t), intent(in), target :: pn
type(parse_node_t), pointer :: pn_arg, pn_entry
integer :: n_entry, i
pn_arg => parse_node_get_sub_ptr (pn, 2)
if (associated (pn_arg)) then
n_entry = parse_node_get_n_sub (pn_arg)
allocate (smatrix_expr%entry (n_entry))
pn_entry => parse_node_get_sub_ptr (pn_arg)
do i = 1, n_entry
call smatrix_expr%entry(i)%compile (pn_entry)
pn_entry => parse_node_get_next_ptr (pn_entry)
end do
else
allocate (smatrix_expr%entry (0))
end if
end subroutine smatrix_expr_compile
@ %def smatrix_expr_compile
@ Evaluate the entries and build a new [[smatrix]] object, which
contains just the numerical results.
<<Commands: smatrix expr: TBP>>=
procedure :: evaluate => smatrix_expr_evaluate
<<Commands: procedures>>=
subroutine smatrix_expr_evaluate (smatrix_expr, smatrix, global)
class(smatrix_expr_t), intent(inout) :: smatrix_expr
type(smatrix_t), intent(out) :: smatrix
type(rt_data_t), intent(in), target :: global
integer, dimension(2) :: idx
complex(default) :: value
integer :: i, n_entry
n_entry = size (smatrix_expr%entry)
call smatrix%init (2, n_entry)
do i = 1, n_entry
call smatrix_expr%entry(i)%evaluate (idx, value, global)
call smatrix%set_entry (i, idx, value)
end do
end subroutine smatrix_expr_evaluate
@ %def smatrix_expr_evaluate
@
\subsubsection{Beam polarization density}
The beam polarization command defines spin density matrix for one or
two beams (scattering or decay).
<<Commands: types>>=
type, extends (command_t) :: cmd_beams_pol_density_t
private
integer :: n_in = 0
type(smatrix_expr_t), dimension(:), allocatable :: smatrix
contains
<<Commands: cmd beams pol density: TBP>>
end type cmd_beams_pol_density_t
@ %def cmd_beams_pol_density_t
@ Output.
<<Commands: cmd beams pol density: TBP>>=
procedure :: write => cmd_beams_pol_density_write
<<Commands: procedures>>=
subroutine cmd_beams_pol_density_write (cmd, unit, indent)
class(cmd_beams_pol_density_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
select case (cmd%n_in)
case (1)
write (u, "(1x,A)") "beams polarization setup: 1 [decay]"
case (2)
write (u, "(1x,A)") "beams polarization setup: 2 [scattering]"
case default
write (u, "(1x,A)") "beams polarization setup: [undefined]"
end select
end subroutine cmd_beams_pol_density_write
@ %def cmd_beams_pol_density_write
@ Compile. Find and assign the parse nodes.
Note: local environments are not yet supported.
<<Commands: cmd beams pol density: TBP>>=
procedure :: compile => cmd_beams_pol_density_compile
<<Commands: procedures>>=
subroutine cmd_beams_pol_density_compile (cmd, global)
class(cmd_beams_pol_density_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_pol_spec, pn_smatrix
integer :: i
pn_pol_spec => parse_node_get_sub_ptr (cmd%pn, 3)
call cmd%compile_options (global)
cmd%n_in = parse_node_get_n_sub (pn_pol_spec)
allocate (cmd%smatrix (cmd%n_in))
pn_smatrix => parse_node_get_sub_ptr (pn_pol_spec)
do i = 1, cmd%n_in
call cmd%smatrix(i)%compile (pn_smatrix)
pn_smatrix => parse_node_get_next_ptr (pn_smatrix)
end do
end subroutine cmd_beams_pol_density_compile
@ %def cmd_beams_pol_density_compile
@ Command execution: Fill polarization density matrices. No check
yet, the matrices are checked and normalized when the actual beam
object is created, just before integration. For intermediate storage,
we use the [[beam_structure]] object in the [[global]] data set.
<<Commands: cmd beams pol density: TBP>>=
procedure :: execute => cmd_beams_pol_density_execute
<<Commands: procedures>>=
subroutine cmd_beams_pol_density_execute (cmd, global)
class(cmd_beams_pol_density_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(smatrix_t) :: smatrix
integer :: i
call global%beam_structure%init_pol (cmd%n_in)
do i = 1, cmd%n_in
call cmd%smatrix(i)%evaluate (smatrix, global)
call global%beam_structure%set_smatrix (i, smatrix)
end do
end subroutine cmd_beams_pol_density_execute
@ %def cmd_beams_pol_density_execute
@
\subsubsection{Beam polarization fraction}
In addition to the polarization density matrix, we can independently
specify the polarization fraction for one or both beams.
<<Commands: types>>=
type, extends (command_t) :: cmd_beams_pol_fraction_t
private
integer :: n_in = 0
type(parse_node_p), dimension(:), allocatable :: expr
contains
<<Commands: cmd beams pol fraction: TBP>>
end type cmd_beams_pol_fraction_t
@ %def cmd_beams_pol_fraction_t
@ Output.
<<Commands: cmd beams pol fraction: TBP>>=
procedure :: write => cmd_beams_pol_fraction_write
<<Commands: procedures>>=
subroutine cmd_beams_pol_fraction_write (cmd, unit, indent)
class(cmd_beams_pol_fraction_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
select case (cmd%n_in)
case (1)
write (u, "(1x,A)") "beams polarization fraction: 1 [decay]"
case (2)
write (u, "(1x,A)") "beams polarization fraction: 2 [scattering]"
case default
write (u, "(1x,A)") "beams polarization fraction: [undefined]"
end select
end subroutine cmd_beams_pol_fraction_write
@ %def cmd_beams_pol_fraction_write
@ Compile. Find and assign the parse nodes.
Note: local environments are not yet supported.
<<Commands: cmd beams pol fraction: TBP>>=
procedure :: compile => cmd_beams_pol_fraction_compile
<<Commands: procedures>>=
subroutine cmd_beams_pol_fraction_compile (cmd, global)
class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_frac_spec, pn_expr
integer :: i
pn_frac_spec => parse_node_get_sub_ptr (cmd%pn, 3)
call cmd%compile_options (global)
cmd%n_in = parse_node_get_n_sub (pn_frac_spec)
allocate (cmd%expr (cmd%n_in))
pn_expr => parse_node_get_sub_ptr (pn_frac_spec)
do i = 1, cmd%n_in
cmd%expr(i)%ptr => pn_expr
pn_expr => parse_node_get_next_ptr (pn_expr)
end do
end subroutine cmd_beams_pol_fraction_compile
@ %def cmd_beams_pol_fraction_compile
@ Command execution: Retrieve the numerical values of the beam
polarization fractions. The results are stored in the
[[beam_structure]] component of the [[global]] data block.
<<Commands: cmd beams pol fraction: TBP>>=
procedure :: execute => cmd_beams_pol_fraction_execute
<<Commands: procedures>>=
subroutine cmd_beams_pol_fraction_execute (cmd, global)
class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
real(default), dimension(:), allocatable :: pol_f
type(eval_tree_t) :: expr
integer :: i
var_list => global%get_var_list_ptr ()
allocate (pol_f (cmd%n_in))
do i = 1, cmd%n_in
call expr%init_expr (cmd%expr(i)%ptr, var_list)
call expr%evaluate ()
if (expr%is_known ()) then
pol_f(i) = expr%get_real ()
else
call msg_fatal ("beams polarization fraction: undefined value")
end if
call expr%final ()
end do
call global%beam_structure%set_pol_f (pol_f)
end subroutine cmd_beams_pol_fraction_execute
@ %def cmd_beams_pol_fraction_execute
@
\subsubsection{Beam momentum}
This is completely analogous to the previous command, hence we can use
inheritance.
<<Commands: types>>=
type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_momentum_t
contains
<<Commands: cmd beams momentum: TBP>>
end type cmd_beams_momentum_t
@ %def cmd_beams_momentum_t
@ Output.
<<Commands: cmd beams momentum: TBP>>=
procedure :: write => cmd_beams_momentum_write
<<Commands: procedures>>=
subroutine cmd_beams_momentum_write (cmd, unit, indent)
class(cmd_beams_momentum_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
select case (cmd%n_in)
case (1)
write (u, "(1x,A)") "beams momentum: 1 [decay]"
case (2)
write (u, "(1x,A)") "beams momentum: 2 [scattering]"
case default
write (u, "(1x,A)") "beams momentum: [undefined]"
end select
end subroutine cmd_beams_momentum_write
@ %def cmd_beams_momentum_write
@ Compile: inherited.
Command execution: Not inherited, but just the error string and the final
command are changed.
<<Commands: cmd beams momentum: TBP>>=
procedure :: execute => cmd_beams_momentum_execute
<<Commands: procedures>>=
subroutine cmd_beams_momentum_execute (cmd, global)
class(cmd_beams_momentum_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
real(default), dimension(:), allocatable :: p
type(eval_tree_t) :: expr
integer :: i
var_list => global%get_var_list_ptr ()
allocate (p (cmd%n_in))
do i = 1, cmd%n_in
call expr%init_expr (cmd%expr(i)%ptr, var_list)
call expr%evaluate ()
if (expr%is_known ()) then
p(i) = expr%get_real ()
else
call msg_fatal ("beams momentum: undefined value")
end if
call expr%final ()
end do
call global%beam_structure%set_momentum (p)
end subroutine cmd_beams_momentum_execute
@ %def cmd_beams_momentum_execute
@
\subsubsection{Beam angles}
Again, this is analogous. There are two angles, polar angle $\theta$
and azimuthal angle $\phi$, which can be set independently for both beams.
<<Commands: types>>=
type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_theta_t
contains
<<Commands: cmd beams theta: TBP>>
end type cmd_beams_theta_t
type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_phi_t
contains
<<Commands: cmd beams phi: TBP>>
end type cmd_beams_phi_t
@ %def cmd_beams_theta_t
@ %def cmd_beams_phi_t
@ Output.
<<Commands: cmd beams theta: TBP>>=
procedure :: write => cmd_beams_theta_write
<<Commands: cmd beams phi: TBP>>=
procedure :: write => cmd_beams_phi_write
<<Commands: procedures>>=
subroutine cmd_beams_theta_write (cmd, unit, indent)
class(cmd_beams_theta_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
select case (cmd%n_in)
case (1)
write (u, "(1x,A)") "beams theta: 1 [decay]"
case (2)
write (u, "(1x,A)") "beams theta: 2 [scattering]"
case default
write (u, "(1x,A)") "beams theta: [undefined]"
end select
end subroutine cmd_beams_theta_write
subroutine cmd_beams_phi_write (cmd, unit, indent)
class(cmd_beams_phi_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
select case (cmd%n_in)
case (1)
write (u, "(1x,A)") "beams phi: 1 [decay]"
case (2)
write (u, "(1x,A)") "beams phi: 2 [scattering]"
case default
write (u, "(1x,A)") "beams phi: [undefined]"
end select
end subroutine cmd_beams_phi_write
@ %def cmd_beams_theta_write
@ %def cmd_beams_phi_write
@ Compile: inherited.
Command execution: Not inherited, but just the error string and the final
command are changed.
<<Commands: cmd beams theta: TBP>>=
procedure :: execute => cmd_beams_theta_execute
<<Commands: cmd beams phi: TBP>>=
procedure :: execute => cmd_beams_phi_execute
<<Commands: procedures>>=
subroutine cmd_beams_theta_execute (cmd, global)
class(cmd_beams_theta_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
real(default), dimension(:), allocatable :: theta
type(eval_tree_t) :: expr
integer :: i
var_list => global%get_var_list_ptr ()
allocate (theta (cmd%n_in))
do i = 1, cmd%n_in
call expr%init_expr (cmd%expr(i)%ptr, var_list)
call expr%evaluate ()
if (expr%is_known ()) then
theta(i) = expr%get_real ()
else
call msg_fatal ("beams theta: undefined value")
end if
call expr%final ()
end do
call global%beam_structure%set_theta (theta)
end subroutine cmd_beams_theta_execute
subroutine cmd_beams_phi_execute (cmd, global)
class(cmd_beams_phi_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
real(default), dimension(:), allocatable :: phi
type(eval_tree_t) :: expr
integer :: i
var_list => global%get_var_list_ptr ()
allocate (phi (cmd%n_in))
do i = 1, cmd%n_in
call expr%init_expr (cmd%expr(i)%ptr, var_list)
call expr%evaluate ()
if (expr%is_known ()) then
phi(i) = expr%get_real ()
else
call msg_fatal ("beams phi: undefined value")
end if
call expr%final ()
end do
call global%beam_structure%set_phi (phi)
end subroutine cmd_beams_phi_execute
@ %def cmd_beams_theta_execute
@ %def cmd_beams_phi_execute
@
\subsubsection{Cuts}
Define a cut expression. We store the parse tree for the right-hand
side instead of compiling it. Compilation is deferred to the process
environment where the cut expression is used.
<<Commands: types>>=
type, extends (command_t) :: cmd_cuts_t
private
type(parse_node_t), pointer :: pn_lexpr => null ()
contains
<<Commands: cmd cuts: TBP>>
end type cmd_cuts_t
@ %def cmd_cuts_t
@ Output. Do not print the parse tree, since this may get cluttered.
Just a message that cuts have been defined.
<<Commands: cmd cuts: TBP>>=
procedure :: write => cmd_cuts_write
<<Commands: procedures>>=
subroutine cmd_cuts_write (cmd, unit, indent)
class(cmd_cuts_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "cuts: [defined]"
end subroutine cmd_cuts_write
@ %def cmd_cuts_write
@ Compile. Simply store the parse (sub)tree.
<<Commands: cmd cuts: TBP>>=
procedure :: compile => cmd_cuts_compile
<<Commands: procedures>>=
subroutine cmd_cuts_compile (cmd, global)
class(cmd_cuts_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
end subroutine cmd_cuts_compile
@ %def cmd_cuts_compile
@ Instead of evaluating the cut expression, link the parse tree to the
global data set, such that it is compiled and executed in the
appropriate process context.
<<Commands: cmd cuts: TBP>>=
procedure :: execute => cmd_cuts_execute
<<Commands: procedures>>=
subroutine cmd_cuts_execute (cmd, global)
class(cmd_cuts_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
global%pn%cuts_lexpr => cmd%pn_lexpr
end subroutine cmd_cuts_execute
@ %def cmd_cuts_execute
@
\subsubsection{General, Factorization and Renormalization Scales}
Define a scale expression for either the renormalization or the
factorization scale. We store the parse tree for the right-hand
side instead of compiling it. Compilation is deferred to the process
environment where the expression is used.
<<Commands: types>>=
type, extends (command_t) :: cmd_scale_t
private
type(parse_node_t), pointer :: pn_expr => null ()
contains
<<Commands: cmd scale: TBP>>
end type cmd_scale_t
@ %def cmd_scale_t
<<Commands: types>>=
type, extends (command_t) :: cmd_fac_scale_t
private
type(parse_node_t), pointer :: pn_expr => null ()
contains
<<Commands: cmd fac scale: TBP>>
end type cmd_fac_scale_t
@ %def cmd_fac_scale_t
<<Commands: types>>=
type, extends (command_t) :: cmd_ren_scale_t
private
type(parse_node_t), pointer :: pn_expr => null ()
contains
<<Commands: cmd ren scale: TBP>>
end type cmd_ren_scale_t
@ %def cmd_ren_scale_t
@ Output. Do not print the parse tree, since this may get cluttered.
Just a message that scale, renormalization and factorization have been
defined, respectively.
<<Commands: cmd scale: TBP>>=
procedure :: write => cmd_scale_write
<<Commands: procedures>>=
subroutine cmd_scale_write (cmd, unit, indent)
class(cmd_scale_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "scale: [defined]"
end subroutine cmd_scale_write
@ %def cmd_scale_write
@
<<Commands: cmd fac scale: TBP>>=
procedure :: write => cmd_fac_scale_write
<<Commands: procedures>>=
subroutine cmd_fac_scale_write (cmd, unit, indent)
class(cmd_fac_scale_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "factorization scale: [defined]"
end subroutine cmd_fac_scale_write
@ %def cmd_fac_scale_write
@
<<Commands: cmd ren scale: TBP>>=
procedure :: write => cmd_ren_scale_write
<<Commands: procedures>>=
subroutine cmd_ren_scale_write (cmd, unit, indent)
class(cmd_ren_scale_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "renormalization scale: [defined]"
end subroutine cmd_ren_scale_write
@ %def cmd_ren_scale_write
@ Compile. Simply store the parse (sub)tree.
<<Commands: cmd scale: TBP>>=
procedure :: compile => cmd_scale_compile
<<Commands: procedures>>=
subroutine cmd_scale_compile (cmd, global)
class(cmd_scale_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
end subroutine cmd_scale_compile
@ %def cmd_scale_compile
@
<<Commands: cmd fac scale: TBP>>=
procedure :: compile => cmd_fac_scale_compile
<<Commands: procedures>>=
subroutine cmd_fac_scale_compile (cmd, global)
class(cmd_fac_scale_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
end subroutine cmd_fac_scale_compile
@ %def cmd_fac_scale_compile
@
<<Commands: cmd ren scale: TBP>>=
procedure :: compile => cmd_ren_scale_compile
<<Commands: procedures>>=
subroutine cmd_ren_scale_compile (cmd, global)
class(cmd_ren_scale_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
end subroutine cmd_ren_scale_compile
@ %def cmd_ren_scale_compile
@ Instead of evaluating the scale expression, link the parse tree to the
global data set, such that it is compiled and executed in the
appropriate process context.
<<Commands: cmd scale: TBP>>=
procedure :: execute => cmd_scale_execute
<<Commands: procedures>>=
subroutine cmd_scale_execute (cmd, global)
class(cmd_scale_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
global%pn%scale_expr => cmd%pn_expr
end subroutine cmd_scale_execute
@ %def cmd_scale_execute
@
<<Commands: cmd fac scale: TBP>>=
procedure :: execute => cmd_fac_scale_execute
<<Commands: procedures>>=
subroutine cmd_fac_scale_execute (cmd, global)
class(cmd_fac_scale_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
global%pn%fac_scale_expr => cmd%pn_expr
end subroutine cmd_fac_scale_execute
@ %def cmd_fac_scale_execute
@
<<Commands: cmd ren scale: TBP>>=
procedure :: execute => cmd_ren_scale_execute
<<Commands: procedures>>=
subroutine cmd_ren_scale_execute (cmd, global)
class(cmd_ren_scale_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
global%pn%ren_scale_expr => cmd%pn_expr
end subroutine cmd_ren_scale_execute
@ %def cmd_ren_scale_execute
@
\subsubsection{Weight}
Define a weight expression. The weight is applied to a process to be
integrated, event by event. We store the parse tree for the right-hand
side instead of compiling it. Compilation is deferred to the process
environment where the expression is used.
<<Commands: types>>=
type, extends (command_t) :: cmd_weight_t
private
type(parse_node_t), pointer :: pn_expr => null ()
contains
<<Commands: cmd weight: TBP>>
end type cmd_weight_t
@ %def cmd_weight_t
@ Output. Do not print the parse tree, since this may get cluttered.
Just a message that scale, renormalization and factorization have been
defined, respectively.
<<Commands: cmd weight: TBP>>=
procedure :: write => cmd_weight_write
<<Commands: procedures>>=
subroutine cmd_weight_write (cmd, unit, indent)
class(cmd_weight_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "weight expression: [defined]"
end subroutine cmd_weight_write
@ %def cmd_weight_write
@ Compile. Simply store the parse (sub)tree.
<<Commands: cmd weight: TBP>>=
procedure :: compile => cmd_weight_compile
<<Commands: procedures>>=
subroutine cmd_weight_compile (cmd, global)
class(cmd_weight_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
end subroutine cmd_weight_compile
@ %def cmd_weight_compile
@ Instead of evaluating the expression, link the parse tree to the
global data set, such that it is compiled and executed in the
appropriate process context.
<<Commands: cmd weight: TBP>>=
procedure :: execute => cmd_weight_execute
<<Commands: procedures>>=
subroutine cmd_weight_execute (cmd, global)
class(cmd_weight_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
global%pn%weight_expr => cmd%pn_expr
end subroutine cmd_weight_execute
@ %def cmd_weight_execute
@
\subsubsection{Selection}
Define a selection expression. This is to be applied upon simulation or
event-file rescanning, event by event. We store the parse tree for the
right-hand side instead of compiling it. Compilation is deferred to the
environment where the expression is used.
<<Commands: types>>=
type, extends (command_t) :: cmd_selection_t
private
type(parse_node_t), pointer :: pn_expr => null ()
contains
<<Commands: cmd selection: TBP>>
end type cmd_selection_t
@ %def cmd_selection_t
@ Output. Do not print the parse tree, since this may get cluttered.
Just a message that scale, renormalization and factorization have been
defined, respectively.
<<Commands: cmd selection: TBP>>=
procedure :: write => cmd_selection_write
<<Commands: procedures>>=
subroutine cmd_selection_write (cmd, unit, indent)
class(cmd_selection_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "selection expression: [defined]"
end subroutine cmd_selection_write
@ %def cmd_selection_write
@ Compile. Simply store the parse (sub)tree.
<<Commands: cmd selection: TBP>>=
procedure :: compile => cmd_selection_compile
<<Commands: procedures>>=
subroutine cmd_selection_compile (cmd, global)
class(cmd_selection_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
end subroutine cmd_selection_compile
@ %def cmd_selection_compile
@ Instead of evaluating the expression, link the parse tree to the
global data set, such that it is compiled and executed in the
appropriate process context.
<<Commands: cmd selection: TBP>>=
procedure :: execute => cmd_selection_execute
<<Commands: procedures>>=
subroutine cmd_selection_execute (cmd, global)
class(cmd_selection_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
global%pn%selection_lexpr => cmd%pn_expr
end subroutine cmd_selection_execute
@ %def cmd_selection_execute
@
\subsubsection{Reweight}
Define a reweight expression. This is to be applied upon simulation or
event-file rescanning, event by event. We store the parse tree for the
right-hand side instead of compiling it. Compilation is deferred to the
environment where the expression is used.
<<Commands: types>>=
type, extends (command_t) :: cmd_reweight_t
private
type(parse_node_t), pointer :: pn_expr => null ()
contains
<<Commands: cmd reweight: TBP>>
end type cmd_reweight_t
@ %def cmd_reweight_t
@ Output. Do not print the parse tree, since this may get cluttered.
Just a message that scale, renormalization and factorization have been
defined, respectively.
<<Commands: cmd reweight: TBP>>=
procedure :: write => cmd_reweight_write
<<Commands: procedures>>=
subroutine cmd_reweight_write (cmd, unit, indent)
class(cmd_reweight_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "reweight expression: [defined]"
end subroutine cmd_reweight_write
@ %def cmd_reweight_write
@ Compile. Simply store the parse (sub)tree.
<<Commands: cmd reweight: TBP>>=
procedure :: compile => cmd_reweight_compile
<<Commands: procedures>>=
subroutine cmd_reweight_compile (cmd, global)
class(cmd_reweight_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
end subroutine cmd_reweight_compile
@ %def cmd_reweight_compile
@ Instead of evaluating the expression, link the parse tree to the
global data set, such that it is compiled and executed in the
appropriate process context.
<<Commands: cmd reweight: TBP>>=
procedure :: execute => cmd_reweight_execute
<<Commands: procedures>>=
subroutine cmd_reweight_execute (cmd, global)
class(cmd_reweight_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
global%pn%reweight_expr => cmd%pn_expr
end subroutine cmd_reweight_execute
@ %def cmd_reweight_execute
@
\subsubsection{Alternative Simulation Setups}
Together with simulation, we can re-evaluate event weights in the context of
alternative setups. The [[cmd_alt_setup_t]] object is designed to hold these
setups, which are brace-enclosed command lists. Compilation is deferred to
the simulation environment where the setup expression is used.
<<Commands: types>>=
type, extends (command_t) :: cmd_alt_setup_t
private
type(parse_node_p), dimension(:), allocatable :: setup
contains
<<Commands: cmd alt setup: TBP>>
end type cmd_alt_setup_t
@ %def cmd_alt_setup_t
@ Output. Print just a message that the alternative setup list has been
defined.
<<Commands: cmd alt setup: TBP>>=
procedure :: write => cmd_alt_setup_write
<<Commands: procedures>>=
subroutine cmd_alt_setup_write (cmd, unit, indent)
class(cmd_alt_setup_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,I0,A)") "alt_setup: ", size (cmd%setup), " entries"
end subroutine cmd_alt_setup_write
@ %def cmd_alt_setup_write
@ Compile. Store the parse sub-trees in an array.
<<Commands: cmd alt setup: TBP>>=
procedure :: compile => cmd_alt_setup_compile
<<Commands: procedures>>=
subroutine cmd_alt_setup_compile (cmd, global)
class(cmd_alt_setup_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_list, pn_setup
integer :: i
pn_list => parse_node_get_sub_ptr (cmd%pn, 3)
if (associated (pn_list)) then
allocate (cmd%setup (parse_node_get_n_sub (pn_list)))
i = 1
pn_setup => parse_node_get_sub_ptr (pn_list)
do while (associated (pn_setup))
cmd%setup(i)%ptr => pn_setup
i = i + 1
pn_setup => parse_node_get_next_ptr (pn_setup)
end do
else
allocate (cmd%setup (0))
end if
end subroutine cmd_alt_setup_compile
@ %def cmd_alt_setup_compile
@ Execute. Transfer the array of command lists to the global environment.
<<Commands: cmd alt setup: TBP>>=
procedure :: execute => cmd_alt_setup_execute
<<Commands: procedures>>=
subroutine cmd_alt_setup_execute (cmd, global)
class(cmd_alt_setup_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
if (allocated (global%pn%alt_setup)) deallocate (global%pn%alt_setup)
allocate (global%pn%alt_setup (size (cmd%setup)))
global%pn%alt_setup = cmd%setup
end subroutine cmd_alt_setup_execute
@ %def cmd_alt_setup_execute
@
\subsubsection{Integration}
Integrate several processes, consecutively with identical parameters.
<<Commands: types>>=
type, extends (command_t) :: cmd_integrate_t
private
integer :: n_proc = 0
type(string_t), dimension(:), allocatable :: process_id
contains
<<Commands: cmd integrate: TBP>>
end type cmd_integrate_t
@ %def cmd_integrate_t
@ Output: we know the process IDs.
<<Commands: cmd integrate: TBP>>=
procedure :: write => cmd_integrate_write
<<Commands: procedures>>=
subroutine cmd_integrate_write (cmd, unit, indent)
class(cmd_integrate_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)", advance="no") "integrate ("
do i = 1, cmd%n_proc
if (i > 1) write (u, "(A,1x)", advance="no") ","
write (u, "(A)", advance="no") char (cmd%process_id(i))
end do
write (u, "(A)") ")"
end subroutine cmd_integrate_write
@ %def cmd_integrate_write
@ Compile.
<<Commands: cmd integrate: TBP>>=
procedure :: compile => cmd_integrate_compile
<<Commands: procedures>>=
subroutine cmd_integrate_compile (cmd, global)
class(cmd_integrate_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_proclist, pn_proc
integer :: i
pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
call cmd%compile_options (global)
cmd%n_proc = parse_node_get_n_sub (pn_proclist)
allocate (cmd%process_id (cmd%n_proc))
pn_proc => parse_node_get_sub_ptr (pn_proclist)
do i = 1, cmd%n_proc
cmd%process_id(i) = parse_node_get_string (pn_proc)
call global%process_stack%init_result_vars (cmd%process_id(i))
pn_proc => parse_node_get_next_ptr (pn_proc)
end do
end subroutine cmd_integrate_compile
@ %def cmd_integrate_compile
@ Command execution. Integrate the process(es) with the predefined number
of passes, iterations and calls. For structure functions, cuts,
weight and scale, use local definitions if present; by default, the local
definitions are initialized with the global ones.
The [[integrate]] procedure should take its input from the currently
active local environment, but produce a process record in the stack of
the global environment.
Since the process acquires a snapshot of the variable list, so if the global
list (or the local one) is deleted, this does no harm. This implies that
later changes of the variable list do not affect the stored process.
<<Commands: cmd integrate: TBP>>=
procedure :: execute => cmd_integrate_execute
<<Commands: procedures>>=
subroutine cmd_integrate_execute (cmd, global)
class(cmd_integrate_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
integer :: i
call msg_debug (D_CORE, "cmd_integrate_execute")
do i = 1, cmd%n_proc
call msg_debug (D_CORE, "cmd%process_id(i) ", cmd%process_id(i))
call integrate_process (cmd%process_id(i), cmd%local, global)
call global%process_stack%fill_result_vars (cmd%process_id(i))
call global%process_stack%update_result_vars &
(cmd%process_id(i), global%var_list)
if (signal_is_pending ()) return
end do
end subroutine cmd_integrate_execute
@ %def cmd_integrate_execute
@
\subsubsection{Observables}
Declare an observable. After the declaration, it can be used to
record data, and at the end one can retrieve average and error.
<<Commands: types>>=
type, extends (command_t) :: cmd_observable_t
private
type(string_t) :: id
contains
<<Commands: cmd observable: TBP>>
end type cmd_observable_t
@ %def cmd_observable_t
@ Output. We know the ID.
<<Commands: cmd observable: TBP>>=
procedure :: write => cmd_observable_write
<<Commands: procedures>>=
subroutine cmd_observable_write (cmd, unit, indent)
class(cmd_observable_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,A)") "observable: ", char (cmd%id)
end subroutine cmd_observable_write
@ %def cmd_observable_write
@ Compile. Just record the observable ID.
<<Commands: cmd observable: TBP>>=
procedure :: compile => cmd_observable_compile
<<Commands: procedures>>=
subroutine cmd_observable_compile (cmd, global)
class(cmd_observable_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_tag
pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
if (associated (pn_tag)) then
cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
end if
call cmd%compile_options (global)
select case (char (parse_node_get_rule_key (pn_tag)))
case ("analysis_id")
cmd%id = parse_node_get_string (pn_tag)
case default
call msg_bug ("observable: name expression not implemented (yet)")
end select
end subroutine cmd_observable_compile
@ %def cmd_observable_compile
@ Command execution. This declares the observable and allocates it in
the analysis store.
<<Commands: cmd observable: TBP>>=
procedure :: execute => cmd_observable_execute
<<Commands: procedures>>=
subroutine cmd_observable_execute (cmd, global)
class(cmd_observable_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(graph_options_t) :: graph_options
type(string_t) :: label, unit
var_list => cmd%local%get_var_list_ptr ()
label = var_list%get_sval (var_str ("$obs_label"))
unit = var_list%get_sval (var_str ("$obs_unit"))
call graph_options_init (graph_options)
call set_graph_options (graph_options, var_list)
call analysis_init_observable (cmd%id, label, unit, graph_options)
end subroutine cmd_observable_execute
@ %def cmd_observable_execute
@
\subsubsection{Histograms}
Declare a histogram. At minimum, we have to set lower and upper bound
and bin width.
<<Commands: types>>=
type, extends (command_t) :: cmd_histogram_t
private
type(string_t) :: id
type(parse_node_t), pointer :: pn_lower_bound => null ()
type(parse_node_t), pointer :: pn_upper_bound => null ()
type(parse_node_t), pointer :: pn_bin_width => null ()
contains
<<Commands: cmd histogram: TBP>>
end type cmd_histogram_t
@ %def cmd_histogram_t
@ Output. Just print the ID.
<<Commands: cmd histogram: TBP>>=
procedure :: write => cmd_histogram_write
<<Commands: procedures>>=
subroutine cmd_histogram_write (cmd, unit, indent)
class(cmd_histogram_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,A)") "histogram: ", char (cmd%id)
end subroutine cmd_histogram_write
@ %def cmd_histogram_write
@ Compile. Record the histogram ID and initialize lower, upper bound
and bin width.
<<Commands: cmd histogram: TBP>>=
procedure :: compile => cmd_histogram_compile
<<Commands: procedures>>=
subroutine cmd_histogram_compile (cmd, global)
class(cmd_histogram_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_tag, pn_args, pn_arg1, pn_arg2, pn_arg3
character(*), parameter :: e_illegal_use = &
"illegal usage of 'histogram': insufficient number of arguments"
pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
pn_args => parse_node_get_next_ptr (pn_tag)
if (associated (pn_args)) then
pn_arg1 => parse_node_get_sub_ptr (pn_args)
if (.not. associated (pn_arg1)) call msg_fatal (e_illegal_use)
pn_arg2 => parse_node_get_next_ptr (pn_arg1)
if (.not. associated (pn_arg2)) call msg_fatal (e_illegal_use)
pn_arg3 => parse_node_get_next_ptr (pn_arg2)
cmd%pn_opt => parse_node_get_next_ptr (pn_args)
end if
call cmd%compile_options (global)
select case (char (parse_node_get_rule_key (pn_tag)))
case ("analysis_id")
cmd%id = parse_node_get_string (pn_tag)
case default
call msg_bug ("histogram: name expression not implemented (yet)")
end select
cmd%pn_lower_bound => pn_arg1
cmd%pn_upper_bound => pn_arg2
cmd%pn_bin_width => pn_arg3
end subroutine cmd_histogram_compile
@ %def cmd_histogram_compile
@ Command execution. This declares the histogram and allocates it in
the analysis store.
<<Commands: cmd histogram: TBP>>=
procedure :: execute => cmd_histogram_execute
<<Commands: procedures>>=
subroutine cmd_histogram_execute (cmd, global)
class(cmd_histogram_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
real(default) :: lower_bound, upper_bound, bin_width
integer :: bin_number
logical :: bin_width_is_used, normalize_bins
type(string_t) :: obs_label, obs_unit
type(graph_options_t) :: graph_options
type(drawing_options_t) :: drawing_options
var_list => cmd%local%get_var_list_ptr ()
lower_bound = eval_real (cmd%pn_lower_bound, var_list)
upper_bound = eval_real (cmd%pn_upper_bound, var_list)
if (associated (cmd%pn_bin_width)) then
bin_width = eval_real (cmd%pn_bin_width, var_list)
bin_width_is_used = .true.
else if (var_list%is_known (var_str ("n_bins"))) then
bin_number = &
var_list%get_ival (var_str ("n_bins"))
bin_width_is_used = .false.
else
call msg_error ("Cmd '" // char (cmd%id) // &
"': neither bin width nor number is defined")
end if
normalize_bins = &
var_list%get_lval (var_str ("?normalize_bins"))
obs_label = &
var_list%get_sval (var_str ("$obs_label"))
obs_unit = &
var_list%get_sval (var_str ("$obs_unit"))
call graph_options_init (graph_options)
call set_graph_options (graph_options, var_list)
call drawing_options_init_histogram (drawing_options)
call set_drawing_options (drawing_options, var_list)
if (bin_width_is_used) then
call analysis_init_histogram &
(cmd%id, lower_bound, upper_bound, bin_width, &
normalize_bins, &
obs_label, obs_unit, &
graph_options, drawing_options)
else
call analysis_init_histogram &
(cmd%id, lower_bound, upper_bound, bin_number, &
normalize_bins, &
obs_label, obs_unit, &
graph_options, drawing_options)
end if
end subroutine cmd_histogram_execute
@ %def cmd_histogram_execute
@ Set the graph options from a variable list.
<<Commands: procedures>>=
subroutine set_graph_options (gro, var_list)
type(graph_options_t), intent(inout) :: gro
type(var_list_t), intent(in) :: var_list
call graph_options_set (gro, title = &
var_list%get_sval (var_str ("$title")))
call graph_options_set (gro, description = &
var_list%get_sval (var_str ("$description")))
call graph_options_set (gro, x_label = &
var_list%get_sval (var_str ("$x_label")))
call graph_options_set (gro, y_label = &
var_list%get_sval (var_str ("$y_label")))
call graph_options_set (gro, width_mm = &
var_list%get_ival (var_str ("graph_width_mm")))
call graph_options_set (gro, height_mm = &
var_list%get_ival (var_str ("graph_height_mm")))
call graph_options_set (gro, x_log = &
var_list%get_lval (var_str ("?x_log")))
call graph_options_set (gro, y_log = &
var_list%get_lval (var_str ("?y_log")))
if (var_list%is_known (var_str ("x_min"))) &
call graph_options_set (gro, x_min = &
var_list%get_rval (var_str ("x_min")))
if (var_list%is_known (var_str ("x_max"))) &
call graph_options_set (gro, x_max = &
var_list%get_rval (var_str ("x_max")))
if (var_list%is_known (var_str ("y_min"))) &
call graph_options_set (gro, y_min = &
var_list%get_rval (var_str ("y_min")))
if (var_list%is_known (var_str ("y_max"))) &
call graph_options_set (gro, y_max = &
var_list%get_rval (var_str ("y_max")))
call graph_options_set (gro, gmlcode_bg = &
var_list%get_sval (var_str ("$gmlcode_bg")))
call graph_options_set (gro, gmlcode_fg = &
var_list%get_sval (var_str ("$gmlcode_fg")))
end subroutine set_graph_options
@ %def set_graph_options
@ Set the drawing options from a variable list.
<<Commands: procedures>>=
subroutine set_drawing_options (dro, var_list)
type(drawing_options_t), intent(inout) :: dro
type(var_list_t), intent(in) :: var_list
if (var_list%is_known (var_str ("?draw_histogram"))) then
if (var_list%get_lval (var_str ("?draw_histogram"))) then
call drawing_options_set (dro, with_hbars = .true.)
else
call drawing_options_set (dro, with_hbars = .false., &
with_base = .false., fill = .false., piecewise = .false.)
end if
end if
if (var_list%is_known (var_str ("?draw_base"))) then
if (var_list%get_lval (var_str ("?draw_base"))) then
call drawing_options_set (dro, with_base = .true.)
else
call drawing_options_set (dro, with_base = .false., fill = .false.)
end if
end if
if (var_list%is_known (var_str ("?draw_piecewise"))) then
if (var_list%get_lval (var_str ("?draw_piecewise"))) then
call drawing_options_set (dro, piecewise = .true.)
else
call drawing_options_set (dro, piecewise = .false.)
end if
end if
if (var_list%is_known (var_str ("?fill_curve"))) then
if (var_list%get_lval (var_str ("?fill_curve"))) then
call drawing_options_set (dro, fill = .true., with_base = .true.)
else
call drawing_options_set (dro, fill = .false.)
end if
end if
if (var_list%is_known (var_str ("?draw_curve"))) then
if (var_list%get_lval (var_str ("?draw_curve"))) then
call drawing_options_set (dro, draw = .true.)
else
call drawing_options_set (dro, draw = .false.)
end if
end if
if (var_list%is_known (var_str ("?draw_errors"))) then
if (var_list%get_lval (var_str ("?draw_errors"))) then
call drawing_options_set (dro, err = .true.)
else
call drawing_options_set (dro, err = .false.)
end if
end if
if (var_list%is_known (var_str ("?draw_symbols"))) then
if (var_list%get_lval (var_str ("?draw_symbols"))) then
call drawing_options_set (dro, symbols = .true.)
else
call drawing_options_set (dro, symbols = .false.)
end if
end if
if (var_list%is_known (var_str ("$fill_options"))) then
call drawing_options_set (dro, fill_options = &
var_list%get_sval (var_str ("$fill_options")))
end if
if (var_list%is_known (var_str ("$draw_options"))) then
call drawing_options_set (dro, draw_options = &
var_list%get_sval (var_str ("$draw_options")))
end if
if (var_list%is_known (var_str ("$err_options"))) then
call drawing_options_set (dro, err_options = &
var_list%get_sval (var_str ("$err_options")))
end if
if (var_list%is_known (var_str ("$symbol"))) then
call drawing_options_set (dro, symbol = &
var_list%get_sval (var_str ("$symbol")))
end if
if (var_list%is_known (var_str ("$gmlcode_bg"))) then
call drawing_options_set (dro, gmlcode_bg = &
var_list%get_sval (var_str ("$gmlcode_bg")))
end if
if (var_list%is_known (var_str ("$gmlcode_fg"))) then
call drawing_options_set (dro, gmlcode_fg = &
var_list%get_sval (var_str ("$gmlcode_fg")))
end if
end subroutine set_drawing_options
@ %def set_drawing_options
@
\subsubsection{Plots}
Declare a plot. No mandatory arguments, just options.
<<Commands: types>>=
type, extends (command_t) :: cmd_plot_t
private
type(string_t) :: id
contains
<<Commands: cmd plot: TBP>>
end type cmd_plot_t
@ %def cmd_plot_t
@ Output. Just print the ID.
<<Commands: cmd plot: TBP>>=
procedure :: write => cmd_plot_write
<<Commands: procedures>>=
subroutine cmd_plot_write (cmd, unit, indent)
class(cmd_plot_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,A)") "plot: ", char (cmd%id)
end subroutine cmd_plot_write
@ %def cmd_plot_write
@ Compile. Record the plot ID and initialize lower, upper bound
and bin width.
<<Commands: cmd plot: TBP>>=
procedure :: compile => cmd_plot_compile
<<Commands: procedures>>=
subroutine cmd_plot_compile (cmd, global)
class(cmd_plot_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_tag
pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
call cmd%init (pn_tag, global)
end subroutine cmd_plot_compile
@ %def cmd_plot_compile
@ This init routine is separated because it is reused below for graph
initialization.
<<Commands: cmd plot: TBP>>=
procedure :: init => cmd_plot_init
<<Commands: procedures>>=
subroutine cmd_plot_init (plot, pn_tag, global)
class(cmd_plot_t), intent(inout) :: plot
type(parse_node_t), intent(in), pointer :: pn_tag
type(rt_data_t), intent(inout), target :: global
call plot%compile_options (global)
select case (char (parse_node_get_rule_key (pn_tag)))
case ("analysis_id")
plot%id = parse_node_get_string (pn_tag)
case default
call msg_bug ("plot: name expression not implemented (yet)")
end select
end subroutine cmd_plot_init
@ %def cmd_plot_init
@ Command execution. This declares the plot and allocates it in
the analysis store.
<<Commands: cmd plot: TBP>>=
procedure :: execute => cmd_plot_execute
<<Commands: procedures>>=
subroutine cmd_plot_execute (cmd, global)
class(cmd_plot_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(graph_options_t) :: graph_options
type(drawing_options_t) :: drawing_options
var_list => cmd%local%get_var_list_ptr ()
call graph_options_init (graph_options)
call set_graph_options (graph_options, var_list)
call drawing_options_init_plot (drawing_options)
call set_drawing_options (drawing_options, var_list)
call analysis_init_plot (cmd%id, graph_options, drawing_options)
end subroutine cmd_plot_execute
@ %def cmd_plot_execute
@
\subsubsection{Graphs}
Declare a graph. The graph is defined in terms of its contents. Both the
graph and its contents may carry options.
The graph object contains its own ID as well as the IDs of its elements. For
the elements, we reuse the [[cmd_plot_t]] defined above.
<<Commands: types>>=
type, extends (command_t) :: cmd_graph_t
private
type(string_t) :: id
integer :: n_elements = 0
type(cmd_plot_t), dimension(:), allocatable :: el
type(string_t), dimension(:), allocatable :: element_id
contains
<<Commands: cmd graph: TBP>>
end type cmd_graph_t
@ %def cmd_graph_t
@ Output. Just print the ID.
<<Commands: cmd graph: TBP>>=
procedure :: write => cmd_graph_write
<<Commands: procedures>>=
subroutine cmd_graph_write (cmd, unit, indent)
class(cmd_graph_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,A,A,I0,A)") "graph: ", char (cmd%id), &
" (", cmd%n_elements, " entries)"
end subroutine cmd_graph_write
@ %def cmd_graph_write
@ Compile. Record the graph ID and initialize lower, upper bound
and bin width. For compiling the graph element syntax, we use part of the
[[cmd_plot_t]] compiler.
Note: currently, we do not respect options, therefore just IDs on the RHS.
<<Commands: cmd graph: TBP>>=
procedure :: compile => cmd_graph_compile
<<Commands: procedures>>=
subroutine cmd_graph_compile (cmd, global)
class(cmd_graph_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_term, pn_tag, pn_def, pn_app
integer :: i
pn_term => parse_node_get_sub_ptr (cmd%pn, 2)
pn_tag => parse_node_get_sub_ptr (pn_term)
cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
call cmd%compile_options (global)
select case (char (parse_node_get_rule_key (pn_tag)))
case ("analysis_id")
cmd%id = parse_node_get_string (pn_tag)
case default
call msg_bug ("graph: name expression not implemented (yet)")
end select
pn_def => parse_node_get_next_ptr (pn_term, 2)
cmd%n_elements = parse_node_get_n_sub (pn_def)
allocate (cmd%element_id (cmd%n_elements))
allocate (cmd%el (cmd%n_elements))
pn_term => parse_node_get_sub_ptr (pn_def)
pn_tag => parse_node_get_sub_ptr (pn_term)
cmd%el(1)%pn_opt => parse_node_get_next_ptr (pn_tag)
call cmd%el(1)%init (pn_tag, global)
cmd%element_id(1) = parse_node_get_string (pn_tag)
pn_app => parse_node_get_next_ptr (pn_term)
do i = 2, cmd%n_elements
pn_term => parse_node_get_sub_ptr (pn_app, 2)
pn_tag => parse_node_get_sub_ptr (pn_term)
cmd%el(i)%pn_opt => parse_node_get_next_ptr (pn_tag)
call cmd%el(i)%init (pn_tag, global)
cmd%element_id(i) = parse_node_get_string (pn_tag)
pn_app => parse_node_get_next_ptr (pn_app)
end do
end subroutine cmd_graph_compile
@ %def cmd_graph_compile
@ Command execution. This declares the graph, allocates it in
the analysis store, and copies the graph elements.
For the graph, we set graph and default drawing options. For the elements, we
reset individual drawing options.
This accesses internals of the contained elements of type [[cmd_plot_t]], see
above. We might disentangle such an interdependency when this code is
rewritten using proper type extension.
<<Commands: cmd graph: TBP>>=
procedure :: execute => cmd_graph_execute
<<Commands: procedures>>=
subroutine cmd_graph_execute (cmd, global)
class(cmd_graph_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(graph_options_t) :: graph_options
type(drawing_options_t) :: drawing_options
integer :: i, type
var_list => cmd%local%get_var_list_ptr ()
call graph_options_init (graph_options)
call set_graph_options (graph_options, var_list)
call analysis_init_graph (cmd%id, cmd%n_elements, graph_options)
do i = 1, cmd%n_elements
if (associated (cmd%el(i)%options)) then
call cmd%el(i)%options%execute (cmd%el(i)%local)
end if
type = analysis_store_get_object_type (cmd%element_id(i))
select case (type)
case (AN_HISTOGRAM)
call drawing_options_init_histogram (drawing_options)
case (AN_PLOT)
call drawing_options_init_plot (drawing_options)
end select
call set_drawing_options (drawing_options, var_list)
if (associated (cmd%el(i)%options)) then
call set_drawing_options (drawing_options, cmd%el(i)%local%var_list)
end if
call analysis_fill_graph (cmd%id, i, cmd%element_id(i), drawing_options)
end do
end subroutine cmd_graph_execute
@ %def cmd_graph_execute
@
\subsubsection{Analysis}
Hold the analysis ID either as a string or as an expression:
<<Commands: types>>=
type :: analysis_id_t
type(string_t) :: tag
type(parse_node_t), pointer :: pn_sexpr => null ()
end type analysis_id_t
@ %def analysis_id_t
@ Define the analysis expression. We store the parse tree for the
right-hand side instead of compiling it. Compilation is deferred to
the process environment where the analysis expression is used.
<<Commands: types>>=
type, extends (command_t) :: cmd_analysis_t
private
type(parse_node_t), pointer :: pn_lexpr => null ()
contains
<<Commands: cmd analysis: TBP>>
end type cmd_analysis_t
@ %def cmd_analysis_t
@ Output. Print just a message that analysis has been defined.
<<Commands: cmd analysis: TBP>>=
procedure :: write => cmd_analysis_write
<<Commands: procedures>>=
subroutine cmd_analysis_write (cmd, unit, indent)
class(cmd_analysis_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "analysis: [defined]"
end subroutine cmd_analysis_write
@ %def cmd_analysis_write
@ Compile. Simply store the parse (sub)tree.
<<Commands: cmd analysis: TBP>>=
procedure :: compile => cmd_analysis_compile
<<Commands: procedures>>=
subroutine cmd_analysis_compile (cmd, global)
class(cmd_analysis_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
end subroutine cmd_analysis_compile
@ %def cmd_analysis_compile
@ Instead of evaluating the cut expression, link the parse tree to the
global data set, such that it is compiled and executed in the
appropriate process context.
<<Commands: cmd analysis: TBP>>=
procedure :: execute => cmd_analysis_execute
<<Commands: procedures>>=
subroutine cmd_analysis_execute (cmd, global)
class(cmd_analysis_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
global%pn%analysis_lexpr => cmd%pn_lexpr
end subroutine cmd_analysis_execute
@ %def cmd_analysis_execute
@
\subsubsection{Write histograms and plots}
The data type encapsulating the command:
<<Commands: types>>=
type, extends (command_t) :: cmd_write_analysis_t
private
type(analysis_id_t), dimension(:), allocatable :: id
type(string_t), dimension(:), allocatable :: tag
contains
<<Commands: cmd write analysis: TBP>>
end type cmd_write_analysis_t
@ %def analysis_id_t
@ %def cmd_write_analysis_t
@ Output. Just the keyword.
<<Commands: cmd write analysis: TBP>>=
procedure :: write => cmd_write_analysis_write
<<Commands: procedures>>=
subroutine cmd_write_analysis_write (cmd, unit, indent)
class(cmd_write_analysis_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "write_analysis"
end subroutine cmd_write_analysis_write
@ %def cmd_write_analysis_write
@ Compile.
<<Commands: cmd write analysis: TBP>>=
procedure :: compile => cmd_write_analysis_compile
<<Commands: procedures>>=
subroutine cmd_write_analysis_compile (cmd, global)
class(cmd_write_analysis_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
integer :: n, i
pn_clause => parse_node_get_sub_ptr (cmd%pn)
pn_args => parse_node_get_sub_ptr (pn_clause, 2)
cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
call cmd%compile_options (global)
if (associated (pn_args)) then
n = parse_node_get_n_sub (pn_args)
allocate (cmd%id (n))
do i = 1, n
pn_id => parse_node_get_sub_ptr (pn_args, i)
if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
cmd%id(i)%tag = parse_node_get_string (pn_id)
else
cmd%id(i)%pn_sexpr => pn_id
end if
end do
else
allocate (cmd%id (0))
end if
end subroutine cmd_write_analysis_compile
@ %def cmd_write_analysis_compile
@ The output format for real data values:
<<Commands: parameters>>=
character(*), parameter, public :: &
DEFAULT_ANALYSIS_FILENAME = "whizard_analysis.dat"
character(len=1), dimension(2), parameter, public :: &
FORBIDDEN_ENDINGS1 = [ "o", "a" ]
character(len=2), dimension(6), parameter, public :: &
FORBIDDEN_ENDINGS2 = [ "mp", "ps", "vg", "pg", "lo", "la" ]
character(len=3), dimension(16), parameter, public :: &
FORBIDDEN_ENDINGS3 = [ "aux", "dvi", "evt", "evx", "f03", "f90", &
"f95", "log", "ltp", "mpx", "olc", "olp", "pdf", "phs", "sin", "tex" ]
@ %def DEFAULT_ANALYSIS_FILENAME
@ %def FORBIDDEN_ENDINGS1
@ %def FORBIDDEN_ENDINGS2
@ %def FORBIDDEN_ENDINGS3
@ As this contains a lot of similar code to [[cmd_compile_analysis_execute]]
we outsource the main code to a subroutine.
<<Commands: cmd write analysis: TBP>>=
procedure :: execute => cmd_write_analysis_execute
<<Commands: procedures>>=
subroutine cmd_write_analysis_execute (cmd, global)
class(cmd_write_analysis_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
var_list => cmd%local%get_var_list_ptr ()
call write_analysis_wrap (var_list, global%out_files, &
cmd%id, tag = cmd%tag)
end subroutine cmd_write_analysis_execute
@ %def cmd_write_analysis_execute
@ If the [[data_file]] optional argument is present, this is
called from [[cmd_compile_analysis_execute]], which needs the file name for
further processing, and requires the default format. For the moment,
parameters and macros for custom data processing are disabled.
<<Commands: procedures>>=
subroutine write_analysis_wrap (var_list, out_files, id, tag, data_file)
type(var_list_t), intent(inout), target :: var_list
type(file_list_t), intent(inout), target :: out_files
type(analysis_id_t), dimension(:), intent(in), target :: id
type(string_t), dimension(:), allocatable, intent(out) :: tag
type(string_t), intent(out), optional :: data_file
type(string_t) :: defaultfile, file
integer :: i
logical :: keep_open !, custom, header, columns
type(string_t) :: extension !, comment_prefix, separator
!!! JRR: WK please check (#542)
! integer :: type
! type(ifile_t) :: ifile
logical :: one_file !, has_writer
! type(analysis_iterator_t) :: iterator
! type(rt_data_t), target :: sandbox
! type(command_list_t) :: writer
defaultfile = var_list%get_sval (var_str ("$out_file"))
if (present (data_file)) then
if (defaultfile == "" .or. defaultfile == ".") then
defaultfile = DEFAULT_ANALYSIS_FILENAME
else
if (scan (".", defaultfile) > 0) then
call split (defaultfile, extension, ".", back=.true.)
if (any (lower_case (char(extension)) == FORBIDDEN_ENDINGS1) .or. &
any (lower_case (char(extension)) == FORBIDDEN_ENDINGS2) .or. &
any (lower_case (char(extension)) == FORBIDDEN_ENDINGS3)) &
call msg_fatal ("The ending " // char(extension) // &
" is internal and not allowed as data file.")
if (extension /= "") then
if (defaultfile /= "") then
defaultfile = defaultfile // "." // extension
else
defaultfile = "whizard_analysis." // extension
end if
else
defaultfile = defaultfile // ".dat"
endif
else
defaultfile = defaultfile // ".dat"
end if
end if
data_file = defaultfile
end if
one_file = defaultfile /= ""
if (one_file) then
file = defaultfile
keep_open = file_list_is_open (out_files, file, &
action = "write")
if (keep_open) then
if (present (data_file)) then
call msg_fatal ("Compiling analysis: File '" &
// char (data_file) &
// "' can't be used, it is already open.")
else
call msg_message ("Appending analysis data to file '" &
// char (file) // "'")
end if
else
call file_list_open (out_files, file, &
action = "write", status = "replace", position = "asis")
call msg_message ("Writing analysis data to file '" &
// char (file) // "'")
end if
end if
!!! JRR: WK please check. Custom data output. Ticket #542
! if (present (data_file)) then
! custom = .false.
! else
! custom = var_list%get_lval (&
! var_str ("?out_custom"))
! end if
! comment_prefix = var_list%get_sval (&
! var_str ("$out_comment"))
! header = var_list%get_lval (&
! var_str ("?out_header"))
! write_yerr = var_list%get_lval (&
! var_str ("?out_yerr"))
! write_xerr = var_list%get_lval (&
! var_str ("?out_xerr"))
call get_analysis_tags (tag, id, var_list)
do i = 1, size (tag)
call file_list_write_analysis &
(out_files, file, tag(i))
end do
if (one_file .and. .not. keep_open) then
call file_list_close (out_files, file)
end if
contains
subroutine get_analysis_tags (analysis_tag, id, var_list)
type(string_t), dimension(:), intent(out), allocatable :: analysis_tag
type(analysis_id_t), dimension(:), intent(in) :: id
type(var_list_t), intent(in), target :: var_list
if (size (id) /= 0) then
allocate (analysis_tag (size (id)))
do i = 1, size (id)
if (associated (id(i)%pn_sexpr)) then
analysis_tag(i) = eval_string (id(i)%pn_sexpr, var_list)
else
analysis_tag(i) = id(i)%tag
end if
end do
else
call analysis_store_get_ids (tag)
end if
end subroutine get_analysis_tags
end subroutine write_analysis_wrap
@ %def write_analysis_wrap
\subsubsection{Compile analysis results}
This command writes files in a form suitable for GAMELAN and executes the
appropriate commands to compile them. The first part is identical to
[[cmd_write_analysis]].
<<Commands: types>>=
type, extends (command_t) :: cmd_compile_analysis_t
private
type(analysis_id_t), dimension(:), allocatable :: id
type(string_t), dimension(:), allocatable :: tag
contains
<<Commands: cmd compile analysis: TBP>>
end type cmd_compile_analysis_t
@ %def cmd_compile_analysis_t
@ Output. Just the keyword.
<<Commands: cmd compile analysis: TBP>>=
procedure :: write => cmd_compile_analysis_write
<<Commands: procedures>>=
subroutine cmd_compile_analysis_write (cmd, unit, indent)
class(cmd_compile_analysis_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "compile_analysis"
end subroutine cmd_compile_analysis_write
@ %def cmd_compile_analysis_write
@ Compile.
<<Commands: cmd compile analysis: TBP>>=
procedure :: compile => cmd_compile_analysis_compile
<<Commands: procedures>>=
subroutine cmd_compile_analysis_compile (cmd, global)
class(cmd_compile_analysis_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
integer :: n, i
pn_clause => parse_node_get_sub_ptr (cmd%pn)
pn_args => parse_node_get_sub_ptr (pn_clause, 2)
cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
call cmd%compile_options (global)
if (associated (pn_args)) then
n = parse_node_get_n_sub (pn_args)
allocate (cmd%id (n))
do i = 1, n
pn_id => parse_node_get_sub_ptr (pn_args, i)
if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
cmd%id(i)%tag = parse_node_get_string (pn_id)
else
cmd%id(i)%pn_sexpr => pn_id
end if
end do
else
allocate (cmd%id (0))
end if
end subroutine cmd_compile_analysis_compile
@ %def cmd_compile_analysis_compile
@ First write the analysis data to file, then write a GAMELAN driver and
produce MetaPost and \TeX\ output.
<<Commands: cmd compile analysis: TBP>>=
procedure :: execute => cmd_compile_analysis_execute
<<Commands: procedures>>=
subroutine cmd_compile_analysis_execute (cmd, global)
class(cmd_compile_analysis_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(string_t) :: file, basename, extension, driver_file, &
makefile
integer :: u_driver, u_makefile
logical :: has_gmlcode, only_file
var_list => cmd%local%get_var_list_ptr ()
call write_analysis_wrap (var_list, &
global%out_files, cmd%id, tag = cmd%tag, &
data_file = file)
basename = file
if (scan (".", basename) > 0) then
call split (basename, extension, ".", back=.true.)
else
extension = ""
end if
driver_file = basename // ".tex"
makefile = basename // "_ana.makefile"
u_driver = free_unit ()
open (unit=u_driver, file=char(driver_file), &
action="write", status="replace")
if (allocated (cmd%tag)) then
call analysis_write_driver (file, cmd%tag, unit=u_driver)
has_gmlcode = analysis_has_plots (cmd%tag)
else
call analysis_write_driver (file, unit=u_driver)
has_gmlcode = analysis_has_plots ()
end if
close (u_driver)
u_makefile = free_unit ()
open (unit=u_makefile, file=char(makefile), &
action="write", status="replace")
call analysis_write_makefile (basename, u_makefile, &
has_gmlcode, global%os_data)
close (u_makefile)
call msg_message ("Compiling analysis results display in '" &
// char (driver_file) // "'")
call msg_message ("Providing analysis steering makefile '" &
// char (makefile) // "'")
only_file = global%var_list%get_lval &
(var_str ("?analysis_file_only"))
if (.not. only_file) call analysis_compile_tex &
(basename, has_gmlcode, global%os_data)
end subroutine cmd_compile_analysis_execute
@ %def cmd_compile_analysis_execute
@
\subsection{User-controlled output to data files}
\subsubsection{Open file (output)}
Open a file for output.
<<Commands: types>>=
type, extends (command_t) :: cmd_open_out_t
private
type(parse_node_t), pointer :: file_expr => null ()
contains
<<Commands: cmd open out: TBP>>
end type cmd_open_out_t
@ %def cmd_open_out
@ Finalizer for the embedded eval tree.
<<Commands: procedures>>=
subroutine cmd_open_out_final (object)
class(cmd_open_out_t), intent(inout) :: object
end subroutine cmd_open_out_final
@ %def cmd_open_out_final
@ Output (trivial here).
<<Commands: cmd open out: TBP>>=
procedure :: write => cmd_open_out_write
<<Commands: procedures>>=
subroutine cmd_open_out_write (cmd, unit, indent)
class(cmd_open_out_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)", advance="no") "open_out: <filename>"
end subroutine cmd_open_out_write
@ %def cmd_open_out_write
@ Compile: create an eval tree for the filename expression.
<<Commands: cmd open out: TBP>>=
procedure :: compile => cmd_open_out_compile
<<Commands: procedures>>=
subroutine cmd_open_out_compile (cmd, global)
class(cmd_open_out_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
cmd%file_expr => parse_node_get_sub_ptr (cmd%pn, 2)
if (associated (cmd%file_expr)) then
cmd%pn_opt => parse_node_get_next_ptr (cmd%file_expr)
end if
call cmd%compile_options (global)
end subroutine cmd_open_out_compile
@ %def cmd_open_out_compile
@ Execute: append the file to the global list of open files.
<<Commands: cmd open out: TBP>>=
procedure :: execute => cmd_open_out_execute
<<Commands: procedures>>=
subroutine cmd_open_out_execute (cmd, global)
class(cmd_open_out_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(eval_tree_t) :: file_expr
type(string_t) :: file
var_list => cmd%local%get_var_list_ptr ()
call file_expr%init_sexpr (cmd%file_expr, var_list)
call file_expr%evaluate ()
if (file_expr%is_known ()) then
file = file_expr%get_string ()
call file_list_open (global%out_files, file, &
action = "write", status = "replace", position = "asis")
else
call msg_fatal ("open_out: file name argument evaluates to unknown")
end if
call file_expr%final ()
end subroutine cmd_open_out_execute
@ %def cmd_open_out_execute
\subsubsection{Open file (output)}
Close an output file. Except for the [[execute]] method, everything is
analogous to the open command, so we can just inherit.
<<Commands: types>>=
type, extends (cmd_open_out_t) :: cmd_close_out_t
private
contains
<<Commands: cmd close out: TBP>>
end type cmd_close_out_t
@ %def cmd_close_out
@ Execute: remove the file from the global list of output files.
<<Commands: cmd close out: TBP>>=
procedure :: execute => cmd_close_out_execute
<<Commands: procedures>>=
subroutine cmd_close_out_execute (cmd, global)
class(cmd_close_out_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(eval_tree_t) :: file_expr
type(string_t) :: file
var_list => cmd%local%var_list
call file_expr%init_sexpr (cmd%file_expr, var_list)
call file_expr%evaluate ()
if (file_expr%is_known ()) then
file = file_expr%get_string ()
call file_list_close (global%out_files, file)
else
call msg_fatal ("close_out: file name argument evaluates to unknown")
end if
call file_expr%final ()
end subroutine cmd_close_out_execute
@ %def cmd_close_out_execute
@
\subsection{Print custom-formatted values}
<<Commands: types>>=
type, extends (command_t) :: cmd_printf_t
private
type(parse_node_t), pointer :: sexpr => null ()
type(parse_node_t), pointer :: sprintf_fun => null ()
type(parse_node_t), pointer :: sprintf_clause => null ()
type(parse_node_t), pointer :: sprintf => null ()
contains
<<Commands: cmd printf: TBP>>
end type cmd_printf_t
@ %def cmd_printf_t
@ Finalize.
<<Commands: cmd printf: TBP>>=
procedure :: final => cmd_printf_final
<<Commands: procedures>>=
subroutine cmd_printf_final (cmd)
class(cmd_printf_t), intent(inout) :: cmd
call parse_node_final (cmd%sexpr, recursive = .false.)
deallocate (cmd%sexpr)
call parse_node_final (cmd%sprintf_fun, recursive = .false.)
deallocate (cmd%sprintf_fun)
call parse_node_final (cmd%sprintf_clause, recursive = .false.)
deallocate (cmd%sprintf_clause)
call parse_node_final (cmd%sprintf, recursive = .false.)
deallocate (cmd%sprintf)
end subroutine cmd_printf_final
@ %def cmd_printf_final
@ Output. Do not print the parse tree, since this may get cluttered.
Just a message that cuts have been defined.
<<Commands: cmd printf: TBP>>=
procedure :: write => cmd_printf_write
<<Commands: procedures>>=
subroutine cmd_printf_write (cmd, unit, indent)
class(cmd_printf_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "printf:"
end subroutine cmd_printf_write
@ %def cmd_printf_write
@ Compile. We create a fake parse node (subtree) with a [[sprintf]] command
with identical arguments which can then be handled by the corresponding
evaluation procedure.
<<Commands: cmd printf: TBP>>=
procedure :: compile => cmd_printf_compile
<<Commands: procedures>>=
subroutine cmd_printf_compile (cmd, global)
class(cmd_printf_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_args, pn_format
pn_cmd => parse_node_get_sub_ptr (cmd%pn)
pn_clause => parse_node_get_sub_ptr (pn_cmd)
pn_format => parse_node_get_sub_ptr (pn_clause, 2)
pn_args => parse_node_get_next_ptr (pn_clause)
cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
call cmd%compile_options (global)
allocate (cmd%sexpr)
call parse_node_create_branch (cmd%sexpr, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("sexpr")))
allocate (cmd%sprintf_fun)
call parse_node_create_branch (cmd%sprintf_fun, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_fun")))
allocate (cmd%sprintf_clause)
call parse_node_create_branch (cmd%sprintf_clause, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_clause")))
allocate (cmd%sprintf)
call parse_node_create_key (cmd%sprintf, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf")))
call parse_node_append_sub (cmd%sprintf_clause, cmd%sprintf)
call parse_node_append_sub (cmd%sprintf_clause, pn_format)
call parse_node_freeze_branch (cmd%sprintf_clause)
call parse_node_append_sub (cmd%sprintf_fun, cmd%sprintf_clause)
if (associated (pn_args)) then
call parse_node_append_sub (cmd%sprintf_fun, pn_args)
end if
call parse_node_freeze_branch (cmd%sprintf_fun)
call parse_node_append_sub (cmd%sexpr, cmd%sprintf_fun)
call parse_node_freeze_branch (cmd%sexpr)
end subroutine cmd_printf_compile
@ %def cmd_printf_compile
@ Execute. Evaluate the string (pretending this is a [[sprintf]] expression)
and print it.
<<Commands: cmd printf: TBP>>=
procedure :: execute => cmd_printf_execute
<<Commands: procedures>>=
subroutine cmd_printf_execute (cmd, global)
class(cmd_printf_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(string_t) :: string, file
type(eval_tree_t) :: sprintf_expr
logical :: advance
var_list => cmd%local%get_var_list_ptr ()
advance = var_list%get_lval (&
var_str ("?out_advance"))
file = var_list%get_sval (&
var_str ("$out_file"))
call sprintf_expr%init_sexpr (cmd%sexpr, var_list)
call sprintf_expr%evaluate ()
if (sprintf_expr%is_known ()) then
string = sprintf_expr%get_string ()
if (len (file) == 0) then
call msg_result (char (string))
else
call file_list_write (global%out_files, file, string, advance)
end if
end if
end subroutine cmd_printf_execute
@ %def cmd_printf_execute
@
\subsubsection{Record data}
The expression syntax already contains a [[record]] keyword; this evaluates to
a logical which is always true, but it has the side-effect of recording data
into analysis objects. Here we define a command as an interface to this
construct.
<<Commands: types>>=
type, extends (command_t) :: cmd_record_t
private
type(parse_node_t), pointer :: pn_lexpr => null ()
contains
<<Commands: cmd record: TBP>>
end type cmd_record_t
@ %def cmd_record_t
@ Output. With the compile hack below, there is nothing of interest
to print here.
<<Commands: cmd record: TBP>>=
procedure :: write => cmd_record_write
<<Commands: procedures>>=
subroutine cmd_record_write (cmd, unit, indent)
class(cmd_record_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)") "record"
end subroutine cmd_record_write
@ %def cmd_record_write
@ Compile. This is a hack which transforms the [[record]] command
into a [[record]] expression, which we handle in the [[expressions]]
module.
<<Commands: cmd record: TBP>>=
procedure :: compile => cmd_record_compile
<<Commands: procedures>>=
subroutine cmd_record_compile (cmd, global)
class(cmd_record_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_lexpr, pn_lsinglet, pn_lterm, pn_record
call parse_node_create_branch (pn_lexpr, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("lexpr")))
call parse_node_create_branch (pn_lsinglet, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("lsinglet")))
call parse_node_append_sub (pn_lexpr, pn_lsinglet)
call parse_node_create_branch (pn_lterm, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("lterm")))
call parse_node_append_sub (pn_lsinglet, pn_lterm)
pn_record => parse_node_get_sub_ptr (cmd%pn)
call parse_node_append_sub (pn_lterm, pn_record)
cmd%pn_lexpr => pn_lexpr
end subroutine cmd_record_compile
@ %def cmd_record_compile
@ Command execution. Again, transfer this to the embedded expression
and just forget the logical result.
<<Commands: cmd record: TBP>>=
procedure :: execute => cmd_record_execute
<<Commands: procedures>>=
subroutine cmd_record_execute (cmd, global)
class(cmd_record_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
logical :: lval
var_list => global%get_var_list_ptr ()
lval = eval_log (cmd%pn_lexpr, var_list)
end subroutine cmd_record_execute
@ %def cmd_record_execute
@
\subsubsection{Unstable particles}
Mark a particle as unstable. For each unstable particle, we store a
number of decay channels and compute their respective BRs.
<<Commands: types>>=
type, extends (command_t) :: cmd_unstable_t
private
integer :: n_proc = 0
type(string_t), dimension(:), allocatable :: process_id
type(parse_node_t), pointer :: pn_prt_in => null ()
contains
<<Commands: cmd unstable: TBP>>
end type cmd_unstable_t
@ %def cmd_unstable_t
@ Output: we know the process IDs.
<<Commands: cmd unstable: TBP>>=
procedure :: write => cmd_unstable_write
<<Commands: procedures>>=
subroutine cmd_unstable_write (cmd, unit, indent)
class(cmd_unstable_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,1x,I0,1x,A)", advance="no") &
"unstable:", 1, "("
do i = 1, cmd%n_proc
if (i > 1) write (u, "(A,1x)", advance="no") ","
write (u, "(A)", advance="no") char (cmd%process_id(i))
end do
write (u, "(A)") ")"
end subroutine cmd_unstable_write
@ %def cmd_unstable_write
@ Compile. Initiate an eval tree for the decaying particle and
determine the decay channel process IDs.
<<Commands: cmd unstable: TBP>>=
procedure :: compile => cmd_unstable_compile
<<Commands: procedures>>=
subroutine cmd_unstable_compile (cmd, global)
class(cmd_unstable_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_list, pn_proc
integer :: i
cmd%pn_prt_in => parse_node_get_sub_ptr (cmd%pn, 2)
pn_list => parse_node_get_next_ptr (cmd%pn_prt_in)
if (associated (pn_list)) then
select case (char (parse_node_get_rule_key (pn_list)))
case ("unstable_arg")
cmd%n_proc = parse_node_get_n_sub (pn_list)
cmd%pn_opt => parse_node_get_next_ptr (pn_list)
case default
cmd%n_proc = 0
cmd%pn_opt => pn_list
pn_list => null ()
end select
end if
call cmd%compile_options (global)
if (associated (pn_list)) then
allocate (cmd%process_id (cmd%n_proc))
pn_proc => parse_node_get_sub_ptr (pn_list)
do i = 1, cmd%n_proc
cmd%process_id(i) = parse_node_get_string (pn_proc)
call cmd%local%process_stack%init_result_vars (cmd%process_id(i))
pn_proc => parse_node_get_next_ptr (pn_proc)
end do
else
allocate (cmd%process_id (0))
end if
end subroutine cmd_unstable_compile
@ %def cmd_unstable_compile
@ Command execution. Evaluate the decaying particle and mark the decays in
the current model object.
<<Commands: cmd unstable: TBP>>=
procedure :: execute => cmd_unstable_execute
<<Commands: procedures>>=
subroutine cmd_unstable_execute (cmd, global)
class(cmd_unstable_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
logical :: auto_decays, auto_decays_radiative
integer :: auto_decays_multiplicity
logical :: isotropic_decay, diagonal_decay, polarized_decay
integer :: decay_helicity
type(pdg_array_t) :: pa_in
integer :: pdg_in
type(string_t) :: libname_cur, libname_dec
type(string_t), dimension(:), allocatable :: auto_id, tmp_id
integer :: n_proc_user
integer :: i, u_tmp
character(80) :: buffer
var_list => cmd%local%get_var_list_ptr ()
auto_decays = &
var_list%get_lval (var_str ("?auto_decays"))
if (auto_decays) then
auto_decays_multiplicity = &
var_list%get_ival (var_str ("auto_decays_multiplicity"))
auto_decays_radiative = &
var_list%get_lval (var_str ("?auto_decays_radiative"))
end if
isotropic_decay = &
var_list%get_lval (var_str ("?isotropic_decay"))
if (isotropic_decay) then
diagonal_decay = .false.
polarized_decay = .false.
else
diagonal_decay = &
var_list%get_lval (var_str ("?diagonal_decay"))
if (diagonal_decay) then
polarized_decay = .false.
else
polarized_decay = &
var_list%is_known (var_str ("decay_helicity"))
if (polarized_decay) then
decay_helicity = var_list%get_ival (var_str ("decay_helicity"))
end if
end if
end if
pa_in = eval_pdg_array (cmd%pn_prt_in, var_list)
if (pdg_array_get_length (pa_in) /= 1) &
call msg_fatal ("Unstable: decaying particle must be unique")
pdg_in = pdg_array_get (pa_in, 1)
n_proc_user = cmd%n_proc
if (auto_decays) then
call create_auto_decays (pdg_in, &
auto_decays_multiplicity, auto_decays_radiative, &
libname_dec, auto_id, cmd%local)
allocate (tmp_id (cmd%n_proc + size (auto_id)))
tmp_id(:cmd%n_proc) = cmd%process_id
tmp_id(cmd%n_proc+1:) = auto_id
call move_alloc (from = tmp_id, to = cmd%process_id)
cmd%n_proc = size (cmd%process_id)
end if
libname_cur = cmd%local%prclib%get_name ()
do i = 1, cmd%n_proc
if (i == n_proc_user + 1) then
call cmd%local%update_prclib &
(cmd%local%prclib_stack%get_library_ptr (libname_dec))
end if
if (.not. global%process_stack%exists (cmd%process_id(i))) then
call var_list%set_log &
(var_str ("?decay_rest_frame"), .false., is_known = .true.)
call integrate_process (cmd%process_id(i), cmd%local, global)
call global%process_stack%fill_result_vars (cmd%process_id(i))
end if
end do
call cmd%local%update_prclib &
(cmd%local%prclib_stack%get_library_ptr (libname_cur))
if (cmd%n_proc > 0) then
if (polarized_decay) then
call global%modify_particle (pdg_in, stable = .false., &
decay = cmd%process_id, &
isotropic_decay = .false., &
diagonal_decay = .false., &
decay_helicity = decay_helicity, &
polarized = .false.)
else
call global%modify_particle (pdg_in, stable = .false., &
decay = cmd%process_id, &
isotropic_decay = isotropic_decay, &
diagonal_decay = diagonal_decay, &
polarized = .false.)
end if
u_tmp = free_unit ()
open (u_tmp, status = "scratch", action = "readwrite")
call show_unstable (global, pdg_in, u_tmp)
rewind (u_tmp)
do
read (u_tmp, "(A)", end = 1) buffer
write (msg_buffer, "(A)") trim (buffer)
call msg_message ()
end do
1 continue
close (u_tmp)
else
call err_unstable (global, pdg_in)
end if
end subroutine cmd_unstable_execute
@ %def cmd_unstable_execute
@ Show data for the current unstable particle. This is called both by
the [[unstable]] and by the [[show]] command.
To determine decay branching rations, we look at the decay process IDs
and inspect the corresponding [[integral()]] result variables.
<<Commands: procedures>>=
subroutine show_unstable (global, pdg, u)
type(rt_data_t), intent(in), target :: global
integer, intent(in) :: pdg, u
type(flavor_t) :: flv
type(string_t), dimension(:), allocatable :: decay
real(default), dimension(:), allocatable :: br
real(default) :: width
type(process_t), pointer :: process
type(process_component_def_t), pointer :: prc_def
type(string_t), dimension(:), allocatable :: prt_out, prt_out_str
integer :: i, j
logical :: opened
call flv%init (pdg, global%model)
call flv%get_decays (decay)
if (.not. allocated (decay)) return
allocate (prt_out_str (size (decay)))
allocate (br (size (decay)))
do i = 1, size (br)
process => global%process_stack%get_process_ptr (decay(i))
prc_def => process%get_component_def_ptr (1)
call prc_def%get_prt_out (prt_out)
prt_out_str(i) = prt_out(1)
do j = 2, size (prt_out)
prt_out_str(i) = prt_out_str(i) // ", " // prt_out(j)
end do
br(i) = global%get_rval ("integral(" // decay(i) // ")")
end do
if (all (br >= 0)) then
if (any (br > 0)) then
width = sum (br)
br = br / sum (br)
write (u, "(A)") "Unstable particle " &
// char (flv%get_name ()) &
// ": computed branching ratios:"
do i = 1, size (br)
write (u, "(2x,A,':'," // FMT_14 // ",3x,A)") &
char (decay(i)), br(i), char (prt_out_str(i))
end do
write (u, "(2x,'Total width ='," // FMT_14 // ",' GeV (computed)')") width
write (u, "(2x,' ='," // FMT_14 // ",' GeV (preset)')") &
flv%get_width ()
if (flv%decays_isotropically ()) then
write (u, "(2x,A)") "Decay options: isotropic"
else if (flv%decays_diagonal ()) then
write (u, "(2x,A)") "Decay options: &
&projection on diagonal helicity states"
else if (flv%has_decay_helicity ()) then
write (u, "(2x,A,1x,I0)") "Decay options: projection onto helicity =", &
flv%get_decay_helicity ()
else
write (u, "(2x,A)") "Decay options: helicity treated exactly"
end if
else
inquire (unit = u, opened = opened)
if (opened .and. .not. mask_fatal_errors) close (u)
call msg_fatal ("Unstable particle " &
// char (flv%get_name ()) &
// ": partial width vanishes for all decay channels")
end if
else
inquire (unit = u, opened = opened)
if (opened .and. .not. mask_fatal_errors) close (u)
call msg_fatal ("Unstable particle " &
// char (flv%get_name ()) &
// ": partial width is negative")
end if
end subroutine show_unstable
@ %def show_unstable
@ If no decays have been found, issue a non-fatal error.
<<Commands: procedures>>=
subroutine err_unstable (global, pdg)
type(rt_data_t), intent(in), target :: global
integer, intent(in) :: pdg
type(flavor_t) :: flv
call flv%init (pdg, global%model)
call msg_error ("Unstable: no allowed decays found for particle " &
// char (flv%get_name ()) // ", keeping as stable")
end subroutine err_unstable
@ %def err_unstable
@ Auto decays: create process IDs and make up process
configurations, using the PDG codes generated by the [[ds_table]] make
method.
We allocate and use a self-contained process library that contains only the
decay processes of the current particle. When done, we revert the global
library pointer to the original library but return the name of the new one.
The new library becomes part of the global library stack and can thus be
referred to at any time.
<<Commands: procedures>>=
subroutine create_auto_decays &
(pdg_in, mult, rad, libname_dec, process_id, global)
integer, intent(in) :: pdg_in
integer, intent(in) :: mult
logical, intent(in) :: rad
type(string_t), intent(out) :: libname_dec
type(string_t), dimension(:), allocatable, intent(out) :: process_id
type(rt_data_t), intent(inout) :: global
type(prclib_entry_t), pointer :: lib_entry
type(process_library_t), pointer :: lib
type(ds_table_t) :: ds_table
type(split_constraints_t) :: constraints
type(pdg_array_t), dimension(:), allocatable :: pa_out
character(80) :: buffer
character :: p_or_a
type(string_t) :: process_string, libname_cur
type(flavor_t) :: flv_in, flv_out
type(string_t) :: prt_in
type(string_t), dimension(:), allocatable :: prt_out
type(process_configuration_t) :: prc_config
integer :: i, j, k
call flv_in%init (pdg_in, global%model)
if (rad) then
call constraints%init (2)
else
call constraints%init (3)
call constraints%set (3, constrain_radiation ())
end if
call constraints%set (1, constrain_n_tot (mult))
call constraints%set (2, &
constrain_mass_sum (flv_in%get_mass (), margin = 0._default))
call ds_table%make (global%model, pdg_in, constraints)
prt_in = flv_in%get_name ()
if (pdg_in > 0) then
p_or_a = "p"
else
p_or_a = "a"
end if
if (ds_table%get_length () == 0) then
call msg_warning ("Auto-decays: Particle " // char (prt_in) // ": " &
// "no decays found")
libname_dec = ""
allocate (process_id (0))
else
call msg_message ("Creating decay process library for particle " &
// char (prt_in))
libname_cur = global%prclib%get_name ()
write (buffer, "(A,A,I0)") "_d", p_or_a, abs (pdg_in)
libname_dec = libname_cur // trim (buffer)
lib => global%prclib_stack%get_library_ptr (libname_dec)
if (.not. (associated (lib))) then
allocate (lib_entry)
call lib_entry%init (libname_dec)
lib => lib_entry%process_library_t
call global%add_prclib (lib_entry)
else
call global%update_prclib (lib)
end if
allocate (process_id (ds_table%get_length ()))
do i = 1, size (process_id)
write (buffer, "(A,'_',A,I0,'_',I0)") &
"decay", p_or_a, abs (pdg_in), i
process_id(i) = trim (buffer)
process_string = process_id(i) // ": " // prt_in // " =>"
call ds_table%get_pdg_out (i, pa_out)
allocate (prt_out (size (pa_out)))
do j = 1, size (pa_out)
do k = 1, pa_out(j)%get_length ()
call flv_out%init (pa_out(j)%get (k), global%model)
if (k == 1) then
prt_out(j) = flv_out%get_name ()
else
prt_out(j) = prt_out(j) // ":" // flv_out%get_name ()
end if
end do
process_string = process_string // " " // prt_out(j)
end do
call msg_message (char (process_string))
call prc_config%init (process_id(i), 1, 1, &
global%model, global%var_list, &
nlo_process = global%nlo_fixed_order)
!!! Causes runtime error with gfortran 4.9.1
! call prc_config%setup_component (1, &
! new_prt_spec ([prt_in]), new_prt_spec (prt_out), global%model, global%var_list)
!!! Workaround:
call prc_config%setup_component (1, &
[new_prt_spec (prt_in)], new_prt_spec (prt_out), global%model, global%var_list)
call prc_config%record (global)
deallocate (prt_out)
deallocate (pa_out)
end do
lib => global%prclib_stack%get_library_ptr (libname_cur)
call global%update_prclib (lib)
end if
call ds_table%final ()
end subroutine create_auto_decays
@ %def create_auto_decays
@
\subsubsection{(Stable particles}
Revert the unstable declaration for a list of particles.
<<Commands: types>>=
type, extends (command_t) :: cmd_stable_t
private
type(parse_node_p), dimension(:), allocatable :: pn_pdg
contains
<<Commands: cmd stable: TBP>>
end type cmd_stable_t
@ %def cmd_stable_t
@ Output: we know only the number of particles.
<<Commands: cmd stable: TBP>>=
procedure :: write => cmd_stable_write
<<Commands: procedures>>=
subroutine cmd_stable_write (cmd, unit, indent)
class(cmd_stable_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,1x,I0)") "stable:", size (cmd%pn_pdg)
end subroutine cmd_stable_write
@ %def cmd_stable_write
@ Compile. Assign parse nodes for the particle IDs.
<<Commands: cmd stable: TBP>>=
procedure :: compile => cmd_stable_compile
<<Commands: procedures>>=
subroutine cmd_stable_compile (cmd, global)
class(cmd_stable_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_list, pn_prt
integer :: n, i
pn_list => parse_node_get_sub_ptr (cmd%pn, 2)
cmd%pn_opt => parse_node_get_next_ptr (pn_list)
call cmd%compile_options (global)
n = parse_node_get_n_sub (pn_list)
allocate (cmd%pn_pdg (n))
pn_prt => parse_node_get_sub_ptr (pn_list)
i = 1
do while (associated (pn_prt))
cmd%pn_pdg(i)%ptr => pn_prt
pn_prt => parse_node_get_next_ptr (pn_prt)
i = i + 1
end do
end subroutine cmd_stable_compile
@ %def cmd_stable_compile
@ Execute: apply the modifications to the current model.
<<Commands: cmd stable: TBP>>=
procedure :: execute => cmd_stable_execute
<<Commands: procedures>>=
subroutine cmd_stable_execute (cmd, global)
class(cmd_stable_t), intent(inout) :: cmd
type(rt_data_t), target, intent(inout) :: global
type(var_list_t), pointer :: var_list
type(pdg_array_t) :: pa
integer :: pdg
type(flavor_t) :: flv
integer :: i
var_list => cmd%local%get_var_list_ptr ()
do i = 1, size (cmd%pn_pdg)
pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
if (pdg_array_get_length (pa) /= 1) &
call msg_fatal ("Stable: listed particles must be unique")
pdg = pdg_array_get (pa, 1)
call global%modify_particle (pdg, stable = .true., &
isotropic_decay = .false., &
diagonal_decay = .false., &
polarized = .false.)
call flv%init (pdg, cmd%local%model)
call msg_message ("Particle " &
// char (flv%get_name ()) &
// " declared as stable")
end do
end subroutine cmd_stable_execute
@ %def cmd_stable_execute
@
\subsubsection{Polarized particles}
These commands mark particles as (un)polarized, to be applied in
subsequent simulation passes. Since this is technically the same as
the [[stable]] command, we take a shortcut and make this an extension,
just overriding methods.
<<Commands: types>>=
type, extends (cmd_stable_t) :: cmd_polarized_t
contains
<<Commands: cmd polarized: TBP>>
end type cmd_polarized_t
type, extends (cmd_stable_t) :: cmd_unpolarized_t
contains
<<Commands: cmd unpolarized: TBP>>
end type cmd_unpolarized_t
@ %def cmd_polarized_t cmd_unpolarized_t
@ Output: we know only the number of particles.
<<Commands: cmd polarized: TBP>>=
procedure :: write => cmd_polarized_write
<<Commands: cmd unpolarized: TBP>>=
procedure :: write => cmd_unpolarized_write
<<Commands: procedures>>=
subroutine cmd_polarized_write (cmd, unit, indent)
class(cmd_polarized_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,1x,I0)") "polarized:", size (cmd%pn_pdg)
end subroutine cmd_polarized_write
subroutine cmd_unpolarized_write (cmd, unit, indent)
class(cmd_unpolarized_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,1x,I0)") "unpolarized:", size (cmd%pn_pdg)
end subroutine cmd_unpolarized_write
@ %def cmd_polarized_write
@ %def cmd_unpolarized_write
@ Compile: accounted for by the base command.
Execute: apply the modifications to the current model.
<<Commands: cmd polarized: TBP>>=
procedure :: execute => cmd_polarized_execute
<<Commands: cmd unpolarized: TBP>>=
procedure :: execute => cmd_unpolarized_execute
<<Commands: procedures>>=
subroutine cmd_polarized_execute (cmd, global)
class(cmd_polarized_t), intent(inout) :: cmd
type(rt_data_t), target, intent(inout) :: global
type(var_list_t), pointer :: var_list
type(pdg_array_t) :: pa
integer :: pdg
type(flavor_t) :: flv
integer :: i
var_list => cmd%local%get_var_list_ptr ()
do i = 1, size (cmd%pn_pdg)
pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
if (pdg_array_get_length (pa) /= 1) &
call msg_fatal ("Polarized: listed particles must be unique")
pdg = pdg_array_get (pa, 1)
call global%modify_particle (pdg, polarized = .true., &
stable = .true., &
isotropic_decay = .false., &
diagonal_decay = .false.)
call flv%init (pdg, cmd%local%model)
call msg_message ("Particle " &
// char (flv%get_name ()) &
// " declared as polarized")
end do
end subroutine cmd_polarized_execute
subroutine cmd_unpolarized_execute (cmd, global)
class(cmd_unpolarized_t), intent(inout) :: cmd
type(rt_data_t), target, intent(inout) :: global
type(var_list_t), pointer :: var_list
type(pdg_array_t) :: pa
integer :: pdg
type(flavor_t) :: flv
integer :: i
var_list => cmd%local%get_var_list_ptr ()
do i = 1, size (cmd%pn_pdg)
pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
if (pdg_array_get_length (pa) /= 1) &
call msg_fatal ("Unpolarized: listed particles must be unique")
pdg = pdg_array_get (pa, 1)
call global%modify_particle (pdg, polarized = .false., &
stable = .true., &
isotropic_decay = .false., &
diagonal_decay = .false.)
call flv%init (pdg, cmd%local%model)
call msg_message ("Particle " &
// char (flv%get_name ()) &
// " declared as unpolarized")
end do
end subroutine cmd_unpolarized_execute
@ %def cmd_polarized_execute
@ %def cmd_unpolarized_execute
@
\subsubsection{Parameters: formats for event-sample output}
Specify all event formats that are to be used for output files in the
subsequent simulation run. (The raw format is on by default and can be turned
off here.)
<<Commands: types>>=
type, extends (command_t) :: cmd_sample_format_t
private
type(string_t), dimension(:), allocatable :: format
contains
<<Commands: cmd sample format: TBP>>
end type cmd_sample_format_t
@ %def cmd_sample_format_t
@ Output: here, everything is known.
<<Commands: cmd sample format: TBP>>=
procedure :: write => cmd_sample_format_write
<<Commands: procedures>>=
subroutine cmd_sample_format_write (cmd, unit, indent)
class(cmd_sample_format_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)", advance="no") "sample_format = "
do i = 1, size (cmd%format)
if (i > 1) write (u, "(A,1x)", advance="no") ","
write (u, "(A)", advance="no") char (cmd%format(i))
end do
write (u, "(A)")
end subroutine cmd_sample_format_write
@ %def cmd_sample_format_write
@ Compile. Initialize evaluation trees.
<<Commands: cmd sample format: TBP>>=
procedure :: compile => cmd_sample_format_compile
<<Commands: procedures>>=
subroutine cmd_sample_format_compile (cmd, global)
class(cmd_sample_format_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg
type(parse_node_t), pointer :: pn_format
integer :: i, n_format
pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
if (associated (pn_arg)) then
n_format = parse_node_get_n_sub (pn_arg)
allocate (cmd%format (n_format))
pn_format => parse_node_get_sub_ptr (pn_arg)
i = 0
do while (associated (pn_format))
i = i + 1
cmd%format(i) = parse_node_get_string (pn_format)
pn_format => parse_node_get_next_ptr (pn_format)
end do
else
allocate (cmd%format (0))
end if
end subroutine cmd_sample_format_compile
@ %def cmd_sample_format_compile
@ Execute. Transfer the list of format specifications to the
corresponding array in the runtime data set.
<<Commands: cmd sample format: TBP>>=
procedure :: execute => cmd_sample_format_execute
<<Commands: procedures>>=
subroutine cmd_sample_format_execute (cmd, global)
class(cmd_sample_format_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
if (allocated (global%sample_fmt)) deallocate (global%sample_fmt)
allocate (global%sample_fmt (size (cmd%format)), source = cmd%format)
end subroutine cmd_sample_format_execute
@ %def cmd_sample_format_execute
@
\subsubsection{The simulate command}
This is the actual SINDARIN command.
<<Commands: types>>=
type, extends (command_t) :: cmd_simulate_t
! not private anymore as required by the whizard-c-interface
integer :: n_proc = 0
type(string_t), dimension(:), allocatable :: process_id
contains
<<Commands: cmd simulate: TBP>>
end type cmd_simulate_t
@ %def cmd_simulate_t
@ Output: we know the process IDs.
<<Commands: cmd simulate: TBP>>=
procedure :: write => cmd_simulate_write
<<Commands: procedures>>=
subroutine cmd_simulate_write (cmd, unit, indent)
class(cmd_simulate_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)", advance="no") "simulate ("
do i = 1, cmd%n_proc
if (i > 1) write (u, "(A,1x)", advance="no") ","
write (u, "(A)", advance="no") char (cmd%process_id(i))
end do
write (u, "(A)") ")"
end subroutine cmd_simulate_write
@ %def cmd_simulate_write
@ Compile. In contrast to WHIZARD 1 the confusing option to give the
number of unweighted events for weighted events as if unweighting were
to take place has been abandoned. (We both use [[n_events]] for
weighted and unweighted events, the variable [[n_calls]] from WHIZARD
1 has been discarded.
<<Commands: cmd simulate: TBP>>=
procedure :: compile => cmd_simulate_compile
<<Commands: procedures>>=
subroutine cmd_simulate_compile (cmd, global)
class(cmd_simulate_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_proclist, pn_proc
integer :: i
pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
call cmd%compile_options (global)
cmd%n_proc = parse_node_get_n_sub (pn_proclist)
allocate (cmd%process_id (cmd%n_proc))
pn_proc => parse_node_get_sub_ptr (pn_proclist)
do i = 1, cmd%n_proc
cmd%process_id(i) = parse_node_get_string (pn_proc)
call global%process_stack%init_result_vars (cmd%process_id(i))
pn_proc => parse_node_get_next_ptr (pn_proc)
end do
end subroutine cmd_simulate_compile
@ %def cmd_simulate_compile
@ Execute command: Simulate events. This is done via a [[simulation_t]]
object and its associated methods.
Signal handling: the [[generate]] method may exit abnormally if there is a
pending signal. The current logic ensures that the [[es_array]] output
channels are closed before the [[execute]] routine returns. The program will
terminate then in [[command_list_execute]].
<<Commands: cmd simulate: TBP>>=
procedure :: execute => cmd_simulate_execute
<<Commands: procedures>>=
subroutine cmd_simulate_execute (cmd, global)
class(cmd_simulate_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(rt_data_t), dimension(:), allocatable, target :: alt_env
integer :: n_events, n_fmt
type(string_t) :: sample, sample_suffix
logical :: rebuild_events, read_raw, write_raw
type(simulation_t), target :: sim
type(string_t), dimension(:), allocatable :: sample_fmt
type(event_stream_array_t) :: es_array
type(event_sample_data_t) :: data
integer :: i, checkpoint, callback
<<Commands: cmd simulate execute: variables>>
var_list => cmd%local%var_list
if (allocated (cmd%local%pn%alt_setup)) then
allocate (alt_env (size (cmd%local%pn%alt_setup)))
do i = 1, size (alt_env)
call build_alt_setup (alt_env(i), cmd%local, &
cmd%local%pn%alt_setup(i)%ptr)
end do
call sim%init (cmd%process_id, .true., .true., cmd%local, global, &
alt_env)
else
call sim%init (cmd%process_id, .true., .true., cmd%local, global)
end if
if (signal_is_pending ()) return
if (sim%is_valid ()) then
call sim%init_process_selector ()
call openmp_set_num_threads_verbose &
(var_list%get_ival (var_str ("openmp_num_threads")), &
var_list%get_lval (var_str ("?openmp_logging")))
call sim%compute_n_events (n_events, var_list)
sample_suffix = ""
<<Commands: cmd simulate execute: init>>
sample = var_list%get_sval (var_str ("$sample"))
if (sample == "") then
sample = sim%get_default_sample_name () // sample_suffix
else
sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
end if
rebuild_events = &
var_list%get_lval (var_str ("?rebuild_events"))
read_raw = &
var_list%get_lval (var_str ("?read_raw")) &
.and. .not. rebuild_events
write_raw = &
var_list%get_lval (var_str ("?write_raw"))
checkpoint = &
var_list%get_ival (var_str ("checkpoint"))
callback = &
var_list%get_ival (var_str ("event_callback_interval"))
if (read_raw) then
inquire (file = char (sample) // ".evx", exist = read_raw)
end if
if (allocated (cmd%local%sample_fmt)) then
n_fmt = size (cmd%local%sample_fmt)
else
n_fmt = 0
end if
data = sim%get_data ()
data%n_evt = n_events
data%nlo_multiplier = sim%get_n_nlo_entries (1)
if (read_raw) then
allocate (sample_fmt (n_fmt))
if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
call es_array%init (sample, &
sample_fmt, cmd%local, &
data = data, &
input = var_str ("raw"), &
allow_switch = write_raw, &
checkpoint = checkpoint, &
callback = callback)
call sim%generate (n_events, es_array)
call es_array%final ()
else if (write_raw) then
allocate (sample_fmt (n_fmt + 1))
if (n_fmt > 0) sample_fmt(:n_fmt) = cmd%local%sample_fmt
sample_fmt(n_fmt+1) = var_str ("raw")
call es_array%init (sample, &
sample_fmt, cmd%local, &
data = data, &
checkpoint = checkpoint, &
callback = callback)
call sim%generate (n_events, es_array)
call es_array%final ()
else if (allocated (cmd%local%sample_fmt) &
.or. checkpoint > 0 &
.or. callback > 0) then
allocate (sample_fmt (n_fmt))
if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
call es_array%init (sample, &
sample_fmt, cmd%local, &
data = data, &
checkpoint = checkpoint, &
callback = callback)
call sim%generate (n_events, es_array)
call es_array%final ()
else
call sim%generate (n_events)
end if
if (allocated (alt_env)) then
do i = 1, size (alt_env)
call alt_env(i)%local_final ()
end do
end if
end if
call sim%final ()
end subroutine cmd_simulate_execute
@ %def cmd_simulate_execute
<<Commands: cmd simulate execute: variables>>=
@
<<Commands: cmd simulate execute: init>>=
@
<<MPI: Commands: cmd simulate execute: variables>>=
logical :: mpi_logging
integer :: rank, n_size
@ Append rank id to sample name.
<<MPI: Commands: cmd simulate execute: init>>=
call mpi_get_comm_id (n_size, rank)
if (n_size > 1) then
sample_suffix = var_str ("_") // str (rank)
end if
mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
& .and. (n_size > 1)) &
& .or. var_list%get_lval (var_str ("?mpi_logging")))
call mpi_set_logging (mpi_logging)
@
@ Build an alternative setup: the parse tree is stored in the global
environment. We create a temporary command list to compile and execute this;
the result is an alternative local environment [[alt_env]] which we can hand
over to the [[simulate]] command.
<<Commands: procedures>>=
recursive subroutine build_alt_setup (alt_env, global, pn)
type(rt_data_t), intent(inout), target :: alt_env
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), intent(in), target :: pn
type(command_list_t), allocatable :: alt_options
allocate (alt_options)
call alt_env%local_init (global)
call alt_env%activate ()
call alt_options%compile (pn, alt_env)
call alt_options%execute (alt_env)
call alt_env%deactivate (global, keep_local = .true.)
call alt_options%final ()
end subroutine build_alt_setup
@ %def build_alt_setup
@
\subsubsection{The rescan command}
This is the actual SINDARIN command.
<<Commands: types>>=
type, extends (command_t) :: cmd_rescan_t
! private
type(parse_node_t), pointer :: pn_filename => null ()
integer :: n_proc = 0
type(string_t), dimension(:), allocatable :: process_id
contains
<<Commands: cmd rescan: TBP>>
end type cmd_rescan_t
@ %def cmd_rescan_t
@ Output: we know the process IDs.
<<Commands: cmd rescan: TBP>>=
procedure :: write => cmd_rescan_write
<<Commands: procedures>>=
subroutine cmd_rescan_write (cmd, unit, indent)
class(cmd_rescan_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, i
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A)", advance="no") "rescan ("
do i = 1, cmd%n_proc
if (i > 1) write (u, "(A,1x)", advance="no") ","
write (u, "(A)", advance="no") char (cmd%process_id(i))
end do
write (u, "(A)") ")"
end subroutine cmd_rescan_write
@ %def cmd_rescan_write
@ Compile. The command takes a suffix argument, namely the file name
of requested event file.
<<Commands: cmd rescan: TBP>>=
procedure :: compile => cmd_rescan_compile
<<Commands: procedures>>=
subroutine cmd_rescan_compile (cmd, global)
class(cmd_rescan_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_filename, pn_proclist, pn_proc
integer :: i
pn_filename => parse_node_get_sub_ptr (cmd%pn, 2)
pn_proclist => parse_node_get_next_ptr (pn_filename)
cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
call cmd%compile_options (global)
cmd%pn_filename => pn_filename
cmd%n_proc = parse_node_get_n_sub (pn_proclist)
allocate (cmd%process_id (cmd%n_proc))
pn_proc => parse_node_get_sub_ptr (pn_proclist)
do i = 1, cmd%n_proc
cmd%process_id(i) = parse_node_get_string (pn_proc)
pn_proc => parse_node_get_next_ptr (pn_proc)
end do
end subroutine cmd_rescan_compile
@ %def cmd_rescan_compile
@ Execute command: Rescan events. This is done via a [[simulation_t]]
object and its associated methods.
<<Commands: cmd rescan: TBP>>=
procedure :: execute => cmd_rescan_execute
<<Commands: procedures>>=
subroutine cmd_rescan_execute (cmd, global)
class(cmd_rescan_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(rt_data_t), dimension(:), allocatable, target :: alt_env
type(string_t) :: sample, sample_suffix
logical :: exist, write_raw, update_event, update_sqme
type(simulation_t), target :: sim
type(event_sample_data_t) :: input_data, data
type(string_t) :: input_sample
integer :: n_fmt
type(string_t), dimension(:), allocatable :: sample_fmt
type(string_t) :: input_format, input_ext, input_file
type(string_t) :: lhef_extension, extension_hepmc, extension_lcio
type(event_stream_array_t) :: es_array
integer :: i, n_events
<<Commands: cmd rescan execute: variables>>
var_list => cmd%local%var_list
if (allocated (cmd%local%pn%alt_setup)) then
allocate (alt_env (size (cmd%local%pn%alt_setup)))
do i = 1, size (alt_env)
call build_alt_setup (alt_env(i), cmd%local, &
cmd%local%pn%alt_setup(i)%ptr)
end do
call sim%init (cmd%process_id, .false., .false., cmd%local, global, &
alt_env)
else
call sim%init (cmd%process_id, .false., .false., cmd%local, global)
end if
call sim%compute_n_events (n_events, var_list)
input_sample = eval_string (cmd%pn_filename, var_list)
input_format = var_list%get_sval (&
var_str ("$rescan_input_format"))
sample_suffix = ""
<<Commands: cmd rescan execute: init>>
sample = var_list%get_sval (var_str ("$sample"))
if (sample == "") then
sample = sim%get_default_sample_name () // sample_suffix
else
sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
end if
write_raw = var_list%get_lval (var_str ("?write_raw"))
if (allocated (cmd%local%sample_fmt)) then
n_fmt = size (cmd%local%sample_fmt)
else
n_fmt = 0
end if
if (write_raw) then
if (sample == input_sample) then
call msg_error ("Rescan: ?write_raw = true: " &
// "suppressing raw event output (filename clashes with input)")
allocate (sample_fmt (n_fmt))
if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
else
allocate (sample_fmt (n_fmt + 1))
if (n_fmt > 0) sample_fmt(:n_fmt) = cmd%local%sample_fmt
sample_fmt(n_fmt+1) = var_str ("raw")
end if
else
allocate (sample_fmt (n_fmt))
if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
end if
update_event = &
var_list%get_lval (var_str ("?update_event"))
update_sqme = &
var_list%get_lval (var_str ("?update_sqme"))
if (update_event .or. update_sqme) then
call msg_message ("Recalculating observables")
if (update_sqme) then
call msg_message ("Recalculating squared matrix elements")
end if
end if
lhef_extension = &
var_list%get_sval (var_str ("$lhef_extension"))
extension_hepmc = &
var_list%get_sval (var_str ("$extension_hepmc"))
extension_lcio = &
var_list%get_sval (var_str ("$extension_lcio"))
select case (char (input_format))
case ("raw"); input_ext = "evx"
call cmd%local%set_log &
(var_str ("?recover_beams"), .false., is_known=.true.)
case ("lhef"); input_ext = lhef_extension
case ("hepmc"); input_ext = extension_hepmc
case default
call msg_fatal ("rescan: input sample format '" // char (input_format) &
// "' not supported")
end select
input_file = input_sample // "." // input_ext
inquire (file = char (input_file), exist = exist)
if (exist) then
input_data = sim%get_data (alt = .false.)
input_data%n_evt = n_events
data = sim%get_data ()
data%n_evt = n_events
input_data%md5sum_cfg = ""
call es_array%init (sample, &
sample_fmt, cmd%local, data, &
input = input_format, input_sample = input_sample, &
input_data = input_data, &
allow_switch = .false.)
call sim%rescan (n_events, es_array, global = cmd%local)
call es_array%final ()
else
call msg_fatal ("Rescan: event file '" &
// char (input_file) // "' not found")
end if
if (allocated (alt_env)) then
do i = 1, size (alt_env)
call alt_env(i)%local_final ()
end do
end if
call sim%final ()
end subroutine cmd_rescan_execute
@ %def cmd_rescan_execute
@
<<Commands: cmd rescan execute: variables>>=
@
<<Commands: cmd rescan execute: init>>=
@
<<MPI: Commands: cmd rescan execute: variables>>=
logical :: mpi_logging
integer :: rank, n_size
@ Append rank id to sample name.
<<MPI: Commands: cmd rescan execute: init>>=
call mpi_get_comm_id (n_size, rank)
if (n_size > 1) then
sample_suffix = var_str ("_") // str (rank)
end if
mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
& .and. (n_size > 1)) &
& .or. var_list%get_lval (var_str ("?mpi_logging")))
call mpi_set_logging (mpi_logging)
@
\subsubsection{Parameters: number of iterations}
Specify number of iterations and number of calls for one integration pass.
<<Commands: types>>=
type, extends (command_t) :: cmd_iterations_t
private
integer :: n_pass = 0
type(parse_node_p), dimension(:), allocatable :: pn_expr_n_it
type(parse_node_p), dimension(:), allocatable :: pn_expr_n_calls
type(parse_node_p), dimension(:), allocatable :: pn_sexpr_adapt
contains
<<Commands: cmd iterations: TBP>>
end type cmd_iterations_t
@ %def cmd_iterations_t
@ Output. Display the number of passes, which is known after compilation.
<<Commands: cmd iterations: TBP>>=
procedure :: write => cmd_iterations_write
<<Commands: procedures>>=
subroutine cmd_iterations_write (cmd, unit, indent)
class(cmd_iterations_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
select case (cmd%n_pass)
case (0)
write (u, "(1x,A)") "iterations: [empty]"
case (1)
write (u, "(1x,A,I0,A)") "iterations: ", cmd%n_pass, " pass"
case default
write (u, "(1x,A,I0,A)") "iterations: ", cmd%n_pass, " passes"
end select
end subroutine cmd_iterations_write
@ %def cmd_iterations_write
@ Compile. Initialize evaluation trees.
<<Commands: cmd iterations: TBP>>=
procedure :: compile => cmd_iterations_compile
<<Commands: procedures>>=
subroutine cmd_iterations_compile (cmd, global)
class(cmd_iterations_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg, pn_n_it, pn_n_calls, pn_adapt
type(parse_node_t), pointer :: pn_it_spec, pn_calls_spec, pn_adapt_spec
integer :: i
pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
if (associated (pn_arg)) then
cmd%n_pass = parse_node_get_n_sub (pn_arg)
allocate (cmd%pn_expr_n_it (cmd%n_pass))
allocate (cmd%pn_expr_n_calls (cmd%n_pass))
allocate (cmd%pn_sexpr_adapt (cmd%n_pass))
pn_it_spec => parse_node_get_sub_ptr (pn_arg)
i = 1
do while (associated (pn_it_spec))
pn_n_it => parse_node_get_sub_ptr (pn_it_spec)
pn_calls_spec => parse_node_get_next_ptr (pn_n_it)
pn_n_calls => parse_node_get_sub_ptr (pn_calls_spec, 2)
pn_adapt_spec => parse_node_get_next_ptr (pn_calls_spec)
if (associated (pn_adapt_spec)) then
pn_adapt => parse_node_get_sub_ptr (pn_adapt_spec, 2)
else
pn_adapt => null ()
end if
cmd%pn_expr_n_it(i)%ptr => pn_n_it
cmd%pn_expr_n_calls(i)%ptr => pn_n_calls
cmd%pn_sexpr_adapt(i)%ptr => pn_adapt
i = i + 1
pn_it_spec => parse_node_get_next_ptr (pn_it_spec)
end do
else
allocate (cmd%pn_expr_n_it (0))
allocate (cmd%pn_expr_n_calls (0))
end if
end subroutine cmd_iterations_compile
@ %def cmd_iterations_compile
@ Execute. Evaluate the trees and transfer the results to the iteration
list in the runtime data set.
<<Commands: cmd iterations: TBP>>=
procedure :: execute => cmd_iterations_execute
<<Commands: procedures>>=
subroutine cmd_iterations_execute (cmd, global)
class(cmd_iterations_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
integer, dimension(cmd%n_pass) :: n_it, n_calls
logical, dimension(cmd%n_pass) :: custom_adapt
type(string_t), dimension(cmd%n_pass) :: adapt_code
integer :: i
var_list => global%get_var_list_ptr ()
do i = 1, cmd%n_pass
n_it(i) = eval_int (cmd%pn_expr_n_it(i)%ptr, var_list)
n_calls(i) = &
eval_int (cmd%pn_expr_n_calls(i)%ptr, var_list)
if (associated (cmd%pn_sexpr_adapt(i)%ptr)) then
adapt_code(i) = &
eval_string (cmd%pn_sexpr_adapt(i)%ptr, &
var_list, is_known = custom_adapt(i))
else
custom_adapt(i) = .false.
end if
end do
call global%it_list%init (n_it, n_calls, custom_adapt, adapt_code)
end subroutine cmd_iterations_execute
@ %def cmd_iterations_execute
@
\subsubsection{Range expressions}
We need a special type for storing and evaluating range expressions.
<<Commands: parameters>>=
integer, parameter :: STEP_NONE = 0
integer, parameter :: STEP_ADD = 1
integer, parameter :: STEP_SUB = 2
integer, parameter :: STEP_MUL = 3
integer, parameter :: STEP_DIV = 4
integer, parameter :: STEP_COMP_ADD = 11
integer, parameter :: STEP_COMP_MUL = 13
@
There is an abstract base type and two implementations: scan over integers and
scan over reals.
<<Commands: types>>=
type, abstract :: range_t
type(parse_node_t), pointer :: pn_expr => null ()
type(parse_node_t), pointer :: pn_term => null ()
type(parse_node_t), pointer :: pn_factor => null ()
type(parse_node_t), pointer :: pn_value => null ()
type(parse_node_t), pointer :: pn_literal => null ()
type(parse_node_t), pointer :: pn_beg => null ()
type(parse_node_t), pointer :: pn_end => null ()
type(parse_node_t), pointer :: pn_step => null ()
type(eval_tree_t) :: expr_beg
type(eval_tree_t) :: expr_end
type(eval_tree_t) :: expr_step
integer :: step_mode = 0
integer :: n_step = 0
contains
<<Commands: range: TBP>>
end type range_t
@ %def range_t
@ These are the implementations:
<<Commands: types>>=
type, extends (range_t) :: range_int_t
integer :: i_beg = 0
integer :: i_end = 0
integer :: i_step = 0
contains
<<Commands: range int: TBP>>
end type range_int_t
type, extends (range_t) :: range_real_t
real(default) :: r_beg = 0
real(default) :: r_end = 0
real(default) :: r_step = 0
real(default) :: lr_beg = 0
real(default) :: lr_end = 0
real(default) :: lr_step = 0
contains
<<Commands: range real: TBP>>
end type range_real_t
@ %def range_int_t range_real_t
@ Finalize the allocated dummy node. The other nodes are just pointers.
<<Commands: range: TBP>>=
procedure :: final => range_final
<<Commands: procedures>>=
subroutine range_final (object)
class(range_t), intent(inout) :: object
if (associated (object%pn_expr)) then
call parse_node_final (object%pn_expr, recursive = .false.)
call parse_node_final (object%pn_term, recursive = .false.)
call parse_node_final (object%pn_factor, recursive = .false.)
call parse_node_final (object%pn_value, recursive = .false.)
call parse_node_final (object%pn_literal, recursive = .false.)
deallocate (object%pn_expr)
deallocate (object%pn_term)
deallocate (object%pn_factor)
deallocate (object%pn_value)
deallocate (object%pn_literal)
end if
end subroutine range_final
@ %def range_final
@ Output.
<<Commands: range: TBP>>=
procedure (range_write), deferred :: write
procedure :: base_write => range_write
<<Commands: range int: TBP>>=
procedure :: write => range_int_write
<<Commands: range real: TBP>>=
procedure :: write => range_real_write
<<Commands: procedures>>=
subroutine range_write (object, unit)
class(range_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(1x,A)") "Range specification:"
if (associated (object%pn_expr)) then
write (u, "(1x,A)") "Dummy value:"
call parse_node_write_rec (object%pn_expr, u)
end if
if (associated (object%pn_beg)) then
write (u, "(1x,A)") "Initial value:"
call parse_node_write_rec (object%pn_beg, u)
call object%expr_beg%write (u)
if (associated (object%pn_end)) then
write (u, "(1x,A)") "Final value:"
call parse_node_write_rec (object%pn_end, u)
call object%expr_end%write (u)
if (associated (object%pn_step)) then
write (u, "(1x,A)") "Step value:"
call parse_node_write_rec (object%pn_step, u)
select case (object%step_mode)
case (STEP_ADD); write (u, "(1x,A)") "Step mode: +"
case (STEP_SUB); write (u, "(1x,A)") "Step mode: -"
case (STEP_MUL); write (u, "(1x,A)") "Step mode: *"
case (STEP_DIV); write (u, "(1x,A)") "Step mode: /"
case (STEP_COMP_ADD); write (u, "(1x,A)") "Division mode: +"
case (STEP_COMP_MUL); write (u, "(1x,A)") "Division mode: *"
end select
end if
end if
else
write (u, "(1x,A)") "Expressions: [undefined]"
end if
end subroutine range_write
subroutine range_int_write (object, unit)
class(range_int_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
call object%base_write (unit)
write (u, "(1x,A)") "Range parameters:"
write (u, "(3x,A,I0)") "i_beg = ", object%i_beg
write (u, "(3x,A,I0)") "i_end = ", object%i_end
write (u, "(3x,A,I0)") "i_step = ", object%i_step
write (u, "(3x,A,I0)") "n_step = ", object%n_step
end subroutine range_int_write
subroutine range_real_write (object, unit)
class(range_real_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
call object%base_write (unit)
write (u, "(1x,A)") "Range parameters:"
write (u, "(3x,A," // FMT_19 // ")") "r_beg = ", object%r_beg
write (u, "(3x,A," // FMT_19 // ")") "r_end = ", object%r_end
write (u, "(3x,A," // FMT_19 // ")") "r_step = ", object%r_end
write (u, "(3x,A,I0)") "n_step = ", object%n_step
end subroutine range_real_write
@ %def range_write
@ Initialize, given a range expression parse node. This is common to the
implementations.
<<Commands: range: TBP>>=
procedure :: init => range_init
<<Commands: procedures>>=
subroutine range_init (range, pn)
class(range_t), intent(out) :: range
type(parse_node_t), intent(in), target :: pn
type(parse_node_t), pointer :: pn_spec, pn_end, pn_step_spec, pn_op
select case (char (parse_node_get_rule_key (pn)))
case ("expr")
case ("range_expr")
range%pn_beg => parse_node_get_sub_ptr (pn)
pn_spec => parse_node_get_next_ptr (range%pn_beg)
if (associated (pn_spec)) then
pn_end => parse_node_get_sub_ptr (pn_spec, 2)
range%pn_end => pn_end
pn_step_spec => parse_node_get_next_ptr (pn_end)
if (associated (pn_step_spec)) then
pn_op => parse_node_get_sub_ptr (pn_step_spec)
range%pn_step => parse_node_get_next_ptr (pn_op)
select case (char (parse_node_get_rule_key (pn_op)))
case ("/+"); range%step_mode = STEP_ADD
case ("/-"); range%step_mode = STEP_SUB
case ("/*"); range%step_mode = STEP_MUL
case ("//"); range%step_mode = STEP_DIV
case ("/+/"); range%step_mode = STEP_COMP_ADD
case ("/*/"); range%step_mode = STEP_COMP_MUL
case default
call range%write ()
call msg_bug ("Range: step mode not implemented")
end select
else
range%step_mode = STEP_ADD
end if
else
range%step_mode = STEP_NONE
end if
call range%create_value_node ()
case default
call msg_bug ("range expression: node type '" &
// char (parse_node_get_rule_key (pn)) &
// "' not implemented")
end select
end subroutine range_init
@ %def range_init
@ This method manually creates a parse node (actually, a cascade of parse
nodes) that hold a constant value as a literal. The idea is that this node is
inserted as the right-hand side of a fake variable assignment, which is
prepended to each scan iteration. Before the variable
assignment is compiled and executed, we can manually reset the value of the
literal and thus pretend that the loop variable is assigned this value.
<<Commands: range: TBP>>=
procedure :: create_value_node => range_create_value_node
<<Commands: procedures>>=
subroutine range_create_value_node (range)
class(range_t), intent(inout) :: range
allocate (range%pn_literal)
allocate (range%pn_value)
select type (range)
type is (range_int_t)
call parse_node_create_value (range%pn_literal, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_literal")),&
ival = 0)
call parse_node_create_branch (range%pn_value, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_value")))
type is (range_real_t)
call parse_node_create_value (range%pn_literal, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_literal")),&
rval = 0._default)
call parse_node_create_branch (range%pn_value, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_value")))
class default
call msg_bug ("range: create value node: type not implemented")
end select
call parse_node_append_sub (range%pn_value, range%pn_literal)
call parse_node_freeze_branch (range%pn_value)
allocate (range%pn_factor)
call parse_node_create_branch (range%pn_factor, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("factor")))
call parse_node_append_sub (range%pn_factor, range%pn_value)
call parse_node_freeze_branch (range%pn_factor)
allocate (range%pn_term)
call parse_node_create_branch (range%pn_term, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("term")))
call parse_node_append_sub (range%pn_term, range%pn_factor)
call parse_node_freeze_branch (range%pn_term)
allocate (range%pn_expr)
call parse_node_create_branch (range%pn_expr, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("expr")))
call parse_node_append_sub (range%pn_expr, range%pn_term)
call parse_node_freeze_branch (range%pn_expr)
end subroutine range_create_value_node
@ %def range_create_value_node
@ Compile, given an environment.
<<Commands: range: TBP>>=
procedure :: compile => range_compile
<<Commands: procedures>>=
subroutine range_compile (range, global)
class(range_t), intent(inout) :: range
type(rt_data_t), intent(in), target :: global
type(var_list_t), pointer :: var_list
var_list => global%get_var_list_ptr ()
if (associated (range%pn_beg)) then
call range%expr_beg%init_expr (range%pn_beg, var_list)
if (associated (range%pn_end)) then
call range%expr_end%init_expr (range%pn_end, var_list)
if (associated (range%pn_step)) then
call range%expr_step%init_expr (range%pn_step, var_list)
end if
end if
end if
end subroutine range_compile
@ %def range_compile
@ Evaluate: compute the actual bounds and parameters that determine the values
that we can iterate.
This is implementation-specific.
<<Commands: range: TBP>>=
procedure (range_evaluate), deferred :: evaluate
<<Commands: interfaces>>=
abstract interface
subroutine range_evaluate (range)
import
class(range_t), intent(inout) :: range
end subroutine range_evaluate
end interface
@ %def range_evaluate
@ The version for an integer variable. If the step is subtractive, we invert
the sign and treat it as an additive step. For a multiplicative step, the
step must be greater than one, and the initial and final values must be of
same sign and strictly ordered. Analogously for a division step.
<<Commands: range int: TBP>>=
procedure :: evaluate => range_int_evaluate
<<Commands: procedures>>=
subroutine range_int_evaluate (range)
class(range_int_t), intent(inout) :: range
integer :: ival
if (associated (range%pn_beg)) then
call range%expr_beg%evaluate ()
if (range%expr_beg%is_known ()) then
range%i_beg = range%expr_beg%get_int ()
else
call range%write ()
call msg_fatal &
("Range expression: initial value evaluates to unknown")
end if
if (associated (range%pn_end)) then
call range%expr_end%evaluate ()
if (range%expr_end%is_known ()) then
range%i_end = range%expr_end%get_int ()
if (associated (range%pn_step)) then
call range%expr_step%evaluate ()
if (range%expr_step%is_known ()) then
range%i_step = range%expr_step%get_int ()
select case (range%step_mode)
case (STEP_SUB); range%i_step = - range%i_step
end select
else
call range%write ()
call msg_fatal &
("Range expression: step value evaluates to unknown")
end if
else
range%i_step = 1
end if
else
call range%write ()
call msg_fatal &
("Range expression: final value evaluates to unknown")
end if
else
range%i_end = range%i_beg
range%i_step = 1
end if
select case (range%step_mode)
case (STEP_NONE)
range%n_step = 1
case (STEP_ADD, STEP_SUB)
if (range%i_step /= 0) then
if (range%i_beg == range%i_end) then
range%n_step = 1
else if (sign (1, range%i_end - range%i_beg) &
== sign (1, range%i_step)) then
range%n_step = (range%i_end - range%i_beg) / range%i_step + 1
else
range%n_step = 0
end if
else
call msg_fatal ("range evaluation (add): step value is zero")
end if
case (STEP_MUL)
if (range%i_step > 1) then
if (range%i_beg == range%i_end) then
range%n_step = 1
else if (range%i_beg == 0) then
call msg_fatal ("range evaluation (mul): initial value is zero")
else if (sign (1, range%i_beg) == sign (1, range%i_end) &
.and. abs (range%i_beg) < abs (range%i_end)) then
range%n_step = 0
ival = range%i_beg
do while (abs (ival) <= abs (range%i_end))
range%n_step = range%n_step + 1
ival = ival * range%i_step
end do
else
range%n_step = 0
end if
else
call msg_fatal &
("range evaluation (mult): step value is one or less")
end if
case (STEP_DIV)
if (range%i_step > 1) then
if (range%i_beg == range%i_end) then
range%n_step = 1
else if (sign (1, range%i_beg) == sign (1, range%i_end) &
.and. abs (range%i_beg) > abs (range%i_end)) then
range%n_step = 0
ival = range%i_beg
do while (abs (ival) >= abs (range%i_end))
range%n_step = range%n_step + 1
if (ival == 0) exit
ival = ival / range%i_step
end do
else
range%n_step = 0
end if
else
call msg_fatal &
("range evaluation (div): step value is one or less")
end if
case (STEP_COMP_ADD)
call msg_fatal ("range evaluation: &
&step mode /+/ not allowed for integer variable")
case (STEP_COMP_MUL)
call msg_fatal ("range evaluation: &
&step mode /*/ not allowed for integer variable")
case default
call range%write ()
call msg_bug ("range evaluation: step mode not implemented")
end select
end if
end subroutine range_int_evaluate
@ %def range_int_evaluate
@ The version for a real variable.
<<Commands: range real: TBP>>=
procedure :: evaluate => range_real_evaluate
<<Commands: procedures>>=
subroutine range_real_evaluate (range)
class(range_real_t), intent(inout) :: range
if (associated (range%pn_beg)) then
call range%expr_beg%evaluate ()
if (range%expr_beg%is_known ()) then
range%r_beg = range%expr_beg%get_real ()
else
call range%write ()
call msg_fatal &
("Range expression: initial value evaluates to unknown")
end if
if (associated (range%pn_end)) then
call range%expr_end%evaluate ()
if (range%expr_end%is_known ()) then
range%r_end = range%expr_end%get_real ()
if (associated (range%pn_step)) then
if (range%expr_step%is_known ()) then
select case (range%step_mode)
case (STEP_ADD, STEP_SUB, STEP_MUL, STEP_DIV)
call range%expr_step%evaluate ()
range%r_step = range%expr_step%get_real ()
select case (range%step_mode)
case (STEP_SUB); range%r_step = - range%r_step
end select
case (STEP_COMP_ADD, STEP_COMP_MUL)
range%n_step = &
max (range%expr_step%get_int (), 0)
end select
else
call range%write ()
call msg_fatal &
("Range expression: step value evaluates to unknown")
end if
else
call range%write ()
call msg_fatal &
("Range expression (real): step value must be provided")
end if
else
call range%write ()
call msg_fatal &
("Range expression: final value evaluates to unknown")
end if
else
range%r_end = range%r_beg
range%r_step = 1
end if
select case (range%step_mode)
case (STEP_NONE)
range%n_step = 1
case (STEP_ADD, STEP_SUB)
if (range%r_step /= 0) then
if (sign (1._default, range%r_end - range%r_beg) &
== sign (1._default, range%r_step)) then
range%n_step = &
nint ((range%r_end - range%r_beg) / range%r_step + 1)
else
range%n_step = 0
end if
else
call msg_fatal ("range evaluation (add): step value is zero")
end if
case (STEP_MUL)
if (range%r_step > 1) then
if (range%r_beg == 0 .or. range%r_end == 0) then
call msg_fatal ("range evaluation (mul): bound is zero")
else if (sign (1._default, range%r_beg) &
== sign (1._default, range%r_end) &
.and. abs (range%r_beg) <= abs (range%r_end)) then
range%lr_beg = log (abs (range%r_beg))
range%lr_end = log (abs (range%r_end))
range%lr_step = log (range%r_step)
range%n_step = nint &
(abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
else
range%n_step = 0
end if
else
call msg_fatal &
("range evaluation (mult): step value is one or less")
end if
case (STEP_DIV)
if (range%r_step > 1) then
if (range%r_beg == 0 .or. range%r_end == 0) then
call msg_fatal ("range evaluation (div): bound is zero")
else if (sign (1._default, range%r_beg) &
== sign (1._default, range%r_end) &
.and. abs (range%r_beg) >= abs (range%r_end)) then
range%lr_beg = log (abs (range%r_beg))
range%lr_end = log (abs (range%r_end))
range%lr_step = -log (range%r_step)
range%n_step = nint &
(abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
else
range%n_step = 0
end if
else
call msg_fatal &
("range evaluation (mult): step value is one or less")
end if
case (STEP_COMP_ADD)
! Number of steps already known
case (STEP_COMP_MUL)
! Number of steps already known
if (range%r_beg == 0 .or. range%r_end == 0) then
call msg_fatal ("range evaluation (mul): bound is zero")
else if (sign (1._default, range%r_beg) &
== sign (1._default, range%r_end)) then
range%lr_beg = log (abs (range%r_beg))
range%lr_end = log (abs (range%r_end))
else
range%n_step = 0
end if
case default
call range%write ()
call msg_bug ("range evaluation: step mode not implemented")
end select
end if
end subroutine range_real_evaluate
@ %def range_real_evaluate
@ Return the number of iterations:
<<Commands: range: TBP>>=
procedure :: get_n_iterations => range_get_n_iterations
<<Commands: procedures>>=
function range_get_n_iterations (range) result (n)
class(range_t), intent(in) :: range
integer :: n
n = range%n_step
end function range_get_n_iterations
@ %def range_get_n_iterations
@ Compute the value for iteration [[i]] and store it in the embedded token.
<<Commands: range: TBP>>=
procedure (range_set_value), deferred :: set_value
<<Commands: interfaces>>=
abstract interface
subroutine range_set_value (range, i)
import
class(range_t), intent(inout) :: range
integer, intent(in) :: i
end subroutine range_set_value
end interface
@ %def range_set_value
@ In the integer case, we compute the value directly for additive step. For
multiplicative step, we perform a loop in the same way as above, where the
number of iteration was determined.
<<Commands: range int: TBP>>=
procedure :: set_value => range_int_set_value
<<Commands: procedures>>=
subroutine range_int_set_value (range, i)
class(range_int_t), intent(inout) :: range
integer, intent(in) :: i
integer :: k, ival
select case (range%step_mode)
case (STEP_NONE)
ival = range%i_beg
case (STEP_ADD, STEP_SUB)
ival = range%i_beg + (i - 1) * range%i_step
case (STEP_MUL)
ival = range%i_beg
do k = 1, i - 1
ival = ival * range%i_step
end do
case (STEP_DIV)
ival = range%i_beg
do k = 1, i - 1
ival = ival / range%i_step
end do
case default
call range%write ()
call msg_bug ("range iteration: step mode not implemented")
end select
call parse_node_set_value (range%pn_literal, ival = ival)
end subroutine range_int_set_value
@ %def range_int_set_value
@ In the integer case, we compute the value directly for additive step. For
multiplicative step, we perform a loop in the same way as above, where the
number of iteration was determined.
<<Commands: range real: TBP>>=
procedure :: set_value => range_real_set_value
<<Commands: procedures>>=
subroutine range_real_set_value (range, i)
class(range_real_t), intent(inout) :: range
integer, intent(in) :: i
real(default) :: rval, x
select case (range%step_mode)
case (STEP_NONE)
rval = range%r_beg
case (STEP_ADD, STEP_SUB, STEP_COMP_ADD)
if (range%n_step > 1) then
x = real (i - 1, default) / (range%n_step - 1)
else
x = 1._default / 2
end if
rval = x * range%r_end + (1 - x) * range%r_beg
case (STEP_MUL, STEP_DIV, STEP_COMP_MUL)
if (range%n_step > 1) then
x = real (i - 1, default) / (range%n_step - 1)
else
x = 1._default / 2
end if
rval = sign &
(exp (x * range%lr_end + (1 - x) * range%lr_beg), range%r_beg)
case default
call range%write ()
call msg_bug ("range iteration: step mode not implemented")
end select
call parse_node_set_value (range%pn_literal, rval = rval)
end subroutine range_real_set_value
@ %def range_real_set_value
@
\subsubsection{Scan over parameters and other objects}
The scan command allocates a new parse node for the variable
assignment (the lhs). The rhs of this parse node is assigned from the
available rhs expressions in the scan list, one at a time, so the
compiled parse node can be prepended to the scan body.
Note: for the integer/real range array, the obvious implementation as a
polymorphic array is suspended because in gfortran 4.7, polymorphic arrays are
apparently broken.
<<Commands: types>>=
type, extends (command_t) :: cmd_scan_t
private
type(string_t) :: name
integer :: n_values = 0
type(parse_node_p), dimension(:), allocatable :: scan_cmd
!!! !!! gfortran 4.7.x memory corruption
!!! class(range_t), dimension(:), allocatable :: range
type(range_int_t), dimension(:), allocatable :: range_int
type(range_real_t), dimension(:), allocatable :: range_real
contains
<<Commands: cmd scan: TBP>>
end type cmd_scan_t
@ %def cmd_scan_t
@ Finalizer.
The auxiliary parse nodes that we have constructed have to be treated
carefully: the embedded pointers all point to persistent objects
somewhere else and should not be finalized, so we should not call the
finalizer recursively.
<<Commands: cmd scan: TBP>>=
procedure :: final => cmd_scan_final
<<Commands: procedures>>=
recursive subroutine cmd_scan_final (cmd)
class(cmd_scan_t), intent(inout) :: cmd
type(parse_node_t), pointer :: pn_var_single, pn_decl_single
type(string_t) :: key
integer :: i
if (allocated (cmd%scan_cmd)) then
do i = 1, size (cmd%scan_cmd)
pn_var_single => parse_node_get_sub_ptr (cmd%scan_cmd(i)%ptr)
key = parse_node_get_rule_key (pn_var_single)
select case (char (key))
case ("scan_string_decl", "scan_log_decl")
pn_decl_single => parse_node_get_sub_ptr (pn_var_single, 2)
call parse_node_final (pn_decl_single, recursive=.false.)
deallocate (pn_decl_single)
end select
call parse_node_final (pn_var_single, recursive=.false.)
deallocate (pn_var_single)
end do
deallocate (cmd%scan_cmd)
end if
!!! !!! gfortran 4.7.x memory corruption
!!! if (allocated (cmd%range)) then
!!! do i = 1, size (cmd%range)
!!! call cmd%range(i)%final ()
!!! end do
!!! end if
if (allocated (cmd%range_int)) then
do i = 1, size (cmd%range_int)
call cmd%range_int(i)%final ()
end do
end if
if (allocated (cmd%range_real)) then
do i = 1, size (cmd%range_real)
call cmd%range_real(i)%final ()
end do
end if
end subroutine cmd_scan_final
@ %def cmd_scan_final
@ Output.
<<Commands: cmd scan: TBP>>=
procedure :: write => cmd_scan_write
<<Commands: procedures>>=
subroutine cmd_scan_write (cmd, unit, indent)
class(cmd_scan_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,1x,A,1x,'(',I0,')')") "scan:", char (cmd%name), &
cmd%n_values
end subroutine cmd_scan_write
@ %def cmd_scan_write
@ Compile the scan command. We construct a new parse node that
implements the variable assignment for a single element on the rhs,
instead of the whole list that we get from the original parse tree.
By simply copying the node, we copy all pointers and inherit the
targets from the original. During execution, we should replace the
rhs by the stored rhs pointers (the list elements), one by one, then
(re)compile the redefined node.
<<Commands: cmd scan: TBP>>=
procedure :: compile => cmd_scan_compile
<<Commands: procedures>>=
recursive subroutine cmd_scan_compile (cmd, global)
class(cmd_scan_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
type(parse_node_t), pointer :: pn_var, pn_body, pn_body_first
type(parse_node_t), pointer :: pn_decl, pn_name
type(parse_node_t), pointer :: pn_arg, pn_scan_cmd, pn_rhs
type(parse_node_t), pointer :: pn_decl_single, pn_var_single
type(syntax_rule_t), pointer :: var_rule_decl, var_rule
type(string_t) :: key
integer :: var_type
integer :: i
call msg_debug (D_CORE, "cmd_scan_compile")
if (debug_active (D_CORE)) call parse_node_write_rec (cmd%pn)
pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
pn_body => parse_node_get_next_ptr (pn_var)
if (associated (pn_body)) then
pn_body_first => parse_node_get_sub_ptr (pn_body)
else
pn_body_first => null ()
end if
key = parse_node_get_rule_key (pn_var)
select case (char (key))
case ("scan_num")
pn_name => parse_node_get_sub_ptr (pn_var)
cmd%name = parse_node_get_string (pn_name)
var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_num"))
pn_arg => parse_node_get_next_ptr (pn_name, 2)
case ("scan_int")
pn_name => parse_node_get_sub_ptr (pn_var, 2)
cmd%name = parse_node_get_string (pn_name)
var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_int"))
pn_arg => parse_node_get_next_ptr (pn_name, 2)
case ("scan_real")
pn_name => parse_node_get_sub_ptr (pn_var, 2)
cmd%name = parse_node_get_string (pn_name)
var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_real"))
pn_arg => parse_node_get_next_ptr (pn_name, 2)
case ("scan_complex")
pn_name => parse_node_get_sub_ptr (pn_var, 2)
cmd%name = parse_node_get_string (pn_name)
var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str("cmd_complex"))
pn_arg => parse_node_get_next_ptr (pn_name, 2)
case ("scan_alias")
pn_name => parse_node_get_sub_ptr (pn_var, 2)
cmd%name = parse_node_get_string (pn_name)
var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_alias"))
pn_arg => parse_node_get_next_ptr (pn_name, 2)
case ("scan_string_decl")
pn_decl => parse_node_get_sub_ptr (pn_var, 2)
pn_name => parse_node_get_sub_ptr (pn_decl, 2)
cmd%name = parse_node_get_string (pn_name)
var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_string"))
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_string_decl"))
pn_arg => parse_node_get_next_ptr (pn_name, 2)
case ("scan_log_decl")
pn_decl => parse_node_get_sub_ptr (pn_var, 2)
pn_name => parse_node_get_sub_ptr (pn_decl, 2)
cmd%name = parse_node_get_string (pn_name)
var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_log"))
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_log_decl"))
pn_arg => parse_node_get_next_ptr (pn_name, 2)
case ("scan_cuts")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_cuts"))
cmd%name = "cuts"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_weight")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_weight"))
cmd%name = "weight"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_scale")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_scale"))
cmd%name = "scale"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_ren_scale")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_ren_scale"))
cmd%name = "renormalization_scale"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_fac_scale")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_fac_scale"))
cmd%name = "factorization_scale"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_selection")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_selection"))
cmd%name = "selection"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_reweight")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_reweight"))
cmd%name = "reweight"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_analysis")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_analysis"))
cmd%name = "analysis"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_model")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_model"))
cmd%name = "model"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case ("scan_library")
var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
var_str ("cmd_library"))
cmd%name = "library"
pn_arg => parse_node_get_sub_ptr (pn_var, 3)
case default
call msg_bug ("scan: case '" // char (key) // "' not implemented")
end select
if (associated (pn_arg)) then
cmd%n_values = parse_node_get_n_sub (pn_arg)
end if
var_list => global%get_var_list_ptr ()
allocate (cmd%scan_cmd (cmd%n_values))
select case (char (key))
case ("scan_num")
var_type = &
var_list%get_type (cmd%name)
select case (var_type)
case (V_INT)
!!! !!! gfortran 4.7.x memory corruption
!!! allocate (range_int_t :: cmd%range (cmd%n_values))
allocate (cmd%range_int (cmd%n_values))
case (V_REAL)
!!! !!! gfortran 4.7.x memory corruption
!!! allocate (range_real_t :: cmd%range (cmd%n_values))
allocate (cmd%range_real (cmd%n_values))
case (V_CMPLX)
call msg_fatal ("scan over complex variable not implemented")
case (V_NONE)
call msg_fatal ("scan: variable '" // char (cmd%name) //"' undefined")
case default
call msg_bug ("scan: impossible variable type")
end select
case ("scan_int")
!!! !!! gfortran 4.7.x memory corruption
!!! allocate (range_int_t :: cmd%range (cmd%n_values))
allocate (cmd%range_int (cmd%n_values))
case ("scan_real")
!!! !!! gfortran 4.7.x memory corruption
!!! allocate (range_real_t :: cmd%range (cmd%n_values))
allocate (cmd%range_real (cmd%n_values))
case ("scan_complex")
call msg_fatal ("scan over complex variable not implemented")
end select
i = 1
if (associated (pn_arg)) then
pn_rhs => parse_node_get_sub_ptr (pn_arg)
else
pn_rhs => null ()
end if
do while (associated (pn_rhs))
allocate (pn_scan_cmd)
call parse_node_create_branch (pn_scan_cmd, &
syntax_get_rule_ptr (syntax_cmd_list, var_str ("command_list")))
allocate (pn_var_single)
pn_var_single = pn_var
call parse_node_replace_rule (pn_var_single, var_rule)
select case (char (key))
case ("scan_num", "scan_int", "scan_real", &
"scan_complex", "scan_alias", &
"scan_cuts", "scan_weight", &
"scan_scale", "scan_ren_scale", "scan_fac_scale", &
"scan_selection", "scan_reweight", "scan_analysis", &
"scan_model", "scan_library")
if (allocated (cmd%range_int)) then
call cmd%range_int(i)%init (pn_rhs)
!!! !!! gfortran 4.7.x memory corruption
!!! call cmd%range_int(i)%compile (global)
call parse_node_replace_last_sub &
(pn_var_single, cmd%range_int(i)%pn_expr)
else if (allocated (cmd%range_real)) then
call cmd%range_real(i)%init (pn_rhs)
!!! !!! gfortran 4.7.x memory corruption
!!! call cmd%range_real(i)%compile (global)
call parse_node_replace_last_sub &
(pn_var_single, cmd%range_real(i)%pn_expr)
else
call parse_node_replace_last_sub (pn_var_single, pn_rhs)
end if
case ("scan_string_decl", "scan_log_decl")
allocate (pn_decl_single)
pn_decl_single = pn_decl
call parse_node_replace_rule (pn_decl_single, var_rule_decl)
call parse_node_replace_last_sub (pn_decl_single, pn_rhs)
call parse_node_freeze_branch (pn_decl_single)
call parse_node_replace_last_sub (pn_var_single, pn_decl_single)
case default
call msg_bug ("scan: case '" // char (key) &
// "' broken")
end select
call parse_node_freeze_branch (pn_var_single)
call parse_node_append_sub (pn_scan_cmd, pn_var_single)
call parse_node_append_sub (pn_scan_cmd, pn_body_first)
call parse_node_freeze_branch (pn_scan_cmd)
cmd%scan_cmd(i)%ptr => pn_scan_cmd
i = i + 1
pn_rhs => parse_node_get_next_ptr (pn_rhs)
end do
if (debug_active (D_CORE)) then
do i = 1, cmd%n_values
print *, "scan command ", i
call parse_node_write_rec (cmd%scan_cmd(i)%ptr)
if (allocated (cmd%range_int)) call cmd%range_int(i)%write ()
if (allocated (cmd%range_real)) call cmd%range_real(i)%write ()
end do
print *, "original"
call parse_node_write_rec (cmd%pn)
end if
end subroutine cmd_scan_compile
@ %def cmd_scan_compile
@ Execute the loop for all values in the step list. We use the
parse trees with single variable assignment that we have stored, to
iteratively create a local environment, execute the stored commands, and
destroy it again. When we encounter a range object, we execute the commands
for each value that this object provides. Computing this value has the side
effect of modifying the rhs of the variable assignment that heads the local
command list, directly in the local parse tree.
<<Commands: cmd scan: TBP>>=
procedure :: execute => cmd_scan_execute
<<Commands: procedures>>=
recursive subroutine cmd_scan_execute (cmd, global)
class(cmd_scan_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(rt_data_t), allocatable :: local
integer :: i, j
do i = 1, cmd%n_values
if (allocated (cmd%range_int)) then
call cmd%range_int(i)%compile (global)
call cmd%range_int(i)%evaluate ()
do j = 1, cmd%range_int(i)%get_n_iterations ()
call cmd%range_int(i)%set_value (j)
allocate (local)
call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
call local%local_final ()
deallocate (local)
end do
else if (allocated (cmd%range_real)) then
call cmd%range_real(i)%compile (global)
call cmd%range_real(i)%evaluate ()
do j = 1, cmd%range_real(i)%get_n_iterations ()
call cmd%range_real(i)%set_value (j)
allocate (local)
call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
call local%local_final ()
deallocate (local)
end do
else
allocate (local)
call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
call local%local_final ()
deallocate (local)
end if
end do
end subroutine cmd_scan_execute
@ %def cmd_scan_execute
@
\subsubsection{Conditionals}
Conditionals are implemented as a list that is compiled and evaluated
recursively; this allows for a straightforward representation of
[[else if]] constructs. A [[cmd_if_t]] object can hold either an
[[else_if]] clause which is another object of this type, or an
[[else_body]], but not both.
If- or else-bodies are no scoping units, so all data remain global and
no copy-in copy-out is needed.
<<Commands: types>>=
type, extends (command_t) :: cmd_if_t
private
type(parse_node_t), pointer :: pn_if_lexpr => null ()
type(command_list_t), pointer :: if_body => null ()
type(cmd_if_t), dimension(:), pointer :: elsif_cmd => null ()
type(command_list_t), pointer :: else_body => null ()
contains
<<Commands: cmd if: TBP>>
end type cmd_if_t
@ %def cmd_if_t
@ Finalizer. There are no local options, therefore we can simply override
the default finalizer.
<<Commands: cmd if: TBP>>=
procedure :: final => cmd_if_final
<<Commands: procedures>>=
recursive subroutine cmd_if_final (cmd)
class(cmd_if_t), intent(inout) :: cmd
integer :: i
if (associated (cmd%if_body)) then
call command_list_final (cmd%if_body)
deallocate (cmd%if_body)
end if
if (associated (cmd%elsif_cmd)) then
do i = 1, size (cmd%elsif_cmd)
call cmd_if_final (cmd%elsif_cmd(i))
end do
deallocate (cmd%elsif_cmd)
end if
if (associated (cmd%else_body)) then
call command_list_final (cmd%else_body)
deallocate (cmd%else_body)
end if
end subroutine cmd_if_final
@ %def cmd_if_final
@ Output. Recursively write the command lists.
<<Commands: cmd if: TBP>>=
procedure :: write => cmd_if_write
<<Commands: procedures>>=
subroutine cmd_if_write (cmd, unit, indent)
class(cmd_if_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, ind, i
u = given_output_unit (unit); if (u < 0) return
ind = 0; if (present (indent)) ind = indent
call write_indent (u, indent)
write (u, "(A)") "if <expr> then"
if (associated (cmd%if_body)) then
call cmd%if_body%write (unit, ind + 1)
end if
if (associated (cmd%elsif_cmd)) then
do i = 1, size (cmd%elsif_cmd)
call write_indent (u, indent)
write (u, "(A)") "elsif <expr> then"
if (associated (cmd%elsif_cmd(i)%if_body)) then
call cmd%elsif_cmd(i)%if_body%write (unit, ind + 1)
end if
end do
end if
if (associated (cmd%else_body)) then
call write_indent (u, indent)
write (u, "(A)") "else"
call cmd%else_body%write (unit, ind + 1)
end if
end subroutine cmd_if_write
@ %def cmd_if_write
@ Compile the conditional.
<<Commands: cmd if: TBP>>=
procedure :: compile => cmd_if_compile
<<Commands: procedures>>=
recursive subroutine cmd_if_compile (cmd, global)
class(cmd_if_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_lexpr, pn_body
type(parse_node_t), pointer :: pn_elsif_clauses, pn_cmd_elsif
type(parse_node_t), pointer :: pn_else_clause, pn_cmd_else
integer :: i, n_elsif
pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 2)
cmd%pn_if_lexpr => pn_lexpr
pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
select case (char (parse_node_get_rule_key (pn_body)))
case ("command_list")
allocate (cmd%if_body)
call cmd%if_body%compile (pn_body, global)
pn_elsif_clauses => parse_node_get_next_ptr (pn_body)
case default
pn_elsif_clauses => pn_body
end select
select case (char (parse_node_get_rule_key (pn_elsif_clauses)))
case ("elsif_clauses")
n_elsif = parse_node_get_n_sub (pn_elsif_clauses)
allocate (cmd%elsif_cmd (n_elsif))
pn_cmd_elsif => parse_node_get_sub_ptr (pn_elsif_clauses)
do i = 1, n_elsif
pn_lexpr => parse_node_get_sub_ptr (pn_cmd_elsif, 2)
cmd%elsif_cmd(i)%pn_if_lexpr => pn_lexpr
pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
if (associated (pn_body)) then
allocate (cmd%elsif_cmd(i)%if_body)
call cmd%elsif_cmd(i)%if_body%compile (pn_body, global)
end if
pn_cmd_elsif => parse_node_get_next_ptr (pn_cmd_elsif)
end do
pn_else_clause => parse_node_get_next_ptr (pn_elsif_clauses)
case default
pn_else_clause => pn_elsif_clauses
end select
select case (char (parse_node_get_rule_key (pn_else_clause)))
case ("else_clause")
pn_cmd_else => parse_node_get_sub_ptr (pn_else_clause)
pn_body => parse_node_get_sub_ptr (pn_cmd_else, 2)
if (associated (pn_body)) then
allocate (cmd%else_body)
call cmd%else_body%compile (pn_body, global)
end if
end select
end subroutine cmd_if_compile
@ %def global
@ (Recursively) execute the condition. Context remains global in all cases.
<<Commands: cmd if: TBP>>=
procedure :: execute => cmd_if_execute
<<Commands: procedures>>=
recursive subroutine cmd_if_execute (cmd, global)
class(cmd_if_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
logical :: lval, is_known
integer :: i
var_list => global%get_var_list_ptr ()
lval = eval_log (cmd%pn_if_lexpr, var_list, is_known=is_known)
if (is_known) then
if (lval) then
if (associated (cmd%if_body)) then
call cmd%if_body%execute (global)
end if
return
end if
else
call error_undecided ()
return
end if
if (associated (cmd%elsif_cmd)) then
SCAN_ELSIF: do i = 1, size (cmd%elsif_cmd)
lval = eval_log (cmd%elsif_cmd(i)%pn_if_lexpr, var_list, &
is_known=is_known)
if (is_known) then
if (lval) then
if (associated (cmd%elsif_cmd(i)%if_body)) then
call cmd%elsif_cmd(i)%if_body%execute (global)
end if
return
end if
else
call error_undecided ()
return
end if
end do SCAN_ELSIF
end if
if (associated (cmd%else_body)) then
call cmd%else_body%execute (global)
end if
contains
subroutine error_undecided ()
call msg_error ("Undefined result of cmditional expression: " &
// "neither branch will be executed")
end subroutine error_undecided
end subroutine cmd_if_execute
@ %def cmd_if_execute
@
\subsubsection{Include another command-list file}
The include command allocates a local parse tree. This must not be
deleted before the command object itself is deleted, since pointers
may point to subobjects of it.
<<Commands: types>>=
type, extends (command_t) :: cmd_include_t
private
type(string_t) :: file
type(command_list_t), pointer :: command_list => null ()
type(parse_tree_t) :: parse_tree
contains
<<Commands: cmd include: TBP>>
end type cmd_include_t
@ %def cmd_include_t
@ Finalizer: delete the command list. No options, so we can simply override
the default finalizer.
<<Commands: cmd include: TBP>>=
procedure :: final => cmd_include_final
<<Commands: procedures>>=
subroutine cmd_include_final (cmd)
class(cmd_include_t), intent(inout) :: cmd
call parse_tree_final (cmd%parse_tree)
if (associated (cmd%command_list)) then
call cmd%command_list%final ()
deallocate (cmd%command_list)
end if
end subroutine cmd_include_final
@ %def cmd_include_final
@ Write: display the command list as-is, if allocated.
<<Commands: cmd include: TBP>>=
procedure :: write => cmd_include_write
<<Commands: procedures>>=
subroutine cmd_include_write (cmd, unit, indent)
class(cmd_include_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u, ind
u = given_output_unit (unit)
ind = 0; if (present (indent)) ind = indent
call write_indent (u, indent)
write (u, "(A,A,A,A)") "include ", '"', char (cmd%file), '"'
if (associated (cmd%command_list)) then
call cmd%command_list%write (u, ind + 1)
end if
end subroutine cmd_include_write
@ %def cmd_include_write
@ Compile file contents: First parse the file, then immediately
compile its contents. Use the global data set.
<<Commands: cmd include: TBP>>=
procedure :: compile => cmd_include_compile
<<Commands: procedures>>=
subroutine cmd_include_compile (cmd, global)
class(cmd_include_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg, pn_file
type(string_t) :: file
logical :: exist
integer :: u
type(stream_t), target :: stream
type(lexer_t) :: lexer
pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
pn_file => parse_node_get_sub_ptr (pn_arg)
file = parse_node_get_string (pn_file)
inquire (file=char(file), exist=exist)
if (exist) then
cmd%file = file
else
cmd%file = global%os_data%whizard_cutspath // "/" // file
inquire (file=char(cmd%file), exist=exist)
if (.not. exist) then
call msg_error ("Include file '" // char (file) // "' not found")
return
end if
end if
u = free_unit ()
call lexer_init_cmd_list (lexer, global%lexer)
call stream_init (stream, char (cmd%file))
call lexer_assign_stream (lexer, stream)
call parse_tree_init (cmd%parse_tree, syntax_cmd_list, lexer)
call stream_final (stream)
call lexer_final (lexer)
close (u)
allocate (cmd%command_list)
call cmd%command_list%compile (cmd%parse_tree%get_root_ptr (), &
global)
end subroutine cmd_include_compile
@ %def cmd_include_compile
@ Execute file contents in the global context.
<<Commands: cmd include: TBP>>=
procedure :: execute => cmd_include_execute
<<Commands: procedures>>=
subroutine cmd_include_execute (cmd, global)
class(cmd_include_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
if (associated (cmd%command_list)) then
call msg_message &
("Including Sindarin from '" // char (cmd%file) // "'")
call cmd%command_list%execute (global)
call msg_message &
("End of included '" // char (cmd%file) // "'")
end if
end subroutine cmd_include_execute
@ %def cmd_include_execute
@
+\subsubsection{Export values}
+This command exports the current values of variables or other objects to the
+surrounding scope. By default, a scope enclosed by braces keeps all objects
+local to it. The [[export]] command exports the values that are generated
+within the scope to the corresponding object in the outer scope.
+
+The allowed set of exportable objects is, in principle, the same as the set of
+objects that the [[show]] command supports. This includes some convenience
+abbreviations.
+
+TODO: The initial implementation inherits syntax from [[show]], but supports
+only the [[results]] pseudo-object. The results (i.e., the process stack) is
+appended to the outer process stack instead of being discarded. The behavior
+of the [[export]] command for other object kinds is to be defined on a
+case-by-case basis. It may involve replacing the outer value or, instead,
+doing some sort of appending or reduction.
+<<Commands: types>>=
+ type, extends (command_t) :: cmd_export_t
+ private
+ type(string_t), dimension(:), allocatable :: name
+ contains
+ <<Commands: cmd export: TBP>>
+ end type cmd_export_t
+
+@ %def cmd_export_t
+@ Output: list the object names, not values.
+<<Commands: cmd export: TBP>>=
+ procedure :: write => cmd_export_write
+<<Commands: procedures>>=
+ subroutine cmd_export_write (cmd, unit, indent)
+ class(cmd_export_t), intent(in) :: cmd
+ integer, intent(in), optional :: unit, indent
+ integer :: u, i
+ u = given_output_unit (unit); if (u < 0) return
+ call write_indent (u, indent)
+ write (u, "(1x,A)", advance="no") "export: "
+ if (allocated (cmd%name)) then
+ do i = 1, size (cmd%name)
+ write (u, "(1x,A)", advance="no") char (cmd%name(i))
+ end do
+ write (u, *)
+ else
+ write (u, "(5x,A)") "[undefined]"
+ end if
+ end subroutine cmd_export_write
+
+@ %def cmd_export_write
+@ Compile. Allocate an array which is filled with the names of the
+variables to export.
+<<Commands: cmd export: TBP>>=
+ procedure :: compile => cmd_export_compile
+<<Commands: procedures>>=
+ subroutine cmd_export_compile (cmd, global)
+ class(cmd_export_t), intent(inout) :: cmd
+ type(rt_data_t), intent(inout), target :: global
+ type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
+ type(string_t) :: key
+ integer :: i, n_args
+ pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
+ if (associated (pn_arg)) then
+ select case (char (parse_node_get_rule_key (pn_arg)))
+ case ("show_arg")
+ cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
+ case default
+ cmd%pn_opt => pn_arg
+ pn_arg => null ()
+ end select
+ end if
+ call cmd%compile_options (global)
+ if (associated (pn_arg)) then
+ n_args = parse_node_get_n_sub (pn_arg)
+ allocate (cmd%name (n_args))
+ pn_var => parse_node_get_sub_ptr (pn_arg)
+ i = 0
+ do while (associated (pn_var))
+ i = i + 1
+ select case (char (parse_node_get_rule_key (pn_var)))
+ case ("model", "library", "beams", "iterations", &
+ "cuts", "weight", "int", "real", "complex", &
+ "scale", "factorization_scale", "renormalization_scale", &
+ "selection", "reweight", "analysis", "pdg", &
+ "stable", "unstable", "polarized", "unpolarized", &
+ "results", "expect", "intrinsic", "string", "logical")
+ cmd%name(i) = parse_node_get_key (pn_var)
+ case ("result_var")
+ pn_prefix => parse_node_get_sub_ptr (pn_var)
+ pn_name => parse_node_get_next_ptr (pn_prefix)
+ if (associated (pn_name)) then
+ cmd%name(i) = parse_node_get_key (pn_prefix) &
+ // "(" // parse_node_get_string (pn_name) // ")"
+ else
+ cmd%name(i) = parse_node_get_key (pn_prefix)
+ end if
+ case ("log_var", "string_var", "alias_var")
+ pn_prefix => parse_node_get_sub_ptr (pn_var)
+ pn_name => parse_node_get_next_ptr (pn_prefix)
+ key = parse_node_get_key (pn_prefix)
+ if (associated (pn_name)) then
+ select case (char (parse_node_get_rule_key (pn_name)))
+ case ("var_name")
+ select case (char (key))
+ case ("?", "$") ! $ sign
+ cmd%name(i) = key // parse_node_get_string (pn_name)
+ case ("alias")
+ cmd%name(i) = parse_node_get_string (pn_name)
+ end select
+ case default
+ call parse_node_mismatch &
+ ("var_name", pn_name)
+ end select
+ else
+ cmd%name(i) = key
+ end if
+ case default
+ cmd%name(i) = parse_node_get_string (pn_var)
+ end select
+ !!! restriction imposed by current lack of implementation
+ select case (char (parse_node_get_rule_key (pn_var)))
+ case ("results")
+ case default
+ call msg_fatal ("export: object (type) '" &
+ // char (parse_node_get_rule_key (pn_var)) &
+ // "' not supported yet")
+ end select
+ pn_var => parse_node_get_next_ptr (pn_var)
+ end do
+ else
+ allocate (cmd%name (0))
+ end if
+ end subroutine cmd_export_compile
+
+@ %def cmd_export_compile
+@ Execute. Scan the list of objects to export.
+<<Commands: cmd export: TBP>>=
+ procedure :: execute => cmd_export_execute
+<<Commands: procedures>>=
+ subroutine cmd_export_execute (cmd, global)
+ class(cmd_export_t), intent(inout) :: cmd
+ type(rt_data_t), intent(inout), target :: global
+ call global%append_exports (cmd%name)
+ end subroutine cmd_export_execute
+
+@ %def cmd_export_execute
+@
\subsubsection{Quit command execution}
The code is the return code of the whole program if it is terminated
by this command.
<<Commands: types>>=
type, extends (command_t) :: cmd_quit_t
private
logical :: has_code = .false.
type(parse_node_t), pointer :: pn_code_expr => null ()
contains
<<Commands: cmd quit: TBP>>
end type cmd_quit_t
@ %def cmd_quit_t
@ Output.
<<Commands: cmd quit: TBP>>=
procedure :: write => cmd_quit_write
<<Commands: procedures>>=
subroutine cmd_quit_write (cmd, unit, indent)
class(cmd_quit_t), intent(in) :: cmd
integer, intent(in), optional :: unit, indent
integer :: u
u = given_output_unit (unit); if (u < 0) return
call write_indent (u, indent)
write (u, "(1x,A,L1)") "quit: has_code = ", cmd%has_code
end subroutine cmd_quit_write
@ %def cmd_quit_write
@ Compile: allocate a [[quit]] object which serves as a placeholder.
<<Commands: cmd quit: TBP>>=
procedure :: compile => cmd_quit_compile
<<Commands: procedures>>=
subroutine cmd_quit_compile (cmd, global)
class(cmd_quit_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_arg
pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
if (associated (pn_arg)) then
cmd%pn_code_expr => parse_node_get_sub_ptr (pn_arg)
cmd%has_code = .true.
end if
end subroutine cmd_quit_compile
@ %def cmd_quit_compile
@ Execute: The quit command does not execute anything, it just stops
command execution. This is achieved by setting quit flag and quit
code in the global variable list. However, the return code, if
present, is an expression which has to be evaluated.
<<Commands: cmd quit: TBP>>=
procedure :: execute => cmd_quit_execute
<<Commands: procedures>>=
subroutine cmd_quit_execute (cmd, global)
class(cmd_quit_t), intent(inout) :: cmd
type(rt_data_t), intent(inout), target :: global
type(var_list_t), pointer :: var_list
logical :: is_known
var_list => global%get_var_list_ptr ()
if (cmd%has_code) then
global%quit_code = eval_int (cmd%pn_code_expr, var_list, &
is_known=is_known)
if (.not. is_known) then
call msg_error ("Undefined return code of quit/exit command")
end if
end if
global%quit = .true.
end subroutine cmd_quit_execute
@ %def cmd_quit_execute
@
\subsection{The command list}
The command list holds a list of commands and relevant global data.
<<Commands: public>>=
public :: command_list_t
<<Commands: types>>=
type :: command_list_t
! not private anymore as required by the whizard-c-interface
class(command_t), pointer :: first => null ()
class(command_t), pointer :: last => null ()
contains
<<Commands: command list: TBP>>
end type command_list_t
@ %def command_list_t
@ Output.
<<Commands: command list: TBP>>=
procedure :: write => command_list_write
<<Commands: procedures>>=
recursive subroutine command_list_write (cmd_list, unit, indent)
class(command_list_t), intent(in) :: cmd_list
integer, intent(in), optional :: unit, indent
class(command_t), pointer :: cmd
cmd => cmd_list%first
do while (associated (cmd))
call cmd%write (unit, indent)
cmd => cmd%next
end do
end subroutine command_list_write
@ %def command_list_write
@ Append a new command to the list and free the original pointer.
<<Commands: command list: TBP>>=
procedure :: append => command_list_append
<<Commands: procedures>>=
subroutine command_list_append (cmd_list, command)
class(command_list_t), intent(inout) :: cmd_list
class(command_t), intent(inout), pointer :: command
if (associated (cmd_list%last)) then
cmd_list%last%next => command
else
cmd_list%first => command
end if
cmd_list%last => command
command => null ()
end subroutine command_list_append
@ %def command_list_append
@ Finalize.
<<Commands: command list: TBP>>=
procedure :: final => command_list_final
<<Commands: procedures>>=
recursive subroutine command_list_final (cmd_list)
class(command_list_t), intent(inout) :: cmd_list
class(command_t), pointer :: command
do while (associated (cmd_list%first))
command => cmd_list%first
cmd_list%first => cmd_list%first%next
call command%final ()
deallocate (command)
end do
cmd_list%last => null ()
end subroutine command_list_final
@ %def command_list_final
@
\subsection{Compiling the parse tree}
Transform a parse tree into a command list. Initialization is assumed
to be done.
After each command, we set a breakpoint.
<<Commands: command list: TBP>>=
procedure :: compile => command_list_compile
<<Commands: procedures>>=
recursive subroutine command_list_compile (cmd_list, pn, global)
class(command_list_t), intent(inout), target :: cmd_list
type(parse_node_t), intent(in), target :: pn
type(rt_data_t), intent(inout), target :: global
type(parse_node_t), pointer :: pn_cmd
class(command_t), pointer :: command
integer :: i
pn_cmd => parse_node_get_sub_ptr (pn)
do i = 1, parse_node_get_n_sub (pn)
call dispatch_command (command, pn_cmd)
call command%compile (global)
call cmd_list%append (command)
call terminate_now_if_signal ()
pn_cmd => parse_node_get_next_ptr (pn_cmd)
end do
end subroutine command_list_compile
@ %def command_list_compile
@
\subsection{Executing the command list}
Before executing a command we should execute its options (if any). After
that, reset the options, i.e., remove temporary effects from the global
state.
Also here, after each command we set a breakpoint.
<<Commands: command list: TBP>>=
procedure :: execute => command_list_execute
<<Commands: procedures>>=
recursive subroutine command_list_execute (cmd_list, global)
class(command_list_t), intent(in) :: cmd_list
type(rt_data_t), intent(inout), target :: global
class(command_t), pointer :: command
command => cmd_list%first
COMMAND_COND: do while (associated (command))
call command%execute_options (global)
call command%execute (global)
call command%reset_options (global)
call terminate_now_if_signal ()
if (global%quit) exit COMMAND_COND
command => command%next
end do COMMAND_COND
end subroutine command_list_execute
@ %def command_list_execute
@
\subsection{Command list syntax}
<<Commands: public>>=
public :: syntax_cmd_list
<<Commands: variables>>=
type(syntax_t), target, save :: syntax_cmd_list
@ %def syntax_cmd_list
<<Commands: public>>=
public :: syntax_cmd_list_init
<<Commands: procedures>>=
subroutine syntax_cmd_list_init ()
type(ifile_t) :: ifile
call define_cmd_list_syntax (ifile)
call syntax_init (syntax_cmd_list, ifile)
call ifile_final (ifile)
end subroutine syntax_cmd_list_init
@ %def syntax_cmd_list_init
<<Commands: public>>=
public :: syntax_cmd_list_final
<<Commands: procedures>>=
subroutine syntax_cmd_list_final ()
call syntax_final (syntax_cmd_list)
end subroutine syntax_cmd_list_final
@ %def syntax_cmd_list_final
<<Commands: public>>=
public :: syntax_cmd_list_write
<<Commands: procedures>>=
subroutine syntax_cmd_list_write (unit)
integer, intent(in), optional :: unit
call syntax_write (syntax_cmd_list, unit)
end subroutine syntax_cmd_list_write
@ %def syntax_cmd_list_write
<<Commands: procedures>>=
subroutine define_cmd_list_syntax (ifile)
type(ifile_t), intent(inout) :: ifile
call ifile_append (ifile, "SEQ command_list = command*")
call ifile_append (ifile, "ALT command = " &
// "cmd_model | cmd_library | cmd_iterations | cmd_sample_format | " &
// "cmd_var | cmd_slha | " &
// "cmd_show | cmd_clear | " &
// "cmd_expect | " &
// "cmd_cuts | cmd_scale | cmd_fac_scale | cmd_ren_scale | " &
// "cmd_weight | cmd_selection | cmd_reweight | " &
// "cmd_beams | cmd_beams_pol_density | cmd_beams_pol_fraction | " &
// "cmd_beams_momentum | cmd_beams_theta | cmd_beams_phi | " &
// "cmd_integrate | " &
// "cmd_observable | cmd_histogram | cmd_plot | cmd_graph | " &
// "cmd_record | " &
// "cmd_analysis | cmd_alt_setup | " &
// "cmd_unstable | cmd_stable | cmd_simulate | cmd_rescan | " &
// "cmd_process | cmd_compile | cmd_exec | " &
// "cmd_scan | cmd_if | cmd_include | cmd_quit | " &
+ // "cmd_export | " &
// "cmd_polarized | cmd_unpolarized | " &
// "cmd_open_out | cmd_close_out | cmd_printf | " &
// "cmd_write_analysis | cmd_compile_analysis | cmd_nlo | cmd_components")
call ifile_append (ifile, "GRO options = '{' local_command_list '}'")
call ifile_append (ifile, "SEQ local_command_list = local_command*")
call ifile_append (ifile, "ALT local_command = " &
// "cmd_model | cmd_library | cmd_iterations | cmd_sample_format | " &
// "cmd_var | cmd_slha | " &
// "cmd_show | " &
// "cmd_expect | " &
// "cmd_cuts | cmd_scale | cmd_fac_scale | cmd_ren_scale | " &
// "cmd_weight | cmd_selection | cmd_reweight | " &
// "cmd_beams | cmd_beams_pol_density | cmd_beams_pol_fraction | " &
// "cmd_beams_momentum | cmd_beams_theta | cmd_beams_phi | " &
// "cmd_observable | cmd_histogram | cmd_plot | cmd_graph | " &
// "cmd_clear | cmd_record | " &
// "cmd_analysis | cmd_alt_setup | " &
// "cmd_open_out | cmd_close_out | cmd_printf | " &
// "cmd_write_analysis | cmd_compile_analysis | cmd_nlo | cmd_components")
call ifile_append (ifile, "SEQ cmd_model = model '=' model_name model_arg?")
call ifile_append (ifile, "KEY model")
call ifile_append (ifile, "ALT model_name = model_id | string_literal")
call ifile_append (ifile, "IDE model_id")
call ifile_append (ifile, "ARG model_arg = ( model_scheme? )")
call ifile_append (ifile, "ALT model_scheme = " &
// "ufo_spec | scheme_id | string_literal")
call ifile_append (ifile, "SEQ ufo_spec = ufo ufo_arg?")
call ifile_append (ifile, "KEY ufo")
call ifile_append (ifile, "ARG ufo_arg = ( string_literal )")
call ifile_append (ifile, "IDE scheme_id")
call ifile_append (ifile, "SEQ cmd_library = library '=' lib_name")
call ifile_append (ifile, "KEY library")
call ifile_append (ifile, "ALT lib_name = lib_id | string_literal")
call ifile_append (ifile, "IDE lib_id")
call ifile_append (ifile, "ALT cmd_var = " &
// "cmd_log_decl | cmd_log | " &
// "cmd_int | cmd_real | cmd_complex | cmd_num | " &
// "cmd_string_decl | cmd_string | cmd_alias | " &
// "cmd_result")
call ifile_append (ifile, "SEQ cmd_log_decl = logical cmd_log")
call ifile_append (ifile, "SEQ cmd_log = '?' var_name '=' lexpr")
call ifile_append (ifile, "SEQ cmd_int = int var_name '=' expr")
call ifile_append (ifile, "SEQ cmd_real = real var_name '=' expr")
call ifile_append (ifile, "SEQ cmd_complex = complex var_name '=' expr")
call ifile_append (ifile, "SEQ cmd_num = var_name '=' expr")
call ifile_append (ifile, "SEQ cmd_string_decl = string cmd_string")
call ifile_append (ifile, "SEQ cmd_string = " &
// "'$' var_name '=' sexpr") ! $
call ifile_append (ifile, "SEQ cmd_alias = alias var_name '=' cexpr")
call ifile_append (ifile, "SEQ cmd_result = result '=' expr")
call ifile_append (ifile, "SEQ cmd_slha = slha_action slha_arg options?")
call ifile_append (ifile, "ALT slha_action = " &
// "read_slha | write_slha")
call ifile_append (ifile, "KEY read_slha")
call ifile_append (ifile, "KEY write_slha")
call ifile_append (ifile, "ARG slha_arg = ( string_literal )")
call ifile_append (ifile, "SEQ cmd_show = show show_arg options?")
call ifile_append (ifile, "KEY show")
call ifile_append (ifile, "ARG show_arg = ( showable* )")
call ifile_append (ifile, "ALT showable = " &
// "model | library | beams | iterations | " &
// "cuts | weight | logical | string | pdg | " &
// "scale | factorization_scale | renormalization_scale | " &
// "selection | reweight | analysis | " &
// "stable | unstable | polarized | unpolarized | " &
// "expect | intrinsic | int | real | complex | " &
// "alias_var | string | results | result_var | " &
// "log_var | string_var | var_name")
call ifile_append (ifile, "KEY results")
call ifile_append (ifile, "KEY intrinsic")
call ifile_append (ifile, "SEQ alias_var = alias var_name")
call ifile_append (ifile, "SEQ result_var = result_key result_arg?")
call ifile_append (ifile, "SEQ log_var = '?' var_name")
call ifile_append (ifile, "SEQ string_var = '$' var_name") ! $
call ifile_append (ifile, "SEQ cmd_clear = clear clear_arg options?")
call ifile_append (ifile, "KEY clear")
call ifile_append (ifile, "ARG clear_arg = ( clearable* )")
call ifile_append (ifile, "ALT clearable = " &
// "beams | iterations | " &
// "cuts | weight | " &
// "scale | factorization_scale | renormalization_scale | " &
// "selection | reweight | analysis | " &
// "unstable | polarized | " &
// "expect | " &
// "log_var | string_var | var_name")
call ifile_append (ifile, "SEQ cmd_expect = expect expect_arg options?")
call ifile_append (ifile, "KEY expect")
call ifile_append (ifile, "ARG expect_arg = ( lexpr )")
call ifile_append (ifile, "SEQ cmd_cuts = cuts '=' lexpr")
call ifile_append (ifile, "SEQ cmd_scale = scale '=' expr")
call ifile_append (ifile, "SEQ cmd_fac_scale = " &
// "factorization_scale '=' expr")
call ifile_append (ifile, "SEQ cmd_ren_scale = " &
// "renormalization_scale '=' expr")
call ifile_append (ifile, "SEQ cmd_weight = weight '=' expr")
call ifile_append (ifile, "SEQ cmd_selection = selection '=' lexpr")
call ifile_append (ifile, "SEQ cmd_reweight = reweight '=' expr")
call ifile_append (ifile, "KEY cuts")
call ifile_append (ifile, "KEY scale")
call ifile_append (ifile, "KEY factorization_scale")
call ifile_append (ifile, "KEY renormalization_scale")
call ifile_append (ifile, "KEY weight")
call ifile_append (ifile, "KEY selection")
call ifile_append (ifile, "KEY reweight")
call ifile_append (ifile, "SEQ cmd_process = process process_id '=' " &
// "process_prt '=>' prt_state_list options?")
call ifile_append (ifile, "KEY process")
call ifile_append (ifile, "KEY '=>'")
call ifile_append (ifile, "LIS process_prt = cexpr+")
call ifile_append (ifile, "LIS prt_state_list = prt_state_sum+")
call ifile_append (ifile, "SEQ prt_state_sum = " &
// "prt_state prt_state_addition*")
call ifile_append (ifile, "SEQ prt_state_addition = '+' prt_state")
call ifile_append (ifile, "ALT prt_state = grouped_prt_state_list | cexpr")
call ifile_append (ifile, "GRO grouped_prt_state_list = " &
// "( prt_state_list )")
call ifile_append (ifile, "SEQ cmd_compile = compile_cmd options?")
call ifile_append (ifile, "SEQ compile_cmd = compile_clause compile_arg?")
call ifile_append (ifile, "SEQ compile_clause = compile exec_name_spec?")
call ifile_append (ifile, "KEY compile")
call ifile_append (ifile, "SEQ exec_name_spec = as exec_name")
call ifile_append (ifile, "KEY as")
call ifile_append (ifile, "ALT exec_name = exec_id | string_literal")
call ifile_append (ifile, "IDE exec_id")
call ifile_append (ifile, "ARG compile_arg = ( lib_name* )")
call ifile_append (ifile, "SEQ cmd_exec = exec exec_arg")
call ifile_append (ifile, "KEY exec")
call ifile_append (ifile, "ARG exec_arg = ( sexpr )")
call ifile_append (ifile, "SEQ cmd_beams = beams '=' beam_def")
call ifile_append (ifile, "KEY beams")
call ifile_append (ifile, "SEQ beam_def = beam_spec strfun_seq*")
call ifile_append (ifile, "SEQ beam_spec = beam_list")
call ifile_append (ifile, "LIS beam_list = cexpr, cexpr?")
call ifile_append (ifile, "SEQ cmd_beams_pol_density = " &
// "beams_pol_density '=' beams_pol_spec")
call ifile_append (ifile, "KEY beams_pol_density")
call ifile_append (ifile, "LIS beams_pol_spec = smatrix, smatrix?")
call ifile_append (ifile, "SEQ smatrix = '@' smatrix_arg")
! call ifile_append (ifile, "KEY '@'") !!! Key already exists
call ifile_append (ifile, "ARG smatrix_arg = ( sentry* )")
call ifile_append (ifile, "SEQ sentry = expr extra_sentry*")
call ifile_append (ifile, "SEQ extra_sentry = ':' expr")
call ifile_append (ifile, "SEQ cmd_beams_pol_fraction = " &
// "beams_pol_fraction '=' beams_par_spec")
call ifile_append (ifile, "KEY beams_pol_fraction")
call ifile_append (ifile, "SEQ cmd_beams_momentum = " &
// "beams_momentum '=' beams_par_spec")
call ifile_append (ifile, "KEY beams_momentum")
call ifile_append (ifile, "SEQ cmd_beams_theta = " &
// "beams_theta '=' beams_par_spec")
call ifile_append (ifile, "KEY beams_theta")
call ifile_append (ifile, "SEQ cmd_beams_phi = " &
// "beams_phi '=' beams_par_spec")
call ifile_append (ifile, "KEY beams_phi")
call ifile_append (ifile, "LIS beams_par_spec = expr, expr?")
call ifile_append (ifile, "SEQ strfun_seq = '=>' strfun_pair")
call ifile_append (ifile, "LIS strfun_pair = strfun_def, strfun_def?")
call ifile_append (ifile, "SEQ strfun_def = strfun_id")
call ifile_append (ifile, "ALT strfun_id = " &
// "none | lhapdf | lhapdf_photon | pdf_builtin | pdf_builtin_photon | " &
// "isr | epa | ewa | circe1 | circe2 | energy_scan | " &
// "gaussian | beam_events")
call ifile_append (ifile, "KEY none")
call ifile_append (ifile, "KEY lhapdf")
call ifile_append (ifile, "KEY lhapdf_photon")
call ifile_append (ifile, "KEY pdf_builtin")
call ifile_append (ifile, "KEY pdf_builtin_photon")
call ifile_append (ifile, "KEY isr")
call ifile_append (ifile, "KEY epa")
call ifile_append (ifile, "KEY ewa")
call ifile_append (ifile, "KEY circe1")
call ifile_append (ifile, "KEY circe2")
call ifile_append (ifile, "KEY energy_scan")
call ifile_append (ifile, "KEY gaussian")
call ifile_append (ifile, "KEY beam_events")
call ifile_append (ifile, "SEQ cmd_integrate = " &
// "integrate proc_arg options?")
call ifile_append (ifile, "KEY integrate")
call ifile_append (ifile, "ARG proc_arg = ( proc_id* )")
call ifile_append (ifile, "IDE proc_id")
call ifile_append (ifile, "SEQ cmd_iterations = " &
// "iterations '=' iterations_list")
call ifile_append (ifile, "KEY iterations")
call ifile_append (ifile, "LIS iterations_list = iterations_spec+")
call ifile_append (ifile, "ALT iterations_spec = it_spec")
call ifile_append (ifile, "SEQ it_spec = expr calls_spec adapt_spec?")
call ifile_append (ifile, "SEQ calls_spec = ':' expr")
call ifile_append (ifile, "SEQ adapt_spec = ':' sexpr")
call ifile_append (ifile, "SEQ cmd_components = " &
// "active '=' component_list")
call ifile_append (ifile, "KEY active")
call ifile_append (ifile, "LIS component_list = sexpr+")
call ifile_append (ifile, "SEQ cmd_sample_format = " &
// "sample_format '=' event_format_list")
call ifile_append (ifile, "KEY sample_format")
call ifile_append (ifile, "LIS event_format_list = event_format+")
call ifile_append (ifile, "IDE event_format")
call ifile_append (ifile, "SEQ cmd_observable = " &
// "observable analysis_tag options?")
call ifile_append (ifile, "KEY observable")
call ifile_append (ifile, "SEQ cmd_histogram = " &
// "histogram analysis_tag histogram_arg " &
// "options?")
call ifile_append (ifile, "KEY histogram")
call ifile_append (ifile, "ARG histogram_arg = (expr, expr, expr?)")
call ifile_append (ifile, "SEQ cmd_plot = plot analysis_tag options?")
call ifile_append (ifile, "KEY plot")
call ifile_append (ifile, "SEQ cmd_graph = graph graph_term '=' graph_def")
call ifile_append (ifile, "KEY graph")
call ifile_append (ifile, "SEQ graph_term = analysis_tag options?")
call ifile_append (ifile, "SEQ graph_def = graph_term graph_append*")
call ifile_append (ifile, "SEQ graph_append = '&' graph_term")
call ifile_append (ifile, "SEQ cmd_analysis = analysis '=' lexpr")
call ifile_append (ifile, "KEY analysis")
call ifile_append (ifile, "SEQ cmd_alt_setup = " &
// "alt_setup '=' option_list_expr")
call ifile_append (ifile, "KEY alt_setup")
call ifile_append (ifile, "ALT option_list_expr = " &
// "grouped_option_list | option_list")
call ifile_append (ifile, "GRO grouped_option_list = ( option_list_expr )")
call ifile_append (ifile, "LIS option_list = options+")
call ifile_append (ifile, "SEQ cmd_open_out = open_out open_arg options?")
call ifile_append (ifile, "SEQ cmd_close_out = close_out open_arg options?")
call ifile_append (ifile, "KEY open_out")
call ifile_append (ifile, "KEY close_out")
call ifile_append (ifile, "ARG open_arg = (sexpr)")
call ifile_append (ifile, "SEQ cmd_printf = printf_cmd options?")
call ifile_append (ifile, "SEQ printf_cmd = printf_clause sprintf_args?")
call ifile_append (ifile, "SEQ printf_clause = printf sexpr")
call ifile_append (ifile, "KEY printf")
call ifile_append (ifile, "SEQ cmd_record = record_cmd")
call ifile_append (ifile, "SEQ cmd_unstable = " &
// "unstable cexpr unstable_arg options?")
call ifile_append (ifile, "KEY unstable")
call ifile_append (ifile, "ARG unstable_arg = ( proc_id* )")
call ifile_append (ifile, "SEQ cmd_stable = stable stable_list options?")
call ifile_append (ifile, "KEY stable")
call ifile_append (ifile, "LIS stable_list = cexpr+")
call ifile_append (ifile, "KEY polarized")
call ifile_append (ifile, "SEQ cmd_polarized = polarized polarized_list options?")
call ifile_append (ifile, "LIS polarized_list = cexpr+")
call ifile_append (ifile, "KEY unpolarized")
call ifile_append (ifile, "SEQ cmd_unpolarized = unpolarized unpolarized_list options?")
call ifile_append (ifile, "LIS unpolarized_list = cexpr+")
call ifile_append (ifile, "SEQ cmd_simulate = " &
// "simulate proc_arg options?")
call ifile_append (ifile, "KEY simulate")
call ifile_append (ifile, "SEQ cmd_rescan = " &
// "rescan sexpr proc_arg options?")
call ifile_append (ifile, "KEY rescan")
call ifile_append (ifile, "SEQ cmd_scan = scan scan_var scan_body?")
call ifile_append (ifile, "KEY scan")
call ifile_append (ifile, "ALT scan_var = " &
// "scan_log_decl | scan_log | " &
// "scan_int | scan_real | scan_complex | scan_num | " &
// "scan_string_decl | scan_string | scan_alias | " &
// "scan_cuts | scan_weight | " &
// "scan_scale | scan_ren_scale | scan_fac_scale | " &
// "scan_selection | scan_reweight | scan_analysis | " &
// "scan_model | scan_library")
call ifile_append (ifile, "SEQ scan_log_decl = logical scan_log")
call ifile_append (ifile, "SEQ scan_log = '?' var_name '=' scan_log_arg")
call ifile_append (ifile, "ARG scan_log_arg = ( lexpr* )")
call ifile_append (ifile, "SEQ scan_int = int var_name '=' scan_num_arg")
call ifile_append (ifile, "SEQ scan_real = real var_name '=' scan_num_arg")
call ifile_append (ifile, "SEQ scan_complex = " &
// "complex var_name '=' scan_num_arg")
call ifile_append (ifile, "SEQ scan_num = var_name '=' scan_num_arg")
call ifile_append (ifile, "ARG scan_num_arg = ( range* )")
call ifile_append (ifile, "ALT range = grouped_range | range_expr")
call ifile_append (ifile, "GRO grouped_range = ( range_expr )")
call ifile_append (ifile, "SEQ range_expr = expr range_spec?")
call ifile_append (ifile, "SEQ range_spec = '=>' expr step_spec?")
call ifile_append (ifile, "SEQ step_spec = step_op expr")
call ifile_append (ifile, "ALT step_op = " &
// "'/+' | '/-' | '/*' | '//' | '/+/' | '/*/'")
call ifile_append (ifile, "KEY '/+'")
call ifile_append (ifile, "KEY '/-'")
call ifile_append (ifile, "KEY '/*'")
call ifile_append (ifile, "KEY '//'")
call ifile_append (ifile, "KEY '/+/'")
call ifile_append (ifile, "KEY '/*/'")
call ifile_append (ifile, "SEQ scan_string_decl = string scan_string")
call ifile_append (ifile, "SEQ scan_string = " &
// "'$' var_name '=' scan_string_arg")
call ifile_append (ifile, "ARG scan_string_arg = ( sexpr* )")
call ifile_append (ifile, "SEQ scan_alias = " &
// "alias var_name '=' scan_alias_arg")
call ifile_append (ifile, "ARG scan_alias_arg = ( cexpr* )")
call ifile_append (ifile, "SEQ scan_cuts = cuts '=' scan_lexpr_arg")
call ifile_append (ifile, "ARG scan_lexpr_arg = ( lexpr* )")
call ifile_append (ifile, "SEQ scan_scale = scale '=' scan_expr_arg")
call ifile_append (ifile, "ARG scan_expr_arg = ( expr* )")
call ifile_append (ifile, "SEQ scan_fac_scale = " &
// "factorization_scale '=' scan_expr_arg")
call ifile_append (ifile, "SEQ scan_ren_scale = " &
// "renormalization_scale '=' scan_expr_arg")
call ifile_append (ifile, "SEQ scan_weight = weight '=' scan_expr_arg")
call ifile_append (ifile, "SEQ scan_selection = selection '=' scan_lexpr_arg")
call ifile_append (ifile, "SEQ scan_reweight = reweight '=' scan_expr_arg")
call ifile_append (ifile, "SEQ scan_analysis = analysis '=' scan_lexpr_arg")
call ifile_append (ifile, "SEQ scan_model = model '=' scan_model_arg")
call ifile_append (ifile, "ARG scan_model_arg = ( model_name* )")
call ifile_append (ifile, "SEQ scan_library = library '=' scan_library_arg")
call ifile_append (ifile, "ARG scan_library_arg = ( lib_name* )")
call ifile_append (ifile, "GRO scan_body = '{' command_list '}'")
call ifile_append (ifile, "SEQ cmd_if = " &
// "if lexpr then command_list elsif_clauses else_clause endif")
call ifile_append (ifile, "SEQ elsif_clauses = cmd_elsif*")
call ifile_append (ifile, "SEQ cmd_elsif = elsif lexpr then command_list")
call ifile_append (ifile, "SEQ else_clause = cmd_else?")
call ifile_append (ifile, "SEQ cmd_else = else command_list")
call ifile_append (ifile, "SEQ cmd_include = include include_arg")
call ifile_append (ifile, "KEY include")
call ifile_append (ifile, "ARG include_arg = ( string_literal )")
call ifile_append (ifile, "SEQ cmd_quit = quit_cmd quit_arg?")
call ifile_append (ifile, "ALT quit_cmd = quit | exit")
call ifile_append (ifile, "KEY quit")
call ifile_append (ifile, "KEY exit")
call ifile_append (ifile, "ARG quit_arg = ( expr )")
+ call ifile_append (ifile, "SEQ cmd_export = export show_arg options?")
+ call ifile_append (ifile, "KEY export")
call ifile_append (ifile, "SEQ cmd_write_analysis = " &
// "write_analysis_clause options?")
call ifile_append (ifile, "SEQ cmd_compile_analysis = " &
// "compile_analysis_clause options?")
call ifile_append (ifile, "SEQ write_analysis_clause = " &
// "write_analysis write_analysis_arg?")
call ifile_append (ifile, "SEQ compile_analysis_clause = " &
// "compile_analysis write_analysis_arg?")
call ifile_append (ifile, "KEY write_analysis")
call ifile_append (ifile, "KEY compile_analysis")
call ifile_append (ifile, "ARG write_analysis_arg = ( analysis_tag* )")
call ifile_append (ifile, "SEQ cmd_nlo = " &
// "nlo_calculation '=' nlo_calculation_list")
call ifile_append (ifile, "KEY nlo_calculation")
call ifile_append (ifile, "LIS nlo_calculation_list = nlo_comp+")
call ifile_append (ifile, "ALT nlo_comp = " // &
"full | born | real | virtual | dglap | subtraction | " // &
"mismatch | GKS")
call ifile_append (ifile, "KEY full")
call ifile_append (ifile, "KEY born")
call ifile_append (ifile, "KEY virtual")
call ifile_append (ifile, "KEY dglap")
call ifile_append (ifile, "KEY subtraction")
call ifile_append (ifile, "KEY mismatch")
call ifile_append (ifile, "KEY GKS")
call define_expr_syntax (ifile, particles=.true., analysis=.true.)
end subroutine define_cmd_list_syntax
@ %def define_cmd_list_syntax
<<Commands: public>>=
public :: lexer_init_cmd_list
<<Commands: procedures>>=
subroutine lexer_init_cmd_list (lexer, parent_lexer)
type(lexer_t), intent(out) :: lexer
type(lexer_t), intent(in), optional, target :: parent_lexer
call lexer_init (lexer, &
comment_chars = "#!", &
quote_chars = '"', &
quote_match = '"', &
single_chars = "()[]{},;:&%?$@", &
special_class = [ "+-*/^", "<>=~ " ] , &
keyword_list = syntax_get_keyword_list_ptr (syntax_cmd_list), &
parent = parent_lexer)
end subroutine lexer_init_cmd_list
@ %def lexer_init_cmd_list
@
\subsection{Unit Tests}
Test module, followed by the corresponding implementation module.
<<[[commands_ut.f90]]>>=
<<File header>>
module commands_ut
use unit_tests
use commands_uti
<<Standard module head>>
<<Commands: public test>>
contains
<<Commands: test driver>>
end module commands_ut
@ %def commands_ut
@
<<[[commands_uti.f90]]>>=
<<File header>>
module commands_uti
<<Use kinds>>
use kinds, only: i64
<<Use strings>>
use io_units
use ifiles
use parser
use interactions, only: reset_interaction_counter
use prclib_stacks
use analysis
use variables, only: var_list_t
use models
use slha_interface
use rt_data
use event_base, only: generic_event_t, event_callback_t
use commands
<<Standard module head>>
<<Commands: test declarations>>
<<Commands: test auxiliary types>>
contains
<<Commands: tests>>
<<Commands: test auxiliary>>
end module commands_uti
@ %def commands_uti
@ API: driver for the unit tests below.
<<Commands: public test>>=
public :: commands_test
<<Commands: test driver>>=
subroutine commands_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Commands: execute tests>>
end subroutine commands_test
@ %def commands_test
@
\subsubsection{Prepare Sindarin code}
This routine parses an internal file, prints the parse tree, and
returns a parse node to the root. We use the routine in the tests
below.
<<Commands: public test auxiliary>>=
public :: parse_ifile
<<Commands: test auxiliary>>=
subroutine parse_ifile (ifile, pn_root, u)
use ifiles
use lexers
use parser
use commands
type(ifile_t), intent(in) :: ifile
type(parse_node_t), pointer, intent(out) :: pn_root
integer, intent(in), optional :: u
type(stream_t), target :: stream
type(lexer_t), target :: lexer
type(parse_tree_t) :: parse_tree
call lexer_init_cmd_list (lexer)
call stream_init (stream, ifile)
call lexer_assign_stream (lexer, stream)
call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
if (present (u)) call parse_tree_write (parse_tree, u)
pn_root => parse_tree%get_root_ptr ()
call stream_final (stream)
call lexer_final (lexer)
end subroutine parse_ifile
@ %def parse_ifile
@
\subsubsection{Empty command list}
Compile and execute an empty command list. Should do nothing but
test the integrity of the workflow.
<<Commands: execute tests>>=
call test (commands_1, "commands_1", &
"empty command list", &
u, results)
<<Commands: test declarations>>=
public :: commands_1
<<Commands: tests>>=
subroutine commands_1 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_1"
write (u, "(A)") "* Purpose: compile and execute empty command list"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Parse empty file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
if (associated (pn_root)) then
call command_list%compile (pn_root, global)
end if
write (u, "(A)")
write (u, "(A)") "* Execute command list"
call global%activate ()
call command_list%execute (global)
call global%deactivate ()
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call syntax_cmd_list_final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_1"
end subroutine commands_1
@ %def commands_1
@
\subsubsection{Read model}
Execute a [[model]] assignment.
<<Commands: execute tests>>=
call test (commands_2, "commands_2", &
"model", &
u, results)
<<Commands: test declarations>>=
public :: commands_2
<<Commands: tests>>=
subroutine commands_2 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_2"
write (u, "(A)") "* Purpose: set model"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_write (ifile, u)
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_2"
end subroutine commands_2
@ %def commands_2
@
\subsubsection{Declare Process}
Read a model, then declare a process. The process library is allocated
explicitly. For the process definition, We take the default ([[omega]])
method. Since we do not compile, \oMega\ is not actually called.
<<Commands: execute tests>>=
call test (commands_3, "commands_3", &
"process declaration", &
u, results)
<<Commands: test declarations>>=
public :: commands_3
<<Commands: tests>>=
subroutine commands_3 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: commands_3"
write (u, "(A)") "* Purpose: define process"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%var_list%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
allocate (lib)
call lib%init (var_str ("lib_cmd3"))
call global%add_prclib (lib)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process t3 = s, s => s, s')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%prclib_stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_3"
end subroutine commands_3
@ %def commands_3
@
\subsubsection{Compile Process}
Read a model, then declare a process and compile the library. The process
library is allocated explicitly. For the process definition, We take the
default ([[unit_test]]) method. There is no external code, so compilation of
the library is merely a formal status change.
<<Commands: execute tests>>=
call test (commands_4, "commands_4", &
"compilation", &
u, results)
<<Commands: test declarations>>=
public :: commands_4
<<Commands: tests>>=
subroutine commands_4 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: commands_4"
write (u, "(A)") "* Purpose: define process and compile library"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
allocate (lib)
call lib%init (var_str ("lib_cmd4"))
call global%add_prclib (lib)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process t4 = s, s => s, s')
call ifile_append (ifile, 'compile ("lib_cmd4")')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%prclib_stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_4"
end subroutine commands_4
@ %def commands_4
@
\subsubsection{Integrate Process}
Read a model, then declare a process, compile the library, and
integrate over phase space. We take the
default ([[unit_test]]) method and use the simplest methods of
phase-space parameterization and integration.
<<Commands: execute tests>>=
call test (commands_5, "commands_5", &
"integration", &
u, results)
<<Commands: test declarations>>=
public :: commands_5
<<Commands: tests>>=
subroutine commands_5 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: commands_5"
write (u, "(A)") "* Purpose: define process, iterations, and integrate"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
call global%var_list%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known=.true.)
call global%var_list%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known=.true.)
call global%var_list%set_log (var_str ("?vis_history"),&
.false., is_known=.true.)
call global%var_list%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%var_list%set_real (var_str ("sqrts"), &
1000._default, is_known=.true.)
call global%var_list%set_int (var_str ("seed"), 0, is_known=.true.)
allocate (lib)
call lib%init (var_str ("lib_cmd5"))
call global%add_prclib (lib)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process t5 = s, s => s, s')
call ifile_append (ifile, 'compile')
call ifile_append (ifile, 'iterations = 1:1000')
call ifile_append (ifile, 'integrate (t5)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call reset_interaction_counter ()
call command_list%execute (global)
call global%it_list%write (u)
write (u, "(A)")
call global%process_stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_5"
end subroutine commands_5
@ %def commands_5
@
\subsubsection{Variables}
Set intrinsic and user-defined variables.
<<Commands: execute tests>>=
call test (commands_6, "commands_6", &
"variables", &
u, results)
<<Commands: test declarations>>=
public :: commands_6
<<Commands: tests>>=
subroutine commands_6 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_6"
write (u, "(A)") "* Purpose: define and set variables"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
call global%write_vars (u, [ &
var_str ("$run_id"), &
var_str ("?unweighted"), &
var_str ("sqrts")])
write (u, "(A)")
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, '$run_id = "run1"')
call ifile_append (ifile, '?unweighted = false')
call ifile_append (ifile, 'sqrts = 1000')
call ifile_append (ifile, 'int j = 10')
call ifile_append (ifile, 'real x = 1000.')
call ifile_append (ifile, 'complex z = 5')
call ifile_append (ifile, 'string $text = "abcd"')
call ifile_append (ifile, 'logical ?flag = true')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_vars (u, [ &
var_str ("$run_id"), &
var_str ("?unweighted"), &
var_str ("sqrts"), &
var_str ("j"), &
var_str ("x"), &
var_str ("z"), &
var_str ("$text"), &
var_str ("?flag")])
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call syntax_cmd_list_final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_6"
end subroutine commands_6
@ %def commands_6
@
\subsubsection{Process library}
Open process libraries explicitly.
<<Commands: execute tests>>=
call test (commands_7, "commands_7", &
"process library", &
u, results)
<<Commands: test declarations>>=
public :: commands_7
<<Commands: tests>>=
subroutine commands_7 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_7"
write (u, "(A)") "* Purpose: declare process libraries"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
call global%var_list%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
global%os_data%fc = "Fortran-compiler"
global%os_data%fcflags = "Fortran-flags"
write (u, "(A)")
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'library = "lib_cmd7_1"')
call ifile_append (ifile, 'library = "lib_cmd7_2"')
call ifile_append (ifile, 'library = "lib_cmd7_1"')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_libraries (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call syntax_cmd_list_final ()
call global%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_7"
end subroutine commands_7
@ %def commands_7
@
\subsubsection{Generate events}
Read a model, then declare a process, compile the library, and
generate weighted events. We take the
default ([[unit_test]]) method and use the simplest methods of
phase-space parameterization and integration.
<<Commands: execute tests>>=
call test (commands_8, "commands_8", &
"event generation", &
u, results)
<<Commands: test declarations>>=
public :: commands_8
<<Commands: tests>>=
subroutine commands_8 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: commands_8"
write (u, "(A)") "* Purpose: define process, integrate, generate events"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
call global%var_list%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known=.true.)
call global%var_list%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known=.true.)
call global%var_list%set_log (var_str ("?vis_history"),&
.false., is_known=.true.)
call global%var_list%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%var_list%set_real (var_str ("sqrts"), &
1000._default, is_known=.true.)
allocate (lib)
call lib%init (var_str ("lib_cmd8"))
call global%add_prclib (lib)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process commands_8_p = s, s => s, s')
call ifile_append (ifile, 'compile')
call ifile_append (ifile, 'iterations = 1:1000')
call ifile_append (ifile, 'integrate (commands_8_p)')
call ifile_append (ifile, '?unweighted = false')
call ifile_append (ifile, 'n_events = 3')
call ifile_append (ifile, '?read_raw = false')
call ifile_append (ifile, 'simulate (commands_8_p)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
call command_list%execute (global)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_8"
end subroutine commands_8
@ %def commands_8
@
\subsubsection{Define cuts}
Declare a cut expression.
<<Commands: execute tests>>=
call test (commands_9, "commands_9", &
"cuts", &
u, results)
<<Commands: test declarations>>=
public :: commands_9
<<Commands: tests>>=
subroutine commands_9 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(string_t), dimension(0) :: no_vars
write (u, "(A)") "* Test output: commands_9"
write (u, "(A)") "* Purpose: define cuts"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'cuts = all Pt > 0 [particle]')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write (u, vars = no_vars)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_9"
end subroutine commands_9
@ %def commands_9
@
\subsubsection{Beams}
Define beam setup.
<<Commands: execute tests>>=
call test (commands_10, "commands_10", &
"beams", &
u, results)
<<Commands: test declarations>>=
public :: commands_10
<<Commands: tests>>=
subroutine commands_10 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_10"
write (u, "(A)") "* Purpose: define beams"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = QCD')
call ifile_append (ifile, 'sqrts = 1000')
call ifile_append (ifile, 'beams = p, p')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_beams (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_10"
end subroutine commands_10
@ %def commands_10
@
\subsubsection{Structure functions}
Define beam setup with structure functions
<<Commands: execute tests>>=
call test (commands_11, "commands_11", &
"structure functions", &
u, results)
<<Commands: test declarations>>=
public :: commands_11
<<Commands: tests>>=
subroutine commands_11 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_11"
write (u, "(A)") "* Purpose: define beams with structure functions"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = QCD')
call ifile_append (ifile, 'sqrts = 1100')
call ifile_append (ifile, 'beams = p, p => lhapdf => pdf_builtin, isr')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_beams (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_11"
end subroutine commands_11
@ %def commands_11
@
\subsubsection{Rescan events}
Read a model, then declare a process, compile the library, and
generate weighted events. We take the
default ([[unit_test]]) method and use the simplest methods of
phase-space parameterization and integration. Then, rescan the
generated event sample.
<<Commands: execute tests>>=
call test (commands_12, "commands_12", &
"event rescanning", &
u, results)
<<Commands: test declarations>>=
public :: commands_12
<<Commands: tests>>=
subroutine commands_12 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: commands_12"
write (u, "(A)") "* Purpose: generate events and rescan"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%var_list%append_log (&
var_str ("?rebuild_phase_space"), .false., &
intrinsic=.true.)
call global%var_list%append_log (&
var_str ("?rebuild_grids"), .false., &
intrinsic=.true.)
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
call global%var_list%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known=.true.)
call global%var_list%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known=.true.)
call global%var_list%set_log (var_str ("?vis_history"),&
.false., is_known=.true.)
call global%var_list%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%var_list%set_real (var_str ("sqrts"), &
1000._default, is_known=.true.)
allocate (lib)
call lib%init (var_str ("lib_cmd12"))
call global%add_prclib (lib)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process commands_12_p = s, s => s, s')
call ifile_append (ifile, 'compile')
call ifile_append (ifile, 'iterations = 1:1000')
call ifile_append (ifile, 'integrate (commands_12_p)')
call ifile_append (ifile, '?unweighted = false')
call ifile_append (ifile, 'n_events = 3')
call ifile_append (ifile, '?read_raw = false')
call ifile_append (ifile, 'simulate (commands_12_p)')
call ifile_append (ifile, '?write_raw = false')
call ifile_append (ifile, 'rescan "commands_12_p" (commands_12_p)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
call command_list%execute (global)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_12"
end subroutine commands_12
@ %def commands_12
@
\subsubsection{Event Files}
Set output formats for event files.
<<Commands: execute tests>>=
call test (commands_13, "commands_13", &
"event output formats", &
u, results)
<<Commands: test declarations>>=
public :: commands_13
<<Commands: tests>>=
subroutine commands_13 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
logical :: exist
write (u, "(A)") "* Test output: commands_13"
write (u, "(A)") "* Purpose: generate events and rescan"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
call global%var_list%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known=.true.)
call global%var_list%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known=.true.)
call global%var_list%set_real (var_str ("sqrts"), &
1000._default, is_known=.true.)
call global%var_list%set_log (var_str ("?vis_history"),&
.false., is_known=.true.)
call global%var_list%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
allocate (lib)
call lib%init (var_str ("lib_cmd13"))
call global%add_prclib (lib)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process commands_13_p = s, s => s, s')
call ifile_append (ifile, 'compile')
call ifile_append (ifile, 'iterations = 1:1000')
call ifile_append (ifile, 'integrate (commands_13_p)')
call ifile_append (ifile, '?unweighted = false')
call ifile_append (ifile, 'n_events = 1')
call ifile_append (ifile, '?read_raw = false')
call ifile_append (ifile, 'sample_format = weight_stream')
call ifile_append (ifile, 'simulate (commands_13_p)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
call command_list%execute (global)
write (u, "(A)")
write (u, "(A)") "* Verify output files"
write (u, "(A)")
inquire (file = "commands_13_p.evx", exist = exist)
if (exist) write (u, "(1x,A)") "raw"
inquire (file = "commands_13_p.weights.dat", exist = exist)
if (exist) write (u, "(1x,A)") "weight_stream"
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_13"
end subroutine commands_13
@ %def commands_13
@
\subsubsection{Compile Empty Libraries}
(This is a regression test:) Declare two empty libraries and compile them.
<<Commands: execute tests>>=
call test (commands_14, "commands_14", &
"empty libraries", &
u, results)
<<Commands: test declarations>>=
public :: commands_14
<<Commands: tests>>=
subroutine commands_14 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_14"
write (u, "(A)") "* Purpose: define and compile empty libraries"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'library = "lib1"')
call ifile_append (ifile, 'library = "lib2"')
call ifile_append (ifile, 'compile ()')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%prclib_stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_14"
end subroutine commands_14
@ %def commands_14
@
\subsubsection{Compile Process}
Read a model, then declare a process and compile the library. The process
library is allocated explicitly. For the process definition, We take the
default ([[unit_test]]) method. There is no external code, so compilation of
the library is merely a formal status change.
<<Commands: execute tests>>=
call test (commands_15, "commands_15", &
"compilation", &
u, results)
<<Commands: test declarations>>=
public :: commands_15
<<Commands: tests>>=
subroutine commands_15 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: commands_15"
write (u, "(A)") "* Purpose: define process and compile library"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
call global%var_list%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known=.true.)
call global%var_list%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known=.true.)
call global%var_list%set_real (var_str ("sqrts"), &
1000._default, is_known=.true.)
call global%var_list%set_log (var_str ("?vis_history"),&
.false., is_known=.true.)
call global%var_list%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
allocate (lib)
call lib%init (var_str ("lib_cmd15"))
call global%add_prclib (lib)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process t15 = s, s => s, s')
call ifile_append (ifile, 'iterations = 1:1000')
call ifile_append (ifile, 'integrate (t15)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%prclib_stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_15"
end subroutine commands_15
@ %def commands_15
@
\subsubsection{Observable}
Declare an observable, fill it and display.
<<Commands: execute tests>>=
call test (commands_16, "commands_16", &
"observables", &
u, results)
<<Commands: test declarations>>=
public :: commands_16
<<Commands: tests>>=
subroutine commands_16 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_16"
write (u, "(A)") "* Purpose: declare an observable"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, '$obs_label = "foo"')
call ifile_append (ifile, '$obs_unit = "cm"')
call ifile_append (ifile, '$title = "Observable foo"')
call ifile_append (ifile, '$description = "This is observable foo"')
call ifile_append (ifile, 'observable foo')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Record two data items"
write (u, "(A)")
call analysis_record_data (var_str ("foo"), 1._default)
call analysis_record_data (var_str ("foo"), 3._default)
write (u, "(A)") "* Display analysis store"
write (u, "(A)")
call analysis_write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_16"
end subroutine commands_16
@ %def commands_16
@
\subsubsection{Histogram}
Declare a histogram, fill it and display.
<<Commands: execute tests>>=
call test (commands_17, "commands_17", &
"histograms", &
u, results)
<<Commands: test declarations>>=
public :: commands_17
<<Commands: tests>>=
subroutine commands_17 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(string_t), dimension(3) :: name
integer :: i
write (u, "(A)") "* Test output: commands_17"
write (u, "(A)") "* Purpose: declare histograms"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, '$obs_label = "foo"')
call ifile_append (ifile, '$obs_unit = "cm"')
call ifile_append (ifile, '$title = "Histogram foo"')
call ifile_append (ifile, '$description = "This is histogram foo"')
call ifile_append (ifile, 'histogram foo (0,5,1)')
call ifile_append (ifile, '$title = "Histogram bar"')
call ifile_append (ifile, '$description = "This is histogram bar"')
call ifile_append (ifile, 'n_bins = 2')
call ifile_append (ifile, 'histogram bar (0,5)')
call ifile_append (ifile, '$title = "Histogram gee"')
call ifile_append (ifile, '$description = "This is histogram gee"')
call ifile_append (ifile, '?normalize_bins = true')
call ifile_append (ifile, 'histogram gee (0,5)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Record two data items"
write (u, "(A)")
name(1) = "foo"
name(2) = "bar"
name(3) = "gee"
do i = 1, 3
call analysis_record_data (name(i), 0.1_default, &
weight = 0.25_default)
call analysis_record_data (name(i), 3.1_default)
call analysis_record_data (name(i), 4.1_default, &
excess = 0.5_default)
call analysis_record_data (name(i), 7.1_default)
end do
write (u, "(A)") "* Display analysis store"
write (u, "(A)")
call analysis_write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_17"
end subroutine commands_17
@ %def commands_17
@
\subsubsection{Plot}
Declare a plot, fill it and display contents.
<<Commands: execute tests>>=
call test (commands_18, "commands_18", &
"plots", &
u, results)
<<Commands: test declarations>>=
public :: commands_18
<<Commands: tests>>=
subroutine commands_18 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_18"
write (u, "(A)") "* Purpose: declare a plot"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, '$obs_label = "foo"')
call ifile_append (ifile, '$obs_unit = "cm"')
call ifile_append (ifile, '$title = "Plot foo"')
call ifile_append (ifile, '$description = "This is plot foo"')
call ifile_append (ifile, '$x_label = "x axis"')
call ifile_append (ifile, '$y_label = "y axis"')
call ifile_append (ifile, '?x_log = false')
call ifile_append (ifile, '?y_log = true')
call ifile_append (ifile, 'x_min = -1')
call ifile_append (ifile, 'x_max = 1')
call ifile_append (ifile, 'y_min = 0.1')
call ifile_append (ifile, 'y_max = 1000')
call ifile_append (ifile, 'plot foo')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Record two data items"
write (u, "(A)")
call analysis_record_data (var_str ("foo"), 0._default, 20._default, &
xerr = 0.25_default)
call analysis_record_data (var_str ("foo"), 0.5_default, 0.2_default, &
yerr = 0.07_default)
call analysis_record_data (var_str ("foo"), 3._default, 2._default)
write (u, "(A)") "* Display analysis store"
write (u, "(A)")
call analysis_write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_18"
end subroutine commands_18
@ %def commands_18
@
\subsubsection{Graph}
Combine two (empty) plots to a graph.
<<Commands: execute tests>>=
call test (commands_19, "commands_19", &
"graphs", &
u, results)
<<Commands: test declarations>>=
public :: commands_19
<<Commands: tests>>=
subroutine commands_19 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_19"
write (u, "(A)") "* Purpose: combine two plots to a graph"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'plot a')
call ifile_append (ifile, 'plot b')
call ifile_append (ifile, '$title = "Graph foo"')
call ifile_append (ifile, '$description = "This is graph foo"')
call ifile_append (ifile, 'graph foo = a & b')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Display analysis object"
write (u, "(A)")
call analysis_write (var_str ("foo"), u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_19"
end subroutine commands_19
@ %def commands_19
@
\subsubsection{Record Data}
Record data in previously allocated analysis objects.
<<Commands: execute tests>>=
call test (commands_20, "commands_20", &
"record data", &
u, results)
<<Commands: test declarations>>=
public :: commands_20
<<Commands: tests>>=
subroutine commands_20 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_20"
write (u, "(A)") "* Purpose: record data"
write (u, "(A)")
write (u, "(A)") "* Initialization: create observable, histogram, plot"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
call analysis_init_observable (var_str ("o"))
call analysis_init_histogram (var_str ("h"), 0._default, 1._default, 3, &
normalize_bins = .false.)
call analysis_init_plot (var_str ("p"))
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'record o (1.234)')
call ifile_append (ifile, 'record h (0.5)')
call ifile_append (ifile, 'record p (1, 2)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Display analysis object"
write (u, "(A)")
call analysis_write (u, verbose = .true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_20"
end subroutine commands_20
@ %def commands_20
@
\subsubsection{Analysis}
Declare an analysis expression and use it to fill an observable during
event generation.
<<Commands: execute tests>>=
call test (commands_21, "commands_21", &
"analysis expression", &
u, results)
<<Commands: test declarations>>=
public :: commands_21
<<Commands: tests>>=
subroutine commands_21 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: commands_21"
write (u, "(A)") "* Purpose: create and use analysis expression"
write (u, "(A)")
write (u, "(A)") "* Initialization: create observable"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
call global%var_list%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known=.true.)
call global%var_list%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known=.true.)
call global%var_list%set_log (var_str ("?vis_history"),&
.false., is_known=.true.)
call global%var_list%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%var_list%set_real (var_str ("sqrts"), &
1000._default, is_known=.true.)
allocate (lib)
call lib%init (var_str ("lib_cmd8"))
call global%add_prclib (lib)
call analysis_init_observable (var_str ("m"))
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process commands_21_p = s, s => s, s')
call ifile_append (ifile, 'compile')
call ifile_append (ifile, 'iterations = 1:100')
call ifile_append (ifile, 'integrate (commands_21_p)')
call ifile_append (ifile, '?unweighted = true')
call ifile_append (ifile, 'n_events = 3')
call ifile_append (ifile, '?read_raw = false')
call ifile_append (ifile, 'observable m')
call ifile_append (ifile, 'analysis = record m (eval M [s])')
call ifile_append (ifile, 'simulate (commands_21_p)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Display analysis object"
write (u, "(A)")
call analysis_write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_21"
end subroutine commands_21
@ %def commands_21
@
\subsubsection{Write Analysis}
Write accumulated analysis data to file.
<<Commands: execute tests>>=
call test (commands_22, "commands_22", &
"write analysis", &
u, results)
<<Commands: test declarations>>=
public :: commands_22
<<Commands: tests>>=
subroutine commands_22 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
integer :: u_file, iostat
logical :: exist
character(80) :: buffer
write (u, "(A)") "* Test output: commands_22"
write (u, "(A)") "* Purpose: write analysis data"
write (u, "(A)")
write (u, "(A)") "* Initialization: create observable"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
call analysis_init_observable (var_str ("m"))
call analysis_record_data (var_str ("m"), 125._default)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, '$out_file = "commands_22.dat"')
call ifile_append (ifile, 'write_analysis')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Display analysis data"
write (u, "(A)")
inquire (file = "commands_22.dat", exist = exist)
if (.not. exist) then
write (u, "(A)") "ERROR: File commands_22.dat not found"
return
end if
u_file = free_unit ()
open (u_file, file = "commands_22.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 ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_22"
end subroutine commands_22
@ %def commands_22
@
\subsubsection{Compile Analysis}
Write accumulated analysis data to file and compile.
<<Commands: execute tests>>=
call test (commands_23, "commands_23", &
"compile analysis", &
u, results)
<<Commands: test declarations>>=
public :: commands_23
<<Commands: tests>>=
subroutine commands_23 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
integer :: u_file, iostat
character(256) :: buffer
logical :: exist
type(graph_options_t) :: graph_options
write (u, "(A)") "* Test output: commands_23"
write (u, "(A)") "* Purpose: write and compile analysis data"
write (u, "(A)")
write (u, "(A)") "* Initialization: create and fill histogram"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
call graph_options_init (graph_options)
call graph_options_set (graph_options, &
title = var_str ("Histogram for test: commands 23"), &
description = var_str ("This is a test."), &
width_mm = 125, height_mm = 85)
call analysis_init_histogram (var_str ("h"), &
0._default, 10._default, 2._default, .false., &
graph_options = graph_options)
call analysis_record_data (var_str ("h"), 1._default)
call analysis_record_data (var_str ("h"), 1._default)
call analysis_record_data (var_str ("h"), 1._default)
call analysis_record_data (var_str ("h"), 1._default)
call analysis_record_data (var_str ("h"), 3._default)
call analysis_record_data (var_str ("h"), 3._default)
call analysis_record_data (var_str ("h"), 3._default)
call analysis_record_data (var_str ("h"), 5._default)
call analysis_record_data (var_str ("h"), 7._default)
call analysis_record_data (var_str ("h"), 7._default)
call analysis_record_data (var_str ("h"), 7._default)
call analysis_record_data (var_str ("h"), 7._default)
call analysis_record_data (var_str ("h"), 9._default)
call analysis_record_data (var_str ("h"), 9._default)
call analysis_record_data (var_str ("h"), 9._default)
call analysis_record_data (var_str ("h"), 9._default)
call analysis_record_data (var_str ("h"), 9._default)
call analysis_record_data (var_str ("h"), 9._default)
call analysis_record_data (var_str ("h"), 9._default)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, '$out_file = "commands_23.dat"')
call ifile_append (ifile, 'compile_analysis')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Delete Postscript output"
write (u, "(A)")
inquire (file = "commands_23.ps", exist = exist)
if (exist) then
u_file = free_unit ()
open (u_file, file = "commands_23.ps", action = "write", status = "old")
close (u_file, status = "delete")
end if
inquire (file = "commands_23.ps", exist = exist)
write (u, "(1x,A,L1)") "Postcript output exists = ", exist
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* TeX file"
write (u, "(A)")
inquire (file = "commands_23.tex", exist = exist)
if (.not. exist) then
write (u, "(A)") "ERROR: File commands_23.tex not found"
return
end if
u_file = free_unit ()
open (u_file, file = "commands_23.tex", &
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, *)
inquire (file = "commands_23.ps", exist = exist)
write (u, "(1x,A,L1)") "Postcript output exists = ", exist
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_23"
end subroutine commands_23
@ %def commands_23
@
\subsubsection{Histogram}
Declare a histogram, fill it and display.
<<Commands: execute tests>>=
call test (commands_24, "commands_24", &
"drawing options", &
u, results)
<<Commands: test declarations>>=
public :: commands_24
<<Commands: tests>>=
subroutine commands_24 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_24"
write (u, "(A)") "* Purpose: check graph and drawing options"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, '$title = "Title"')
call ifile_append (ifile, '$description = "Description"')
call ifile_append (ifile, '$x_label = "X Label"')
call ifile_append (ifile, '$y_label = "Y Label"')
call ifile_append (ifile, 'graph_width_mm = 111')
call ifile_append (ifile, 'graph_height_mm = 222')
call ifile_append (ifile, 'x_min = -11')
call ifile_append (ifile, 'x_max = 22')
call ifile_append (ifile, 'y_min = -33')
call ifile_append (ifile, 'y_max = 44')
call ifile_append (ifile, '$gmlcode_bg = "GML Code BG"')
call ifile_append (ifile, '$gmlcode_fg = "GML Code FG"')
call ifile_append (ifile, '$fill_options = "Fill Options"')
call ifile_append (ifile, '$draw_options = "Draw Options"')
call ifile_append (ifile, '$err_options = "Error Options"')
call ifile_append (ifile, '$symbol = "Symbol"')
call ifile_append (ifile, 'histogram foo (0,1)')
call ifile_append (ifile, 'plot bar')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Display analysis store"
write (u, "(A)")
call analysis_write (u, verbose=.true.)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_24"
end subroutine commands_24
@ %def commands_24
@
\subsubsection{Local Environment}
Declare a local environment.
<<Commands: execute tests>>=
call test (commands_25, "commands_25", &
"local process environment", &
u, results)
<<Commands: test declarations>>=
public :: commands_25
<<Commands: tests>>=
subroutine commands_25 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_25"
write (u, "(A)") "* Purpose: declare local environment for process"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_cmd_list_init ()
call global%global_init ()
call global%var_list%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'library = "commands_25_lib"')
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process commands_25_p1 = g, g => g, g &
&{ model = "QCD" }')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_libraries (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_25"
end subroutine commands_25
@ %def commands_25
@
\subsubsection{Alternative Setups}
Declare a list of alternative setups.
<<Commands: execute tests>>=
call test (commands_26, "commands_26", &
"alternative setups", &
u, results)
<<Commands: test declarations>>=
public :: commands_26
<<Commands: tests>>=
subroutine commands_26 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_26"
write (u, "(A)") "* Purpose: declare alternative setups for simulation"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'int i = 0')
call ifile_append (ifile, 'alt_setup = ({ i = 1 }, { i = 2 })')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_expr (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_26"
end subroutine commands_26
@ %def commands_26
@
\subsubsection{Unstable Particle}
Define decay processes and declare a particle as unstable. Also check
the commands stable, polarized, unpolarized.
<<Commands: execute tests>>=
call test (commands_27, "commands_27", &
"unstable and polarized particles", &
u, results)
<<Commands: test declarations>>=
public :: commands_27
<<Commands: tests>>=
subroutine commands_27 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: commands_27"
write (u, "(A)") "* Purpose: modify particle properties"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
call global%var_list%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known=.true.)
call global%var_list%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known=.true.)
call global%var_list%set_log (var_str ("?vis_history"),&
.false., is_known=.true.)
call global%var_list%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
allocate (lib)
call lib%init (var_str ("commands_27_lib"))
call global%add_prclib (lib)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'ff = 0.4')
call ifile_append (ifile, 'process d1 = s => f, fbar')
call ifile_append (ifile, 'unstable s (d1)')
call ifile_append (ifile, 'polarized f, fbar')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Show model"
write (u, "(A)")
call global%model%write (u)
write (u, "(A)")
write (u, "(A)") "* Extra Input"
write (u, "(A)")
call ifile_final (ifile)
call ifile_append (ifile, '?diagonal_decay = true')
call ifile_append (ifile, 'unstable s (d1)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%final ()
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Show model"
write (u, "(A)")
call global%model%write (u)
write (u, "(A)")
write (u, "(A)") "* Extra Input"
write (u, "(A)")
call ifile_final (ifile)
call ifile_append (ifile, '?isotropic_decay = true')
call ifile_append (ifile, 'unstable s (d1)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%final ()
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Show model"
write (u, "(A)")
call global%model%write (u)
write (u, "(A)")
write (u, "(A)") "* Extra Input"
write (u, "(A)")
call ifile_final (ifile)
call ifile_append (ifile, 'stable s')
call ifile_append (ifile, 'unpolarized f')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%final ()
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Show model"
write (u, "(A)")
call global%model%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_model_file_init ()
call syntax_cmd_list_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_27"
end subroutine commands_27
@ %def commands_27
@
\subsubsection{Quit the program}
Quit the program.
<<Commands: execute tests>>=
call test (commands_28, "commands_28", &
"quit", &
u, results)
<<Commands: test declarations>>=
public :: commands_28
<<Commands: tests>>=
subroutine commands_28 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root1, pn_root2
type(string_t), dimension(0) :: no_vars
write (u, "(A)") "* Test output: commands_28"
write (u, "(A)") "* Purpose: quit the program"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file: quit without code"
write (u, "(A)")
call ifile_append (ifile, 'quit')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root1, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root1, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write (u, vars = no_vars)
write (u, "(A)")
write (u, "(A)") "* Input file: quit with code"
write (u, "(A)")
call ifile_final (ifile)
call command_list%final ()
call ifile_append (ifile, 'quit ( 3 + 4 )')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root2, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root2, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write (u, vars = no_vars)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_28"
end subroutine commands_28
@ %def commands_28
@
\subsubsection{SLHA interface}
Testing commands steering the SLHA interface.
<<Commands: execute tests>>=
call test (commands_29, "commands_29", &
"SLHA interface", &
u, results)
<<Commands: test declarations>>=
public :: commands_29
<<Commands: tests>>=
subroutine commands_29 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(var_list_t), pointer :: model_vars
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_29"
write (u, "(A)") "* Purpose: test SLHA interface"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call syntax_model_file_init ()
call syntax_slha_init ()
call global%global_init ()
write (u, "(A)") "* Model MSSM, read SLHA file"
write (u, "(A)")
call ifile_append (ifile, 'model = "MSSM"')
call ifile_append (ifile, '?slha_read_decays = true')
call ifile_append (ifile, 'read_slha ("sps1ap_decays.slha")')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Model MSSM, default values:"
write (u, "(A)")
call global%model%write (u, verbose = .false., &
show_vertices = .false., show_particles = .false.)
write (u, "(A)")
write (u, "(A)") "* Selected global variables"
write (u, "(A)")
model_vars => global%model%get_var_list_ptr ()
call model_vars%write_var (var_str ("mch1"), u)
call model_vars%write_var (var_str ("wch1"), u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)") "* Model MSSM, values from SLHA file"
write (u, "(A)")
call global%model%write (u, verbose = .false., &
show_vertices = .false., show_particles = .false.)
write (u, "(A)")
write (u, "(A)") "* Selected global variables"
write (u, "(A)")
model_vars => global%model%get_var_list_ptr ()
call model_vars%write_var (var_str ("mch1"), u)
call model_vars%write_var (var_str ("wch1"), u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_slha_final ()
call syntax_model_file_final ()
call syntax_cmd_list_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_29"
end subroutine commands_29
@ %def commands_29
@
\subsubsection{Expressions for scales}
Declare a scale, factorization scale or factorization scale expression.
<<Commands: execute tests>>=
call test (commands_30, "commands_30", &
"scales", &
u, results)
<<Commands: test declarations>>=
public :: commands_30
<<Commands: tests>>=
subroutine commands_30 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_30"
write (u, "(A)") "* Purpose: define scales"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'scale = 200 GeV')
call ifile_append (ifile, &
'factorization_scale = eval Pt [particle]')
call ifile_append (ifile, &
'renormalization_scale = eval E [particle]')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_expr (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_30"
end subroutine commands_30
@ %def commands_30
@
\subsubsection{Weight and reweight expressions}
Declare an expression for event weights and reweighting.
<<Commands: execute tests>>=
call test (commands_31, "commands_31", &
"event weights/reweighting", &
u, results)
<<Commands: test declarations>>=
public :: commands_31
<<Commands: tests>>=
subroutine commands_31 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_31"
write (u, "(A)") "* Purpose: define weight/reweight"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'weight = eval Pz [particle]')
call ifile_append (ifile, 'reweight = eval M2 [particle]')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_expr (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_31"
end subroutine commands_31
@ %def commands_31
@
\subsubsection{Selecting events}
Declare an expression for selecting events in an analysis.
<<Commands: execute tests>>=
call test (commands_32, "commands_32", &
"event selection", &
u, results)
<<Commands: test declarations>>=
public :: commands_32
<<Commands: tests>>=
subroutine commands_32 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
write (u, "(A)") "* Test output: commands_32"
write (u, "(A)") "* Purpose: define selection"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'selection = any PDG == 13 [particle]')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
call global%write_expr (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_32"
end subroutine commands_32
@ %def commands_32
@
\subsubsection{Executing shell commands}
Execute a shell command.
<<Commands: execute tests>>=
call test (commands_33, "commands_33", &
"execute shell command", &
u, results)
<<Commands: test declarations>>=
public :: commands_33
<<Commands: tests>>=
subroutine commands_33 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
integer :: u_file, iostat
character(3) :: buffer
write (u, "(A)") "* Test output: commands_33"
write (u, "(A)") "* Purpose: execute shell command"
write (u, "(A)")
write (u, "(A)") "* Initialization"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'exec ("echo foo >> bar")')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root, u)
write (u, "(A)")
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
u_file = free_unit ()
open (u_file, file = "bar", &
action = "read", status = "old")
do
read (u_file, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
end do
write (u, "(A,A)") "should be 'foo': ", trim (buffer)
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_33"
end subroutine commands_33
@ %def commands_33
@
\subsubsection{Callback}
Instead of an explicit write, use the callback feature to write the
analysis file during event generation. We generate 4 events and
arrange that the callback is executed while writing the 3rd event.
<<Commands: execute tests>>=
call test (commands_34, "commands_34", &
"analysis via callback", &
u, results)
<<Commands: test declarations>>=
public :: commands_34
<<Commands: tests>>=
subroutine commands_34 (u)
integer, intent(in) :: u
type(ifile_t) :: ifile
type(command_list_t), target :: command_list
type(rt_data_t), target :: global
type(parse_node_t), pointer :: pn_root
type(prclib_entry_t), pointer :: lib
type(event_callback_34_t) :: event_callback
write (u, "(A)") "* Test output: commands_34"
write (u, "(A)") "* Purpose: write analysis data"
write (u, "(A)")
write (u, "(A)") "* Initialization: create observable"
write (u, "(A)")
call syntax_cmd_list_init ()
call global%global_init ()
call syntax_model_file_init ()
call global%global_init ()
call global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
call global%var_list%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known=.true.)
call global%var_list%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known=.true.)
call global%var_list%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known=.true.)
call global%var_list%set_real (var_str ("sqrts"), &
1000._default, is_known=.true.)
call global%var_list%set_log (var_str ("?vis_history"),&
.false., is_known=.true.)
call global%var_list%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
allocate (lib)
call lib%init (var_str ("lib_cmd34"))
call global%add_prclib (lib)
write (u, "(A)") "* Prepare callback for writing analysis to I/O unit"
write (u, "(A)")
event_callback%u = u
call global%set_event_callback (event_callback)
write (u, "(A)") "* Input file"
write (u, "(A)")
call ifile_append (ifile, 'model = "Test"')
call ifile_append (ifile, 'process commands_34_p = s, s => s, s')
call ifile_append (ifile, 'compile')
call ifile_append (ifile, 'iterations = 1:1000')
call ifile_append (ifile, 'integrate (commands_34_p)')
call ifile_append (ifile, 'observable sq')
call ifile_append (ifile, 'analysis = record sq (sqrts)')
call ifile_append (ifile, 'n_events = 4')
call ifile_append (ifile, 'event_callback_interval = 3')
call ifile_append (ifile, 'simulate (commands_34_p)')
call ifile_write (ifile, u)
write (u, "(A)")
write (u, "(A)") "* Parse file"
write (u, "(A)")
call parse_ifile (ifile, pn_root)
write (u, "(A)") "* Compile command list"
write (u, "(A)")
call command_list%compile (pn_root, global)
call command_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Execute command list"
write (u, "(A)")
call command_list%execute (global)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call ifile_final (ifile)
call analysis_final ()
call command_list%final ()
call global%final ()
call syntax_cmd_list_final ()
call syntax_model_file_final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: commands_34"
end subroutine commands_34
@ %def commands_34
@ For this test, we invent a callback object which simply writes the
analysis file, using the standard call for this. Here we rely on the
fact that the analysis data are stored as a global entity, otherwise
we would have to access them via the event object.
<<Commands: test auxiliary types>>=
type, extends (event_callback_t) :: event_callback_34_t
private
integer :: u = 0
contains
procedure :: write => event_callback_34_write
procedure :: proc => event_callback_34
end type event_callback_34_t
@ %def event_callback_t
@ The output routine is unused. The actual callback should write the
analysis data to the output unit that we have injected into the
callback object.
<<Commands: test auxiliary>>=
subroutine event_callback_34_write (event_callback, unit)
class(event_callback_34_t), intent(in) :: event_callback
integer, intent(in), optional :: unit
end subroutine event_callback_34_write
subroutine event_callback_34 (event_callback, i, event)
class(event_callback_34_t), intent(in) :: event_callback
integer(i64), intent(in) :: i
class(generic_event_t), intent(in) :: event
call analysis_write (event_callback%u)
end subroutine event_callback_34
@ %def event_callback_34_write
@ %def event_callback_34
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Toplevel module WHIZARD}
<<[[whizard.f90]]>>=
<<File header>>
module whizard
use io_units
<<Use strings>>
use system_defs, only: VERSION_STRING
use system_defs, only: EOF, BACKSLASH
use diagnostics
use os_interface
use ifiles
use lexers
use parser
use eval_trees
use models
use phs_forests
use prclib_stacks
use slha_interface
use blha_config
use rt_data
use commands
<<Standard module head>>
<<WHIZARD: public>>
<<WHIZARD: types>>
save
contains
<<WHIZARD: procedures>>
end module whizard
@ %def whizard
@
\subsection{Options}
Here we introduce a wrapper that holds various user options, so they
can transparently be passed from the main program to the [[whizard]]
object. Most parameters are used for initializing the [[global]]
state.
<<WHIZARD: public>>=
public :: whizard_options_t
<<WHIZARD: types>>=
type :: whizard_options_t
type(string_t) :: job_id
+ type(string_t), dimension(:), allocatable :: pack_args
+ type(string_t), dimension(:), allocatable :: unpack_args
type(string_t) :: preload_model
type(string_t) :: default_lib
type(string_t) :: preload_libraries
logical :: rebuild_library = .false.
logical :: recompile_library = .false.
logical :: rebuild_user
logical :: rebuild_phs = .false.
logical :: rebuild_grids = .false.
logical :: rebuild_events = .false.
end type whizard_options_t
@ %def whizard_options_t
@
\subsection{Parse tree stack}
We collect all parse trees that we generate in the [[whizard]] object. To
this end, we create a stack of parse trees. They must not be finalized before
the [[global]] object is finalized, because items such as a cut definition may
contain references to the parse tree from which they were generated.
<<WHIZARD: types>>=
type, extends (parse_tree_t) :: pt_entry_t
type(pt_entry_t), pointer :: previous => null ()
end type pt_entry_t
@ %def pt_entry_t
@ This is the stack. Since we always prepend, we just need the [[last]]
pointer.
<<WHIZARD: types>>=
type :: pt_stack_t
type(pt_entry_t), pointer :: last => null ()
contains
<<WHIZARD: pt stack: TBP>>
end type pt_stack_t
@ %def pt_stack_t
@ The finalizer is called at the very end.
<<WHIZARD: pt stack: TBP>>=
procedure :: final => pt_stack_final
<<WHIZARD: procedures>>=
subroutine pt_stack_final (pt_stack)
class(pt_stack_t), intent(inout) :: pt_stack
type(pt_entry_t), pointer :: current
do while (associated (pt_stack%last))
current => pt_stack%last
pt_stack%last => current%previous
call parse_tree_final (current%parse_tree_t)
deallocate (current)
end do
end subroutine pt_stack_final
@ %def pt_stack_final
@ Create and push a new entry, keeping the previous ones.
<<WHIZARD: pt stack: TBP>>=
procedure :: push => pt_stack_push
<<WHIZARD: procedures>>=
subroutine pt_stack_push (pt_stack, parse_tree)
class(pt_stack_t), intent(inout) :: pt_stack
type(parse_tree_t), intent(out), pointer :: parse_tree
type(pt_entry_t), pointer :: current
allocate (current)
parse_tree => current%parse_tree_t
current%previous => pt_stack%last
pt_stack%last => current
end subroutine pt_stack_push
@ %def pt_stack_push
@
\subsection{The [[whizard]] object}
An object of type [[whizard_t]] is the top-level wrapper for a
\whizard\ instance. The object holds various default
settings and the current state of the generator, the [[global]] object
of type [[rt_data_t]]. This object contains, for instance, the list
of variables and the process libraries.
Since components of the [[global]] subobject are frequently used as
targets, the [[whizard]] object should also consistently carry the
[[target]] attribute.
The various self-tests do no not use this object. They initialize
only specific subsets of the system, according to their needs.
Note: we intend to allow several concurrent instances. In the current
implementation, there are still a few obstacles to this: the model
library and the syntax tables are global variables, and the error
handling uses global state. This should be improved.
<<WHIZARD: public>>=
public :: whizard_t
<<WHIZARD: types>>=
type :: whizard_t
type(whizard_options_t) :: options
type(rt_data_t) :: global
type(pt_stack_t) :: pt_stack
contains
<<WHIZARD: whizard: TBP>>
end type whizard_t
@ %def whizard_t
@
\subsection{Initialization and finalization}
<<WHIZARD: whizard: TBP>>=
procedure :: init => whizard_init
<<WHIZARD: procedures>>=
subroutine whizard_init (whizard, options, paths, logfile)
class(whizard_t), intent(out), target :: whizard
type(whizard_options_t), intent(in) :: options
type(paths_t), intent(in), optional :: paths
type(string_t), intent(in), optional :: logfile
call init_syntax_tables ()
whizard%options = options
call whizard%global%global_init (paths, logfile)
call whizard%init_job_id ()
call whizard%init_rebuild_flags ()
+ call whizard%unpack_files ()
call whizard%preload_model ()
call whizard%preload_library ()
call whizard%global%init_fallback_model &
(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
end subroutine whizard_init
@ %def whizard_init
@ Apart from the global data which have been initialized above, the
process and model lists need to be finalized.
<<WHIZARD: whizard: TBP>>=
procedure :: final => whizard_final
<<WHIZARD: procedures>>=
subroutine whizard_final (whizard)
class(whizard_t), intent(inout), target :: whizard
call whizard%global%final ()
call whizard%pt_stack%final ()
+ call whizard%pack_files ()
!!! JRR: WK please check (#529)
! call user_code_final ()
call final_syntax_tables ()
end subroutine whizard_final
@ %def whizard_final
@ Set the job ID, if nonempty. If the ID string is empty, the value remains
undefined.
<<WHIZARD: whizard: TBP>>=
procedure :: init_job_id => whizard_init_job_id
<<WHIZARD: procedures>>=
subroutine whizard_init_job_id (whizard)
class(whizard_t), intent(inout), target :: whizard
associate (var_list => whizard%global%var_list, options => whizard%options)
if (options%job_id /= "") then
call var_list%set_string (var_str ("$job_id"), &
options%job_id, is_known=.true.)
end if
end associate
end subroutine whizard_init_job_id
@ %def whizard_init_job_id
@
Set the rebuild flags. They can be specified on the command line and
set the initial value for the associated logical variables.
<<WHIZARD: whizard: TBP>>=
procedure :: init_rebuild_flags => whizard_init_rebuild_flags
<<WHIZARD: procedures>>=
subroutine whizard_init_rebuild_flags (whizard)
class(whizard_t), intent(inout), target :: whizard
associate (var_list => whizard%global%var_list, options => whizard%options)
call var_list%append_log (var_str ("?rebuild_library"), &
options%rebuild_library, intrinsic=.true.)
call var_list%append_log (var_str ("?recompile_library"), &
options%recompile_library, intrinsic=.true.)
call var_list%append_log (var_str ("?rebuild_phase_space"), &
options%rebuild_phs, intrinsic=.true.)
call var_list%append_log (var_str ("?rebuild_grids"), &
options%rebuild_grids, intrinsic=.true.)
call var_list%append_log (var_str ("?powheg_rebuild_grids"), &
options%rebuild_grids, intrinsic=.true.)
call var_list%append_log (var_str ("?rebuild_events"), &
options%rebuild_events, intrinsic=.true.)
end associate
end subroutine whizard_init_rebuild_flags
@ %def whizard_init_rebuild_flags
@
+Pack/unpack files in the working directory, if requested.
+<<WHIZARD: whizard: TBP>>=
+ procedure :: pack_files => whizard_pack_files
+ procedure :: unpack_files => whizard_unpack_files
+<<WHIZARD: procedures>>=
+ subroutine whizard_pack_files (whizard)
+ class(whizard_t), intent(in), target :: whizard
+ logical :: exist
+ integer :: i
+ type(string_t) :: file
+ if (allocated (whizard%options%pack_args)) then
+ do i = 1, size (whizard%options%pack_args)
+ file = whizard%options%pack_args(i)
+ call msg_message ("Packing file/dir '" // char (file) // "'")
+ exist = os_file_exist (file) .or. os_dir_exist (file)
+ if (exist) then
+ call os_pack_file (whizard%options%pack_args(i), &
+ whizard%global%os_data)
+ else
+ call msg_error ("File/dir '" // char (file) // "' not found")
+ end if
+ end do
+ end if
+ end subroutine whizard_pack_files
+
+ subroutine whizard_unpack_files (whizard)
+ class(whizard_t), intent(in), target :: whizard
+ logical :: exist
+ integer :: i
+ type(string_t) :: file
+ if (allocated (whizard%options%unpack_args)) then
+ do i = 1, size (whizard%options%unpack_args)
+ file = whizard%options%unpack_args(i)
+ call msg_message ("Unpacking file '" // char (file) // "'")
+ exist = os_file_exist (file)
+ if (exist) then
+ call os_unpack_file (whizard%options%unpack_args(i), &
+ whizard%global%os_data)
+ else
+ call msg_error ("File '" // char (file) // "' not found")
+ end if
+ end do
+ end if
+ end subroutine whizard_unpack_files
+
+@ %def whizard_pack_files
+@ %def whizard_unpack_files
+@
This procedure preloads a model, if a model name is given.
<<WHIZARD: whizard: TBP>>=
procedure :: preload_model => whizard_preload_model
<<WHIZARD: procedures>>=
subroutine whizard_preload_model (whizard)
class(whizard_t), intent(inout), target :: whizard
type(string_t) :: model_name
model_name = whizard%options%preload_model
if (model_name /= "") then
call whizard%global%read_model (model_name, whizard%global%preload_model)
whizard%global%model => whizard%global%preload_model
if (associated (whizard%global%model)) then
call whizard%global%model%link_var_list (whizard%global%var_list)
call msg_message ("Preloaded model: " &
// char (model_name))
else
call msg_fatal ("Preloading model " // char (model_name) &
// " failed")
end if
else
call msg_message ("No model preloaded")
end if
end subroutine whizard_preload_model
@ %def whizard_preload_model
@
This procedure preloads a library, if a library name is given.
Note: This version just opens a new library with that name. It does not load
(yet) an existing library on file, as previous \whizard\ versions would do.
<<WHIZARD: whizard: TBP>>=
procedure :: preload_library => whizard_preload_library
<<WHIZARD: procedures>>=
subroutine whizard_preload_library (whizard)
class(whizard_t), intent(inout), target :: whizard
type(string_t) :: library_name, libs
type(string_t), dimension(:), allocatable :: libname_static
type(prclib_entry_t), pointer :: lib_entry
integer :: i
call get_prclib_static (libname_static)
do i = 1, size (libname_static)
allocate (lib_entry)
call lib_entry%init_static (libname_static(i))
call whizard%global%add_prclib (lib_entry)
end do
libs = adjustl (whizard%options%preload_libraries)
if (libs == "" .and. whizard%options%default_lib /= "") then
allocate (lib_entry)
call lib_entry%init (whizard%options%default_lib)
call whizard%global%add_prclib (lib_entry)
call msg_message ("Preloaded library: " // &
char (whizard%options%default_lib))
end if
SCAN_LIBS: do while (libs /= "")
call split (libs, library_name, " ")
if (library_name /= "") then
allocate (lib_entry)
call lib_entry%init (library_name)
call whizard%global%add_prclib (lib_entry)
call msg_message ("Preloaded library: " // char (library_name))
end if
end do SCAN_LIBS
end subroutine whizard_preload_library
@ %def whizard_preload_library
@
\subsection{Initialization and finalization (old version)}
These procedures initialize and finalize global variables. Most of
them are collected in the [[global]] data record located here, the
others are syntax tables located in various modules, which do not
change during program execution. Furthermore, there is a global model
list and a global process store, which get filled during program
execution but are finalized here.
During initialization, we can preload a default model and initialize a
default library for setting up processes. The default library is
loaded if requested by the setup. Further libraries can be loaded as
specified by command-line flags.
@ Initialize/finalize the syntax tables used by WHIZARD:
<<WHIZARD: public>>=
public :: init_syntax_tables
public :: final_syntax_tables
<<WHIZARD: procedures>>=
subroutine init_syntax_tables ()
call syntax_model_file_init ()
call syntax_phs_forest_init ()
call syntax_pexpr_init ()
call syntax_slha_init ()
call syntax_cmd_list_init ()
end subroutine init_syntax_tables
subroutine final_syntax_tables ()
call syntax_model_file_final ()
call syntax_phs_forest_final ()
call syntax_pexpr_final ()
call syntax_slha_final ()
call syntax_cmd_list_final ()
end subroutine final_syntax_tables
@ %def init_syntax_tables
@ %def final_syntax_tables
@ Write the syntax tables to external files.
<<WHIZARD: public>>=
public :: write_syntax_tables
<<WHIZARD: procedures>>=
subroutine write_syntax_tables ()
integer :: unit
character(*), parameter :: file_model = "whizard.model_file.syntax"
character(*), parameter :: file_phs = "whizard.phase_space_file.syntax"
character(*), parameter :: file_pexpr = "whizard.prt_expressions.syntax"
character(*), parameter :: file_slha = "whizard.slha.syntax"
character(*), parameter :: file_sindarin = "whizard.sindarin.syntax"
unit = free_unit ()
print *, "Writing file '" // file_model // "'"
open (unit=unit, file=file_model, status="replace", action="write")
write (unit, "(A)") VERSION_STRING
write (unit, "(A)") "Syntax definition file: " // file_model
call syntax_model_file_write (unit)
close (unit)
print *, "Writing file '" // file_phs // "'"
open (unit=unit, file=file_phs, status="replace", action="write")
write (unit, "(A)") VERSION_STRING
write (unit, "(A)") "Syntax definition file: " // file_phs
call syntax_phs_forest_write (unit)
close (unit)
print *, "Writing file '" // file_pexpr // "'"
open (unit=unit, file=file_pexpr, status="replace", action="write")
write (unit, "(A)") VERSION_STRING
write (unit, "(A)") "Syntax definition file: " // file_pexpr
call syntax_pexpr_write (unit)
close (unit)
print *, "Writing file '" // file_slha // "'"
open (unit=unit, file=file_slha, status="replace", action="write")
write (unit, "(A)") VERSION_STRING
write (unit, "(A)") "Syntax definition file: " // file_slha
call syntax_slha_write (unit)
close (unit)
print *, "Writing file '" // file_sindarin // "'"
open (unit=unit, file=file_sindarin, status="replace", action="write")
write (unit, "(A)") VERSION_STRING
write (unit, "(A)") "Syntax definition file: " // file_sindarin
call syntax_cmd_list_write (unit)
close (unit)
end subroutine write_syntax_tables
@ %def write_syntax_tables
@
\subsection{Execute command lists}
Process commands given on the command line, stored as an [[ifile]]. The whole
input is read, compiled and executed as a whole.
<<WHIZARD: whizard: TBP>>=
procedure :: process_ifile => whizard_process_ifile
<<WHIZARD: procedures>>=
subroutine whizard_process_ifile (whizard, ifile, quit, quit_code)
class(whizard_t), intent(inout), target :: whizard
type(ifile_t), intent(in) :: ifile
logical, intent(out) :: quit
integer, intent(out) :: quit_code
type(lexer_t), target :: lexer
type(stream_t), target :: stream
call msg_message ("Reading commands given on the command line")
call lexer_init_cmd_list (lexer)
call stream_init (stream, ifile)
call whizard%process_stream (stream, lexer, quit, quit_code)
call stream_final (stream)
call lexer_final (lexer)
end subroutine whizard_process_ifile
@ %def whizard_process_ifile
@ Process standard input as a command list. The whole input is read,
compiled and executed as a whole.
<<WHIZARD: whizard: TBP>>=
procedure :: process_stdin => whizard_process_stdin
<<WHIZARD: procedures>>=
subroutine whizard_process_stdin (whizard, quit, quit_code)
class(whizard_t), intent(inout), target :: whizard
logical, intent(out) :: quit
integer, intent(out) :: quit_code
type(lexer_t), target :: lexer
type(stream_t), target :: stream
call msg_message ("Reading commands from standard input")
call lexer_init_cmd_list (lexer)
call stream_init (stream, 5)
call whizard%process_stream (stream, lexer, quit, quit_code)
call stream_final (stream)
call lexer_final (lexer)
end subroutine whizard_process_stdin
@ %def whizard_process_stdin
@ Process a file as a command list.
<<WHIZARD: whizard: TBP>>=
procedure :: process_file => whizard_process_file
<<WHIZARD: procedures>>=
subroutine whizard_process_file (whizard, file, quit, quit_code)
class(whizard_t), intent(inout), target :: whizard
type(string_t), intent(in) :: file
logical, intent(out) :: quit
integer, intent(out) :: quit_code
type(lexer_t), target :: lexer
type(stream_t), target :: stream
logical :: exist
call msg_message ("Reading commands from file '" // char (file) // "'")
inquire (file=char(file), exist=exist)
if (exist) then
call lexer_init_cmd_list (lexer)
call stream_init (stream, char (file))
call whizard%process_stream (stream, lexer, quit, quit_code)
call stream_final (stream)
call lexer_final (lexer)
else
call msg_error ("File '" // char (file) // "' not found")
end if
end subroutine whizard_process_file
@ %def whizard_process_file
@
<<WHIZARD: whizard: TBP>>=
procedure :: process_stream => whizard_process_stream
<<WHIZARD: procedures>>=
subroutine whizard_process_stream (whizard, stream, lexer, quit, quit_code)
class(whizard_t), intent(inout), target :: whizard
type(stream_t), intent(inout), target :: stream
type(lexer_t), intent(inout), target :: lexer
logical, intent(out) :: quit
integer, intent(out) :: quit_code
type(parse_tree_t), pointer :: parse_tree
type(command_list_t), target :: command_list
call lexer_assign_stream (lexer, stream)
call whizard%pt_stack%push (parse_tree)
call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
if (associated (parse_tree%get_root_ptr ())) then
whizard%global%lexer => lexer
call command_list%compile (parse_tree%get_root_ptr (), &
whizard%global)
end if
call whizard%global%activate ()
call command_list%execute (whizard%global)
call command_list%final ()
quit = whizard%global%quit
quit_code = whizard%global%quit_code
end subroutine whizard_process_stream
@ %def whizard_process_stream
@
\subsection{The WHIZARD shell}
This procedure implements interactive mode. One line is processed at
a time.
<<WHIZARD: whizard: TBP>>=
procedure :: shell => whizard_shell
<<WHIZARD: procedures>>=
subroutine whizard_shell (whizard, quit_code)
class(whizard_t), intent(inout), target :: whizard
integer, intent(out) :: quit_code
type(lexer_t), target :: lexer
type(stream_t), target :: stream
type(string_t) :: prompt1
type(string_t) :: prompt2
type(string_t) :: input
type(string_t) :: extra
integer :: last
integer :: iostat
logical :: mask_tmp
logical :: quit
call msg_message ("Launching interactive shell")
call lexer_init_cmd_list (lexer)
prompt1 = "whish? "
prompt2 = " > "
COMMAND_LOOP: do
call put (6, prompt1)
call get (5, input, iostat=iostat)
if (iostat > 0 .or. iostat == EOF) exit COMMAND_LOOP
CONTINUE_INPUT: do
last = len_trim (input)
if (extract (input, last, last) /= BACKSLASH) exit CONTINUE_INPUT
call put (6, prompt2)
call get (5, extra, iostat=iostat)
if (iostat > 0) exit COMMAND_LOOP
input = replace (input, last, extra)
end do CONTINUE_INPUT
call stream_init (stream, input)
mask_tmp = mask_fatal_errors
mask_fatal_errors = .true.
call whizard%process_stream (stream, lexer, quit, quit_code)
msg_count = 0
mask_fatal_errors = mask_tmp
call stream_final (stream)
if (quit) exit COMMAND_LOOP
end do COMMAND_LOOP
print *
call lexer_final (lexer)
end subroutine whizard_shell
@ %def whizard_shell
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Tools for the command line}
We don't intent to be very smart here, but this module provides a few
small tools that simplify dealing with the command line.
<<[[cmdline_options.f90]]>>=
<<File header>>
module cmdline_options
<<Use strings>>
use diagnostics
<<Standard module head>>
public :: init_options
public :: no_option_value
public :: get_option_value
<<Main: cmdline arg len declaration>>
abstract interface
subroutine msg
end subroutine msg
end interface
procedure (msg), pointer :: print_usage => null ()
contains
subroutine init_options (usage_msg)
procedure (msg) :: usage_msg
print_usage => usage_msg
end subroutine init_options
subroutine no_option_value (option, value)
type(string_t), intent(in) :: option, value
if (value /= "") then
call msg_error (" Option '" // char (option) // "' should have no value")
end if
end subroutine no_option_value
function get_option_value (i, option, value) result (string)
type(string_t) :: string
integer, intent(inout) :: i
type(string_t), intent(in) :: option
type(string_t), intent(in), optional :: value
character(CMDLINE_ARG_LEN) :: arg_value
integer :: arg_len, arg_status
logical :: has_value
if (present (value)) then
has_value = value /= ""
else
has_value = .false.
end if
if (has_value) then
string = value
else
i = i + 1
call get_command_argument (i, arg_value, arg_len, arg_status)
select case (arg_status)
case (0)
case (-1)
call msg_error (" Option value truncated: '" // arg_value // "'")
case default
call print_usage ()
call msg_fatal (" Option '" // char (option) // "' needs a value")
end select
select case (arg_value(1:1))
case ("-")
call print_usage ()
call msg_fatal (" Option '" // char (option) // "' needs a value")
end select
string = trim (arg_value)
end if
end function get_option_value
end module cmdline_options
@ %def init_options
@ %def no_option_value
@ %def get_option_value
@ %def cmdline_options
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Query Feature Support}
This module accesses the various optional features (modules) that
WHIZARD can support and repors on their availability.
<<[[features.f90]]>>=
module features
use string_utils, only: lower_case
use system_dependencies, only: WHIZARD_VERSION
<<Features: dependencies>>
<<Standard module head>>
<<Features: public>>
contains
<<Features: procedures>>
end module features
@ %def features
@
\subsection{Output}
<<Features: public>>=
public :: print_features
<<Features: procedures>>=
subroutine print_features ()
print "(A)", "WHIZARD " // WHIZARD_VERSION
print "(A)", "Build configuration:"
<<Features: config>>
print "(A)", "Optional features available in this build:"
<<Features: print>>
end subroutine print_features
@ %def print_features
@
\subsection{Query function}
<<Features: procedures>>=
subroutine check (feature, recognized, result, help)
character(*), intent(in) :: feature
logical, intent(out) :: recognized
character(*), intent(out) :: result, help
recognized = .true.
result = "no"
select case (lower_case (trim (feature)))
<<Features: cases>>
case default
recognized = .false.
end select
end subroutine check
@ %def check
@ Print this result:
<<Features: procedures>>=
subroutine print_check (feature)
character(*), intent(in) :: feature
character(16) :: f
logical :: recognized
character(10) :: result
character(48) :: help
call check (feature, recognized, result, help)
if (.not. recognized) then
result = "unknown"
help = ""
end if
f = feature
print "(2x,A,1x,A,'(',A,')')", f, result, trim (help)
end subroutine print_check
@ %def print_check
@
\subsection{Basic configuration}
<<Features: config>>=
call print_check ("precision")
<<Features: dependencies>>=
use kinds, only: default
<<Features: cases>>=
case ("precision")
write (result, "(I0)") precision (1._default)
help = "significant decimals of real/complex numbers"
@
\subsection{Optional features case by case}
<<Features: print>>=
call print_check ("OpenMP")
<<Features: dependencies>>=
use system_dependencies, only: openmp_is_active
<<Features: cases>>=
case ("openmp")
if (openmp_is_active ()) then
result = "yes"
end if
help = "OpenMP parallel execution"
@
<<Features: print>>=
call print_check ("GoSam")
<<Features: dependencies>>=
use system_dependencies, only: GOSAM_AVAILABLE
<<Features: cases>>=
case ("gosam")
if (GOSAM_AVAILABLE) then
result = "yes"
end if
help = "external NLO matrix element provider"
@
<<Features: print>>=
call print_check ("OpenLoops")
<<Features: dependencies>>=
use system_dependencies, only: OPENLOOPS_AVAILABLE
<<Features: cases>>=
case ("openloops")
if (OPENLOOPS_AVAILABLE) then
result = "yes"
end if
help = "external NLO matrix element provider"
@
<<Features: print>>=
call print_check ("Recola")
<<Features: dependencies>>=
use system_dependencies, only: RECOLA_AVAILABLE
<<Features: cases>>=
case ("recola")
if (RECOLA_AVAILABLE) then
result = "yes"
end if
help = "external NLO matrix element provider"
@
<<Features: print>>=
call print_check ("LHAPDF")
<<Features: dependencies>>=
use system_dependencies, only: LHAPDF5_AVAILABLE
use system_dependencies, only: LHAPDF6_AVAILABLE
<<Features: cases>>=
case ("lhapdf")
if (LHAPDF5_AVAILABLE) then
result = "v5"
else if (LHAPDF6_AVAILABLE) then
result = "v6"
end if
help = "PDF library"
@
<<Features: print>>=
call print_check ("HOPPET")
<<Features: dependencies>>=
use system_dependencies, only: HOPPET_AVAILABLE
<<Features: cases>>=
case ("hoppet")
if (HOPPET_AVAILABLE) then
result = "yes"
end if
help = "PDF evolution package"
@
<<Features: print>>=
call print_check ("fastjet")
<<Features: dependencies>>=
use jets, only: fastjet_available
<<Features: cases>>=
case ("fastjet")
if (fastjet_available ()) then
result = "yes"
end if
help = "jet-clustering package"
@
<<Features: print>>=
call print_check ("Pythia6")
<<Features: dependencies>>=
use system_dependencies, only: PYTHIA6_AVAILABLE
<<Features: cases>>=
case ("pythia6")
if (PYTHIA6_AVAILABLE) then
result = "yes"
end if
help = "direct access for shower/hadronization"
@
<<Features: print>>=
call print_check ("Pythia8")
<<Features: dependencies>>=
use system_dependencies, only: PYTHIA8_AVAILABLE
<<Features: cases>>=
case ("pythia8")
if (PYTHIA8_AVAILABLE) then
result = "yes"
end if
help = "direct access for shower/hadronization"
@
<<Features: print>>=
call print_check ("StdHEP")
<<Features: cases>>=
case ("stdhep")
result = "yes"
help = "event I/O format"
@
<<Features: print>>=
call print_check ("HepMC")
<<Features: dependencies>>=
use hepmc_interface, only: hepmc_is_available
<<Features: cases>>=
case ("hepmc")
if (hepmc_is_available ()) then
result = "yes"
end if
help = "event I/O format"
@
<<Features: print>>=
call print_check ("LCIO")
<<Features: dependencies>>=
use lcio_interface, only: lcio_is_available
<<Features: cases>>=
case ("lcio")
if (lcio_is_available ()) then
result = "yes"
end if
help = "event I/O format"
@
<<Features: print>>=
call print_check ("MetaPost")
<<Features: dependencies>>=
use system_dependencies, only: EVENT_ANALYSIS
<<Features: cases>>=
case ("metapost")
result = EVENT_ANALYSIS
help = "graphical event analysis via LaTeX/MetaPost"
@
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Driver program}
The main program handles command options, initializes the environment,
and runs WHIZARD in a particular mode (interactive, file, standard
input).
This is also used in the C interface:
<<Main: cmdline arg len declaration>>=
integer, parameter :: CMDLINE_ARG_LEN = 1000
@ %def CMDLINE_ARG_LEN
@
The actual main program:
<<[[main.f90]]>>=
<<File header>>
program main
<<Use strings>>
use system_dependencies
use diagnostics
use ifiles
use os_interface
use rt_data, only: show_description_of_string, show_tex_descriptions
use whizard
use cmdline_options
use features
<<Use mpi f08>>
implicit none
<<Main: cmdline arg len declaration>>
!!! (WK 02/2016) Interface for the separate external routine below
interface
subroutine print_usage ()
end subroutine print_usage
end interface
! Main program variable declarations
character(CMDLINE_ARG_LEN) :: arg
character(2) :: option
type(string_t) :: long_option, value
integer :: i, j, arg_len, arg_status
logical :: look_for_options
logical :: interactive
logical :: banner
type(string_t) :: job_id, files, this, model, default_lib, library, libraries
type(string_t) :: logfile, query_string
logical :: user_code_enable = .false.
integer :: n_user_src = 0, n_user_lib = 0
type(string_t) :: user_src, user_lib, user_target
type(paths_t) :: paths
+ type(string_t) :: pack_arg, unpack_arg
+ type(string_t), dimension(:), allocatable :: pack_args, unpack_args
+ type(string_t), dimension(:), allocatable :: tmp_strings
logical :: rebuild_library, rebuild_user
logical :: rebuild_phs, rebuild_grids, rebuild_events
logical :: recompile_library
type(ifile_t) :: commands
type(string_t) :: command
type(whizard_options_t), allocatable :: options
type(whizard_t), allocatable, target :: whizard_instance
! Exit status
logical :: quit = .false.
integer :: quit_code = 0
! Initial values
look_for_options = .true.
interactive = .false.
job_id = ""
files = ""
model = "SM"
default_lib = "default_lib"
library = ""
libraries = ""
banner = .true.
logging = .true.
msg_level = RESULT
logfile = "whizard.log"
user_src = ""
user_lib = ""
user_target = ""
rebuild_library = .false.
rebuild_user = .false.
rebuild_phs = .false.
rebuild_grids = .false.
rebuild_events = .false.
recompile_library = .false.
call paths_init (paths)
<<Main: MPI init>>
! Read and process options
call init_options (print_usage)
i = 0
SCAN_CMDLINE: do
i = i + 1
call get_command_argument (i, arg, arg_len, arg_status)
select case (arg_status)
case (0)
case (-1)
call msg_error (" Command argument truncated: '" // arg // "'")
case default
exit SCAN_CMDLINE
end select
if (look_for_options) then
select case (arg(1:2))
case ("--")
value = trim (arg)
call split (value, long_option, "=")
select case (char (long_option))
case ("--version")
call no_option_value (long_option, value)
call print_version (); stop
case ("--help")
call no_option_value (long_option, value)
call print_usage (); stop
case ("--prefix")
paths%prefix = get_option_value (i, long_option, value)
cycle scan_cmdline
case ("--exec-prefix")
paths%exec_prefix = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--bindir")
paths%bindir = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--libdir")
paths%libdir = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--includedir")
paths%includedir = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--datarootdir")
paths%datarootdir = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--libtool")
paths%libtool = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--lhapdfdir")
paths%lhapdfdir = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--check")
call print_usage ()
call msg_fatal ("Option --check not supported &
&(for unit tests, run whizard_ut instead)")
case ("--show-config")
call no_option_value (long_option, value)
call print_features (); stop
case ("--execute")
command = get_option_value (i, long_option, value)
call ifile_append (commands, command)
cycle SCAN_CMDLINE
case ("--interactive")
call no_option_value (long_option, value)
interactive = .true.
cycle SCAN_CMDLINE
case ("--job-id")
job_id = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--library")
library = get_option_value (i, long_option, value)
libraries = libraries // " " // library
cycle SCAN_CMDLINE
case ("--no-library")
call no_option_value (long_option, value)
default_lib = ""
library = ""
libraries = ""
cycle SCAN_CMDLINE
case ("--localprefix")
paths%localprefix = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--logfile")
logfile = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--no-logfile")
call no_option_value (long_option, value)
logfile = ""
cycle SCAN_CMDLINE
case ("--logging")
call no_option_value (long_option, value)
logging = .true.
cycle SCAN_CMDLINE
case ("--no-logging")
call no_option_value (long_option, value)
logging = .false.
cycle SCAN_CMDLINE
case ("--query")
call no_option_value (long_option, value)
query_string = get_option_value (i, long_option, value)
call show_description_of_string (query_string)
call exit (0)
case ("--generate-variables-tex")
call no_option_value (long_option, value)
call show_tex_descriptions ()
call exit (0)
case ("--debug")
call no_option_value (long_option, value)
call set_debug_levels (get_option_value (i, long_option, value))
cycle SCAN_CMDLINE
case ("--debug2")
call no_option_value (long_option, value)
call set_debug2_levels (get_option_value (i, long_option, value))
cycle SCAN_CMDLINE
case ("--single-event")
call no_option_value (long_option, value)
single_event = .true.
cycle SCAN_CMDLINE
case ("--banner")
call no_option_value (long_option, value)
banner = .true.
cycle SCAN_CMDLINE
case ("--no-banner")
call no_option_value (long_option, value)
banner = .false.
cycle SCAN_CMDLINE
+ case ("--pack")
+ pack_arg = get_option_value (i, long_option, value)
+ if (allocated (pack_args)) then
+ call move_alloc (from=pack_args, to=tmp_strings)
+ allocate (pack_args (size (tmp_strings)+1))
+ pack_args(1:size(tmp_strings)) = tmp_strings
+ else
+ allocate (pack_args (1))
+ end if
+ pack_args(size(pack_args)) = pack_arg
+ cycle SCAN_CMDLINE
+ case ("--unpack")
+ unpack_arg = get_option_value (i, long_option, value)
+ if (allocated (unpack_args)) then
+ call move_alloc (from=unpack_args, to=tmp_strings)
+ allocate (unpack_args (size (tmp_strings)+1))
+ unpack_args(1:size(tmp_strings)) = tmp_strings
+ else
+ allocate (unpack_args (1))
+ end if
+ unpack_args(size(unpack_args)) = unpack_arg
+ cycle SCAN_CMDLINE
case ("--model")
model = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--no-model")
call no_option_value (long_option, value)
model = ""
cycle SCAN_CMDLINE
case ("--rebuild")
call no_option_value (long_option, value)
rebuild_library = .true.
rebuild_user = .true.
rebuild_phs = .true.
rebuild_grids = .true.
rebuild_events = .true.
cycle SCAN_CMDLINE
case ("--no-rebuild")
call no_option_value (long_option, value)
rebuild_library = .false.
recompile_library = .false.
rebuild_user = .false.
rebuild_phs = .false.
rebuild_grids = .false.
rebuild_events = .false.
cycle SCAN_CMDLINE
case ("--rebuild-library")
call no_option_value (long_option, value)
rebuild_library = .true.
cycle SCAN_CMDLINE
case ("--rebuild-user")
call no_option_value (long_option, value)
rebuild_user = .true.
cycle SCAN_CMDLINE
case ("--rebuild-phase-space")
call no_option_value (long_option, value)
rebuild_phs = .true.
cycle SCAN_CMDLINE
case ("--rebuild-grids")
call no_option_value (long_option, value)
rebuild_grids = .true.
cycle SCAN_CMDLINE
case ("--rebuild-events")
call no_option_value (long_option, value)
rebuild_events = .true.
cycle SCAN_CMDLINE
case ("--recompile")
call no_option_value (long_option, value)
recompile_library = .true.
rebuild_grids = .true.
cycle SCAN_CMDLINE
case ("--user")
user_code_enable = .true.
cycle SCAN_CMDLINE
case ("--user-src")
if (user_src == "") then
user_src = get_option_value (i, long_option, value)
else
user_src = user_src // " " &
// get_option_value (i, long_option, value)
end if
n_user_src = n_user_src + 1
cycle SCAN_CMDLINE
case ("--user-lib")
if (user_lib == "") then
user_lib = get_option_value (i, long_option, value)
else
user_lib = user_lib // " " &
// get_option_value (i, long_option, value)
end if
n_user_lib = n_user_lib + 1
cycle SCAN_CMDLINE
case ("--user-target")
user_target = get_option_value (i, long_option, value)
cycle SCAN_CMDLINE
case ("--write-syntax-tables")
call no_option_value (long_option, value)
call init_syntax_tables ()
call write_syntax_tables ()
call final_syntax_tables ()
stop
cycle SCAN_CMDLINE
case default
call print_usage ()
call msg_fatal ("Option '" // trim (arg) // "' not recognized")
end select
end select
select case (arg(1:1))
case ("-")
j = 1
if (len_trim (arg) == 1) then
look_for_options = .false.
else
SCAN_SHORT_OPTIONS: do
j = j + 1
if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
option = "-" // arg(j:j)
select case (option)
case ("-V")
call print_version (); stop
case ("-?", "-h")
call print_usage (); stop
case ("-e")
command = get_option_value (i, var_str (option))
call ifile_append (commands, command)
cycle SCAN_CMDLINE
case ("-i")
interactive = .true.
cycle SCAN_SHORT_OPTIONS
case ("-J")
if (j == len_trim (arg)) then
job_id = get_option_value (i, var_str (option))
else
job_id = trim (arg(j+1:))
end if
cycle SCAN_CMDLINE
case ("-l")
if (j == len_trim (arg)) then
library = get_option_value (i, var_str (option))
else
library = trim (arg(j+1:))
end if
libraries = libraries // " " // library
cycle SCAN_CMDLINE
case ("-L")
if (j == len_trim (arg)) then
logfile = get_option_value (i, var_str (option))
else
logfile = trim (arg(j+1:))
end if
cycle SCAN_CMDLINE
case ("-m")
if (j < len_trim (arg)) call msg_fatal &
("Option '" // option // "' needs a value")
model = get_option_value (i, var_str (option))
cycle SCAN_CMDLINE
case ("-q")
call no_option_value (long_option, value)
query_string = get_option_value (i, long_option, value)
call show_description_of_string (query_string)
call exit (0)
case ("-r")
rebuild_library = .true.
rebuild_user = .true.
rebuild_phs = .true.
rebuild_grids = .true.
rebuild_events = .true.
cycle SCAN_SHORT_OPTIONS
case ("-u")
user_code_enable = .true.
cycle SCAN_SHORT_OPTIONS
case default
call print_usage ()
call msg_fatal &
("Option '" // option // "' not recognized")
end select
end do SCAN_SHORT_OPTIONS
end if
case default
files = files // " " // trim (arg)
end select
else
files = files // " " // trim (arg)
end if
end do SCAN_CMDLINE
! Overall initialization
if (logfile /= "") call logfile_init (logfile)
if (banner) call msg_banner ()
allocate (options)
allocate (whizard_instance)
if (.not. quit) then
! Set options and initialize the whizard object
options%job_id = job_id
+ if (allocated (pack_args)) then
+ options%pack_args = pack_args
+ else
+ allocate (options%pack_args (0))
+ end if
+ if (allocated (unpack_args)) then
+ options%unpack_args = unpack_args
+ else
+ allocate (options%unpack_args (0))
+ end if
options%preload_model = model
options%default_lib = default_lib
options%preload_libraries = libraries
options%rebuild_library = rebuild_library
options%recompile_library = recompile_library
options%rebuild_user = rebuild_user
options%rebuild_phs = rebuild_phs
options%rebuild_grids = rebuild_grids
options%rebuild_events = rebuild_events
<<Main: dependent flags>>
call whizard_instance%init (options, paths, logfile)
call mask_term_signals ()
end if
! Run commands given on the command line
if (.not. quit .and. ifile_get_length (commands) > 0) then
call whizard_instance%process_ifile (commands, quit, quit_code)
end if
if (.not. quit) then
! Process commands from standard input
if (.not. interactive .and. files == "") then
call whizard_instance%process_stdin (quit, quit_code)
! ... or process commands from file
else
files = trim (adjustl (files))
SCAN_FILES: do while (files /= "")
call split (files, this, " ")
call whizard_instance%process_file (this, quit, quit_code)
if (quit) exit SCAN_FILES
end do SCAN_FILES
end if
end if
! Enter an interactive shell if requested
if (.not. quit .and. interactive) then
call whizard_instance%shell (quit_code)
end if
! Overall finalization
call ifile_final (commands)
deallocate (options)
call whizard_instance%final ()
deallocate (whizard_instance)
<<Main: MPI finalize>>
call terminate_now_if_signal ()
call release_term_signals ()
call msg_terminate (quit_code = quit_code)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
contains
subroutine print_version ()
print "(A)", "WHIZARD " // WHIZARD_VERSION
print "(A)", "Copyright (C) 1999-2018 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
print "(A)", " --------------------------------------- "
print "(A)", "This is free software; see the source for copying conditions. There is NO"
print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
print *
end subroutine print_version
end program main
!!! (WK 02/2016)
!!! Separate subroutine, because this becomes a procedure pointer target
!!! Internal procedures as targets are not supported by some compilers.
subroutine print_usage ()
use system_dependencies, only: WHIZARD_VERSION
print "(A)", "WHIZARD " // WHIZARD_VERSION
print "(A)", "Usage: whizard [OPTIONS] [FILE]"
print "(A)", "Run WHIZARD with the command list taken from FILE(s)"
print "(A)", "Options for resetting default directories and tools" &
// "(GNU naming conventions):"
print "(A)", " --prefix DIR"
print "(A)", " --exec-prefix DIR"
print "(A)", " --bindir DIR"
print "(A)", " --libdir DIR"
print "(A)", " --includedir DIR"
print "(A)", " --datarootdir DIR"
print "(A)", " --libtool LOCAL_LIBTOOL"
print "(A)", " --lhapdfdir DIR (PDF sets directory)"
print "(A)", "Other options:"
print "(A)", "-h, --help display this help and exit"
print "(A)", " --banner display banner at startup (default)"
print "(A)", " --debug AREA switch on debug output for AREA."
print "(A)", " AREA can be one of Whizard's src dirs or 'all'"
print "(A)", " --debug2 AREA switch on more verbose debug output for AREA."
print "(A)", " --single-event only compute one phase-space point (for debugging)"
print "(A)", "-e, --execute CMDS execute SINDARIN CMDS before reading FILE(s)"
print "(A)", "-i, --interactive run interactively after reading FILE(s)"
print "(A)", "-J, --job-id STRING set job ID to STRING (default: empty)"
print "(A)", "-l, --library LIB preload process library NAME"
print "(A)", " --localprefix DIR"
print "(A)", " search in DIR for local models (default: ~/.whizard)"
print "(A)", "-L, --logfile FILE write log to FILE (default: 'whizard.log'"
print "(A)", " --logging switch on logging at startup (default)"
print "(A)", "-m, --model NAME preload model NAME (default: 'SM')"
print "(A)", " --no-banner do not display banner at startup"
print "(A)", " --no-library do not preload process library"
print "(A)", " --no-logfile do not write a logfile"
print "(A)", " --no-logging switch off logging at startup"
print "(A)", " --no-model do not preload a model"
print "(A)", " --no-rebuild do not force rebuilding"
+ print "(A)", " --pack DIR tar/gzip DIR after job"
print "(A)", "-q, --query VARIABLE display documentation of VARIABLE"
print "(A)", "-r, --rebuild rebuild all (see below)"
print "(A)", " --rebuild-library"
print "(A)", " rebuild process code library"
print "(A)", " --rebuild-user rebuild user-provided code"
print "(A)", " --rebuild-phase-space"
print "(A)", " rebuild phase-space configuration"
print "(A)", " --rebuild-grids rebuild integration grids"
print "(A)", " --rebuild-events rebuild event samples"
print "(A)", " --recompile recompile process code"
print "(A)", " --show-config show build-time configuration"
+ print "(A)", " --unpack FILE untar/gunzip FILE before job"
print "(A)", "-u --user enable user-provided code"
print "(A)", " --user-src FILE user-provided source file"
print "(A)", " --user-lib FILE user-provided library file"
print "(A)", " --user-target BN basename of created user library (default: user)"
print "(A)", "-V, --version output version information and exit"
print "(A)", " --write-syntax-tables"
print "(A)", " write the internal syntax tables to files and exit"
print "(A)", "- further options are taken as filenames"
print *
print "(A)", "With no FILE, read standard input."
end subroutine print_usage
@ %def main
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Driver program for the unit tests}
This is a variant of the above main program that takes unit-test names
as command-line options and runs those tests.
<<[[main_ut.f90]]>>=
<<File header>>
program main_ut
<<Use strings>>
use unit_tests
use io_units
use system_dependencies
use diagnostics
use os_interface
use cmdline_options
use model_testbed !NODEP!
<<Use mpi f08>>
<<Main: use tests>>
implicit none
<<Main: cmdline arg len declaration>>
!!! (WK 02/2016) Interface for the separate external routine below
interface
subroutine print_usage ()
end subroutine print_usage
end interface
! Main program variable declarations
character(CMDLINE_ARG_LEN) :: arg
character(2) :: option
type(string_t) :: long_option, value
integer :: i, j, arg_len, arg_status
logical :: look_for_options
logical :: banner
type(string_t) :: check, checks
type(test_results_t) :: test_results
logical :: success
! Exit status
integer :: quit_code = 0
! Initial values
look_for_options = .true.
banner = .true.
logging = .false.
msg_level = RESULT
check = ""
checks = ""
<<Main: MPI init>>
! Read and process options
call init_options (print_usage)
i = 0
SCAN_CMDLINE: do
i = i + 1
call get_command_argument (i, arg, arg_len, arg_status)
select case (arg_status)
case (0)
case (-1)
call msg_error (" Command argument truncated: '" // arg // "'")
case default
exit SCAN_CMDLINE
end select
if (look_for_options) then
select case (arg(1:2))
case ("--")
value = trim (arg)
call split (value, long_option, "=")
select case (char (long_option))
case ("--version")
call no_option_value (long_option, value)
call print_version (); stop
case ("--help")
call no_option_value (long_option, value)
call print_usage (); stop
case ("--banner")
call no_option_value (long_option, value)
banner = .true.
cycle SCAN_CMDLINE
case ("--no-banner")
call no_option_value (long_option, value)
banner = .false.
cycle SCAN_CMDLINE
case ("--check")
check = get_option_value (i, long_option, value)
checks = checks // " " // check
cycle SCAN_CMDLINE
case ("--debug")
call no_option_value (long_option, value)
call set_debug_levels (get_option_value (i, long_option, value))
cycle SCAN_CMDLINE
case ("--debug2")
call no_option_value (long_option, value)
call set_debug2_levels (get_option_value (i, long_option, value))
cycle SCAN_CMDLINE
case default
call print_usage ()
call msg_fatal ("Option '" // trim (arg) // "' not recognized")
end select
end select
select case (arg(1:1))
case ("-")
j = 1
if (len_trim (arg) == 1) then
look_for_options = .false.
else
SCAN_SHORT_OPTIONS: do
j = j + 1
if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
option = "-" // arg(j:j)
select case (option)
case ("-V")
call print_version (); stop
case ("-?", "-h")
call print_usage (); stop
case default
call print_usage ()
call msg_fatal &
("Option '" // option // "' not recognized")
end select
end do SCAN_SHORT_OPTIONS
end if
case default
call print_usage ()
call msg_fatal ("Option '" // trim (arg) // "' not recognized")
end select
else
call print_usage ()
call msg_fatal ("Option '" // trim (arg) // "' not recognized")
end if
end do SCAN_CMDLINE
! Overall initialization
if (banner) call msg_banner ()
! Run any self-checks (and no commands)
if (checks /= "") then
checks = trim (adjustl (checks))
RUN_CHECKS: do while (checks /= "")
call split (checks, check, " ")
call whizard_check (check, test_results)
end do RUN_CHECKS
call test_results%wrapup (6, success)
if (.not. success) quit_code = 7
end if
<<Main: MPI finalize>>
call msg_terminate (quit_code = quit_code)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
contains
subroutine print_version ()
print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
print "(A)", "Copyright (C) 1999-2018 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
print "(A)", " --------------------------------------- "
print "(A)", "This is free software; see the source for copying conditions. There is NO"
print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
print *
end subroutine print_version
<<Main: tests>>
end program main_ut
!!! (WK 02/2016)
!!! Separate subroutine, because this becomes a procedure pointer target
!!! Internal procedures as targets are not supported by some compilers.
subroutine print_usage ()
use system_dependencies, only: WHIZARD_VERSION
print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
print "(A)", "Usage: whizard_ut [OPTIONS] [FILE]"
print "(A)", "Run WHIZARD unit tests as given on the command line"
print "(A)", "Options:"
print "(A)", "-h, --help display this help and exit"
print "(A)", " --banner display banner at startup (default)"
print "(A)", " --no-banner do not display banner at startup"
print "(A)", " --debug AREA switch on debug output for AREA."
print "(A)", " AREA can be one of Whizard's src dirs or 'all'"
print "(A)", " --debug2 AREA switch on more verbose debug output for AREA."
print "(A)", "-V, --version output version information and exit"
print "(A)", " --check TEST run unit test TEST"
end subroutine print_usage
@ %def main_ut
@
<<Main: MPI init>>=
@
<<Main: MPI finalize>>=
@
@ MPI init.
<<MPI: Main: MPI init>>=
call MPI_init ()
<<MPI: Main: MPI finalize>>=
call MPI_finalize ()
@ %def MPI_init MPI_finalize
<<Main: dependent flags>>=
@
Every rebuild action is forbidden for the slave workers except
[[rebuild_grids]], which is handled correctly inside the corresponding
integration object.
<<MPI: Main: dependent flags>>=
if (.not. mpi_is_comm_master ()) then
options%rebuild_library = .false.
options%recompile_library = .false.
options%rebuild_user = .false.
options%rebuild_phs = .false.
options%rebuild_events = .false.
end if
@
\subsection{Self-tests}
For those self-tests, we need some auxiliary routines that provide an
enviroment. The environment depends on things that are not available at the
level of the module that we want to test.
\subsubsection{Testbed for event I/O}
This subroutine prepares a test process with a single event. All objects are
allocated via anonymous pointers, because we want to recover the pointers and
delete the objects in a separate procedure.
<<Main: tests>>=
subroutine prepare_eio_test (event, unweighted, n_alt)
use variables, only: var_list_t
use model_data
use process, only: process_t
use instances, only: process_instance_t
use processes_ut, only: prepare_test_process
use event_base
use events
class(generic_event_t), intent(inout), pointer :: event
logical, intent(in), optional :: unweighted
integer, intent(in), optional :: n_alt
type(model_data_t), pointer :: model
type(var_list_t) :: var_list
type(process_t), pointer :: proc
type(process_instance_t), pointer :: process_instance
allocate (model)
call model%init_test ()
allocate (proc)
allocate (process_instance)
call prepare_test_process (proc, process_instance, model)
call process_instance%setup_event_data ()
call model%final ()
deallocate (model)
allocate (event_t :: event)
select type (event)
type is (event_t)
if (present (unweighted)) then
call var_list%append_log (&
var_str ("?unweighted"), unweighted, &
intrinsic = .true.)
else
call var_list%append_log (&
var_str ("?unweighted"), .true., &
intrinsic = .true.)
end if
call var_list%append_string (&
var_str ("$sample_normalization"), &
var_str ("auto"), intrinsic = .true.)
call event%basic_init (var_list, n_alt)
call event%connect (process_instance, proc%get_model_ptr ())
call var_list%final ()
end select
end subroutine prepare_eio_test
@ %def prepare_eio_test_event
@ Recover those pointers, finalize the objects and deallocate.
<<Main: tests>>=
subroutine cleanup_eio_test (event)
use model_data
use process, only: process_t
use instances, only: process_instance_t
use processes_ut, only: cleanup_test_process
use event_base
use events
class(generic_event_t), intent(inout), pointer :: event
type(process_t), pointer :: proc
type(process_instance_t), pointer :: process_instance
select type (event)
type is (event_t)
proc => event%get_process_ptr ()
process_instance => event%get_process_instance_ptr ()
call cleanup_test_process (proc, process_instance)
deallocate (process_instance)
deallocate (proc)
call event%final ()
end select
deallocate (event)
end subroutine cleanup_eio_test
@ %def cleanup_eio_test_event
@ Assign those procedures to appropriate pointers (module variables) in the
[[eio_base]] module, so they can be called as if they were module procedures.
<<Main: use tests>>=
use eio_base_ut, only: eio_prepare_test
use eio_base_ut, only: eio_cleanup_test
<<Main: prepare testbed>>=
eio_prepare_test => prepare_eio_test
eio_cleanup_test => cleanup_eio_test
@
\subsubsection{Any Model}
This procedure reads any model from file and, optionally, assigns a
var-list pointer.
<<Main: tests>>=
subroutine prepare_whizard_model (model, name, vars)
<<Use strings>>
use os_interface
use model_data
use var_base
use models
class(model_data_t), intent(inout), pointer :: model
type(string_t), intent(in) :: name
class(vars_t), pointer, intent(out), optional :: vars
type(os_data_t) :: os_data
call syntax_model_file_init ()
call os_data_init (os_data)
allocate (model_t :: model)
select type (model)
type is (model_t)
call model%read (name // ".mdl", os_data)
if (present (vars)) then
vars => model%get_var_list_ptr ()
end if
end select
end subroutine prepare_whizard_model
@ %def prepare_whizard_model
@ Cleanup after use. Includes deletion of the model-file syntax.
<<Main: tests>>=
subroutine cleanup_whizard_model (model)
use model_data
use models
class(model_data_t), intent(inout), pointer :: model
call model%final ()
deallocate (model)
call syntax_model_file_final ()
end subroutine cleanup_whizard_model
@ %def cleanup_whizard_model
@ Assign those procedures to appropriate pointers (module variables) in the
[[model_testbed]] module, so they can be called as if they were module
procedures.
<<Main: prepare testbed>>=
prepare_model => prepare_whizard_model
cleanup_model => cleanup_whizard_model
@
\subsubsection{Fallback model: hadrons}
Some event format tests require the hadronic SM implementation, which
has to be read from file. We provide the functionality here, so the
tests do not depend on model I/O.
<<Main: tests>>=
subroutine prepare_fallback_model (model)
use model_data
class(model_data_t), intent(inout), pointer :: model
call prepare_whizard_model (model, var_str ("SM_hadrons"))
end subroutine prepare_fallback_model
@ %def prepare_fallback_model
@ Assign those procedures to appropriate pointers (module variables) in the
[[eio_base]] module, so they can be called as if they were module procedures.
<<Main: use tests>>=
use eio_base_ut, only: eio_prepare_fallback_model
use eio_base_ut, only: eio_cleanup_fallback_model
<<Main: prepare testbed>>=
eio_prepare_fallback_model => prepare_fallback_model
eio_cleanup_fallback_model => cleanup_model
@
\subsubsection{Access to the test random-number generator}
This generator is not normally available for the dispatcher. We assign an
additional dispatch routine to the hook in the [[dispatch]] module
which will be checked before the default rule.
<<Main: use tests>>=
use dispatch_rng, only: dispatch_rng_factory_extra
use dispatch_rng_ut, only: dispatch_rng_factory_test
<<Main: prepare testbed>>=
dispatch_rng_factory_extra => dispatch_rng_factory_test
@
\subsubsection{Access to the test structure functions}
These are not normally available for the dispatcher. We assign an
additional dispatch routine to the hook in the [[dispatch]] module
which will be checked before the default rule.
<<Main: use tests>>=
use dispatch_beams, only: dispatch_sf_data_extra
use dispatch_ut, only: dispatch_sf_data_test
<<Main: prepare testbed>>=
dispatch_sf_data_extra => dispatch_sf_data_test
@
\subsubsection{Procedure for Checking}
This is for developers only, but needs a well-defined interface.
<<Main: tests>>=
subroutine whizard_check (check, results)
type(string_t), intent(in) :: check
type(test_results_t), intent(inout) :: results
type(os_data_t) :: os_data
integer :: u
call os_data_init (os_data)
u = free_unit ()
open (u, file="whizard_check." // char (check) // ".log", &
action="write", status="replace")
call msg_message (repeat ('=', 76), 0)
call msg_message ("Running self-test: " // char (check), 0)
call msg_message (repeat ('-', 76), 0)
<<Main: prepare testbed>>
select case (char (check))
<<Main: test cases>>
case ("all")
<<Main: all tests>>
case default
call msg_fatal ("Self-test '" // char (check) // "' not implemented.")
end select
close (u)
end subroutine whizard_check
@ %def whizard_check
@
\subsection{Unit test references}
\subsubsection{Formats}
<<Main: use tests>>=
use formats_ut, only: format_test
<<Main: test cases>>=
case ("formats")
call format_test (u, results)
<<Main: all tests>>=
call format_test (u, results)
@
\subsubsection{MD5}
<<Main: use tests>>=
use md5_ut, only: md5_test
<<Main: test cases>>=
case ("md5")
call md5_test (u, results)
<<Main: all tests>>=
call md5_test (u, results)
@
\subsubsection{OS Interface}
<<Main: use tests>>=
use os_interface_ut, only: os_interface_test
<<Main: test cases>>=
case ("os_interface")
call os_interface_test (u, results)
<<Main: all tests>>=
call os_interface_test (u, results)
@
\subsubsection{Sorting}
<<Main: use tests>>=
use sorting_ut, only: sorting_test
<<Main: test cases>>=
case ("sorting")
call sorting_test (u, results)
<<Main: all tests>>=
call sorting_test (u, results)
@
\subsubsection{Grids}
<<Main: use tests>>=
use grids_ut, only: grids_test
<<Main: test cases>>=
case ("grids")
call grids_test (u, results)
<<Main: all tests>>=
call grids_test (u, results)
@
\subsubsection{Solver}
<<Main: use tests>>=
use solver_ut, only: solver_test
<<Main: test cases>>=
case ("solver")
call solver_test (u, results)
<<Main: all tests>>=
call solver_test (u, results)
@
\subsubsection{CPU Time}
<<Main: use tests>>=
use cputime_ut, only: cputime_test
<<Main: test cases>>=
case ("cputime")
call cputime_test (u, results)
<<Main: all tests>>=
call cputime_test (u, results)
@
\subsubsection{SM QCD}
<<Main: use tests>>=
use sm_qcd_ut, only: sm_qcd_test
<<Main: test cases>>=
case ("sm_qcd")
call sm_qcd_test (u, results)
<<Main: all tests>>=
call sm_qcd_test (u, results)
@
\subsubsection{SM physics}
<<Main: use tests>>=
use sm_physics_ut, only: sm_physics_test
<<Main: test cases>>=
case ("sm_physics")
call sm_physics_test (u, results)
<<Main: all tests>>=
call sm_physics_test (u, results)
@
\subsubsection{Lexers}
<<Main: use tests>>=
use lexers_ut, only: lexer_test
<<Main: test cases>>=
case ("lexers")
call lexer_test (u, results)
<<Main: all tests>>=
call lexer_test (u, results)
@
\subsubsection{Parser}
<<Main: use tests>>=
use parser_ut, only: parse_test
<<Main: test cases>>=
case ("parser")
call parse_test (u, results)
<<Main: all tests>>=
call parse_test (u, results)
@
\subsubsection{XML}
<<Main: use tests>>=
use xml_ut, only: xml_test
<<Main: test cases>>=
case ("xml")
call xml_test (u, results)
<<Main: all tests>>=
call xml_test (u, results)
@
\subsubsection{Colors}
<<Main: use tests>>=
use colors_ut, only: color_test
<<Main: test cases>>=
case ("colors")
call color_test (u, results)
<<Main: all tests>>=
call color_test (u, results)
@
\subsubsection{State matrices}
<<Main: use tests>>=
use state_matrices_ut, only: state_matrix_test
<<Main: test cases>>=
case ("state_matrices")
call state_matrix_test (u, results)
<<Main: all tests>>=
call state_matrix_test (u, results)
@
\subsubsection{Analysis}
<<Main: use tests>>=
use analysis_ut, only: analysis_test
<<Main: test cases>>=
case ("analysis")
call analysis_test (u, results)
<<Main: all tests>>=
call analysis_test (u, results)
@
\subsubsection{Particles}
<<Main: use tests>>=
use particles_ut, only: particles_test
<<Main: test cases>>=
case ("particles")
call particles_test (u, results)
<<Main: all tests>>=
call particles_test (u, results)
@
\subsubsection{Models}
<<Main: use tests>>=
use models_ut, only: models_test
<<Main: test cases>>=
case ("models")
call models_test (u, results)
<<Main: all tests>>=
call models_test (u, results)
@
\subsubsection{Auto Components}
<<Main: use tests>>=
use auto_components_ut, only: auto_components_test
<<Main: test cases>>=
case ("auto_components")
call auto_components_test (u, results)
<<Main: all tests>>=
call auto_components_test (u, results)
@
\subsubsection{Radiation Generator}
<<Main: use tests>>=
use radiation_generator_ut, only: radiation_generator_test
<<Main: test cases>>=
case ("radiation_generator")
call radiation_generator_test (u, results)
<<Main: all tests>>=
call radiation_generator_test (u, results)
@
\subsection{BLHA}
<<Main: use tests>>=
use blha_ut, only: blha_test
<<Main: test cases>>=
case ("blha")
call blha_test (u, results)
<<Main: all tests>>=
call blha_test (u, results)
@
\subsubsection{Evaluators}
<<Main: use tests>>=
use evaluators_ut, only: evaluator_test
<<Main: test cases>>=
case ("evaluators")
call evaluator_test (u, results)
<<Main: all tests>>=
call evaluator_test (u, results)
@
\subsubsection{Expressions}
<<Main: use tests>>=
use eval_trees_ut, only: expressions_test
<<Main: test cases>>=
case ("expressions")
call expressions_test (u, results)
<<Main: all tests>>=
call expressions_test (u, results)
@
\subsubsection{Resonances}
<<Main: use tests>>=
use resonances_ut, only: resonances_test
<<Main: test cases>>=
case ("resonances")
call resonances_test (u, results)
<<Main: all tests>>=
call resonances_test (u, results)
@
\subsubsection{PHS Trees}
<<Main: use tests>>=
use phs_trees_ut, only: phs_trees_test
<<Main: test cases>>=
case ("phs_trees")
call phs_trees_test (u, results)
<<Main: all tests>>=
call phs_trees_test (u, results)
@
\subsubsection{PHS Forests}
<<Main: use tests>>=
use phs_forests_ut, only: phs_forests_test
<<Main: test cases>>=
case ("phs_forests")
call phs_forests_test (u, results)
<<Main: all tests>>=
call phs_forests_test (u, results)
@
\subsubsection{Beams}
<<Main: use tests>>=
use beams_ut, only: beams_test
<<Main: test cases>>=
case ("beams")
call beams_test (u, results)
<<Main: all tests>>=
call beams_test (u, results)
@
\subsubsection{$su(N)$ Algebra}
<<Main: use tests>>=
use su_algebra_ut, only: su_algebra_test
<<Main: test cases>>=
case ("su_algebra")
call su_algebra_test (u, results)
<<Main: all tests>>=
call su_algebra_test (u, results)
@
\subsubsection{Bloch Vectors}
<<Main: use tests>>=
use bloch_vectors_ut, only: bloch_vectors_test
<<Main: test cases>>=
case ("bloch_vectors")
call bloch_vectors_test (u, results)
<<Main: all tests>>=
call bloch_vectors_test (u, results)
@
\subsubsection{Polarizations}
<<Main: use tests>>=
use polarizations_ut, only: polarizations_test
<<Main: test cases>>=
case ("polarizations")
call polarizations_test (u, results)
<<Main: all tests>>=
call polarizations_test (u, results)
@
\subsubsection{SF Aux}
<<Main: use tests>>=
use sf_aux_ut, only: sf_aux_test
<<Main: test cases>>=
case ("sf_aux")
call sf_aux_test (u, results)
<<Main: all tests>>=
call sf_aux_test (u, results)
@
\subsubsection{SF Mappings}
<<Main: use tests>>=
use sf_mappings_ut, only: sf_mappings_test
<<Main: test cases>>=
case ("sf_mappings")
call sf_mappings_test (u, results)
<<Main: all tests>>=
call sf_mappings_test (u, results)
@
\subsubsection{SF Base}
<<Main: use tests>>=
use sf_base_ut, only: sf_base_test
<<Main: test cases>>=
case ("sf_base")
call sf_base_test (u, results)
<<Main: all tests>>=
call sf_base_test (u, results)
@
\subsubsection{SF PDF Builtin}
<<Main: use tests>>=
use sf_pdf_builtin_ut, only: sf_pdf_builtin_test
<<Main: test cases>>=
case ("sf_pdf_builtin")
call sf_pdf_builtin_test (u, results)
<<Main: all tests>>=
call sf_pdf_builtin_test (u, results)
@
\subsubsection{SF LHAPDF}
<<Main: use tests>>=
use sf_lhapdf_ut, only: sf_lhapdf_test
<<Main: test cases>>=
case ("sf_lhapdf")
call sf_lhapdf_test (u, results)
<<Main: all tests>>=
call sf_lhapdf_test (u, results)
@
\subsubsection{SF ISR}
<<Main: use tests>>=
use sf_isr_ut, only: sf_isr_test
<<Main: test cases>>=
case ("sf_isr")
call sf_isr_test (u, results)
<<Main: all tests>>=
call sf_isr_test (u, results)
@
\subsubsection{SF EPA}
<<Main: use tests>>=
use sf_epa_ut, only: sf_epa_test
<<Main: test cases>>=
case ("sf_epa")
call sf_epa_test (u, results)
<<Main: all tests>>=
call sf_epa_test (u, results)
@
\subsubsection{SF EWA}
<<Main: use tests>>=
use sf_ewa_ut, only: sf_ewa_test
<<Main: test cases>>=
case ("sf_ewa")
call sf_ewa_test (u, results)
<<Main: all tests>>=
call sf_ewa_test (u, results)
@
\subsubsection{SF CIRCE1}
<<Main: use tests>>=
use sf_circe1_ut, only: sf_circe1_test
<<Main: test cases>>=
case ("sf_circe1")
call sf_circe1_test (u, results)
<<Main: all tests>>=
call sf_circe1_test (u, results)
@
\subsubsection{SF CIRCE2}
<<Main: use tests>>=
use sf_circe2_ut, only: sf_circe2_test
<<Main: test cases>>=
case ("sf_circe2")
call sf_circe2_test (u, results)
<<Main: all tests>>=
call sf_circe2_test (u, results)
@
\subsubsection{SF Gaussian}
<<Main: use tests>>=
use sf_gaussian_ut, only: sf_gaussian_test
<<Main: test cases>>=
case ("sf_gaussian")
call sf_gaussian_test (u, results)
<<Main: all tests>>=
call sf_gaussian_test (u, results)
@
\subsubsection{SF Beam Events}
<<Main: use tests>>=
use sf_beam_events_ut, only: sf_beam_events_test
<<Main: test cases>>=
case ("sf_beam_events")
call sf_beam_events_test (u, results)
<<Main: all tests>>=
call sf_beam_events_test (u, results)
@
\subsubsection{SF EScan}
<<Main: use tests>>=
use sf_escan_ut, only: sf_escan_test
<<Main: test cases>>=
case ("sf_escan")
call sf_escan_test (u, results)
<<Main: all tests>>=
call sf_escan_test (u, results)
@
\subsubsection{PHS Base}
<<Main: use tests>>=
use phs_base_ut, only: phs_base_test
<<Main: test cases>>=
case ("phs_base")
call phs_base_test (u, results)
<<Main: all tests>>=
call phs_base_test (u, results)
@
\subsubsection{PHS None}
<<Main: use tests>>=
use phs_none_ut, only: phs_none_test
<<Main: test cases>>=
case ("phs_none")
call phs_none_test (u, results)
<<Main: all tests>>=
call phs_none_test (u, results)
@
\subsubsection{PHS Single}
<<Main: use tests>>=
use phs_single_ut, only: phs_single_test
<<Main: test cases>>=
case ("phs_single")
call phs_single_test (u, results)
<<Main: all tests>>=
call phs_single_test (u, results)
@
\subsubsection{PHS Wood}
<<Main: use tests>>=
use phs_wood_ut, only: phs_wood_test
use phs_wood_ut, only: phs_wood_vis_test
<<Main: test cases>>=
case ("phs_wood")
call phs_wood_test (u, results)
case ("phs_wood_vis")
call phs_wood_vis_test (u, results)
<<Main: all tests>>=
call phs_wood_test (u, results)
call phs_wood_vis_test (u, results)
@
\subsubsection{PHS FKS Generator}
<<Main: use tests>>=
use phs_fks_ut, only: phs_fks_generator_test
<<Main: test cases>>=
case ("phs_fks_generator")
call phs_fks_generator_test (u, results)
<<Main: all tests>>=
call phs_fks_generator_test (u, results)
@
\subsubsection{FKS regions}
<<Main: use tests>>=
use fks_regions_ut, only: fks_regions_test
<<Main: test cases>>=
case ("fks_regions")
call fks_regions_test (u, results)
<<Main: all tests>>=
call fks_regions_test (u, results)
@
\subsubsection{Real subtraction}
<<Main: use tests>>=
use real_subtraction_ut, only: real_subtraction_test
<<Main: test cases>>=
case ("real_subtraction")
call real_subtraction_test (u, results)
<<Main: all tests>>=
call real_subtraction_test (u, results)
@
\subsubsection{RECOLA}
<<Main: use tests>>=
use prc_recola_ut, only: prc_recola_test
<<Main: test cases>>=
case ("prc_recola")
call prc_recola_test (u, results)
<<Main: all tests>>=
call prc_recola_test (u, results)
@
\subsubsection{RNG Base}
<<Main: use tests>>=
use rng_base_ut, only: rng_base_test
<<Main: test cases>>=
case ("rng_base")
call rng_base_test (u, results)
<<Main: all tests>>=
call rng_base_test (u, results)
@
\subsubsection{RNG Tao}
<<Main: use tests>>=
use rng_tao_ut, only: rng_tao_test
<<Main: test cases>>=
case ("rng_tao")
call rng_tao_test (u, results)
<<Main: all tests>>=
call rng_tao_test (u, results)
@
\subsubsection{RNG Stream}
<<Main: use tests>>=
use rng_stream_ut, only: rng_stream_test
<<Main: test cases>>=
case ("rng_stream")
call rng_stream_test (u, results)
<<Main: all tests>>=
call rng_stream_test (u, results)
@
\subsubsection{Selectors}
<<Main: use tests>>=
use selectors_ut, only: selectors_test
<<Main: test cases>>=
case ("selectors")
call selectors_test (u, results)
<<Main: all tests>>=
call selectors_test (u, results)
@
\subsubsection{VEGAS}
<<Main: use tests>>=
use vegas_ut, only: vegas_test
<<Main: test cases>>=
case ("vegas")
call vegas_test (u, results)
<<Main: all tests>>=
call vegas_test (u, results)
@
\subsubsection{VAMP2}
<<Main: use tests>>=
use vamp2_ut, only: vamp2_test
<<Main: test cases>>=
case ("vamp2")
call vamp2_test (u, results)
<<Main: all tests>>=
call vamp2_test (u, results)
@
\subsubsection{MCI Base}
<<Main: use tests>>=
use mci_base_ut, only: mci_base_test
<<Main: test cases>>=
case ("mci_base")
call mci_base_test (u, results)
<<Main: all tests>>=
call mci_base_test (u, results)
@
\subsubsection{MCI None}
<<Main: use tests>>=
use mci_none_ut, only: mci_none_test
<<Main: test cases>>=
case ("mci_none")
call mci_none_test (u, results)
<<Main: all tests>>=
call mci_none_test (u, results)
@
\subsubsection{MCI Midpoint}
<<Main: use tests>>=
use mci_midpoint_ut, only: mci_midpoint_test
<<Main: test cases>>=
case ("mci_midpoint")
call mci_midpoint_test (u, results)
<<Main: all tests>>=
call mci_midpoint_test (u, results)
@
\subsubsection{MCI VAMP}
<<Main: use tests>>=
use mci_vamp_ut, only: mci_vamp_test
<<Main: test cases>>=
case ("mci_vamp")
call mci_vamp_test (u, results)
<<Main: all tests>>=
call mci_vamp_test (u, results)
@
\subsubsection{MCI VAMP2}
<<Main: use tests>>=
use mci_vamp2_ut, only: mci_vamp2_test
<<Main: test cases>>=
case ("mci_vamp2")
call mci_vamp2_test (u, results)
<<Main: all tests>>=
call mci_vamp2_test (u, results)
@
\subsubsection{Integration Results}
<<Main: use tests>>=
use integration_results_ut, only: integration_results_test
<<Main: test cases>>=
case ("integration_results")
call integration_results_test (u, results)
<<Main: all tests>>=
call integration_results_test (u, results)
@
\subsubsection{PRCLib Interfaces}
<<Main: use tests>>=
use prclib_interfaces_ut, only: prclib_interfaces_test
<<Main: test cases>>=
case ("prclib_interfaces")
call prclib_interfaces_test (u, results)
<<Main: all tests>>=
call prclib_interfaces_test (u, results)
@
\subsubsection{Particle Specifiers}
<<Main: use tests>>=
use particle_specifiers_ut, only: particle_specifiers_test
<<Main: test cases>>=
case ("particle_specifiers")
call particle_specifiers_test (u, results)
<<Main: all tests>>=
call particle_specifiers_test (u, results)
@
\subsubsection{Process Libraries}
<<Main: use tests>>=
use process_libraries_ut, only: process_libraries_test
<<Main: test cases>>=
case ("process_libraries")
call process_libraries_test (u, results)
<<Main: all tests>>=
call process_libraries_test (u, results)
@
\subsubsection{PRCLib Stacks}
<<Main: use tests>>=
use prclib_stacks_ut, only: prclib_stacks_test
<<Main: test cases>>=
case ("prclib_stacks")
call prclib_stacks_test (u, results)
<<Main: all tests>>=
call prclib_stacks_test (u, results)
@
\subsubsection{HepMC}
<<Main: use tests>>=
use hepmc_interface_ut, only: hepmc_interface_test
<<Main: test cases>>=
case ("hepmc")
call hepmc_interface_test (u, results)
<<Main: all tests>>=
call hepmc_interface_test (u, results)
@
\subsubsection{LCIO}
<<Main: use tests>>=
use lcio_interface_ut, only: lcio_interface_test
<<Main: test cases>>=
case ("lcio")
call lcio_interface_test (u, results)
<<Main: all tests>>=
call lcio_interface_test (u, results)
@
\subsubsection{Jets}
<<Main: use tests>>=
use jets_ut, only: jets_test
<<Main: test cases>>=
case ("jets")
call jets_test (u, results)
<<Main: all tests>>=
call jets_test (u, results)
@
\subsubsection{PDG Arrays}
<<Main: use tests>>=
use pdg_arrays_ut, only: pdg_arrays_test
<<Main: test cases>>=
case ("pdg_arrays")
call pdg_arrays_test (u, results)
<<Main: all tests>>=
call pdg_arrays_test (u, results)
@
\subsubsection{interactions}
<<Main: use tests>>=
use interactions_ut, only: interaction_test
<<Main: test cases>>=
case ("interactions")
call interaction_test (u, results)
<<Main: all tests>>=
call interaction_test (u, results)
@
\subsubsection{SLHA}
<<Main: use tests>>=
use slha_interface_ut, only: slha_test
<<Main: test cases>>=
case ("slha_interface")
call slha_test (u, results)
<<Main: all tests>>=
call slha_test (u, results)
@
\subsubsection{Cascades}
<<Main: use tests>>=
use cascades_ut, only: cascades_test
<<Main: test cases>>=
case ("cascades")
call cascades_test (u, results)
<<Main: all tests>>=
call cascades_test (u, results)
@
\subsubsection{Cascades2 lexer}
<<Main: use tests>>=
use cascades2_lexer_ut, only: cascades2_lexer_test
<<Main: test cases>>=
case ("cascades2_lexer")
call cascades2_lexer_test (u, results)
<<Main: all tests>>=
call cascades2_lexer_test (u, results)
@
\subsubsection{Cascades2}
<<Main: use tests>>=
use cascades2_ut, only: cascades2_test
<<Main: test cases>>=
case ("cascades2")
call cascades2_test (u, results)
<<Main: all tests>>=
call cascades2_test (u, results)
@
\subsubsection{PRC Test}
<<Main: use tests>>=
use prc_test_ut, only: prc_test_test
<<Main: test cases>>=
case ("prc_test")
call prc_test_test (u, results)
<<Main: all tests>>=
call prc_test_test (u, results)
@
\subsubsection{PRC Template ME}
<<Main: use tests>>=
use prc_template_me_ut, only: prc_template_me_test
<<Main: test cases>>=
case ("prc_template_me")
call prc_template_me_test (u, results)
<<Main: all tests>>=
call prc_template_me_test (u, results)
@
\subsubsection{PRC OMega}
<<Main: use tests>>=
use prc_omega_ut, only: prc_omega_test
use prc_omega_ut, only: prc_omega_diags_test
<<Main: test cases>>=
case ("prc_omega")
call prc_omega_test (u, results)
case ("prc_omega_diags")
call prc_omega_diags_test (u, results)
<<Main: all tests>>=
call prc_omega_test (u, results)
call prc_omega_diags_test (u, results)
@
\subsubsection{Parton States}
<<Main: use tests>>=
use parton_states_ut, only: parton_states_test
<<Main: test cases>>=
case ("parton_states")
call parton_states_test (u, results)
<<Main: all tests>>=
call parton_states_test (u, results)
@
\subsubsection{Subevt Expr}
<<Main: use tests>>=
use expr_tests_ut, only: subevt_expr_test
<<Main: test cases>>=
case ("subevt_expr")
call subevt_expr_test (u, results)
<<Main: all tests>>=
call subevt_expr_test (u, results)
@
\subsubsection{Processes}
<<Main: use tests>>=
use processes_ut, only: processes_test
<<Main: test cases>>=
case ("processes")
call processes_test (u, results)
<<Main: all tests>>=
call processes_test (u, results)
@
\subsubsection{Process Stacks}
<<Main: use tests>>=
use process_stacks_ut, only: process_stacks_test
<<Main: test cases>>=
case ("process_stacks")
call process_stacks_test (u, results)
<<Main: all tests>>=
call process_stacks_test (u, results)
@
\subsubsection{Event Transforms}
<<Main: use tests>>=
use event_transforms_ut, only: event_transforms_test
<<Main: test cases>>=
case ("event_transforms")
call event_transforms_test (u, results)
<<Main: all tests>>=
call event_transforms_test (u, results)
@
\subsubsection{Resonance Insertion Transform}
<<Main: use tests>>=
use resonance_insertion_ut, only: resonance_insertion_test
<<Main: test cases>>=
case ("resonance_insertion")
call resonance_insertion_test (u, results)
<<Main: all tests>>=
call resonance_insertion_test (u, results)
@
\subsubsection{Recoil Kinematics}
<<Main: use tests>>=
use recoil_kinematics_ut, only: recoil_kinematics_test
<<Main: test cases>>=
case ("recoil_kinematics")
call recoil_kinematics_test (u, results)
<<Main: all tests>>=
call recoil_kinematics_test (u, results)
@
\subsubsection{ISR Handler}
<<Main: use tests>>=
use isr_epa_handler_ut, only: isr_handler_test
<<Main: test cases>>=
case ("isr_handler")
call isr_handler_test (u, results)
<<Main: all tests>>=
call isr_handler_test (u, results)
@
\subsubsection{EPA Handler}
<<Main: use tests>>=
use isr_epa_handler_ut, only: epa_handler_test
<<Main: test cases>>=
case ("epa_handler")
call epa_handler_test (u, results)
<<Main: all tests>>=
call epa_handler_test (u, results)
@
\subsubsection{Decays}
<<Main: use tests>>=
use decays_ut, only: decays_test
<<Main: test cases>>=
case ("decays")
call decays_test (u, results)
<<Main: all tests>>=
call decays_test (u, results)
@
\subsubsection{Shower}
<<Main: use tests>>=
use shower_ut, only: shower_test
<<Main: test cases>>=
case ("shower")
call shower_test (u, results)
<<Main: all tests>>=
call shower_test (u, results)
@
\subsubsection{Events}
<<Main: use tests>>=
use events_ut, only: events_test
<<Main: test cases>>=
case ("events")
call events_test (u, results)
<<Main: all tests>>=
call events_test (u, results)
@
\subsubsection{HEP Events}
<<Main: use tests>>=
use hep_events_ut, only: hep_events_test
<<Main: test cases>>=
case ("hep_events")
call hep_events_test (u, results)
<<Main: all tests>>=
call hep_events_test (u, results)
@
\subsubsection{EIO Data}
<<Main: use tests>>=
use eio_data_ut, only: eio_data_test
<<Main: test cases>>=
case ("eio_data")
call eio_data_test (u, results)
<<Main: all tests>>=
call eio_data_test (u, results)
@
\subsubsection{EIO Base}
<<Main: use tests>>=
use eio_base_ut, only: eio_base_test
<<Main: test cases>>=
case ("eio_base")
call eio_base_test (u, results)
<<Main: all tests>>=
call eio_base_test (u, results)
@
\subsubsection{EIO Direct}
<<Main: use tests>>=
use eio_direct_ut, only: eio_direct_test
<<Main: test cases>>=
case ("eio_direct")
call eio_direct_test (u, results)
<<Main: all tests>>=
call eio_direct_test (u, results)
@
\subsubsection{EIO Raw}
<<Main: use tests>>=
use eio_raw_ut, only: eio_raw_test
<<Main: test cases>>=
case ("eio_raw")
call eio_raw_test (u, results)
<<Main: all tests>>=
call eio_raw_test (u, results)
@
\subsubsection{EIO Checkpoints}
<<Main: use tests>>=
use eio_checkpoints_ut, only: eio_checkpoints_test
<<Main: test cases>>=
case ("eio_checkpoints")
call eio_checkpoints_test (u, results)
<<Main: all tests>>=
call eio_checkpoints_test (u, results)
@
\subsubsection{EIO LHEF}
<<Main: use tests>>=
use eio_lhef_ut, only: eio_lhef_test
<<Main: test cases>>=
case ("eio_lhef")
call eio_lhef_test (u, results)
<<Main: all tests>>=
call eio_lhef_test (u, results)
@
\subsubsection{EIO HepMC}
<<Main: use tests>>=
use eio_hepmc_ut, only: eio_hepmc_test
<<Main: test cases>>=
case ("eio_hepmc")
call eio_hepmc_test (u, results)
<<Main: all tests>>=
call eio_hepmc_test (u, results)
@
\subsubsection{EIO LCIO}
<<Main: use tests>>=
use eio_lcio_ut, only: eio_lcio_test
<<Main: test cases>>=
case ("eio_lcio")
call eio_lcio_test (u, results)
<<Main: all tests>>=
call eio_lcio_test (u, results)
@
\subsubsection{EIO StdHEP}
<<Main: use tests>>=
use eio_stdhep_ut, only: eio_stdhep_test
<<Main: test cases>>=
case ("eio_stdhep")
call eio_stdhep_test (u, results)
<<Main: all tests>>=
call eio_stdhep_test (u, results)
@
\subsubsection{EIO ASCII}
<<Main: use tests>>=
use eio_ascii_ut, only: eio_ascii_test
<<Main: test cases>>=
case ("eio_ascii")
call eio_ascii_test (u, results)
<<Main: all tests>>=
call eio_ascii_test (u, results)
@
\subsubsection{EIO Weights}
<<Main: use tests>>=
use eio_weights_ut, only: eio_weights_test
<<Main: test cases>>=
case ("eio_weights")
call eio_weights_test (u, results)
<<Main: all tests>>=
call eio_weights_test (u, results)
@
\subsubsection{EIO Dump}
<<Main: use tests>>=
use eio_dump_ut, only: eio_dump_test
<<Main: test cases>>=
case ("eio_dump")
call eio_dump_test (u, results)
<<Main: all tests>>=
call eio_dump_test (u, results)
@
\subsubsection{Iterations}
<<Main: use tests>>=
use iterations_ut, only: iterations_test
<<Main: test cases>>=
case ("iterations")
call iterations_test (u, results)
<<Main: all tests>>=
call iterations_test (u, results)
@
\subsubsection{Beam Structures}
<<Main: use tests>>=
use beam_structures_ut, only: beam_structures_test
<<Main: test cases>>=
case ("beam_structures")
call beam_structures_test (u, results)
<<Main: all tests>>=
call beam_structures_test (u, results)
@
\subsubsection{RT Data}
<<Main: use tests>>=
use rt_data_ut, only: rt_data_test
<<Main: test cases>>=
case ("rt_data")
call rt_data_test (u, results)
<<Main: all tests>>=
call rt_data_test (u, results)
@
\subsubsection{Dispatch}
<<Main: use tests>>=
use dispatch_ut, only: dispatch_test
<<Main: test cases>>=
case ("dispatch")
call dispatch_test (u, results)
<<Main: all tests>>=
call dispatch_test (u, results)
@
\subsubsection{Dispatch RNG}
<<Main: use tests>>=
use dispatch_rng_ut, only: dispatch_rng_test
<<Main: test cases>>=
case ("dispatch_rng")
call dispatch_rng_test (u, results)
<<Main: all tests>>=
call dispatch_rng_test (u, results)
@
\subsubsection{Dispatch MCI}
<<Main: use tests>>=
use dispatch_mci_ut, only: dispatch_mci_test
<<Main: test cases>>=
case ("dispatch_mci")
call dispatch_mci_test (u, results)
<<Main: all tests>>=
call dispatch_mci_test (u, results)
@
\subsubsection{Dispatch PHS}
<<Main: use tests>>=
use dispatch_phs_ut, only: dispatch_phs_test
<<Main: test cases>>=
case ("dispatch_phs")
call dispatch_phs_test (u, results)
<<Main: all tests>>=
call dispatch_phs_test (u, results)
@
\subsubsection{Dispatch transforms}
<<Main: use tests>>=
use dispatch_transforms_ut, only: dispatch_transforms_test
<<Main: test cases>>=
case ("dispatch_transforms")
call dispatch_transforms_test (u, results)
<<Main: all tests>>=
call dispatch_transforms_test (u, results)
@
\subsubsection{Shower partons}
<<Main: use tests>>=
use shower_base_ut, only: shower_base_test
<<Main: test cases>>=
case ("shower_base")
call shower_base_test (u, results)
<<Main: all tests>>=
call shower_base_test (u, results)
@
\subsubsection{Process Configurations}
<<Main: use tests>>=
use process_configurations_ut, only: process_configurations_test
<<Main: test cases>>=
case ("process_configurations")
call process_configurations_test (u, results)
<<Main: all tests>>=
call process_configurations_test (u, results)
@
\subsubsection{Compilations}
<<Main: use tests>>=
use compilations_ut, only: compilations_test
use compilations_ut, only: compilations_static_test
<<Main: test cases>>=
case ("compilations")
call compilations_test (u, results)
case ("compilations_static")
call compilations_static_test (u, results)
<<Main: all tests>>=
call compilations_test (u, results)
call compilations_static_test (u, results)
@
\subsubsection{Integrations}
<<Main: use tests>>=
use integrations_ut, only: integrations_test
use integrations_ut, only: integrations_history_test
<<Main: test cases>>=
case ("integrations")
call integrations_test (u, results)
case ("integrations_history")
call integrations_history_test (u, results)
<<Main: all tests>>=
call integrations_test (u, results)
call integrations_history_test (u, results)
@
\subsubsection{Event Streams}
<<Main: use tests>>=
use event_streams_ut, only: event_streams_test
<<Main: test cases>>=
case ("event_streams")
call event_streams_test (u, results)
<<Main: all tests>>=
call event_streams_test (u, results)
@
\subsubsection{Restricted Subprocesses}
<<Main: use tests>>=
use restricted_subprocesses_ut, only: restricted_subprocesses_test
<<Main: test cases>>=
case ("restricted_subprocesses")
call restricted_subprocesses_test (u, results)
<<Main: all tests>>=
call restricted_subprocesses_test (u, results)
@
\subsubsection{Simulations}
<<Main: use tests>>=
use simulations_ut, only: simulations_test
<<Main: test cases>>=
case ("simulations")
call simulations_test (u, results)
<<Main: all tests>>=
call simulations_test (u, results)
@
\subsubsection{Commands}
<<Main: use tests>>=
use commands_ut, only: commands_test
<<Main: test cases>>=
case ("commands")
call commands_test (u, results)
<<Main: all tests>>=
call commands_test (u, results)
@
\subsubsection{$ttV$ formfactors}
<<Main: use tests>>=
use ttv_formfactors_ut, only: ttv_formfactors_test
<<Main: test cases>>=
case ("ttv_formfactors")
call ttv_formfactors_test (u, results)
<<Main: all tests>>=
call ttv_formfactors_test (u, results)
@
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Whizard-C-Interface}
<<[[whizard-c-interface.f90]]>>=
<<File header>>
<<Whizard-C-Interface: Internals>>
<<Whizard-C-Interface: Init and Finalize>>
<<Whizard-C-Interface: Interfaced Commads>>
<<Whizard-C-Interface: HepMC>>
@
<<Whizard-C-Interface: Internals>>=
subroutine c_whizard_convert_string (c_string, f_string)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
character(kind=c_char), intent(in) :: c_string(*)
type(string_t), intent(inout) :: f_string
character(len=1) :: dummy_char
integer :: dummy_i = 1
f_string = ""
do
if (c_string(dummy_i) == c_null_char) then
exit
else if (c_string(dummy_i) == c_new_line) then
dummy_char = CHAR(13)
f_string = f_string // dummy_char
dummy_char = CHAR(10)
else
dummy_char = c_string (dummy_i)
end if
f_string = f_string // dummy_char
dummy_i = dummy_i + 1
end do
dummy_i = 1
end subroutine c_whizard_convert_string
subroutine c_whizard_commands (w_c_instance, cmds)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
use commands
use diagnostics
use lexers
use models
use parser
use whizard
type(c_ptr), intent(inout) :: w_c_instance
type(whizard_t), pointer :: whizard_instance
type(string_t) :: cmds
type(parse_tree_t) :: parse_tree
type(parse_node_t), pointer :: pn_root
type(stream_t), target :: stream
type(lexer_t) :: lexer
type(command_list_t), target :: cmd_list
call c_f_pointer (w_c_instance, whizard_instance)
call lexer_init_cmd_list (lexer)
call syntax_cmd_list_init ()
call stream_init (stream, cmds)
call lexer_assign_stream (lexer, stream)
call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
pn_root => parse_tree%get_root_ptr ()
if (associated (pn_root)) then
call cmd_list%compile (pn_root, whizard_instance%global)
end if
call whizard_instance%global%activate ()
call cmd_list%execute (whizard_instance%global)
call cmd_list%final ()
call parse_tree_final (parse_tree)
call stream_final (stream)
call lexer_final (lexer)
call syntax_cmd_list_final ()
end subroutine c_whizard_commands
@
<<Whizard-C-Interface: Init and Finalize>>=
subroutine c_whizard_init (w_c_instance) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
use system_dependencies
use diagnostics
use ifiles
use os_interface
use whizard
implicit none
<<Main: cmdline arg len declaration>>
type(c_ptr), intent(out) :: w_c_instance
logical :: banner
type(string_t) :: files, model, default_lib, library, libraries
! type(string_t) :: check, checks
type(string_t) :: logfile
type(string_t) :: user_src, user_lib
type(paths_t) :: paths
logical :: rebuild_library, rebuild_user
logical :: rebuild_phs, rebuild_grids, rebuild_events
type(whizard_options_t), allocatable :: options
type(whizard_t), pointer :: whizard_instance
! Initial values
files = ""
model = "SM"
default_lib = "default_lib"
library = ""
libraries = ""
banner = .true.
logging = .true.
logfile = "whizard.log"
! check = ""
! checks = ""
user_src = ""
user_lib = ""
rebuild_library = .false.
rebuild_user = .false.
rebuild_phs = .false.
rebuild_grids = .false.
rebuild_events = .false.
call paths_init (paths)
! Overall initialization
if (logfile /= "") call logfile_init (logfile)
call mask_term_signals ()
if (banner) call msg_banner ()
! Set options and initialize the whizard object
allocate (options)
options%preload_model = model
options%default_lib = default_lib
options%preload_libraries = libraries
options%rebuild_library = rebuild_library
options%rebuild_user = rebuild_user
options%rebuild_phs = rebuild_phs
options%rebuild_grids = rebuild_grids
options%rebuild_events = rebuild_events
allocate (whizard_instance)
call whizard_instance%init (options, paths)
! if (checks /= "") then
! checks = trim (adjustl (checks))
! RUN_CHECKS: do while (checks /= "")
! call split (checks, check, " ")
! call whizard_check (check, test_results)
! end do RUN_CHECKS
! call test_results%wrapup (6, success)
! if (.not. success) quit_code = 7
! quit = .true.
! end if
w_c_instance = c_loc (whizard_instance)
end subroutine c_whizard_init
subroutine c_whizard_finalize (w_c_instance) bind(C)
use, intrinsic :: iso_c_binding
use system_dependencies
use diagnostics
use ifiles
use os_interface
use whizard
type(c_ptr), intent(in) :: w_c_instance
type(whizard_t), pointer :: whizard_instance
integer :: quit_code = 0
call c_f_pointer (w_c_instance, whizard_instance)
call whizard_instance%final ()
deallocate (whizard_instance)
call terminate_now_if_signal ()
call release_term_signals ()
call msg_terminate (quit_code = quit_code)
end subroutine c_whizard_finalize
subroutine c_whizard_process_string (w_c_instance, c_cmds_in) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
character(kind=c_char) :: c_cmds_in(*)
type(string_t) :: f_cmds
call c_whizard_convert_string (c_cmds_in, f_cmds)
call c_whizard_commands (w_c_instance, f_cmds)
end subroutine c_whizard_process_string
@
<<Whizard-C-Interface: Interfaced Commads>>=
subroutine c_whizard_model (w_c_instance, c_model) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
character(kind=c_char) :: c_model(*)
type(string_t) :: model, mdl_str
call c_whizard_convert_string (c_model, model)
mdl_str = "model = " // model
call c_whizard_commands (w_c_instance, mdl_str)
end subroutine c_whizard_model
subroutine c_whizard_library (w_c_instance, c_library) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
character(kind=c_char) :: c_library(*)
type(string_t) :: library, lib_str
call c_whizard_convert_string(c_library, library)
lib_str = "library = " // library
call c_whizard_commands (w_c_instance, lib_str)
end subroutine c_whizard_library
subroutine c_whizard_process (w_c_instance, c_id, c_in, c_out) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
character(kind=c_char) :: c_id(*), c_in(*), c_out(*)
type(string_t) :: proc_str, id, in, out
call c_whizard_convert_string (c_id, id)
call c_whizard_convert_string (c_in, in)
call c_whizard_convert_string (c_out, out)
proc_str = "process " // id // " = " // in // " => " // out
call c_whizard_commands (w_c_instance, proc_str)
end subroutine c_whizard_process
subroutine c_whizard_compile (w_c_instance) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
type(c_ptr), intent(inout) :: w_c_instance
type(string_t) :: cmp_str
cmp_str = "compile"
call c_whizard_commands (w_c_instance, cmp_str)
end subroutine c_whizard_compile
subroutine c_whizard_beams (w_c_instance, c_specs) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
character(kind=c_char) :: c_specs(*)
type(string_t) :: specs, beam_str
call c_whizard_convert_string (c_specs, specs)
beam_str = "beams = " // specs
call c_whizard_commands (w_c_instance, beam_str)
end subroutine c_whizard_beams
subroutine c_whizard_integrate (w_c_instance, c_process) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
character(kind=c_char) :: c_process(*)
type(string_t) :: process, int_str
call c_whizard_convert_string (c_process, process)
int_str = "integrate (" // process //")"
call c_whizard_commands (w_c_instance, int_str)
end subroutine c_whizard_integrate
subroutine c_whizard_matrix_element_test &
(w_c_instance, c_process, n_calls) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
integer(kind=c_int) :: n_calls
character(kind=c_char) :: c_process(*)
type(string_t) :: process, me_str
character(len=8) :: buffer
call c_whizard_convert_string (c_process, process)
write (buffer, "(I0)") n_calls
me_str = "integrate (" // process // ") { ?phs_only = true" // &
" n_calls_test = " // trim (buffer)
call c_whizard_commands (w_c_instance, me_str)
end subroutine c_whizard_matrix_element_test
subroutine c_whizard_simulate (w_c_instance, c_id) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
character(kind=c_char) :: c_id(*)
type(string_t) :: sim_str, id
call c_whizard_convert_string(c_id, id)
sim_str = "simulate (" // id // ")"
call c_whizard_commands (w_c_instance, sim_str)
end subroutine c_whizard_simulate
subroutine c_whizard_sqrts (w_c_instance, c_value, c_unit) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
type(c_ptr), intent(inout) :: w_c_instance
character(kind=c_char) :: c_unit(*)
integer(kind=c_int) :: c_value
integer :: f_value
character(len=8) :: f_val
type(string_t) :: val, unit, sqrts_str
f_value = c_value
write (f_val,'(i8)') f_value
val = f_val
call c_whizard_convert_string (c_unit, unit)
sqrts_str = "sqrts =" // val // unit
call c_whizard_commands (w_c_instance, sqrts_str)
end subroutine c_whizard_sqrts
@
<<Whizard-C-Interface: HepMC>>=
type(c_ptr) function c_whizard_hepmc_test &
(w_c_instance, c_id, c_proc_id, c_event_id) bind(C)
use, intrinsic :: iso_c_binding
use iso_varying_string, string_t => varying_string !NODEP!
use commands
use diagnostics
use events
use hepmc_interface
use lexers
use models
use parser
use instances
use rt_data
use simulations
use whizard
use os_interface
implicit none
type(c_ptr), intent(inout) :: w_c_instance
type(string_t) :: sim_str
type(parse_tree_t) :: parse_tree
type(parse_node_t), pointer :: pn_root
type(stream_t), target :: stream
type(lexer_t) :: lexer
type(command_list_t), pointer :: cmd_list
type(whizard_t), pointer :: whizard_instance
type(simulation_t), target :: sim
character(kind=c_char), intent(in) :: c_id(*)
type(string_t) :: id
integer(kind=c_int), value :: c_proc_id, c_event_id
integer :: proc_id
type(hepmc_event_t), pointer :: hepmc_event
call c_f_pointer (w_c_instance, whizard_instance)
call c_whizard_convert_string (c_id, id)
sim_str = "simulate (" // id // ")"
proc_id = c_proc_id
allocate (hepmc_event)
call hepmc_event_init (hepmc_event, c_proc_id, c_event_id)
call syntax_cmd_list_init ()
call lexer_init_cmd_list (lexer)
call stream_init (stream, sim_str)
call lexer_assign_stream (lexer, stream)
call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
pn_root => parse_tree%get_root_ptr ()
allocate (cmd_list)
if (associated (pn_root)) then
call cmd_list%compile (pn_root, whizard_instance%global)
end if
call sim%init ([id], .true., .true., whizard_instance%global)
!!! This should generate a HepMC event as hepmc_event_t type
call msg_message ("Not enabled for the moment.")
call sim%final ()
call cmd_list%final ()
call parse_tree_final (parse_tree)
call stream_final (stream)
call lexer_final (lexer)
call syntax_cmd_list_final ()
c_whizard_hepmc_test = c_loc(hepmc_event)
return
end function c_whizard_hepmc_test
@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Index: trunk/src/gamelan/Makefile.am
===================================================================
--- trunk/src/gamelan/Makefile.am (revision 8157)
+++ trunk/src/gamelan/Makefile.am (revision 8158)
@@ -1,188 +1,188 @@
## Makefile.am -- Makefile for WHIZARD
##
#
# Copyright (C) 1999-2018 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.
#
########################################################################
## Process this file with automake to produce Makefile.in
## Install the gml executable and WHIZARD logo here:
GML=whizard-gml
-gmlexeclibdir = $(PKGLIBDIR)/gamelan
-gmlexecbindir = $(BINDIR)
+gmlexeclibdir = $(pkglibdir)/gamelan
+gmlexecbindir = $(bindir)
dist_gmlexecbin_SCRIPTS = $(GML)
## Install the gml MetaPost code here:
-gmllibdir = $(PKGLIBDIR)/gamelan
+gmllibdir = $(pkglibdir)/gamelan
## The NOWEB source and the test / demofiles generated from it must be distributed,
## but not installed.
dist_noinst_DATA = \
gamelan.nw \
$(GML_TEX_EXAMPLES_SRC) $(GML_TEX_EXAMPLES_DAT) \
$(GML_TEX_TEST_SRC) $(GML_TEX_TEST_DAT)
## Mem files are no longer existent in MetaPost, hence we need to install
## all the gamelan includes.
dist_gmllib_DATA = $(GML_MPOST_SRC) $(GML_WHIZARD_LOGO)
## Distribute the style file and color definition files, and install them here:
gmltexdir = $(PKGTEXDIR)
dist_gmltex_DATA = \
$(GML_STY) \
$(GML_TEX_SRC)
## ---------------------------------------------------------------
## File lists
## Contents of gamelan.nw
GML_FROM_GAMELAN_NW = \
$(GML_MPOST_SRC) $(GML_STY) $(GML_TEX_SRC) \
$(GML_TEX_EXAMPLES_SRC) $(GML_TEX_EXAMPLES_DAT) \
$(GML_TEX_TEST_SRC) $(GML_TEX_TEST_DAT) $(GML_WHIZARD_LOGO)
## The WHIZARD logo as EPS file
GML_WHIZARD_LOGO = \
Whizard-Logo.eps
## Gamelan MetaPost sources
GML_MPOST_SRC = \
gamelan.mp \
gmlaux.mp gmlhatch.mp gmlbox.mp gmlshapes.mp gmlspectra.mp \
gmlarith.mp gmlformat.mp gmlfiles.mp gmlset.mp gmlscan.mp \
gmlcoords.mp gmldraw.mp gmlgrid.mp gmleps.mp
## LaTeX style file
GML_STY = \
gamelan.sty
## Color definitions, to be included upon request:
GML_TEX_SRC = \
gmlcolors.tex gmlextracolors.tex
## Examples for gamelan usage:
GML_TEX_EXAMPLES_SRC = \
gmlfun.tex gmldata.tex gmlerr.tex gmlimp.tex
GML_TEX_EXAMPLES_DAT = \
gmldata.dat gmlerr.dat
GML_TEX_EXAMPLES_MP = \
gmlfun.mp gmldata.mp gmlerr.mp gmlimp.mp
GML_TEX_EXAMPLES_TARGETS = \
gmlfun.ps gmldata.ps gmlerr.ps gmlimp.ps
## Self-tests
GML_TEX_TEST_SRC = \
gmltest.tex gmllongtest.tex
GML_TEX_TEST_DAT = \
gmllongtest.dat
GML_TEX_TEST_MP = \
gmltest.mp gmllongtest.mp
GML_TEX_TEST_TARGETS =
if DVIPS_AVAILABLE
GML_TEX_TEST_TARGETS += \
gmltest.ps gmllongtest.ps
endif
## --------------------------------------------------------------------
## Special targets
## The 'check' rule consists of building these PS files from TEX sources:
check: $(GML_TEX_TEST_TARGETS)
## These examples can be built upon request:
examples: $(GML_TEX_EXAMPLES_TARGETS)
## don't try to run the examples in parallel (TeXLive 2009 doesn't like it)
gmllongtest.ps: gmltest.ps
## Run texhash to include the style file in the TeX search path
install-data-hook:
test -x `which texhash` && texhash
## Create sources from the noweb file, if possible
if NOWEB_AVAILABLE
gamelan.stamp: $(srcdir)/gamelan.nw
@rm -f gamelan.tmp
@touch gamelan.tmp
for src in $(GML_FROM_GAMELAN_NW); do \
$(NOTANGLE) -R$$src $< | $(CPIF) $$src; \
done
@mv -f gamelan.tmp gamelan.stamp
$(GML_FROM_GAMELAN_NW): gamelan.stamp
## Recover from the removal of $@
@if test -f $@; then :; else \
rm -f gamelan.stamp; \
$(MAKE) $(AM_MAKEFLAGS) gamelan.stamp; \
fi
endif
## Implicit rule for building test and examples
## If noweb is not available copy the stuff over
if NOWEB_AVAILABLE
.tex.ps:
$(LATEX) $*
./whizard-gml $*
$(LATEX) $*
$(DVIPS) -o $@ $*
else !NOWEB_AVAILABLE
.tex.ps:
-if test "$(srcdir)" != "."; then \
for file in $(GML_FROM_GAMELAN_NW); do \
test -f "$$file" || cp $(srcdir)/$$file .; \
done; \
fi
$(LATEX) $*
./whizard-gml $*
$(LATEX) $*
$(DVIPS) -o $@ $*
endif
## Non-standard cleanup tasks
if NOWEB_AVAILABLE
maintainer-clean-noweb:
-rm -f $(GML_FROM_GAMELAN_NW)
endif
.PHONY: maintainer-clean-noweb
## Remove these sources also if builddir and srcdir are different
if NOWEB_AVAILABLE
clean-noweb:
-rm -f gamelan.stamp gamelan.tmp
test "$(srcdir)" != "." && rm -f $(GML_FROM_GAMELAN_NW) || true
-rm -f $(GML_TEX_EXAMPLES_MP) $(GML_TEX_TEST_MP)
else !NOWEB_AVAILABLE
clean-noweb:
test "$(srcdir)" != "." && rm -f *.sty *.tex *.mp *.dat *.eps || true
endif
.PHONY: clean-noweb
## Remove test
clean-local: clean-noweb
-rm -f *.ps *.pool *.aux *.dvi *.idx *.log *.toc
-rm -f *.mpx *.sh *.tmp *.1 *.ltp
## Remove backup files
maintainer-clean-local: maintainer-clean-noweb
-rm -f *~

File Metadata

Mime Type
application/octet-stream
Expires
Wed, May 8, 9:25 AM (1 d, 23 h)
Storage Engine
chunks
Storage Format
Chunks
Storage Handle
IMGF3qPvapIW
Default Alt Text
(5 MB)

Event Timeline