No OneTemporary
Actions

Size

264 KB

Subscribers

None

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.

	Index: trunk/src/blha/Makefile.am
	===================================================================
	--- trunk/src/blha/Makefile.am (revision 8789)
	+++ trunk/src/blha/Makefile.am (revision 8790)
	@@ -1,237 +1,253 @@
	## Makefile.am -- Makefile for WHIZARD
	##
	## Process this file with automake to produce Makefile.in
	#
	# Copyright (C) 1999-2022 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	## The files in this directory interface the BLHA amplitude calculator

	## We create a library which is still to be combined with auxiliary libs.
	noinst_LTLIBRARIES = libblha.la
	check_LTLIBRARIES = libblha_ut.la

	COMMON_F90 = \
	- blha_olp_interfaces.f90
	+ blha_olp_interfaces.f90 \
	+ blha_config.f90
	MPI_F90 = \
	- blha_config.f90_mpi
	+ blha_config_sub.f90_mpi
	SERIAL_F90 = \
	- blha_config.f90_serial
	+ blha_config_sub.f90_serial
	+BLHA_SUBMODULES = \
	+ blha_olp_interfaces_sub.f90
	+
	+BLHA_MODULES = \
	+ $(COMMON_F90)

	EXTRA_DIST = \
	$(COMMON_F90) \
	+ $(BLHA_SUBMODULES) \
	$(SERIAL_F90) \
	$(MPI_F90)

	nodist_libblha_la_SOURCES = \
	- blha_config.f90 \
	- $(COMMON_F90)
	+ $(BLHA_MODULES) \
	+ blha_config_sub.f90 \
	+ $(BLHA_SUBMODULES)

	-DISTCLEANFILES = blha_config.f90
	+DISTCLEANFILES = blha_config_sub.f90

	if FC_USE_MPI
	-blha_config.f90: blha_config.f90_mpi
	+blha_config_sub.f90: blha_config_sub.f90_mpi
	-cp -f $< $@
	else
	-blha_config.f90: blha_config.f90_serial
	+blha_config_sub.f90: blha_config_sub.f90_serial
	-cp -f $< $@
	endif

	libblha_ut_la_SOURCES = \
	blha_uti.f90 blha_ut.f90

	## Omitting this would exclude it from the distribution
	dist_noinst_DATA = blha.nw

	# Modules and installation
	# Dump module names into file Modules
	execmoddir = $(fmoddir)/whizard
	nodist_execmod_HEADERS = \
	${libblha_la_SOURCES:.f90=.$(FCMOD)} \
	blha_olp_interfaces.$(FCMOD) \
	blha_config.$(FCMOD)

	libblha_Modules = $(nodist_libblha_la_SOURCES:.f90=) $(libblha_ut_la_SOURCES:.f90=)
	Modules: Makefile
	@for module in $(libblha_Modules); do \
	echo $$module >> $@.new; \
	done
	@if diff $@ $@.new -q >/dev/null; then \
	rm $@.new; \
	else \
	mv $@.new $@; echo "Modules updated"; \
	fi
	BUILT_SOURCES = Modules

	## Fortran module dependencies
	# Get module lists from other directories
	module_lists = \
	../basics/Modules \
	../utilities/Modules \
	../testing/Modules \
	../system/Modules \
	../combinatorics/Modules \
	../parsing/Modules \
	../physics/Modules \
	../qft/Modules \
	../expr_base/Modules \
	../types/Modules \
	../variables/Modules \
	../model_features/Modules \
	../matrix_elements/Modules \
	../particles/Modules \
	../threshold/Modules \
	../beams/Modules \
	../me_methods/Modules

	include_modules_bare = ${module_lists:/Modules=}
	include_modules = ${include_modules_bare:../%=-I../%}

	$(module_lists):
	$(MAKE) -C `dirname $@` Modules

	Module_dependencies.sed: $(nodist_libblha_la_SOURCES) $(libblha_ut_la_SOURCES)
	Module_dependencies.sed: $(module_lists)
	@rm -f $@
	echo 's/, only:.//' >> $@
	echo 's/, *&//' >> $@
	echo 's/, .=>.*//' >> $@
	echo 's/$$/.lo/' >> $@
	for list in $(module_lists); do \
	dir="`dirname $$list`"; \
	for mod in `cat $$list`; do \
	echo 's!: '$$mod'.lo$$!': $$dir/$$mod'.lo!' >> $@; \
	done \
	done

	DISTCLEANFILES += Module_dependencies.sed

	# The following line just says
	# include Makefile.depend
	# but in a portable fashion (depending on automake's AM_MAKE_INCLUDE
	@am__include@ @am__quote@Makefile.depend@am__quote@

	Makefile.depend: Module_dependencies.sed
	Makefile.depend: $(nodist_libblha_la_SOURCES) $(libblha_ut_la_SOURCES)
	@rm -f $@
	for src in $^; do \
	module="`basename $$src \| sed 's/\.f[90][0358]//'`"; \
	grep '^ *use ' $$src \
	\| grep -v '!NODEP!' \
	\| sed -e 's/^ use /'$$module'.lo: /' \
	-f Module_dependencies.sed; \
	done > $@

	DISTCLEANFILES += Makefile.depend

	# Fortran90 module files are generated at the same time as object files
	.lo.$(FCMOD):
	@:
	# touch $@

	AM_FCFLAGS = $(include_modules) -I../fastjet -I../pdf_builtin -I../lhapdf

	########################################################################
	+# For the moment, the submodule dependencies will be hard-coded
	+blha_config_sub.lo: blha_config.lo
	+blha_olp_interfaces_sub.lo: blha_olp_interfaces.lo
	+
	+########################################################################
	## Default Fortran compiler options

	## Profiling
	if FC_USE_PROFILING
	AM_FCFLAGS += $(FCFLAGS_PROFILING)
	endif

	## OpenMP
	if FC_USE_OPENMP
	AM_FCFLAGS += $(FCFLAGS_OPENMP)
	endif

	# MPI
	if FC_USE_MPI
	AM_FCFLAGS += $(FCFLAGS_MPI)
	endif

	########################################################################
	## Non-standard targets and dependencies

	## (Re)create F90 sources from NOWEB source.
	if NOWEB_AVAILABLE

	FILTER = -filter "sed 's/defn MPI:/defn/'"

	PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw
	POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw

	blha.stamp: $(PRELUDE) $(srcdir)/blha.nw $(POSTLUDE)
	@rm -f blha.tmp
	@touch blha.tmp
	for src in $(COMMON_F90) $(libblha_ut_la_SOURCES); do \
	$(NOTANGLE) -R[[$$src]] $^ \| $(CPIF) $$src; \
	done
	+ for src in $(BLHA_SUBMODULES); do \
	+ $(NOTANGLE) -R[[$$src]] $^ \| $(CPIF) $$src; \
	+ done
	for src in $(SERIAL_F90:.f90_serial=.f90); do \
	$(NOTANGLE) -R[[$$src]] $^ \| $(CPIF) $$src'_serial'; \
	done
	for src in $(MPI_F90:.f90_mpi=.f90); do \
	$(NOTANGLE) -R[[$$src]] $(FILTER) $^ \| $(CPIF) $$src'_mpi'; \
	done
	@mv -f blha.tmp blha.stamp

	-$(COMMON_F90) $(SERIAL_F90) $(MPI_F90) $(libblha_ut_la_SOURCES): blha.stamp
	+$(COMMON_F90) $(BLHA_SUBMODULES) $(SERIAL_F90) $(MPI_F90) $(libblha_ut_la_SOURCES): blha.stamp
	## Recover from the removal of $@
	@if test -f $@; then :; else \
	rm -f blha.stamp; \
	$(MAKE) $(AM_MAKEFLAGS) blha.stamp; \
	fi

	endif


	########################################################################
	## Non-standard cleanup tasks
	## Remove sources that can be recreated using NOWEB
	if NOWEB_AVAILABLE
	maintainer-clean-noweb:
	-rm -f .f90 .f90_serial .f90_mpi .c
	endif
	.PHONY: maintainer-clean-noweb

	## Remove those sources also if builddir and srcdir are different
	if NOWEB_AVAILABLE
	clean-noweb:
	test "$(srcdir)" != "." && rm -f .f90 .f90_serial .f90_mpi .c \|\| true
	endif
	.PHONY: clean-noweb

	## Remove F90 module files
	clean-local: clean-noweb
	-rm -f blha.stamp blha.tmp
	-rm -f *.$(FCMOD)
	if FC_SUBMODULES
	-rm -f .smod .sub
	endif

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	maintainer-clean-local: maintainer-clean-noweb maintainer-clean-backup
	Index: trunk/src/blha/blha.nw
	===================================================================
	--- trunk/src/blha/blha.nw (revision 8789)
	+++ trunk/src/blha/blha.nw (revision 8790)
	@@ -1,3713 +1,4255 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: matrix elements and process libraries
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{BLHA Interface}
	\includemodulegraph{blha}

	The code in this chapter implements support for the BLHA record that
	communicates data for NLO processes.

	These are the modules:
	\begin{description}
	\item[blha\_config]
	-\item[blha\_interface]
	-\item[blha\_driver]
	+\item[blha\_olp\_interfaces]
	\end{description}

	+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	+The module is split into a configuration interface which manages configuration
	+and handles the request and contract files, a module which interfaces the OLP
	+matrix elements and a driver.
	+
	+<<[[blha_config.f90]]>>=
	+<<File header>>
	+
	+module blha_config
	+
	+ use kinds
	+<<Use strings>>
	+ use variables, only: var_list_t
	+ use model_data
	+ use beam_structures, only: beam_structure_t
	+
	+<<Standard module head>>
	+
	+<<BLHA config: public>>
	+
	+<<BLHA config: parameters>>
	+
	+<<BLHA config: types>>
	+
	+<<BLHA config: variables>>
	+
	+<<BLHA config: interfaces>>
	+
	+ interface
	+<<BLHA config: sub interfaces>>
	+ end interface
	+
	+end module blha_config
	+
	+@ %def blha_config
	+@
	+<<[[blha_config_sub.f90]]>>=
	+<<File header>>
	+
	+submodule (blha_config) blha_config_s
	+
	+<<Use mpi f08>>
	+ use io_units
	+ use constants
	+ use string_utils
	+ use physics_defs, only: PHOTON, PHOTON_OFFSHELL
	+ use diagnostics
	+ use flavors
	+ use pdg_arrays
	+
	+ implicit none
	+
	+contains
	+
	+<<BLHA config: procedures>>
	+
	+end submodule blha_config_s
	+
	+@ %def blha_config_s
	+@
	+\section{Configuration}
	+
	+Parameters to enumerate the different options in the order.
	+<<BLHA config: parameters>>=
	+ integer, public, parameter :: &
	+ BLHA_CT_QCD = 1, BLHA_CT_EW = 2, BLHA_CT_OTHER = 3
	+ integer, public, parameter :: &
	+ BLHA_IRREG_CDR = 1, BLHA_IRREG_DRED = 2, BLHA_IRREG_THV = 3, &
	+ BLHA_IRREG_MREG = 4, BLHA_IRREG_OTHER = 5
	+ integer, public, parameter :: &
	+ BLHA_MPS_ONSHELL = 1, BLHA_MPS_OTHER = 2
	+ integer, public, parameter :: &
	+ BLHA_MODE_GOSAM = 1, BLHA_MODE_FEYNARTS = 2, BLHA_MODE_GENERIC = 3, &
	+ BLHA_MODE_OPENLOOPS = 4
	+ integer, public, parameter :: &
	+ BLHA_VERSION_1 = 1, BLHA_VERSION_2 = 2
	+ integer, public, parameter :: &
	+ BLHA_AMP_LOOP = 1, BLHA_AMP_COLOR_C = 2, BLHA_AMP_SPIN_C = 3, &
	+ BLHA_AMP_TREE = 4, BLHA_AMP_LOOPINDUCED = 5
	+ integer, public, parameter :: &
	+ BLHA_EW_INTERNAL = 0, &
	+ BLHA_EW_GF = 1, BLHA_EW_MZ = 2, BLHA_EW_MSBAR = 3, &
	+ BLHA_EW_0 = 4, BLHA_EW_RUN = 5
	+ integer, public, parameter :: &
	+ BLHA_WIDTH_COMPLEX = 1, BLHA_WIDTH_FIXED = 2, &
	+ BLHA_WIDTH_RUNNING = 3, BLHA_WIDTH_POLE = 4, &
	+ BLHA_WIDTH_DEFAULT = 5
	+
	+@ %def blha_ct_qcd blha_ct_ew blha_ct_other
	+@ %def blha_irreg_cdr blha_irreg_dred blha_irreg_thv blha_irreg_mreg blha_irreg_other
	+@ %def blha_mps_onshell blha_mps_other
	+@ %def blha_mode_gosam blha_mode_feynarts blha_mode_generic
	+@ %def blha version blha_amp blha_ew blha_width
	+@
	+Those are the default pdg codes for massive particles in BLHA programs
	+<<BLHA config: parameters>>=
	+ integer, parameter, public :: OLP_N_MASSIVE_PARTICLES = 12
	+ integer, dimension(OLP_N_MASSIVE_PARTICLES), public :: &
	+ OLP_MASSIVE_PARTICLES = [5, -5, 6, -6, 13, -13, 15, -15, 23, 24, -24, 25]
	+ integer, parameter :: OLP_HEL_UNPOLARIZED = 0
	+
	+@ %def OLP_MASSIVE_PARTICLES
	+@ The user might provide an extra command string for OpenLoops to
	+apply special libraries instead of the default ones, such as
	+signal-only amplitudes for off-shell top production. We check in this
	+subroutine that the provided string is valid and print out the
	+possible options to ease the user's memory.
	+<<BLHA config: parameters>>=
	+ integer, parameter :: N_KNOWN_SPECIAL_OL_METHODS = 3
	+<<BLHA config: procedures>>=
	+ subroutine check_extra_cmd (extra_cmd)
	+ type(string_t), intent(in) :: extra_cmd
	+ type(string_t), dimension(N_KNOWN_SPECIAL_OL_METHODS) :: known_methods
	+ integer :: i
	+ logical :: found
	+ known_methods(1) = 'top'
	+ known_methods(2) = 'not'
	+ known_methods(3) = 'stop'
	+ if (extra_cmd == var_str ("")) return
	+ found = .false.
	+ do i = 1, N_KNOWN_SPECIAL_OL_METHODS
	+ found = found .or. &
	+ (extra_cmd == var_str ('extra approx ') // known_methods(i))
	+ end do
	+ if (.not. found) &
	+ call msg_fatal ("The given extra OpenLoops method is not kown ", &
	+ [var_str ("Available commands are: "), &
	+ var_str ("extra approx top (only WbWb signal),"), &
	+ var_str ("extra approx stop (only WbWb singletop),"), &
	+ var_str ("extra approx not (no top in WbWb).")])
	+ end subroutine check_extra_cmd
	+
	+@ %def check_extra_cmd
	+@ This type contains the pdg code of the particle to be written in the process
	+specification string and an optional additional information about the polarization
	+of the particles. Note that the output can only be processed by OpenLoops.
	+<<BLHA config: types>>=
	+ type :: blha_particle_string_element_t
	+ integer :: pdg = 0
	+ integer :: hel = OLP_HEL_UNPOLARIZED
	+ logical :: polarized = .false.
	+ contains
	+ <<BLHA config: blha particle string element: TBP>>
	+ end type blha_particle_string_element_t
	+
	+@ %def blha_particle_string_element_t
	+@
	+<<BLHA config: blha particle string element: TBP>>=
	+ generic :: init => init_default
	+ generic :: init => init_polarized
	+ procedure :: init_default => blha_particle_string_element_init_default
	+ procedure :: init_polarized => blha_particle_string_element_init_polarized
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_particle_string_element_init_default (blha_p, id)
	+ class(blha_particle_string_element_t), intent(out) :: blha_p
	+ integer, intent(in) :: id
	+ end subroutine blha_particle_string_element_init_default
	+ module subroutine blha_particle_string_element_init_polarized (blha_p, id, hel)
	+ class(blha_particle_string_element_t), intent(out) :: blha_p
	+ integer, intent(in) :: id, hel
	+ end subroutine blha_particle_string_element_init_polarized
	+<<BLHA config: procedures>>=
	+ module subroutine blha_particle_string_element_init_default (blha_p, id)
	+ class(blha_particle_string_element_t), intent(out) :: blha_p
	+ integer, intent(in) :: id
	+ blha_p%pdg = id
	+ end subroutine blha_particle_string_element_init_default
	+
	+@ %def blha_particle_string_element_init_default
	+@
	+<<BLHA config: procedures>>=
	+ module subroutine blha_particle_string_element_init_polarized (blha_p, id, hel)
	+ class(blha_particle_string_element_t), intent(out) :: blha_p
	+ integer, intent(in) :: id, hel
	+ blha_p%polarized = .true.
	+ blha_p%pdg = id
	+ blha_p%hel = hel
	+ end subroutine blha_particle_string_element_init_polarized
	+
	+@ %def blha_particle_string_element_init_polarized
	+@
	+<<BLHA config: blha particle string element: TBP>>=
	+ generic :: write_pdg => write_pdg_unit
	+ generic :: write_pdg => write_pdg_character
	+ procedure :: write_pdg_unit => blha_particle_string_element_write_pdg_unit
	+ procedure :: write_pdg_character &
	+ => blha_particle_string_element_write_pdg_character
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_particle_string_element_write_pdg_unit (blha_p, unit)
	+ class(blha_particle_string_element_t), intent(in) :: blha_p
	+ integer, intent(in), optional :: unit
	+ end subroutine blha_particle_string_element_write_pdg_unit
	+ module subroutine blha_particle_string_element_write_pdg_character (blha_p, c)
	+ class(blha_particle_string_element_t), intent(in) :: blha_p
	+ character(3), intent(inout) :: c
	+ end subroutine blha_particle_string_element_write_pdg_character
	+<<BLHA config: procedures>>=
	+ module subroutine blha_particle_string_element_write_pdg_unit (blha_p, unit)
	+ class(blha_particle_string_element_t), intent(in) :: blha_p
	+ integer, intent(in), optional :: unit
	+ integer :: u
	+ u = given_output_unit (unit)
	+ write (u, '(I3)') blha_p%pdg
	+ end subroutine blha_particle_string_element_write_pdg_unit
	+
	+@ %def blha_particle_string_element_write_pdg_unit
	+@
	+<<BLHA config: procedures>>=
	+ module subroutine blha_particle_string_element_write_pdg_character (blha_p, c)
	+ class(blha_particle_string_element_t), intent(in) :: blha_p
	+ character(3), intent(inout) :: c
	+ write (c, '(I3)') blha_p%pdg
	+ end subroutine blha_particle_string_element_write_pdg_character
	+
	+@ %def blha_particle_string_element_write_pdg_character
	+@
	+<<BLHA config: blha particle string element: TBP>>=
	+ generic :: write_helicity => write_helicity_unit
	+ generic :: write_helicity => write_helicity_character
	+ procedure :: write_helicity_unit &
	+ => blha_particle_string_element_write_helicity_unit
	+ procedure :: write_helicity_character &
	+ => blha_particle_string_element_write_helicity_character
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_particle_string_element_write_helicity_unit (blha_p, unit)
	+ class(blha_particle_string_element_t), intent(in) :: blha_p
	+ integer, intent(in), optional :: unit
	+ end subroutine blha_particle_string_element_write_helicity_unit
	+ module subroutine blha_particle_string_element_write_helicity_character (blha_p, c)
	+ class(blha_particle_string_element_t), intent(in) :: blha_p
	+ character(4), intent(inout) :: c
	+ end subroutine blha_particle_string_element_write_helicity_character
	+<<BLHA config: procedures>>=
	+ module subroutine blha_particle_string_element_write_helicity_unit (blha_p, unit)
	+ class(blha_particle_string_element_t), intent(in) :: blha_p
	+ integer, intent(in), optional :: unit
	+ integer :: u
	+ u = given_output_unit (unit)
	+ write (u, '(A1,I0,A1)') '(', blha_p%hel, ')'
	+ end subroutine blha_particle_string_element_write_helicity_unit
	+
	+@ %def blha_particle_string_element_write_helicity_unit
	+@
	+<<BLHA config: procedures>>=
	+ module subroutine blha_particle_string_element_write_helicity_character (blha_p, c)
	+ class(blha_particle_string_element_t), intent(in) :: blha_p
	+ character(4), intent(inout) :: c
	+ write (c, '(A1,I0,A1)') '(', blha_p%hel, ')'
	+ end subroutine blha_particle_string_element_write_helicity_character
	+
	+@ %def blha_particle_string_element_write_helicity_character
	+@ This type encapsulates a BLHA request.
	+<<BLHA config: public>>=
	+ public :: blha_configuration_t
	+ public :: blha_cfg_process_node_t
	+<<BLHA config: types>>=
	+ type :: blha_cfg_process_node_t
	+ type(blha_particle_string_element_t), dimension(:), allocatable :: pdg_in, pdg_out
	+ integer, dimension(:), allocatable :: fingerprint
	+ integer :: nsub
	+ integer, dimension(:), allocatable :: ids
	+ integer :: amplitude_type
	+ type(blha_cfg_process_node_t), pointer :: next => null ()
	+ end type blha_cfg_process_node_t
	+
	+ type :: blha_configuration_t
	+ type(string_t) :: name
	+ class(model_data_t), pointer :: model => null ()
	+ type(string_t) :: md5
	+ integer :: version = 2
	+ logical :: dirty = .false.
	+ integer :: n_proc = 0
	+ real(default) :: accuracy_target
	+ logical :: debug_unstable = .false.
	+ integer :: mode = BLHA_MODE_GENERIC
	+ logical :: polarized = .false.
	+ type(blha_cfg_process_node_t), pointer :: processes => null ()
	+ !integer, dimension(2) :: matrix_element_square_type = BLHA_MEST_SUM
	+ integer :: correction_type
	+ type(string_t) :: correction_type_other
	+ integer :: irreg = BLHA_IRREG_THV
	+ type(string_t) :: irreg_other
	+ integer :: massive_particle_scheme = BLHA_MPS_ONSHELL
	+ type(string_t) :: massive_particle_scheme_other
	+ type(string_t) :: model_file
	+ logical :: subdivide_subprocesses = .false.
	+ integer :: alphas_power = -1, alpha_power = -1
	+ integer :: ew_scheme = BLHA_EW_GF
	+ integer :: width_scheme = BLHA_WIDTH_DEFAULT
	+ logical :: openloops_use_cms = .false.
	+ integer :: openloops_phs_tolerance = 0
	+ type(string_t) :: openloops_extra_cmd
	+ integer :: openloops_stability_log = 0
	+ integer :: n_off_photons_is = 0
	+ integer :: n_off_photons_fs = 0
	+ end type blha_configuration_t
	+
	+@ %def blha_cffg_process_node_t blha_configuration_t
	+@ Translate the SINDARIN input string to the corresponding named integer.
	+<<BLHA config: public>>=
	+ public :: ew_scheme_string_to_int
	+<<BLHA config: sub interfaces>>=
	+ module function ew_scheme_string_to_int (ew_scheme_str) result (ew_scheme_int)
	+ integer :: ew_scheme_int
	+ type(string_t), intent(in) :: ew_scheme_str
	+ end function ew_scheme_string_to_int
	+<<BLHA config: procedures>>=
	+ module function ew_scheme_string_to_int (ew_scheme_str) result (ew_scheme_int)
	+ integer :: ew_scheme_int
	+ type(string_t), intent(in) :: ew_scheme_str
	+ select case (char (ew_scheme_str))
	+ case ('GF', 'Gmu')
	+ ew_scheme_int = BLHA_EW_GF
	+ case ('alpha_qed', 'alpha_internal')
	+ ew_scheme_int = BLHA_EW_INTERNAL
	+ case ('alpha_mz')
	+ ew_scheme_int = BLHA_EW_MZ
	+ case ('alpha_0', 'alpha_thompson')
	+ ew_scheme_int = BLHA_EW_0
	+ case default
	+ call msg_fatal ("ew_scheme: " // char (ew_scheme_str) // &
	+ " not supported. Try 'Gmu', 'alpha_internal', 'alpha_mz' or 'alpha_0'.")
	+ end select
	+ end function ew_scheme_string_to_int
	+
	+@ %def ew_scheme_string_to_int
	+@
	+@ Translate the SINDARIN input string to the corresponding named integer
	+denoting the type of NLO correction.
	+<<BLHA config: public>>=
	+ public :: correction_type_string_to_int
	+<<BLHA config: sub interfaces>>=
	+ module function correction_type_string_to_int &
	+ (correction_type_str) result (correction_type_int)
	+ integer :: correction_type_int
	+ type(string_t), intent(in) :: correction_type_str
	+ end function correction_type_string_to_int
	+<<BLHA config: procedures>>=
	+ module function correction_type_string_to_int &
	+ (correction_type_str) result (correction_type_int)
	+ integer :: correction_type_int
	+ type(string_t), intent(in) :: correction_type_str
	+ select case (char (correction_type_str))
	+ case ('QCD')
	+ correction_type_int = BLHA_CT_QCD
	+ case ('EW')
	+ correction_type_int = BLHA_CT_EW
	+ case default
	+ call msg_warning ("nlo_correction_type: " // char (correction_type_str) // &
	+ " not supported. Try setting it to 'QCD', 'EW'.")
	+ end select
	+ end function correction_type_string_to_int
	+
	+@ %def correction_type_string_to_int
	+@
	+This types control the creation of BLHA-interface files
	+<<BLHA config: public>>=
	+ public :: blha_flv_state_t
	+ public :: blha_master_t
	+<<BLHA config: types>>=
	+ type:: blha_flv_state_t
	+ integer, dimension(:), allocatable :: flavors
	+ integer :: flv_mult
	+ logical :: flv_real = .false.
	+ end type blha_flv_state_t
	+
	+ type :: blha_master_t
	+ integer, dimension(5) :: blha_mode = BLHA_MODE_GENERIC
	+ logical :: compute_borns = .false.
	+ logical :: compute_real_trees = .false.
	+ logical :: compute_loops = .true.
	+ logical :: compute_correlations = .false.
	+ logical :: compute_dglap = .false.
	+ integer :: ew_scheme
	+ type(string_t), dimension(:), allocatable :: suffix
	+ type(blha_configuration_t), dimension(:), allocatable :: blha_cfg
	+ integer :: n_files = 0
	+ integer, dimension(:), allocatable :: i_file_to_nlo_index
	+ contains
	+ <<BLHA config: blha master: TBP>>
	+ end type blha_master_t
	+
	+@ %def blha_flv_state_t, blha_master_t
	+@ Master-Routines
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: set_methods => blha_master_set_methods
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_set_methods (master, is_nlo, var_list)
	+ class(blha_master_t), intent(inout) :: master
	+ logical, intent(in) :: is_nlo
	+ type(var_list_t), intent(in) :: var_list
	+ end subroutine blha_master_set_methods
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_set_methods (master, is_nlo, var_list)
	+ class(blha_master_t), intent(inout) :: master
	+ logical, intent(in) :: is_nlo
	+ type(var_list_t), intent(in) :: var_list
	+ type(string_t) :: method, born_me_method, real_tree_me_method
	+ type(string_t) :: loop_me_method, correlation_me_method
	+ type(string_t) :: dglap_me_method
	+ type(string_t) :: default_method
	+ logical :: cmp_born, cmp_real
	+ logical :: cmp_loop, cmp_corr
	+ logical :: cmp_dglap
	+ if (is_nlo) then
	+ 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
	+ cmp_born = born_me_method /= 'omega'
	+ cmp_real = is_nlo .and. (real_tree_me_method /= 'omega')
	+ cmp_loop = is_nlo .and. (loop_me_method /= 'omega')
	+ cmp_corr = is_nlo .and. (correlation_me_method /= 'omega')
	+ cmp_dglap = is_nlo .and. (dglap_me_method /= 'omega')
	+ call set_me_method (1, loop_me_method)
	+ call set_me_method (2, correlation_me_method)
	+ call set_me_method (3, real_tree_me_method)
	+ call set_me_method (4, born_me_method)
	+ call set_me_method (5, dglap_me_method)
	+ else
	+ default_method = var_list%get_sval (var_str ("$method"))
	+ cmp_born = default_method /= 'omega'
	+ cmp_real = .false.; cmp_loop = .false.; cmp_corr = .false.
	+ call set_me_method (4, default_method)
	+ end if
	+ master%n_files = count ([cmp_born, cmp_real, cmp_loop, cmp_corr, cmp_dglap])
	+ call set_nlo_indices ()
	+ master%compute_borns = cmp_born
	+ master%compute_real_trees = cmp_real
	+ master%compute_loops = cmp_loop
	+ master%compute_correlations = cmp_corr
	+ master%compute_dglap = cmp_dglap
	+ contains
	+ subroutine set_nlo_indices ()
	+ integer :: i_file
	+ allocate (master%i_file_to_nlo_index (master%n_files))
	+ master%i_file_to_nlo_index = 0
	+ i_file = 0
	+ if (cmp_loop) then
	+ i_file = i_file + 1
	+ master%i_file_to_nlo_index(i_file) = 1
	+ end if
	+ if (cmp_corr) then
	+ i_file = i_file + 1
	+ master%i_file_to_nlo_index(i_file) = 2
	+ end if
	+ if (cmp_real) then
	+ i_file = i_file + 1
	+ master%i_file_to_nlo_index(i_file) = 3
	+ end if
	+ if (cmp_born) then
	+ i_file = i_file + 1
	+ master%i_file_to_nlo_index(i_file) = 4
	+ end if
	+ if (cmp_dglap) then
	+ i_file = i_file + 1
	+ master%i_file_to_nlo_index(i_file) = 5
	+ end if
	+ end subroutine set_nlo_indices
	+
	+ subroutine set_me_method (i, me_method)
	+ integer, intent(in) :: i
	+ type(string_t) :: me_method
	+ select case (char (me_method))
	+ case ('gosam')
	+ call master%set_gosam (i)
	+ case ('openloops')
	+ call master%set_openloops (i)
	+ end select
	+ end subroutine set_me_method
	+ end subroutine blha_master_set_methods
	+
	+@ %def blha_master_set_methods
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: allocate_config_files => blha_master_allocate_config_files
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_allocate_config_files (master)
	+ class(blha_master_t), intent(inout) :: master
	+ end subroutine blha_master_allocate_config_files
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_allocate_config_files (master)
	+ class(blha_master_t), intent(inout) :: master
	+ allocate (master%blha_cfg (master%n_files))
	+ allocate (master%suffix (master%n_files))
	+ end subroutine blha_master_allocate_config_files
	+
	+@ %def blha_master_allocate_config_files
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: set_ew_scheme => blha_master_set_ew_scheme
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_set_ew_scheme (master, ew_scheme)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: ew_scheme
	+ end subroutine blha_master_set_ew_scheme
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_set_ew_scheme (master, ew_scheme)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: ew_scheme
	+ master%ew_scheme = ew_scheme_string_to_int (ew_scheme)
	+ end subroutine blha_master_set_ew_scheme
	+
	+@ %def blha_master_set_ew_scheme
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: set_correction_type => blha_master_set_correction_type
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_set_correction_type (master, correction_type_str)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: correction_type_str
	+ end subroutine blha_master_set_correction_type
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_set_correction_type (master, correction_type_str)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: correction_type_str
	+ master%blha_cfg(:)%correction_type = &
	+ correction_type_string_to_int (correction_type_str)
	+ end subroutine blha_master_set_correction_type
	+
	+@ %def blha_master_set_correction_type
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: set_photon_characteristics => blha_master_set_photon_characteristics
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_set_photon_characteristics (master, flv_born, n_in)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, dimension(:,:), intent(in) :: flv_born
	+ integer, intent(in) :: n_in
	+ end subroutine blha_master_set_photon_characteristics
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_set_photon_characteristics (master, flv_born, n_in)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, dimension(:,:), intent(in) :: flv_born
	+ integer, intent(in) :: n_in
	+ integer :: i_file, i, i_flv
	+ integer :: noff_is, noff_fs, noff_is_max, noff_fs_max
	+ do i_file = 1, master%n_files
	+ noff_is_max = 0; noff_fs_max = 0
	+ do i_flv = 1, size (flv_born, 2)
	+ noff_is = 0; noff_fs = 0
	+ do i = 1, n_in
	+ if (flv_born (i, i_flv) == PHOTON) noff_is = noff_is + 1
	+ end do
	+ noff_is_max = max (noff_is, noff_is_max)
	+ do i = n_in + 1, size (flv_born(:, i_flv))
	+ if (flv_born (i, i_flv) == PHOTON) noff_fs = noff_fs + 1
	+ end do
	+ noff_fs_max = max (noff_fs, noff_fs_max)
	+ end do
	+ if (master%blha_cfg(i_file)%correction_type == BLHA_CT_EW &
	+ .and. master%ew_scheme == BLHA_EW_0 &
	+ .and. (noff_is_max > 0 .or. noff_fs_max > 0)) then
	+ call msg_fatal ("For NLO EW/mixed corrections, 'alpha_0'/" &
	+ // "'alpha_thompson' are ", [ var_str ("inconsistent EW input " &
	+ // "schemes. Please use 'alpha_mz' or 'Gmu'")])
	+ end if
	+ master%blha_cfg(i_file)%n_off_photons_is = noff_is_max
	+ master%blha_cfg(i_file)%n_off_photons_fs = noff_fs_max
	+ end do
	+ end subroutine blha_master_set_photon_characteristics
	+
	+@ %def blha_master_set_photon_characteristics
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: generate => blha_master_generate
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_generate (master, basename, model, &
	+ n_in, alpha_power, alphas_power, flv_born, flv_real)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, intent(in), dimension(:,:), allocatable :: flv_born, flv_real
	+ end subroutine blha_master_generate
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_generate (master, basename, model, &
	+ n_in, alpha_power, alphas_power, flv_born, flv_real)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, intent(in), dimension(:,:), allocatable :: flv_born, flv_real
	+ integer :: i_file
	+ if (master%n_files < 1) &
	+ call msg_fatal ("Attempting to generate OLP-files, but none are specified!")
	+ i_file = 1
	+ call master%generate_loop (basename, model, n_in, alpha_power, &
	+ alphas_power, flv_born, i_file)
	+ call master%generate_correlation (basename, model, n_in, alpha_power, &
	+ alphas_power, flv_born, i_file)
	+ call master%generate_real_tree (basename, model, n_in, alpha_power, &
	+ alphas_power, flv_real, i_file)
	+ call master%generate_born (basename, model, n_in, alpha_power, &
	+ alphas_power, flv_born, i_file)
	+ call master%generate_dglap (basename, model, n_in, alpha_power, &
	+ alphas_power, flv_born, i_file)
	+ end subroutine blha_master_generate
	+
	+@ %def blha_master_generate
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: generate_loop => blha_master_generate_loop
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_generate_loop (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_born, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_born
	+ integer, intent(inout) :: i_file
	+ end subroutine blha_master_generate_loop
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_generate_loop (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_born, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_born
	+ integer, intent(inout) :: i_file
	+ type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	+ integer :: i_flv
	+ if (master%compute_loops) then
	+ if (allocated (flv_born)) then
	+ allocate (blha_flavor (size (flv_born, 2)))
	+ do i_flv = 1, size (flv_born, 2)
	+ allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	+ blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	+ blha_flavor(i_flv)%flv_mult = 2
	+ end do
	+ master%suffix(i_file) = blha_get_additional_suffix (var_str ("_LOOP"))
	+ call blha_init_virtual (master%blha_cfg(i_file), blha_flavor, &
	+ n_in, alpha_power, alphas_power, master%ew_scheme, &
	+ basename, model, master%blha_mode(1), master%suffix(i_file))
	+ i_file = i_file + 1
	+ else
	+ call msg_fatal ("BLHA Loops requested but " &
	+ // "Born flavor not existing")
	+ end if
	+ end if
	+ end subroutine blha_master_generate_loop
	+
	+@ %def blha_master_generate_loop
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: generate_correlation => blha_master_generate_correlation
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_generate_correlation (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_born, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_born
	+ integer, intent(inout) :: i_file
	+ end subroutine blha_master_generate_correlation
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_generate_correlation (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_born, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_born
	+ integer, intent(inout) :: i_file
	+ type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	+ integer :: i_flv
	+ if (master%compute_correlations) then
	+ if (allocated (flv_born)) then
	+ allocate (blha_flavor (size (flv_born, 2)))
	+ do i_flv = 1, size (flv_born, 2)
	+ allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	+ blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	+ blha_flavor(i_flv)%flv_mult = 3
	+ end do
	+ master%suffix(i_file) = blha_get_additional_suffix (var_str ("_SUB"))
	+ call blha_init_subtraction (master%blha_cfg(i_file), blha_flavor, &
	+ n_in, alpha_power, alphas_power, master%ew_scheme, &
	+ basename, model, master%blha_mode(2), master%suffix(i_file))
	+ i_file = i_file + 1
	+ else
	+ call msg_fatal ("BLHA Correlations requested but "&
	+ // "Born flavor not existing")
	+ end if
	+ end if
	+ end subroutine blha_master_generate_correlation
	+
	+@ %def blha_master_generate_correlation
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: generate_real_tree => blha_master_generate_real_tree
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_generate_real_tree (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_real, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_real
	+ integer, intent(inout) :: i_file
	+ end subroutine blha_master_generate_real_tree
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_generate_real_tree (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_real, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_real
	+ integer, intent(inout) :: i_file
	+ type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	+ integer :: i_flv
	+ if (master%compute_real_trees) then
	+ if (allocated (flv_real)) then
	+ allocate (blha_flavor (size (flv_real, 2)))
	+ do i_flv = 1, size (flv_real, 2)
	+ allocate (blha_flavor(i_flv)%flavors (size (flv_real(:,i_flv))))
	+ blha_flavor(i_flv)%flavors = flv_real(:,i_flv)
	+ blha_flavor(i_flv)%flv_mult = 1
	+ end do
	+ master%suffix(i_file) = blha_get_additional_suffix (var_str ("_REAL"))
	+ call blha_init_real (master%blha_cfg(i_file), blha_flavor, &
	+ n_in, alpha_power, alphas_power, master%ew_scheme, &
	+ basename, model, master%blha_mode(3), master%suffix(i_file))
	+ i_file = i_file + 1
	+ else
	+ call msg_fatal ("BLHA Trees requested but "&
	+ // "Real flavor not existing")
	+ end if
	+ end if
	+ end subroutine blha_master_generate_real_tree
	+
	+@ %def blha_master_generate_real_tree
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: generate_born => blha_master_generate_born
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_generate_born (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_born, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_born
	+ integer, intent(inout) :: i_file
	+ end subroutine blha_master_generate_born
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_generate_born (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_born, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_born
	+ integer, intent(inout) :: i_file
	+ type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	+ integer :: i_flv
	+ if (master%compute_borns) then
	+ if (allocated (flv_born)) then
	+ allocate (blha_flavor (size (flv_born, 2)))
	+ do i_flv = 1, size (flv_born, 2)
	+ allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	+ blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	+ blha_flavor(i_flv)%flv_mult = 1
	+ end do
	+ master%suffix(i_file) = blha_get_additional_suffix (var_str ("_BORN"))
	+ call blha_init_born (master%blha_cfg(i_file), blha_flavor, &
	+ n_in, alpha_power, alphas_power, master%ew_scheme, &
	+ basename, model, master%blha_mode(4), master%suffix(i_file))
	+ i_file = i_file + 1
	+ end if
	+ end if
	+ end subroutine blha_master_generate_born
	+
	+@ %def blha_master_generate_born
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: generate_dglap => blha_master_generate_dglap
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_generate_dglap (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_born, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_born
	+ integer, intent(inout) :: i_file
	+ end subroutine blha_master_generate_dglap
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_generate_dglap (master, basename, model, n_in, &
	+ alpha_power, alphas_power, flv_born, i_file)
	+ class(blha_master_t), intent(inout) :: master
	+ type(string_t), intent(in) :: basename
	+ class(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: alpha_power, alphas_power
	+ integer, dimension(:,:), allocatable, intent(in) :: flv_born
	+ integer, intent(inout) :: i_file
	+ type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	+ integer :: i_flv
	+ if (master%compute_dglap) then
	+ if (allocated (flv_born)) then
	+ allocate (blha_flavor (size (flv_born, 2)))
	+ do i_flv = 1, size (flv_born, 2)
	+ allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	+ blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	+ blha_flavor(i_flv)%flv_mult = 2
	+ end do
	+ master%suffix(i_file) = blha_get_additional_suffix (var_str ("_DGLAP"))
	+ call blha_init_dglap (master%blha_cfg(i_file), blha_flavor, &
	+ n_in, alpha_power, alphas_power, master%ew_scheme, &
	+ basename, model, master%blha_mode(5), master%suffix(i_file))
	+ i_file = i_file + 1
	+ end if
	+ end if
	+ end subroutine blha_master_generate_dglap
	+
	+@ %def blha_master_generate_dglap
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: setup_additional_features => blha_master_setup_additional_features
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_setup_additional_features (master, &
	+ phs_tolerance, use_cms, stability_log, extra_cmd, beam_structure)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, intent(in) :: phs_tolerance
	+ logical, intent(in) :: use_cms
	+ type(string_t), intent(in), optional :: extra_cmd
	+ integer, intent(in) :: stability_log
	+ type(beam_structure_t), intent(in), optional :: beam_structure
	+ end subroutine blha_master_setup_additional_features
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_setup_additional_features (master, &
	+ phs_tolerance, use_cms, stability_log, extra_cmd, beam_structure)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, intent(in) :: phs_tolerance
	+ logical, intent(in) :: use_cms
	+ type(string_t), intent(in), optional :: extra_cmd
	+ integer, intent(in) :: stability_log
	+ type(beam_structure_t), intent(in), optional :: beam_structure
	+ integer :: i_file
	+ logical :: polarized, throw_warning
	+
	+ polarized = .false.
	+ if (present (beam_structure)) polarized = beam_structure%has_polarized_beams ()
	+
	+ throw_warning = .false.
	+ if (use_cms) then
	+ throw_warning = throw_warning .or. (master%compute_loops &
	+ .and. master%blha_mode(1) /= BLHA_MODE_OPENLOOPS)
	+ throw_warning = throw_warning .or. (master%compute_correlations &
	+ .and. master%blha_mode(2) /= BLHA_MODE_OPENLOOPS)
	+ throw_warning = throw_warning .or. (master%compute_real_trees &
	+ .and. master%blha_mode(3) /= BLHA_MODE_OPENLOOPS)
	+ throw_warning = throw_warning .or. (master%compute_borns &
	+ .and. master%blha_mode(4) /= BLHA_MODE_OPENLOOPS)
	+ throw_warning = throw_warning .or. (master%compute_dglap &
	+ .and. master%blha_mode(5) /= BLHA_MODE_OPENLOOPS)
	+ if (throw_warning) call cms_warning ()
	+ end if
	+
	+ do i_file = 1, master%n_files
	+ if (phs_tolerance > 0) then
	+ select case (master%blha_mode (master%i_file_to_nlo_index(i_file)))
	+ case (BLHA_MODE_GOSAM)
	+ if (polarized) call gosam_error_message ()
	+ case (BLHA_MODE_OPENLOOPS)
	+ master%blha_cfg(i_file)%openloops_use_cms = use_cms
	+ master%blha_cfg(i_file)%openloops_phs_tolerance = phs_tolerance
	+ master%blha_cfg(i_file)%polarized = polarized
	+ if (present (extra_cmd)) then
	+ master%blha_cfg(i_file)%openloops_extra_cmd = extra_cmd
	+ else
	+ master%blha_cfg(i_file)%openloops_extra_cmd = var_str ('')
	+ end if
	+ master%blha_cfg(i_file)%openloops_stability_log = stability_log
	+ end select
	+ end if
	+ end do
	+ contains
	+ subroutine cms_warning ()
	+ call msg_warning ("You have set ?openloops_use_cms = true, but not all active matrix ", &
	+ [var_str ("element methods are set to OpenLoops. Note that other "), &
	+ var_str ("methods might not necessarily support the complex mass "), &
	+ var_str ("scheme. This can yield inconsistencies in your NLO results!")])
	+ end subroutine cms_warning
	+
	+ subroutine gosam_error_message ()
	+ call msg_fatal ("You are trying to evaluate a process at NLO ", &
	+ [var_str ("which involves polarized beams using GoSam. "), &
	+ var_str ("This feature is not supported yet. "), &
	+ var_str ("Please use OpenLoops instead")])
	+ end subroutine gosam_error_message
	+ end subroutine blha_master_setup_additional_features
	+
	+@ %def blha_master_setup_additional_features
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: set_gosam => blha_master_set_gosam
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_set_gosam (master, i)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, intent(in) :: i
	+ end subroutine blha_master_set_gosam
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_set_gosam (master, i)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, intent(in) :: i
	+ master%blha_mode(i) = BLHA_MODE_GOSAM
	+ end subroutine blha_master_set_gosam
	+
	+@ %def blha_master_set_gosam
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: set_openloops => blha_master_set_openloops
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_set_openloops (master, i)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, intent(in) :: i
	+ end subroutine blha_master_set_openloops
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_set_openloops (master, i)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, intent(in) :: i
	+ master%blha_mode(i) = BLHA_MODE_OPENLOOPS
	+ end subroutine blha_master_set_openloops
	+
	+@ %def blha_master_set_openloops
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: set_polarization => blha_master_set_polarization
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_set_polarization (master, i)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, intent(in) :: i
	+ end subroutine blha_master_set_polarization
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_set_polarization (master, i)
	+ class(blha_master_t), intent(inout) :: master
	+ integer, intent(in) :: i
	+ master%blha_cfg(i)%polarized = .true.
	+ end subroutine blha_master_set_polarization
	+
	+@ %def blha_master_set_polarization
	+@
	+<<BLHA config: procedures>>=
	+ subroutine blha_init_born (blha_cfg, blha_flavor, n_in, &
	+ ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	+ type(blha_configuration_t), intent(inout) :: blha_cfg
	+ type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: ap, asp
	+ integer, intent(in) :: ew_scheme
	+ type(string_t), intent(in) :: basename
	+ type(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: blha_mode
	+ type(string_t), intent(in) :: suffix
	+ integer, dimension(:), allocatable :: amp_type
	+ integer :: i
	+
	+ allocate (amp_type (size (blha_flavor)))
	+ do i = 1, size (blha_flavor)
	+ amp_type(i) = BLHA_AMP_TREE
	+ end do
	+ call blha_configuration_init (blha_cfg, basename // suffix , &
	+ model, blha_mode)
	+ call blha_configuration_append_processes (blha_cfg, n_in, &
	+ blha_flavor, amp_type)
	+ call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	+ irreg = BLHA_IRREG_CDR, alphas_power = asp, &
	+ alpha_power = ap, ew_scheme = ew_scheme, &
	+ debug = blha_mode == BLHA_MODE_GOSAM)
	+ end subroutine blha_init_born
	+
	+ subroutine blha_init_virtual (blha_cfg, blha_flavor, n_in, &
	+ ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	+ type(blha_configuration_t), intent(inout) :: blha_cfg
	+ type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: ap, asp
	+ integer, intent(in) :: ew_scheme
	+ type(string_t), intent(in) :: basename
	+ type(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: blha_mode
	+ type(string_t), intent(in) :: suffix
	+ integer, dimension(:), allocatable :: amp_type
	+ integer :: i
	+
	+ allocate (amp_type (size (blha_flavor) * 2))
	+ do i = 1, size (blha_flavor)
	+ amp_type(2 * i - 1) = BLHA_AMP_LOOP
	+ amp_type(2 * i) = BLHA_AMP_COLOR_C
	+ end do
	+ call blha_configuration_init (blha_cfg, basename // suffix , &
	+ model, blha_mode)
	+ call blha_configuration_append_processes (blha_cfg, n_in, &
	+ blha_flavor, amp_type)
	+ call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	+ irreg = BLHA_IRREG_CDR, &
	+ alphas_power = asp, &
	+ alpha_power = ap, &
	+ ew_scheme = ew_scheme, &
	+ debug = blha_mode == BLHA_MODE_GOSAM)
	+ end subroutine blha_init_virtual
	+
	+ subroutine blha_init_dglap (blha_cfg, blha_flavor, n_in, &
	+ ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	+ type(blha_configuration_t), intent(inout) :: blha_cfg
	+ type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: ap, asp
	+ integer, intent(in) :: ew_scheme
	+ type(string_t), intent(in) :: basename
	+ type(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: blha_mode
	+ type(string_t), intent(in) :: suffix
	+ integer, dimension(:), allocatable :: amp_type
	+ integer :: i
	+
	+ allocate (amp_type (size (blha_flavor) * 2))
	+ do i = 1, size (blha_flavor)
	+ amp_type(2 * i - 1) = BLHA_AMP_TREE
	+ amp_type(2 * i) = BLHA_AMP_COLOR_C
	+ end do
	+ call blha_configuration_init (blha_cfg, basename // suffix , &
	+ model, blha_mode)
	+ call blha_configuration_append_processes (blha_cfg, n_in, &
	+ blha_flavor, amp_type)
	+ call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	+ irreg = BLHA_IRREG_CDR, &
	+ alphas_power = asp, &
	+ alpha_power = ap, &
	+ ew_scheme = ew_scheme, &
	+ debug = blha_mode == BLHA_MODE_GOSAM)
	+ end subroutine blha_init_dglap
	+
	+ subroutine blha_init_subtraction (blha_cfg, blha_flavor, n_in, &
	+ ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	+ type(blha_configuration_t), intent(inout) :: blha_cfg
	+ type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: ap, asp
	+ integer, intent(in) :: ew_scheme
	+ type(string_t), intent(in) :: basename
	+ type(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: blha_mode
	+ type(string_t), intent(in) :: suffix
	+ integer, dimension(:), allocatable :: amp_type
	+ integer :: i
	+
	+ allocate (amp_type (size (blha_flavor) * 3))
	+ do i = 1, size (blha_flavor)
	+ amp_type(3 * i - 2) = BLHA_AMP_TREE
	+ amp_type(3 * i - 1) = BLHA_AMP_COLOR_C
	+ amp_type(3 * i) = BLHA_AMP_SPIN_C
	+ end do
	+ call blha_configuration_init (blha_cfg, basename // suffix , &
	+ model, blha_mode)
	+ call blha_configuration_append_processes (blha_cfg, n_in, &
	+ blha_flavor, amp_type)
	+ call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	+ irreg = BLHA_IRREG_CDR, &
	+ alphas_power = asp, &
	+ alpha_power = ap, &
	+ ew_scheme = ew_scheme, &
	+ debug = blha_mode == BLHA_MODE_GOSAM)
	+ end subroutine blha_init_subtraction
	+
	+ subroutine blha_init_real (blha_cfg, blha_flavor, n_in, &
	+ ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	+ type(blha_configuration_t), intent(inout) :: blha_cfg
	+ type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	+ integer, intent(in) :: n_in
	+ integer, intent(in) :: ap, asp
	+ integer :: ap_ew, ap_qcd
	+ integer, intent(in) :: ew_scheme
	+ type(string_t), intent(in) :: basename
	+ type(model_data_t), intent(in), target :: model
	+ integer, intent(in) :: blha_mode
	+ type(string_t), intent(in) :: suffix
	+ integer, dimension(:), allocatable :: amp_type
	+ integer :: i
	+
	+ allocate (amp_type (size (blha_flavor)))
	+ do i = 1, size (blha_flavor)
	+ amp_type(i) = BLHA_AMP_TREE
	+ end do
	+ select case (blha_cfg%correction_type)
	+ case (BLHA_CT_QCD)
	+ ap_ew = ap
	+ ap_qcd = asp + 1
	+ case (BLHA_CT_EW)
	+ ap_ew = ap + 1
	+ ap_qcd = asp
	+ end select
	+ call blha_configuration_init (blha_cfg, basename // suffix , &
	+ model, blha_mode)
	+ call blha_configuration_append_processes (blha_cfg, n_in, &
	+ blha_flavor, amp_type)
	+
	+ call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	+ irreg = BLHA_IRREG_CDR, &
	+ alphas_power = ap_qcd, &
	+ alpha_power = ap_ew, &
	+ ew_scheme = ew_scheme, &
	+ debug = blha_mode == BLHA_MODE_GOSAM)
	+ end subroutine blha_init_real
	+
	+@ %def blha_init_virtual blha_init_real
	+@ %def blha_init_subtraction
	+@
	+<<BLHA config: public>>=
	+ public :: blha_get_additional_suffix
	+<<BLHA config: sub interfaces>>=
	+ module function blha_get_additional_suffix (base_suffix) result (suffix)
	+ type(string_t) :: suffix
	+ type(string_t), intent(in) :: base_suffix
	+ end function blha_get_additional_suffix
	+<<BLHA config: procedures>>=
	+ module function blha_get_additional_suffix (base_suffix) result (suffix)
	+ type(string_t) :: suffix
	+ type(string_t), intent(in) :: base_suffix
	+ <<blha master: blha master extend suffixes: variables>>
	+ suffix = base_suffix
	+ <<blha master: blha master extend suffixes: procedure>>
	+ end function blha_get_additional_suffix
	+
	+@ %def blha_master_extend_suffixes
	+@
	+<<MPI: blha master: blha master extend suffixes: variables>>=
	+ integer :: n_size, rank
	+<<MPI: blha master: blha master extend suffixes: procedure>>=
	+ call MPI_Comm_rank (MPI_COMM_WORLD, rank)
	+ call MPI_Comm_size (MPI_COMM_WORLD, n_size)
	+ if (n_size > 1) then
	+ suffix = suffix // var_str ("_") // str (rank)
	+ end if
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: write_olp => blha_master_write_olp
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_write_olp (master, basename)
	+ class(blha_master_t), intent(in) :: master
	+ type(string_t), intent(in) :: basename
	+ end subroutine blha_master_write_olp
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_write_olp (master, basename)
	+ class(blha_master_t), intent(in) :: master
	+ type(string_t), intent(in) :: basename
	+ integer :: unit
	+ type(string_t) :: filename
	+ integer :: i_file
	+ do i_file = 1, master%n_files
	+ filename = basename // master%suffix(i_file) // ".olp"
	+ unit = free_unit ()
	+ open (unit, file = char (filename), status = 'replace', action = 'write')
	+ call blha_configuration_write &
	+ (master%blha_cfg(i_file), master%suffix(i_file), unit)
	+ close (unit)
	+ end do
	+ end subroutine blha_master_write_olp
	+
	+@ %def blha_master_write_olp
	+@
	+<<BLHA config: blha master: TBP>>=
	+ procedure :: final => blha_master_final
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_master_final (master)
	+ class(blha_master_t), intent(inout) :: master
	+ end subroutine blha_master_final
	+<<BLHA config: procedures>>=
	+ module subroutine blha_master_final (master)
	+ class(blha_master_t), intent(inout) :: master
	+ master%n_files = 0
	+ deallocate (master%suffix)
	+ deallocate (master%blha_cfg)
	+ deallocate (master%i_file_to_nlo_index)
	+ end subroutine blha_master_final
	+
	+@ %def blha_master_final
	+@
	+<<BLHA config: public>>=
	+ public :: blha_configuration_init
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_configuration_init (cfg, name, model, mode)
	+ type(blha_configuration_t), intent(inout) :: cfg
	+ type(string_t), intent(in) :: name
	+ class(model_data_t), target, intent(in) :: model
	+ integer, intent(in), optional :: mode
	+ end subroutine blha_configuration_init
	+<<BLHA config: procedures>>=
	+ module subroutine blha_configuration_init (cfg, name, model, mode)
	+ type(blha_configuration_t), intent(inout) :: cfg
	+ type(string_t), intent(in) :: name
	+ class(model_data_t), target, intent(in) :: model
	+ integer, intent(in), optional :: mode
	+ if (.not. associated (cfg%model)) then
	+ cfg%name = name
	+ cfg%model => model
	+ end if
	+ if (present (mode)) cfg%mode = mode
	+ end subroutine blha_configuration_init
	+
	+@ %def blha_configuration_init
	+@ Create an array of massive particle indices, to be used by the
	+"MassiveParticle"-statement of the order file.
	+<<BLHA config: procedures>>=
	+ subroutine blha_configuration_get_massive_particles &
	+ (cfg, massive, i_massive)
	+ type(blha_configuration_t), intent(in) :: cfg
	+ logical, intent(out) :: massive
	+ integer, intent(out), dimension(:), allocatable :: i_massive
	+ integer, parameter :: max_particles = 10
	+ integer, dimension(max_particles) :: i_massive_tmp
	+ integer, dimension(max_particles) :: checked
	+ type(blha_cfg_process_node_t), pointer :: current_process
	+ integer :: k
	+ integer :: n_massive
	+ n_massive = 0; k = 1
	+ checked = 0
	+ if (associated (cfg%processes)) then
	+ current_process => cfg%processes
	+ else
	+ call msg_fatal ("BLHA, massive particles: " // &
	+ "No processes allocated!")
	+ end if
	+ do
	+ call check_pdg_list (current_process%pdg_in%pdg)
	+ call check_pdg_list (current_process%pdg_out%pdg)
	+ if (k > max_particles) &
	+ call msg_fatal ("BLHA, massive particles: " // &
	+ "Max. number of particles exceeded!")
	+ if (associated (current_process%next)) then
	+ current_process => current_process%next
	+ else
	+ exit
	+ end if
	+ end do
	+ if (n_massive > 0) then
	+ allocate (i_massive (n_massive))
	+ i_massive = i_massive_tmp (1:n_massive)
	+ massive = .true.
	+ else
	+ massive = .false.
	+ end if
	+ contains
	+ subroutine check_pdg_list (pdg_list)
	+ integer, dimension(:), intent(in) :: pdg_list
	+ integer :: i, i_pdg
	+ type(flavor_t) :: flv
	+ do i = 1, size (pdg_list)
	+ i_pdg = abs (pdg_list(i))
	+ call flv%init (i_pdg, cfg%model)
	+ if (flv%get_mass () > 0._default) then
	+ !!! Avoid duplicates in output
	+ if (.not. any (checked == i_pdg)) then
	+ i_massive_tmp(k) = i_pdg
	+ checked(k) = i_pdg
	+ k = k + 1
	+ n_massive = n_massive + 1
	+ end if
	+ end if
	+ end do
	+ end subroutine check_pdg_list
	+ end subroutine blha_configuration_get_massive_particles
	+
	+@ %def blha_configuration_get_massive_particles
	+@
	+<<BLHA config: public>>=
	+ public :: blha_configuration_append_processes
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_configuration_append_processes (cfg, n_in, flavor, amp_type)
	+ type(blha_configuration_t), intent(inout) :: cfg
	+ integer, intent(in) :: n_in
	+ type(blha_flv_state_t), dimension(:), intent(in) :: flavor
	+ integer, dimension(:), intent(in), optional :: amp_type
	+ end subroutine blha_configuration_append_processes
	+<<BLHA config: procedures>>=
	+ module subroutine blha_configuration_append_processes (cfg, n_in, flavor, amp_type)
	+ type(blha_configuration_t), intent(inout) :: cfg
	+ integer, intent(in) :: n_in
	+ type(blha_flv_state_t), dimension(:), intent(in) :: flavor
	+ integer, dimension(:), intent(in), optional :: amp_type
	+ integer :: n_tot
	+ type(blha_cfg_process_node_t), pointer :: current_node
	+ integer :: i_process, i_flv
	+ integer, dimension(:), allocatable :: pdg_in, pdg_out
	+ integer, dimension(:), allocatable :: flavor_state
	+ integer :: proc_offset, n_proc_tot
	+ proc_offset = 0; n_proc_tot = 0
	+ do i_flv = 1, size (flavor)
	+ n_proc_tot = n_proc_tot + flavor(i_flv)%flv_mult
	+ end do
	+ if (.not. associated (cfg%processes)) &
	+ allocate (cfg%processes)
	+ current_node => cfg%processes
	+ do i_flv = 1, size (flavor)
	+ n_tot = size (flavor(i_flv)%flavors)
	+ allocate (pdg_in (n_in), pdg_out (n_tot - n_in))
	+ allocate (flavor_state (n_tot))
	+ flavor_state = flavor(i_flv)%flavors
	+ do i_process = 1, flavor(i_flv)%flv_mult
	+ pdg_in = flavor_state (1 : n_in)
	+ pdg_out = flavor_state (n_in + 1 : )
	+ if (cfg%polarized) then
	+ select case (cfg%mode)
	+ case (BLHA_MODE_OPENLOOPS)
	+ call allocate_and_init_pdg_and_helicities (current_node, &
	+ pdg_in, pdg_out, amp_type (proc_offset + i_process))
	+ case (BLHA_MODE_GOSAM)
	+ !!! Nothing special for GoSam yet. This exception is already caught
	+ !!! in blha_master_setup_additional_features
	+ end select
	+ else
	+ call allocate_and_init_pdg (current_node, pdg_in, pdg_out, &
	+ amp_type (proc_offset + i_process))
	+ end if
	+ if (proc_offset + i_process /= n_proc_tot) then
	+ allocate (current_node%next)
	+ current_node => current_node%next
	+ end if
	+ if (i_process == flavor(i_flv)%flv_mult) &
	+ proc_offset = proc_offset + flavor(i_flv)%flv_mult
	+ end do
	+ deallocate (pdg_in, pdg_out)
	+ deallocate (flavor_state)
	+ end do
	+
	+ contains
	+
	+ subroutine allocate_and_init_pdg (node, pdg_in, pdg_out, amp_type)
	+ type(blha_cfg_process_node_t), intent(inout), pointer :: node
	+ integer, intent(in), dimension(:), allocatable :: pdg_in, pdg_out
	+ integer, intent(in) :: amp_type
	+ allocate (node%pdg_in (size (pdg_in)))
	+ allocate (node%pdg_out (size (pdg_out)))
	+ node%pdg_in%pdg = pdg_in
	+ node%pdg_out%pdg = pdg_out
	+ node%amplitude_type = amp_type
	+ end subroutine allocate_and_init_pdg
	+
	+ subroutine allocate_and_init_pdg_and_helicities (node, pdg_in, pdg_out, amp_type)
	+ type(blha_cfg_process_node_t), intent(inout), pointer :: node
	+ integer, intent(in), dimension(:), allocatable :: pdg_in, pdg_out
	+ integer, intent(in) :: amp_type
	+ integer :: h1, h2
	+ if (size (pdg_in) == 2) then
	+ do h1 = -1, 1, 2
	+ do h2 = -1, 1, 2
	+ call allocate_and_init_pdg (current_node, pdg_in, pdg_out, amp_type)
	+ current_node%pdg_in(1)%polarized = .true.
	+ current_node%pdg_in(2)%polarized = .true.
	+ current_node%pdg_in(1)%hel = h1
	+ current_node%pdg_in(2)%hel = h2
	+ if (h1 + h2 /= 2) then !!! not end of loop
	+ allocate (current_node%next)
	+ current_node => current_node%next
	+ end if
	+ end do
	+ end do
	+ else
	+ do h1 = -1, 1, 2
	+ call allocate_and_init_pdg (current_node, pdg_in, pdg_out, amp_type)
	+ current_node%pdg_in(1)%polarized = .true.
	+ current_node%pdg_in(1)%hel = h1
	+ if (h1 /= 1) then !!! not end of loop
	+ allocate (current_node%next)
	+ current_node => current_node%next
	+ end if
	+ end do
	+ end if
	+ end subroutine allocate_and_init_pdg_and_helicities
	+
	+ end subroutine blha_configuration_append_processes
	+
	+@ %def blha_configuration_append_processes
	+@ Change parameter(s).
	+<<BLHA config: public>>=
	+ public :: blha_configuration_set
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_configuration_set (cfg, &
	+ version, irreg, massive_particle_scheme, &
	+ model_file, alphas_power, alpha_power, ew_scheme, width_scheme, &
	+ accuracy, debug)
	+ type(blha_configuration_t), intent(inout) :: cfg
	+ integer, optional, intent(in) :: version
	+ integer, optional, intent(in) :: irreg
	+ integer, optional, intent(in) :: massive_particle_scheme
	+ type(string_t), optional, intent(in) :: model_file
	+ integer, optional, intent(in) :: alphas_power, alpha_power
	+ integer, optional, intent(in) :: ew_scheme
	+ integer, optional, intent(in) :: width_scheme
	+ real(default), optional, intent(in) :: accuracy
	+ logical, optional, intent(in) :: debug
	+ end subroutine blha_configuration_set
	+<<BLHA config: procedures>>=
	+ module subroutine blha_configuration_set (cfg, &
	+ version, irreg, massive_particle_scheme, &
	+ model_file, alphas_power, alpha_power, ew_scheme, width_scheme, &
	+ accuracy, debug)
	+ type(blha_configuration_t), intent(inout) :: cfg
	+ integer, optional, intent(in) :: version
	+ integer, optional, intent(in) :: irreg
	+ integer, optional, intent(in) :: massive_particle_scheme
	+ type(string_t), optional, intent(in) :: model_file
	+ integer, optional, intent(in) :: alphas_power, alpha_power
	+ integer, optional, intent(in) :: ew_scheme
	+ integer, optional, intent(in) :: width_scheme
	+ real(default), optional, intent(in) :: accuracy
	+ logical, optional, intent(in) :: debug
	+ if (present (version)) &
	+ cfg%version = version
	+ if (present (irreg)) &
	+ cfg%irreg = irreg
	+ if (present (massive_particle_scheme)) &
	+ cfg%massive_particle_scheme = massive_particle_scheme
	+ if (present (model_file)) &
	+ cfg%model_file = model_file
	+ if (present (alphas_power)) &
	+ cfg%alphas_power = alphas_power
	+ if (present (alpha_power)) &
	+ cfg%alpha_power = alpha_power
	+ if (present (ew_scheme)) &
	+ cfg%ew_scheme = ew_scheme
	+ if (present (width_scheme)) &
	+ cfg%width_scheme = width_scheme
	+ if (present (accuracy)) &
	+ cfg%accuracy_target = accuracy
	+ if (present (debug)) &
	+ cfg%debug_unstable = debug
	+ cfg%dirty = .false.
	+ end subroutine blha_configuration_set
	+
	+@ %def blha_configuration_set
	+@
	+<<BLHA config: public>>=
	+ public :: blha_configuration_get_n_proc
	+<<BLHA config: sub interfaces>>=
	+ module function blha_configuration_get_n_proc (cfg) result (n_proc)
	+ type(blha_configuration_t), intent(in) :: cfg
	+ integer :: n_proc
	+ end function blha_configuration_get_n_proc
	+<<BLHA config: procedures>>=
	+ module function blha_configuration_get_n_proc (cfg) result (n_proc)
	+ type(blha_configuration_t), intent(in) :: cfg
	+ integer :: n_proc
	+ n_proc = cfg%n_proc
	+ end function blha_configuration_get_n_proc
	+
	+@ %def blha_configuration_get_n_proc
	+@
	+Write the BLHA file. Internal mode is intented for md5summing only.
	+
	+Special cases of external photons in \texttt{OpenLoops}:
	+
	+For electroweak corrections the particle ID (PID) of photons is a crucial input for the
	+computation of matrix elements by \texttt{OpenLoops}.
	+According to "arXiv: 1907.13071", section 3.2, external photons are classified by the
	+following types:
	+\begin{itemize}
	+\item PID $= -2002$: off-shell photons, that undergo $\gamma\rightarrow f\bar{f}$ splittings
	+at NLO EW, or initial state photons from QED PDFs
	+\item PID $= 2002$: on-shell photons, that do not undergo $\gamma\rightarrow f\bar{f}$
	+splittings at NLO EW, or initial state photons for example at photon colliders
	+\item PID $= 22$: unresolved photons, representing radiated photons at NLO EW, absent at LO
	+\end{itemize}
	+For the first two types scattering amplitudes for processes with external photons at NLO EW
	+get renormalisation factors containing photon-coupling and wave function counterterms.
	+Logarithmic mass singularities arising due to the renormalisation of off-shell external
	+photon wave functions are cancelled by collinear singularities of photon PDF counterterms or
	+analogous terms in virtual contributions originating from $\gamma\rightarrow f\bar{f}$
	+splittings of final state photons.
	+
	+The finite remainders of the renormalisation factors are thus dictated by the specific photon
	+PID stated above.
	+As consequence, we have to adjust the input PIDs written into the BLHA file which will be
	+read by \texttt{OpenLoops}.\\
	+Concretely, for the case of electroweak corrections initial state photons associated with
	+photon PDFs and final state photons (if existent at LO) are labeled as off-shell photons with
	+PID "$-2002$".
	+On-shell photons with PID "$2002$" are neglected for now since to include them for processes
	+at NLO EW is non-trivial from the phenomenological point of view.
	+Processes at NLO EW typically are studied at high energy scales for which photon-induced
	+sub-processes in most cases can not be neglected.
	+However, on-shell, e.~g. tagged, photons are defined at low energy scales and thus the
	+process has to be described with external photon fields and couplings at two different
	+scales.
	+
	+Another issue which has to be adressed if various photon PIDs are taken into account is that
	+real and virtual amplitudes have to be computed at the same order in $\alpha$ at a specific
	+scale for the subtraction scheme to be consistent.
	+The complication comes by the fact that the EW coupling $\alpha$ of each external photon in
	+the amplitudes will automatically be rescaled by \texttt{OpenLoops} corresponding to the
	+specific photon type.
	+Following eq. (3.30) of "arXiv: 1907.13071", by default the coupling of an on-shell photon
	+will be changed to $\alpha(0)$ and that of an off-shell photon to $\alpha_{G_\mu}$ if not
	+chosen already at a high scale, e.~g. $\alpha(M_Z)$.
	+In order to not spoil the IR cancellation \texttt{OpenLoops} supplies to register unresolved
	+photons with PID "22" describing a radiated photon at NLO EW for which the photon-coupling
	+$\alpha$ is left unchanged at the value which is computed with the electroweak input scheme
	+chosen by the user.
	+This is adopted here by labeling each emitted photon as unresolved with PID "22" if no
	+photons are present at LO.\\
	+For EW corrections the freedom to choose an electroweak input scheme is restricted, however,
	+since the number of external photons present at LO is not conserved for the corresponding
	+real flavor structures due to possible $\gamma \rightarrow f\bar{f}$ splittings.
	+This forbids to choose $\alpha=\alpha(0)$ since otherwise the order in $\alpha(0)$ is not
	+conserved in the real amplitudes corresponding to the factorizing Born process.
	+Consequently, for FKS the NLO components are not of the same order in $\alpha(0)$.
	+The option \texttt{\$blha\_ew\_scheme = "alpha\_0"} is thus refused for the case if EW
	+corrections are activated and photons are present at LO.
	+<<BLHA config: public>>=
	+ public :: blha_configuration_write
	+<<BLHA config: sub interfaces>>=
	+ module subroutine blha_configuration_write (cfg, suffix, unit, internal, no_version)
	+ type(blha_configuration_t), intent(in) :: cfg
	+ integer, intent(in), optional :: unit
	+ logical, intent(in), optional :: internal, no_version
	+ type(string_t), intent(in) :: suffix
	+ end subroutine blha_configuration_write
	+<<BLHA config: procedures>>=
	+ module subroutine blha_configuration_write (cfg, suffix, unit, internal, no_version)
	+ type(blha_configuration_t), intent(in) :: cfg
	+ integer, intent(in), optional :: unit
	+ logical, intent(in), optional :: internal, no_version
	+ type(string_t), intent(in) :: suffix
	+ integer, dimension(:), allocatable :: pdg_flv
	+ integer :: u
	+ logical :: full
	+ type(string_t) :: buf
	+ type(blha_cfg_process_node_t), pointer :: node
	+ integer :: i
	+ character(3) :: pdg_char
	+ character(5) :: pdg_char_extra
	+ character(4) :: hel_char
	+ character(6) :: suffix_char
	+ character(len=25), parameter :: pad = ""
	+ logical :: write_process, no_v
	+ no_v = .false. ; if (present (no_version)) no_v = no_version
	+ u = given_output_unit (unit); if (u < 0) return
	+ full = .true.; if (present (internal)) full = .not. internal
	+ if (full .and. cfg%dirty) call msg_bug ( &
	+ "BUG: attempted to write out a dirty BLHA configuration")
	+ if (full) then
	+ if (no_v) then
	+ write (u, "(A)") "# BLHA order written by WHIZARD [version]"
	+ else
	+ write (u, "(A)") "# BLHA order written by WHIZARD <<Version>>"
	+ end if
	+ write (u, "(A)")
	+ end if
	+ select case (cfg%mode)
	+ case (BLHA_MODE_GOSAM); buf = "GoSam"
	+ case (BLHA_MODE_OPENLOOPS); buf = "OpenLoops"
	+ case default; buf = "vanilla"
	+ end select
	+ write (u, "(A)") "# BLHA interface mode: " // char (buf)
	+ write (u, "(A)") "# process: " // char (cfg%name)
	+ write (u, "(A)") "# model: " // char (cfg%model%get_name ())
	+ select case (cfg%version)
	+ case (1); buf = "BLHA1"
	+ case (2); buf = "BLHA2"
	+ end select
	+ write (u, '(A25,A)') "InterfaceVersion " // pad, char (buf)
	+ select case (cfg%correction_type)
	+ case (BLHA_CT_QCD); buf = "QCD"
	+ case (BLHA_CT_EW); buf = "EW"
	+ case default; buf = cfg%correction_type_other
	+ end select
	+ write (u,'(A25,A)') "CorrectionType" // pad, char (buf)
	+
	+ select case (cfg%mode)
	+ case (BLHA_MODE_OPENLOOPS)
	+ buf = cfg%name // '.olc'
	+ write (u, '(A25,A)') "Extra AnswerFile" // pad, char (buf)
	+ end select
	+
	+ select case (cfg%irreg)
	+ case (BLHA_IRREG_CDR); buf = "CDR"
	+ case (BLHA_IRREG_DRED); buf = "DRED"
	+ case (BLHA_IRREG_THV); buf = "tHV"
	+ case (BLHA_IRREG_MREG); buf = "MassReg"
	+ case default; buf = cfg%irreg_other
	+ end select
	+ write (u,'(A25,A)') "IRregularisation" // pad, char (buf)
	+ select case (cfg%massive_particle_scheme)
	+ case (BLHA_MPS_ONSHELL); buf = "OnShell"
	+ case default; buf = cfg%massive_particle_scheme_other
	+ end select
	+ if (cfg%mode == BLHA_MODE_GOSAM) &
	+ write (u,'(A25,A)') "MassiveParticleScheme" // pad, char (buf)
	+ select case (cfg%version)
	+ case (1)
	+ if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	+ "AlphasPower" // pad, int2char (cfg%alphas_power)
	+ if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	+ "AlphaPower " // pad, int2char (cfg%alpha_power)
	+ case (2)
	+ if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	+ "CouplingPower QCD " // pad, int2char (cfg%alphas_power)
	+ if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	+ "CouplingPower QED " // pad, int2char (cfg%alpha_power)
	+ end select
	+ select case (cfg%mode)
	+ case (BLHA_MODE_GOSAM)
	+ select case (cfg%ew_scheme)
	+ case (BLHA_EW_GF, BLHA_EW_INTERNAL); buf = "alphaGF"
	+ case (BLHA_EW_MZ); buf = "alphaMZ"
	+ case (BLHA_EW_MSBAR); buf = "alphaMSbar"
	+ case (BLHA_EW_0); buf = "alpha0"
	+ case (BLHA_EW_RUN); buf = "alphaRUN"
	+ end select
	+ write (u, '(A25, A)') "EWScheme " // pad, char (buf)
	+ case (BLHA_MODE_OPENLOOPS)
	+ select case (cfg%ew_scheme)
	+ case (BLHA_EW_0); buf = "alpha0"
	+ case (BLHA_EW_GF); buf = "Gmu"
	+ case (BLHA_EW_MZ, BLHA_EW_INTERNAL); buf = "alphaMZ"
	+ case default
	+ call msg_fatal ("OpenLoops input: Only supported EW schemes &
	+ & are 'alpha0', 'Gmu', and 'alphaMZ'")
	+ end select
	+ write (u, '(A25, A)') "ewscheme " // pad, char (buf)
	+ end select
	+ select case (cfg%mode)
	+ case (BLHA_MODE_GOSAM)
	+ write (u, '(A25)', advance='no') "MassiveParticles " // pad
	+ do i = 1, size (OLP_MASSIVE_PARTICLES)
	+ if (OLP_MASSIVE_PARTICLES(i) > 0) &
	+ write (u, '(I2,1X)', advance='no') OLP_MASSIVE_PARTICLES(i)
	+ end do
	+ write (u,*)
	+ case (BLHA_MODE_OPENLOOPS)
	+ if (cfg%openloops_use_cms) then
	+ write (u, '(A25,I1)') "extra use_cms " // pad, 1
	+ else
	+ write (u, '(A25,I1)') "extra use_cms " // pad, 0
	+ end if
	+ write (u, '(A25,I1)') "extra me_cache " // pad, 0
	+ !!! Turn off calculation of 1/eps & 1/eps^2 poles in one-loop calculation
	+ !!! Not needed in FKS (or any numerical NLO subtraction scheme)
	+ write (u, '(A25,I1)') "extra IR_on " // pad, 0
	+ if (cfg%openloops_phs_tolerance > 0) then
	+ write (u, '(A25,A4,I0)') "extra psp_tolerance " // pad, "10e-", &
	+ cfg%openloops_phs_tolerance
	+ end if
	+ call check_extra_cmd (cfg%openloops_extra_cmd)
	+ write (u, '(A)') char (cfg%openloops_extra_cmd)
	+ if (cfg%openloops_stability_log > 0) &
	+ write (u, '(A25,I1)') "extra stability_log " // pad, &
	+ cfg%openloops_stability_log
	+ end select
	+ if (full) then
	+ write (u, "(A)")
	+ write (u, "(A)") "# Process definitions"
	+ write (u, "(A)")
	+ end if
	+ if (cfg%debug_unstable) &
	+ write (u, '(A25,A)') "DebugUnstable " // pad, "True"
	+ write (u, *)
	+ node => cfg%processes
	+ do while (associated (node))
	+ write_process = .true.
	+ allocate (pdg_flv (size (node%pdg_in) + size (node%pdg_out)))
	+ do i = 1, size (node%pdg_in)
	+ pdg_flv (i) = node%pdg_in(i)%pdg
	+ end do
	+ do i = 1, size (node%pdg_out)
	+ pdg_flv (i + size (node%pdg_in)) = node%pdg_out(i)%pdg
	+ end do
	+ suffix_char = char (suffix)
	+ if (cfg%correction_type == BLHA_CT_EW .and. cfg%alphas_power > 0) then
	+ if ((suffix_char (1:5) == "_BORN" .and. .not. query_coupling_powers &
	+ (pdg_flv, cfg%alpha_power, cfg%alphas_power)) .or. &
	+ ((suffix_char (1:4) == "_SUB" .or. suffix_char (1:5) == "_LOOP" .or. &
	+ suffix_char (1:6) == "_DGLAP") .and. (.not. (query_coupling_powers &
	+ (pdg_flv, cfg%alpha_power, cfg%alphas_power) .or. query_coupling_powers &
	+ (pdg_flv, cfg%alpha_power + 1, cfg%alphas_power - 1)) .or. &
	+ all (is_gluon (pdg_flv))))) then
	+ deallocate (pdg_flv)
	+ node => node%next
	+ cycle
	+ end if
	+ end if
	+ select case (node%amplitude_type)
	+ case (BLHA_AMP_LOOP); buf = "Loop"
	+ case (BLHA_AMP_COLOR_C); buf = "ccTree"
	+ case (BLHA_AMP_SPIN_C)
	+ if (cfg%mode == BLHA_MODE_OPENLOOPS) then
	+ buf = "sctree_polvect"
	+ else
	+ buf = "scTree"
	+ end if
	+ case (BLHA_AMP_TREE); buf = "Tree"
	+ case (BLHA_AMP_LOOPINDUCED); buf = "LoopInduced"
	+ end select
	+ if (write_process) then
	+ write (u, '(A25, A)') "AmplitudeType " // pad, char (buf)
	+ buf = ""
	+ if (cfg%correction_type == BLHA_CT_EW .and. cfg%alphas_power > 0 .and. &
	+ (suffix_char (1:4) == "_SUB" .or. suffix_char (1:5) == "_LOOP" &
	+ .or. suffix_char (1:6) == "_DGLAP")) then
	+ if (query_coupling_powers (pdg_flv, cfg%alpha_power, cfg%alphas_power)) then
	+ write (u,'(A25,A)') "CorrectionType" // pad, "EW"
	+ select case (cfg%version)
	+ case (1)
	+ if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	+ "AlphasPower" // pad, int2char (cfg%alphas_power)
	+ if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	+ "AlphaPower " // pad, int2char (cfg%alpha_power)
	+ case (2)
	+ if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	+ "CouplingPower QCD " // pad, int2char (cfg%alphas_power)
	+ if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	+ "CouplingPower QED " // pad, int2char (cfg%alpha_power)
	+ end select
	+ else if (query_coupling_powers &
	+ (pdg_flv, cfg%alpha_power + 1, cfg%alphas_power - 1)) then
	+ write (u,'(A25,A)') "CorrectionType" // pad, "QCD"
	+ select case (cfg%version)
	+ case (1)
	+ if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	+ "AlphasPower" // pad, int2char (cfg%alphas_power - 1)
	+ if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	+ "AlphaPower " // pad, int2char (cfg%alpha_power + 1)
	+ case (2)
	+ if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	+ "CouplingPower QCD " // pad, int2char (cfg%alphas_power - 1)
	+ if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	+ "CouplingPower QED " // pad, int2char (cfg%alpha_power + 1)
	+ end select
	+ end if
	+ end if
	+ do i = 1, size (node%pdg_in)
	+ if (cfg%correction_type == BLHA_CT_EW .and. node%pdg_in(i)%pdg == PHOTON &
	+ .and. cfg%n_off_photons_is > 0) then
	+ if (cfg%ew_scheme == BLHA_EW_0) then
	+ call msg_fatal ("ew_scheme: 'alpha_0' or 'alpha_thompson' " &
	+ // "in combination", [ var_str ("with off-shell external photons " &
	+ // "is not consistent with FKS.")])
	+ end if
	+ write (pdg_char_extra, '(I5)') PHOTON_OFFSHELL
	+ buf = (buf // pdg_char_extra) // " "
	+ else
	+ call node%pdg_in(i)%write_pdg (pdg_char)
	+ if (node%pdg_in(i)%polarized) then
	+ call node%pdg_in(i)%write_helicity (hel_char)
	+ buf = (buf // pdg_char // hel_char) // " "
	+ else
	+ buf = (buf // pdg_char) // " "
	+ end if
	+ end if
	+ end do
	+ buf = buf // "-> "
	+ do i = 1, size (node%pdg_out)
	+ if (cfg%correction_type == BLHA_CT_EW .and. node%pdg_out(i)%pdg == PHOTON &
	+ .and. cfg%n_off_photons_fs > 0) then
	+ if (cfg%ew_scheme == BLHA_EW_0) then
	+ call msg_fatal ("ew_scheme: 'alpha_0' or 'alpha_thompson' " &
	+ // "in combination with off-shell external photons " &
	+ // "is not consistent with FKS. Try a different one.")
	+ end if
	+ write (pdg_char_extra, '(I5)') PHOTON_OFFSHELL
	+ buf = (buf // pdg_char_extra) // " "
	+ else
	+ call node%pdg_out(i)%write_pdg (pdg_char)
	+ buf = (buf // pdg_char) // " "
	+ end if
	+ end do
	+ write (u, "(A)") char (trim (buf))
	+ write (u, *)
	+ end if
	+ deallocate (pdg_flv)
	+ node => node%next
	+ end do
	+ end subroutine blha_configuration_write
	+
	+@ %def blha_configuration_write
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Module definition}

	These modules implement the communication with one loop matrix element providers
	according to the Binoth LesHouches Accord Interface. The actual matrix
	element(s) are loaded as a dynamic library.

	This module defines the common OLP-interfaces defined through the Binoth Les-Houches
	accord.

	<<[[blha_olp_interfaces.f90]]>>=
	<<File header>>

	module blha_olp_interfaces

	use, intrinsic :: iso_c_binding !NODEP!
	use, intrinsic :: iso_fortran_env

	use kinds
	<<Use strings>>
	-<<Use debug>>
	- use constants
	- use numeric_utils, only: vanishes
	- use numeric_utils, only: extend_integer_array, crop_integer_array
	- use io_units
	- use string_utils
	- use physics_defs
	- use diagnostics
	use os_interface
	use lorentz
	- use sm_qcd
	use interactions
	- use flavors
	use model_data
	- use pdg_arrays, only: is_gluon, is_quark, qcd_ew_interferences

	use prclib_interfaces
	use process_libraries
	use prc_core_def
	use prc_core
	-
	use prc_external
	-
	use blha_config

	<<Standard module head>>

	<<BLHA OLP interfaces: public>>

	<<BLHA OLP interfaces: public parameters>>

	-<<BLHA OLP interfaces: parameters>>
	-
	<<BLHA OLP interfaces: types>>

	<<BLHA OLP interfaces: interfaces>>

	+ interface
	+<<BLHA OLP interfaces: sub interfaces>>
	+ end interface
	+
	+end module blha_olp_interfaces
	+
	+@ %def module blha_olp_interfaces
	+@
	+<<[[blha_olp_interfaces_sub.f90]]>>=
	+<<File header>>
	+
	+submodule (blha_olp_interfaces) blha_olp_interfaces_s
	+
	+<<Use debug>>
	+ use constants
	+ use numeric_utils, only: vanishes
	+ use numeric_utils, only: extend_integer_array, crop_integer_array
	+ use io_units
	+ use string_utils
	+ use physics_defs
	+ use diagnostics
	+ use sm_qcd
	+ use flavors
	+ use pdg_arrays, only: is_gluon, is_quark, qcd_ew_interferences
	+
	+ implicit none
	+
	+<<BLHA OLP interfaces: parameters>>
	+
	contains

	<<BLHA OLP interfaces: procedures>>

	-end module blha_olp_interfaces
	+end submodule blha_olp_interfaces_s

	-@ %def module blha_olp_interfaces
	+@ %def blha_olp_interfaces_s
	@
	<<BLHA OLP interfaces: public>>=
	public :: blha_template_t
	<<BLHA OLP interfaces: types>>=
	type :: blha_template_t
	integer :: I_BORN = 0
	integer :: I_REAL = 1
	integer :: I_LOOP = 2
	integer :: I_SUB = 3
	integer :: I_DGLAP = 4
	logical, dimension(0:4) :: compute_component
	logical :: include_polarizations = .false.
	logical :: switch_off_muon_yukawas = .false.
	logical :: use_internal_color_correlations = .true.
	real(default) :: external_top_yukawa = -1._default
	integer :: ew_scheme
	integer :: loop_method = BLHA_MODE_GENERIC
	contains
	<<BLHA OLP interfaces: blha template: TBP>>
	end type blha_template_t

	@ %def blha_template_t
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: write => blha_template_write
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_template_write (blha_template, unit)
	+ class(blha_template_t), intent(in) :: blha_template
	+ integer, intent(in), optional :: unit
	+ end subroutine blha_template_write
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_template_write (blha_template, unit)
	+ module subroutine blha_template_write (blha_template, unit)
	class(blha_template_t), intent(in) :: blha_template
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(A,4(L1))") "Compute components: ", &
	blha_template%compute_component
	write (u,"(A,L1)") "Include polarizations: ", &
	blha_template%include_polarizations
	write (u,"(A,L1)") "Switch off muon yukawas: ", &
	blha_template%switch_off_muon_yukawas
	write (u,"(A,L1)") "Use internal color correlations: ", &
	blha_template%use_internal_color_correlations
	end subroutine blha_template_write

	@ %def blha_template_write
	@ Compute the total number of used helicity states for the given particle PDG
	codes, given a model. Applies only if polarization is supported. This
	yields the [[n_hel]] value as required below.
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: get_n_hel => blha_template_get_n_hel
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function blha_template_get_n_hel (blha_template, pdg, model) result (n_hel)
	+ class(blha_template_t), intent(in) :: blha_template
	+ integer, dimension(:), intent(in) :: pdg
	+ class(model_data_t), intent(in), target :: model
	+ integer :: n_hel
	+ end function blha_template_get_n_hel
	<<BLHA OLP interfaces: procedures>>=
	- function blha_template_get_n_hel (blha_template, pdg, model) result (n_hel)
	+ module function blha_template_get_n_hel (blha_template, pdg, model) result (n_hel)
	class(blha_template_t), intent(in) :: blha_template
	integer, dimension(:), intent(in) :: pdg
	class(model_data_t), intent(in), target :: model
	integer :: n_hel
	type(flavor_t) :: flv
	integer :: f
	n_hel = 1
	if (blha_template%include_polarizations) then
	do f = 1, size (pdg)
	call flv%init (pdg(f), model)
	n_hel = n_hel * flv%get_multiplicity ()
	end do
	end if
	end function blha_template_get_n_hel

	@ %def blha_template_get_n_hel
	@
	<<BLHA OLP interfaces: parameters>>=
	integer, parameter :: I_ALPHA_0 = 1
	integer, parameter :: I_GF = 2
	integer, parameter :: I_ALPHA_MZ = 3
	integer, parameter :: I_ALPHA_INTERNAL = 4
	integer, parameter :: I_SW2 = 5

	<<BLHA OLP interfaces: public>>=
	public :: prc_blha_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_t) :: prc_blha_t
	integer :: n_particles
	integer :: n_hel
	integer :: n_proc
	integer, dimension(:, :), allocatable :: i_tree, i_spin_c, i_color_c
	integer, dimension(:, :), allocatable :: i_virt
	integer, dimension(:, :), allocatable :: i_hel
	logical, dimension(5) :: ew_parameter_mask
	integer :: sqme_tree_pos
	contains
	<<BLHA OLP interfaces: prc blha: TBP>>
	end type prc_blha_t

	@ %def prc_blha_t
	@
	Obviously, this process-core type uses the BLHA interface.
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure, nopass :: uses_blha => prc_blha_uses_blha
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function prc_blha_uses_blha () result (flag)
	+ logical :: flag
	+ end function prc_blha_uses_blha
	<<BLHA OLP interfaces: procedures>>=
	- function prc_blha_uses_blha () result (flag)
	+ module function prc_blha_uses_blha () result (flag)
	logical :: flag
	flag = .true.
	end function prc_blha_uses_blha

	@ %def prc_blha_uses_blha
	@
	<<BLHA OLP interfaces: public>>=
	public :: blha_driver_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_driver_t) :: blha_driver_t
	type(string_t) :: contract_file
	type(string_t) :: nlo_suffix
	logical :: include_polarizations = .false.
	logical :: switch_off_muon_yukawas = .false.
	real(default) :: external_top_yukawa = -1.0
	procedure(olp_start),nopass, pointer :: &
	blha_olp_start => null ()
	procedure(olp_eval), nopass, pointer :: &
	blha_olp_eval => null()
	procedure(olp_info), nopass, pointer :: &
	blha_olp_info => null ()
	procedure(olp_set_parameter), nopass, pointer :: &
	blha_olp_set_parameter => null ()
	procedure(olp_eval2), nopass, pointer :: &
	blha_olp_eval2 => null ()
	procedure(olp_option), nopass, pointer :: &
	blha_olp_option => null ()
	procedure(olp_polvec), nopass, pointer :: &
	blha_olp_polvec => null ()
	procedure(olp_finalize), nopass, pointer :: &
	blha_olp_finalize => null ()
	procedure(olp_print_parameter), nopass, pointer :: &
	blha_olp_print_parameter => null ()
	contains
	<<BLHA OLP interfaces: blha driver: TBP>>
	end type blha_driver_t

	@
	@ %def blha_driver_t
	<<BLHA OLP interfaces: public>>=
	public :: prc_blha_writer_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_writer_t) :: prc_blha_writer_t
	type(blha_configuration_t) :: blha_cfg
	contains
	<<BLHA OLP interfaces: blha writer: TBP>>
	end type prc_blha_writer_t

	@
	@ %def prc_blha_writer_t
	<<BLHA OLP interfaces: public>>=
	public :: blha_def_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_def_t) :: blha_def_t
	type(string_t) :: suffix
	contains
	<<BLHA OLP interfaces: blha def: TBP>>
	end type blha_def_t

	@ %def blha_def_t
	@
	<<BLHA OLP interfaces: public>>=
	public :: blha_state_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_state_t) :: blha_state_t
	contains
	<<BLHA OLP interfaces: blha state: TBP>>
	end type blha_state_t

	@ %def blha_state_t
	@
	<<BLHA OLP interfaces: blha state: TBP>>=
	procedure :: reset_new_kinematics => blha_state_reset_new_kinematics
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_state_reset_new_kinematics (object)
	+ class(blha_state_t), intent(inout) :: object
	+ end subroutine blha_state_reset_new_kinematics
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_state_reset_new_kinematics (object)
	+ module subroutine blha_state_reset_new_kinematics (object)
	class(blha_state_t), intent(inout) :: object
	object%new_kinematics = .true.
	end subroutine blha_state_reset_new_kinematics

	@ %def blha_state_reset_new_kinematics
	@
	<<BLHA OLP interfaces: public parameters>>=
	integer, parameter, public :: OLP_PARAMETER_LIMIT = 10
	integer, parameter, public :: OLP_MOMENTUM_LIMIT = 50
	integer, parameter, public :: OLP_RESULTS_LIMIT = 60

	<<BLHA OLP interfaces: public>>=
	public :: olp_start
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_start (contract_file_name, ierr) bind (C,name = "OLP_Start")
	import
	character(kind = c_char, len = 1), intent(in) :: contract_file_name
	integer(kind = c_int), intent(out) :: ierr
	end subroutine olp_start
	end interface

	@ %def olp_start_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_eval
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_eval (label, momenta, mu, parameters, res) &
	bind (C, name = "OLP_EvalSubProcess")
	import
	integer(kind = c_int), value, intent(in) :: label
	real(kind = c_double), value, intent(in) :: mu
	real(kind = c_double), dimension(OLP_MOMENTUM_LIMIT), intent(in) :: &
	momenta
	real(kind = c_double), dimension(OLP_PARAMETER_LIMIT), intent(in) :: &
	parameters
	real(kind = c_double), dimension(OLP_RESULTS_LIMIT), intent(out) :: res
	end subroutine olp_eval
	end interface

	@ %def olp_eval interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_info
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_info (olp_file, olp_version, message) bind(C)
	import
	character(kind = c_char), intent(inout), dimension(15) :: olp_file
	character(kind = c_char), intent(inout), dimension(15) :: olp_version
	character(kind = c_char), intent(inout), dimension(255) :: message
	end subroutine olp_info
	end interface

	@ %def olp_info interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_set_parameter
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_set_parameter &
	(variable_name, real_part, complex_part, success) bind(C)
	import
	character(kind = c_char,len = 1), intent(in) :: variable_name
	real(kind = c_double), intent(in) :: real_part, complex_part
	integer(kind = c_int), intent(out) :: success
	end subroutine olp_set_parameter
	end interface

	@ %def olp_set_parameter_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_eval2
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_eval2 (label, momenta, mu, res, acc) bind(C)
	import
	integer(kind = c_int), intent(in) :: label
	real(kind = c_double), intent(in) :: mu
	real(kind = c_double), dimension(OLP_MOMENTUM_LIMIT), intent(in) :: momenta
	real(kind = c_double), dimension(OLP_RESULTS_LIMIT), intent(out) :: res
	real(kind = c_double), intent(out) :: acc
	end subroutine olp_eval2
	end interface

	@ %def olp_eval2 interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_option
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_option (line, stat) bind(C)
	import
	character(kind = c_char, len=1), intent(in) :: line
	integer(kind = c_int), intent(out) :: stat
	end subroutine
	end interface

	@ %def olp_option_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_polvec
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_polvec (p, q, eps) bind(C)
	import
	real(kind = c_double), dimension(0:3), intent(in) :: p, q
	real(kind = c_double), dimension(0:7), intent(out) :: eps
	end subroutine
	end interface

	@ %def olp_polvec_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_finalize
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_finalize () bind(C)
	import
	end subroutine olp_finalize
	end interface

	@ %def olp_finalize_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_print_parameter
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_print_parameter (filename) bind(C)
	import
	character(kind = c_char, len = 1), intent(in) :: filename
	end subroutine olp_print_parameter
	end interface

	@ %def olp_print_parameter_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: blha_result_array_size
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ pure module function blha_result_array_size &
	+ (n_part, amp_type) result (rsize)
	+ integer, intent(in) :: n_part, amp_type
	+ integer :: rsize
	+ end function blha_result_array_size
	<<BLHA OLP interfaces: procedures>>=
	- pure function blha_result_array_size (n_part, amp_type) result (rsize)
	+ pure module function blha_result_array_size &
	+ (n_part, amp_type) result (rsize)
	integer, intent(in) :: n_part, amp_type
	integer :: rsize
	select case (amp_type)
	case (BLHA_AMP_TREE)
	rsize = 1
	case (BLHA_AMP_LOOP)
	rsize = 4
	case (BLHA_AMP_COLOR_C)
	rsize = n_part * (n_part - 1) / 2
	case (BLHA_AMP_SPIN_C)
	rsize = 2 * n_part**2
	case default
	rsize = 0
	end select
	end function blha_result_array_size

	@ %def blha_result_array_size
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: create_momentum_array => prc_blha_create_momentum_array
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function prc_blha_create_momentum_array (object, p) result (mom)
	+ class(prc_blha_t), intent(in) :: object
	+ type(vector4_t), intent(in), dimension(:) :: p
	+ real(double), dimension(5*object%n_particles) :: mom
	+ end function prc_blha_create_momentum_array
	<<BLHA OLP interfaces: procedures>>=
	- function prc_blha_create_momentum_array (object, p) result (mom)
	+ module function prc_blha_create_momentum_array (object, p) result (mom)
	class(prc_blha_t), intent(in) :: object
	type(vector4_t), intent(in), dimension(:) :: p
	real(double), dimension(5*object%n_particles) :: mom
	integer :: n, i, k

	n = size (p)
	if (n > 10) call msg_fatal ("Number of external particles exceeds" &
	// "size of BLHA-internal momentum array")

	mom = zero
	k = 1
	do i = 1, n
	mom(k : k + 3) = vector4_get_components (p(i))
	mom(k + 4) = invariant_mass (p(i))
	k = k + 5
	end do
	end function prc_blha_create_momentum_array

	@ %def prc_blha_create_momentum_array
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: init => blha_template_init
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_template_init (template, requires_polarizations, &
	+ switch_off_muon_yukawas, external_top_yukawa, ew_scheme)
	+ class(blha_template_t), intent(inout) :: template
	+ logical, intent(in) :: requires_polarizations, switch_off_muon_yukawas
	+ real(default), intent(in) :: external_top_yukawa
	+ type(string_t), intent(in) :: ew_scheme
	+ end subroutine blha_template_init
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_template_init (template, requires_polarizations, &
	+ module subroutine blha_template_init (template, requires_polarizations, &
	switch_off_muon_yukawas, external_top_yukawa, ew_scheme)
	class(blha_template_t), intent(inout) :: template
	logical, intent(in) :: requires_polarizations, switch_off_muon_yukawas
	real(default), intent(in) :: external_top_yukawa
	type(string_t), intent(in) :: ew_scheme
	template%compute_component = .false.
	template%include_polarizations = requires_polarizations
	template%switch_off_muon_yukawas = switch_off_muon_yukawas
	template%external_top_yukawa = external_top_yukawa
	template%ew_scheme = ew_scheme_string_to_int (ew_scheme)
	end subroutine blha_template_init

	@ %def blha_template_init
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: set_born => blha_template_set_born
	procedure :: set_real_trees => blha_template_set_real_trees
	procedure :: set_loop => blha_template_set_loop
	procedure :: set_subtraction => blha_template_set_subtraction
	procedure :: set_dglap => blha_template_set_dglap
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_template_set_born (template)
	+ class(blha_template_t), intent(inout) :: template
	+ end subroutine blha_template_set_born
	+ module subroutine blha_template_set_real_trees (template)
	+ class(blha_template_t), intent(inout) :: template
	+ end subroutine blha_template_set_real_trees
	+ module subroutine blha_template_set_loop (template)
	+ class(blha_template_t), intent(inout) :: template
	+ end subroutine blha_template_set_loop
	+ module subroutine blha_template_set_subtraction (template)
	+ class(blha_template_t), intent(inout) :: template
	+ end subroutine blha_template_set_subtraction
	+ module subroutine blha_template_set_dglap (template)
	+ class(blha_template_t), intent(inout) :: template
	+ end subroutine blha_template_set_dglap
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_template_set_born (template)
	+ module subroutine blha_template_set_born (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component (template%I_BORN) = .true.
	end subroutine blha_template_set_born

	- subroutine blha_template_set_real_trees (template)
	+ module subroutine blha_template_set_real_trees (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component (template%I_REAL) = .true.
	end subroutine blha_template_set_real_trees

	- subroutine blha_template_set_loop (template)
	+ module subroutine blha_template_set_loop (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component(template%I_LOOP) = .true.
	end subroutine blha_template_set_loop

	- subroutine blha_template_set_subtraction (template)
	+ module subroutine blha_template_set_subtraction (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component (template%I_SUB) = .true.
	end subroutine blha_template_set_subtraction

	- subroutine blha_template_set_dglap (template)
	+ module subroutine blha_template_set_dglap (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component (template%I_DGLAP) = .true.
	end subroutine blha_template_set_dglap

	@ %def blha_template_set_components
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: set_internal_color_correlations &
	=> blha_template_set_internal_color_correlations
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_template_set_internal_color_correlations (template)
	+ class(blha_template_t), intent(inout) :: template
	+ end subroutine blha_template_set_internal_color_correlations
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_template_set_internal_color_correlations (template)
	+ module subroutine blha_template_set_internal_color_correlations (template)
	class(blha_template_t), intent(inout) :: template
	template%use_internal_color_correlations = .true.
	end subroutine blha_template_set_internal_color_correlations

	@ %def blha_template_set_internal_color_correlations
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: get_internal_color_correlations &
	=> blha_template_get_internal_color_correlations
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ pure module function blha_template_get_internal_color_correlations &
	+ (template) result (val)
	+ logical :: val
	+ class(blha_template_t), intent(in) :: template
	+ end function blha_template_get_internal_color_correlations
	<<BLHA OLP interfaces: procedures>>=
	- pure function blha_template_get_internal_color_correlations (template) &
	- result (val)
	+ pure module function blha_template_get_internal_color_correlations &
	+ (template) result (val)
	logical :: val
	class(blha_template_t), intent(in) :: template
	val = template%use_internal_color_correlations
	end function blha_template_get_internal_color_correlations

	@ %def blha_template_use_internal_color_correlations
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: compute_born => blha_template_compute_born
	procedure :: compute_real_trees => blha_template_compute_real_trees
	procedure :: compute_loop => blha_template_compute_loop
	procedure :: compute_subtraction => blha_template_compute_subtraction
	procedure :: compute_dglap => blha_template_compute_dglap
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ pure module function blha_template_compute_born (template) result (val)
	+ class(blha_template_t), intent(in) :: template
	+ logical :: val
	+ end function blha_template_compute_born
	+ pure module function blha_template_compute_real_trees (template) result (val)
	+ class(blha_template_t), intent(in) :: template
	+ logical :: val
	+ end function blha_template_compute_real_trees
	+ pure module function blha_template_compute_loop (template) result (val)
	+ class(blha_template_t), intent(in) :: template
	+ logical :: val
	+ end function blha_template_compute_loop
	+ pure module function blha_template_compute_subtraction (template) result (val)
	+ class(blha_template_t), intent(in) :: template
	+ logical :: val
	+ end function blha_template_compute_subtraction
	+ pure module function blha_template_compute_dglap (template) result (val)
	+ class(blha_template_t), intent(in) :: template
	+ logical :: val
	+ end function blha_template_compute_dglap
	<<BLHA OLP interfaces: procedures>>=
	- pure function blha_template_compute_born (template) result (val)
	+ pure module function blha_template_compute_born (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_BORN)
	end function blha_template_compute_born

	- pure function blha_template_compute_real_trees (template) result (val)
	+ pure module function blha_template_compute_real_trees (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_REAL)
	end function blha_template_compute_real_trees

	- pure function blha_template_compute_loop (template) result (val)
	+ pure module function blha_template_compute_loop (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_LOOP)
	end function blha_template_compute_loop

	- pure function blha_template_compute_subtraction (template) result (val)
	+ pure module function blha_template_compute_subtraction (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_SUB)
	end function blha_template_compute_subtraction

	- pure function blha_template_compute_dglap (template) result (val)
	+ pure module function blha_template_compute_dglap (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_DGLAP)
	end function blha_template_compute_dglap

	@ %def blha_template_compute
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: set_loop_method => blha_template_set_loop_method
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_template_set_loop_method (template, master)
	+ class(blha_template_t), intent(inout) :: template
	+ class(blha_master_t), intent(in) :: master
	+ end subroutine blha_template_set_loop_method
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_template_set_loop_method (template, master)
	+ module subroutine blha_template_set_loop_method (template, master)
	class(blha_template_t), intent(inout) :: template
	class(blha_master_t), intent(in) :: master
	template%loop_method = master%blha_mode(1)
	end subroutine blha_template_set_loop_method
	@ %def blha_template_set_loop_method
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: check => blha_template_check
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function blha_template_check (template) result (val)
	+ class(blha_template_t), intent(in) :: template
	+ logical :: val
	+ end function blha_template_check
	<<BLHA OLP interfaces: procedures>>=
	- function blha_template_check (template) result (val)
	+ module function blha_template_check (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = count (template%compute_component) == 1
	end function blha_template_check

	@ %def blha_template_check
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: reset => blha_template_reset
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_template_reset (template)
	+ class(blha_template_t), intent(inout) :: template
	+ end subroutine blha_template_reset
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_template_reset (template)
	+ module subroutine blha_template_reset (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component = .false.
	end subroutine blha_template_reset

	@ %def blha_template_reset
	@
	<<BLHA OLP interfaces: blha writer: TBP>>=
	procedure :: write => prc_blha_writer_write
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_writer_write (writer, unit)
	+ class(prc_blha_writer_t), intent(in) :: writer
	+ integer, intent(in) :: unit
	+ end subroutine prc_blha_writer_write
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_writer_write (writer, unit)
	+ module subroutine prc_blha_writer_write (writer, unit)
	class(prc_blha_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	write (unit, "(1x,A)") char (writer%get_process_string ())
	end subroutine prc_blha_writer_write

	@
	@ %def prc_blha_writer_write
	<<BLHA OLP interfaces: blha writer: TBP>>=
	procedure :: get_process_string => prc_blha_writer_get_process_string
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function prc_blha_writer_get_process_string (writer) result (s_proc)
	+ class(prc_blha_writer_t), intent(in) :: writer
	+ type(string_t) :: s_proc
	+ end function prc_blha_writer_get_process_string
	<<BLHA OLP interfaces: procedures>>=
	- function prc_blha_writer_get_process_string (writer) result (s_proc)
	+ module function prc_blha_writer_get_process_string (writer) result (s_proc)
	class(prc_blha_writer_t), intent(in) :: writer
	type(string_t) :: s_proc
	s_proc = var_str ("")
	end function prc_blha_writer_get_process_string

	@ %def prc_blha_writer_get_process_string
	@
	<<BLHA OLP interfaces: blha writer: TBP>>=
	procedure :: get_n_proc => prc_blha_writer_get_n_proc
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function prc_blha_writer_get_n_proc (writer) result (n_proc)
	+ class(prc_blha_writer_t), intent(in) :: writer
	+ integer :: n_proc
	+ end function prc_blha_writer_get_n_proc
	<<BLHA OLP interfaces: procedures>>=
	- function prc_blha_writer_get_n_proc (writer) result (n_proc)
	+ module function prc_blha_writer_get_n_proc (writer) result (n_proc)
	class(prc_blha_writer_t), intent(in) :: writer
	integer :: n_proc
	n_proc = blha_configuration_get_n_proc (writer%blha_cfg)
	end function prc_blha_writer_get_n_proc

	@ %def prc_blha_writer_get_n_proc
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_set_GF), deferred :: &
	set_GF
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_set_GF (driver, GF)
	import
	class(blha_driver_t), intent(inout) :: driver
	real(default), intent(in) :: GF
	end subroutine blha_driver_set_GF
	end interface

	@ %def blha_driver_set_GF
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_set_alpha_s), deferred :: &
	set_alpha_s
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_set_alpha_s (driver, alpha_s)
	import
	class(blha_driver_t), intent(in) :: driver
	real(default), intent(in) :: alpha_s
	end subroutine blha_driver_set_alpha_s
	end interface

	@ %def set_alpha_s interface
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_set_weinberg_angle), deferred :: &
	set_weinberg_angle
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_set_weinberg_angle (driver, sw2)
	import
	class(blha_driver_t), intent(inout) :: driver
	real(default), intent(in) :: sw2
	end subroutine blha_driver_set_weinberg_angle
	end interface

	@ %def blha_driver_set_weinberg_angle
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_set_alpha_qed), deferred :: set_alpha_qed
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_set_alpha_qed (driver, alpha)
	import
	class(blha_driver_t), intent(inout) :: driver
	real(default), intent(in) :: alpha
	end subroutine blha_driver_set_alpha_qed
	end interface

	@ %def blha_driver_set_alpha_qed
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_print_alpha_s), deferred :: &
	print_alpha_s
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_print_alpha_s (object)
	import
	class(blha_driver_t), intent(in) :: object
	end subroutine blha_driver_print_alpha_s
	end interface

	@ %def print_alpha_s interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: parameter_error_message
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine parameter_error_message (par, subr)
	- type(string_t), intent(in) :: par, subr
	- type(string_t) :: message
	- message = "Setting of parameter " // par &
	- // "failed in " // subr // "!"
	- call msg_fatal (char (message))
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine parameter_error_message (par, subr)
	+ type(string_t), intent(in) :: par, subr
	+ end subroutine parameter_error_message
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine parameter_error_message (par, subr)
	+ type(string_t), intent(in) :: par, subr
	+ type(string_t) :: message
	+ message = "Setting of parameter " // par &
	+ // "failed in " // subr // "!"
	+ call msg_fatal (char (message))
	end subroutine parameter_error_message

	@ %def parameter_error_message
	@
	<<BLHA OLP interfaces: public>>=
	public :: ew_parameter_error_message
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine ew_parameter_error_message (par)
	- type(string_t), intent(in) :: par
	- type(string_t) :: message
	- message = "Setting of parameter " // par &
	- // "failed. This happens because the chosen " &
	- // "EWScheme in the BLHA file does not fit " &
	- // "your parameter choice"
	- call msg_fatal (char (message))
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine ew_parameter_error_message (par)
	+ type(string_t), intent(in) :: par
	+ end subroutine ew_parameter_error_message
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine ew_parameter_error_message (par)
	+ type(string_t), intent(in) :: par
	+ type(string_t) :: message
	+ message = "Setting of parameter " // par &
	+ // "failed. This happens because the chosen " &
	+ // "EWScheme in the BLHA file does not fit " &
	+ // "your parameter choice"
	+ call msg_fatal (char (message))
	end subroutine ew_parameter_error_message

	@ %def ew_parameter_error_message
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure :: set_mass_and_width => blha_driver_set_mass_and_width
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_driver_set_mass_and_width &
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_driver_set_mass_and_width &
	(driver, i_pdg, mass, width)
	+ class(blha_driver_t), intent(inout) :: driver
	+ integer, intent(in) :: i_pdg
	+ real(default), intent(in), optional :: mass
	+ real(default), intent(in), optional :: width
	+ end subroutine blha_driver_set_mass_and_width
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine blha_driver_set_mass_and_width &
	+ (driver, i_pdg, mass, width)
	class(blha_driver_t), intent(inout) :: driver
	integer, intent(in) :: i_pdg
	real(default), intent(in), optional :: mass
	real(default), intent(in), optional :: width
	type(string_t) :: buf
	character(kind=c_char,len=20) :: c_string
	integer :: ierr
	if (present (mass)) then
	buf = 'mass(' // str (abs(i_pdg)) // ')'
	c_string = char(buf) // c_null_char
	call driver%blha_olp_set_parameter &
	(c_string, dble(mass), 0._double, ierr)
	if (ierr == 0) then
	buf = "BLHA driver: Attempt to set mass of particle " // &
	str (abs(i_pdg)) // "failed"
	call msg_fatal (char(buf))
	end if
	end if
	if (present (width)) then
	buf = 'width(' // str (abs(i_pdg)) // ')'
	c_string = char(buf)//c_null_char
	call driver%blha_olp_set_parameter &
	(c_string, dble(width), 0._double, ierr)
	if (ierr == 0) then
	buf = "BLHA driver: Attempt to set width of particle " // &
	str (abs(i_pdg)) // "failed"
	call msg_fatal (char(buf))
	end if
	end if
	end subroutine blha_driver_set_mass_and_width

	@ %def blha_driver_set_mass_and_width
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_init_dlaccess_to_library), deferred :: &
	init_dlaccess_to_library
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_init_dlaccess_to_library &
	(object, os_data, dlaccess, success)
	import
	class(blha_driver_t), intent(in) :: object
	type(os_data_t), intent(in) :: os_data
	type(dlaccess_t), intent(out) :: dlaccess
	logical, intent(out) :: success
	end subroutine blha_driver_init_dlaccess_to_library
	end interface

	@ %def interface blha_driver_init_dlaccess_to_library
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure :: load => blha_driver_load
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_driver_load (object, os_data, success)
	+ class(blha_driver_t), intent(inout) :: object
	+ type(os_data_t), intent(in) :: os_data
	+ logical, intent(out) :: success
	+ end subroutine blha_driver_load
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_driver_load (object, os_data, success)
	+ module subroutine blha_driver_load (object, os_data, success)
	class(blha_driver_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	logical, intent(out) :: success
	type(dlaccess_t) :: dlaccess
	type(c_funptr) :: c_fptr
	logical :: init_success

	call object%init_dlaccess_to_library (os_data, dlaccess, init_success)

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Start"))
	call c_f_procpointer (c_fptr, object%blha_olp_start)
	call check_for_error (var_str ("OLP_Start"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_EvalSubProcess"))
	call c_f_procpointer (c_fptr, object%blha_olp_eval)
	call check_for_error (var_str ("OLP_EvalSubProcess"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Info"))
	call c_f_procpointer (c_fptr, object%blha_olp_info)
	call check_for_error (var_str ("OLP_Info"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_SetParameter"))
	call c_f_procpointer (c_fptr, object%blha_olp_set_parameter)
	call check_for_error (var_str ("OLP_SetParameter"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_EvalSubProcess2"))
	call c_f_procpointer (c_fptr, object%blha_olp_eval2)
	call check_for_error (var_str ("OLP_EvalSubProcess2"))

	!!! The following three functions are not implemented in OpenLoops.
	!!! In another BLHA provider, they need to be implemented separately.

	!!! c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Option"))
	!!! call c_f_procpointer (c_fptr, object%blha_olp_option)
	!!! call check_for_error (var_str ("OLP_Option"))

	!!! c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Polvec"))
	!!! call c_f_procpointer (c_fptr, object%blha_olp_polvec)
	!!! call check_for_error (var_str ("OLP_Polvec"))

	!!! c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Finalize"))
	!!! call c_f_procpointer (c_fptr, object%blha_olp_finalize)
	!!! call check_for_error (var_str ("OLP_Finalize"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_PrintParameter"))
	call c_f_procpointer (c_fptr, object%blha_olp_print_parameter)
	call check_for_error (var_str ("OLP_PrintParameter"))

	success = .true.
	contains
	subroutine check_for_error (function_name)
	type(string_t), intent(in) :: function_name
	if (dlaccess_has_error (dlaccess)) &
	call msg_fatal (char ("Loading of " // function_name // " failed!"))
	end subroutine check_for_error
	end subroutine blha_driver_load

	@ %def blha_driver_load
	@
	<<BLHA OLP interfaces: parameters>>=
	integer, parameter :: LEN_MAX_FLAVOR_STRING = 100
	integer, parameter :: N_MAX_FLAVORS = 100
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure :: read_contract_file => blha_driver_read_contract_file
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_driver_read_contract_file (driver, flavors, &
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_driver_read_contract_file (driver, flavors, &
	amp_type, flv_index, hel_index, label, helicities)
	+ class(blha_driver_t), intent(inout) :: driver
	+ integer, intent(in), dimension(:,:) :: flavors
	+ integer, intent(out), dimension(:), allocatable :: amp_type, &
	+ flv_index, hel_index, label
	+ integer, intent(out), dimension(:,:) :: helicities
	+ end subroutine blha_driver_read_contract_file
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine blha_driver_read_contract_file (driver, flavors, &
	+ amp_type, flv_index, hel_index, label, helicities)
	class(blha_driver_t), intent(inout) :: driver
	integer, intent(in), dimension(:,:) :: flavors
	integer, intent(out), dimension(:), allocatable :: amp_type, &
	flv_index, hel_index, label
	integer, intent(out), dimension(:,:) :: helicities
	integer :: unit, filestat
	character(len=LEN_MAX_FLAVOR_STRING) :: rd_line
	logical :: read_flavor, give_warning
	integer :: label_count, i_flv, i
	integer :: i_hel, n_in
	integer :: i_next, n_entries
	integer, dimension(size(flavors, 1) + 2) :: i_array
	integer, dimension(size(flavors, 1) + 2) :: hel_array
	integer, dimension(size(flavors, 1)) :: flv_array
	integer, parameter :: NO_NUMBER = -1000
	integer, parameter :: PROC_NOT_FOUND = -1001
	integer, parameter :: list_incr = 50
	integer :: n_found
	allocate (amp_type (N_MAX_FLAVORS), flv_index (N_MAX_FLAVORS), &
	hel_index (N_MAX_FLAVORS), label (N_MAX_FLAVORS))
	amp_type = -1; flv_index = -1; hel_index = -1; label = -1
	helicities = 0
	n_in = size (helicities, dim = 2)
	n_entries = size (flavors, 1) + 2
	unit = free_unit ()
	open (unit, file = char (driver%contract_file), status="old")
	read_flavor = .false.
	label_count = 1
	i_hel = 1
	n_found = 0
	give_warning = .false.
	do
	read (unit, "(A)", iostat = filestat) rd_line
	if (filestat == iostat_end) then
	exit
	else
	if (rd_line(1:13) == 'AmplitudeType') then
	if (i_hel > 2 * n_in) i_hel = 1
	i_next = find_next_word_index (rd_line, 13)
	if (label_count > size (amp_type)) &
	call extend_integer_array (amp_type, list_incr)
	if (rd_line(i_next : i_next + 4) == 'Loop') then
	amp_type(label_count) = BLHA_AMP_LOOP
	else if (rd_line(i_next : i_next + 4) == 'Tree') then
	amp_type(label_count) = BLHA_AMP_TREE
	else if (rd_line(i_next : i_next + 6) == 'ccTree') then
	amp_type(label_count) = BLHA_AMP_COLOR_C
	else if (rd_line(i_next : i_next + 6) == 'scTree' .or. &
	rd_line(i_next : i_next + 14) == 'sctree_polvect') then
	amp_type(label_count) = BLHA_AMP_SPIN_C
	else
	call msg_fatal ("AmplitudeType present but AmpType not known!")
	end if
	read_flavor = .true.
	else if (read_flavor .and. .not. (rd_line(1:13) == 'CouplingPower' &
	.or. rd_line(1:14) == 'CorrectionType')) then
	i_array = create_flavor_string (rd_line, n_entries)
	if (driver%include_polarizations) then
	hel_array = create_helicity_string (rd_line, n_entries)
	call check_helicity_array (hel_array, n_entries, n_in)
	else
	hel_array = 0
	end if
	if (.not. all (i_array == PROC_NOT_FOUND)) then
	do i_flv = 1, size (flavors, 2)
	flv_array = 0
	do i = 1, size (flv_array)
	if (i_array (i) == PHOTON_OFFSHELL .and. &
	flavors (i, i_flv) == PHOTON) then
	flv_array (i) = i_array (i)
	else
	flv_array (i) = flavors (i, i_flv)
	end if
	end do
	if (all (i_array (1 : n_entries - 2) == flv_array (:))) then
	if (label_count > size (label)) &
	call extend_integer_array (label, list_incr)
	label(label_count) = i_array (n_entries)
	if (label_count > size (flv_index)) &
	call extend_integer_array (flv_index, list_incr)
	flv_index (label_count) = i_flv
	if (label_count > size (hel_index)) &
	call extend_integer_array (hel_index, list_incr)
	hel_index (label_count) = i_hel
	if (driver%include_polarizations) then
	helicities (label(label_count), :) = hel_array (1:n_in)
	i_hel = i_hel + 1
	end if
	n_found = n_found + 1
	label_count = label_count + 1
	exit
	end if
	end do
	give_warning = .false.
	else
	give_warning = .true.
	end if
	read_flavor = .false.
	end if
	end if
	end do
	call crop_integer_array (amp_type, label_count-1)
	if (n_found == 0) then
	call msg_fatal ("The desired process has not been found ", &
	[var_str ("by the OLP-Provider. Maybe the value of alpha_power "), &
	var_str ("or alphas_power does not correspond to the process. "), &
	var_str ("If you are using OpenLoops, you can set the option "), &
	var_str ("openloops_verbosity to a value larger than 1 to obtain "), &
	var_str ("more information")])
	else if (give_warning) then
	call msg_warning ("Some processes have not been found in the OLC file.", &
	[var_str ("This is because these processes do not fit the required "), &
	var_str ("coupling alpha_power and alphas_power. Be aware that the "), &
	var_str ("results of this calculation are not necessarily an accurate "), &
	var_str ("description of the physics of interest.")])
	end if
	close(unit)

	contains

	function create_flavor_string (s, n_entries) result (i_array)
	character(len=LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(in) :: n_entries
	integer, dimension(n_entries) :: i_array
	integer :: k, current_position
	integer :: i_entry
	k = 1; current_position = 1
	do
	if (current_position > LEN_MAX_FLAVOR_STRING) &
	call msg_fatal ("Read OLC File: Current position exceeds maximum value")
	if (s(current_position:current_position) /= " ") then
	call create_flavor (s, i_entry, current_position)
	if (i_entry /= NO_NUMBER .and. i_entry /= PROC_NOT_FOUND) then
	i_array(k) = i_entry
	k = k + 1
	if (k > n_entries) then
	return
	else
	call increment_current_position (s, current_position)
	end if
	else if (i_entry == PROC_NOT_FOUND) then
	i_array = PROC_NOT_FOUND
	return
	else
	call increment_current_position (s, current_position)
	end if
	else
	call increment_current_position (s, current_position)
	end if
	end do
	end function create_flavor_string

	function create_helicity_string (s, n_entries) result (hel_array)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(in) :: n_entries
	integer, dimension(n_entries) :: hel_array
	integer :: k, current_position
	integer :: hel
	k = 1; current_position = 1
	do
	if (current_position > LEN_MAX_FLAVOR_STRING) &
	call msg_fatal ("Read OLC File: Current position exceeds maximum value")
	if (s(current_position:current_position) /= " ") then
	call create_helicity (s, hel, current_position)
	if (hel >= -1 .and. hel <= 1) then
	hel_array(k) = hel
	k = k + 1
	if (k > n_entries) then
	return
	else
	call increment_current_position (s, current_position)
	end if
	else
	call increment_current_position (s, current_position)
	end if
	else
	call increment_current_position (s, current_position)
	end if
	end do
	end function create_helicity_string

	subroutine increment_current_position (s, current_position)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(inout) :: current_position
	current_position = find_next_word_index (s, current_position)
	end subroutine increment_current_position

	subroutine get_next_buffer (s, current_position, buf, last_buffer_index)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(inout) :: current_position
	character(len = 10), intent(out) :: buf
	integer, intent(out) :: last_buffer_index
	integer :: i
	i = 1; buf = ""
	do
	if (s(current_position:current_position) /= " ") then
	buf(i:i) = s(current_position:current_position)
	i = i + 1; current_position = current_position + 1
	else
	exit
	end if
	end do
	last_buffer_index = i
	end subroutine get_next_buffer

	function is_particle_buffer (buf, i) result (valid)
	logical :: valid
	character(len = 10), intent(in) :: buf
	integer, intent(in) :: i
	valid = (buf(1 : i - 1) /= "->" .and. buf(1 : i - 1) /= "\|" &
	.and. buf(1 : i - 1) /= "Process")
	end function is_particle_buffer

	subroutine create_flavor (s, i_particle, current_position)
	character(len=LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(out) :: i_particle
	integer, intent(inout) :: current_position
	character(len=10) :: buf
	integer :: i, last_buffer_index
	call get_next_buffer (s, current_position, buf, last_buffer_index)
	i = last_buffer_index
	if (is_particle_buffer (buf, i)) then
	call strip_helicity (buf, i)
	i_particle = read_ival (var_str (buf(1 : i - 1)))
	else if (buf(1 : i - 1) == "Process") then
	i_particle = PROC_NOT_FOUND
	else
	i_particle = NO_NUMBER
	end if
	end subroutine create_flavor

	subroutine create_helicity (s, helicity, current_position)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(out) :: helicity
	integer, intent(inout) :: current_position
	character(len = 10) :: buf
	integer :: i, last_buffer_index
	logical :: success
	call get_next_buffer (s, current_position, buf, last_buffer_index)
	i = last_buffer_index
	if (is_particle_buffer (buf, i)) then
	call strip_flavor (buf, i, helicity, success)
	else
	helicity = 0
	end if
	end subroutine create_helicity

	subroutine strip_helicity (buf, i)
	character(len = 10), intent(in) :: buf
	integer, intent(inout) :: i
	integer :: i_last
	i_last = i - 1
	if (i_last < 4) return
	if (buf(i_last - 2 : i_last) == "(1)") then
	i = i - 3
	else if (buf(i_last - 3 : i_last) == "(-1)") then
	i = i - 4
	end if
	end subroutine strip_helicity

	subroutine strip_flavor (buf, i, helicity, success)
	character(len = 10), intent(in) :: buf
	integer, intent(in) :: i
	integer, intent(out) :: helicity
	logical, intent(out) :: success
	integer :: i_last
	i_last = i - 1
	helicity = 0
	if (i_last < 4) return
	if (buf(i_last - 2 : i_last) == "(1)") then
	helicity = 1
	success = .true.
	else if (buf(i_last - 3 : i_last) == "(-1)") then
	helicity = -1
	success = .true.
	else
	success = .false.
	end if
	end subroutine strip_flavor

	function find_next_word_index (word, i_start) result (i_next)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: word
	integer, intent(in) :: i_start
	integer :: i_next
	i_next = i_start + 1
	do
	if (word(i_next : i_next) /= " ") then
	exit
	else
	i_next = i_next + 1
	end if
	if (i_next > LEN_MAX_FLAVOR_STRING) &
	call msg_fatal ("Find next word: line limit exceeded")
	end do
	end function find_next_word_index

	subroutine check_helicity_array (hel_array, n_entries, n_in)
	integer, intent(in), dimension(:) :: hel_array
	integer, intent(in) :: n_entries, n_in
	integer :: n_particles, i
	logical :: valid
	n_particles = n_entries - 2
	!!! only allow polarisations for incoming fermions for now
	valid = all (hel_array (n_in + 1 : n_particles) == 0)
	do i = 1, n_in
	valid = valid .and. (hel_array(i) == 1 .or. hel_array(i) == -1)
	end do
	if (.not. valid) &
	call msg_fatal ("Invalid helicities encountered!")
	end subroutine check_helicity_array

	end subroutine blha_driver_read_contract_file

	@ %def blha_driver_read_contract_file
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_alpha_qed => prc_blha_set_alpha_qed
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_set_alpha_qed (object, model)
	+ class(prc_blha_t), intent(inout) :: object
	+ type(model_data_t), intent(in), target :: model
	+ end subroutine prc_blha_set_alpha_qed
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_set_alpha_qed (object, model)
	+ module subroutine prc_blha_set_alpha_qed (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	real(default) :: alpha

	alpha = one / model%get_real (var_str ('alpha_em_i'))

	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_alpha_qed (alpha)
	end select
	end subroutine prc_blha_set_alpha_qed

	@ %def prc_blha_set_alpha_qed
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_GF => prc_blha_set_GF
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_set_GF (object, model)
	+ class(prc_blha_t), intent(inout) :: object
	+ type(model_data_t), intent(in), target :: model
	+ end subroutine prc_blha_set_GF
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_set_GF (object, model)
	+ module subroutine prc_blha_set_GF (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	real(default) :: GF

	GF = model%get_real (var_str ('GF'))
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_GF (GF)
	end select
	end subroutine prc_blha_set_GF

	@ %def prc_blha_set_GF
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_weinberg_angle => prc_blha_set_weinberg_angle
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_set_weinberg_angle (object, model)
	+ class(prc_blha_t), intent(inout) :: object
	+ type(model_data_t), intent(in), target :: model
	+ end subroutine prc_blha_set_weinberg_angle
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_set_weinberg_angle (object, model)
	+ module subroutine prc_blha_set_weinberg_angle (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	real(default) :: sw2

	sw2 = model%get_real (var_str ('sw2'))
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_weinberg_angle (sw2)
	end select
	end subroutine prc_blha_set_weinberg_angle

	@ %def prc_blha_set_weinberg_angle
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_electroweak_parameters => &
	prc_blha_set_electroweak_parameters
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_set_electroweak_parameters (object, model)
	+ class(prc_blha_t), intent(inout) :: object
	+ type(model_data_t), intent(in), target :: model
	+ end subroutine prc_blha_set_electroweak_parameters
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_set_electroweak_parameters (object, model)
	+ module subroutine prc_blha_set_electroweak_parameters (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	if (count (object%ew_parameter_mask) == 0) then
	call msg_fatal ("Cannot decide EW parameter setting: No scheme set!")
	else if (count (object%ew_parameter_mask) > 1) then
	call msg_fatal ("Cannot decide EW parameter setting: More than one scheme set!")
	end if
	if (object%ew_parameter_mask (I_ALPHA_INTERNAL)) call object%set_alpha_qed (model)
	if (object%ew_parameter_mask (I_GF)) call object%set_GF (model)
	if (object%ew_parameter_mask (I_SW2)) call object%set_weinberg_angle (model)
	end subroutine prc_blha_set_electroweak_parameters

	@ %def prc_blha_set_electrweak_parameters
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: read_contract_file => prc_blha_read_contract_file
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_read_contract_file (object, flavors)
	+ class(prc_blha_t), intent(inout) :: object
	+ integer, intent(in), dimension(:,:) :: flavors
	+ end subroutine prc_blha_read_contract_file
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_read_contract_file (object, flavors)
	+ module subroutine prc_blha_read_contract_file (object, flavors)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in), dimension(:,:) :: flavors
	integer, dimension(:), allocatable :: amp_type, flv_index, hel_index, label
	integer, dimension(:,:), allocatable :: helicities
	integer :: i_proc, i_hel
	allocate (helicities (N_MAX_FLAVORS, object%data%n_in))
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%read_contract_file (flavors, amp_type, flv_index, &
	hel_index, label, helicities)
	end select
	object%n_proc = count (amp_type >= 0)
	do i_proc = 1, object%n_proc
	if (amp_type (i_proc) < 0) exit
	if (hel_index(i_proc) < 0 .and. object%includes_polarization ()) &
	call msg_bug ("Object includes polarization, but helicity index is undefined.")
	i_hel = hel_index (i_proc)
	select case (amp_type (i_proc))
	case (BLHA_AMP_TREE)
	if (allocated (object%i_tree)) then
	object%i_tree(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Tree matrix element present, &
	&but neither Born nor real indices are allocated!")
	end if
	case (BLHA_AMP_COLOR_C)
	if (allocated (object%i_color_c)) then
	object%i_color_c(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Color-correlated matrix element present, &
	&but cc-indices are not allocated!")
	end if
	case (BLHA_AMP_SPIN_C)
	if (allocated (object%i_spin_c)) then
	object%i_spin_c(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Spin-correlated matrix element present, &
	&but sc-indices are not allocated!")
	end if
	case (BLHA_AMP_LOOP)
	if (allocated (object%i_virt)) then
	object%i_virt(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Loop matrix element present, &
	&but virt-indices are not allocated!")
	end if
	case default
	call msg_fatal ("Undefined amplitude type")
	end select
	if (allocated (object%i_hel)) &
	object%i_hel (i_proc, :) = helicities (label(i_proc), :)
	end do
	end subroutine prc_blha_read_contract_file

	@ %def prc_blha_read_contract_file
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: print_parameter_file => prc_blha_print_parameter_file
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_print_parameter_file (object, i_component)
	+ class(prc_blha_t), intent(in) :: object
	+ integer, intent(in) :: i_component
	+ end subroutine prc_blha_print_parameter_file
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_print_parameter_file (object, i_component)
	+ module subroutine prc_blha_print_parameter_file (object, i_component)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_component
	type(string_t) :: filename

	select type (def => object%def)
	class is (blha_def_t)
	filename = def%basename // '_' // str (i_component) // '.olp_parameters'
	end select
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%blha_olp_print_parameter (char(filename)//c_null_char)
	end select
	end subroutine prc_blha_print_parameter_file

	@ %def prc_blha_print_parameter_file
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_amplitude => prc_blha_compute_amplitude
	-<<BLHA OLP interfaces: procedures>>=
	- function prc_blha_compute_amplitude &
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function prc_blha_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	+ class(prc_blha_t), intent(in) :: object
	+ integer, intent(in) :: j
	+ type(vector4_t), dimension(:), intent(in) :: p
	+ integer, intent(in) :: f, h, c
	+ real(default), intent(in) :: fac_scale, ren_scale
	+ real(default), intent(in), allocatable :: alpha_qcd_forced
	+ class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	+ complex(default) :: amp
	+ end function prc_blha_compute_amplitude
	+<<BLHA OLP interfaces: procedures>>=
	+ module function prc_blha_compute_amplitude &
	+ (object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	+ core_state) result (amp)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	complex(default) :: amp
	select type (core_state)
	class is (blha_state_t)
	core_state%alpha_qcd = object%qcd%alpha%get (ren_scale)
	end select
	amp = zero
	end function prc_blha_compute_amplitude

	-@
	@ %def prc_blha_compute_amplitude
	+@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	- procedure :: init_blha => prc_blha_init_blha
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_init_blha (object, blha_template, n_in, &
	+ procedure :: init_blha => prc_blha_init_blha
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_init_blha (object, blha_template, n_in, &
	n_particles, n_flv, n_hel)
	+ class(prc_blha_t), intent(inout) :: object
	+ type(blha_template_t), intent(in) :: blha_template
	+ integer, intent(in) :: n_in, n_particles, n_flv, n_hel
	+ end subroutine prc_blha_init_blha
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine prc_blha_init_blha (object, blha_template, n_in, &
	+ n_particles, n_flv, n_hel)
	class(prc_blha_t), intent(inout) :: object
	type(blha_template_t), intent(in) :: blha_template
	integer, intent(in) :: n_in, n_particles, n_flv, n_hel
	object%n_particles = n_particles
	object%n_flv = n_flv
	object%n_hel = n_hel
	if (blha_template%compute_loop ()) then
	if (blha_template%include_polarizations) then
	allocate (object%i_virt (n_flv, n_hel), &
	object%i_color_c (n_flv, n_hel))
	if (blha_template%use_internal_color_correlations) then
	allocate (object%i_hel (n_flv * n_in * n_hel * 2, n_in))
	else
	allocate (object%i_hel (n_flv * n_in * n_hel, n_in))
	end if
	else
	allocate (object%i_virt (n_flv, 1), object%i_color_c (n_flv, 1))
	end if
	object%i_virt = -1
	object%i_color_c = -1
	else if (blha_template%compute_subtraction ()) then
	if (blha_template%include_polarizations) then
	allocate (object%i_tree (n_flv, n_hel), &
	object%i_color_c (n_flv, n_hel), &
	object%i_spin_c (n_flv, n_hel), &
	object%i_hel (3 * (n_flv * n_hel * n_in), n_in))
	object%i_hel = 0
	else
	allocate (object%i_tree (n_flv, 1), object%i_color_c (n_flv, 1) , &
	object%i_spin_c (n_flv, 1))
	end if
	object%i_tree = -1
	object%i_color_c = -1
	object%i_spin_c = -1
	else if (blha_template%compute_dglap ()) then
	if (blha_template%include_polarizations) then
	allocate (object%i_tree (n_flv, n_hel), &
	object%i_color_c (n_flv, n_hel), &
	object%i_hel (3 * (n_flv * n_hel * n_in), n_in))
	object%i_hel = 0
	else
	allocate (object%i_tree (n_flv, 1), object%i_color_c (n_flv, 1))
	end if
	object%i_tree = -1
	object%i_color_c = -1
	else if (blha_template%compute_real_trees () .or. blha_template%compute_born ()) then
	if (blha_template%include_polarizations) then
	allocate (object%i_tree (n_flv, n_hel))
	allocate (object%i_hel (n_flv * n_hel * n_in, n_in))
	object%i_hel = 0
	else
	allocate (object%i_tree (n_flv, 1))
	end if
	object%i_tree = -1
	end if

	call object%init_ew_parameters (blha_template%ew_scheme)

	select type (driver => object%driver)
	class is (blha_driver_t)
	driver%include_polarizations = blha_template%include_polarizations
	driver%switch_off_muon_yukawas = blha_template%switch_off_muon_yukawas
	driver%external_top_yukawa = blha_template%external_top_yukawa
	end select
	end subroutine prc_blha_init_blha

	@ %def prc_blha_init_blha
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_mass_and_width => prc_blha_set_mass_and_width
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_set_mass_and_width (object, i_pdg, mass, width)
	+ class(prc_blha_t), intent(inout) :: object
	+ integer, intent(in) :: i_pdg
	+ real(default), intent(in) :: mass, width
	+ end subroutine prc_blha_set_mass_and_width
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_set_mass_and_width (object, i_pdg, mass, width)
	+ module subroutine prc_blha_set_mass_and_width (object, i_pdg, mass, width)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: i_pdg
	real(default), intent(in) :: mass, width
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_mass_and_width (i_pdg, mass, width)
	end select
	end subroutine prc_blha_set_mass_and_width

	@ %def prc_blha_set_mass_and_width
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_particle_properties => prc_blha_set_particle_properties
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_set_particle_properties (object, model)
	+ class(prc_blha_t), intent(inout) :: object
	+ class(model_data_t), intent(in), target :: model
	+ end subroutine prc_blha_set_particle_properties
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_set_particle_properties (object, model)
	+ module subroutine prc_blha_set_particle_properties (object, model)
	class(prc_blha_t), intent(inout) :: object
	class(model_data_t), intent(in), target :: model
	integer :: i, i_pdg
	type(flavor_t) :: flv
	real(default) :: mass, width
	integer :: ierr
	real(default) :: top_yukawa
	do i = 1, OLP_N_MASSIVE_PARTICLES
	i_pdg = OLP_MASSIVE_PARTICLES(i)
	if (i_pdg < 0) cycle
	call flv%init (i_pdg, model)
	mass = flv%get_mass (); width = flv%get_width ()
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_mass_and_width (i_pdg, mass = mass, width = width)
	if (i_pdg == 5) call driver%blha_olp_set_parameter &
	('yuk(5)'//c_null_char, dble(mass), 0._double, ierr)
	if (i_pdg == 6) then
	if (driver%external_top_yukawa > 0._default) then
	top_yukawa = driver%external_top_yukawa
	else
	top_yukawa = mass
	end if
	call driver%blha_olp_set_parameter &
	('yuk(6)'//c_null_char, dble(top_yukawa), 0._double, ierr)
	end if
	if (driver%switch_off_muon_yukawas) then
	if (i_pdg == 13) call driver%blha_olp_set_parameter &
	('yuk(13)' //c_null_char, 0._double, 0._double, ierr)
	end if
	end select
	end do
	end subroutine prc_blha_set_particle_properties

	@ %def prc_blha_set_particle_properties
	@ This mask adapts which electroweak parameters are supposed to set according to
	the chosen BLHA EWScheme. This is only implemented for the default OLP method so far.
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: init_ew_parameters => prc_blha_init_ew_parameters
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_init_ew_parameters (object, ew_scheme)
	+ class(prc_blha_t), intent(inout) :: object
	+ integer, intent(in) :: ew_scheme
	+ end subroutine prc_blha_init_ew_parameters
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_init_ew_parameters (object, ew_scheme)
	+ module subroutine prc_blha_init_ew_parameters (object, ew_scheme)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: ew_scheme
	object%ew_parameter_mask = .false.
	select case (ew_scheme)
	case (BLHA_EW_0)
	object%ew_parameter_mask (I_ALPHA_0) = .true.
	case (BLHA_EW_GF)
	object%ew_parameter_mask (I_GF) = .true.
	case (BLHA_EW_MZ)
	object%ew_parameter_mask (I_ALPHA_MZ) = .true.
	case (BLHA_EW_INTERNAL)
	object%ew_parameter_mask (I_ALPHA_INTERNAL) = .true.
	end select
	end subroutine prc_blha_init_ew_parameters

	@ %def prc_blha_init_ew_parameters
	@ Computes a virtual matrix element from an interface to an
	external one-loop provider. The output of [[blha_olp_eval2]]
	is an array of [[dimension(4)]], corresponding to the
	$\epsilon^2$-, $\epsilon^1$- and $\epsilon^0$-poles of the
	virtual matrix element at position [[r(1:3)]] and the Born
	matrix element at position [[r(4)]]. The matrix element is
	rejected if its accuracy is larger than the maximal allowed
	accuracy. OpenLoops includes a factor of 1 / [[n_hel]] in the
	amplitudes, which we have to undo if polarized matrix elements
	are requested (GoSam does not support polarized matrix elements).
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_sqme_virt => prc_blha_compute_sqme_virt
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_compute_sqme_virt (object, &
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_compute_sqme_virt (object, &
	i_flv, i_hel, p, ren_scale, es_scale, loop_method, sqme, bad_point)
	+ class(prc_blha_t), intent(in) :: object
	+ integer, intent(in) :: i_flv, i_hel
	+ type(vector4_t), dimension(:), intent(in) :: p
	+ real(default), intent(in) :: ren_scale, es_scale
	+ integer, intent(in) :: loop_method
	+ real(default), dimension(4), intent(out) :: sqme
	+ logical, intent(out) :: bad_point
	+ end subroutine prc_blha_compute_sqme_virt
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine prc_blha_compute_sqme_virt (object, &
	+ i_flv, i_hel, p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	real(default), dimension(4), intent(out) :: sqme
	logical, intent(out) :: bad_point
	real(double), dimension(5 * object%n_particles) :: mom
	real(double), dimension(:), allocatable :: r
	real(double) :: mu_dble, es_dble
	real(double) :: acc_dble
	real(default) :: acc
	real(default) :: alpha_s
	integer :: ierr
	if (object%i_virt(i_flv, i_hel) >= 0) then
	allocate (r (blha_result_array_size (object%n_particles, BLHA_AMP_LOOP)))
	if (debug_on) call msg_debug2 (D_VIRTUAL, "prc_blha_compute_sqme_virt")
	if (debug_on) call msg_debug2 (D_VIRTUAL, "i_flv", i_flv)
	if (debug_on) call msg_debug2 (D_VIRTUAL, "object%i_virt(i_flv, i_hel)", object%i_virt(i_flv, i_hel))
	if (debug2_active (D_VIRTUAL)) then
	call msg_debug2 (D_VIRTUAL, "use momenta: ")
	call vector4_write_set (p, show_mass = .true., &
	check_conservation = .true.)
	end if
	mom = object%create_momentum_array (p)
	if (vanishes (ren_scale)) &
	call msg_fatal ("prc_blha_compute_sqme_virt: ren_scale vanishes")
	mu_dble = dble (ren_scale)
	es_dble = dble (es_scale)
	alpha_s = object%qcd%alpha%get (ren_scale)
	select type (driver => object%driver)
	class is (blha_driver_t)
	if (loop_method == BLHA_MODE_OPENLOOPS) then
	call driver%blha_olp_set_parameter ('mureg'//c_null_char, es_dble, 0._double, ierr)
	if (ierr == 0) call parameter_error_message (var_str ('mureg'), &
	var_str ('prc_blha_compute_sqme_virt'))
	end if
	call driver%set_alpha_s (alpha_s)
	call driver%blha_olp_eval2 (object%i_virt(i_flv, i_hel), mom, mu_dble, r, acc_dble)
	end select
	acc = acc_dble
	sqme = r(1:4)
	bad_point = acc > object%maximum_accuracy
	if (object%includes_polarization ()) sqme = object%n_hel * sqme
	else
	sqme = zero
	end if
	end subroutine prc_blha_compute_sqme_virt

	@ %def prc_blha_compute_sqme_virt
	@ Computes a tree-level matrix element from an interface to an
	external one-loop provider. The matrix element is
	rejected if its accuracy is larger than the maximal allowed
	accuracy. OpenLoops includes a factor of 1 / [[n_hel]] in the
	amplitudes, which we have to undo if polarized matrix elements
	are requested (GoSam does not support polarized matrix elements).
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_sqme => prc_blha_compute_sqme
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_compute_sqme (object, i_flv, i_hel, p, &
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	+ class(prc_blha_t), intent(in) :: object
	+ integer, intent(in) :: i_flv, i_hel
	+ type(vector4_t), intent(in), dimension(:) :: p
	+ real(default), intent(in) :: ren_scale
	+ real(default), intent(out) :: sqme
	+ logical, intent(out) :: bad_point
	+ end subroutine prc_blha_compute_sqme
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine prc_blha_compute_sqme (object, i_flv, i_hel, p, &
	+ ren_scale, sqme, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	real(double), dimension(5*object%n_particles) :: mom
	real(double), dimension(OLP_RESULTS_LIMIT) :: r
	real(double) :: mu_dble, acc_dble
	real(default) :: acc, alpha_s
	if (object%i_tree(i_flv, i_hel) >= 0) then
	if (debug_on) call msg_debug2 (D_REAL, "prc_blha_compute_sqme")
	if (debug_on) call msg_debug2 (D_REAL, "i_flv", i_flv)
	if (debug2_active (D_REAL)) then
	call msg_debug2 (D_REAL, "use momenta: ")
	call vector4_write_set (p, show_mass = .true., &
	check_conservation = .true.)
	end if
	mom = object%create_momentum_array (p)
	if (vanishes (ren_scale)) &
	call msg_fatal ("prc_blha_compute_sqme: ren_scale vanishes")
	mu_dble = dble(ren_scale)
	alpha_s = object%qcd%alpha%get (ren_scale)
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_alpha_s (alpha_s)
	call driver%blha_olp_eval2 (object%i_tree(i_flv, i_hel), mom, &
	mu_dble, r, acc_dble)
	sqme = r(object%sqme_tree_pos)
	end select
	acc = acc_dble
	bad_point = acc > object%maximum_accuracy
	if (object%includes_polarization ()) sqme = object%n_hel * sqme
	else
	sqme = zero
	end if
	end subroutine prc_blha_compute_sqme

	@ %def prc_blha_compute_sqme
	@
	For the color correlated matrix the standard is to compute the diagonal entries
	from the born amplitudes and corresponding casimirs. However, if EW
	corrections are activated, the thus derived entries can be computed with born
	amplitudes of wrong coupling powers if the flavor structure potentially induces
	QCD-EW interference amplitudes. For this purpose a second possibility, to
	compute the diagonal from the off-diagonal elements is implemented as a special
	case.
	<<BLHA OLP interfaces: public>>=
	public :: blha_color_c_fill_diag
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_color_c_fill_diag (sqme_born, flavors, sqme_color_c, special_case)
	- real(default), intent(in) :: sqme_born
	- integer, intent(in), dimension(:) :: flavors
	- logical, intent(in), optional :: special_case
	- real(default), intent(inout), dimension(:,:) :: sqme_color_c
	- real(default) :: sqme_line_off
	- integer :: i, j
	- logical :: special_c
	- special_c = .false.
	- if (present (special_case)) &
	- special_c = special_case .and. qcd_ew_interferences (flavors)
	- do i = 1, size (flavors)
	- if (is_quark (flavors(i))) then
	- sqme_line_off = zero
	- do j = 1, size (flavors)
	- if (j /= i) sqme_line_off = sqme_line_off + sqme_color_c (i, j)
	- end do
	- if (special_c) then
	- sqme_color_c (i, i) = - sqme_line_off
	- else
	- sqme_color_c (i, i) = -cf * sqme_born
	- end if
	- else if (is_gluon (flavors(i))) then
	- sqme_line_off = zero
	- do j = 1, size (flavors)
	- if (j /= i) sqme_line_off = sqme_line_off + sqme_color_c (i, j)
	- end do
	- if (special_c) then
	- sqme_color_c (i, i) = - sqme_line_off
	- else
	- sqme_color_c (i, i) = -ca * sqme_born
	- end if
	- else
	- sqme_color_c (i, i) = zero
	- end if
	- end do
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_color_c_fill_diag &
	+ (sqme_born, flavors, sqme_color_c, special_case)
	+ real(default), intent(in) :: sqme_born
	+ integer, intent(in), dimension(:) :: flavors
	+ logical, intent(in), optional :: special_case
	+ real(default), intent(inout), dimension(:,:) :: sqme_color_c
	+ end subroutine blha_color_c_fill_diag
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine blha_color_c_fill_diag &
	+ (sqme_born, flavors, sqme_color_c, special_case)
	+ real(default), intent(in) :: sqme_born
	+ integer, intent(in), dimension(:) :: flavors
	+ logical, intent(in), optional :: special_case
	+ real(default), intent(inout), dimension(:,:) :: sqme_color_c
	+ real(default) :: sqme_line_off
	+ integer :: i, j
	+ logical :: special_c
	+ special_c = .false.
	+ if (present (special_case)) &
	+ special_c = special_case .and. qcd_ew_interferences (flavors)
	+ do i = 1, size (flavors)
	+ if (is_quark (flavors(i))) then
	+ sqme_line_off = zero
	+ do j = 1, size (flavors)
	+ if (j /= i) sqme_line_off = sqme_line_off + sqme_color_c (i, j)
	+ end do
	+ if (special_c) then
	+ sqme_color_c (i, i) = - sqme_line_off
	+ else
	+ sqme_color_c (i, i) = -cf * sqme_born
	+ end if
	+ else if (is_gluon (flavors(i))) then
	+ sqme_line_off = zero
	+ do j = 1, size (flavors)
	+ if (j /= i) sqme_line_off = sqme_line_off + sqme_color_c (i, j)
	+ end do
	+ if (special_c) then
	+ sqme_color_c (i, i) = - sqme_line_off
	+ else
	+ sqme_color_c (i, i) = -ca * sqme_born
	+ end if
	+ else
	+ sqme_color_c (i, i) = zero
	+ end if
	+ end do
	end subroutine blha_color_c_fill_diag

	@ %def blha_color_c_fill_diag
	<<BLHA OLP interfaces: public>>=
	public :: blha_color_c_fill_offdiag
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine blha_color_c_fill_offdiag &
	+ (n, r, sqme_color_c, offset, n_flv)
	+ integer, intent(in) :: n
	+ real(default), intent(in), dimension(:) :: r
	+ real(default), intent(inout), dimension(:,:) :: sqme_color_c
	+ integer, intent(in), optional :: offset, n_flv
	+ end subroutine blha_color_c_fill_offdiag
	<<BLHA OLP interfaces: procedures>>=
	- subroutine blha_color_c_fill_offdiag (n, r, sqme_color_c, offset, n_flv)
	+ module subroutine blha_color_c_fill_offdiag &
	+ (n, r, sqme_color_c, offset, n_flv)
	integer, intent(in) :: n
	real(default), intent(in), dimension(:) :: r
	real(default), intent(inout), dimension(:,:) :: sqme_color_c
	integer, intent(in), optional :: offset, n_flv
	integer :: i, j, pos, incr
	if (present (offset)) then
	incr = offset
	else
	incr = 0
	end if
	pos = 0
	do j = 1, n
	do i = 1, j
	if (i /= j) then
	pos = (j - 1) * (j - 2) / 2 + i
	if (present (n_flv)) incr = incr + n_flv - 1
	if (present (offset)) pos = pos + incr
	sqme_color_c (i, j) = -r (pos)
	sqme_color_c (j, i) = sqme_color_c (i, j)
	end if
	end do
	end do
	end subroutine blha_color_c_fill_offdiag

	@ %def blha_color_c_fill_offdiag
	@ Computes a color-correlated matrix element from an interface to an
	external one-loop provider. The output of [[blha_olp_eval2]] is
	an array of [[dimension(n * (n - 1) / 2)]]. The matrix element is
	rejected if its accuracy is larger than the maximal allowed
	accuracy. OpenLoops includes a factor of 1 / [[n_hel]] in the
	amplitudes, which we have to undo if polarized matrix elements
	are requested (GoSam does not support polarized matrix elements).
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_sqme_color_c_raw => prc_blha_compute_sqme_color_c_raw
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_compute_sqme_color_c_raw &
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_compute_sqme_color_c_raw &
	(object, i_flv, i_hel, p, ren_scale, rr, bad_point)
	+ class(prc_blha_t), intent(in) :: object
	+ integer, intent(in) :: i_flv, i_hel
	+ type(vector4_t), intent(in), dimension(:) :: p
	+ real(default), intent(in) :: ren_scale
	+ real(default), intent(out), dimension(:) :: rr
	+ logical, intent(out) :: bad_point
	+ end subroutine prc_blha_compute_sqme_color_c_raw
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine prc_blha_compute_sqme_color_c_raw &
	+ (object, i_flv, i_hel, p, ren_scale, rr, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out), dimension(:) :: rr
	logical, intent(out) :: bad_point
	real(double), dimension(5 * object%n_particles) :: mom
	real(double), dimension(size(rr)) :: r
	real(default) :: alpha_s, acc
	real(double) :: mu_dble, acc_dble
	if (debug2_active (D_REAL)) then
	call msg_debug2 (D_REAL, "use momenta: ")
	call vector4_write_set (p, show_mass = .true., &
	check_conservation = .true.)
	end if
	if (object%i_color_c(i_flv, i_hel) >= 0) then
	mom = object%create_momentum_array (p)
	if (vanishes (ren_scale)) &
	call msg_fatal ("prc_blha_compute_sqme_color_c: ren_scale vanishes")
	mu_dble = dble(ren_scale)
	alpha_s = object%qcd%alpha%get (ren_scale)

	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_alpha_s (alpha_s)
	call driver%blha_olp_eval2 (object%i_color_c(i_flv, i_hel), &
	mom, mu_dble, r, acc_dble)
	end select
	rr = r
	acc = acc_dble
	bad_point = acc > object%maximum_accuracy
	if (object%includes_polarization ()) rr = object%n_hel * rr
	else
	rr = zero
	end if
	end subroutine prc_blha_compute_sqme_color_c_raw

	@ %def prc_blha_compute_sqme_color_c_raw
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_sqme_color_c => prc_blha_compute_sqme_color_c
	-<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_compute_sqme_color_c &
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_compute_sqme_color_c &
	(object, i_flv, i_hel, p, ren_scale, born_color_c, bad_point, born_out)
	+ class(prc_blha_t), intent(inout) :: object
	+ integer, intent(in) :: i_flv, i_hel
	+ type(vector4_t), intent(in), dimension(:) :: p
	+ real(default), intent(in) :: ren_scale
	+ real(default), intent(inout), dimension(:,:) :: born_color_c
	+ real(default), intent(out), optional :: born_out
	+ logical, intent(out) :: bad_point
	+ end subroutine prc_blha_compute_sqme_color_c
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine prc_blha_compute_sqme_color_c &
	+ (object, i_flv, i_hel, p, ren_scale, born_color_c, bad_point, born_out)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(inout), dimension(:,:) :: born_color_c
	real(default), intent(out), optional :: born_out
	logical, intent(out) :: bad_point
	real(default), dimension(:), allocatable :: r
	logical :: bad_point2
	real(default) :: born
	integer, dimension(:), allocatable :: flavors
	if (debug2_active (D_REAL)) then
	call msg_debug2 (D_REAL, "use momenta: ")
	call vector4_write_set (p, show_mass = .true., &
	check_conservation = .true.)
	end if
	allocate (r (blha_result_array_size &
	(size(born_color_c, dim=1), BLHA_AMP_COLOR_C)))
	call object%compute_sqme_color_c_raw (i_flv, i_hel, p, ren_scale, r, bad_point)

	select type (driver => object%driver)
	class is (blha_driver_t)
	if (allocated (object%i_tree)) then
	call object%compute_sqme (i_flv, i_hel, p, ren_scale, born, bad_point2)
	else
	born = zero
	end if
	if (present (born_out)) born_out = born
	end select
	call blha_color_c_fill_offdiag (object%n_particles, r, born_color_c)
	flavors = object%get_flv_state (i_flv)
	call blha_color_c_fill_diag (born, flavors, born_color_c)

	bad_point = bad_point .or. bad_point2
	end subroutine prc_blha_compute_sqme_color_c

	@ %def prc_blha_compute_sqme_color_c
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	generic :: get_beam_helicities => get_beam_helicities_single
	generic :: get_beam_helicities => get_beam_helicities_array
	procedure :: get_beam_helicities_single => prc_blha_get_beam_helicities_single
	procedure :: get_beam_helicities_array => prc_blha_get_beam_helicities_array
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function prc_blha_get_beam_helicities_single &
	+ (object, i, invert_second) result (hel)
	+ integer, dimension(:), allocatable :: hel
	+ class(prc_blha_t), intent(in) :: object
	+ logical, intent(in), optional :: invert_second
	+ integer, intent(in) :: i
	+ end function prc_blha_get_beam_helicities_single
	+ module function prc_blha_get_beam_helicities_array &
	+ (object, invert_second) result (hel)
	+ integer, dimension(:,:), allocatable :: hel
	+ class(prc_blha_t), intent(in) :: object
	+ logical, intent(in), optional :: invert_second
	+ end function prc_blha_get_beam_helicities_array
	<<BLHA OLP interfaces: procedures>>=
	- function prc_blha_get_beam_helicities_single (object, i, invert_second) result (hel)
	+ module function prc_blha_get_beam_helicities_single &
	+ (object, i, invert_second) result (hel)
	integer, dimension(:), allocatable :: hel
	class(prc_blha_t), intent(in) :: object
	logical, intent(in), optional :: invert_second
	integer, intent(in) :: i
	logical :: inv
	inv = .false.; if (present (invert_second)) inv = invert_second
	allocate (hel (object%data%n_in))
	hel = object%i_hel (i, :)
	if (inv .and. object%data%n_in == 2) hel(2) = -hel(2)
	end function prc_blha_get_beam_helicities_single

	@ %def prc_blha_get_beam_helicities_single
	@
	-<<BLHA OLP interfaces: prc blha: TBP>>=
	- procedure :: includes_polarization => prc_blha_includes_polarization
	<<BLHA OLP interfaces: procedures>>=
	- function prc_blha_includes_polarization (object) result (polarized)
	- logical :: polarized
	- class(prc_blha_t), intent(in) :: object
	- select type (driver => object%driver)
	- class is (blha_driver_t)
	- polarized = driver%include_polarizations
	- end select
	- end function prc_blha_includes_polarization
	-
	-@ %def prc_blha_includes_polarization
	-@
	-<<BLHA OLP interfaces: procedures>>=
	- function prc_blha_get_beam_helicities_array (object, invert_second) result (hel)
	+ module function prc_blha_get_beam_helicities_array &
	+ (object, invert_second) result (hel)
	integer, dimension(:,:), allocatable :: hel
	class(prc_blha_t), intent(in) :: object
	logical, intent(in), optional :: invert_second
	integer :: i
	allocate (hel (object%n_proc, object%data%n_in))
	do i = 1, object%n_proc
	hel(i,:) = object%get_beam_helicities (i, invert_second)
	end do
	end function prc_blha_get_beam_helicities_array

	@ %def prc_blha_get_beam_helicities_array
	+@
	+<<BLHA OLP interfaces: prc blha: TBP>>=
	+ procedure :: includes_polarization => prc_blha_includes_polarization
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module function prc_blha_includes_polarization (object) result (polarized)
	+ logical :: polarized
	+ class(prc_blha_t), intent(in) :: object
	+ end function prc_blha_includes_polarization
	+<<BLHA OLP interfaces: procedures>>=
	+ module function prc_blha_includes_polarization (object) result (polarized)
	+ logical :: polarized
	+ class(prc_blha_t), intent(in) :: object
	+ select type (driver => object%driver)
	+ class is (blha_driver_t)
	+ polarized = driver%include_polarizations
	+ end select
	+ end function prc_blha_includes_polarization
	+
	+@ %def prc_blha_includes_polarization
	@ Setup an index mapping for flavor structures and helicities that give the same matrix
	element. The index mapping is according to the order of flavor structures known to the
	[[prc_core]] class. Overrides [[prc_core_set_equivalent_flv_hel_indices]].
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_equivalent_flv_hel_indices => prc_blha_set_equivalent_flv_hel_indices
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_set_equivalent_flv_hel_indices (object)
	+ class(prc_blha_t), intent(inout) :: object
	+ end subroutine prc_blha_set_equivalent_flv_hel_indices
	<<BLHA OLP interfaces: procedures>>=
	- subroutine prc_blha_set_equivalent_flv_hel_indices (object)
	+ module subroutine prc_blha_set_equivalent_flv_hel_indices (object)
	class(prc_blha_t), intent(inout) :: object
	integer :: n_flv, n_hel
	integer :: i_flv1, i_flv2, i_hel1, i_hel2
	integer, dimension(:,:), allocatable :: amp_id, amp_id_color
	if (allocated (object%i_virt)) then
	amp_id = object%i_virt
	else
	amp_id = object%i_tree
	end if
	if (allocated (object%i_color_c)) then
	amp_id_color = object%i_color_c
	end if
	n_flv = size (amp_id, dim=1)
	n_hel = size (amp_id, dim=2)
	if (.not. allocated (object%data%eqv_flv_index)) &
	allocate (object%data%eqv_flv_index(n_flv))
	if (.not. allocated (object%data%eqv_hel_index)) &
	allocate (object%data%eqv_hel_index(n_hel))
	if (size (object%data%eqv_flv_index) /= n_flv) &
	call msg_bug ("BLHA Core: Size mismatch between eqv_flv_index and number of flavors.")
	if (size (object%data%eqv_hel_index) /= n_hel) &
	call msg_bug ("BLHA Core: Size mismatch between eqv_hel_index and number of helicities.")
	do i_flv1 = 1, n_flv
	do i_hel1 = 1, n_hel
	FLV_LOOP: do i_flv2 = 1, i_flv1
	do i_hel2 = 1, i_hel1
	if (amp_id(i_flv2, i_hel2) == amp_id(i_flv1, i_hel1)) then
	if (.not. allocated (amp_id_color)) then
	object%data%eqv_flv_index(i_flv1) = i_flv2
	object%data%eqv_hel_index(i_hel1) = i_hel2
	exit FLV_LOOP
	else if (amp_id_color (i_flv2, i_hel2) == &
	amp_id_color(i_flv1, i_hel1)) then
	object%data%eqv_flv_index(i_flv1) = i_flv2
	object%data%eqv_hel_index(i_hel1) = i_hel2
	exit FLV_LOOP
	end if
	end if
	end do
	end do FLV_LOOP
	end do
	end do
	end subroutine prc_blha_set_equivalent_flv_hel_indices

	@ %def prc_blha_set_equivalent_flv_hel_indices
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure(prc_blha_init_driver), deferred :: &
	init_driver
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine prc_blha_init_driver (object, os_data)
	import
	class(prc_blha_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	end subroutine prc_blha_init_driver
	end interface

	@ %def prc_blha_init_driver interface
	@ In general, the BLHA consits of a virtual matrix element and $n_{\rm{sub}}$
	subtraction terms. The subtractions terms can be pure Born matrix elements
	(to be used in collinear subtraction or in internal color-correlation),
	color-correlated matrix elements or spin-correlated matrix elements.
	The numbers should be ordered in such a way that $\mathcal{V}_{\rm{fin}}$
	is first, followed by the pure Born, the color-correlated and the spin-correlated
	matrix elements. This repeats $n_{\rm{flv}}$ times. Let $\nu_i$ be the position
	of the $ith$ virtual matrix element. The next $\mathcal{V}_{\rm{fin}}$ is
	at position $\nu_i = \nu_{i - 1} + n_{\rm{sub}} + 1$. Obviously, $\nu_1 = 1$.
	This allows us to determine the virtual matrix element positions using the
	recursive function implemented below.
	<<BLHA OLP interfaces: public>>=
	public :: blha_loop_positions
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ recursive module function blha_loop_positions (i_flv, n_sub) result (index)
	+ integer :: index
	+ integer, intent(in) :: i_flv, n_sub
	+ end function blha_loop_positions
	<<BLHA OLP interfaces: procedures>>=
	- recursive function blha_loop_positions (i_flv, n_sub) result (index)
	+ recursive module function blha_loop_positions (i_flv, n_sub) result (index)
	integer :: index
	integer, intent(in) :: i_flv, n_sub
	index = 0
	if (i_flv == 1) then
	index = 1
	else
	index = blha_loop_positions (i_flv - 1, n_sub) + n_sub + 1
	end if
	end function blha_loop_positions

	@ %def blha_loop_positions
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	-The module is split into a configuration interface which manages configuration
	-and handles the request and contract files, a module which interfaces the OLP
	-matrix elements and a driver.
	-
	-<<[[blha_config.f90]]>>=
	-<<File header>>
	-
	-module blha_config
	-
	- use kinds
	-<<Use strings>>
	- use io_units
	- use constants
	- use string_utils
	- use variables, only: var_list_t
	- use physics_defs, only: PHOTON, PHOTON_OFFSHELL
	- use diagnostics
	- use md5
	- use model_data
	- use flavors
	- use quantum_numbers
	- use pdg_arrays
	- use sorting
	- use lexers
	- use parser
	- use syntax_rules
	- use ifiles
	-
	- use beam_structures, only: beam_structure_t
	-
	-<<Use mpi f08>>
	-<<Standard module head>>
	-
	-<<BLHA config: public>>
	-
	-<<BLHA config: parameters>>
	-
	-<<BLHA config: types>>
	-
	-<<BLHA config: variables>>
	-
	-<<BLHA config: interfaces>>
	-
	-contains
	-
	-<<BLHA config: procedures>>
	-
	-end module blha_config
	-
	-@ %def blha_config
	-@
	-\section{Configuration}
	-
	-Parameters to enumerate the different options in the order.
	-<<BLHA config: parameters>>=
	- integer, public, parameter :: &
	- BLHA_CT_QCD = 1, BLHA_CT_EW = 2, BLHA_CT_OTHER = 3
	- integer, public, parameter :: &
	- BLHA_IRREG_CDR = 1, BLHA_IRREG_DRED = 2, BLHA_IRREG_THV = 3, &
	- BLHA_IRREG_MREG = 4, BLHA_IRREG_OTHER = 5
	- integer, public, parameter :: &
	- BLHA_MPS_ONSHELL = 1, BLHA_MPS_OTHER = 2
	- integer, public, parameter :: &
	- BLHA_MODE_GOSAM = 1, BLHA_MODE_FEYNARTS = 2, BLHA_MODE_GENERIC = 3, &
	- BLHA_MODE_OPENLOOPS = 4
	- integer, public, parameter :: &
	- BLHA_VERSION_1 = 1, BLHA_VERSION_2 = 2
	- integer, public, parameter :: &
	- BLHA_AMP_LOOP = 1, BLHA_AMP_COLOR_C = 2, BLHA_AMP_SPIN_C = 3, &
	- BLHA_AMP_TREE = 4, BLHA_AMP_LOOPINDUCED = 5
	- integer, public, parameter :: &
	- BLHA_EW_INTERNAL = 0, &
	- BLHA_EW_GF = 1, BLHA_EW_MZ = 2, BLHA_EW_MSBAR = 3, &
	- BLHA_EW_0 = 4, BLHA_EW_RUN = 5
	- integer, public, parameter :: &
	- BLHA_WIDTH_COMPLEX = 1, BLHA_WIDTH_FIXED = 2, &
	- BLHA_WIDTH_RUNNING = 3, BLHA_WIDTH_POLE = 4, &
	- BLHA_WIDTH_DEFAULT = 5
	-
	-@ %def blha_ct_qcd blha_ct_ew blha_ct_other
	-@ %def blha_irreg_cdr blha_irreg_dred blha_irreg_thv blha_irreg_mreg blha_irreg_other
	-@ %def blha_mps_onshell blha_mps_other
	-@ %def blha_mode_gosam blha_mode_feynarts blha_mode_generic
	-@ %def blha version blha_amp blha_ew blha_width
	-@
	-Those are the default pdg codes for massive particles in BLHA programs
	-<<BLHA config: parameters>>=
	- integer, parameter, public :: OLP_N_MASSIVE_PARTICLES = 12
	- integer, dimension(OLP_N_MASSIVE_PARTICLES), public :: &
	- OLP_MASSIVE_PARTICLES = [5, -5, 6, -6, 13, -13, 15, -15, 23, 24, -24, 25]
	- integer, parameter :: OLP_HEL_UNPOLARIZED = 0
	-
	-@ %def OLP_MASSIVE_PARTICLES
	-@ The user might provide an extra command string for OpenLoops to
	-apply special libraries instead of the default ones, such as
	-signal-only amplitudes for off-shell top production. We check in this
	-subroutine that the provided string is valid and print out the
	-possible options to ease the user's memory.
	-<<BLHA config: parameters>>=
	- integer, parameter :: N_KNOWN_SPECIAL_OL_METHODS = 3
	-<<BLHA config: procedures>>=
	- subroutine check_extra_cmd (extra_cmd)
	- type(string_t), intent(in) :: extra_cmd
	- type(string_t), dimension(N_KNOWN_SPECIAL_OL_METHODS) :: known_methods
	- integer :: i
	- logical :: found
	- known_methods(1) = 'top'
	- known_methods(2) = 'not'
	- known_methods(3) = 'stop'
	- if (extra_cmd == var_str ("")) return
	- found = .false.
	- do i = 1, N_KNOWN_SPECIAL_OL_METHODS
	- found = found .or. &
	- (extra_cmd == var_str ('extra approx ') // known_methods(i))
	- end do
	- if (.not. found) &
	- call msg_fatal ("The given extra OpenLoops method is not kown ", &
	- [var_str ("Available commands are: "), &
	- var_str ("extra approx top (only WbWb signal),"), &
	- var_str ("extra approx stop (only WbWb singletop),"), &
	- var_str ("extra approx not (no top in WbWb).")])
	- end subroutine check_extra_cmd
	-
	-@ %def check_extra_cmd
	-@ This type contains the pdg code of the particle to be written in the process
	-specification string and an optional additional information about the polarization
	-of the particles. Note that the output can only be processed by OpenLoops.
	-<<BLHA config: types>>=
	- type :: blha_particle_string_element_t
	- integer :: pdg = 0
	- integer :: hel = OLP_HEL_UNPOLARIZED
	- logical :: polarized = .false.
	- contains
	- <<BLHA config: blha particle string element: TBP>>
	- end type blha_particle_string_element_t
	-
	-@ %def blha_particle_string_element_t
	-@
	-<<BLHA config: blha particle string element: TBP>>=
	- generic :: init => init_default
	- generic :: init => init_polarized
	- procedure :: init_default => blha_particle_string_element_init_default
	- procedure :: init_polarized => blha_particle_string_element_init_polarized
	-<<BLHA config: procedures>>=
	- subroutine blha_particle_string_element_init_default (blha_p, id)
	- class(blha_particle_string_element_t), intent(out) :: blha_p
	- integer, intent(in) :: id
	- blha_p%pdg = id
	- end subroutine blha_particle_string_element_init_default
	-
	-@ %def blha_particle_string_element_init_default
	-@
	-<<BLHA config: procedures>>=
	- subroutine blha_particle_string_element_init_polarized (blha_p, id, hel)
	- class(blha_particle_string_element_t), intent(out) :: blha_p
	- integer, intent(in) :: id, hel
	- blha_p%polarized = .true.
	- blha_p%pdg = id
	- blha_p%hel = hel
	- end subroutine blha_particle_string_element_init_polarized
	-
	-@ %def blha_particle_string_element_init_polarized
	-@
	-<<BLHA config: blha particle string element: TBP>>=
	- generic :: write_pdg => write_pdg_unit
	- generic :: write_pdg => write_pdg_character
	- procedure :: write_pdg_unit => blha_particle_string_element_write_pdg_unit
	- procedure :: write_pdg_character &
	- => blha_particle_string_element_write_pdg_character
	-<<BLHA config: procedures>>=
	- subroutine blha_particle_string_element_write_pdg_unit (blha_p, unit)
	- class(blha_particle_string_element_t), intent(in) :: blha_p
	- integer, intent(in), optional :: unit
	- integer :: u
	- u = given_output_unit (unit)
	- write (u, '(I3)') blha_p%pdg
	- end subroutine blha_particle_string_element_write_pdg_unit
	-
	-@ %def blha_particle_string_element_write_pdg_unit
	-@
	-<<BLHA config: procedures>>=
	- subroutine blha_particle_string_element_write_pdg_character (blha_p, c)
	- class(blha_particle_string_element_t), intent(in) :: blha_p
	- character(3), intent(inout) :: c
	- write (c, '(I3)') blha_p%pdg
	- end subroutine blha_particle_string_element_write_pdg_character
	-
	-@ %def blha_particle_string_element_write_pdg_character
	-@
	-<<BLHA config: blha particle string element: TBP>>=
	- generic :: write_helicity => write_helicity_unit
	- generic :: write_helicity => write_helicity_character
	- procedure :: write_helicity_unit &
	- => blha_particle_string_element_write_helicity_unit
	- procedure :: write_helicity_character &
	- => blha_particle_string_element_write_helicity_character
	-<<BLHA config: procedures>>=
	- subroutine blha_particle_string_element_write_helicity_unit (blha_p, unit)
	- class(blha_particle_string_element_t), intent(in) :: blha_p
	- integer, intent(in), optional :: unit
	- integer :: u
	- u = given_output_unit (unit)
	- write (u, '(A1,I0,A1)') '(', blha_p%hel, ')'
	- end subroutine blha_particle_string_element_write_helicity_unit
	-
	-@ %def blha_particle_string_element_write_helicity_unit
	-@
	-<<BLHA config: procedures>>=
	- subroutine blha_particle_string_element_write_helicity_character (blha_p, c)
	- class(blha_particle_string_element_t), intent(in) :: blha_p
	- character(4), intent(inout) :: c
	- write (c, '(A1,I0,A1)') '(', blha_p%hel, ')'
	- end subroutine blha_particle_string_element_write_helicity_character
	-
	-@ %def blha_particle_string_element_write_helicity_character
	-@ This type encapsulates a BLHA request.
	-<<BLHA config: public>>=
	- public :: blha_configuration_t
	- public :: blha_cfg_process_node_t
	-<<BLHA config: types>>=
	- type :: blha_cfg_process_node_t
	- type(blha_particle_string_element_t), dimension(:), allocatable :: pdg_in, pdg_out
	- integer, dimension(:), allocatable :: fingerprint
	- integer :: nsub
	- integer, dimension(:), allocatable :: ids
	- integer :: amplitude_type
	- type(blha_cfg_process_node_t), pointer :: next => null ()
	- end type blha_cfg_process_node_t
	-
	- type :: blha_configuration_t
	- type(string_t) :: name
	- class(model_data_t), pointer :: model => null ()
	- type(string_t) :: md5
	- integer :: version = 2
	- logical :: dirty = .false.
	- integer :: n_proc = 0
	- real(default) :: accuracy_target
	- logical :: debug_unstable = .false.
	- integer :: mode = BLHA_MODE_GENERIC
	- logical :: polarized = .false.
	- type(blha_cfg_process_node_t), pointer :: processes => null ()
	- !integer, dimension(2) :: matrix_element_square_type = BLHA_MEST_SUM
	- integer :: correction_type
	- type(string_t) :: correction_type_other
	- integer :: irreg = BLHA_IRREG_THV
	- type(string_t) :: irreg_other
	- integer :: massive_particle_scheme = BLHA_MPS_ONSHELL
	- type(string_t) :: massive_particle_scheme_other
	- type(string_t) :: model_file
	- logical :: subdivide_subprocesses = .false.
	- integer :: alphas_power = -1, alpha_power = -1
	- integer :: ew_scheme = BLHA_EW_GF
	- integer :: width_scheme = BLHA_WIDTH_DEFAULT
	- logical :: openloops_use_cms = .false.
	- integer :: openloops_phs_tolerance = 0
	- type(string_t) :: openloops_extra_cmd
	- integer :: openloops_stability_log = 0
	- integer :: n_off_photons_is = 0
	- integer :: n_off_photons_fs = 0
	- end type blha_configuration_t
	-
	-@ %def blha_cffg_process_node_t blha_configuration_t
	-@ Translate the SINDARIN input string to the corresponding named integer.
	-<<BLHA config: public>>=
	- public :: ew_scheme_string_to_int
	-<<BLHA config: procedures>>=
	- function ew_scheme_string_to_int (ew_scheme_str) result (ew_scheme_int)
	- integer :: ew_scheme_int
	- type(string_t), intent(in) :: ew_scheme_str
	- select case (char (ew_scheme_str))
	- case ('GF', 'Gmu')
	- ew_scheme_int = BLHA_EW_GF
	- case ('alpha_qed', 'alpha_internal')
	- ew_scheme_int = BLHA_EW_INTERNAL
	- case ('alpha_mz')
	- ew_scheme_int = BLHA_EW_MZ
	- case ('alpha_0', 'alpha_thompson')
	- ew_scheme_int = BLHA_EW_0
	- case default
	- call msg_fatal ("ew_scheme: " // char (ew_scheme_str) // &
	- " not supported. Try 'Gmu', 'alpha_internal', 'alpha_mz' or 'alpha_0'.")
	- end select
	- end function ew_scheme_string_to_int
	-
	-@ %def ew_scheme_string_to_int
	-@
	-@ Translate the SINDARIN input string to the corresponding named integer
	-denoting the type of NLO correction.
	-<<BLHA config: public>>=
	- public :: correction_type_string_to_int
	-<<BLHA config: procedures>>=
	- function correction_type_string_to_int (correction_type_str) result (correction_type_int)
	- integer :: correction_type_int
	- type(string_t), intent(in) :: correction_type_str
	- select case (char (correction_type_str))
	- case ('QCD')
	- correction_type_int = BLHA_CT_QCD
	- case ('EW')
	- correction_type_int = BLHA_CT_EW
	- case default
	- call msg_warning ("nlo_correction_type: " // char (correction_type_str) // &
	- " not supported. Try setting it to 'QCD', 'EW'.")
	- end select
	- end function correction_type_string_to_int
	-
	-@ %def correction_type_string_to_int
	-@
	-This types control the creation of BLHA-interface files
	-<<BLHA config: public>>=
	- public :: blha_flv_state_t
	- public :: blha_master_t
	-<<BLHA config: types>>=
	- type:: blha_flv_state_t
	- integer, dimension(:), allocatable :: flavors
	- integer :: flv_mult
	- logical :: flv_real = .false.
	- end type blha_flv_state_t
	-
	- type :: blha_master_t
	- integer, dimension(5) :: blha_mode = BLHA_MODE_GENERIC
	- logical :: compute_borns = .false.
	- logical :: compute_real_trees = .false.
	- logical :: compute_loops = .true.
	- logical :: compute_correlations = .false.
	- logical :: compute_dglap = .false.
	- integer :: ew_scheme
	- type(string_t), dimension(:), allocatable :: suffix
	- type(blha_configuration_t), dimension(:), allocatable :: blha_cfg
	- integer :: n_files = 0
	- integer, dimension(:), allocatable :: i_file_to_nlo_index
	- contains
	- <<BLHA config: blha master: TBP>>
	- end type blha_master_t
	-
	-@ %def blha_flv_state_t, blha_master_t
	-@ Master-Routines
	-<<BLHA config: blha master: TBP>>=
	- procedure :: set_methods => blha_master_set_methods
	-<<BLHA config: procedures>>=
	- subroutine blha_master_set_methods (master, is_nlo, var_list)
	- class(blha_master_t), intent(inout) :: master
	- logical, intent(in) :: is_nlo
	- type(var_list_t), intent(in) :: var_list
	- type(string_t) :: method, born_me_method, real_tree_me_method
	- type(string_t) :: loop_me_method, correlation_me_method
	- type(string_t) :: dglap_me_method
	- type(string_t) :: default_method
	- logical :: cmp_born, cmp_real
	- logical :: cmp_loop, cmp_corr
	- logical :: cmp_dglap
	- if (is_nlo) then
	- 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
	- cmp_born = born_me_method /= 'omega'
	- cmp_real = is_nlo .and. (real_tree_me_method /= 'omega')
	- cmp_loop = is_nlo .and. (loop_me_method /= 'omega')
	- cmp_corr = is_nlo .and. (correlation_me_method /= 'omega')
	- cmp_dglap = is_nlo .and. (dglap_me_method /= 'omega')
	- call set_me_method (1, loop_me_method)
	- call set_me_method (2, correlation_me_method)
	- call set_me_method (3, real_tree_me_method)
	- call set_me_method (4, born_me_method)
	- call set_me_method (5, dglap_me_method)
	- else
	- default_method = var_list%get_sval (var_str ("$method"))
	- cmp_born = default_method /= 'omega'
	- cmp_real = .false.; cmp_loop = .false.; cmp_corr = .false.
	- call set_me_method (4, default_method)
	- end if
	- master%n_files = count ([cmp_born, cmp_real, cmp_loop, cmp_corr, cmp_dglap])
	- call set_nlo_indices ()
	- master%compute_borns = cmp_born
	- master%compute_real_trees = cmp_real
	- master%compute_loops = cmp_loop
	- master%compute_correlations = cmp_corr
	- master%compute_dglap = cmp_dglap
	- contains
	- subroutine set_nlo_indices ()
	- integer :: i_file
	- allocate (master%i_file_to_nlo_index (master%n_files))
	- master%i_file_to_nlo_index = 0
	- i_file = 0
	- if (cmp_loop) then
	- i_file = i_file + 1
	- master%i_file_to_nlo_index(i_file) = 1
	- end if
	- if (cmp_corr) then
	- i_file = i_file + 1
	- master%i_file_to_nlo_index(i_file) = 2
	- end if
	- if (cmp_real) then
	- i_file = i_file + 1
	- master%i_file_to_nlo_index(i_file) = 3
	- end if
	- if (cmp_born) then
	- i_file = i_file + 1
	- master%i_file_to_nlo_index(i_file) = 4
	- end if
	- if (cmp_dglap) then
	- i_file = i_file + 1
	- master%i_file_to_nlo_index(i_file) = 5
	- end if
	- end subroutine set_nlo_indices
	-
	- subroutine set_me_method (i, me_method)
	- integer, intent(in) :: i
	- type(string_t) :: me_method
	- select case (char (me_method))
	- case ('gosam')
	- call master%set_gosam (i)
	- case ('openloops')
	- call master%set_openloops (i)
	- end select
	- end subroutine set_me_method
	- end subroutine blha_master_set_methods
	-
	-@ %def blha_master_set_methods
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: allocate_config_files => blha_master_allocate_config_files
	-<<BLHA config: procedures>>=
	- subroutine blha_master_allocate_config_files (master)
	- class(blha_master_t), intent(inout) :: master
	- allocate (master%blha_cfg (master%n_files))
	- allocate (master%suffix (master%n_files))
	- end subroutine blha_master_allocate_config_files
	-@ %def blha_master_allocate_config_files
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: set_ew_scheme => blha_master_set_ew_scheme
	-<<BLHA config: procedures>>=
	- subroutine blha_master_set_ew_scheme (master, ew_scheme)
	- class(blha_master_t), intent(inout) :: master
	- type(string_t), intent(in) :: ew_scheme
	- master%ew_scheme = ew_scheme_string_to_int (ew_scheme)
	- end subroutine blha_master_set_ew_scheme
	-
	-@ %def blha_master_set_ew_scheme
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: set_correction_type => blha_master_set_correction_type
	-<<BLHA config: procedures>>=
	- subroutine blha_master_set_correction_type (master, correction_type_str)
	- class(blha_master_t), intent(inout) :: master
	- type(string_t), intent(in) :: correction_type_str
	- master%blha_cfg(:)%correction_type = correction_type_string_to_int (correction_type_str)
	- end subroutine blha_master_set_correction_type
	-
	-@ %def blha_master_set_correction_type
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: set_photon_characteristics => blha_master_set_photon_characteristics
	-<<BLHA config: procedures>>=
	- subroutine blha_master_set_photon_characteristics (master, flv_born, n_in)
	- class(blha_master_t), intent(inout) :: master
	- integer, dimension(:,:), intent(in) :: flv_born
	- integer, intent(in) :: n_in
	- integer :: i_file, i, i_flv
	- integer :: noff_is, noff_fs, noff_is_max, noff_fs_max
	- do i_file = 1, master%n_files
	- noff_is_max = 0; noff_fs_max = 0
	- do i_flv = 1, size (flv_born, 2)
	- noff_is = 0; noff_fs = 0
	- do i = 1, n_in
	- if (flv_born (i, i_flv) == PHOTON) noff_is = noff_is + 1
	- end do
	- noff_is_max = max (noff_is, noff_is_max)
	- do i = n_in + 1, size (flv_born(:, i_flv))
	- if (flv_born (i, i_flv) == PHOTON) noff_fs = noff_fs + 1
	- end do
	- noff_fs_max = max (noff_fs, noff_fs_max)
	- end do
	- if (master%blha_cfg(i_file)%correction_type == BLHA_CT_EW &
	- .and. master%ew_scheme == BLHA_EW_0 &
	- .and. (noff_is_max > 0 .or. noff_fs_max > 0)) then
	- call msg_fatal ("For NLO EW/mixed corrections, 'alpha_0'/" &
	- // "'alpha_thompson' are ", [ var_str ("inconsistent EW input " &
	- // "schemes. Please use 'alpha_mz' or 'Gmu'")])
	- end if
	- master%blha_cfg(i_file)%n_off_photons_is = noff_is_max
	- master%blha_cfg(i_file)%n_off_photons_fs = noff_fs_max
	- end do
	- end subroutine blha_master_set_photon_characteristics
	-
	-@ %def blha_master_set_photon_characteristics
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: generate => blha_master_generate
	-<<BLHA config: procedures>>=
	- subroutine blha_master_generate (master, basename, model, &
	- n_in, alpha_power, alphas_power, flv_born, flv_real)
	- class(blha_master_t), intent(inout) :: master
	- type(string_t), intent(in) :: basename
	- class(model_data_t), intent(in), target :: model
	- integer, intent(in) :: n_in
	- integer, intent(in) :: alpha_power, alphas_power
	- integer, intent(in), dimension(:,:), allocatable :: flv_born, flv_real
	- integer :: i_file
	- if (master%n_files < 1) &
	- call msg_fatal ("Attempting to generate OLP-files, but none are specified!")
	- i_file = 1
	- call master%generate_loop (basename, model, n_in, alpha_power, &
	- alphas_power, flv_born, i_file)
	- call master%generate_correlation (basename, model, n_in, alpha_power, &
	- alphas_power, flv_born, i_file)
	- call master%generate_real_tree (basename, model, n_in, alpha_power, &
	- alphas_power, flv_real, i_file)
	- call master%generate_born (basename, model, n_in, alpha_power, &
	- alphas_power, flv_born, i_file)
	- call master%generate_dglap (basename, model, n_in, alpha_power, &
	- alphas_power, flv_born, i_file)
	- end subroutine blha_master_generate
	-
	-@ %def blha_master_generate
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: generate_loop => blha_master_generate_loop
	-<<BLHA config: procedures>>=
	- subroutine blha_master_generate_loop (master, basename, model, n_in, &
	- alpha_power, alphas_power, flv_born, i_file)
	- class(blha_master_t), intent(inout) :: master
	- type(string_t), intent(in) :: basename
	- class(model_data_t), intent(in), target :: model
	- integer, intent(in) :: n_in
	- integer, intent(in) :: alpha_power, alphas_power
	- integer, dimension(:,:), allocatable, intent(in) :: flv_born
	- integer, intent(inout) :: i_file
	- type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	- integer :: i_flv
	- if (master%compute_loops) then
	- if (allocated (flv_born)) then
	- allocate (blha_flavor (size (flv_born, 2)))
	- do i_flv = 1, size (flv_born, 2)
	- allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	- blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	- blha_flavor(i_flv)%flv_mult = 2
	- end do
	- master%suffix(i_file) = blha_get_additional_suffix (var_str ("_LOOP"))
	- call blha_init_virtual (master%blha_cfg(i_file), blha_flavor, &
	- n_in, alpha_power, alphas_power, master%ew_scheme, &
	- basename, model, master%blha_mode(1), master%suffix(i_file))
	- i_file = i_file + 1
	- else
	- call msg_fatal ("BLHA Loops requested but " &
	- // "Born flavor not existing")
	- end if
	- end if
	- end subroutine blha_master_generate_loop
	-
	-@ %def blha_master_generate_loop
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: generate_correlation => blha_master_generate_correlation
	-<<BLHA config: procedures>>=
	- subroutine blha_master_generate_correlation (master, basename, model, n_in, &
	- alpha_power, alphas_power, flv_born, i_file)
	- class(blha_master_t), intent(inout) :: master
	- type(string_t), intent(in) :: basename
	- class(model_data_t), intent(in), target :: model
	- integer, intent(in) :: n_in
	- integer, intent(in) :: alpha_power, alphas_power
	- integer, dimension(:,:), allocatable, intent(in) :: flv_born
	- integer, intent(inout) :: i_file
	- type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	- integer :: i_flv
	- if (master%compute_correlations) then
	- if (allocated (flv_born)) then
	- allocate (blha_flavor (size (flv_born, 2)))
	- do i_flv = 1, size (flv_born, 2)
	- allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	- blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	- blha_flavor(i_flv)%flv_mult = 3
	- end do
	- master%suffix(i_file) = blha_get_additional_suffix (var_str ("_SUB"))
	- call blha_init_subtraction (master%blha_cfg(i_file), blha_flavor, &
	- n_in, alpha_power, alphas_power, master%ew_scheme, &
	- basename, model, master%blha_mode(2), master%suffix(i_file))
	- i_file = i_file + 1
	- else
	- call msg_fatal ("BLHA Correlations requested but "&
	- // "Born flavor not existing")
	- end if
	- end if
	- end subroutine blha_master_generate_correlation
	-
	-@ %def blha_master_generate_correlation
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: generate_real_tree => blha_master_generate_real_tree
	-<<BLHA config: procedures>>=
	- subroutine blha_master_generate_real_tree (master, basename, model, n_in, &
	- alpha_power, alphas_power, flv_real, i_file)
	- class(blha_master_t), intent(inout) :: master
	- type(string_t), intent(in) :: basename
	- class(model_data_t), intent(in), target :: model
	- integer, intent(in) :: n_in
	- integer, intent(in) :: alpha_power, alphas_power
	- integer, dimension(:,:), allocatable, intent(in) :: flv_real
	- integer, intent(inout) :: i_file
	- type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	- integer :: i_flv
	- if (master%compute_real_trees) then
	- if (allocated (flv_real)) then
	- allocate (blha_flavor (size (flv_real, 2)))
	- do i_flv = 1, size (flv_real, 2)
	- allocate (blha_flavor(i_flv)%flavors (size (flv_real(:,i_flv))))
	- blha_flavor(i_flv)%flavors = flv_real(:,i_flv)
	- blha_flavor(i_flv)%flv_mult = 1
	- end do
	- master%suffix(i_file) = blha_get_additional_suffix (var_str ("_REAL"))
	- call blha_init_real (master%blha_cfg(i_file), blha_flavor, &
	- n_in, alpha_power, alphas_power, master%ew_scheme, &
	- basename, model, master%blha_mode(3), master%suffix(i_file))
	- i_file = i_file + 1
	- else
	- call msg_fatal ("BLHA Trees requested but "&
	- // "Real flavor not existing")
	- end if
	- end if
	- end subroutine blha_master_generate_real_tree
	-
	-@ %def blha_master_generate_real_tree
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: generate_born => blha_master_generate_born
	-<<BLHA config: procedures>>=
	-subroutine blha_master_generate_born (master, basename, model, n_in, &
	- alpha_power, alphas_power, flv_born, i_file)
	- class(blha_master_t), intent(inout) :: master
	- type(string_t), intent(in) :: basename
	- class(model_data_t), intent(in), target :: model
	- integer, intent(in) :: n_in
	- integer, intent(in) :: alpha_power, alphas_power
	- integer, dimension(:,:), allocatable, intent(in) :: flv_born
	- integer, intent(inout) :: i_file
	- type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	- integer :: i_flv
	- if (master%compute_borns) then
	- if (allocated (flv_born)) then
	- allocate (blha_flavor (size (flv_born, 2)))
	- do i_flv = 1, size (flv_born, 2)
	- allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	- blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	- blha_flavor(i_flv)%flv_mult = 1
	- end do
	- master%suffix(i_file) = blha_get_additional_suffix (var_str ("_BORN"))
	- call blha_init_born (master%blha_cfg(i_file), blha_flavor, &
	- n_in, alpha_power, alphas_power, master%ew_scheme, &
	- basename, model, master%blha_mode(4), master%suffix(i_file))
	- i_file = i_file + 1
	- end if
	- end if
	- end subroutine blha_master_generate_born
	-
	-@ %def blha_master_generate_born
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: generate_dglap => blha_master_generate_dglap
	-<<BLHA config: procedures>>=
	-subroutine blha_master_generate_dglap (master, basename, model, n_in, &
	- alpha_power, alphas_power, flv_born, i_file)
	- class(blha_master_t), intent(inout) :: master
	- type(string_t), intent(in) :: basename
	- class(model_data_t), intent(in), target :: model
	- integer, intent(in) :: n_in
	- integer, intent(in) :: alpha_power, alphas_power
	- integer, dimension(:,:), allocatable, intent(in) :: flv_born
	- integer, intent(inout) :: i_file
	- type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	- integer :: i_flv
	- if (master%compute_dglap) then
	- if (allocated (flv_born)) then
	- allocate (blha_flavor (size (flv_born, 2)))
	- do i_flv = 1, size (flv_born, 2)
	- allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	- blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	- blha_flavor(i_flv)%flv_mult = 2
	- end do
	- master%suffix(i_file) = blha_get_additional_suffix (var_str ("_DGLAP"))
	- call blha_init_dglap (master%blha_cfg(i_file), blha_flavor, &
	- n_in, alpha_power, alphas_power, master%ew_scheme, &
	- basename, model, master%blha_mode(5), master%suffix(i_file))
	- i_file = i_file + 1
	- end if
	- end if
	- end subroutine blha_master_generate_dglap
	-
	-@ %def blha_master_generate_dglap
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: setup_additional_features => blha_master_setup_additional_features
	-<<BLHA config: procedures>>=
	- subroutine blha_master_setup_additional_features (master, &
	- phs_tolerance, use_cms, stability_log, extra_cmd, beam_structure)
	- class(blha_master_t), intent(inout) :: master
	- integer, intent(in) :: phs_tolerance
	- logical, intent(in) :: use_cms
	- type(string_t), intent(in), optional :: extra_cmd
	- integer, intent(in) :: stability_log
	- type(beam_structure_t), intent(in), optional :: beam_structure
	- integer :: i_file
	- logical :: polarized, throw_warning
	-
	- polarized = .false.
	- if (present (beam_structure)) polarized = beam_structure%has_polarized_beams ()
	-
	- throw_warning = .false.
	- if (use_cms) then
	- throw_warning = throw_warning .or. (master%compute_loops &
	- .and. master%blha_mode(1) /= BLHA_MODE_OPENLOOPS)
	- throw_warning = throw_warning .or. (master%compute_correlations &
	- .and. master%blha_mode(2) /= BLHA_MODE_OPENLOOPS)
	- throw_warning = throw_warning .or. (master%compute_real_trees &
	- .and. master%blha_mode(3) /= BLHA_MODE_OPENLOOPS)
	- throw_warning = throw_warning .or. (master%compute_borns &
	- .and. master%blha_mode(4) /= BLHA_MODE_OPENLOOPS)
	- throw_warning = throw_warning .or. (master%compute_dglap &
	- .and. master%blha_mode(5) /= BLHA_MODE_OPENLOOPS)
	- if (throw_warning) call cms_warning ()
	- end if
	-
	- do i_file = 1, master%n_files
	- if (phs_tolerance > 0) then
	- select case (master%blha_mode (master%i_file_to_nlo_index(i_file)))
	- case (BLHA_MODE_GOSAM)
	- if (polarized) call gosam_error_message ()
	- case (BLHA_MODE_OPENLOOPS)
	- master%blha_cfg(i_file)%openloops_use_cms = use_cms
	- master%blha_cfg(i_file)%openloops_phs_tolerance = phs_tolerance
	- master%blha_cfg(i_file)%polarized = polarized
	- if (present (extra_cmd)) then
	- master%blha_cfg(i_file)%openloops_extra_cmd = extra_cmd
	- else
	- master%blha_cfg(i_file)%openloops_extra_cmd = var_str ('')
	- end if
	- master%blha_cfg(i_file)%openloops_stability_log = stability_log
	- end select
	- end if
	- end do
	- contains
	- subroutine cms_warning ()
	- call msg_warning ("You have set ?openloops_use_cms = true, but not all active matrix ", &
	- [var_str ("element methods are set to OpenLoops. Note that other "), &
	- var_str ("methods might not necessarily support the complex mass "), &
	- var_str ("scheme. This can yield inconsistencies in your NLO results!")])
	- end subroutine cms_warning
	-
	- subroutine gosam_error_message ()
	- call msg_fatal ("You are trying to evaluate a process at NLO ", &
	- [var_str ("which involves polarized beams using GoSam. "), &
	- var_str ("This feature is not supported yet. "), &
	- var_str ("Please use OpenLoops instead")])
	- end subroutine gosam_error_message
	- end subroutine blha_master_setup_additional_features
	-
	-@ %def blha_master_setup_additional_features
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: set_gosam => blha_master_set_gosam
	-<<BLHA config: procedures>>=
	- subroutine blha_master_set_gosam (master, i)
	- class(blha_master_t), intent(inout) :: master
	- integer, intent(in) :: i
	- master%blha_mode(i) = BLHA_MODE_GOSAM
	- end subroutine blha_master_set_gosam
	-
	-@ %def blha_master_set_gosam
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: set_openloops => blha_master_set_openloops
	-<<BLHA config: procedures>>=
	- subroutine blha_master_set_openloops (master, i)
	- class(blha_master_t), intent(inout) :: master
	- integer, intent(in) :: i
	- master%blha_mode(i) = BLHA_MODE_OPENLOOPS
	- end subroutine blha_master_set_openloops
	-
	-@ %def blha_master_set_openloops
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: set_polarization => blha_master_set_polarization
	-<<BLHA config: procedures>>=
	- subroutine blha_master_set_polarization (master, i)
	- class(blha_master_t), intent(inout) :: master
	- integer, intent(in) :: i
	- master%blha_cfg(i)%polarized = .true.
	- end subroutine blha_master_set_polarization
	-
	-@ %def blha_master_set_polarization
	-@
	-<<BLHA config: procedures>>=
	- subroutine blha_init_born (blha_cfg, blha_flavor, n_in, &
	- ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	- type(blha_configuration_t), intent(inout) :: blha_cfg
	- type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	- integer, intent(in) :: n_in
	- integer, intent(in) :: ap, asp
	- integer, intent(in) :: ew_scheme
	- type(string_t), intent(in) :: basename
	- type(model_data_t), intent(in), target :: model
	- integer, intent(in) :: blha_mode
	- type(string_t), intent(in) :: suffix
	- integer, dimension(:), allocatable :: amp_type
	- integer :: i
	-
	- allocate (amp_type (size (blha_flavor)))
	- do i = 1, size (blha_flavor)
	- amp_type(i) = BLHA_AMP_TREE
	- end do
	- call blha_configuration_init (blha_cfg, basename // suffix , &
	- model, blha_mode)
	- call blha_configuration_append_processes (blha_cfg, n_in, &
	- blha_flavor, amp_type)
	- call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	- irreg = BLHA_IRREG_CDR, alphas_power = asp, &
	- alpha_power = ap, ew_scheme = ew_scheme, &
	- debug = blha_mode == BLHA_MODE_GOSAM)
	- end subroutine blha_init_born
	-
	- subroutine blha_init_virtual (blha_cfg, blha_flavor, n_in, &
	- ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	- type(blha_configuration_t), intent(inout) :: blha_cfg
	- type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	- integer, intent(in) :: n_in
	- integer, intent(in) :: ap, asp
	- integer, intent(in) :: ew_scheme
	- type(string_t), intent(in) :: basename
	- type(model_data_t), intent(in), target :: model
	- integer, intent(in) :: blha_mode
	- type(string_t), intent(in) :: suffix
	- integer, dimension(:), allocatable :: amp_type
	- integer :: i
	-
	- allocate (amp_type (size (blha_flavor) * 2))
	- do i = 1, size (blha_flavor)
	- amp_type(2 * i - 1) = BLHA_AMP_LOOP
	- amp_type(2 * i) = BLHA_AMP_COLOR_C
	- end do
	- call blha_configuration_init (blha_cfg, basename // suffix , &
	- model, blha_mode)
	- call blha_configuration_append_processes (blha_cfg, n_in, &
	- blha_flavor, amp_type)
	- call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	- irreg = BLHA_IRREG_CDR, &
	- alphas_power = asp, &
	- alpha_power = ap, &
	- ew_scheme = ew_scheme, &
	- debug = blha_mode == BLHA_MODE_GOSAM)
	- end subroutine blha_init_virtual
	-
	- subroutine blha_init_dglap (blha_cfg, blha_flavor, n_in, &
	- ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	- type(blha_configuration_t), intent(inout) :: blha_cfg
	- type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	- integer, intent(in) :: n_in
	- integer, intent(in) :: ap, asp
	- integer, intent(in) :: ew_scheme
	- type(string_t), intent(in) :: basename
	- type(model_data_t), intent(in), target :: model
	- integer, intent(in) :: blha_mode
	- type(string_t), intent(in) :: suffix
	- integer, dimension(:), allocatable :: amp_type
	- integer :: i
	-
	- allocate (amp_type (size (blha_flavor) * 2))
	- do i = 1, size (blha_flavor)
	- amp_type(2 * i - 1) = BLHA_AMP_TREE
	- amp_type(2 * i) = BLHA_AMP_COLOR_C
	- end do
	- call blha_configuration_init (blha_cfg, basename // suffix , &
	- model, blha_mode)
	- call blha_configuration_append_processes (blha_cfg, n_in, &
	- blha_flavor, amp_type)
	- call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	- irreg = BLHA_IRREG_CDR, &
	- alphas_power = asp, &
	- alpha_power = ap, &
	- ew_scheme = ew_scheme, &
	- debug = blha_mode == BLHA_MODE_GOSAM)
	- end subroutine blha_init_dglap
	-
	- subroutine blha_init_subtraction (blha_cfg, blha_flavor, n_in, &
	- ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	- type(blha_configuration_t), intent(inout) :: blha_cfg
	- type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	- integer, intent(in) :: n_in
	- integer, intent(in) :: ap, asp
	- integer, intent(in) :: ew_scheme
	- type(string_t), intent(in) :: basename
	- type(model_data_t), intent(in), target :: model
	- integer, intent(in) :: blha_mode
	- type(string_t), intent(in) :: suffix
	- integer, dimension(:), allocatable :: amp_type
	- integer :: i
	-
	- allocate (amp_type (size (blha_flavor) * 3))
	- do i = 1, size (blha_flavor)
	- amp_type(3 * i - 2) = BLHA_AMP_TREE
	- amp_type(3 * i - 1) = BLHA_AMP_COLOR_C
	- amp_type(3 * i) = BLHA_AMP_SPIN_C
	- end do
	- call blha_configuration_init (blha_cfg, basename // suffix , &
	- model, blha_mode)
	- call blha_configuration_append_processes (blha_cfg, n_in, &
	- blha_flavor, amp_type)
	- call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	- irreg = BLHA_IRREG_CDR, &
	- alphas_power = asp, &
	- alpha_power = ap, &
	- ew_scheme = ew_scheme, &
	- debug = blha_mode == BLHA_MODE_GOSAM)
	- end subroutine blha_init_subtraction
	-
	- subroutine blha_init_real (blha_cfg, blha_flavor, n_in, &
	- ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	- type(blha_configuration_t), intent(inout) :: blha_cfg
	- type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	- integer, intent(in) :: n_in
	- integer, intent(in) :: ap, asp
	- integer :: ap_ew, ap_qcd
	- integer, intent(in) :: ew_scheme
	- type(string_t), intent(in) :: basename
	- type(model_data_t), intent(in), target :: model
	- integer, intent(in) :: blha_mode
	- type(string_t), intent(in) :: suffix
	- integer, dimension(:), allocatable :: amp_type
	- integer :: i
	-
	- allocate (amp_type (size (blha_flavor)))
	- do i = 1, size (blha_flavor)
	- amp_type(i) = BLHA_AMP_TREE
	- end do
	- select case (blha_cfg%correction_type)
	- case (BLHA_CT_QCD)
	- ap_ew = ap
	- ap_qcd = asp + 1
	- case (BLHA_CT_EW)
	- ap_ew = ap + 1
	- ap_qcd = asp
	- end select
	- call blha_configuration_init (blha_cfg, basename // suffix , &
	- model, blha_mode)
	- call blha_configuration_append_processes (blha_cfg, n_in, &
	- blha_flavor, amp_type)
	-
	- call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	- irreg = BLHA_IRREG_CDR, &
	- alphas_power = ap_qcd, &
	- alpha_power = ap_ew, &
	- ew_scheme = ew_scheme, &
	- debug = blha_mode == BLHA_MODE_GOSAM)
	- end subroutine blha_init_real
	-
	-@ %def blha_init_virtual blha_init_real
	-@ %def blha_init_subtraction
	-@
	-<<BLHA config: public>>=
	- public :: blha_get_additional_suffix
	-<<BLHA config: procedures>>=
	- function blha_get_additional_suffix (base_suffix) result (suffix)
	- type(string_t) :: suffix
	- type(string_t), intent(in) :: base_suffix
	- <<blha master: blha master extend suffixes: variables>>
	- suffix = base_suffix
	- <<blha master: blha master extend suffixes: procedure>>
	- end function blha_get_additional_suffix
	-
	-@ %def blha_master_extend_suffixes
	-@
	-<<MPI: blha master: blha master extend suffixes: variables>>=
	- integer :: n_size, rank
	-<<MPI: blha master: blha master extend suffixes: procedure>>=
	- call MPI_Comm_rank (MPI_COMM_WORLD, rank)
	- call MPI_Comm_size (MPI_COMM_WORLD, n_size)
	- if (n_size > 1) then
	- suffix = suffix // var_str ("_") // str (rank)
	- end if
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: write_olp => blha_master_write_olp
	-<<BLHA config: procedures>>=
	- subroutine blha_master_write_olp (master, basename)
	- class(blha_master_t), intent(in) :: master
	- type(string_t), intent(in) :: basename
	- integer :: unit
	- type(string_t) :: filename
	- integer :: i_file
	- do i_file = 1, master%n_files
	- filename = basename // master%suffix(i_file) // ".olp"
	- unit = free_unit ()
	- open (unit, file = char (filename), status = 'replace', action = 'write')
	- call blha_configuration_write (master%blha_cfg(i_file), master%suffix(i_file), unit)
	- close (unit)
	- end do
	- end subroutine blha_master_write_olp
	-
	-@ %def blha_master_write_olp
	-@
	-<<BLHA config: blha master: TBP>>=
	- procedure :: final => blha_master_final
	-<<BLHA config: procedures>>=
	- subroutine blha_master_final (master)
	- class(blha_master_t), intent(inout) :: master
	- master%n_files = 0
	- deallocate (master%suffix)
	- deallocate (master%blha_cfg)
	- deallocate (master%i_file_to_nlo_index)
	- end subroutine blha_master_final
	-
	-@ %def blha_master_final
	-@
	-<<BLHA config: public>>=
	- public :: blha_configuration_init
	-<<BLHA config: procedures>>=
	- subroutine blha_configuration_init (cfg, name, model, mode)
	- type(blha_configuration_t), intent(inout) :: cfg
	- type(string_t), intent(in) :: name
	- class(model_data_t), target, intent(in) :: model
	- integer, intent(in), optional :: mode
	- if (.not. associated (cfg%model)) then
	- cfg%name = name
	- cfg%model => model
	- end if
	- if (present (mode)) cfg%mode = mode
	- end subroutine blha_configuration_init
	-
	-@ %def blha_configuration_init
	-@ Create an array of massive particle indices, to be used by the
	-"MassiveParticle"-statement of the order file.
	-<<BLHA config: procedures>>=
	- subroutine blha_configuration_get_massive_particles &
	- (cfg, massive, i_massive)
	- type(blha_configuration_t), intent(in) :: cfg
	- logical, intent(out) :: massive
	- integer, intent(out), dimension(:), allocatable :: i_massive
	- integer, parameter :: max_particles = 10
	- integer, dimension(max_particles) :: i_massive_tmp
	- integer, dimension(max_particles) :: checked
	- type(blha_cfg_process_node_t), pointer :: current_process
	- integer :: k
	- integer :: n_massive
	- n_massive = 0; k = 1
	- checked = 0
	- if (associated (cfg%processes)) then
	- current_process => cfg%processes
	- else
	- call msg_fatal ("BLHA, massive particles: " // &
	- "No processes allocated!")
	- end if
	- do
	- call check_pdg_list (current_process%pdg_in%pdg)
	- call check_pdg_list (current_process%pdg_out%pdg)
	- if (k > max_particles) &
	- call msg_fatal ("BLHA, massive particles: " // &
	- "Max. number of particles exceeded!")
	- if (associated (current_process%next)) then
	- current_process => current_process%next
	- else
	- exit
	- end if
	- end do
	- if (n_massive > 0) then
	- allocate (i_massive (n_massive))
	- i_massive = i_massive_tmp (1:n_massive)
	- massive = .true.
	- else
	- massive = .false.
	- end if
	- contains
	- subroutine check_pdg_list (pdg_list)
	- integer, dimension(:), intent(in) :: pdg_list
	- integer :: i, i_pdg
	- type(flavor_t) :: flv
	- do i = 1, size (pdg_list)
	- i_pdg = abs (pdg_list(i))
	- call flv%init (i_pdg, cfg%model)
	- if (flv%get_mass () > 0._default) then
	- !!! Avoid duplicates in output
	- if (.not. any (checked == i_pdg)) then
	- i_massive_tmp(k) = i_pdg
	- checked(k) = i_pdg
	- k = k + 1
	- n_massive = n_massive + 1
	- end if
	- end if
	- end do
	- end subroutine check_pdg_list
	- end subroutine blha_configuration_get_massive_particles
	-
	-@ %def blha_configuration_get_massive_particles
	-@
	-<<BLHA config: public>>=
	- public :: blha_configuration_append_processes
	-<<BLHA config: procedures>>=
	- subroutine blha_configuration_append_processes (cfg, n_in, flavor, amp_type)
	- type(blha_configuration_t), intent(inout) :: cfg
	- integer, intent(in) :: n_in
	- type(blha_flv_state_t), dimension(:), intent(in) :: flavor
	- integer, dimension(:), intent(in), optional :: amp_type
	- integer :: n_tot
	- type(blha_cfg_process_node_t), pointer :: current_node
	- integer :: i_process, i_flv
	- integer, dimension(:), allocatable :: pdg_in, pdg_out
	- integer, dimension(:), allocatable :: flavor_state
	- integer :: proc_offset, n_proc_tot
	- proc_offset = 0; n_proc_tot = 0
	- do i_flv = 1, size (flavor)
	- n_proc_tot = n_proc_tot + flavor(i_flv)%flv_mult
	- end do
	- if (.not. associated (cfg%processes)) &
	- allocate (cfg%processes)
	- current_node => cfg%processes
	- do i_flv = 1, size (flavor)
	- n_tot = size (flavor(i_flv)%flavors)
	- allocate (pdg_in (n_in), pdg_out (n_tot - n_in))
	- allocate (flavor_state (n_tot))
	- flavor_state = flavor(i_flv)%flavors
	- do i_process = 1, flavor(i_flv)%flv_mult
	- pdg_in = flavor_state (1 : n_in)
	- pdg_out = flavor_state (n_in + 1 : )
	- if (cfg%polarized) then
	- select case (cfg%mode)
	- case (BLHA_MODE_OPENLOOPS)
	- call allocate_and_init_pdg_and_helicities (current_node, &
	- pdg_in, pdg_out, amp_type (proc_offset + i_process))
	- case (BLHA_MODE_GOSAM)
	- !!! Nothing special for GoSam yet. This exception is already caught
	- !!! in blha_master_setup_additional_features
	- end select
	- else
	- call allocate_and_init_pdg (current_node, pdg_in, pdg_out, &
	- amp_type (proc_offset + i_process))
	- end if
	- if (proc_offset + i_process /= n_proc_tot) then
	- allocate (current_node%next)
	- current_node => current_node%next
	- end if
	- if (i_process == flavor(i_flv)%flv_mult) &
	- proc_offset = proc_offset + flavor(i_flv)%flv_mult
	- end do
	- deallocate (pdg_in, pdg_out)
	- deallocate (flavor_state)
	- end do
	-
	- contains
	-
	- subroutine allocate_and_init_pdg (node, pdg_in, pdg_out, amp_type)
	- type(blha_cfg_process_node_t), intent(inout), pointer :: node
	- integer, intent(in), dimension(:), allocatable :: pdg_in, pdg_out
	- integer, intent(in) :: amp_type
	- allocate (node%pdg_in (size (pdg_in)))
	- allocate (node%pdg_out (size (pdg_out)))
	- node%pdg_in%pdg = pdg_in
	- node%pdg_out%pdg = pdg_out
	- node%amplitude_type = amp_type
	- end subroutine allocate_and_init_pdg
	-
	- subroutine allocate_and_init_pdg_and_helicities (node, pdg_in, pdg_out, amp_type)
	- type(blha_cfg_process_node_t), intent(inout), pointer :: node
	- integer, intent(in), dimension(:), allocatable :: pdg_in, pdg_out
	- integer, intent(in) :: amp_type
	- integer :: h1, h2
	- if (size (pdg_in) == 2) then
	- do h1 = -1, 1, 2
	- do h2 = -1, 1, 2
	- call allocate_and_init_pdg (current_node, pdg_in, pdg_out, amp_type)
	- current_node%pdg_in(1)%polarized = .true.
	- current_node%pdg_in(2)%polarized = .true.
	- current_node%pdg_in(1)%hel = h1
	- current_node%pdg_in(2)%hel = h2
	- if (h1 + h2 /= 2) then !!! not end of loop
	- allocate (current_node%next)
	- current_node => current_node%next
	- end if
	- end do
	- end do
	- else
	- do h1 = -1, 1, 2
	- call allocate_and_init_pdg (current_node, pdg_in, pdg_out, amp_type)
	- current_node%pdg_in(1)%polarized = .true.
	- current_node%pdg_in(1)%hel = h1
	- if (h1 /= 1) then !!! not end of loop
	- allocate (current_node%next)
	- current_node => current_node%next
	- end if
	- end do
	- end if
	- end subroutine allocate_and_init_pdg_and_helicities
	-
	- end subroutine blha_configuration_append_processes
	-
	-@ %def blha_configuration_append_processes
	-@ Change parameter(s).
	-<<BLHA config: public>>=
	- public :: blha_configuration_set
	-<<BLHA config: procedures>>=
	- subroutine blha_configuration_set (cfg, &
	- version, irreg, massive_particle_scheme, &
	- model_file, alphas_power, alpha_power, ew_scheme, width_scheme, &
	- accuracy, debug)
	- type(blha_configuration_t), intent(inout) :: cfg
	- integer, optional, intent(in) :: version
	- integer, optional, intent(in) :: irreg
	- integer, optional, intent(in) :: massive_particle_scheme
	- type(string_t), optional, intent(in) :: model_file
	- integer, optional, intent(in) :: alphas_power, alpha_power
	- integer, optional, intent(in) :: ew_scheme
	- integer, optional, intent(in) :: width_scheme
	- real(default), optional, intent(in) :: accuracy
	- logical, optional, intent(in) :: debug
	- if (present (version)) &
	- cfg%version = version
	- if (present (irreg)) &
	- cfg%irreg = irreg
	- if (present (massive_particle_scheme)) &
	- cfg%massive_particle_scheme = massive_particle_scheme
	- if (present (model_file)) &
	- cfg%model_file = model_file
	- if (present (alphas_power)) &
	- cfg%alphas_power = alphas_power
	- if (present (alpha_power)) &
	- cfg%alpha_power = alpha_power
	- if (present (ew_scheme)) &
	- cfg%ew_scheme = ew_scheme
	- if (present (width_scheme)) &
	- cfg%width_scheme = width_scheme
	- if (present (accuracy)) &
	- cfg%accuracy_target = accuracy
	- if (present (debug)) &
	- cfg%debug_unstable = debug
	- cfg%dirty = .false.
	- end subroutine blha_configuration_set
	-
	-@ %def blha_configuration_set
	-@
	-<<BLHA config: public>>=
	- public :: blha_configuration_get_n_proc
	-<<BLHA config: procedures>>=
	- function blha_configuration_get_n_proc (cfg) result (n_proc)
	- type(blha_configuration_t), intent(in) :: cfg
	- integer :: n_proc
	- n_proc = cfg%n_proc
	- end function blha_configuration_get_n_proc
	-
	-@ %def blha_configuration_get_n_proc
	-@
	-Write the BLHA file. Internal mode is intented for md5summing only.\\
	-\\
	-Special cases of external photons in \texttt{OpenLoops}:\\
	-For electroweak corrections the particle ID (PID) of photons is a crucial input for the
	-computation of matrix elements by \texttt{OpenLoops}.
	-According to "arXiv: 1907.13071", section 3.2, external photons are classified by the
	-following types:
	-\begin{itemize}
	-\item PID $= -2002$: off-shell photons, that undergo $\gamma\rightarrow f\bar{f}$ splittings
	-at NLO EW, or initial state photons from QED PDFs
	-\item PID $= 2002$: on-shell photons, that do not undergo $\gamma\rightarrow f\bar{f}$
	-splittings at NLO EW, or initial state photons for example at photon colliders
	-\item PID $= 22$: unresolved photons, representing radiated photons at NLO EW, absent at LO
	-\end{itemize}
	-For the first two types scattering amplitudes for processes with external photons at NLO EW
	-get renormalisation factors containing photon-coupling and wave function counterterms.
	-Logarithmic mass singularities arising due to the renormalisation of off-shell external
	-photon wave functions are cancelled by collinear singularities of photon PDF counterterms or
	-analogous terms in virtual contributions originating from $\gamma\rightarrow f\bar{f}$
	-splittings of final state photons.\\
	-The finite remainders of the renormalisation factors are thus dictated by the specific photon
	-PID stated above.
	-As consequence, we have to adjust the input PIDs written into the BLHA file which will be
	-read by \texttt{OpenLoops}.\\
	-Concretely, for the case of electroweak corrections initial state photons associated with
	-photon PDFs and final state photons (if existent at LO) are labeled as off-shell photons with
	-PID "$-2002$".
	-On-shell photons with PID "$2002$" are neglected for now since to include them for processes
	-at NLO EW is non-trivial from the phenomenological point of view.
	-Processes at NLO EW typically are studied at high energy scales for which photon-induced
	-sub-processes in most cases can not be neglected.
	-However, on-shell, e.~g. tagged, photons are defined at low energy scales and thus the
	-process has to be described with external photon fields and couplings at two different
	-scales.\\
	-Another issue which has to be adressed if various photon PIDs are taken into account is that
	-real and virtual amplitudes have to be computed at the same order in $\alpha$ at a specific
	-scale for the subtraction scheme to be consistent.
	-The complication comes by the fact that the EW coupling $\alpha$ of each external photon in
	-the amplitudes will automatically be rescaled by \texttt{OpenLoops} corresponding to the
	-specific photon type.
	-Following eq. (3.30) of "arXiv: 1907.13071", by default the coupling of an on-shell photon
	-will be changed to $\alpha(0)$ and that of an off-shell photon to $\alpha_{G_\mu}$ if not
	-chosen already at a high scale, e.~g. $\alpha(M_Z)$.
	-In order to not spoil the IR cancellation \texttt{OpenLoops} supplies to register unresolved
	-photons with PID "22" describing a radiated photon at NLO EW for which the photon-coupling
	-$\alpha$ is left unchanged at the value which is computed with the electroweak input scheme
	-chosen by the user.
	-This is adopted here by labeling each emitted photon as unresolved with PID "22" if no
	-photons are present at LO.\\
	-For EW corrections the freedom to choose an electroweak input scheme is restricted, however,
	-since the number of external photons present at LO is not conserved for the corresponding
	-real flavor structures due to possible $\gamma \rightarrow f\bar{f}$ splittings.
	-This forbids to choose $\alpha=\alpha(0)$ since otherwise the order in $\alpha(0)$ is not
	-conserved in the real amplitudes corresponding to the factorizing Born process.
	-Consequently, for FKS the NLO components are not of the same order in $\alpha(0)$.
	-The option \texttt{\$blha\_ew\_scheme = "alpha\_0"} is thus refused for the case if EW
	-corrections are activated and photons are present at LO.
	-<<BLHA config: public>>=
	- public :: blha_configuration_write
	-<<BLHA config: procedures>>=
	- subroutine blha_configuration_write (cfg, suffix, unit, internal, no_version)
	- type(blha_configuration_t), intent(in) :: cfg
	- integer, intent(in), optional :: unit
	- logical, intent(in), optional :: internal, no_version
	- type(string_t), intent(in) :: suffix
	- integer, dimension(:), allocatable :: pdg_flv
	- integer :: u
	- logical :: full
	- type(string_t) :: buf
	- type(blha_cfg_process_node_t), pointer :: node
	- integer :: i
	- character(3) :: pdg_char
	- character(5) :: pdg_char_extra
	- character(4) :: hel_char
	- character(6) :: suffix_char
	- character(len=25), parameter :: pad = ""
	- logical :: write_process, no_v
	- no_v = .false. ; if (present (no_version)) no_v = no_version
	- u = given_output_unit (unit); if (u < 0) return
	- full = .true.; if (present (internal)) full = .not. internal
	- if (full .and. cfg%dirty) call msg_bug ( &
	- "BUG: attempted to write out a dirty BLHA configuration")
	- if (full) then
	- if (no_v) then
	- write (u, "(A)") "# BLHA order written by WHIZARD [version]"
	- else
	- write (u, "(A)") "# BLHA order written by WHIZARD <<Version>>"
	- end if
	- write (u, "(A)")
	- end if
	- select case (cfg%mode)
	- case (BLHA_MODE_GOSAM); buf = "GoSam"
	- case (BLHA_MODE_OPENLOOPS); buf = "OpenLoops"
	- case default; buf = "vanilla"
	- end select
	- write (u, "(A)") "# BLHA interface mode: " // char (buf)
	- write (u, "(A)") "# process: " // char (cfg%name)
	- write (u, "(A)") "# model: " // char (cfg%model%get_name ())
	- select case (cfg%version)
	- case (1); buf = "BLHA1"
	- case (2); buf = "BLHA2"
	- end select
	- write (u, '(A25,A)') "InterfaceVersion " // pad, char (buf)
	- select case (cfg%correction_type)
	- case (BLHA_CT_QCD); buf = "QCD"
	- case (BLHA_CT_EW); buf = "EW"
	- case default; buf = cfg%correction_type_other
	- end select
	- write (u,'(A25,A)') "CorrectionType" // pad, char (buf)
	-
	- select case (cfg%mode)
	- case (BLHA_MODE_OPENLOOPS)
	- buf = cfg%name // '.olc'
	- write (u, '(A25,A)') "Extra AnswerFile" // pad, char (buf)
	- end select
	-
	- select case (cfg%irreg)
	- case (BLHA_IRREG_CDR); buf = "CDR"
	- case (BLHA_IRREG_DRED); buf = "DRED"
	- case (BLHA_IRREG_THV); buf = "tHV"
	- case (BLHA_IRREG_MREG); buf = "MassReg"
	- case default; buf = cfg%irreg_other
	- end select
	- write (u,'(A25,A)') "IRregularisation" // pad, char (buf)
	- select case (cfg%massive_particle_scheme)
	- case (BLHA_MPS_ONSHELL); buf = "OnShell"
	- case default; buf = cfg%massive_particle_scheme_other
	- end select
	- if (cfg%mode == BLHA_MODE_GOSAM) &
	- write (u,'(A25,A)') "MassiveParticleScheme" // pad, char (buf)
	- select case (cfg%version)
	- case (1)
	- if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	- "AlphasPower" // pad, int2char (cfg%alphas_power)
	- if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	- "AlphaPower " // pad, int2char (cfg%alpha_power)
	- case (2)
	- if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	- "CouplingPower QCD " // pad, int2char (cfg%alphas_power)
	- if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	- "CouplingPower QED " // pad, int2char (cfg%alpha_power)
	- end select
	- select case (cfg%mode)
	- case (BLHA_MODE_GOSAM)
	- select case (cfg%ew_scheme)
	- case (BLHA_EW_GF, BLHA_EW_INTERNAL); buf = "alphaGF"
	- case (BLHA_EW_MZ); buf = "alphaMZ"
	- case (BLHA_EW_MSBAR); buf = "alphaMSbar"
	- case (BLHA_EW_0); buf = "alpha0"
	- case (BLHA_EW_RUN); buf = "alphaRUN"
	- end select
	- write (u, '(A25, A)') "EWScheme " // pad, char (buf)
	- case (BLHA_MODE_OPENLOOPS)
	- select case (cfg%ew_scheme)
	- case (BLHA_EW_0); buf = "alpha0"
	- case (BLHA_EW_GF); buf = "Gmu"
	- case (BLHA_EW_MZ, BLHA_EW_INTERNAL); buf = "alphaMZ"
	- case default
	- call msg_fatal ("OpenLoops input: Only supported EW schemes &
	- & are 'alpha0', 'Gmu', and 'alphaMZ'")
	- end select
	- write (u, '(A25, A)') "ewscheme " // pad, char (buf)
	- end select
	- select case (cfg%mode)
	- case (BLHA_MODE_GOSAM)
	- write (u, '(A25)', advance='no') "MassiveParticles " // pad
	- do i = 1, size (OLP_MASSIVE_PARTICLES)
	- if (OLP_MASSIVE_PARTICLES(i) > 0) &
	- write (u, '(I2,1X)', advance='no') OLP_MASSIVE_PARTICLES(i)
	- end do
	- write (u,*)
	- case (BLHA_MODE_OPENLOOPS)
	- if (cfg%openloops_use_cms) then
	- write (u, '(A25,I1)') "extra use_cms " // pad, 1
	- else
	- write (u, '(A25,I1)') "extra use_cms " // pad, 0
	- end if
	- write (u, '(A25,I1)') "extra me_cache " // pad, 0
	- !!! Turn off calculation of 1/eps & 1/eps^2 poles in one-loop calculation
	- !!! Not needed in FKS (or any numerical NLO subtraction scheme)
	- write (u, '(A25,I1)') "extra IR_on " // pad, 0
	- if (cfg%openloops_phs_tolerance > 0) then
	- write (u, '(A25,A4,I0)') "extra psp_tolerance " // pad, "10e-", &
	- cfg%openloops_phs_tolerance
	- end if
	- call check_extra_cmd (cfg%openloops_extra_cmd)
	- write (u, '(A)') char (cfg%openloops_extra_cmd)
	- if (cfg%openloops_stability_log > 0) &
	- write (u, '(A25,I1)') "extra stability_log " // pad, &
	- cfg%openloops_stability_log
	- end select
	- if (full) then
	- write (u, "(A)")
	- write (u, "(A)") "# Process definitions"
	- write (u, "(A)")
	- end if
	- if (cfg%debug_unstable) &
	- write (u, '(A25,A)') "DebugUnstable " // pad, "True"
	- write (u, *)
	- node => cfg%processes
	- do while (associated (node))
	- write_process = .true.
	- allocate (pdg_flv (size (node%pdg_in) + size (node%pdg_out)))
	- do i = 1, size (node%pdg_in)
	- pdg_flv (i) = node%pdg_in(i)%pdg
	- end do
	- do i = 1, size (node%pdg_out)
	- pdg_flv (i + size (node%pdg_in)) = node%pdg_out(i)%pdg
	- end do
	- suffix_char = char (suffix)
	- if (cfg%correction_type == BLHA_CT_EW .and. cfg%alphas_power > 0) then
	- if ((suffix_char (1:5) == "_BORN" .and. .not. query_coupling_powers &
	- (pdg_flv, cfg%alpha_power, cfg%alphas_power)) .or. &
	- ((suffix_char (1:4) == "_SUB" .or. suffix_char (1:5) == "_LOOP" .or. &
	- suffix_char (1:6) == "_DGLAP") .and. (.not. (query_coupling_powers &
	- (pdg_flv, cfg%alpha_power, cfg%alphas_power) .or. query_coupling_powers &
	- (pdg_flv, cfg%alpha_power + 1, cfg%alphas_power - 1)) .or. &
	- all (is_gluon (pdg_flv))))) then
	- deallocate (pdg_flv)
	- node => node%next
	- cycle
	- end if
	- end if
	- select case (node%amplitude_type)
	- case (BLHA_AMP_LOOP); buf = "Loop"
	- case (BLHA_AMP_COLOR_C); buf = "ccTree"
	- case (BLHA_AMP_SPIN_C)
	- if (cfg%mode == BLHA_MODE_OPENLOOPS) then
	- buf = "sctree_polvect"
	- else
	- buf = "scTree"
	- end if
	- case (BLHA_AMP_TREE); buf = "Tree"
	- case (BLHA_AMP_LOOPINDUCED); buf = "LoopInduced"
	- end select
	- if (write_process) then
	- write (u, '(A25, A)') "AmplitudeType " // pad, char (buf)
	- buf = ""
	- if (cfg%correction_type == BLHA_CT_EW .and. cfg%alphas_power > 0 .and. &
	- (suffix_char (1:4) == "_SUB" .or. suffix_char (1:5) == "_LOOP" &
	- .or. suffix_char (1:6) == "_DGLAP")) then
	- if (query_coupling_powers (pdg_flv, cfg%alpha_power, cfg%alphas_power)) then
	- write (u,'(A25,A)') "CorrectionType" // pad, "EW"
	- select case (cfg%version)
	- case (1)
	- if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	- "AlphasPower" // pad, int2char (cfg%alphas_power)
	- if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	- "AlphaPower " // pad, int2char (cfg%alpha_power)
	- case (2)
	- if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	- "CouplingPower QCD " // pad, int2char (cfg%alphas_power)
	- if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	- "CouplingPower QED " // pad, int2char (cfg%alpha_power)
	- end select
	- else if (query_coupling_powers &
	- (pdg_flv, cfg%alpha_power + 1, cfg%alphas_power - 1)) then
	- write (u,'(A25,A)') "CorrectionType" // pad, "QCD"
	- select case (cfg%version)
	- case (1)
	- if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	- "AlphasPower" // pad, int2char (cfg%alphas_power - 1)
	- if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	- "AlphaPower " // pad, int2char (cfg%alpha_power + 1)
	- case (2)
	- if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	- "CouplingPower QCD " // pad, int2char (cfg%alphas_power - 1)
	- if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	- "CouplingPower QED " // pad, int2char (cfg%alpha_power + 1)
	- end select
	- end if
	- end if
	- do i = 1, size (node%pdg_in)
	- if (cfg%correction_type == BLHA_CT_EW .and. node%pdg_in(i)%pdg == PHOTON &
	- .and. cfg%n_off_photons_is > 0) then
	- if (cfg%ew_scheme == BLHA_EW_0) then
	- call msg_fatal ("ew_scheme: 'alpha_0' or 'alpha_thompson' " &
	- // "in combination", [ var_str ("with off-shell external photons " &
	- // "is not consistent with FKS.")])
	- end if
	- write (pdg_char_extra, '(I5)') PHOTON_OFFSHELL
	- buf = (buf // pdg_char_extra) // " "
	- else
	- call node%pdg_in(i)%write_pdg (pdg_char)
	- if (node%pdg_in(i)%polarized) then
	- call node%pdg_in(i)%write_helicity (hel_char)
	- buf = (buf // pdg_char // hel_char) // " "
	- else
	- buf = (buf // pdg_char) // " "
	- end if
	- end if
	- end do
	- buf = buf // "-> "
	- do i = 1, size (node%pdg_out)
	- if (cfg%correction_type == BLHA_CT_EW .and. node%pdg_out(i)%pdg == PHOTON &
	- .and. cfg%n_off_photons_fs > 0) then
	- if (cfg%ew_scheme == BLHA_EW_0) then
	- call msg_fatal ("ew_scheme: 'alpha_0' or 'alpha_thompson' " &
	- // "in combination with off-shell external photons " &
	- // "is not consistent with FKS. Try a different one.")
	- end if
	- write (pdg_char_extra, '(I5)') PHOTON_OFFSHELL
	- buf = (buf // pdg_char_extra) // " "
	- else
	- call node%pdg_out(i)%write_pdg (pdg_char)
	- buf = (buf // pdg_char) // " "
	- end if
	- end do
	- write (u, "(A)") char (trim (buf))
	- write (u, *)
	- end if
	- deallocate (pdg_flv)
	- node => node%next
	- end do
	- end subroutine blha_configuration_write
	-
	-@ %def blha_configuration_write
	-@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[blha_ut.f90]]>>=
	<<File header>>

	module blha_ut
	use unit_tests
	use blha_uti

	<<Standard module head>>

	<<BLHA: public tests>>

	contains

	<<BLHA: test driver>>

	end module blha_ut

	@ %def blha_ut
	@
	<<[[blha_uti.f90]]>>=
	<<File header>>

	module blha_uti

	<<Use strings>>
	use format_utils, only: write_separator
	use variables, only: var_list_t
	use os_interface
	use models
	use blha_config


	<<Standard module head>>

	<<BLHA: test declarations>>

	contains

	<<BLHA: test procedures>>

	<<BLHA: tests>>

	end module blha_uti

	@ %def blha_uti
	@ API: driver for the unit tests below.
	<<BLHA: public tests>>=
	public :: blha_test
	<<BLHA: test driver>>=
	subroutine blha_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	call test(blha_1, "blha_1", "Test the creation of BLHA-OLP files", u, results)
	call test(blha_2, "blha_2", "Test the creation of BLHA-OLP files for "&
	&"multiple flavor structures", u, results)
	call test(blha_3, "blha_3", "Test helicity-information in OpenLoops OLP files", &
	u, results)
	end subroutine blha_test

	@ %def blha_test
	@
	<<BLHA: test procedures>>=
	subroutine setup_and_write_blha_configuration (u, single, polarized)
	integer, intent(in) :: u
	logical, intent(in), optional :: single
	logical, intent(in), optional :: polarized
	logical :: polrzd, singl
	type(blha_master_t) :: blha_master
	integer :: i
	integer :: n_in, n_out
	integer :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(string_t) :: proc_id, method, correction_type
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(var_list_t) :: var_list
	type(model_t), pointer :: model => null ()
	integer :: openloops_phs_tolerance

	polrzd = .false.; if (present (polarized)) polrzd = polarized
	singl = .true.; if (present (single)) singl = single

	if (singl) then
	write (u, "(A)") "* Process: e+ e- -> W+ W- b b~"
	n_in = 2; n_out = 4
	alpha_power = 4; alphas_power = 0
	allocate (flv_born (n_in + n_out, 1))
	allocate (flv_real (n_in + n_out + 1, 1))
	flv_born(1,1) = 11; flv_born(2,1) = -11
	flv_born(3,1) = 24; flv_born(4,1) = -24
	flv_born(5,1) = 5; flv_born(6,1) = -5
	flv_real(1:6,1) = flv_born(:,1)
	flv_real(7,1) = 21
	else
	write (u, "(A)") "* Process: e+ e- -> u:d:s U:D:S"
	n_in = 2; n_out = 2
	alpha_power = 2; alphas_power = 0
	allocate (flv_born (n_in + n_out, 3))
	allocate (flv_real (n_in + n_out + 1, 3))
	flv_born(1,:) = 11; flv_born(2,:) = -11
	flv_born(3,1) = 1; flv_born(4,1) = -1
	flv_born(3,2) = 2; flv_born(4,2) = -2
	flv_born(3,3) = 3; flv_born(4,3) = -3
	flv_real(1:4,:) = flv_born
	flv_real(5,:) = 21
	end if
	proc_id = var_str ("BLHA_Test")

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), os_data, model)

	write (u, "(A)") "* BLHA matrix elements assumed for all process components"
	write (u, "(A)") "* Mode: GoSam"

	method = var_str ("gosam")
	correction_type = var_str ("QCD")
	call var_list%append_string (var_str ("$born_me_method"), method)
	call var_list%append_string (var_str ("$real_tree_me_method"), method)
	call var_list%append_string (var_str ("$loop_me_method"), method)
	call var_list%append_string (var_str ("$correlation_me_method"), method)
	call blha_master%set_ew_scheme (var_str ("GF"))
	call blha_master%set_methods (.true., var_list)
	call blha_master%allocate_config_files ()
	call blha_master%set_correction_type (correction_type)
	call blha_master%generate (proc_id, model, n_in, &
	alpha_power, alphas_power, flv_born, flv_real)

	call test_output (u)

	call blha_master%final ()
	call var_list%final ()
	write (u, "(A)") "* Switch to OpenLoops"
	openloops_phs_tolerance = 7

	method = var_str ("openloops")
	correction_type = var_str ("QCD")
	call var_list%append_string (var_str ("$born_me_method"), method)
	call var_list%append_string (var_str ("$real_tree_me_method"), method)
	call var_list%append_string (var_str ("$loop_me_method"), method)
	call var_list%append_string (var_str ("$correlation_me_method"), method)
	call blha_master%set_methods (.true., var_list)
	call blha_master%allocate_config_files ()
	call blha_master%set_correction_type (correction_type)
	call blha_master%generate (proc_id, model, n_in, &
	alpha_power, alphas_power, flv_born, flv_real)

	if (polrzd) then
	do i = 1, 4
	call blha_master%set_polarization (i)
	end do
	end if
	call blha_master%setup_additional_features &
	(openloops_phs_tolerance, .false., 0)

	call test_output (u)

	contains

	subroutine test_output (u)
	integer, intent(in) :: u
	do i = 1, 4
	call write_separator (u)
	call write_component_type (i, u)
	call write_separator (u)
	call blha_configuration_write &
	(blha_master%blha_cfg(i), blha_master%suffix(i), u, no_version = .true.)
	end do
	end subroutine test_output

	subroutine write_component_type (i, u)
	integer, intent(in) :: i, u
	type(string_t) :: message, component_type
	message = var_str ("OLP-File content for ")
	select case (i)
	case (1)
	component_type = var_str ("loop")
	case (2)
	component_type = var_str ("subtraction")
	case (3)
	component_type = var_str ("real")
	case (4)
	component_type = var_str ("born")
	end select
	message = message // component_type // " matrix elements"
	write (u, "(A)") char (message)
	end subroutine write_component_type

	end subroutine setup_and_write_blha_configuration

	@ %def setup_and_write_blha_configuration
	@
	<<BLHA: test declarations>>=
	public :: blha_1
	<<BLHA: tests>>=
	subroutine blha_1 (u)
	integer, intent(in) :: u
	write (u, "(A)") "* Test output: blha_1"
	write (u, "(A)") "* Purpose: Test the creation of olp-files for single "&
	&"and unpolarized flavor structures"
	write (u, "(A)")
	call setup_and_write_blha_configuration (u, single = .true., polarized = .false.)
	end subroutine blha_1

	@ %def blha_1
	@
	<<BLHA: test declarations>>=
	public :: blha_2
	<<BLHA: tests>>=
	subroutine blha_2 (u)
	integer, intent(in) :: u
	write (u, "(A)") "* Test output: blha_2"
	write (u, "(A)") "* Purpose: Test the creation of olp-files for multiple "&
	&"and unpolarized flavor structures"
	write (u, "(A)")
	call setup_and_write_blha_configuration (u, single = .false., polarized = .false.)
	end subroutine blha_2

	@ %def blha_2
	@
	<<BLHA: test declarations>>=
	public :: blha_3
	<<BLHA: tests>>=
	subroutine blha_3 (u)
	integer, intent(in) :: u
	write (u, "(A)") "* Test output: blha_3"
	write (u, "(A)") "* Purpose: Test the creation of olp-files for single "&
	&"and polarized flavor structures"
	write (u, "(A)")
	call setup_and_write_blha_configuration (u, single = .true., polarized = .true.)
	end subroutine blha_3

	@ %def blha_3
	@
	Index: trunk/share/debug/Makefile_full
	===================================================================
	--- trunk/share/debug/Makefile_full (revision 8789)
	+++ trunk/share/debug/Makefile_full (revision 8790)
	@@ -1,640 +1,642 @@
	FC=pgfortran_2019
	FCFLAGS=-Mbackslash
	CC=gcc
	CCFLAGS=

	MODELS = \
	SM.mdl \
	SM_hadrons.mdl \
	Test.mdl

	CC_SRC = \
	sprintf_interface.c \
	signal_interface.c

	F77_SRC = \
	pythia.F \
	pythia_pdf.f \
	pythia6_up.f \
	toppik.f \
	toppik_axial.f

	FC0_SRC =

	FC_SRC = \
	format_defs.f90 \
	io_units.f90 \
	kinds.f90 \
	constants.f90 \
	iso_varying_string.f90 \
	unit_tests.f90 \
	unit_tests_sub.f90 \
	numeric_utils.f90 \
	numeric_utils_sub.f90 \
	system_dependencies.f90 \
	string_utils.f90 \
	string_utils_sub.f90 \
	system_defs.f90 \
	system_defs_sub.f90 \
	debug_master.f90 \
	diagnostics.f90 \
	diagnostics_sub.f90 \
	sorting.f90 \
	physics_defs.f90 \
	physics_defs_sub.f90 \
	pdg_arrays.f90 \
	bytes.f90 \
	hashes.f90 \
	md5.f90 \
	model_data.f90 \
	model_data_sub.f90 \
	auto_components.f90 \
	var_base.f90 \
	model_testbed.f90 \
	auto_components_uti.f90 \
	auto_components_ut.f90 \
	os_interface.f90 \
	os_interface_sub.f90 \
	c_particles.f90 \
	c_particles_sub.f90 \
	format_utils.f90 \
	lorentz.f90 \
	lorentz_sub.f90 \
	phs_points.f90 \
	phs_points_sub.f90 \
	colors.f90 \
	colors_sub.f90 \
	flavors.f90 \
	flavors_sub.f90 \
	helicities.f90 \
	helicities_sub.f90 \
	quantum_numbers.f90 \
	quantum_numbers_sub.f90 \
	state_matrices.f90 \
	state_matrices_sub.f90 \
	interactions.f90 \
	interactions_sub.f90 \
	CppStringsWrap_dummy.f90 \
	FastjetWrap_dummy.f90 \
	cpp_strings.f90 \
	cpp_strings_sub.f90 \
	fastjet.f90 \
	fastjet_sub.f90 \
	jets.f90 \
	subevents.f90 \
	su_algebra.f90 \
	su_algebra_sub.f90 \
	bloch_vectors.f90 \
	bloch_vectors_sub.f90 \
	polarizations.f90 \
	polarizations_sub.f90 \
	particles.f90 \
	particles_sub.f90 \
	event_base.f90 \
	event_base_sub.f90 \
	eio_data.f90 \
	eio_data_sub.f90 \
	event_handles.f90 \
	eio_base.f90 \
	eio_base_sub.f90 \
	eio_base_uti.f90 \
	eio_base_ut.f90 \
	variables.f90 \
	variables_sub.f90 \
	rng_base.f90 \
	rng_base_sub.f90 \
	tao_random_numbers.f90 \
	rng_tao.f90 \
	rng_tao_sub.f90 \
	rng_stream.f90 \
	rng_stream_sub.f90 \
	rng_base_uti.f90 \
	rng_base_ut.f90 \
	dispatch_rng.f90 \
	dispatch_rng_sub.f90 \
	dispatch_rng_uti.f90 \
	dispatch_rng_ut.f90 \
	beam_structures.f90 \
	beam_structures_sub.f90 \
	evaluators.f90 \
	evaluators_sub.f90 \
	beams.f90 \
	beams_sub.f90 \
	sm_physics.f90 \
	sm_physics_sub.f90 \
	file_registries.f90 \
	file_registries_sub.f90 \
	sf_aux.f90 \
	sf_aux_sub.f90 \
	sf_mappings.f90 \
	sf_mappings_sub.f90 \
	sf_base.f90 \
	sf_base_sub.f90 \
	electron_pdfs.f90 \
	electron_pdfs_sub.f90 \
	sf_isr.f90 \
	sf_isr_sub.f90 \
	sf_epa.f90 \
	sf_epa_sub.f90 \
	sf_ewa.f90 \
	sf_ewa_sub.f90 \
	sf_escan.f90 \
	sf_escan_sub.f90 \
	sf_gaussian.f90 \
	sf_gaussian_sub.f90 \
	sf_beam_events.f90 \
	sf_beam_events_sub.f90 \
	circe1.f90 \
	sf_circe1.f90 \
	sf_circe1_sub.f90 \
	circe2.f90 \
	selectors.f90 \
	selectors_sub.f90 \
	sf_circe2.f90 \
	sf_circe2_sub.f90 \
	sm_qcd.f90 \
	sm_qcd_sub.f90 \
	sm_qed.f90 \
	sm_qed_sub.f90 \
	mrst2004qed.f90 \
	cteq6pdf.f90 \
	mstwpdf.f90 \
	ct10pdf.f90 \
	CJpdf.f90 \
	ct14pdf.f90 \
	pdf_builtin.f90 \
	pdf_builtin_sub.f90 \
	LHAPDFWrap_dummy.f90 \
	lhapdf5_full_dummy.f90 \
	lhapdf5_has_photon_dummy.f90 \
	lhapdf.f90 \
	hoppet_dummy.f90 \
	hoppet_interface.f90 \
	sf_pdf_builtin.f90 \
	sf_pdf_builtin_sub.f90 \
	sf_lhapdf.f90 \
	sf_lhapdf_sub.f90 \
	dispatch_beams.f90 \
	dispatch_beams_sub.f90 \
	process_constants.f90 \
	process_constants_sub.f90 \
	prclib_interfaces.f90 \
	prc_core_def.f90 \
	prc_core_def_sub.f90 \
	particle_specifiers.f90 \
	particle_specifiers_sub.f90 \
	process_libraries.f90 \
	process_libraries_sub.f90 \
	prc_test.f90 \
	prc_test_sub.f90 \
	prc_core.f90 \
	prc_core_sub.f90 \
	prc_test_core.f90 \
	prc_test_core_sub.f90 \
	sm_qed.f90 \
	sm_qed_sub.f90 \
	prc_omega.f90 \
	prc_omega_sub.f90 \
	phs_base.f90 \
	ifiles.f90 \
	lexers.f90 \
	syntax_rules.f90 \
	parser.f90 \
	expr_base.f90 \
	formats.f90 \
	formats_sub.f90 \
	analysis.f90 \
	user_code_interface.f90 \
	observables.f90 \
	observables_sub.f90 \
	eval_trees.f90 \
	interpolation.f90 \
	interpolation_sub.f90 \
	nr_tools.f90 \
	ttv_formfactors.f90 \
	ttv_formfactors_use.f90 \
	ttv_formfactors_uti.f90 \
	ttv_formfactors_ut.f90 \
	models.f90 \
	prclib_stacks.f90 \
	prclib_stacks_sub.f90 \
	user_files.f90 \
	cputime.f90 \
	cputime_sub.f90 \
	mci_base.f90 \
	integration_results.f90 \
	integration_results_uti.f90 \
	integration_results_ut.f90 \
	mappings.f90 \
	permutations.f90 \
	resonances.f90 \
	phs_trees.f90 \
	phs_forests.f90 \
	prc_external.f90 \
	blha_config.f90 \
	+ blha_config_sub.f90 \
	blha_olp_interfaces.f90 \
	+ blha_olp_interfaces_sub.f90 \
	prc_openloops.f90 \
	prc_threshold.f90 \
	prc_threshold_sub.f90 \
	process_config.f90 \
	process_counter.f90 \
	process_mci.f90 \
	pcm_base.f90 \
	nlo_data.f90 \
	cascades.f90 \
	cascades2_lexer.f90 \
	cascades2_lexer_uti.f90 \
	cascades2_lexer_ut.f90 \
	cascades2.f90 \
	cascades2_uti.f90 \
	cascades2_ut.f90 \
	phs_none.f90 \
	phs_rambo.f90 \
	phs_wood.f90 \
	phs_fks.f90 \
	phs_single.f90 \
	fks_regions.f90 \
	virtual.f90 \
	pdf.f90 \
	pdf_sub.f90 \
	real_subtraction.f90 \
	dglap_remnant.f90 \
	dispatch_fks.f90 \
	dispatch_phase_space.f90 \
	pcm.f90 \
	recola_wrapper_dummy.f90 \
	prc_recola.f90 \
	subevt_expr.f90 \
	parton_states.f90 \
	prc_template_me.f90 \
	prc_template_me_sub.f90 \
	process.f90 \
	process_stacks.f90 \
	iterations.f90 \
	rt_data.f90 \
	file_utils.f90 \
	file_utils_sub.f90 \
	prc_gosam.f90 \
	dispatch_me_methods.f90 \
	sf_base_uti.f90 \
	sf_base_ut.f90 \
	dispatch_uti.f90 \
	dispatch_ut.f90 \
	formats_uti.f90 \
	formats_ut.f90 \
	md5_uti.f90 \
	md5_ut.f90 \
	os_interface_uti.f90 \
	os_interface_ut.f90 \
	sorting_uti.f90 \
	sorting_ut.f90 \
	grids.f90 \
	grids_uti.f90 \
	grids_ut.f90 \
	solver.f90 \
	solver_uti.f90 \
	solver_ut.f90 \
	cputime_uti.f90 \
	cputime_ut.f90 \
	sm_qcd_uti.f90 \
	sm_qcd_ut.f90 \
	sm_physics_uti.f90 \
	sm_physics_ut.f90 \
	lexers_uti.f90 \
	lexers_ut.f90 \
	parser_uti.f90 \
	parser_ut.f90 \
	xml.f90 \
	xml_uti.f90 \
	xml_ut.f90 \
	colors_uti.f90 \
	colors_ut.f90 \
	state_matrices_uti.f90 \
	state_matrices_ut.f90 \
	analysis_uti.f90 \
	analysis_ut.f90 \
	particles_uti.f90 \
	particles_ut.f90 \
	radiation_generator.f90 \
	radiation_generator_uti.f90 \
	radiation_generator_ut.f90 \
	blha_uti.f90 \
	blha_ut.f90 \
	evaluators_uti.f90 \
	evaluators_ut.f90 \
	models_uti.f90 \
	models_ut.f90 \
	eval_trees_uti.f90 \
	eval_trees_ut.f90 \
	resonances_uti.f90 \
	resonances_ut.f90 \
	phs_trees_uti.f90 \
	phs_trees_ut.f90 \
	phs_forests_uti.f90 \
	phs_forests_ut.f90 \
	beams_uti.f90 \
	beams_ut.f90 \
	su_algebra_uti.f90 \
	su_algebra_ut.f90 \
	bloch_vectors_uti.f90 \
	bloch_vectors_ut.f90 \
	polarizations_uti.f90 \
	polarizations_ut.f90 \
	sf_aux_uti.f90 \
	sf_aux_ut.f90 \
	sf_mappings_uti.f90 \
	sf_mappings_ut.f90 \
	sf_pdf_builtin_uti.f90 \
	sf_pdf_builtin_ut.f90 \
	sf_lhapdf_uti.f90 \
	sf_lhapdf_ut.f90 \
	sf_isr_uti.f90 \
	sf_isr_ut.f90 \
	sf_epa_uti.f90 \
	sf_epa_ut.f90 \
	sf_ewa_uti.f90 \
	sf_ewa_ut.f90 \
	sf_circe1_uti.f90 \
	sf_circe1_ut.f90 \
	sf_circe2_uti.f90 \
	sf_circe2_ut.f90 \
	sf_gaussian_uti.f90 \
	sf_gaussian_ut.f90 \
	sf_beam_events_uti.f90 \
	sf_beam_events_ut.f90 \
	sf_escan_uti.f90 \
	sf_escan_ut.f90 \
	phs_base_uti.f90 \
	phs_base_ut.f90 \
	phs_none_uti.f90 \
	phs_none_ut.f90 \
	phs_single_uti.f90 \
	phs_single_ut.f90 \
	phs_rambo_uti.f90 \
	phs_rambo_ut.f90 \
	phs_wood_uti.f90 \
	phs_wood_ut.f90 \
	phs_fks_uti.f90 \
	phs_fks_ut.f90 \
	fks_regions_uti.f90 \
	fks_regions_ut.f90 \
	mci_midpoint.f90 \
	mci_base_uti.f90 \
	mci_base_ut.f90 \
	mci_midpoint_uti.f90 \
	mci_midpoint_ut.f90 \
	kinematics.f90 \
	instances.f90 \
	mci_none.f90 \
	mci_none_uti.f90 \
	mci_none_ut.f90 \
	processes_uti.f90 \
	processes_ut.f90 \
	process_stacks_uti.f90 \
	process_stacks_ut.f90 \
	prc_recola_uti.f90 \
	prc_recola_ut.f90 \
	rng_tao_uti.f90 \
	rng_tao_ut.f90 \
	rng_stream_uti.f90 \
	rng_stream_ut.f90 \
	selectors_uti.f90 \
	selectors_ut.f90 \
	vegas.f90 \
	vegas_uti.f90 \
	vegas_ut.f90 \
	vamp2.f90 \
	vamp2_uti.f90 \
	vamp2_ut.f90 \
	exceptions.f90 \
	vamp_stat.f90 \
	utils.f90 \
	divisions.f90 \
	linalg.f90 \
	vamp.f90 \
	mci_vamp.f90 \
	mci_vamp_uti.f90 \
	mci_vamp_ut.f90 \
	mci_vamp2.f90 \
	mci_vamp2_uti.f90 \
	mci_vamp2_ut.f90 \
	prclib_interfaces_uti.f90 \
	prclib_interfaces_ut.f90 \
	particle_specifiers_uti.f90 \
	particle_specifiers_ut.f90 \
	process_libraries_uti.f90 \
	process_libraries_ut.f90 \
	prclib_stacks_uti.f90 \
	prclib_stacks_ut.f90 \
	slha_interface.f90 \
	slha_interface_uti.f90 \
	slha_interface_ut.f90 \
	cascades_uti.f90 \
	cascades_ut.f90 \
	prc_test_uti.f90 \
	prc_test_ut.f90 \
	prc_template_me_uti.f90 \
	prc_template_me_ut.f90 \
	prc_omega_uti.f90 \
	prc_omega_ut.f90 \
	event_transforms.f90 \
	event_transforms_uti.f90 \
	event_transforms_ut.f90 \
	hep_common.f90 \
	hep_common_sub.f90 \
	hepev4_aux.f90 \
	tauola_dummy.f90 \
	tauola_interface.f90 \
	tauola_interface_sub.f90 \
	shower_base.f90 \
	shower_base_sub.f90 \
	shower_partons.f90 \
	shower_partons_sub.f90 \
	muli.f90 \
	matching_base.f90 \
	powheg_matching.f90 \
	shower_core.f90 \
	shower_core_sub.f90 \
	shower_base_uti.f90 \
	shower_base_ut.f90 \
	shower.f90 \
	shower_uti.f90 \
	shower_ut.f90 \
	shower_pythia6.f90 \
	shower_pythia6_sub.f90 \
	whizard_lha.f90 \
	whizard_lha_uti.f90 \
	whizard_lha_ut.f90 \
	LHAWhizard_dummy.f90 \
	Pythia8Wrap_dummy.f90 \
	pythia8.f90 \
	pythia8_uti.f90 \
	pythia8_ut.f90 \
	shower_pythia8.f90 \
	shower_pythia8_sub.f90 \
	hadrons.f90 \
	ktclus.f90 \
	mlm_matching.f90 \
	ckkw_matching.f90 \
	jets_uti.f90 \
	jets_ut.f90 \
	pdg_arrays_uti.f90 \
	pdg_arrays_ut.f90 \
	interactions_uti.f90 \
	interactions_ut.f90 \
	decays.f90 \
	decays_uti.f90 \
	decays_ut.f90 \
	evt_nlo.f90 \
	events.f90 \
	events_uti.f90 \
	events_ut.f90 \
	HepMCWrap_dummy.f90 \
	hepmc_interface.f90 \
	hepmc_interface_sub.f90 \
	hepmc_interface_uti.f90 \
	hepmc_interface_ut.f90 \
	LCIOWrap_dummy.f90 \
	lcio_interface.f90 \
	lcio_interface_sub.f90 \
	lcio_interface_uti.f90 \
	lcio_interface_ut.f90 \
	hep_events.f90 \
	hep_events_sub.f90 \
	hep_events_uti.f90 \
	hep_events_ut.f90 \
	expr_tests_uti.f90 \
	expr_tests_ut.f90 \
	parton_states_uti.f90 \
	parton_states_ut.f90 \
	eio_data_uti.f90 \
	eio_data_ut.f90 \
	eio_raw.f90 \
	eio_raw_uti.f90 \
	eio_raw_ut.f90 \
	eio_checkpoints.f90 \
	eio_checkpoints_sub.f90 \
	eio_checkpoints_uti.f90 \
	eio_checkpoints_ut.f90 \
	eio_lhef.f90 \
	eio_lhef_sub.f90 \
	eio_lhef_uti.f90 \
	eio_lhef_ut.f90 \
	eio_hepmc.f90 \
	eio_hepmc_sub.f90 \
	eio_hepmc_uti.f90 \
	eio_hepmc_ut.f90 \
	eio_lcio.f90 \
	eio_lcio_sub.f90 \
	eio_lcio_uti.f90 \
	eio_lcio_ut.f90 \
	stdhep_dummy.f90 \
	xdr_wo_stdhep.f90 \
	eio_stdhep.f90 \
	eio_stdhep_sub.f90 \
	eio_stdhep_uti.f90 \
	eio_stdhep_ut.f90 \
	eio_ascii.f90 \
	eio_ascii_sub.f90 \
	eio_ascii_uti.f90 \
	eio_ascii_ut.f90 \
	eio_weights.f90 \
	eio_weights_sub.f90 \
	eio_weights_uti.f90 \
	eio_weights_ut.f90 \
	eio_dump.f90 \
	eio_dump_sub.f90 \
	eio_dump_uti.f90 \
	eio_dump_ut.f90 \
	eio_callback.f90 \
	eio_callback_sub.f90 \
	real_subtraction_uti.f90 \
	real_subtraction_ut.f90 \
	iterations_uti.f90 \
	iterations_ut.f90 \
	rt_data_uti.f90 \
	rt_data_ut.f90 \
	dispatch_mci.f90 \
	dispatch_mci_uti.f90 \
	dispatch_mci_ut.f90 \
	dispatch_phs_uti.f90 \
	dispatch_phs_ut.f90 \
	resonance_insertion.f90 \
	resonance_insertion_uti.f90 \
	resonance_insertion_ut.f90 \
	recoil_kinematics.f90 \
	recoil_kinematics_uti.f90 \
	recoil_kinematics_ut.f90 \
	isr_epa_handler.f90 \
	isr_epa_handler_uti.f90 \
	isr_epa_handler_ut.f90 \
	dispatch_transforms.f90 \
	dispatch_transforms_uti.f90 \
	dispatch_transforms_ut.f90 \
	beam_structures_uti.f90 \
	beam_structures_ut.f90 \
	process_configurations.f90 \
	process_configurations_uti.f90 \
	process_configurations_ut.f90 \
	compilations.f90 \
	compilations_uti.f90 \
	compilations_ut.f90 \
	integrations.f90 \
	integrations_uti.f90 \
	integrations_ut.f90 \
	event_streams.f90 \
	event_streams_uti.f90 \
	event_streams_ut.f90 \
	restricted_subprocesses.f90 \
	eio_direct.f90 \
	eio_direct_sub.f90 \
	eio_direct_uti.f90 \
	eio_direct_ut.f90 \
	simulations.f90 \
	restricted_subprocesses_uti.f90 \
	restricted_subprocesses_ut.f90 \
	simulations_uti.f90 \
	simulations_ut.f90 \
	commands.f90 \
	commands_uti.f90 \
	commands_ut.f90 \
	cmdline_options.f90 \
	libmanager.f90 \
	features.f90 \
	whizard.f90 \
	api.f90 \
	api_hepmc_uti.f90 \
	api_hepmc_ut.f90 \
	api_lcio_uti.f90 \
	api_lcio_ut.f90 \
	api_uti.f90 \
	api_ut.f90

	FC_OBJ = $(FC0_SRC:.f90=.o) $(F77_SRC:.f=.o) $(FC_SRC:.f90=.o)
	CC_OBJ = $(CC_SRC:.c=.o)

	all: whizard_test
	check: whizard_test
	./whizard_test --check resonances

	whizard_test: $(FC_OBJ) $(CC_OBJ) main_ut.f90
	$(FC) $(FC_OBJ) $(CC_OBJ) -ldl -o $@ main_ut.f90

	whizard: $(FC_OBJ) $(CC_OBJ) main.f90
	$(FC) $(FC_OBJ) $(CC_OBJ) -ldl -o $@ main.f90

	%.o: %.f90
	$(FC) $(FCFLAGS) -c $<

	%.o: %.f
	$(FC) $(FCFLAGS) -c $<

	%.o: %.c
	$(CC) $(CCFLAGS) -c $<

	tar: $(FC_SRC) $(F77_SRC) $(FC0_SRC) $(CC_SRC) $(MODELS)
	tar cvvzf whizard-`date +%y%m%d`-`date +%H%M`.tar.gz $(FC_SRC) $(FC0_SRC) \
	$(F77_SRC) $(CC_SRC) main_ut.f90 Makefile $(MODELS)

	clean:
	rm -f .mod .o whizard_test

File Metadata

Mime Type: text/x-diff
Expires: Tue, Nov 19, 9:19 PM (23 h, 4 m)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 3806237
Default Alt Text: (264 KB)

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions