Page MenuHomeHEPForge
Files F9501644

No OneTemporary
Actions

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
Index: trunk/src/matrix_elements/matrix_elements.nw
===================================================================
--- trunk/src/matrix_elements/matrix_elements.nw (revision 8781)
+++ trunk/src/matrix_elements/matrix_elements.nw (revision 8782)
@@ -1,10226 +1,11570 @@
% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
% WHIZARD code as NOWEB source: matrix elements and process libraries
\chapter{Matrix Element Handling}
\includemodulegraph{matrix_elements}
In this chapter, we support internal and external matrix elements:
initialization, automatic generation where necessary, and numerical
evaluation. We provide the interface for code generation and linking.
Matrix-element code is organized in processes and process libraries.
\begin{description}
\item[process\_constants]
A record of static process properties, for easy transfer between
various \whizard\ modules.
\item[prclib\_interfaces]
This module deals with matrix-element code which is accessible via
external libraries (Fortran libraries or generic C-compatible
libraries) and must either be generated by the program or provided
by the user explicitly.
The module defines and uses an abstract type [[prc_writer_t]] and two
abstract extensions, one for a Fortran module and one for a C-compatible
library. The implementation provides the specific methods for writing the
appropriate parts in external matrix element code.
\item[prc\_core\_def]
This module defines the abstract types [[prc_core_def_t]] and
[[prc_driver_t]]. The implementation of the former provides the
configuration for processes of a certain class, while the latter accesses
the corresponding matrix element, in particular those generated by the
appropriate [[prc_writer_t]] object.
\item[process\_libraries]
This module combines the functionality of
the previous module with the means for holding processes definitions
(the internal counterpart of appropriate declarations in the user
interface), for handling matrix elements which do not need external
code, and for accessing the matrix elements by the procedures for
matrix-element evaluation, integration and event generation.
\item[prclib\_stacks]
Collect process libraries.
\item[test\_me] This module provides a test implementation for the abstract
types in the [[prc_core_def]] module. The implementation is intended for
self-tests of several later modules. The implementation is internal, i.e.,
no external code has is generated.
\end{description}
All data structures which are specific for a particular way of
generating code or evaluating matrix element are kept abstract and
thus generic. Later modules such as [[prc_omega]] provide
implementations, in the form of type extensions for the various
abstract types.
\clearpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process data block}
We define a simple transparent type that contains universal constant
process data. We will reference objects of this type for the
phase-space setup, for interfacing with process libraries, for
implementing matrix-element generation, and in the master
process-handling module.
<<[[process_constants.f90]]>>=
<<File header>>
module process_constants
<<Use kinds>>
<<Use strings>>
-
- use io_units, only: given_output_unit, free_unit
- use format_utils, only: write_integer_array
- use md5, only: md5sum
-
use pdg_arrays
<<Standard module head>>
-<<Process Constants: public>>
-
-<<Process Constants: types>>
+<<Process constants: public>>
-contains
+<<Process constants: types>>
-<<Process Constants: procedures>>
+ interface
+<<Process constants: sub interfaces>>
+ end interface
end module process_constants
@ %def process_constants
@
+<<[[process_constants_sub.f90]]>>=
+<<File header>>
+
+submodule (process_constants) process_constants_s
+
+ use io_units, only: given_output_unit, free_unit
+ use format_utils, only: write_integer_array
+ use md5, only: md5sum
+
+ implicit none
+
+contains
+
+<<Process constants: procedures>>
+
+end submodule process_constants_s
+
+@ %def process_constants_s
+@
The data type is just a block of public objects, only elementary
types, no type-bound procedures.
-<<Process Constants: public>>=
+<<Process constants: public>>=
public :: process_constants_t
-<<Process Constants: types>>=
+<<Process constants: types>>=
type :: process_constants_t
type(string_t) :: id
type(string_t) :: model_name
character(32) :: md5sum = ""
logical :: openmp_supported = .false.
integer :: n_in = 0
integer :: n_out = 0
integer :: n_flv = 0
integer :: n_hel = 0
integer :: n_col = 0
integer :: n_cin = 0
integer :: n_cf = 0
integer, dimension(:,:), allocatable :: flv_state
integer, dimension(:,:), allocatable :: hel_state
integer, dimension(:,:,:), allocatable :: col_state
logical, dimension(:,:), allocatable :: ghost_flag
complex(default), dimension(:), allocatable :: color_factors
integer, dimension(:,:), allocatable :: cf_index
integer, dimension(:), allocatable :: eqv_flv_index
integer, dimension(:), allocatable :: eqv_hel_index
contains
- <<Process Constants: process constants: TBP>>
+ <<Process constants: process constants: TBP>>
end type process_constants_t
@ %def process_constants_t
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_n_tot => process_constants_get_n_tot
-<<Process Constants: procedures>>=
- elemental function process_constants_get_n_tot (prc_const) result (n_tot)
+<<Process constants: sub interfaces>>=
+ elemental module function process_constants_get_n_tot (prc_const) result (n_tot)
+ integer :: n_tot
+ class(process_constants_t), intent(in) :: prc_const
+ end function process_constants_get_n_tot
+<<Process constants: procedures>>=
+ elemental module function process_constants_get_n_tot (prc_const) result (n_tot)
integer :: n_tot
class(process_constants_t), intent(in) :: prc_const
n_tot = prc_const%n_in + prc_const%n_out
end function process_constants_get_n_tot
@ %def process_constants_get_n_tot
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_flv_state => process_constants_get_flv_state
-<<Process Constants: procedures>>=
- subroutine process_constants_get_flv_state (prc_const, flv_state)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_get_flv_state (prc_const, flv_state)
+ class(process_constants_t), intent(in) :: prc_const
+ integer, dimension(:,:), allocatable, intent(out) :: flv_state
+ end subroutine process_constants_get_flv_state
+<<Process constants: procedures>>=
+ module subroutine process_constants_get_flv_state (prc_const, flv_state)
class(process_constants_t), intent(in) :: prc_const
integer, dimension(:,:), allocatable, intent(out) :: flv_state
allocate (flv_state (size (prc_const%flv_state, 1), &
size (prc_const%flv_state, 2)))
flv_state = prc_const%flv_state
end subroutine process_constants_get_flv_state
@ %def process_constants_get_flv_state
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_n_flv => process_constants_get_n_flv
-<<Process Constants: procedures>>=
- function process_constants_get_n_flv (data) result (n_flv)
+<<Process constants: sub interfaces>>=
+ module function process_constants_get_n_flv (data) result (n_flv)
+ integer :: n_flv
+ class(process_constants_t), intent(in) :: data
+ end function process_constants_get_n_flv
+<<Process constants: procedures>>=
+ module function process_constants_get_n_flv (data) result (n_flv)
integer :: n_flv
class(process_constants_t), intent(in) :: data
n_flv = data%n_flv
end function process_constants_get_n_flv
@ %def process_constants_get_n_flv
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_n_hel => process_constants_get_n_hel
-<<Process Constants: procedures>>=
- function process_constants_get_n_hel (data) result (n_hel)
+<<Process constants: sub interfaces>>=
+ module function process_constants_get_n_hel (data) result (n_hel)
+ integer :: n_hel
+ class(process_constants_t), intent(in) :: data
+ end function process_constants_get_n_hel
+<<Process constants: procedures>>=
+ module function process_constants_get_n_hel (data) result (n_hel)
integer :: n_hel
class(process_constants_t), intent(in) :: data
n_hel = data%n_hel
end function process_constants_get_n_hel
@ %def process_constants_get_n_flv
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_hel_state => process_constants_get_hel_state
-<<Process Constants: procedures>>=
- subroutine process_constants_get_hel_state (prc_const, hel_state)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_get_hel_state (prc_const, hel_state)
+ class(process_constants_t), intent(in) :: prc_const
+ integer, dimension(:,:), allocatable, intent(out) :: hel_state
+ end subroutine process_constants_get_hel_state
+<<Process constants: procedures>>=
+ module subroutine process_constants_get_hel_state (prc_const, hel_state)
class(process_constants_t), intent(in) :: prc_const
integer, dimension(:,:), allocatable, intent(out) :: hel_state
allocate (hel_state (size (prc_const%hel_state, 1), &
size (prc_const%hel_state, 2)))
hel_state = prc_const%hel_state
end subroutine process_constants_get_hel_state
@ %def process_constants_get_hel_state
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_col_state => process_constants_get_col_state
-<<Process Constants: procedures>>=
- subroutine process_constants_get_col_state (prc_const, col_state)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_get_col_state (prc_const, col_state)
+ class(process_constants_t), intent(in) :: prc_const
+ integer, dimension(:,:,:), allocatable, intent(out) :: col_state
+ end subroutine process_constants_get_col_state
+<<Process constants: procedures>>=
+ module subroutine process_constants_get_col_state (prc_const, col_state)
class(process_constants_t), intent(in) :: prc_const
integer, dimension(:,:,:), allocatable, intent(out) :: col_state
allocate (col_state (size (prc_const%col_state, 1), &
size (prc_const%col_state, 2), size (prc_const%col_state, 3)))
col_state = prc_const%col_state
end subroutine process_constants_get_col_state
@ %def process_constants_get_col_state
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_ghost_flag => process_constants_get_ghost_flag
-<<Process Constants: procedures>>=
- subroutine process_constants_get_ghost_flag (prc_const, ghost_flag)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_get_ghost_flag (prc_const, ghost_flag)
+ class(process_constants_t), intent(in) :: prc_const
+ logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
+ end subroutine process_constants_get_ghost_flag
+<<Process constants: procedures>>=
+ module subroutine process_constants_get_ghost_flag (prc_const, ghost_flag)
class(process_constants_t), intent(in) :: prc_const
logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
allocate (ghost_flag (size (prc_const%ghost_flag, 1), &
size (prc_const%ghost_flag, 2)))
ghost_flag = prc_const%ghost_flag
end subroutine process_constants_get_ghost_flag
@ %def process_constants_get_ghost_flag
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_color_factors => process_constants_get_color_factors
-<<Process Constants: procedures>>=
- subroutine process_constants_get_color_factors (prc_const, col_facts)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_get_color_factors (prc_const, col_facts)
+ class(process_constants_t), intent(in) :: prc_const
+ complex(default), dimension(:), allocatable, intent(out) :: col_facts
+ end subroutine process_constants_get_color_factors
+<<Process constants: procedures>>=
+ module subroutine process_constants_get_color_factors (prc_const, col_facts)
class(process_constants_t), intent(in) :: prc_const
complex(default), dimension(:), allocatable, intent(out) :: col_facts
allocate (col_facts (size (prc_const%color_factors)))
col_facts = prc_const%color_factors
end subroutine process_constants_get_color_factors
@ %def process_constants_get_color_factors
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_cf_index => process_constants_get_cf_index
-<<Process Constants: procedures>>=
- subroutine process_constants_get_cf_index (prc_const, cf_index)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_get_cf_index (prc_const, cf_index)
+ class(process_constants_t), intent(in) :: prc_const
+ integer, intent(out), dimension(:,:), allocatable :: cf_index
+ end subroutine process_constants_get_cf_index
+<<Process constants: procedures>>=
+ module subroutine process_constants_get_cf_index (prc_const, cf_index)
class(process_constants_t), intent(in) :: prc_const
integer, intent(out), dimension(:,:), allocatable :: cf_index
allocate (cf_index (size (prc_const%cf_index, 1), &
size (prc_const%cf_index, 2)))
cf_index = prc_const%cf_index
end subroutine process_constants_get_cf_index
@ %def process_constants_get_cf_index
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: set_flv_state => process_constants_set_flv_state
-<<Process Constants: procedures>>=
- subroutine process_constants_set_flv_state (prc_const, flv_state)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_set_flv_state (prc_const, flv_state)
+ class(process_constants_t), intent(inout) :: prc_const
+ integer, intent(in), dimension(:,:), allocatable :: flv_state
+ end subroutine process_constants_set_flv_state
+<<Process constants: procedures>>=
+ module subroutine process_constants_set_flv_state (prc_const, flv_state)
class(process_constants_t), intent(inout) :: prc_const
integer, intent(in), dimension(:,:), allocatable :: flv_state
if (allocated (prc_const%flv_state)) deallocate (prc_const%flv_state)
allocate (prc_const%flv_state (size (flv_state, 1), &
size (flv_state, 2)))
prc_const%flv_state = flv_state
prc_const%n_flv = size (flv_state, 2)
end subroutine process_constants_set_flv_state
@ %def process_constants_set_flv_state
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: set_col_state => process_constants_set_col_state
-<<Process Constants: procedures>>=
- subroutine process_constants_set_col_state (prc_const, col_state)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_set_col_state (prc_const, col_state)
+ class(process_constants_t), intent(inout) :: prc_const
+ integer, intent(in), dimension(:,:,:), allocatable :: col_state
+ end subroutine process_constants_set_col_state
+<<Process constants: procedures>>=
+ module subroutine process_constants_set_col_state (prc_const, col_state)
class(process_constants_t), intent(inout) :: prc_const
integer, intent(in), dimension(:,:,:), allocatable :: col_state
allocate (prc_const%col_state (size (col_state, 1), &
size (col_state, 2), size (col_state, 3)))
prc_const%col_state = col_state
end subroutine process_constants_set_col_state
@ %def process_constants_set_col_state
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: set_cf_index => process_constants_set_cf_index
-<<Process Constants: procedures>>=
- subroutine process_constants_set_cf_index (prc_const, cf_index)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_set_cf_index (prc_const, cf_index)
+ class(process_constants_t), intent(inout) :: prc_const
+ integer, dimension(:,:), intent(in), allocatable :: cf_index
+ end subroutine process_constants_set_cf_index
+<<Process constants: procedures>>=
+ module subroutine process_constants_set_cf_index (prc_const, cf_index)
class(process_constants_t), intent(inout) :: prc_const
integer, dimension(:,:), intent(in), allocatable :: cf_index
allocate (prc_const%cf_index (size (cf_index, 1), &
size (cf_index, 2)))
prc_const%cf_index = cf_index
end subroutine process_constants_set_cf_index
@ %def process_constants_set_cf_index
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: set_color_factors => process_constants_set_color_factors
-<<Process Constants: procedures>>=
- subroutine process_constants_set_color_factors (prc_const, color_factors)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_set_color_factors (prc_const, color_factors)
+ class(process_constants_t), intent(inout) :: prc_const
+ complex(default), dimension(:), intent(in), allocatable :: color_factors
+ end subroutine process_constants_set_color_factors
+<<Process constants: procedures>>=
+ module subroutine process_constants_set_color_factors (prc_const, color_factors)
class(process_constants_t), intent(inout) :: prc_const
complex(default), dimension(:), intent(in), allocatable :: color_factors
allocate (prc_const%color_factors (size (color_factors)))
prc_const%color_factors = color_factors
end subroutine process_constants_set_color_factors
@ %def process_constants_set_color_factors
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: set_ghost_flag => process_constants_set_ghost_flag
-<<Process Constants: procedures>>=
- subroutine process_constants_set_ghost_flag (prc_const, ghost_flag)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_set_ghost_flag (prc_const, ghost_flag)
+ class(process_constants_t), intent(inout) :: prc_const
+ logical, dimension(:,:), allocatable, intent(in) :: ghost_flag
+ end subroutine process_constants_set_ghost_flag
+<<Process constants: procedures>>=
+ module subroutine process_constants_set_ghost_flag (prc_const, ghost_flag)
class(process_constants_t), intent(inout) :: prc_const
logical, dimension(:,:), allocatable, intent(in) :: ghost_flag
allocate (prc_const%ghost_flag (size (ghost_flag, 1), &
size (ghost_flag, 2)))
prc_const%ghost_flag = ghost_flag
end subroutine process_constants_set_ghost_flag
@ %def process_constants_set_ghost_flag
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: get_pdg_in => process_constants_get_pdg_in
-<<Process Constants: procedures>>=
- function process_constants_get_pdg_in (prc_const) result (pdg_in)
+<<Process constants: sub interfaces>>=
+ module function process_constants_get_pdg_in (prc_const) result (pdg_in)
+ type(pdg_array_t), dimension(:), allocatable :: pdg_in
+ class(process_constants_t), intent(in) :: prc_const
+ end function process_constants_get_pdg_in
+<<Process constants: procedures>>=
+ module function process_constants_get_pdg_in (prc_const) result (pdg_in)
type(pdg_array_t), dimension(:), allocatable :: pdg_in
class(process_constants_t), intent(in) :: prc_const
type(pdg_array_t) :: pdg_tmp
integer :: i
allocate (pdg_in (prc_const%n_in))
do i = 1, prc_const%n_in
pdg_tmp = prc_const%flv_state(i,:)
pdg_in(i) = sort_abs (pdg_tmp, unique = .true.)
end do
end function process_constants_get_pdg_in
@ %def process_constants_get_pdg_in
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: compute_md5sum => process_constants_compute_md5sum
-<<Process Constants: procedures>>=
- subroutine process_constants_compute_md5sum (prc_const, include_id)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_compute_md5sum (prc_const, include_id)
+ class(process_constants_t), intent(inout) :: prc_const
+ logical, intent(in) :: include_id
+ end subroutine process_constants_compute_md5sum
+<<Process constants: procedures>>=
+ module subroutine process_constants_compute_md5sum (prc_const, include_id)
class(process_constants_t), intent(inout) :: prc_const
logical, intent(in) :: include_id
integer :: unit
unit = prc_const%fill_unit_for_md5sum (include_id)
rewind (unit)
prc_const%md5sum = md5sum (unit)
close (unit)
end subroutine process_constants_compute_md5sum
@ %process_constants_compute_md5sum
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: fill_unit_for_md5sum => process_constants_fill_unit_for_md5sum
-<<Process Constants: procedures>>=
- function process_constants_fill_unit_for_md5sum (prc_const, include_id) result (unit)
+<<Process constants: sub interfaces>>=
+ module function process_constants_fill_unit_for_md5sum &
+ (prc_const, include_id) result (unit)
+ integer :: unit
+ class(process_constants_t), intent(in) :: prc_const
+ logical, intent(in) :: include_id
+ end function process_constants_fill_unit_for_md5sum
+<<Process constants: procedures>>=
+ module function process_constants_fill_unit_for_md5sum &
+ (prc_const, include_id) result (unit)
integer :: unit
class(process_constants_t), intent(in) :: prc_const
logical, intent(in) :: include_id
integer :: i, j, k
unit = free_unit ()
open (unit, status="scratch", action="readwrite")
if (include_id) write (unit, '(A)') char (prc_const%id)
write (unit, '(A)') char (prc_const%model_name)
write (unit, '(L1)') prc_const%openmp_supported
write (unit, '(I0)') prc_const%n_in
write (unit, '(I0)') prc_const%n_out
write (unit, '(I0)') prc_const%n_flv
write (unit, '(I0)') prc_const%n_hel
write (unit, '(I0)') prc_const%n_col
write (unit, '(I0)') prc_const%n_cin
write (unit, '(I0)') prc_const%n_cf
do i = 1, size (prc_const%flv_state, dim=1)
do j = 1, size (prc_const%flv_state, dim=2)
write (unit, '(I0)') prc_const%flv_state (i, j)
end do
end do
do i = 1, size (prc_const%hel_state, dim=1)
do j = 1, size (prc_const%hel_state, dim=2)
write (unit, '(I0)') prc_const%hel_state (i, j)
end do
end do
do i = 1, size (prc_const%col_state, dim=1)
do j = 1, size (prc_const%col_state, dim=2)
do k = 1, size (prc_const%col_state, dim=3)
write (unit, '(I0)') prc_const%col_state (i, j, k)
end do
end do
end do
do i = 1, size (prc_const%ghost_flag, dim=1)
do j = 1, size (prc_const%ghost_flag, dim=2)
write (unit, '(L1)') prc_const%ghost_flag (i, j)
end do
end do
do i = 1, size (prc_const%color_factors)
write (unit, '(F0.0,F0.0)') real (prc_const%color_factors(i)), &
aimag (prc_const%color_factors(i))
end do
do i = 1, size (prc_const%cf_index, dim=1)
do j = 1, size (prc_const%cf_index, dim=2)
write (unit, '(I0)') prc_const%cf_index(i, j)
end do
end do
end function process_constants_fill_unit_for_md5sum
@ %def process_constants_fill_unit_for_md5sum
@
-<<Process Constants: process constants: TBP>>=
+<<Process constants: process constants: TBP>>=
procedure :: write => process_constants_write
-<<Process Constants: procedures>>=
- subroutine process_constants_write (prc_const, unit)
+<<Process constants: sub interfaces>>=
+ module subroutine process_constants_write (prc_const, unit)
+ class(process_constants_t), intent(in) :: prc_const
+ integer, intent(in), optional :: unit
+ end subroutine process_constants_write
+<<Process constants: procedures>>=
+ module subroutine process_constants_write (prc_const, unit)
class(process_constants_t), intent(in) :: prc_const
integer, intent(in), optional :: unit
integer :: u, i
u = given_output_unit (unit)
write (u, "(1x,A,A)") "Process data of id: ", char (prc_const%id)
write (u, "(1x,A,A)") "Associated model: ", char (prc_const%model_name)
write (u, "(1x,A,I0)") "n_in: ", prc_const%n_in
write (u, "(1x,A,I0)") "n_out: ", prc_const%n_out
write (u, "(1x,A,I0)") "n_flv: ", prc_const%n_flv
write (u, "(1x,A,I0)") "n_hel: ", prc_const%n_hel
write (u, "(1x,A,I0)") "n_col: ", prc_const%n_col
write (u, "(1x,A,I0)") "n_cin: ", prc_const%n_cin
write (u, "(1x,A,I0)") "n_cf: ", prc_const%n_cf
write (u, "(1x,A)") "Flavors: "
do i = 1, prc_const%n_flv
write (u, "(1x,A,I0)") "i_flv: ", i
call write_integer_array (prc_const%flv_state (:,i))
end do
end subroutine process_constants_write
@ %def process_constants_write
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process library interface}
The module [[prclib_interfaces]] handles external matrix-element code.
\subsection{Overview}
The top-level data structure is the [[prclib_driver_t]] data type.
The associated type-bound procedures deal with the generation of
external code, compilation and linking, and accessing the active
external library.
An object of type [[prclib_driver_t]] consists of the following parts:
\begin{enumerate}
\item\ Metadata that identify name and status of the library driver,
etc.
\item\ An array of process records ([[prclib_driver_record_t]]), one
for each external matrix element.
\item\ A record of type [[dlaccess_t]] which handles the
operating-system part of linking a dynamically loadable library.
\item\ A collection of procedure pointers which have a counterpart in
the external library interface. Given the unique identifier of a
matrix element, the procedures retrieve generic matrix-element
information such as the particle content and helicity combination
tables. There is also a procedure which returns pointers to the
more specific procedures that a matrix element provides, called
\emph{features}.
\end{enumerate}
The process records of type [[prclib_driver_record_t]] handle the
individual matrix elements. Each record identifies a process by name
([[id]]), names the physics model to be loaded for this process, lists
the features that the associated matrix-element code provides, and
holds a [[writer]] object which handles all operations that depend on
the process type. The numbering of process records is identical to
the numbering of matrix-element codes in the external library.
The writer object is of abstract type [[prc_writer_t]]. The module
defines two basic, also abstract, extensions:
[[prc_writer_f_module_t]] and [[prc_writer_c_lib_t]]. The first
version is for matrix-element code that is available in form of
Fortran modules. The writer contains type-bound procedures which
create appropriate [[use]] directives and [[C]]-compatible wrapper
functions for the given set of Fortran modules and their features.
The second version is for matrix-element code that is available in
form of a C-compatible library (this includes Fortran libraries with
proper C bindings). The writer needs not write wrapper function, but
explicit interface blocks for the matrix-element features.
Each matrix-element variant is encoded in an appropriate extension of
[[prc_writer_t]]. For instance, \oMega\ matrix elements provide an
implementation [[omega_writer_t]] which extends
[[prc_writer_f_module_t]].
\subsection{Workflow}
We expect that the functionality provided by this module is called in
the following order:
\begin{enumerate}
\item
The caller initializes the [[prclib_driver_t]] object and fills the
array of [[prclib_record_t]] entries with the appropriate process
data and process-specific writer objects.
\item
It calls the [[generate_makefile]] method to set up an appropriate
makefile in the current directory. The makefile will handle source
generation, compilation and linking both for the individual matrix
elements (unless this has to be done manually) and for the common
external driver code which interfaces those matrix element.
\item
The [[generate_driver_code]] writes the common driver as source code
to file.
\item
The methods [[make_source]], [[make_compile]], and [[make_link]]
individually perform the corresponding steps in building the
library. Wherever possible, they simply use the generated makefile.
By calling [[make]], we make sure that we can avoid
unnecessary recompilation. For the
compilation and linking steps, the makefile will employ [[libtool]].
\item
The [[load]] method loads the library procedures into the
corresponding procedure pointers, using the [[dlopen]] mechanism via
the [[dlaccess]] subobject.
\end{enumerate}
\subsection{The module}
<<[[prclib_interfaces.f90]]>>=
<<File header>>
module prclib_interfaces
use, intrinsic :: iso_c_binding !NODEP!
use kinds
<<Use strings>>
- use io_units
- use system_defs, only: TAB
- use string_utils, only: lower_case
- use diagnostics
use os_interface
<<Standard module head>>
<<Prclib interfaces: public>>
<<Prclib interfaces: types>>
<<Prclib interfaces: interfaces>>
+ interface
+<<Prclib interfaces: sub interfaces>>
+ end interface
+
contains
-<<Prclib interfaces: procedures>>
+<<Prclib interfaces: main procedures>>
end module prclib_interfaces
@ %def prclib_interfaces
@
+<<[[prclib_interfaces_sub.f90]]>>=
+<<File header>>
+
+submodule (prclib_interfaces) prclib_interfaces_s
+
+ use io_units
+ use system_defs, only: TAB
+ use string_utils, only: lower_case
+ use diagnostics
+
+ implicit none
+
+contains
+
+<<Prclib interfaces: procedures>>
+
+end submodule prclib_interfaces_s
+
+@ %def prclib_interfaces_s
+@
\subsection{Writers}
External matrix element code provides externally visible procedures,
which we denote as \emph{features}. The features consist of
informational subroutines and functions which are mandatory (universal
features) and matrix-element specific subroutines and functions
(specific features). The driver interfaces the
generic features directly, while it returns the specific features in
form of bind(C) procedure pointers to the caller. For instance,
function [[n_in]] is generic, while the matrix matrix-element value
itself is specific.
To implement these tasks, the driver needs [[use]] directives for
Fortran module procedures, interface blocks for other external stuff,
wrapper code, and Makefile snippets.
\subsubsection{Generic writer}
In the [[prc_writer_t]] data type, we collect the procedures which
implement the writing tasks. The type is abstract. The
concrete implementations are defined by an extension which is specific
for the process type.
The MD5 sum stored here should be the MD5 checksum of the current process
component, which can be calculated once the process is configured completely.
It can be used by implementations which work with external files, such as
\oMega.
<<Prclib interfaces: public>>=
public :: prc_writer_t
<<Prclib interfaces: types>>=
type, abstract :: prc_writer_t
character(32) :: md5sum = ""
contains
<<Prclib interfaces: prc writer: TBP>>
end type prc_writer_t
@ %def prc_writer_t
@ In any case, it is useful to have a string representation of the
writer type. This must be implemented by all extensions.
<<Prclib interfaces: prc writer: TBP>>=
procedure(get_const_string), nopass, deferred :: type_name
<<Prclib interfaces: interfaces>>=
abstract interface
function get_const_string () result (string)
import
type(string_t) :: string
end function get_const_string
end interface
@ %def get_const_string
@ Return the name of a procedure that implements a given feature, as
it is provided by the external matrix-element code. For a reasonable
-default, we take the feature name unchanged.
+default, we take the feature name unchanged. Due to a bug of bind(C)
+features with submodules in gfortran 7/8/9 (and maybe together with
+MPI) this needs to be in the module, not the submodule.
<<Prclib interfaces: prc writer: TBP>>=
procedure, nopass :: get_procname => prc_writer_get_procname
-<<Prclib interfaces: procedures>>=
+<<Prclib interfaces: main procedures>>=
function prc_writer_get_procname (feature) result (name)
type(string_t) :: name
type(string_t), intent(in) :: feature
name = feature
end function prc_writer_get_procname
@ %def prc_writer_get_procname
@ Return the name of a procedure that implements a given feature with
the bind(C) property, so it can be accessed via a C procedure pointer and
handled by dlopen. We need this for all special features of a matrix
element, since the interface has to return a C function pointer for it.
For a default implementation, we prefix the external procedure name by
-the process ID.
+the process ID. Due to a bug of bind(C) features with submodules in
+gfortran 7/8/9 (and maybe together with MPI) this needs to be in the
+module, not the submodule.
<<Prclib interfaces: prc writer: TBP>>=
procedure :: get_c_procname => prc_writer_get_c_procname
-<<Prclib interfaces: procedures>>=
+<<Prclib interfaces: main procedures>>=
function prc_writer_get_c_procname (writer, id, feature) result (name)
class(prc_writer_t), intent(in) :: writer
type(string_t), intent(in) :: id, feature
type(string_t) :: name
name = id // "_" // feature
end function prc_writer_get_c_procname
@ %def get_c_procname
@ Common signature of code-writing procedures. The procedure may
use the process ID, and the feature name.
(Not necessarily all of them.)
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine write_code_file (writer, id)
import
class(prc_writer_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine write_code_file
end interface
abstract interface
subroutine write_code (writer, unit, id)
import
class(prc_writer_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
end subroutine write_code
end interface
abstract interface
subroutine write_code_os &
(writer, unit, id, os_data, verbose, testflag)
import
class(prc_writer_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
end subroutine write_code_os
end interface
abstract interface
subroutine write_feature_code (writer, unit, id, feature)
import
class(prc_writer_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
end subroutine write_feature_code
end interface
@ %def write_code write_feature_code
@ There must be a procedure which writes an interface block for a
given feature. If the external matrix element is implemented as a
Fortran module, this is required only for the specific features which
are returned as procedure pointers.
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_feature_code), deferred :: write_interface
@ %def write_interface
@ There must also be a procedure which writes Makefile code which is
specific for the current process, but not the feature.
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code_os), deferred :: write_makefile_code
@ %def write_makefile_code
@ This procedure writes code process-specific source-code file
(which need not be Fortran). It is called before [[make]] [[source]] is
called. It may be a no-op, if the source code is
generated by Make instead.
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code_file), deferred :: write_source_code
@ %def write_source_code
@ This procedure is executed, once for each process, before (after)
[[make]] [[compile]] is called, respectively.
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code_file), deferred :: before_compile
procedure(write_code_file), deferred :: after_compile
@ %def before_compile
@ %def after_compile
@
\subsubsection{Writer for Fortran-module matrix elements}
If the matrix element is available as a Fortran module, we have
specific requirements: (i) the features are imported via [[use]]
directives, (ii) the specific features require bind(C) wrappers.
The type is still abstract, all methods must be implemented explicitly
for a specific matrix-element variant.
<<Prclib interfaces: public>>=
public :: prc_writer_f_module_t
<<Prclib interfaces: types>>=
type, extends (prc_writer_t), abstract :: prc_writer_f_module_t
contains
<<Prclib interfaces: prc writer f module: TBP>>
end type prc_writer_f_module_t
@ %def prc_writer_f_module_t
-@ Return the name of the Fortran module. As a default
-implementation, we take the process ID unchanged.
+@ Return the name of the Fortran module. As a default implementation,
+we take the process ID unchanged. Due to a bug of bind(C) features
+with submodules in gfortran 7/8/9 (and maybe together with MPI) this
+needs to be in the module, not the submodule.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure, nopass :: get_module_name => prc_writer_get_module_name
-<<Prclib interfaces: procedures>>=
+<<Prclib interfaces: main procedures>>=
function prc_writer_get_module_name (id) result (name)
type(string_t) :: name
type(string_t), intent(in) :: id
name = id
end function prc_writer_get_module_name
@ %def prc_writer_get_module_name
@ Write a [[use]] directive that associates the driver reference with
the procedure in the matrix element code. By default, we use the C
name for this.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_use_line => prc_writer_write_use_line
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_write_use_line (writer, unit, id, feature)
+ class(prc_writer_f_module_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t) :: id, feature
+ end subroutine prc_writer_write_use_line
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_write_use_line (writer, unit, id, feature)
+ module subroutine prc_writer_write_use_line (writer, unit, id, feature)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t) :: id, feature
write (unit, "(2x,9A)") "use ", char (writer%get_module_name (id)), &
", only: ", char (writer%get_c_procname (id, feature)), &
" => ", char (writer%get_procname (feature))
end subroutine prc_writer_write_use_line
@ %def prc_writer_write_use_line
@ Write a wrapper routine for a feature. This also associates a C
name the module procedure. The details depend on the writer variant.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure(prc_write_wrapper), deferred :: write_wrapper
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_write_wrapper (writer, unit, id, feature)
import
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
end subroutine prc_write_wrapper
end interface
@ %def prc_write_wrapper
@ This is used for testing only: initialize the writer with a specific MD5 sum
string.
<<Prclib interfaces: prc writer: TBP>>=
procedure :: init_test => prc_writer_init_test
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_init_test (writer)
+ class(prc_writer_t), intent(out) :: writer
+ end subroutine prc_writer_init_test
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_init_test (writer)
+ module subroutine prc_writer_init_test (writer)
class(prc_writer_t), intent(out) :: writer
writer%md5sum = "1234567890abcdef1234567890abcdef"
end subroutine prc_writer_init_test
@ %def prc_writer_init_test
@
\subsubsection{Writer for C-library matrix elements}
This applies if the matrix element is available as a C library or a Fortran
library with bind(C) compatible interface. We can use the basic
version.
The type is still abstract, all methods must be implemented explicitly
for a specific matrix-element variant.
<<Prclib interfaces: public>>=
public :: prc_writer_c_lib_t
<<Prclib interfaces: types>>=
type, extends (prc_writer_t), abstract :: prc_writer_c_lib_t
contains
<<Prclib interfaces: prc writer c lib: TBP>>
end type prc_writer_c_lib_t
@ %def prc_writer_c_lib_t
@
\subsection{Process records in the library driver}
A process record holds the process (component) [[ID]], the physics
[[model_name]], and the array of [[feature]]s that are
implemented by the corresponding matrix element code.
The [[writer]] component holds procedures. The procedures write
source code for the current record, either for the driver or for the
Makefile.
<<Prclib interfaces: types>>=
type :: prclib_driver_record_t
type(string_t) :: id
type(string_t) :: model_name
type(string_t), dimension(:), allocatable :: feature
class(prc_writer_t), pointer :: writer => null ()
contains
<<Prclib interfaces: prclib driver record: TBP>>
end type prclib_driver_record_t
@ %def prclib_driver_record
@ Output routine. We indent the output, so it smoothly integrates
into the output routine for the whole driver.
Note: the pointer [[writer]] is introduced as a workaround for a NAG compiler
bug.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write => prclib_driver_record_write
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write (object, unit)
+ class(prclib_driver_record_t), intent(in) :: object
+ integer, intent(in) :: unit
+ end subroutine prclib_driver_record_write
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write (object, unit)
+ module subroutine prclib_driver_record_write (object, unit)
class(prclib_driver_record_t), intent(in) :: object
integer, intent(in) :: unit
integer :: j
class(prc_writer_t), pointer :: writer
write (unit, "(3x,A,2x,'[',A,']')") &
char (object%id), char (object%model_name)
if (allocated (object%feature)) then
writer => object%writer
write (unit, "(5x,A,A)", advance="no") &
char (writer%type_name ()), ":"
do j = 1, size (object%feature)
write (unit, "(1x,A)", advance="no") &
char (object%feature(j))
end do
write (unit, *)
end if
end subroutine prclib_driver_record_write
@ %def prclib_driver_record_write
-@ Get the C procedure name for a feature.
+@ Get the C procedure name for a feature. Due to a bug of bind(C)
+features with submodules in gfortran 7/8/9 (and maybe together with
+MPI) this needs to be in the module, not the submodule.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: get_c_procname => prclib_driver_record_get_c_procname
-<<Prclib interfaces: procedures>>=
+<<Prclib interfaces: main procedures>>=
function prclib_driver_record_get_c_procname (record, feature) result (name)
type(string_t) :: name
class(prclib_driver_record_t), intent(in) :: record
type(string_t), intent(in) :: feature
name = record%writer%get_c_procname (record%id, feature)
end function prclib_driver_record_get_c_procname
@ %def prclib_driver_record_get_c_procname
@ Write a USE directive for a given feature. Applies only if the
record corresponds to a Fortran module.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_use_line => prclib_driver_record_write_use_line
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_use_line (record, unit, feature)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: feature
+ end subroutine prclib_driver_record_write_use_line
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_use_line (record, unit, feature)
+ module subroutine prclib_driver_record_write_use_line (record, unit, feature)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
type(string_t), intent(in) :: feature
select type (writer => record%writer)
class is (prc_writer_f_module_t)
call writer%write_use_line (unit, record%id, feature)
end select
end subroutine prclib_driver_record_write_use_line
@ %def prclib_driver_record_write_use_line
@ The alternative: write an interface block for a given feature,
unless the record corresponds to a Fortran module.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_interface => prclib_driver_record_write_interface
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_interface (record, unit, feature)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: feature
+ end subroutine prclib_driver_record_write_interface
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_interface (record, unit, feature)
+ module subroutine prclib_driver_record_write_interface (record, unit, feature)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
type(string_t), intent(in) :: feature
select type (writer => record%writer)
class is (prc_writer_f_module_t)
class default
call writer%write_interface (unit, record%id, feature)
end select
end subroutine prclib_driver_record_write_interface
@ %def prclib_driver_record_write_use_line
@ Write all special feature interfaces for the current record. Do
this for all process variants.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_interfaces => prclib_driver_record_write_interfaces
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_interfaces (record, unit)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ end subroutine prclib_driver_record_write_interfaces
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_interfaces (record, unit)
+ module subroutine prclib_driver_record_write_interfaces (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
integer :: i
do i = 1, size (record%feature)
call record%writer%write_interface (unit, record%id, record%feature(i))
end do
end subroutine prclib_driver_record_write_interfaces
@ %def prclib_driver_record_write_interfaces
@ Write the wrapper routines for this record, if it corresponds to a
Fortran module.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_wrappers => prclib_driver_record_write_wrappers
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_wrappers (record, unit)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ end subroutine prclib_driver_record_write_wrappers
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_wrappers (record, unit)
+ module subroutine prclib_driver_record_write_wrappers (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
integer :: i
select type (writer => record%writer)
class is (prc_writer_f_module_t)
do i = 1, size (record%feature)
call writer%write_wrapper (unit, record%id, record%feature(i))
end do
end select
end subroutine prclib_driver_record_write_wrappers
@ %def prclib_driver_record_write_wrappers
@ Write the Makefile code for this record.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_makefile_code => prclib_driver_record_write_makefile_code
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_makefile_code &
+ (record, unit, os_data, verbose, testflag)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in) :: verbose
+ logical, intent(in), optional :: testflag
+ end subroutine prclib_driver_record_write_makefile_code
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_makefile_code &
+ module subroutine prclib_driver_record_write_makefile_code &
(record, unit, os_data, verbose, testflag)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
call record%writer%write_makefile_code &
(unit, record%id, os_data, verbose, testflag)
end subroutine prclib_driver_record_write_makefile_code
@ %def prclib_driver_record_write_makefile_code
@ Write source-code files for this record. This can be used as an alternative
to handling source code via Makefile. In fact, this procedure is executed
before [[make]] [[source]] is called. Usually, does nothing.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_source_code => prclib_driver_record_write_source_code
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_source_code (record)
+ class(prclib_driver_record_t), intent(in) :: record
+ end subroutine prclib_driver_record_write_source_code
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_source_code (record)
+ module subroutine prclib_driver_record_write_source_code (record)
class(prclib_driver_record_t), intent(in) :: record
call record%writer%write_source_code (record%id)
end subroutine prclib_driver_record_write_source_code
@ %def prclib_driver_record_write_source_code
@ Execute commands for this record that depend on the sources, so they
cannot be included in the previous procedure. This procedure is
executed before (after) [[make]] [[compile]] is called, respectively.
Usually, does nothing.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: before_compile => prclib_driver_record_before_compile
procedure :: after_compile => prclib_driver_record_after_compile
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_before_compile (record)
+ class(prclib_driver_record_t), intent(in) :: record
+ end subroutine prclib_driver_record_before_compile
+ module subroutine prclib_driver_record_after_compile (record)
+ class(prclib_driver_record_t), intent(in) :: record
+ end subroutine prclib_driver_record_after_compile
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_before_compile (record)
+ module subroutine prclib_driver_record_before_compile (record)
class(prclib_driver_record_t), intent(in) :: record
call record%writer%before_compile (record%id)
end subroutine prclib_driver_record_before_compile
- subroutine prclib_driver_record_after_compile (record)
+ module subroutine prclib_driver_record_after_compile (record)
class(prclib_driver_record_t), intent(in) :: record
call record%writer%after_compile (record%id)
end subroutine prclib_driver_record_after_compile
@ %def prclib_driver_record_before_compile
@ %def prclib_driver_record_after_compile
@
\subsection{The process library driver object}
A [[prclib_driver_t]] object provides the interface to external matrix element
code. The code is provided by an external library which is either
statically or dynamically linked.
The dynamic and static versions of the library are two different
implementations of the abstract base type.
The [[basename]] identifies the library, both by file names and by Fortran
variable names.
The [[loaded]] flag becomes true once all procedure pointers to the
matrix element have been assigned.
For a dynamical external library, the communication proceeds via a
[[dlaccess]] object.
[[n_processes]] is the number of external process code components that
are referenced by this library. The code is addressed by index ([[i_lib]]
in the process library entry above). This number should be equal to
the number returned by [[get_n_prc]].
For each external process, there is a separate [[record]] which holds
the data that are needed for the driver parts which are specific
for a given process component. The actual pointers for the loaded
library will be assigned elsewhere.
The remainder is a collection of procedure pointers, which can be
assigned once all external code has been compiled and linked.
The procedure pointers all take a process component code
index as an argument. Most return information about the process
component that should match the process definition. The [[get_fptr]]
procedures return a function pointer, which is the actual means to
compute matrix elements or retrieve associated data.
Finally, the [[unload_hook]] and [[reload_hook]] pointers allow for
the insertion of additional code when a library is loaded.
<<Prclib interfaces: public>>=
public :: prclib_driver_t
<<Prclib interfaces: types>>=
type, abstract :: prclib_driver_t
type(string_t) :: basename
character(32) :: md5sum = ""
logical :: loaded = .false.
type(string_t) :: libname
type(string_t) :: modellibs_ldflags
integer :: n_processes = 0
type(prclib_driver_record_t), dimension(:), allocatable :: record
procedure(prc_get_n_processes), nopass, pointer :: &
get_n_processes => null ()
procedure(prc_get_stringptr), nopass, pointer :: &
get_process_id_ptr => null ()
procedure(prc_get_stringptr), nopass, pointer :: &
get_model_name_ptr => null ()
procedure(prc_get_stringptr), nopass, pointer :: &
get_md5sum_ptr => null ()
procedure(prc_get_log), nopass, pointer :: &
get_openmp_status => null ()
procedure(prc_get_int), nopass, pointer :: get_n_in => null ()
procedure(prc_get_int), nopass, pointer :: get_n_out => null ()
procedure(prc_get_int), nopass, pointer :: get_n_flv => null ()
procedure(prc_get_int), nopass, pointer :: get_n_hel => null ()
procedure(prc_get_int), nopass, pointer :: get_n_col => null ()
procedure(prc_get_int), nopass, pointer :: get_n_cin => null ()
procedure(prc_get_int), nopass, pointer :: get_n_cf => null ()
procedure(prc_set_int_tab1), nopass, pointer :: &
set_flv_state_ptr => null ()
procedure(prc_set_int_tab1), nopass, pointer :: &
set_hel_state_ptr => null ()
procedure(prc_set_col_state), nopass, pointer :: &
set_col_state_ptr => null ()
procedure(prc_set_color_factors), nopass, pointer :: &
set_color_factors_ptr => null ()
procedure(prc_get_fptr), nopass, pointer :: get_fptr => null ()
contains
<<Prclib interfaces: prclib driver: TBP>>
end type prclib_driver_t
@ %def prclib_driver_t
@ This is the dynamic version. It contains a [[dlaccess]] object for
communicating with the OS.
<<Prclib interfaces: public>>=
public :: prclib_driver_dynamic_t
<<Prclib interfaces: types>>=
type, extends (prclib_driver_t) :: prclib_driver_dynamic_t
type(dlaccess_t) :: dlaccess
contains
<<Prclib interfaces: prclib driver dynamic: TBP>>
end type prclib_driver_dynamic_t
@ %def prclib_driver_dynamic_t
@ Print just the metadata. Procedure pointers cannot be printed.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write => prclib_driver_write
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_write (object, unit, libpath)
+ class(prclib_driver_t), intent(in) :: object
+ integer, intent(in) :: unit
+ logical, intent(in), optional :: libpath
+ end subroutine prclib_driver_write
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_write (object, unit, libpath)
+ module subroutine prclib_driver_write (object, unit, libpath)
class(prclib_driver_t), intent(in) :: object
integer, intent(in) :: unit
logical, intent(in), optional :: libpath
logical :: write_lib
integer :: i
write_lib = .true.
if (present (libpath)) write_lib = libpath
write (unit, "(1x,A,A)") &
"External matrix-element code library: ", char (object%basename)
select type (object)
type is (prclib_driver_dynamic_t)
write (unit, "(3x,A,L1)") "static = F"
class default
write (unit, "(3x,A,L1)") "static = T"
end select
write (unit, "(3x,A,L1)") "loaded = ", object%loaded
write (unit, "(3x,A,A,A)") "MD5 sum = '", object%md5sum, "'"
if (write_lib) then
write (unit, "(3x,A,A,A)") "Mdl flags = '", &
char (object%modellibs_ldflags), "'"
end if
select type (object)
type is (prclib_driver_dynamic_t)
write (unit, *)
call object%dlaccess%write (unit)
end select
write (unit, *)
if (allocated (object%record)) then
write (unit, "(1x,A)") "Matrix-element code entries:"
do i = 1, object%n_processes
call object%record(i)%write (unit)
end do
else
write (unit, "(1x,A)") "Matrix-element code entries: [undefined]"
end if
end subroutine prclib_driver_write
@ %def prclib_driver_write
@ Allocate a library as either static or dynamic. For static
libraries, the procedure defers control to an external procedure which
knows about the available static libraries. By default, this
procedure is empty, but when we build a stand-alone executable, we
replace the dummy by an actual dispatcher for the available
static libraries. If the static dispatcher was not successful, we
allocate a dynamic library.
The default version of [[dispatch_prclib_static]] resides in the
[[prebuilt]] section of the \whizard\ tree, in a separate
library. It does nothing, but can be replaced by a different
procedure that allocates a static library driver if requested by name.
+Due to a bug of bind(C) features with submodules in gfortran 7/8/9
+(and maybe together with MPI) this needs to be in the module, not the
+submodule.
<<Prclib interfaces: public>>=
public :: dispatch_prclib_driver
-<<Prclib interfaces: procedures>>=
+<<Prclib interfaces: main procedures>>=
subroutine dispatch_prclib_driver &
(driver, basename, modellibs_ldflags)
class(prclib_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
type(string_t), intent(in), optional :: modellibs_ldflags
procedure(dispatch_prclib_driver) :: dispatch_prclib_static
if (allocated (driver)) deallocate (driver)
call dispatch_prclib_static (driver, basename)
if (.not. allocated (driver)) then
allocate (prclib_driver_dynamic_t :: driver)
end if
driver%basename = basename
driver%modellibs_ldflags = modellibs_ldflags
end subroutine dispatch_prclib_driver
@ %def dispatch_prclib_driver
@ Initialize the ID array and set [[n_processes]] accordingly.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: init => prclib_driver_init
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_init (driver, n_processes)
+ class(prclib_driver_t), intent(inout) :: driver
+ integer, intent(in) :: n_processes
+ end subroutine prclib_driver_init
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_init (driver, n_processes)
+ module subroutine prclib_driver_init (driver, n_processes)
class(prclib_driver_t), intent(inout) :: driver
integer, intent(in) :: n_processes
driver%n_processes = n_processes
allocate (driver%record (n_processes))
end subroutine prclib_driver_init
@ %def prclib_driver_init
@ Set the MD5 sum. This is separate because the MD5 sum may be known only
after initialization.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_md5sum => prclib_driver_set_md5sum
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_set_md5sum (driver, md5sum)
+ class(prclib_driver_t), intent(inout) :: driver
+ character(32), intent(in) :: md5sum
+ end subroutine prclib_driver_set_md5sum
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_set_md5sum (driver, md5sum)
+ module subroutine prclib_driver_set_md5sum (driver, md5sum)
class(prclib_driver_t), intent(inout) :: driver
character(32), intent(in) :: md5sum
driver%md5sum = md5sum
end subroutine prclib_driver_set_md5sum
@ %def prclib_driver_set_md5sum
@ Set the process record for a specific library entry. If the index
is zero, we do nothing.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_record => prclib_driver_set_record
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_set_record (driver, i, &
+ id, model_name, features, writer)
+ class(prclib_driver_t), intent(inout) :: driver
+ integer, intent(in) :: i
+ type(string_t), intent(in) :: id
+ type(string_t), intent(in) :: model_name
+ type(string_t), dimension(:), intent(in) :: features
+ class(prc_writer_t), intent(in), pointer :: writer
+ end subroutine prclib_driver_set_record
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_set_record (driver, i, &
+ module subroutine prclib_driver_set_record (driver, i, &
id, model_name, features, writer)
class(prclib_driver_t), intent(inout) :: driver
integer, intent(in) :: i
type(string_t), intent(in) :: id
type(string_t), intent(in) :: model_name
type(string_t), dimension(:), intent(in) :: features
class(prc_writer_t), intent(in), pointer :: writer
if (i > 0) then
associate (record => driver%record(i))
record%id = id
record%model_name = model_name
allocate (record%feature (size (features)))
record%feature = features
record%writer => writer
end associate
end if
end subroutine prclib_driver_set_record
@ %def prclib_driver_set_record
@ Write all USE directives for a given feature, scanning the array of
processes. Only Fortran-module processes count. Then, write
interface blocks for the remaining processes.
The [[implicit none]] statement must go in-between.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_interfaces => prclib_driver_write_interfaces
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_write_interfaces (driver, unit, feature)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: feature
+ end subroutine prclib_driver_write_interfaces
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_write_interfaces (driver, unit, feature)
+ module subroutine prclib_driver_write_interfaces (driver, unit, feature)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: feature
integer :: i
do i = 1, driver%n_processes
call driver%record(i)%write_use_line (unit, feature)
end do
write (unit, "(2x,9A)") "implicit none"
do i = 1, driver%n_processes
call driver%record(i)%write_interface (unit, feature)
end do
end subroutine prclib_driver_write_interfaces
@ %def prclib_driver_write_interfaces
@
\subsection{Write makefile}
The makefile contains constant parts, parts that depend on the library
name, and parts that depend on the specific processes and their types.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: generate_makefile => prclib_driver_generate_makefile
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_generate_makefile (driver, unit, os_data, verbose, testflag)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in) :: verbose
+ logical, intent(in), optional :: testflag
+ end subroutine prclib_driver_generate_makefile
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_generate_makefile (driver, unit, os_data, verbose, testflag)
+ module subroutine prclib_driver_generate_makefile (driver, unit, os_data, verbose, testflag)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
integer :: i
write (unit, "(A)") "# WHIZARD: Makefile for process library '" &
// char (driver%basename) // "'"
write (unit, "(A)") "# Automatically generated file, do not edit"
write (unit, "(A)") ""
write (unit, "(A)") "# Integrity check (don't modify the following line!)"
write (unit, "(A)") "MD5SUM = '" // driver%md5sum // "'"
write (unit, "(A)") ""
write (unit, "(A)") "# Library name"
write (unit, "(A)") "BASE = " // char (driver%basename)
write (unit, "(A)") ""
write (unit, "(A)") "# Compiler"
write (unit, "(A)") "FC = " // char (os_data%fc)
write (unit, "(A)") "CC = " // char (os_data%cc)
write (unit, "(A)") ""
write (unit, "(A)") "# Included libraries"
write (unit, "(A)") "FCINCL = " // char (os_data%whizard_includes)
write (unit, "(A)") ""
write (unit, "(A)") "# Compiler flags"
write (unit, "(A)") "FCFLAGS = " // char (os_data%fcflags)
write (unit, "(A)") "FCFLAGS_PIC = " // char (os_data%fcflags_pic)
write (unit, "(A)") "CFLAGS = " // char (os_data%cflags)
write (unit, "(A)") "CFLAGS_PIC = " // char (os_data%cflags_pic)
write (unit, "(A)") "LDFLAGS = " // char (os_data%whizard_ldflags) &
// " " // char (os_data%ldflags) // " " // &
char (driver%modellibs_ldflags)
write (unit, "(A)") ""
write (unit, "(A)") "# LaTeX setup"
write (unit, "(A)") "LATEX = " // char (os_data%latex)
write (unit, "(A)") "MPOST = " // char (os_data%mpost)
write (unit, "(A)") "DVIPS = " // char (os_data%dvips)
write (unit, "(A)") "PS2PDF = " // char (os_data%ps2pdf)
write (unit, "(A)") 'TEX_FLAGS = "$$TEXINPUTS:' // &
char(os_data%whizard_texpath) // '"'
write (unit, "(A)") 'MP_FLAGS = "$$MPINPUTS:' // &
char(os_data%whizard_texpath) // '"'
write (unit, "(A)") ""
write (unit, "(A)") "# Libtool"
write (unit, "(A)") "LIBTOOL = " // char (os_data%whizard_libtool)
if (verbose) then
write (unit, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
write (unit, "(A)") "CCOMPILE = $(LIBTOOL) --tag=CC --mode=compile"
write (unit, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
else
write (unit, "(A)") "FCOMPILE = @$(LIBTOOL) --silent --tag=FC --mode=compile"
write (unit, "(A)") "CCOMPILE = @$(LIBTOOL) --silent --tag=CC --mode=compile"
write (unit, "(A)") "LINK = @$(LIBTOOL) --silent --tag=FC --mode=link"
end if
write (unit, "(A)") ""
write (unit, "(A)") "# Compile commands (default)"
write (unit, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c &
&$(FCINCL) $(FCFLAGS) $(FCFLAGS_PIC)"
write (unit, "(A)") "LTCCOMPILE = $(CCOMPILE) $(CC) -c &
&$(CFLAGS) $(CFLAGS_PIC)"
write (unit, "(A)") ""
write (unit, "(A)") "# Default target"
write (unit, "(A)") "all: link diags"
write (unit, "(A)") ""
write (unit, "(A)") "# Matrix-element code files"
do i = 1, size (driver%record)
call driver%record(i)%write_makefile_code (unit, os_data, verbose, testflag)
end do
write (unit, "(A)") ""
write (unit, "(A)") "# Library driver"
write (unit, "(A)") "$(BASE).lo: $(BASE).f90 $(OBJECTS)"
write (unit, "(A)") TAB // "$(LTFCOMPILE) $<"
if (.not. verbose) then
write (unit, "(A)") TAB // '@echo " FC " $@'
end if
write (unit, "(A)") ""
write (unit, "(A)") "# Library"
write (unit, "(A)") "$(BASE).la: $(BASE).lo $(OBJECTS)"
if (.not. verbose) then
write (unit, "(A)") TAB // '@echo " FCLD " $@'
end if
write (unit, "(A)") TAB // "$(LINK) $(FC) -module -rpath /dev/null &
&$(FCFLAGS) $(LDFLAGS) -o $(BASE).la $^"
write (unit, "(A)") ""
write (unit, "(A)") "# Main targets"
write (unit, "(A)") "link: compile $(BASE).la"
write (unit, "(A)") "compile: source $(OBJECTS) $(TEX_OBJECTS) $(BASE).lo"
write (unit, "(A)") "compile_tex: $(TEX_OBJECTS)"
write (unit, "(A)") "source: $(SOURCES) $(BASE).f90 $(TEX_SOURCES)"
write (unit, "(A)") ".PHONY: link diags compile compile_tex source"
write (unit, "(A)") ""
write (unit, "(A)") "# Specific cleanup targets"
do i = 1, size (driver%record)
write (unit, "(A)") "clean-" // char (driver%record(i)%id) // ":"
write (unit, "(A)") ".PHONY: clean-" // char (driver%record(i)%id)
end do
write (unit, "(A)") ""
write (unit, "(A)") "# Generic cleanup targets"
write (unit, "(A)") "clean-library:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(BASE).la"
else
write (unit, "(A)") TAB // '@echo " RM $(BASE).la"'
write (unit, "(A)") TAB // "@rm -f $(BASE).la"
end if
write (unit, "(A)") "clean-objects:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(BASE).lo $(BASE)_driver.mod &
&$(CLEAN_OBJECTS)"
else
write (unit, "(A)") TAB // '@echo " RM $(BASE).lo &
&$(BASE)_driver.mod $(CLEAN_OBJECTS)"'
write (unit, "(A)") TAB // "@rm -f $(BASE).lo $(BASE)_driver.mod &
&$(CLEAN_OBJECTS)"
end if
write (unit, "(A)") "clean-source:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(CLEAN_SOURCES)"
else
write (unit, "(A)") TAB // '@echo " RM $(CLEAN_SOURCES)"'
write (unit, "(A)") TAB // "@rm -f $(CLEAN_SOURCES)"
end if
write (unit, "(A)") "clean-driver:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(BASE).f90"
else
write (unit, "(A)") TAB // '@echo " RM $(BASE).f90"'
write (unit, "(A)") TAB // "@rm -f $(BASE).f90"
end if
write (unit, "(A)") "clean-makefile:"
if (verbose) then
write (unit, "(A)") TAB // "rm -f $(BASE).makefile"
else
write (unit, "(A)") TAB // '@echo " RM $(BASE).makefile"'
write (unit, "(A)") TAB // "@rm -f $(BASE).makefile"
end if
write (unit, "(A)") ".PHONY: clean-library clean-objects &
&clean-source clean-driver clean-makefile"
write (unit, "(A)") ""
write (unit, "(A)") "clean: clean-library clean-objects clean-source"
write (unit, "(A)") "distclean: clean clean-driver clean-makefile"
write (unit, "(A)") ".PHONY: clean distclean"
end subroutine prclib_driver_generate_makefile
@ %def prclib_driver_generate_makefile
@
\subsection{Write driver file}
This procedure writes the process library driver source code to the
specified output unit. The individual routines for writing
source-code procedures are given below.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: generate_driver_code => prclib_driver_generate_code
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_generate_code (driver, unit)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ end subroutine prclib_driver_generate_code
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_generate_code (driver, unit)
+ module subroutine prclib_driver_generate_code (driver, unit)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t) :: prefix
integer :: i
prefix = driver%basename // "_"
write (unit, "(A)") "! WHIZARD matrix-element code interface"
write (unit, "(A)") "!"
write (unit, "(A)") "! Automatically generated file, do not edit"
call driver%write_module (unit, prefix)
call driver%write_lib_md5sum_fun (unit, prefix)
call driver%write_get_n_processes_fun (unit, prefix)
call driver%write_get_process_id_fun (unit, prefix)
call driver%write_get_model_name_fun (unit, prefix)
call driver%write_get_md5sum_fun (unit, prefix)
call driver%write_string_to_array_fun (unit, prefix)
call driver%write_get_openmp_status_fun (unit, prefix)
call driver%write_get_int_fun (unit, prefix, var_str ("n_in"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_out"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_flv"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_hel"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_col"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_cin"))
call driver%write_get_int_fun (unit, prefix, var_str ("n_cf"))
call driver%write_set_int_sub (unit, prefix, var_str ("flv_state"))
call driver%write_set_int_sub (unit, prefix, var_str ("hel_state"))
call driver%write_set_col_state_sub (unit, prefix)
call driver%write_set_color_factors_sub (unit, prefix)
call driver%write_get_fptr_sub (unit, prefix)
do i = 1, driver%n_processes
call driver%record(i)%write_wrappers (unit)
end do
end subroutine prclib_driver_generate_code
@ %def prclib_driver_generate_code
@ The driver module is used and required \emph{only} if we intend to
link the library statically. Then, it provides the (static) driver
type as a concrete implementation of the abstract library driver.
This type contains the internal dispatcher for assigning the library
procedures to their appropriate procedure pointers. In the dynamical
case, the assignment is done via the base-type dispatcher which invokes
the DL mechanism.
However, compiling this together with the rest in any case should not
do any harm.
<<Prclib interfaces: prclib driver: TBP>>=
procedure, nopass :: write_module => prclib_driver_write_module
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_write_module (unit, prefix)
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine prclib_driver_write_module
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_write_module (unit, prefix)
+ module subroutine prclib_driver_write_module (unit, prefix)
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(A)") ""
write (unit, "(A)") "! Module: define library driver as an extension &
&of the abstract driver type."
write (unit, "(A)") "! This is used _only_ by the library dispatcher &
&of a static executable."
write (unit, "(A)") "! For a dynamical library, the stand-alone proce&
&dures are linked via libdl."
write (unit, "(A)") ""
write (unit, "(A)") "module " &
// char (prefix) // "driver"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " use iso_varying_string, string_t => varying_string"
write (unit, "(A)") " use diagnostics"
write (unit, "(A)") " use prclib_interfaces"
write (unit, "(A)") ""
write (unit, "(A)") " implicit none"
write (unit, "(A)") ""
write (unit, "(A)") " type, extends (prclib_driver_t) :: " &
// char (prefix) // "driver_t"
write (unit, "(A)") " contains"
write (unit, "(A)") " procedure :: get_c_funptr => " &
// char (prefix) // "driver_get_c_funptr"
write (unit, "(A)") " end type " &
// char (prefix) // "driver_t"
write (unit, "(A)") ""
write (unit, "(A)") "contains"
write (unit, "(A)") ""
write (unit, "(A)") " function " &
// char (prefix) // "driver_get_c_funptr (driver, feature) result &
&(c_fptr)"
write (unit, "(A)") " class(" &
// char (prefix) // "driver_t), intent(inout) :: driver"
write (unit, "(A)") " type(string_t), intent(in) :: feature"
write (unit, "(A)") " type(c_funptr) :: c_fptr"
call write_decl ("get_n_processes", "get_n_processes")
call write_decl ("get_stringptr", "get_process_id_ptr")
call write_decl ("get_stringptr", "get_model_name_ptr")
call write_decl ("get_stringptr", "get_md5sum_ptr")
call write_decl ("get_log", "get_openmp_status")
call write_decl ("get_int", "get_n_in")
call write_decl ("get_int", "get_n_out")
call write_decl ("get_int", "get_n_flv")
call write_decl ("get_int", "get_n_hel")
call write_decl ("get_int", "get_n_col")
call write_decl ("get_int", "get_n_cin")
call write_decl ("get_int", "get_n_cf")
call write_decl ("set_int_tab1", "set_flv_state_ptr")
call write_decl ("set_int_tab1", "set_hel_state_ptr")
call write_decl ("set_col_state", "set_col_state_ptr")
call write_decl ("set_color_factors", "set_color_factors_ptr")
call write_decl ("get_fptr", "get_fptr")
write (unit, "(A)") " select case (char (feature))"
call write_case ("get_n_processes")
call write_case ("get_process_id_ptr")
call write_case ("get_model_name_ptr")
call write_case ("get_md5sum_ptr")
call write_case ("get_openmp_status")
call write_case ("get_n_in")
call write_case ("get_n_out")
call write_case ("get_n_flv")
call write_case ("get_n_hel")
call write_case ("get_n_col")
call write_case ("get_n_cin")
call write_case ("get_n_cf")
call write_case ("set_flv_state_ptr")
call write_case ("set_hel_state_ptr")
call write_case ("set_col_state_ptr")
call write_case ("set_color_factors_ptr")
call write_case ("get_fptr")
write (unit, "(A)") " case default"
write (unit, "(A)") " call msg_bug ('prclib2 driver setup: unknown &
&function name')"
write (unit, "(A)") " end select"
write (unit, "(A)") " end function " &
// char (prefix) // "driver_get_c_funptr"
write (unit, "(A)") ""
write (unit, "(A)") "end module " &
// char (prefix) // "driver"
write (unit, "(A)") ""
write (unit, "(A)") "! Stand-alone external procedures: used for both &
&static and dynamic linkage"
contains
subroutine write_decl (template, feature)
character(*), intent(in) :: template, feature
write (unit, "(A)") " procedure(prc_" // template // ") &"
write (unit, "(A)") " :: " &
// char (prefix) // feature
end subroutine write_decl
subroutine write_case (feature)
character(*), intent(in) :: feature
write (unit, "(A)") " case ('" // feature // "')"
write (unit, "(A)") " c_fptr = c_funloc (" &
// char (prefix) // feature // ")"
end subroutine write_case
end subroutine prclib_driver_write_module
@ %def prclib_driver_write_module
@ This function provides the overall library MD5sum. The function is for
internal use (therefore not bind(C)), the external interface is via the
[[get_md5sum_ptr]] procedure with index 0.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_lib_md5sum_fun => prclib_driver_write_lib_md5sum_fun
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_write_lib_md5sum_fun (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine prclib_driver_write_lib_md5sum_fun
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_write_lib_md5sum_fun (driver, unit, prefix)
+ module subroutine prclib_driver_write_lib_md5sum_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(A)") ""
write (unit, "(A)") "! The MD5 sum of the library"
write (unit, "(A)") "function " // char (prefix) &
// "md5sum () result (md5sum)"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " character(32) :: md5sum"
write (unit, "(A)") " md5sum = '" // driver%md5sum // "'"
write (unit, "(A)") "end function " // char (prefix) // "md5sum"
end subroutine prclib_driver_write_lib_md5sum_fun
@ %def prclib_driver_write_lib_md5sum_fun
@
\subsection{Interface bodies for informational functions}
These interfaces implement the communication between WHIZARD (the main
program) and the process-library driver. The procedures are all
BIND(C), so they can safely be exposed by the library and handled by
the [[dlopen]] mechanism, which apparently understands only C calling
conventions.
In the sections below, for each procedure, we provide both the
interface itself and a procedure that writes the correponding
procedure as source code to the process library driver.
\subsubsection{Process count}
Return the number of processes contained in the library.
<<Prclib interfaces: public>>=
public :: prc_get_n_processes
<<Prclib interfaces: interfaces>>=
abstract interface
function prc_get_n_processes () result (n) bind(C)
import
integer(c_int) :: n
end function prc_get_n_processes
end interface
@ %def prc_get_n_processes
@ Here is the code.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_n_processes_fun
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_get_n_processes_fun (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_get_n_processes_fun
<<Prclib interfaces: procedures>>=
- subroutine write_get_n_processes_fun (driver, unit, prefix)
+ module subroutine write_get_n_processes_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(A)") ""
write (unit, "(A)") "! Return the number of processes in this library"
write (unit, "(A)") "function " // char (prefix) &
// "get_n_processes () result (n) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " integer(c_int) :: n"
write (unit, "(A,I0)") " n = ", driver%n_processes
write (unit, "(A)") "end function " // char (prefix) &
// "get_n_processes"
end subroutine write_get_n_processes_fun
@ %def write_get_n_processes_fun
@
\subsubsection{Informational string functions}
These functions return constant information about the matrix-element
code.
The following procedures have to return strings. With the BIND(C)
constraint, we choose to return the C pointer to a string, and its
length, so the procedures implement this interface. They are actually
subroutines.
<<Prclib interfaces: public>>=
public :: prc_get_stringptr
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_get_stringptr (i, cptr, len) bind(C)
import
integer(c_int), intent(in) :: i
type(c_ptr), intent(out) :: cptr
integer(c_int), intent(out) :: len
end subroutine prc_get_stringptr
end interface
@ %def prc_get_stringptr
@ To hide this complication, we introduce a subroutine that converts the
returned C pointer to a [[string_t]] object. As a side effect, we
deallocate the original after conversion -- otherwise, we might have a
memory leak.
For the conversion, we first pointer-convert the C pointer to a
Fortran character array pointer, length 1 and size [[len]]. Using
argument association and an internal subroutine, we convert this to a
character array with length [[len]] and size 1. Using ordinary
assignment, we finally convert this to [[string_t]].
The function takes the pointer-returning function as an argument. The
index [[i]] identifies the process in the library.
<<Prclib interfaces: procedures>>=
subroutine get_string_via_cptr (string, i, get_stringptr)
type(string_t), intent(out) :: string
integer, intent(in) :: i
procedure(prc_get_stringptr) :: get_stringptr
type(c_ptr) :: cptr
integer(c_int) :: pid, len
character(kind=c_char), dimension(:), pointer :: c_array
pid = i
call get_stringptr (pid, cptr, len)
if (c_associated (cptr)) then
call c_f_pointer (cptr, c_array, shape = [len])
call set_string (c_array)
call get_stringptr (0_c_int, cptr, len)
else
string = ""
end if
contains
subroutine set_string (buffer)
character(len, kind=c_char), dimension(1), intent(in) :: buffer
string = buffer(1)
end subroutine set_string
end subroutine get_string_via_cptr
@ %def get_string_via_cptr
@ Since the module procedures return Fortran strings, we have to
convert them. This is the necessary auxiliary routine. The routine
is not BIND(C), it is not accessed from outside.
<<Prclib interfaces: prclib driver: TBP>>=
procedure, nopass :: write_string_to_array_fun
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_string_to_array_fun (unit, prefix)
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_string_to_array_fun
<<Prclib interfaces: procedures>>=
- subroutine write_string_to_array_fun (unit, prefix)
+ module subroutine write_string_to_array_fun (unit, prefix)
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(A)") ""
write (unit, "(A)") "! Auxiliary: convert character string &
&to array pointer"
write (unit, "(A)") "subroutine " // char (prefix) &
// "string_to_array (string, a)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " character(*), intent(in) :: string"
write (unit, "(A)") " character(kind=c_char), dimension(:), &
&allocatable, intent(out) :: a"
write (unit, "(A)") " integer :: i"
write (unit, "(A)") " allocate (a (len (string)))"
write (unit, "(A)") " do i = 1, size (a)"
write (unit, "(A)") " a(i) = string(i:i)"
write (unit, "(A)") " end do"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "string_to_array"
end subroutine write_string_to_array_fun
@ %def write_string_to_array_fun
@ The above routine is called by other functions. It is not in a
module, so they need its interface explicitly.
<<Prclib interfaces: procedures>>=
subroutine write_string_to_array_interface (unit, prefix)
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
write (unit, "(2x,A)") "interface"
write (unit, "(2x,A)") " subroutine " // char (prefix) &
// "string_to_array (string, a)"
write (unit, "(2x,A)") " use iso_c_binding"
write (unit, "(2x,A)") " implicit none"
write (unit, "(2x,A)") " character(*), intent(in) :: string"
write (unit, "(2x,A)") " character(kind=c_char), dimension(:), &
&allocatable, intent(out) :: a"
write (unit, "(2x,A)") " end subroutine " // char (prefix) &
// "string_to_array"
write (unit, "(2x,A)") "end interface"
end subroutine write_string_to_array_interface
@ %def write_string_to_array_interface
@
Here are the info functions which return strings, implementing the interface
[[prc_get_stringptr]].
Return the process ID for each process.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_process_id_fun
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_get_process_id_fun (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_get_process_id_fun
<<Prclib interfaces: procedures>>=
- subroutine write_get_process_id_fun (driver, unit, prefix)
+ module subroutine write_get_process_id_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
write (unit, "(A)") ""
write (unit, "(A)") "! Return the process ID of process #i &
&(as a C pointer to a character array)"
write (unit, "(A)") "subroutine " // char (prefix) &
// "get_process_id_ptr (i, cptr, len) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
write (unit, "(A)") " integer(c_int), intent(out) :: len"
write (unit, "(A)") " character(kind=c_char), dimension(:), &
&allocatable, target, save :: a"
call write_string_to_array_interface (unit, prefix)
write (unit, "(A)") " select case (i)"
write (unit, "(A)") " case (0); if (allocated (a)) deallocate (a)"
do i = 1, driver%n_processes
write (unit, "(A,I0,9A)") " case (", i, "); ", &
"call ", char (prefix), "string_to_array ('", &
char (driver%record(i)%id), "', a)"
end do
write (unit, "(A)") " end select"
write (unit, "(A)") " if (allocated (a)) then"
write (unit, "(A)") " cptr = c_loc (a)"
write (unit, "(A)") " len = size (a)"
write (unit, "(A)") " else"
write (unit, "(A)") " cptr = c_null_ptr"
write (unit, "(A)") " len = 0"
write (unit, "(A)") " end if"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "get_process_id_ptr"
end subroutine write_get_process_id_fun
@ %def write_get_process_id_fun
@ Return the model name, given explicitly.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_model_name_fun
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_get_model_name_fun (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_get_model_name_fun
<<Prclib interfaces: procedures>>=
- subroutine write_get_model_name_fun (driver, unit, prefix)
+ module subroutine write_get_model_name_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
write (unit, "(A)") ""
write (unit, "(A)") "! Return the model name for process #i &
&(as a C pointer to a character array)"
write (unit, "(A)") "subroutine " // char (prefix) &
// "get_model_name_ptr (i, cptr, len) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
write (unit, "(A)") " integer(c_int), intent(out) :: len"
write (unit, "(A)") " character(kind=c_char), dimension(:), &
&allocatable, target, save :: a"
call write_string_to_array_interface (unit, prefix)
write (unit, "(A)") " select case (i)"
write (unit, "(A)") " case (0); if (allocated (a)) deallocate (a)"
do i = 1, driver%n_processes
write (unit, "(A,I0,9A)") " case (", i, "); ", &
"call ", char (prefix), "string_to_array ('" , &
char (driver%record(i)%model_name), &
"', a)"
end do
write (unit, "(A)") " end select"
write (unit, "(A)") " if (allocated (a)) then"
write (unit, "(A)") " cptr = c_loc (a)"
write (unit, "(A)") " len = size (a)"
write (unit, "(A)") " else"
write (unit, "(A)") " cptr = c_null_ptr"
write (unit, "(A)") " len = 0"
write (unit, "(A)") " end if"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "get_model_name_ptr"
end subroutine write_get_model_name_fun
@ %def write_get_model_name_fun
@ Call the MD5 sum function for the process. The function calls the
corresponding function of the matrix-element code, and it returns the
C address of a character array with length 32.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_md5sum_fun
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_get_md5sum_fun (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_get_md5sum_fun
<<Prclib interfaces: procedures>>=
- subroutine write_get_md5sum_fun (driver, unit, prefix)
+ module subroutine write_get_md5sum_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
write (unit, "(A)") ""
write (unit, "(A)") "! Return the MD5 sum for the process configuration &
&(as a C pointer to a character array)"
write (unit, "(A)") "subroutine " // char (prefix) &
// "get_md5sum_ptr (i, cptr, len) bind(C)"
write (unit, "(A)") " use iso_c_binding"
call driver%write_interfaces (unit, var_str ("md5sum"))
write (unit, "(A)") " interface"
write (unit, "(A)") " function " // char (prefix) &
// "md5sum () result (md5sum)"
write (unit, "(A)") " character(32) :: md5sum"
write (unit, "(A)") " end function " // char (prefix) // "md5sum"
write (unit, "(A)") " end interface"
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
write (unit, "(A)") " integer(c_int), intent(out) :: len"
write (unit, "(A)") " character(kind=c_char), dimension(32), &
&target, save :: md5sum"
write (unit, "(A)") " select case (i)"
write (unit, "(A)") " case (0)"
write (unit, "(A)") " call copy (" // char (prefix) // "md5sum ())"
write (unit, "(A)") " cptr = c_loc (md5sum)"
do i = 1, driver%n_processes
write (unit, "(A,I0,A)") " case (", i, ")"
call driver%record(i)%write_md5sum_call (unit)
end do
write (unit, "(A)") " case default"
write (unit, "(A)") " cptr = c_null_ptr"
write (unit, "(A)") " end select"
write (unit, "(A)") " len = 32"
write (unit, "(A)") "contains"
write (unit, "(A)") " subroutine copy (md5sum_tmp)"
write (unit, "(A)") " character, dimension(32), intent(in) :: &
&md5sum_tmp"
write (unit, "(A)") " md5sum = md5sum_tmp"
write (unit, "(A)") " end subroutine copy"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "get_md5sum_ptr"
end subroutine write_get_md5sum_fun
@ %def write_get_md5sum_fun
@ The actual call depends on the type of matrix element.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_md5sum_call => prclib_driver_record_write_md5sum_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_md5sum_call (record, unit)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ end subroutine prclib_driver_record_write_md5sum_call
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_md5sum_call (record, unit)
+ module subroutine prclib_driver_record_write_md5sum_call (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
call record%writer%write_md5sum_call (unit, record%id)
end subroutine prclib_driver_record_write_md5sum_call
@ %def prclib_driver_record_write_md5sum_call
@ The interface goes into the writer base type:
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code), deferred :: write_md5sum_call
@ %def write_md5sum_call
@ In the Fortran module case, we take a detour. The string returned
by the Fortran function is copied into a fixed-size array. The copy
routine is an internal subroutine of [[get_md5sum_ptr]]. We
return the C address of the target array.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_md5sum_call => prc_writer_f_module_write_md5sum_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_f_module_write_md5sum_call (writer, unit, id)
+ class(prc_writer_f_module_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id
+ end subroutine prc_writer_f_module_write_md5sum_call
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_f_module_write_md5sum_call (writer, unit, id)
+ module subroutine prc_writer_f_module_write_md5sum_call (writer, unit, id)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "call copy (", &
char (writer%get_c_procname (id, var_str ("md5sum"))), " ())"
write (unit, "(5x,9A)") "cptr = c_loc (md5sum)"
end subroutine prc_writer_f_module_write_md5sum_call
@ %def prc_writer_f_module_write_md5sum_call
@ In the C library case, the library function returns a C pointer,
which we can just copy.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_md5sum_call => prc_writer_c_lib_write_md5sum_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_c_lib_write_md5sum_call (writer, unit, id)
+ class(prc_writer_c_lib_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id
+ end subroutine prc_writer_c_lib_write_md5sum_call
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_c_lib_write_md5sum_call (writer, unit, id)
+ module subroutine prc_writer_c_lib_write_md5sum_call (writer, unit, id)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") &
"cptr = ", &
char (writer%get_c_procname (id, var_str ("get_md5sum"))), " ()"
end subroutine prc_writer_c_lib_write_md5sum_call
@ %def prc_writer_c_lib_write_md5sum_call
@
\subsubsection{Actual references to the info functions}
The string-valued info functions return C character arrays. For the
API of the library driver, we provide convenience functions which
(re)convert those arrays into [[string_t]] objects.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: get_process_id => prclib_driver_get_process_id
procedure :: get_model_name => prclib_driver_get_model_name
procedure :: get_md5sum => prclib_driver_get_md5sum
+<<Prclib interfaces: sub interfaces>>=
+ module function prclib_driver_get_process_id (driver, i) result (string)
+ type(string_t) :: string
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ end function prclib_driver_get_process_id
+ module function prclib_driver_get_model_name (driver, i) result (string)
+ type(string_t) :: string
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ end function prclib_driver_get_model_name
+ module function prclib_driver_get_md5sum (driver, i) result (string)
+ type(string_t) :: string
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ end function prclib_driver_get_md5sum
<<Prclib interfaces: procedures>>=
- function prclib_driver_get_process_id (driver, i) result (string)
+ module function prclib_driver_get_process_id (driver, i) result (string)
type(string_t) :: string
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
call get_string_via_cptr (string, i, driver%get_process_id_ptr)
end function prclib_driver_get_process_id
- function prclib_driver_get_model_name (driver, i) result (string)
+ module function prclib_driver_get_model_name (driver, i) result (string)
type(string_t) :: string
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
call get_string_via_cptr (string, i, driver%get_model_name_ptr)
end function prclib_driver_get_model_name
- function prclib_driver_get_md5sum (driver, i) result (string)
+ module function prclib_driver_get_md5sum (driver, i) result (string)
type(string_t) :: string
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
call get_string_via_cptr (string, i, driver%get_md5sum_ptr)
end function prclib_driver_get_md5sum
@ %def prclib_driver_get_process_id
@ %def prclib_driver_get_model_name
@ %def prclib_driver_get_md5sum
@
\subsubsection{Informational logical functions}
When returning a logical value, we use the C boolean type, which
may differ from Fortran.
<<Prclib interfaces: public>>=
public :: prc_get_log
<<Prclib interfaces: interfaces>>=
abstract interface
function prc_get_log (pid) result (l) bind(C)
import
integer(c_int), intent(in) :: pid
logical(c_bool) :: l
end function prc_get_log
end interface
@ %def prc_get_log
@ Return a logical flag which tells whether OpenMP is supported for a
specific process code.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_openmp_status_fun
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_get_openmp_status_fun (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_get_openmp_status_fun
<<Prclib interfaces: procedures>>=
- subroutine write_get_openmp_status_fun (driver, unit, prefix)
+ module subroutine write_get_openmp_status_fun (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
write (unit, "(A)") ""
write (unit, "(A)") "! Return the OpenMP support status"
write (unit, "(A)") "function " // char (prefix) &
// "get_openmp_status (i) result (openmp_status) bind(C)"
write (unit, "(A)") " use iso_c_binding"
call driver%write_interfaces (unit, var_str ("openmp_supported"))
write (unit, "(A)") " integer(c_int), intent(in) :: i"
write (unit, "(A)") " logical(c_bool) :: openmp_status"
write (unit, "(A)") " select case (i)"
do i = 1, driver%n_processes
write (unit, "(A,I0,9A)") " case (", i, "); ", &
"openmp_status = ", &
char (driver%record(i)%get_c_procname &
(var_str ("openmp_supported"))), " ()"
end do
write (unit, "(A)") " end select"
write (unit, "(A)") "end function " // char (prefix) &
// "get_openmp_status"
end subroutine write_get_openmp_status_fun
@ %def write_get_openmp_status_fun
@
\subsubsection{Informational integer functions}
Various process metadata are integer values. We can use a single
interface for all of them.
<<Prclib interfaces: public>>=
public :: prc_get_int
<<Prclib interfaces: interfaces>>=
abstract interface
function prc_get_int (pid) result (n) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int) :: n
end function prc_get_int
end interface
@ %def prc_get_int
@ This function returns any data of type integer, for each process.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_int_fun
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_get_int_fun (driver, unit, prefix, feature)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ type(string_t), intent(in) :: feature
+ end subroutine write_get_int_fun
<<Prclib interfaces: procedures>>=
- subroutine write_get_int_fun (driver, unit, prefix, feature)
+ module subroutine write_get_int_fun (driver, unit, prefix, feature)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
type(string_t), intent(in) :: feature
integer :: i
write (unit, "(A)") ""
write (unit, "(9A)") "! Return the value of ", char (feature)
write (unit, "(9A)") "function ", char (prefix), &
"get_", char (feature), " (pid)", &
" result (", char (feature), ") bind(C)"
write (unit, "(9A)") " use iso_c_binding"
call driver%write_interfaces (unit, feature)
write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
write (unit, "(9A)") " integer(c_int) :: ", char (feature)
write (unit, "(9A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(2x,A,I0,9A)") "case (", i, "); ", &
char (feature), " = ", &
char (driver%record(i)%get_c_procname (feature)), &
" ()"
end do
write (unit, "(9A)") " end select"
write (unit, "(9A)") "end function ", char (prefix), &
"get_", char (feature)
end subroutine write_get_int_fun
@ %def write_get_int_fun
@ Write a [[case]] line that assigns the value of the external function
to the current return value.
<<Prclib interfaces: procedures>>=
subroutine write_case_int_fun (record, unit, i, feature)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
integer, intent(in) :: i
type(string_t), intent(in) :: feature
write (unit, "(5x,A,I0,9A)") "case (", i, "); ", &
char (feature), " = ", char (record%get_c_procname (feature))
end subroutine write_case_int_fun
@ %def write_case_int_fun
@
\subsubsection{Flavor and helicity tables}
Transferring tables is more complicated. First, a two-dimensional array.
<<Prclib interfaces: public>>=
public :: prc_set_int_tab1
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_set_int_tab1 (pid, tab, shape) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int), dimension(*), intent(out) :: tab
integer(c_int), dimension(2), intent(in) :: shape
end subroutine prc_set_int_tab1
end interface
@ %def prc_set_int_tab1
@ This subroutine returns a table of integers.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_set_int_sub
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_set_int_sub (driver, unit, prefix, feature)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ type(string_t), intent(in) :: feature
+ end subroutine write_set_int_sub
<<Prclib interfaces: procedures>>=
- subroutine write_set_int_sub (driver, unit, prefix, feature)
+ module subroutine write_set_int_sub (driver, unit, prefix, feature)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
type(string_t), intent(in) :: feature
integer :: i
write (unit, "(A)") ""
write (unit, "(9A)") "! Set table: ", char (feature)
write (unit, "(9A)") "subroutine ", char (prefix), &
"set_", char (feature), "_ptr (pid, ", char (feature), &
", shape) bind(C)"
write (unit, "(9A)") " use iso_c_binding"
call driver%write_interfaces (unit, feature)
write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
write (unit, "(9A)") " integer(c_int), dimension(*), intent(out) :: ", &
char (feature)
write (unit, "(9A)") " integer(c_int), dimension(2), intent(in) :: shape"
write (unit, "(9A)") " integer, dimension(:,:), allocatable :: ", &
char (feature), "_tmp"
write (unit, "(9A)") " integer :: i, j"
write (unit, "(9A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(2x,A,I0,A)") "case (", i, ")"
call driver%record(i)%write_int_sub_call (unit, feature)
end do
write (unit, "(9A)") " end select"
write (unit, "(9A)") "end subroutine ", char (prefix), &
"set_", char (feature), "_ptr"
end subroutine write_set_int_sub
@ %def write_set_int_sub
@ The actual call depends on the type of matrix element.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_int_sub_call => prclib_driver_record_write_int_sub_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_int_sub_call (record, unit, feature)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: feature
+ end subroutine prclib_driver_record_write_int_sub_call
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_int_sub_call (record, unit, feature)
+ module subroutine prclib_driver_record_write_int_sub_call (record, unit, feature)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
type(string_t), intent(in) :: feature
call record%writer%write_int_sub_call (unit, record%id, feature)
end subroutine prclib_driver_record_write_int_sub_call
@ %def prclib_driver_record_write_int_sub_call
@ The interface goes into the writer base type:
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_feature_code), deferred :: write_int_sub_call
@ %def write_int_sub_call
@ In the Fortran module case, we need an extra copy in the
(academical) situation where default integer and [[c_int]] differ.
Otherwise, we just associate a Fortran array with the C pointer and
let the matrix-element subroutine fill the array.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_int_sub_call => prc_writer_f_module_write_int_sub_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_f_module_write_int_sub_call (writer, unit, id, feature)
+ class(prc_writer_f_module_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id, feature
+ end subroutine prc_writer_f_module_write_int_sub_call
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_f_module_write_int_sub_call (writer, unit, id, feature)
+ module subroutine prc_writer_f_module_write_int_sub_call (writer, unit, id, feature)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(5x,9A)") "allocate (", char (feature), "_tmp ", &
"(shape(1), shape(2)))"
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, feature)), &
" (", char (feature), "_tmp)"
write (unit, "(5x,9A)") "forall (i=1:shape(1), j=1:shape(2)) "
write (unit, "(8x,9A)") char (feature), "(i + shape(1)*(j-1)) = ", &
char (feature), "_tmp", "(i,j)"
write (unit, "(5x,9A)") "end forall"
end subroutine prc_writer_f_module_write_int_sub_call
@ %def prc_writer_f_module_write_int_sub_call
@ In the C library case, we just transfer the C pointer to the library
function.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_int_sub_call => prc_writer_c_lib_write_int_sub_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_c_lib_write_int_sub_call (writer, unit, id, feature)
+ class(prc_writer_c_lib_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id, feature
+ end subroutine prc_writer_c_lib_write_int_sub_call
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_c_lib_write_int_sub_call (writer, unit, id, feature)
+ module subroutine prc_writer_c_lib_write_int_sub_call (writer, unit, id, feature)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, feature)), " (", char (feature), ")"
end subroutine prc_writer_c_lib_write_int_sub_call
@ %def prc_writer_c_lib_write_int_sub_call
@
\subsubsection{Color state table}
The color-state specification needs a table of integers (one array per
color flow) and a corresponding array of color-ghost flags.
<<Prclib interfaces: public>>=
public :: prc_set_col_state
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_set_col_state (pid, col_state, ghost_flag, shape) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int), dimension(*), intent(out) :: col_state
logical(c_bool), dimension(*), intent(out) :: ghost_flag
integer(c_int), dimension(3), intent(in) :: shape
end subroutine prc_set_col_state
end interface
@ %def prc_set_int_tab2
@
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_set_col_state_sub
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_set_col_state_sub (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_set_col_state_sub
<<Prclib interfaces: procedures>>=
- subroutine write_set_col_state_sub (driver, unit, prefix)
+ module subroutine write_set_col_state_sub (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
type(string_t) :: feature
feature = "col_state"
write (unit, "(A)") ""
write (unit, "(9A)") "! Set tables: col_state, ghost_flag"
write (unit, "(9A)") "subroutine ", char (prefix), &
"set_col_state_ptr (pid, col_state, ghost_flag, shape) bind(C)"
write (unit, "(9A)") " use iso_c_binding"
call driver%write_interfaces (unit, feature)
write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
write (unit, "(9A)") &
" integer(c_int), dimension(*), intent(out) :: col_state"
write (unit, "(9A)") &
" logical(c_bool), dimension(*), intent(out) :: ghost_flag"
write (unit, "(9A)") &
" integer(c_int), dimension(3), intent(in) :: shape"
write (unit, "(9A)") &
" integer, dimension(:,:,:), allocatable :: col_state_tmp"
write (unit, "(9A)") &
" logical, dimension(:,:), allocatable :: ghost_flag_tmp"
write (unit, "(9A)") " integer :: i, j, k"
write (unit, "(A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(A,I0,A)") " case (", i, ")"
call driver%record(i)%write_col_state_call (unit)
end do
write (unit, "(A)") " end select"
write (unit, "(9A)") "end subroutine ", char (prefix), &
"set_col_state_ptr"
end subroutine write_set_col_state_sub
@ %def write_set_col_state_sub
@ The actual call depends on the type of matrix element.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_col_state_call => prclib_driver_record_write_col_state_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_col_state_call (record, unit)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ end subroutine prclib_driver_record_write_col_state_call
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_col_state_call (record, unit)
+ module subroutine prclib_driver_record_write_col_state_call (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
call record%writer%write_col_state_call (unit, record%id)
end subroutine prclib_driver_record_write_col_state_call
@ %def prclib_driver_record_write_col_state_call
@ The interface goes into the writer base type:
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code), deferred :: write_col_state_call
@ %def write_col_state_call
@ In the Fortran module case, we need an extra copy in the
(academical) situation where default integer and [[c_int]] differ.
Otherwise, we just associate a Fortran array with the C pointer and
let the matrix-element subroutine fill the array.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_col_state_call => prc_writer_f_module_write_col_state_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_f_module_write_col_state_call (writer, unit, id)
+ class(prc_writer_f_module_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id
+ end subroutine prc_writer_f_module_write_col_state_call
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_f_module_write_col_state_call (writer, unit, id)
+ module subroutine prc_writer_f_module_write_col_state_call (writer, unit, id)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(9A)") " allocate (col_state_tmp ", &
"(shape(1), shape(2), shape(3)))"
write (unit, "(5x,9A)") "allocate (ghost_flag_tmp ", &
"(shape(2), shape(3)))"
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, var_str ("col_state"))), &
" (col_state_tmp, ghost_flag_tmp)"
write (unit, "(5x,9A)") "forall (i = 1:shape(2), j = 1:shape(3))"
write (unit, "(8x,9A)") "forall (k = 1:shape(1))"
write (unit, "(11x,9A)") &
"col_state(k + shape(1) * (i + shape(2)*(j-1) - 1)) ", &
"= col_state_tmp(k,i,j)"
write (unit, "(8x,9A)") "end forall"
write (unit, "(8x,9A)") &
"ghost_flag(i + shape(2)*(j-1)) = ghost_flag_tmp(i,j)"
write (unit, "(5x,9A)") "end forall"
end subroutine prc_writer_f_module_write_col_state_call
@ %def prc_writer_f_module_write_col_state_call
@ In the C library case, we just transfer the C pointer to the library
function.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_col_state_call => prc_writer_c_lib_write_col_state_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_c_lib_write_col_state_call (writer, unit, id)
+ class(prc_writer_c_lib_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id
+ end subroutine prc_writer_c_lib_write_col_state_call
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_c_lib_write_col_state_call (writer, unit, id)
+ module subroutine prc_writer_c_lib_write_col_state_call (writer, unit, id)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, var_str ("col_state"))), &
" (col_state, ghost_flag)"
end subroutine prc_writer_c_lib_write_col_state_call
@ %def prc_writer_c_lib_write_col_state_call
@
\subsubsection{Color factors}
For the color-factor information, we return two integer arrays and a
complex array.
<<Prclib interfaces: public>>=
public :: prc_set_color_factors
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_set_color_factors &
(pid, cf_index1, cf_index2, color_factors, shape) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int), dimension(*), intent(out) :: cf_index1, cf_index2
complex(c_default_complex), dimension(*), intent(out) :: color_factors
integer(c_int), dimension(1), intent(in) :: shape
end subroutine prc_set_color_factors
end interface
@ %def prc_set_color_factors
@ This subroutine returns the color-flavor factor table.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_set_color_factors_sub
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_set_color_factors_sub (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_set_color_factors_sub
<<Prclib interfaces: procedures>>=
- subroutine write_set_color_factors_sub (driver, unit, prefix)
+ module subroutine write_set_color_factors_sub (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i
type(string_t) :: feature
feature = "color_factors"
write (unit, "(A)") ""
write (unit, "(A)") "! Set tables: color factors"
write (unit, "(9A)") "subroutine ", char (prefix), &
"set_color_factors_ptr (pid, cf_index1, cf_index2, color_factors, ", &
"shape) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " use kinds"
write (unit, "(A)") " use omega_color"
call driver%write_interfaces (unit, feature)
write (unit, "(A)") " integer(c_int), intent(in) :: pid"
write (unit, "(A)") " integer(c_int), dimension(1), intent(in) :: shape"
write (unit, "(A)") " integer(c_int), dimension(*), intent(out) :: &
&cf_index1, cf_index2"
write (unit, "(A)") " complex(c_default_complex), dimension(*), &
&intent(out) :: color_factors"
write (unit, "(A)") " type(omega_color_factor), dimension(:), &
&allocatable :: cf"
write (unit, "(A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(2x,A,I0,A)") "case (", i, ")"
call driver%record(i)%write_color_factors_call (unit)
end do
write (unit, "(A)") " end select"
write (unit, "(A)") "end subroutine " // char (prefix) &
// "set_color_factors_ptr"
end subroutine write_set_color_factors_sub
@ %def write_set_color_factors_sub
@ The actual call depends on the type of matrix element.
<<Prclib interfaces: prclib driver record: TBP>>=
procedure :: write_color_factors_call => prclib_driver_record_write_color_factors_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_record_write_color_factors_call (record, unit)
+ class(prclib_driver_record_t), intent(in) :: record
+ integer, intent(in) :: unit
+ end subroutine prclib_driver_record_write_color_factors_call
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_record_write_color_factors_call (record, unit)
+ module subroutine prclib_driver_record_write_color_factors_call (record, unit)
class(prclib_driver_record_t), intent(in) :: record
integer, intent(in) :: unit
call record%writer%write_color_factors_call (unit, record%id)
end subroutine prclib_driver_record_write_color_factors_call
@ %def prclib_driver_record_write_color_factors_call
@ The interface goes into the writer base type:
<<Prclib interfaces: prc writer: TBP>>=
procedure(write_code), deferred :: write_color_factors_call
@ %def write_color_factors_call
@ In the Fortran module case, the matrix-element procedure fills an
array of [[omega_color_factor]] elements. We distribute this array
among two integer arrays and one complex-valued array, for which we
have the C pointers.
<<Prclib interfaces: prc writer f module: TBP>>=
procedure :: write_color_factors_call => prc_writer_f_module_write_color_factors_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_f_module_write_color_factors_call (writer, unit, id)
+ class(prc_writer_f_module_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id
+ end subroutine prc_writer_f_module_write_color_factors_call
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_f_module_write_color_factors_call (writer, unit, id)
+ module subroutine prc_writer_f_module_write_color_factors_call (writer, unit, id)
class(prc_writer_f_module_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,A)") "allocate (cf (shape(1)))"
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, var_str ("color_factors"))), " (cf)"
write (unit, "(5x,9A)") "cf_index1(1:shape(1)) = cf%i1"
write (unit, "(5x,9A)") "cf_index2(1:shape(1)) = cf%i2"
write (unit, "(5x,9A)") "color_factors(1:shape(1)) = cf%factor"
end subroutine prc_writer_f_module_write_color_factors_call
@ %def prc_writer_f_module_write_color_factors_call
@ In the C library case, we just transfer the C pointers to the library
function. There are three arrays.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_color_factors_call => &
prc_writer_c_lib_write_color_factors_call
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_c_lib_write_color_factors_call (writer, unit, id)
+ class(prc_writer_c_lib_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id
+ end subroutine prc_writer_c_lib_write_color_factors_call
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_c_lib_write_color_factors_call (writer, unit, id)
+ module subroutine prc_writer_c_lib_write_color_factors_call (writer, unit, id)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "call ", &
char (writer%get_c_procname (id, var_str ("color_factors"))), &
" (cf_index1, cf_index2, color_factors)"
end subroutine prc_writer_c_lib_write_color_factors_call
@ %def prc_writer_c_lib_write_color_factors_call
@
\subsection{Interfaces for C-library matrix element}
If the matrix element code is not provided as a Fortran module but as
a C or bind(C) Fortran library, we need explicit interfaces for the
library functions. They are not identical to the Fortran module
versions. They transfer pointers directly.
The implementation is part of the [[prc_writer_c_lib]] type, which
serves as base type for all C-library writers. It writes specific
interfaces depending on the feature.
We bind this as the method [[write_standard_interface]] instead of
[[write_interface]], because we have to override the latter.
Otherwise we could not call the method because the writer type is
abstract.
<<Prclib interfaces: prc writer c lib: TBP>>=
procedure :: write_standard_interface => prc_writer_c_lib_write_interface
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prc_writer_c_lib_write_interface (writer, unit, id, feature)
+ class(prc_writer_c_lib_t), intent(in) :: writer
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: id, feature
+ end subroutine prc_writer_c_lib_write_interface
<<Prclib interfaces: procedures>>=
- subroutine prc_writer_c_lib_write_interface (writer, unit, id, feature)
+ module subroutine prc_writer_c_lib_write_interface (writer, unit, id, feature)
class(prc_writer_c_lib_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
select case (char (feature))
case ("md5sum")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "function ", &
char (writer%get_c_procname (id, var_str ("get_md5sum"))), &
" () result (cptr) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "type(c_ptr) :: cptr"
write (unit, "(5x,9A)") "end function ", &
char (writer%get_c_procname (id, var_str ("get_md5sum")))
write (unit, "(2x,9A)") "end interface"
case ("openmp_supported")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "function ", &
char (writer%get_c_procname (id, feature)), &
" () result (status) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "logical(c_bool) :: status"
write (unit, "(5x,9A)") "end function ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case ("n_in", "n_out", "n_flv", "n_hel", "n_col", "n_cin", "n_cf")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "function ", &
char (writer%get_c_procname (id, feature)), &
" () result (n) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int) :: n"
write (unit, "(5x,9A)") "end function ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case ("flv_state", "hel_state")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (", char (feature), ") bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), dimension(*), intent(out) ", &
":: ", char (feature)
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case ("col_state")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (col_state, ghost_flag) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), dimension(*), intent(out) ", &
":: col_state"
write (unit, "(7x,9A)") "logical(c_bool), dimension(*), intent(out) ", &
":: ghost_flag"
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case ("color_factors")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (cf_index1, cf_index2, color_factors) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), dimension(*), &
&intent(out) :: cf_index1"
write (unit, "(7x,9A)") "integer(c_int), dimension(*), &
&intent(out) :: cf_index2"
write (unit, "(7x,9A)") "complex(c_default_complex), dimension(*), &
&intent(out) :: color_factors"
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
end select
end subroutine prc_writer_c_lib_write_interface
@ %def prc_writer_c_lib_write_interface
@
\subsection{Retrieving the tables}
In the previous section we had the writer routines for procedures that
return tables, actually C pointers to tables. Here, we write
convenience routines that unpack them and move the contents to
suitable Fortran arrays.
The flavor and helicity tables are two-dimensional integer arrays. We
use intermediate storage for correctly transforming C to Fortran data
types.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_flv_state => prclib_driver_set_flv_state
procedure :: set_hel_state => prclib_driver_set_hel_state
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_set_flv_state (driver, i, flv_state)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ integer, dimension(:,:), allocatable, intent(out) :: flv_state
+ end subroutine prclib_driver_set_flv_state
+ module subroutine prclib_driver_set_hel_state (driver, i, hel_state)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ integer, dimension(:,:), allocatable, intent(out) :: hel_state
+ end subroutine prclib_driver_set_hel_state
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_set_flv_state (driver, i, flv_state)
+ module subroutine prclib_driver_set_flv_state (driver, i, flv_state)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
integer, dimension(:,:), allocatable, intent(out) :: flv_state
integer :: n_tot, n_flv
integer(c_int) :: pid
integer(c_int), dimension(:,:), allocatable :: c_flv_state
pid = i
n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
n_flv = driver%get_n_flv (pid)
allocate (flv_state (n_tot, n_flv))
allocate (c_flv_state (n_tot, n_flv))
call driver%set_flv_state_ptr &
(pid, c_flv_state, int ([n_tot, n_flv], kind=c_int))
flv_state = c_flv_state
end subroutine prclib_driver_set_flv_state
- subroutine prclib_driver_set_hel_state (driver, i, hel_state)
+ module subroutine prclib_driver_set_hel_state (driver, i, hel_state)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
integer, dimension(:,:), allocatable, intent(out) :: hel_state
integer :: n_tot, n_hel
integer(c_int) :: pid
integer(c_int), dimension(:,:), allocatable, target :: c_hel_state
pid = i
n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
n_hel = driver%get_n_hel (pid)
allocate (hel_state (n_tot, n_hel))
allocate (c_hel_state (n_tot, n_hel))
call driver%set_hel_state_ptr &
(pid, c_hel_state, int ([n_tot, n_hel], kind=c_int))
hel_state = c_hel_state
end subroutine prclib_driver_set_hel_state
@ %def prclib_driver_set_flv_state
@ %def prclib_driver_set_hel_state
@ The color-flow table is three-dimensional, otherwise similar. We
simultaneously set the ghost-flag table, which consists of logical
entries.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_col_state => prclib_driver_set_col_state
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_set_col_state (driver, i, col_state, ghost_flag)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ integer, dimension(:,:,:), allocatable, intent(out) :: col_state
+ logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
+ end subroutine prclib_driver_set_col_state
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_set_col_state (driver, i, col_state, ghost_flag)
+ module subroutine prclib_driver_set_col_state (driver, i, col_state, ghost_flag)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
integer, dimension(:,:,:), allocatable, intent(out) :: col_state
logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
integer :: n_cin, n_tot, n_col
integer(c_int) :: pid
integer(c_int), dimension(:,:,:), allocatable :: c_col_state
logical(c_bool), dimension(:,:), allocatable :: c_ghost_flag
pid = i
n_cin = driver%get_n_cin (pid)
n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
n_col = driver%get_n_col (pid)
allocate (col_state (n_cin, n_tot, n_col))
allocate (c_col_state (n_cin, n_tot, n_col))
allocate (ghost_flag (n_tot, n_col))
allocate (c_ghost_flag (n_tot, n_col))
call driver%set_col_state_ptr (pid, &
c_col_state, c_ghost_flag, int ([n_cin, n_tot, n_col], kind=c_int))
col_state = c_col_state
ghost_flag = c_ghost_flag
end subroutine prclib_driver_set_col_state
@ %def prclib_driver_set_col_state
@ The color-factor table is a sparse matrix: a two-column array of indices and
one array which contains the corresponding factors.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: set_color_factors => prclib_driver_set_color_factors
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_set_color_factors (driver, i, color_factors, cf_index)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ complex(default), dimension(:), allocatable, intent(out) :: color_factors
+ integer, dimension(:,:), allocatable, intent(out) :: cf_index
+ end subroutine prclib_driver_set_color_factors
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_set_color_factors (driver, i, color_factors, cf_index)
+ module subroutine prclib_driver_set_color_factors (driver, i, color_factors, cf_index)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
complex(default), dimension(:), allocatable, intent(out) :: color_factors
integer, dimension(:,:), allocatable, intent(out) :: cf_index
integer :: n_cf
integer(c_int) :: pid
complex(c_default_complex), dimension(:), allocatable, target :: c_color_factors
integer(c_int), dimension(:), allocatable, target :: c_cf_index1
integer(c_int), dimension(:), allocatable, target :: c_cf_index2
pid = i
n_cf = driver%get_n_cf (pid)
allocate (color_factors (n_cf))
allocate (c_color_factors (n_cf))
allocate (c_cf_index1 (n_cf))
allocate (c_cf_index2 (n_cf))
call driver%set_color_factors_ptr (pid, &
c_cf_index1, c_cf_index2, &
c_color_factors, int ([n_cf], kind=c_int))
color_factors = c_color_factors
allocate (cf_index (2, n_cf))
cf_index(1,:) = c_cf_index1
cf_index(2,:) = c_cf_index2
end subroutine prclib_driver_set_color_factors
@ %def prclib_driver_set_color_factors
@
\subsection{Returning a procedure pointer}
The functions that directly access the matrix element, event by event,
are assigned to a process-specific driver object as procedure
pointers. For the [[dlopen]] interface, we use C function pointers.
This subroutine returns such a pointer:
<<Prclib interfaces: public>>=
public :: prc_get_fptr
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prc_get_fptr (pid, fid, fptr) bind(C)
import
integer(c_int), intent(in) :: pid
integer(c_int), intent(in) :: fid
type(c_funptr), intent(out) :: fptr
end subroutine prc_get_fptr
end interface
@ %def prc_get_fptr
@ This procedure writes the source code for the procedure pointer
returning subroutine.
All C functions that are provided by the matrix element code of a
specific process are handled here. The selection consists of a double
layered [[select]] [[case]] construct.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: write_get_fptr_sub
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine write_get_fptr_sub (driver, unit, prefix)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: unit
+ type(string_t), intent(in) :: prefix
+ end subroutine write_get_fptr_sub
<<Prclib interfaces: procedures>>=
- subroutine write_get_fptr_sub (driver, unit, prefix)
+ module subroutine write_get_fptr_sub (driver, unit, prefix)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
integer :: i, j
write (unit, "(A)") ""
write (unit, "(A)") "! Return C pointer to a procedure:"
write (unit, "(A)") "! pid = process index; fid = function index"
write (unit, "(4A)") "subroutine ", char (prefix), "get_fptr ", &
"(pid, fid, fptr) bind(C)"
write (unit, "(A)") " use iso_c_binding"
write (unit, "(A)") " use kinds"
write (unit, "(A)") " implicit none"
write (unit, "(A)") " integer(c_int), intent(in) :: pid"
write (unit, "(A)") " integer(c_int), intent(in) :: fid"
write (unit, "(A)") " type(c_funptr), intent(out) :: fptr"
do i = 1, driver%n_processes
call driver%record(i)%write_interfaces (unit)
end do
write (unit, "(A)") " select case (pid)"
do i = 1, driver%n_processes
write (unit, "(2x,A,I0,A)") "case (", i, ")"
write (unit, "(5x,A)") "select case (fid)"
associate (record => driver%record(i))
do j = 1, size (record%feature)
write (unit, "(5x,A,I0,9A)") "case (", j, "); ", &
"fptr = c_funloc (", &
char (record%get_c_procname (record%feature(j))), &
")"
end do
end associate
write (unit, "(5x,A)") "end select"
end do
write (unit, "(A)") " end select"
write (unit, "(3A)") "end subroutine ", char (prefix), "get_fptr"
end subroutine write_get_fptr_sub
@ %def write_get_fptr_sub
@ The procedures for which we want to return a pointer (the 'features'
of the matrix element code) are actually Fortran module procedures.
If we want to have a C signature, we must write wrapper functions for
all of them. The procedures, their signatures, and the appropriate
writer routines are specific for the process type.
To keep this generic, we do not provide the writer routines here, but
just the interface for a writer routine. The actual routines are
stored in the process record.
The [[prefix]] indicates the library, the [[id]] indicates the
process, and [[procname]] is the bare name of the procedure to be
written.
<<Prclib interfaces: public>>=
public :: write_driver_code
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine write_driver_code (unit, prefix, id, procname)
import
integer, intent(in) :: unit
type(string_t), intent(in) :: prefix
type(string_t), intent(in) :: id
type(string_t), intent(in) :: procname
end subroutine write_driver_code
end interface
@ %def write_driver_code
@
\subsection{Hooks}
Interface for additional library unload / reload hooks (currently unused!)
<<Prclib interfaces: public>>=
public :: prclib_unload_hook
public :: prclib_reload_hook
<<Prclib interfaces: interfaces>>=
abstract interface
subroutine prclib_unload_hook (libname)
import
type(string_t), intent(in) :: libname
end subroutine prclib_unload_hook
subroutine prclib_reload_hook (libname)
import
type(string_t), intent(in) :: libname
end subroutine prclib_reload_hook
end interface
@ %def prclib_unload_hook
@ %def prclib_reload_hook
@
\subsection{Make source, compile, link}
Since we should have written a Makefile, these tasks amount to simple
[[make]] calls. Note that the Makefile targets depend on each other,
so calling [[link]] executes also the [[source]] and [[compile]]
steps, when necessary.
Optionally, we can use a subdirectory. We construct a prefix for the
subdirectory, and generate a shell [[cd]] call that moves us into the
workspace.
The [[prefix]] version is intended to be prepended to a filename, and can be
empty. The [[path]] version is intended to be prepended with a following
slash, so the default is [[.]].
<<Prclib interfaces: public>>=
public :: workspace_prefix
public :: workspace_path
+<<Prclib interfaces: sub interfaces>>=
+ module function workspace_prefix (workspace) result (prefix)
+ type(string_t), intent(in), optional :: workspace
+ type(string_t) :: prefix
+ end function workspace_prefix
+ module function workspace_path (workspace) result (path)
+ type(string_t), intent(in), optional :: workspace
+ type(string_t) :: path
+ end function workspace_path
+ module function workspace_cmd (workspace) result (cmd)
+ type(string_t), intent(in), optional :: workspace
+ type(string_t) :: cmd
+ end function workspace_cmd
<<Prclib interfaces: procedures>>=
- function workspace_prefix (workspace) result (prefix)
+ module function workspace_prefix (workspace) result (prefix)
type(string_t), intent(in), optional :: workspace
type(string_t) :: prefix
if (present (workspace)) then
if (workspace /= "") then
prefix = workspace // "/"
else
prefix = ""
end if
else
prefix = ""
end if
end function workspace_prefix
- function workspace_path (workspace) result (path)
+ module function workspace_path (workspace) result (path)
type(string_t), intent(in), optional :: workspace
type(string_t) :: path
if (present (workspace)) then
if (workspace /= "") then
path = workspace
else
path = "."
end if
else
path = "."
end if
end function workspace_path
- function workspace_cmd (workspace) result (cmd)
+ module function workspace_cmd (workspace) result (cmd)
type(string_t), intent(in), optional :: workspace
type(string_t) :: cmd
if (present (workspace)) then
if (workspace /= "") then
cmd = "cd " // workspace // " && "
else
cmd = ""
end if
else
cmd = ""
end if
end function workspace_cmd
@ %def workspace_prefix
@ %def workspace_path
@ %def workspace_cmd
@ The first routine writes source-code files for the individual
processes. First it calls the writer routines directly for each
process, then it calls [[make source]]. The make command may either
post-process the files, or it may do the complete work, e.g., calling
an external program the generates the files.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: make_source => prclib_driver_make_source
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_make_source (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_make_source
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_make_source (driver, os_data, workspace)
+ module subroutine prclib_driver_make_source (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
integer :: i
do i = 1, driver%n_processes
call driver%record(i)%write_source_code ()
end do
call os_system_call ( &
workspace_cmd (workspace) &
// "make source " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end subroutine prclib_driver_make_source
@ %def prclib_driver_make_source
@ Compile matrix element source code and the driver source code. As above, we
first iterate through all processes and call [[before_compile]]. This is
usually empty, but can execute code that depends on [[make_source]] already
completed. Similarly, [[after_compile]] scans all processes again.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: make_compile => prclib_driver_make_compile
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_make_compile (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_make_compile
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_make_compile (driver, os_data, workspace)
+ module subroutine prclib_driver_make_compile (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
integer :: i
do i = 1, driver%n_processes
call driver%record(i)%before_compile ()
end do
call os_system_call ( &
workspace_cmd (workspace) &
// "make compile " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
do i = 1, driver%n_processes
call driver%record(i)%after_compile ()
end do
end subroutine prclib_driver_make_compile
@ %def prclib_driver_make_compile
@ Combine all matrix-element code together with the driver in a
process library on disk.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: make_link => prclib_driver_make_link
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_make_link (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_make_link
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_make_link (driver, os_data, workspace)
+ module subroutine prclib_driver_make_link (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
integer :: i
call os_system_call ( &
workspace_cmd (workspace) &
// "make link " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end subroutine prclib_driver_make_link
@ %def prclib_driver_make_link
@
\subsection{Clean up generated files}
The task of cleaning any generated files should also be deferred to
Makefile targets. Apart from removing everything, removing specific
files may be useful for partial rebuilds. (Note that removing the
makefile itself can only be done once, for obvious reasons.)
If there is no makefile, do nothing.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: clean_library => prclib_driver_clean_library
procedure :: clean_objects => prclib_driver_clean_objects
procedure :: clean_source => prclib_driver_clean_source
procedure :: clean_driver => prclib_driver_clean_driver
procedure :: clean_makefile => prclib_driver_clean_makefile
procedure :: clean => prclib_driver_clean
procedure :: distclean => prclib_driver_distclean
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_clean_library (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_clean_library
+ module subroutine prclib_driver_clean_objects (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_clean_objects
+ module subroutine prclib_driver_clean_source (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_clean_source
+ module subroutine prclib_driver_clean_driver (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_clean_driver
+ module subroutine prclib_driver_clean_makefile (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_clean_makefile
+ module subroutine prclib_driver_clean (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_clean
+ module subroutine prclib_driver_distclean (driver, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_distclean
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_clean_library (driver, os_data, workspace)
+ module subroutine prclib_driver_clean_library (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-library " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_library
- subroutine prclib_driver_clean_objects (driver, os_data, workspace)
+ module subroutine prclib_driver_clean_objects (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-objects " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_objects
- subroutine prclib_driver_clean_source (driver, os_data, workspace)
+ module subroutine prclib_driver_clean_source (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-source " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_source
- subroutine prclib_driver_clean_driver (driver, os_data, workspace)
+ module subroutine prclib_driver_clean_driver (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-driver " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_driver
- subroutine prclib_driver_clean_makefile (driver, os_data, workspace)
+ module subroutine prclib_driver_clean_makefile (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-makefile " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_makefile
- subroutine prclib_driver_clean (driver, os_data, workspace)
+ module subroutine prclib_driver_clean (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean
- subroutine prclib_driver_distclean (driver, os_data, workspace)
+ module subroutine prclib_driver_distclean (driver, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
if (driver%makefile_exists ()) then
call os_system_call ( &
workspace_cmd (workspace) &
// "make distclean " // os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_distclean
@ %def prclib_driver_clean_library
@ %def prclib_driver_clean_objects
@ %def prclib_driver_clean_source
@ %def prclib_driver_clean_driver
@ %def prclib_driver_clean_makefile
@ %def prclib_driver_clean
@ %def prclib_driver_distclean
@ This Make target should remove all files that apply to a specific process.
We execute this when we want to force remaking source code. Note that source
targets need not have prerequisites, so just calling [[make_source]] would not
do anything if the files exist.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: clean_proc => prclib_driver_clean_proc
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_clean_proc (driver, i, os_data, workspace)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_clean_proc
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_clean_proc (driver, i, os_data, workspace)
+ module subroutine prclib_driver_clean_proc (driver, i, os_data, workspace)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
type(string_t) :: id
if (driver%makefile_exists ()) then
id = driver%record(i)%id
call os_system_call ( &
workspace_cmd (workspace) &
// "make clean-" // driver%record(i)%id // " " &
// os_data%makeflags &
// " -f " // driver%basename // ".makefile")
end if
end subroutine prclib_driver_clean_proc
@ %def prclib_driver_clean_proc
@
\subsection{Further Tools}
Check for the appropriate makefile.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: makefile_exists => prclib_driver_makefile_exists
+<<Prclib interfaces: sub interfaces>>=
+ module function prclib_driver_makefile_exists (driver, workspace) result (flag)
+ class(prclib_driver_t), intent(in) :: driver
+ type(string_t), intent(in), optional :: workspace
+ logical :: flag
+ end function prclib_driver_makefile_exists
<<Prclib interfaces: procedures>>=
- function prclib_driver_makefile_exists (driver, workspace) result (flag)
+ module function prclib_driver_makefile_exists (driver, workspace) result (flag)
class(prclib_driver_t), intent(in) :: driver
type(string_t), intent(in), optional :: workspace
logical :: flag
inquire (file = char (workspace_prefix (workspace) &
& // driver%basename) // ".makefile", &
exist = flag)
end function prclib_driver_makefile_exists
@ %def prclib_driver_makefile_exists
@
\subsection{Load the library}
Once the library has been linked, we can dlopen it and assign all
procedure pointers to their proper places in the library driver
object. The [[loaded]] flag is set only if all required pointers
have become assigned.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: load => prclib_driver_load
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_load (driver, os_data, noerror, workspace)
+ class(prclib_driver_t), intent(inout) :: driver
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in), optional :: noerror
+ type(string_t), intent(in), optional :: workspace
+ end subroutine prclib_driver_load
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_load (driver, os_data, noerror, workspace)
+ module subroutine prclib_driver_load (driver, os_data, noerror, workspace)
class(prclib_driver_t), intent(inout) :: driver
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: noerror
type(string_t), intent(in), optional :: workspace
type(c_funptr) :: c_fptr
logical :: ignore
ignore = .false.; if (present (noerror)) ignore = noerror
driver%libname = os_get_dlname ( &
workspace_prefix (workspace) // driver%basename, &
os_data, noerror, noerror)
if (driver%libname == "") return
select type (driver)
type is (prclib_driver_dynamic_t)
if (.not. dlaccess_is_open (driver%dlaccess)) then
call dlaccess_init &
(driver%dlaccess, workspace_path (workspace), &
driver%libname, os_data)
if (.not. ignore) call driver%check_dlerror ()
end if
driver%loaded = dlaccess_is_open (driver%dlaccess)
class default
driver%loaded = .true.
end select
if (.not. driver%loaded) return
c_fptr = driver%get_c_funptr (var_str ("get_n_processes"))
call c_f_procpointer (c_fptr, driver%get_n_processes)
driver%loaded = driver%loaded .and. associated (driver%get_n_processes)
c_fptr = driver%get_c_funptr (var_str ("get_process_id_ptr"))
call c_f_procpointer (c_fptr, driver%get_process_id_ptr)
driver%loaded = driver%loaded .and. associated (driver%get_process_id_ptr)
c_fptr = driver%get_c_funptr (var_str ("get_model_name_ptr"))
call c_f_procpointer (c_fptr, driver%get_model_name_ptr)
driver%loaded = driver%loaded .and. associated (driver%get_model_name_ptr)
c_fptr = driver%get_c_funptr (var_str ("get_md5sum_ptr"))
call c_f_procpointer (c_fptr, driver%get_md5sum_ptr)
driver%loaded = driver%loaded .and. associated (driver%get_md5sum_ptr)
c_fptr = driver%get_c_funptr (var_str ("get_openmp_status"))
call c_f_procpointer (c_fptr, driver%get_openmp_status)
driver%loaded = driver%loaded .and. associated (driver%get_openmp_status)
c_fptr = driver%get_c_funptr (var_str ("get_n_in"))
call c_f_procpointer (c_fptr, driver%get_n_in)
driver%loaded = driver%loaded .and. associated (driver%get_n_in)
c_fptr = driver%get_c_funptr (var_str ("get_n_out"))
call c_f_procpointer (c_fptr, driver%get_n_out)
driver%loaded = driver%loaded .and. associated (driver%get_n_out)
c_fptr = driver%get_c_funptr (var_str ("get_n_flv"))
call c_f_procpointer (c_fptr, driver%get_n_flv)
driver%loaded = driver%loaded .and. associated (driver%get_n_flv)
c_fptr = driver%get_c_funptr (var_str ("get_n_hel"))
call c_f_procpointer (c_fptr, driver%get_n_hel)
driver%loaded = driver%loaded .and. associated (driver%get_n_hel)
c_fptr = driver%get_c_funptr (var_str ("get_n_col"))
call c_f_procpointer (c_fptr, driver%get_n_col)
driver%loaded = driver%loaded .and. associated (driver%get_n_col)
c_fptr = driver%get_c_funptr (var_str ("get_n_cin"))
call c_f_procpointer (c_fptr, driver%get_n_cin)
driver%loaded = driver%loaded .and. associated (driver%get_n_cin)
c_fptr = driver%get_c_funptr (var_str ("get_n_cf"))
call c_f_procpointer (c_fptr, driver%get_n_cf)
driver%loaded = driver%loaded .and. associated (driver%get_n_cf)
c_fptr = driver%get_c_funptr (var_str ("set_flv_state_ptr"))
call c_f_procpointer (c_fptr, driver%set_flv_state_ptr)
driver%loaded = driver%loaded .and. associated (driver%set_flv_state_ptr)
c_fptr = driver%get_c_funptr (var_str ("set_hel_state_ptr"))
call c_f_procpointer (c_fptr, driver%set_hel_state_ptr)
driver%loaded = driver%loaded .and. associated (driver%set_hel_state_ptr)
c_fptr = driver%get_c_funptr (var_str ("set_col_state_ptr"))
call c_f_procpointer (c_fptr, driver%set_col_state_ptr)
driver%loaded = driver%loaded .and. associated (driver%set_col_state_ptr)
c_fptr = driver%get_c_funptr (var_str ("set_color_factors_ptr"))
call c_f_procpointer (c_fptr, driver%set_color_factors_ptr)
driver%loaded = driver%loaded .and. associated (driver%set_color_factors_ptr)
c_fptr = driver%get_c_funptr (var_str ("get_fptr"))
call c_f_procpointer (c_fptr, driver%get_fptr)
driver%loaded = driver%loaded .and. associated (driver%get_fptr)
end subroutine prclib_driver_load
@ %def prclib_driver_load
@ Unload. To be sure, nullify the procedure pointers.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: unload => prclib_driver_unload
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_unload (driver)
+ class(prclib_driver_t), intent(inout) :: driver
+ end subroutine prclib_driver_unload
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_unload (driver)
+ module subroutine prclib_driver_unload (driver)
class(prclib_driver_t), intent(inout) :: driver
select type (driver)
type is (prclib_driver_dynamic_t)
if (dlaccess_is_open (driver%dlaccess)) then
call dlaccess_final (driver%dlaccess)
call driver%check_dlerror ()
end if
end select
driver%loaded = .false.
nullify (driver%get_n_processes)
nullify (driver%get_process_id_ptr)
nullify (driver%get_model_name_ptr)
nullify (driver%get_md5sum_ptr)
nullify (driver%get_openmp_status)
nullify (driver%get_n_in)
nullify (driver%get_n_out)
nullify (driver%get_n_flv)
nullify (driver%get_n_hel)
nullify (driver%get_n_col)
nullify (driver%get_n_cin)
nullify (driver%get_n_cf)
nullify (driver%set_flv_state_ptr)
nullify (driver%set_hel_state_ptr)
nullify (driver%set_col_state_ptr)
nullify (driver%set_color_factors_ptr)
nullify (driver%get_fptr)
end subroutine prclib_driver_unload
@ %def prclib_driver_unload
@ This subroutine checks the [[dlerror]] content and issues a fatal
error if it finds an error there.
<<Prclib interfaces: prclib driver dynamic: TBP>>=
procedure :: check_dlerror => prclib_driver_check_dlerror
+<<Prclib interfaces: sub interfaces>>=
+ module subroutine prclib_driver_check_dlerror (driver)
+ class(prclib_driver_dynamic_t), intent(in) :: driver
+ end subroutine prclib_driver_check_dlerror
<<Prclib interfaces: procedures>>=
- subroutine prclib_driver_check_dlerror (driver)
+ module subroutine prclib_driver_check_dlerror (driver)
class(prclib_driver_dynamic_t), intent(in) :: driver
if (dlaccess_has_error (driver%dlaccess)) then
call msg_fatal (char (dlaccess_get_error (driver%dlaccess)))
end if
end subroutine prclib_driver_check_dlerror
@ %def prclib_driver_check_dlerror
@ Get the handle (C function pointer) for a given ``feature'' of the
matrix element code, so it can be assigned to the appropriate
procedure pointer slot. In the static case, this is a
trivial pointer assignment, hard-coded into the driver type
implementation.
<<Prclib interfaces: prclib driver: TBP>>=
procedure (prclib_driver_get_c_funptr), deferred :: get_c_funptr
<<Prclib interfaces: interfaces>>=
abstract interface
function prclib_driver_get_c_funptr (driver, feature) result (c_fptr)
import
class(prclib_driver_t), intent(inout) :: driver
type(string_t), intent(in) :: feature
type(c_funptr) :: c_fptr
end function prclib_driver_get_c_funptr
end interface
@ %def prclib_driver_get_c_funptr
@ In the dynamic-library case, we call the DL interface to retrieve the C
pointer to a named procedure.
<<Prclib interfaces: prclib driver dynamic: TBP>>=
procedure :: get_c_funptr => prclib_driver_dynamic_get_c_funptr
+<<Prclib interfaces: sub interfaces>>=
+ module function prclib_driver_dynamic_get_c_funptr &
+ (driver, feature) result (c_fptr)
+ class(prclib_driver_dynamic_t), intent(inout) :: driver
+ type(string_t), intent(in) :: feature
+ type(c_funptr) :: c_fptr
+ end function prclib_driver_dynamic_get_c_funptr
<<Prclib interfaces: procedures>>=
- function prclib_driver_dynamic_get_c_funptr (driver, feature) result (c_fptr)
+ module function prclib_driver_dynamic_get_c_funptr &
+ (driver, feature) result (c_fptr)
class(prclib_driver_dynamic_t), intent(inout) :: driver
type(string_t), intent(in) :: feature
type(c_funptr) :: c_fptr
type(string_t) :: prefix, full_name
prefix = lower_case (driver%basename) // "_"
full_name = prefix // feature
c_fptr = dlaccess_get_c_funptr (driver%dlaccess, full_name)
call driver%check_dlerror ()
end function prclib_driver_dynamic_get_c_funptr
@ %def prclib_driver_get_c_funptr
@
\subsection{MD5 sums}
Recall the MD5 sum written in the Makefile
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: get_md5sum_makefile => prclib_driver_get_md5sum_makefile
+<<Prclib interfaces: sub interfaces>>=
+ module function prclib_driver_get_md5sum_makefile &
+ (driver, workspace) result (md5sum)
+ class(prclib_driver_t), intent(in) :: driver
+ type(string_t), intent(in), optional :: workspace
+ character(32) :: md5sum
+ end function prclib_driver_get_md5sum_makefile
<<Prclib interfaces: procedures>>=
- function prclib_driver_get_md5sum_makefile (driver, workspace) result (md5sum)
+ module function prclib_driver_get_md5sum_makefile &
+ (driver, workspace) result (md5sum)
class(prclib_driver_t), intent(in) :: driver
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum
type(string_t) :: filename
character(80) :: buffer
logical :: exist
integer :: u, iostat
md5sum = ""
filename = workspace_prefix (workspace) // driver%basename // ".makefile"
inquire (file = char (filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (filename), action = "read", status = "old")
iostat = 0
do
read (u, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
buffer = adjustl (buffer)
select case (buffer(1:9))
case ("MD5SUM = ")
read (buffer(11:), "(A32)") md5sum
exit
end select
end do
close (u)
end if
end function prclib_driver_get_md5sum_makefile
@ %def prclib_driver_get_md5sum_makefile
@ Recall the MD5 sum written in the driver source code.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: get_md5sum_driver => prclib_driver_get_md5sum_driver
+<<Prclib interfaces: sub interfaces>>=
+ module function prclib_driver_get_md5sum_driver (driver, workspace) result (md5sum)
+ class(prclib_driver_t), intent(in) :: driver
+ type(string_t), intent(in), optional :: workspace
+ character(32) :: md5sum
+ end function prclib_driver_get_md5sum_driver
<<Prclib interfaces: procedures>>=
- function prclib_driver_get_md5sum_driver (driver, workspace) result (md5sum)
+ module function prclib_driver_get_md5sum_driver (driver, workspace) result (md5sum)
class(prclib_driver_t), intent(in) :: driver
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum
type(string_t) :: filename
character(80) :: buffer
logical :: exist
integer :: u, iostat
md5sum = ""
filename = workspace_prefix (workspace) // driver%basename // ".f90"
inquire (file = char (filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (filename), action = "read", status = "old")
iostat = 0
do
read (u, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
buffer = adjustl (buffer)
select case (buffer(1:9))
case ("md5sum = ")
read (buffer(11:), "(A32)") md5sum
exit
end select
end do
close (u)
end if
end function prclib_driver_get_md5sum_driver
@ %def prclib_driver_get_md5sum_driver
@ Recall the MD5 sum written in the matrix element source code.
<<Prclib interfaces: prclib driver: TBP>>=
procedure :: get_md5sum_source => prclib_driver_get_md5sum_source
+<<Prclib interfaces: sub interfaces>>=
+ module function prclib_driver_get_md5sum_source &
+ (driver, i, workspace) result (md5sum)
+ class(prclib_driver_t), intent(in) :: driver
+ integer, intent(in) :: i
+ type(string_t), intent(in), optional :: workspace
+ character(32) :: md5sum
+ end function prclib_driver_get_md5sum_source
<<Prclib interfaces: procedures>>=
- function prclib_driver_get_md5sum_source &
+ module function prclib_driver_get_md5sum_source &
(driver, i, workspace) result (md5sum)
class(prclib_driver_t), intent(in) :: driver
integer, intent(in) :: i
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum
type(string_t) :: filename
character(80) :: buffer
logical :: exist
integer :: u, iostat
md5sum = ""
filename = workspace_prefix (workspace) // driver%record(i)%id // ".f90"
inquire (file = char (filename), exist = exist)
if (exist) then
u = free_unit ()
open (u, file = char (filename), action = "read", status = "old")
iostat = 0
do
read (u, "(A)", iostat = iostat) buffer
if (iostat /= 0) exit
buffer = adjustl (buffer)
select case (buffer(1:9))
case ("md5sum = ")
read (buffer(11:), "(A32)") md5sum
exit
end select
end do
close (u)
end if
end function prclib_driver_get_md5sum_source
@ %def prclib_driver_get_md5sum_source
@
\subsection{Unit Test}
Test module, followed by the corresponding implementation module.
<<[[prclib_interfaces_ut.f90]]>>=
<<File header>>
module prclib_interfaces_ut
use kinds
use system_dependencies, only: CC_IS_GNU, CC_HAS_QUADMATH
use unit_tests
use prclib_interfaces_uti
<<Standard module head>>
<<Prclib interfaces: public test>>
<<Prclib interfaces: public test auxiliary>>
contains
<<Prclib interfaces: test driver>>
end module prclib_interfaces_ut
@ %def prclib_interfaces_ut
@
<<[[prclib_interfaces_uti.f90]]>>=
<<File header>>
module prclib_interfaces_uti
use, intrinsic :: iso_c_binding !NODEP!
use kinds
use system_dependencies, only: CC_HAS_QUADMATH, DEFAULT_FC_PRECISION
<<Use strings>>
use io_units
use system_defs, only: TAB
use os_interface
use prclib_interfaces
<<Standard module head>>
<<Prclib interfaces: public test auxiliary>>
<<Prclib interfaces: test declarations>>
<<Prclib interfaces: test types>>
contains
<<Prclib interfaces: tests>>
<<Prclib interfaces: test auxiliary>>
end module prclib_interfaces_uti
@ %def prclib_interfaces_ut
@ API: driver for the unit tests below.
<<Prclib interfaces: public test>>=
public :: prclib_interfaces_test
<<Prclib interfaces: test driver>>=
subroutine prclib_interfaces_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Prclib interfaces: execute tests>>
end subroutine prclib_interfaces_test
@ %def prclib_interfaces_test
@
\subsubsection{Empty process list}
Test 1: Create a driver object and display its contents. One of the
feature lists references a writer procedure; this is just a dummy that
does nothing useful.
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_1, "prclib_interfaces_1", &
"create driver object", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_1
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_1 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
character(32), parameter :: md5sum = "prclib_interfaces_1_md5sum "
class(prc_writer_t), pointer :: test_writer_1
write (u, "(A)") "* Test output: prclib_interfaces_1"
write (u, "(A)") "* Purpose: display the driver object contents"
write (u, *)
write (u, "(A)") "* Create a prclib driver object"
write (u, "(A)")
call dispatch_prclib_driver (driver, var_str ("prclib"), var_str (""))
call driver%init (3)
call driver%set_md5sum (md5sum)
allocate (test_writer_1_t :: test_writer_1)
call driver%set_record (1, var_str ("test1"), var_str ("test_model"), &
[var_str ("init")], test_writer_1)
call driver%set_record (2, var_str ("test2"), var_str ("foo_model"), &
[var_str ("another_proc")], test_writer_1)
call driver%set_record (3, var_str ("test3"), var_str ("test_model"), &
[var_str ("init"), var_str ("some_proc")], test_writer_1)
call driver%write (u)
deallocate (test_writer_1)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_1"
end subroutine prclib_interfaces_1
@ %def prclib_interfaces_1
@ The writer: the procedures write just comment lines. We can fix an
instance of this as a parameter (since it has no mutable content) and
just reference the fixed parameter.
NOTE: temporarily made public.
<<Prclib interfaces: test types>>=
type, extends (prc_writer_t) :: test_writer_1_t
contains
procedure, nopass :: type_name => test_writer_1_type_name
procedure :: write_makefile_code => test_writer_1_mk
procedure :: write_source_code => test_writer_1_src
procedure :: write_interface => test_writer_1_if
procedure :: write_md5sum_call => test_writer_1_md5sum
procedure :: write_int_sub_call => test_writer_1_int_sub
procedure :: write_col_state_call => test_writer_1_col_state
procedure :: write_color_factors_call => test_writer_1_col_factors
procedure :: before_compile => test_writer_1_before_compile
procedure :: after_compile => test_writer_1_after_compile
end type test_writer_1_t
@ %def test_writer_1
@
<<Prclib interfaces: test auxiliary>>=
function test_writer_1_type_name () result (string)
type(string_t) :: string
string = "test_1"
end function test_writer_1_type_name
subroutine test_writer_1_mk &
(writer, unit, id, os_data, verbose, testflag)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "# Makefile code for process ", char (id), &
" goes here."
end subroutine test_writer_1_mk
subroutine test_writer_1_src (writer, id)
class(test_writer_1_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_1_src
subroutine test_writer_1_if (writer, unit, id, feature)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(2x,9A)") "! Interface code for ", &
char (id), "_", char (writer%get_procname (feature)), &
" goes here."
end subroutine test_writer_1_if
subroutine test_writer_1_md5sum (writer, unit, id)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "! MD5sum call for ", char (id), " goes here."
end subroutine test_writer_1_md5sum
subroutine test_writer_1_int_sub (writer, unit, id, feature)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(5x,9A)") "! ", char (feature), " call for ", &
char (id), " goes here."
end subroutine test_writer_1_int_sub
subroutine test_writer_1_col_state (writer, unit, id)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "! col_state call for ", &
char (id), " goes here."
end subroutine test_writer_1_col_state
subroutine test_writer_1_col_factors (writer, unit, id)
class(test_writer_1_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
write (unit, "(5x,9A)") "! color_factors call for ", &
char (id), " goes here."
end subroutine test_writer_1_col_factors
subroutine test_writer_1_before_compile (writer, id)
class(test_writer_1_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_1_before_compile
subroutine test_writer_1_after_compile (writer, id)
class(test_writer_1_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_1_after_compile
@ %def test_writer_1_type_name
@ %def test_writer_1_mk test_writer_1_if
@ %def test_writer_1_md5sum test_writer_1_int_sub
@ %def test_writer_1_col_state test_writer_1_col_factors
@ %def test_writer_1_before_compile test_writer_1_after_compile
@
\subsubsection{Process library driver file}
Test 2: Write the driver file for a test case with two processes. The
first process needs no wrapper (C library), the second one needs
wrappers (Fortran module library).
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_2, "prclib_interfaces_2", &
"write driver file", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_2
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_2 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
character(32), parameter :: md5sum = "prclib_interfaces_2_md5sum "
class(prc_writer_t), pointer :: test_writer_1, test_writer_2
write (u, "(A)") "* Test output: prclib_interfaces_2"
write (u, "(A)") "* Purpose: check the generated driver source code"
write (u, "(A)")
write (u, "(A)") "* Create a prclib driver object (2 processes)"
write (u, "(A)")
call dispatch_prclib_driver (driver, var_str ("prclib2"), var_str (""))
call driver%init (2)
call driver%set_md5sum (md5sum)
allocate (test_writer_1_t :: test_writer_1)
allocate (test_writer_2_t :: test_writer_2)
call driver%set_record (1, var_str ("test1"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_1)
call driver%set_record (2, var_str ("test2"), var_str ("Test_model"), &
[var_str ("proc1"), var_str ("proc2")], test_writer_2)
call driver%write (u)
write (u, "(A)")
write (u, "(A)") "* Write the driver file"
write (u, "(A)") "* File contents:"
write (u, "(A)")
call driver%generate_driver_code (u)
deallocate (test_writer_1)
deallocate (test_writer_2)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_2"
end subroutine prclib_interfaces_2
@ %def prclib_interfaces_2
@ A writer with wrapper code: the procedures again write just comment
lines. Since all procedures are NOPASS, we can reuse two of the TBP.
<<Prclib interfaces: test types>>=
type, extends (prc_writer_f_module_t) :: test_writer_2_t
contains
procedure, nopass :: type_name => test_writer_2_type_name
procedure :: write_makefile_code => test_writer_2_mk
procedure :: write_source_code => test_writer_2_src
procedure :: write_interface => test_writer_2_if
procedure :: write_wrapper => test_writer_2_wr
procedure :: before_compile => test_writer_2_before_compile
procedure :: after_compile => test_writer_2_after_compile
end type test_writer_2_t
@ %def test_writer_2
@
<<Prclib interfaces: test auxiliary>>=
function test_writer_2_type_name () result (string)
type(string_t) :: string
string = "test_2"
end function test_writer_2_type_name
subroutine test_writer_2_mk &
(writer, unit, id, os_data, verbose, testflag)
class(test_writer_2_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "# Makefile code for process ", char (id), &
" goes here."
end subroutine test_writer_2_mk
subroutine test_writer_2_src (writer, id)
class(test_writer_2_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_2_src
subroutine test_writer_2_if (writer, unit, id, feature)
class(test_writer_2_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(2x,9A)") "! Interface code for ", &
char (writer%get_module_name (id)), "_", &
char (writer%get_procname (feature)), " goes here."
end subroutine test_writer_2_if
subroutine test_writer_2_wr (writer, unit, id, feature)
class(test_writer_2_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, *)
write (unit, "(9A)") "! Wrapper code for ", &
char (writer%get_c_procname (id, feature)), " goes here."
end subroutine test_writer_2_wr
subroutine test_writer_2_before_compile (writer, id)
class(test_writer_2_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_2_before_compile
subroutine test_writer_2_after_compile (writer, id)
class(test_writer_2_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_2_after_compile
@ %def test_writer_2_type_name test_writer_2_wr
@ %def test_writer_2_before_compile test_writer_2_after_compile
@
\subsubsection{Process library makefile}
Test 3: Write the makefile for compiling and linking the process
library (processes and driver code). There are two processes, one
with one method, one with two methods.
To have predictable output, we reset the system-dependent initial
components of [[os_data]] to known values.
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_3, "prclib_interfaces_3", &
"write makefile", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_3
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_3 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
type(os_data_t) :: os_data
character(32), parameter :: md5sum = "prclib_interfaces_3_md5sum "
class(prc_writer_t), pointer :: test_writer_1, test_writer_2
call os_data%init ()
os_data%fc = "fortran-compiler"
os_data%whizard_includes = "-I module-dir"
os_data%fcflags = "-C=all"
os_data%fcflags_pic = "-PIC"
os_data%cc = "c-compiler"
os_data%cflags = "-I include-dir"
os_data%cflags_pic = "-PIC"
os_data%whizard_ldflags = ""
os_data%ldflags = ""
os_data%whizard_libtool = "my-libtool"
os_data%latex = "latex -halt-on-error"
os_data%mpost = "mpost --math=scaled -halt-on-error"
os_data%dvips = "dvips"
os_data%ps2pdf = "ps2pdf14"
os_data%whizard_texpath = ""
write (u, "(A)") "* Test output: prclib_interfaces_3"
write (u, "(A)") "* Purpose: check the generated Makefile"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (2 processes)"
write (u, "(A)")
call dispatch_prclib_driver (driver, var_str ("prclib3"), var_str (""))
call driver%init (2)
call driver%set_md5sum (md5sum)
allocate (test_writer_1_t :: test_writer_1)
allocate (test_writer_2_t :: test_writer_2)
call driver%set_record (1, var_str ("test1"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_1)
call driver%set_record (2, var_str ("test2"), var_str ("Test_model"), &
[var_str ("proc1"), var_str ("proc2")], test_writer_2)
call driver%write (u)
write (u, "(A)")
write (u, "(A)") "* Write Makefile"
write (u, "(A)") "* File contents:"
write (u, "(A)")
call driver%generate_makefile (u, os_data, verbose = .true.)
deallocate (test_writer_1)
deallocate (test_writer_2)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_3"
end subroutine prclib_interfaces_3
@ %def prclib_interfaces_3
@
\subsubsection{Compile test with Fortran module}
Test 4: Write driver and makefile and try to compile and link the
library driver.
There is a single test process with a single feature. The process
code is provided as a Fortran module, therefore we need a wrapper for
the featured procedure.
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_4, "prclib_interfaces_4", &
"compile and link (Fortran module)", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_4
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_4 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
class(prc_writer_t), pointer :: test_writer_4
type(os_data_t) :: os_data
integer :: u_file
integer, dimension(:,:), allocatable :: flv_state
integer, dimension(:,:), allocatable :: hel_state
integer, dimension(:,:,:), allocatable :: col_state
logical, dimension(:,:), allocatable :: ghost_flag
integer, dimension(:,:), allocatable :: cf_index
complex(default), dimension(:), allocatable :: color_factors
character(32), parameter :: md5sum = "prclib_interfaces_4_md5sum "
character(32) :: md5sum_file
type(c_funptr) :: proc1_ptr
interface
subroutine proc1_t (n) bind(C)
import
integer(c_int), intent(out) :: n
end subroutine proc1_t
end interface
procedure(proc1_t), pointer :: proc1
integer(c_int) :: n
write (u, "(A)") "* Test output: prclib_interfaces_4"
write (u, "(A)") "* Purpose: compile, link, and load process library"
write (u, "(A)") "* with (fake) matrix-element code &
&as a Fortran module"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (1 process)"
write (u, "(A)")
call os_data%init ()
allocate (test_writer_4_t :: test_writer_4)
call test_writer_4%init_test ()
call dispatch_prclib_driver (driver, var_str ("prclib4"), var_str (""))
call driver%init (1)
call driver%set_md5sum (md5sum)
call driver%set_record (1, var_str ("test4"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_4)
call driver%write (u)
write (u, *)
write (u, "(A)") "* Write Makefile"
u_file = free_unit ()
open (u_file, file="prclib4.makefile", status="replace", action="write")
call driver%generate_makefile (u_file, os_data, verbose = .false.)
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Recall MD5 sum from Makefile"
write (u, "(A)")
md5sum_file = driver%get_md5sum_makefile ()
write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"
write (u, "(A)")
write (u, "(A)") "* Write driver source code"
u_file = free_unit ()
open (u_file, file="prclib4.f90", status="replace", action="write")
call driver%generate_driver_code (u_file)
close (u_file)
write (u, "(A)")
write (u, "(A)") "* Recall MD5 sum from driver source"
write (u, "(A)")
md5sum_file = driver%get_md5sum_driver ()
write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"
write (u, "(A)")
write (u, "(A)") "* Write matrix-element source code"
call driver%make_source (os_data)
write (u, "(A)")
write (u, "(A)") "* Recall MD5 sum from matrix-element source"
write (u, "(A)")
md5sum_file = driver%get_md5sum_source (1)
write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"
write (u, "(A)")
write (u, "(A)") "* Compile source code"
call driver%make_compile (os_data)
write (u, "(A)") "* Link library"
call driver%make_link (os_data)
write (u, "(A)") "* Load library"
call driver%load (os_data)
write (u, *)
call driver%write (u)
write (u, *)
if (driver%loaded) then
write (u, "(A)") "* Call library functions:"
write (u, *)
write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
write (u, "(1x,A,A,A)") "process_id = '", &
char (driver%get_process_id (1)), "'"
write (u, "(1x,A,A,A)") "model_name = '", &
char (driver%get_model_name (1)), "'"
write (u, "(1x,A,A,A)") "md5sum (lib) = '", &
char (driver%get_md5sum (0)), "'"
write (u, "(1x,A,A,A)") "md5sum (proc) = '", &
char (driver%get_md5sum (1)), "'"
write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)
call driver%set_flv_state (1, flv_state)
write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state
call driver%set_hel_state (1, hel_state)
write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state
call driver%set_col_state (1, col_state, ghost_flag)
write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag
call driver%set_color_factors (1, color_factors, cf_index)
write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index
call driver%get_fptr (1, 1, proc1_ptr)
call c_f_procpointer (proc1_ptr, proc1)
if (associated (proc1)) then
write (u, *)
call proc1 (n)
write (u, "(1x,A,I0)") "proc1(1) = ", n
end if
end if
deallocate (test_writer_4)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_4"
end subroutine prclib_interfaces_4
@ %def prclib_interfaces_4
@ This version of test-code writer actually writes an interface and
wrapper code. The wrapped function is a no-parameter function with integer
result.
The stored MD5 sum may be modified.
We will reuse this later, therefore public.
<<Prclib interfaces: public test auxiliary>>=
public :: test_writer_4_t
<<Prclib interfaces: test types>>=
type, extends (prc_writer_f_module_t) :: test_writer_4_t
contains
procedure, nopass :: type_name => test_writer_4_type_name
procedure, nopass :: get_module_name => &
test_writer_4_get_module_name
procedure :: write_makefile_code => test_writer_4_mk
procedure :: write_source_code => test_writer_4_src
procedure :: write_interface => test_writer_4_if
procedure :: write_wrapper => test_writer_4_wr
procedure :: before_compile => test_writer_4_before_compile
procedure :: after_compile => test_writer_4_after_compile
end type test_writer_4_t
@ %def test_writer_4
@
<<Prclib interfaces: test auxiliary>>=
function test_writer_4_type_name () result (string)
type(string_t) :: string
string = "test_4"
end function test_writer_4_type_name
function test_writer_4_get_module_name (id) result (name)
type(string_t), intent(in) :: id
type(string_t) :: name
name = "tpr_" // id
end function test_writer_4_get_module_name
subroutine test_writer_4_mk &
(writer, unit, id, os_data, verbose, testflag)
class(test_writer_4_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "SOURCES += ", char (id), ".f90"
write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
write (unit, "(5A)") "CLEAN_SOURCES += ", char (id), ".f90"
write (unit, "(5A)") "CLEAN_OBJECTS += tpr_", char (id), ".mod"
write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), ".lo"
write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
if (.not. verbose) then
write (unit, "(5A)") TAB // '@echo " FC " $@'
end if
write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
end subroutine test_writer_4_mk
subroutine test_writer_4_src (writer, id)
class(test_writer_4_t), intent(in) :: writer
type(string_t), intent(in) :: id
call write_test_module_file (id, var_str ("proc1"), writer%md5sum)
end subroutine test_writer_4_src
subroutine test_writer_4_if (writer, unit, id, feature)
class(test_writer_4_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (n) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), intent(out) :: n"
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
end subroutine test_writer_4_if
subroutine test_writer_4_wr (writer, unit, id, feature)
class(test_writer_4_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
write (unit, *)
write (unit, "(9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (n) bind(C)"
write (unit, "(2x,9A)") "use iso_c_binding"
write (unit, "(2x,9A)") "use tpr_", char (id), ", only: ", &
char (writer%get_procname (feature))
write (unit, "(2x,9A)") "implicit none"
write (unit, "(2x,9A)") "integer(c_int), intent(out) :: n"
write (unit, "(2x,9A)") "call ", char (feature), " (n)"
write (unit, "(9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
end subroutine test_writer_4_wr
subroutine test_writer_4_before_compile (writer, id)
class(test_writer_4_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_4_before_compile
subroutine test_writer_4_after_compile (writer, id)
class(test_writer_4_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_4_after_compile
@ %def test_writer_2_type_name test_writer_4_wr
@ %def test_writer_4_before_compile test_writer_4_after_compile
@
We need a test module file (actually, one for each process in the test
above) that allows us to check compilation and linking. The test
module implements a colorless $1\to 2$ process, and it implements one
additional function (feature), the name given as an argument.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_module_file (basename, feature, md5sum)
type(string_t), intent(in) :: basename
type(string_t), intent(in) :: feature
character(32), intent(in) :: md5sum
integer :: u
u = free_unit ()
open (u, file = char (basename) // ".f90", &
status = "replace", action = "write")
write (u, "(A)") "! (Pseudo) matrix element code file &
&for WHIZARD self-test"
write (u, *)
write (u, "(A)") "module tpr_" // char (basename)
write (u, *)
write (u, "(2x,A)") "use kinds"
write (u, "(2x,A)") "use omega_color, OCF => omega_color_factor"
write (u, *)
write (u, "(2x,A)") "implicit none"
write (u, "(2x,A)") "private"
write (u, *)
call write_test_me_code_1 (u)
write (u, *)
write (u, "(2x,A)") "public :: " // char (feature)
write (u, *)
write (u, "(A)") "contains"
write (u, *)
call write_test_me_code_2 (u, md5sum)
write (u, *)
write (u, "(2x,A)") "subroutine " // char (feature) // " (n)"
write (u, "(2x,A)") " integer, intent(out) :: n"
write (u, "(2x,A)") " n = 42"
write (u, "(2x,A)") "end subroutine " // char (feature)
write (u, *)
write (u, "(A)") "end module tpr_" // char (basename)
close (u)
end subroutine write_test_module_file
@ %def write_test_module_file
@
The following two subroutines provide building blocks for a
matrix-element source code file, useful only for testing the
workflow. The first routine writes the header part, the other routine
the implementation of the procedures listed in the header.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_me_code_1 (u)
integer, intent(in) :: u
write (u, "(2x,A)") "public :: md5sum"
write (u, "(2x,A)") "public :: openmp_supported"
write (u, *)
write (u, "(2x,A)") "public :: n_in"
write (u, "(2x,A)") "public :: n_out"
write (u, "(2x,A)") "public :: n_flv"
write (u, "(2x,A)") "public :: n_hel"
write (u, "(2x,A)") "public :: n_cin"
write (u, "(2x,A)") "public :: n_col"
write (u, "(2x,A)") "public :: n_cf"
write (u, *)
write (u, "(2x,A)") "public :: flv_state"
write (u, "(2x,A)") "public :: hel_state"
write (u, "(2x,A)") "public :: col_state"
write (u, "(2x,A)") "public :: color_factors"
end subroutine write_test_me_code_1
subroutine write_test_me_code_2 (u, md5sum)
integer, intent(in) :: u
character(32), intent(in) :: md5sum
write (u, "(2x,A)") "pure function md5sum ()"
write (u, "(2x,A)") " character(len=32) :: md5sum"
write (u, "(2x,A)") " md5sum = '" // md5sum // "'"
write (u, "(2x,A)") "end function md5sum"
write (u, *)
write (u, "(2x,A)") "pure function openmp_supported () result (status)"
write (u, "(2x,A)") " logical :: status"
write (u, "(2x,A)") " status = .false."
write (u, "(2x,A)") "end function openmp_supported"
write (u, *)
write (u, "(2x,A)") "pure function n_in () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_in"
write (u, *)
write (u, "(2x,A)") "pure function n_out () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 2"
write (u, "(2x,A)") "end function n_out"
write (u, *)
write (u, "(2x,A)") "pure function n_flv () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_flv"
write (u, *)
write (u, "(2x,A)") "pure function n_hel () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_hel"
write (u, *)
write (u, "(2x,A)") "pure function n_cin () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 2"
write (u, "(2x,A)") "end function n_cin"
write (u, *)
write (u, "(2x,A)") "pure function n_col () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_col"
write (u, *)
write (u, "(2x,A)") "pure function n_cf () result (n)"
write (u, "(2x,A)") " integer :: n"
write (u, "(2x,A)") " n = 1"
write (u, "(2x,A)") "end function n_cf"
write (u, *)
write (u, "(2x,A)") "pure subroutine flv_state (a)"
write (u, "(2x,A)") " integer, dimension(:,:), intent(out) :: a"
write (u, "(2x,A)") " a = reshape ([1,2,3], [3,1])"
write (u, "(2x,A)") "end subroutine flv_state"
write (u, *)
write (u, "(2x,A)") "pure subroutine hel_state (a)"
write (u, "(2x,A)") " integer, dimension(:,:), intent(out) :: a"
write (u, "(2x,A)") " a = reshape ([0,0,0], [3,1])"
write (u, "(2x,A)") "end subroutine hel_state"
write (u, *)
write (u, "(2x,A)") "pure subroutine col_state (a, g)"
write (u, "(2x,A)") " integer, dimension(:,:,:), intent(out) :: a"
write (u, "(2x,A)") " logical, dimension(:,:), intent(out) :: g"
write (u, "(2x,A)") " a = reshape ([0,0, 0,0, 0,0], [2,3,1])"
write (u, "(2x,A)") " g = reshape ([.false., .false., .false.], [3,1])"
write (u, "(2x,A)") "end subroutine col_state"
write (u, *)
write (u, "(2x,A)") "pure subroutine color_factors (cf)"
write (u, "(2x,A)") " type(OCF), dimension(:), intent(out) :: cf"
write (u, "(2x,A)") " cf = [ OCF(1,1,+1._default) ]"
write (u, "(2x,A)") "end subroutine color_factors"
end subroutine write_test_me_code_2
@ %def write_test_me_code_1 write_test_me_code_2
@
\subsubsection{Compile test with Fortran bind(C) library}
Test 5: Write driver and makefile and try to compile and link the
library driver.
There is a single test process with a single feature. The process
code is provided as a Fortran library of independent procedures.
These procedures are bind(C).
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_5, "prclib_interfaces_5", &
"compile and link (Fortran library)", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_5
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_5 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
class(prc_writer_t), pointer :: test_writer_5
type(os_data_t) :: os_data
integer :: u_file
integer, dimension(:,:), allocatable :: flv_state
integer, dimension(:,:), allocatable :: hel_state
integer, dimension(:,:,:), allocatable :: col_state
logical, dimension(:,:), allocatable :: ghost_flag
integer, dimension(:,:), allocatable :: cf_index
complex(default), dimension(:), allocatable :: color_factors
character(32), parameter :: md5sum = "prclib_interfaces_5_md5sum "
type(c_funptr) :: proc1_ptr
interface
subroutine proc1_t (n) bind(C)
import
integer(c_int), intent(out) :: n
end subroutine proc1_t
end interface
procedure(proc1_t), pointer :: proc1
integer(c_int) :: n
write (u, "(A)") "* Test output: prclib_interfaces_5"
write (u, "(A)") "* Purpose: compile, link, and load process library"
write (u, "(A)") "* with (fake) matrix-element code &
&as a Fortran bind(C) library"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (1 process)"
write (u, "(A)")
call os_data%init ()
allocate (test_writer_5_t :: test_writer_5)
call dispatch_prclib_driver (driver, var_str ("prclib5"), var_str (""))
call driver%init (1)
call driver%set_md5sum (md5sum)
call driver%set_record (1, var_str ("test5"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_5)
call driver%write (u)
write (u, *)
write (u, "(A)") "* Write makefile"
u_file = free_unit ()
open (u_file, file="prclib5.makefile", status="replace", action="write")
call driver%generate_makefile (u_file, os_data, verbose = .false.)
close (u_file)
write (u, "(A)") "* Write driver source code"
u_file = free_unit ()
open (u_file, file="prclib5.f90", status="replace", action="write")
call driver%generate_driver_code (u_file)
close (u_file)
write (u, "(A)") "* Write matrix-element source code"
call driver%make_source (os_data)
write (u, "(A)") "* Compile source code"
call driver%make_compile (os_data)
write (u, "(A)") "* Link library"
call driver%make_link (os_data)
write (u, "(A)") "* Load library"
call driver%load (os_data)
write (u, *)
call driver%write (u)
write (u, *)
if (driver%loaded) then
write (u, "(A)") "* Call library functions:"
write (u, *)
write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
write (u, "(1x,A,A)") "process_id = ", &
char (driver%get_process_id (1))
write (u, "(1x,A,A)") "model_name = ", &
char (driver%get_model_name (1))
write (u, "(1x,A,A)") "md5sum = ", &
char (driver%get_md5sum (1))
write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)
call driver%set_flv_state (1, flv_state)
write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state
call driver%set_hel_state (1, hel_state)
write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state
call driver%set_col_state (1, col_state, ghost_flag)
write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag
call driver%set_color_factors (1, color_factors, cf_index)
write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index
call driver%get_fptr (1, 1, proc1_ptr)
call c_f_procpointer (proc1_ptr, proc1)
if (associated (proc1)) then
write (u, *)
call proc1 (n)
write (u, "(1x,A,I0)") "proc1(1) = ", n
end if
end if
deallocate (test_writer_5)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_5"
end subroutine prclib_interfaces_5
@ %def prclib_interfaces_5
@ This version of test-code writer writes interfaces for all standard
features plus one specific feature. The interfaces are all bind(C),
so no wrapper is needed.
<<Prclib interfaces: test types>>=
type, extends (prc_writer_c_lib_t) :: test_writer_5_t
contains
procedure, nopass :: type_name => test_writer_5_type_name
procedure :: write_makefile_code => test_writer_5_mk
procedure :: write_source_code => test_writer_5_src
procedure :: write_interface => test_writer_5_if
procedure :: before_compile => test_writer_5_before_compile
procedure :: after_compile => test_writer_5_after_compile
end type test_writer_5_t
@ %def test_writer_5
@ The
<<Prclib interfaces: test auxiliary>>=
function test_writer_5_type_name () result (string)
type(string_t) :: string
string = "test_5"
end function test_writer_5_type_name
subroutine test_writer_5_mk &
(writer, unit, id, os_data, verbose, testflag)
class(test_writer_5_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "SOURCES += ", char (id), ".f90"
write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
if (.not. verbose) then
write (unit, "(5A)") TAB // '@echo " FC " $@'
end if
write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
end subroutine test_writer_5_mk
subroutine test_writer_5_src (writer, id)
class(test_writer_5_t), intent(in) :: writer
type(string_t), intent(in) :: id
call write_test_f_lib_file (id, var_str ("proc1"))
end subroutine test_writer_5_src
subroutine test_writer_5_if (writer, unit, id, feature)
class(test_writer_5_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id, feature
select case (char (feature))
case ("proc1")
write (unit, "(2x,9A)") "interface"
write (unit, "(5x,9A)") "subroutine ", &
char (writer%get_c_procname (id, feature)), &
" (n) bind(C)"
write (unit, "(7x,9A)") "import"
write (unit, "(7x,9A)") "implicit none"
write (unit, "(7x,9A)") "integer(c_int), intent(out) :: n"
write (unit, "(5x,9A)") "end subroutine ", &
char (writer%get_c_procname (id, feature))
write (unit, "(2x,9A)") "end interface"
case default
call writer%write_standard_interface (unit, id, feature)
end select
end subroutine test_writer_5_if
subroutine test_writer_5_before_compile (writer, id)
class(test_writer_5_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_5_before_compile
subroutine test_writer_5_after_compile (writer, id)
class(test_writer_5_t), intent(in) :: writer
type(string_t), intent(in) :: id
end subroutine test_writer_5_after_compile
@ %def test_writer_5_type_name test_writer_5_mk
@ %def test_writer_5_if
@ %def test_writer_5_before_compile test_writer_5_after_compile
@
We need a test module file (actually, one for each process in the test
above) that allows us to check compilation and linking. The test
module implements a colorless $1\to 2$ process, and it implements one
additional function (feature), the name given as an argument.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_f_lib_file (basename, feature)
type(string_t), intent(in) :: basename
type(string_t), intent(in) :: feature
integer :: u
u = free_unit ()
open (u, file = char (basename) // ".f90", &
status = "replace", action = "write")
write (u, "(A)") "! (Pseudo) matrix element code file &
&for WHIZARD self-test"
call write_test_me_code_3 (u, char (basename))
write (u, *)
write (u, "(A)") "subroutine " // char (basename) // "_" &
// char (feature) // " (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), intent(out) :: n"
write (u, "(A)") " n = 42"
write (u, "(A)") "end subroutine " // char (basename) // "_" &
// char (feature)
close (u)
end subroutine write_test_f_lib_file
@ %def write_test_module_file
@
The following matrix-element source code is identical to the previous
one, but modified such as to provide independent procedures without a
module envelope.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_me_code_3 (u, id)
integer, intent(in) :: u
character(*), intent(in) :: id
write (u, "(A)") "function " // id // "_get_md5sum () &
&result (cptr) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " type(c_ptr) :: cptr"
write (u, "(A)") " character(c_char), dimension(32), &
&target, save :: md5sum"
write (u, "(A)") " md5sum = copy (c_char_&
&'1234567890abcdef1234567890abcdef')"
write (u, "(A)") " cptr = c_loc (md5sum)"
write (u, "(A)") "contains"
write (u, "(A)") " function copy (md5sum)"
write (u, "(A)") " character(c_char), dimension(32) :: copy"
write (u, "(A)") " character(c_char), dimension(32), intent(in) :: &
&md5sum"
write (u, "(A)") " copy = md5sum"
write (u, "(A)") " end function copy"
write (u, "(A)") "end function " // id // "_get_md5sum"
write (u, *)
write (u, "(A)") "function " // id // "_openmp_supported () &
&result (status) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " logical(c_bool) :: status"
write (u, "(A)") " status = .false."
write (u, "(A)") "end function " // id // "_openmp_supported"
write (u, *)
write (u, "(A)") "function " // id // "_n_in () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_in"
write (u, *)
write (u, "(A)") "function " // id // "_n_out () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 2"
write (u, "(A)") "end function " // id // "_n_out"
write (u, *)
write (u, "(A)") "function " // id // "_n_flv () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_flv"
write (u, *)
write (u, "(A)") "function " // id // "_n_hel () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_hel"
write (u, *)
write (u, "(A)") "function " // id // "_n_cin () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 2"
write (u, "(A)") "end function " // id // "_n_cin"
write (u, *)
write (u, "(A)") "function " // id // "_n_col () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_col"
write (u, *)
write (u, "(A)") "function " // id // "_n_cf () result (n) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int) :: n"
write (u, "(A)") " n = 1"
write (u, "(A)") "end function " // id // "_n_cf"
write (u, *)
write (u, "(A)") "subroutine " // id // "_flv_state (flv_state) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: flv_state"
write (u, "(A)") " flv_state(1:3) = [1,2,3]"
write (u, "(A)") "end subroutine " // id // "_flv_state"
write (u, *)
write (u, "(A)") "subroutine " // id // "_hel_state (hel_state) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: hel_state"
write (u, "(A)") " hel_state(1:3) = [0,0,0]"
write (u, "(A)") "end subroutine " // id // "_hel_state"
write (u, *)
write (u, "(A)") "subroutine " // id // "_col_state &
&(col_state, ghost_flag) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) &
&:: col_state"
write (u, "(A)") " logical(c_bool), dimension(*), intent(out) &
&:: ghost_flag"
write (u, "(A)") " col_state(1:6) = [0,0, 0,0, 0,0]"
write (u, "(A)") " ghost_flag(1:3) = [.false., .false., .false.]"
write (u, "(A)") "end subroutine " // id // "_col_state"
write (u, *)
write (u, "(A)") "subroutine " // id // "_color_factors &
&(cf_index1, cf_index2, color_factors) bind(C)"
write (u, "(A)") " use iso_c_binding"
write (u, "(A)") " use kinds"
write (u, "(A)") " implicit none"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: cf_index1"
write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: cf_index2"
write (u, "(A)") " complex(c_default_complex), dimension(*), &
&intent(out) :: color_factors"
write (u, "(A)") " cf_index1(1:1) = [1]"
write (u, "(A)") " cf_index2(1:1) = [1]"
write (u, "(A)") " color_factors(1:1) = [1]"
write (u, "(A)") "end subroutine " // id // "_color_factors"
end subroutine write_test_me_code_3
@ %def write_test_me_code_3
@
\subsubsection{Compile test with genuine C library}
Test 6: Write driver and makefile and try to compile and link the
library driver.
There is a single test process with a single feature. The process
code is provided as a C library of independent procedures.
These procedures should match the Fortran bind(C) interface.
<<Prclib interfaces: execute tests>>=
if (default == double .or. (CC_IS_GNU .and. CC_HAS_QUADMATH)) then
call test (prclib_interfaces_6, "prclib_interfaces_6", &
"compile and link (C library)", &
u, results)
end if
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_6
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_6 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
class(prc_writer_t), pointer :: test_writer_6
type(os_data_t) :: os_data
integer :: u_file
integer, dimension(:,:), allocatable :: flv_state
integer, dimension(:,:), allocatable :: hel_state
integer, dimension(:,:,:), allocatable :: col_state
logical, dimension(:,:), allocatable :: ghost_flag
integer, dimension(:,:), allocatable :: cf_index
complex(default), dimension(:), allocatable :: color_factors
character(32), parameter :: md5sum = "prclib_interfaces_6_md5sum "
type(c_funptr) :: proc1_ptr
interface
subroutine proc1_t (n) bind(C)
import
integer(c_int), intent(out) :: n
end subroutine proc1_t
end interface
procedure(proc1_t), pointer :: proc1
integer(c_int) :: n
write (u, "(A)") "* Test output: prclib_interfaces_6"
write (u, "(A)") "* Purpose: compile, link, and load process library"
write (u, "(A)") "* with (fake) matrix-element code &
&as a C library"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (1 process)"
write (u, "(A)")
call os_data%init ()
allocate (test_writer_6_t :: test_writer_6)
call dispatch_prclib_driver (driver, var_str ("prclib6"), var_str (""))
call driver%init (1)
call driver%set_md5sum (md5sum)
call driver%set_record (1, var_str ("test6"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_6)
call driver%write (u)
write (u, *)
write (u, "(A)") "* Write makefile"
u_file = free_unit ()
open (u_file, file="prclib6.makefile", status="replace", action="write")
call driver%generate_makefile (u_file, os_data, verbose = .false.)
close (u_file)
write (u, "(A)") "* Write driver source code"
u_file = free_unit ()
open (u_file, file="prclib6.f90", status="replace", action="write")
call driver%generate_driver_code (u_file)
close (u_file)
write (u, "(A)") "* Write matrix-element source code"
call driver%make_source (os_data)
write (u, "(A)") "* Compile source code"
call driver%make_compile (os_data)
write (u, "(A)") "* Link library"
call driver%make_link (os_data)
write (u, "(A)") "* Load library"
call driver%load (os_data)
write (u, *)
call driver%write (u)
write (u, *)
if (driver%loaded) then
write (u, "(A)") "* Call library functions:"
write (u, *)
write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
write (u, "(1x,A,A)") "process_id = ", &
char (driver%get_process_id (1))
write (u, "(1x,A,A)") "model_name = ", &
char (driver%get_model_name (1))
write (u, "(1x,A,A)") "md5sum = ", &
char (driver%get_md5sum (1))
write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)
call driver%set_flv_state (1, flv_state)
write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state
call driver%set_hel_state (1, hel_state)
write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state
call driver%set_col_state (1, col_state, ghost_flag)
write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag
call driver%set_color_factors (1, color_factors, cf_index)
write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index
call driver%get_fptr (1, 1, proc1_ptr)
call c_f_procpointer (proc1_ptr, proc1)
if (associated (proc1)) then
write (u, *)
call proc1 (n)
write (u, "(1x,A,I0)") "proc1(1) = ", n
end if
end if
deallocate (test_writer_6)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_interfaces_6"
end subroutine prclib_interfaces_6
@ %def prclib_interfaces_6
@ This version of test-code writer writes interfaces for all standard
features plus one specific feature. The interfaces are all bind(C),
so no wrapper is needed.
The driver part is identical to the Fortran case, so we simply extend
the previous [[test_writer_5]] type. We only have to override the
Makefile writer.
<<Prclib interfaces: test types>>=
type, extends (test_writer_5_t) :: test_writer_6_t
contains
procedure, nopass :: type_name => test_writer_6_type_name
procedure :: write_makefile_code => test_writer_6_mk
procedure :: write_source_code => test_writer_6_src
end type test_writer_6_t
@ %def test_writer_6
@
<<Prclib interfaces: test auxiliary>>=
function test_writer_6_type_name () result (string)
type(string_t) :: string
string = "test_6"
end function test_writer_6_type_name
subroutine test_writer_6_mk &
(writer, unit, id, os_data, verbose, testflag)
class(test_writer_6_t), intent(in) :: writer
integer, intent(in) :: unit
type(string_t), intent(in) :: id
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: verbose
logical, intent(in), optional :: testflag
write (unit, "(5A)") "SOURCES += ", char (id), ".c"
write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
write (unit, "(5A)") char (id), ".lo: ", char (id), ".c"
if (.not. verbose) then
write (unit, "(5A)") TAB // '@echo " FC " $@'
end if
write (unit, "(5A)") TAB, "$(LTCCOMPILE) $<"
end subroutine test_writer_6_mk
subroutine test_writer_6_src (writer, id)
class(test_writer_6_t), intent(in) :: writer
type(string_t), intent(in) :: id
call write_test_c_lib_file (id, var_str ("proc1"))
end subroutine test_writer_6_src
@ %def test_writer_6_type_name test_writer_6_mk
@
We need a test module file (actually, one for each process in the test
above) that allows us to check compilation and linking. The test
module implements a colorless $1\to 2$ process, and it implements one
additional function (feature), the name given as an argument.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_c_lib_file (basename, feature)
type(string_t), intent(in) :: basename
type(string_t), intent(in) :: feature
integer :: u
u = free_unit ()
open (u, file = char (basename) // ".c", &
status = "replace", action = "write")
write (u, "(A)") "/* (Pseudo) matrix element code file &
&for WHIZARD self-test */"
write (u, "(A)") "#include <stdbool.h>"
if (CC_HAS_QUADMATH) then
write (u, "(A)") "#include <quadmath.h>"
end if
write (u, *)
call write_test_me_code_4 (u, char (basename))
write (u, *)
write (u, "(A)") "void " // char (basename) // "_" &
// char (feature) // "(int* n) {"
write (u, "(A)") " *n = 42;"
write (u, "(A)") "}"
close (u)
end subroutine write_test_c_lib_file
@ %def write_test_module_file
@
The following matrix-element source code is equivalent to the code in
the previous example, but coded in C.
<<Prclib interfaces: test auxiliary>>=
subroutine write_test_me_code_4 (u, id)
integer, intent(in) :: u
character(*), intent(in) :: id
write (u, "(A)") "char* " // id // "_get_md5sum() {"
write (u, "(A)") " return ""1234567890abcdef1234567890abcdef"";"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "bool " // id // "_openmp_supported() {"
write (u, "(A)") " return false;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_in() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_out() {"
write (u, "(A)") " return 2;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_flv() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_hel() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_cin() {"
write (u, "(A)") " return 2;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_col() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "int " // id // "_n_cf() {"
write (u, "(A)") " return 1;"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "void " // id // "_flv_state( int (*a)[] ) {"
write (u, "(A)") " static int flv_state[1][3] = { { 1, 2, 3 } };"
write (u, "(A)") " int j;"
write (u, "(A)") " for (j = 0; j < 3; j++) { (*a)[j] &
&= flv_state[0][j]; }"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "void " // id // "_hel_state( int (*a)[] ) {"
write (u, "(A)") " static int hel_state[1][3] = { { 0, 0, 0 } };"
write (u, "(A)") " int j;"
write (u, "(A)") " for (j = 0; j < 3; j++) { (*a)[j] &
&= hel_state[0][j]; }"
write (u, "(A)") "}"
write (u, *)
write (u, "(A)") "void " // id // "_col_state&
&( int (*a)[], bool (*g)[] ) {"
write (u, "(A)") " static int col_state[1][3][2] = &
&{ { {0, 0}, {0, 0}, {0, 0} } };"
write (u, "(A)") " static bool ghost_flag[1][3] = &
&{ { false, false, false } };"
write (u, "(A)") " int j,k;"
write (u, "(A)") " for (j = 0; j < 3; j++) {"
write (u, "(A)") " for (k = 0; k < 2; k++) {"
write (u, "(A)") " (*a)[j*2+k] = col_state[0][j][k];"
write (u, "(A)") " }"
write (u, "(A)") " (*g)[j] = ghost_flag[0][j];"
write (u, "(A)") " }"
write (u, "(A)") "}"
write (u, *)
select case (DEFAULT_FC_PRECISION)
case ("quadruple")
write (u, "(A)") "void " // id // "_color_factors&
&( int (*cf_index1)[], int (*cf_index2)[], &
&__complex128 (*color_factors)[] ) {"
case ("extended")
write (u, "(A)") "void " // id // "_color_factors&
&( int (*cf_index1)[], int (*cf_index2)[], &
&long double _Complex (*color_factors)[] ) {"
case default
write (u, "(A)") "void " // id // "_color_factors&
&( int (*cf_index1)[], int (*cf_index2)[], &
&double _Complex (*color_factors)[] ) {"
end select
write (u, "(A)") " (*color_factors)[0] = 1;"
write (u, "(A)") " (*cf_index1)[0] = 1;"
write (u, "(A)") " (*cf_index2)[0] = 1;"
write (u, "(A)") "}"
end subroutine write_test_me_code_4
@ %def write_test_me_code_4
@
\subsubsection{Test cleanup targets}
Test 7: Repeat test 4 (create, compile, link Fortran module and
driver) and properly clean up all generated files.
<<Prclib interfaces: execute tests>>=
call test (prclib_interfaces_7, "prclib_interfaces_7", &
"cleanup", &
u, results)
<<Prclib interfaces: test declarations>>=
public :: prclib_interfaces_7
<<Prclib interfaces: tests>>=
subroutine prclib_interfaces_7 (u)
integer, intent(in) :: u
class(prclib_driver_t), allocatable :: driver
class(prc_writer_t), pointer :: test_writer_4
type(os_data_t) :: os_data
integer :: u_file
character(32), parameter :: md5sum = "1234567890abcdef1234567890abcdef"
write (u, "(A)") "* Test output: prclib_interfaces_7"
write (u, "(A)") "* Purpose: compile and link process library"
write (u, "(A)") "* with (fake) matrix-element code &
&as a Fortran module"
write (u, "(A)") "* then clean up generated files"
write (u, *)
write (u, "(A)") "* Create a prclib driver object (1 process)"
allocate (test_writer_4_t :: test_writer_4)
call os_data%init ()
call dispatch_prclib_driver (driver, var_str ("prclib7"), var_str (""))
call driver%init (1)
call driver%set_md5sum (md5sum)
call driver%set_record (1, var_str ("test7"), var_str ("Test_model"), &
[var_str ("proc1")], test_writer_4)
write (u, "(A)") "* Write makefile"
u_file = free_unit ()
open (u_file, file="prclib7.makefile", status="replace", action="write")
call driver%generate_makefile (u_file, os_data, verbose = .false.)
close (u_file)
write (u, "(A)") "* Write driver source code"
u_file = free_unit ()
open (u_file, file="prclib7.f90", status="replace", action="write")
call driver%generate_driver_code (u_file)
close (u_file)
write (u, "(A)") "* Write matrix-element source code"
call driver%make_source (os_data)
write (u, "(A)") "* Compile source code"
call driver%make_compile (os_data)
write (u, "(A)") "* Link library"
call driver%make_link (os_data)
write (u, "(A)") "* File check"
write (u, *)
call check_file (u, "test7.f90")
call check_file (u, "tpr_test7.mod")
call check_file (u, "test7.lo")
call check_file (u, "prclib7.makefile")
call check_file (u, "prclib7.f90")
call check_file (u, "prclib7.lo")
call check_file (u, "prclib7.la")
write (u, *)
write (u, "(A)") "* Delete library"
write (u, *)
call driver%clean_library (os_data)
call check_file (u, "prclib7.la")
write (u, *)
write (u, "(A)") "* Delete object code"
write (u, *)
call driver%clean_objects (os_data)
call check_file (u, "test7.lo")
call check_file (u, "tpr_test7.mod")
call check_file (u, "prclib7.lo")
write (u, *)
write (u, "(A)") "* Delete source code"
write (u, *)
call driver%clean_source (os_data)
call check_file (u, "test7.f90")
write (u, *)
write (u, "(A)") "* Delete driver source code"
write (u, *)
call driver%clean_driver (os_data)
call check_file (u, "prclib7.f90")
write (u, *)
write (u, "(A)") "* Delete makefile"
write (u, *)
call driver%clean_makefile (os_data)
call check_file (u, "prclib7.makefile")
deallocate (test_writer_4)
write (u, *)
write (u, "(A)") "* Test output end: prclib_interfaces_7"
end subroutine prclib_interfaces_7
@ %def prclib_interfaces_7
@ Auxiliary routine: check and report existence of a file
<<Prclib interfaces: test auxiliary>>=
subroutine check_file (u, file)
integer, intent(in) :: u
character(*), intent(in) :: file
logical :: exist
inquire (file=file, exist=exist)
write (u, "(2x,A,A,L1)") file, " = ", exist
end subroutine check_file
@ %def check_file
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Abstract process core configuration}
In this module, we define abstract data types that handle the method-specific
part of defining a process (including all of its options) and accessing an
external matrix element.
There are no unit tests, these are deferred to the [[process_libraries]]
module below.
<<[[prc_core_def.f90]]>>=
<<File header>>
module prc_core_def
<<Use strings>>
- use io_units
- use diagnostics
-
use process_constants
use prclib_interfaces
<<Standard module head>>
<<Prc core def: public>>
<<Prc core def: types>>
<<Prc core def: interfaces>>
+ interface
+<<Prc core def: sub interfaces>>
+ end interface
+
+end module prc_core_def
+@ %def prc_core_def
+@
+<<[[prc_core_def_sub.f90]]>>=
+<<File header>>
+
+submodule (prc_core_def) prc_core_def_s
+
+ use io_units
+ use diagnostics
+
+ implicit none
+
contains
<<Prc core def: procedures>>
-end module prc_core_def
-@ %def prc_core_def
+end submodule prc_core_def_s
+
+@ %def prc_core_def_s
@
\subsection{Process core definition type}
For storing configuration data that depend on the specific process
variant, we introduce a polymorphic type. At this point, we just
declare an abstract base type. This allows us to defer the
implementation to later modules.
There should be no components that need explicit finalization,
otherwise we would have to call a finalizer from the
[[process_component_def_t]] wrapper.
@ Translate a [[prc_core_def_t]] to above named integers
<<Prc core def: public>>=
public :: prc_core_def_t
<<Prc core def: types>>=
type, abstract :: prc_core_def_t
class(prc_writer_t), allocatable :: writer
contains
<<Prc core def: process core def: TBP>>
end type prc_core_def_t
@ %def prc_core_def_t
@ Interfaces for the deferred methods.
This returns a string. No passed argument; the string is constant and
depends just on the type.
<<Prc core def: process core def: TBP>>=
procedure (prc_core_def_get_string), nopass, deferred :: type_string
<<Prc core def: interfaces>>=
abstract interface
function prc_core_def_get_string () result (string)
import
type(string_t) :: string
end function prc_core_def_get_string
end interface
@ %def prc_core_def_get_string
@
The [[write]] method should
display the content completely.
<<Prc core def: process core def: TBP>>=
procedure (prc_core_def_write), deferred :: write
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_write (object, unit)
import
class(prc_core_def_t), intent(in) :: object
integer, intent(in) :: unit
end subroutine prc_core_def_write
end interface
@ %def prc_core_def_write
@
The [[read]] method should
fill the content completely.
<<Prc core def: process core def: TBP>>=
procedure (prc_core_def_read), deferred :: read
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_read (object, unit)
import
class(prc_core_def_t), intent(out) :: object
integer, intent(in) :: unit
end subroutine prc_core_def_read
end interface
@ %def prc_core_def_read
@ This communicates a MD5 checksum to the writer inside the [[core_def]]
object, if there is any. Usually, this checksum is not yet known at the time
when the writer is initialized.
<<Prc core def: process core def: TBP>>=
procedure :: set_md5sum => prc_core_def_set_md5sum
+<<Prc core def: sub interfaces>>=
+ module subroutine prc_core_def_set_md5sum (core_def, md5sum)
+ class(prc_core_def_t), intent(inout) :: core_def
+ character(32) :: md5sum
+ end subroutine prc_core_def_set_md5sum
<<Prc core def: procedures>>=
- subroutine prc_core_def_set_md5sum (core_def, md5sum)
+ module subroutine prc_core_def_set_md5sum (core_def, md5sum)
class(prc_core_def_t), intent(inout) :: core_def
character(32) :: md5sum
if (allocated (core_def%writer)) core_def%writer%md5sum = md5sum
end subroutine prc_core_def_set_md5sum
@ %def prc_core_def_set_md5sum
@ Allocate an appropriate driver object which corresponds to the
chosen process core definition.
For internal matrix element (i.e., those which do not need external
code), the driver should have access to all matrix element information
from the beginning. In short, it is the matrix-element code.
For external matrix elements, the driver will get access to the
external matrix element code.
<<Prc core def: process core def: TBP>>=
procedure(prc_core_def_allocate_driver), deferred :: allocate_driver
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_allocate_driver (object, driver, basename)
import
class(prc_core_def_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
end subroutine prc_core_def_allocate_driver
end interface
@ %def prc_core_def_allocate_driver
@ This flag tells whether the particular variant needs external code.
We implement a default function which returns false. The flag
depends only on the type, therefore we implement it as [[nopass]].
<<Prc core def: process core def: TBP>>=
procedure, nopass :: needs_code => prc_core_def_needs_code
+<<Prc core def: sub interfaces>>=
+ module function prc_core_def_needs_code () result (flag)
+ logical :: flag
+ end function prc_core_def_needs_code
<<Prc core def: procedures>>=
- function prc_core_def_needs_code () result (flag)
+ module function prc_core_def_needs_code () result (flag)
logical :: flag
flag = .false.
end function prc_core_def_needs_code
@ %def prc_core_def_needs_code
@ This subroutine allocates an array which holds the name of all
features that this process core implements. This feature
applies to matrix element code that is not coded as a Fortran module
but communicates via independent library functions, which follow the C
calling conventions. The addresses of those functions are returned as
C function pointers, which can be converted into Fortran procedure
pointers. The conversion is done in code specific for the process
variant; here we just retrieve the C function pointer.
The array returned here serves the purpose of writing specific
driver code. The driver interfaces only those C functions which are
supported for the given process core.
If the process core does not require external code, this array is
meaningless.
<<Prc core def: process core def: TBP>>=
procedure(prc_core_def_get_features), nopass, deferred &
:: get_features
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_get_features (features)
import
type(string_t), dimension(:), allocatable, intent(out) :: features
end subroutine prc_core_def_get_features
end interface
@ %def prc_core_def_get_features
@ Assign pointers to the process-specific procedures to the driver, if
the process is external.
<<Prc core def: process core def: TBP>>=
procedure(prc_core_def_connect), deferred :: connect
<<Prc core def: interfaces>>=
abstract interface
subroutine prc_core_def_connect (def, lib_driver, i, proc_driver)
import
class(prc_core_def_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
end subroutine prc_core_def_connect
end interface
@ %def prc_core_def_connect
@
\subsection{Process core template}
We must be able to automatically allocate a process core definition object
with the appropriate type, given only the type name.
To this end, we introduce a [[prc_template_t]] type which is simply a wrapper
for an empty [[prc_core_def_t]] object. Choosing one of the templates from an
array, we can allocate the target object.
<<Prc core def: public>>=
public :: prc_template_t
<<Prc core def: types>>=
type :: prc_template_t
class(prc_core_def_t), allocatable :: core_def
end type prc_template_t
@ %def prc_template_t
@ The allocation routine. We use the [[source]] option of the [[allocate]]
statement. The [[mold]] option would probably more appropriate, but is a
F2008 feature.
<<Prc core def: public>>=
public :: allocate_core_def
+<<Prc core def: sub interfaces>>=
+ module subroutine allocate_core_def (template, name, core_def)
+ type(prc_template_t), dimension(:), intent(in) :: template
+ type(string_t), intent(in) :: name
+ class(prc_core_def_t), allocatable :: core_def
+ end subroutine allocate_core_def
<<Prc core def: procedures>>=
- subroutine allocate_core_def (template, name, core_def)
+ module subroutine allocate_core_def (template, name, core_def)
type(prc_template_t), dimension(:), intent(in) :: template
type(string_t), intent(in) :: name
class(prc_core_def_t), allocatable :: core_def
integer :: i
do i = 1, size (template)
if (template(i)%core_def%type_string () == name) then
allocate (core_def, source = template(i)%core_def)
return
end if
end do
end subroutine allocate_core_def
@ %def allocate_core_def
@
\subsection{Process driver}
For each process component, we implement a driver object which holds
the calls to the matrix element and various auxiliary routines as
procedure pointers. Any actual calculation will use this object to
communicate with the process.
Depending on the type of process (as described by a corresponding
[[prc_core_def]] object), the procedure pointers may refer to
external or internal code, and there may be additional procedures for
certain types. The base type defined here is abstract.
<<Prc core def: public>>=
public :: prc_core_driver_t
<<Prc core def: types>>=
type, abstract :: prc_core_driver_t
contains
<<Prc core def: process driver: TBP>>
end type prc_core_driver_t
@ %def prc_core_driver_t
@ This returns the process type. No reference to contents.
<<Prc core def: process driver: TBP>>=
procedure(prc_core_driver_type_name), nopass, deferred :: type_name
<<Prc core def: interfaces>>=
abstract interface
function prc_core_driver_type_name () result (type)
import
type(string_t) :: type
end function prc_core_driver_type_name
end interface
@ %def prc_core_driver_type_name
@
\subsection{Process driver for intrinsic process}
This is an abstract extension for the driver type. It has one
additional method, namely a subroutine that fills the record of
constant process data. For an external process, this task is
performed by the external library driver instead.
<<Prc core def: public>>=
public :: process_driver_internal_t
<<Prc core def: types>>=
type, extends (prc_core_driver_t), abstract :: process_driver_internal_t
contains
<<Prc core def: process driver internal: TBP>>
end type process_driver_internal_t
@ %def process_driver_internal_t
<<Prc core def: process driver internal: TBP>>=
procedure(process_driver_fill_constants), deferred :: fill_constants
<<Prc core def: interfaces>>=
abstract interface
subroutine process_driver_fill_constants (driver, data)
import
class(process_driver_internal_t), intent(in) :: driver
type(process_constants_t), intent(out) :: data
end subroutine process_driver_fill_constants
end interface
@ %def process_driver_fill_constants
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process library access}
\label{sec:process_libraries}
Processes (the code and data that are necessary for evaluating matrix
elements of a particular process or process component) are organized
in process libraries. In full form, process libraries contain
generated and dynamically compiled and linked code, so they are actual
libraries on the OS level. Alternatively, there may be simple
processes that can be generated without referring to external
libraries, and external libraries that are just linked in.
This module interfaces the OS to create, build, and use process
libraries.
We work with two related data structures. There is the list of
process configurations that stores the user input and data derived
from it. A given process configuration list is scanned for creating a
process library, which consists of both data and code. The creation
step involves calling external programs and incorporating external
code.
For the subsequent integration and event generation steps, we read the
process library. We also support partial (re)creation of the process
library. To this end, we should be able to reconstruct the
configuration data records from the process library.
<<[[process_libraries.f90]]>>=
<<File header>>
module process_libraries
use, intrinsic :: iso_c_binding !NODEP!
<<Use strings>>
- use io_units
- use diagnostics
- use md5
use physics_defs
use os_interface
use model_data
use particle_specifiers
use process_constants
use prclib_interfaces
use prc_core_def
<<Standard module head>>
<<Process libraries: public>>
<<Process libraries: parameters>>
<<Process libraries: types>>
+ interface
+<<Process libraries: sub interfaces>>
+ end interface
+
+end module process_libraries
+
+@ %def process_libraries
+@
+<<[[process_libraries_sub.f90]]>>=
+<<File header>>
+
+submodule (process_libraries) process_libraries_s
+
+ use io_units
+ use diagnostics
+ use md5
+
+ implicit none
+
contains
<<Process libraries: procedures>>
-end module process_libraries
-@ %def process_libraries
+end submodule process_libraries_s
+
+@ %def process_libraries_s
@
\subsection{Auxiliary stuff}
Here is a small subroutine that strips the left-hand side and the
equals sign off an equation.
<<Process libraries: public>>=
public :: strip_equation_lhs
+<<Process libraries: sub interfaces>>=
+ module subroutine strip_equation_lhs (buffer)
+ character(*), intent(inout) :: buffer
+ end subroutine strip_equation_lhs
<<Process libraries: procedures>>=
- subroutine strip_equation_lhs (buffer)
+ module subroutine strip_equation_lhs (buffer)
character(*), intent(inout) :: buffer
type(string_t) :: string, prefix
string = buffer
call split (string, prefix, "=")
buffer = string
end subroutine strip_equation_lhs
@ %def strip_equation_lhs
@
\subsection{Process definition objects}
We collect process configuration data in a derived type,
[[process_def_t]]. A process can be a collection of several
components which are treated as a single entity for the purpose of
observables and event generation. Multiple process components may
initially be defined by the user. The system may add additional
components, e.g., subtraction terms. The common data type is
[[process_component_def_t]]. Within each component, there are several
universal data items, and a part which depend on the particular
process variant. The latter is covered by an abstract type
[[prc_core_def_t]] and its extensions.
@
\subsubsection{Wrapper for components}
We define a wrapper type for the configuration of individual
components.
The string [[basename]] is used for building file, module, and
function names for the current process component. Initially, it will
be built from the corresponding process basename by appending an
alphanumeric suffix.
The logical [[initial]] tells whether this is a user-defined (true) or
system-generated (false) configuration.
The numbers [[n_in]], [[n_out]], and [[n_tot]] denote the incoming,
outgoing and total number of particles (partons) participating in the
process component, respectively. These are the nominal particles, as
input by the user (recombination may change the particle content, for
the output events).
The string arrays [[prt_in]] and [[prt_out]] hold the particle
specifications as provided by the user. For a system-generated
process component, they remain deallocated.
The [[method]] string is used to determine the type of process matrix
element and how it is obtained.
The [[description]] string collects the information about particle
content and method in a single human-readable string.
The pointer object [[core_def]] is allocated according to the
actual process variant, which depends on the method. The subobject
holds any additional configuration data that is relevant for the
process component.
We assume that no finalizer is needed.
<<Process libraries: public>>=
public :: process_component_def_t
<<Process libraries: types>>=
type :: process_component_def_t
private
type(string_t) :: basename
logical :: initial = .false.
integer :: n_in = 0
integer :: n_out = 0
integer :: n_tot = 0
type(prt_spec_t), dimension(:), allocatable :: prt_in
type(prt_spec_t), dimension(:), allocatable :: prt_out
type(string_t) :: method
type(string_t) :: description
class(prc_core_def_t), allocatable :: core_def
character(32) :: md5sum = ""
integer :: nlo_type = BORN
integer, dimension(N_ASSOCIATED_COMPONENTS) :: associated_components = 0
logical :: active
integer :: fixed_emitter = -1
integer :: alpha_power = 0
integer :: alphas_power = 0
contains
<<Process libraries: process component def: TBP>>
end type process_component_def_t
@ %def process_component_def_t
@ Display the complete content.
<<Process libraries: process component def: TBP>>=
procedure :: write => process_component_def_write
+<<Process libraries: sub interfaces>>=
+ module subroutine process_component_def_write (object, unit)
+ class(process_component_def_t), intent(in) :: object
+ integer, intent(in), optional :: unit
+ end subroutine process_component_def_write
<<Process libraries: procedures>>=
- subroutine process_component_def_write (object, unit)
+ module subroutine process_component_def_write (object, unit)
class(process_component_def_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(3x,A,A)") "Component ID = ", char (object%basename)
write (u, "(3x,A,L1)") "Initial component = ", object%initial
write (u, "(3x,A,I0,1x,I0,1x,I0)") "N (in, out, tot) = ", &
object%n_in, object%n_out, object%n_tot
write (u, "(3x,A)", advance="no") "Particle content = "
if (allocated (object%prt_in)) then
call prt_spec_write (object%prt_in, u, advance="no")
else
write (u, "(A)", advance="no") "[undefined]"
end if
write (u, "(A)", advance="no") " => "
if (allocated (object%prt_out)) then
call prt_spec_write (object%prt_out, u, advance="no")
else
write (u, "(A)", advance="no") "[undefined]"
end if
write (u, "(A)")
if (object%method /= "") then
write (u, "(3x,A,A)") "Method = ", &
char (object%method)
else
write (u, "(3x,A)") "Method = [undefined]"
end if
if (allocated (object%core_def)) then
write (u, "(3x,A,A)") "Process variant = ", &
char (object%core_def%type_string ())
call object%core_def%write (u)
else
write (u, "(3x,A)") "Process variant = [undefined]"
end if
write (u, "(3x,A,A,A)") "MD5 sum (def) = '", object%md5sum, "'"
end subroutine process_component_def_write
@ %def process_component_def_write
@ Read the process component definition. Allocate the process variant
definition with appropriate type, matching the type name on file with
the provided templates.
<<Process libraries: process component def: TBP>>=
procedure :: read => process_component_def_read
+<<Process libraries: sub interfaces>>=
+ module subroutine process_component_def_read (component, unit, core_def_templates)
+ class(process_component_def_t), intent(out) :: component
+ integer, intent(in) :: unit
+ type(prc_template_t), dimension(:), intent(in) :: core_def_templates
+ end subroutine process_component_def_read
<<Process libraries: procedures>>=
- subroutine process_component_def_read (component, unit, core_def_templates)
+ module subroutine process_component_def_read (component, unit, core_def_templates)
class(process_component_def_t), intent(out) :: component
integer, intent(in) :: unit
type(prc_template_t), dimension(:), intent(in) :: core_def_templates
character(80) :: buffer
type(string_t) :: var_buffer, prefix, in_state, out_state
type(string_t) :: variant_type
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
component%basename = trim (adjustl (buffer))
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) component%initial
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) component%n_in, component%n_out, component%n_tot
call get (unit, var_buffer)
call split (var_buffer, prefix, "=") ! keeps 'in => out'
call split (var_buffer, prefix, "=") ! actually: separator is '=>'
in_state = prefix
if (component%n_in > 0) then
call prt_spec_read (component%prt_in, in_state)
end if
out_state = extract (var_buffer, 2)
if (component%n_out > 0) then
call prt_spec_read (component%prt_out, out_state)
end if
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
component%method = trim (adjustl (buffer))
if (component%method == "[undefined]") &
component%method = ""
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
variant_type = trim (adjustl (buffer))
call allocate_core_def &
(core_def_templates, variant_type, component%core_def)
if (allocated (component%core_def)) then
call component%core_def%read (unit)
end if
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer(3:34), "(A32)") component%md5sum
end subroutine process_component_def_read
@ %def process_component_def_read
@ Short account.
<<Process libraries: process component def: TBP>>=
procedure :: show => process_component_def_show
+<<Process libraries: sub interfaces>>=
+ module subroutine process_component_def_show (object, unit)
+ class(process_component_def_t), intent(in) :: object
+ integer, intent(in), optional :: unit
+ end subroutine process_component_def_show
<<Process libraries: procedures>>=
- subroutine process_component_def_show (object, unit)
+ module subroutine process_component_def_show (object, unit)
class(process_component_def_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(6x,A)", advance="no") char (object%basename)
if (.not. object%initial) &
write (u, "('*')", advance="no")
write (u, "(':',1x)", advance="no")
if (allocated (object%prt_in)) then
call prt_spec_write (object%prt_in, u, advance="no")
else
write (u, "(A)", advance="no") "[undefined]"
end if
write (u, "(A)", advance="no") " => "
if (allocated (object%prt_out)) then
call prt_spec_write (object%prt_out, u, advance="no")
else
write (u, "(A)", advance="no") "[undefined]"
end if
if (object%method /= "") then
write (u, "(2x,'[',A,']')") char (object%method)
else
write (u, *)
end if
end subroutine process_component_def_show
@ %def process_component_def_show
@ Compute the MD5 sum of a process component. We reset the stored MD5
sum to the empty string (so a previous value is not included in the
calculation), then write a temporary file and calculate the MD5 sum of
that file.
This implies that all data that are displayed by the [[write]] method
become part of the MD5 sum calculation.
The [[model]] is not part of the object, but must be included in the MD5 sum.
Otherwise, modifying the model and nothing else would not trigger remaking the
process-component source. Note that the model parameters may change later and
therefore are not incorporated.
After the MD5 sum of the component has been computed, we communicate it to the
[[writer]] subobject of the specific [[core_def]] component. Although these
types are abstract, the MD5-related features are valid for the abstract
types.
<<Process libraries: process component def: TBP>>=
procedure :: compute_md5sum => process_component_def_compute_md5sum
+<<Process libraries: sub interfaces>>=
+ module subroutine process_component_def_compute_md5sum (component, model)
+ class(process_component_def_t), intent(inout) :: component
+ class(model_data_t), intent(in), optional, target :: model
+ end subroutine process_component_def_compute_md5sum
<<Process libraries: procedures>>=
- subroutine process_component_def_compute_md5sum (component, model)
+ module subroutine process_component_def_compute_md5sum (component, model)
class(process_component_def_t), intent(inout) :: component
class(model_data_t), intent(in), optional, target :: model
integer :: u
component%md5sum = ""
u = free_unit ()
open (u, status = "scratch", action = "readwrite")
if (present (model)) write (u, "(A32)") model%get_md5sum ()
call component%write (u)
rewind (u)
component%md5sum = md5sum (u)
close (u)
if (allocated (component%core_def)) then
call component%core_def%set_md5sum (component%md5sum)
end if
end subroutine process_component_def_compute_md5sum
@ %def process_component_def_compute_md5sum
@
<<Process libraries: process component def: TBP>>=
procedure :: get_def_type_string => process_component_def_get_def_type_string
+<<Process libraries: sub interfaces>>=
+ module function process_component_def_get_def_type_string (component) result (type_string)
+ type(string_t) :: type_string
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_def_type_string
<<Process libraries: procedures>>=
- function process_component_def_get_def_type_string (component) result (type_string)
+ module function process_component_def_get_def_type_string (component) result (type_string)
type(string_t) :: type_string
class(process_component_def_t), intent(in) :: component
type_string = component%core_def%type_string ()
end function process_component_def_get_def_type_string
@ %def process_component_def_get_def_type_string
@ Allocate the process driver (with a suitable type) for a process
component. For internal processes, we may set all data already at
this stage.
<<Process libraries: process component def: TBP>>=
procedure :: allocate_driver => process_component_def_allocate_driver
+<<Process libraries: sub interfaces>>=
+ module subroutine process_component_def_allocate_driver (component, driver)
+ class(process_component_def_t), intent(in) :: component
+ class(prc_core_driver_t), intent(out), allocatable :: driver
+ end subroutine process_component_def_allocate_driver
<<Process libraries: procedures>>=
- subroutine process_component_def_allocate_driver (component, driver)
+ module subroutine process_component_def_allocate_driver (component, driver)
class(process_component_def_t), intent(in) :: component
class(prc_core_driver_t), intent(out), allocatable :: driver
if (allocated (component%core_def)) then
call component%core_def%allocate_driver (driver, component%basename)
end if
end subroutine process_component_def_allocate_driver
@ %def process_component_def_allocate_driver
@ Tell whether the process core needs external code.
<<Process libraries: process component def: TBP>>=
procedure :: needs_code => process_component_def_needs_code
+<<Process libraries: sub interfaces>>=
+ module function process_component_def_needs_code (component) result (flag)
+ class(process_component_def_t), intent(in) :: component
+ logical :: flag
+ end function process_component_def_needs_code
<<Process libraries: procedures>>=
- function process_component_def_needs_code (component) result (flag)
+ module function process_component_def_needs_code (component) result (flag)
class(process_component_def_t), intent(in) :: component
logical :: flag
flag = component%core_def%needs_code ()
end function process_component_def_needs_code
@ %def process_component_def_needs_code
@ If there is external code, the [[core_def]] subobject should
provide a writer object. This method returns a pointer to the writer.
<<Process libraries: process component def: TBP>>=
procedure :: get_writer_ptr => process_component_def_get_writer_ptr
+<<Process libraries: sub interfaces>>=
+ module function process_component_def_get_writer_ptr (component) result (writer)
+ class(process_component_def_t), intent(in), target :: component
+ class(prc_writer_t), pointer :: writer
+ end function process_component_def_get_writer_ptr
<<Process libraries: procedures>>=
- function process_component_def_get_writer_ptr (component) result (writer)
+ module function process_component_def_get_writer_ptr (component) result (writer)
class(process_component_def_t), intent(in), target :: component
class(prc_writer_t), pointer :: writer
writer => component%core_def%writer
end function process_component_def_get_writer_ptr
@ %def process_component_def_get_writer_ptr
@ Return an array which holds the names of all C functions that this
process component implements.
<<Process libraries: process component def: TBP>>=
procedure :: get_features => process_component_def_get_features
+<<Process libraries: sub interfaces>>=
+ module function process_component_def_get_features (component) result (features)
+ class(process_component_def_t), intent(in) :: component
+ type(string_t), dimension(:), allocatable :: features
+ end function process_component_def_get_features
<<Process libraries: procedures>>=
- function process_component_def_get_features (component) result (features)
+ module function process_component_def_get_features (component) result (features)
class(process_component_def_t), intent(in) :: component
type(string_t), dimension(:), allocatable :: features
call component%core_def%get_features (features)
end function process_component_def_get_features
@ %def process_component_def_get_features
@ Assign procedure pointers in the [[driver]] component (external
processes). For internal processes, this is meaningless.
<<Process libraries: process component def: TBP>>=
procedure :: connect => process_component_def_connect
+<<Process libraries: sub interfaces>>=
+ module subroutine process_component_def_connect &
+ (component, lib_driver, i, proc_driver)
+ class(process_component_def_t), intent(in) :: component
+ class(prclib_driver_t), intent(in) :: lib_driver
+ integer, intent(in) :: i
+ class(prc_core_driver_t), intent(inout) :: proc_driver
+ end subroutine process_component_def_connect
<<Process libraries: procedures>>=
- subroutine process_component_def_connect &
+ module subroutine process_component_def_connect &
(component, lib_driver, i, proc_driver)
class(process_component_def_t), intent(in) :: component
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
select type (proc_driver)
class is (process_driver_internal_t)
!!! Nothing to do
class default
call component%core_def%connect (lib_driver, i, proc_driver)
end select
end subroutine process_component_def_connect
@ %def process_component_def_connect
@ Return a pointer to the process core definition, which is of
abstract type.
<<Process libraries: process component def: TBP>>=
procedure :: get_core_def_ptr => process_component_get_core_def_ptr
+<<Process libraries: sub interfaces>>=
+ module function process_component_get_core_def_ptr (component) result (ptr)
+ class(process_component_def_t), intent(in), target :: component
+ class(prc_core_def_t), pointer :: ptr
+ end function process_component_get_core_def_ptr
<<Process libraries: procedures>>=
- function process_component_get_core_def_ptr (component) result (ptr)
+ module function process_component_get_core_def_ptr (component) result (ptr)
class(process_component_def_t), intent(in), target :: component
class(prc_core_def_t), pointer :: ptr
ptr => component%core_def
end function process_component_get_core_def_ptr
@ %def process_component_get_core_def_ptr
@ Return nominal particle counts, as input by the user.
<<Process libraries: process component def: TBP>>=
procedure :: get_n_in => process_component_def_get_n_in
procedure :: get_n_out => process_component_def_get_n_out
procedure :: get_n_tot => process_component_def_get_n_tot
+<<Process libraries: sub interfaces>>=
+ module function process_component_def_get_n_in (component) result (n_in)
+ class(process_component_def_t), intent(in) :: component
+ integer :: n_in
+ end function process_component_def_get_n_in
+ module function process_component_def_get_n_out (component) result (n_out)
+ class(process_component_def_t), intent(in) :: component
+ integer :: n_out
+ end function process_component_def_get_n_out
+ module function process_component_def_get_n_tot (component) result (n_tot)
+ class(process_component_def_t), intent(in) :: component
+ integer :: n_tot
+ end function process_component_def_get_n_tot
<<Process libraries: procedures>>=
- function process_component_def_get_n_in (component) result (n_in)
+ module function process_component_def_get_n_in (component) result (n_in)
class(process_component_def_t), intent(in) :: component
integer :: n_in
n_in = component%n_in
end function process_component_def_get_n_in
- function process_component_def_get_n_out (component) result (n_out)
+ module function process_component_def_get_n_out (component) result (n_out)
class(process_component_def_t), intent(in) :: component
integer :: n_out
n_out = component%n_out
end function process_component_def_get_n_out
- function process_component_def_get_n_tot (component) result (n_tot)
+ module function process_component_def_get_n_tot (component) result (n_tot)
class(process_component_def_t), intent(in) :: component
integer :: n_tot
n_tot = component%n_tot
end function process_component_def_get_n_tot
@ %def process_component_def_get_n_in
@ %def process_component_def_get_n_out
@ %def process_component_def_get_n_tot
@ Allocate and return string arrays for the incoming and outgoing particles.
<<Process libraries: process component def: TBP>>=
procedure :: get_prt_in => process_component_def_get_prt_in
procedure :: get_prt_out => process_component_def_get_prt_out
+<<Process libraries: sub interfaces>>=
+ module subroutine process_component_def_get_prt_in (component, prt)
+ class(process_component_def_t), intent(in) :: component
+ type(string_t), dimension(:), intent(out), allocatable :: prt
+ end subroutine process_component_def_get_prt_in
+ module subroutine process_component_def_get_prt_out (component, prt)
+ class(process_component_def_t), intent(in) :: component
+ type(string_t), dimension(:), intent(out), allocatable :: prt
+ end subroutine process_component_def_get_prt_out
<<Process libraries: procedures>>=
- subroutine process_component_def_get_prt_in (component, prt)
+ module subroutine process_component_def_get_prt_in (component, prt)
class(process_component_def_t), intent(in) :: component
type(string_t), dimension(:), intent(out), allocatable :: prt
integer :: i
allocate (prt (component%n_in))
do i = 1, component%n_in
prt(i) = component%prt_in(i)%to_string ()
end do
end subroutine process_component_def_get_prt_in
- subroutine process_component_def_get_prt_out (component, prt)
+ module subroutine process_component_def_get_prt_out (component, prt)
class(process_component_def_t), intent(in) :: component
type(string_t), dimension(:), intent(out), allocatable :: prt
integer :: i
allocate (prt (component%n_out))
do i = 1, component%n_out
prt(i) = component%prt_out(i)%to_string ()
end do
end subroutine process_component_def_get_prt_out
@ %def process_component_def_get_prt_in
@ %def process_component_def_get_prt_out
@ Return the incoming and outgoing particle specifiers as-is.
<<Process libraries: process component def: TBP>>=
procedure :: get_prt_spec_in => process_component_def_get_prt_spec_in
procedure :: get_prt_spec_out => process_component_def_get_prt_spec_out
+<<Process libraries: sub interfaces>>=
+ module function process_component_def_get_prt_spec_in (component) result (prt)
+ class(process_component_def_t), intent(in) :: component
+ type(prt_spec_t), dimension(:), allocatable :: prt
+ end function process_component_def_get_prt_spec_in
+ module function process_component_def_get_prt_spec_out (component) result (prt)
+ class(process_component_def_t), intent(in) :: component
+ type(prt_spec_t), dimension(:), allocatable :: prt
+ end function process_component_def_get_prt_spec_out
<<Process libraries: procedures>>=
- function process_component_def_get_prt_spec_in (component) result (prt)
+ module function process_component_def_get_prt_spec_in (component) result (prt)
class(process_component_def_t), intent(in) :: component
type(prt_spec_t), dimension(:), allocatable :: prt
allocate (prt (component%n_in))
prt(:) = component%prt_in(:)
end function process_component_def_get_prt_spec_in
- function process_component_def_get_prt_spec_out (component) result (prt)
+ module function process_component_def_get_prt_spec_out (component) result (prt)
class(process_component_def_t), intent(in) :: component
type(prt_spec_t), dimension(:), allocatable :: prt
allocate (prt (component%n_out))
prt(:) = component%prt_out(:)
end function process_component_def_get_prt_spec_out
@ %def process_component_def_get_prt_spec_in
@ %def process_component_def_get_prt_spec_out
@ Return the combination of incoming particles as a PDG code
<<Process libraries: process component def: TBP>>=
procedure :: get_pdg_in => process_component_def_get_pdg_in
+<<Process libraries: sub interfaces>>=
+ module subroutine process_component_def_get_pdg_in (component, model, pdg)
+ class(process_component_def_t), intent(in) :: component
+ class(model_data_t), intent(in), target :: model
+ integer, intent(out), dimension(:) :: pdg
+ end subroutine process_component_def_get_pdg_in
<<Process libraries: procedures>>=
- subroutine process_component_def_get_pdg_in (component, model, pdg)
+ module subroutine process_component_def_get_pdg_in (component, model, pdg)
class(process_component_def_t), intent(in) :: component
class(model_data_t), intent(in), target :: model
integer, intent(out), dimension(:) :: pdg
integer :: i
do i = 1, size (pdg)
pdg(i) = model%get_pdg (component%prt_in(i)%to_string ())
end do
end subroutine process_component_def_get_pdg_in
@ %def process_component_def_get_pdg_in
@ Return the MD5 sum.
<<Process libraries: process component def: TBP>>=
procedure :: get_md5sum => process_component_def_get_md5sum
+<<Process libraries: sub interfaces>>=
+ pure module function process_component_def_get_md5sum (component) result (md5sum)
+ class(process_component_def_t), intent(in) :: component
+ character(32) :: md5sum
+ end function process_component_def_get_md5sum
<<Process libraries: procedures>>=
- pure function process_component_def_get_md5sum (component) result (md5sum)
+ pure module function process_component_def_get_md5sum (component) result (md5sum)
class(process_component_def_t), intent(in) :: component
character(32) :: md5sum
md5sum = component%md5sum
end function process_component_def_get_md5sum
@ %def process_component_def_get_md5sum
@ Get NLO data
<<Process libraries: process component def: TBP>>=
procedure :: get_nlo_type => process_component_def_get_nlo_type
procedure :: get_associated_born &
=> process_component_def_get_associated_born
procedure :: get_associated_real_fin &
=> process_component_def_get_associated_real_fin
procedure :: get_associated_real_sing &
=> process_component_def_get_associated_real_sing
procedure :: get_associated_subtraction &
=> process_component_def_get_associated_subtraction
procedure :: get_association_list &
=> process_component_def_get_association_list
procedure :: can_be_integrated &
=> process_component_def_can_be_integrated
procedure :: get_associated_real => process_component_def_get_associated_real
+<<Process libraries: sub interfaces>>=
+ elemental module function process_component_def_get_nlo_type &
+ (component) result (nlo_type)
+ integer :: nlo_type
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_nlo_type
+ elemental module function process_component_def_get_associated_born &
+ (component) result (i_born)
+ integer :: i_born
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_associated_born
+ elemental module function process_component_def_get_associated_real_fin &
+ (component) result (i_rfin)
+ integer :: i_rfin
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_associated_real_fin
+ elemental module function process_component_def_get_associated_real_sing &
+ (component) result (i_rsing)
+ integer :: i_rsing
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_associated_real_sing
+ elemental module function process_component_def_get_associated_subtraction &
+ (component) result (i_sub)
+ integer :: i_sub
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_associated_subtraction
+ elemental module function process_component_def_can_be_integrated &
+ (component) result (active)
+ logical :: active
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_can_be_integrated
+ module function process_component_def_get_association_list &
+ (component, i_skip_in) result (list)
+ integer, dimension(:), allocatable :: list
+ class(process_component_def_t), intent(in) :: component
+ integer, intent(in), optional :: i_skip_in
+ end function process_component_def_get_association_list
+ module function process_component_def_get_associated_real &
+ (component) result (i_real)
+ integer :: i_real
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_associated_real
<<Process libraries: procedures>>=
- elemental function process_component_def_get_nlo_type (component) result (nlo_type)
+ elemental module function process_component_def_get_nlo_type &
+ (component) result (nlo_type)
integer :: nlo_type
class(process_component_def_t), intent(in) :: component
nlo_type = component%nlo_type
end function process_component_def_get_nlo_type
- elemental function process_component_def_get_associated_born (component) result (i_born)
+ elemental module function process_component_def_get_associated_born &
+ (component) result (i_born)
integer :: i_born
class(process_component_def_t), intent(in) :: component
i_born = component%associated_components(ASSOCIATED_BORN)
end function process_component_def_get_associated_born
- elemental function process_component_def_get_associated_real_fin (component) result (i_rfin)
+ elemental module function process_component_def_get_associated_real_fin &
+ (component) result (i_rfin)
integer :: i_rfin
class(process_component_def_t), intent(in) :: component
i_rfin = component%associated_components(ASSOCIATED_REAL_FIN)
end function process_component_def_get_associated_real_fin
- elemental function process_component_def_get_associated_real_sing (component) result (i_rsing)
+ elemental module function process_component_def_get_associated_real_sing &
+ (component) result (i_rsing)
integer :: i_rsing
class(process_component_def_t), intent(in) :: component
i_rsing = component%associated_components(ASSOCIATED_REAL_SING)
end function process_component_def_get_associated_real_sing
- elemental function process_component_def_get_associated_subtraction (component) result (i_sub)
+ elemental module function process_component_def_get_associated_subtraction &
+ (component) result (i_sub)
integer :: i_sub
class(process_component_def_t), intent(in) :: component
i_sub = component%associated_components(ASSOCIATED_SUB)
end function process_component_def_get_associated_subtraction
- elemental function process_component_def_can_be_integrated (component) result (active)
+ elemental module function process_component_def_can_be_integrated &
+ (component) result (active)
logical :: active
class(process_component_def_t), intent(in) :: component
active = component%active
end function process_component_def_can_be_integrated
- function process_component_def_get_association_list (component, i_skip_in) result (list)
+ module function process_component_def_get_association_list &
+ (component, i_skip_in) result (list)
integer, dimension(:), allocatable :: list
class(process_component_def_t), intent(in) :: component
integer, intent(in), optional :: i_skip_in
integer :: i, j, n, i_skip
logical :: valid
i_skip = 0; if (present (i_skip_in)) i_skip = i_skip_in
n = count (component%associated_components /= 0) - 1
if (i_skip > 0) then
if (component%associated_components(i_skip) > 0) n = n - 1
end if
allocate (list (n))
j = 1
do i = 1, size(component%associated_components)
valid = component%associated_components(i) /= 0 &
.and. i /= ASSOCIATED_SUB .and. i /= i_skip
if (valid) then
list(j) = component%associated_components(i)
j = j + 1
end if
end do
end function process_component_def_get_association_list
- function process_component_def_get_associated_real (component) result (i_real)
+ module function process_component_def_get_associated_real &
+ (component) result (i_real)
integer :: i_real
class(process_component_def_t), intent(in) :: component
i_real = component%associated_components(ASSOCIATED_REAL)
end function process_component_def_get_associated_real
@ %def process_component_def_get_nlo_type, process_component_def_get_associated_born
@ %def process_component_def_can_be_integrated
@ %def process_component_def_get_association_list
@ %def process_component_def_get_associated_real
@ %def process_component_def_get_associated_real_fin
@ %def process_component_def_get_associated_subtraction
@
<<Process libraries: process component def: TBP>>=
procedure :: get_me_method => process_component_def_get_me_method
+<<Process libraries: sub interfaces>>=
+ elemental module function process_component_def_get_me_method (component) result (method)
+ type(string_t) :: method
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_me_method
<<Process libraries: procedures>>=
- elemental function process_component_def_get_me_method (component) result (method)
+ elemental module function process_component_def_get_me_method (component) result (method)
type(string_t) :: method
class(process_component_def_t), intent(in) :: component
method = component%method
end function process_component_def_get_me_method
@ %def process_component_def_get_me_method
@
<<Process libraries: process component def: TBP>>=
procedure :: get_fixed_emitter => process_component_def_get_fixed_emitter
+<<Process libraries: sub interfaces>>=
+ module function process_component_def_get_fixed_emitter (component) result (emitter)
+ integer :: emitter
+ class(process_component_def_t), intent(in) :: component
+ end function process_component_def_get_fixed_emitter
<<Process libraries: procedures>>=
- function process_component_def_get_fixed_emitter (component) result (emitter)
- integer :: emitter
- class(process_component_def_t), intent(in) :: component
- emitter = component%fixed_emitter
+ module function process_component_def_get_fixed_emitter (component) result (emitter)
+ integer :: emitter
+ class(process_component_def_t), intent(in) :: component
+ emitter = component%fixed_emitter
end function process_component_def_get_fixed_emitter
@ %def process_component_def_get_fixed_emitter
@
<<Process libraries: process component def: TBP>>=
procedure :: get_coupling_powers => process_component_def_get_coupling_powers
+<<Process libraries: sub interfaces>>=
+ pure module subroutine process_component_def_get_coupling_powers &
+ (component, alpha_power, alphas_power)
+ class(process_component_def_t), intent(in) :: component
+ integer, intent(out) :: alpha_power, alphas_power
+ end subroutine process_component_def_get_coupling_powers
<<Process libraries: procedures>>=
- pure subroutine process_component_def_get_coupling_powers (component, alpha_power, alphas_power)
+ pure module subroutine process_component_def_get_coupling_powers &
+ (component, alpha_power, alphas_power)
class(process_component_def_t), intent(in) :: component
integer, intent(out) :: alpha_power, alphas_power
alpha_power = component%alpha_power
alphas_power = component%alphas_power
end subroutine process_component_def_get_coupling_powers
@ %def process_component_def_get_coupling_powers
@
\subsubsection{Process definition}
The process component definitions are collected in a common process
definition object.
The [[id]] is the ID string that the user has provided for identifying
this process. It must be a string that is allowed as part of a
Fortran variable name, since it may be used for generating code.
The number [[n_in]] is 1 or 2 for a decay or scattering process,
respectively. This must be identical to [[n_in]] for all components.
The initial and extra component definitions (see above) are allocated as the
[[initial]] and [[extra]] arrays, respectively. The latter
are determined from the former.
The [[md5sum]] is used to verify the integrity of the configuration.
<<Process libraries: public>>=
public :: process_def_t
<<Process libraries: types>>=
type :: process_def_t
private
type(string_t) :: id
integer :: num_id = 0
class(model_data_t), pointer :: model => null ()
type(string_t) :: model_name
integer :: n_in = 0
integer :: n_initial = 0
integer :: n_extra = 0
type(process_component_def_t), dimension(:), allocatable :: initial
type(process_component_def_t), dimension(:), allocatable :: extra
character(32) :: md5sum = ""
logical :: nlo_process = .false.
logical :: negative_sf = .false.
logical :: requires_resonances = .false.
contains
<<Process libraries: process def: TBP>>
end type process_def_t
@ %def process_def_t
@ Write the process definition including components:
<<Process libraries: process def: TBP>>=
procedure :: write => process_def_write
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_write (object, unit)
+ class(process_def_t), intent(in) :: object
+ integer, intent(in) :: unit
+ end subroutine process_def_write
<<Process libraries: procedures>>=
- subroutine process_def_write (object, unit)
+ module subroutine process_def_write (object, unit)
class(process_def_t), intent(in) :: object
integer, intent(in) :: unit
integer :: i
write (unit, "(1x,A,A,A)") "ID = '", char (object%id), "'"
if (object%num_id /= 0) &
write (unit, "(1x,A,I0)") "ID(num) = ", object%num_id
select case (object%n_in)
case (1); write (unit, "(1x,A)") "Decay"
case (2); write (unit, "(1x,A)") "Scattering"
case default
write (unit, "(1x,A)") "[Undefined process]"
return
end select
if (object%model_name /= "") then
write (unit, "(1x,A,A)") "Model = ", char (object%model_name)
else
write (unit, "(1x,A)") "Model = [undefined]"
end if
write (unit, "(1x,A,I0)") "Initially defined component(s) = ", &
object%n_initial
write (unit, "(1x,A,I0)") "Extra generated component(s) = ", &
object%n_extra
if (object%requires_resonances) then
! This line has to matched with the reader below!
write (unit, "(1x,A,I0)") "Resonant subprocesses required"
end if
write (unit, "(1x,A,A,A)") "MD5 sum = '", object%md5sum, "'"
if (allocated (object%initial)) then
do i = 1, size (object%initial)
write (unit, "(1x,A,I0)") "Component #", i
call object%initial(i)%write (unit)
end do
end if
if (allocated (object%extra)) then
do i = 1, size (object%extra)
write (unit, "(1x,A,I0)") "Component #", object%n_initial + i
call object%extra(i)%write (unit)
end do
end if
end subroutine process_def_write
@ %def process_def_write
@ Read the process definition including components.
<<Process libraries: process def: TBP>>=
procedure :: read => process_def_read
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_read (object, unit, core_def_templates)
+ class(process_def_t), intent(out) :: object
+ integer, intent(in) :: unit
+ type(prc_template_t), dimension(:), intent(in) :: core_def_templates
+ end subroutine process_def_read
<<Process libraries: procedures>>=
- subroutine process_def_read (object, unit, core_def_templates)
+ module subroutine process_def_read (object, unit, core_def_templates)
class(process_def_t), intent(out) :: object
integer, intent(in) :: unit
type(prc_template_t), dimension(:), intent(in) :: core_def_templates
integer :: i, i1, i2
character(80) :: buffer, ref
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
i1 = scan (buffer, "'")
i2 = scan (buffer, "'", back=.true.)
if (i2 > i1) then
object%id = buffer(i1+1:i2-1)
else
object%id = ""
end if
read (unit, "(A)") buffer
select case (buffer(2:11))
case ("Decay "); object%n_in = 1
case ("Scattering"); object%n_in = 2
case default
return
end select
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
object%model_name = trim (adjustl (buffer))
if (object%model_name == "[undefined]") object%model_name = ""
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) object%n_initial
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) object%n_extra
read (unit, "(A)") buffer
if (buffer(1:9) == " Resonant") then
object%requires_resonances = .true.
read (unit, "(A)") buffer
else
object%requires_resonances = .false.
end if
call strip_equation_lhs (buffer)
read (buffer(3:34), "(A32)") object%md5sum
if (object%n_initial > 0) then
allocate (object%initial (object%n_initial))
do i = 1, object%n_initial
read (unit, "(A)") buffer
write (ref, "(1x,A,I0)") "Component #", i
if (buffer /= ref) return ! Wrong component header
call object%initial(i)%read (unit, core_def_templates)
end do
end if
end subroutine process_def_read
@ %def process_def_read
@ Short account.
<<Process libraries: process def: TBP>>=
procedure :: show => process_def_show
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_show (object, unit)
+ class(process_def_t), intent(in) :: object
+ integer, intent(in) :: unit
+ end subroutine process_def_show
<<Process libraries: procedures>>=
- subroutine process_def_show (object, unit)
+ module subroutine process_def_show (object, unit)
class(process_def_t), intent(in) :: object
integer, intent(in) :: unit
integer :: i
write (unit, "(4x,A)", advance="no") char (object%id)
if (object%num_id /= 0) &
write (unit, "(1x,'(',I0,')')", advance="no") object%num_id
if (object%model_name /= "") &
write (unit, "(1x,'[',A,']')", advance="no") char (object%model_name)
if (object%requires_resonances) then
write (unit, "(1x,A)", advance="no") "[+ resonant subprocesses]"
end if
write (unit, *)
if (allocated (object%initial)) then
do i = 1, size (object%initial)
call object%initial(i)%show (unit)
end do
end if
if (allocated (object%extra)) then
do i = 1, size (object%extra)
call object%extra(i)%show (unit)
end do
end if
end subroutine process_def_show
@ %def process_def_show
@ Initialize an entry (initialize the process definition inside). We
allocate the 'initial' set of components. Extra components remain
unallocated.
The model should be present as a pointer. This allows us to retrieve the
model's MD5 sum. However, for various tests it is sufficient to have the
name.
We create the basenames for the process components by appending a
suffix which we increment for each component.
<<Process libraries: process def: TBP>>=
procedure :: init => process_def_init
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_init (def, id, &
+ model, model_name, n_in, n_components, num_id, &
+ nlo_process, negative_sf, requires_resonances)
+ class(process_def_t), intent(out) :: def
+ type(string_t), intent(in), optional :: id
+ class(model_data_t), intent(in), optional, target :: model
+ type(string_t), intent(in), optional :: model_name
+ integer, intent(in), optional :: n_in
+ integer, intent(in), optional :: n_components
+ integer, intent(in), optional :: num_id
+ logical, intent(in), optional :: nlo_process
+ logical, intent(in), optional :: negative_sf
+ logical, intent(in), optional :: requires_resonances
+ end subroutine process_def_init
<<Process libraries: procedures>>=
- subroutine process_def_init (def, id, &
+ module subroutine process_def_init (def, id, &
model, model_name, n_in, n_components, num_id, &
nlo_process, negative_sf, requires_resonances)
class(process_def_t), intent(out) :: def
type(string_t), intent(in), optional :: id
class(model_data_t), intent(in), optional, target :: model
type(string_t), intent(in), optional :: model_name
integer, intent(in), optional :: n_in
integer, intent(in), optional :: n_components
integer, intent(in), optional :: num_id
logical, intent(in), optional :: nlo_process
logical, intent(in), optional :: negative_sf
logical, intent(in), optional :: requires_resonances
character(16) :: suffix
integer :: i
if (present (id)) then
def%id = id
else
def%id = ""
end if
if (present (num_id)) then
def%num_id = num_id
end if
if (present (model)) then
def%model => model
def%model_name = model%get_name ()
else
def%model => null ()
if (present (model_name)) then
def%model_name = model_name
else
def%model_name = ""
end if
end if
if (present (n_in)) def%n_in = n_in
if (present (n_components)) then
def%n_initial = n_components
allocate (def%initial (n_components))
end if
if (present (nlo_process)) then
def%nlo_process = nlo_process
end if
if (present (negative_sf)) then
def%negative_sf = negative_sf
end if
if (present (requires_resonances)) then
def%requires_resonances = requires_resonances
end if
def%initial%initial = .true.
def%initial%method = ""
do i = 1, def%n_initial
write (suffix, "(A,I0)") "_i", i
def%initial(i)%basename = def%id // trim (suffix)
end do
def%initial%description = ""
end subroutine process_def_init
@ %def process_def_init
@ Explicitly set the model name (for unit test).
<<Process libraries: process def: TBP>>=
procedure :: set_model_name => process_def_set_model_name
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_set_model_name (def, model_name)
+ class(process_def_t), intent(inout) :: def
+ type(string_t), intent(in) :: model_name
+ end subroutine process_def_set_model_name
<<Process libraries: procedures>>=
- subroutine process_def_set_model_name (def, model_name)
+ module subroutine process_def_set_model_name (def, model_name)
class(process_def_t), intent(inout) :: def
type(string_t), intent(in) :: model_name
def%model_name = model_name
end subroutine process_def_set_model_name
@ %def process_def_set_model_name
@ Initialize an initial component. The particle content
must be specified. The process core block is not (yet) allocated.
We assume that the particle arrays match the [[n_in]] and
[[n_out]] values in size. The model is referred to by name; it is
identified as an existing model later. The index [[i]] must refer to
an existing element of the component array.
Data specific for the process core of a component are imported as
the [[core_def]] argument. We should allocate an object of class
[[prc_core_def_t]] with the appropriate specific type, fill it,
and transfer it to the process component definition here. The
allocation is moved, so the original allocated object is returned empty.
<<Process libraries: process def: TBP>>=
procedure :: import_component => process_def_import_component
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_import_component (def, &
+ i, n_out, prt_in, prt_out, method, variant, &
+ nlo_type, can_be_integrated)
+ class(process_def_t), intent(inout) :: def
+ integer, intent(in) :: i
+ integer, intent(in), optional :: n_out
+ type(prt_spec_t), dimension(:), intent(in), optional :: prt_in
+ type(prt_spec_t), dimension(:), intent(in), optional :: prt_out
+ type(string_t), intent(in), optional :: method
+ integer, intent(in), optional :: nlo_type
+ logical, intent(in), optional :: can_be_integrated
+ class(prc_core_def_t), &
+ intent(inout), allocatable, optional :: variant
+ end subroutine process_def_import_component
<<Process libraries: procedures>>=
- subroutine process_def_import_component (def, &
+ module subroutine process_def_import_component (def, &
i, n_out, prt_in, prt_out, method, variant, &
nlo_type, can_be_integrated)
class(process_def_t), intent(inout) :: def
integer, intent(in) :: i
integer, intent(in), optional :: n_out
type(prt_spec_t), dimension(:), intent(in), optional :: prt_in
type(prt_spec_t), dimension(:), intent(in), optional :: prt_out
type(string_t), intent(in), optional :: method
integer, intent(in), optional :: nlo_type
logical, intent(in), optional :: can_be_integrated
type(string_t) :: nlo_type_string
class(prc_core_def_t), &
intent(inout), allocatable, optional :: variant
integer :: p
associate (comp => def%initial(i))
if (present (n_out)) then
comp%n_in = def%n_in
comp%n_out = n_out
comp%n_tot = def%n_in + n_out
end if
if (present (prt_in)) then
allocate (comp%prt_in (size (prt_in)))
comp%prt_in = prt_in
end if
if (present (prt_out)) then
allocate (comp%prt_out (size (prt_out)))
comp%prt_out = prt_out
end if
if (present (method)) comp%method = method
if (present (variant)) then
call move_alloc (variant, comp%core_def)
end if
if (present (nlo_type)) then
comp%nlo_type = nlo_type
end if
if (present (can_be_integrated)) then
comp%active = can_be_integrated
else
comp%active = .true.
end if
if (allocated (comp%prt_in) .and. allocated (comp%prt_out)) then
associate (d => comp%description)
d = ""
do p = 1, size (prt_in)
if (p > 1) d = d // ", "
d = d // comp%prt_in(p)%to_string ()
end do
d = d // " => "
do p = 1, size (prt_out)
if (p > 1) d = d // ", "
d = d // comp%prt_out(p)%to_string ()
end do
if (comp%method /= "") then
if ((def%nlo_process .and. .not. comp%active) .or. &
comp%nlo_type == NLO_SUBTRACTION) then
d = d // " [inactive]"
else
d = d // " [" // comp%method // "]"
end if
end if
nlo_type_string = component_status (comp%nlo_type)
if (nlo_type_string /= "born") then
d = d // ", [" // nlo_type_string // "]"
end if
end associate
end if
end associate
end subroutine process_def_import_component
@ %def process_def_import_component
@
<<Process libraries: process def: TBP>>=
procedure :: get_n_components => process_def_get_n_components
+<<Process libraries: sub interfaces>>=
+ module function process_def_get_n_components (def) result (n)
+ class(process_def_t), intent(in) :: def
+ integer :: n
+ end function process_def_get_n_components
<<Process libraries: procedures>>=
- function process_def_get_n_components (def) result (n)
+ module function process_def_get_n_components (def) result (n)
class(process_def_t), intent(in) :: def
integer :: n
n = size (def%initial)
end function process_def_get_n_components
@ %def process_def_get_n_components
@
<<Process libraries: process def: TBP>>=
procedure :: set_fixed_emitter => process_def_set_fixed_emitter
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_set_fixed_emitter (def, i, emitter)
+ class(process_def_t), intent(inout) :: def
+ integer, intent(in) :: i, emitter
+ end subroutine process_def_set_fixed_emitter
<<Process libraries: procedures>>=
- subroutine process_def_set_fixed_emitter (def, i, emitter)
+ module subroutine process_def_set_fixed_emitter (def, i, emitter)
class(process_def_t), intent(inout) :: def
integer, intent(in) :: i, emitter
def%initial(i)%fixed_emitter = emitter
end subroutine process_def_set_fixed_emitter
@ %def process_def_set_fixed_emitter
@
<<Process libraries: process def: TBP>>=
procedure :: set_coupling_powers => process_def_set_coupling_powers
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_set_coupling_powers (def, alpha_power, alphas_power)
+ class(process_def_t), intent(inout) :: def
+ integer, intent(in) :: alpha_power, alphas_power
+ end subroutine process_def_set_coupling_powers
<<Process libraries: procedures>>=
- subroutine process_def_set_coupling_powers (def, alpha_power, alphas_power)
+ module subroutine process_def_set_coupling_powers (def, alpha_power, alphas_power)
class(process_def_t), intent(inout) :: def
integer, intent(in) :: alpha_power, alphas_power
def%initial(1)%alpha_power = alpha_power
def%initial(1)%alphas_power = alphas_power
end subroutine process_def_set_coupling_powers
@ %def process_def_set_coupling_powers
@
<<Process libraries: process def: TBP>>=
procedure :: set_associated_components => &
process_def_set_associated_components
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_set_associated_components (def, i, &
+ i_list, remnant, real_finite, mismatch)
+ class(process_def_t), intent(inout) :: def
+ logical, intent(in) :: remnant, real_finite, mismatch
+ integer, intent(in) :: i
+ integer, dimension(:), intent(in) :: i_list
+ end subroutine process_def_set_associated_components
<<Process libraries: procedures>>=
- subroutine process_def_set_associated_components (def, i, &
+ module subroutine process_def_set_associated_components (def, i, &
i_list, remnant, real_finite, mismatch)
class(process_def_t), intent(inout) :: def
logical, intent(in) :: remnant, real_finite, mismatch
integer, intent(in) :: i
integer, dimension(:), intent(in) :: i_list
integer :: add_index
add_index = 0
associate (comp => def%initial(i)%associated_components)
comp(ASSOCIATED_BORN) = i_list(1)
comp(ASSOCIATED_REAL) = i_list(2)
comp(ASSOCIATED_VIRT) = i_list(3)
comp(ASSOCIATED_SUB) = i_list(4)
if (remnant) then
comp(ASSOCIATED_PDF) = i_list(5)
add_index = add_index + 1
end if
if (real_finite) then
comp(ASSOCIATED_REAL_FIN) = i_list(5+add_index)
add_index = add_index + 1
end if
if (mismatch) then
!!! incomplete
end if
end associate
end subroutine process_def_set_associated_components
@ %def process_def_set_associated_components
@
Compute the MD5 sum for this process definition. We compute the MD5
sums for all components individually, than concatenate a string of
those and compute the MD5 sum of this string. We also include the
model name. All other data part of the component definitions.
<<Process libraries: process def: TBP>>=
procedure :: compute_md5sum => process_def_compute_md5sum
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_compute_md5sum (def, model)
+ class(process_def_t), intent(inout) :: def
+ class(model_data_t), intent(in), optional, target :: model
+ end subroutine process_def_compute_md5sum
<<Process libraries: procedures>>=
- subroutine process_def_compute_md5sum (def, model)
+ module subroutine process_def_compute_md5sum (def, model)
class(process_def_t), intent(inout) :: def
class(model_data_t), intent(in), optional, target :: model
integer :: i
type(string_t) :: buffer
buffer = def%model_name
do i = 1, def%n_initial
call def%initial(i)%compute_md5sum (model)
buffer = buffer // def%initial(i)%md5sum
end do
do i = 1, def%n_extra
call def%extra(i)%compute_md5sum (model)
buffer = buffer // def%initial(i)%md5sum
end do
def%md5sum = md5sum (char (buffer))
end subroutine process_def_compute_md5sum
@ %def process_def_compute_md5sum
@ Return the MD5 sum of the process or of a process component.
<<Process libraries: process def: TBP>>=
procedure :: get_md5sum => process_def_get_md5sum
+<<Process libraries: sub interfaces>>=
+ module function process_def_get_md5sum (def, i_component) result (md5sum)
+ class(process_def_t), intent(in) :: def
+ integer, intent(in), optional :: i_component
+ character(32) :: md5sum
+ end function process_def_get_md5sum
<<Process libraries: procedures>>=
- function process_def_get_md5sum (def, i_component) result (md5sum)
+ module function process_def_get_md5sum (def, i_component) result (md5sum)
class(process_def_t), intent(in) :: def
integer, intent(in), optional :: i_component
character(32) :: md5sum
if (present (i_component)) then
md5sum = def%initial(i_component)%md5sum
else
md5sum = def%md5sum
end if
end function process_def_get_md5sum
@ %def process_def_get_md5sum
@ Return a pointer to the definition of a particular component (for
test purposes).
<<Process libraries: process def: TBP>>=
procedure :: get_core_def_ptr => process_def_get_core_def_ptr
+<<Process libraries: sub interfaces>>=
+ module function process_def_get_core_def_ptr (def, i_component) result (ptr)
+ class(process_def_t), intent(in), target :: def
+ integer, intent(in) :: i_component
+ class(prc_core_def_t), pointer :: ptr
+ end function process_def_get_core_def_ptr
<<Process libraries: procedures>>=
- function process_def_get_core_def_ptr (def, i_component) result (ptr)
+ module function process_def_get_core_def_ptr (def, i_component) result (ptr)
class(process_def_t), intent(in), target :: def
integer, intent(in) :: i_component
class(prc_core_def_t), pointer :: ptr
ptr => def%initial(i_component)%get_core_def_ptr ()
end function process_def_get_core_def_ptr
@ %def process_def_get_core_def_ptr
@
This query tells whether a specific process component relies on
external code. This includes all traditional WHIZARD matrix elements
which rely on \oMega\ for code generation. Other process components
(trivial decays, subtraction terms) do not require external code.
NOTE: Implemented only for initial component.
The query is passed to the process component.
<<Process libraries: process def: TBP>>=
procedure :: needs_code => process_def_needs_code
+<<Process libraries: sub interfaces>>=
+ module function process_def_needs_code (def, i_component) result (flag)
+ class(process_def_t), intent(in) :: def
+ integer, intent(in) :: i_component
+ logical :: flag
+ end function process_def_needs_code
<<Process libraries: procedures>>=
- function process_def_needs_code (def, i_component) result (flag)
+ module function process_def_needs_code (def, i_component) result (flag)
class(process_def_t), intent(in) :: def
integer, intent(in) :: i_component
logical :: flag
flag = def%initial(i_component)%needs_code ()
end function process_def_needs_code
@ %def process_def_needs_code
@ Return the first entry for the incoming particle(s), PDG code, of
this process.
<<Process libraries: process def: TBP>>=
procedure :: get_pdg_in_1 => process_def_get_pdg_in_1
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_get_pdg_in_1 (def, pdg)
+ class(process_def_t), intent(in), target :: def
+ integer, dimension(:), intent(out) :: pdg
+ end subroutine process_def_get_pdg_in_1
<<Process libraries: procedures>>=
- subroutine process_def_get_pdg_in_1 (def, pdg)
+ module subroutine process_def_get_pdg_in_1 (def, pdg)
class(process_def_t), intent(in), target :: def
integer, dimension(:), intent(out) :: pdg
call def%initial(1)%get_pdg_in (def%model, pdg)
end subroutine process_def_get_pdg_in_1
@ %def process_def_get_pdg_in_1
@
<<Process libraries: process def: TBP>>=
procedure :: is_nlo => process_def_is_nlo
+<<Process libraries: sub interfaces>>=
+ elemental module function process_def_is_nlo (def) result (flag)
+ logical :: flag
+ class(process_def_t), intent(in) :: def
+ end function process_def_is_nlo
<<Process libraries: procedures>>=
- elemental function process_def_is_nlo (def) result (flag)
+ elemental module function process_def_is_nlo (def) result (flag)
logical :: flag
class(process_def_t), intent(in) :: def
flag = def%nlo_process
end function process_def_is_nlo
@ %def process_def_is_nlo
@
<<Process libraries: process def: TBP>>=
procedure :: get_nlo_type => process_def_get_nlo_type
+<<Process libraries: sub interfaces>>=
+ elemental module function process_def_get_nlo_type (def, i_component) result (nlo_type)
+ integer :: nlo_type
+ class(process_def_t), intent(in) :: def
+ integer, intent(in) :: i_component
+ end function process_def_get_nlo_type
<<Process libraries: procedures>>=
- elemental function process_def_get_nlo_type (def, i_component) result (nlo_type)
+ elemental module function process_def_get_nlo_type (def, i_component) result (nlo_type)
integer :: nlo_type
class(process_def_t), intent(in) :: def
integer, intent(in) :: i_component
nlo_type = def%initial(i_component)%nlo_type
end function process_def_get_nlo_type
@ %def process_def_get_nlo_type
@
<<Process libraries: process def: TBP>>=
procedure :: get_negative_sf => process_def_get_negative_sf
+<<Process libraries: sub interfaces>>=
+ elemental module function process_def_get_negative_sf (def) result (neg_sf)
+ logical :: neg_sf
+ class(process_def_t), intent(in) :: def
+ end function process_def_get_negative_sf
<<Process libraries: procedures>>=
- elemental function process_def_get_negative_sf (def) result (neg_sf)
+ elemental module function process_def_get_negative_sf (def) result (neg_sf)
logical :: neg_sf
class(process_def_t), intent(in) :: def
neg_sf = def%negative_sf
end function process_def_get_negative_sf
@ %def process_def_get_negative_sf
@ Number of incoming particles, common to all components.
<<Process libraries: process def: TBP>>=
procedure :: get_n_in => process_def_get_n_in
+<<Process libraries: sub interfaces>>=
+ module function process_def_get_n_in (def) result (n_in)
+ class(process_def_t), intent(in) :: def
+ integer :: n_in
+ end function process_def_get_n_in
<<Process libraries: procedures>>=
- function process_def_get_n_in (def) result (n_in)
+ module function process_def_get_n_in (def) result (n_in)
class(process_def_t), intent(in) :: def
integer :: n_in
n_in = def%n_in
end function process_def_get_n_in
@ %def process_def_get_n_in
@ Pointer to a particular component definition record.
<<Process libraries: process def: TBP>>=
procedure :: get_component_def_ptr => process_def_get_component_def_ptr
+<<Process libraries: sub interfaces>>=
+ module function process_def_get_component_def_ptr (def, i) result (component)
+ type(process_component_def_t), pointer :: component
+ class(process_def_t), intent(in), target :: def
+ integer, intent(in) :: i
+ end function process_def_get_component_def_ptr
<<Process libraries: procedures>>=
- function process_def_get_component_def_ptr (def, i) result (component)
+ module function process_def_get_component_def_ptr (def, i) result (component)
type(process_component_def_t), pointer :: component
class(process_def_t), intent(in), target :: def
integer, intent(in) :: i
if (i <= def%n_initial) then
component => def%initial(i)
else
component => null ()
end if
end function process_def_get_component_def_ptr
@ %def process_def_get_component_def_ptr
@
\subsubsection{Process definition list}
A list of process definitions is the starting point for creating a
process library. The list is built when reading the user input. When
reading an existing process library, the list is used for
cross-checking and updating the configuration.
We need a type for the list entry. The simplest way is to extend the
process definition type, so all methods apply to the process
definition directly.
<<Process libraries: public>>=
public :: process_def_entry_t
<<Process libraries: types>>=
type, extends (process_def_t) :: process_def_entry_t
private
type(process_def_entry_t), pointer :: next => null ()
end type process_def_entry_t
@ %def process_def_entry_t
@ This is the type for the list itself.
<<Process libraries: public>>=
public :: process_def_list_t
<<Process libraries: types>>=
type :: process_def_list_t
private
type(process_def_entry_t), pointer :: first => null ()
type(process_def_entry_t), pointer :: last => null ()
contains
<<Process libraries: process def list: TBP>>
end type process_def_list_t
@ %def process_def_list_t
@ The deallocates the list iteratively. We assume that the list
entries do not need finalization themselves.
<<Process libraries: process def list: TBP>>=
procedure :: final => process_def_list_final
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_final (list)
+ class(process_def_list_t), intent(inout) :: list
+ end subroutine process_def_list_final
<<Process libraries: procedures>>=
- subroutine process_def_list_final (list)
+ module subroutine process_def_list_final (list)
class(process_def_list_t), intent(inout) :: list
type(process_def_entry_t), pointer :: current
nullify (list%last)
do while (associated (list%first))
current => list%first
list%first => current%next
deallocate (current)
end do
end subroutine process_def_list_final
@ %def process_def_list_final
@ Write the complete list.
<<Process libraries: process def list: TBP>>=
procedure :: write => process_def_list_write
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_write (object, unit, libpath)
+ class(process_def_list_t), intent(in) :: object
+ integer, intent(in), optional :: unit
+ logical, intent(in), optional :: libpath
+ end subroutine process_def_list_write
<<Process libraries: procedures>>=
- subroutine process_def_list_write (object, unit, libpath)
+ module subroutine process_def_list_write (object, unit, libpath)
class(process_def_list_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: libpath
type(process_def_entry_t), pointer :: entry
integer :: i, u
u = given_output_unit (unit)
if (associated (object%first)) then
i = 1
entry => object%first
do while (associated (entry))
write (u, "(1x,A,I0,A)") "Process #", i, ":"
call entry%write (u)
i = i + 1
entry => entry%next
if (associated (entry)) write (u, *)
end do
else
write (u, "(1x,A)") "Process definition list: [empty]"
end if
end subroutine process_def_list_write
@ %def process_def_list_write
@ Short account.
<<Process libraries: process def list: TBP>>=
procedure :: show => process_def_list_show
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_show (object, unit)
+ class(process_def_list_t), intent(in) :: object
+ integer, intent(in), optional :: unit
+ end subroutine process_def_list_show
<<Process libraries: procedures>>=
- subroutine process_def_list_show (object, unit)
+ module subroutine process_def_list_show (object, unit)
class(process_def_list_t), intent(in) :: object
integer, intent(in), optional :: unit
type(process_def_entry_t), pointer :: entry
integer :: u
u = given_output_unit (unit)
if (associated (object%first)) then
write (u, "(2x,A)") "Processes:"
entry => object%first
do while (associated (entry))
call entry%show (u)
entry => entry%next
end do
else
write (u, "(2x,A)") "Processes: [empty]"
end if
end subroutine process_def_list_show
@ %def process_def_list_show
@ Read the complete list. We need an array of templates for the
component subobjects of abstract [[prc_core_t]] type, to
allocate them with the correct specific type.
NOTE: Error handling is missing. Reading will just be aborted on
error, or an I/O error occurs.
<<Process libraries: process def list: TBP>>=
procedure :: read => process_def_list_read
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_read (object, unit, core_def_templates)
+ class(process_def_list_t), intent(out) :: object
+ integer, intent(in) :: unit
+ type(prc_template_t), dimension(:), intent(in) :: core_def_templates
+ end subroutine process_def_list_read
<<Process libraries: procedures>>=
- subroutine process_def_list_read (object, unit, core_def_templates)
+ module subroutine process_def_list_read (object, unit, core_def_templates)
class(process_def_list_t), intent(out) :: object
integer, intent(in) :: unit
type(prc_template_t), dimension(:), intent(in) :: core_def_templates
type(process_def_entry_t), pointer :: entry
character(80) :: buffer, ref
integer :: i
read (unit, "(A)") buffer
write (ref, "(1x,A)") "Process definition list: [empty]"
if (buffer == ref) return ! OK: empty library
backspace (unit)
READ_ENTRIES: do i = 1, huge (0)
if (i > 1) read (unit, *, end=1)
read (unit, "(A)") buffer
write (ref, "(1x,A,I0,A)") "Process #", i, ":"
if (buffer /= ref) return ! Wrong process header: done.
allocate (entry)
call entry%read (unit, core_def_templates)
call object%append (entry)
end do READ_ENTRIES
1 continue ! EOF: done
end subroutine process_def_list_read
@ %def process_def_list_read
@ Append an entry to the list. The entry should be allocated as a
pointer, and the pointer allocation is transferred. The original
pointer is returned null.
<<Process libraries: process def list: TBP>>=
procedure :: append => process_def_list_append
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_append (list, entry)
+ class(process_def_list_t), intent(inout) :: list
+ type(process_def_entry_t), intent(inout), pointer :: entry
+ end subroutine process_def_list_append
<<Process libraries: procedures>>=
- subroutine process_def_list_append (list, entry)
+ module subroutine process_def_list_append (list, entry)
class(process_def_list_t), intent(inout) :: list
type(process_def_entry_t), intent(inout), pointer :: entry
if (list%contains (entry%id)) then
call msg_fatal ("Recording process: '" // char (entry%id) &
// "' has already been defined")
end if
if (associated (list%first)) then
list%last%next => entry
else
list%first => entry
end if
list%last => entry
entry => null ()
end subroutine process_def_list_append
@ %def process_def_list_append
@
\subsubsection{Probe the process definition list}
Return the number of processes supported by the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_n_processes => process_def_list_get_n_processes
+<<Process libraries: sub interfaces>>=
+ module function process_def_list_get_n_processes (list) result (n)
+ integer :: n
+ class(process_def_list_t), intent(in) :: list
+ end function process_def_list_get_n_processes
<<Process libraries: procedures>>=
- function process_def_list_get_n_processes (list) result (n)
+ module function process_def_list_get_n_processes (list) result (n)
integer :: n
class(process_def_list_t), intent(in) :: list
type(process_def_entry_t), pointer :: current
n = 0
current => list%first
do while (associated (current))
n = n + 1
current => current%next
end do
end function process_def_list_get_n_processes
@ %def process_def_list_get_n_processes
@ Allocate an array with the process IDs supported by the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_process_id_list => process_def_list_get_process_id_list
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_get_process_id_list (list, id)
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), dimension(:), allocatable, intent(out) :: id
+ end subroutine process_def_list_get_process_id_list
<<Process libraries: procedures>>=
- subroutine process_def_list_get_process_id_list (list, id)
+ module subroutine process_def_list_get_process_id_list (list, id)
class(process_def_list_t), intent(in) :: list
type(string_t), dimension(:), allocatable, intent(out) :: id
type(process_def_entry_t), pointer :: current
integer :: i
allocate (id (list%get_n_processes ()))
i = 0
current => list%first
do while (associated (current))
i = i + 1
id(i) = current%id
current => current%next
end do
end subroutine process_def_list_get_process_id_list
@ %def process_def_list_get_process_id_list
@ Return just the processes which require resonant subprocesses.
<<Process libraries: process def list: TBP>>=
procedure :: get_process_id_req_resonant => &
process_def_list_get_process_id_req_resonant
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_get_process_id_req_resonant (list, id)
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), dimension(:), allocatable, intent(out) :: id
+ end subroutine process_def_list_get_process_id_req_resonant
<<Process libraries: procedures>>=
- subroutine process_def_list_get_process_id_req_resonant (list, id)
+ module subroutine process_def_list_get_process_id_req_resonant (list, id)
class(process_def_list_t), intent(in) :: list
type(string_t), dimension(:), allocatable, intent(out) :: id
type(process_def_entry_t), pointer :: current
integer :: i
allocate (id (list%get_n_processes ()))
i = 0
current => list%first
do while (associated (current))
if (current%requires_resonances) then
i = i + 1
id(i) = current%id
end if
current => current%next
end do
id = id(1:i)
end subroutine process_def_list_get_process_id_req_resonant
@ %def process_def_list_get_process_id_list
@ Return a pointer to a particular process entry.
<<Process libraries: process def list: TBP>>=
procedure :: get_process_def_ptr => process_def_list_get_process_def_ptr
+<<Process libraries: sub interfaces>>=
+ module function process_def_list_get_process_def_ptr (list, id) result (entry)
+ type(process_def_entry_t), pointer :: entry
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ end function process_def_list_get_process_def_ptr
<<Process libraries: procedures>>=
- function process_def_list_get_process_def_ptr (list, id) result (entry)
+ module function process_def_list_get_process_def_ptr (list, id) result (entry)
type(process_def_entry_t), pointer :: entry
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%first
do while (associated (current))
if (id == current%id) exit
current => current%next
end do
entry => current
end function process_def_list_get_process_def_ptr
@ %def process_def_list_get_process_def_ptr
@ Return true if a given process is in the library.
<<Process libraries: process def list: TBP>>=
procedure :: contains => process_def_list_contains
+<<Process libraries: sub interfaces>>=
+ module function process_def_list_contains (list, id) result (flag)
+ logical :: flag
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ end function process_def_list_contains
<<Process libraries: procedures>>=
- function process_def_list_contains (list, id) result (flag)
+ module function process_def_list_contains (list, id) result (flag)
logical :: flag
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%get_process_def_ptr (id)
flag = associated (current)
end function process_def_list_contains
@ %def process_def_list_contains
@ Return the index of the entry that corresponds to a given process.
<<Process libraries: process def list: TBP>>=
procedure :: get_entry_index => process_def_list_get_entry_index
+<<Process libraries: sub interfaces>>=
+ module function process_def_list_get_entry_index (list, id) result (n)
+ integer :: n
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ end function process_def_list_get_entry_index
<<Process libraries: procedures>>=
- function process_def_list_get_entry_index (list, id) result (n)
+ module function process_def_list_get_entry_index (list, id) result (n)
integer :: n
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
n = 0
current => list%first
do while (associated (current))
n = n + 1
if (id == current%id) then
return
end if
current => current%next
end do
n = 0
end function process_def_list_get_entry_index
@ %def process_def_list_get_entry_index
@ Return the numerical ID for a process.
<<Process libraries: process def list: TBP>>=
procedure :: get_num_id => process_def_list_get_num_id
+<<Process libraries: sub interfaces>>=
+ module function process_def_list_get_num_id (list, id) result (num_id)
+ integer :: num_id
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ end function process_def_list_get_num_id
<<Process libraries: procedures>>=
- function process_def_list_get_num_id (list, id) result (num_id)
+ module function process_def_list_get_num_id (list, id) result (num_id)
integer :: num_id
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%get_process_def_ptr (id)
if (associated (current)) then
num_id = current%num_id
else
num_id = 0
end if
end function process_def_list_get_num_id
@ %def process_def_list_get_num_id
@ Return the model name for a given process in the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_model_name => process_def_list_get_model_name
+<<Process libraries: sub interfaces>>=
+ module function process_def_list_get_model_name (list, id) result (model_name)
+ type(string_t) :: model_name
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ end function process_def_list_get_model_name
<<Process libraries: procedures>>=
- function process_def_list_get_model_name (list, id) result (model_name)
+ module function process_def_list_get_model_name (list, id) result (model_name)
type(string_t) :: model_name
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%get_process_def_ptr (id)
if (associated (current)) then
model_name = current%model_name
else
model_name = ""
end if
end function process_def_list_get_model_name
@ %def process_def_list_get_model_name
@ Return the number of incoming particles of a given process in the library.
This tells us whether the process is a decay or a scattering.
<<Process libraries: process def list: TBP>>=
procedure :: get_n_in => process_def_list_get_n_in
+<<Process libraries: sub interfaces>>=
+ module function process_def_list_get_n_in (list, id) result (n)
+ integer :: n
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ end function process_def_list_get_n_in
<<Process libraries: procedures>>=
- function process_def_list_get_n_in (list, id) result (n)
+ module function process_def_list_get_n_in (list, id) result (n)
integer :: n
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(process_def_entry_t), pointer :: current
current => list%get_process_def_ptr (id)
if (associated (current)) then
n = current%n_in
else
n = 0
end if
end function process_def_list_get_n_in
@ %def process_def_list_get_n_in
@ Return the incoming particle pdg codesnumber of incoming particles
of a given process in the library. If there is a PDG array, return
only the first code for each beam. This serves as a quick way
for (re)constructing beam properties.
<<Process libraries: process def list: TBP>>=
procedure :: get_pdg_in_1 => process_def_list_get_pdg_in_1
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_get_pdg_in_1 (list, id, pdg)
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ integer, dimension(:), intent(out) :: pdg
+ end subroutine process_def_list_get_pdg_in_1
<<Process libraries: procedures>>=
- subroutine process_def_list_get_pdg_in_1 (list, id, pdg)
+ module subroutine process_def_list_get_pdg_in_1 (list, id, pdg)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
integer, dimension(:), intent(out) :: pdg
type(process_def_entry_t), pointer :: current
current => list%get_process_def_ptr (id)
if (associated (current)) then
call current%get_pdg_in_1 (pdg)
else
pdg = 0
end if
end subroutine process_def_list_get_pdg_in_1
@ %def process_def_list_get_pdg_in_1
@ Return the list of component IDs of a given process in the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_component_list => process_def_list_get_component_list
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_get_component_list (list, id, cid)
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ type(string_t), dimension(:), allocatable, intent(out) :: cid
+ end subroutine process_def_list_get_component_list
<<Process libraries: procedures>>=
- subroutine process_def_list_get_component_list (list, id, cid)
+ module subroutine process_def_list_get_component_list (list, id, cid)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(string_t), dimension(:), allocatable, intent(out) :: cid
type(process_def_entry_t), pointer :: current
integer :: i, n
current => list%get_process_def_ptr (id)
if (associated (current)) then
allocate (cid (current%n_initial + current%n_extra))
do i = 1, current%n_initial
cid(i) = current%initial(i)%basename
end do
n = current%n_initial
do i = 1, current%n_extra
cid(n + i) = current%extra(i)%basename
end do
end if
end subroutine process_def_list_get_component_list
@ %def process_def_list_get_component_list
@ Return the list of component description strings for a given process
in the library.
<<Process libraries: process def list: TBP>>=
procedure :: get_component_description_list => &
process_def_list_get_component_description_list
+<<Process libraries: sub interfaces>>=
+ module subroutine process_def_list_get_component_description_list &
+ (list, id, description)
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ type(string_t), dimension(:), allocatable, intent(out) :: description
+ end subroutine process_def_list_get_component_description_list
<<Process libraries: procedures>>=
- subroutine process_def_list_get_component_description_list &
+ module subroutine process_def_list_get_component_description_list &
(list, id, description)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
type(string_t), dimension(:), allocatable, intent(out) :: description
type(process_def_entry_t), pointer :: current
integer :: i, n
current => list%get_process_def_ptr (id)
if (associated (current)) then
allocate (description (current%n_initial + current%n_extra))
do i = 1, current%n_initial
description(i) = current%initial(i)%description
end do
n = current%n_initial
do i = 1, current%n_extra
description(n + i) = current%extra(i)%description
end do
end if
end subroutine process_def_list_get_component_description_list
@ %def process_def_list_get_component_description_list
@ Return whether the entry requires construction of a resonanct
subprocess set.
<<Process libraries: process def list: TBP>>=
procedure :: req_resonant => process_def_list_req_resonant
+<<Process libraries: sub interfaces>>=
+ module function process_def_list_req_resonant (list, id) result (flag)
+ class(process_def_list_t), intent(in) :: list
+ type(string_t), intent(in) :: id
+ logical :: flag
+ end function process_def_list_req_resonant
<<Process libraries: procedures>>=
- function process_def_list_req_resonant (list, id) result (flag)
+ module function process_def_list_req_resonant (list, id) result (flag)
class(process_def_list_t), intent(in) :: list
type(string_t), intent(in) :: id
logical :: flag
type(process_def_entry_t), pointer :: current
current => list%get_process_def_ptr (id)
if (associated (current)) then
flag = current%requires_resonances
else
flag = .false.
end if
end function process_def_list_req_resonant
@ %def process_def_list_req_resonant
@
\subsection{Process library}
The process library object is the interface between the process
definition data, as provided by the user, generated or linked process
code on file, and the process run data that reference the process
code.
\subsubsection{Process library entry}
For each process component that is part of the library, there is a
separate library entry ([[process_library_entry_t]]. The library
entry connects a process definition with the specific code (if any) in
the compiled driver library.
The [[status]] indicates how far the process has been
processed by the system (definition, code generation, compilation,
linking). A process with status [[STAT_LOADED]] is accessible for
computing matrix elements.
The [[def]] pointer identifies the corresponding process definition.
The process component within that definition is identified by the
[[i_component]] index.
The [[i_external]] index refers to the compiled library driver. If it is zero,
there is no associated matrix-element code.
The [[driver]] component holds the pointers to the matrix-element
specific functions, in particular the matrix element function itself.
<<Process libraries: types>>=
type :: process_library_entry_t
private
integer :: status = STAT_UNKNOWN
type(process_def_t), pointer :: def => null ()
integer :: i_component = 0
integer :: i_external = 0
class(prc_core_driver_t), allocatable :: driver
contains
<<Process libraries: process library entry: TBP>>
end type process_library_entry_t
@ %def process_library_entry_t
@ Here are the available status codes. An entry starts with
[[UNKNOWN]] status. Once the association with a valid process
definition is established, the status becomes [[CONFIGURED]].
If matrix element source code is to be generated by the system or
provided from elsewhere, [[CODE_GENERATED]] indicates that this is
done. The [[COMPILED]] status is next, it also applies to
processes which are accessed as precompiled binaries. Finally, the
library is linked and process pointers are set; this is marked as
[[LOADED]].
For a process library, the initial status is [[OPEN]], since process
definitions may be added. After configuration, the process content is fixed
and the status becomes [[CONFIGURED]]. The further states are as above,
always referring to the lowest status among the process entries.
<<Process libraries: parameters>>=
integer, parameter, public :: STAT_UNKNOWN = 0
integer, parameter, public :: STAT_OPEN = 1
integer, parameter, public :: STAT_CONFIGURED = 2
integer, parameter, public :: STAT_SOURCE = 3
integer, parameter, public :: STAT_COMPILED = 4
integer, parameter, public :: STAT_LINKED = 5
integer, parameter, public :: STAT_ACTIVE = 6
integer, parameter, public :: ASSOCIATED_BORN = 1
integer, parameter, public :: ASSOCIATED_REAL = 2
integer, parameter, public :: ASSOCIATED_VIRT = 3
integer, parameter, public :: ASSOCIATED_SUB = 4
integer, parameter, public :: ASSOCIATED_PDF = 5
integer, parameter, public :: ASSOCIATED_REAL_SING = 6
integer, parameter, public :: ASSOCIATED_REAL_FIN = 7
integer, parameter, public :: N_ASSOCIATED_COMPONENTS = 7
@ %def STAT_UNKNOWN STAT_OPEN STAT_CONFIGURED
@ %def STAT_SOURCE STAT_COMPILED STAT_LINKED STAT_ACTIVE
@ These are the associated code letters, for output:
<<Process libraries: parameters>>=
character, dimension(0:6), parameter :: STATUS_LETTER = &
["?", "o", "f", "s", "c", "l", "a"]
@ %def STATUS_LETTER
@ This produces a condensed account of the library entry. The status
is indicated by a letter in brackets, then the ID and component index
of the associated process definition, finally the library index, if available.
<<Process libraries: process library entry: TBP>>=
procedure :: to_string => process_library_entry_to_string
+<<Process libraries: sub interfaces>>=
+ module function process_library_entry_to_string (object) result (string)
+ type(string_t) :: string
+ class(process_library_entry_t), intent(in) :: object
+ end function process_library_entry_to_string
<<Process libraries: procedures>>=
- function process_library_entry_to_string (object) result (string)
+ module function process_library_entry_to_string (object) result (string)
type(string_t) :: string
class(process_library_entry_t), intent(in) :: object
character(32) :: buffer
string = "[" // STATUS_LETTER(object%status) // "]"
select case (object%status)
case (STAT_UNKNOWN)
case default
if (associated (object%def)) then
write (buffer, "(I0)") object%i_component
string = string // " " // object%def%id // "." // trim (buffer)
end if
if (object%i_external /= 0) then
write (buffer, "(I0)") object%i_external
string = string // " = ext:" // trim (buffer)
else
string = string // " = int"
end if
if (allocated (object%driver)) then
string = string // " (" // object%driver%type_name () // ")"
end if
end select
end function process_library_entry_to_string
@ %def process_library_entry_to_string
@ Initialize with data. Used for the unit tests.
<<Process libraries: process library entry: TBP>>=
procedure :: init => process_library_entry_init
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_entry_init (object, &
+ status, def, i_component, i_external, driver_template)
+ class(process_library_entry_t), intent(out) :: object
+ integer, intent(in) :: status
+ type(process_def_t), target, intent(in) :: def
+ integer, intent(in) :: i_component
+ integer, intent(in) :: i_external
+ class(prc_core_driver_t), intent(inout), allocatable, optional &
+ :: driver_template
+ end subroutine process_library_entry_init
<<Process libraries: procedures>>=
- subroutine process_library_entry_init (object, &
+ module subroutine process_library_entry_init (object, &
status, def, i_component, i_external, driver_template)
class(process_library_entry_t), intent(out) :: object
integer, intent(in) :: status
type(process_def_t), target, intent(in) :: def
integer, intent(in) :: i_component
integer, intent(in) :: i_external
class(prc_core_driver_t), intent(inout), allocatable, optional &
:: driver_template
object%status = status
object%def => def
object%i_component = i_component
object%i_external = i_external
if (present (driver_template)) then
call move_alloc (driver_template, object%driver)
end if
end subroutine process_library_entry_init
@ %def process_library_entry_init
@ Assign pointers for all process-specific features. We have to
combine the method from the [[core_def]] specification, the
assigned pointers within the library driver, the index within that
driver, and the process driver which should receive the links.
<<Process libraries: process library entry: TBP>>=
procedure :: connect => process_library_entry_connect
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_entry_connect (entry, lib_driver, i)
+ class(process_library_entry_t), intent(inout) :: entry
+ class(prclib_driver_t), intent(in) :: lib_driver
+ integer, intent(in) :: i
+ end subroutine process_library_entry_connect
<<Process libraries: procedures>>=
- subroutine process_library_entry_connect (entry, lib_driver, i)
+ module subroutine process_library_entry_connect (entry, lib_driver, i)
class(process_library_entry_t), intent(inout) :: entry
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
call entry%def%initial(entry%i_component)%connect &
(lib_driver, i, entry%driver)
end subroutine process_library_entry_connect
@ %def process_library_entry_connect
@
\subsubsection{The process library object}
The [[process_library_t]] type is an extension of the
[[process_def_list_t]] type. Thus, it automatically contains the
process definition list.
The [[basename]] identifies the library generically.
The [[external]] flag is true if any process within the library needs external
code, so the library must correspond to an actual code library (statically or
dynamically linked).
The [[entry]] array contains all process components that can be handled by this
library. Each entry refers to the process (component) definition and to the
associated external matrix element code, if there is any.
The [[driver]] object is needed only if [[external]] is true. This object
handles all interactions with external matrix-element code.
The [[md5sum]] summarizes the complete [[process_def_list_t]] base
object. It can be used to check if the library configuration has changed.
<<Process libraries: public>>=
public :: process_library_t
<<Process libraries: types>>=
type, extends (process_def_list_t) :: process_library_t
private
type(string_t) :: basename
integer :: n_entries = 0
logical :: external = .false.
integer :: status = STAT_UNKNOWN
logical :: static = .false.
logical :: driver_exists = .false.
logical :: makefile_exists = .false.
integer :: update_counter = 0
type(process_library_entry_t), dimension(:), allocatable :: entry
class(prclib_driver_t), allocatable :: driver
character(32) :: md5sum = ""
contains
<<Process libraries: process library: TBP>>
end type process_library_t
@ %def process_library_t
@ For the output, we write first the metadata and the DL access
record, then the library entries in short form, and finally the
process definition list which is the base object.
Don't write the MD5 sum since this is used to generate it.
<<Process libraries: process library: TBP>>=
procedure :: write => process_library_write
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_write (object, unit, libpath)
+ class(process_library_t), intent(in) :: object
+ integer, intent(in), optional :: unit
+ logical, intent(in), optional :: libpath
+ end subroutine process_library_write
<<Process libraries: procedures>>=
- subroutine process_library_write (object, unit, libpath)
+ module subroutine process_library_write (object, unit, libpath)
class(process_library_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: libpath
integer :: i, u
u = given_output_unit (unit)
write (u, "(1x,A,A)") "Process library: ", char (object%basename)
write (u, "(3x,A,L1)") "external = ", object%external
write (u, "(3x,A,L1)") "makefile exists = ", object%makefile_exists
write (u, "(3x,A,L1)") "driver exists = ", object%driver_exists
write (u, "(3x,A,A1)") "code status = ", &
STATUS_LETTER (object%status)
write (u, *)
if (allocated (object%entry)) then
write (u, "(1x,A)", advance="no") "Process library entries:"
write (u, "(1x,I0)") object%n_entries
do i = 1, size (object%entry)
write (u, "(1x,A,I0,A,A)") "Entry #", i, ": ", &
char (object%entry(i)%to_string ())
end do
write (u, *)
end if
if (object%external) then
call object%driver%write (u, libpath)
write (u, *)
end if
call object%process_def_list_t%write (u)
end subroutine process_library_write
@ %def process_library_write
@ Condensed version for screen output.
<<Process libraries: process library: TBP>>=
procedure :: show => process_library_show
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_show (object, unit)
+ class(process_library_t), intent(in) :: object
+ integer, intent(in), optional :: unit
+ end subroutine process_library_show
<<Process libraries: procedures>>=
- subroutine process_library_show (object, unit)
+ module subroutine process_library_show (object, unit)
class(process_library_t), intent(in) :: object
integer, intent(in), optional :: unit
integer :: u
u = given_output_unit (unit)
write (u, "(A,A)") "Process library: ", char (object%basename)
write (u, "(2x,A,L1)") "external = ", object%external
if (object%static) then
write (u, "(2x,A,L1)") "static = ", .true.
else
write (u, "(2x,A,L1)") "makefile exists = ", object%makefile_exists
write (u, "(2x,A,L1)") "driver exists = ", object%driver_exists
end if
write (u, "(2x,A,A1)", advance="no") "code status = "
select case (object%status)
case (STAT_UNKNOWN); write (u, "(A)") "[unknown]"
case (STAT_OPEN); write (u, "(A)") "open"
case (STAT_CONFIGURED); write (u, "(A)") "configured"
case (STAT_SOURCE); write (u, "(A)") "source code exists"
case (STAT_COMPILED); write (u, "(A)") "compiled"
case (STAT_LINKED); write (u, "(A)") "linked"
case (STAT_ACTIVE); write (u, "(A)") "active"
end select
call object%process_def_list_t%show (u)
end subroutine process_library_show
@ %def process_library_show
@
The initializer defines just the basename. We may now add process definitions
to the library.
<<Process libraries: process library: TBP>>=
procedure :: init => process_library_init
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_init (lib, basename)
+ class(process_library_t), intent(out) :: lib
+ type(string_t), intent(in) :: basename
+ end subroutine process_library_init
<<Process libraries: procedures>>=
- subroutine process_library_init (lib, basename)
+ module subroutine process_library_init (lib, basename)
class(process_library_t), intent(out) :: lib
type(string_t), intent(in) :: basename
lib%basename = basename
lib%status = STAT_OPEN
call msg_message ("Process library '" // char (basename) &
// "': initialized")
end subroutine process_library_init
@ %def process_library_init
@
This alternative initializer declares the library as static. We
should now add process definitions to the library, but all external
process code exists already. We need the driver object, and we should
check the defined processes against the stored ones.
<<Process libraries: process library: TBP>>=
procedure :: init_static => process_library_init_static
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_init_static (lib, basename)
+ class(process_library_t), intent(out) :: lib
+ type(string_t), intent(in) :: basename
+ end subroutine process_library_init_static
<<Process libraries: procedures>>=
- subroutine process_library_init_static (lib, basename)
+ module subroutine process_library_init_static (lib, basename)
class(process_library_t), intent(out) :: lib
type(string_t), intent(in) :: basename
lib%basename = basename
lib%status = STAT_OPEN
lib%static = .true.
call msg_message ("Static process library '" // char (basename) &
// "': initialized")
end subroutine process_library_init_static
@ %def process_library_init_static
@ The [[configure]] procedure scans the allocated entries in the process
definition list. The configuration proceeds in three passes.
In the first pass, we scan the process definition list and count the
number of process components and the number of components which need
external code. This is used to allocate the [[entry]] array.
In the second pass, we initialize the [[entry]] elements which connect
process definitions, process driver objects, and external code.
In the third pass, we initialize the library driver object, allocating
an entry for each external matrix element.
NOTE: Currently we handle only [[initial]] process components; [[extra]]
components are ignored.
<<Process libraries: process library: TBP>>=
procedure :: configure => process_library_configure
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_configure (lib, os_data)
+ class(process_library_t), intent(inout) :: lib
+ type(os_data_t), intent(in) :: os_data
+ end subroutine process_library_configure
<<Process libraries: procedures>>=
- subroutine process_library_configure (lib, os_data)
+ module subroutine process_library_configure (lib, os_data)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
type(process_def_entry_t), pointer :: def_entry
integer :: n_entries, n_external, i_entry, i_external
type(string_t) :: model_name
integer :: i_component
n_entries = 0
n_external = 0
if (allocated (lib%entry)) deallocate (lib%entry)
def_entry => lib%first
do while (associated (def_entry))
do i_component = 1, def_entry%n_initial
n_entries = n_entries + 1
if (def_entry%initial(i_component)%needs_code ()) then
n_external = n_external + 1
lib%external = .true.
end if
end do
def_entry => def_entry%next
end do
call lib%allocate_entries (n_entries)
i_entry = 0
i_external = 0
def_entry => lib%first
do while (associated (def_entry))
do i_component = 1, def_entry%n_initial
i_entry = i_entry + 1
associate (lib_entry => lib%entry(i_entry))
lib_entry%status = STAT_CONFIGURED
lib_entry%def => def_entry%process_def_t
lib_entry%i_component = i_component
if (def_entry%initial(i_component)%needs_code ()) then
i_external = i_external + 1
lib_entry%i_external = i_external
end if
call def_entry%initial(i_component)%allocate_driver &
(lib_entry%driver)
end associate
end do
def_entry => def_entry%next
end do
call dispatch_prclib_driver (lib%driver, &
lib%basename, lib%get_modellibs_ldflags (os_data))
call lib%driver%init (n_external)
do i_entry = 1, n_entries
associate (lib_entry => lib%entry(i_entry))
i_component = lib_entry%i_component
model_name = lib_entry%def%model_name
associate (def => lib_entry%def%initial(i_component))
if (def%needs_code ()) then
call lib%driver%set_record (lib_entry%i_external, &
def%basename, &
model_name, &
def%get_features (), def%get_writer_ptr ())
end if
end associate
end associate
end do
if (lib%static) then
if (lib%n_entries /= 0) lib%entry%status = STAT_LINKED
lib%status = STAT_LINKED
else if (lib%external) then
where (lib%entry%i_external == 0) lib%entry%status = STAT_LINKED
lib%status = STAT_CONFIGURED
lib%makefile_exists = .false.
lib%driver_exists = .false.
else
if (lib%n_entries /= 0) lib%entry%status = STAT_LINKED
lib%status = STAT_LINKED
end if
end subroutine process_library_configure
@ %def process_library_configure
@ Basic setup: allocate the [[entry]] array.
<<Process libraries: process library: TBP>>=
procedure :: allocate_entries => process_library_allocate_entries
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_allocate_entries (lib, n_entries)
+ class(process_library_t), intent(inout) :: lib
+ integer, intent(in) :: n_entries
+ end subroutine process_library_allocate_entries
<<Process libraries: procedures>>=
- subroutine process_library_allocate_entries (lib, n_entries)
+ module subroutine process_library_allocate_entries (lib, n_entries)
class(process_library_t), intent(inout) :: lib
integer, intent(in) :: n_entries
lib%n_entries = n_entries
allocate (lib%entry (n_entries))
end subroutine process_library_allocate_entries
@ %def process_library_allocate_entries
@ Initialize an entry with data (used by unit tests).
<<Process libraries: process library: TBP>>=
procedure :: init_entry => process_library_init_entry
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_init_entry (lib, i, &
+ status, def, i_component, i_external, driver_template)
+ class(process_library_t), intent(inout) :: lib
+ integer, intent(in) :: i
+ integer, intent(in) :: status
+ type(process_def_t), target, intent(in) :: def
+ integer, intent(in) :: i_component
+ integer, intent(in) :: i_external
+ class(prc_core_driver_t), intent(inout), allocatable, optional &
+ :: driver_template
+ end subroutine process_library_init_entry
<<Process libraries: procedures>>=
- subroutine process_library_init_entry (lib, i, &
+ module subroutine process_library_init_entry (lib, i, &
status, def, i_component, i_external, driver_template)
class(process_library_t), intent(inout) :: lib
integer, intent(in) :: i
integer, intent(in) :: status
type(process_def_t), target, intent(in) :: def
integer, intent(in) :: i_component
integer, intent(in) :: i_external
class(prc_core_driver_t), intent(inout), allocatable, optional &
:: driver_template
call lib%entry(i)%init (status, def, i_component, i_external, &
driver_template)
end subroutine process_library_init_entry
@ %def process_library_init_entry
@ Compute the MD5 sum. We concatenate the individual MD5 sums of all
processes (which, in turn, are derived from the MD5 sums of their
components) and compute the MD5 sum of that.
This should be executed \emph{after} configuration, where the driver was
initialized, since otherwise the MD5 sum stored in the driver would be
overwritten.
<<Process libraries: process library: TBP>>=
procedure :: compute_md5sum => process_library_compute_md5sum
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_compute_md5sum (lib, model)
+ class(process_library_t), intent(inout) :: lib
+ class(model_data_t), intent(in), optional, target :: model
+ end subroutine process_library_compute_md5sum
<<Process libraries: procedures>>=
- subroutine process_library_compute_md5sum (lib, model)
+ module subroutine process_library_compute_md5sum (lib, model)
class(process_library_t), intent(inout) :: lib
class(model_data_t), intent(in), optional, target :: model
type(process_def_entry_t), pointer :: def_entry
type(string_t) :: buffer
buffer = lib%basename
def_entry => lib%first
do while (associated (def_entry))
call def_entry%compute_md5sum (model)
buffer = buffer // def_entry%md5sum
def_entry => def_entry%next
end do
lib%md5sum = md5sum (char (buffer))
call lib%driver%set_md5sum (lib%md5sum)
end subroutine process_library_compute_md5sum
@ %def process_library_compute_md5sum
@ Write an appropriate makefile, if there are external processes. Unless
[[force]] is in effect, first check if there is already a makefile with the
correct MD5 sum. If yes, do nothing.
The [[workspace]] optional argument puts any library code in a subdirectory.
<<Process libraries: process library: TBP>>=
procedure :: write_makefile => process_library_write_makefile
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_write_makefile &
+ (lib, os_data, force, verbose, testflag, workspace)
+ class(process_library_t), intent(inout) :: lib
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in) :: force, verbose
+ logical, intent(in), optional :: testflag
+ type(string_t), intent(in), optional :: workspace
+ end subroutine process_library_write_makefile
<<Process libraries: procedures>>=
- subroutine process_library_write_makefile &
+ module subroutine process_library_write_makefile &
(lib, os_data, force, verbose, testflag, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: force, verbose
logical, intent(in), optional :: testflag
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum_file
logical :: generate
integer :: unit
if (lib%external .and. .not. lib%static) then
generate = .true.
if (.not. force) then
md5sum_file = lib%driver%get_md5sum_makefile (workspace)
if (lib%md5sum == md5sum_file) then
call msg_message ("Process library '" // char (lib%basename) &
// "': keeping makefile")
generate = .false.
end if
end if
if (generate) then
call msg_message ("Process library '" // char (lib%basename) &
// "': writing makefile")
unit = free_unit ()
open (unit, &
file = char (workspace_prefix (workspace) &
& // lib%driver%basename // ".makefile"), &
status="replace", action="write")
call lib%driver%generate_makefile (unit, os_data, verbose, testflag)
close (unit)
end if
lib%makefile_exists = .true.
end if
end subroutine process_library_write_makefile
@ %def process_library_write_makefile
@
@ Write the driver source code for the library to file, if there are
external processes.
<<Process libraries: process library: TBP>>=
procedure :: write_driver => process_library_write_driver
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_write_driver (lib, force, workspace)
+ class(process_library_t), intent(inout) :: lib
+ logical, intent(in) :: force
+ type(string_t), intent(in), optional :: workspace
+ end subroutine process_library_write_driver
<<Process libraries: procedures>>=
- subroutine process_library_write_driver (lib, force, workspace)
+ module subroutine process_library_write_driver (lib, force, workspace)
class(process_library_t), intent(inout) :: lib
logical, intent(in) :: force
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum_file
logical :: generate
integer :: unit
if (lib%external .and. .not. lib%static) then
generate = .true.
if (.not. force) then
md5sum_file = lib%driver%get_md5sum_driver (workspace)
if (lib%md5sum == md5sum_file) then
call msg_message ("Process library '" // char (lib%basename) &
// "': keeping driver")
generate = .false.
end if
end if
if (generate) then
call msg_message ("Process library '" // char (lib%basename) &
// "': writing driver")
unit = free_unit ()
open (unit, &
file = char (workspace_prefix (workspace) &
& // lib%driver%basename // ".f90"), &
status="replace", action="write")
call lib%driver%generate_driver_code (unit)
close (unit)
end if
lib%driver_exists = .true.
end if
end subroutine process_library_write_driver
@ %def process_library_write_driver
@ Update the compilation status of an external library.
Strictly speaking, this is not necessary for a one-time run, since the
individual library methods will update the status themselves.
However, it allows us to identify compilation steps that we can skip
because the file exists or is already loaded, for the whole library or
for particular entries.
Independently, the building process is controlled by a makefile.
Thus, previous files are reused if they are not modified by the
current compilation.
\begin{enumerate}
\item
If it is not already loaded, attempt to load the library. If successful,
check the overall MD5 sum. If it matches, just keep it loaded and mark as
ACTIVE. If not, check the MD5 sum for all linked process components.
Where it matches, mark the entry as COMPILED. Then, unload the library and
mark as CONFIGURED.
Thus, we can identify compiled files for all matrix elements which are
accessible via the previous compiled library, even if it is no longer up to
date.
\item
If the library is now in CONFIGURED state, look for valid source files.
Each entry that is just in CONFIGURED state will advance to SOURCE if the
MD5 sum matches. Finally, advance the whole library to SOURCE if all
entries are at least in this condition.
\end{enumerate}
<<Process libraries: process library: TBP>>=
procedure :: update_status => process_library_update_status
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_update_status (lib, os_data, workspace)
+ class(process_library_t), intent(inout) :: lib
+ type(os_data_t), intent(in) :: os_data
+ type(string_t), intent(in), optional :: workspace
+ end subroutine process_library_update_status
<<Process libraries: procedures>>=
- subroutine process_library_update_status (lib, os_data, workspace)
+ module subroutine process_library_update_status (lib, os_data, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
type(string_t), intent(in), optional :: workspace
character(32) :: md5sum_file
integer :: i, i_external, i_component
if (lib%external) then
select case (lib%status)
case (STAT_CONFIGURED:STAT_LINKED)
call lib%driver%load (os_data, noerror=.true., workspace=workspace)
end select
if (lib%driver%loaded) then
md5sum_file = lib%driver%get_md5sum (0)
if (lib%md5sum == md5sum_file) then
call lib%load_entries ()
lib%entry%status = STAT_ACTIVE
lib%status = STAT_ACTIVE
call msg_message ("Process library '" // char (lib%basename) &
// "': active")
else
do i = 1, lib%n_entries
associate (entry => lib%entry(i))
i_external = entry%i_external
i_component = entry%i_component
if (i_external /= 0) then
md5sum_file = lib%driver%get_md5sum (i_external)
if (entry%def%get_md5sum (i_component) == md5sum_file) then
entry%status = STAT_COMPILED
else
entry%status = STAT_CONFIGURED
end if
end if
end associate
end do
call lib%driver%unload ()
lib%status = STAT_CONFIGURED
end if
end if
select case (lib%status)
case (STAT_CONFIGURED)
do i = 1, lib%n_entries
associate (entry => lib%entry(i))
i_external = entry%i_external
i_component = entry%i_component
if (i_external /= 0) then
select case (entry%status)
case (STAT_CONFIGURED)
md5sum_file = lib%driver%get_md5sum_source &
(i_external, workspace)
if (entry%def%get_md5sum (i_component) == md5sum_file) then
entry%status = STAT_SOURCE
end if
end select
end if
end associate
end do
if (all (lib%entry%status >= STAT_SOURCE)) then
md5sum_file = lib%driver%get_md5sum_driver (workspace)
if (lib%md5sum == md5sum_file) then
lib%status = STAT_SOURCE
end if
end if
end select
end if
end subroutine process_library_update_status
@ %def process_library_update_status
@
This procedure triggers code generation for all processes where this
is possible.
We generate code only for external processes of status
[[STAT_CONFIGURED]], which then advance to [[STAT_SOURCE]]. If, for a
particular process, the status is already advanced, we do not remove previous
files, so [[make]] will consider them as up to date if they exist. Otherwise,
we remove those files to force a fresh [[make]].
Finally, if any source code has been generated, we need a driver file.
<<Process libraries: process library: TBP>>=
procedure :: make_source => process_library_make_source
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_make_source &
+ (lib, os_data, keep_old_source, workspace)
+ class(process_library_t), intent(inout) :: lib
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in), optional :: keep_old_source
+ type(string_t), intent(in), optional :: workspace
+ end subroutine process_library_make_source
<<Process libraries: procedures>>=
- subroutine process_library_make_source &
+ module subroutine process_library_make_source &
(lib, os_data, keep_old_source, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: keep_old_source
type(string_t), intent(in), optional :: workspace
logical :: keep_old
integer :: i, i_external
keep_old = .false.
if (present (keep_old_source)) keep_old = keep_old_source
if (lib%external .and. .not. lib%static) then
select case (lib%status)
case (STAT_CONFIGURED)
if (keep_old) then
call msg_message ("Process library '" // char (lib%basename) &
// "': keeping source code")
else
call msg_message ("Process library '" // char (lib%basename) &
// "': creating source code")
do i = 1, size (lib%entry)
associate (entry => lib%entry(i))
i_external = entry%i_external
if (i_external /= 0 &
.and. lib%entry(i)%status == STAT_CONFIGURED) then
call lib%driver%clean_proc &
(i_external, os_data, workspace)
end if
end associate
if (signal_is_pending ()) return
end do
call lib%driver%make_source (os_data, workspace)
end if
lib%status = STAT_SOURCE
where (lib%entry%i_external /= 0 &
.and. lib%entry%status == STAT_CONFIGURED)
lib%entry%status = STAT_SOURCE
end where
lib%status = STAT_SOURCE
end select
end if
end subroutine process_library_make_source
@ %def process_library_make_source
@ Compile the generated code and update the status codes. Try to make
the sources first, just in case. This includes compiling possible \LaTeX
Feynman diagram files.
<<Process libraries: process library: TBP>>=
procedure :: make_compile => process_library_make_compile
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_make_compile &
+ (lib, os_data, keep_old_source, workspace)
+ class(process_library_t), intent(inout) :: lib
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in), optional :: keep_old_source
+ type(string_t), intent(in), optional :: workspace
+ end subroutine process_library_make_compile
<<Process libraries: procedures>>=
- subroutine process_library_make_compile &
+ module subroutine process_library_make_compile &
(lib, os_data, keep_old_source, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: keep_old_source
type(string_t), intent(in), optional :: workspace
if (lib%external .and. .not. lib%static) then
select case (lib%status)
case (STAT_CONFIGURED)
call lib%make_source (os_data, keep_old_source, workspace)
end select
if (signal_is_pending ()) return
select case (lib%status)
case (STAT_SOURCE)
call msg_message ("Process library '" // char (lib%basename) &
// "': compiling sources")
call lib%driver%make_compile (os_data, workspace)
where (lib%entry%i_external /= 0 &
.and. lib%entry%status == STAT_SOURCE)
lib%entry%status = STAT_COMPILED
end where
lib%status = STAT_COMPILED
end select
end if
end subroutine process_library_make_compile
@ %def process_library_make_compile
@ Link the process library. Try to compile first, just in case.
<<Process libraries: process library: TBP>>=
procedure :: make_link => process_library_make_link
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_make_link &
+ (lib, os_data, keep_old_source, workspace)
+ class(process_library_t), intent(inout) :: lib
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in), optional :: keep_old_source
+ type(string_t), intent(in), optional :: workspace
+ end subroutine process_library_make_link
<<Process libraries: procedures>>=
- subroutine process_library_make_link &
+ module subroutine process_library_make_link &
(lib, os_data, keep_old_source, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: keep_old_source
type(string_t), intent(in), optional :: workspace
if (lib%external .and. .not. lib%static) then
select case (lib%status)
case (STAT_CONFIGURED:STAT_SOURCE)
call lib%make_compile (os_data, keep_old_source, workspace)
end select
if (signal_is_pending ()) return
select case (lib%status)
case (STAT_COMPILED)
call msg_message ("Process library '" // char (lib%basename) &
// "': linking")
call lib%driver%make_link (os_data, workspace)
lib%entry%status = STAT_LINKED
lib%status = STAT_LINKED
end select
end if
end subroutine process_library_make_link
@ %def process_library_make_link
@ Load the process library, i.e., assign pointers to the library
functions.
<<Process libraries: process library: TBP>>=
procedure :: load => process_library_load
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_load (lib, os_data, keep_old_source, workspace)
+ class(process_library_t), intent(inout) :: lib
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in), optional :: keep_old_source
+ type(string_t), intent(in), optional :: workspace
+ end subroutine process_library_load
<<Process libraries: procedures>>=
- subroutine process_library_load (lib, os_data, keep_old_source, workspace)
+ module subroutine process_library_load (lib, os_data, keep_old_source, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in), optional :: keep_old_source
type(string_t), intent(in), optional :: workspace
select case (lib%status)
case (STAT_CONFIGURED:STAT_COMPILED)
call lib%make_link (os_data, keep_old_source, workspace)
end select
if (signal_is_pending ()) return
select case (lib%status)
case (STAT_LINKED)
if (lib%external) then
call msg_message ("Process library '" // char (lib%basename) &
// "': loading")
call lib%driver%load (os_data, workspace=workspace)
call lib%load_entries ()
end if
lib%entry%status = STAT_ACTIVE
lib%status = STAT_ACTIVE
end select
end subroutine process_library_load
@ %def process_library_load
@ This is the actual loading part for the process methods.
<<Process libraries: process library: TBP>>=
procedure :: load_entries => process_library_load_entries
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_load_entries (lib)
+ class(process_library_t), intent(inout) :: lib
+ end subroutine process_library_load_entries
<<Process libraries: procedures>>=
- subroutine process_library_load_entries (lib)
+ module subroutine process_library_load_entries (lib)
class(process_library_t), intent(inout) :: lib
integer :: i
do i = 1, size (lib%entry)
associate (entry => lib%entry(i))
if (entry%i_external /= 0) then
call entry%connect (lib%driver, entry%i_external)
end if
end associate
end do
end subroutine process_library_load_entries
@ %def process_library_load_entries
@ Unload the library, if possible. This reverts the status to ``linked''.
<<Process libraries: process library: TBP>>=
procedure :: unload => process_library_unload
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_unload (lib)
+ class(process_library_t), intent(inout) :: lib
+ end subroutine process_library_unload
<<Process libraries: procedures>>=
- subroutine process_library_unload (lib)
+ module subroutine process_library_unload (lib)
class(process_library_t), intent(inout) :: lib
select case (lib%status)
case (STAT_ACTIVE)
if (lib%external) then
call msg_message ("Process library '" // char (lib%basename) &
// "': unloading")
call lib%driver%unload ()
end if
lib%entry%status = STAT_LINKED
lib%status = STAT_LINKED
end select
end subroutine process_library_unload
@ %def process_library_unload
@ Unload, clean all generated files and revert the library status. If
[[distclean]] is set, also remove the makefile and the driver source.
<<Process libraries: process library: TBP>>=
procedure :: clean => process_library_clean
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_clean (lib, os_data, distclean, workspace)
+ class(process_library_t), intent(inout) :: lib
+ type(os_data_t), intent(in) :: os_data
+ logical, intent(in) :: distclean
+ type(string_t), intent(in), optional :: workspace
+ end subroutine process_library_clean
<<Process libraries: procedures>>=
- subroutine process_library_clean (lib, os_data, distclean, workspace)
+ module subroutine process_library_clean (lib, os_data, distclean, workspace)
class(process_library_t), intent(inout) :: lib
type(os_data_t), intent(in) :: os_data
logical, intent(in) :: distclean
type(string_t), intent(in), optional :: workspace
call lib%unload ()
if (lib%external .and. .not. lib%static) then
call msg_message ("Process library '" // char (lib%basename) &
// "': removing old files")
if (distclean) then
call lib%driver%distclean (os_data, workspace)
else
call lib%driver%clean (os_data, workspace)
end if
end if
where (lib%entry%i_external /= 0)
lib%entry%status = STAT_CONFIGURED
elsewhere
lib%entry%status = STAT_LINKED
end where
if (lib%external) then
lib%status = STAT_CONFIGURED
else
lib%status = STAT_LINKED
end if
end subroutine process_library_clean
@ %def process_library_clean
@ Unload and revert the library status to INITIAL. This allows for
appending new processes. No files are deleted.
<<Process libraries: process library: TBP>>=
procedure :: open => process_library_open
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_open (lib)
+ class(process_library_t), intent(inout) :: lib
+ end subroutine process_library_open
<<Process libraries: procedures>>=
- subroutine process_library_open (lib)
+ module subroutine process_library_open (lib)
class(process_library_t), intent(inout) :: lib
select case (lib%status)
case (STAT_OPEN)
case default
call lib%unload ()
if (.not. lib%static) then
lib%entry%status = STAT_OPEN
lib%status = STAT_OPEN
if (lib%external) lib%update_counter = lib%update_counter + 1
call msg_message ("Process library '" // char (lib%basename) &
// "': open")
else
call msg_error ("Static process library '" // char (lib%basename) &
// "': processes can't be appended")
end if
end select
end subroutine process_library_open
@ %def process_library_open
@
\subsection{Use the library}
Return the base name of the library
<<Process libraries: process library: TBP>>=
procedure :: get_name => process_library_get_name
+<<Process libraries: sub interfaces>>=
+ module function process_library_get_name (lib) result (name)
+ class(process_library_t), intent(in) :: lib
+ type(string_t) :: name
+ end function process_library_get_name
<<Process libraries: procedures>>=
- function process_library_get_name (lib) result (name)
+ module function process_library_get_name (lib) result (name)
class(process_library_t), intent(in) :: lib
type(string_t) :: name
name = lib%basename
end function process_library_get_name
@ %def process_library_get_name
@
Once activated, we view the process library object as an interface for
accessing the matrix elements.
<<Process libraries: process library: TBP>>=
procedure :: is_active => process_library_is_active
+<<Process libraries: sub interfaces>>=
+ module function process_library_is_active (lib) result (flag)
+ logical :: flag
+ class(process_library_t), intent(in) :: lib
+ end function process_library_is_active
<<Process libraries: procedures>>=
- function process_library_is_active (lib) result (flag)
+ module function process_library_is_active (lib) result (flag)
logical :: flag
class(process_library_t), intent(in) :: lib
flag = lib%status == STAT_ACTIVE
end function process_library_is_active
@ %def process_library_is_active
@ Return the current status code of the library. If an index is
provided, return the status of that entry.
<<Process libraries: process library: TBP>>=
procedure :: get_status => process_library_get_status
+<<Process libraries: sub interfaces>>=
+ module function process_library_get_status (lib, i) result (status)
+ class(process_library_t), intent(in) :: lib
+ integer, intent(in), optional :: i
+ integer :: status
+ end function process_library_get_status
<<Process libraries: procedures>>=
- function process_library_get_status (lib, i) result (status)
+ module function process_library_get_status (lib, i) result (status)
class(process_library_t), intent(in) :: lib
integer, intent(in), optional :: i
integer :: status
if (present (i)) then
status = lib%entry(i)%status
else
status = lib%status
end if
end function process_library_get_status
@ %def process_library_get_status
@ Return the update counter. Since this is incremented each time the
library is re-opened, we can use this to check if existing pointers to
matrix element code are still valid.
<<Process libraries: process library: TBP>>=
procedure :: get_update_counter => process_library_get_update_counter
+<<Process libraries: sub interfaces>>=
+ module function process_library_get_update_counter (lib) result (counter)
+ class(process_library_t), intent(in) :: lib
+ integer :: counter
+ end function process_library_get_update_counter
<<Process libraries: procedures>>=
- function process_library_get_update_counter (lib) result (counter)
+ module function process_library_get_update_counter (lib) result (counter)
class(process_library_t), intent(in) :: lib
integer :: counter
counter = lib%update_counter
end function process_library_get_update_counter
@ %def process_library_get_update_counter
@ Manually set the current status code of the library. If the
optional flag is set, set also the entry status codes. This is used
for unit tests.
<<Process libraries: process library: TBP>>=
procedure :: set_status => process_library_set_status
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_set_status (lib, status, entries)
+ class(process_library_t), intent(inout) :: lib
+ integer, intent(in) :: status
+ logical, intent(in), optional :: entries
+ end subroutine process_library_set_status
<<Process libraries: procedures>>=
- subroutine process_library_set_status (lib, status, entries)
+ module subroutine process_library_set_status (lib, status, entries)
class(process_library_t), intent(inout) :: lib
integer, intent(in) :: status
logical, intent(in), optional :: entries
lib%status = status
if (present (entries)) then
if (entries) lib%entry%status = status
end if
end subroutine process_library_set_status
@ %def process_library_set_status
@ Return the load status of the associated driver.
<<Process libraries: process library: TBP>>=
procedure :: is_loaded => process_library_is_loaded
+<<Process libraries: sub interfaces>>=
+ module function process_library_is_loaded (lib) result (flag)
+ class(process_library_t), intent(in) :: lib
+ logical :: flag
+ end function process_library_is_loaded
<<Process libraries: procedures>>=
- function process_library_is_loaded (lib) result (flag)
+ module function process_library_is_loaded (lib) result (flag)
class(process_library_t), intent(in) :: lib
logical :: flag
flag = lib%driver%loaded
end function process_library_is_loaded
@ %def process_library_is_loaded
@ Retrieve constants using the process library driver. We assume that
the process code has been loaded, if external.
<<Process libraries: process library entry: TBP>>=
procedure :: fill_constants => process_library_entry_fill_constants
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_entry_fill_constants (entry, driver, data)
+ class(process_library_entry_t), intent(in) :: entry
+ class(prclib_driver_t), intent(in) :: driver
+ type(process_constants_t), intent(out) :: data
+ end subroutine process_library_entry_fill_constants
<<Process libraries: procedures>>=
- subroutine process_library_entry_fill_constants (entry, driver, data)
+ module subroutine process_library_entry_fill_constants (entry, driver, data)
class(process_library_entry_t), intent(in) :: entry
class(prclib_driver_t), intent(in) :: driver
type(process_constants_t), intent(out) :: data
integer :: i
if (entry%i_external /= 0) then
i = entry%i_external
data%id = driver%get_process_id (i)
data%model_name = driver%get_model_name (i)
data%md5sum = driver%get_md5sum (i)
data%openmp_supported = driver%get_openmp_status (i)
data%n_in = driver%get_n_in (i)
data%n_out = driver%get_n_out (i)
data%n_flv = driver%get_n_flv (i)
data%n_hel = driver%get_n_hel (i)
data%n_col = driver%get_n_col (i)
data%n_cin = driver%get_n_cin (i)
data%n_cf = driver%get_n_cf (i)
call driver%set_flv_state (i, data%flv_state)
call driver%set_hel_state (i, data%hel_state)
call driver%set_col_state (i, data%col_state, data%ghost_flag)
call driver%set_color_factors (i, data%color_factors, data%cf_index)
else
select type (proc_driver => entry%driver)
class is (process_driver_internal_t)
call proc_driver%fill_constants (data)
end select
end if
end subroutine process_library_entry_fill_constants
@ %def process_library_entry_fill_constants
@ Retrieve the constants for a process
<<Process libraries: process library: TBP>>=
procedure :: fill_constants => process_library_fill_constants
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_fill_constants (lib, id, i_component, data)
+ class(process_library_t), intent(in) :: lib
+ type(string_t), intent(in) :: id
+ integer, intent(in) :: i_component
+ type(process_constants_t), intent(out) :: data
+ end subroutine process_library_fill_constants
<<Process libraries: procedures>>=
- subroutine process_library_fill_constants (lib, id, i_component, data)
+ module subroutine process_library_fill_constants (lib, id, i_component, data)
class(process_library_t), intent(in) :: lib
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
type(process_constants_t), intent(out) :: data
integer :: i
do i = 1, size (lib%entry)
associate (entry => lib%entry(i))
if (entry%def%id == id .and. entry%i_component == i_component) then
call entry%fill_constants (lib%driver, data)
return
end if
end associate
end do
end subroutine process_library_fill_constants
@ %def process_library_fill_constants
@ Retrieve the constants and a connected driver for a process,
identified by a process ID and a subprocess index. We
scan the process entries until we have found a match.
<<Process libraries: process library: TBP>>=
procedure :: connect_process => process_library_connect_process
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_connect_process &
+ (lib, id, i_component, data, proc_driver)
+ class(process_library_t), intent(in) :: lib
+ type(string_t), intent(in) :: id
+ integer, intent(in) :: i_component
+ type(process_constants_t), intent(out) :: data
+ class(prc_core_driver_t), allocatable, intent(out) :: proc_driver
+ end subroutine process_library_connect_process
<<Process libraries: procedures>>=
- subroutine process_library_connect_process &
+ module subroutine process_library_connect_process &
(lib, id, i_component, data, proc_driver)
class(process_library_t), intent(in) :: lib
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
type(process_constants_t), intent(out) :: data
class(prc_core_driver_t), allocatable, intent(out) :: proc_driver
integer :: i
do i = 1, size (lib%entry)
associate (entry => lib%entry(i))
if (entry%def%id == id .and. entry%i_component == i_component) then
call entry%fill_constants (lib%driver, data)
allocate (proc_driver, source = entry%driver)
return
end if
end associate
end do
call msg_fatal ("Process library '" // char (lib%basename) &
// "': process '" // char (id) // "' not found")
end subroutine process_library_connect_process
@ %def process_library_connect_process
@
Shortcut for use in unit tests: fetch the MD5sum from a specific
library entry and inject it into the writer of a specific record.
<<Process libraries: process library: TBP>>=
procedure :: test_transfer_md5sum => process_library_test_transfer_md5sum
+<<Process libraries: sub interfaces>>=
+ module subroutine process_library_test_transfer_md5sum (lib, r, e, c)
+ class(process_library_t), intent(inout) :: lib
+ integer, intent(in) :: r, e, c
+ end subroutine process_library_test_transfer_md5sum
<<Process libraries: procedures>>=
- subroutine process_library_test_transfer_md5sum (lib, r, e, c)
+ module subroutine process_library_test_transfer_md5sum (lib, r, e, c)
class(process_library_t), intent(inout) :: lib
integer, intent(in) :: r, e, c
associate (writer => lib%driver%record(r)%writer)
writer%md5sum = lib%entry(e)%def%get_md5sum (c)
end associate
end subroutine process_library_test_transfer_md5sum
@ %def process_library_test_transfer_md5sum
@
<<Process libraries: process library: TBP>>=
procedure :: get_nlo_type => process_library_get_nlo_type
+<<Process libraries: sub interfaces>>=
+ module function process_library_get_nlo_type (lib, id, i_component) result (nlo_type)
+ integer :: nlo_type
+ class(process_library_t), intent(in) :: lib
+ type(string_t), intent(in) :: id
+ integer, intent(in) :: i_component
+ end function process_library_get_nlo_type
<<Process libraries: procedures>>=
- function process_library_get_nlo_type (lib, id, i_component) result (nlo_type)
+ module function process_library_get_nlo_type (lib, id, i_component) result (nlo_type)
integer :: nlo_type
class(process_library_t), intent(in) :: lib
type(string_t), intent(in) :: id
integer, intent(in) :: i_component
integer :: i
do i = 1, size (lib%entry)
if (lib%entry(i)%def%id == id .and. lib%entry(i)%i_component == i_component) then
nlo_type = lib%entry(i)%def%get_nlo_type (i_component)
exit
end if
end do
end function process_library_get_nlo_type
@ %def process_library_get_nlo_type
@
\subsection{Collect model-specific libraries}
This returns appropriate linker flags for the model parameter libraries that
are used by the generated matrix element. At the end, the main libwhizard is
appended (again), because functions from that may be reqired.
Extra models in the local user space need to be treated individually.
<<Process libraries: process library: TBP>>=
procedure :: get_modellibs_ldflags => process_library_get_modellibs_ldflags
+<<Process libraries: sub interfaces>>=
+ module function process_library_get_modellibs_ldflags (prc_lib, os_data) result (flags)
+ class(process_library_t), intent(in) :: prc_lib
+ type(os_data_t), intent(in) :: os_data
+ type(string_t) :: flags
+ end function process_library_get_modellibs_ldflags
<<Process libraries: procedures>>=
- function process_library_get_modellibs_ldflags (prc_lib, os_data) result (flags)
+ module function process_library_get_modellibs_ldflags (prc_lib, os_data) result (flags)
class(process_library_t), intent(in) :: prc_lib
type(os_data_t), intent(in) :: os_data
type(string_t) :: flags
type(string_t), dimension(:), allocatable :: models
type(string_t) :: modelname, modellib, modellib_full
logical :: exist
integer :: i, j, mi
flags = " -lomega"
if ((.not. os_data%use_testfiles) .and. &
os_dir_exist (os_data%whizard_models_libpath_local)) &
flags = flags // " -L" // os_data%whizard_models_libpath_local
flags = flags // " -L" // os_data%whizard_models_libpath
allocate (models(prc_lib%n_entries + 1))
models = ""
mi = 1
if (allocated (prc_lib%entry)) then
SCAN: do i = 1, prc_lib%n_entries
if (associated (prc_lib%entry(i)%def)) then
if (prc_lib%entry(i)%def%model_name /= "") then
modelname = prc_lib%entry(i)%def%model_name
else
cycle SCAN
end if
else
cycle SCAN
end if
do j = 1, mi
if (models(mi) == modelname) cycle SCAN
end do
models(mi) = modelname
mi = mi + 1
if (os_data%use_libtool) then
modellib = "libparameters_" // modelname // ".la"
else
modellib = "libparameters_" // modelname // ".a"
end if
exist = .false.
if (.not. os_data%use_testfiles) then
modellib_full = os_data%whizard_models_libpath_local &
// "/" // modellib
inquire (file=char (modellib_full), exist=exist)
end if
if (.not. exist) then
modellib_full = os_data%whizard_models_libpath &
// "/" // modellib
inquire (file=char (modellib_full), exist=exist)
end if
if (exist) flags = flags // " -lparameters_" // modelname
end do SCAN
end if
deallocate (models)
flags = flags // " -lwhizard"
end function process_library_get_modellibs_ldflags
@ %def process_library_get_modellibs_ldflags
@
<<Process libraries: process library: TBP>>=
procedure :: get_static_modelname => process_library_get_static_modelname
+<<Process libraries: sub interfaces>>=
+ module function process_library_get_static_modelname (prc_lib, os_data) result (name)
+ class(process_library_t), intent(in) :: prc_lib
+ type(os_data_t), intent(in) :: os_data
+ type(string_t) :: name
+ end function process_library_get_static_modelname
<<Process libraries: procedures>>=
- function process_library_get_static_modelname (prc_lib, os_data) result (name)
+ module function process_library_get_static_modelname (prc_lib, os_data) result (name)
class(process_library_t), intent(in) :: prc_lib
type(os_data_t), intent(in) :: os_data
type(string_t) :: name
type(string_t), dimension(:), allocatable :: models
type(string_t) :: modelname, modellib, modellib_full
logical :: exist
integer :: i, j, mi
name = ""
allocate (models(prc_lib%n_entries + 1))
models = ""
mi = 1
if (allocated (prc_lib%entry)) then
SCAN: do i = 1, prc_lib%n_entries
if (associated (prc_lib%entry(i)%def)) then
if (prc_lib%entry(i)%def%model_name /= "") then
modelname = prc_lib%entry(i)%def%model_name
else
cycle SCAN
end if
else
cycle SCAN
end if
do j = 1, mi
if (models(mi) == modelname) cycle SCAN
end do
models(mi) = modelname
mi = mi + 1
modellib = "libparameters_" // modelname // ".a"
exist = .false.
if (.not. os_data%use_testfiles) then
modellib_full = os_data%whizard_models_libpath_local &
// "/" // modellib
inquire (file=char (modellib_full), exist=exist)
end if
if (.not. exist) then
modellib_full = os_data%whizard_models_libpath &
// "/" // modellib
inquire (file=char (modellib_full), exist=exist)
end if
if (exist) name = name // " " // modellib_full
end do SCAN
end if
deallocate (models)
end function process_library_get_static_modelname
@ %def process_library_get_static_modelname
@
\subsection{Unit Test}
Test module, followed by the corresponding implementation module.
<<[[process_libraries_ut.f90]]>>=
<<File header>>
module process_libraries_ut
use unit_tests
use process_libraries_uti
<<Standard module head>>
<<Process libraries: public test>>
contains
<<Process libraries: test driver>>
end module process_libraries_ut
@ %def process_libraries_ut
@
<<[[process_libraries_uti.f90]]>>=
<<File header>>
module process_libraries_uti
use, intrinsic :: iso_c_binding !NODEP!
<<Use strings>>
use io_units
use os_interface
use particle_specifiers, only: new_prt_spec
use process_constants
use prclib_interfaces
use prc_core_def
use process_libraries
use prclib_interfaces_ut, only: test_writer_4_t
<<Standard module head>>
<<Process libraries: test declarations>>
<<Process libraries: test types>>
contains
<<Process libraries: tests>>
<<Process libraries: test auxiliary>>
end module process_libraries_uti
@ %def process_libraries_ut
@ API: driver for the unit tests below.
<<Process libraries: public test>>=
public :: process_libraries_test
<<Process libraries: test driver>>=
subroutine process_libraries_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Process libraries: execute tests>>
end subroutine process_libraries_test
@ %def process_libraries_test
@
\subsubsection{Empty process list}
Test 1: Write an empty process list.
<<Process libraries: execute tests>>=
call test (process_libraries_1, "process_libraries_1", &
"empty process list", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_1
<<Process libraries: tests>>=
subroutine process_libraries_1 (u)
integer, intent(in) :: u
type(process_def_list_t) :: process_def_list
write (u, "(A)") "* Test output: process_libraries_1"
write (u, "(A)") "* Purpose: Display an empty process definition list"
write (u, "(A)")
call process_def_list%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_1"
end subroutine process_libraries_1
@ %def process_libraries_1
@
\subsubsection{Process definition list}
Test 2: Process definition list with processes and components.
Construct the list, write to file, read it in again, and display.
Finalize and delete the list after use.
We define a trivial 'test' type for the process variant. The test
type contains just one (meaningless) data item, which is an integer.
<<Process libraries: test types>>=
type, extends (prc_core_def_t) :: prcdef_2_t
integer :: data = 0
logical :: file = .false.
contains
<<Process libraries: prcdef 2: TBP>>
end type prcdef_2_t
@ %def prcdef_2_t
@ The process variant is named 'test'.
<<Process libraries: prcdef 2: TBP>>=
procedure, nopass :: type_string => prcdef_2_type_string
<<Process libraries: test auxiliary>>=
function prcdef_2_type_string () result (string)
type(string_t) :: string
string = "test"
end function prcdef_2_type_string
@ %def prcdef_2_type_string
@ Write the contents (the integer value).
<<Process libraries: prcdef 2: TBP>>=
procedure :: write => prcdef_2_write
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_write (object, unit)
class(prcdef_2_t), intent(in) :: object
integer, intent(in) :: unit
write (unit, "(3x,A,I0)") "Test data = ", object%data
end subroutine prcdef_2_write
@ %def prcdef_2_write
@ Recover the integer value.
<<Process libraries: prcdef 2: TBP>>=
procedure :: read => prcdef_2_read
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_read (object, unit)
class(prcdef_2_t), intent(out) :: object
integer, intent(in) :: unit
character(80) :: buffer
read (unit, "(A)") buffer
call strip_equation_lhs (buffer)
read (buffer, *) object%data
end subroutine prcdef_2_read
@ %def prcdef_2_read
@ No external procedures.
<<Process libraries: prcdef 2: TBP>>=
procedure, nopass :: get_features => prcdef_2_get_features
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_get_features (features)
type(string_t), dimension(:), allocatable, intent(out) :: features
allocate (features (0))
end subroutine prcdef_2_get_features
@ %def prcdef_2_get_features
@ No code generated.
<<Process libraries: prcdef 2: TBP>>=
procedure :: generate_code => prcdef_2_generate_code
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_generate_code (object, &
basename, model_name, prt_in, prt_out)
class(prcdef_2_t), intent(in) :: object
type(string_t), intent(in) :: basename
type(string_t), intent(in) :: model_name
type(string_t), dimension(:), intent(in) :: prt_in
type(string_t), dimension(:), intent(in) :: prt_out
end subroutine prcdef_2_generate_code
@ %def prcdef_2_generate_code
@ Allocate the driver with the appropriate type.
<<Process libraries: prcdef 2: TBP>>=
procedure :: allocate_driver => prcdef_2_allocate_driver
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_allocate_driver (object, driver, basename)
class(prcdef_2_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
allocate (prctest_2_t :: driver)
end subroutine prcdef_2_allocate_driver
@ %def prcdef_2_allocate_driver
@ Nothing to connect.
<<Process libraries: prcdef 2: TBP>>=
procedure :: connect => prcdef_2_connect
<<Process libraries: test auxiliary>>=
subroutine prcdef_2_connect (def, lib_driver, i, proc_driver)
class(prcdef_2_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
end subroutine prcdef_2_connect
@ %def prcdef_2_connect
@ The associated driver type.
<<Process libraries: test types>>=
type, extends (process_driver_internal_t) :: prctest_2_t
contains
<<Process libraries: prctest 2: TBP>>
end type prctest_2_t
@ %def prctest_2_t
@ Return the type name.
<<Process libraries: prctest 2: TBP>>=
procedure, nopass :: type_name => prctest_2_type_name
<<Process libraries: test auxiliary>>=
function prctest_2_type_name () result (type)
type(string_t) :: type
type = "test"
end function prctest_2_type_name
@ %def prctest_2_type_name
@ This should fill constant process data. We do not check those here,
however, therefore nothing done.
<<Process libraries: prctest 2: TBP>>=
procedure :: fill_constants => prctest_2_fill_constants
<<Process libraries: test auxiliary>>=
subroutine prctest_2_fill_constants (driver, data)
class(prctest_2_t), intent(in) :: driver
type(process_constants_t), intent(out) :: data
end subroutine prctest_2_fill_constants
@ %def prctest_2_fill_constants
@
Here is the actual test.
For reading, we need a list of templates, i.e., an array containing
allocated objects for all available process variants. This is the
purpose of [[process_core_templates]]. Here, we have only a single
template for the 'test' variant.
<<Process libraries: execute tests>>=
call test (process_libraries_2, "process_libraries_2", &
"process definition list", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_2
<<Process libraries: tests>>=
subroutine process_libraries_2 (u)
integer, intent(in) :: u
type(prc_template_t), dimension(:), allocatable :: process_core_templates
type(process_def_list_t) :: process_def_list
type(process_def_entry_t), pointer :: entry => null ()
class(prc_core_def_t), allocatable :: test_def
integer :: scratch_unit
write (u, "(A)") "* Test output: process_libraries_2"
write (u, "(A)") "* Purpose: Construct a process definition list,"
write (u, "(A)") "* write it to file and reread it"
write (u, "(A)") ""
write (u, "(A)") "* Construct a process definition list"
write (u, "(A)") "* First process definition: empty"
write (u, "(A)") "* Second process definition: two components"
write (u, "(A)") "* First component: empty"
write (u, "(A)") "* Second component: test data"
write (u, "(A)") "* Third process definition:"
write (u, "(A)") "* Embedded decays and polarization"
write (u, "(A)")
allocate (process_core_templates (1))
allocate (prcdef_2_t :: process_core_templates(1)%core_def)
allocate (entry)
call entry%init (var_str ("first"), n_in = 0, n_components = 0)
call entry%compute_md5sum ()
call process_def_list%append (entry)
allocate (entry)
call entry%init (var_str ("second"), model_name = var_str ("Test"), &
n_in = 1, n_components = 2)
allocate (prcdef_2_t :: test_def)
select type (test_def)
type is (prcdef_2_t); test_def%data = 42
end select
call entry%import_component (2, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = test_def)
call entry%compute_md5sum ()
call process_def_list%append (entry)
allocate (entry)
call entry%init (var_str ("third"), model_name = var_str ("Test"), &
n_in = 2, n_components = 1)
allocate (prcdef_2_t :: test_def)
call entry%import_component (1, n_out = 3, &
prt_in = &
new_prt_spec ([var_str ("a"), var_str ("b")]), &
prt_out = &
[new_prt_spec (var_str ("c")), &
new_prt_spec (var_str ("d"), .true.), &
new_prt_spec (var_str ("e"), [var_str ("e_decay")])], &
method = var_str ("test"), &
variant = test_def)
call entry%compute_md5sum ()
call process_def_list%append (entry)
call process_def_list%write (u)
write (u, "(A)") ""
write (u, "(A)") "* Write the process definition list to (scratch) file"
scratch_unit = free_unit ()
open (unit = scratch_unit, status="scratch", action = "readwrite")
call process_def_list%write (scratch_unit)
call process_def_list%final ()
write (u, "(A)") "* Reread it"
write (u, "(A)") ""
rewind (scratch_unit)
call process_def_list%read (scratch_unit, process_core_templates)
close (scratch_unit)
call process_def_list%write (u)
call process_def_list%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_2"
end subroutine process_libraries_2
@ %def process_libraries_2
@
\subsubsection{Process library object}
Test 3: Process library object with several process definitions and
library entries. Just construct the object, modify some initial
content, and write the result. The modifications are mostly applied
directly, so we do not test anything but the contents and the output
routine.
<<Process libraries: execute tests>>=
call test (process_libraries_3, "process_libraries_3", &
"recover process definition list from file", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_3
<<Process libraries: tests>>=
subroutine process_libraries_3 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_driver_t), allocatable :: driver_template
write (u, "(A)") "* Test output: process_libraries_3"
write (u, "(A)") "* Purpose: Construct a process library object &
&with entries"
write (u, "(A)") ""
write (u, "(A)") "* Construct and display a process library object"
write (u, "(A)") "* with 5 entries"
write (u, "(A)") "* associated with 3 matrix element codes"
write (u, "(A)") "* corresponding to 3 process definitions"
write (u, "(A)") "* with 2, 1, 1 components, respectively"
write (u, "(A)")
call lib%init (var_str ("testlib"))
call lib%set_status (STAT_ACTIVE)
call lib%allocate_entries (5)
allocate (entry)
call entry%init (var_str ("test_a"), n_in = 2, n_components = 2)
allocate (prctest_2_t :: driver_template)
call lib%init_entry (3, STAT_SOURCE, entry%process_def_t, 2, 2, &
driver_template)
call lib%init_entry (4, STAT_COMPILED, entry%process_def_t, 1, 0)
call lib%append (entry)
allocate (entry)
call entry%init (var_str ("test_b"), n_in = 2, n_components = 1)
call lib%init_entry (2, STAT_CONFIGURED, entry%process_def_t, 1, 1)
call lib%append (entry)
allocate (entry)
call entry%init (var_str ("test_c"), n_in = 2, n_components = 1)
allocate (prctest_2_t :: driver_template)
call lib%init_entry (5, STAT_LINKED, entry%process_def_t, 1, 3, &
driver_template)
call lib%append (entry)
call lib%write (u)
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_3"
end subroutine process_libraries_3
@ %def process_libraries_3
@
\subsubsection{Process library for test matrix element (no file)}
Test 4: We proceed through the library generation and loading phases
with a test matrix element type that needs no code written on file.
<<Process libraries: execute tests>>=
call test (process_libraries_4, "process_libraries_4", &
"build and load internal process library", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_4
<<Process libraries: tests>>=
subroutine process_libraries_4 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_def_t), allocatable :: core_def
type(os_data_t) :: os_data
write (u, "(A)") "* Test output: process_libraries_4"
write (u, "(A)") "* Purpose: build a process library with an &
&internal (pseudo) matrix element"
write (u, "(A)") "* No Makefile or code should be generated"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry &
&(no external code)"
write (u, "(A)")
call os_data%init ()
call lib%init (var_str ("proclibs4"))
allocate (prcdef_2_t :: core_def)
allocate (entry)
call entry%init (var_str ("proclibs4_a"), n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, variant = core_def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Compute MD5 sum"
write (u, "(A)")
call lib%compute_md5sum ()
write (u, "(A)") "* Write makefile (no-op)"
write (u, "(A)")
call lib%write_makefile (os_data, force = .true., verbose = .true.)
write (u, "(A)") "* Write driver source code (no-op)"
write (u, "(A)")
call lib%write_driver (force = .true.)
write (u, "(A)") "* Write process source code (no-op)"
write (u, "(A)")
call lib%make_source (os_data)
write (u, "(A)") "* Compile (no-op)"
write (u, "(A)")
call lib%make_compile (os_data)
write (u, "(A)") "* Link (no-op)"
write (u, "(A)")
call lib%make_link (os_data)
write (u, "(A)") "* Load (no-op)"
write (u, "(A)")
call lib%load (os_data)
call lib%write (u)
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_4"
end subroutine process_libraries_4
@ %def process_libraries_4
@
\subsubsection{Build workflow for test matrix element}
Test 5: We write source code for a dummy process.
We define another trivial type for the process variant. The test
type contains just no variable data, but produces code on file.
<<Process libraries: test types>>=
type, extends (prc_core_def_t) :: prcdef_5_t
contains
<<Process libraries: prcdef 5: TBP>>
end type prcdef_5_t
@ %def prcdef_5_t
@ The process variant is named [[test_file]].
<<Process libraries: prcdef 5: TBP>>=
procedure, nopass :: type_string => prcdef_5_type_string
<<Process libraries: test auxiliary>>=
function prcdef_5_type_string () result (string)
type(string_t) :: string
string = "test_file"
end function prcdef_5_type_string
@ %def prcdef_5_type_string
@ We reuse the writer [[test_writer_4]] from the previous module.
<<Process libraries: prcdef 5: TBP>>=
procedure :: init => prcdef_5_init
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_init (object)
class(prcdef_5_t), intent(out) :: object
allocate (test_writer_4_t :: object%writer)
end subroutine prcdef_5_init
@ %def prcdef_5_init
@ Nothing to write.
<<Process libraries: prcdef 5: TBP>>=
procedure :: write => prcdef_5_write
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_write (object, unit)
class(prcdef_5_t), intent(in) :: object
integer, intent(in) :: unit
end subroutine prcdef_5_write
@ %def prcdef_5_write
@ Nothing to read.
<<Process libraries: prcdef 5: TBP>>=
procedure :: read => prcdef_5_read
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_read (object, unit)
class(prcdef_5_t), intent(out) :: object
integer, intent(in) :: unit
end subroutine prcdef_5_read
@ %def prcdef_5_read
@ Allocate the driver with the appropriate type.
<<Process libraries: prcdef 5: TBP>>=
procedure :: allocate_driver => prcdef_5_allocate_driver
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_allocate_driver (object, driver, basename)
class(prcdef_5_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
allocate (prctest_5_t :: driver)
end subroutine prcdef_5_allocate_driver
@ %def prcdef_5_allocate_driver
@ This time we need code:
<<Process libraries: prcdef 5: TBP>>=
procedure, nopass :: needs_code => prcdef_5_needs_code
<<Process libraries: test auxiliary>>=
function prcdef_5_needs_code () result (flag)
logical :: flag
flag = .true.
end function prcdef_5_needs_code
@ %def prcdef_5_needs_code
@ For the test case, we implement a single feature [[proc1]].
<<Process libraries: prcdef 5: TBP>>=
procedure, nopass :: get_features => prcdef_5_get_features
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_get_features (features)
type(string_t), dimension(:), allocatable, intent(out) :: features
allocate (features (1))
features = [ var_str ("proc1") ]
end subroutine prcdef_5_get_features
@ %def prcdef_5_get_features
@ Nothing to connect.
<<Process libraries: prcdef 5: TBP>>=
procedure :: connect => prcdef_5_connect
<<Process libraries: test auxiliary>>=
subroutine prcdef_5_connect (def, lib_driver, i, proc_driver)
class(prcdef_5_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
end subroutine prcdef_5_connect
@ %def prcdef_5_connect
@ The driver type.
<<Process libraries: test types>>=
type, extends (prc_core_driver_t) :: prctest_5_t
contains
<<Process libraries: prctest 5: TBP>>
end type prctest_5_t
@ %def prctest_5_t
@ Return the type name.
<<Process libraries: prctest 5: TBP>>=
procedure, nopass :: type_name => prctest_5_type_name
<<Process libraries: test auxiliary>>=
function prctest_5_type_name () result (type)
type(string_t) :: type
type = "test_file"
end function prctest_5_type_name
@ %def prctest_5_type_name
@
Here is the actual test:
<<Process libraries: execute tests>>=
call test (process_libraries_5, "process_libraries_5", &
"build external process library", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_5
<<Process libraries: tests>>=
subroutine process_libraries_5 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_def_t), allocatable :: core_def
type(os_data_t) :: os_data
write (u, "(A)") "* Test output: process_libraries_5"
write (u, "(A)") "* Purpose: build a process library with an &
&external (pseudo) matrix element"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call lib%init (var_str ("proclibs5"))
call os_data%init ()
allocate (prcdef_5_t :: core_def)
select type (core_def)
type is (prcdef_5_t)
call core_def%init ()
end select
allocate (entry)
call entry%init (var_str ("proclibs5_a"), &
model_name = var_str ("Test_Model"), &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = core_def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Compute MD5 sum"
write (u, "(A)")
call lib%compute_md5sum ()
write (u, "(A)") "* Write makefile"
write (u, "(A)")
call lib%write_makefile (os_data, force = .true., verbose = .false.)
write (u, "(A)") "* Write driver source code"
write (u, "(A)")
call lib%write_driver (force = .true.)
write (u, "(A)") "* Write process source code"
write (u, "(A)")
call lib%make_source (os_data)
write (u, "(A)") "* Compile"
write (u, "(A)")
call lib%make_compile (os_data)
write (u, "(A)") "* Link"
write (u, "(A)")
call lib%make_link (os_data)
call lib%write (u, libpath = .false.)
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_5"
end subroutine process_libraries_5
@ %def process_libraries_5
@
\subsubsection{Build and load library with test matrix element}
Test 6: We write source code for a dummy process.
This process variant is identical to the previous case, but it
supports a driver for the test procedure 'proc1'.
<<Process libraries: test types>>=
type, extends (prc_core_def_t) :: prcdef_6_t
contains
<<Process libraries: prcdef 6: TBP>>
end type prcdef_6_t
@ %def prcdef_6_t
@ The process variant is named [[test_file]].
<<Process libraries: prcdef 6: TBP>>=
procedure, nopass :: type_string => prcdef_6_type_string
<<Process libraries: test auxiliary>>=
function prcdef_6_type_string () result (string)
type(string_t) :: string
string = "test_file"
end function prcdef_6_type_string
@ %def prcdef_6_type_string
@ We reuse the writer [[test_writer_4]] from the previous module.
<<Process libraries: prcdef 6: TBP>>=
procedure :: init => prcdef_6_init
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_init (object)
class(prcdef_6_t), intent(out) :: object
allocate (test_writer_4_t :: object%writer)
call object%writer%init_test ()
end subroutine prcdef_6_init
@ %def prcdef_6_init
@ Nothing to write.
<<Process libraries: prcdef 6: TBP>>=
procedure :: write => prcdef_6_write
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_write (object, unit)
class(prcdef_6_t), intent(in) :: object
integer, intent(in) :: unit
end subroutine prcdef_6_write
@ %def prcdef_6_write
@ Nothing to read.
<<Process libraries: prcdef 6: TBP>>=
procedure :: read => prcdef_6_read
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_read (object, unit)
class(prcdef_6_t), intent(out) :: object
integer, intent(in) :: unit
end subroutine prcdef_6_read
@ %def prcdef_6_read
@ Allocate the driver with the appropriate type.
<<Process libraries: prcdef 6: TBP>>=
procedure :: allocate_driver => prcdef_6_allocate_driver
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_allocate_driver (object, driver, basename)
class(prcdef_6_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
allocate (prctest_6_t :: driver)
end subroutine prcdef_6_allocate_driver
@ %def prcdef_6_allocate_driver
@ This time we need code:
<<Process libraries: prcdef 6: TBP>>=
procedure, nopass :: needs_code => prcdef_6_needs_code
<<Process libraries: test auxiliary>>=
function prcdef_6_needs_code () result (flag)
logical :: flag
flag = .true.
end function prcdef_6_needs_code
@ %def prcdef_6_needs_code
@ For the test case, we implement a single feature [[proc1]].
<<Process libraries: prcdef 6: TBP>>=
procedure, nopass :: get_features => prcdef_6_get_features
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_get_features (features)
type(string_t), dimension(:), allocatable, intent(out) :: features
allocate (features (1))
features = [ var_str ("proc1") ]
end subroutine prcdef_6_get_features
@ %def prcdef_6_get_features
@ The interface of the only specific feature.
<<Process libraries: test types>>=
abstract interface
subroutine proc1_t (n) bind(C)
import
integer(c_int), intent(out) :: n
end subroutine proc1_t
end interface
@ %def proc1_t
@ Connect the feature [[proc1]] with the process driver.
<<Process libraries: prcdef 6: TBP>>=
procedure :: connect => prcdef_6_connect
<<Process libraries: test auxiliary>>=
subroutine prcdef_6_connect (def, lib_driver, i, proc_driver)
class(prcdef_6_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
integer(c_int) :: pid, fid
type(c_funptr) :: fptr
select type (proc_driver)
type is (prctest_6_t)
pid = i
fid = 1
call lib_driver%get_fptr (pid, fid, fptr)
call c_f_procpointer (fptr, proc_driver%proc1)
end select
end subroutine prcdef_6_connect
@ %def prcdef_6_connect
@
The driver type.
<<Process libraries: test types>>=
type, extends (prc_core_driver_t) :: prctest_6_t
procedure(proc1_t), nopass, pointer :: proc1 => null ()
contains
<<Process libraries: prctest 6: TBP>>
end type prctest_6_t
@ %def prctest_6_t
@ Return the type name.
<<Process libraries: prctest 6: TBP>>=
procedure, nopass :: type_name => prctest_6_type_name
<<Process libraries: test auxiliary>>=
function prctest_6_type_name () result (type)
type(string_t) :: type
type = "test_file"
end function prctest_6_type_name
@ %def prctest_6_type_name
@
Here is the actual test:
<<Process libraries: execute tests>>=
call test (process_libraries_6, "process_libraries_6", &
"build and load external process library", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_6
<<Process libraries: tests>>=
subroutine process_libraries_6 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_def_t), allocatable :: core_def
type(os_data_t) :: os_data
type(string_t), dimension(:), allocatable :: name_list
type(process_constants_t) :: data
class(prc_core_driver_t), allocatable :: proc_driver
integer :: i
integer(c_int) :: n
write (u, "(A)") "* Test output: process_libraries_6"
write (u, "(A)") "* Purpose: build and load a process library"
write (u, "(A)") "* with an external (pseudo) matrix element"
write (u, "(A)") "* Check single-call linking"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call lib%init (var_str ("proclibs6"))
call os_data%init ()
allocate (prcdef_6_t :: core_def)
select type (core_def)
type is (prcdef_6_t)
call core_def%init ()
end select
allocate (entry)
call entry%init (var_str ("proclibs6_a"), &
model_name = var_str ("Test_model"), &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = core_def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Write makefile"
write (u, "(A)")
call lib%write_makefile (os_data, force = .true., verbose = .false.)
write (u, "(A)") "* Write driver source code"
write (u, "(A)")
call lib%write_driver (force = .true.)
write (u, "(A)") "* Write process source code, compile, link, load"
write (u, "(A)")
call lib%load (os_data)
call lib%write (u, libpath = .false.)
write (u, "(A)")
write (u, "(A)") "* Probe library API:"
write (u, "(A)")
write (u, "(1x,A,A,A)") "name = '", &
char (lib%get_name ()), "'"
write (u, "(1x,A,L1)") "is active = ", &
lib%is_active ()
write (u, "(1x,A,I0)") "n_processes = ", &
lib%get_n_processes ()
write (u, "(1x,A)", advance="no") "processes ="
call lib%get_process_id_list (name_list)
do i = 1, size (name_list)
write (u, "(1x,A)", advance="no") char (name_list(i))
end do
write (u, *)
write (u, "(1x,A,L1)") "proclibs6_a is process = ", &
lib%contains (var_str ("proclibs6_a"))
write (u, "(1x,A,I0)") "proclibs6_a has index = ", &
lib%get_entry_index (var_str ("proclibs6_a"))
write (u, "(1x,A,L1)") "foobar is process = ", &
lib%contains (var_str ("foobar"))
write (u, "(1x,A,I0)") "foobar has index = ", &
lib%get_entry_index (var_str ("foobar"))
write (u, "(1x,A,I0)") "n_in(proclibs6_a) = ", &
lib%get_n_in (var_str ("proclibs6_a"))
write (u, "(1x,A,A)") "model_name(proclibs6_a) = ", &
char (lib%get_model_name (var_str ("proclibs6_a")))
write (u, "(1x,A)", advance="no") "components(proclibs6_a) ="
call lib%get_component_list (var_str ("proclibs6_a"), name_list)
do i = 1, size (name_list)
write (u, "(1x,A)", advance="no") char (name_list(i))
end do
write (u, *)
write (u, "(A)")
write (u, "(A)") "* Constants of proclibs6_a_i1:"
write (u, "(A)")
call lib%connect_process (var_str ("proclibs6_a"), 1, data, proc_driver)
write (u, "(1x,A,A)") "component ID = ", char (data%id)
write (u, "(1x,A,A)") "model name = ", char (data%model_name)
write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
write (u, "(1x,A,I0)") "n_in = ", data%n_in
write (u, "(1x,A,I0)") "n_out = ", data%n_out
write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
write (u, "(1x,A,I0)") "n_col = ", data%n_col
write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
write (u, "(1x,A,10(1x,I0))") "hel state =", data%hel_state
write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index
write (u, "(A)")
write (u, "(A)") "* Call feature of proclibs6_a:"
write (u, "(A)")
select type (proc_driver)
type is (prctest_6_t)
call proc_driver%proc1 (n)
write (u, "(1x,A,I0)") "proc1 = ", n
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_6"
end subroutine process_libraries_6
@ %def process_libraries_6
@
\subsubsection{MD5 sums}
Check MD5 sum calculation.
<<Process libraries: execute tests>>=
call test (process_libraries_7, "process_libraries_7", &
"process definition list", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_7
<<Process libraries: tests>>=
subroutine process_libraries_7 (u)
integer, intent(in) :: u
type(prc_template_t), dimension(:), allocatable :: process_core_templates
type(process_def_entry_t), target :: entry
class(prc_core_def_t), allocatable :: test_def
class(prc_core_def_t), pointer :: def
write (u, "(A)") "* Test output: process_libraries_7"
write (u, "(A)") "* Purpose: Construct a process definition list &
&and check MD5 sums"
write (u, "(A)")
write (u, "(A)") "* Construct a process definition list"
write (u, "(A)") "* Process: two components"
write (u, "(A)")
allocate (process_core_templates (1))
allocate (prcdef_2_t :: process_core_templates(1)%core_def)
call entry%init (var_str ("first"), model_name = var_str ("Test"), &
n_in = 1, n_components = 2)
allocate (prcdef_2_t :: test_def)
select type (test_def)
type is (prcdef_2_t); test_def%data = 31
end select
call entry%import_component (1, n_out = 3, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c"), &
var_str ("e")]), &
method = var_str ("test"), &
variant = test_def)
allocate (prcdef_2_t :: test_def)
select type (test_def)
type is (prcdef_2_t); test_def%data = 42
end select
call entry%import_component (2, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = test_def)
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Compute MD5 sums"
write (u, "(A)")
call entry%compute_md5sum ()
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Recalculate MD5 sums (should be identical)"
write (u, "(A)")
call entry%compute_md5sum ()
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Modify a component and recalculate MD5 sums"
write (u, "(A)")
def => entry%get_core_def_ptr (2)
select type (def)
type is (prcdef_2_t)
def%data = 54
end select
call entry%compute_md5sum ()
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Modify the model and recalculate MD5 sums"
write (u, "(A)")
call entry%set_model_name (var_str ("foo"))
call entry%compute_md5sum ()
call entry%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_7"
end subroutine process_libraries_7
@ %def process_libraries_7
@
Here is the actual test:
<<Process libraries: execute tests>>=
call test (process_libraries_8, "process_libraries_8", &
"library status checks", &
u, results)
<<Process libraries: test declarations>>=
public :: process_libraries_8
<<Process libraries: tests>>=
subroutine process_libraries_8 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
type(process_def_entry_t), pointer :: entry
class(prc_core_def_t), allocatable :: core_def
type(os_data_t) :: os_data
write (u, "(A)") "* Test output: process_libraries_8"
write (u, "(A)") "* Purpose: build and load a process library"
write (u, "(A)") "* with an external (pseudo) matrix element"
write (u, "(A)") "* Check status updates"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call lib%init (var_str ("proclibs8"))
call os_data%init ()
allocate (prcdef_6_t :: core_def)
select type (core_def)
type is (prcdef_6_t)
call core_def%init ()
end select
allocate (entry)
call entry%init (var_str ("proclibs8_a"), &
model_name = var_str ("Test_model"), &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
method = var_str ("test"), &
variant = core_def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
call lib%compute_md5sum ()
call lib%test_transfer_md5sum (1, 1, 1)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(A)")
write (u, "(A)") "* Write makefile"
write (u, "(A)")
call lib%write_makefile (os_data, force = .true., verbose = .false.)
write (u, "(A)") "* Update status"
write (u, "(A)")
call lib%update_status (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(A)")
write (u, "(A)") "* Write driver source code"
write (u, "(A)")
call lib%write_driver (force = .false.)
write (u, "(A)") "* Write process source code"
write (u, "(A)")
call lib%make_source (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(A)")
write (u, "(A)") "* Compile and load"
write (u, "(A)")
call lib%load (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(A)")
write (u, "(A)") "* Append process and reconfigure"
write (u, "(A)")
allocate (prcdef_6_t :: core_def)
select type (core_def)
type is (prcdef_6_t)
call core_def%init ()
end select
allocate (entry)
call entry%init (var_str ("proclibs8_b"), &
model_name = var_str ("Test_model"), &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = 2, &
prt_in = new_prt_spec ([var_str ("a")]), &
prt_out = new_prt_spec ([var_str ("b"), var_str ("d")]), &
method = var_str ("test"), &
variant = core_def)
call lib%append (entry)
call lib%configure (os_data)
call lib%compute_md5sum ()
call lib%test_transfer_md5sum (2, 2, 1)
call lib%write_makefile (os_data, force = .false., verbose = .false.)
call lib%write_driver (force = .false.)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Update status"
write (u, "(A)")
call lib%update_status (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Write source code"
write (u, "(A)")
call lib%make_source (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Reset status"
write (u, "(A)")
call lib%set_status (STAT_CONFIGURED, entries=.true.)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Update status"
write (u, "(A)")
call lib%update_status (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Partial cleanup"
write (u, "(A)")
call lib%clean (os_data, distclean = .false.)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Update status"
write (u, "(A)")
call lib%update_status (os_data)
write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)
write (u, "(A)")
write (u, "(A)") "* Complete cleanup"
call lib%clean (os_data, distclean = .true.)
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: process_libraries_8"
end subroutine process_libraries_8
@ %def process_libraries_8
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Process Library Stacks}
For storing and handling multiple libraries, we define process library stacks.
These are ordinary stacks where new entries are pushed onto the top.
<<[[prclib_stacks.f90]]>>=
<<File header>>
module prclib_stacks
<<Use strings>>
- use io_units
- use format_utils, only: write_separator
use process_libraries
<<Standard module head>>
<<Prclib stacks: public>>
<<Prclib stacks: types>>
+ interface
+<<Prclib stacks: sub interfaces>>
+ end interface
+
+end module prclib_stacks
+@ %def prclib_stacks
+@
+<<[[prclib_stacks_sub.f90]]>>=
+<<File header>>
+
+submodule (prclib_stacks) prclib_stacks_s
+
+ use io_units
+ use format_utils, only: write_separator
+
+ implicit none
+
contains
<<Prclib stacks: procedures>>
-end module prclib_stacks
-@ %def prclib_stacks
+end submodule prclib_stacks_s
+
+@ %def prclib_stacks_s
@
\subsection{The stack entry type}
A stack entry is a process library object, augmented by a pointer to the
next entry. We do not need specific methods, all relevant methods are
inherited.
On higher level, process libraries should be prepared as process entry objects.
<<Prclib stacks: public>>=
public :: prclib_entry_t
<<Prclib stacks: types>>=
type, extends (process_library_t) :: prclib_entry_t
type(prclib_entry_t), pointer :: next => null ()
end type prclib_entry_t
@ %def prclib_entry_t
@
\subsection{The prclib stack type}
For easy conversion and lookup it is useful to store the filling
number in the object. The content is stored as a linked list.
<<Prclib stacks: public>>=
public :: prclib_stack_t
<<Prclib stacks: types>>=
type :: prclib_stack_t
integer :: n = 0
type(prclib_entry_t), pointer :: first => null ()
contains
<<Prclib stacks: prclib stack: TBP>>
end type prclib_stack_t
@ %def prclib_stack_t
@ Finalizer. Iteratively deallocate the stack entries. The resulting
empty stack can be immediately recycled, if necessary.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: final => prclib_stack_final
+<<Prclib stacks: sub interfaces>>=
+ module subroutine prclib_stack_final (object)
+ class(prclib_stack_t), intent(inout) :: object
+ end subroutine prclib_stack_final
<<Prclib stacks: procedures>>=
- subroutine prclib_stack_final (object)
+ module subroutine prclib_stack_final (object)
class(prclib_stack_t), intent(inout) :: object
type(prclib_entry_t), pointer :: lib
do while (associated (object%first))
lib => object%first
object%first => lib%next
call lib%final ()
deallocate (lib)
end do
object%n = 0
end subroutine prclib_stack_final
@ %def prclib_stack_final
@ Output. The entries on the stack will be ordered LIFO, i.e., backwards.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: write => prclib_stack_write
+<<Prclib stacks: sub interfaces>>=
+ module subroutine prclib_stack_write (object, unit, libpath)
+ class(prclib_stack_t), intent(in) :: object
+ integer, intent(in), optional :: unit
+ logical, intent(in), optional :: libpath
+ end subroutine prclib_stack_write
<<Prclib stacks: procedures>>=
- subroutine prclib_stack_write (object, unit, libpath)
+ module subroutine prclib_stack_write (object, unit, libpath)
class(prclib_stack_t), intent(in) :: object
integer, intent(in), optional :: unit
logical, intent(in), optional :: libpath
type(prclib_entry_t), pointer :: lib
integer :: u
u = given_output_unit (unit)
call write_separator (u, 2)
select case (object%n)
case (0)
write (u, "(1x,A)") "Process library stack: [empty]"
case default
write (u, "(1x,A)") "Process library stack:"
lib => object%first
do while (associated (lib))
call write_separator (u)
call lib%write (u, libpath)
lib => lib%next
end do
end select
call write_separator (u, 2)
end subroutine prclib_stack_write
@ %def prclib_stack_write
@
\subsection{Operating on Stacks}
We take a library entry pointer and push it onto the stack. The previous
pointer is nullified. Subsequently, the library entry is `owned' by the
stack and will be finalized when the stack is deleted.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: push => prclib_stack_push
+<<Prclib stacks: sub interfaces>>=
+ module subroutine prclib_stack_push (stack, lib)
+ class(prclib_stack_t), intent(inout) :: stack
+ type(prclib_entry_t), intent(inout), pointer :: lib
+ end subroutine prclib_stack_push
<<Prclib stacks: procedures>>=
- subroutine prclib_stack_push (stack, lib)
+ module subroutine prclib_stack_push (stack, lib)
class(prclib_stack_t), intent(inout) :: stack
type(prclib_entry_t), intent(inout), pointer :: lib
lib%next => stack%first
stack%first => lib
lib => null ()
stack%n = stack%n + 1
end subroutine prclib_stack_push
@ %def prclib_stack_push
@
\subsection{Accessing Contents}
Return a pointer to the topmost stack element. The result type is
just the bare [[process_library_t]]. There is no [[target]] attribute
required since the stack elements are allocated via pointers.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: get_first_ptr => prclib_stack_get_first_ptr
+<<Prclib stacks: sub interfaces>>=
+ module function prclib_stack_get_first_ptr (stack) result (ptr)
+ class(prclib_stack_t), intent(in) :: stack
+ type(process_library_t), pointer :: ptr
+ end function prclib_stack_get_first_ptr
<<Prclib stacks: procedures>>=
- function prclib_stack_get_first_ptr (stack) result (ptr)
+ module function prclib_stack_get_first_ptr (stack) result (ptr)
class(prclib_stack_t), intent(in) :: stack
type(process_library_t), pointer :: ptr
if (associated (stack%first)) then
ptr => stack%first%process_library_t
else
ptr => null ()
end if
end function prclib_stack_get_first_ptr
@ %def prclib_stack_get_first_ptr
@ Return a complete list of the libraries (names) in the stack. The list is
in the order in which the elements got pushed onto the stack, so the 'first'
entry is listed last.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: get_names => prclib_stack_get_names
+<<Prclib stacks: sub interfaces>>=
+ module subroutine prclib_stack_get_names (stack, libname)
+ class(prclib_stack_t), intent(in) :: stack
+ type(string_t), dimension(:), allocatable, intent(out) :: libname
+ end subroutine prclib_stack_get_names
<<Prclib stacks: procedures>>=
- subroutine prclib_stack_get_names (stack, libname)
+ module subroutine prclib_stack_get_names (stack, libname)
class(prclib_stack_t), intent(in) :: stack
type(string_t), dimension(:), allocatable, intent(out) :: libname
type(prclib_entry_t), pointer :: lib
integer :: i
allocate (libname (stack%n))
i = stack%n
lib => stack%first
do while (associated (lib))
libname(i) = lib%get_name ()
i = i - 1
lib => lib%next
end do
end subroutine prclib_stack_get_names
@ %def prclib_stack_get_names
@ Return a pointer to the library with given name.
<<Prclib stacks: prclib stack: TBP>>=
procedure :: get_library_ptr => prclib_stack_get_library_ptr
+<<Prclib stacks: sub interfaces>>=
+ module function prclib_stack_get_library_ptr (stack, libname) result (ptr)
+ class(prclib_stack_t), intent(in) :: stack
+ type(string_t), intent(in) :: libname
+ type(process_library_t), pointer :: ptr
+ end function prclib_stack_get_library_ptr
<<Prclib stacks: procedures>>=
- function prclib_stack_get_library_ptr (stack, libname) result (ptr)
+ module function prclib_stack_get_library_ptr (stack, libname) result (ptr)
class(prclib_stack_t), intent(in) :: stack
type(string_t), intent(in) :: libname
type(process_library_t), pointer :: ptr
type(prclib_entry_t), pointer :: current
current => stack%first
do while (associated (current))
if (current%get_name () == libname) then
ptr => current%process_library_t
return
end if
current => current%next
end do
ptr => null ()
end function prclib_stack_get_library_ptr
@ %def prclib_stack_get_library_ptr
@
\subsection{Unit tests}
Test module, followed by the corresponding implementation module.
<<[[prclib_stacks_ut.f90]]>>=
<<File header>>
module prclib_stacks_ut
use unit_tests
use prclib_stacks_uti
<<Standard module head>>
<<Prclib stacks: public test>>
contains
<<Prclib stacks: test driver>>
end module prclib_stacks_ut
@ %def prclib_stacks_ut
@
<<[[prclib_stacks_uti.f90]]>>=
<<File header>>
module prclib_stacks_uti
<<Use strings>>
use prclib_stacks
<<Standard module head>>
<<Prclib stacks: test declarations>>
contains
<<Prclib stacks: tests>>
end module prclib_stacks_uti
@ %def prclib_stacks_ut
@ API: driver for the unit tests below.
<<Prclib stacks: public test>>=
public :: prclib_stacks_test
<<Prclib stacks: test driver>>=
subroutine prclib_stacks_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Prclib stacks: execute tests>>
end subroutine prclib_stacks_test
@ %def prclib_stacks_test
@
\subsubsection{Write an empty process library stack}
The most trivial test is to write an uninitialized process library stack.
<<Prclib stacks: execute tests>>=
call test (prclib_stacks_1, "prclib_stacks_1", &
"write an empty process library stack", &
u, results)
<<Prclib stacks: test declarations>>=
public :: prclib_stacks_1
<<Prclib stacks: tests>>=
subroutine prclib_stacks_1 (u)
integer, intent(in) :: u
type(prclib_stack_t) :: stack
write (u, "(A)") "* Test output: prclib_stacks_1"
write (u, "(A)") "* Purpose: display an empty process library stack"
write (u, "(A)")
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_stacks_1"
end subroutine prclib_stacks_1
@ %def prclib_stacks_1
@
\subsubsection{Fill a process library stack}
Fill a process library stack with two (identical) processes.
<<Prclib stacks: execute tests>>=
call test (prclib_stacks_2, "prclib_stacks_2", &
"fill a process library stack", &
u, results)
<<Prclib stacks: test declarations>>=
public :: prclib_stacks_2
<<Prclib stacks: tests>>=
subroutine prclib_stacks_2 (u)
integer, intent(in) :: u
type(prclib_stack_t) :: stack
type(prclib_entry_t), pointer :: lib
write (u, "(A)") "* Test output: prclib_stacks_2"
write (u, "(A)") "* Purpose: fill a process library stack"
write (u, "(A)")
write (u, "(A)") "* Initialize two (empty) libraries &
&and push them on the stack"
write (u, "(A)")
allocate (lib)
call lib%init (var_str ("lib1"))
call stack%push (lib)
allocate (lib)
call lib%init (var_str ("lib2"))
call stack%push (lib)
call stack%write (u)
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call stack%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prclib_stacks_2"
end subroutine prclib_stacks_2
@ %def prclib_stacks_2
@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Trivial matrix element for tests}
For the purpose of testing the workflow, we implement here two matrix
elements with the simplest possible structure.
This matrix element generator can only generate a single scattering
process and a single decay process. The scattering process is a
quartic interaction of a massless, neutral and colorless scalar [[s]]
with unit coupling results in a trivial $2\to 2$ scattering process.
The matrix element is implemented internally, so we do not need the
machinery of external process libraries. The decay process is a decay
of [[s]] into a pair of colored fermions [[f]].
<<[[prc_test.f90]]>>=
<<File header>>
module prc_test
use, intrinsic :: iso_c_binding !NODEP!
<<Use kinds>>
<<Use strings>>
use os_interface
+ use particle_specifiers, only: new_prt_spec
use process_constants
use prclib_interfaces
use prc_core_def
- use particle_specifiers, only: new_prt_spec
use process_libraries
<<Standard module head>>
<<Test ME: public>>
<<Test ME: types>>
+ interface
+<<Test ME: sub interfaces>>
+ end interface
+
contains
-<<Test ME: procedures>>
+<<Test ME: main procedures>>
end module prc_test
@ %def prc_test
@
+<<[[prc_test_sub.f90]]>>=
+<<File header>>
+
+submodule (prc_test) prc_test_s
+
+ implicit none
+
+contains
+
+<<Test ME: procedures>>
+
+end submodule prc_test_s
+
+@ %def prc_test_s
+@
\subsection{Process definition}
For the process definition we implement an extension of the
[[prc_core_def_t]] abstract type.
<<Test ME: public>>=
public :: prc_test_def_t
<<Test ME: types>>=
type, extends (prc_core_def_t) :: prc_test_def_t
type(string_t) :: model_name
type(string_t), dimension(:), allocatable :: prt_in
type(string_t), dimension(:), allocatable :: prt_out
contains
<<Test ME: test me def: TBP>>
end type prc_test_def_t
@ %def prc_test_def_t
<<Test ME: test me def: TBP>>=
procedure, nopass :: type_string => prc_test_def_type_string
+<<Test ME: sub interfaces>>=
+ module function prc_test_def_type_string () result (string)
+ type(string_t) :: string
+ end function prc_test_def_type_string
<<Test ME: procedures>>=
- function prc_test_def_type_string () result (string)
+ module function prc_test_def_type_string () result (string)
type(string_t) :: string
string = "test_me"
end function prc_test_def_type_string
@ %def prc_test_def_type_string
@ There is no 'feature' here since there is no external code.
<<Test ME: test me def: TBP>>=
procedure, nopass :: get_features => prc_test_def_get_features
+<<Test ME: sub interfaces>>=
+ module subroutine prc_test_def_get_features (features)
+ type(string_t), dimension(:), allocatable, intent(out) :: features
+ end subroutine prc_test_def_get_features
<<Test ME: procedures>>=
- subroutine prc_test_def_get_features (features)
+ module subroutine prc_test_def_get_features (features)
type(string_t), dimension(:), allocatable, intent(out) :: features
allocate (features (0))
end subroutine prc_test_def_get_features
@ %def prc_test_def_get_features
@ Initialization: set some data (not really useful).
<<Test ME: test me def: TBP>>=
procedure :: init => prc_test_def_init
+<<Test ME: sub interfaces>>=
+ module subroutine prc_test_def_init (object, model_name, prt_in, prt_out)
+ class(prc_test_def_t), intent(out) :: object
+ type(string_t), intent(in) :: model_name
+ type(string_t), dimension(:), intent(in) :: prt_in
+ type(string_t), dimension(:), intent(in) :: prt_out
+ end subroutine prc_test_def_init
<<Test ME: procedures>>=
- subroutine prc_test_def_init (object, model_name, prt_in, prt_out)
+ module subroutine prc_test_def_init (object, model_name, prt_in, prt_out)
class(prc_test_def_t), intent(out) :: object
type(string_t), intent(in) :: model_name
type(string_t), dimension(:), intent(in) :: prt_in
type(string_t), dimension(:), intent(in) :: prt_out
object%model_name = model_name
allocate (object%prt_in (size (prt_in)))
object%prt_in = prt_in
allocate (object%prt_out (size (prt_out)))
object%prt_out = prt_out
end subroutine prc_test_def_init
@ %def prc_test_def_init
@ Write/read process- and method-specific data. (No-op)
<<Test ME: test me def: TBP>>=
procedure :: write => prc_test_def_write
+<<Test ME: sub interfaces>>=
+ module subroutine prc_test_def_write (object, unit)
+ class(prc_test_def_t), intent(in) :: object
+ integer, intent(in) :: unit
+ end subroutine prc_test_def_write
<<Test ME: procedures>>=
- subroutine prc_test_def_write (object, unit)
+ module subroutine prc_test_def_write (object, unit)
class(prc_test_def_t), intent(in) :: object
integer, intent(in) :: unit
end subroutine prc_test_def_write
@ %def prc_test_def_write
@
<<Test ME: test me def: TBP>>=
procedure :: read => prc_test_def_read
+<<Test ME: sub interfaces>>=
+ module subroutine prc_test_def_read (object, unit)
+ class(prc_test_def_t), intent(out) :: object
+ integer, intent(in) :: unit
+ end subroutine prc_test_def_read
<<Test ME: procedures>>=
- subroutine prc_test_def_read (object, unit)
+ module subroutine prc_test_def_read (object, unit)
class(prc_test_def_t), intent(out) :: object
integer, intent(in) :: unit
end subroutine prc_test_def_read
@ %def prc_test_def_read
@ Allocate the driver for test ME matrix elements. We get the
actual component ID (basename), and we can transfer all
-process-specific data from the process definition.
+process-specific data from the process definition.Due to a bug of
+bind(C) features with submodules in gfortran 7/8/9 (and maybe together
+with MPI) this needs to be in the module, not the submodule.
<<Test ME: test me def: TBP>>=
procedure :: allocate_driver => prc_test_def_allocate_driver
-<<Test ME: procedures>>=
+<<Test ME: main procedures>>=
subroutine prc_test_def_allocate_driver (object, driver, basename)
class(prc_test_def_t), intent(in) :: object
class(prc_core_driver_t), intent(out), allocatable :: driver
type(string_t), intent(in) :: basename
allocate (prc_test_t :: driver)
select type (driver)
type is (prc_test_t)
driver%id = basename
driver%model_name = object%model_name
select case (size (object%prt_in))
case (1); driver%scattering = .false.
case (2); driver%scattering = .true.
end select
end select
end subroutine prc_test_def_allocate_driver
@ %def prc_test_def_allocate_driver
@ Nothing to connect. This subroutine will not be called.
<<Test ME: test me def: TBP>>=
procedure :: connect => prc_test_def_connect
+<<Test ME: sub interfaces>>=
+ module subroutine prc_test_def_connect (def, lib_driver, i, proc_driver)
+ class(prc_test_def_t), intent(in) :: def
+ class(prclib_driver_t), intent(in) :: lib_driver
+ integer, intent(in) :: i
+ class(prc_core_driver_t), intent(inout) :: proc_driver
+ end subroutine prc_test_def_connect
<<Test ME: procedures>>=
- subroutine prc_test_def_connect (def, lib_driver, i, proc_driver)
+ module subroutine prc_test_def_connect (def, lib_driver, i, proc_driver)
class(prc_test_def_t), intent(in) :: def
class(prclib_driver_t), intent(in) :: lib_driver
integer, intent(in) :: i
class(prc_core_driver_t), intent(inout) :: proc_driver
end subroutine prc_test_def_connect
@ %def prc_test_def_connect
@
\subsection{Driver}
<<Test ME: public>>=
public :: prc_test_t
<<Test ME: types>>=
type, extends (process_driver_internal_t) :: prc_test_t
type(string_t) :: id
type(string_t) :: model_name
logical :: scattering = .true.
contains
<<Test ME: test me driver: TBP>>
end type prc_test_t
@ %def prc_test_t
@ In contrast to generic matrix-element implementations, we can
hard-wire the amplitude method as a type-bound procedure.
<<Test ME: test me driver: TBP>>=
procedure, nopass :: get_amplitude => prc_test_get_amplitude
+<<Test ME: sub interfaces>>=
+ module function prc_test_get_amplitude (p) result (amp)
+ complex(default) :: amp
+ real(default), dimension(:,:), intent(in) :: p
+ end function prc_test_get_amplitude
<<Test ME: procedures>>=
- function prc_test_get_amplitude (p) result (amp)
+ module function prc_test_get_amplitude (p) result (amp)
complex(default) :: amp
real(default), dimension(:,:), intent(in) :: p
amp = 1
end function prc_test_get_amplitude
@ %def prc_test_get_amplitude
@ The reported type is the same as for the [[prc_test_def_t]] type.
<<Test ME: test me driver: TBP>>=
procedure, nopass :: type_name => prc_test_type_name
+<<Test ME: sub interfaces>>=
+ module function prc_test_type_name () result (string)
+ type(string_t) :: string
+ end function prc_test_type_name
<<Test ME: procedures>>=
- function prc_test_type_name () result (string)
+ module function prc_test_type_name () result (string)
type(string_t) :: string
string = "test_me"
end function prc_test_type_name
@ %def prc_test_type_name
@ Fill process constants.
<<Test ME: test me driver: TBP>>=
procedure :: fill_constants => prc_test_fill_constants
+<<Test ME: sub interfaces>>=
+ module subroutine prc_test_fill_constants (driver, data)
+ class(prc_test_t), intent(in) :: driver
+ type(process_constants_t), intent(out) :: data
+ end subroutine prc_test_fill_constants
<<Test ME: procedures>>=
- subroutine prc_test_fill_constants (driver, data)
+ module subroutine prc_test_fill_constants (driver, data)
class(prc_test_t), intent(in) :: driver
type(process_constants_t), intent(out) :: data
data%id = driver%id
data%model_name = driver%model_name
if (driver%scattering) then
data%n_in = 2
data%n_out = 2
data%n_flv = 1
data%n_hel = 1
data%n_col = 1
data%n_cin = 2
data%n_cf = 1
allocate (data%flv_state (4, 1))
data%flv_state = 25
allocate (data%hel_state (4, 1))
data%hel_state = 0
allocate (data%col_state (2, 4, 1))
data%col_state = 0
allocate (data%ghost_flag (4, 1))
data%ghost_flag = .false.
allocate (data%color_factors (1))
data%color_factors = 1
allocate (data%cf_index (2, 1))
data%cf_index = 1
else
data%n_in = 1
data%n_out = 2
data%n_flv = 1
data%n_hel = 2
data%n_col = 1
data%n_cin = 2
data%n_cf = 1
allocate (data%flv_state (3, 1))
data%flv_state(:,1) = [25, 6, -6]
allocate (data%hel_state (3, 2))
data%hel_state(:,1) = [0, 1,-1]
data%hel_state(:,2) = [0,-1, 1]
allocate (data%col_state (2, 3, 1))
data%col_state = reshape ([0,0, 1,0, 0,-1], [2,3,1])
allocate (data%ghost_flag (3, 1))
data%ghost_flag = .false.
allocate (data%color_factors (1))
data%color_factors = 3
allocate (data%cf_index (2, 1))
data%cf_index = 1
end if
end subroutine prc_test_fill_constants
@ %def prc_test_fill_constants
@
\subsection{Shortcut}
Since this module is there for testing purposes, we set up a
subroutine that does all the work at once: create a library with the
two processes (scattering and decay), configure and load, and set up
-the driver.
+the driver. Due to a bug of bind(C) features with submodules in
+gfortran 7/8/9 (and maybe together with MPI) this needs to be in the
+module, not the submodule.
<<Test ME: public>>=
public :: prc_test_create_library
-<<Test ME: procedures>>=
+<<Test ME: main procedures>>=
subroutine prc_test_create_library &
(libname, lib, scattering, decay, procname1, procname2)
type(string_t), intent(in) :: libname
type(process_library_t), intent(out) :: lib
logical, intent(in), optional :: scattering, decay
type(string_t), intent(in), optional :: procname1, procname2
type(string_t) :: model_name, procname
type(string_t), dimension(:), allocatable :: prt_in, prt_out
class(prc_core_def_t), allocatable :: def
type(process_def_entry_t), pointer :: entry
type(os_data_t) :: os_data
logical :: sca, dec
sca = .true.; if (present (scattering)) sca = scattering
dec = .false.; if (present (decay)) dec = decay
call os_data%init ()
call lib%init (libname)
model_name = "Test"
if (sca) then
if (present (procname1)) then
procname = procname1
else
procname = libname
end if
allocate (prt_in (2), prt_out (2))
prt_in = [var_str ("s"), var_str ("s")]
prt_out = [var_str ("s"), var_str ("s")]
allocate (prc_test_def_t :: def)
select type (def)
type is (prc_test_def_t)
call def%init (model_name, prt_in, prt_out)
end select
allocate (entry)
call entry%init (procname, model_name = model_name, &
n_in = 2, n_components = 1)
call entry%import_component (1, n_out = size (prt_out), &
prt_in = new_prt_spec (prt_in), &
prt_out = new_prt_spec (prt_out), &
method = var_str ("test_me"), &
variant = def)
call lib%append (entry)
end if
if (dec) then
if (present (procname2)) then
procname = procname2
else
procname = libname
end if
if (allocated (prt_in)) deallocate (prt_in, prt_out)
allocate (prt_in (1), prt_out (2))
prt_in = [var_str ("s")]
prt_out = [var_str ("f"), var_str ("fbar")]
allocate (prc_test_def_t :: def)
select type (def)
type is (prc_test_def_t)
call def%init (model_name, prt_in, prt_out)
end select
allocate (entry)
call entry%init (procname, model_name = model_name, &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = size (prt_out), &
prt_in = new_prt_spec (prt_in), &
prt_out = new_prt_spec (prt_out), &
method = var_str ("test_decay"), &
variant = def)
call lib%append (entry)
end if
call lib%configure (os_data)
call lib%load (os_data)
end subroutine prc_test_create_library
@ %def prc_test_create_library
@
\subsection{Unit Test}
Test module, followed by the corresponding implementation module.
<<[[prc_test_ut.f90]]>>=
<<File header>>
module prc_test_ut
use unit_tests
use prc_test_uti
<<Standard module head>>
<<Test ME: public test>>
contains
<<Test ME: test driver>>
end module prc_test_ut
@ %def prc_test_ut
@
<<[[prc_test_uti.f90]]>>=
<<File header>>
module prc_test_uti
<<Use kinds>>
<<Use strings>>
use os_interface
use particle_specifiers, only: new_prt_spec
use process_constants
use prc_core_def
use process_libraries
use prc_test
<<Standard module head>>
<<Test ME: test declarations>>
contains
<<Test ME: tests>>
end module prc_test_uti
@ %def prc_test_ut
@ API: driver for the unit tests below.
<<Test ME: public test>>=
public :: prc_test_test
<<Test ME: test driver>>=
subroutine prc_test_test (u, results)
integer, intent(in) :: u
type(test_results_t), intent(inout) :: results
<<Test ME: execute tests>>
end subroutine prc_test_test
@ %def prc_test_test
@
\subsubsection{Generate and load the scattering process}
The process is $s s \to s s$, where $s$ is a trivial scalar particle,
for vanishing mass and unit coupling. We initialize the process,
build the library, and compute the particular matrix element for
momenta of unit energy and right-angle scattering. (The scattering is
independent of angle.) The matrix element is equal to unity.
<<Test ME: execute tests>>=
call test (prc_test_1, "prc_test_1", &
"build and load trivial process", &
u, results)
<<Test ME: test declarations>>=
public :: prc_test_1
<<Test ME: tests>>=
subroutine prc_test_1 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(process_library_t) :: lib
class(prc_core_def_t), allocatable :: def
type(process_def_entry_t), pointer :: entry
type(string_t) :: model_name
type(string_t), dimension(:), allocatable :: prt_in, prt_out
type(process_constants_t) :: data
class(prc_core_driver_t), allocatable :: driver
real(default), dimension(0:3,4) :: p
integer :: i
write (u, "(A)") "* Test output: prc_test_1"
write (u, "(A)") "* Purpose: create a trivial process"
write (u, "(A)") "* build a library and &
&access the matrix element"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call os_data%init ()
call lib%init (var_str ("prc_test1"))
model_name = "Test"
allocate (prt_in (2), prt_out (2))
prt_in = [var_str ("s"), var_str ("s")]
prt_out = [var_str ("s"), var_str ("s")]
allocate (prc_test_def_t :: def)
select type (def)
type is (prc_test_def_t)
call def%init (model_name, prt_in, prt_out)
end select
allocate (entry)
call entry%init (var_str ("prc_test1_a"), model_name = model_name, &
n_in = 2, n_components = 1)
call entry%import_component (1, n_out = size (prt_out), &
prt_in = new_prt_spec (prt_in), &
prt_out = new_prt_spec (prt_out), &
method = var_str ("test_me"), &
variant = def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Load library"
write (u, "(A)")
call lib%load (os_data)
call lib%write (u)
write (u, "(A)")
write (u, "(A)") "* Probe library API:"
write (u, "(A)")
write (u, "(1x,A,L1)") "is active = ", &
lib%is_active ()
write (u, "(1x,A,I0)") "n_processes = ", &
lib%get_n_processes ()
write (u, "(A)")
write (u, "(A)") "* Constants of prc_test1_a_i1:"
write (u, "(A)")
call lib%connect_process (var_str ("prc_test1_a"), 1, data, driver)
write (u, "(1x,A,A)") "component ID = ", char (data%id)
write (u, "(1x,A,A)") "model name = ", char (data%model_name)
write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
write (u, "(1x,A,I0)") "n_in = ", data%n_in
write (u, "(1x,A,I0)") "n_out = ", data%n_out
write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
write (u, "(1x,A,I0)") "n_col = ", data%n_col
write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index
write (u, "(A)")
write (u, "(A)") "* Set kinematics:"
write (u, "(A)")
p = reshape ([ &
1.0_default, 0.0_default, 0.0_default, 1.0_default, &
1.0_default, 0.0_default, 0.0_default,-1.0_default, &
1.0_default, 1.0_default, 0.0_default, 0.0_default, &
1.0_default,-1.0_default, 0.0_default, 0.0_default &
], [4,4])
do i = 1, 4
write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
end do
write (u, "(A)")
write (u, "(A)") "* Compute matrix element:"
write (u, "(A)")
select type (driver)
type is (prc_test_t)
write (u, "(1x,A,1x,E11.4)") "|amp| =", abs (driver%get_amplitude (p))
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prc_test_1"
end subroutine prc_test_1
@ %def prc_test_1
@
\subsubsection{Shortcut}
This is identical to the previous test, but we create the library be a single
command. This is handy for other modules which use the test process.
<<Test ME: execute tests>>=
call test (prc_test_2, "prc_test_2", &
"build and load trivial process using shortcut", &
u, results)
<<Test ME: test declarations>>=
public :: prc_test_2
<<Test ME: tests>>=
subroutine prc_test_2 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
class(prc_core_driver_t), allocatable :: driver
type(process_constants_t) :: data
real(default), dimension(0:3,4) :: p
write (u, "(A)") "* Test output: prc_test_2"
write (u, "(A)") "* Purpose: create a trivial process"
write (u, "(A)") "* build a library and &
&access the matrix element"
write (u, "(A)")
write (u, "(A)") "* Build and load a process library with one entry"
call prc_test_create_library (var_str ("prc_test2"), lib)
call lib%connect_process (var_str ("prc_test2"), 1, data, driver)
p = reshape ([ &
1.0_default, 0.0_default, 0.0_default, 1.0_default, &
1.0_default, 0.0_default, 0.0_default,-1.0_default, &
1.0_default, 1.0_default, 0.0_default, 0.0_default, &
1.0_default,-1.0_default, 0.0_default, 0.0_default &
], [4,4])
write (u, "(A)")
write (u, "(A)") "* Compute matrix element:"
write (u, "(A)")
select type (driver)
type is (prc_test_t)
write (u, "(1x,A,1x,E11.4)") "|amp| =", abs (driver%get_amplitude (p))
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prc_test_2"
end subroutine prc_test_2
@ %def prc_test_2
@
\subsubsection{Generate and load the decay process}
The process is $s \to f\bar f$, where $s$ is a trivial scalar particle
and $f$ is a colored fermion. We initialize the process,
build the library, and compute the particular matrix element for a
fixed momentum configuration. (The decay is
independent of angle.) The matrix element is equal to unity.
<<Test ME: execute tests>>=
call test (prc_test_3, "prc_test_3", &
"build and load trivial decay", &
u, results)
<<Test ME: test declarations>>=
public :: prc_test_3
<<Test ME: tests>>=
subroutine prc_test_3 (u)
integer, intent(in) :: u
type(os_data_t) :: os_data
type(process_library_t) :: lib
class(prc_core_def_t), allocatable :: def
type(process_def_entry_t), pointer :: entry
type(string_t) :: model_name
type(string_t), dimension(:), allocatable :: prt_in, prt_out
type(process_constants_t) :: data
class(prc_core_driver_t), allocatable :: driver
real(default), dimension(0:3,3) :: p
integer :: i
write (u, "(A)") "* Test output: prc_test_3"
write (u, "(A)") "* Purpose: create a trivial decay process"
write (u, "(A)") "* build a library and &
&access the matrix element"
write (u, "(A)")
write (u, "(A)") "* Initialize a process library with one entry"
write (u, "(A)")
call os_data%init ()
call lib%init (var_str ("prc_test3"))
model_name = "Test"
allocate (prt_in (1), prt_out (2))
prt_in = [var_str ("s")]
prt_out = [var_str ("f"), var_str ("F")]
allocate (prc_test_def_t :: def)
select type (def)
type is (prc_test_def_t)
call def%init (model_name, prt_in, prt_out)
end select
allocate (entry)
call entry%init (var_str ("prc_test3_a"), model_name = model_name, &
n_in = 1, n_components = 1)
call entry%import_component (1, n_out = size (prt_out), &
prt_in = new_prt_spec (prt_in), &
prt_out = new_prt_spec (prt_out), &
method = var_str ("test_me"), &
variant = def)
call lib%append (entry)
write (u, "(A)") "* Configure library"
write (u, "(A)")
call lib%configure (os_data)
write (u, "(A)") "* Load library"
write (u, "(A)")
call lib%load (os_data)
call lib%write (u)
write (u, "(A)")
write (u, "(A)") "* Probe library API:"
write (u, "(A)")
write (u, "(1x,A,L1)") "is active = ", &
lib%is_active ()
write (u, "(1x,A,I0)") "n_processes = ", &
lib%get_n_processes ()
write (u, "(A)")
write (u, "(A)") "* Constants of prc_test3_a_i1:"
write (u, "(A)")
call lib%connect_process (var_str ("prc_test3_a"), 1, data, driver)
write (u, "(1x,A,A)") "component ID = ", char (data%id)
write (u, "(1x,A,A)") "model name = ", char (data%model_name)
write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
write (u, "(1x,A,I0)") "n_in = ", data%n_in
write (u, "(1x,A,I0)") "n_out = ", data%n_out
write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
write (u, "(1x,A,I0)") "n_col = ", data%n_col
write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,2)
write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index
write (u, "(A)")
write (u, "(A)") "* Set kinematics:"
write (u, "(A)")
p = reshape ([ &
125._default, 0.0_default, 0.0_default, 0.0_default, &
62.5_default, 0.0_default, 0.0_default, 62.5_default, &
62.5_default, 0.0_default, 0.0_default,-62.5_default &
], [4,3])
do i = 1, 3
write (u, "(2x,A,I0,A,4(1x,F8.4))") "p", i, " =", p(:,i)
end do
write (u, "(A)")
write (u, "(A)") "* Compute matrix element:"
write (u, "(A)")
select type (driver)
type is (prc_test_t)
write (u, "(1x,A,1x,E11.4)") "|amp| =", abs (driver%get_amplitude (p))
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prc_test_3"
end subroutine prc_test_3
@ %def prc_test_3
@
\subsubsection{Shortcut}
This is identical to the previous test, but we create the library be a single
command. This is handy for other modules which use the test process.
<<Test ME: execute tests>>=
call test (prc_test_4, "prc_test_4", &
"build and load trivial decay using shortcut", &
u, results)
<<Test ME: test declarations>>=
public :: prc_test_4
<<Test ME: tests>>=
subroutine prc_test_4 (u)
integer, intent(in) :: u
type(process_library_t) :: lib
class(prc_core_driver_t), allocatable :: driver
type(process_constants_t) :: data
real(default), dimension(0:3,3) :: p
write (u, "(A)") "* Test output: prc_test_4"
write (u, "(A)") "* Purpose: create a trivial decay process"
write (u, "(A)") "* build a library and &
&access the matrix element"
write (u, "(A)")
write (u, "(A)") "* Build and load a process library with one entry"
call prc_test_create_library (var_str ("prc_test4"), lib, &
scattering=.false., decay=.true.)
call lib%connect_process (var_str ("prc_test4"), 1, data, driver)
p = reshape ([ &
125._default, 0.0_default, 0.0_default, 0.0_default, &
62.5_default, 0.0_default, 0.0_default, 62.5_default, &
62.5_default, 0.0_default, 0.0_default,-62.5_default &
], [4,3])
write (u, "(A)")
write (u, "(A)") "* Compute matrix element:"
write (u, "(A)")
select type (driver)
type is (prc_test_t)
write (u, "(1x,A,1x,E11.4)") "|amp| =", abs (driver%get_amplitude (p))
end select
call lib%final ()
write (u, "(A)")
write (u, "(A)") "* Test output end: prc_test_4"
end subroutine prc_test_4
@ %def prc_test_4
Index: trunk/src/matrix_elements/Makefile.am
===================================================================
--- trunk/src/matrix_elements/Makefile.am (revision 8781)
+++ trunk/src/matrix_elements/Makefile.am (revision 8782)
@@ -1,210 +1,231 @@
## 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 implement quantum field theory concepts
## such as model representation and quantum numbers.
## We create a library which is still to be combined with auxiliary libs.
noinst_LTLIBRARIES = libmatrix_elements.la
check_LTLIBRARIES = libmatrix_elements_ut.la
libmatrix_elements_la_SOURCES = \
+ $(MATRIX_ELEMENTS_MODULES) \
+ $(MATRIX_ELEMENTS_SUBMODULES)
+
+MATRIX_ELEMENTS_MODULES = \
process_constants.f90 \
prclib_interfaces.f90 \
prc_core_def.f90 \
process_libraries.f90 \
prclib_stacks.f90 \
prc_test.f90
+MATRIX_ELEMENTS_SUBMODULES = \
+ process_constants_sub.f90 \
+ prclib_interfaces_sub.f90 \
+ prc_core_def_sub.f90 \
+ process_libraries_sub.f90 \
+ prclib_stacks_sub.f90 \
+ prc_test_sub.f90
+
libmatrix_elements_ut_la_SOURCES = \
prclib_interfaces_uti.f90 prclib_interfaces_ut.f90 \
process_libraries_uti.f90 process_libraries_ut.f90 \
prclib_stacks_uti.f90 prclib_stacks_ut.f90 \
prc_test_uti.f90 prc_test_ut.f90
## Omitting this would exclude it from the distribution
dist_noinst_DATA = matrix_elements.nw
# Modules and installation
# Dump module names into file Modules
execmoddir = $(fmoddir)/whizard
nodist_execmod_HEADERS = \
- ${libmatrix_elements_la_SOURCES:.f90=.$(FCMOD)}
+ ${MATRIX_ELEMENTS_MODULES:.f90=.$(FCMOD)}
# Dump module names into file Modules
+# Submodules must not be included here
libmatrix_elements_Modules = \
- ${libmatrix_elements_la_SOURCES:.f90=} \
+ ${MATRIX_ELEMENTS_MODULES:.f90=} \
${libmatrix_elements_ut_la_SOURCES:.f90=}
Modules: Makefile
@for module in $(libmatrix_elements_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 \
../qft/Modules \
../types/Modules \
../physics/Modules
$(module_lists):
$(MAKE) -C `dirname $@` Modules
Module_dependencies.sed: $(libmatrix_elements_la_SOURCES) \
$(libmatrix_elements_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: $(libmatrix_elements_la_SOURCES) \
$(libmatrix_elements_ut_la_SOURCES)
@rm -f $@
for src in $^; do \
module="`basename $$src | sed 's/\.f[90][0358]//'`"; \
grep '^ *use ' $$src \
| grep -v '!NODEP!' \
| sed -e 's/^ *use */'$$module'.lo: /' \
-f Module_dependencies.sed; \
done > $@
DISTCLEANFILES += Makefile.depend
# Fortran90 module files are generated at the same time as object files
.lo.$(FCMOD):
@:
# touch $@
AM_FCFLAGS = -I../basics -I../utilities -I../testing -I../system -I../combinatorics -I../parsing -I../physics -I../qft -I../types
+########################################################################
+# For the moment, the submodule dependencies will be hard-coded
+process_constants_sub.lo: process_constants.lo
+prclib_interfaces_sub.lo: prclib_interfaces.lo
+prc_core_def_sub.lo: prc_core_def.lo
+process_libraries_sub.lo: process_libraries.lo
+prclib_stacks_sub.lo: prclib_stacks.lo
+prc_test_sub.lo: prc_test.lo
########################################################################
## Default Fortran compiler options
## Profiling
if FC_USE_PROFILING
AM_FCFLAGS += $(FCFLAGS_PROFILING)
endif
## OpenMP
if FC_USE_OPENMP
AM_FCFLAGS += $(FCFLAGS_OPENMP)
endif
# MPI
if FC_USE_MPI
AM_FCFLAGS += $(FCFLAGS_MPI)
endif
########################################################################
## Non-standard targets and dependencies
## (Re)create F90 sources from NOWEB source.
if NOWEB_AVAILABLE
PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw
POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw
matrix_elements.stamp: $(PRELUDE) $(srcdir)/matrix_elements.nw $(POSTLUDE)
@rm -f matrix_elements.tmp
@touch matrix_elements.tmp
for src in \
$(libmatrix_elements_la_SOURCES) \
$(libmatrix_elements_ut_la_SOURCES); do \
$(NOTANGLE) -R[[$$src]] $^ | $(CPIF) $$src; \
done
@mv -f matrix_elements.tmp matrix_elements.stamp
$(libmatrix_elements_la_SOURCES) $(libmatrix_elements_ut_la_SOURCES): matrix_elements.stamp
## Recover from the removal of $@
@if test -f $@; then :; else \
rm -f matrix_elements.stamp; \
$(MAKE) $(AM_MAKEFLAGS) matrix_elements.stamp; \
fi
endif
########################################################################
## Non-standard cleanup tasks
## Remove sources that can be recreated using NOWEB
if NOWEB_AVAILABLE
maintainer-clean-noweb:
-rm -f *.f90 *.c
endif
.PHONY: maintainer-clean-noweb
## Remove those sources also if builddir and srcdir are different
if NOWEB_AVAILABLE
clean-noweb:
test "$(srcdir)" != "." && rm -f *.f90 *.c || true
endif
.PHONY: clean-noweb
## Remove F90 module files
clean-local: clean-noweb
-rm -f matrix_elements.stamp matrix_elements.tmp
-rm -f *.$(FCMOD)
if FC_SUBMODULES
- -rm -f *.smod
+ -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/share/debug/Makefile_full
===================================================================
--- trunk/share/debug/Makefile_full (revision 8781)
+++ trunk/share/debug/Makefile_full (revision 8782)
@@ -1,580 +1,586 @@
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 \
eio_data.f90 \
event_handles.f90 \
eio_base.f90 \
eio_base_uti.f90 \
eio_base_ut.f90 \
variables.f90 \
rng_base.f90 \
tao_random_numbers.f90 \
rng_tao.f90 \
rng_stream.f90 \
rng_base_uti.f90 \
rng_base_ut.f90 \
dispatch_rng.f90 \
dispatch_rng_uti.f90 \
dispatch_rng_ut.f90 \
beam_structures.f90 \
evaluators.f90 \
evaluators_sub.f90 \
beams.f90 \
sm_physics.f90 \
sm_physics_sub.f90 \
file_registries.f90 \
file_registries_sub.f90 \
sf_aux.f90 \
sf_mappings.f90 \
sf_base.f90 \
electron_pdfs.f90 \
sf_isr.f90 \
sf_epa.f90 \
sf_ewa.f90 \
sf_escan.f90 \
sf_gaussian.f90 \
sf_beam_events.f90 \
circe1.f90 \
sf_circe1.f90 \
circe2.f90 \
selectors.f90 \
sf_circe2.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_lhapdf.f90 \
dispatch_beams.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_test_core.f90 \
sm_qed.f90 \
prc_omega.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 \
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_olp_interfaces.f90 \
prc_openloops.f90 \
prc_threshold.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 \
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 \
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 \
hepev4_aux.f90 \
tauola_dummy.f90 \
tauola_interface.f90 \
shower_base.f90 \
shower_partons.f90 \
muli.f90 \
matching_base.f90 \
powheg_matching.f90 \
shower_core.f90 \
shower_base_uti.f90 \
shower_base_ut.f90 \
shower.f90 \
shower_uti.f90 \
shower_ut.f90 \
shower_pythia6.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 \
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_uti.f90 \
hepmc_interface_ut.f90 \
LCIOWrap_dummy.f90 \
lcio_interface.f90 \
lcio_interface_uti.f90 \
lcio_interface_ut.f90 \
hep_events.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_uti.f90 \
eio_checkpoints_ut.f90 \
eio_lhef.f90 \
eio_lhef_uti.f90 \
eio_lhef_ut.f90 \
eio_hepmc.f90 \
eio_hepmc_uti.f90 \
eio_hepmc_ut.f90 \
eio_lcio.f90 \
eio_lcio_uti.f90 \
eio_lcio_ut.f90 \
stdhep_dummy.f90 \
xdr_wo_stdhep.f90 \
eio_stdhep.f90 \
eio_stdhep_uti.f90 \
eio_stdhep_ut.f90 \
eio_ascii.f90 \
eio_ascii_uti.f90 \
eio_ascii_ut.f90 \
eio_weights.f90 \
eio_weights_uti.f90 \
eio_weights_ut.f90 \
eio_dump.f90 \
eio_dump_uti.f90 \
eio_dump_ut.f90 \
eio_callback.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_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
Sun, Feb 23, 2:52 PM (22 h, 58 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
4484149
Default Alt Text
(495 KB)

Event Timeline