From 93cda16c9ebdfd434a9bd54992eff1de4eb38a92 Mon Sep 17 00:00:00 2001 From: Sebastian Date: Thu, 5 Nov 2015 15:52:03 +0100 Subject: [PATCH] Version 1.2.3 imported from tarball. --- README | 64 +- SConstruct | 133 +- examples/OL_cpp.cpp | 2 +- examples/README | 3 +- examples/SConstruct | 29 +- lib_src/olcommon/src/common.F90 | 347 +++- lib_src/olcommon/src/cwrappers.c | 82 + lib_src/olcommon/src/debug.F90 | 114 ++ lib_src/oneloop/src/avh_olo_qp.f90 | 312 ++-- lib_src/oneloop/version.txt | 14 +- lib_src/openloops/src/blha_interface.F90 | 136 +- lib_src/openloops/src/contractions.F90 | 16 +- lib_src/openloops/src/helicity.F90 | 138 +- lib_src/openloops/src/helicity_init.F90 | 13 +- lib_src/openloops/src/i-operator.F90 | 54 +- lib_src/openloops/src/init_ui.F90 | 313 ++-- lib_src/openloops/src/kinematics.F90 | 230 ++- lib_src/openloops/src/looproutines.F90 | 57 +- lib_src/openloops/src/ol_interface.F90 | 1534 +++++++++++------ lib_src/openloops/src/parameters.F90 | 93 +- lib_src/openloops/src/parameters_init.F90 | 321 +++- lib_src/openloops/src/renormalisation_qcd.F90 | 76 +- lib_src/openloops/src/stability.F90 | 39 +- lib_src/openloops/src/wavefunctions.F90 | 481 +++++- openloops | 33 +- pyol/bin/download_process.py | 20 +- pyol/bin/interactive_legacy.py | 65 + pyol/bin/plot_stability.py | 7 +- pyol/bin/run.py | 314 ++-- pyol/bin/run_legacy.py | 188 ++ pyol/bin/show.py | 2 +- pyol/bin/upload_process.py | 28 +- pyol/build/cpp.scons | 28 +- pyol/config/default.cfg | 22 +- pyol/tools/OLBaseConfig.py | 33 +- pyol/tools/OLLibrary.py | 3 +- pyol/tools/OLToolbox.py | 46 +- pyol/tools/openloops.py | 1335 +++++--------- pyol/tools/openloops_legacy.py | 914 ++++++++++ 39 files changed, 5264 insertions(+), 2375 deletions(-) create mode 100644 lib_src/olcommon/src/cwrappers.c create mode 100644 lib_src/olcommon/src/debug.F90 create mode 100644 pyol/bin/interactive_legacy.py create mode 100644 pyol/bin/run_legacy.py create mode 100644 pyol/tools/openloops_legacy.py diff --git a/README b/README index 53c71f55..c732d585 100644 --- a/README +++ b/README @@ -16,6 +16,11 @@ Contact openloops@projects.hepforge.org +If you would like to receive notifications about OpenLoops updates and news +per e-mail, please sign up to our mailing list at + + https://www.hepforge.org/lists/listinfo/openloops-announce + OpenLoops is a Fortran 90 package for the calculation of tree and one-loop matrix elements for Standard Model processes based on @@ -63,35 +68,66 @@ Compile Download and compile process libraries - ./scons auto= + ./openloops libinstall + +where is a white space separated list of the processes or +process collections (with suffix ".coll") which should be installed. +Some process collections are defined in the process repository (in +particular "all.coll" to install all processes from the repository). +User-defined collections can be set up as plain text files with file +extension ".coll" with line break separated names of process libraries. -where is a comma separated list of the processes or -process collections (ending with "/") which should be installed. A list of the available process libraries can be found here http://openloops.hepforge.org/processes +Process libraries usually include all real correction processes required +for an NLO calculation. However these processes are not compiled by default. +Note that Sherpa uses its own matrix elements for real corrections, thus +compiling OpenLoops real corrections is not required for usage with Sherpa. +In order to activate the compilation of real corrections, create a file named +"openloops.cfg" in your installation directory which contains the following +(besides other options which you might have set): + + [OpenLoops] + compile_extra = 1 + The set of available processes will be extended continuously. If you need a process which is not (yet) available, please contact the OpenLoops authors. -================================================================ -Update OpenLoops from SVN (when it's already installed from SVN) -================================================================ +====================================== +Update OpenLoops and process libraries +====================================== -To pull updates from SVN and compile +Note that automatic updates of the process independent OpenLoops code +are only supported when OpenLoops was installed from SVN. - svn update - ./scons +To update from SVN and update all installed processes + + ./openloops update + +To only update installed processes, but not OpenLoops itself +(this also works when OpenLoops was not installed from SVN) + + ./openloops update --processes + +Updating individual process libraries works the same way as installing +new processes. + + ./openloops libinstall -To update process libraries (will install new libraries if available and -replace old libraries if newer versions are available) +If process collections are used, new processes in the collection +will be installed and previously installed processes will be updated +if newer versions are available. E.g. - ./scons auto=lhc/ + ./openloops libinstall all.coll -After updating OpenLoops, updating the installed processes might be required -for compatibility. +Updating/installing processes also creates/updates a local database +of all processes which are available for download. This database is used +at runtime to report if a requested process is available for download, +if it is not yet installed. ===================== diff --git a/SConstruct b/SConstruct index fd2ebf6f..df672000 100644 --- a/SConstruct +++ b/SConstruct @@ -1,9 +1,9 @@ #dd_version = '' dd_version = '_dp19032014' -#dd_version = '_06082014' -if dd_version != '_06082014': - dd_cppdef = ['COLLIER_LEGACY'] +#dd_version = '_03092015' +if dd_version != '_03092015': + dd_cppdef = ['COLLIER_LEGACY', 'collierdd'] else: dd_cppdef = [] @@ -157,7 +157,7 @@ cpp_defines = map(lambda lib: 'USE_' + lib.upper(), config['link_libraries']) cpp_defines += [('KIND_TYPES', 'kind_types'), ('DREALKIND', 'dp'), ('QREALKIND', 'qp'), - 'USE_' + config['fortran_compiler'].upper(), + 'USE_' + config['fortran_tool'].upper(), ('OL_INSTALL_PATH', '\\"' + install_path + '\\"'), 'SING'] + dd_cppdef @@ -175,7 +175,7 @@ for libname in ['olcommon', 'rambo', 'qcdloop', 'oneloop', 'cuttools', 'samurai' lib_mod_dirs[libname] = os.path.join(config['lib_src_dir'], libname, 'mod') # OLCommon -olcommon_dp_src = ['kind_types.F90'] +olcommon_dp_src = ['kind_types.F90', 'debug.F90', 'cwrappers.c'] olcommon_mp_src = ['common.F90'] # Rambo @@ -276,11 +276,24 @@ if dd_version == '_dp19032014': 'bt_GramCayley.F90', 'bt_LightCone.F90', 'bt_MatrixManipulations.F90', 'bt_TensorManipulations.F90', 'bt_TensorReduction.F90', 'bt_TI_interface.F90'] -if dd_version == '_06082014': +if dd_version == '_03092015': collier_inc_dp = [] collier_src_mp = [] collier_src_dp = [ - "BuildTensors.F90", "cache.F90", "coli_aux2.F90", "coli_aux.F", "coli_b0.F", "coli_c0.F", "coli_d0.F", "coli_d0reg.F", "coli_stat.F90", "collier_aux.F90", "collier_coefs.F90", "COLLIER.F90", "collier_global.F90", "collier_init.F90", "collier_tensors.F90", "Combinatorics.F90", "dcuhre.f", "DD_2pt.F", "DD_3pt_coll.F", "DD_3pt.F", "DD_4pt.F", "DD_5pt.F", "DD_6pt.F", "DD_aux.F", "DD_to_COLLIER.F", "InitTensors.F90", "master.F90", "reductionAB.F90", "reductionC.F90", "reductionD.F90", "reductionEFG.F90", "reductionTN.F90", "TensorReduction.F90"] + # Aux/ + 'Combinatorics.F90', 'cache.F90', 'master.F90', + # COLI/ + 'coli_aux.F', 'coli_aux2.F90', 'coli_b0.F', 'coli_c0.F', 'coli_d0.F', + 'coli_d0reg.F', 'coli_stat.F90', 'reductionAB.F90', 'reductionC.F90', + 'reductionD.F90', 'reductionEFG.F90', 'reductionTN.F90', + # DDlib/ + 'DD_2pt.F', 'DD_3pt.F', 'DD_3pt_coll.F', 'DD_4pt.F', 'DD_5pt.F', + 'DD_6pt.F', 'DD_aux.F', 'DD_to_COLLIER.F', 'dcuhre.f', + # tensors/ + 'BuildTensors.F90', 'InitTensors.F90', 'TensorReduction.F90', + # ./ + 'COLLIER.F90', 'collier_aux.F90', 'collier_coefs.F90', + 'collier_global.F90', 'collier_init.F90', 'collier_tensors.F90'] if compile_libraries: cpp_container = CPPContainer(scons_cmd = scons_cmd, @@ -292,13 +305,14 @@ if compile_libraries: target_prefix = os.path.join('..', 'obj', '')) if 'olcommon' in compile_libraries: - olcommon_lib = OLLibrary(name = 'olcommon', - linklibs = ['dl'], - target_dir = config['generic_lib_dir'], - src_dir = lib_src_dirs['olcommon'], - dp_src = olcommon_dp_src, - mp_src = olcommon_mp_src, - to_cpp = cpp_container) + olcommon_lib = OLLibrary( + name = 'olcommon', + linklibs = ([] if sys.platform.startswith('freebsd') else ['dl']), + target_dir = config['generic_lib_dir'], + src_dir = lib_src_dirs['olcommon'], + dp_src = olcommon_dp_src, + mp_src = olcommon_mp_src, + to_cpp = cpp_container) if 'rambo' in compile_libraries: VariantDir(lib_obj_dirs['rambo'], @@ -375,36 +389,50 @@ if 'openloops' in compile_libraries: version_src = [openloops_version_src], to_cpp = cpp_container) - -if compile_libraries: - if not GetOption('clean'): - if not cpp_container.run(): - print '*** cpp failed ***' - Exit(1) - - -if config['import_path']: - env_path = os.environ.get('PATH', '') - env_ld_library_path = os.environ.get('LD_LIBRARY_PATH', '') +if '@all' in config['import_env']: + imported_env = os.environ else: - env_path = [] - env_ld_library_path = [] + imported_env = {} + for envvar in config['import_env']: + imported_env[envvar] = os.environ.get(envvar, '') -env = Environment(tools = ['default', 'textfile'] + [config['fortran_compiler']], - ENV = {"PATH": env_path, "LD_LIBRARY_PATH": env_ld_library_path}, +env = Environment(tools = ['default', 'textfile'] + [config['fortran_tool']], + ENV = imported_env, + CCFLAGS = config['ccflags'] + config['generic_optimisation'], FORTRANFLAGS = config['f77_flags'] + config['generic_optimisation'], F90FLAGS = config['f90_flags'] + config['generic_optimisation'], LINKFLAGS = config['link_flags'], LIBPATH = [config['generic_lib_dir']], - RPATH = [Literal('\$$ORIGIN')]) - + RPATH = [Literal('\$$ORIGIN')], + F90 = config['fortran_compiler'], + FORTRAN = config['fortran_compiler'], + CC = config['cc']) -if env.subst('$F90') == 'gfortran': +if config['fortran_tool'] == 'gfortran': # SCons bug: FORTRANMODDIRPREFIX is missing in gfortran tool env.Replace(FORTRANMODDIRPREFIX = '-J') - if tuple(map(int, env.subst('$CCVERSION').split('.')[:2])) < (4,6): - print 'ERROR: This OpenLoops version requires gfortran 4.6 or later (found %s)' % env.subst('$CCVERSION') - Exit(1) + # determine gfortran version; + # do not use CCVERSION, because mit might not be from gcc + gfort_exitcode = 1 + try: + gfort_proc = subprocess.Popen( + [config['fortran_compiler'], '-dumpversion'], + stdout=subprocess.PIPE) + gfort_out, gfort_err = gfort_proc.communicate() + gfort_exitcode = gfort_proc.returncode + except OSError: + pass + if not gfort_exitcode: # else ignore and continue without version check + if tuple(map(int, gfort_out.strip().split('.')[:2])) < (4,6): + print ('ERROR: This OpenLoops version requires gfortran 4.6 ' + + 'or later (found %s)' % env.subst('$CCVERSION')) + Exit(1) + +if compile_libraries: + if not GetOption('clean'): + if not cpp_container.run(): + print '*** cpp failed ***' + Exit(1) env_noautomatic = env.Clone() env_noautomatic.AppendUnique(F90FLAGS = config['noautomatic'], @@ -491,11 +519,19 @@ def split_processlist(loops, procs): proclist = [(loops, proc) for proc in proclist if not (proc.endswith('/') or coll.endswith('.coll'))] for coll in collections: + coll_repo = False + for repo in config['process_repositories']: + if coll == OLToolbox.repo_name(repo) + '.coll': + coll_repo = repo + break process_coll = [] if coll == 'all.coll': for repo in config['process_repositories']: process_db = OLToolbox.ProcessDB(db=(version_db_url % repo)) process_coll += process_db.content.keys() + elif coll_repo: + process_db = OLToolbox.ProcessDB(db=(version_db_url % coll_repo)) + process_coll += process_db.content.keys() else: found_collection = False first_repo = True @@ -589,14 +625,29 @@ def revoke_processes(): def download_processes(processes): """Download processes""" - if subprocess.call(['python', config['process_download_script']] + force_download_flag + processes) != 0: + try: + err = subprocess.call( + ['python2', config['process_download_script']] + + force_download_flag + processes + + ['='.join(arg) for arg in commandline_options]) + except OSError: + # try again with 'python' instead of 'python2' + err = subprocess.call( + ['python', config['process_download_script']] + + force_download_flag + processes + + ['='.join(arg) for arg in commandline_options]) + if err: print 'ERROR: process downloader failed.' Exit(1) def generate_process(loops, processlib): """Generate a process library""" - if subprocess.call([scons_cmd, '-Q'] + generator_options + ['-f', config['code_generator_script'], 'PROC=' + processlib, 'LOOPS=' + loops]) != 0: + if subprocess.call( + [scons_cmd, '-Q'] + generator_options + + ['-f', config['code_generator_script'], + 'PROC=' + processlib, 'LOOPS=' + loops] + + ['='.join(arg) for arg in commandline_options]) != 0: print 'ERROR: code generator failed.' Exit(1) @@ -609,8 +660,9 @@ if config['process_update']: if download_process_true: proc_ls = list(set([proc for loops, proc in process_list])) - revoke_processes() - download_processes(proc_ls) + if proc_ls or config['process_update']: + revoke_processes() + download_processes(proc_ls) process_list = map(get_auto_loops, process_list) @@ -657,7 +709,8 @@ for (loops, processlib) in process_list: # set up process library process_lib = OLLibrary(name = processlib_name, target_dir = config['process_lib_dir'], - mod_dependencies = ['olcommon', 'openloops'], + # need to include oneloop mod dir for ifort + mod_dependencies = ['olcommon', 'openloops', 'oneloop'], mod_dir = os.path.join(processlib_obj_dir, 'mod'), mp_src = process_mp_src, dp_src = process_dp_src, diff --git a/examples/OL_cpp.cpp b/examples/OL_cpp.cpp index 30a41cf5..1b20ac5b 100644 --- a/examples/OL_cpp.cpp +++ b/examples/OL_cpp.cpp @@ -50,7 +50,7 @@ int main() { // Set parameter: strong coupling ol_setparameter_double("alpha_s", alphas); // Set parameter: renormalization scale - ol_setparameter_double("mu", 100.); + ol_setparameter_double("mu", mu); // Obtain a random phase-space point in the format pp[5*N] from Rambo double pp[5*ol_n_external(id)]; diff --git a/examples/README b/examples/README index afd1bba4..f82aef74 100644 --- a/examples/README +++ b/examples/README @@ -25,7 +25,7 @@ To remove object code and executables Before running the examples, the process library "ppzjj" must be installed. # from the OpenLoops installation folder run - ./scons auto=ppzjj + ./openloops libinstall ppzjj How to use OpenLoops in your own programs @@ -39,6 +39,7 @@ How to use OpenLoops in your own programs (linker option -L/lib) * Set LD_LIBRARY_PATH=/lib so that the linker finds libopenloops.so at runtime (alternatively you can set the RPATH, gcc linker option -Wl,-rpath=/lib) + * On MacOSX you have to set DYLD_LIBRARY_PATH=/lib Examples diff --git a/examples/SConstruct b/examples/SConstruct index 6d18a3a5..406ef6c7 100644 --- a/examples/SConstruct +++ b/examples/SConstruct @@ -1,27 +1,34 @@ +cwd = Dir('..').abspath + import os import sys -sys.path.insert(0, os.path.abspath(os.path.join('..', 'pyol', 'tools'))) +sys.path.insert(0, os.path.abspath(os.path.join(cwd, 'pyol', 'tools'))) import OLBaseConfig -OLBaseConfig.prefix = '..' +OLBaseConfig.prefix = cwd config = OLBaseConfig.get_config(ARGLIST) -if config['import_path']: +if config['import_env']: env_path = os.environ.get('PATH', '') env_ld_library_path = os.environ.get('LD_LIBRARY_PATH', '') else: env_path = [] env_ld_library_path = [] -env = Environment(tools = ['default', config['fortran_compiler']], +env = Environment(tools = ['default', config['fortran_tool']], ENV = {"PATH": env_path, "LD_LIBRARY_PATH": env_ld_library_path}, + CXX = config['cxx'], + F90 = config['fortran_compiler'], + CCFLAGS = config['ccflags'] + config['generic_optimisation'], + FORTRAN = config['fortran_compiler'], F90FLAGS = config['f90_flags'] + config['generic_optimisation'], - F90PATH = [os.path.join('..', 'lib_src', 'openloops', 'mod')], - LIBPATH = [os.path.join('..', config['generic_lib_dir'])], - RPATH = [os.path.join('..', config['generic_lib_dir'])]) + F90PATH = [os.path.join(cwd, 'lib_src', 'openloops', 'mod')], + LIBPATH = [os.path.join(cwd, config['generic_lib_dir'])], + LINKFLAGS = config['link_flags'], + RPATH = [os.path.join(cwd, config['generic_lib_dir'])]) -env.Program('OL_minimal.f90', LIBS = ['openloops']) -env.Program('OL_fortran.f90', LIBS = ['openloops']) -env.Program('OL_cpp.cpp', LIBS = ['openloops']) -env.Program('OL_blha.cpp', LIBS = ['openloops']) +env.Program('OL_minimal', ['OL_minimal.f90'], LIBS = ['openloops']) +env.Program('OL_fortran', ['OL_fortran.f90'], LIBS = ['openloops']) +env.Program('OL_cpp', ['OL_cpp.cpp'], LIBS = ['openloops']) +env.Program('OL_blha', ['OL_blha.cpp'], LIBS = ['openloops']) diff --git a/lib_src/olcommon/src/common.F90 b/lib_src/olcommon/src/common.F90 index 894405ea..96418ab6 100644 --- a/lib_src/olcommon/src/common.F90 +++ b/lib_src/olcommon/src/common.F90 @@ -35,14 +35,15 @@ module ol_generic character(len=26), private, parameter :: upper_case = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' interface to_string - module procedure integer_to_string, integerlist_to_string + module procedure integer_to_string, integer1_to_string, integer2_to_string, & + & double_to_string, complex_to_string, single_to_string, & + & integerlist_to_string, doublelist_to_string end interface to_string interface to_int module procedure string_to_integer end interface to_int - contains function integer_to_string(x) @@ -53,19 +54,231 @@ function integer_to_string(x) integer_to_string = adjustl(integer_to_string) end function integer_to_string + function integer1_to_string(x) + use KIND_TYPES, only: intkind1 + implicit none + integer(intkind1) :: x + character(12) :: integer1_to_string + write(integer1_to_string,*) x + integer1_to_string = adjustl(integer1_to_string) + end function integer1_to_string + + function integer2_to_string(x) + use KIND_TYPES, only: intkind2 + implicit none + integer(intkind2) :: x + character(12) :: integer2_to_string + write(integer2_to_string,*) x + integer2_to_string = adjustl(integer2_to_string) + end function integer2_to_string - function integerlist_to_string(x) + function integerlist_to_string(x,del,sep) implicit none integer :: x(:) character(12*size(x)+1) :: integerlist_to_string + logical, optional, intent(in) :: del + character(1), optional, intent(in) :: sep + character(1) :: seperator integer :: k - integerlist_to_string = "[" - do k = 1, size(x)-1 - integerlist_to_string = trim(integerlist_to_string) // trim(integer_to_string(x(k))) // "," + if (present(sep)) then + seperator = sep + else + seperator = "," + end if + integerlist_to_string = "" + if (present(del)) then + if (del) integerlist_to_string = "[" + end if + + integerlist_to_string = trim(integerlist_to_string) // trim(integer_to_string(x(1))) + do k = 2, size(x) + integerlist_to_string = trim(integerlist_to_string) // seperator // trim(integer_to_string(x(k))) end do - integerlist_to_string = trim(integerlist_to_string) // trim(integer_to_string(x(size(x)))) // "]" + + if (present(del)) then + if (del) integerlist_to_string = trim(integerlist_to_string) // "]" + end if + end function integerlist_to_string + function doublelist_to_string(x,del,sep) + use KIND_TYPES, only: DREALKIND + implicit none + real(DREALKIND) :: x(:) + character(15*size(x)+1) :: doublelist_to_string + logical, optional, intent(in) :: del + character(1), optional, intent(in) :: sep + character(1) :: seperator + integer :: k + if (present(sep)) then + seperator = sep + else + seperator = "," + end if + doublelist_to_string = "" + if (present(del)) then + if (del) doublelist_to_string = "[" + end if + + doublelist_to_string = trim(doublelist_to_string) // trim(double_to_string(x(1))) + do k = 2, size(x) + doublelist_to_string = trim(doublelist_to_string) // seperator // trim(double_to_string(x(k))) + end do + + if (present(del)) then + if (del) doublelist_to_string = trim(doublelist_to_string) // "]" + end if + + end function doublelist_to_string + + function string_to_integerlist(c_in) + ! convert a comma/space/slash separated string of numbers into an array of integers + implicit none + character(len=*), intent(in) :: c_in + character(len(c_in)+1) :: c + integer, allocatable :: string_to_integerlist(:) + integer i, n, pos1 + logical last_seperator + + c = c_in // " " + + n=0 + pos1=0 + last_seperator = .false. + do i = 1, len(c) + if (c(i:i) == "[" .or. c(i:i) == "]") c(i:i) = " " + + if (c(i:i) == ',' .or. c(i:i) == ' ' .or. c(i:i) == "/" ) then + if (last_seperator) then + pos1 = i + cycle + end if + n = n+1 + pos1 = i + last_seperator = .true. + else + last_seperator = .false. + end if + end do + + allocate(string_to_integerlist(n)) + + n=0 + pos1=0 + last_seperator = .false. + do i = 1, len(c) + if (c(i:i) == ',' .or. c(i:i) == ' ' .or. c(i:i) == "/") then + if (last_seperator) then + pos1 = i + cycle + end if + n = n+1 + string_to_integerlist(n) = string_to_integer(c(pos1+1:i-1)) + pos1 = i + last_seperator = .true. + else + last_seperator = .false. + end if + end do + end function string_to_integerlist + + + function double_to_string(x) + use KIND_TYPES, only: DREALKIND + implicit none + real(DREALKIND) :: x + character(28) :: double_to_string + character(26) :: str + integer :: k, epos, mantissaendpos + logical :: leading0 + write(str,*) x + str = adjustl(str) + epos = index(to_lowercase(str), "e") + if (epos == 0) then + mantissaendpos = len(trim(str)) + else + mantissaendpos = epos-1 + end if + double_to_string = str(1:mantissaendpos) + do k = mantissaendpos, 1, -1 + if (double_to_string(k:k) == "0") then + double_to_string(k:k) = " " + else + exit + end if + end do + if (epos /= 0) then + double_to_string = trim(double_to_string) // "e" + if (str(epos+1:epos+1) == "+" .or. str(epos+1:epos+1) == "-") then + double_to_string = trim(double_to_string) // str(epos+1:epos+1) + epos = epos + 1 + end if + leading0 = .true. + do k = epos+1, len(str) + if (str(k:k) == "0" .and. leading0) then + cycle + else + leading0 = .false. + double_to_string = trim(double_to_string) // str(k:k) + end if + end do + end if + double_to_string = trim(double_to_string) // "_dp" + end function double_to_string + + function single_to_string(x) + implicit none + real(selected_real_kind(6)) :: x + character(20) :: single_to_string + character(18) :: str + integer :: k, epos, mantissaendpos + logical :: leading0 + write(str,*) x + str = adjustl(str) + epos = index(to_lowercase(str), "e") + if (epos == 0) then + mantissaendpos = len(trim(str)) + else + mantissaendpos = epos-1 + end if + single_to_string = str(1:mantissaendpos) + do k = mantissaendpos, 1, -1 + if (single_to_string(k:k) == "0") then + single_to_string(k:k) = " " + else + exit + end if + end do + if (epos /= 0) then + single_to_string = trim(single_to_string) // "e" + if (str(epos+1:epos+1) == "+" .or. str(epos+1:epos+1) == "-") then + single_to_string = trim(single_to_string) // str(epos+1:epos+1) + epos = epos + 1 + end if + leading0 = .true. + do k = epos+1, len(str) + if (str(k:k) == "0" .and. leading0) then + cycle + else + leading0 = .false. + single_to_string = trim(single_to_string) // str(k:k) + end if + end do + end if + single_to_string = trim(single_to_string) // "_sp" + end function single_to_string + + + + function complex_to_string(x) + use KIND_TYPES, only: DREALKIND + implicit none + complex(DREALKIND) :: x + character(59) :: complex_to_string + complex_to_string = "(" // trim(double_to_string(real(x))) // & + & "," // trim(double_to_string(aimag(x))) // ")" + end function complex_to_string + function string_to_integer(c) implicit none @@ -247,8 +460,6 @@ function relative_deviation(a, b) real(DREALKIND) :: relative_deviation if (a == b) then relative_deviation = 0 - else if ( a == 0 .and. b == 0) then - relative_deviation = 0 else if ( a == 0 .or. b == 0) then relative_deviation = huge(a) else @@ -307,6 +518,23 @@ function to_lowercase(instr) end do end function to_lowercase + + function count_substring(s1, s2) result(c) + ! counts the occurance of string s2 in string s1 + character(*), intent(in) :: s1, s2 + integer :: c, p, posn + + c = 0 + if(len(s2) == 0) return + p = 1 + do + posn = index(s1(p:), s2) + if(posn == 0) return + c = c + 1 + p = p + posn + len(s2) + end do + end function count_substring + end module ol_generic @@ -325,7 +553,7 @@ module ol_iso_c_utilities ! character(kind=c_char), dimension(*), intent(in) :: c_str ! character(len=:), allocatable, intent(out) :: f_str ! - convert a null terminated C character array to a Fortran allocatable string; - use, intrinsic :: iso_c_binding, only: c_char + use, intrinsic :: iso_c_binding, only: c_char, c_ptr, c_long, c_short implicit none character(kind=c_char), save, target, private :: dummy_string(1) = "?" @@ -396,7 +624,7 @@ end subroutine c_f_string_static ! f_str(i:i) = f_str_ptr(i) ! end do ! end subroutine c_f_string_static -! +! ! deactivate to circumvent a bug in certain gfortran versions. ! Previously used in register_process_c, olp_setparameter_c, olp_printparameter_c, olp_start_c @@ -418,9 +646,101 @@ end subroutine c_f_string_static ! end do ! end subroutine c_f_string_alloc + end module ol_iso_c_utilities +module ol_dirent + ! err = opendir(dirname) + ! open directory; only one directory can be open at a time; + ! err=0 if successful + ! err = readdir(entryname) + ! read next entry from directory; + ! err=0 if successful; entryname="" if all entries were retrieved; + ! closedir() + ! close directory + ! mkdir(dirname) + ! create directory + use, intrinsic :: iso_c_binding, only: c_char, c_null_char + use ol_iso_c_utilities, only: c_f_string + implicit none + private + public :: opendir, readdir, closedir, mkdir, direntry_length + integer, parameter :: direntry_length = 256 + interface + function c_opendir(dirname) bind(c,name="ol_c_opendir") + ! int ol_c_opendir(const char *dirname) + use, intrinsic :: iso_c_binding, only: c_char, c_int + implicit none + character(kind=c_char), dimension(*), intent(in) :: dirname + integer(c_int) :: c_opendir + end function c_opendir + function c_readdir(entryname) bind(c,name="ol_c_readdir") + ! int ol_c_readdir(char* entryname) + use, intrinsic :: iso_c_binding, only: c_char, c_int + implicit none + character(kind=c_char), intent(out) :: entryname(256) ! =direntry_length + integer(c_int) :: c_readdir + end function c_readdir + subroutine c_closedir() bind(c,name="ol_c_closedir") + ! void ol_c_closedir() + implicit none + end subroutine c_closedir + function c_mkdir(dirname) bind(c,name="ol_c_mkdir") + ! int ol_c_mkdir(char* dirname) + use, intrinsic :: iso_c_binding, only: c_char, c_int + implicit none + character(kind=c_char), dimension(*), intent(in) :: dirname + integer(c_int) :: c_mkdir + end function c_mkdir + end interface + + contains + + function opendir(dirname) + implicit none + character(len=*), intent(in) :: dirname + integer :: opendir + opendir = c_opendir(trim(dirname) // c_null_char) + if (opendir == 127) then + print *, "[OpenLoops] opendir: a directory is already open." + else if (opendir /= 0) then + print *, "[OpenLoops] opendir: error", opendir + end if + end function opendir + + function readdir(entryname) + implicit none + character(*), intent(out) :: entryname + integer :: readdir + character(kind=c_char) :: c_entryname(direntry_length) + if (len(entryname) < 256) then + print *, "[OpenLoops] readdir argument length <256." + readdir = 127 + return + end if + readdir = c_readdir(c_entryname) + if (readdir /= 0) then + print *, "[OpenLoops] readdir: error reading directory content." + end if + entryname = "" + call c_f_string(c_entryname, entryname, direntry_length) + end function readdir + + subroutine closedir() + implicit none + call c_closedir() + end subroutine closedir + + function mkdir(dirname) + implicit none + character(len=*), intent(in) :: dirname + integer :: mkdir + mkdir = c_mkdir(trim(dirname) // c_null_char) + end function mkdir + +end module ol_dirent + module ol_dlfcn use, intrinsic :: iso_c_binding, only: c_int, c_char, c_ptr, c_funptr, & @@ -430,7 +750,10 @@ module ol_dlfcn public :: RTLD_LAZY, RTLD_NOW, RTLD_GLOBAL, RTLD_LOCAL public :: dlopen, dlsym, dlclose ! dlopen modes: - integer(c_int), parameter :: RTLD_LAZY = 1, RTLD_NOW = 2, RTLD_GLOBAL = 256, RTLD_LOCAL = 0 + integer(c_int), bind(c,name="ol_c_rtld_lazy") :: RTLD_LAZY + integer(c_int), bind(c,name="ol_c_rtld_now") :: RTLD_NOW + integer(c_int), bind(c,name="ol_c_rtld_global") :: RTLD_GLOBAL + integer(c_int), bind(c,name="ol_c_rtld_local") :: RTLD_LOCAL interface function c_dlopen(file, mode) bind(c,name="dlopen") diff --git a/lib_src/olcommon/src/cwrappers.c b/lib_src/olcommon/src/cwrappers.c new file mode 100644 index 00000000..d7bf6847 --- /dev/null +++ b/lib_src/olcommon/src/cwrappers.c @@ -0,0 +1,82 @@ + +// Copyright 2014 Fabio Cascioli, Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini +// +// This file is part of OpenLoops. +// +// OpenLoops 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 3 of the License, or +// (at your option) any later version. +// +// OpenLoops 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 OpenLoops. If not, see . + +#include +#include +#include +#include +#include +#include + +// modes for dlopen (direct binding to Fortran doesn't work) +int ol_c_rtld_lazy = RTLD_LAZY; +int ol_c_rtld_now = RTLD_NOW; +int ol_c_rtld_global = RTLD_GLOBAL; +int ol_c_rtld_local = RTLD_LOCAL; + +// global variable to hold a directory stream: +// only one directory can be open at a time. +DIR *ol_c_dirstream = NULL; + +int ol_c_opendir(const char *dirname) +{ + if (ol_c_dirstream != NULL) + { + // printf("opendir failed: a directory is already open\n"); + return 127; + }; + errno = 0; + if ((ol_c_dirstream = opendir(dirname)) == NULL) + { + // printf("opendir: failed opening directory %s\n", dirname); + return errno; + }; + return 0; +} + +int ol_c_readdir(char* entryname) +{ + struct dirent *direntry; + entryname[0] = '\0'; + errno = 0; + direntry = readdir(ol_c_dirstream); + if (errno != 0) + { + // printf("readdir: reading directory content failed\n"); + return errno; + }; + if (direntry != NULL) + { + strncpy(entryname, direntry->d_name, 256); + }; + return 0; +} + +void ol_c_closedir() +{ + closedir(ol_c_dirstream); + ol_c_dirstream = NULL; + return; +} + +int ol_c_mkdir(const char *dirname) +{ + int err; + err = mkdir(dirname, ACCESSPERMS); + return err; +} diff --git a/lib_src/olcommon/src/debug.F90 b/lib_src/olcommon/src/debug.F90 new file mode 100644 index 00000000..f14bdeb0 --- /dev/null +++ b/lib_src/olcommon/src/debug.F90 @@ -0,0 +1,114 @@ + +! Copyright 2014 Fabio Cascioli, Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini +! +! This file is part of OpenLoops. +! +! OpenLoops 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 3 of the License, or +! (at your option) any later version. +! +! OpenLoops 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 OpenLoops. If not, see . + +module ol_debug + ! precision independent message and error routines + use, intrinsic :: iso_c_binding, only: c_int + use, intrinsic :: iso_fortran_env, only : stdout=>output_unit, & + stderr=>error_unit + implicit none + private + public :: set_verbose, get_verbose, get_error, ol_msg, ol_error, ol_fatal + public :: error, verbose, do_not_stop + + integer, save :: verbose = 0 + integer, save :: error = 0 + logical, save :: do_not_stop = .false. + + interface ol_msg + module procedure ol_print_msg_level, ol_print_msg + end interface ol_msg + + interface ol_error + module procedure ol_error_msg, ol_error_level + end interface ol_error + + contains + + subroutine set_verbose(level) + implicit none + integer, intent(in) :: level + verbose = level + end subroutine set_verbose + + subroutine get_verbose(level) + implicit none + integer, intent(in) :: level + verbose = level + end subroutine get_verbose + + subroutine ol_print_msg(msg) + implicit none + character(len=*), intent(in) :: msg + call ol_msg(0,msg) + end subroutine ol_print_msg + + subroutine ol_print_msg_level(level, msg) + implicit none + integer, intent(in) :: level + character(len=*), intent(in) :: msg + if (verbose >= level) write(stdout,*) "[OpenLoops] " // trim(msg) + end subroutine ol_print_msg_level + + subroutine ol_error_level(err, msg) + implicit none + integer, intent(in) :: err + character(len=*), intent(in), optional :: msg + error = err + if (present(msg)) then + write(stderr,*) "[OpenLoops] Error: " // trim(msg) + end if + end subroutine ol_error_level + + subroutine ol_error_msg(msg) + implicit none + character(len=*), intent(in), optional :: msg + call ol_error_level(1,msg) + end subroutine ol_error_msg + + function get_error() + implicit none + integer :: get_error + get_error = error + end function get_error + + function get_error_c() bind(c,name="ol_get_error") + implicit none + integer(c_int) :: get_error_c + get_error_c = error + end function get_error_c + + subroutine ol_fatal(msg, fatal_err) + implicit none + character(len=*), optional, intent(in) :: msg + integer, optional, intent(out) :: fatal_err + error = 2 + if (present(msg)) write(stderr,*) "[OpenLoops] ERROR: " // trim(msg) + if (present(fatal_err)) then + fatal_err = 1 + else if (do_not_stop) then + if (verbose > 0) write(stderr,*) "[OpenLoops] FATAL ERROR." + else + if (verbose > 0) then + write(stderr,*) "[OpenLoops] STOP." + end if + stop + end if + end subroutine ol_fatal + +end module ol_debug diff --git a/lib_src/oneloop/src/avh_olo_qp.f90 b/lib_src/oneloop/src/avh_olo_qp.f90 index 51e9cabf..2e81d4e1 100644 --- a/lib_src/oneloop/src/avh_olo_qp.f90 +++ b/lib_src/oneloop/src/avh_olo_qp.f90 @@ -1,20 +1,20 @@ ! -! Copyright (C) 2014 Andreas van Hameren. +! Copyright (C) 2015 Andreas van Hameren. ! -! This file is part of OneLOop-3.5. +! This file is part of OneLOop-3.6. ! -! OneLOop-3.5 is free software: you can redistribute it and/or modify +! OneLOop-3.6 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 3 of the License, or ! (at your option) any later version. ! -! OneLOop-3.5 is distributed in the hope that it will be useful, +! OneLOop-3.6 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 OneLOop-3.5. If not, see . +! along with OneLOop-3.6. If not, see . ! @@ -28,12 +28,12 @@ subroutine olo_version if (done) return ;done=.true. write(*,'(a72)') '########################################################################' write(*,'(a72)') '# #' - write(*,'(a72)') '# You are using OneLOop-3.5 #' + write(*,'(a72)') '# You are using OneLOop-3.6 #' write(*,'(a72)') '# #' write(*,'(a72)') '# for the evaluation of 1-loop scalar 1-, 2-, 3- and 4-point functions #' write(*,'(a72)') '# #' write(*,'(a72)') '# author: Andreas van Hameren #' - write(*,'(a72)') '# date: 14-05-2014 #' + write(*,'(a72)') '# date: 10-05-2015 #' write(*,'(a72)') '# #' write(*,'(a72)') '# Please cite #' write(*,'(a72)') '# A. van Hameren, #' @@ -405,7 +405,7 @@ subroutine set_epsn ndec = -log10(EPSN) ndecim(prcpar) = ndec epsilo(prcpar) = EPSN - neglig(prcpar) = EPSN*10**(ndec/7) + neglig(prcpar) = EPSN*(8**(ndec/7)) end subroutine ! end subroutine @@ -780,22 +780,28 @@ subroutine solabc_rcc( x1,x2 ,aa,bb,cc ) gg=xd1*pq1 ;hh=yd1*uv1 rx2 = gg+hh if (abs(rx2).lt.neglig(prcpar)*max(abs(gg),abs(hh))) rx2 = 0 - else + elseif (abs(pq2).gt.abs(pq1)) then rx2 = pq2 gg=xd2*pq2 ;hh=yd2*uv2 rx1 = gg+hh if (abs(rx1).lt.neglig(prcpar)*max(abs(gg),abs(hh))) rx1 = 0 + else + rx1 = pq1 + rx2 = pq2 endif if (abs(uv1).gt.abs(uv2)) then ix1 = uv1 gg=yd1*pq1 ;hh=xd1*uv1 ix2 = gg-hh if (abs(ix2).lt.neglig(prcpar)*max(abs(gg),abs(hh))) ix2 = 0 - else + elseif (abs(uv2).gt.abs(uv1)) then ix2 = uv2 gg=yd2*pq2 ;hh=xd2*uv2 ix1 = gg-hh if (abs(ix1).lt.neglig(prcpar)*max(abs(gg),abs(hh))) ix1 = 0 + else + ix1 = uv1 + ix2 = uv2 endif x1 = acmplx(rx1,ix1) x2 = acmplx(rx2,ix2) @@ -1443,8 +1449,8 @@ function log2_c(xx,iph) result(rslt) imx = aimag(xx) ! if (rex.eq.RZRO.and.imx.eq.RZRO) then -! if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop log2_c: ' & -! ,'xx = 0, returning 0' +! if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop log2_c: ' & +! ,'xx = 0, returning 0' rslt = 0 return endif @@ -1512,8 +1518,8 @@ function log3_c(xx,iph) result(rslt) imx = aimag(xx) ! if (rex.eq.RZRO.and.imx.eq.RZRO) then -! if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop log2_c: ' & -! ,'xx = 0, returning 0' +! if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop log3_c: ' & +! ,'xx = 0, returning 0' rslt = 0 return endif @@ -1917,7 +1923,7 @@ function dilog2_c( x1,i1 ,x2,i2 ) result(rslt) oo=mod(j1,2) ;nn=j1-oo ;y1=r1 ;if (oo.ne.0) y1=-y1 oo=mod(j2,2) ;nn=j2-oo ;y2=r2 ;if (oo.ne.0) y2=-y2 ! - eps = 10*EPSN + eps = 8*EPSN ! if (j1.ne.j2) then if (r1.eq.r2) then @@ -2051,7 +2057,7 @@ function dilog2_r( x1,i1 ,x2,i2 ) result(rslt) oo=mod(j1,2) ;nn=j1-oo ;y1=r1 ;if (oo.ne.0) y1=-y1 oo=mod(j2,2) ;nn=j2-oo ;y2=r2 ;if (oo.ne.0) y2=-y2 ! - eps = 10*EPSN + eps = 8*EPSN ! if (j1.ne.j2) then if (r1.eq.r2) then @@ -2416,7 +2422,7 @@ function bnlog_c( irank ,xx ) result(rslt) return endif ! - if (abs(xx-1).le.EPSN*10) then + if (abs(xx-1).le.EPSN*8) then aa = 1 rslt = -1 do ii=2,irank+1 @@ -2489,7 +2495,7 @@ function bnlog_r( irank ,xx ,sgn ) result(rslt) ,'argument xx=',trim(myprint(xx,8)),', returning 0' rslt = 0 return - elseif (abs(xx-1).le.EPSN*10) then + elseif (abs(xx-1).le.EPSN*8) then aa = 1 rslt = -1 do ii=2,irank+1 @@ -3485,11 +3491,15 @@ subroutine dbub0( rslt & endif ! if (app.eq.RZRO) then - if (abs(m0-m1).le.am1*EPSN*10) then + if (abs(m0-m1).le.am1*EPSN*8) then rslt = 1/(6*m1) else ch = m0/m1 - rslt = ( CONE/2 - ch*olog3(ch,0) )/m1 + if (abs(ch).le.EPSN) then + rslt = 1/(2*m1) + else + rslt = ( CONE/2 - ch*olog3(ch,0) )/m1 + endif endif elseif (am1.eq.RZRO) then rslt =-1/pp @@ -3504,7 +3514,7 @@ subroutine dbub0( rslt & ax2 = abs(x2) ax1x2 = abs(x1-x2) maxa = max(ax1,ax2) - if (ax1x2.lt.maxa*EPSN*10) then + if (ax1x2.lt.maxa*EPSN*8) then rslt = ( (x1+x2-1)*logc(q2/q2o) - 2 )/pp elseif (ax1x2*2.lt.maxa) then if (x1.eq.CZRO.or.x1.eq.CONE) then @@ -3846,7 +3856,7 @@ subroutine trif1( rslt ,p1i,p2i,p3i ,m3i ) :: p2,p3,p4,p12,p23,m4,sm2,sm3,sm4 & ,aa,bb,cc,dd,x1,x2,r23,r24,r34 real(kindr2) & - :: mhh + :: mhh,small logical :: r24Not0,r34Not0 ! ! p1 = nul @@ -3869,8 +3879,9 @@ subroutine trif1( rslt ,p1i,p2i,p3i ,m3i ) r24 = ( m4-p23-p23*IEPS )/(sm2*sm4) r34 = ( m4-p3 -p3 *IEPS )/(sm3*sm4) ! - r24Not0 = (abs(areal(r24))+abs(aimag(r24)).ge.neglig(prcpar)) - r34Not0 = (abs(areal(r34))+abs(aimag(r34)).ge.neglig(prcpar)) + small = 16*neglig(prcpar) + r24Not0 = (abs(areal(r24))+abs(aimag(r24)).ge.small) + r34Not0 = (abs(areal(r34))+abs(aimag(r34)).ge.small) ! aa = r34*r24 - r23 ! @@ -3933,6 +3944,8 @@ subroutine trif2( rslt ,p1i,p2i,p3i ,m2i,m3i ) :: p2,p3,p23,m2,m4,sm2,sm3,sm4,aa,bb,cc,dd,x1,x2 & ,r23,k24,r34,r24,d24 logical :: r23Not0,r34Not0 + real(kindr2) & + :: small ! ! p1 = nul p2 = p3i @@ -3954,8 +3967,9 @@ subroutine trif2( rslt ,p1i,p2i,p3i ,m2i,m3i ) k24 = ( m2+m4-p23-p23*IEPS )/(sm2*sm4) ! p2+p3 r34 = ( m4-p3 -p3 *IEPS )/(sm3*sm4) ! p3 ! - r23Not0 = (abs(areal(r23))+abs(aimag(r23)).ge.neglig(prcpar)) - r34Not0 = (abs(areal(r34))+abs(aimag(r34)).ge.neglig(prcpar)) + small = 16*neglig(prcpar) + r23Not0 = (abs(areal(r23))+abs(aimag(r23)).ge.small) + r34Not0 = (abs(areal(r34))+abs(aimag(r34)).ge.small) ! call rfun( r24,d24 ,k24 ) ! @@ -4439,6 +4453,9 @@ subroutine box15( rslt ,p2,p3,p12,p23 ,m2,m4 ,rmu ) :: cp2,cp3,cp12,cp23,cm2,cm4,sm1,sm2,sm3,sm4 & ,r13,r23,r24,r34,d24,log24,cc type(qmplx_type) :: q13,q23,q24,q34,qss,qz1,qz2 + logical :: r34ne0 + real(kindr2) & + :: small ! if (abs(m2-p2).gt.abs(m4-p3)) then cm2=m2 ;cm4=m4 ;cp2=p2 ;cp3=p3 @@ -4462,6 +4479,9 @@ subroutine box15( rslt ,p2,p3,p12,p23 ,m2,m4 ,rmu ) r23 = (cm2 -cp2 )/(sm2*sm3) r34 = ( cm4-cp3 )/(sm3*sm4) call rfun( r24,d24 ,(cm2+cm4-cp23)/(sm2*sm4) ) +! + small = 16*neglig(prcpar) + r34ne0 = (abs(areal(r34))+abs(aimag(r34)).gt.small) ! if (r24.eq.-CONE) then if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop box15: ' & @@ -4483,7 +4503,7 @@ subroutine box15( rslt ,p2,p3,p12,p23 ,m2,m4 ,rmu ) rslt(2) = 0 rslt(1) = -log24 rslt(0) = log24 * logc(qss) + li2c2(q24*q24,qonv(1)) - if (r34.ne.CZRO) then + if (r34ne0) then qss = q34/q23 qz1 = qss*q24 qz2 = qss/q24 @@ -4777,7 +4797,8 @@ subroutine box10( rslt ,p2,p3,p4,p12,p23 ,m4 ,rmu ) :: cp2,cp3,cp4,cp12,cp23,cm4,r13,r14,r23,r24,r34,z1,z0 type(qmplx_type) :: q13,q14,q23,q24,q34,qm4,qxx,qx1,qx2 real(kindr2) & - :: h1,h2 + :: h1,h2,small + logical :: r34zero ! if (p12.eq.CZRO) then if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop box10: ' & @@ -4812,13 +4833,16 @@ subroutine box10( rslt ,p2,p3,p4,p12,p23 ,m4 ,rmu ) q24 = qonv(r24,-1) qm4 = qonv(cm4,-1) ! - if (r34.ne.CZRO) then + small = 16*neglig(prcpar) + r34zero = (abs(r34).lt.(abs(cm4)+abs(cp3))*small) +! + if (r34zero) then + z0 = 0 + else qx1 = q34/qm4 qx2 = qx1*q14/q13 qx1 = qx1*q24/q23 z0 = -li2c2(qx1,qx2)*r34/(2*cm4*r23) - else - z0 = 0 endif ! qx1 = q23/q13 @@ -5404,6 +5428,8 @@ subroutine boxf1( rslt ,p1,p2,p3,p4,p12,p23 ,m4 ) complex(kindr2) & :: smm,sm4,aa,bb,cc,dd,x1,x2,r12,r13,r14,r23,r24,r34 logical :: r12zero,r13zero,r14zero + real(kindr2) & + :: small ! sm4 = mysqrt(m4) smm = abs(sm4) @@ -5415,9 +5441,10 @@ subroutine boxf1( rslt ,p1,p2,p3,p4,p12,p23 ,m4 ) r24 = ( -p12-p12*IEPS )/(smm*smm) r34 = ( -p2 -p2 *IEPS )/(smm*smm) ! - r12zero=(abs(areal(r12))+abs(aimag(r12)).lt.neglig(prcpar)) - r13zero=(abs(areal(r13))+abs(aimag(r13)).lt.neglig(prcpar)) - r14zero=(abs(areal(r14))+abs(aimag(r14)).lt.neglig(prcpar)) + small = 16*neglig(prcpar) + r12zero=(abs(areal(r12))+abs(aimag(r12)).lt.small) + r13zero=(abs(areal(r13))+abs(aimag(r13)).lt.small) + r14zero=(abs(areal(r14))+abs(aimag(r14)).lt.small) ! aa = r34*r24 ! @@ -5508,6 +5535,8 @@ subroutine boxf2( rslt ,p1,p2,p3,p4,p12,p23 ,m3,m4 ) :: smm,sm3,sm4,aa,bb,cc,dd,x1,x2 & ,r12,r13,r14,r23,r24,r34,d14,k14 logical :: r12zero,r13zero,r24zero,r34zero + real(kindr2) & + :: small ! sm3 = mysqrt(m3) sm4 = mysqrt(m4) @@ -5521,10 +5550,11 @@ subroutine boxf2( rslt ,p1,p2,p3,p4,p12,p23 ,m3,m4 ) r24 = ( m3-p12-p12*IEPS )/(smm*sm3) r34 = ( m3-p2 -p2 *IEPS )/(smm*sm3) ! - r12zero = (abs(areal(r12))+abs(aimag(r12)).lt.neglig(prcpar)) - r13zero = (abs(areal(r13))+abs(aimag(r13)).lt.neglig(prcpar)) - r24zero = (abs(areal(r24))+abs(aimag(r24)).lt.neglig(prcpar)) - r34zero = (abs(areal(r34))+abs(aimag(r34)).lt.neglig(prcpar)) + small = 16*neglig(prcpar) + r12zero = (abs(areal(r12))+abs(aimag(r12)).lt.small) + r13zero = (abs(areal(r13))+abs(aimag(r13)).lt.small) + r24zero = (abs(areal(r24))+abs(aimag(r24)).lt.small) + r34zero = (abs(areal(r34))+abs(aimag(r34)).lt.small) ! if (r12zero.and.r24zero) then if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop boxf2: ' & @@ -5640,6 +5670,8 @@ subroutine boxf33( rslt ,p1,p2,p3,p4,p12,p23, m1,m2,m4 ) :: sm1,sm2,sm3,sm4 ,aa,bb,cc,dd,x1,x2 & ,r12,r13,r14,r23,r24,r34,d12,d14,d24,k12,k14,k24 logical ::r13zero,r23zero,r34zero + real(kindr2) & + :: small ! sm1 = mysqrt(m1) sm2 = mysqrt(m2) @@ -5653,9 +5685,10 @@ subroutine boxf33( rslt ,p1,p2,p3,p4,p12,p23, m1,m2,m4 ) k24 = ( m2+m4-p23-p23*IEPS )/(sm2*sm4) ! p2+p3 r34 = ( m4-p3 -p3 *IEPS )/(sm3*sm4) ! p3 ! - r13zero = (abs(areal(r13))+abs(aimag(r13)).lt.neglig(prcpar)) - r23zero = (abs(areal(r23))+abs(aimag(r23)).lt.neglig(prcpar)) - r34zero = (abs(areal(r34))+abs(aimag(r34)).lt.neglig(prcpar)) + small = 16*neglig(prcpar) + r13zero = (abs(areal(r13))+abs(aimag(r13)).lt.small) + r23zero = (abs(areal(r23))+abs(aimag(r23)).lt.small) + r34zero = (abs(areal(r34))+abs(aimag(r34)).lt.small) ! if (r13zero) then if (r23zero) then @@ -6182,7 +6215,7 @@ function s3fun( y1i,y2i ,dd,ee ,aa,bb,cin ) result(rslt) rea = abs(aa) reb = abs(bb) simc = abs(cc) - if (simc.lt.10*neglig(prcpar)*min(rea,reb)) cc = 0 + if (simc.lt.8*neglig(prcpar)*min(rea,reb)) cc = 0 ! simc = aimag(cc) if (simc.eq.RZRO) then @@ -6347,6 +6380,7 @@ function r0fun( y1,y2 ) result(rslt) ,intent(in) :: y1,y2 complex(kindr2) & :: rslt ,oy1,oy2 +! oy1 = 1-y1 oy2 = 1-y2 rslt = logc2( qonv(-y2)/qonv(-y1) )/y1 & @@ -10318,7 +10352,8 @@ subroutine d0cc( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -10334,9 +10369,8 @@ subroutine d0cc( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -10593,7 +10627,8 @@ subroutine d0ccr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -10609,9 +10644,8 @@ subroutine d0ccr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -10860,7 +10894,8 @@ subroutine d0rc( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -10876,9 +10911,8 @@ subroutine d0rc( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -11129,7 +11163,8 @@ subroutine d0rcr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -11145,9 +11180,8 @@ subroutine d0rcr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -11389,7 +11423,8 @@ subroutine d0rr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -11405,9 +11440,8 @@ subroutine d0rr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -11651,7 +11685,8 @@ subroutine d0rrr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -11667,9 +11702,8 @@ subroutine d0rrr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -12095,7 +12129,7 @@ subroutine set_epsn ndec = -log10(EPSN) ndecim(prcpar) = ndec epsilo(prcpar) = EPSN - neglig(prcpar) = EPSN*10**(ndec/7) + neglig(prcpar) = EPSN*(8**(ndec/7)) end subroutine ! end subroutine @@ -12470,22 +12504,28 @@ subroutine solabc_rcc( x1,x2 ,aa,bb,cc ) gg=xd1*pq1 ;hh=yd1*uv1 rx2 = gg+hh if (abs(rx2).lt.neglig(prcpar)*max(abs(gg),abs(hh))) rx2 = 0 - else + elseif (abs(pq2).gt.abs(pq1)) then rx2 = pq2 gg=xd2*pq2 ;hh=yd2*uv2 rx1 = gg+hh if (abs(rx1).lt.neglig(prcpar)*max(abs(gg),abs(hh))) rx1 = 0 + else + rx1 = pq1 + rx2 = pq2 endif if (abs(uv1).gt.abs(uv2)) then ix1 = uv1 gg=yd1*pq1 ;hh=xd1*uv1 ix2 = gg-hh if (abs(ix2).lt.neglig(prcpar)*max(abs(gg),abs(hh))) ix2 = 0 - else + elseif (abs(uv2).gt.abs(uv1)) then ix2 = uv2 gg=yd2*pq2 ;hh=xd2*uv2 ix1 = gg-hh if (abs(ix1).lt.neglig(prcpar)*max(abs(gg),abs(hh))) ix1 = 0 + else + ix1 = uv1 + ix2 = uv2 endif x1 = acmplx(rx1,ix1) x2 = acmplx(rx2,ix2) @@ -13202,7 +13242,7 @@ function log3_c(xx,iph) result(rslt) imx = aimag(xx) ! if (rex.eq.RZRO.and.imx.eq.RZRO) then - if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop log2_c: ' & + if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop log3_c: ' & ,'xx = 0, returning 0' rslt = 0 return @@ -13607,7 +13647,7 @@ function dilog2_c( x1,i1 ,x2,i2 ) result(rslt) oo=mod(j1,2) ;nn=j1-oo ;y1=r1 ;if (oo.ne.0) y1=-y1 oo=mod(j2,2) ;nn=j2-oo ;y2=r2 ;if (oo.ne.0) y2=-y2 ! - eps = 10*EPSN + eps = 8*EPSN ! if (j1.ne.j2) then if (r1.eq.r2) then @@ -13741,7 +13781,7 @@ function dilog2_r( x1,i1 ,x2,i2 ) result(rslt) oo=mod(j1,2) ;nn=j1-oo ;y1=r1 ;if (oo.ne.0) y1=-y1 oo=mod(j2,2) ;nn=j2-oo ;y2=r2 ;if (oo.ne.0) y2=-y2 ! - eps = 10*EPSN + eps = 8*EPSN ! if (j1.ne.j2) then if (r1.eq.r2) then @@ -14106,7 +14146,7 @@ function bnlog_c( irank ,xx ) result(rslt) return endif ! - if (abs(xx-1).le.EPSN*10) then + if (abs(xx-1).le.EPSN*8) then aa = 1 rslt = -1 do ii=2,irank+1 @@ -14179,7 +14219,7 @@ function bnlog_r( irank ,xx ,sgn ) result(rslt) ,'argument xx=',trim(myprint(xx,8)),', returning 0' rslt = 0 return - elseif (abs(xx-1).le.EPSN*10) then + elseif (abs(xx-1).le.EPSN*8) then aa = 1 rslt = -1 do ii=2,irank+1 @@ -15175,11 +15215,15 @@ subroutine dbub0( rslt & endif ! if (app.eq.RZRO) then - if (abs(m0-m1).le.am1*EPSN*10) then + if (abs(m0-m1).le.am1*EPSN*8) then rslt = 1/(6*m1) else ch = m0/m1 - rslt = ( CONE/2 - ch*olog3(ch,0) )/m1 + if (abs(ch).le.EPSN) then + rslt = 1/(2*m1) + else + rslt = ( CONE/2 - ch*olog3(ch,0) )/m1 + endif endif elseif (am1.eq.RZRO) then rslt =-1/pp @@ -15194,7 +15238,7 @@ subroutine dbub0( rslt & ax2 = abs(x2) ax1x2 = abs(x1-x2) maxa = max(ax1,ax2) - if (ax1x2.lt.maxa*EPSN*10) then + if (ax1x2.lt.maxa*EPSN*8) then rslt = ( (x1+x2-1)*logc(q2/q2o) - 2 )/pp elseif (ax1x2*2.lt.maxa) then if (x1.eq.CZRO.or.x1.eq.CONE) then @@ -15536,7 +15580,7 @@ subroutine trif1( rslt ,p1i,p2i,p3i ,m3i ) :: p2,p3,p4,p12,p23,m4,sm2,sm3,sm4 & ,aa,bb,cc,dd,x1,x2,r23,r24,r34 real(kindr2) & - :: mhh + :: mhh,small logical :: r24Not0,r34Not0 ! ! p1 = nul @@ -15559,8 +15603,9 @@ subroutine trif1( rslt ,p1i,p2i,p3i ,m3i ) r24 = ( m4-p23-p23*IEPS )/(sm2*sm4) r34 = ( m4-p3 -p3 *IEPS )/(sm3*sm4) ! - r24Not0 = (abs(areal(r24))+abs(aimag(r24)).ge.neglig(prcpar)) - r34Not0 = (abs(areal(r34))+abs(aimag(r34)).ge.neglig(prcpar)) + small = 16*neglig(prcpar) + r24Not0 = (abs(areal(r24))+abs(aimag(r24)).ge.small) + r34Not0 = (abs(areal(r34))+abs(aimag(r34)).ge.small) ! aa = r34*r24 - r23 ! @@ -15623,6 +15668,8 @@ subroutine trif2( rslt ,p1i,p2i,p3i ,m2i,m3i ) :: p2,p3,p23,m2,m4,sm2,sm3,sm4,aa,bb,cc,dd,x1,x2 & ,r23,k24,r34,r24,d24 logical :: r23Not0,r34Not0 + real(kindr2) & + :: small ! ! p1 = nul p2 = p3i @@ -15644,8 +15691,9 @@ subroutine trif2( rslt ,p1i,p2i,p3i ,m2i,m3i ) k24 = ( m2+m4-p23-p23*IEPS )/(sm2*sm4) ! p2+p3 r34 = ( m4-p3 -p3 *IEPS )/(sm3*sm4) ! p3 ! - r23Not0 = (abs(areal(r23))+abs(aimag(r23)).ge.neglig(prcpar)) - r34Not0 = (abs(areal(r34))+abs(aimag(r34)).ge.neglig(prcpar)) + small = 16*neglig(prcpar) + r23Not0 = (abs(areal(r23))+abs(aimag(r23)).ge.small) + r34Not0 = (abs(areal(r34))+abs(aimag(r34)).ge.small) ! call rfun( r24,d24 ,k24 ) ! @@ -16129,6 +16177,9 @@ subroutine box15( rslt ,p2,p3,p12,p23 ,m2,m4 ,rmu ) :: cp2,cp3,cp12,cp23,cm2,cm4,sm1,sm2,sm3,sm4 & ,r13,r23,r24,r34,d24,log24,cc type(qmplx_type) :: q13,q23,q24,q34,qss,qz1,qz2 + logical :: r34ne0 + real(kindr2) & + :: small ! if (abs(m2-p2).gt.abs(m4-p3)) then cm2=m2 ;cm4=m4 ;cp2=p2 ;cp3=p3 @@ -16152,6 +16203,9 @@ subroutine box15( rslt ,p2,p3,p12,p23 ,m2,m4 ,rmu ) r23 = (cm2 -cp2 )/(sm2*sm3) r34 = ( cm4-cp3 )/(sm3*sm4) call rfun( r24,d24 ,(cm2+cm4-cp23)/(sm2*sm4) ) +! + small = 16*neglig(prcpar) + r34ne0 = (abs(areal(r34))+abs(aimag(r34)).gt.small) ! if (r24.eq.-CONE) then if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop box15: ' & @@ -16173,7 +16227,7 @@ subroutine box15( rslt ,p2,p3,p12,p23 ,m2,m4 ,rmu ) rslt(2) = 0 rslt(1) = -log24 rslt(0) = log24 * logc(qss) + li2c2(q24*q24,qonv(1)) - if (r34.ne.CZRO) then + if (r34ne0) then qss = q34/q23 qz1 = qss*q24 qz2 = qss/q24 @@ -16467,7 +16521,8 @@ subroutine box10( rslt ,p2,p3,p4,p12,p23 ,m4 ,rmu ) :: cp2,cp3,cp4,cp12,cp23,cm4,r13,r14,r23,r24,r34,z1,z0 type(qmplx_type) :: q13,q14,q23,q24,q34,qm4,qxx,qx1,qx2 real(kindr2) & - :: h1,h2 + :: h1,h2,small + logical :: r34zero ! if (p12.eq.CZRO) then if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop box10: ' & @@ -16502,13 +16557,16 @@ subroutine box10( rslt ,p2,p3,p4,p12,p23 ,m4 ,rmu ) q24 = qonv(r24,-1) qm4 = qonv(cm4,-1) ! - if (r34.ne.CZRO) then + small = 16*neglig(prcpar) + r34zero = (abs(r34).lt.(abs(cm4)+abs(cp3))*small) +! + if (r34zero) then + z0 = 0 + else qx1 = q34/qm4 qx2 = qx1*q14/q13 qx1 = qx1*q24/q23 z0 = -li2c2(qx1,qx2)*r34/(2*cm4*r23) - else - z0 = 0 endif ! qx1 = q23/q13 @@ -17094,6 +17152,8 @@ subroutine boxf1( rslt ,p1,p2,p3,p4,p12,p23 ,m4 ) complex(kindr2) & :: smm,sm4,aa,bb,cc,dd,x1,x2,r12,r13,r14,r23,r24,r34 logical :: r12zero,r13zero,r14zero + real(kindr2) & + :: small ! sm4 = mysqrt(m4) smm = abs(sm4) @@ -17105,9 +17165,10 @@ subroutine boxf1( rslt ,p1,p2,p3,p4,p12,p23 ,m4 ) r24 = ( -p12-p12*IEPS )/(smm*smm) r34 = ( -p2 -p2 *IEPS )/(smm*smm) ! - r12zero=(abs(areal(r12))+abs(aimag(r12)).lt.neglig(prcpar)) - r13zero=(abs(areal(r13))+abs(aimag(r13)).lt.neglig(prcpar)) - r14zero=(abs(areal(r14))+abs(aimag(r14)).lt.neglig(prcpar)) + small = 16*neglig(prcpar) + r12zero=(abs(areal(r12))+abs(aimag(r12)).lt.small) + r13zero=(abs(areal(r13))+abs(aimag(r13)).lt.small) + r14zero=(abs(areal(r14))+abs(aimag(r14)).lt.small) ! aa = r34*r24 ! @@ -17198,6 +17259,8 @@ subroutine boxf2( rslt ,p1,p2,p3,p4,p12,p23 ,m3,m4 ) :: smm,sm3,sm4,aa,bb,cc,dd,x1,x2 & ,r12,r13,r14,r23,r24,r34,d14,k14 logical :: r12zero,r13zero,r24zero,r34zero + real(kindr2) & + :: small ! sm3 = mysqrt(m3) sm4 = mysqrt(m4) @@ -17211,10 +17274,11 @@ subroutine boxf2( rslt ,p1,p2,p3,p4,p12,p23 ,m3,m4 ) r24 = ( m3-p12-p12*IEPS )/(smm*sm3) r34 = ( m3-p2 -p2 *IEPS )/(smm*sm3) ! - r12zero = (abs(areal(r12))+abs(aimag(r12)).lt.neglig(prcpar)) - r13zero = (abs(areal(r13))+abs(aimag(r13)).lt.neglig(prcpar)) - r24zero = (abs(areal(r24))+abs(aimag(r24)).lt.neglig(prcpar)) - r34zero = (abs(areal(r34))+abs(aimag(r34)).lt.neglig(prcpar)) + small = 16*neglig(prcpar) + r12zero = (abs(areal(r12))+abs(aimag(r12)).lt.small) + r13zero = (abs(areal(r13))+abs(aimag(r13)).lt.small) + r24zero = (abs(areal(r24))+abs(aimag(r24)).lt.small) + r34zero = (abs(areal(r34))+abs(aimag(r34)).lt.small) ! if (r12zero.and.r24zero) then if (eunit.gt.0) write(eunit,*) 'ERROR in OneLOop boxf2: ' & @@ -17330,6 +17394,8 @@ subroutine boxf33( rslt ,p1,p2,p3,p4,p12,p23, m1,m2,m4 ) :: sm1,sm2,sm3,sm4 ,aa,bb,cc,dd,x1,x2 & ,r12,r13,r14,r23,r24,r34,d12,d14,d24,k12,k14,k24 logical ::r13zero,r23zero,r34zero + real(kindr2) & + :: small ! sm1 = mysqrt(m1) sm2 = mysqrt(m2) @@ -17343,9 +17409,10 @@ subroutine boxf33( rslt ,p1,p2,p3,p4,p12,p23, m1,m2,m4 ) k24 = ( m2+m4-p23-p23*IEPS )/(sm2*sm4) ! p2+p3 r34 = ( m4-p3 -p3 *IEPS )/(sm3*sm4) ! p3 ! - r13zero = (abs(areal(r13))+abs(aimag(r13)).lt.neglig(prcpar)) - r23zero = (abs(areal(r23))+abs(aimag(r23)).lt.neglig(prcpar)) - r34zero = (abs(areal(r34))+abs(aimag(r34)).lt.neglig(prcpar)) + small = 16*neglig(prcpar) + r13zero = (abs(areal(r13))+abs(aimag(r13)).lt.small) + r23zero = (abs(areal(r23))+abs(aimag(r23)).lt.small) + r34zero = (abs(areal(r34))+abs(aimag(r34)).lt.small) ! if (r13zero) then if (r23zero) then @@ -17872,7 +17939,7 @@ function s3fun( y1i,y2i ,dd,ee ,aa,bb,cin ) result(rslt) rea = abs(aa) reb = abs(bb) simc = abs(cc) - if (simc.lt.10*neglig(prcpar)*min(rea,reb)) cc = 0 + if (simc.lt.8*neglig(prcpar)*min(rea,reb)) cc = 0 ! simc = aimag(cc) if (simc.eq.RZRO) then @@ -18037,6 +18104,7 @@ function r0fun( y1,y2 ) result(rslt) ,intent(in) :: y1,y2 complex(kindr2) & :: rslt ,oy1,oy2 +! oy1 = 1-y1 oy2 = 1-y2 rslt = logc2( qonv(-y2)/qonv(-y1) )/y1 & @@ -22008,7 +22076,8 @@ subroutine d0cc( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -22024,9 +22093,8 @@ subroutine d0cc( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -22283,7 +22351,8 @@ subroutine d0ccr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -22299,9 +22368,8 @@ subroutine d0ccr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -22550,7 +22618,8 @@ subroutine d0rc( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -22566,9 +22635,8 @@ subroutine d0rc( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -22819,7 +22887,8 @@ subroutine d0rcr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -22835,9 +22904,8 @@ subroutine d0rcr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -23079,7 +23147,8 @@ subroutine d0rr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -23095,9 +23164,8 @@ subroutine d0rr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -23341,7 +23409,8 @@ subroutine d0rrr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & - .and.areal(ss(4)).ge.-small) ) + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else @@ -23357,9 +23426,8 @@ subroutine d0rrr( rslt ,p1,p2,p3,p4,p12,p23 ,m1,m2,m3,m4 ,rmu ) .or.( areal(ss(1)).ge.-small & .and.areal(ss(2)).ge.-small & .and.areal(ss(3)).ge.-small & -!OLD .and.areal(ss(4)).ge.-small) ) - .and.areal(ss(4)).ge.-small) & !NEW - .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) !NEW + .and.areal(ss(4)).ge.-small) & + .or.(areal(ss(5)).ge.-small.and.areal(ss(6)).ge.-small)) if (useboxc) then call boxc( rslt ,ss,rr ,as ,smax ) else diff --git a/lib_src/oneloop/version.txt b/lib_src/oneloop/version.txt index ac8b54fa..919544b3 100644 --- a/lib_src/oneloop/version.txt +++ b/lib_src/oneloop/version.txt @@ -1,18 +1,18 @@ -OneLOop 3.5 +OneLOop, unofficial version from 10 May 2015 # quad precision library created by ./src/avh_olo.py dpkind="dp" qpkind="qp" kindmod="kind_types" cppintf="no" commented lines -1938-1939 -2072-2073 -13628-13629 -13762-13763 +1944f +2078f +13668f +13802f to avoid warnings "ERROR in OneLOop dilog2_c: r1,r2 = [...] returning 0" and "ERROR in OneLOop dilog2_r: r1,r2 = [...] returning 0" and lines -1446-1447 -1515-1516 +1452f +1521f to avoid warning "ERROR in OneLOop log2_c: xx = 0, returning 0" diff --git a/lib_src/openloops/src/blha_interface.F90 b/lib_src/openloops/src/blha_interface.F90 index 0aa41425..b68d56bf 100644 --- a/lib_src/openloops/src/blha_interface.F90 +++ b/lib_src/openloops/src/blha_interface.F90 @@ -26,7 +26,8 @@ module openloops_blha use, intrinsic :: iso_c_binding, only: c_char, c_int, c_double, c_null_char use ol_init, only: set_parameter, set_init_error_fatal use ol_parameters_decl_/**/DREALKIND, only: max_parameter_length - use ol_parameters_decl_/**/DREALKIND, only: max_parameter_length + use ol_debug, only: ol_error, ol_msg, ol_fatal + use openloops, only: ol_printparameter implicit none private ! BLHA interface @@ -48,6 +49,10 @@ module openloops_blha type(flag) flags + interface olp_printparameter + module procedure ol_printparameter + end interface olp_printparameter + contains @@ -73,19 +78,19 @@ subroutine olp_evalsubprocess2(id, psp, mu, rval, acc) case (2) ! ccTree call evaluate_cc(id, psp, m2l0, rval(1:rval_size(n_external(id),2)), m2l1(0)) case (3) ! scTree - print *, "[OpenLoops] Error: spin correlations in BLHA notation are not implemented" - stop + call ol_fatal("[OpenLoops] Error: spin correlations in BLHA notation are not implemented") + return case (4) ! scTree_polvect - print *, "[OpenLoops] Error: spin correlations in BLHA notation are not implemented" - stop + call ol_fatal("[OpenLoops] Error: spin correlations in BLHA notation are not implemented") + return case (11) ! Loop call evaluate_loop(id, psp, m2l0, m2l1, acc) rval(1:4) = [m2l1(2), m2l1(1), m2l1(0), m2l0] case (12) ! LoopInduced call evaluate_loop2(id, psp, rval(1), acc) case default - print *, "[OpenLoops] Error: invalid amplitude type" - stop + call ol_fatal("invalid amplitude type") + return end select end subroutine olp_evalsubprocess2 @@ -165,73 +170,6 @@ subroutine olp_info(olp_name, olp_version, message) end subroutine olp_info - - subroutine olp_printparameter(filename) - ! Fortran BLHA-like olp_printparameter routine. - ! Write parameters to a file. - ! [in] filename - use ol_parameters_decl_/**/DREALKIND - use ol_loop_parameters_decl_/**/DREALKIND - implicit none - character(len=*), intent(in) :: filename - integer :: ios - open(10, file=filename, status="replace", iostat=ios) - if (ios /= 0) then - write(*,*) "[OpenLoops] ol_printparameter: error opening file ", filename - write(*,*) " iostat =", ios - else - write(10,*) 'OpenLoops Parameters' - write(10,*) - write(10,*) 'coupling constants' - write(10,*) 'alpha_s =', alpha_QCD - write(10,*) 'alpha_qed =', alpha_QED, ' 1/alpha_qed =', 1/alpha_QED - write(10,*) 'sw = ', sw, ' sw2 = ', sw2 - write(10,*) - write(10,*) 'particle masses and widths' - write(10,*) 'rME =', rMU, 'wME =', wMU - write(10,*) 'rMM =', rMU, 'wMM =', wMU - write(10,*) 'rML =', rMU, 'wML =', wMU - write(10,*) 'rMU =', rMU, 'wMU =', wMU - write(10,*) 'rMD =', rMD, 'wMD =', wMD - write(10,*) 'rMS =', rMS, 'wMS =', wMS - write(10,*) 'rMC =', rMC, 'wMC =', wMC - write(10,*) 'rMB =', rMB, 'wMB =', wMB - write(10,*) 'rMT =', rMT, 'wMT =', wMT - write(10,*) 'rMW =', rMW, 'wMW =', wMW - write(10,*) 'rMZ =', rMZ, 'wMZ =', wMZ - write(10,*) 'rMH =', rMH, 'wMH =', wMH - write(10,*) - write(10,*) 'last_switch =', l_switch - write(10,*) 'redlib1 =', a_switch - write(10,*) 'redlib2 =', a_switch_rescue - write(10,*) 'redlib_qp =', redlib_qp - write(10,*) 'use_me_cache =', use_me_cache - write(10,*) 'use_coli_cache =', coli_cache_use - write(10,*) 'check_ward_tree =', Ward_tree - write(10,*) 'check_ward_loop =', Ward_loop - write(10,*) 'out_symmetry =', out_symmetry_on - write(10,*) - write(10,*) 'renscale =', mureg - write(10,*) 'n_quarks =', nf - write(10,*) 'light quarks =', N_lf - write(10,*) 'pole1_uv =', de1_UV - write(10,*) 'pole1_ir =', de1_IR - write(10,*) 'pole2_ir =', de2_i_IR - write(10,*) 'fermion_loops =', SwF - write(10,*) 'nonfermion_loops =', SwB - write(10,*) 'ct_on =', CT_is_on - write(10,*) 'r2_on =', R2_is_on - write(10,*) 'ir_on =', IR_is_on - write(10,*) 'polecheck =', polecheck_is - write(10,*) 'fact_uv =', 1/x_UV - write(10,*) 'fact_ir =', 1/x_IR - write(10,*) 'polenorm_swi =', norm_swi - close(10) - end if - write(*,*) "[OpenLoops] ol_printparameter: parameters written to file ", filename - end subroutine olp_printparameter - - subroutine olp_evalsubprocess_c(id, pp, mu, alpha_s, rval) bind(c,name="OLP_EvalSubProcess") ! BLHA OLP_EvalSubProcess routine (version 1). ! C wrapper to olp_evalsubprocess @@ -389,7 +327,7 @@ subroutine olp_start(contract_file_name, ierr) #ifdef USE_IFORT use ifport, only: system #endif - use ol_parameters_decl_/**/DREALKIND, only: tmp_dir, verbose + use ol_parameters_decl_/**/DREALKIND, only: tmp_dir implicit none integer, parameter :: cf = 993 integer :: readok, commentpos @@ -407,16 +345,14 @@ subroutine olp_start(contract_file_name, ierr) flags%answer_file_name = trim(contract_file_name) ierr = 1 - if (verbose > 0) then - write(*,*) "[OpenLoops] BLHA interface for OpenLoops invoked." - write(*,*) "[OpenLoops] Reading contract file: ", contract_file_name - end if + call ol_msg(1,"BLHA interface for OpenLoops invoked.") + call ol_msg(1,"Reading contract file: " // contract_file_name) ! open contract files open(cf , file=contract_file_name, status = "old", iostat=readok ) if (readok /= 0) then - write(*,*) "[OpenLoops] error: can't find contract file ", contract_file_name + call ol_error(1, "can't find contract file " // trim(contract_file_name)) ierr = 0 return end if @@ -430,7 +366,7 @@ subroutine olp_start(contract_file_name, ierr) if (readok == iostat_end) then exit ReadLoop else - write(*,*) "[OpenLoops] error reading contract file" + call ol_error(1, "error reading contract file") ierr = 0 return end if @@ -450,16 +386,13 @@ subroutine olp_start(contract_file_name, ierr) end if call olp_start_line(linein, lineout, ierrr) + call add_blha_answer(trim(lineout)) if (ierrr == 1) then - call add_blha_answer(trim(lineout)) ierr = ierr*1 else - if (verbose > 0) then - write(*,*) "[OpenLoops] Error while reading contract file at: " - write(*,*) "[OpenLoops] > ", trim(lineout) - call add_blha_answer(trim(lineout)) - ierr = 0 - end if + call ol_error(1,"error while reading contract file at: ") + call ol_msg(1,"> " // trim(lineout)) + ierr = 0 end if end do ReadLoop @@ -469,25 +402,20 @@ subroutine olp_start(contract_file_name, ierr) ! Write answer file if (stdout_contract < 2) then - if (verbose > 0) then - write(*,*) "[OpenLoops] Writing contract file to: ", trim(flags%answer_file_name) - end if + call ol_msg(1,"Writing contract file to: " // trim(flags%answer_file_name)) call write_blha_answer(ierrr) if (ierrr /= 1) then - write(*,*) "[OpenLoops] error: can't write answer file ", trim(flags%answer_file_name) + call ol_msg("Error: can't write answer file " // trim(flags%answer_file_name)) ierr = 0 end if end if - ! exit if something went wrong, i.e. not all required flags were set. if (ierr /= 1) then - write(*,*) "[OpenLoops] error reading/understanding BLHA contract file!" - return - end if - - ! everything looks fine -> exit without errors - if (verbose > 0) then - write(*,*) "[OpenLoops] OLP_start: done. " + ! exit with error if something went wrong, i.e. not all required flags were set. + call ol_error("Error reading/understanding BLHA contract file!") + else + ! everything looks fine -> exit without errors + call ol_msg(1,"OLP_start: done. ") end if end subroutine olp_start @@ -553,7 +481,7 @@ subroutine olp_start_line(line, lineout, ierr) if (ierrparam == 0) then lineout = trim(line) // " | OK" else - lineout = trim(line) // " | Error: unsupported model. Currently only 'SMdiag', 'HEFT', supported" + lineout = trim(line) // " | Error: unsupported model. Currently only 'SM', 'HEFT', supported" ierr = 0 end if case ("correctiontype") @@ -760,14 +688,14 @@ subroutine olp_start_line(line, lineout, ierr) write(lineout,'(A,A,I4)') trim(line), " | 1 " , libid end if else - print*, "[OpenLoops] Error: amplitude type not specified!" + call ol_error(1,"amplitude type not specified!") lineout = trim(line) // " | Error: amplitude type not specified!" ierr=0 return end if end if - if (stdout_contract > 0) print *, trim(lineout) + if (stdout_contract > 0) call ol_msg(trim(lineout)) end subroutine olp_start_line @@ -804,7 +732,7 @@ subroutine write_blha_answer(ierr) open(cfo, file=trim(flags%answer_file_name) , status = "REPLACE", iostat=readok) if (readok /= 0) then - write(*,*) "[OpenLoops] error: can't open output file " // trim(flags%answer_file_name) + call ol_msg("Error: can't open output file " // trim(flags%answer_file_name)) ierr = 0 return end if diff --git a/lib_src/openloops/src/contractions.F90 b/lib_src/openloops/src/contractions.F90 index 1f6fd3ff..1cdfee54 100644 --- a/lib_src/openloops/src/contractions.F90 +++ b/lib_src/openloops/src/contractions.F90 @@ -155,15 +155,15 @@ subroutine cont_EpVVV(B, C, D, Aout) complex(REALKIND), intent(out) :: Aout(4) complex(REALKIND) :: C1D4, C1D3, C1D2, C2D3, C2D4, C3D4 ! all vectors in standard representation - ! Aout(1) = B(2) * (C(3)*D(4) - C(4)*D(3)) + B(3) * (C(4)*D(2) - C(2)*D(4)) + B(4) * (C(2)*D(3) - C(3)*D(2)) - ! Aout(2) = B(3) * (C(4)*D(1) - C(1)*D(4)) + B(4) * (C(1)*D(3) - C(3)*D(1)) + B(1) * (C(3)*D(4) - C(4)*D(3)) - ! Aout(3) = B(4) * (C(2)*D(1) - C(1)*D(2)) + B(1) * (C(4)*D(2) - C(2)*D(4)) + B(2) * (C(1)*D(4) - C(4)*D(1)) - ! Aout(4) = B(1) * (C(2)*D(3) - C(3)*D(2)) + B(2) * (C(3)*D(1) - C(1)*D(3)) + B(3) * (C(1)*D(2) - C(2)*D(1)) + ! aout(1) = b(2) * (c(3)*d(4) - c(4)*d(3)) + b(3) * (c(4)*d(2) - c(2)*d(4)) + b(4) * (c(2)*d(3) - c(3)*d(2)) + ! aout(2) = b(1) * (c(3)*d(4) - c(4)*d(3)) + b(3) * (c(4)*d(1) - c(1)*d(4)) + b(4) * (c(1)*d(3) - c(3)*d(1)) + ! aout(3) = b(1) * (c(4)*d(2) - c(2)*d(4)) + b(2) * (c(1)*d(4) - c(4)*d(1)) + b(4) * (c(2)*d(1) - c(1)*d(2)) + ! aout(4) = b(1) * (c(2)*d(3) - c(3)*d(2)) + b(2) * (c(3)*d(1) - c(1)*d(3)) + b(3) * (c(1)*d(2) - c(2)*d(1)) ! light-cone representation - ! Aout(1) = B(1) * (C(4)*D(3) - C(3)*D(4)) + B(4) * (C(3)*D(1) - C(1)*D(3)) + B(3) * (C(1)*D(4) - C(4)*D(1)) - ! Aout(2) = B(2) * (C(3)*D(4) - C(4)*D(3)) + B(3) * (C(4)*D(2) - C(2)*D(4)) + B(4) * (C(2)*D(3) - C(3)*D(2)) - ! Aout(3) = B(3) * (C(1)*D(2) - C(2)*D(1)) + B(1) * (C(2)*D(3) - C(3)*D(2)) + B(2) * (C(3)*D(1) - C(1)*D(3)) - ! Aout(4) = B(4) * (C(2)*D(1) - C(1)*D(2)) + B(2) * (C(1)*D(4) - C(4)*D(1)) + B(1) * (C(4)*D(2) - C(2)*D(4)) + ! Aout(1) = i/2 * (B(1) * (C(4)*D(3) - C(3)*D(4)) + B(3) * (C(1)*D(4) - C(4)*D(1)) + B(4) * (C(3)*D(1) - C(1)*D(3))) + ! Aout(2) = i/2 * (B(2) * (C(3)*D(4) - C(4)*D(3)) + B(3) * (C(4)*D(2) - C(2)*D(4)) + B(4) * (C(2)*D(3) - C(3)*D(2))) + ! Aout(3) = i/2 * (B(1) * (C(2)*D(3) - C(3)*D(2)) + B(2) * (C(3)*D(1) - C(1)*D(3)) + B(3) * (C(1)*D(2) - C(2)*D(1))) + ! Aout(4) = i/2 * (B(1) * (C(4)*D(2) - C(2)*D(4)) + B(2) * (C(1)*D(4) - C(4)*D(1)) + B(4) * (C(2)*D(1) - C(1)*D(2))) C1D2 = C(1)*D(2) - C(2)*D(1) C1D3 = C(1)*D(3) - C(3)*D(1) C1D4 = C(1)*D(4) - C(4)*D(1) diff --git a/lib_src/openloops/src/helicity.F90 b/lib_src/openloops/src/helicity.F90 index d1e33361..4b1a5687 100644 --- a/lib_src/openloops/src/helicity.F90 +++ b/lib_src/openloops/src/helicity.F90 @@ -73,6 +73,8 @@ subroutine helbookkeeping_prop(ntry, WF1, WF2, n) ! WF2(1:n) = output wfun array ! ********************************************************************** use KIND_TYPES, only: intkind1, intkind2 + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal use ol_data_types_/**/REALKIND, only: wfun implicit none integer(intkind1), intent(in) :: ntry @@ -82,9 +84,8 @@ subroutine helbookkeeping_prop(ntry, WF1, WF2, n) integer(intkind2) :: h1, i if (ntry > 1) then ! the following operations input table t in initialisation form - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_prop:' - write(*,*) '[OpenLoops] ntry =', ntry,'not allowed' - stop + call ol_error(2,'in subroutine helbookkeeping_prop:') + call ol_fatal('ntry =' // to_string(ntry) // 'not allowed') end if ! sets n = # of non-zero WF1 components and check that all zeros are at the end @@ -99,9 +100,10 @@ subroutine helbookkeeping_prop(ntry, WF1, WF2, n) do i = h1 + 1, n if (WF1(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_prop:' - write(*,*) '[OpenLoops] i, h1, n, WF1(i)%e =', i, h1, n, WF1(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_prop:') + call ol_error(2,'i, h1, n, WF1(i)%e =' // to_string(i) // " " // to_string(h1) // " " // & + & to_string(n) // " " // to_string(WF1(i)%e)) + call ol_fatal() end if WF2(i)%e = -1_intkind2 ! mark vanishing helicity configurations end do @@ -122,6 +124,8 @@ subroutine helbookkeeping_vert3(ntry, WF1, WF2, WF3, n, t) ! array sizes n(1),n(2),n(3) restricted to non-vanishing components ! ********************************************************************** use KIND_TYPES, only: intkind1, intkind2 + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal use ol_data_types_/**/REALKIND, only: wfun implicit none integer(intkind1), intent(in) :: ntry @@ -134,9 +138,9 @@ subroutine helbookkeeping_vert3(ntry, WF1, WF2, WF3, n, t) type(wfun) :: WFaux if (ntry /= 1) then ! the following operations input table t in initialisation form - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert3:' - write(*,*) '[OpenLoops] ntry =', ntry, 'not allowed' - stop + call ol_error(2,'in subroutine helbookkeeping_vert3:') + call ol_error(2,' ntry =' // to_string(ntry) // ' not allowed') + call ol_fatal() end if ! sets n(1) = # of non-zero WF1 components and check that all zeros are at the end @@ -149,9 +153,10 @@ subroutine helbookkeeping_vert3(ntry, WF1, WF2, WF3, n, t) end do do i = h1+1, n(1) if (WF1(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert3:' - write(*,*) '[OpenLoops] i, h1, n(1), WF1(i)%e =', i, h1, n(1), WF1(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_vert3:') + call ol_error(2,'i, h1, n(1), WF1(i)%e =' // to_string(i) // " " // to_string(h1) // " " // & + & to_string(n(1)) // " " // to_string(WF1(i)%e)) + call ol_fatal() end if end do n(1) = h1 @@ -166,9 +171,10 @@ subroutine helbookkeeping_vert3(ntry, WF1, WF2, WF3, n, t) end do do i = h2+1, n(2) if (WF2(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert3:' - write(*,*) '[OpenLoops] i, h2, n(2), WF2(i)%e =', i, h2, n(2), WF2(i)%e - stop + call ol_error(2, 'in subroutine helbookkeeping_vert3:') + call ol_error(2,'i, h1, n(2), WF2(i)%e =' // to_string(i) // " " // to_string(h2) // " " // & + & to_string(n(2)) // " " // to_string(WF2(i)%e)) + call ol_fatal() end if end do n2_in = n(2) @@ -235,6 +241,8 @@ subroutine helbookkeeping_vert4(ntry, WF1, WF2, WF3, WF4, n, t) ! array sizes n(1), n(2), n(3), n(4) restricted to non-vanishing components ! ********************************************************************** use KIND_TYPES, only: intkind1, intkind2 + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal use ol_data_types_/**/REALKIND, only: wfun implicit none integer(intkind1), intent(in) :: ntry @@ -247,9 +255,9 @@ subroutine helbookkeeping_vert4(ntry, WF1, WF2, WF3, WF4, n, t) type(wfun) :: WFaux if(ntry /= 1) then ! the following operations input table t in initialisation form - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert4:' - write(*,*) '[OpenLoops] ntry =', ntry, 'not allowed' - stop + call ol_error(2,'in subroutine helbookkeeping_vert4:') + call ol_error(2,'ntry =' // to_string(ntry) // ' not allowed') + call ol_fatal() end if ! sets n(1) = # of non-zero WF1 components and check that all zeros are at the end @@ -262,9 +270,10 @@ subroutine helbookkeeping_vert4(ntry, WF1, WF2, WF3, WF4, n, t) end do do i = h1 + 1, n(1) if (WF1(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert4:' - write(*,*) '[OpenLoops] i, h1, n(1), WF1(i)%e =', i, h1, n(1), WF1(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_vert4:') + call ol_error(2,'i, h1, n(1), WF1(i)%e =' // to_string(i) // " " // to_string(h1) // " " // & + & to_string(n(1)) // " " // to_string(WF1(i)%e)) + call ol_fatal() end if end do n(1) = h1 @@ -279,9 +288,10 @@ subroutine helbookkeeping_vert4(ntry, WF1, WF2, WF3, WF4, n, t) end do do i = h2 + 1, n(2) if (WF2(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert4:' - write(*,*) '[OpenLoops] i, h2, n(2), WF2(i)%e =', i, h2, n(2), WF2(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_vert4:') + call ol_error(2,'i, h1, n(2), WF2(i)%e =' // to_string(i) // " " // to_string(h2) // " " // & + & to_string(n(2)) // " " // to_string(WF2(i)%e)) + call ol_fatal() end if end do n2_in = n(2) @@ -297,9 +307,10 @@ subroutine helbookkeeping_vert4(ntry, WF1, WF2, WF3, WF4, n, t) end do do i = h3 + 1, n(3) if (WF3(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert4:' - write(*,*) '[OpenLoops] i, h3, n(3), WF3(i)%e =', i, h3, n(3), WF3(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_vert4:') + call ol_error(2,'i, h3, n(3), WF3(i)%e =' // to_string(i) // " " // to_string(h3) // " " // & + & to_string(n(3)) // " " // to_string(WF3(i)%e)) + call ol_fatal() end if end do n3_in = n(3) @@ -371,6 +382,8 @@ subroutine helbookkeeping_vert5(ntry, WF1, WF2, WF3, WF4, WF5, n, t) ! array sizes n(1), n(2), n(3), n(4), n(5) restricted to non-vanishing components ! ********************************************************************** use KIND_TYPES, only: intkind1, intkind2 + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal use ol_data_types_/**/REALKIND, only: wfun implicit none integer(intkind1), intent(in) :: ntry @@ -383,9 +396,9 @@ subroutine helbookkeeping_vert5(ntry, WF1, WF2, WF3, WF4, WF5, n, t) type(wfun) :: WFaux if(ntry /= 1) then ! the following operations input table t in initialisation form - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert5:' - write(*,*) '[OpenLoops] ntry =', ntry, 'not allowed' - stop + call ol_error(2,'in subroutine helbookkeeping_vert5:') + call ol_error(2,'ntry =' // to_string(ntry) // ' not allowed') + call ol_fatal() end if ! sets n(1) = # of non-zero WF1 components and check that all zeros are at the end @@ -398,9 +411,10 @@ subroutine helbookkeeping_vert5(ntry, WF1, WF2, WF3, WF4, WF5, n, t) end do do i = h1 + 1, n(1) if (WF1(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert5:' - write(*,*) '[OpenLoops] i, h1, n(1), WF1(i)%e =', i, h1, n(1), WF1(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_vert5:') + call ol_error(2,'i, h1, n(1), WF1(i)%e =' // to_string(i) // " " // to_string(h1) // " " // & + & to_string(n(1)) // " " // to_string(WF1(i)%e)) + call ol_fatal() end if end do n(1) = h1 @@ -415,9 +429,10 @@ subroutine helbookkeeping_vert5(ntry, WF1, WF2, WF3, WF4, WF5, n, t) end do do i = h2 + 1, n(2) if (WF2(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert5:' - write(*,*) '[OpenLoops] i, h2, n(2), WF2(i)%e =', i, h2, n(2), WF2(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_vert5:') + call ol_error(2,'i, h2, n(2), WF2(i)%e =' // to_string(i) // " " // to_string(h2) // " " // & + & to_string(n(2)) // " " // to_string(WF2(i)%e)) + call ol_fatal() end if end do n2_in = n(2) @@ -433,9 +448,10 @@ subroutine helbookkeeping_vert5(ntry, WF1, WF2, WF3, WF4, WF5, n, t) end do do i = h3 + 1, n(3) if (WF3(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] subroutine helbookkeeping_vert5:' - write(*,*) '[OpenLoops] i, h3, n(3), WF3(i)%e =', i, h3, n(3), WF3(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_vert5:') + call ol_error(2,'i, h3, n(3), WF3(i)%e =' // to_string(i) // " " // to_string(h3) // " " // & + & to_string(n(3)) // " " // to_string(WF3(i)%e)) + call ol_fatal() end if end do n3_in = n(3) @@ -452,9 +468,10 @@ subroutine helbookkeeping_vert5(ntry, WF1, WF2, WF3, WF4, WF5, n, t) end do do i = h4 + 1, n(4) if (WF4(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_vert5:' - write(*,*) '[OpenLoops] i, h4, n(4), WF4(i)%e =', i, h4, n(4), WF4(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_vert5:') + call ol_error(2,'i, h4, n(4), WF4(i)%e =' // to_string(i) // " " // to_string(h4) // " " // & + & to_string(n(4)) // " " // to_string(WF4(i)%e)) + call ol_fatal() end if end do n4_in = n(4) @@ -529,6 +546,8 @@ subroutine helbookkeeping_cont(nsync, WF1, WF2, cont, n, t, nhel) ! (n3 = # nonvanishing hels for actual diag => n3 = global # nonvanishing hels) ! ********************************************************************** use KIND_TYPES, only: intkind1, intkind2 + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal use ol_data_types_/**/REALKIND, only: wfun, polcont implicit none integer(intkind1), intent(in) :: nsync @@ -541,9 +560,9 @@ subroutine helbookkeeping_cont(nsync, WF1, WF2, cont, n, t, nhel) type(polcont) :: contaux if (n(3) > nhel) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_cont:' - write(*,*) '[OpenLoops] n(3) =', n(3), '> nhel =', nhel, 'not allowed' - stop + call ol_error(2,'in subroutine helbookkeeping_cont:') + call ol_error(2,'n(3) = ' // to_string(n(3)) // ' > nhel = ' // to_string(nhel) // ' not allowed') + call ol_fatal() end if select case (nsync) @@ -559,9 +578,10 @@ subroutine helbookkeeping_cont(nsync, WF1, WF2, cont, n, t, nhel) end do do i = h1+1, n(1) if (WF1(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_cont:' - write(*,*) '[OpenLoops] i, h1, n(1), WF1(i)%e =', i, h1, n(1), WF1(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_cont:') + call ol_error(2,'i, h1, n(1), WF1(i)%e =' // to_string(i) // " " // to_string(h1) // " " // & + & to_string(n(1)) // " " // to_string(WF1(i)%e)) + call ol_fatal() end if end do n(1) = h1 @@ -576,9 +596,10 @@ subroutine helbookkeeping_cont(nsync, WF1, WF2, cont, n, t, nhel) end do do i = h2+1, n(2) if (WF2(i)%e /= -1_intkind2) then - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_cont:' - write(*,*) '[OpenLoops] i, h2, n(2), WF2(i)%e =', i, h2, n(2), WF2(i)%e - stop + call ol_error(2,'in subroutine helbookkeeping_cont:') + call ol_error(2,'i, h2, n(2), WF2(i)%e =' // to_string(i) // " " // to_string(h2) // " " // & + & to_string(n(2)) // " " // to_string(WF2(i)%e)) + call ol_fatal() end if end do n2_in = n(2) @@ -641,10 +662,9 @@ subroutine helbookkeeping_cont(nsync, WF1, WF2, cont, n, t, nhel) end do case default - write(*,*) '[OpenLoops] ERROR in subroutine helbookkeeping_cont:' - write(*,*) '[OpenLoops] nsync =', nsync, 'not allowed' - stop - + call ol_error(2, 'in subroutine helbookkeeping_cont:') + call ol_error(2, 'nsync = ' // to_string(nsync) // ' not allowed') + call ol_fatal() end select end subroutine helbookkeeping_cont @@ -658,6 +678,8 @@ subroutine helsync(nsync, cont, Nhel, Hel) ! Nhelmax = maximal number of helicity configurations ! ********************************************************************** use KIND_TYPES, only: intkind1, intkind2 + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal use ol_data_types_/**/REALKIND, only: polcont implicit none integer(intkind1), intent(in) :: nsync @@ -668,9 +690,9 @@ subroutine helsync(nsync, cont, Nhel, Hel) integer :: Nhelmax, h, h0, i, ishift, Ndiag, n if (nsync /= 1) then - write(*,*) '[OpenLoops] ERROR in subroutine helsync:' - write(*,*) '[OpenLoops] nsync =', nsync, 'not allowed' - stop + call ol_error(2,'in subroutine helsync:') + call ol_error(2,'nsync = ' // to_string(nsync) // ' not allowed') + call ol_fatal() end if Ndiag = size(cont,2) ! number of diagrams diff --git a/lib_src/openloops/src/helicity_init.F90 b/lib_src/openloops/src/helicity_init.F90 index 6a83e2cd..81c55b68 100644 --- a/lib_src/openloops/src/helicity_init.F90 +++ b/lib_src/openloops/src/helicity_init.F90 @@ -25,6 +25,8 @@ module ol_helicity_init subroutine heltable(n_in, n, tab) ! ********************************************************************** use KIND_TYPES, only: intkind2 + use ol_generic, only: to_string + use ol_debug, only: ol_fatal implicit none integer, intent(in) :: n_in(:) integer(intkind2), intent(out) :: n(:), tab(:,:) @@ -69,8 +71,7 @@ subroutine heltable(n_in, n, tab) end do end do else - print *, "heltable:", size(n), "point vertices are not supported." - stop + call ol_fatal("heltable: " // to_string(size(n)) // " point vertices are not supported.") end if end subroutine heltable @@ -140,6 +141,8 @@ subroutine helsync_flip(nsync, nhel, hel, eflip, exthel) ! nhelmax = maximal number of helicity configurations ! ********************************************************************** use KIND_TYPES, only: intkind1, intkind2 + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal implicit none integer(intkind1), intent(in) :: nsync integer(intkind2), intent(in) :: nhel, hel(:) @@ -149,9 +152,9 @@ subroutine helsync_flip(nsync, nhel, hel, eflip, exthel) integer :: nhelmax, e, h, k if (nsync /= 1) then - write(*,*) '[OpenLoops] ERROR in subroutine helsync_flip:' - write(*,*) '[OpenLoops] nsync =', nsync, 'not allowed' - stop + call ol_error(2, 'in subroutine helsync_flip:') + call ol_error(2, 'nsync = ' // to_string(nsync) // ' not allowed') + call ol_fatal() end if nhelmax = size(hel) ! maximal number of helicity configurations diff --git a/lib_src/openloops/src/i-operator.F90 b/lib_src/openloops/src/i-operator.F90 index 85313d42..d0d6efc2 100644 --- a/lib_src/openloops/src/i-operator.F90 +++ b/lib_src/openloops/src/i-operator.F90 @@ -18,6 +18,7 @@ module ol_i_operator_/**/REALKIND + use ol_debug, only: ol_fatal implicit none contains @@ -138,6 +139,8 @@ subroutine intdip_Gj(j,flavj,M2j,Q2_aux,Gj) ! the Les-Houches accord normalisation ! ********************************************************************** use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_fatal, ol_error + use ol_generic, only: to_string use ol_parameters_decl_/**/REALKIND use ol_loop_parameters_decl_/**/REALKIND, only: pi2_6, tf, ca, mu2_IR use ol_loop_parameters_decl_/**/DREALKIND, only: N_lf, SwF, SwB @@ -178,16 +181,13 @@ subroutine intdip_Gj(j,flavj,M2j,Q2_aux,Gj) Gj(1) = 1 Gj(0) = 0.5_/**/REALKIND*log(M2j/mu2_IR) - 2 else - write(*,*) '[OpenLoops] subroutine intdip_Gj: arguments out of range' - write(*,*) '[OpenLoops] allowed range M2j > 0' - write(*,*) '[OpenLoops] M2j = ', M2j - stop + call ol_error(2,'subroutine intdip_Gj: argument M2j out of range') + call ol_fatal() end if else - write(*,*) '[OpenLoops] subroutine intdip_Gj: arguments out of range' - write(*,*) '[OpenLoops] allowed range flavj=1,2' - write(*,*) '[OpenLoops] flavj = ', flavj - stop + call ol_error(2,'subroutine intdip_Gj: argument flavj out of range') +! call ol_error(2,'flavj = ' // to_string(flavj)) + call ol_fatal() end if ! Gj = Tj^2*([V_jk] - pi^2/3) + Gamma_j + Gaj + Kaj @@ -215,6 +215,8 @@ subroutine intdip_Fjk(j,k,Tjk,flavj,M2j,M2k,Q2_aux,Fjk) ! if j=initial-state gluon => kappa=2/3 according to (6.52) ! ********************************************************************** use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_fatal, ol_error + use ol_generic, only: to_string use ol_parameters_decl_/**/REALKIND use ol_loop_parameters_decl_/**/REALKIND, only: mu2_IR, pi2_6, tf, ca, kappa use ol_loop_parameters_decl_/**/DREALKIND, only: N_lf, SwF, SwB @@ -296,11 +298,11 @@ subroutine intdip_Fjk(j,k,Tjk,flavj,M2j,M2k,Q2_aux,Fjk) -pi2_6 & +log(rho)*log(Q2jk/Sjk))/Nujk else - write(*,*) '[OpenLoops] subroutine intdip_Fjk: arguments out of range' - write(*,*) '[OpenLoops] allowed range M2j, M2k >= 0' - write(*,*) '[OpenLoops] M2j = ', M2j - write(*,*) '[OpenLoops] M2k = ', M2k - stop + call ol_error(2,'subroutine intdip_Fjk: arguments out of range') + call ol_error(2,'allowed range M2j, M2k >= 0') +! write(*,*) '[OpenLoops] M2j = ', M2j +! write(*,*) '[OpenLoops] M2k = ', M2k + call ol_fatal() end if ! non-singular part of nu_j function for gluons (ok) @@ -319,10 +321,10 @@ subroutine intdip_Fjk(j,k,Tjk,flavj,M2j,M2k,Q2_aux,Fjk) if (SwF /= 0) Nuj_nonsing = Nuj_nonsing + (kappa-2._/**/REALKIND/3._/**/REALKIND)*M2k/Sjk*log(2*Mk/(Qjk+Mk))*(2*tf*N_lf)/3 end if else - write(*,*) '[OpenLoops] subroutine intdip_Fjk: arguments out of range' - write(*,*) '[OpenLoops] allowed range M2k >= 0' - write(*,*) '[OpenLoops] M2k =', M2k - stop + call ol_error(2,'subroutine intdip_Fjk: arguments out of range') + call ol_error(2,'allowed range M2k >= 0') + ! write(*,*) '[OpenLoops] M2k =', M2k + call ol_fatal() end if ! non-singular part of nu_j function for quarks (ok) @@ -341,17 +343,17 @@ subroutine intdip_Fjk(j,k,Tjk,flavj,M2j,M2k,Q2_aux,Fjk) & + log((Qjk-Mk)/Qjk) - 2*log(((Qjk-Mk)**2-M2j)/Q2jk) - 2*M2j/Sjk*log(Mj/(Qjk-Mk)) & & - Mk/(Qjk-Mk) + 2*Mk*(2*Mk-Qjk)/Sjk + 3*pi2_6 else - write(*,*) '[OpenLoops] subroutine intdip_Fjk: arguments out of range' - write(*,*) '[OpenLoops] allowed range M2j, M2k >= 0' - write(*,*) '[OpenLoops] M2j =',M2j - write(*,*) '[OpenLoops] M2k =',M2k - stop + call ol_error(2,'subroutine intdip_Fjk: arguments out of range') + call ol_error(2,'allowed range M2j, M2k >= 0') +! write(*,*) '[OpenLoops] M2j =',M2j +! write(*,*) '[OpenLoops] M2k =',M2k + call ol_fatal() end if else - write(*,*) '[OpenLoops] subroutine intdip_Fjk: arguments out of range' - write(*,*) '[OpenLoops] allowed range flavj=1,2' - write(*,*) '[OpenLoops] flavj =', flavj - stop + call ol_error(2,'subroutine intdip_Fjk: arguments out of range') + call ol_error(2,'allowed range flavj=1,2') +! write(*,*) '[OpenLoops] flavj =', flavj + call ol_fatal() end if Fjk(0) = Fjk(0) + Nuj_nonsing + Gaj*logmu2_Sjk diff --git a/lib_src/openloops/src/init_ui.F90 b/lib_src/openloops/src/init_ui.F90 index dd584cdc..99dcb347 100644 --- a/lib_src/openloops/src/init_ui.F90 +++ b/lib_src/openloops/src/init_ui.F90 @@ -21,13 +21,15 @@ module ol_init use KIND_TYPES, only: DREALKIND use, intrinsic :: iso_c_binding, only: c_char, c_double, c_int use ol_iso_c_utilities, only: c_f_string + use ol_debug, only: ol_fatal, ol_msg, ol_error, set_verbose, get_verbose, do_not_stop implicit none private - public :: set_init_error_fatal, get_error - public :: set_parameter, get_parameter, parameters_flush + public :: set_init_error_fatal + public :: set_parameter, get_parameter, parameters_flush, tree_parameters_flush public :: register_cleanup, cleanup - logical, save :: setparameter_was_called = .true. + logical, save :: setparameter_tree_was_called = .true. + logical, save :: setparameter_loop_was_called = .true. logical, save :: forwarded_init = .false. integer, save :: error = 0 integer, save :: init_error_fatal = 2 @@ -66,19 +68,6 @@ subroutine set_init_error_fatal_c(flag) bind(c,name="ol_set_init_error_fatal") init_error_fatal = flag end subroutine set_init_error_fatal_c - function get_error() - implicit none - integer :: get_error - get_error = error - end function get_error - - function get_error_c() bind(c,name="ol_get_error") - implicit none - integer(c_int) :: get_error_c - get_error_c = error - end function get_error_c - - subroutine set_if_modified_int(current, new) use ol_parameters_decl_/**/DREALKIND, only: parameters_changed implicit none @@ -121,19 +110,19 @@ subroutine setparameter_int(param, val, err) ! sets error flag: 0=ok, 1=ignored, 2=error(unused) use ol_parameters_decl_/**/DREALKIND use ol_loop_parameters_decl_/**/DREALKIND + use ol_generic, only: to_lowercase, to_string implicit none character(*), intent(in) :: param integer, intent(in) :: val integer, intent(out), optional :: err error = 0 - setparameter_was_called = .true. + setparameter_tree_was_called = .true. + setparameter_loop_was_called = .true. - if (verbose > 3) then - print*, "[OpenLoops] setparameter_int: ", trim(param), val - end if + call ol_msg(4, "setparameter_int: " // trim(param) // " " // to_string(val)) - select case (param) + select case (to_lowercase(param)) case ("redlib1") call set_if_modified(a_switch, val) @@ -160,9 +149,8 @@ subroutine setparameter_int(param, val, err) #ifndef USE_qp if (val == 13 .or. val == 14 .or. val == 22 .or. val == 23 .or. & & val == 31 .or. val == 32) then - print *, "ERROR: stability_mode", val, "is not available" - print *, " because quad precision is deactivated" - error = 1 + call ol_error(1, "stability_mode" // to_string(val) // "is not available") + call ol_msg(" because quad precision is deactivated") else call set_if_modified(stability_mode, val) end if @@ -172,14 +160,12 @@ subroutine setparameter_int(param, val, err) case ("deviation_mode") call set_if_modified(deviation_mode, val) if (val /= 1 .and. val /= 2) then - print *, "[OpenLoops] unrecognised deviation_mode:", val - error = 1 + call ol_error(1,"unrecognised deviation_mode:" // to_string(val)) end if case ("scaling_mode") call set_if_modified(scaling_mode, val) if (val /= 1 .and. val /= 3) then - print *, "[OpenLoops] unrecognised scaling_mode:", val - error = 1 + call ol_error(1, "unrecognised scaling_mode:" // to_string(val)) end if case ("write_psp", "write_points") write_psp = val @@ -202,6 +188,8 @@ subroutine setparameter_int(param, val, err) case ("coupling_ew_1", "coupling_ew_l") coupling_ew(1) = val call set_if_modified(do_ew_renorm, 1) + case ("add_associated_ew") + add_associated_ew = val case ("order_ew") coupling_ew(0) = val coupling_ew(1) = 0 @@ -226,7 +214,13 @@ subroutine setparameter_int(param, val, err) case ("ioperator_mode") call set_if_modified(ioperator_mode, val) case ("polecheck") - call set_if_modified(polecheck_is, val) + if (val == 1) then + call set_if_modified(polecheck_is, val) + else if (val == 2) then + call set_if_modified(polecheck_is, 1) + call set_if_modified(do_ew_renorm, 1) + call set_if_modified(ir_is_on, 2) + end if case ("fermion_loops") call set_if_modified(swf, val) case ("nonfermion_loops") @@ -257,8 +251,23 @@ subroutine setparameter_int(param, val, err) call set_if_modified(do_ew_renorm, val) case ("ew_renorm_switch") call set_if_modified(ew_renorm_switch, val) + case ("ew_scheme") + if (val /= 0 .and. val /= 1 .and. val /= 2) then + call ol_error(1,"unrecognised ew_scheme:" // to_string(val)) + else + call set_if_modified(ew_scheme, val) + call set_if_modified(ew_renorm_scheme, val) + end if + case ("ew_renorm_scheme") + if (val /= 0 .and. val /= 1 .and. val /= 2) then + call ol_error(1,"unrecognised ew_renorm_scheme:" // to_string(val)) + else + call set_if_modified(ew_renorm_scheme, val) + end if case ("complex_mass_scheme", "use_cms") call set_if_modified(cms_on, val) + case ("select_pol_v") + call ol_error(1,"select_pol_V is deprecated use direct polarization selection instead.") case ("cll_tenred") call set_if_modified(cll_tenred, val) case ("cll_channels") @@ -286,9 +295,19 @@ subroutine setparameter_int(param, val, err) case ("ol_params_verbose", "parameters_verbose") parameters_verbose = val case ("verbose") - verbose = val + call set_verbose(val) + case ("do_not_stop") + if (do_not_stop) then + do_not_stop = .true. + else + do_not_stop = .false. + end if case ("no_splash", "nosplash") - if (val == 1) then + if (val == 0) then + splash_todo = .true. + olo_splash_done = .false. + cts_splash_todo = .true. + else splash_todo = .false. olo_splash_done = .true. cts_splash_todo = .false. @@ -298,22 +317,35 @@ subroutine setparameter_int(param, val, err) splash_todo = .false. olo_splash_done = .true. cts_splash_todo = .false. + else + splash_todo = .true. + olo_splash_done = .false. + cts_splash_todo = .true. end if case ("preset") if (val == 1) then call set_if_modified(a_switch, 5) + call set_if_modified(redlib_qp, 5) call set_if_modified(stability_mode, 14) call set_if_modified(ew_renorm_switch, 3) else if (val == 2) then call set_if_modified(a_switch, 1) call set_if_modified(a_switch_rescue, 7) + call set_if_modified(redlib_qp, 5) call set_if_modified(stability_mode, 23) call set_if_modified(ew_renorm_switch, 1) else if (val == 3) then call set_if_modified(a_switch, 1) call set_if_modified(a_switch_rescue, 7) + call set_if_modified(redlib_qp, 5) call set_if_modified(stability_mode, 21) call set_if_modified(ew_renorm_switch, 1) + else if (val == 4) then + call set_if_modified(a_switch, 1) + call set_if_modified(a_switch_rescue, 7) + call set_if_modified(redlib_qp, 5) + call set_if_modified(stability_mode, 22) + call set_if_modified(ew_renorm_switch, 1) end if case default error = 1 @@ -322,7 +354,7 @@ subroutine setparameter_int(param, val, err) call setparameter_double(param, real(val, DREALKIND)) forwarded_init = .false. if (error == 1 .and. init_error_fatal == 1) then - write(*,*) "[OpenLoops] ol_setparameter_int ignored unknown parameter '" // trim(param) // "'" + call ol_error(1, "ol_setparameter_int ignored unknown parameter '" // trim(param) // "'") end if end if @@ -332,8 +364,8 @@ subroutine setparameter_int(param, val, err) err = error else if (init_error_fatal == 2 .and. error /= 0) then - write(*,*) "[OpenLoops] error: unknown parameter '" // trim(param) // "' in ol_setparameter_int" - stop + call ol_fatal("unknown parameter '" // trim(param) // "' in ol_setparameter_int") + return end if end if end subroutine setparameter_int @@ -347,6 +379,7 @@ subroutine getparameter_int(param, val, err) ! sets error flag: 0=ok, 1=ignored, 2=error(unused) use ol_parameters_decl_/**/DREALKIND use ol_loop_parameters_decl_/**/DREALKIND + use ol_generic, only: to_lowercase implicit none character(*), intent(in) :: param integer, intent(out) :: val @@ -354,7 +387,7 @@ subroutine getparameter_int(param, val, err) error = 0 - select case (param) + select case (to_lowercase(param)) case ("redlib1") val = a_switch @@ -430,6 +463,10 @@ subroutine getparameter_int(param, val, err) val = do_ew_renorm case ("ew_renorm_switch") val = ew_renorm_switch + case ("ew_scheme") + val = ew_scheme + case ("ew_renorm_scheme") + val = ew_renorm_scheme case ("complex_mass_scheme", "use_cms") val = cms_on case ("cll_tenred") @@ -453,14 +490,20 @@ subroutine getparameter_int(param, val, err) case ("ol_params_verbose") val = parameters_verbose case ("verbose") - val = verbose + call get_verbose(val) + case("do_not_stop") + if (do_not_stop) then + val = 1 + else + val = 0 + end if case ("welcome_length") val = welcome_length case default error = 1 if (init_error_fatal == 1) then - write(*,*) "[OpenLoops] getparameter_int ignored unknown parameter '" // trim(param) // "'" + call ol_error(1,"getparameter_int ignored unknown parameter '" // trim(param) // "'") end if end select @@ -469,8 +512,8 @@ subroutine getparameter_int(param, val, err) err = error else if (init_error_fatal == 2 .and. error /= 0) then - write(*,*) "[OpenLoops] error: unknown parameter '" // trim(param) // "' in ol_getparameter_int" - stop + call ol_fatal("unknown parameter '" // trim(param) // "' in ol_getparameter_int") + return end if end if end subroutine getparameter_int @@ -486,30 +529,45 @@ subroutine setparameter_double(param, val, err) ! sets error flag: 0=ok, 1=ignored, 2=error(unused) use ol_parameters_decl_/**/DREALKIND use ol_loop_parameters_decl_/**/DREALKIND + use ol_generic, only: to_lowercase, to_string implicit none character(*), intent(in) :: param real(DREALKIND), intent(in) :: val integer, intent(out), optional :: err error = 0 - setparameter_was_called = .true. + setparameter_tree_was_called = .true. + setparameter_loop_was_called = .true. - if (verbose > 3) then - print*, "[OpenLoops] setparameter_double: ", trim(param), val - end if + call ol_msg(4, "setparameter_double: " // trim(param) // " " // to_string(val)) - select case (param) + select case (to_lowercase(param)) case ("mu", "renscale") if (mureg /= val) reset_mureg = .true. call set_if_modified(mureg_unscaled, val) + call set_if_modified(muren_unscaled, val) + case ("muren") + call set_if_modified(muren_unscaled, val) + case ("mureg") + if (mureg /= val) reset_mureg = .true. + call set_if_modified(mureg_unscaled, val) case ("alphas", "alpha_s", "alpha_qcd") call set_if_modified(alpha_QCD, val) - case ("alpha", "alpha_ew", "alpha_qed") - call set_if_modified(alpha_QED, val) + case ("alpha", "alpha_qed", "alpha_qed_mz") + call set_if_modified(alpha_QED_MZ, val) + case ("alpha_qed_0") + call set_if_modified(alpha_QED_0, val) + case ("gmu") + call set_if_modified(Gmu_unscaled, val) case ("scalefactor") - if (scalefactor /= val) reset_scalefactor = .true. - scalefactor = val + if (scalefactor == 0) then + call ol_error("scalefactor == 0 not supported!") + return + else + if (scalefactor /= val) reset_scalefactor = .true. + scalefactor = val + end if case ("rescalefactor") call set_if_modified(rescalefactor, val) case ("mass(1)", "d_mass", "rmd") @@ -542,25 +600,25 @@ subroutine setparameter_double(param, val, err) call set_if_modified(rYC_unscaled, val) case ("muy(4)", "c_muy") call set_if_modified(muyc_unscaled, val) - case ("mass(5)", "b_mass", "rmb") + case ("mass(5)", "b_mass", "rmb", "mb") call set_if_modified(rMB_unscaled, val) call set_if_modified(rYB_unscaled, val) case ("width(5)", "b_width", "wmb") call set_if_modified(wMB_unscaled, val) call set_if_modified(wYB_unscaled, val) - case ("yuk(5)", "b_yuk") + case ("yuk(5)", "b_yuk", "yb") call set_if_modified(rYB_unscaled, val) case ("yukw(5)", "b_yukw") call set_if_modified(wYB_unscaled, val) case ("muy(5)", "b_muy") call set_if_modified(muyb_unscaled, val) - case ("mass(6)", "t_mass", "rmt") + case ("mass(6)", "t_mass", "rmt", "mt") call set_if_modified(rMT_unscaled, val) call set_if_modified(rYT_unscaled, val) case ("width(6)", "t_width", "wmt") call set_if_modified(wMT_unscaled, val) call set_if_modified(wYT_unscaled, val) - case ("yuk(6)", "t_yuk") + case ("yuk(6)", "t_yuk", "yt") call set_if_modified(rYT_unscaled, val) case ("yukw(6)", "t_yukw") call set_if_modified(wYT_unscaled, val) @@ -578,37 +636,56 @@ subroutine setparameter_double(param, val, err) call set_if_modified(rYM_unscaled, val) case ("width(13)", "mu_width", "wmm") call set_if_modified(wMM_unscaled, val) - case ("yuk(13)", "m_yuk") + case ("yuk(13)", "m_yuk", "mu_yuk") call set_if_modified(rYM_unscaled, val) case ("mass(15)", "tau_mass", "rml") call set_if_modified(rML_unscaled, val) call set_if_modified(rYL_unscaled, val) case ("width(15)", "tau_width", "wml") call set_if_modified(wML_unscaled, val) - case ("yuk(15)", "l_yuk") + case ("yuk(15)", "l_yuk", "tau_yuk") call set_if_modified(rYL_unscaled, val) - case ("mass(23)", "z_mass", "rmz") + case ("mass(23)", "z_mass", "rmz", "mz") call set_if_modified(rMZ_unscaled, val) case ("width(23)", "z_width", "wmz") call set_if_modified(wMZ_unscaled, val) - case ("mass(24)", "w_mass", "rmw") + case ("mass(24)", "w_mass", "rmw", "mw") call set_if_modified(rMW_unscaled, val) case ("width(24)", "w_width", "wmw") call set_if_modified(wMW_unscaled, val) - case ("mass(25)", "h_mass", "rmh") + case ("mass(25)", "h_mass", "rmh", "mh") call set_if_modified(rMH_unscaled, val) case ("width(25)", "h_width", "wmh") call set_if_modified(wMH_unscaled, val) case("x_width", "wx") if (trim(model) /= "sm_vaux") then - print*, "[OpenLoops] Warning: x_width can only be used with model sm_vaux" + call ol_msg("Warning: x_width can only be used with model sm_vaux") end if call set_if_modified(wMX_unscaled, val) case("y_width", "wy") if (trim(model) /= "sm_vaux") then - print*, "[OpenLoops] Warning: y_width can only be used with model sm_vaux" + call ol_msg("Warning: y_width can only be used with model sm_vaux") end if call set_if_modified(wMY_unscaled, val) + case("mass(36)", "rma0", "ma0") + call set_if_modified(rMA0_unscaled, val) + case("width(36)", "wma0") + call set_if_modified(wMA0_unscaled, val) + case("mass(35)", "rmhh", "mhh") + call set_if_modified(rMHH_unscaled, val) + case("width(35)", "wmhh") + call set_if_modified(wMHH_unscaled, val) + case("mass(37)", "rmhp", "mhp") + call set_if_modified(rMHp_unscaled, val) + case("width(37)", "wmhp") + call set_if_modified(wMHp_unscaled, val) + case("tanb", "tan_b") + call set_if_modified(thdmTB, val) + case("sinba", "sin_ba") + call set_if_modified(thdmSBA, val) + case("lambda5") + call set_if_modified(thdmL5, val) + case("hqq_right") call set_if_modified(gH(1), val) case("hqq_left") @@ -679,7 +756,7 @@ subroutine setparameter_double(param, val, err) forwarded_init = .false. end if if (error == 1 .and. init_error_fatal == 1) then - write(*,*) "[OpenLoops] ol_setparameter_double ignored unknown parameter '" // trim(param) // "'" + call ol_error(1, "ol_setparameter_double ignored unknown parameter '" // trim(param) // "'") end if end if @@ -689,8 +766,8 @@ subroutine setparameter_double(param, val, err) err = error else if (init_error_fatal == 2 .and. error /= 0) then - write(*,*) "[OpenLoops] error: unknown parameter '" // trim(param) // "' in ol_setparameter_double" - stop + call ol_fatal("unknown parameter '" // trim(param) // "' in ol_setparameter_double") + return end if end if end subroutine setparameter_double @@ -716,11 +793,12 @@ subroutine setparameter_dcomplex(param, val, err) integer, intent(out), optional :: err call setparameter_double(param, real(val, DREALKIND), err) if (aimag(val) /= 0) then - print *, "[OpenLoops] non-vanishing imaginary part in real parameter" if (present(err)) then + call ol_error(1, "non-vanishing imaginary part in real parameter") err = 1 else - stop + call ol_fatal("non-vanishing imaginary part in real parameter") + return end if end if end subroutine setparameter_dcomplex @@ -734,6 +812,7 @@ subroutine getparameter_double(param, val, err) ! sets error flag: 0=ok, 1=ignored, 2=error(unused) use ol_parameters_decl_/**/DREALKIND use ol_loop_parameters_decl_/**/DREALKIND + use ol_generic, only: to_lowercase implicit none character(*), intent(in) :: param real(DREALKIND), intent(out) :: val @@ -741,14 +820,18 @@ subroutine getparameter_double(param, val, err) error = 0 - select case (param) + select case (to_lowercase(param)) case ("mu", "renscale") val = mureg case ("alphas", "alpha_s", "alpha_qcd") val = alpha_QCD - case ("alpha", "alpha_ew", "alpha_qed") + case ("alpha", "alpha_qed", "alpha_qed_mz") val = alpha_QED + case ("alpha_qed_0") + val = alpha_qed_0 + case ("gmu") + val = Gmu case ("scalefactor") val = scalefactor case ("rescalefactor") @@ -757,47 +840,65 @@ subroutine getparameter_double(param, val, err) val = rMD case ("width(1)", "d_width", "wmd") val = wMD + case ("yuk(1)", "d_yuk") + val = rYD case ("mass(2)", "u_mass", "rmu") val = rMU case ("width(2)", "u_width", "wmu") val = wMU + case ("yuk(2)", "u_yuk") + val = rYU case ("mass(3)", "s_mass", "rms") val = rMS case ("width(3)", "s_width", "wms") val = wMS + case ("yuk(3)", "s_yuk") + val = rYS case ("mass(4)", "c_mass", "rmc") val = rMC case ("width(4)", "c_width", "wmc") val = wMC - case ("mass(5)", "b_mass", "rmb") + case ("yuk(4)", "c_yuk") + val = rYC + case ("mass(5)", "b_mass", "rmb", "mb") val = rMB case ("width(5)", "b_width", "wmb") val = wMB - case ("mass(6)", "t_mass", "rmt") + case ("yuk(5)", "b_yuk", "yb") + val = rYB + case ("mass(6)", "t_mass", "rmt", "mt") val = rMT case ("width(6)", "t_width", "wmt") val = wMT + case ("yuk(6)", "t_yuk", "yt") + val = rYT case ("mass(11)", "e_mass", "rme") val = rME case ("width(11)", "e_width", "wme") val = wME + case ("yuk(11)", "e_yuk") + val = rYE case ("mass(13)", "mu_mass", "rmm") val = rMM case ("width(13)", "mu_width", "wmm") val = wMM + case ("yuk(13)", "m_yuk") + val = rYM case ("mass(15)", "tau_mass", "rml") val = rML case ("width(15)", "tau_width", "wml") val = wML - case ("mass(23)", "z_mass", "rmz") + case ("yuk(15)", "l_yuk") + val = rYL + case ("mass(23)", "z_mass", "rmz", "mz") val = rMZ case ("width(23)", "z_width", "wmz") val = wMZ - case ("mass(24)", "w_mass", "rmw") + case ("mass(24)", "w_mass", "rmw", "mw") val = rMW case ("width(24)", "w_width", "wmw") val = wMW - case ("mass(25)", "h_mass", "rmh") + case ("mass(25)", "h_mass", "rmh", "mh") val = rMH case ("width(25)", "h_width", "wmh") val = wMH @@ -854,7 +955,7 @@ subroutine getparameter_double(param, val, err) case default error = 1 if (init_error_fatal == 1) then - write(*,*) "[OpenLoops] getparameter_double ignored unknown parameter '" // trim(param) // "'" + call ol_error(1,"getparameter_double ignored unknown parameter '" // trim(param) // "'") end if end select @@ -863,8 +964,8 @@ subroutine getparameter_double(param, val, err) err = error else if (init_error_fatal == 2 .and. error /= 0) then - write(*,*) "[OpenLoops] error: unknown parameter '" // trim(param) // "' in ol_getparameter_double" - stop + call ol_fatal("error: unknown parameter '" // trim(param) // "' in ol_getparameter_double") + return end if end if end subroutine getparameter_double @@ -889,19 +990,18 @@ subroutine setparameter_string(param, val, err) integer :: i error = 0 - setparameter_was_called = .true. + setparameter_tree_was_called = .true. + setparameter_loop_was_called = .true. - if (verbose > 3) then - print *, "[OpenLoops] setparameter_string: " // trim(param) // " " // trim(val) - end if + call ol_msg(4, "setparameter_string: " // trim(param) // " " // trim(val)) if (len(val) > max_parameter_length) then - print *, "[OpenLoops] ol_setparameter_string: " // trim(param) // " value must not exceed " // & - & trim(to_string(max_parameter_length)) // " characters" - stop + call ol_fatal("ol_setparameter_string: " // trim(param) // " value must not exceed " // & + & trim(to_string(max_parameter_length)) // " characters") + return end if - select case (trim(param)) + select case (to_lowercase(param)) case ("install_path") install_path = val @@ -914,17 +1014,17 @@ subroutine setparameter_string(param, val, err) tmp_dir = val case ("samurai_imeth") if (len(val) > 4) then - print *, "[OpenLoops] ol_setparameter_string: " // trim(param) // " value must not exceed 4 characters" - stop + call ol_fatal("ol_setparameter_string: " // trim(param) // " value must not exceed 4 characters") + return end if if (set_imeth /= val) samurai_not_init = .true. set_imeth = val case ("allowed_libs", "allowed_libraries", "allowedlibs", "allowedlibraries") if (len(val) > max_parameter_length-2) then ! needs a leading and a trailing space - print *, "[OpenLoops] ol_setparameter_string: " // trim(param) // " value must not exceed " // & - & trim(to_string(max_parameter_length-2)) // " characters" - stop + call ol_fatal("ol_setparameter_string: " // trim(param) // " value must not exceed " // & + & trim(to_string(max_parameter_length-2)) // " characters") + return end if allowed_libs = val do i = 1, max_parameter_length @@ -941,18 +1041,26 @@ subroutine setparameter_string(param, val, err) write_shopping_list = .true. case ("model") if (to_lowercase(trim(val)) == "sm" & - .or. to_lowercase(trim(val)) == "sm_vaux" & + .or. to_lowercase(trim(val)) == "smdiag" & .or. to_lowercase(trim(val)) == "sm_yuksel") then - model = to_lowercase(trim(val)) + model = "sm" call set_if_modified(nf, 6) + else if (to_lowercase(trim(val)) == "sm_vaux" ) then + model = to_lowercase(trim(val)) + call set_if_modified(nf, 6) + call set_if_modified(cms_on, 0) else if (to_lowercase(trim(val)) == "heft" .or. to_lowercase(trim(val)) == "sm+ehc") then model = "heft" call set_if_modified(nf, 5) + else if (to_lowercase(trim(val)) == "2hdm" .or. to_lowercase(trim(val)) == "thdm") then + model = "2hdm" + call set_if_modified(nf, 6) else - print *, "[OpenLoops] unknown model: " // trim(val) // ", model set to: " // trim(model) - error = 1 + call ol_error(1, "unknown model: " // trim(val) // ", model set to: " // trim(model)) end if + + case default error = 1 @@ -965,7 +1073,7 @@ subroutine setparameter_string(param, val, err) error = 1 end if if (error == 1 .and. init_error_fatal == 1) then - write(*,*) "[OpenLoops] ol_setparameter_string ignored unknown parameter '" // trim(param) // "'" + call ol_error(1,"ol_setparameter_string ignored unknown parameter '" // trim(param) // "'") end if end select @@ -974,8 +1082,8 @@ subroutine setparameter_string(param, val, err) err = error else if (init_error_fatal == 2 .and. error /= 0) then - write(*,*) "[OpenLoops] error: unknown parameter '" // trim(param) // "' in ol_setparameter_string" - stop + call ol_fatal("unknown parameter '" // trim(param) // "' in ol_setparameter_string") + return end if end if end subroutine setparameter_string @@ -983,18 +1091,27 @@ end subroutine setparameter_string subroutine parameters_flush() bind(c,name="ol_parameters_flush") - use ol_parameters_decl_/**/DREALKIND, only: parameters_changed use ol_parameters_init_/**/DREALKIND, only: parameters_init, loop_parameters_init implicit none - if (setparameter_was_called) then + if (setparameter_loop_was_called) then call parameters_init() call loop_parameters_init() - setparameter_was_called = .false. - parameters_changed = 0 + setparameter_tree_was_called = .false. + setparameter_loop_was_called = .false. end if end subroutine parameters_flush + subroutine tree_parameters_flush() bind(c,name="ol_tree_parameters_flush") + use ol_parameters_init_/**/DREALKIND, only: parameters_init + implicit none + if (setparameter_tree_was_called) then + call parameters_init() + setparameter_tree_was_called = .false. + end if + end subroutine tree_parameters_flush + + subroutine register_cleanup(sub) implicit none procedure() :: sub diff --git a/lib_src/openloops/src/kinematics.F90 b/lib_src/openloops/src/kinematics.F90 index 1b3482bc..1465e43b 100644 --- a/lib_src/openloops/src/kinematics.F90 +++ b/lib_src/openloops/src/kinematics.F90 @@ -128,6 +128,8 @@ subroutine rambo(sqrt_s, m_ex, p_rambo) ! ********************************************************************* use KIND_TYPES, only: REALKIND use ol_external_decl_/**/DREALKIND, only: n_scatt + use ol_generic, only: to_string + use ol_debug, only: ol_fatal implicit none real(REALKIND), intent(in) :: sqrt_s, m_ex(:) real(REALKIND), intent(out) :: p_rambo(0:3,size(m_ex)) @@ -137,13 +139,93 @@ subroutine rambo(sqrt_s, m_ex, p_rambo) else if (n_scatt == 1) then call rambo_decay(sqrt_s, m_ex, p_rambo) else - print*, "[OpenLoops] ERROR: Phase-space not available for scattering of: ", n_scatt , " -> ", size(m_ex)-n_scatt - stop + call ol_fatal("phase-space not available for scattering of: " // to_string(n_scatt) // & + & " -> " // to_string(size(m_ex)-n_scatt)) end if end subroutine rambo +subroutine rand_sphere(r, v) + ! Random point, uniformly distributed on the surface of a sphere with radius r: + ! z/r in [-1,1], phi in [0,2*pi), + ! x=sqrt(r^2-z^2)*cos(phi), y=sqrt(r^2-z^2)*sin(phi) + use ol_parameters_decl_/**/REALKIND, only: pi + use ol_ramboX, only: rans + implicit none + real(REALKIND), intent(in) :: r + real(REALKIND), intent(out) :: v(3) + real(REALKIND) :: u, phi, rho + call rans(u) + v(3) = r*(2*u-1) + rho = sqrt(r**2-v(3)**2) + call rans(phi) + phi = 2*pi*phi + v(1) = rho*cos(phi) + v(2) = rho*sin(phi) +end subroutine rand_sphere + + +subroutine decay3(E_in, m, psp) + ! Random phase space point for a 1->2 decay with energy E_in. + ! Set up the decay in the centre of mass system, then apply a Lorentz boost. + ! Note that the points won't be uniformly distributed if E_in /= m(1). + use ol_parameters_decl_/**/REALKIND, only: psp_tolerance + use ol_debug, only: ol_error, ol_msg, ol_fatal + implicit none + real(REALKIND), intent(in) :: E_in, m(3) + real(REALKIND), intent(out) :: psp(0:3,3) + real(REALKIND) :: E1, m12, m22, m32, E2a, E3a, p1_abs, p2a_abs, p2a(3), gamma, beta(3), beta_p2a + if (m(1) <= m(2) + m(3)) then + call ol_error(2,"3-particle interaction:") + call ol_msg("mass condition m1+m2>m3 (production) or m1>m2+m3 (decay) not satisfied.") + call ol_fatal() + end if + if (abs(E_in/m(1)-1) < psp_tolerance) then + E1 = m(1) + else if (E_in < m(1)) then + call ol_fatal("3-particle interaction energy too low.") + else + E1 = E_in + end if + m12 = m(1)**2 + m22 = m(2)**2 + m32 = m(3)**2 + ! centre of mass system: (m1,0) = (E2,p2a) + (E3,-p2a) + E2a = (m12 + m22 - m32)/(2*m(1)) + E3a = (m12 - m22 + m32)/(2*m(1)) +! p2a_abs = sqrt((m12**2 + m22**2 + m32**2 - 2*m12*m22 - 2*m12*m32 - 2*m22*m32)/(4*m12)) + p2a_abs = sqrt(E2a**2-m22) + call rand_sphere(p2a_abs, p2a) + ! Lorentz boost (E',p') = L.(E,p) such that L.(m1,0) = (sqrt,p1) + ! L_00 = gamma, L_0i = L_i0 = -gamma*beta_i, L_ij = delta_ij + (gamma-1)*beta_i*beta_j/beta^2 + ! E' = gamma*(E-beta.p) + ! p' = p + ((gamma-1)*beta.p/beta^2 - E*gamma)*beta + ! p1 and boost parameters + if (E1 == m(1)) then + psp(0,1) = m(1) + psp(1:3,1) = 0 + psp(0,2) = E2a + psp(0,3) = E3a + psp(1:3,2) = p2a + psp(1:3,3) = -p2a + else + p1_abs = sqrt(E1**2-m12) + psp(0,1) = E1 + call rand_sphere(p1_abs, psp(1:3,1)) + gamma = E1/m(1) + beta = -psp(1:3,1)/E1 + ! p2 and p3 + beta_p2a = sum(beta*p2a) + psp(0,2) = gamma*(E2a-beta_p2a) + psp(0,3) = gamma*(E3a+beta_p2a) + p2a = p2a + ((gamma-1)*beta_p2a/sum(beta**2)) * beta + psp(1:3,2) = p2a - (gamma*E2a)*beta + psp(1:3,3) = -p2a - (gamma*E3a)*beta + end if +end subroutine decay3 + + ! ********************************************************************* subroutine rambo_2scatt(sqrt_s, m_ex, p_rambo) ! ********************************************************************* @@ -160,6 +242,7 @@ subroutine rambo_2scatt(sqrt_s, m_ex, p_rambo) ! kA + kB = 0 ! ********************************************************************* use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_fatal use ol_ramboX, only: rambo0 => rambo implicit none real(REALKIND), intent(in) :: sqrt_s, m_ex(:) @@ -168,33 +251,45 @@ subroutine rambo_2scatt(sqrt_s, m_ex, p_rambo) real(REALKIND) :: p_scatt(4,size(m_ex)-2), wgt integer :: n n = size(m_ex) - E = sqrt_s*0.5_/**/REALKIND - ! beam momenta - if((m_ex(1) == 0) .and. (m_ex(2) == 0)) then - p_rambo(0,1) = E - p_rambo(1,1) = 0 - p_rambo(2,1) = 0 - p_rambo(3,1) = E - p_rambo(0,2) = E - p_rambo(1,2) = 0 - p_rambo(2,2) = 0 - p_rambo(3,2) = -E + if (n >= 4) then + E = sqrt_s*0.5_/**/REALKIND + ! beam momenta + if((m_ex(1) == 0) .and. (m_ex(2) == 0)) then + p_rambo(0,1) = E + p_rambo(1,1) = 0 + p_rambo(2,1) = 0 + p_rambo(3,1) = E + p_rambo(0,2) = E + p_rambo(1,2) = 0 + p_rambo(2,2) = 0 + p_rambo(3,2) = -E + else + MA2 = m_ex(1)*m_ex(1) + MB2 = m_ex(2)*m_ex(2) + dEAB = (MA2 - MB2) / (2*sqrt_s) + p_rambo(0,1) = E + dEAB + p_rambo(1,1) = 0 + p_rambo(2,1) = 0 + p_rambo(3,1) = sqrt(p_rambo(0,1)**2-MA2) + p_rambo(0,2) = E - dEAB + p_rambo(1,2) = 0 + p_rambo(2,2) = 0 + p_rambo(3,2) = -p_rambo(3,1) + end if + call rambo0(n-2, sqrt_s, m_ex(3:n), p_scatt, wgt) + p_rambo( 0,3:n) = p_scatt( 4,1:n-2) + p_rambo(1:3,3:n) = p_scatt(1:3,1:n-2) + else if (n == 3) then + ! reverse 1->2 decay + call decay3(sqrt_s, [m_ex(3),m_ex(1),m_ex(2)], p_rambo) + p_scatt(:,1) = p_rambo(:,1) + p_rambo(:,1) = p_rambo(:,2) + p_rambo(:,2) = p_rambo(:,3) + p_rambo(:,3) = p_scatt(:,1) else - MA2 = m_ex(1)*m_ex(1) - MB2 = m_ex(2)*m_ex(2) - dEAB = (MA2 - MB2) / (2*sqrt_s) - p_rambo(0,1) = E + dEAB - p_rambo(1,1) = 0 - p_rambo(2,1) = 0 - p_rambo(3,1) = sqrt(p_rambo(0,1)**2-MA2) - p_rambo(0,2) = E - dEAB - p_rambo(1,2) = 0 - p_rambo(2,2) = 0 - p_rambo(3,2) = -p_rambo(3,1) + call ol_fatal("2->0 scattering not possible -- use decay instead.") end if - call rambo0(n-2, sqrt_s, m_ex(3:n), p_scatt, wgt) - p_rambo( 0,3:n) = p_scatt( 4,1:n-2) - p_rambo(1:3,3:n) = p_scatt(1:3,1:n-2) + end subroutine rambo_2scatt @@ -209,24 +304,40 @@ subroutine rambo_decay(sqrt_s, m_ex, p_rambo) ! p_rambo(0:3,n) = momenta, n = 2,..,n outgoing ! ********************************************************************* use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_fatal, ol_msg + use ol_parameters_decl_/**/REALKIND, only: psp_tolerance use ol_ramboX, only: rambo0 => rambo implicit none real(REALKIND), intent(in) :: sqrt_s, m_ex(:) real(REALKIND), intent(out) :: p_rambo(0:3,size(m_ex)) - real(REALKIND) :: p_scatt(4,size(m_ex)-1), wgt + real(REALKIND) :: p_scatt(4,size(m_ex)-1), wgt, p1 integer :: n, k n = size(m_ex) - if( m_ex(1) == 0 ) then - print*, "[OpenLoops] Warning: decay of massless particle!" + if (sqrt_s < m_ex(1)) then + call ol_fatal("energy in decay lower than mass.") + end if + if (n >= 3) then + if( m_ex(1) == 0 ) then + call ol_msg("Warning: decay of massless particle!") + else + p_rambo(0,1) = sqrt_s + p_rambo(1,1) = 0 + p_rambo(2,1) = 0 + p_rambo(3,1) = 0 + end if + call rambo0(n-1, sqrt_s, m_ex(2:n), p_scatt, wgt) + p_rambo( 0,2:n) = p_scatt( 4,1:n-1) + p_rambo(1:3,2:n) = p_scatt(1:3,1:n-1) else - p_rambo(0,1) = sqrt_s - p_rambo(1,1) = 0 - p_rambo(2,1) = 0 - p_rambo(3,1) = 0 + ! particle with energy sqrt_s coming from a random direction + if (abs(m_ex(1)-m_ex(2))/sqrt_s > psp_tolerance) then + call ol_fatal("two particle processes require external particles with equal mass.") + end if + p1 = sqrt(sqrt_s**2-m_ex(1)**2) + p_rambo(0,1) = sqrt_s + call rand_sphere(p1, p_rambo(1:3,1)) + p_rambo(:,2) = p_rambo(:,1) end if - call rambo0(n-1, sqrt_s, m_ex(2:n), p_scatt, wgt) - p_rambo( 0,2:n) = p_scatt( 4,1:n-1) - p_rambo(1:3,2:n) = p_scatt(1:3,1:n-1) end subroutine rambo_decay @@ -250,24 +361,24 @@ end subroutine rambo_c subroutine rambo(sqrt_s, m_ex, p_rambo) use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_fatal implicit none real(REALKIND), intent(in) :: sqrt_s, m_ex(:) real(REALKIND), intent(out) :: p_rambo(0:3,size(m_ex)) p_rambo = 0 ! prevent compiler warning - write(*,*) '[OpenLoops] ERROR: Rambo is not available.' - stop + call ol_fatal('Rambo is not available.') end subroutine rambo subroutine rambo_c(sqrt_s, m_ex, n, p_rambo) bind(c,name="ol_rambo") use KIND_TYPES, only: REALKIND + use ol_debug, ol_fatal use, intrinsic :: iso_c_binding, only: c_double, c_int implicit none integer(c_int), intent(in) :: n real(c_double), intent(out) :: p_rambo(0:3,n) real(c_double), intent(in) :: sqrt_s, m_ex(n) p_rambo = 0 ! prevent compiler warning - write(*,*) '[OpenLoops] ERROR: Rambo is not available.' - stop + call ol_fatal('Rambo is not available.') end subroutine rambo_c ! #ifdef USE_RAMBO @@ -288,6 +399,8 @@ subroutine clean_mom_in(P_in, m_ext2, P, n) ! so that energy conservation is fulfilled up to terms of O(eps^3) ! ********************************************************************** use KIND_TYPES, only: REALKIND, DREALKIND + use ol_debug, only: ol_msg + use ol_generic, only: to_string use ol_parameters_decl_/**/REALKIND, only: psp_tolerance implicit none real(DREALKIND), intent(in) :: P_in(0:3,n) @@ -317,10 +430,10 @@ subroutine clean_mom_in(P_in, m_ext2, P, n) do i = 0, 3 prec = abs(sum(P(i,:)))/E_ref if (prec > psp_tolerance) then - write(*,*) "[OpenLoops] === WARNING ===" - write(*,*) "[OpenLoops] OpenLoops subroutine clean_mom: inconsistent phase space point." - write(*,*) "[OpenLoops] Momentum conservation is only satisfied to", -log10(prec), "digits." - write(*,*) "[OpenLoops] ===============" + call ol_msg("=== WARNING ===") + call ol_msg("OpenLoops subroutine clean_mom: inconsistent phase space point.") + call ol_msg("Momentum conservation is only satisfied to " // to_string(-log10(prec)) // "digits.") + call ol_msg("===============") end if end do @@ -330,10 +443,10 @@ subroutine clean_mom_in(P_in, m_ext2, P, n) P0(nex) = sign(sqrt(P2(nex) + m_ext2(nex)), P(0,nex)) prec = abs(P(0,nex)-P0(nex))/E_ref if(prec > psp_tolerance) then - write(*,*) "[OpenLoops] === WARNING ===" - write(*,*) "[OpenLoops] OpenLoops subroutine clean_mom: inconsistent phase space point." - write(*,*) "[OpenLoops] On-shell condition is only satisfied to", -log10(prec), "digits." - write(*,*) "[OpenLoops] ===============" + call ol_msg("=== WARNING ===") + call ol_msg("OpenLoops subroutine clean_mom: inconsistent phase space point.") + call ol_msg("On-shell condition is only satisfied to " // to_string(-log10(prec)) // "digits.") + call ol_msg("===============") end if end do @@ -458,12 +571,12 @@ end subroutine dirty_mom #else subroutine dirty_mom(P_in,P, n, DIG) use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_fatal implicit none integer, intent(in) :: n, DIG real(REALKIND), intent(in) :: P_in(0:3,n) real(REALKIND), intent(out) :: P(0:3,n) - write(*,*) '[OpenLoops] ERROR: dirty_mom() requires Rambo.' - stop + call ol_fatal('dirty_mom() requires Rambo.') end subroutine dirty_mom ! #ifdef USE_RAMBO #endif @@ -756,13 +869,15 @@ function momenta_invariants(moms) result(invs) ! as used by Collier. Apply 'squeeze_onshell' to each invariant with the masses in the theory. ! ********************************************************************** use KIND_TYPES, only: REALKIND + use ol_parameters_decl_/**/DREALKIND, only: model use ol_parameters_decl_/**/REALKIND, only: & - & wMW, rMW, wMZ, rMZ, wMH, rMH, wMC, rMC, wMB, rMB, wMT, rMT + & wMW, rMW, wMZ, rMZ, wMH, rMH, wMC, rMC, wMB, rMB, wMT, rMT, & + & wMA0, rMA0, wMHH, rMHH, wMHp, rMHp implicit none complex(REALKIND), intent(in) :: moms(:,:) complex(REALKIND) :: invs(binom2(size(moms,2)+1)) complex(REALKIND) :: moms0(0:3,0:size(moms,2)) - real(REALKIND) :: masses(0:6) + real(REALKIND) :: masses(0:9) integer :: n, k, a, b n = size(moms,2) + 1 moms0(:,0) = 0 @@ -785,14 +900,21 @@ function momenta_invariants(moms) result(invs) end do #endif masses = 0 + n = 6 if (wMW == 0) masses(1) = rMW if (wMZ == 0) masses(2) = rMZ if (wMH == 0) masses(3) = rMH if (wMC == 0 .and. rMC /= 0) masses(4) = rMC if (wMB == 0 .and. rMB /= 0) masses(5) = rMB if (wMT == 0) masses(6) = rMT + if (trim(model) == "2hdm") then + n = 9 + if (wMA0 == 0) masses(7) = rMA0 + if (wMHH == 0) masses(8) = rMHH + if (wMHp == 0) masses(9) = rMHp + end if do k = 1, size(invs) - invs(k) = squeeze_onshell(invs(k), masses) + invs(k) = squeeze_onshell(invs(k), masses(0:n)) end do end function momenta_invariants diff --git a/lib_src/openloops/src/looproutines.F90 b/lib_src/openloops/src/looproutines.F90 index 2ac5ccd9..74088fa6 100644 --- a/lib_src/openloops/src/looproutines.F90 +++ b/lib_src/openloops/src/looproutines.F90 @@ -18,6 +18,7 @@ module ol_loop_routines_/**/REALKIND + use ol_debug, only: ol_fatal, ol_msg, ol_error implicit none contains @@ -25,6 +26,8 @@ module ol_loop_routines_/**/REALKIND subroutine tensor_integral(rank, momenta, masses_2, TI) ! **************************************************** use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_error, ol_msg + use ol_generic, only: to_string #ifdef USE_COLLIER use ol_parameters_decl_/**/DREALKIND, only: current_processname use ol_loop_parameters_decl_/**/DREALKIND, only: tensor_reduction_error @@ -70,19 +73,19 @@ subroutine tensor_integral(rank, momenta, masses_2, TI) ! Error handling should be in a separate routine which handles errors from all reduction libraries. ! Call might be moved to the process code. if (tensor_reduction_error > 0) then - write(*,*) "[OpenLoops] === TENSOR INTEGRAL REDUCTION ERROR ===" + call ol_error("=== TENSOR INTEGRAL REDUCTION ERROR ===") if (TI_library == 1) then - write(*,*) "[OpenLoops] library: Coli" + call ol_msg(1,"library: Coli") else if (TI_library == 2) then - write(*,*) "[OpenLoops] library: DD" + call ol_msg(1,"library: DD") end if - write(*,*) "[OpenLoops] process: ", current_processname - write(*,*) "[OpenLoops] phase space point:" + call ol_msg(1,"process: " // current_processname ) + call ol_msg(1,"phase space point:") do l = 1, nParticles - write(*,*) P_ex(:,l) + print*, P_ex(:,l) crossing(inverse_crossing(l)) = l end do - write(*,*) "[OpenLoops] crossing:", crossing(1:nParticles) + call ol_msg(1,"crossing:" // to_string(crossing(1:nParticles))) T2dim = 0 end if @@ -103,8 +106,7 @@ subroutine tensor_integral(rank, momenta, masses_2, TI) call lorentz2lc_tensor(rank, T_Lor, TI) #else TI = 0 ! prevent compiler warning - print *, '[OpenLoops] ERROR in tensor_integral: Collier is not available' - stop + call ol_fatal('in tensor_integral: Collier is not available') #endif end subroutine tensor_integral @@ -158,8 +160,7 @@ subroutine scalar_integral(momenta, masses_2) #endif #else - print *, '[OpenLoops] ERROR in scalar_integral: Collier is not available' - stop + call ol_fatal('in scalar_integral: Collier is not available') #endif end subroutine scalar_integral @@ -194,8 +195,7 @@ subroutine covariant_coefficients(rank, momenta, masses_2) deallocate(Coefs) #else - print *, '[OpenLoops] ERROR in covariant_coefficients: Collier (legacy) is not available' - stop + call ol_fatal('in covariant_coefficients: Collier (legacy) is not available') #endif end subroutine covariant_coefficients @@ -251,6 +251,7 @@ subroutine TI_call(rank, momenta, masses_2, Gsum, M2) ! *************************************************** use KIND_TYPES, only: REALKIND use ol_parameters_decl_/**/DREALKIND, only: a_switch + use ol_generic, only: to_string implicit none integer, intent(in) :: rank complex(REALKIND), intent(in) :: momenta(:,:), masses_2(:), Gsum(:) @@ -279,8 +280,7 @@ subroutine TI_call(rank, momenta, masses_2, Gsum, M2) ! Samurai call samurai_interface(rank, momenta, masses_2, Gsum, M2add) else - write(*,*) '[OpenLoops] ERROR in TI_call: amp_switch out of range: ', a_switch - stop + call ol_fatal('in TI_call: amp_switch out of range: ' // to_string(a_switch)) end if M2 = M2 + real(M2add) end subroutine TI_call @@ -294,7 +294,9 @@ function TI2_call(rank, momenta, masses_2, Gsum, TI) ! Returns the contribution to the amplitude ! **************************************************** use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_fatal, ol_msg, ol_error use ol_parameters_decl_/**/DREALKIND, only: a_switch + use ol_generic, only: to_string implicit none integer, intent(in) :: rank complex(REALKIND), intent(in) :: momenta(:,:), masses_2(:), Gsum(:), TI(:) @@ -314,9 +316,9 @@ function TI2_call(rank, momenta, masses_2, Gsum, TI) ! Samurai call samurai_interface(rank, momenta, masses_2, Gsum, TI2_call) else - write(*,*) '[OpenLoops] ERROR in TI2_call: amp_switch out of range: ', a_switch - write(*,*) '[OpenLoops] note that modes 2 and 3 are not supported in loop^2.' - stop + call ol_error(2, 'in TI2_call: amp_switch out of range: ' // to_string(a_switch)) + call ol_msg('note that modes 2 and 3 are not supported in loop^2.') + call ol_fatal() end if end function TI2_call @@ -477,10 +479,7 @@ subroutine cuttools_interface(rank, momenta, masses2, Gtensor, M2) logical :: cts_stable if (de1_UV /= de1_IR) then - write(*,*) '[OpenLoops] === ERROR ===' - write(*,*) '[OpenLoops] pole1_UV != pole1_IR is not allowed with CutTools.' - write(*,*) '[OpenLoops] =============' - stop + call ol_fatal('pole1_UV != pole1_IR is not allowed with CutTools.') end if tensor_stored(:size(Gtensor)) = Gtensor @@ -506,8 +505,7 @@ subroutine cuttools_interface(rank, momenta, masses2, Gtensor, M2) M2 = cts_amp_array(0) + cts_amp_array(1)*de1_IR + cts_amp_array(2)*de2_i_IR #else M2 = 0 ! prevent compiler warning - print *, '[OpenLoops] ERROR in cuttools_interface: CutTools is not available' - stop + call ol_fatal('cuttools_interface: CutTools is not available') ! #ifdef USE_CUTTOOLS #endif end subroutine cuttools_interface @@ -536,10 +534,7 @@ subroutine samurai_interface(rank, momenta, masses2, Gtensor, M2) logical :: sam_test if (de1_UV /= de1_IR) then - write(*,*) '[OpenLoops] === ERROR ===' - write(*,*) '[OpenLoops] pole1_UV != pole1_IR is not allowed with Samurai.' - write(*,*) '[OpenLoops] ========' - stop + call ol_fatal('pole1_UV != pole1_IR is not allowed with Samurai.') end if tensor_stored(:size(Gtensor)) = Gtensor @@ -562,12 +557,10 @@ subroutine samurai_interface(rank, momenta, masses2, Gtensor, M2) #endif #ifdef USE_SAMURAI #ifndef PRECISION_dp - print *, '[OpenLoops] ERROR in samurai_interface: Samurai only supports double precision' - stop + call ol_fatal('in samurai_interface: Samurai only supports double precision') #endif #else - print *, '[OpenLoops] ERROR in samurai_interface: Samurai is not available' - stop + call ol_fatal('in samurai_interface: Samurai is not available') #endif end subroutine samurai_interface diff --git a/lib_src/openloops/src/ol_interface.F90 b/lib_src/openloops/src/ol_interface.F90 index e3de9d46..b925126c 100644 --- a/lib_src/openloops/src/ol_interface.F90 +++ b/lib_src/openloops/src/ol_interface.F90 @@ -21,16 +21,18 @@ module openloops use KIND_TYPES, only: DREALKIND use ol_global_decl, only: MaxParticles use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr, c_char, c_int, c_double, c_null_char - use ol_init, only: set_init_error_fatal, get_error, & - & set_parameter, get_parameter, parameters_flush, cleanup + use ol_init, only: set_init_error_fatal, set_parameter, get_parameter, parameters_flush, & + & tree_parameters_flush, cleanup use ol_version, only: welcome - use ol_parameters_decl_/**/DREALKIND, only: procname_length, max_parameter_length, verbose + use ol_parameters_decl_/**/DREALKIND, only: procname_length, max_parameter_length use ol_external_decl_/**/DREALKIND, only: n_scatt + use ol_debug, only: get_error, ol_msg, ol_error, ol_fatal, error + use ol_parameters_init_/**/DREALKIND, only: parameters_write implicit none private ! from module init_iu public :: set_init_error_fatal, get_error - public :: set_parameter, get_parameter, parameters_flush + public :: set_parameter, get_parameter, parameters_flush, tree_parameters_flush ! from module use ol_version public :: welcome ! process interface @@ -38,6 +40,8 @@ module openloops public :: register_process, register_process_id public :: evaluate_tree, evaluate_tree_colvect, evaluate_cc, evaluate_ccmatrix, evaluate_sc, evaluate_scpowheg public :: evaluate_full, evaluate_loop, evaluate_loop2, evaluate_ct, evaluate_pt + ! Print parameters + public :: ol_printparameter ! used in BLHA interface public :: rval_size, stop_invalid_id @@ -51,13 +55,19 @@ module openloops integer :: tensor_rank = -1 ! allocatable length character members are not supported in gfortran (tested with 4.8.1) character(len=procname_length) :: process_name - character(len=procname_length) :: library_name + character(len=max_parameter_length) :: library_name integer, allocatable :: permutation(:) + integer, allocatable :: pol(:) type(c_ptr) :: library_handle = c_null_ptr integer :: amplitude_type ! 1=Tree, 2=ccTree, 3=scTree, 4=scTree_polvect, 11=Loop, 12=LoopInduced integer :: content = 0 ! bitwise: 2^0=tree, 2^1=loop, 2^2=loop2, 2^3=pt + logical :: has_pol = .false. ! true if library supports polarization integer :: n_in = 2 ! Phase-space for n_in -> n-n_in + integer :: associated_ew = 0 + integer :: associated_born = 0 + real(DREALKIND), allocatable :: masses(:) procedure(), pointer, nopass :: set_permutation => null() + procedure(), pointer, nopass :: pol_init => null() procedure(), pointer, nopass :: tree => null() procedure(), pointer, nopass :: loop => null() procedure(), pointer, nopass :: ct => null() @@ -73,13 +83,13 @@ module openloops type(process_handle), save, allocatable :: process_handles(:) type processinfos - integer :: ID integer :: EWorder(0:1) integer :: QCDorder(0:1) integer :: LeadingColour integer :: NF integer :: NC integer :: CKMORDER + integer :: POLSEL character :: ME, MM, ML, MU, MD, MS, MC, MB integer :: YE, YM, YL, YU, YD, YS, YC, YB, YT character :: CC @@ -89,12 +99,19 @@ module openloops character(len=127) :: MAP character(len=127) :: MAPPERM character(len=127) :: APPROX + character(len=4) :: ID character(len=4) :: TYPE character(len=4) :: LTYPE end type processinfos type(processinfos), save, allocatable :: process_infos(:) type(processinfos), save, allocatable :: loaded_libs(:) + type extparticle + integer :: id + integer :: pol + logical :: is_initial + end type extparticle + ! array for shopping list character(len=max_parameter_length), save, allocatable :: shopped_processes(:) logical, save :: shopping_list_open = .false. @@ -106,6 +123,7 @@ module openloops character(len=2), parameter :: dynlib_extension='so' #endif + character(len=4) :: loops_flags = "tlsp" ! used in this order to set content bits contains @@ -128,11 +146,14 @@ pure function rval_size(n_part, amp_type) rval_size = n_part case (0) rval_size = 0 + case default + ! unknown amp_type + rval_size = 0 end select end function rval_size - function get_process_handle(lib, libname, proc, perm, content, amptype, n_in) + function get_process_handle(lib, libname, proc, content, amptype, n_in, perm, pol) ! [in] lib: a shared library handle ! [in] proc: a full process name, '__' ! [in] perm: integer array with the crossing @@ -140,19 +161,34 @@ function get_process_handle(lib, libname, proc, perm, content, amptype, n_in) ! [in] amptype: integer to specify BLHA matrix element type ! return process handle of type process_handle ! note: error handling is done in dlsym + use KIND_TYPES, only: DREALKIND use ol_dlfcn, only: dlsym implicit none type(c_ptr), intent(in) :: lib character(len=*), intent(in) :: libname character(len=*), intent(in) :: proc - integer, intent(in) :: perm(:), content, amptype, n_in + integer, intent(in) :: content, amptype, n_in + integer, intent(in), optional :: perm(:) + integer, intent(in), optional :: pol(:) type(process_handle) :: get_process_handle - real(DREALKIND) :: masses(MaxParticles) + integer :: k procedure(), pointer :: tmp_fun + ! number of external particles + tmp_fun => dlsym(lib, "ol_f_n_external_" // trim(proc)) + call tmp_fun(get_process_handle%n_particles) get_process_handle%library_name = trim(libname) get_process_handle%process_name = trim(proc) - allocate(get_process_handle%permutation(size(perm))) - get_process_handle%permutation = perm + allocate(get_process_handle%permutation(get_process_handle%n_particles)) + if (present(perm)) then + ! check correct size of the permutation + if (get_process_handle%n_particles /= size(perm)) then + call ol_fatal('error: registered process with wrong size of particle permutation') + return + end if + get_process_handle%permutation = perm + else + get_process_handle%permutation = [(k, k=1, get_process_handle%n_particles)] + end if get_process_handle%library_handle = lib get_process_handle%set_permutation => dlsym(lib, "ol_f_set_permutation_" // trim(proc)) get_process_handle%rambo => dlsym(lib, "ol_f_rambo_" // trim(proc)) @@ -163,20 +199,30 @@ function get_process_handle(lib, libname, proc, perm, content, amptype, n_in) get_process_handle%pt => dlsym(lib, "ol_f_ptamp2_" // trim(proc)) get_process_handle%content = content get_process_handle%n_in = n_in - ! number of external particles and highest tensor rank - tmp_fun => dlsym(lib, "ol_f_n_external_" // trim(proc)) - call tmp_fun(get_process_handle%n_particles) + ! external masses and highest tensor rank + tmp_fun => dlsym(lib, "ol_f_get_masses_" // trim(proc)) + allocate(get_process_handle%masses(get_process_handle%n_particles)) + call tmp_fun(get_process_handle%masses) + allocate(get_process_handle%pol(get_process_handle%n_particles)) + if (present(pol)) then + ! check correct size of the polarization vector + if (get_process_handle%n_particles /= size(pol)) then + call ol_fatal('error: registered process with wrong size of polarization vector') + return + end if + get_process_handle%has_pol = .true. + get_process_handle%pol = pol + get_process_handle%pol_init => dlsym(lib, "ol_f_pol_init_" // trim(proc)) + else + get_process_handle%has_pol = .false. + get_process_handle%pol = 0 + end if if (btest(content, 1)) then tmp_fun => dlsym(lib, "ol_f_max_point_" // trim(proc)) call tmp_fun(get_process_handle%max_point) tmp_fun => dlsym(lib, "ol_f_tensor_rank_" // trim(proc)) call tmp_fun(get_process_handle%tensor_rank) end if - ! check correct size of the permutation - if (get_process_handle%n_particles /= size(perm)) then - write(*,*) '[OpenLoops] error: registered process with wrong size of particle permutation' - stop - end if ! colour basis get_process_handle%tree_colbasis_dim => dlsym(lib, "ol_tree_colbasis_dim_" // trim(proc)) get_process_handle%tree_colbasis => dlsym(lib, "ol_tree_colbasis_" // trim(proc)) @@ -184,32 +230,49 @@ function get_process_handle(lib, libname, proc, perm, content, amptype, n_in) end function get_process_handle - function register_process_lib(libname, proc, perm, content, amptype, n_in) + function register_process_lib(libname, proc, content, amptype, n_in, pol, perm) ! [in] libname: name of the process library ! [in] proc: a full process name, '__' ! [in] perm: integer array with the crossing ! [in] content: integer with binary tags for tree, loop, loop2, pt ! [in] amptype: integer to specify BLHA matrix element type ! return (integer) process id to be used in OLP_EvalSubProcess + use KIND_TYPES, only: DREALKIND use ol_dlfcn, only: dlopen, RTLD_LAZY use ol_loop_parameters_decl_/**/DREALKIND, only: maxpoint, maxrank implicit none character(len=*), intent(in) :: libname character(len=*), intent(in) :: proc - integer, intent(in) :: perm(:), content, amptype, n_in + integer, intent(in) :: content, amptype, n_in + integer, intent(in), optional :: pol(:) + integer, intent(in), optional :: perm(:) type(c_ptr) :: lib + logical :: same_perm, same_pol integer :: register_process_lib - integer :: k + integer :: j, k type(process_handle) :: prochandle type(process_handle), allocatable :: process_handles_bak(:) lib = dlopen(libname, RTLD_LAZY, 2) - prochandle = get_process_handle(lib, libname, proc, perm, content, amptype, n_in) - ! Check if the process was registered before with the same permutation and amptype. + prochandle = get_process_handle(lib, libname, proc, content, amptype, n_in, perm=perm, pol=pol) + if (error > 1) return + ! Check if the process was registered before with the same permutation, polarization and amptype. ! If yes, return the previously assigned id do k = 1, last_process_id + if (present(perm)) then + same_perm = all(perm == process_handles(k)%permutation) + else + ! perm not present means 1,2,..,n + same_perm = all(process_handles(k)%permutation == [(j, j=1, process_handles(k)%n_particles)]) + end if + if (present(pol)) then + same_pol = all(pol == process_handles(k)%pol) + else + same_pol = all(process_handles(k)%pol == 0) + end if if ((trim(proc) == trim(process_handles(k)%process_name)) .and. & & (trim(libname) == trim(process_handles(k)%library_name)) .and. & - & all(perm == process_handles(k)%permutation) .and. & + & same_perm .and. & + & same_pol .and. & & (amptype == process_handles(k)%amplitude_type) ) then register_process_lib = k return @@ -249,6 +312,7 @@ subroutine unregister_processes() process_handles(id)%n_particles = 0 process_handles(id)%content = 0 deallocate(process_handles(id)%permutation) + deallocate(process_handles(id)%masses) process_handles(id)%library_handle = c_null_ptr process_handles(id)%set_permutation => null() process_handles(id)%tree => null() @@ -261,231 +325,189 @@ subroutine unregister_processes() end subroutine unregister_processes - function register_process_string(process, amptype) + function register_process_string(process_in, amptype) ! process: string with format 2->n-2 ! amptype: integer 1,2,3,4,11,12 ! return (integer) process id to be used in evaluate_process - use ol_generic, only: to_int + use KIND_TYPES, only: DREALKIND + use ol_generic, only: to_int, string_to_integerlist, count_substring, to_string, to_lowercase, & + & integerlist_to_string + use ol_parameters_decl_/**/DREALKIND, only: & + & install_path,flavour_mapping_on, coupling_QCD, coupling_EW, write_shopping_list, add_associated_ew implicit none - character(len=*), intent(in) :: process + character(len=*), intent(in) :: process_in integer, intent(in) :: amptype integer :: register_process_string character(len=max_parameter_length) :: tmp character(len=max_parameter_length) :: inp, outp - integer :: tmpi - integer :: next, n_in - integer, allocatable :: ext(:) - integer, allocatable :: ext_bak(:) + character(len=max_parameter_length) :: process, proc, libhandle, permstring + integer :: librarytype + integer:: check + integer :: n_ext, n_in, n_out + type(extparticle), allocatable :: ext(:) + integer, allocatable :: perm(:) + integer, allocatable :: pol(:) + integer :: coupling_QCD_1_bak, coupling_EW_1_bak + integer :: associated_ew, associated_born + integer :: i logical :: decay = .false. - ! split: process->(in,out) - next = 0 - inp = adjustl(trim(process(1:index(process, "->")-1))) - outp = adjustl(process(index(process, "->")+2:len(process))) - - allocate(ext(4)) - ! split initial state - ISloop: do - tmp = adjustl(inp(1:index(inp, " "))) - inp = adjustl(inp(index(inp, " "):)) - if (index(tmp, " ") == 1) then - exit ISloop - else - next = next + 1 - ext(next) = to_int(trim(tmp)) - end if - end do ISloop - n_in = next - - ! split final state - FSloop: do - tmp = adjustl(outp(1:index(outp, " "))) - outp = adjustl(outp(index(outp, " "):)) - if (index(tmp, " ") == 1) then - exit FSloop !no more final state particles - else - next = next + 1 - if (next > size(ext)) then - allocate(ext_bak(size(ext))) - ext_bak = ext - deallocate(ext) - allocate(ext(2*next)) - ext(1:size(ext_bak)) = ext_bak - deallocate(ext_bak) - end if - ext(next) = to_int(trim(tmp)) - end if - end do FSloop - - if (next == n_in .or. n_in == 0) then - print *, "[OpenLoops] register_process: invalid argument: " // trim(process) - register_process_string = -1 - return - end if + call parameters_flush() ! make sure that pid_string is set + register_process_string = -1 - register_process_string = register_process_id(ext(1:next), amptype, n_in) + ! process: in -> out + if (index(process_in, ">") > 0) then - end function register_process_string + if (index(process_in, "->") > 0) then + inp = adjustl(trim(process_in(1:index(process_in, "->")-1))) + outp = adjustl(process_in(index(process_in, "->")+2:len(process_in))) + else + inp = adjustl(trim(process_in(1:index(process_in, ">")-1))) + outp = adjustl(process_in(index(process_in, ">")+2:len(process_in))) + end if - function register_process_id(ext_in, amptype, n_in_in) - ! process: array with format [in_1, in_2, out_1, .. , out_n-2] - ! amptype: integer 1,2,3,4,11,12 - ! return (integer) process id to be used in evaluate_process - use ol_parameters_decl_/**/DREALKIND, only: & - & install_path,flavour_mapping_on, coupling_QCD, coupling_EW, write_shopping_list - use ol_generic, only: to_string, to_lowercase -#ifdef USE_IFORT - use ifport, only: system -#endif - implicit none - integer, intent(in) :: ext_in(:) - integer, intent(in) :: amptype - integer, optional, intent(in) :: n_in_in - integer :: register_process_id - character(len=4) :: loops_flags - character(len=max_parameter_length) :: proc - character :: coupling_order(2) - character(len=max_parameter_length) :: process - integer :: lib_content - integer :: ierrparam, i - integer :: check - integer :: libid - integer :: next - integer :: ext(size(ext_in)) - logical :: proclib_exists - integer :: n_in = 2 - integer, allocatable :: perm(:) - integer :: librarytype + n_in = size(process_to_extparticlelist(inp)) + n_out = size(process_to_extparticlelist(outp)) + if (error > 0 .or. n_in == 0 .or. n_out == 0 .or. n_in+n_out < 3) then + call ol_error("register_process: invalid argument: " // trim(process_in) ) + end if + allocate (ext(n_in+n_out)) + ext(1:n_in) = process_to_extparticlelist(inp, .true.) + ext(n_in+1:) = process_to_extparticlelist(outp, .false.) - loops_flags = "tlsp" ! used in this order to set content bits - call parameters_flush() ! make sure that pid_string is set - register_process_id = -1 + ! charge conjugate final state particles + call charge_conj(ext) - ! check that proclib exists -#ifdef USE_GFORTRAN - inquire(file=trim(install_path)//"/proclib/.", exist=proclib_exists) -#endif -#ifdef USE_IFORT - inquire(directory=trim(install_path)//"/proclib", exist=proclib_exists) -#endif - if (.not. proclib_exists) then - print *, "[OpenLoops] register_process: proclib folder not found, check install_path or install libraries." - return - end if - - next = size(ext_in) - ! check - if (next < 3) then - print*, "[OpenLoops] Error: 1 -> 1 not supported!" - return - end if + ! flavour mapping + if (flavour_mapping_on == 1) then + call flavour_mapping(ext) + end if + ! determine normal ordering + allocate (perm(size(ext))) + call normal_order(ext, perm, proc) + if (proc == "") then + call ol_error("register_process: invalid argument: " // trim(process_in)) + return + end if - if (present(n_in_in)) then - n_in = n_in_in - end if + ! permute polarization states + allocate (pol(size(ext))) + do i=1, size(ext) + pol(perm(i)) = ext(i)%pol + end do - ! write process string for output - process = "" - do i=1,n_in - process = trim(process) // " " // trim(to_string(ext_in(i))) - end do - process = trim(process) // " ->" - do i=n_in+1,next - process = trim(process) // " " // trim(to_string(ext_in(i))) - end do + call ol_msg(3,"registering process: " // trim(proc) // ", " // integerlist_to_string([(ext(i)%id,i=1,size(ext))])) - ext = ext_in - ! charge conjugate final state particles - call charge_conj(ext,n_in) + if (amptype == 99 .or. write_shopping_list ) then ! write shopping list + ! charge conjugate back final state particles to write shopping list + call charge_conj(ext) + register_process_string = write_shop_list(ext, proc) + else - ! flavour mapping - if (flavour_mapping_on == 1) then - if (verbose > 2) then - print*, "[OpenLoops] Flavour mapping. Original (all ingoing) process: ", ext(1:next) - end if - call flavour_mapping(ext) - if (verbose > 2) then - print*, "[OpenLoops] Flavour mapping. Mapped (all ingoing) process: ", ext(1:next) + register_process_string = loop_over_libraries(proc, amptype, n_in, perm, pol, process_in) + + ! register associate EW one-loop amplitude + if (register_process_string > 0 .and. add_associated_ew == 1 .and. coupling_EW(1) == 0 ) then + coupling_QCD_1_bak = coupling_QCD(1) + call set_parameter("coupling_qcd_1",0) + call set_parameter("coupling_ew_1",1) + associated_ew = loop_over_libraries(proc, amptype, n_in, perm, pol, process_in) + process_handles(register_process_string)%associated_ew = associated_ew + call set_parameter("coupling_qcd_1",coupling_QCD_1_bak) + call set_parameter("coupling_ew_1",0) + end if end if - end if - ! determine normal ordering - allocate (perm(next)) - call normal_order(ext(1:next), perm, proc) - if (proc == "") return + else ! direct library loader - if (verbose > 3) then - print*, "[OpenLoops] registering process: ", trim(proc) // ", ", ext_in - end if + ! read permutation + permstring = process_in(index(process_in, '[')+1:index(process_in, ']')-1) + if (len_trim(permstring) /= 0) then + allocate(perm(size(string_to_integerlist(permstring)))) + perm = string_to_integerlist(permstring) + libhandle = process_in(:index(process_in,"[")-1) + else + libhandle = trim(process_in) + end if - if (amptype == 99 .or. write_shopping_list ) then ! write shopping list - ! charge conjugate back final state particles to write shopping list - call charge_conj(ext,n_in) - register_process_id = write_shop_list(ext(1:next), proc) - else + !register librarytype = 0 do - check = check_process(process, proc, perm, amptype, librarytype, n_in) - if (check > 0) then ! found & registered - register_process_id = check + if (allocated(perm)) then + register_process_string = check_process(libhandle, amptype, librarytype, 2, perm) + if (error > 1) return + else + register_process_string = check_process(libhandle, amptype, librarytype, 2) + if (error > 1) return + end if + if (register_process_string > 0) then ! found & registered exit - else if (check == 0) then ! look in next library type + else if (register_process_string == 0) then ! look in next library type librarytype = librarytype + 1 else - if (check == -1) then ! not found --> check collections - check = check_process(process, proc, perm, 999, librarytype, n_in) - end if - if (check /= 1) then ! not found anywhere - print *, "[OpenLoops] register_process: process " // trim(process) // " not found!" - end if + call ol_msg("register_process: library " // trim(libhandle) // " not found!") exit end if end do + end if !deallocate - deallocate(perm) - + if (allocated(ext)) then + deallocate(ext) + end if + if (allocated(perm)) then + deallocate(perm) + end if + if (allocated(pol)) then + deallocate(pol) + end if contains - subroutine charge_conj(x,n_in) + subroutine charge_conj(x) ! determine charge conjugate of array x(3:) implicit none - integer, intent(inout) :: x(:) - integer, intent(in) :: n_in - - do i=n_in+1,size(x) - select case(x(i)) - case(0, 21, 22, 23, 25) - x(i) = x(i) - case default - x(i) = -x(i) - end select + type(extparticle), intent(inout) :: x(:) + integer :: i + + do i=1,size(x) + if (.not. x(i)%is_initial) then + select case(x(i)%id) + case(0, 21, 22, 23, 25, 35, 36) + x(i)%id = x(i)%id + case default + x(i)%id = -x(i)%id + end select + end if end do end subroutine charge_conj + subroutine normal_order(ext, perm, proc) + use KIND_TYPES, only: DREALKIND implicit none - integer, intent(in) :: ext(:) + type(extparticle), intent(in) :: ext(:) integer, intent(out) :: perm(:) character(len=*), intent(out) :: proc - integer :: i,j, normal(31), pos - character(len=3) :: normalc(31) + integer :: i,j, normal(35), pos + character(len=3) :: normalc(35) ! define normal ordering and corresponding characters + + ! SM normal( 1:10) = [ 12 ,-12 , 14 ,-14 , 16 ,-16 , 11 ,-11 , 13 ,-13 ] normalc( 1:10) = ["ne ","nex","nm ","nmx","nl ","nlx","e ","ex ","m ","mx "] normal( 11:20) = [ 15 ,-15 , 2 , -2 , 4 , -4 , 6 , -6 , 1 , -1 ] normalc(11:20) = ["l ","lx ","u ","ux ","c ","cx ","t ","tx ","d ","dx "] - normal( 21:30) = [ 3 , -3 , 5 , -5 , 25 , 22 , 23 , -24 , 24 , 21 ] - normalc(21:30) = ["s ","sx ","b ","bx ","h ","a ","z ","w ","wx ","g "] + normal( 21:30) = [ 3 , -3 , 5 , -5 , 25 , 35 , 36 , 37 ,-37 , 22 ] + normalc(21:30) = ["s ","sx ","b ","bx ","h ","h0 ","a0 ","hp ","hpx","a "] - normal( 31:31) = [ 0 ] - normalc(31:31) = ["g "] + normal( 31:35) = [ 23 , -24 , 24 , 21 , 0 ] + normalc(31:35) = ["z ","w ","wx ","g ","g "] perm = 0 proc = "" @@ -494,7 +516,7 @@ subroutine normal_order(ext, perm, proc) pos = 1 do i = 1, size(normal) do j = 1, size(ext) - if (ext(j) == normal(i)) then + if (ext(j)%id == normal(i)) then proc = trim(proc) // trim(normalc(i)) perm(j) = pos pos = pos + 1 @@ -503,69 +525,128 @@ subroutine normal_order(ext, perm, proc) end do if (pos-1 /= size(ext)) then - print *, "[OpenLoops] normal_order: invalid process specification:", ext proc = "" end if end subroutine normal_order - subroutine map_permutation(perm, mapping_str_in) - use ol_generic, only: to_int + function loop_over_libraries(proc, amptype, n_in, perm, pol, process_in) + use KIND_TYPES, only: DREALKIND + ! loop over library types implicit none - integer, intent(inout) :: perm(:) - character(len=127), intent(in) :: mapping_str_in - character(len=127) :: mapping_str - integer, allocatable :: mapping(:), perm_tmp(:) - integer :: i, x - allocate (mapping(size(perm))) - allocate (perm_tmp(size(perm))) - mapping_str=trim(mapping_str_in) // ',' - do i = 1, size(mapping) - mapping(i) = to_int(trim(adjustl(mapping_str(1:index(mapping_str,',')-1)))) - mapping_str = mapping_str(index(mapping_str,',')+1:len_trim(mapping_str)) - end do - !map permutation - do i = 1, size(mapping) - perm_tmp(i) = mapping(perm(i)) + character(len=max_parameter_length), intent(in) :: proc + integer, intent(in) :: amptype, n_in + integer, intent(in), optional :: perm(:) + integer, intent(in), optional :: pol(:) + character(len=*), intent(in), optional :: process_in + integer loop_over_libraries + integer librarytype, check + + loop_over_libraries = -1 + librarytype = 0 + do + check = check_process(proc, amptype, librarytype, n_in, perm_in=perm, pol=pol, process_string=process_in) + if (error > 1) return + if (check > 0) then ! found & registered + loop_over_libraries = check + exit + else if (check == 0) then ! look in next library type + librarytype = librarytype + 1 + else if (check == -1) then ! not found --> check collections + check = check_process(proc, 999, librarytype, n_in, perm_in=perm, pol=pol, process_string=process_in) + if (error > 1) return + if (check /= 1) then ! not found anywhere + call ol_msg("register_process: process " // trim(process_in) // " not found!") + end if + exit + else if (check == -2) then ! error + return + end if end do - perm = perm_tmp - deallocate(mapping) - deallocate(perm_tmp) - end subroutine map_permutation + end function loop_over_libraries + + end function register_process_string + - function check_process(process, proc, perm, amptype, librarytype, n_in) + function register_process_id(ext, amptype, n_in_in) + ! ext: array with format [in_1, .. , in_n_in, out_1, .. , out_n_out] + ! amptype: integer 1,2,3,4,11,12 + ! (optional) n_in_in: number of initial state particles, default=2 + ! return (integer) process id to be used in evaluate_process + use ol_generic, only: integerlist_to_string + implicit none + integer, intent(in) :: ext(:) + integer, intent(in) :: amptype + integer, optional, intent(in) :: n_in_in + integer :: register_process_id + character(len=max_parameter_length) :: process + integer :: n_in, i + if (present(n_in_in)) then + n_in = n_in_in + else + n_in = 2 + end if + process = integerlist_to_string(ext(1:n_in),.false., " ") + process = trim(process) // " -> " // integerlist_to_string(ext(n_in+1:),.false., " ") + register_process_id = register_process_string(process, amptype) + end function register_process_id + + + function check_process(proc_in, amptype, librarytype, n_in, perm_in, pol, process_string) ! 1: found, 0: not found, -1: abort + use KIND_TYPES, only: DREALKIND use ol_parameters_decl_/**/DREALKIND, only: & - & install_path, rMB, & - & allowed_libs, pid_string, tmp_dir + & install_path, rMB, rMC, & + & allowed_libs, tmp_dir + use ol_generic, only: to_string, to_lowercase, integerlist_to_string, & + & count_substring, string_to_integerlist implicit none - character(len=max_parameter_length), intent(in) :: process - character(len=max_parameter_length), intent(inout) :: proc - integer, intent(inout) :: perm(:) + character(len=max_parameter_length), intent(in) :: proc_in integer, intent(in) :: amptype, librarytype, n_in + integer, intent(in), optional :: perm_in(:) + integer, intent(in), optional :: pol(:) + character(len=*), intent(in), optional :: process_string + integer, allocatable :: perm(:) + integer, allocatable :: select_pol(:) integer check_process + integer :: lib_content integer, save :: info_files_read = 0 integer :: readok, ierrg integer :: i, j, p, p_unmapped + integer, save :: max_out_length = 35 logical :: found logical :: is_already_loaded, only_loaded + logical :: has_pol character(len=4) :: loops_specification character(len=4) :: lib_specification - character(len=max_parameter_length) :: libfilename, libhandle, libname + character(len=max_parameter_length) :: proc, libfilename, libhandle, libname character(len=max_parameter_length) :: map_libname character(len=max_parameter_length) :: procunmapped - character(len=max_parameter_length) :: perm_str, mapping_str + character(len=max_parameter_length) :: mapping_str + character(len=max_parameter_length) :: outstring + check_process = -1 + found = .false. check_process = 0 map_libname = '' + mapping_str = '' + if (present(perm_in)) then + allocate(perm(size(perm_in))) + perm = perm_in + end if + + if (.not. check_proclib_exists()) then + check_process = -2 + return + end if ! read all info files - if ( info_files_read < 1) then - call readAllInfoFiles(ierrg) - info_files_read = 1 - if (ierrg /= 0) then - check_process = -1 + if (info_files_read < 1) then + call readAllInfoFiles() + if (error /= 0) then + check_process = -2 return end if + info_files_read = 1 end if only_loaded = .false. @@ -625,157 +706,266 @@ function check_process(process, proc, perm, amptype, librarytype, n_in) case (999) ! check libraries lib_specification = "lib" if (info_files_read < 2) then - call readAllInfoFiles(ierrg, .true.) - info_files_read = 2 - if (ierrg /= 0) then - check_process = -1 - print *, "[OpenLoops] Error: no process libraries installed." + call readAllInfoFiles(.true.) + if (error /= 0) then + check_process = -2 + call ol_msg("Error: no process libraries installed.") return end if + info_files_read = 2 end if case default - print *, "[OpenLoops] register_process: amplitude type not supported:", amptype + call ol_msg("register_process: amplitude type not supported: " // to_string(amptype)) + check_process = -2 end select - p = 0 - p_unmapped = 0 - InfoLoop: do - p = p+1 - if (p > size(process_infos)) then - if ( len_trim(map_libname) /= 0 ) then - map_libname = '' - proc = procunmapped - p = p_unmapped - cycle - else - exit + ! find process + proc = proc_in + p = 0 + p_unmapped = 0 + InfoLoop: do + p = p+1 + if (p > size(process_infos)) then + if ( len_trim(map_libname) /= 0 ) then + map_libname = '' + mapping_str = '' + proc = procunmapped + p = p_unmapped + if (allocated(perm)) then + perm = perm_in + end if + cycle + else + exit + end if end if - end if - - if ( trim(proc) /= trim(process_infos(p)%PROC) & - & .or. trim(lib_specification) /= trim(process_infos(p)%LTYPE) & - & .or. index(trim(process_infos(p)%TYPE), trim(loops_specification)) == 0 & - & ) then - cycle InfoLoop - end if - libname = trim(process_infos(p)%LIBNAME) - !check if library is "allowed" (and for correct mapping) - if (len_trim(allowed_libs) /= 0 .and. index(allowed_libs, " " // trim(libname) // " ") == 0 & - & .or. (len_trim(map_libname) /= 0 .and. trim(map_libname) /= libname) & - ) then - cycle InfoLoop - end if - - !if required, check if library is already loaded - if (only_loaded) then - is_already_loaded = .false. - if (allocated(loaded_libs)) then - do j = 1, size(loaded_libs) - if (trim(loaded_libs(j)%LIBNAME) == trim(libname) & - & .and. index(trim(process_infos(p)%TYPE), trim(loops_specification)) > 0 & - & ) then - is_already_loaded = .true. + !process loader + if (index(proc_in,"_") == 0) then + + ! correct process? + if ( trim(proc) /= trim(process_infos(p)%PROC) & + & .or. trim(lib_specification) /= trim(process_infos(p)%LTYPE) & + & .or. index(trim(process_infos(p)%TYPE), trim(loops_specification)) == 0 & + & ) cycle InfoLoop + + libname = trim(process_infos(p)%LIBNAME) + !check if library is "allowed" (and for correct mapping) + if (len_trim(allowed_libs) /= 0 .and. index(allowed_libs, " " // trim(libname) // " ") == 0 & + & .or. (len_trim(map_libname) /= 0 .and. trim(map_libname) /= libname) & + ) cycle InfoLoop + + !follow mapping + if(trim(process_infos(p)%MAP) /= '') then + !check for conditional mappings + call check_parameters_condmap(p, found) + if (found) then + procunmapped = proc + proc = trim(process_infos(p)%MAP) + call ol_msg(2, "Following info-file mapping: " // trim(procunmapped) // & + " --> " // trim(process_infos(p)%MAP) // "[" // trim(process_infos(p)%MAPPERM) // "].") + !map permutation + if(len_trim(process_infos(p)%MAPPERM) /= 0) then + if (allocated(perm)) then + call map_permutation(perm,string_to_integerlist(process_infos(p)%MAPPERM)) + if (error > 1) return + end if + end if + mapping_str = " (mapped from " // trim(procunmapped) // ")" + map_libname = libname + p_unmapped = p + p = 0 + cycle InfoLoop + else + call ol_msg(2, "Not following mapping " // trim(proc) // " --> " // trim(process_infos(p)%MAP) // ".") + cycle InfoLoop end if - end do - end if - if (.not. is_already_loaded) cycle InfoLoop - end if + end if - !follow mapping - if(trim(process_infos(p)%MAP) /= '') then - procunmapped = proc - proc = trim(process_infos(p)%MAP) - !check for MB etc. Todo: check all parameters - if ((process_infos(p)%MB == "0" .and. rMB /= 0) ) then - if (verbose > 1) then - print*, "[OpenLoops] Not following massless b-mapping ", trim(procunmapped), " --> ", trim(proc) , ": MB /= 0." + ! get library filename + if (amptype == 999) then + libfilename = "collection " // trim(process_infos(p)%LIBNAME) + else + libfilename = 'libopenloops_' // trim(process_infos(p)%LIBNAME) // '_' // & + & trim(process_infos(p)%LTYPE) // '.' // dynlib_extension end if - proc = procunmapped - cycle InfoLoop - end if - if (verbose > 1) then - print*, "[OpenLoops] Following info-file mapping: ",trim(procunmapped), & - & " --> ", trim(process_infos(p)%MAP), "[", trim(process_infos(p)%MAPPERM), "]" , "." - end if - !map permutation - if(len_trim(process_infos(p)%MAPPERM) /= 0) then - call map_permutation(perm,process_infos(p)%MAPPERM) - mapping_str = " (mapped from " // trim(procunmapped) // ")" - end if - map_libname = libname - p_unmapped = p - p = 0 - cycle - else - mapping_str = '' - end if + ! check if library offers polarization selection + if (process_infos(p)%POLSEL == 1) then + has_pol = .true. + if (allocated(select_pol)) deallocate(select_pol) + allocate(select_pol(size(pol))) + select_pol = 0 + else + has_pol = .false. + end if - ! get library filename - if (amptype == 999) then - libfilename = "collection " // trim(process_infos(p)%LIBNAME) - else - libfilename = 'libopenloops_' // trim(process_infos(p)%LIBNAME) // '_' // & - & trim(process_infos(p)%LTYPE) // '.' // dynlib_extension - end if + if (present(pol)) then + if (any(pol /= 0) .and. .not. has_pol) then + call ol_msg(2,"Library does not match: polarization selection not available.") + cycle + else if (has_pol) then + select_pol = pol + end if + end if - ! check parameters - call check_parameters(p,amptype,found) + ! check parameters + call check_parameters(p,amptype,found) + + ! direct library loader + else if (index(proc_in,"_") > 0) then + libhandle = proc_in + libname = proc_in(:index(proc_in(:index(proc_in,"_",.true.)-1),"_",.true.)-1) + proc = proc_in(index(proc_in(:index(proc_in,"_",.true.)-1),"_",.true.)+1:index(proc_in,"_",.true.)-1) + if ( trim(proc) /= trim(process_infos(p)%PROC) .or. & + & trim(libname) /= trim(process_infos(p)%LIBNAME) .or. & + & trim(lib_specification) /= trim(process_infos(p)%LTYPE) .or. & + & index(trim(process_infos(p)%TYPE), trim(loops_specification)) == 0 .or. & + & proc_in(index(proc_in,"_",.true.)+1:) /= trim(process_infos(p)%ID) & + & ) cycle InfoLoop + libfilename = 'libopenloops_' // trim(libname) // '_' // & + & trim(lib_specification) // '.' // dynlib_extension + found = .true. + call set_parameter("ew_renorm", 1) + exit InfoLoop + else + call ol_error("register_process: process format not supported.") + check_process = -2 + return + end if - ! found correct library - if (found) then - if (verbose > 1) then - print*, "[OpenLoops] Parameters do match info-file for process ", trim(proc), " in library ", trim(libfilename) + !if required, check if library is already loaded + if (only_loaded) then + is_already_loaded = .false. + if (allocated(loaded_libs)) then + do j = 1, size(loaded_libs) + if (trim(loaded_libs(j)%LIBNAME) == trim(libname) & + & .and. index(trim(loaded_libs(j)%TYPE), trim(loops_specification)) > 0 & + & ) then + is_already_loaded = .true. + end if + end do + end if + if (.not. is_already_loaded) found = .false. end if - if (amptype == 999) then - print*, "[OpenLoops] Library for ", trim(process), " not installed but available in: ", trim(libname) - print*, "[OpenLoops] Note: this library can be downloaded and installed via" - print*, "[OpenLoops] $ cd " // trim(install_path) - print*, "[OpenLoops] $ ./openloops libinstall ", trim(libname) - check_process = 1 - return + ! found correct library + if (found) then + call ol_msg(2, "Parameters do match info-file for process " // trim(proc) // " in library " // trim(libfilename)) + if (amptype == 999) then + if (present(process_string)) then + call ol_msg("Library for " // trim(process_string) // " not installed but available in: " // trim(libname)) + else + call ol_msg("Library for " // trim(proc) // " not installed but available in: " // trim(libname)) + end if + call ol_msg("Note: this library can be downloaded and installed via") + call ol_msg("$ cd " // trim(install_path)) + call ol_msg("$ ./openloops libinstall " // trim(libname)) + check_process = 1 + return + end if + libhandle = trim(to_lowercase(libname)) // "_" // trim(proc) // "_" // trim(process_infos(p)%ID) + exit + else + call ol_msg(2,"Parameters do not match info-file for process " // trim(proc) // " in library " // trim(libfilename)) + check_process = 0 end if + end do InfoLoop + + if (found) then libfilename = trim(install_path) // '/proclib/' // libfilename - libhandle = trim(to_lowercase(libname)) // "_" // trim(proc) // "_" // to_string(process_infos(p)%ID) lib_content = 0 do i = 1, len(loops_flags) - if (index(process_infos(p)%TYPE, loops_flags(i:i)) > 0) lib_content = ibset(lib_content, i-1) + if (index(trim(process_infos(p)%TYPE), loops_flags(i:i)) > 0) lib_content = ibset(lib_content, i-1) end do !register - check_process = register_process_lib(libfilename, libhandle, perm, lib_content, amptype, n_in) + if (has_pol) then + check_process = register_process_lib(libfilename, libhandle, lib_content, amptype, n_in, perm=perm, pol=select_pol) + else + check_process = register_process_lib(libfilename, libhandle, lib_content, amptype, n_in, perm=perm) + end if + if (error > 1) then + call ol_error("register_process_lib failed") + check_process = -2 + return + end if + + if (present(process_string)) then + outstring = "Library loaded: " // trim(process_string) + else + outstring = "Library loaded: " // trim(proc) + end if + outstring = adjustl(outstring) + if (len_trim(outstring) > max_out_length) max_out_length = len_trim(outstring) + outstring = outstring(1:max_out_length) // " @" // & + & " EW=" // trim(to_string(process_infos(p)%EWorder(0))) // "," // & + & trim(to_string(process_infos(p)%EWorder(1))) // & + & " QCD=" // trim(to_string(process_infos(p)%QCDorder(0))) // "," // & + & trim(to_string(process_infos(p)%QCDorder(1))) // & + & " > " // trim(libhandle) + if (allocated(perm)) then + outstring = trim(outstring) // trim(integerlist_to_string(perm,.true.)) + end if + outstring = trim(outstring) // trim(mapping_str) + call ol_msg(1,outstring) !add to list of loaded libraries call add_loaded_library(process_infos(p)) + end if - if (verbose > 0) then - perm_str = "[" - do i = 1, size(perm) - 1 - perm_str = trim(perm_str) // trim(to_string(perm(i))) // "," - end do - perm_str = trim(perm_str) // trim(to_string(perm(i))) // "]" - print *, "[OpenLoops] Loaded library for process " // trim(process) // & - & " EW=" // trim(to_string(process_infos(p)%EWorder(0))) // "," // trim(to_string(process_infos(p)%EWorder(1))) // & - & " QCD=" // trim(to_string(process_infos(p)%QCDorder(0))) // "," // trim(to_string(process_infos(p)%QCDorder(1))) // & - & " : " // trim(libhandle) // trim(perm_str) // trim(mapping_str) - end if - exit - else - if (verbose > 1) then - print*, "[OpenLoops] Parameters do not match info-file for process ", trim(proc), " in library ", trim(libfilename) - end if - check_process = 0 + + if (allocated(perm)) deallocate(perm) + if (allocated(select_pol)) deallocate(select_pol) + + contains + + subroutine map_permutation(perm, map) + !map permutation + implicit none + integer, intent(inout) :: perm(:) + integer, intent(in) :: map(:) + integer :: perm_tmp(size(perm)) + integer :: i, x + if (size(perm) /= size(map)) then + call ol_fatal("error in map_permutation") + return end if + do i = 1, size(map) + perm_tmp(i) = map(perm(i)) + end do + perm = perm_tmp + end subroutine map_permutation - end do InfoLoop - end function check_process - end function register_process_id + end function check_process + + + + function check_proclib_exists() + ! checks that proclib folder exists within set install_path + use ol_parameters_decl_/**/DREALKIND, only: install_path + implicit none + logical check_proclib_exists + logical proclib_exists +#ifdef USE_GFORTRAN + inquire(file=trim(install_path)//"/proclib/.", exist=proclib_exists) +#endif +#ifdef USE_IFORT + inquire(directory=trim(install_path)//"/proclib", exist=proclib_exists) +#endif + if (.not. proclib_exists) then + call ol_fatal("register_process: proclib folder not found, check install_path or install libraries.") + check_proclib_exists = .false. + return + else + check_proclib_exists = .true. + return + end if + end function check_proclib_exists subroutine check_parameters(p,amptype,found) @@ -790,17 +980,26 @@ subroutine check_parameters(p,amptype,found) integer, intent(in) :: amptype logical, intent(out) :: found + found = .false. if (allocated(process_infos)) then - found = .true. - call check(process_infos(p)%EWorder(0) == coupling_EW(0) .or. coupling_EW(0) == -1,found, "EW tree coupling NOT ok.") - call check(process_infos(p)%EWorder(1) == coupling_EW(1) .or. coupling_EW(1) == -1,found, "EW loop coupling NOT ok.") + if (size(process_infos) < p) then + call ol_error(1,"check_parameters: process not available") + return + end if + found = .true. + + call check(process_infos(p)%EWorder(0) == coupling_EW(0) .or. coupling_EW(0) == -1, found, "EW tree coupling NOT ok.") + call check(amptype == 1 .or. process_infos(p)%EWorder(1) == coupling_EW(1) & + .or. coupling_EW(1) == -1, found, "EW loop NOT ok.") call check(process_infos(p)%QCDorder(0) == coupling_QCD(0) .or. coupling_QCD(0) == -1, found, "QCD tree coupling NOT ok.") - call check(process_infos(p)%QCDorder(1) == coupling_QCD(1) .or. coupling_QCD(1) == -1, found, "QCD loop coupling NOT ok.") + call check(amptype == 1 .or. process_infos(p)%QCDorder(1) == coupling_QCD(1) & + .or. coupling_QCD(1) == -1, found, "QCD loop NOT ok.") + call check(process_infos(p)%LeadingColour == leadingcolour, found, "LeadingColour OK.") call check(process_infos(p)%NC == nc, found, "nc NOT ok.") call check(process_infos(p)%NF == nf, found, "nf NOT ok.") call check(process_infos(p)%CKMorder == ckmorder, found, "CKM NOT ok.") - ! call check(index(process_infos(p)%MODEL, trim(model)) == 1, found, "model NOT ok.") + call check(index(process_infos(p)%MODEL, trim(model)) == 1, found, "model NOT ok.") call check((process_infos(p)%ME /= "0" .and. rME /= 0) .or. rME == 0, found, "mass ME NOT ok.") call check((process_infos(p)%MM /= "0" .and. rMM /= 0) .or. rMM == 0, found, "mass MM NOT ok.") call check((process_infos(p)%ML /= "0" .and. rML /= 0) .or. rML == 0, found, "mass ML NOT ok.") @@ -820,100 +1019,95 @@ subroutine check_parameters(p,amptype,found) call check(rMT == rYT .or. process_infos(p)%YT == 1, found, "YukT /= YT NOT ok.") call check(amptype == 1 .or. amptype > 10 .or. process_infos(p)%CC /= "0", found, "CC NOT ok.") call check(trim(process_infos(p)%APPROX) == trim(approximation) .or. len_trim(allowed_libs) /= 0, found, "APPROX NOT ok.") - else - found = .false. end if - contains + end subroutine check_parameters - subroutine check(test,found,message) + subroutine check_parameters_condmap(p,found) + use ol_parameters_decl_/**/DREALKIND, only: & + & rME, rMM, rML, rMU, rMD, rMC, rMS, rMB + implicit none + integer, intent(in) :: p + logical, intent(out) :: found + + found = .false. + if (allocated(process_infos)) then + if (size(process_infos) < p) then + call ol_error(1,"check_parameters_mapping: process not available") + return + end if + found = .true. + call check(.not. (process_infos(p)%ME == "0" .and. rME /= 0), found, "mass ME NOT ok.") + call check(.not. (process_infos(p)%MM == "0" .and. rMM /= 0), found, "mass MM NOT ok.") + call check(.not. (process_infos(p)%ML == "0" .and. rML /= 0), found, "mass ML NOT ok.") + call check(.not. (process_infos(p)%MU == "0" .and. rMU /= 0), found, "mass MU NOT ok.") + call check(.not. (process_infos(p)%MD == "0" .and. rMD /= 0), found, "mass MD NOT ok.") + call check(.not. (process_infos(p)%MS == "0" .and. rMS /= 0), found, "mass MS NOT ok.") + call check(.not. (process_infos(p)%MC == "0" .and. rMC /= 0), found, "mass MC NOT ok.") + call check(.not. (process_infos(p)%MB == "0" .and. rMB /= 0), found, "mass MB NOT ok.") + end if + + end subroutine check_parameters_condmap + + subroutine check(test,found,message) implicit none logical, intent(in) :: test logical, intent(inout) :: found character(len=*), intent(in) :: message - if (.not. test) then found = .false. - if (verbose > 2) print*, "[OpenLoops] Library not suitable: " // trim(message) + call ol_msg(3,"Library does not match: " // trim(message)) end if + end subroutine - end subroutine - - - end subroutine check_parameters - - - subroutine readAllInfoFiles(ierr, load_channel_lib) - use ol_parameters_decl_/**/DREALKIND, only: & - & install_path, tmp_dir, pid_string + subroutine readAllInfoFiles(load_channel_lib) + use ol_parameters_decl_/**/DREALKIND, only: install_path use iso_fortran_env, only: iostat_end -#ifdef USE_IFORT - use ifport, only: system -#endif + use ol_dirent, only: opendir, readdir, closedir implicit none logical, optional, intent(in) :: load_channel_lib - integer, intent(out) :: ierr integer :: readok - integer, parameter :: gf_list = 995, gf_info = 994 - integer :: counter, sysstate - character(len=max_parameter_length) :: infofile_list - character(len=500) :: sys_list_info + integer, parameter :: gf_info = 994 + integer :: counter character(len=500) :: infofilename character(len=500) :: infoline character(len=5) :: info_file_suffix = 'info' logical :: iqopen - character(len=4) :: old_type - type(processinfos) infos - type(processinfos), save, allocatable :: process_infos_bak(:) - - ierr = 0 + type(processinfos), allocatable :: process_infos_bak(:) if (present(load_channel_lib)) then + call ol_msg(1, "Requested library not installed. Checking collection...") if (load_channel_lib) then - info_file_suffix = 'rinfo' + info_file_suffix = 'rinfo' end if end if - infofile_list = trim(tmp_dir) // "/OL_output_list_" // trim(pid_string) // ".tmp" - sys_list_info = 'ls -1 ' // & - & trim(install_path) // '/proclib/*.' // info_file_suffix // & - & ' > ' // infofile_list // & - & ' 2> /dev/null' - - call system(sys_list_info, sysstate) - if (sysstate /= 0) then - ierr = 1 - return - end if - - inquire(gf_list, opened=iqopen) - if(iqopen) close(unit=gf_list) - open(gf_list, file=trim(infofile_list), status = "old", iostat=readok) + ! open proclib folder + readok = opendir(trim(install_path) // '/proclib') if (readok /= 0) then - print *, "[OpenLoops] readAllInfoFiles can't open temporary file." - ierr = 1 + call ol_error('opening proclib directory failed. Check install_path.') return end if - InfoListLoop: do - read (gf_list, '(A)', iostat=readok ) infofilename - if (readok /= 0) then ! EOF -> exit - if (readok == iostat_end) then - exit InfoListLoop - else - print *, "[OpenLoops] redAllInfoFiles error reading temporary file." - ierr = 1 - exit - end if + ProclibDirLoop: do + readok = readdir(infofilename) + if (readok /= 0) then + call ol_error("reading proclib directory content failed.") + exit + end if + if (len(trim(infofilename)) == 0) exit + if (index(trim(infofilename),"."//trim(info_file_suffix)) == 0) then + cycle + else + infofilename = trim(install_path) // "/proclib/" // trim(infofilename) end if inquire(gf_info, opened=iqopen) if(iqopen) close(unit=gf_info) open(gf_info, file=trim(infofilename), status = "old", iostat=readok) if (readok /= 0) then - print *, "[OpenLoops] readAllInfoFiles: can't open file " // infofilename - ierr = 1 + call ol_error("in readAllInfoFiles can't open file: " // trim(infofilename) ) exit end if counter = 0 @@ -923,13 +1117,11 @@ subroutine readAllInfoFiles(ierr, load_channel_lib) if (readok == iostat_end) then exit InfoFileLoop else - print *, "[OpenLoops] redAllInfoFiles error reading file " // infofilename - ierr = 1 - exit + call ol_error("in redAllInfoFiles error reading file: " // trim(infofilename) ) + exit ProclibDirLoop end if end if - ! strip empty lines if (len_trim(infoline) == 0) then cycle InfoFileLoop @@ -949,10 +1141,10 @@ subroutine readAllInfoFiles(ierr, load_channel_lib) counter = counter+1 ! strip first line of collection files if (info_file_suffix == 'rinfo' .and. counter == 1) then - cycle + cycle InfoFileLoop end if - ! read all Infos + ! determine library type from name of info file if (info_file_suffix == 'rinfo') then infos%LTYPE = "lib" else @@ -960,6 +1152,10 @@ subroutine readAllInfoFiles(ierr, load_channel_lib) end if call readAllInfos(infoline, infos) + if (error > 1) then + call ol_error("reading infofile line: " // trim(infoline)) + exit ProclibDirLoop + end if ! Add to array of infos if (.not. allocated(process_infos)) then @@ -974,16 +1170,15 @@ subroutine readAllInfoFiles(ierr, load_channel_lib) end if process_infos(size(process_infos)) = infos end do InfoFileLoop - end do InfoListLoop + end do ProclibDirLoop + + ! close directory handle + call closedir() + ! close file handle inquire(gf_info, opened=iqopen) if(iqopen) close(unit=gf_info) - inquire(gf_list, opened=iqopen) - if(iqopen) close(unit=gf_list) - - call system("rm -f " // infofile_list ) - contains subroutine readAllInfos(lineinfo, infos) @@ -1001,16 +1196,16 @@ subroutine readAllInfos(lineinfo, infos) else if (index(lineinfo, ' condmap') > 0) then call readInfo(lineinfo, 'condmap', infos%MAP) else - print*, "[OpenLoops] error: mapping not supported!" - stop + call ol_fatal("info-file mapping not supported!") + return end if infos%MAPPERM = infos%MAP(index(infos%MAP, '[')+1:index(infos%MAP, ']')-1) if (len_trim(infos%MAPPERM) /= 0) then infos%MAP = infos%MAP(1:index(infos%MAP,'[')-1) end if - infos%ID = 0 + infos%ID = '0' else - call readInfoColInt(lineinfo, 3, infos%ID) + call readInfoCol(lineinfo, 3, infos%ID) call readInfoCoupling(lineinfo, 'QCD', infos%QCDorder) call readInfoCoupling(lineinfo, 'EW', infos%EWorder) infos%MAP = '' @@ -1038,6 +1233,7 @@ subroutine readAllInfos(lineinfo, infos) call readInfoInt(lineinfo, 'nc', infos%NC) call readInfoInt(lineinfo, 'nf', infos%NF) call readInfoInt(lineinfo, 'LeadingColour', infos%LeadingColour) + call readInfoInt(lineinfo, 'POLSEL', infos%POLSEL) call readInfo(lineinfo, 'CC', infos%CC) call readInfo(lineinfo, 'MODEL', infos%Model) if (len_trim(infos%Model) == 0) then @@ -1087,9 +1283,7 @@ subroutine readInfoColInt(lineinfo, col, res) call readInfoCol(lineinfo,col, resc) res = to_int(trim(resc)) if (res == -huge(res)) then - if (verbose > 0) then - print*, "[OpenLoops] Warning: problem reading info line: ", trim(lineinfo) - end if + call ol_msg(1, "Warning: problem reading info line: " // trim(lineinfo)) end if end subroutine readInfoColInt @@ -1108,9 +1302,7 @@ subroutine readInfoInt(lineinfo, var, res) end if res = to_int(restemp) if (res == -huge(res)) then - if (verbose > 0) then - print*, "[OpenLoops] Warning: problem reading info line: ", trim(lineinfo) - end if + call ol_msg(1, "Warning: problem reading info line: " // trim(lineinfo)) end if end subroutine readInfoInt @@ -1131,9 +1323,7 @@ subroutine readInfoCoupling(lineinfo, var, res) res(1) = 0 end if if (any(res == -huge(res))) then - if (verbose > 0) then - print*, "[OpenLoops] Warning: problem reading info line: ", trim(lineinfo) - end if + call ol_msg(1,"Warning: problem reading info line: " // trim(lineinfo)) end if end subroutine readInfoCoupling @@ -1180,9 +1370,11 @@ subroutine flavour_mapping(ext) ! It is also convenient to set Ngen=10, although i runs only from 1 to 3. ! (3) Reassign the lepton generations with a permutation ! p1 -> 1, p2 -> 2, p3 -> 3 such that N[p1] > N[p2] > N[p3] */ + use ol_generic, only: integerlist_to_string + use ol_parameters_decl_/**/DREALKIND, only: rMC, rYC, rMM, rYM, rML, rYL implicit none - integer, intent(inout) :: ext(:) - integer, allocatable :: new_ext(:) + type(extparticle), intent(inout) :: ext(:) + type(extparticle), allocatable :: new_ext(:) integer i, j integer Ngen, Nlgen, Nqgen, Nmax integer l_gen, nu_gen, l_gen_new, nu_gen_new @@ -1190,24 +1382,22 @@ subroutine flavour_mapping(ext) integer a_nu, a_nubar, a_l, a_lbar integer a_u, a_ubar, a_d, a_dbar integer Nl(3,2), Nq(2,2) - real(DREALKIND) mtau, mmu, mc integer perm(size(ext)) Ngen=10 Nmax=10 - call get_parameter("tau_mass", mtau) - call get_parameter("mu_mass", mmu) - if (mtau == 0 .and. mmu == 0) then + call ol_msg(3,"Flavour mapping. Original (all ingoing) process: " // integerlist_to_string([(ext(j)%id, j=1,size(ext))]) ) + + if (rML == 0 .and. rYL == 0 .and. rMM == 0 .and. rYM == 0) then Nlgen = 3 - else if (mtau /= 0. .and. mmu == 0) then + else if ((rML /= 0. .or. rYL /= 0 ) .and. rMM == 0 .and. rYM == 0) then Nlgen = 2 else Nlgen = 1 end if - call get_parameter("c_mass", mc) - if (mc == 0) then + if (rMC == 0 .and. rYC == 0) then Nqgen = 2 else Nqgen = 1 @@ -1221,10 +1411,10 @@ subroutine flavour_mapping(ext) l_gen=9+2*i; nu_gen=10+2*i; - a_nu=count_flav(ext,nu_gen); - a_nubar=count_flav(ext,-nu_gen); - a_l=count_flav(ext,l_gen); - a_lbar=count_flav(ext,-l_gen); + a_nu=count_integer(ext,nu_gen); + a_nubar=count_integer(ext,-nu_gen); + a_l=count_integer(ext,l_gen); + a_lbar=count_integer(ext,-l_gen); Nl(i,1)=Ngen-i+Ngen*(a_nubar+a_nu*Nmax+a_lbar*Nmax*Nmax+a_l*Nmax*Nmax*Nmax) Nl(i,2)=i @@ -1239,8 +1429,8 @@ subroutine flavour_mapping(ext) nu_gen_new=10+2*i; do j = 1, size(ext) - if (abs(ext(j))==nu_gen) new_ext(j)=sign(nu_gen_new,ext(j)) - if (abs(ext(j))==l_gen) new_ext(j)=sign(l_gen_new,ext(j)) + if (abs(ext(j)%id)==nu_gen) new_ext(j)%id=sign(nu_gen_new,ext(j)%id) + if (abs(ext(j)%id)==l_gen) new_ext(j)%id=sign(l_gen_new,ext(j)%id) end do end do @@ -1251,10 +1441,10 @@ subroutine flavour_mapping(ext) d_gen=2*i-1; u_gen=2*i; - a_d=count_flav(ext,d_gen); - a_dbar=count_flav(ext,-d_gen); - a_u=count_flav(ext,u_gen); - a_ubar=count_flav(ext,-u_gen); + a_d=count_integer(ext,d_gen); + a_dbar=count_integer(ext,-d_gen); + a_u=count_integer(ext,u_gen); + a_ubar=count_integer(ext,-u_gen); Nq(i,1)=Ngen-(i+1) + Ngen*(a_ubar+a_u*Nmax+a_dbar*Nmax*Nmax+a_d*Nmax*Nmax*Nmax) Nq(i,2)=i @@ -1269,35 +1459,18 @@ subroutine flavour_mapping(ext) u_gen_new=2*i; do j = 1, size(ext) - if (abs(ext(j))==u_gen) new_ext(j)=sign(u_gen_new,ext(j)) - if (abs(ext(j))==d_gen) new_ext(j)=sign(d_gen_new,ext(j)) + if (abs(ext(j)%id)==u_gen) new_ext(j)%id=sign(u_gen_new,ext(j)%id) + if (abs(ext(j)%id)==d_gen) new_ext(j)%id=sign(d_gen_new,ext(j)%id) end do end do ext = new_ext - !inverse normal ordering -! print*, perm -! do i = 1, size(ext) -! ext(i) = new_ext(perm(i)) -! end do deallocate(new_ext) - contains + call ol_msg(3, "Flavour mapping. Mapped (all ingoing) process: " // integerlist_to_string([(ext(j)%id, j=1,size(ext))])) - function count_flav(ext, pid) - ! count frequency of integer pid in array ext - implicit none - integer, intent(in) :: ext(:) - integer, intent(in) :: pid - integer :: count_flav - integer i - - count_flav = 0 - do i = 1, size(ext) - if (ext(i) == pid) count_flav = count_flav+1 - end do - end function count_flav + contains subroutine sort_pair(a,n) ! Simple insertion sort. Sorting descending on the first component of a 2-tuple of length n @@ -1321,6 +1494,19 @@ subroutine sort_pair(a,n) end do end subroutine sort_pair + function count_integer(list, j) + ! count frequency of integer j in array ilist + implicit none + type(extparticle), intent(in) :: list(:) + integer, intent(in) :: j + integer :: count_integer + integer i + count_integer = 0 + do i = 1, size(list) + if (list(i)%id == j) count_integer = count_integer+1 + end do + end function count_integer + end subroutine @@ -1329,7 +1515,7 @@ function write_shop_list(ext, proc) & rMU, rMD, rMC, rMS, rMB, rME, rMM, rML use ol_generic, only: to_string implicit none - integer, intent(in) :: ext(:) + type(extparticle), intent(in) :: ext(:) character(len=max_parameter_length), intent(in) :: proc integer write_shop_list character(len=500) :: output @@ -1349,7 +1535,7 @@ function write_shop_list(ext, proc) !open shopping list open(fh_shopping, file=trim(shopping_list), status = "replace", iostat=readok) if (readok /= 0) then - print*, "[OpenLoops] Error opening shopping list ", trim(shopping_list) + call ol_msg("Error opening shopping list " // trim(shopping_list)) return end if ! write header @@ -1374,10 +1560,8 @@ function write_shop_list(ext, proc) if (allocated(shopped_processes)) then do i = 1, size(shopped_processes) if ( trim(proc) == trim(shopped_processes(i)) ) then - if (verbose > 1) then - print*, "[OpenLoops] Not written to shopping list. Already shopped as process " & - & // trim(to_string(i)) // ": " //trim(proc) - end if + call ol_msg(2, "Not written to shopping list. Already shopped as process " & + & // trim(to_string(i)) // ": " //trim(proc) ) write_shop_list = i return end if @@ -1398,10 +1582,10 @@ function write_shop_list(ext, proc) ! process name and id output = "(* " //trim(proc)// " *) AddProcess[FeynArtsProcess -> " ! inital state - output = trim(output) // " {" // trim(PDGtoFA(ext(1))) // ", " // trim(PDGtoFA(ext(2))) // "} -> {" + output = trim(output) // " {" // trim(PDGtoFA(ext(1)%id)) // ", " // trim(PDGtoFA(ext(2)%id)) // "} -> {" ! final state do i=3,size(ext) - output = trim(output) // trim(PDGtoFA(ext(i))) + output = trim(output) // trim(PDGtoFA(ext(i)%id)) if (i /= size(ext)) output = trim(output) // ", " end do output = trim(output) // "}" @@ -1455,9 +1639,7 @@ function write_shop_list(ext, proc) output = trim(output) // "];" - if (verbose > 0) then - print*, "[OpenLoops] Write to shopping list "// trim(shopping_list) //": " // trim(output) - end if + call ol_msg(1," Write to shopping list "// trim(shopping_list) //": " // trim(output)) ! write process to shopping list write(fh_shopping,'(A)') trim(output) @@ -1518,13 +1700,189 @@ function PDGtoFA(pdg) case (25) PDGtoFA = "S[1]" case default - print*, "[OpenLoops] Error: only SM particles are allowed!" + call ol_msg("Error: only SM particles are allowed!") PDGtoFA = "?" end select end function PDGtoFA + function ID_to_extparticle(id_in) + use KIND_TYPES, only: DREALKIND + use ol_generic, only: to_int, to_lowercase + ! MadGraph naming scheme -> PDG + implicit none + character(len=*), intent(in) :: id_in + character(len=len(id_in)) :: id + type(extparticle) :: ID_to_extparticle + + if (index(id_in, "(") > 0 .and. index(id_in, ")") > 0) then + ID_to_extparticle%pol = to_int(id_in(index(id_in,"(")+1:index(id_in,")")-1)) + if (ID_to_extparticle%pol /= 0 .and. abs(ID_to_extparticle%pol) /= 1 .and. ID_to_extparticle%pol /= 2) then + call ol_error("polarization of external particles has to be: 0,-1,1,2") + end if + id = id_in(1:index(id_in,"(")-1) + else + ID_to_extparticle%pol = 0 + id = id_in + end if + + select case (trim(to_lowercase(id))) + case ('d') + ID_to_extparticle%id = 1 + case ('d~') + ID_to_extparticle%id = -1 + case ('u') + ID_to_extparticle%id = 2 + case ('u~') + ID_to_extparticle%id = -2 + case ('s') + ID_to_extparticle%id = 3 + case ('s~') + ID_to_extparticle%id = -3 + case ('c') + ID_to_extparticle%id = 4 + case ('c~') + ID_to_extparticle%id = -4 + case ('b') + ID_to_extparticle%id = 5 + case ('b~') + ID_to_extparticle%id = -5 + case ('t') + ID_to_extparticle%id = 6 + case ('t~') + ID_to_extparticle%id = -6 + case ('e-') + ID_to_extparticle%id = 11 + case ('e+') + ID_to_extparticle%id = -11 + case ('ve') + ID_to_extparticle%id = 12 + case ('ve~') + ID_to_extparticle%id = -12 + case ('mu-') + ID_to_extparticle%id = 13 + case ('mu+') + ID_to_extparticle%id = -13 + case ('vm') + ID_to_extparticle%id = 14 + case ('vm~') + ID_to_extparticle%id = -14 + case ('ta-') + ID_to_extparticle%id = 15 + case ('ta+') + ID_to_extparticle%id = -15 + case ('vt') + ID_to_extparticle%id = 16 + case ('vt~') + ID_to_extparticle%id = -16 + case ('g') + ID_to_extparticle%id = 21 + case ('a') + ID_to_extparticle%id = 22 + case ('z') + ID_to_extparticle%id = 23 + case ('w+') + ID_to_extparticle%id = 24 + case ('w-') + ID_to_extparticle%id = -24 + case ('h') + ID_to_extparticle%id = 25 + case ('h1') + ID_to_extparticle%id = 25 + case ('h2') + ID_to_extparticle%id = 35 + case ('h3') + ID_to_extparticle%id = 36 + case ('h-') + ID_to_extparticle%id = -37 + case ('h+') + ID_to_extparticle%id = 37 + case default + ID_to_extparticle%id = to_int(trim(id)) + if (ID_to_extparticle%id == -huge(ID_to_extparticle%id)) then + call ol_error('unrecognised particle id: ' // trim(id)) + end if + end select + end function ID_to_extparticle + + + function process_to_extparticlelist(c_in,is_initial) + ! convert a comma/space/slash separated string of MadGraph or PDG ids into an array of PDG integers + implicit none + character(len=*), intent(in) :: c_in + logical, optional, intent(in) :: is_initial + character(len(c_in)+1) :: c + type(extparticle), allocatable :: process_to_extparticlelist(:) + integer i, n, pos1 + logical last_seperator + + c = c_in // " " + + n=0 + pos1=0 + last_seperator = .false. + do i = 1, len(c) + if (c(i:i) == "[" .or. c(i:i) == "]") c(i:i) = " " + + if (c(i:i) == ',' .or. c(i:i) == ' ' .or. c(i:i) == "/" ) then + if (last_seperator) then + pos1 = i + cycle + end if + n = n+1 + pos1 = i + last_seperator = .true. + else + last_seperator = .false. + end if + end do + + allocate(process_to_extparticlelist(n)) + + n=0 + pos1=0 + last_seperator = .false. + do i = 1, len(c) + if (c(i:i) == ',' .or. c(i:i) == ' ' .or. c(i:i) == "/") then + if (last_seperator) then + pos1 = i + cycle + end if + n = n+1 + process_to_extparticlelist(n) = ID_to_extparticle(c(pos1+1:i-1)) + if (present(is_initial)) process_to_extparticlelist(n)%is_initial = is_initial + pos1 = i + last_seperator = .true. + else + last_seperator = .false. + end if + end do + end function process_to_extparticlelist + + + subroutine ol_printparameter(filename) + ! Write parameters to a file. + ! [in] filename + use ol_parameters_init_/**/DREALKIND, only: parameters_write + implicit none + character(len=*), intent(in) :: filename + call parameters_write(filename) + end subroutine ol_printparameter + + + subroutine ol_printparameter_c(filename) bind(c,name="ol_printparameter") + ! C wrapper to ol_printparameter + ! [in] filename as C string + use ol_iso_c_utilities, only: c_f_string + implicit none + character(kind=c_char), dimension(*), intent(in) :: filename + character(len=max_parameter_length) :: f_filename + call c_f_string(filename, f_filename, max_parameter_length) + call ol_printparameter(trim(f_filename)) + end subroutine ol_printparameter_c + + function register_process_c(process, amptype) bind(c,name="ol_register_process") use ol_iso_c_utilities, only: c_f_string use ol_parameters_decl_/**/DREALKIND, only: max_parameter_length @@ -1545,12 +1903,11 @@ subroutine stop_invalid_id(id) implicit none integer, intent(in) :: id if (id <= 0 .or. id > last_process_id) then - print *, "[OpenLoops] Error: no registered process with id " // to_string(id) - stop + call ol_fatal("Error: no registered process with id " // to_string(id)) + return end if end subroutine stop_invalid_id - pure function amplitudetype(id) ! [in] id: a process id ! return amptype of type integer @@ -1571,13 +1928,24 @@ function amplitudetype_c(id) bind(c,name="ol_amplitudetype") ! [in] id: a process id ! return amptype of type integer implicit none - integer(c_int), intent(in) :: id - integer(c_int) amplitudetype_c + integer(c_int), value :: id + integer(c_int) :: amplitudetype_c call stop_invalid_id(int(id)) + if (error > 1) return amplitudetype_c = process_handles(int(id))%amplitude_type end function amplitudetype_c + function library_content_c(id) bind(c,name='ol_library_content') + implicit none + integer(c_int), value :: id + integer(c_int) :: library_content_c + call stop_invalid_id(int(id)) + if (error > 1) return + library_content_c = process_handles(int(id))%content + end function library_content_c + + pure function n_external(id) implicit none integer, intent(in) :: id @@ -1597,6 +1965,7 @@ function n_external_c(id) bind(c,name="ol_n_external") integer(c_int), value :: id integer(c_int) :: n_external_c call stop_invalid_id(int(id)) + if (error > 1) return n_external_c = process_handles(int(id))%n_particles end function n_external_c @@ -1608,6 +1977,7 @@ subroutine phase_space_point(id, sqrt_s, psp) real(DREALKIND), intent(out) :: psp(:,:) type(process_handle) :: subprocess call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) call subprocess%set_permutation(subprocess%permutation) n_scatt = subprocess%n_in @@ -1619,17 +1989,19 @@ subroutine phase_space_point_c(id, sqrt_s, pp) bind(c,name="ol_phase_space_point implicit none integer(c_int), value :: id real(c_double), value :: sqrt_s - real(c_double), intent(out) :: pp(5*n_external(id)) - integer :: f_id + real(c_double), intent(out) :: pp(5*n_external(int(id))) + type(process_handle) :: subprocess + integer :: i real(DREALKIND) :: f_sqrt_s - real(DREALKIND) :: f_psp(0:3,n_external(id)) + real(DREALKIND) :: f_psp(0:3,n_external(int(id))) ! call stop_invalid_id(id) not needed here - f_id = id + i = id f_sqrt_s = sqrt_s - call phase_space_point(f_id, f_sqrt_s, f_psp) - do f_id = 1, n_external(id) - pp(5*(f_id-1)+1:5*(f_id-1)+4) = f_psp(0:3,f_id) - pp(5*f_id) = -1 + subprocess = process_handles(i) + call phase_space_point(i, f_sqrt_s, f_psp) + do i = 1, subprocess%n_particles + pp(5*(i-1)+1:5*(i-1)+4) = f_psp(0:3,i) + pp(5*i) = subprocess%masses(i) end do end subroutine phase_space_point_c @@ -1644,10 +2016,11 @@ subroutine tree_colbasis_dim(id, ncolb, colelemsz, nhel) integer, intent(out) :: ncolb, colelemsz, nhel integer :: extcols(n_external(id)), ncoupl, maxpows, ncolext call stop_invalid_id(id) + if (error > 1) return if (.not. associated(process_handles(id)%tree_colbasis_dim)) then - print *, "[OpenLoops] Error: colour basis information is not available" - print *, " for process " // process_handles(id)%process_name - stop + call ol_msg("Error: colour basis information is not available") + call ol_fatal(" for process " // process_handles(id)%process_name) + return end if call process_handles(id)%tree_colbasis_dim(extcols, ncolb, ncoupl, maxpows, nhel) ncolext = count(extcols /= 0) @@ -1731,6 +2104,7 @@ subroutine tree_colbasis(id, basis, needed) integer :: ncol2ext(n_external(id)), invextperm(n_external(id)) logical :: powok call stop_invalid_id(id) + if (error > 1) return call process_handles(id)%tree_colbasis_dim(extcols, ncolb, ncoupl, maxpows, nhel) ! number of coloured external particles ncolext = 0 @@ -1807,10 +2181,17 @@ end subroutine tree_colbasis_c subroutine start() bind(c,name="ol_start") - use ol_parameters_decl_/**/DREALKIND, only: write_params_at_start + use ol_parameters_decl_/**/DREALKIND, only: & + & write_params_at_start, stability_logdir_not_created, stability_log, stability_logdir use ol_parameters_init_/**/DREALKIND, only: parameters_write + use ol_dirent, only: mkdir implicit none + integer :: mkdirerr call parameters_flush() + if (stability_logdir_not_created .and. stability_log > 0) then + stability_logdir_not_created = .false. + mkdirerr = mkdir(stability_logdir) + end if if (write_params_at_start) call parameters_write() end subroutine @@ -1834,17 +2215,19 @@ subroutine evaluate_tree(id, psp, res) real(DREALKIND), intent(in) :: psp(:,:) real(DREALKIND), intent(out) :: res real(DREALKIND) :: m2cc(0:n_external(id)*(n_external(id)+1)/2+1) - real(DREALKIND) :: resmunu + real(DREALKIND) :: resmunu(4,4) type(process_handle) :: subprocess call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) if (.not. btest(subprocess%content, 0)) then - write(*,*) '[OpenLoops] evaluate: tree routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal("evaluate: tree routine not available for process " // trim(to_string(id))) + return end if - call subprocess%set_permutation(subprocess%permutation) n_scatt = subprocess%n_in - call parameters_flush() + call tree_parameters_flush() + call subprocess%set_permutation(subprocess%permutation) + if (subprocess%has_pol) call subprocess%pol_init(subprocess%pol) call subprocess%tree(psp, m2cc, 0, & & [0._/**/DREALKIND, 0._/**/DREALKIND, 0._/**/DREALKIND, 0._/**/DREALKIND], & & 1, [0], resmunu) @@ -1862,6 +2245,7 @@ subroutine evaluate_tree_c(id, pp, res) bind(c,name="ol_evaluate_tree") real(DREALKIND) :: f_res f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) call evaluate_tree(f_id, f_pp(0:3,:), f_res) res = f_res @@ -1923,18 +2307,19 @@ subroutine evaluate_cc(id, psp, tree, cc, ewcc) real(DREALKIND), intent(out) :: tree, cc(:), ewcc type(process_handle) :: subprocess real(DREALKIND) :: m2cc(0:n_external(id)*(n_external(id)+1)/2+1) ! keep +1 for compatibility - real(DREALKIND) :: resmunu + real(DREALKIND) :: resmunu(4,4) integer :: n_cc, i, j call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) if (.not. btest(subprocess%content, 0)) then - write(*,*) '[OpenLoops] evaluate: cc routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal('evaluate: cc routine not available for process ' // trim(to_string(id))) + return end if + n_scatt = subprocess%n_in call subprocess%set_permutation(subprocess%permutation) n_cc = subprocess%n_particles*(subprocess%n_particles+1)/2 - n_scatt = subprocess%n_in - call parameters_flush() + call tree_parameters_flush() call subprocess%tree(psp, m2cc, 0, & & [0._/**/DREALKIND, 0._/**/DREALKIND, 0._/**/DREALKIND, 0._/**/DREALKIND], & & n_cc, [(i, i = 0, n_cc)], resmunu) @@ -1958,6 +2343,7 @@ subroutine evaluate_cc_c(id, pp, tree, cc, ewcc) bind(c,name="ol_evaluate_cc") real(DREALKIND) :: f_tree, f_cc(rval_size(n_external(id),2)), f_ewcc f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) call evaluate_cc(f_id, f_pp(0:3,:), f_tree, f_cc, f_ewcc) tree = f_tree @@ -1983,17 +2369,18 @@ subroutine evaluate_ccmatrix(id, psp, tree, ccij, ewcc) type(process_handle) :: subprocess real(DREALKIND) :: m2cc(0:n_external(id)*(n_external(id)+1)/2+1) integer :: n_cc, i, j - real(DREALKIND) :: resmunu + real(DREALKIND) :: resmunu(4,4) call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) if (.not. btest(subprocess%content, 0)) then - write(*,*) '[OpenLoops] evaluate: cc routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal('evaluate: cc routine not available for process ' // trim(to_string(id))) + return end if + n_scatt = subprocess%n_in call subprocess%set_permutation(subprocess%permutation) n_cc = subprocess%n_particles*(subprocess%n_particles+1)/2+1 - n_scatt = subprocess%n_in - call parameters_flush() + call tree_parameters_flush() call subprocess%tree(psp, m2cc, 0, & & [0._/**/DREALKIND, 0._/**/DREALKIND, 0._/**/DREALKIND, 0._/**/DREALKIND], & & n_cc, [(i, i = 0, n_cc)], resmunu) @@ -2018,6 +2405,7 @@ subroutine evaluate_ccmatrix_c(id, pp, tree, ccij, ewcc) bind(c,name="ol_evaluat real(DREALKIND) :: f_tree, f_ccij(n_external(id),n_external(id)), f_ewcc f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) call evaluate_ccmatrix(f_id, f_pp(0:3,:), f_tree, f_ccij, f_ewcc) tree = f_tree @@ -2042,12 +2430,13 @@ subroutine evaluate_sc(id, psp, emitter, polvect, res) type(process_handle) :: subprocess integer :: j, extcombs(n_external(id)) real(DREALKIND) :: m2sc(0:n_external(id)*(n_external(id)+1)/2+1) - real(DREALKIND) :: resmunu + real(DREALKIND) :: resmunu(4,4) call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) if (.not. btest(subprocess%content, 0)) then - write(*,*) '[OpenLoops] evaluate: sc routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal('evaluate: sc routine not available for process ' // trim(to_string(id))) + return end if do j = 1, subprocess%n_particles if (j <= emitter) then @@ -2057,7 +2446,7 @@ subroutine evaluate_sc(id, psp, emitter, polvect, res) end if end do n_scatt = subprocess%n_in - call parameters_flush() + call tree_parameters_flush() call subprocess%tree(psp, m2sc, emitter, polvect, subprocess%n_particles, extcombs, resmunu) do j = 1, subprocess%n_particles res(j) = m2sc(extcombs(j)) @@ -2075,6 +2464,7 @@ subroutine evaluate_sc_c(id, pp, emitter, polvect, res) bind(c,name="ol_evaluate real(DREALKIND) :: f_res(n_external(id)) f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) f_emitter = emitter f_polvect = polvect @@ -2098,14 +2488,15 @@ subroutine evaluate_scpowheg(id, psp, emitter, res, resmunu) type(process_handle) :: subprocess real(DREALKIND) :: m2cc(0:n_external(id)*(n_external(id)+1)/2+1) call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) if (.not. btest(subprocess%content, 0)) then - write(*,*) '[OpenLoops] evaluate: scpowheg routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal('evaluate: scpowheg routine not available for process ' // trim(to_string(id))) + return end if - call subprocess%set_permutation(subprocess%permutation) n_scatt = subprocess%n_in - call parameters_flush() + call subprocess%set_permutation(subprocess%permutation) + call tree_parameters_flush() call subprocess%tree(psp, m2cc, -emitter, & & [0._/**/DREALKIND, 0._/**/DREALKIND, 0._/**/DREALKIND, 0._/**/DREALKIND], & & 1, [0], resmunu) @@ -2123,6 +2514,7 @@ subroutine evaluate_scpowheg_c(id, pp, emitter, res, resmunu) bind(c,name="ol_ev real(DREALKIND) :: f_res, f_resmunu(4,4) f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) f_emitter = emitter call evaluate_scpowheg(f_id, f_pp(0:3,:), f_emitter, f_res, f_resmunu) @@ -2133,23 +2525,57 @@ end subroutine evaluate_scpowheg_c subroutine evaluate_full(id, psp, m2l0, m2l1, ir1, m2l2, ir2, acc) use ol_stability use ol_generic, only: to_string + use ol_parameters_decl_/**/DREALKIND, only: add_associated_ew + use ol_parameters_decl_/**/DREALKIND, only: rMZ + use ol_loop_parameters_decl_/**/DREALKIND, only: IR_is_on implicit none integer, intent(in) :: id real(DREALKIND), intent(in) :: psp(:,:) real(DREALKIND), intent(out) :: m2l0, m2l1(0:2), ir1(0:2), m2l2(0:4), ir2(0:4) real(DREALKIND), intent(out) :: acc - type(process_handle) :: subprocess + real(DREALKIND) :: m2l0ew, m2l1ew(0:2), ir1ew(0:2), m2l2ew(0:4), ir2ew(0:4) + integer :: IR_is_on_bak + type(process_handle) :: subprocess, subprocessew call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) if (.not. btest(subprocess%content, 1)) then - write(*,*) '[OpenLoops] evaluate: loop routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal('evaluate: loop routine not available for process ' // trim(to_string(id))) + return end if - call subprocess%set_permutation(subprocess%permutation) n_scatt = subprocess%n_in + call subprocess%set_permutation(subprocess%permutation) + if (subprocess%has_pol) call subprocess%pol_init(subprocess%pol) call parameters_flush() call subprocess%loop(psp, m2l0, m2l1, ir1, m2l2, ir2) acc = last_relative_deviation + ! add associated one-loop ew + if (add_associated_ew == 1 .and. subprocess%associated_ew > 0) then + subprocessew = process_handles(subprocess%associated_ew) + if (.not. btest(subprocessew%content, 1)) then + call ol_fatal('evaluate: loop routine not available for associated process ' // trim(to_string(subprocess%associated_ew))) + return + end if + n_scatt = subprocessew%n_in + call subprocessew%set_permutation(subprocessew%permutation) + IR_is_on_bak = IR_is_on + IR_is_on = 0 + call set_parameter("mureg", rMZ) + call set_parameter("ew_renorm", 1) + if (subprocessew%has_pol) call subprocessew%pol_init(subprocessew%pol) + call parameters_flush() + call subprocessew%loop(psp, m2l0ew, m2l1ew, ir1ew, m2l2ew, ir2ew) + IR_is_on = IR_is_on_bak + m2l1 = m2l1 + m2l1ew + acc = max(acc, last_relative_deviation) + call set_parameter("ew_renorm", 0) + else if (add_associated_ew == 1 .and. subprocess%associated_ew <= 0) then + call ol_error("evaluate_full: associated EW library not loaded -> only QCD used.") + end if + ! Return I-Operator as vamp (for debug) + if (IR_is_on == 3) then + m2l1 = ir1 + end if end subroutine evaluate_full @@ -2164,6 +2590,7 @@ subroutine evaluate_full_c(id, pp, m2l0, m2l1, ir1, m2l2, ir2, acc) bind(c,name= real(DREALKIND) :: f_acc f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) call evaluate_full(f_id, f_pp(0:3,:), f_m2l0, f_m2l1, f_ir1, f_m2l2, f_ir2, f_acc) m2l0 = f_m2l0 @@ -2197,6 +2624,7 @@ subroutine evaluate_loop_c(id, pp, m2l0, m2l1, acc) bind(c,name="ol_evaluate_loo real(DREALKIND) :: f_acc f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) call evaluate_loop(f_id, f_pp(0:3,:), f_m2l0, f_m2l1, f_acc) m2l0 = f_m2l0 @@ -2214,8 +2642,8 @@ subroutine evaluate_loop2(id, psp, res, acc) real(DREALKIND), intent(out) :: acc real(DREALKIND) :: m2l0, m2l1(0:2), ir1(0:2), m2l2(0:4), ir2(0:4) if (.not. btest(process_handles(id)%content, 2)) then - write(*,*) '[OpenLoops] evaluate: loop^2 routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal('evaluate: loop^2 routine not available for process ' // trim(to_string(id))) + return end if call evaluate_full(id, psp, m2l0, m2l1, ir1, m2l2, ir2, acc) res = m2l2(0) @@ -2232,6 +2660,7 @@ subroutine evaluate_loop2_c(id, pp, res, acc) bind(c,name="ol_evaluate_loop2") real(DREALKIND) :: f_res, f_acc f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) call evaluate_loop2(f_id, f_pp(0:3,:), f_res, f_acc) res = f_res @@ -2240,23 +2669,45 @@ end subroutine evaluate_loop2_c subroutine evaluate_ct(id, psp, m2l0, m2ct) + use ol_parameters_decl_/**/DREALKIND, only: add_associated_ew + use ol_parameters_decl_/**/DREALKIND, only: rMZ use ol_stability use ol_generic, only: to_string implicit none integer, intent(in) :: id real(DREALKIND), intent(in) :: psp(:,:) real(DREALKIND), intent(out) :: m2l0, m2ct - type(process_handle) :: subprocess + real(DREALKIND) :: m2l0ew, m2ctew + type(process_handle) :: subprocess, subprocessew call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) if (.not. btest(subprocess%content, 1)) then - write(*,*) '[OpenLoops] evaluate: ct routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal('evaluate: ct routine not available for process ' // trim(to_string(id))) + return end if - call subprocess%set_permutation(subprocess%permutation) n_scatt = subprocess%n_in + call subprocess%set_permutation(subprocess%permutation) + if (subprocess%has_pol) call subprocess%pol_init(subprocess%pol) call parameters_flush() call subprocess%ct(psp, m2l0, m2ct) + if (add_associated_ew == 1 .and. subprocess%associated_ew > 0) then + subprocessew = process_handles(subprocess%associated_ew) + if (.not. btest(subprocessew%content, 1)) then + call ol_fatal('evaluate: loop routine not available for associated process ' // trim(to_string(subprocess%associated_ew))) + return + end if + n_scatt = subprocess%n_in + call subprocessew%set_permutation(subprocessew%permutation) + call set_parameter("mureg", rMZ) + call set_parameter("ew_renorm", 1) + call parameters_flush() + call subprocessew%ct(psp, m2l0ew, m2ctew) + m2ct = m2ct + m2ctew + call set_parameter("ew_renorm", 0) + else if (add_associated_ew == 1 .and. subprocess%associated_ew <= 0) then + call ol_error("evaluate_ct: associated EW library not loaded -> only QCD used.") + end if end subroutine evaluate_ct @@ -2270,6 +2721,7 @@ subroutine evaluate_ct_c(id, pp, m2l0, m2ct) bind(c,name="ol_evaluate_ct") real(DREALKIND) :: f_m2l0, f_m2ct f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) call evaluate_ct(f_id, f_pp(0:3,:), f_m2l0, f_m2ct) m2l0 = f_m2l0 @@ -2286,13 +2738,14 @@ subroutine evaluate_pt(id, psp, m2l0, m2pt, m2l1) real(DREALKIND), intent(out) :: m2l0, m2pt, m2l1 type(process_handle) :: subprocess call stop_invalid_id(id) + if (error > 1) return subprocess = process_handles(id) if (.not. btest(subprocess%content, 3)) then - write(*,*) '[OpenLoops] evaluate: ct routine not available for process ' // trim(to_string(id)) - stop + call ol_fatal('evaluate: ct routine not available for process ' // trim(to_string(id))) + return end if - call subprocess%set_permutation(subprocess%permutation) n_scatt = subprocess%n_in + call subprocess%set_permutation(subprocess%permutation) call parameters_flush() call subprocess%pt(psp, m2l0, m2pt, m2l1) end subroutine evaluate_pt @@ -2308,6 +2761,7 @@ subroutine evaluate_pt_c(id, pp, m2l0, m2pt, m2l1) bind(c,name="ol_evaluate_pt") real(DREALKIND) :: f_m2l0, f_m2pt, f_m2l1 f_id = id call stop_invalid_id(f_id) ! needed because of reshape + if (error > 1) return f_pp = reshape(pp, [5,process_handles(id)%n_particles]) call evaluate_pt(f_id, f_pp(0:3,:), f_m2l0, f_m2pt, f_m2l1) m2l0 = f_m2l0 diff --git a/lib_src/openloops/src/parameters.F90 b/lib_src/openloops/src/parameters.F90 index 092c778a..0a962027 100644 --- a/lib_src/openloops/src/parameters.F90 +++ b/lib_src/openloops/src/parameters.F90 @@ -22,7 +22,7 @@ module ol_data_types_/**/REALKIND type wfun ! four complex components for the wave function complex(REALKIND) :: j(4) - ! indicator if left- or right components of of-sheel line vanish + ! indicator if left- or right components of of-shell line vanish ! j= (0,0,0,0) (0,0,j3,j4) (j1,j2,0,0) (j1,j2,j3,j4) integer(intkind1) :: h ! B"00" B"01" B"10" B"11" integer(intkind2) :: e ! helicities of external on-shell lines @@ -67,6 +67,7 @@ end module ol_global_decl module ol_momenta_decl_/**/REALKIND use KIND_TYPES, only: REALKIND use ol_global_decl, only: MaxParticles + use ol_debug, only: ol_msg implicit none ! Internal momenta for up to 'MaxParticles' external particles ! Components 1:4 = light cone representation; component 5 = squared momentum @@ -84,13 +85,13 @@ function momenta_nan_check(P) momenta_nan_check = 0 else ! contains NaN - write(*,*) "[OpenLoops] === WARNING ===" - write(*,*) "[OpenLoops] corrupted phase space point:" + call ol_msg("=== WARNING ===") + call ol_msg("corrupted phase space point:") do i = 1, size(P,2) write(*,*) P(:,i) end do momenta_nan_check = 1 - write(*,*) "[OpenLoops] ===============" + call ol_msg("===============") end if end function momenta_nan_check @@ -156,17 +157,16 @@ module ol_parameters_decl_/**/REALKIND integer, save :: parameters_status = 0 #ifdef PRECISION_dp integer, save :: parameters_verbose = 0 - integer, save :: verbose = 0 integer, parameter :: procname_length = 80 character(procname_length) :: current_processname = 'none' ! set by vamp2generic() integer, parameter :: max_parameter_length = 255 ! used for stability_logdir, install_path, ! contract_file, printparameter file integer, parameter :: max_parameter_name_length = 30 ! maximal length of parameter names in init routines ! 0: never, 1: on finish() call, 2: adaptive, 3: always - integer, save :: stability_log = 2 + integer, save :: stability_log = 0 integer, save :: write_psp = 0 ! write out phase space points from vamp2generic is called integer, save :: use_me_cache = 1 - integer, save :: parameters_changed = 0 + integer, save :: parameters_changed = 1 ! unchanged: ME for the same psp can be taken from cache character(len=max_parameter_length) :: stability_logdir = "stability_log" character(len=max_parameter_length) :: tmp_dir = "." character(len=max_parameter_length) :: allowed_libs = "" @@ -196,8 +196,10 @@ module ol_parameters_decl_/**/REALKIND ! in the tensor library cache system integer, save :: next_channel_number = 1 integer, save :: coli_cache_use = 1 - ! select alpha_QED renormalization scheme: 0 = on-shell scheme, 1 = G_mu scheme - integer, save :: ew_scheme = 1 + ! select alpha_QED input scheme: 0 = on-shell = alpha(0), 1 = G_mu, 2 = alpha(MZ) + integer, save :: ew_scheme = 2 + ! select alpha_QED renormalization scheme: 0 = on-shell = alpha(0), 1 = G_mu, 2 = alpha(MZ) + integer, save :: ew_renorm_scheme = 2 ! coupling order integer :: coupling_QCD(0:1) = -1 integer :: coupling_EW(0:1) = -1 @@ -209,6 +211,10 @@ module ol_parameters_decl_/**/REALKIND integer, save :: ew_renorm_switch = 3 integer, save :: do_ew_renorm = 0 integer, save :: cms_on = 1 + ! select only specific polarization of external vector bosons + ! 0: both, 1: only transverse, 2: only longitudinal + integer, save :: select_pol_V = 0 + integer :: add_associated_ew = 0 #endif ! Numerical constants @@ -259,7 +265,11 @@ module ol_parameters_decl_/**/REALKIND real(REALKIND), save :: MREG_unscaled = 1._/**/REALKIND ! collinear mass regulator for photon WF CT ! Coupling constants real(REALKIND), save :: alpha_QCD = 0.1258086856923967_/**/REALKIND ! LO MRST - real(REALKIND), save :: alpha_QED = 1/128._/**/REALKIND + real(REALKIND), save :: alpha_QED_MZ = 1/128._/**/REALKIND ! alpha(MZ) derived from PDG 2014 + real(REALKIND), save :: alpha_QED_0 = 1/137.035999074_/**/REALKIND ! alpha(0) from PDG 2014 + real(REALKIND), save :: alpha_QED + real(REALKIND), save :: Gmu_unscaled = 0.0000116637_/**/REALKIND ! G_mu + real(REALKIND), save :: Gmu ! Everything beyond this line is derived from the values given above and initialised by parameters_init(). real(REALKIND), save :: rescalefactor = 1.1 ! scaled masses, widths and yukawas @@ -278,13 +288,13 @@ module ol_parameters_decl_/**/REALKIND real(REALKIND), save :: rMX, wMX real(REALKIND), save :: rMY, wMY ! Complex masses, complex and real squared masses - complex(REALKIND), save :: ME, MM, ML, MU, MD, MS, MC, MB, MT, MW, MZ, MH, MX, MY - complex(REALKIND), save :: ME2, MM2, ML2, MU2, MD2, MS2, MC2, MB2, MT2, MW2, MZ2, MH2, MX2, MY2 + complex(REALKIND), save :: ME, MM, ML, MU, MD, MS, MC, MB, MT, MW, MZ, MH, MX, MY + complex(REALKIND), save :: ME2, MM2, ML2, MU2, MD2, MS2, MC2, MB2, MT2, MW2, MZ2, MH2, MX2, MY2 complex(REALKIND), save :: YE, YM, YL, YU, YD, YS, YC, YB, YT complex(REALKIND), save :: YE2, YM2, YL2, YU2, YD2, YS2, YC2, YB2, YT2 - complex(REALKIND), save :: YC2pair, YB2pair, YT2pair ! pair masses: only non-zero if the SU(2) partner is active real(REALKIND), save :: rYE2, rYM2, rYL2, rYU2, rYD2, rYS2, rYC2, rYB2, rYT2 real(REALKIND), save :: rME2, rMM2, rML2, rMU2, rMD2, rMS2, rMC2, rMB2, rMT2, rMW2, rMZ2, rMH2, rMX2, rMY2 + complex(REALKIND), save :: YC2pair, YB2pair, YT2pair ! pair masses: only non-zero if the SU(2) partner is active ! collinear mass regulator for photon WF CT real(REALKIND), save :: MREG ! Coupling constants @@ -320,7 +330,27 @@ module ol_parameters_decl_/**/REALKIND ! take the following real for the moment. In general can be complex real(REALKIND), save :: epsilonWqq(3) = 0 real(REALKIND), save :: epsilonWln(3) = 0 - + ! 2HDM parameters + ! thdm_a ("alpha") is the (h0, H0) mixing angle, + ! thdmTB is the ratio of the VEVs of the two Higgs doublets + integer, save :: thdm_type = 2 ! 2HDM Type I or Type II + real(REALKIND), save :: rMA0_unscaled = 130, wMA0_unscaled = 0 ! pseudoscalar Higgs mass and width + real(REALKIND), save :: rMHH_unscaled = 140, wMHH_unscaled = 0 ! heavy higgs mass and width + real(REALKIND), save :: rMHp_unscaled = 150, wMHp_unscaled = 0 ! charged Higgs mass and width + real(REALKIND), save :: rMA0, wMA0, rMA02 + real(REALKIND), save :: rMHH, wMHH, rMHH2 + real(REALKIND), save :: rMHp, wMHp, rMHp2 + complex(REALKIND), save :: MA0, MA02, MHH, MHH2, MHp, MHp2 + ! basic parameters: tan(beta), sin(beta-alpha), lambda5 + real(REALKIND), save :: thdmTB = 1, thdmSBA = 1, thdmL5 = 0 + real(REALKIND), save :: thdm_a, thdm_b + real(REALKIND), save :: thdmCA, thdmSA, thdmCB, thdmSB + real(REALKIND), save :: thdmC2A, thdmS2A, thdmC2B, thdmS2B + real(REALKIND), save :: thdmCAB, thdmSAB, thdmCBA + ! Type I/II dependent couplins + real(REALKIND), save :: thdmYuk1, thdmYuk2, thdmYuk3 + ! Charged Higgs-fermion left/right couplings + complex(REALKIND), save :: thdmHpud(2), thdmHpdu(2), thdmHpcs(2), thdmHpsc(2), thdmHptb(2), thdmHpbt(2) end module ol_parameters_decl_/**/REALKIND @@ -347,7 +377,7 @@ module ol_loop_parameters_decl_/**/REALKIND integer, save :: loop_parameters_status = 0 #ifdef PRECISION_dp - integer, save :: maxpoint = 6 + integer, save :: maxpoint = 6, maxpoint_active = -1 integer, save :: maxrank = 6 integer, save :: norm_swi = 0 ! switch controlling normalisation of UV/IR poles character(10), save :: norm_name @@ -366,29 +396,31 @@ module ol_loop_parameters_decl_/**/REALKIND integer, save :: deviation_mode = 1 ! deviation measure in vamp scaling based on ! (1) k-factor (2) virtual matrix element - real(REALKIND), save :: trigeff_targ = .2 ! target efficiency of K-factor based stability trigger (should not be << 0.1) - real(REALKIND), save :: abscorr_unst = 0.01 ! absolute correction discrepancy above which a point is considered "unstable" - real(REALKIND), save :: ratcorr_bad = 1 ! relative deviation to two virtual matrix elements above which + real(REALKIND), save :: trigeff_targ = .2_/**/REALKIND ! target efficiency of K-factor based stability trigger (should not be << 0.1) + real(REALKIND), save :: abscorr_unst = 0.01_/**/REALKIND ! relative deviation above which a point is considered "unstable" and + ! reevaluated in quad precision (if active); also logs the point in 2x modes + real(REALKIND), save :: ratcorr_bad = 1 ! relative deviation of two virtual matrix elements above which ! an unstable point is considered "bad" and possibly "killed" ! (i.e. the finite part of the virtual correcton is set to zero) - real(REALKIND), save :: ratcorr_bad_L2 = 10 ! relative deviation to two virtual matrix elements above which + real(REALKIND), save :: ratcorr_bad_L2 = 10 ! relative deviation of two virtual matrix elements above which ! an unstable point is killed in loop induced amplitudes ! Collier parameters - integer, save :: cll_channels = 50 ! number of cache channels + integer, save :: cll_channels = 50, cll_channels_active = -1 ! number of cache channels real(REALKIND), save :: C_PV_threshold = 1.e-6 ! threshold precision to activate 3-point alternative reductions real(REALKIND), save :: D_PV_threshold = 1.e-6 ! threshold precision to activate 4-point alternative reductions integer, save :: dd_red_mode = 2 ! PV or alternative 3/4-point reductions ! setaccuracy_cll() arguments - real(REALKIND), save :: cll_pvthr = 1.e-6, cll_accthr = 1.e-4, cll_mode3thr = 1.e-8 + real(REALKIND), save :: cll_pvthr = 1.e-6_/**/REALKIND, cll_accthr = 1.e-4_/**/REALKIND + real(REALKIND), save :: cll_mode3thr = 1.e-8_/**/REALKIND integer, save :: cll_tenred = 7 ! settenred_cll(): # of legs from which on component reduction is used real(REALKIND), save :: ti_os_thresh = 1.e-10 ! CutTools parameters real(REALKIND), save :: opprootsvalue_unscaled = 1000 real(REALKIND), save :: opprootsvalue - real(REALKIND), save :: opplimitvalue = 0.01 - real(REALKIND), save :: oppthrs = 1.e-6 + real(REALKIND), save :: opplimitvalue = 0.01_/**/REALKIND + real(REALKIND), save :: oppthrs = 1.e-6_/**/REALKIND integer, save :: oppidig = 0 integer, save :: oppscaloop = 2 #ifndef USE_ONELOOP @@ -435,7 +467,9 @@ module ol_loop_parameters_decl_/**/REALKIND real(REALKIND), save :: de1_IR = 0 ! numerical value of single IR pole (independent of norm-convention) real(REALKIND), save :: de2_i_IR = 0 ! numerical value of double IR pole using actual norm-convention real(REALKIND), save :: de2_i_shift = 0 ! double pole shift defining actual norm convention - real(REALKIND), save :: mureg_unscaled = 100 ! renormalisation scale + real(REALKIND), save :: muren_unscaled = 100 ! renormalisation scale + real(REALKIND), save :: mureg_unscaled = 100 ! regularization scale + real(REALKIND), save :: muren real(REALKIND), save :: mureg real(REALKIND), save :: x_UV = 1 ! rescaling factor for dim-reg scale in UV-divergent quantities real(REALKIND), save :: x_IR = 1 ! rescaling factor for dim-reg scale in IR-divergent quantities @@ -450,7 +484,8 @@ module ol_loop_parameters_decl_/**/REALKIND ! the following derived parameters are initilised by subroutine loop_parameters_init real(REALKIND), save :: de2_0_IR ! numerical value of double IR pole using LH-accord convention (i=0) real(REALKIND), save :: de2_1_IR ! numerical value of double IR pole using COLI convention (i=1) - real(REALKIND), save :: mureg2 ! squared renormalisation scale + real(REALKIND), save :: muren2 ! squared renormalisation scale + real(REALKIND), save :: mureg2 ! squared regularization scale real(REALKIND), save :: mu2_UV ! dim-reg scale for UV-divergent quantities real(REALKIND), save :: mu2_IR ! dim-reg scale for IR-divergent quantities real(REALKIND), save :: muyc2 ! squared yukawa renormalization scale for c quark @@ -502,6 +537,8 @@ module ol_loop_parameters_decl_/**/REALKIND ! Additional parameters for R2 complex(REALKIND), save :: MQ2sum, MQ2sumpairs + complex(REALKIND), save :: YQD2sum, YQU2sum + complex(REALKIND), save :: YQD2sumpairs, YQU2sumpairs ! Additional counterterms for R2 QCD complex(REALKIND), save :: ctZGG @@ -526,6 +563,12 @@ module ol_loop_parameters_decl_/**/REALKIND real(REALKIND), save :: R2HEFThqq real(REALKIND), save :: R2HEFTghqq + ! 2HDM + complex(REALKIND), save :: thdmctHpsc(2), thdmctHpbt(2), thdmctHpcs(2), thdmctHptb(2) + complex(REALKIND), save :: thdmctHGG, thdmctHh0GG, thdmctHHGG, thdmctHHhGG + complex(REALKIND), save :: thdmctXA0GG, thdmctHhHhGG, thdmctA0A0GG + complex(REALKIND), save :: thdmctPHpGG, thdmctHpHpGG + ! EW_renormalisation renormalisation constants complex(REALKIND), save :: dZMBEW = 0 ! bottom-quark mass RC : MB_bare = MB+dZMBEW) complex(REALKIND), save :: dZMTEW = 0 ! top-quark mass RC : MT_bare = MT+dZMTEW) diff --git a/lib_src/openloops/src/parameters_init.F90 b/lib_src/openloops/src/parameters_init.F90 index 460d4f7e..a2c60502 100644 --- a/lib_src/openloops/src/parameters_init.F90 +++ b/lib_src/openloops/src/parameters_init.F90 @@ -30,12 +30,13 @@ subroutine masspowers(rM, Ga, M, M2, rM2) complex(REALKIND), intent(out) :: M, M2 real(REALKIND), intent(out) :: rM2 M2 = rM*rM - CI*rM*Ga - if ( cms_on == 0 ) then + if (cms_on == 0) then M = rM rM2 = rM*rM else - M = sqrt(M2) + M = sqrt(M2) rM2 = real(M2) + if (rM < 0) M = -M end if end subroutine masspowers @@ -58,9 +59,6 @@ subroutine parameters_init(Mass_E, Mass_M, Mass_L, Mass_U, Mass_D, Mass_S, Mass_ use ol_parameters_decl_/**/REALKIND #if defined(COLLIER_LEGACY) && defined(USE_COLLIER) use bt_TI_lib_switch, only: TI_library ! from COLI: module to switch between COLI and DD libraries -#endif -#ifdef USE_IFORT - use ifport, only: getpid, system #endif use ol_version, only: splash_todo, print_welcome implicit none @@ -74,7 +72,6 @@ subroutine parameters_init(Mass_E, Mass_M, Mass_L, Mass_U, Mass_D, Mass_S, Mass_ integer, intent(in), optional :: check_Ward_tree, check_Ward_loop integer, intent(in), optional :: out_symmetry integer, intent(in), optional :: leading_colour - integer :: dummy if (parameters_status == 0) then pid_string = trim(to_string(getpid())) // "-" // random_string(4) @@ -84,11 +81,6 @@ subroutine parameters_init(Mass_E, Mass_M, Mass_L, Mass_U, Mass_D, Mass_S, Mass_ call print_welcome() end if - if (stability_logdir_not_created .and. stability_log > 0) then - stability_logdir_not_created = .false. - dummy = system("mkdir -p " // trim(stability_logdir)) - end if - ! Mode switches if (present(last_switch)) l_switch = last_switch if (present(amp_switch)) a_switch = amp_switch @@ -198,7 +190,17 @@ subroutine parameters_init(Mass_E, Mass_M, Mass_L, Mass_U, Mass_D, Mass_S, Mass_ wMY = scalefactor * wMY_unscaled rMH = scalefactor * rMH_unscaled wMH = scalefactor * wMH_unscaled - MREG= scalefactor * MREG_unscaled + + rMA0 = scalefactor * rMA0_unscaled + wMA0 = scalefactor * wMA0_unscaled + rMHH = scalefactor * rMHH_unscaled + wMHH = scalefactor * wMHH_unscaled + rMHp = scalefactor * rMHp_unscaled + wMHp = scalefactor * wMHp_unscaled + + MREG = scalefactor * MREG_unscaled + + Gmu = Gmu_unscaled / scalefactor**2 ! ifdef PRECISION_dp #else @@ -208,21 +210,26 @@ subroutine parameters_init() use KIND_TYPES, only: REALKIND use ol_parameters_decl_/**/REALKIND use ol_parameters_decl_/**/DREALKIND, only: & - & parameters_verbose, scalefactor_dp => scalefactor, cms_on => cms_on, & - & parameters_status_dp => parameters_status, alpha_QED_dp => alpha_QED, alpha_QCD_dp => alpha_QCD, & + & model, parameters_verbose, scalefactor_dp => scalefactor, cms_on => cms_on, ew_scheme => ew_scheme, & + & parameters_status_dp => parameters_status, alpha_QCD_dp => alpha_QCD, & + & alpha_QED_0_dp => alpha_QED_0, alpha_QED_MZ_dp => alpha_QED_MZ, Gmu_dp => Gmu, & & rME_dp => rME, wME_dp => wME, rMM_dp => rMM, wMM_dp => wMM, rML_dp => rML, wML_dp => wML, & & rMU_dp => rMU, wMU_dp => wMU, rMD_dp => rMD, wMD_dp => wMD, rMS_dp => rMS, wMS_dp => wMS, & & rMC_dp => rMC, wMC_dp => wMC, rMB_dp => rMB, wMB_dp => wMB, rMT_dp => rMT, wMT_dp => wMT, & & rMW_dp => rMW, wMW_dp => wMW, rMZ_dp => rMZ, wMZ_dp => wMZ, rMH_dp => rMH, wMH_dp => wMH, & & rMX_dp => rMX, wMX_dp => wMX, rMY_dp => rMY, wMY_dp => wMY, & & rYE_dp => rYE, rYM_dp => rYM, rYL_dp => rYL, rYU_dp => rYU, rYD_dp => rYD, rYS_dp => rYS, & - & rYC_dp => rYC, rYB_dp => rYB, wYB_dp => wYB, rYT_dp => rYT, wYT_dp => wYT + & rYC_dp => rYC, rYB_dp => rYB, wYB_dp => wYB, rYT_dp => rYT, wYT_dp => wYT, & + & rMA0_dp => rMA0, wMA0_dp => wMA0, rMHH_dp => rMHH, wMHH_dp => wMHH, rMHp_dp => rMHp, wMHp_dp => wMHp, & + & thdmTB_dp => thdmTB, thdmSBA_dp => thdmSBA, thdmL5_dp => thdmL5 implicit none scalefactor = scalefactor_dp - alpha_QED = alpha_QED_dp - alpha_QCD = alpha_QCD_dp + alpha_QED_0 = alpha_QED_0_dp + alpha_QED_MZ = alpha_QED_MZ_dp + Gmu = Gmu_dp + alpha_QCD = alpha_QCD_dp rME = rME_dp wME = wME_dp @@ -265,6 +272,16 @@ subroutine parameters_init() rYT = rYT_dp wYT = wYT_dp + thdmTB = thdmTB_dp + thdmSBA = thdmSBA_dp + thdmL5 = thdmL5_dp + + rMA0 = rMA0_dp + wMA0 = wMA0_dp + rMHH = rMHH_dp + wMHH = wMHH_dp + rMHp = rMHp_dp + wMHp = wMHp_dp ! ifdef PRECISION_dp #endif @@ -295,6 +312,10 @@ subroutine parameters_init() call masspowers(rYB, wYB, YB, YB2, rYB2) call masspowers(rYT, wYT, YT, YT2, rYT2) + call masspowers(rMA0, wMA0, MA0, MA02, rMA02) + call masspowers(rMHH, wMHH, MHH, MHH2, rMHH2) + call masspowers(rMHp, wMHp, MHp, MHp2, rMHp2) + ! Dependent couplings !QCD @@ -302,8 +323,6 @@ subroutine parameters_init() gQCD = sqrt(G2_QCD) !EW - E2_QED = 4*pi*alpha_QED - eQED = sqrt(E2_QED) if ( cms_on == 0 ) then cw = rMW/rMZ else @@ -318,6 +337,17 @@ subroutine parameters_init() sw4 = sw2**2 sw6 = sw2**3 + if (ew_scheme == 0) then ! alpha(0) OS scheme + alpha_QED = alpha_QED_0 + else if (ew_scheme == 1) then ! Gmu scheme + alpha_QED = sqrt2/pi*Gmu*abs(MW2*sw2) + else if (ew_scheme == 2) then ! alpha(MZ) scheme + alpha_QED = alpha_QED_MZ + end if + + E2_QED = 4*pi*alpha_QED + eQED = sqrt(E2_QED) + ! (1) Right-handed Z-fermion couplings = gf^+ = gZRH*Qf in Denner's FRs ! (2) Left-handed Z-fermion couplings = gf^- = gZLH*(I3f-sw2*Qf) in Denner's FRs gZRH = -sw/cw @@ -335,6 +365,8 @@ subroutine parameters_init() gPsc = [ -YC, YS ] gPbt = [ -YT, YB ] + if (trim(model) == "2hdm") call thdm_parameters_init() + ! Number of time this function has been called: #ifdef PRECISION_dp parameters_status = parameters_status + 1 @@ -351,6 +383,54 @@ end subroutine parameters_init +subroutine thdm_parameters_init() + use ol_debug, only: ol_fatal + use ol_parameters_decl_/**/REALKIND + implicit none + ! mixing angles + thdm_b = atan(thdmTB) + thdm_a = thdm_b - asin(thdmSBA) + thdmCA = cos(thdm_a) + thdmSA = sin(thdm_a) + thdmCB = cos(thdm_b) + thdmSB = sin(thdm_b) + thdmC2A = cos(2*thdm_a) + thdmS2A = sin(2*thdm_a) + thdmC2B = cos(2*thdm_b) + thdmS2B = sin(2*thdm_b) + thdmCAB = cos(thdm_a+thdm_b) + thdmSAB = sin(thdm_a+thdm_b) + thdmCBA = cos(thdm_b-thdm_a) + if (thdmTB == 0) then + call ol_fatal("2HDM model parameter ill defined: tan(beta) = 0") + end if + ! 2HDM Type I or Type II + if (thdm_type == 1) then + if (thdmSB == 0) then + call ol_fatal("2HDM-Type-I model parameter ill defined: sin(beta) = 0") + end if + thdmYuk1 = thdmCA/thdmSB + thdmYuk2 = thdmSA/thdmSB + thdmYuk3 = -1/thdmTB + else if (thdm_type == 2) then + if (thdmCB == 0) then + call ol_fatal("2HDM-Type-II model parameter ill defined: cos(beta) = 0") + end if + thdmYuk1 = -thdmSA/thdmCB + thdmYuk2 = thdmCA/thdmCB + thdmYuk3 = thdmTB + end if + ! 2HDM charged higgs quark couplings + thdmHpud = [-YD*(-thdmYuk3), YU/thdmTB] + thdmHpcs = [-YS*(-thdmYuk3), YC/thdmTB] + thdmHptb = [-YB*(-thdmYuk3), YT/thdmTB] + thdmHpdu = [-YU/thdmTB, YD*(-thdmYuk3)] + thdmHpsc = [-YC/thdmTB, YS*(-thdmYuk3)] + thdmHpbt = [-YT/thdmTB, YB*(-thdmYuk3)] +end subroutine thdm_parameters_init + + + subroutine ensure_mp_init() ! synchronise non-dp parameters with dp if they are not up to date ! should be called after parameters_init() @@ -374,6 +454,8 @@ subroutine channel_on(ch) ! ********************************************************************** use ol_parameters_decl_/**/DREALKIND, only: & next_channel_number, coli_cache_use, a_switch + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal #ifdef USE_COLLIER #ifndef COLLIER_LEGACY use collier, only: initevent_cll @@ -392,11 +474,11 @@ subroutine channel_on(ch) next_channel_number = next_channel_number + 1 if (ch > maxcache) then ! maximum number of channels exceeded - write(*,*) 'subroutine channel_on: stop' - write(*,*) 'next channel =', next_channel_number,'/',maxcache - write(*,*) 'to handle more channels increase maxcache' - write(*,*) 'in collier/src/coli_params_cache.h' - stop + call ol_error(2, 'subroutine channel_on:') + call ol_error(2, 'next channel = ' // to_string(next_channel_number) // '/' // to_string(maxcache)) + call ol_error(2, 'to handle more channels increase maxcache') + call ol_error(2, 'in collier/src/coli_params_cache.h') + call ol_fatal() else call cacheon(ch) end if @@ -514,6 +596,8 @@ subroutine loop_parameters_init(renscale, fact_UV, fact_IR, pole1_UV, pole1_IR, ! = F_j(0) - F(2)*[de2_i_shift-de2_j_shift] ! ********************************************************************** use KIND_TYPES, only: REALKIND + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_fatal use ol_tensor_storage_/**/REALKIND, only: tensor_storage_maxrank use ol_parameters_decl_/**/REALKIND use ol_loop_parameters_decl_/**/REALKIND @@ -557,6 +641,7 @@ subroutine loop_parameters_init(renscale, fact_UV, fact_IR, pole1_UV, pole1_IR, if (present(renscale)) then if (mureg_unscaled /= renscale) reset_mureg = .true. mureg_unscaled = renscale + muren_unscaled = renscale end if if (present(fact_UV)) x_UV = fact_UV if (present(fact_IR)) x_IR = fact_IR @@ -621,6 +706,7 @@ subroutine loop_parameters_init(renscale, fact_UV, fact_IR, pole1_UV, pole1_IR, opprootsvalue = scalefactor * opprootsvalue_unscaled mureg = scalefactor * mureg_unscaled + muren = scalefactor * muren_unscaled muyc = scalefactor * muyc_unscaled muyb = scalefactor * muyb_unscaled muyt = scalefactor * muyt_unscaled @@ -633,9 +719,9 @@ subroutine loop_parameters_init(renscale, fact_UV, fact_IR, pole1_UV, pole1_IR, de2_i_shift = pi2_6 norm_name = 'COLI ' else - write(*,*) 'routine loop_parameters_init: stop' - write(*,*) 'norm_swi =', norm_swi, 'not allowed.' - stop + call ol_error(2,'routine loop_parameters_init: ') + call ol_error(2,'norm_swi = ' // to_string(norm_swi) // ' not allowed.') + call ol_fatal() end if ! ifdef PRECISION_dp @@ -648,7 +734,7 @@ subroutine loop_parameters_init use ol_loop_parameters_decl_/**/REALKIND use ol_loop_parameters_decl_/**/DREALKIND, only: & & loop_parameters_status_dp => loop_parameters_status, norm_swi, a_switch, a_switch_rescue, redlib_qp, & - & dd_qp_not_init, tensorlib_qp_not_init, renscale_dp => mureg, fact_UV_dp => x_UV, fact_IR_dp => x_IR, & + & dd_qp_not_init, tensorlib_qp_not_init, mureg_dp => mureg, muren_dp => muren, fact_UV_dp => x_UV, fact_IR_dp => x_IR, & & pole1_UV_dp => de1_UV, pole1_IR_dp => de1_IR, pole2_IR_dp => de2_i_IR, do_ew_renorm, maxrank #if defined(USE_COLLIER) && defined(COLLIER_LEGACY) use dd_init_/**/REALKIND, only: dd_setmode, dd_setparam @@ -663,7 +749,9 @@ subroutine loop_parameters_init de2_i_shift = pi2_6 end if - mureg = renscale_dp + mureg = mureg_dp + muren = muren_dp + x_UV = fact_UV_dp x_IR = fact_IR_dp de1_UV = pole1_UV_dp @@ -677,8 +765,9 @@ subroutine loop_parameters_init de2_0_IR = de2_i_IR - de2_i_shift ! LH-norm double pole de2_1_IR = de2_i_IR - de2_i_shift + pi2_6 ! COLI-norm double pole - ! renormalisation scale + ! renormalisation & regularization scale mureg2 = mureg**2 + muren2 = muren**2 if (muyc /= 0) then muyc2 = muyc**2 @@ -743,8 +832,12 @@ subroutine loop_parameters_init #else if (a_switch == 1 .or. a_switch_rescue == 1 .or. a_switch == 2 .or. a_switch == 3 .or. & & a_switch == 7 .or. a_switch_rescue == 7) then - call init_cll(maxpoint) ! TODO: max number of legs on the loop - call initcachesystem_cll(cll_channels,maxpoint) ! TODO + if (maxpoint > maxpoint_active .or. cll_channels > cll_channels_active) then + if (maxpoint > maxpoint_active) call init_cll(maxpoint) + call initcachesystem_cll(cll_channels,maxpoint) + maxpoint_active = maxpoint + cll_channels_active = cll_channels + end if if (a_switch == 1) call setmode_cll(1) if (a_switch == 7) call setmode_cll(2) call setmuuv2_cll(mu2_UV) @@ -827,7 +920,7 @@ subroutine loop_parameters_init #endif call qcd_renormalisation -! if (ew_renorm_switch /= 0) then +! if (do_ew_renorm /= 0) then ! call ew_renormalisation ! end if @@ -863,65 +956,127 @@ end subroutine ensure_mp_loop_init -#ifdef PRECISION_dp -subroutine parameters_write() bind(c,name="ol_parameters_write") -#else -subroutine parameters_write() -#endif +!#ifdef PRECISION_dp +!subroutine parameters_write(filename) bind(c,name="ol_parameters_write") +!#else +subroutine parameters_write(filename) +!#endif use KIND_TYPES, only: REALKIND + use ol_generic, only: to_string + use ol_debug, only: ol_error, ol_msg use ol_parameters_decl_/**/REALKIND + use ol_parameters_decl_/**/DREALKIND, only: model, ew_scheme, ew_renorm_scheme use ol_loop_parameters_decl_/**/REALKIND implicit none - write(*,*) 'coupling constants' - write(*,*) 'alpha_s =', alpha_QCD - write(*,*) 'alpha_qed =', alpha_QED - write(*,*) 'sw2 =', sw2 - write(*,*) - write(*,*) 'particle masses and widths' - write(*,*) 'ME = ', ME, 'rME =', rME, 'wME =', wMU, 'YE =', YE - write(*,*) 'MM = ', MM, 'rMM =', rMM, 'wMM =', wMU, 'YM =', YM - write(*,*) 'ML = ', ML, 'rML =', rML, 'wML =', wMU, 'YL =', YL - write(*,*) 'MU = ', MU, 'rMU =', rMU, 'wMU =', wMU, 'YU =', YU - write(*,*) 'MD = ', MD, 'rMD =', rMD, 'wMD =', wMD, 'YD =', YD - write(*,*) 'MS = ', MS, 'rMS =', rMS, 'wMS =', wMS, 'YS =', YS - write(*,*) 'MC = ', MC, 'rMC =', rMC, 'wMC =', wMC, 'YC =', YC - write(*,*) 'MB = ', MB, 'rMB =', rMB, 'wMB =', wMB, 'YB =', YB - write(*,*) 'MT = ', MT, 'rMT =', rMT, 'wMT =', wMT, 'YT =', YT - write(*,*) 'MW = ', MW, 'rMW =', rMW, 'wMW =', wMW - write(*,*) 'MZ = ', MZ, 'rMZ =', rMZ, 'wMZ =', wMZ - write(*,*) 'MH = ', MH, 'rMH =', rMH, 'wMH =', wMH - write(*,*) 'MX = ', MX, 'rMX =', rMX, 'wMX =', wMX - write(*,*) 'MY = ', MY, 'rMY =', rMY, 'wMY =', wMY - write(*,*) - write(*,*) 'renscale =', mureg - write(*,*) 'pole1_UV =', de1_UV - write(*,*) 'pole1_IR =', de1_IR - write(*,*) 'pole2_IR =', de2_i_IR - write(*,*) 'fact_UV =', x_UV - write(*,*) 'fact_IR =', x_IR + character(len=*), optional :: filename + integer :: outid, ios + outid = 0 + if (present(filename)) then + if (len_trim(filename) > 0) then + outid = 10 + open(outid, file=filename, status="replace", iostat=ios) + if (ios /= 0) then + call ol_error("ol_printparameter: error opening file " // trim(filename)) + call ol_msg("iostat =" // to_string(ios)) + return + end if + end if + end if + + write(outid,*) '====================================================' + write(outid,*) '================OpenLoops Parameters================' + write(outid,*) '====================================================' + write(outid,*) 'model =', trim(model) + write(outid,*) + write(outid,*) 'coupling constants' + write(outid,*) 'alpha_s =', alpha_QCD + write(outid,*) 'alpha_qed =', alpha_QED, ' 1/alpha_qed =', 1/alpha_QED + write(outid,*) 'sw =', sw + write(outid,*) 'sw2 =', sw2 + write(outid,*) + write(outid,*) 'ew_scheme =', ew_scheme + write(outid,*) 'alpha_qed_0 =', alpha_QED_0, ' 1/alpha_qed_0 =', 1/alpha_QED_0 + write(outid,*) 'alpha_qed_MZ =', alpha_QED_MZ, ' 1/alpha_qed_MZ =', 1/alpha_QED_MZ + write(outid,*) 'Gmu =', Gmu + if (trim(model) == "2hdm") then + write(outid,*) + write(outid,*) '2HDM tan(beta) =', thdmTB + write(outid,*) '2HDM sin(beta-alpha) =', thdmSBA + end if + write(outid,*) + write(outid,*) 'particle masses and widths' + write(outid,*) 'ME = ', ME, 'rME =', rME, 'wME =', wMU, 'YE =', YE + write(outid,*) 'MM = ', MM, 'rMM =', rMM, 'wMM =', wMU, 'YM =', YM + write(outid,*) 'ML = ', ML, 'rML =', rML, 'wML =', wMU, 'YL =', YL + write(outid,*) 'MU = ', MU, 'rMU =', rMU, 'wMU =', wMU, 'YU =', YU + write(outid,*) 'MD = ', MD, 'rMD =', rMD, 'wMD =', wMD, 'YD =', YD + write(outid,*) 'MS = ', MS, 'rMS =', rMS, 'wMS =', wMS, 'YS =', YS + write(outid,*) 'MC = ', MC, 'rMC =', rMC, 'wMC =', wMC, 'YC =', YC + write(outid,*) 'MB = ', MB, 'rMB =', rMB, 'wMB =', wMB, 'YB =', YB + write(outid,*) 'MT = ', MT, 'rMT =', rMT, 'wMT =', wMT, 'YT =', YT + write(outid,*) 'MW = ', MW, 'rMW =', rMW, 'wMW =', wMW + write(outid,*) 'MZ = ', MZ, 'rMZ =', rMZ, 'wMZ =', wMZ + write(outid,*) 'MH = ', MH, 'rMH =', rMH, 'wMH =', wMH + write(outid,*) 'MX = ', MX, 'rMX =', rMX, 'wMX =', wMX + write(outid,*) 'MY = ', MY, 'rMY =', rMY, 'wMY =', wMY + if (trim(model) == "2hdm") then + write(outid,*) 'MA0 = ', MA0, 'rMA0 =', rMA0, 'wMA0 =', wMA0 + write(outid,*) 'MHH = ', MHH, 'rMHH =', rMHH, 'wMHH =', wMHH + write(outid,*) 'MHp = ', MHp, 'rMHp =', rMHp, 'wMHp =', wMHp + end if + write(outid,*) + write(outid,*) 'muren =', muren + write(outid,*) 'mureg =', mureg + write(outid,*) 'pole1_UV =', de1_UV + write(outid,*) 'pole1_IR =', de1_IR + write(outid,*) 'pole2_IR =', de2_i_IR + write(outid,*) 'fact_UV =', x_UV + write(outid,*) 'fact_IR =', x_IR + write(outid,*) 'ew_renorm_scheme =', ew_renorm_scheme #ifdef PRECISION_dp - write(*,*) 'N_quarks =', nf - write(*,*) 'light quarks =', N_lf - write(*,*) 'fermion_loops =', SwF - write(*,*) 'nonfermion_loops =', SwB - write(*,*) 'CT_on =', CT_is_on - write(*,*) 'R2_on =', R2_is_on - write(*,*) 'IR_on =', IR_is_on - write(*,*) 'polecheck =', polecheck_is - write(*,*) 'polenorm_swi =', norm_swi - write(*,*) 'i-operator mode =', ioperator_mode - write(*,*) 'last_switch =', l_switch - write(*,*) 'amp_switch =', a_switch - write(*,*) 'amp_switch_rescue =', a_switch_rescue - write(*,*) 'ew_renorm_switch =', ew_renorm_switch - write(*,*) 'use_coli_cache =', coli_cache_use - write(*,*) 'check_Ward_tree =', Ward_tree - write(*,*) 'check_Ward_loop =', Ward_loop - write(*,*) 'out_symmetry =', out_symmetry_on + write(outid,*) 'N_quarks =', nf + write(outid,*) 'light quarks =', N_lf + write(outid,*) 'nq_nondecoupled =', nq_nondecoupl + write(outid,*) 'fermion_loops =', SwF + write(outid,*) 'nonfermion_loops =', SwB + write(outid,*) 'CT_on =', CT_is_on + write(outid,*) 'R2_on =', R2_is_on + write(outid,*) 'IR_on =', IR_is_on + write(outid,*) 'polecheck =', polecheck_is + write(outid,*) 'polenorm_swi =', norm_swi + write(outid,*) 'i-operator mode =', ioperator_mode + write(outid,*) 'last_switch =', l_switch + write(outid,*) 'ew_renorm_switch =', ew_renorm_switch + write(outid,*) 'use_coli_cache =', coli_cache_use + write(outid,*) 'use_me_cache =', use_me_cache + write(outid,*) 'check_Ward_tree =', Ward_tree + write(outid,*) 'check_Ward_loop =', Ward_loop + write(outid,*) 'out_symmetry =', out_symmetry_on + write(outid,*) 'stability_mode =', stability_mode + write(outid,*) 'deviation_mode =', deviation_mode + write(outid,*) 'stability_triggerratio =', trigeff_targ + write(outid,*) 'stability_unstable =', abscorr_unst + write(outid,*) 'stability_kill =', ratcorr_bad + write(outid,*) 'stability_kill2 =', ratcorr_bad_L2 + write(outid,*) 'redlib1 =', a_switch + write(outid,*) 'redlib2 =', a_switch_rescue + write(outid,*) 'redlib_qp =', redlib_qp + write(outid,*) + write(outid,*) '====================================================' #endif ! opp_rootsvalue, opp_limitvalue, opp_thrs, opp_idig, opp_scaloop ! sam_isca, sam_verbosity, sam_itest ! set_C_PV_threshold, set_D_PV_threshold, set_dd_red_mode + + if (outid == 10) then + call ol_msg("Parameters written to file " // trim(filename)) + close(outid, iostat=ios) + if (ios /= 0) then + call ol_error("Error writing parameters to file " // trim(filename)) + call ol_msg("iostat =" // to_string(ios)) + return + end if + end if end subroutine parameters_write end module ol_parameters_init_/**/REALKIND diff --git a/lib_src/openloops/src/renormalisation_qcd.F90 b/lib_src/openloops/src/renormalisation_qcd.F90 index f10d83fd..0e58ac6d 100644 --- a/lib_src/openloops/src/renormalisation_qcd.F90 +++ b/lib_src/openloops/src/renormalisation_qcd.F90 @@ -41,10 +41,12 @@ subroutine qcd_renormalisation ! dgQCD = strong coupling RC : g_bare = (1+dgQCD)*g_ren ! ********************************************************************** use KIND_TYPES, only: REALKIND + use ol_debug, only: ol_msg, ol_error, ol_fatal + use ol_generic, only: to_string use ol_parameters_decl_/**/REALKIND use ol_loop_parameters_decl_/**/REALKIND #ifndef PRECISION_dp - use ol_parameters_decl_/**/DREALKIND, only: LeadingColour + use ol_parameters_decl_/**/DREALKIND, only: LeadingColour, model use ol_loop_parameters_decl_/**/DREALKIND, only: & & nc, nf, nf_up, nf_down, N_lf, nq_nondecoupl, CT_is_on, R2_is_on, SwF, SwB #endif @@ -59,9 +61,9 @@ subroutine qcd_renormalisation N_lf = count(zeromasses(:nf)) if (N_lf /= 3 .and. N_lf /= 4 .and. N_lf /= 5) then - write(*,*) '[OpenLoops] ERROR in qcd_renormalisation:' - write(*,*) '[OpenLoops] N_lf = ', N_lf, 'is not supported.' - stop + call ol_error(2, 'in qcd_renormalisation:') + call ol_msg( 'N_lf = ' // to_string(N_lf) // 'is not supported.') + call ol_fatal() end if #endif @@ -133,13 +135,13 @@ subroutine qcd_renormalisation dZYT = -cf * (4 + 3*(de1_UV+log(mu2_UV/muyt2))) end if ! MS-bar renormalization constant for gQCD, YM-contribution - dgQCD = -(11*ca)/6 * (de1_UV + log(mu2_UV/mureg2)) + dgQCD = -(11*ca)/6 * (de1_UV + log(mu2_UV/muren2)) end if if (SwF /= 0) then ! fermionic dZg = dZg - (4*tf)/3 * N_lf * (deT_UV - deT_IR) ! MS-bar renormalization constant for gQCD; contribution for nf quarks - dgQCD = dgQCD + (2*tf*nf)/3 * (de1_UV + log(mu2_UV/mureg2)) + dgQCD = dgQCD + (2*tf*nf)/3 * (de1_UV + log(mu2_UV/muren2)) if (nf > 3) then if (MC /= 0) then dZg = dZg - (4*tf)/3 * deC_UV @@ -186,6 +188,10 @@ subroutine qcd_renormalisation ! Sum of squared quark masses MQ2sum = MU2 + MD2 + MS2 MQ2sumpairs = YU2 + YD2 + YQD2sum = YD2 + YS2 + YQU2sum = YU2 + YQD2sumpairs = YD2 + YQU2sumpairs = YU2 nf_up = 1 nf_down = 2 YC2pair = 0 @@ -194,16 +200,23 @@ subroutine qcd_renormalisation if (nf > 3) then MQ2sum = MQ2sum + MC2 MQ2sumpairs = MQ2sumpairs + YS2 + YC2 + YQU2sum = YQU2sum + YC2 + YQD2sumpairs = YQD2sumpairs + YS2 + YQU2sumpairs = YQU2sumpairs + YC2 nf_up = nf_up + 1 YC2pair = YC2 end if if (nf > 4) then MQ2sum = MQ2sum + MB2 + YQD2sum = YQD2sum + YB2 nf_down = nf_down + 1 end if if (nf > 5) then MQ2sum = MQ2sum + MT2 MQ2sumpairs = MQ2sumpairs + YB2 + YT2 + YQU2sum = YQU2sum + YT2 + YQD2sumpairs = YQD2sumpairs + YB2 + YQU2sumpairs = YQU2sumpairs + YT2 nf_up = nf_up + 1 YB2pair = YB2 YT2pair = YT2 @@ -294,6 +307,14 @@ subroutine qcd_renormalisation ctHEFTggh = (11+2*dgQCD + dZg) * [ rZERO, -rONE, rZERO, rZERO, rONE] ctHEFTgggh = (11+3*dgQCD + 1.5_/**/REALKIND*dZg) ctHEFTggggh = (11+4*dgQCD + 2*dZg) + + ! 2HDM + if (trim(model) == "2hdm") then + thdmctHpcs = [ -YS*(-thdmYuk3) * (dZc/2 + dZq/2 ), YC/thdmTB * (dZc/2 + dZq/2 + dZYC) ] + thdmctHpsc = [ -YC/thdmTB * (dZc/2 + dZq/2 + dZYC), YS*(-thdmYuk3) * (dZc/2 + dZq/2 ) ] + thdmctHptb = [ -YB*(-thdmYuk3) * (dZt/2 + dZb/2 + dZYB), YT/thdmTB * (dZt/2 + dZb/2 + dZYT) ] + thdmctHpbt = [ -YT/thdmTB * (dZt/2 + dZb/2 + dZYT), YB*(-thdmYuk3) * (dZt/2 + dZb/2 + dZYB) ] + end if end if if (R2_is_on /= 0) then @@ -321,10 +342,10 @@ subroutine qcd_renormalisation ctVcc = ctVcc - 2*cf ctVbb = ctVbb - 2*cf ctVqq = ctVqq - 2*cf - ctScs = ctScs - [4*cf,4*cf] - ctSsc = ctSsc - [4*cf,4*cf] - ctStb = ctStb - [4*cf,4*cf] - ctSbt = ctSbt - [4*cf,4*cf] + ctScs = ctScs - 4*cf*gPcs + ctSsc = ctSsc - 4*cf*gPsc + ctStb = ctStb - 4*cf*gPtb + ctSbt = ctSbt - 4*cf*gPbt ctSqq = ctSqq - 4*cf ctScc = ctScc - 4*cf ctSbb = ctSbb - 4*cf @@ -336,6 +357,14 @@ subroutine qcd_renormalisation R2HEFTggggh = 0.125_/**/REALKIND R2HEFThqq = 0.25_/**/REALKIND*(nc-1._/**/REALKIND/nc) R2HEFTghqq = 0.25_/**/REALKIND*(3._/**/REALKIND/nc-5*nc) + + ! 2HDM + if (trim(model) == "2hdm") then + thdmctHpcs = thdmctHpcs - 4*cf*thdmHpcs + thdmctHpsc = thdmctHpsc - 4*cf*thdmHpsc + thdmctHptb = thdmctHptb - 4*cf*thdmHptb + thdmctHpbt = thdmctHpbt - 4*cf*thdmHpbt + end if end if if (SwF /= 0) then ! fermionic @@ -346,22 +375,43 @@ subroutine qcd_renormalisation ! ZGG R2 coupling: 4/3*sum_q(a_q) ctZGG = (nf_down-nf_up)*(-2*tf)/(3*cw*sw) ! HGG R2 coupling: 2*sum_q(m_q*v_q) - ctHGG = -2*tf*MQ2sum/(sw*MW) + ctHGG = -2*tf*MQ2sum/(sw*MW) ! *MQ*YQ/MQ2sum in Feynman rule ! VVGG R2 coupling: 2/3*sum(v1*v2+a1*a2) ctAAGG = (nf_up*4+nf_down)*(tf*4)/27 ctAZGG = (nf_up*(-6+16*sw2)+nf_down*(-3+4*sw2)) * tf/(27*cw*sw) ctZZGG = (nf_up*(9-24*sw2+32*sw2**2)+nf_down*(9-12*sw2+ 8*sw2**2)) * tf/(54*cw2*sw2) ctWWGG = int(nf/2)*tf/(3*sw2) ! tf/(3*sw2) per SU(2) doublet ! SSGG R2 coupling: 2*sum(v1*v2-a1*a2) - ctHHGG = tf*MQ2sum/(sw2*MW2) + ctHHGG = tf*MQ2sum/(sw2*MW2) ! *YQ2/MQ2sum in Feynman rule ctHXGG = 0 - ctXXGG = tf*MQ2sum/(sw2*MW2) + ctXXGG = tf*MQ2sum/(sw2*MW2) ! *YQ2/MQ2sum in Feynman rule ctPPGG = tf*MQ2sumpairs/(sw2*MW2) ! VGGG R2 coupling: [ 4/3*tf*sum_q(v_q), -12*tf*CI*sum_q(a_q) ] dummy_complex = -(4*tf)/9*(2*nf_up-nf_down) ctAGGG = [ dummy_complex, ZERO ] ctZGGG = [ (nf_up*(3-8*sw2)+nf_down*(-3+4*sw2)) * tf/(9*cw*sw) , (nf_up-nf_down)*3*tf*CI/(sw*cw) ] R2GGGG = int(2*tf) ! switch on the 4-gluon R2 + ! 2HDM + if (trim(model) == "2hdm") then + ! SGG + ! thdmctA0GG = 0 + thdmctHGG = -(thdmYuk1*YQD2sum + thdmCA/thdmSB*YQU2sum)/(MW*sw) + thdmctHh0GG = -(thdmYuk2*YQD2sum + thdmSA/thdmSB*YQU2sum)/(MW*sw) + ! SSGG + ! thdmctHA0GG = 0 + ! thdmctXHhGG = 0 + ! thdmctHhA0GG = 0 + ! thdmctHXGG = 0 (effectively unchanged wrt. SM) + ! XXGG unchanged wrt. SM + ! PPGG unchanged wrt. SM + thdmctHHGG = (thdmYuk1**2*YQD2sum + thdmCA**2/thdmSB**2*YQU2sum)/(2*MW2*sw2) + thdmctHHhGG = (thdmYuk1*thdmYuk2*YQD2sum + thdmCA*thdmSA/thdmSB**2*YQU2sum)/(2*MW2*sw2) + thdmctXA0GG = (-thdmYuk3*YQD2sum + YQU2sum/thdmTB)/(2*MW2*sw2) + thdmctHhHhGG = (thdmYuk2**2*YQD2sum + thdmSA**2/thdmSB**2*YQU2sum)/(2*MW2*sw2) + thdmctA0A0GG = (thdmYuk3**2*YQD2sum + YQU2sum/thdmTB**2)/(2*MW2*sw2) + thdmctPHpGG = (-thdmYuk3*YQD2sumpairs + YQU2sumpairs/thdmTB)/(2*MW2*sw2) + thdmctHpHpGG = (thdmYuk3**2*YQD2sumpairs + YQU2sumpairs/thdmTB**2)/(2*MW2*sw2) + end if end if end if diff --git a/lib_src/openloops/src/stability.F90 b/lib_src/openloops/src/stability.F90 index 7fd2a3bc..34cdcbf5 100644 --- a/lib_src/openloops/src/stability.F90 +++ b/lib_src/openloops/src/stability.F90 @@ -19,6 +19,7 @@ module ol_stability use KIND_TYPES, only: DREALKIND + use ol_debug, only: ol_error, ol_msg, ol_fatal, verbose implicit none real(DREALKIND), save :: last_relative_deviation = -1, last_vme2 = -1, last_vme2_scaled = -1 contains @@ -39,6 +40,7 @@ function check_stability_write(n) ! 1 --> adaptive, logarithmic ! 2 --> .true. (log every point) use ol_parameters_decl_/**/DREALKIND, only: stability_log + use ol_generic, only: to_string implicit none integer, intent(in) :: n logical :: check_stability_write @@ -63,9 +65,9 @@ function check_stability_write(n) else if (stability_log == 3) then check_stability_write = .true. else - print *, "[OpenLoops] ERROR: invalid value of stability_log:", stability_log - print *, "[OpenLoops] must be 0(never) / 1(default:adaptive) / 2(always)" - stop + call ol_error(2,"invalid value of stability_log:" // to_string(stability_log)) + call ol_msg(" must be 0(never) / 1(default:adaptive) / 2(always)") + call ol_fatal() end if end function check_stability_write @@ -635,7 +637,7 @@ subroutine vamp2generic(vamp2dp, vamp2qp, processname, P_scatt, M2L0, M2L1, IRL1 & extperm, me_caches) use KIND_TYPES, only: DREALKIND use ol_data_types_/**/DREALKIND, only: me_cache - use ol_parameters_decl_/**/DREALKIND, only: verbose, current_processname, a_switch, & + use ol_parameters_decl_/**/DREALKIND, only: current_processname, a_switch, & & a_switch_rescue, redlib_qp, write_psp, use_me_cache, parameters_changed use ol_loop_parameters_decl_/**/DREALKIND, only: ratcorr_bad, ratcorr_bad_L2, & & stability_mode, abscorr_unst, mureg_unscaled @@ -690,12 +692,12 @@ end subroutine vamp2qp cache%psp = -1 allocate(cache%me(18)) end if - if (verbose >= 2) then + if (verbose >= 3) then if (all(cache%psp == P_scatt)) then if (parameters_changed == 0) then - print *, "[OpenLoops] " // trim(current_processname) // trim(to_string(extperm)) // ' taken from the cache' + call ol_msg(3, trim(current_processname) // "__" //trim(to_string(extperm)) // ' taken from the cache') else - print *, '[OpenLoops] me-cache: same phase space point, but parameters changed' + call ol_msg(3, 'me-cache: same phase space point, but parameters changed') end if end if end if @@ -727,6 +729,7 @@ end subroutine vamp2qp ! double precision + scaling with a single library last_relative_deviation = vamp2_dp_scaled(vamp2dp, P_scatt, M2L0, M2L1, IRL1, M2L2, IRL2) if (last_relative_deviation > ratcorr_bad) then + call ol_msg(3,"stability system: point killed.") ! kill point killed = killed + 1 M2L1(0) = 0 @@ -740,6 +743,7 @@ end subroutine vamp2qp ! + quad precision with (possibly) a different library last_relative_deviation = vamp2_dp_scaled(vamp2dp, P_scatt, M2L0, M2L1, IRL1, M2L2, IRL2) if (last_relative_deviation > abscorr_unst) then + call ol_msg(3,"stability system: qp rescue invoked.") qp_eval = qp_eval + 1 call vamp2_qp(vamp2qp, P_scatt, M2L0, M2L1, IRL1, M2L2, IRL2, redlib_qp) end if @@ -752,9 +756,11 @@ end subroutine vamp2qp last_relative_deviation = vamp2_dp_scaled(vamp2dp, P_scatt, M2L0, M2L1, IRL1, M2L2, IRL2) call update_stability_histogram(processname, stability_histogram, last_relative_deviation, qp_eval, killed) if (last_relative_deviation > abscorr_unst) then + call ol_msg(3,"stability system: qp rescue invoked.") qp_eval = qp_eval + 1 last_relative_deviation = vamp2_qp_scaled(vamp2qp, P_scatt, M2L0, M2L1, IRL1, M2L2, IRL2, redlib_qp) if (last_relative_deviation > ratcorr_bad) then + call ol_msg(3, "stability system: point killed after qp scaling.") ! kill point killed = killed + 1 M2L1(0) = 0 @@ -796,8 +802,7 @@ end subroutine vamp2qp else if (stability_mode >= 20 .and. stability_mode < 30) then if (a_switch == a_switch_rescue) then - print *, '[OpenLoops] ERROR: stability modes 2x require different redlib1 and redlib2' - stop + call ol_fatal('stability modes 2x require different redlib1 and redlib2') end if ! reevaluation with a second library if abs(k-factor) is in ! the largest 'trigeff_targ' fraction of the distribution @@ -817,7 +822,9 @@ end subroutine vamp2qp abs_kfactor = abs(M2L1(0)/M2L0) if (abs_kfactor > abs_kfactor_threshold) then ! reevaluate the matrix element with a different reduction library + call ol_msg(3,"stability system: reevaluate the matrix element with a different reduction library.") call vamp2_dp(vamp2dp, P_scatt, M2L0, M2L1_rescue, IRL1, M2L2, IRL2, redlib = a_switch_rescue) + last_relative_deviation = relative_deviation(M2L1(0), M2L1_rescue(0)) abs_kfactor_rescue = abs(M2L1_rescue(0)/M2L0) else abs_kfactor_rescue = abs_kfactor @@ -829,10 +836,12 @@ end subroutine vamp2qp end if #ifdef USE_qp - if ((M2L0 /= 0 .and. M2L1(0) == 0) .or. (M2L0 == 0 .and. M2L2(0) == 0)) then - ! if the point was killed and qp rescue is active, reevaluate it + if (last_relative_deviation > abscorr_unst) then + ! if the point was reevaluated and is considered unstable + ! (last_relative_deviation=-1 if the point was not reevaluated) if (stability_mode == 22) then ! quad precision rescue + call ol_msg(3,"stability system: qp rescue invoked.") qp_eval = qp_eval + 1 call vamp2_qp(vamp2qp, P_scatt, M2L0, M2L1, IRL1, M2L2, IRL2, redlib = redlib_qp) last_relative_deviation = 0 @@ -840,10 +849,12 @@ end subroutine vamp2qp & last_relative_deviation, qp_eval, killed) else if (stability_mode == 23) then ! quad precision rescue + scaling + call ol_msg(3,"stability system: qp rescue invoked.") qp_eval = qp_eval + 1 last_relative_deviation = vamp2_qp_scaled(vamp2qp, P_scatt, M2L0, M2L1, IRL1, M2L2, IRL2, redlib = redlib_qp) if (last_relative_deviation > ratcorr_bad) then ! kill point + call ol_msg(3, "stability system: point killed after qp scaling.") killed = killed + 1 M2L1(0) = 0 end if @@ -863,6 +874,7 @@ end subroutine vamp2qp last_relative_deviation = vamp2_qp_scaled(vamp2qp, P_scatt, M2L0, M2L1, IRL1, M2L2, IRL2, redlib = redlib_qp) if (last_relative_deviation > ratcorr_bad) then ! kill point + call ol_msg(3, "stability system: point killed after qp scaling.") killed = killed + 1 M2L1(0) = 0 end if @@ -872,11 +884,11 @@ end subroutine vamp2qp #endif else - print *, "ERROR: unknown stability mode:", stability_mode + call ol_error(2,"unknown stability mode:" // to_string(stability_mode)) #ifndef USE_qp print *, "Note that some modes are only available when quad precision support is enabled." #endif - stop + call ol_fatal() end if @@ -893,6 +905,7 @@ end subroutine vamp2qp cache%me(8:12) = M2L2 cache%me(13:17) = IRL2 cache%me(18) = last_relative_deviation + parameters_changed = 0 end if end subroutine vamp2generic diff --git a/lib_src/openloops/src/wavefunctions.F90 b/lib_src/openloops/src/wavefunctions.F90 index 7d4ab3f0..602a9d20 100644 --- a/lib_src/openloops/src/wavefunctions.F90 +++ b/lib_src/openloops/src/wavefunctions.F90 @@ -22,12 +22,14 @@ module ol_wavefunctions_/**/REALKIND implicit none private public :: wf_S, wf_V, wf_V_Std, wf_Q, wf_A, wfIN_Q + public :: pol_wf_S, pol_wf_V, pol_wf_Q, pol_wf_A real(REALKIND) :: small_real = 1.e-44_dp contains ! ********************************************************************** subroutine wf_S(P, M, POL, J_S) ! Wave function for a scalar particle. Just returns 1. +! (version without POLSEL kept for compatibility with old process code) ! ********************************************************************** implicit none real(REALKIND), intent(in) :: P(0:3), M @@ -37,10 +39,24 @@ subroutine wf_S(P, M, POL, J_S) J_S(2:4) = 0 end subroutine wf_S +! ********************************************************************** +subroutine pol_wf_S(P, M, POL, J_S, POLSEL) +! Wave function for a scalar particle. Just returns 1. +! (version without POLSEL kept for compatibility with old process code) +! ********************************************************************** + implicit none + real(REALKIND), intent(in) :: P(0:3), M + integer, intent(in) :: POL + integer, optional, intent(in) :: POLSEL + complex(REALKIND), intent(out) :: J_S(4) + J_S(1) = 1 + J_S(2:4) = 0 +end subroutine pol_wf_S ! ********************************************************************** subroutine wf_V(P, M, POL, J_V) ! vector boson wave function (incoming and outgoing) +! (version without POLSEL kept for compatibility with old process code) ! ---------------------------------------------------------------------- ! P(0:3): incoming momentum (standard representation) ! POL: -1|0|+1 polarisation @@ -85,6 +101,58 @@ subroutine wf_V(P, M, POL, J_V) end subroutine wf_V +! ********************************************************************** +subroutine pol_wf_V(P, M, POL, J_V, POLSEL) +! vector boson wave function (incoming and outgoing) +! ---------------------------------------------------------------------- +! P(0:3): incoming momentum (standard representation) +! POL: -1|0|+1 polarisation +! M >= 0: real mass +! ---------------------------------------------------------------------- +! if P(0) > 0 +! J_V(1:4) = EPS(P,POL) +! = incoming vector boson wave function (light-cone representation) +! ---------------------------------------------------------------------- +! if P(0) < 0 +! J_V(1:4) = EPS^*(-P,POL) +! = outgoing vector boson wave function (light-cone representation) +! ********************************************************************** + use KIND_TYPES + use ol_global_decl, only: MaxParticles + use ol_external_decl_/**/REALKIND, only: P_ex, Ward_array + use ol_parameters_decl_/**/DREALKIND, only: Ward_tree, Ward_loop + use ol_kinematics_/**/REALKIND, only: Std2LC_Rep + implicit none + real(REALKIND), intent(in) :: P(0:3), M + integer, intent(in) :: POL + integer, optional, intent(in) :: POLSEL + complex(REALKIND), intent(out) :: J_V(4) + integer :: i + + if (Ward_tree /= 0 .or. Ward_loop /= 0) then + do i = 1, MaxParticles + ! identify the particle number to associate the Ward_array(i) + if ((P(0) >= 0 .and. all(P == P_ex(:,i))) .or. (P(0) < 0 .and. all(-P == P_ex(:,i)))) exit + end do + + if (Ward_array(i) == 1) then + call Std2LC_Rep(P, J_V) + else + ! normal wavefunction + call wf_V_Std(P, M, POL, J_V) + end if + + else + if (present(POLSEL)) then + call wf_V_Std(P, M, POL, J_V, POLSEL) + else + call wf_V_Std(P, M, POL, J_V) + end if + end if + +end subroutine pol_wf_V + + ! ! ********************************************************************** ! subroutine wf_V(P, M, POL, J_V) ! ! vector boson wave function (incoming and outgoing) @@ -127,7 +195,7 @@ end subroutine wf_V ! ********************************************************************** -subroutine wf_V_Std(P, M, POL, J_V) +subroutine wf_V_Std(P, M, POL, J_V, POLSEL) ! wave function for IN/OUT vector boson ! ---------------------------------------------------------------------- ! P(0:3) : incoming momentum P^mu (standard representation) @@ -146,15 +214,16 @@ subroutine wf_V_Std(P, M, POL, J_V) real(REALKIND), intent(in) :: P(0:3), M integer, intent(in) :: POL + integer, optional, intent(in) :: POLSEL complex(REALKIND), intent(out) :: J_V(4) complex(REALKIND) :: J_AUX(4) if (P(0) >= 0) then ! incoming gluon -> EPS(P) - call wfIN_V(P,M,POL,J_V) + call wfIN_V(P,M,POL,J_V, POLSEL) ! call wf_interface_V(P,M,POL,J_V) ! gauge-fixing of Stefano's algebraic code ! call wfIN_V_MG(P,M,POL,J_V) ! MadGraph convention else if (P(0) < 0) then ! outgoing gluon -> EPS^*(-P) - call wfIN_V(-P,M,POL,J_AUX) + call wfIN_V(-P,M,POL,J_AUX, POLSEL) ! call wf_interface_V(-P,M,POL,J_AUX) ! gauge-fixing Stefano's algebraic code ! call wfIN_V_MG(P,M,POL,J_AUX) ! MadGraph convention @@ -252,6 +321,7 @@ end subroutine wf_gf_V ! ********************************************************************** subroutine wf_Q(P, M, POL, J_Q) ! wave function for an incoming quark or outgoing anti-quark +! (version without POLSEL kept for compatibility with old process code) ! ---------------------------------------------------------------------- ! P(0:3) : incoming momentum P^mu (standard representation) ! M >= 0 : mass @@ -278,13 +348,56 @@ subroutine wf_Q(P, M, POL, J_Q) ! call wfIN_Q(-P,-M,-POL,J_Q) call wfIN_Q(-P,-M,POL,J_Q) end if - end subroutine wf_Q +! ********************************************************************** +subroutine pol_wf_Q(P, M, POL, J_Q, POLSEL) +! wave function for an incoming quark or outgoing anti-quark +! ---------------------------------------------------------------------- +! P(0:3) : incoming momentum P^mu (standard representation) +! M >= 0 : mass +! POL : +1|-1 quark polarisation as (14,15) of hep-ph/0002082 (HELAC) +! but with flipped polarisation for outgoing anti-quarks +! ---------------------------------------------------------------------- +! if P(0) > 0: +! J_Q(1:4) = U(P,M,POL) +! = incoming quark wave function +! ---------------------------------------------------------------------- +! if P(0) < 0: +! J_Q(1:4) = V(-P,M,POL) = U(-P,-M,-POL) +! = outgoing anti-quark wave function +! ********************************************************************** + implicit none + + real(REALKIND), intent(in) :: P(0:3), M + integer, intent(in) :: POL + complex(REALKIND), intent(out) :: J_Q(4) + integer, optional, intent(in) :: POLSEL + + if (present(POLSEL)) then + if (P(0) >= 0) then ! in-quark -> U(P,M,POL) + call wfIN_Q(P,M,POL,J_Q, POLSEL) + else if (P(0) < 0) then ! out-antiquark -> V(-P,M,POL)=U(-P,-M,-POL) + ! call wfIN_Q(-P,-M,-POL,J_Q) + call wfIN_Q(-P,-M,POL,J_Q, POLSEL) + end if + else + if (P(0) >= 0) then ! in-quark -> U(P,M,POL) + call wfIN_Q(P,M,POL,J_Q) + else if (P(0) < 0) then ! out-antiquark -> V(-P,M,POL)=U(-P,-M,-POL) + ! call wfIN_Q(-P,-M,-POL,J_Q) + call wfIN_Q(-P,-M,POL,J_Q) + end if + end if + +end subroutine pol_wf_Q + + ! ********************************************************************** subroutine wf_A(P, M, POL, J_A) ! wave function for incoming anti-quark or outgoing quark +! (version without POLSEL kept for compatibility with old process code) ! ---------------------------------------------------------------------- ! P(0:3) : incoming momentum P^mu (standard representation) ! M>=0 : mass @@ -312,6 +425,7 @@ subroutine wf_A(P, M, POL, J_A) ! call wfIN_Q(-P,M,POL,J_AUX) call wfIN_Q(-P,M,-POL,J_AUX) end if + ! Dirac conjugation of spinor J_A(1) = -conjg(J_AUX(3)) J_A(2) = -conjg(J_AUX(4)) @@ -322,25 +436,87 @@ end subroutine wf_A ! ********************************************************************** -subroutine wfIN_V(P, M, POL, EPS) +subroutine pol_wf_A(P, M, POL, J_A, POLSEL) +! wave function for incoming anti-quark or outgoing quark +! ---------------------------------------------------------------------- +! P(0:3) : incoming momentum P^mu (standard representation) +! M>=0 : mass +! POL : +1|-1 quark polarisation as (14,15) of hep-ph/0002082 (HELAC) +! but with flipped polarisation for outgoing quarks +! ---------------------------------------------------------------------- +! if P(0)>0 +! J_A(1:4) = Vbar(P,M,POL) = Ubar(P,-M,-POL) +! = INCOMING-antiquark wave function +! ---------------------------------------------------------------------- +! if P(0)<0 +! J_A(1:4) = Ubar(-P,M,POL) +! = OUTGOING-antiquark wave function +! ********************************************************************** + implicit none + + real(REALKIND), intent(in) :: P(0:3), M + integer, intent(in) :: POL + integer, optional, intent(in) :: POLSEL + complex(REALKIND), intent(out) :: J_A(4) + complex(REALKIND) :: J_AUX(4) + + if (present(POLSEL)) then + if (P(0) >= 0) then ! in-antiquark -> V(P,M,POL)=U(P,-M,-POL) + call wfIN_Q(P,-M,-POL,J_AUX,POLSEL) + else if(P(0) < 0) then ! out-quark -> U(-P,M,POL) + ! call wfIN_Q(-P,M,POL,J_AUX) + call wfIN_Q(-P,M,-POL,J_AUX,POLSEL) + end if + else + if (P(0) >= 0) then ! in-antiquark -> V(P,M,POL)=U(P,-M,-POL) + call wfIN_Q(P,-M,-POL,J_AUX) + else if(P(0) < 0) then ! out-quark -> U(-P,M,POL) + ! call wfIN_Q(-P,M,POL,J_AUX) + call wfIN_Q(-P,M,-POL,J_AUX) + end if + end if + + ! Dirac conjugation of spinor + J_A(1) = -conjg(J_AUX(3)) + J_A(2) = -conjg(J_AUX(4)) + J_A(3) = -conjg(J_AUX(1)) + J_A(4) = -conjg(J_AUX(2)) + +end subroutine pol_wf_A + + +! ********************************************************************** +subroutine wfIN_V(P, M, POL, EPS, POLSEL) ! wave function EPS(P,POL) for vector boson; P0 > 0 ! as in (3.15) of hep-ph/9805445 (Dittmaier) ! I/O see subroutine wf_V ! ********************************************************************** use ol_parameters_decl_/**/REALKIND, only: CI, sqrt05 + use ol_debug, only: ol_fatal, ol_error implicit none real(REALKIND), intent(in) :: P(0:3), M integer, intent(in) :: POL complex(REALKIND), intent(out) :: EPS(4) + integer, optional, intent(in) :: POLSEL real(REALKIND) :: P2_T, P_T, P_MOD real(REALKIND) :: SIN_THETA, ONEPCOS_THETA , ONEMCOS_THETA real(REALKIND) :: COS_THETA, COS_PHI, SIN_PHI complex(REALKIND) :: EPHI_PLUS, EPHI_MINUS if (P(0) < 0) then - write (*,*) '[OpenLoops] ERROR in subroutine wfIN_V: P0 < 0 forbidden' - stop + call ol_fatal('in subroutine wfIN_V: P0 < 0 forbidden') + end if + + if (present(POLSEL)) then + if (POLSEL == 0) then + continue + else if (POL == 0 .and. POLSEL == 2) then + continue + else if (POL /= POLSEL) then + EPS = small_real + return + end if end if P2_T = P(1)**2 + P(2)**2 @@ -383,7 +559,7 @@ subroutine wfIN_V(P, M, POL, EPS) EPHI_MINUS = (P(1) - CI*P(2)) / P_T ! substitute for cmplx() else - write(*,*) '[OpenLoops] ERROR in subroutine wfIN_V: P^2_T < 0 forbidden' + call ol_error('in subroutine wfIN_V: P^2_T < 0 forbidden') end if if (POL == 1) then ! plus polarisation @@ -476,16 +652,18 @@ end subroutine wfIN_V_MG ! ********************************************************************** -subroutine wfIN_Q(P, M, POL, WF) +subroutine wfIN_Q(P, M, POL, WF, POLSEL) ! wave function U(P,M,POL) for incoming Quark; P(0) > 0; M = 0 or M > 0 or M < 0 ! adapted from hep-ph/9805445 (Dittamier): m -> -m owing to Y.Z. conventions for Chiral rep. ! related to hep-ph/0002082 (HELAC) via Q -> POL*exp(POL*I*Phi)*Q ! ********************************************************************** use ol_parameters_decl_/**/REALKIND, only: CI + use ol_debug, only: ol_fatal implicit none real(REALKIND), intent(in) :: P(0:3), M integer, intent(in) :: POL + integer, optional, intent(in) :: POLSEL complex(REALKIND), intent(out) :: WF(4) real(REALKIND) :: P2_T, P_T, P_MOD real(REALKIND) :: COST, SINT, COSTHALF, SINTHALF, CHI, COSP, SINP @@ -493,16 +671,29 @@ subroutine wfIN_Q(P, M, POL, WF) complex(REALKIND) :: ZETA if (P(0) < 0) then - write(*,*) '[OpenLoops] ERROR in subroutine wfIN_Q: P0 < 0 forbidden' - stop + call ol_fatal('in subroutine wfIN_Q: P0 < 0 forbidden') + end if + + if (present(POLSEL)) then + if (POLSEL == 0) then + continue + else if (POL /= POLSEL) then + WF = 0 + return + end if end if P2_T = P(1)*P(1) + P(2)*P(2) P_T = sqrt(P2_T) P_MOD = sqrt(P2_T + P(3)*P(3)) - COST = P(3) / P_MOD - SINT = P_T / P_MOD + if (P_MOD == 0) then + COST = 1 + SINT = 0 + else + COST = P(3) / P_MOD + SINT = P_T / P_MOD + end if if (P2_T == 0) then COSP = 1 @@ -539,6 +730,7 @@ subroutine wfIN_Q(P, M, POL, WF) end subroutine wfIN_Q + end module ol_wavefunctions_/**/REALKIND @@ -645,6 +837,7 @@ subroutine wf_A(P, M, POL, A) else if(P(0) < 0) then ! out-quark -> U(-P,M,POL) call wfIN_Q(-P,M,-POL,J_AUX) end if + ! Dirac conjugation of spinor A%j(1) = -conjg(J_AUX(3)) A%j(2) = -conjg(J_AUX(4)) @@ -719,12 +912,14 @@ module ol_h_wavefunctions_/**/REALKIND implicit none private public :: wf_S, wf_V, wf_Q, wf_A + public :: pol_wf_S, pol_wf_V, pol_wf_Q, pol_wf_A contains ! ********************************************************************** subroutine wf_S(P, M, POL, S) ! Wave function for a scalar particle. ! Just returns 1 in the component 1 of a 4 component wave function. +! (version without POLSEL kept for compatibility with old process code) ! ********************************************************************** use ol_data_types_/**/REALKIND, only: wfun implicit none @@ -736,9 +931,26 @@ subroutine wf_S(P, M, POL, S) end subroutine wf_S +! ********************************************************************** +subroutine pol_wf_S(P, M, POL, S, POLSEL) +! Wave function for a scalar particle. +! Just returns 1 in the component 1 of a 4 component wave function. +! ********************************************************************** + use ol_data_types_/**/REALKIND, only: wfun + implicit none + real(REALKIND), intent(in) :: P(0:3), M + integer, intent(in) :: POL(1) ! only 1 helicity state + integer, optional, intent(in) :: POLSEL + type(wfun), intent(out) :: S(1) + S(1)%j(1) = 1 ! S%j(2:4) components are not used + S(1)%j(2:4) = 0 +end subroutine pol_wf_S + + ! ********************************************************************** subroutine wf_Q(P, M, POL, Q) ! wave function for an incoming quark or outgoing anti-quark +! (version without POLSEL kept for compatibility with old process code) ! ---------------------------------------------------------------------- ! P(0:3): incoming momentum P^mu (standard representation) ! M >= 0: mass @@ -795,9 +1007,83 @@ subroutine wf_Q(P, M, POL, Q) end subroutine wf_Q +! ********************************************************************** +subroutine pol_wf_Q(P, M, POL, Q, POLSEL) +! wave function for an incoming quark or outgoing anti-quark +! ---------------------------------------------------------------------- +! P(0:3): incoming momentum P^mu (standard representation) +! M >= 0: mass +! POL(:): set of helicity states to be summed +! POL(k): +1|-1 quark polarisation as (14,15) of hep-ph/0002082 (HELAC) +! but with flipped polarisation for outgoing anti-quarks +! ---------------------------------------------------------------------- +! if P(0) > 0: +! Q(k)%j(1:4) = U(P,M,POL(k)) +! = incoming quark wave function +! ---------------------------------------------------------------------- +! if P(0) < 0: +! Q(k)%j(1:4) = V(-P,M,POL(k)) = U(-P,-M,-POL(k)) +! = outgoing anti-quark wave function +! ********************************************************************** + use ol_data_types_/**/REALKIND, only: wfun + use ol_wavefunctions_/**/REALKIND, only: wfIN_Q + implicit none + real(REALKIND), intent(in) :: P(0:3), M + integer, intent(in) :: POL(:) + integer, optional, intent(in) :: POLSEL + type(wfun), intent(out) :: Q(:) + integer :: k + + do k = 1, size(POL) + + if (POL(k) == 99) then + ! signal to ignore all remaining polarisation states + Q(k:size(POL))%j(1) = 0 + Q(k:size(POL))%j(2) = 0 + Q(k:size(POL))%j(3) = 0 + Q(k:size(POL))%j(4) = 0 + Q(k:size(POL))%h = B"00" + exit + end if + + if (present(POLSEL)) then + if (POLSEL == 0) then + continue + else if (POL(k) /= POLSEL) then + Q(k)%j(1) = 0 + Q(k)%j(2) = 0 + Q(k)%j(3) = 0 + Q(k)%j(4) = 0 + Q(k)%h = B"00" + cycle + end if + end if + + if (P(0) >= 0) then ! in-quark -> U(P,M,POL(k)) + call wfIN_Q(P, M, POL(k), Q(k)%j) + else if (P(0) < 0) then ! out-antiquark -> V(-P,M,POL(k)) = U(-P,-M,-POL(k)) + call wfIN_Q(-P, -M, POL(k), Q(k)%j) + end if + + if(M /= 0)then + Q(k)%h = B"11" + else + if(POL(k) == 1)then + Q(k)%h = B"10" + else + Q(k)%h = B"01" + end if + end if + + end do + +end subroutine pol_wf_Q + + ! ********************************************************************** subroutine wf_A(P, M, POL, A) ! wave function for incoming anti-quark or outgoing quark +! (version without POLSEL kept for compatibility with old process code) ! ---------------------------------------------------------------------- ! P(0:3): incoming momentum P^mu (standard representation) ! M >= 0: mass @@ -860,9 +1146,89 @@ subroutine wf_A(P, M, POL, A) end subroutine wf_A +! ********************************************************************** +subroutine pol_wf_A(P, M, POL, A, POLSEL) +! wave function for incoming anti-quark or outgoing quark +! ---------------------------------------------------------------------- +! P(0:3): incoming momentum P^mu (standard representation) +! M >= 0: mass +! POL(:): set of helicity states to be summed +! POL(k): +1|-1 quark polarisation as (14,15) of hep-ph/0002082 (HELAC) +! but with flipped polarisation for outgoing quarks +! ---------------------------------------------------------------------- +! if P(0) > 0: +! A(k)%j(1:4) = Vbar(P,M,POL(k)) = Ubar(P,-M,-POL(k)) +! = INCOMING-antiquark wave function +! ---------------------------------------------------------------------- +! if P(0) < 0: +! A(k)%j(1:4) = Ubar(-P,M,POL(k)) +! = OUTGOING-antiquark wave function +! ********************************************************************** + use ol_data_types_/**/REALKIND, only: wfun + use ol_wavefunctions_/**/REALKIND, only: wfIN_Q + implicit none + + real(REALKIND), intent(in) :: P(0:3), M + integer, intent(in) :: POL(:) + integer, optional, intent(in) :: POLSEL + type(wfun), intent(out) :: A(size(POL)) + complex(REALKIND) :: J_AUX(4) + integer :: k + + do k = 1, size(POL) + + if(POL(k) == 99) then ! signal to ignore all remaining polarisation states + A(k:size(POL))%j(1) = 0 + A(k:size(POL))%j(2) = 0 + A(k:size(POL))%j(3) = 0 + A(k:size(POL))%j(4) = 0 + A(k:size(POL))%h = B"00" + exit + end if + + if (present(POLSEL)) then + if (POLSEL == 0) then + continue + else if (-POL(k) /= POLSEL) then + A(k)%j(1) = 0 + A(k)%j(2) = 0 + A(k)%j(3) = 0 + A(k)%j(4) = 0 + A(k)%h = B"00" + cycle + end if + end if + + if (P(0) >= 0) then ! in-antiquark -> V(P,M,POL(k))=U(P,-M,-POL(k)) + call wfIN_Q(P, -M, -POL(k), J_AUX) + else if(P(0) < 0) then ! out-quark -> U(-P,M,POL(k)) + call wfIN_Q(-P, M, -POL(k), J_AUX) + end if + ! Dirac conjugation of spinor + A(k)%j(1) = -conjg(J_AUX(3)) + A(k)%j(2) = -conjg(J_AUX(4)) + A(k)%j(3) = -conjg(J_AUX(1)) + A(k)%j(4) = -conjg(J_AUX(2)) + + if (M /= 0) then + A(k)%h = B"11" + else + if (POL(k) == 1) then + A(k)%h = B"10" + else + A(k)%h = B"01" + end if + end if + + end do + +end subroutine pol_wf_A + + ! ********************************************************************** subroutine wf_V(P, M, POL, V) ! vector boson wave function (incoming and outgoing) +! (version without POLSEL kept for compatibility with old process code) ! ---------------------------------------------------------------------- ! P(0:3): incoming momentum (standard representation) ! POL(:): set of helicity states @@ -933,4 +1299,93 @@ subroutine wf_V(P, M, POL, V) end subroutine wf_V + +! ********************************************************************** +subroutine pol_wf_V(P, M, POL, V, POLSEL) +! vector boson wave function (incoming and outgoing) +! ---------------------------------------------------------------------- +! P(0:3): incoming momentum (standard representation) +! POL(:): set of helicity states +! POL(k): +1|0|-1 as defined in subroutine wfIN_V +! M >= 0: real mass +! ---------------------------------------------------------------------- +! if P(0) > 0: +! V(k)%j(1:4) = EPS(P,POL(k)) +! = incoming vector boson wave function (light-cone representation) +! ---------------------------------------------------------------------- +! if P(0) < 0: +! V(k)%j(1:4) = EPS^*(-P,POL(k)) +! = outgoing vector boson wave function (light-cone representation) +! ********************************************************************** + use KIND_TYPES + use ol_global_decl, only: MaxParticles + use ol_external_decl_/**/REALKIND, only: P_ex, Ward_array + use ol_parameters_decl_/**/DREALKIND, only: Ward_tree, Ward_loop + use ol_kinematics_/**/REALKIND, only: Std2LC_Rep + use ol_wavefunctions_/**/REALKIND, only: wf_V_Std + use ol_data_types_/**/REALKIND, only: wfun + implicit none + real(REALKIND), intent(in) :: P(0:3), M + integer, intent(in) :: POL(:) + integer, optional, intent(in) :: POLSEL + type(wfun), intent(out) :: V(:) + integer :: i, k + + if (Ward_tree /= 0 .or. Ward_loop /= 0) then + + do i = 1, MaxParticles + ! identify the particle number to associate the Ward_array(i) + if ((P(0) >= 0 .and. all(P == P_ex(:,i))) .or. (P(0) < 0 .and. all(-P == P_ex(:,i)))) exit + end do + + if (Ward_array(i) == 1) then + call Std2LC_Rep(P,V(1)%j) + do k = 2, size(POL) + V(k)%j = 0 + end do + else + do k = 1, size(POL) + if (POL(k) == 99) then ! signal to ignore all remaining polarisation states + V(k:size(POL))%j(1) = 0 + V(k:size(POL))%j(1) = 0 + V(k:size(POL))%j(1) = 0 + V(k:size(POL))%j(1) = 0 + exit + end if + ! normal wavefunction + call wf_V_Std(P, M, POL(k), V(k)%j) + end do + end if + + else + + do k = 1, size(POL) + if (POL(k) == 99) then ! signal to ignore all remaining polarisation states + V(k:size(POL))%j(1) = 0 + V(k:size(POL))%j(2) = 0 + V(k:size(POL))%j(3) = 0 + V(k:size(POL))%j(4) = 0 + exit + end if + if (present(POLSEL)) then + if (POLSEL == 0) then + continue + else if (POL(k) == 0 .and. POLSEL == 2) then + continue + else if (POL(k) /= POLSEL) then + V(k)%j(1) = 0 + V(k)%j(2) = 0 + V(k)%j(3) = 0 + V(k)%j(4) = 0 + cycle + end if + end if + call wf_V_Std(P, M, POL(k), V(k)%j) + end do + + end if + +end subroutine pol_wf_V + + end module ol_h_wavefunctions_/**/REALKIND diff --git a/openloops b/openloops index 105b44c2..5f068c90 100755 --- a/openloops +++ b/openloops @@ -8,6 +8,13 @@ command -v python2 > /dev/null && PYTHON="python2" || PYTHON="python" # SCons executable: prefer the user's installation and use scons-local as fallback command -v scons > /dev/null && SCONS="scons -Q" || SCONS="./scons -Q" +# but if the user's version is not 2.x>2.0 use scons-local anyway +if [ "$SCONS" == "scons -Q" ]; then + if [ `$SCONS -v | grep -c "engine: v2.[^0]"` == "0" ]; then + SCONS="./scons -Q" + fi +fi + # directory for generic libraries LIBDIR="lib" # directory for process libraries @@ -82,8 +89,8 @@ case "$1" in echo " (only if installed from SVN)." echo " update --processes -- update installed processes." echo " libinstall -- download and compile process libraries." - echo " run -- calculate a sample of phase space points" - echo " for all sub-processes for of the process ." + echo " run -- calculate matrix elements for a given process." + echo " see '`basename $0` run --help' for more information." echo " clean -- remove object code and libraries of specified processes." echo " clean --all -- remove object code and libraries of all processes." echo " rm -- remove source, object code and libraries of specified processes." @@ -133,14 +140,18 @@ case "$1" in "interactive"|"int") shift - $PYTHON -i "$PYOLBINDIR/interactive.py" "$@";; + $PYTHON -i "$PYOLBINDIR/interactive_legacy.py" "$@";; "run") + shift + $PYTHON "$PYOLBINDIR/run.py" "$@";; + + "runold") shift to_run="$1" if [ -n "$to_run" ]; then shift - $PYTHON "$PYOLBINDIR/run.py" "$to_run" "$@" + $PYTHON "$PYOLBINDIR/run_legacy.py" "$to_run" "$@" else echo "A process must be specified." exit 1 @@ -151,7 +162,7 @@ case "$1" in to_run="$1" if [ -n "$to_run" ]; then shift - $PYTHON "$PYOLBINDIR/run.py" "--check" "$to_run" "$@" + $PYTHON "$PYOLBINDIR/run_legacy.py" "--check" "$to_run" "$@" else echo "A process or a process check definition file must be specified." exit 1 @@ -216,7 +227,7 @@ case "$1" in processes="$processes $arg" fi done - $SCONS auto="$processes" $options generator=2 + $SCONS auto="$processes" $options ;; "rm") @@ -252,8 +263,18 @@ case "$1" in ;; "stabilityplot") + shift $PYTHON "$PYOLBINDIR/plot_stability.py" "$@";; + "--libdir") + shift + echo $LIBDIR;; + + "--ldflags") + shift + echo "-lopenloops";; + + *) echo "Unknown mode: $1" echo "Type '`basename $0` help' for usage." diff --git a/pyol/bin/download_process.py b/pyol/bin/download_process.py index 54d2b190..8b83f428 100755 --- a/pyol/bin/download_process.py +++ b/pyol/bin/download_process.py @@ -33,7 +33,8 @@ import OLBaseConfig import OLToolbox -config = OLBaseConfig.get_config() +commandline_options = [arg.split('=',1) for arg in sys.argv[1:] if ('=' in arg and not arg.startswith('-'))] +config = OLBaseConfig.get_config(commandline_options) #import argparse #parser = argparse.ArgumentParser( @@ -59,7 +60,8 @@ help='ignore non-existing processes and collections') parser.add_option('-f', '--force', action='store_true', default=False, help='force download') -(args, procs) = parser.parse_args() +(args, procs) = parser.parse_args( + [arg for arg in sys.argv[1:] if (arg.startswith('-') or '=' not in arg)]) print '\n>>> OpenLoops Process Downloader <<<\n' @@ -101,11 +103,7 @@ def untar(archive, destinationpath): def update_channel_db(repo): # get repository name of secret repository - # (assumes that there are no public repositories named .+_.{16}) - if len(repo) > 16 and repo[-17] == '_' and '_' not in repo[-16:]: - repo_name = repo[:-17] - else: - repo_name = repo + repo_name = OLToolbox.repo_name(repo) local_channel_file = channel_db_file % repo_name remote_channel_url = channel_db_url % repo if os.path.isfile(local_channel_file): @@ -150,6 +148,7 @@ def download(process, dbs): # differs from the version available on the server; # - download is forced by '--force' option; print '- process:', process, '...', + sys.stdout.flush() local_process_dir = os.path.join(config['process_src_dir'], process) version_installed = OLToolbox.import_dictionary( os.path.join(local_process_dir, 'version.info'), fatal = False) @@ -189,6 +188,7 @@ def download(process, dbs): # download the process print 'download ...', + sys.stdout.flush() try: rf = urllib2.urlopen(remote_archive) except urllib2.HTTPError: @@ -202,6 +202,7 @@ def download(process, dbs): rf.close() lf.close() print 'extract ...', + sys.stdout.flush() # remove target directory if it already exists try: shutil.rmtree(local_process_dir) @@ -231,6 +232,7 @@ def download(process, dbs): first_repo = True found_colls = set() for repo in config['process_repositories']: + repo_name = OLToolbox.repo_name(repo) # download the channel database for this repository update_channel_db(repo) # Latest OpenLoops process API version for which processes @@ -242,8 +244,10 @@ def download(process, dbs): # with the API of the installed OpenLoops version. process_dbs[repo] = OLToolbox.ProcessDB(db=(version_db_url % repo)) # scan all repositories for collections to download + # Note that when the downloader is invoked by the build script, + # the collections will already be resolved. for coll in collections: - if coll == 'all.coll': + if coll == 'all.coll' or coll == repo_name + '.coll': process_coll = process_dbs[repo].content.keys() else: if first_repo: diff --git a/pyol/bin/interactive_legacy.py b/pyol/bin/interactive_legacy.py new file mode 100644 index 00000000..41eac617 --- /dev/null +++ b/pyol/bin/interactive_legacy.py @@ -0,0 +1,65 @@ + +# Copyright 2014 Fabio Cascioli, Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini +# +# This file is part of OpenLoops. +# +# OpenLoops 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 3 of the License, or +# (at your option) any later version. +# +# OpenLoops 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 OpenLoops. If not, see . + + +import sys + +if sys.version_info[:2] < (2,7): + print "Python 2.7 required." + sys.exit(1) + +import os +import atexit +import readline +import rlcompleter + +import openloops_legacy as openloops + +# command completion with tab +readline.parse_and_bind("tab: complete") + +# command history +historyPath = os.path.expanduser("~/.openloops_history") + +def save_history(historyPath=historyPath): + import readline + readline.write_history_file(historyPath) + +if os.path.exists(historyPath): + readline.read_history_file(historyPath) + +atexit.register(save_history) + +del os, atexit, readline, rlcompleter, save_history, historyPath + +# change the prompt +sys.ps1 = "openloops> " +sys.ps2 = ".......... " + +del sys + +# attach openloops classes to the current namespace +Parameters = openloops.Parameters +PhaseSpacePoint = openloops.PhaseSpacePoint +Process = openloops.Process +MatrixElement = openloops.MatrixElement +ProcessTestData = openloops.ProcessTestData + +# welcome +print """Welcome to the OpenLoops Python interface """ + ".".join(map(str,openloops.version)) + """. +This is a Python interpreter with the OpenLoops module loaded and library paths set.""" diff --git a/pyol/bin/plot_stability.py b/pyol/bin/plot_stability.py index bb12ada3..2976b044 100755 --- a/pyol/bin/plot_stability.py +++ b/pyol/bin/plot_stability.py @@ -235,7 +235,8 @@ def import_files(filesdirs, libraries=None, channels=None): fh.readline(), qp=qp, channel=ch) else: - raise Exception('\'{}\' is neither a file nor a directory'.format(f)) + raise Exception( + '\'{}\' is neither a file nor a directory'.format(filedir)) return [data_dict[key] for key in sorted(data_dict.keys())] @@ -275,8 +276,6 @@ def stability_plot(data): dp_points = list(data.points) while dp_points[-1] == 0: dp_points.pop() - # If a value is zero in a logarithmic step plot, matplotlib - # will omit the vertical line --> use a small number instead. n_dp_points = len(dp_points) # minimal non-zero data point min_dp_point = min(y for y in dp_points if y > 0)/total @@ -315,7 +314,7 @@ def stability_plot(data): n_dp_points + xlimit_lower, n_qp_points + xlimit_lower)) # lower limit of y axis values for log scale: - # 10^n with the larges integer n such that 10^n is smaller + # 10^n with the largest integer n such that 10^n is smaller # than the smallest value miny = 10**math.floor(math.log(min_point, 10)) pyplot.ylim(miny, 2) diff --git a/pyol/bin/run.py b/pyol/bin/run.py index 668b64e1..0c1579d9 100644 --- a/pyol/bin/run.py +++ b/pyol/bin/run.py @@ -1,5 +1,7 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- -# Copyright 2014 Fabio Cascioli, Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini +# Copyright 2015 Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini # # This file is part of OpenLoops. # @@ -17,172 +19,160 @@ # along with OpenLoops. If not, see . -import sys +# TODO +# * Python version check. +# * Accept internal channel identifier to register a process +# (distingish from library name). +# * set model automatically, print message. -if sys.version_info[:2] < (2,7): - print "Python 2.7 required." - sys.exit(1) -import os +import sys +import argparse +import time import openloops -import keywordoptions - -false_values = ("false", "f", "none", "no", "n", "off", "0") -true_values = ("true", "t", "all", "yes", "y", "on", "1") - -args = sys.argv -check = False - -if "--check" in args: - args = [arg for arg in args if arg != "--check"] - check = True - -ko = keywordoptions.KeywordOptions(strict = False) - -ko.add("energy", converter=float) -ko.add("subprocess", converter=openloops.parse_subprocess_argument) -ko.add("n", converter=int) -ko.add("verbose", converter=int, default=1) -#ko.add(openloops.Parameters.names, group="parameters") -ko.add("save", default="False") -if check: - ko.add("data", default="True") - - -def strip_stringlist(ls): - """ - Take a list of strings, cut away comments starting with "#", - strip off whitespace, and remove empty strings. - """ - strippedls = [li.split("#")[0].strip() for li in ls] - strippedls = [li for li in strippedls if li != ""] - return strippedls - -def split_first(s): - ls = s.split(" ", 1) - if len(ls) == 1: - ls.append("") - return ls - - -def default_data_file(process_name): - return os.path.join(openloops.test_data_folder, process_name + ".ptd") - -def data_files(data, save, process_name=None): - # data is None/false/0 -> no src, or true/1 -> auto src, or a file name - if not data or data.lower() in false_values: - src = None - elif data.lower() in true_values: - src = default_data_file(process_name) - else: - src = data - # save is false/0/new -> no dst, or true/1 -> auto dst = src if defined, otherwise default dst. - # save=new will save to src if it doesn't exist. - if save.lower() in false_values or save.lower() == "new": - dst = None - elif save.lower() in true_values: - if src is None: - dst = default_data_file(process_name) - else: - dst = src - else: - dst = save - return src, dst - - -try: - with open(args[1]) as fh: - file_input = True - test_definitions = [split_first(td) for td in strip_stringlist(fh.readlines())] -except IOError: - file_input = False - test_definitions = [[args[1], args[2:]]] - - -if file_input: - global_options = [td[1] for td in test_definitions if td[0] == "global_options"] - test_definitions = [td for td in test_definitions if td[0] != "global_options"] - if len(global_options) == 0: - global_options = "" - elif len(global_options) == 1: - global_options = global_options[0] + " " - else: - raise openloops.OpenLoopsError("Only one global_options specification is allowed.") - override_options = " " + " ".join(args[2:]) +# =============== # +# argument parser # +# =============== # + +def amptype_conv(a): + a = a.lower() + try: + return int(a) + except ValueError: + return a + +parser = argparse.ArgumentParser() +parser.add_argument('process', metavar='PROCESS', + help='The process to calculate') +parser.add_argument( + '-a', '--amptype', type=amptype_conv, default=openloops.LOOP, + choices=openloops.AMPTYPES.keys()+openloops.AMPTYPES.values(), + help='amptype') +parser.add_argument( + '-e', '--energy', type=float, default=openloops.default_energy, + help='Energy to be used in phase space point generation.') +parser.add_argument( + '-n', type=int, metavar='POINTS', default=None, + help='Number of phase space points to calculate matrix elements for.') +parser.add_argument( + '-t', '--time', dest='timing', action='store_true', default=False, + help='''Measure runtime per phase space point + (may be inaccurate for very simple processes).''') +parser.add_argument( + '--tt', type=float, dest='mintime', metavar='MINTIME', default=10, + help='Minimal time for runtime measurements in seconds.') +parser.add_argument( + '--tn', type=int, dest='minn', metavar='MINN', default=1, + help='Minimal number of points in runtime measurements.') +parser.add_argument( + '-v', '--verbose', type=int, default=1, help='Verbosity level') +# This is just to create a help message, opt=val pairs are extracted manually +# to avoid ordering conflicts between options and positional arguments. +parser.add_argument( + 'options', metavar='OPT=VAL', nargs='*', + help='Options to pass to directly to OpenLoops') + +options = [arg for arg in sys.argv[1:] if ('=' in arg and not arg.startswith('-'))] +args = parser.parse_args( + [arg for arg in sys.argv[1:] if (arg.startswith('-') or '=' not in arg)]) +if not args.timing and args.n is None: + args.n = 1 + +# ======================== # +# parameter initialisation # +# ======================== # + +openloops.set_parameter('splash',0) + +for opt in options: + try: + key, val = opt.split('=',1) + except ValueError: + print '[PYOL] ERROR: invalid option \'{}\''.format(opt) + sys.exit(1) + if key.startswith('alpha') and '/' in val: + try: + valnum, valden = val.split('/') + val = float(valnum)/float(valden) + except ValueError: + print '[PYOL] ERROR: invalid option \'{}\''.format(opt) + if args.verbose >= 3: + print 'call set_parameter({},{})'.format(key,val) + openloops.set_parameter(key, val) + +# ================== # +# register processes # +# ================== # + +is_library = False +if not '>' in args.process: + is_library = True + try: + procinfo = openloops.ProcessInfo(args.process) + except openloops.ProcessInfoError: + is_library = False + +if not is_library: + # register a partonic channel + try: + processes = [openloops.Process(args.process, args.amptype)] + except openloops.RegisterProcessError: + print ('[PYOL] ERROR registering process \'{}\' ' + + 'with amptype {}.').format(args.process, args.amptype) + if not '>' in args.process: + print '(reading info file failed, too)' + sys.exit(1) else: - global_options = [] - override_options = [] - - - -def run_process(test_def, dst_override=None, quiet=False): - process_name = test_def[0] - options = global_options + test_def[1] + override_options - ko.parse(options) - if dst_override: - save = dst_override - else: - save = ko.save - src, dst = data_files(None, save, process_name) - if not dst and ko.save.lower() == "new": - default_dst = default_data_file(process_name) - if not os.path.exists(default_dst): - dst = default_dst - if not quiet: - print "\nProcess:", process_name, "with options", options - if ko.remaining_args: - print "WARNING: unrecognised options:", ko.remaining_args - print "Destination file:", dst - print - ptd = openloops.ProcessTestData(test_def[0], - subprocess=ko.subprocess, - phasespace=ko.energy, - n=ko.n, - parameters=openloops.Parameters(**ko.unknown_options), - verbose=ko.verbose) - if dst: - ptd.dump(dst) - print "Created reference data." - - - -def check_process(test_def): - process_name = test_def[0] - options = global_options + test_def[1] + override_options - print "\nProcess:", process_name, "with options", options, "(ignored in check mode)" - ko.parse(options) - if ko.remaining_args: - print "WARNING: unrecognised options:", ko.remaining_args - src, dst = data_files(ko.data, ko.save, process_name) - src_msg = src - if src and not os.path.exists(src): - if ko.save.lower() == "new": - dst = src - src = None - src_msg = "NOT FOUND" - print "Source file: ", src_msg - print "Destination file:", dst + # register channels from a process library + try: + processes = procinfo.register() + except openloops.RegisterProcessError as err: + print ('[PYOL] ERROR while registering process from library ' + + '{}:\n {}').format(args.process, err.args[0]) + sys.exit(1) + +# === # +# run # +# === # + +def eval_and_print(proc, first=False): + me = proc.evaluate(args.energy) + if args.verbose >= 2: + print me.psp + if args.verbose >= 1: + if first: + if me.amptype == openloops.TREE: + print '{:>23}'.format('tree') + elif me.amptype == openloops.LOOP: + print (5*'{:>23}').format( + 'tree', 'finite', 'ir1', 'ir2', 'acc') + elif me.amptype == openloops.LOOP2: + print (2*'{:>23}').format('loop2', 'acc') + print me.valuestr() + +for proc in processes: print - if src is None: - run_process(test_def, dst_override=dst, quiet=True) - if not dst: - print "NOT VALIDATED" + print '"' + proc.process + '"' + if not args.timing: + for n in range(args.n): + eval_and_print(proc, first=not(n)) else: - ptd = openloops.ProcessTestData.load(src) - new_ptd = ptd.validate(verbose=ko.verbose) - agrees = new_ptd.check_successful - if agrees: - print "Validation succeeded" + eval_and_print(proc, first=True) + eval_and_print(proc) + starttime = time.clock() + if args.n is not None: + npoints = args.n + for n in range(args.n): + eval_and_print(proc, first=not(n)) else: - print "VALIDATION FAILED" - if dst is not None and (agrees or force): - new_ptd.dump(dst) - - - -for test_def in test_definitions: - if check: - check_process(test_def) - else: - run_process(test_def) + npoints = 0 + while (time.clock() < starttime + args.mintime or + npoints < args.minn): + npoints = npoints + 1 + eval_and_print(proc) + endtime = time.clock() + print ('time per phase space point: {:3f} ms (avg. of {} ' + + 'points)').format(1000*(endtime - starttime)/npoints, npoints) + +print diff --git a/pyol/bin/run_legacy.py b/pyol/bin/run_legacy.py new file mode 100644 index 00000000..cbb1d774 --- /dev/null +++ b/pyol/bin/run_legacy.py @@ -0,0 +1,188 @@ + +# Copyright 2014 Fabio Cascioli, Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini +# +# This file is part of OpenLoops. +# +# OpenLoops 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 3 of the License, or +# (at your option) any later version. +# +# OpenLoops 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 OpenLoops. If not, see . + + +import sys + +if sys.version_info[:2] < (2,7): + print "Python 2.7 required." + sys.exit(1) + +import os +import openloops_legacy as openloops +import keywordoptions + +false_values = ("false", "f", "none", "no", "n", "off", "0") +true_values = ("true", "t", "all", "yes", "y", "on", "1") + +args = sys.argv +check = False + +if "--check" in args: + args = [arg for arg in args if arg != "--check"] + check = True + +ko = keywordoptions.KeywordOptions(strict = False) + +ko.add("energy", converter=float) +ko.add("subprocess", converter=openloops.parse_subprocess_argument) +ko.add("n", converter=int) +ko.add("verbose", converter=int, default=1) +#ko.add(openloops.Parameters.names, group="parameters") +ko.add("save", default="False") +if check: + ko.add("data", default="True") + + +def strip_stringlist(ls): + """ + Take a list of strings, cut away comments starting with "#", + strip off whitespace, and remove empty strings. + """ + strippedls = [li.split("#")[0].strip() for li in ls] + strippedls = [li for li in strippedls if li != ""] + return strippedls + +def split_first(s): + ls = s.split(" ", 1) + if len(ls) == 1: + ls.append("") + return ls + + +def default_data_file(process_name): + return os.path.join(openloops.test_data_folder, process_name + ".ptd") + + +def data_files(data, save, process_name=None): + # data is None/false/0 -> no src, or true/1 -> auto src, or a file name + if not data or data.lower() in false_values: + src = None + elif data.lower() in true_values: + src = default_data_file(process_name) + else: + src = data + # save is false/0/new -> no dst, or true/1 -> auto dst = src if defined, otherwise default dst. + # save=new will save to src if it doesn't exist. + if save.lower() in false_values or save.lower() == "new": + dst = None + elif save.lower() in true_values: + if src is None: + dst = default_data_file(process_name) + else: + dst = src + else: + dst = save + return src, dst + + +try: + with open(args[1]) as fh: + file_input = True + test_definitions = [split_first(td) for td in strip_stringlist(fh.readlines())] +except IOError: + file_input = False + test_definitions = [[args[1], args[2:]]] + + +if file_input: + global_options = [td[1] for td in test_definitions if td[0] == "global_options"] + test_definitions = [td for td in test_definitions if td[0] != "global_options"] + if len(global_options) == 0: + global_options = "" + elif len(global_options) == 1: + global_options = global_options[0] + " " + else: + raise openloops.OpenLoopsError("Only one global_options specification is allowed.") + override_options = " " + " ".join(args[2:]) +else: + global_options = [] + override_options = [] + + + +def run_process(test_def, dst_override=None, quiet=False): + process_name = test_def[0] + options = global_options + test_def[1] + override_options + ko.parse(options) + if dst_override: + save = dst_override + else: + save = ko.save + src, dst = data_files(None, save, process_name) + if not dst and ko.save.lower() == "new": + default_dst = default_data_file(process_name) + if not os.path.exists(default_dst): + dst = default_dst + if not quiet: + print "\nProcess:", process_name, "with options", options + if ko.remaining_args: + print "WARNING: unrecognised options:", ko.remaining_args + print "Destination file:", dst + print + ptd = openloops.ProcessTestData(test_def[0], + subprocess=ko.subprocess, + phasespace=ko.energy, + n=ko.n, + parameters=openloops.Parameters(**ko.unknown_options), + verbose=ko.verbose) + if dst: + ptd.dump(dst) + print "Created reference data." + + + +def check_process(test_def): + process_name = test_def[0] + options = global_options + test_def[1] + override_options + print "\nProcess:", process_name, "with options", options, "(ignored in check mode)" + ko.parse(options) + if ko.remaining_args: + print "WARNING: unrecognised options:", ko.remaining_args + src, dst = data_files(ko.data, ko.save, process_name) + src_msg = src + if src and not os.path.exists(src): + if ko.save.lower() == "new": + dst = src + src = None + src_msg = "NOT FOUND" + print "Source file: ", src_msg + print "Destination file:", dst + print + if src is None: + run_process(test_def, dst_override=dst, quiet=True) + if not dst: + print "NOT VALIDATED" + else: + ptd = openloops.ProcessTestData.load(src) + new_ptd = ptd.validate(verbose=ko.verbose) + agrees = new_ptd.check_successful + if agrees: + print "Validation succeeded" + else: + print "VALIDATION FAILED" + if dst is not None and (agrees or force): + new_ptd.dump(dst) + + + +for test_def in test_definitions: + if check: + check_process(test_def) + else: + run_process(test_def) diff --git a/pyol/bin/show.py b/pyol/bin/show.py index 33afcde0..49d507f0 100644 --- a/pyol/bin/show.py +++ b/pyol/bin/show.py @@ -24,7 +24,7 @@ sys.exit(1) import os -import openloops +import openloops_legacy as openloops import keywordoptions diff --git a/pyol/bin/upload_process.py b/pyol/bin/upload_process.py index 84f80f42..f2263614 100755 --- a/pyol/bin/upload_process.py +++ b/pyol/bin/upload_process.py @@ -193,6 +193,7 @@ def upload_process(process, db, ch_db, api): to a repository on the web server.""" # need: repository_path, deprecated_path, backup_old_processes print '- upload process:', process, '...', + sys.stdout.flush() old_date, old_hash, old_descr = db.get(process, (None, None, None)) process_dir = os.path.join(config['process_src_dir'], process) process_version_file = os.path.join(process_dir, 'version.info') @@ -252,10 +253,12 @@ def upload_process(process, db, ch_db, api): os.rename(server_process_archive, server_backup_archive) except OSError: print '[process backup failed]', + sys.stdout.flush() try: os.rename(server_process_definition, server_backup_definition) except OSError: print '[definition backup failed]', + sys.stdout.flush() # create process archive archive = tarfile.open(local_process_archive, 'w:gz') @@ -290,14 +293,25 @@ def upload_process(process, db, ch_db, api): info_options = info_options[0].split()[1:] else: info_options = [] - info_files = [ - os.path.join(process_dir, inf) for inf in os.listdir(process_dir) - if inf.startswith('info_' + process + '_') and inf.endswith('.txt')] + info_files = OLToolbox.import_list(os.path.join( + process_dir, "process_definition", "subprocesses.list")) + info_files = [os.path.join(process_dir, "info_" + proc + ".txt") + for proc in info_files] + info_files_extra = OLToolbox.import_list(os.path.join( + process_dir, "process_definition", "subprocesses_extra.list")) + info_files_extra = [os.path.join(process_dir, "info_" + proc + ".txt") + for proc in info_files_extra] channels = [] for inf in info_files: channels.extend([line.split() + info_options for line in OLToolbox.import_list(inf)]) - ch_db.update({process: channels}) + channels.sort(key=lambda el: el[1]) + channels_extra = [] + for inf in info_files_extra: + channels_extra.extend([line.split() + info_options + for line in OLToolbox.import_list(inf)]) + channels_extra.sort(key=lambda el: el[1]) + ch_db.update({process: channels + channels_extra}) # upload process archive and definition, delete temporary local archive shutil.copyfile(local_process_archive, server_process_archive) os.remove(local_process_archive) @@ -309,6 +323,7 @@ def delete_process(process, db, ch_db, api): """Delete a process from a repository on the server.""" # need: repository_path, deprecated_path, backup_old_processes print '- delete process:', process, '...', + sys.stdout.flush() old_date, old_hash, old_descr = db.get(process, (None, None, None)) if not old_date: print 'skipped: does not exist' @@ -326,18 +341,22 @@ def delete_process(process, db, ch_db, api): os.rename(server_process_archive, server_backup_archive) except OSError: print '[process backup failed]', + sys.stdout.flush() try: os.rename(server_process_definition, server_backup_definition) except OSError: print '[definition backup failed]', + sys.stdout.flush() else: try: os.remove(server_process_archive) except OSError: print '[deleting process failed]', + sys.stdout.flush() os.remove(server_process_definition) except OSError: print '[deleting definition failed]', + sys.stdout.flush() # update process and channel databases db.remove(process) ch_db.remove(process) @@ -400,6 +419,7 @@ def delete_process(process, db, ch_db, api): if process_db.updated or channel_db.updated: print 'update process database ...', + sys.stdout.flush() process_db.export_db(version_db_file) channel_db.export_db(channel_db_file) diff --git a/pyol/build/cpp.scons b/pyol/build/cpp.scons index 7b898513..6636833b 100644 --- a/pyol/build/cpp.scons +++ b/pyol/build/cpp.scons @@ -25,11 +25,15 @@ # USE_p if precision p is active globally # PRECISION_p if the currect file is for precision p +# TODO: better use a pseudo builder to modify target directories import os +import sys +sys.path.insert(0, os.path.abspath(os.path.join('pyol', 'tools'))) +import OLBaseConfig +config = OLBaseConfig.get_config() cpp_flags = ['--traditional-cpp', '-P'] -# TODO: better use a pseudo builder to modify target directories def split_and_clean(ls): """Create a list from a comma separated string and remove empty elements.""" @@ -40,7 +44,7 @@ dp_src = split_and_clean(ARGUMENTS.get('dp_src', '')) version_src = split_and_clean(ARGUMENTS.get('version_src', '')) cpp_defs = split_and_clean(ARGUMENTS.get('def', '')) mp = split_and_clean(ARGUMENTS.get('mp', 'dp')) -cpp_cmd = ARGUMENTS.get('cpp_cmd', 'cpp' ) +cpp_cmd = ARGUMENTS.get('cpp_cmd', config['cpp']) kind_parameter = ARGUMENTS.get('kind_parameter', 'REALKIND') version_macro = ARGUMENTS.get('version_macro', 'VERSION' ) revision_macro = ARGUMENTS.get('revision_macro', 'REVISION') @@ -68,10 +72,20 @@ def target_rename(target, source, env): cpp_builder = Builder(action = '$CPP $CPPFLAGS $_CPPDEFFLAGS $SOURCE $TARGET', emitter = target_rename, single_source = 1) +copy_builder = Builder(action = Copy('$TARGET', '$SOURCE'), + emitter = target_rename, + single_source = 1) +if '@all' in config['import_env']: + imported_env = os.environ +else: + imported_env = {} + for envvar in config['import_env']: + imported_env[envvar] = os.environ.get(envvar, '') env = Environment(CPP = cpp_cmd, - BUILDERS = {'CPP': cpp_builder}, + ENV = imported_env, + BUILDERS = {'CPP': cpp_builder, 'COPY': copy_builder}, CPPFLAGS = cpp_flags, CPPDEFINES = cpp_defs, PRECISION = mp[0]) @@ -85,8 +99,12 @@ if mp_src: CPPDEFINES = cpp_defs + ['PRECISION_' + precision])) if dp_src: - cpp_out.extend(env.CPP(source = dp_src, - PRECISION = '')) + dp_fsrc = [fs for fs in dp_src if not fs.endswith('.c')] + dp_csrc = [cs for cs in dp_src if cs.endswith('.c')] + if dp_fsrc: + cpp_out.extend(env.CPP(source = dp_fsrc, PRECISION = '')) + if dp_csrc: + cpp_out.extend(env.COPY(source = dp_csrc, PRECISION = '')) if version_src: cpp_out.extend(env.CPP(source = version_src, diff --git a/pyol/config/default.cfg b/pyol/config/default.cfg index 849a7d2e..399c267e 100644 --- a/pyol/config/default.cfg +++ b/pyol/config/default.cfg @@ -10,6 +10,10 @@ supported_compilers = gfortran ifort fortran_compiler = gfortran +fortran_tool = auto +cc = gcc +cxx = g++ +cpp = cpp # compiler dependent flags gfortran_noautomatic = -fno-automatic @@ -20,7 +24,7 @@ ifort_noautomatic = -save ifort_f77_flags = -132 ifort_f90_flags = ifort_f_flags = - +ccflags = -Wall # generator: 0:off, 1:on, 2:download generator = 2 @@ -32,7 +36,7 @@ gjobs = 1 glog = 0 # release version; max. 8 characters, empty if none -release = +release = 1.2.3 clean = # precision: [sp (single),] dp (double), [ep (extended, only gfortran),] qp (quad), @@ -48,7 +52,7 @@ num_jobs = 0 # compile: 0:off, 1:on (generic libraries only when no process is specified), 2:on compile = 2 # compile extra: compile 'extra' processes (usually extra means real corrections) -compile_extra = 1 +compile_extra = 0 # compile_libraries/link_libraries: whitespace separated list of rambo, collier, cuttools, samurai # if needed, olcommon, oneloop, openloops are added automatically @@ -67,11 +71,11 @@ debug_flags_1 = -g # added to f_flags if debug = 4,5,6,7 gfortran_debug_flags_4 = -Warray-bounds -fbounds-check ifort_debug_flags_4 = -CB -debug_flags_4 = %%(%(fortran_compiler)s_debug_flags_4)s +debug_flags_4 = %%(%(fortran_tool)s_debug_flags_4)s # Fortran 77 compiler options -f77_flags = %%(%(fortran_compiler)s_f77_flags)s +f77_flags = %%(%(fortran_tool)s_f77_flags)s # Fortran 90 compiler options -f90_flags = %%(%(fortran_compiler)s_f90_flags)s +f90_flags = %%(%(fortran_tool)s_f90_flags)s # loop_optimisation is only used for loop_*, virtual__*, tensorsum_* generic_optimisation = -O2 born_optimisation = -O2 @@ -81,10 +85,10 @@ link_optimisation = -O2 common_flags = link_flags = %(common_flags)s # common Fortran compiler options, added to f77_flags and f90_flags -f_flags = %%(%(fortran_compiler)s_f_flags)s %(common_flags)s -noautomatic = %%(%(fortran_compiler)s_noautomatic)s +f_flags = %%(%(fortran_tool)s_f_flags)s %(common_flags)s +noautomatic = %%(%(fortran_tool)s_noautomatic)s -import_path = 1 +import_env = PATH LD_LIBRARY_PATH CPATH C_INCLUDE_PATH CPLUS_INCLUDE_PATH INTEL_LICENSE_FILE math_cmd = math-8.0 math_flags = -noinit lib_src_dir = lib_src diff --git a/pyol/tools/OLBaseConfig.py b/pyol/tools/OLBaseConfig.py index 5187c815..afea7ce8 100644 --- a/pyol/tools/OLBaseConfig.py +++ b/pyol/tools/OLBaseConfig.py @@ -108,7 +108,13 @@ def get_config(args=[]): # parse options parse_option(config, 'num_jobs', converter=int) parse_option(config, 'supported_compilers', converter=split_list) - parse_option(config, 'fortran_compiler', one_of=config['supported_compilers']) + parse_option(config, 'fortran_tool', + one_of=config['supported_compilers']+['auto']) + parse_option(config, 'fortran_compiler') + parse_option(config, 'cpp') + parse_option(config, 'cc') + parse_option(config, 'cxx') + parse_option(config, 'ccflags', converter=split_list) parse_option(config, 'generator', converter=int, one_of=[0,1,2]) parse_option(config, 'gjobs', converter=int) parse_option(config, 'compile', converter=int, one_of=[0,1,2]) @@ -132,19 +138,26 @@ def get_config(args=[]): parse_option(config, 'born_optimisation', converter=split_list) parse_option(config, 'loop_optimisation', converter=split_list) parse_option(config, 'link_optimisation', converter=split_list) - parse_option(config, 'import_path', converter=parse_bool) + parse_option(config, 'import_env', converter=split_list) parse_option(config, 'process_repositories', converter=split_list) parse_option(config, 'process_api_version', converter=int) parse_option(config, 'template_files', converter=split_list) parse_option(config, 'generator_files', converter=split_list) parse_option(config, 'force_download', converter=parse_bool) parse_option(config, 'process_update', converter=parse_bool) - for compiler in config['supported_compilers']: - parse_option(config, compiler + '_noautomatic') - parse_option(config, compiler + '_f77_flags') - parse_option(config, compiler + '_f90_flags') - parse_option(config, compiler + '_f_flags') - parse_option(config, compiler + '_debug_flags_4') + + if config['fortran_tool'] == 'auto': + if config['fortran_compiler'].startswith('ifort'): + config['fortran_tool'] = 'ifort' + else: + config['fortran_tool'] = 'gfortran' + + config['auto_noautomatic'] = config[config['fortran_tool'] + '_noautomatic'] + config['auto_f77_flags'] = config[config['fortran_tool'] + '_f77_flags'] + config['auto_f90_flags'] = config[config['fortran_tool'] + '_f90_flags'] + config['auto_f_flags'] = config[config['fortran_tool'] + '_f_flags'] + config['auto_debug_flags_4'] = config[config['fortran_tool'] + + '_debug_flags_4'] parse_option(config, 'noautomatic', interpolate=True, converter=split_list) parse_option(config, 'f77_flags', interpolate=True, converter=split_list) parse_option(config, 'f90_flags', interpolate=True, converter=split_list) @@ -152,7 +165,8 @@ def get_config(args=[]): parse_option(config, 'common_flags', interpolate=True, converter=split_list) parse_option(config, 'link_flags', interpolate=True, converter=split_list) parse_option(config, 'debug_flags_1', converter=split_list) - parse_option(config, 'debug_flags_4', interpolate=True, converter=split_list) + parse_option(config, 'debug_flags_4', interpolate=True, + converter=split_list) if config['num_jobs'] <= 0: import multiprocessing @@ -168,6 +182,7 @@ def get_config(args=[]): if config['debug'] in (1,3,5,7): config['f_flags'].extend(config['debug_flags_1']) + config['ccflags'].extend(config['debug_flags_1']) if config['debug'] in (2,3,6,7): config['generic_optimisation'] = ['-O0'] config['born_optimisation'] = ['-O0'] diff --git a/pyol/tools/OLLibrary.py b/pyol/tools/OLLibrary.py index af769237..98a748cf 100644 --- a/pyol/tools/OLLibrary.py +++ b/pyol/tools/OLLibrary.py @@ -114,7 +114,8 @@ def __init__(self, name, target_dir = '', mod_dir = '@mod', mod_dependencies = [ else: self.mod_dir = mod_dir self.mod_dependencies = list(mod_dependencies) - self.linklibs = linklibs + [dep.lower() for dep in mod_dependencies] + self.linklibs = list(set( + linklibs + [dep.lower() for dep in mod_dependencies])) self.src = [] self.add(src_dir = src_dir, mp_src = list(mp_src), dp_src = list(dp_src), version_src = list(version_src), py_src = list(py_src), to_cpp = to_cpp) diff --git a/pyol/tools/OLToolbox.py b/pyol/tools/OLToolbox.py index 844ae2d4..925af514 100644 --- a/pyol/tools/OLToolbox.py +++ b/pyol/tools/OLToolbox.py @@ -137,42 +137,46 @@ def export_dictionary(filename, dic, form='%s %s'): export_list(filename, ls) - # ============ # # SVN revision # # ============ # - def get_svn_revision(mandatory=False): """Get the SVN revision number from `svn info` in the current working directory.""" import subprocess - - svninfo_proc = subprocess.Popen( - ['svn', 'info'], stdout=subprocess.PIPE, stderr=subprocess.PIPE) - svninfo_out, svninfo_err = svninfo_proc.communicate() - svninfo_exitcode = svninfo_proc.returncode - + svninfo_exitcode = 1 + try: + svninfo_proc = subprocess.Popen( + ['svn', 'info'], stdout=subprocess.PIPE, stderr=subprocess.PIPE) + svninfo_out, svninfo_err = svninfo_proc.communicate() + svninfo_exitcode = svninfo_proc.returncode + except OSError: + try: + svninfo_proc = subprocess.Popen( + ['svnlite', 'info'], + stdout=subprocess.PIPE, stderr=subprocess.PIPE) + svninfo_out, svninfo_err = svninfo_proc.communicate() + svninfo_exitcode = svninfo_proc.returncode + except OSError: + pass revision = 'none' - for line in svninfo_out.split('\n'): - line = line.split() - if len(line) == 2 and line[0] == 'Revision:' and line[1].isdigit(): - revision = int(line[1]) - break - + if not svninfo_exitcode: + for line in svninfo_out.split('\n'): + line = line.split() + if len(line) == 2 and line[0] == 'Revision:' and line[1].isdigit(): + revision = int(line[1]) + break if mandatory and (revision == 'none' or svninfo_exitcode != 0): raise OSError(svninfo_exitcode, '`svn info` failed. ' + svninfo_err.strip()) - return revision - # ============================ # # Process library source files # # ============================ # - def get_subprocess_src(loops, sub_process, processlib_src_dir, nvirtualfiles=0, override_loops=False): """Return lists of double precision, multi precision and info files @@ -400,3 +404,11 @@ def export_db(self, db=None): time.strftime(timeformat)) export_list(tmp_file, data) os.rename(tmp_file, self.db_file) + + +def repo_name(repo): + # (assumes that there are no public repositories named .+_.{16}) + if len(repo) > 16 and repo[-17] == '_' and '_' not in repo[-16:]: + return repo[:-17] + else: + return repo diff --git a/pyol/tools/openloops.py b/pyol/tools/openloops.py index e2edaa05..cffc1865 100644 --- a/pyol/tools/openloops.py +++ b/pyol/tools/openloops.py @@ -1,7 +1,7 @@ #!/usr/bin/env python # -*- coding: utf-8 -*- -# Copyright 2014 Fabio Cascioli, Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini +# Copyright 2015 Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini # # This file is part of OpenLoops. # @@ -18,900 +18,497 @@ # You should have received a copy of the GNU General Public License # along with OpenLoops. If not, see . -# This module requires Python 2.7, but this must be tested before importing -# the module. -import sys -import os -import shlex -import math -import atexit -import pickle -from ctypes import CDLL, byref, c_int, c_double, c_char_p - -import OLBaseConfig - -if sys.platform.startswith("darwin"): - shared_lib_ext = ".dylib" -else: - shared_lib_ext = ".so" - -pyol = CDLL("libopenloops" + shared_lib_ext) - -pyol_setparameter = pyol.ol_setparameter_string -pyol_rambo = pyol.ol_rambo -pyol_parameters_flush = pyol.ol_parameters_flush -pyol_parameters_write = pyol.ol_parameters_write -pyol_finish = pyol.ol_finish +# TODO +# * ProcessInfo(): select loop/tree processes only, +# use Type= to group channels. +# * Take proclib_dir from OL config? +# * If config is loaded, replace loopspec_flags. +# * Retrieve install_path (needs getparameter_string)? -pyol_n_particles = "ol_n_external_%s" -pyol_get_external_masses = "ol_get_masses_%s" -pyol_set_permutation = "ol_set_permutation_%s" -pyol_amp2tree = "ol_amp2tree_%s" -pyol_vamp2 = "ol_vamp2_%s" -pyol_ctamp2 = "ol_ctamp2_%s" -pyol_ptamp2 = "ol_ptamp2_%s" +import os +import sys +import atexit +import ctypes +import collections +from ctypes import c_int, c_double, c_char_p, byref, POINTER -if sys.version_info[:2] < (2,7): - print "This module requires Python 2.7." - sys.exit(1) +proclib_dir = 'proclib' +c_int_ptr = POINTER(c_int) +c_double_ptr = POINTER(c_double) +TREE = 1 +CC = 2 +SC = 3 +SCPV = 4 +LOOP = 11 +LOOP2 = 12 +AMPTYPES = {'tree': TREE, 'cc': CC, 'sc': SC, 'scpv': SCPV, + 'loop': LOOP, 'loop2': LOOP2} +loopspec_flags = 'tlsp' -# Openloops interface version. -# In future version this can be used to import ProcessTestData in a deprecated format. -version = (0,1) -test_data_folder = "test_data" -# center-of-mass energy if not specified otherwise default_energy = 1000 -# number of phase space points in test data if not specified otherwise -default_sample_size = 10 -# various accuracy thresholds in digits -phasespace_accuracy_warn = 9 -phasespace_accuracy_fatal = 5 -tree_accuracy_warn = 9 -tree_accuracy_fatal = 5 -matrix_element_agreement = 5 -# precision of 'float' in digits -max_precision = sys.float_info.mant_dig * math.log(2,10) - - -atexit.register(pyol_finish) - +default_amptype = LOOP +numberformat = '{:>23.15e}' class OpenLoopsError(Exception): pass +class RegisterProcessError(OpenLoopsError): + pass +class ProcessInfoError(OpenLoopsError): + pass -def float_list_string(ls): - return "[ " + ", ".join(["{:>23.15e}".format(val) for val in ls]) + " ]" - - - -def common_digits(x, y): - if x == y: - return max_precision - else: - return -math.log(2*abs(x-y)/(abs(x)+abs(y)), 10) - - - -def valid_permutation(arg, n=None): - if isinstance(arg, str): - try: - perm = eval(arg) - except SyntaxError: - raise ValueError("Invalid permutation: " + repr(arg)) - else: - perm = arg - if not (isinstance(perm, list) and - all([lambda nn: isinstance(nn, int) for nn in perm]) and - set(perm) == set(range(1, len(perm)+1))): - raise ValueError("Invalid permutation: " + repr(arg)) - if n is not None and max(perm) != n: - raise ValueError("Permutation " + repr(arg) + " does not have length " + repr(n)) - return perm - - +#from ctypes.util import find_library +#libopenloops = find_library('openloops') +#if not libopenloops: + #print 'ERROR: openloops library not found' + #sys.exit(1) +#ol = ctypes.CDLL(libopenloops) -def to_subprocess_id(sp): - if isinstance(sp, SubprocessID): - return sp - else: - return SubprocessID(sp) - - - -def parse_subprocess_argument(arg, process=None): - """ - Convert a string into a list of SubprocessID instances. - - Example: "sub[2,3,1],sub_2,..." --> [SubprocessID("sub[2,3,1]"), SubprocessID("sub_2"), ...] - """ - # quote permutation lists: sub[1,2,3] --> sub"[1,2,3]" - if isinstance(arg, str): - sl = arg.replace("[", "\"[").replace("]", "]\"") - sl = shlex.shlex(sl, posix=True) - sl.whitespace = "," - sl.whitespace_split = True - sl.wordchars += "[]" - sp_list = [SubprocessID(sp) for sp in sl] - elif isinstance(arg, (list, tuple, set)): - sp_list = [to_subprocess_id(sp) for sp in arg] +if sys.platform.startswith("darwin"): + ol = ctypes.CDLL("libopenloops.dylib") +else: + ol = ctypes.CDLL("libopenloops.so") + +class LibraryContent(object): + def __init__(self, content, func=None, args=None): + # content bit flag order: 1=tree 2=loop 4=loops 8=pt + self.tree = bool(content & 1) + self.loop = bool((content >> 1) & 1) + self.loop2 = bool((content >> 2) & 1) + self.pt = bool((content >> 3) & 1) + +# (const char* key, int val) +setparameter_int = ol.ol_setparameter_int +setparameter_int.argtypes = [c_char_p, c_int] +setparameter_int.restype = None + +# (const char* key, double val) +setparameter_double = ol.ol_setparameter_double +setparameter_double.argtypes = [c_char_p, c_double] +setparameter_double.restype = None + +# (const char* key, char* val) +setparameter_string = ol.ol_setparameter_string +setparameter_string.argtypes = [c_char_p, c_char_p] +setparameter_string.restype = None + +# (const char* key, int[1] val) +getparameter_int_c = ol.ol_getparameter_int +getparameter_int_c.argtypes = [c_char_p, c_int_ptr] +getparameter_int_c.restype = None + +# (const char* key, double[1] val) +getparameter_double_c = ol.ol_getparameter_double +getparameter_double_c.argtypes = [c_char_p, c_double_ptr] +getparameter_double_c.restype = None + +# (const char* proc, int amptype) -> int +register_process = ol.ol_register_process +register_process.argtypes = [c_char_p, c_int] +register_process.restype = int + +# (int id) -> int +n_external = ol.ol_n_external +n_external.argtypes = [c_int] +n_external.restype = int + +# (int id) -> int +amplitudetype = ol.ol_amplitudetype +n_external.argtypes = [c_int] +n_external.restype = int + +# (int id, double sqrt_s, double[5*n] pp) +phase_space_point_c = ol.ol_phase_space_point +phase_space_point_c.argtypes = [c_int, c_double, c_double_ptr] +phase_space_point_c.restype = None + +parameters_flush = ol.ol_parameters_flush +parameters_flush.argtypes = [] +parameters_flush.restype = None + +parameters_write = ol.ol_printparameter +parameters_write.argtypes = [] +parameters_write.restype = None + +start = ol.ol_start +start.argtypes = [] +start.restype = None +start.started = False + +finish = ol.ol_finish +finish.argtypes = [] +finish.restype = None + +library_content = ol.ol_library_content +library_content.argtypes = [c_int] +library_content.restype = int +library_content.errcheck = LibraryContent + +# (int id, double[5*n] pp, double[1] tree) +evaluate_tree_c = ol.ol_evaluate_tree +evaluate_tree_c.argtypes = [c_int, c_double_ptr, c_double_ptr] +evaluate_tree_c.restype = None + +# (int id, double[5*n] pp, double[1] tree, double[r] cc, double[1] ewcc) +evaluate_cc_c = ol.ol_evaluate_cc +evaluate_cc_c.argtypes = [c_int, c_double_ptr, c_double_ptr, + c_double_ptr, c_double_ptr] +evaluate_cc_c.restype = None + +# (int id, double[5*n] pp, int emitter, double[4] polvect, double[n] sc) +evaluate_sc_c = ol.ol_evaluate_sc +evaluate_sc_c.argtypes = [ + c_int, c_double_ptr, c_int, c_double_ptr, c_double_ptr] +evaluate_sc_c.restype = None + +# (int id, double[5*n] pp, double[1] tree, double[3] loop, double[3] ir1, +# double[5] loop2, double[5] ir2, double[1] acc) +evaluate_full_c = ol.ol_evaluate_full +evaluate_full_c.argtypes = [ + c_int, c_double_ptr, c_double_ptr, c_double_ptr, + c_double_ptr, c_double_ptr, c_double_ptr, c_double_ptr] +evaluate_full_c.restype = None + +# (int id, double[5*n] pp, double[1] tree, double[3] loop, double[1] acc) +evaluate_loop_c = ol.ol_evaluate_loop +evaluate_loop_c.argtypes = [c_int, c_double_ptr, c_double_ptr, + c_double_ptr, c_double_ptr] +evaluate_loop_c.restype = None + +# (int id, double[5*n] pp, double[1] loop2, double[1] acc) +evaluate_loop2_c = ol.ol_evaluate_loop2 +evaluate_loop2_c.argtypes = [ + c_int, c_double_ptr, c_double_ptr, c_double_ptr] +evaluate_loop2_c.restype = None + +# (int id, double[5*n] pp, double[1] tree, double[1] ct) +evaluate_ct_c = ol.ol_evaluate_ct +evaluate_ct_c.argtypes = [ + c_int, c_double_ptr, c_double_ptr, c_double_ptr] +evaluate_ct_c.restype = None + +# (int id, double[5*n] pp, double[1] tree, double[1] pt, double[1] loop) +evaluate_pt = ol.ol_evaluate_pt +evaluate_pt.argtypes = [c_int, c_double_ptr, c_double_ptr, + c_double_ptr, c_double_ptr] +evaluate_pt.restype = None + +# ol_tree_colbasis_dim(int id, int[1] ncolb, int[1] colelemsz, int[1] nhel) +# ol_tree_colbasis(int id, int* basis, int* needed) +# basis(tree_colbasis_elemsize(id),get_tree_colbasis_dim(id)) +# needed(get_tree_colbasis_dim(id),get_tree_colbasis_dim(id)) +# ol_evaluate_tree_colvect(int id, double[5*n] pp, double* amp, int[1] nhel) +# amp(2*get_tree_colbasis_dim(id),get_nhel(id)) +# ol_evaluate_ccmatrix(int id, double[5*n] pp, double[1] tree, double[n][n] ccij, double[1] ewcc) +# ol_evaluate_scpowheg(int id, double[5*n] pp, int emitter, double[1] res, double[n][n] resmunu) + +atexit.register(finish) + + +def set_parameter(key, val): + if isinstance(val, int): + setparameter_int(key, val) + elif isinstance(val, float): + setparameter_double(key, val) + elif isinstance(val, str): + setparameter_string(key, val) else: - raise ValueError("Invalid subprocess argument: " + repr(arg)) - if process is not None: - sp_list = [sp.validate(process) for sp in sp_list] - return sp_list - - - -class Parameters: - """ - Parameters class to store, and commit parameters via pyol_setparameter(). - - No default values are provided, parameters must be reset explicitly if needed - when they were initialised before, e.g. by a different Parameters instance. - """ - def __init__(self, commit = True, **parameters): - self.parameters = {key: str(val) for key, val in parameters.items()} - if commit: - err = c_int() - for key, val in self.parameters.items(): - pyol_setparameter(c_char_p(key), c_char_p(val), byref(err)) - if err.value != 0: - raise OpenLoopsError("Unknown parameter " + repr(key)) - pyol_parameters_flush() - - set = __init__ - - @staticmethod - def write(): - """Call the Fortran parameters_write() subroutines.""" - pyol_parameters_write() - - def __repr__(self): - return "Parameters(" + ", ".join([" = ".join(pair) for pair in self.parameters.items()]) + ")" - - def __str__(self): - return "\n".join([" = ".join(pair) for pair in self._parameters.items()]) - - - -class PhaseSpacePoint: - """ - A phase space point consisting of masses, energy, and momenta. - - Arguments: - masses -- list of masses or the number of massless particles - energy -- center of mass energy; has default default_energy - momenta -- phase space point as c_double array; - if momenta is present, masses and energy must not be present - """ - @staticmethod - def mass_from_momentum(momentum): - mass = momentum[0]**2 - momentum[1]**2 - momentum[2]**2 - momentum[3]**2 - if abs(mass) < phasespace_accuracy_warn: - mass = 0. - # Commented so that inconsistencies are handled within Fortran - #elif mass < 0: - #raise OpenLoopsError("mass < 0 in phase space piont") - return math.sqrt(mass) - - def __init__(self, masses=None, energy=None, momenta=None): - if momenta is None: - # Generate a phase space point with RAMBO - if energy is None: - energy = default_energy - if masses is None: - raise OpenLoopsError("masses needed") - elif isinstance(masses, int) and masses >= 4: - masses = masses * [0.] - self.masses = list(masses) # copy - self.energy = energy - - n_particles = len(masses) - c_masses_type = n_particles * c_double - c_psp_type = n_particles * (4*c_double) - p_rambo = c_psp_type() - - pyol_rambo(byref(c_double(energy)), - byref(c_masses_type(*masses)), - byref(c_int(n_particles)), - byref(p_rambo)) - - self.momenta = p_rambo - - else: - # A phase space point is given - if isinstance(momenta, PhaseSpacePoint): - self.masses = momenta.masses - self.energy = momenta.energy - self.momenta = momenta.momenta + raise TypeError('set_parameter() value argument must be int, ' + + 'float or str, not \'{}\''.format(type(val))) + +def get_parameter_int(key): + val_c = c_int() + getparameter_int_c(key, byref(val_c)) + return val_c.value + +def get_parameter_double(key): + val_c = c_double() + getparameter_double_c(key, byref(val_c)) + return val_c.value + + +class PhaseSpacePoint(object): + """A phase space point, stored as a 5*n c_double array. + Can be passed to C function handles directly. + The 5th momentum component can store the mass, but is neither used by + OpenLoops nor calculated from the momentum by this class.""" + def __init__(self, pp, n=None): + """PhaseSpacePoint constructor. Valid input formats for n particles: + * 5*n c_double array; + * 5*n list; + * 4*n list if n is given; + * 2-dimenional list of 4 (or 5) component momenta. + Note: does not generate random points.""" + if isinstance(pp, (list, tuple)): + if isinstance(pp[0], (list, tuple)) or n: + if not isinstance(pp[0], (list, tuple)): + # 1-dimensional -> 2-dimensional using n + if len(pp) % n: + raise OpenLoopsError('Invalid phase space point.') + k = len(pp)/n + pp = [(pp[m:m+k]) for m in range(0,len(pp),k)] + ppls = [] + if n and len(pp) != n: + raise OpenLoopsError( + 'Invalid phase space point: wrong number of momenta') + for p in pp: + ppls.extend(p) + if len(p) == 4: + ppls.append(-1) + elif len(p) != 5: + raise OpenLoopsError( + 'Invalid phase space point: momentum must have 4' + + ' or 5 components.') else: - self.masses = map(PhaseSpacePoint.mass_from_momentum, momenta) - self.energy = sum([mom[0] for mom in momenta])/2 - if isinstance(momenta, (list, tuple)): - # convert to a c_double array - self.momenta = (len(momenta) * (4*c_double))(*map(tuple, momenta)) - else: - # should already be a c_double array - self.momenta = momenta - consistency = 1000 - if masses is not None: - consistency = min([common_digits(m1,m2) for m1, m2 in zip(*[self.masses, masses])]) - if energy is not None: - consistency = min(consistency, common_digits(self.energy, energy)) - if consistency < phasespace_accuracy_warn: - if consistency < phasespace_accuracy_fatal: - raise OpenLoopsError("inconsistent with given masses/energy, agreement: " - + str(consistency) + " digits") - else: - print ("WARNING: phase space point is compatible with given masses/energy only to " - + str(consistency) + " digits.") - - def __repr__(self): - return "PhaseSpacePoint(masses = {}, energy = {}, momenta =\n{})".format( - self.masses, self.energy, map(list, self.momenta)) - + # 1-dimensional and n not known: assume 5*n notation + ppls = pp + pp = (len(ppls)*c_double)(*ppls) + # else: assume that a valid c_double array was passed + self.pp = pp + self._as_parameter_ = ctypes.cast(pp,c_double_ptr) def __str__(self): - return str(map(list, self.momenta)) - - - -class Process: - """ - Process class. - Provides access to matrix element routines. - self.permute[subprocess]([permutation]) = active permutation - self.external[subprocess]() = number_of_particles, masses - self.tree[subprocess](ps_point) = M2tree - self.loop[subprocess](ps_point) = M2tree, M2loop0, M2loop1, M2loop2, IR0, IR1, IR2 - self.ct[subprocess](ps_point) = M2tree, M2ct - self.pseudotree[subprocess](ps_point) = M2tree, M2pt, M2loop - """ - _proclib_path = "proclib" - _m2l0 = c_double() - _m2ct = c_double() - _m2pt = c_double() - _m2l1 = (3*c_double)() - _irl1 = (3*c_double)() - _m2l2 = (5*c_double)() - _irl2 = (5*c_double)() - - @staticmethod - def _get_library_name(name, loops="auto"): - """ - Check for existing libraries for a process and return a dictionary with their names. - - Arguments: - name -- the process name - loop -- the loops specification (defaults to "auto") - If loops="auto", the call only succeeds if the library is unique. - The result conatins the keys "loops", "process_module" (file name), and "info_file" (file name). - """ - process_library = "libopenloops_" + name + "_%s" + shared_lib_ext - info_file = "libopenloops_" + name + "_%s.info" - - if loops == "auto": - available_loops = [lps for lps in OLBaseConfig.loops_specifications - if lps != "auto" and os.path.isfile(os.path.join(Process._proclib_path, - process_library % (lps,)))] - if len(available_loops) == 0: - raise OpenLoopsError("process library not found " + repr(name)) - elif len(available_loops) > 1: - raise OpenLoopsError("process library not unique " + repr(available_loops)) - loops = available_loops[0] - else: - if loops not in OLBaseConfig.loops_specifications: - raise OpenLoopsError("unknown loops specification " + repr(loops)) - if not os.path.isfile(os.path.join(Process._proclib_path, process_library % (loops,))): - raise OpenLoopsError("process library not found: " + repr(name) + "_" + repr(loops)) - if not os.path.isfile(os.path.join(Process._proclib_path, info_file % (loops,))): - raise OpenLoopsError("info file not found: " + repr(name) + "_" + repr(loops)) - return {"loops": loops, - "process_library": process_library % (loops,), - "info_file": info_file % (loops,)} - - @staticmethod - def _parse_infoline(infoline): - """Convert a string "KEY1=VAL1 KEY2=VAL2 ..." to a dictionary {KEY1: VAL1, KEY2: VAL2, ...}.""" - il = infoline.split() - return [il[1], {il[2]: dict([[opt[0], opt[1]] for opt in [opt.split("=") for opt in il[3:]]])}] - #return (il[1] + "_" + il[2], dict([[opt[0], eval(opt[1])] for opt in [opt.split("=") for opt in il[3:]]])) - - @staticmethod - def _get_info(name=None, loops="auto", info_file=None): - """ - Read an info file and return a dictionary with the available sub-processes. - - Arguments: - name -- the process name - loops -- the loops specification (defaults to "auto") - info_file -- name of the info file - Either name or info_file must be given. - This is a static method so that it can be called without creating a Process instance. - """ - if info_file is None: - info_file = Process._get_library_name(name, loops)["info_file"] - if info_file == os.path.basename(info_file): - info_file = os.path.join(Process._proclib_path, info_file) - # Fill a dictionary with - # {SubProcessA_1: {VarA11: ValA11, ...}, SubProcessA_2: {...}, SubProcessB_1: ..., ...} - available_subprocesses = {} - with open(info_file) as fh: - for infoline in fh.readlines(): - if " map=" in infoline or " condmap=" in infoline or infoline.startswith("options "): - continue - subprocinfo = Process._parse_infoline(infoline) - subprocnum = subprocinfo[1].keys()[0] # there is only one element here - available_subprocesses[subprocinfo[0] + '_' + str(subprocnum)] = subprocinfo[1][subprocnum] - return dict(available_subprocesses) - # Fill a dictionary with - # {SubProcessA_1: {VarA11: ValA11, ...}, SubProcessA_2: {...}, SubProcessB_1: {...}, ...} - #available_subprocesses = {} - #with open(info_file) as fh: - #for infoline in fh.readlines(): - #subprocinfo = Process._parse_infoline(infoline) - #available_subprocesses[subprocinfo[0]] = subprocinfo[1] - #return available_subprocesses - - - def __init__(self, name, loops="auto"): - library_name = Process._get_library_name(name, loops) - loops = library_name["loops"] - process_library = library_name["process_library"] - - self.name = name # process name - self.loops = loops # loops specification - self.info = Process._get_info(name, loops) - self.subprocesses = sorted(self.info.keys()) - self.external = {} # dictionary of functions - self.nexternal = {} # number of external particles - self.permute = {} # dictionary of functions - self.rambo = {} # dictionary of functions - self.tree = {} # dictionary of functions - self.loop = {} # dictionary of functions - self.ct = {} # dictionary of functions - self.pseudotree = {} # dictionary of functions - self.matrix_element = {} # dictionary pointing to the MatrixElement constructor - - self._library = CDLL(process_library) - self._fortran_external = {} - self._fortran_permutation = {} - self._active_permutation = {} - self._fortran_tree = {} - self._fortran_loop = {} - self._fortran_ct = {} - self._fortran_pseudotree = {} - - self.contains_tree = {} - self.contains_loop = {} - self.contains_pseudotree = {} - self.contains_loopsquared = {} - - if "s" in loops: - self.loop_type = "loopsquared" - elif "l" in loops: - self.loop_type = "loop" - else: - self.loop_type = "tree" - - for subprocess in self.subprocesses: - process_name = (self.name + "_" + subprocess).lower() - - force_loops = self.info[subprocess].get('Type', None) - if not force_loops: - force_loops = loops - self.contains_tree[subprocess] = "t" in force_loops - self.contains_loop[subprocess] = "l" in force_loops - self.contains_pseudotree[subprocess] = "p" in force_loops - self.contains_loopsquared[subprocess] = "s" in force_loops - - n_ext = c_int() - getattr(self._library, pyol_n_particles % (process_name,))(byref(n_ext)) - self.nexternal[subprocess] = n_ext.value - self._active_permutation[subprocess] = range(1, self.nexternal[subprocess] + 1) - - self._fortran_external[subprocess] = getattr(self._library, pyol_get_external_masses % (process_name,)) - - def external_tmp(subprocess=subprocess): - """Get the masses of the external particles in the active permutation.""" - c_masses = (self.nexternal[subprocess]*c_double)() - self._fortran_external[subprocess](byref(c_masses)) - return list(c_masses) - - self.external[subprocess] = external_tmp - del external_tmp - - self._fortran_permutation[subprocess] = getattr(self._library, pyol_set_permutation % (process_name,)) - - def permutation_tmp(permutation=None, subprocess=subprocess): - """ - Set the permutation for the sub-process if it changed and return it. - If no argument is given, the active permutation is returned. - """ - if permutation is not None and permutation != self._active_permutation[subprocess]: - c_perm_type = self.nexternal[subprocess] * c_int - self._fortran_permutation[subprocess](byref(c_perm_type(*permutation))) - self._active_permutation[subprocess] = list(permutation) - return self._active_permutation[subprocess] - - self.permute[subprocess] = permutation_tmp - del permutation_tmp - - def rambo_tmp(energy_or_momenta=None, subprocess=subprocess): - """ - Call the PhaseSpacePoint constructor for the sub-process. - - If no argument is given, None will be used (resulting in default_energy). - If the argument is a phase space point (as a list/array, or as a PhaseSpacePoint instance), - return it as PhaseSpacePoint instance. - """ - if energy_or_momenta is None or isinstance(energy_or_momenta, (int, float)): - return PhaseSpacePoint(self.external[subprocess](), energy_or_momenta) - else: - return PhaseSpacePoint(momenta=energy_or_momenta) - - self.rambo[subprocess] = rambo_tmp - del rambo_tmp - - if self.contains_tree[subprocess]: - self._fortran_tree[subprocess] = getattr(self._library, pyol_amp2tree % (process_name,)) - def tree_tmp(ps_pt=None, permutation=None, subprocess=subprocess): - """ - Calculate a tree matrix element. Return M2tree. - - Arguments: - ps_pt -- either a phase space point (list/array/PhaseSpacePoint), - or the energy, or None (defaults to None, resulting in default_energy) - permutation -- the permutation of the external particles (optional) - """ - self.permute[subprocess](permutation) - ps_pt = self.rambo[subprocess](ps_pt) - - self._fortran_tree[subprocess](byref(ps_pt.momenta), byref(self._m2l0)) - # return a tuple with one element - return (self._m2l0.value,) - - self.tree[subprocess] = tree_tmp - del tree_tmp - - if self.contains_loop[subprocess]: - self._fortran_loop[subprocess] = getattr(self._library, pyol_vamp2 % (process_name,)) - def loop_tmp(ps_pt=None, permutation=None, subprocess=subprocess): - """ - Calculate a loop matrix element. Return (M2L0, M2L1(0:2), IRL1(0:2), M2L2(0:4), IRL2(0:4)). - - M2L1(0)..M2L1(2) are the finite, 1/ep and 1/ep^2 parts of the loop matrix element. - IRL1(0)..IRL1(2) are the finite, 1/ep and 1/ep^2 parts of the i-operator. - M2L2(0)..M2L2(4) and IRL2_0..IRL2_4 are the loop^2 matrix element and IR contribution - as a Laurant series. - - Arguments: - ps_pt -- either a phase space point (list/array/PhaseSpacePoint), - or the energy, or None (defaults to None, resulting in default_energy) - permutation -- the permutation of the external particles (optional) - """ - self.permute[subprocess](permutation) - ps_pt = self.rambo[subprocess](ps_pt) - - self._fortran_loop[subprocess](byref(ps_pt.momenta), byref(self._m2l0), - byref(self._m2l1), byref(self._irl1), - byref(self._m2l2), byref(self._irl2)) - - return (self._m2l0.value, list(self._m2l1), list(self._irl1), - list(self._m2l2), list(self._irl2)) - - self.loop[subprocess] = loop_tmp - del loop_tmp - - self._fortran_ct[subprocess] = getattr(self._library, pyol_ctamp2 % (process_name,)) - def ct_tmp(ps_pt=None, permutation=None, subprocess=subprocess): - """ - Calculate a counter-term matrix element. Return (M2tree, M2ct). - - Arguments: - ps_pt -- either a phase space point (list/array/PhaseSpacePoint), - or the energy, or None (defaults to None, resulting in default_energy) - permutation -- the permutation of the external particles (optional) - """ - self.permute[subprocess](permutation) - ps_pt = self.rambo[subprocess](ps_pt) - - self._fortran_ct[subprocess](byref(ps_pt.momenta), byref(self._m2l0), byref(self._m2ct)) - - return (self._m2l0.value, self._m2ct.value) - - self.ct[subprocess] = ct_tmp - del ct_tmp - - if self.contains_pseudotree[subprocess]: - self._fortran_pseudotree[subprocess] = getattr(self._library, pyol_ptamp2 % (process_name,)) - def pseudotree_tmp(ps_pt=None, permutation=None, subprocess=subprocess): - """ - Calculate a pseudo-tree matrix element. Return (M2tree, M2pt, M2loop). - - Arguments: - ps_pt -- either a phase space point (list/array/PhaseSpacePoint), - or the energy, or None (defaults to None, resulting in default_energy) - permutation -- the permutation of the external particles (optional) - """ - self.permute[subprocess](permutation) - ps_pt = self.rambo[subprocess](ps_pt) - - self._fortran_pseudotree[subprocess](byref(ps_pt.momenta), byref(self._m2l0), - byref(self._m2pt), byref(self._m2ct)) # loop --> ct - - return (self._m2l0.value, self._m2pt.value, self._m2ct.value) - - self.pseudotree[subprocess] = pseudotree_tmp - del pseudotree_tmp - - def matrix_element_tmp(ps_point=None, permutation=None, subprocess=subprocess): - """ - Call the MatrixElement constructor. - """ - return MatrixElement(self, SubprocessID(subprocess, permutation), ps_point) - self.matrix_element[subprocess] = matrix_element_tmp - del matrix_element_tmp - - def __repr__(self): - return "Process(name={}, loops={})".format(self.name, self.loops) - - def __str__(self): - return "process name: {}\nloops: {}\nsub-processes: {}\n".format( - self.name, self.loops, ", ".join(self.subprocesses)) + return str(tuple(self.pp)) +LoopME = collections.namedtuple('loop', ['finite', 'ir1', 'ir2']) +IOperator = collections.namedtuple('ioperator', ['finite', 'ir1', 'ir2']) +Loop2ME = collections.namedtuple('loop2', + ['finite', 'ir1', 'ir2', 'ir3', 'ir4']) -class SubprocessID: - - def __init__(self, subprocess, permutation=None): - if not isinstance(subprocess, str): - raise ValueError("Invalid sub-process identifier: " + repr(subprocess)) - subprocess = subprocess.split("[", 1) - permutation_from_subprocess = None - if len(subprocess) == 2: - permutation_from_subprocess = valid_permutation("[" + subprocess[1]) - subprocess = subprocess[0] - - if not subprocess.split("_")[-1].isdigit(): - subprocess = subprocess + "_1" - if permutation is None: - permutation = permutation_from_subprocess - else: - valid_permutation(permutation) - if permutation_from_subprocess is not None: - raise ValueError("Permutation cannot be given twice for a sub-process.") - - self.name = subprocess - self.permutation = permutation - - def validate(self, process, default_permutation=None): - # Check if self.name is in process.subprocesses - # and if set(self.permutation) == set(range(1, n_particles+1)). - # If self.permutation == None, replace it by default_permutation, - # if present, otherwise range(1, n_particles+1). - if not isinstance(process, Process): - raise ValueError("process must be a process instance.") - if not self.name in process.subprocesses: - raise OpenLoopsError("Process " + repr(process.name) - + " does not contain a sub-processes " + repr(self.name)) - if self.permutation is None: - if default_permutation is None: - self.permutation = range(1, process.nexternal[self.name] + 1) - else: - self.permutation = valid_permutation(default_permutation) - else: - if set(self.permutation) != set(range(1, process.nexternal[self.name] + 1)): - raise ValueError("Invalid permutation: " + str(self.permutation) + " for sub-process " + self.name) - return self +class MatrixElement(object): + def __init__(self, amptype, psp, **kwargs): + self.amptype = amptype + self.psp = psp + for key, val in kwargs.items(): + setattr(self, key, val) def __str__(self): - if self.permutation is None: - perm = "" + if self.amptype == TREE: + return 'tree={}'.format(self.tree) + elif self.amptype == LOOP: + return 'tree={} {} acc={}'.format(self.tree, self.loop, self.acc) + elif self.amptype == LOOP2: + return 'loop2={} acc={}'.format(self.loop2.finite, self.acc) else: - perm = str(self.permutation).replace(" ", "") - return self.name + perm - - def __repr__(self): - return "SubprocessID(" + repr(self.name) + ", " + str(self.permutation).replace(" ", "") + ")" - - - -class MatrixElement: - """ - Store a phase space point and the matrix elements at this point for a partonic process. - - Members: - ps_point -- a PhaseSpacePoint instance - value -- the matrix elements as returned by Fortran - (float for tree process, 7-tuple for loop) - - Does NOT contain any further information like the process, parameters, permutation, ... - """ - def __init__(self, process=None, subprocess=None, ps_point=None, - tree=True, loop=True, value=None, verbose=0): - """ - Calculate matrix a element. - - Arguments: - process -- a Process instance - subprocess -- a (permuted) sub-process as SubprocessID() or as a string; - if omitted or None and there is only one sub-process, use this one - ps_point -- if omitted or None, use default_energy, - the energy if it is a number, - or a phase space point, either as an array, or as a PhaseSpacePoint instance - tree -- calculate the tree matrix element, if a tree routine is available - loop -- calculate the loop matrix element, if a loop routine is available - value -- set the matrix element to value instead of calculating it; - only makes sense if ps_point is actually a phase space point. - """ - if process is not None: - if subprocess is None: - if len(process.subprocesses) == 1: - subprocess = list(process.subprocesses)[0] - else: - raise OpenLoopsError("sub-process not unique") - if not isinstance(subprocess, SubprocessID): - subprocess = SubprocessID(subprocess) - subprocess.validate(process) - permutation = subprocess.permutation - subprocess_name = subprocess.name - - looptree = tree and not loop and not process.contains_tree[subprocess_name] - tree = tree and process.contains_tree[subprocess_name] - loop = loop and process.contains_loop[subprocess_name] - - process.permute[subprocess_name](permutation) - self.ps_point = process.rambo[subprocess_name](ps_point) - if loop: - self.value = process.loop[subprocess_name](self.ps_point) - if tree: - tree = process.tree[subprocess_name](self.ps_point) - consistency = common_digits(self.value[0], tree[0]) - if consistency < tree_accuracy_warn: - if consistency < tree_accuracy_fatal: - raise OpenLoopsError("inconsistent tree matrix element from tree and loop routines, agreement: " + repr(consistency) + " digits.") - else: - print ("WARNING: tree matrix element from tree and loop routines only consistent to" - + str(consistency) + " digits.") - if process.contains_loopsquared[subprocess_name]: - # flatten tuple - self.value = (self.value[0],) + tuple(self.value[1]) + tuple(self.value[2]) + tuple(self.value[3]) + tuple(self.value[4]) - else: - # flatten tuple and discard loop^2 information - self.value = (self.value[0],) + tuple(self.value[1]) + tuple(self.value[2]) - elif tree: - self.value = process.tree[subprocess_name](self.ps_point) - elif looptree: - self.value = (process.loop[subprocess_name](self.ps_point)[0],) - else: - raise OpenLoopsError("tree/loop request is not satisfiable.") - elif process is None and value is not None: - self.ps_point = ps_point - self.value = value + return ('MatrixElement.__str__ not implemented for amptype {}' + ).format(self.amptype) + def valuestr(self): + if self.amptype == TREE: + return numberformat.format(self.tree) + elif self.amptype == LOOP: + return (5*numberformat).format(self.tree, self.loop.finite, + self.loop.ir1, self.loop.ir2, + self.acc) + elif self.amptype == LOOP2: + return (2*numberformat).format(self.loop2.finite, self.acc) else: - OpenLoopsError("Process or value needed to initialise matrix element.") - if verbose > 1: - print self.ps_point - if verbose > 0: - print float_list_string(self.value) - - #if process is not None and value is not None: - #value_is_loop = isinstance() - - def compare(self, other): - if len(self.value) == len(other.value): - agreement = [common_digits(*vals) for vals in zip(self.value, other.value)] - else: - raise OpenLoopsError("Cannot compare matrix elements of different types.") - return min(agreement) - - def __repr__(self): - return "MatrixElement(ps_point=\n{!r},\nvalue={})".format(self.ps_point, self.value) - - def __str__(self): - return str(self.value) - - - -class ProcessTestData: - """ - Proecss test data: store a sample matrix elements for a process - and the environment that was used to generate them. - - Members: - version -- version information as a tuple of two integers. - process_name -- the process name. - loop_type -- "tree", "loop", or "loopsquared". - parameters -- the Parameters instance used to calculate the matrix elements. - subprocess -- a list SubprocessID instances. - all_subprocesses -- True if all sub-processes of the process are contained. - matrix_elements -- a list of MatrixElement instances - Temporary members: - check_successful: set by validate(), deleted by dump()/dumps(). - """ - def __init__(self, process, subprocess=None, phasespace=None, n=None, - parameters=None, verbose=0): - """ - Create sample data for a process. - - subprocess -- a list of (permuted) sub-processes as a string, - or a list of strings (possibly as a string) - or SubprocessID instances. - phasespace -- a list of phase space points (as accepted by PhaseSpacePoint), - or a list of energies, or the energy. - n -- number of matrix elements per sub-process. - parameters -- the Parameters instance to be used. - verbose -- 0: print nothing, 1: print matrix elements, 2: also pront phase space points. + return ('MatrixElement.valuestr not implemented for amptype {}' + ).format(self.amptype) + + +class Process(object): + + _tree_buf = c_double() + _ewcc_buf = c_double() + _ct_buf = c_double() + _pt_buf = c_double() + _ptloop_buf = c_double() + _loop_buf = (3*c_double)() + _ir1_buf = (3*c_double)() + _loop2_buf = (5*c_double)() + _ir2_buf = (5*c_double)() + _acc_buf = c_double() + + def __init__(self, process, amptype=default_amptype, qcd=-1, ew=-1): + """Register a process with given amptype (default=LOOP). + Use 'qcd' rsp. 'ew' to request a process in a certain order + in alpha_s rsp. alpha. + + public members: + * process -- the process name as registered + * id (int) -- process id + * amptype (int) -- amptype + * contains -- LibraryContent() instance + * n -- number of external particles + Process instances can be passed to C functions as id. """ - self.version = version - self.matrix_elements = {} - - if isinstance(process, str): - process = Process(process) - - if n is None: - n = default_sample_size - - if process is None: - pass + typearg = amptype + needs_tree = False + needs_pt = False + if isinstance(amptype, str): + try: + amptype = AMPTYPES[amptype.lower()] + except KeyError: + pass + if isinstance(amptype, str): + if not set(typearg) - set(loopspec_flags): + if 's' in typearg and 'l' in typearg: + amptype = LOOP2 + elif 'l' in amptype: + amptype = LOOP + elif 't' in amptype: + amptype = TREE + if 't' in typearg: + needs_tree = True + if 'p' in typearg: + needs_pt = True + if not amptype in AMPTYPES.values(): + raise RegisterProcessError( + 'Process(): illegal amptype \'{}\''.format(typearg)) + if qcd >= 0: + set_parameter('order_qcd', qcd) + if ew >= 0: + set_parameter('order_ew', ew) + self.id = register_process(process, amptype) + if self.id <= 0: + raise RegisterProcessError( + 'Failed to load process \'{}\' with amptype {}'.format( + process, typearg)) + self.contains = library_content(self.id) + if needs_tree and not self.contains.tree: + raise RegisterProcessError(( + 'Dedicated tree matrix elements are not available ' + + 'in process {}.').format(process)) + if needs_pt and not self.contains.pt: + raise RegisterProcessError(( + 'Pseudo-tree matrix elements are not available ' + + 'in process {}.').format(process)) + self.process = process + self.amptype = amptype + self.n = n_external(self.id) + self._as_parameter_ = self.id + self._pp_buf = ((5*self.n) * c_double)() + if amptype == CC: + self._cc_buf = (((self.n*(self.n-1))/2) * c_double)() + if amptype == SC: + self._sc_buf = ((2*self.n**2) * c_double)() + if amptype == SCPV: + self._sc_polvect_buf = ((self.n) * c_double)() + + def psp(self, sqrt_s=default_energy): + """Generate a random phase space point for the process.""" + phase_space_point_c(self.id, sqrt_s, self._pp_buf) + return PhaseSpacePoint(self._pp_buf, self.n) + + def evaluate(self, pp_or_sqrt_s=default_energy, amptype=None): + """Calculate matrix elements either for a given phase space point + or for a random phase space point of given or default energy. + + 'amptype' overrides the amptype of the process -- if you use this, + it's up to you to figure out if what you do makes sense.""" + if not amptype: + amptype = self.amptype + if not start.started: + start() + start.started = True + if isinstance(pp_or_sqrt_s, (int, float)): + psp = self.psp(pp_or_sqrt_s) + elif isinstance(pp_or_sqrt_s, PhaseSpacePoint): + psp = pp_or_sqrt_s else: - self.process_name = process.name - self.loop_type = process.loop_type - if parameters is None: - self.parameters = Parameters() - else: - self.parameters = parameters - self.all_subprocesses = subprocess is None - - self.parameters.set() - - if self.all_subprocesses: - subprocess = process.subprocesses - - self.subprocesses = parse_subprocess_argument(subprocess, process) - - if phasespace is None or isinstance(phasespace, (int, float)): - phasespace = n * [phasespace] - - for subprocess in self.subprocesses: - if verbose > 0: - print "sub-process:", str(subprocess) - self.matrix_elements[subprocess.name] = [ - MatrixElement(process, subprocess, ps_point, verbose=verbose) - for ps_point in phasespace] - if verbose > 0: - print - - def dump(self, filename=None): - """Write a pickled representation to the file 'filename' (default 'processname.pkl')""" - try: - del self.check_successful - except AttributeError: - pass - if filename is None: - filename = self.process_name + ".pkl" - try: - os.remove(filename) - except OSError: - pass - dump_dir = os.path.dirname(filename) - if not os.path.exists(dump_dir): - os.mkdir(dump_dir) - with open(filename, "w") as fh: - pickle.dump(self, fh) - - def dumps(self): - """Return a pickled representation as a string.""" - try: - del self.check_successful - except AttributeError: - pass - return pickle.dumps(self) - - @staticmethod - def load(filename): - """Load pickled ProcessTestData from a file.""" - with open(filename, "r") as fh: - ptd = pickle.load(fh) - return ptd - - def validate(self, new_process_name=None, verbose=0): - """ - Validate ProcessTestData. - - Calculates matrix elements with the settings stored in 'self' - and compares the results to those in 'self'. - - new_process_name: set if the name of the process changed. - verbose: see __init__. - """ - - agrees = True - - if new_process_name is None: - new_process_name = self.process_name - - process = Process(new_process_name) - new_ptd = ProcessTestData(process=None) - - new_ptd.process_name = new_process_name - new_ptd.loop_type = process.loop_type - new_ptd.parameters = self.parameters - new_ptd.all_subprocesses = self.all_subprocesses - - if new_ptd.loop_type != self.loop_type: - raise OpenLoopsError("ProcessTestData.validate(): loops regression in " + repr(new_ptd.process_name)) - - new_ptd.parameters.set() - - self_sp_names = set([sp.name for sp in self.subprocesses]) - - if self.all_subprocesses: - new_ptd.subprocesses = parse_subprocess_argument(process.subprocesses, process) - missing_sps = self_sp_names - set(process.subprocesses) - new_sps = set(process.subprocesses) - self_sp_names - if missing_sps: - print "WARNING: subprocesses were removed from", self.process_name + ":", missing_sps - if new_sps: - print "WARNING: subprocesses were added to", self.process_name + ":", new_sps + psp = PhaseSpacePoint(pp_or_sqrt_s, self.n) + + if amptype in (LOOP, LOOP2): + evaluate_full_c(self.id, psp, Process._tree_buf, + Process._loop_buf, Process._ir1_buf, + Process._loop2_buf, Process._ir2_buf, + Process._acc_buf) + me = MatrixElement( + amptype, psp, tree=Process._tree_buf.value, + loop=LoopME(*Process._loop_buf), + iop=IOperator(*Process._ir1_buf), + loop2=Loop2ME(*Process._loop2_buf), + acc=Process._acc_buf.value) + + elif amptype == TREE: + evaluate_tree_c(self.id, psp, Process._tree_buf) + me = MatrixElement(amptype, psp, tree=Process._tree_buf.value) else: - missing_sps = self_sp_names - set(process.subprocesses) - if missing_sps: - print "WARNING: subprocesses were removed from", self.process_name + ":", missing_sps - new_ptd.subprocesses = [sp for sp in self.subprocesses if sp.name not in missing_sps] - - for subprocess in new_ptd.subprocesses: - if verbose > 0: - print "sub-process:", str(subprocess) - subprocess_name = subprocess.name - new_ptd.matrix_elements[subprocess_name] = [] - me_count = 0 - for me in self.matrix_elements[subprocess_name]: - new_me = MatrixElement(process, subprocess, me.ps_point, verbose=verbose) - if me.compare(new_me) < matrix_element_agreement: - if verbose > 0: - print float_list_string(me.value), "(old)" - print "WARNING: {}_{}: Matrix element {} disagrees:\n{}\n{}".format( - new_ptd.process_name, subprocess, me_count+1, me, new_me) - agrees = False - new_ptd.matrix_elements[subprocess_name].append(new_me) - me_count = me_count + 1 - if verbose > 0: - print - - new_ptd.check_successful = agrees - - return new_ptd - - def show(self, verbose=1): - """ - Print ProcessTestData. - - verbose -- 0: only process, loop type, version - 1: also matrix elements - 2: also phase space points - 3: also used parameters + raise OpenLoopsError( + 'Process() amptype {} not implemented yet'.format(amptype)) + return me + + +class ProcessInfo(object): + """Process info file data.""" + + def __init__(self, libname): + """Create ProcessInfo from info file for process 'libname'.""" + self.libname = libname + self.channels = [] + self.mappings = {} + self.condmappings = {} + info_files = [fi for fi in os.listdir(proclib_dir) + if fi.endswith('.info')] + info_files = [fi for fi in info_files + if fi.rsplit('_',1)[0] == 'libopenloops_' + libname] + if not info_files: + raise ProcessInfoError( + 'Process library {} info file not found.'.format(libname)) + self.loops_spec = info_files[0].rsplit('_',1)[1][:-5] + with open(os.path.join(proclib_dir, info_files[0])) as fh: + info = fh.readlines() + for inf in info: + inf = inf.split() + if inf[2].startswith('map='): + # mapping[from] = to + self.mappings[inf[1]] = inf[2].split('=')[1] + elif inf[2].startswith('condmap='): + # condmappings[from] = (to, [(param, val), ...]) + self.condmappings[inf[1]] = ( + inf[2].split('=')[1], [cd.split('=') for cd in inf[3:]]) + else: + # channels: (channel, number, {param: val), ...}) + self.channels.append( + (inf[1], int(inf[2]), + dict([cond.split('=') for cond in inf[3:]]))) + # sort by (loops_spec, channel, number) + self.channels.sort(key=lambda ch: + (ch[2].get('Type', self.loops_spec), ch[0], ch[1])) + + def iterchannels(self, select=None): + """Return a generator which provides channel identifiers of the form + (__, loops_spec), taking into account + conditional mappings with currently initialised parameters. I.e. only + channels are return which are not mapped to another channel. """ - print "Process:", self.process_name, "loop_type", self.loop_type, "version", self.version - print - if verbose > 2: - print self.parameters - print - for subprocess in self.subprocesses: - if verbose > 0: - print "sub-process:", str(subprocess) - for me in self.matrix_elements[subprocess.name]: - if verbose > 1: - print me.ps_point - print float_list_string(me.value) - print - - #def __repr__(self): - - #def __str__(self): + # initialisation is needed to make get_parameter_double() + # return the correct values + parameters_flush() + for ch in self.channels: + cmap = self.condmappings.get(ch[0], None) + do_map = False + if cmap: + # NOTE: only works with conditions + # for double precision parameters. + do_map = all(get_parameter_double(param) == float(val) + for param, val in cmap[1]) + if not do_map: + yield ('{}_{}_{}'.format(self.libname, ch[0], ch[1]), + ch[2].get('Type', self.loops_spec)) + + def register(self, select=None): + """Register channels which are returned by iterchannels() + and return a list of Process() objects.""" + processes = [] + for ch in self.iterchannels(select): + processes.append(Process(*ch)) + return processes + + +if __name__ == '__main__': + set_parameter('splash',0) + set_parameter('stability_mode',11) + p = Process('1 -1 -> 22 21') + #me = p.evaluate() + #print 'psp', me.psp + #print 'tree', me.tree, me.loop + + #set_parameter('rmb',0) + #for ch in ProcessInfo('ppajj').iterchannels(): + #print ch diff --git a/pyol/tools/openloops_legacy.py b/pyol/tools/openloops_legacy.py new file mode 100644 index 00000000..1678e57c --- /dev/null +++ b/pyol/tools/openloops_legacy.py @@ -0,0 +1,914 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +# Copyright 2014 Fabio Cascioli, Jonas Lindert, Philipp Maierhoefer, Stefano Pozzorini +# +# This file is part of OpenLoops. +# +# OpenLoops 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 3 of the License, or +# (at your option) any later version. +# +# OpenLoops 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 OpenLoops. If not, see . + +# This module requires Python 2.7, but this must be tested before importing +# the module. + +import sys +import os +import shlex +import math +import atexit +import pickle +from ctypes import CDLL, byref, c_int, c_double, c_char_p + +import OLBaseConfig + +if sys.platform.startswith("darwin"): + shared_lib_ext = ".dylib" +else: + shared_lib_ext = ".so" + +pyol = CDLL("libopenloops" + shared_lib_ext) + +pyol_setparameter = pyol.ol_setparameter_string +pyol_rambo = pyol.ol_rambo +pyol_parameters_flush = pyol.ol_parameters_flush +pyol_parameters_write = pyol.ol_printparameter +pyol_finish = pyol.ol_finish + +pyol_n_particles = "ol_n_external_%s" +pyol_get_external_masses = "ol_get_masses_%s" +pyol_set_permutation = "ol_set_permutation_%s" +pyol_amp2tree = "ol_amp2tree_%s" +pyol_vamp2 = "ol_vamp2_%s" +pyol_ctamp2 = "ol_ctamp2_%s" +pyol_ptamp2 = "ol_ptamp2_%s" + + +if sys.version_info[:2] < (2,7): + print "This module requires Python 2.7." + sys.exit(1) + + + +# Openloops interface version. +# In future version this can be used to import ProcessTestData in a deprecated format. +version = (0,1) +test_data_folder = "test_data" +# center-of-mass energy if not specified otherwise +default_energy = 1000 +# number of phase space points in test data if not specified otherwise +default_sample_size = 10 +# various accuracy thresholds in digits +phasespace_accuracy_warn = 9 +phasespace_accuracy_fatal = 5 +tree_accuracy_warn = 9 +tree_accuracy_fatal = 5 +matrix_element_agreement = 5 +# precision of 'float' in digits +max_precision = sys.float_info.mant_dig * math.log(2,10) + + +atexit.register(pyol_finish) + + +class OpenLoopsError(Exception): + pass + + + +def float_list_string(ls): + return "[ " + ", ".join(["{:>23.15e}".format(val) for val in ls]) + " ]" + + + +def common_digits(x, y): + if x == y: + return max_precision + else: + return -math.log(2*abs(x-y)/(abs(x)+abs(y)), 10) + + + +def valid_permutation(arg, n=None): + if isinstance(arg, str): + try: + perm = eval(arg) + except SyntaxError: + raise ValueError("Invalid permutation: " + repr(arg)) + else: + perm = arg + if not (isinstance(perm, list) and + all([lambda nn: isinstance(nn, int) for nn in perm]) and + set(perm) == set(range(1, len(perm)+1))): + raise ValueError("Invalid permutation: " + repr(arg)) + if n is not None and max(perm) != n: + raise ValueError("Permutation " + repr(arg) + " does not have length " + repr(n)) + return perm + + + +def to_subprocess_id(sp): + if isinstance(sp, SubprocessID): + return sp + else: + return SubprocessID(sp) + + + +def parse_subprocess_argument(arg, process=None): + """ + Convert a string into a list of SubprocessID instances. + + Example: "sub[2,3,1],sub_2,..." --> [SubprocessID("sub[2,3,1]"), SubprocessID("sub_2"), ...] + """ + # quote permutation lists: sub[1,2,3] --> sub"[1,2,3]" + if isinstance(arg, str): + sl = arg.replace("[", "\"[").replace("]", "]\"") + sl = shlex.shlex(sl, posix=True) + sl.whitespace = "," + sl.whitespace_split = True + sl.wordchars += "[]" + sp_list = [SubprocessID(sp) for sp in sl] + elif isinstance(arg, (list, tuple, set)): + sp_list = [to_subprocess_id(sp) for sp in arg] + else: + raise ValueError("Invalid subprocess argument: " + repr(arg)) + if process is not None: + sp_list = [sp.validate(process) for sp in sp_list] + return sp_list + + + +class Parameters: + """ + Parameters class to store, and commit parameters via pyol_setparameter(). + + No default values are provided, parameters must be reset explicitly if needed + when they were initialised before, e.g. by a different Parameters instance. + """ + def __init__(self, commit = True, **parameters): + self.parameters = {key: str(val) for key, val in parameters.items()} + if commit: + for key, val in self.parameters.items(): + pyol_setparameter(c_char_p(key), c_char_p(val)) + pyol_parameters_flush() + + set = __init__ + + @staticmethod + def write(): + """Call the Fortran parameters_write() subroutines.""" + pyol_parameters_write() + + def __repr__(self): + return "Parameters(" + ", ".join([" = ".join(pair) for pair in self.parameters.items()]) + ")" + + def __str__(self): + return "\n".join([" = ".join(pair) for pair in self._parameters.items()]) + + + +class PhaseSpacePoint: + """ + A phase space point consisting of masses, energy, and momenta. + + Arguments: + masses -- list of masses or the number of massless particles + energy -- center of mass energy; has default default_energy + momenta -- phase space point as c_double array; + if momenta is present, masses and energy must not be present + """ + @staticmethod + def mass_from_momentum(momentum): + mass = momentum[0]**2 - momentum[1]**2 - momentum[2]**2 - momentum[3]**2 + if abs(mass) < phasespace_accuracy_warn: + mass = 0. + # Commented so that inconsistencies are handled within Fortran + #elif mass < 0: + #raise OpenLoopsError("mass < 0 in phase space piont") + return math.sqrt(mass) + + def __init__(self, masses=None, energy=None, momenta=None): + if momenta is None: + # Generate a phase space point with RAMBO + if energy is None: + energy = default_energy + if masses is None: + raise OpenLoopsError("masses needed") + elif isinstance(masses, int) and masses >= 4: + masses = masses * [0.] + self.masses = list(masses) # copy + self.energy = energy + + n_particles = len(masses) + c_masses_type = n_particles * c_double + c_psp_type = n_particles * (4*c_double) + p_rambo = c_psp_type() + + pyol_rambo(byref(c_double(energy)), + byref(c_masses_type(*masses)), + byref(c_int(n_particles)), + byref(p_rambo)) + + self.momenta = p_rambo + + else: + # A phase space point is given + if isinstance(momenta, PhaseSpacePoint): + self.masses = momenta.masses + self.energy = momenta.energy + self.momenta = momenta.momenta + else: + self.masses = map(PhaseSpacePoint.mass_from_momentum, momenta) + self.energy = sum([mom[0] for mom in momenta])/2 + if isinstance(momenta, (list, tuple)): + # convert to a c_double array + self.momenta = (len(momenta) * (4*c_double))(*map(tuple, momenta)) + else: + # should already be a c_double array + self.momenta = momenta + consistency = 1000 + if masses is not None: + consistency = min([common_digits(m1,m2) for m1, m2 in zip(*[self.masses, masses])]) + if energy is not None: + consistency = min(consistency, common_digits(self.energy, energy)) + if consistency < phasespace_accuracy_warn: + if consistency < phasespace_accuracy_fatal: + raise OpenLoopsError("inconsistent with given masses/energy, agreement: " + + str(consistency) + " digits") + else: + print ("WARNING: phase space point is compatible with given masses/energy only to " + + str(consistency) + " digits.") + + def __repr__(self): + return "PhaseSpacePoint(masses = {}, energy = {}, momenta =\n{})".format( + self.masses, self.energy, map(list, self.momenta)) + + def __str__(self): + return str(map(list, self.momenta)) + + + +class Process: + """ + Process class. + Provides access to matrix element routines. + self.permute[subprocess]([permutation]) = active permutation + self.external[subprocess]() = number_of_particles, masses + self.tree[subprocess](ps_point) = M2tree + self.loop[subprocess](ps_point) = M2tree, M2loop0, M2loop1, M2loop2, IR0, IR1, IR2 + self.ct[subprocess](ps_point) = M2tree, M2ct + self.pseudotree[subprocess](ps_point) = M2tree, M2pt, M2loop + """ + _proclib_path = "proclib" + _m2l0 = c_double() + _m2ct = c_double() + _m2pt = c_double() + _m2l1 = (3*c_double)() + _irl1 = (3*c_double)() + _m2l2 = (5*c_double)() + _irl2 = (5*c_double)() + + @staticmethod + def _get_library_name(name, loops="auto"): + """ + Check for existing libraries for a process and return a dictionary with their names. + + Arguments: + name -- the process name + loop -- the loops specification (defaults to "auto") + If loops="auto", the call only succeeds if the library is unique. + The result conatins the keys "loops", "process_module" (file name), and "info_file" (file name). + """ + process_library = "libopenloops_" + name + "_%s" + shared_lib_ext + info_file = "libopenloops_" + name + "_%s.info" + + if loops == "auto": + available_loops = [lps for lps in OLBaseConfig.loops_specifications + if lps != "auto" and os.path.isfile(os.path.join(Process._proclib_path, + process_library % (lps,)))] + if len(available_loops) == 0: + raise OpenLoopsError("process library not found " + repr(name)) + elif len(available_loops) > 1: + raise OpenLoopsError("process library not unique " + repr(available_loops)) + loops = available_loops[0] + else: + if loops not in OLBaseConfig.loops_specifications: + raise OpenLoopsError("unknown loops specification " + repr(loops)) + if not os.path.isfile(os.path.join(Process._proclib_path, process_library % (loops,))): + raise OpenLoopsError("process library not found: " + repr(name) + "_" + repr(loops)) + if not os.path.isfile(os.path.join(Process._proclib_path, info_file % (loops,))): + raise OpenLoopsError("info file not found: " + repr(name) + "_" + repr(loops)) + return {"loops": loops, + "process_library": process_library % (loops,), + "info_file": info_file % (loops,)} + + @staticmethod + def _parse_infoline(infoline): + """Convert a string "KEY1=VAL1 KEY2=VAL2 ..." to a dictionary {KEY1: VAL1, KEY2: VAL2, ...}.""" + il = infoline.split() + return [il[1], {il[2]: dict([[opt[0], opt[1]] for opt in [opt.split("=") for opt in il[3:]]])}] + #return (il[1] + "_" + il[2], dict([[opt[0], eval(opt[1])] for opt in [opt.split("=") for opt in il[3:]]])) + + @staticmethod + def _get_info(name=None, loops="auto", info_file=None): + """ + Read an info file and return a dictionary with the available sub-processes. + + Arguments: + name -- the process name + loops -- the loops specification (defaults to "auto") + info_file -- name of the info file + Either name or info_file must be given. + This is a static method so that it can be called without creating a Process instance. + """ + if info_file is None: + info_file = Process._get_library_name(name, loops)["info_file"] + if info_file == os.path.basename(info_file): + info_file = os.path.join(Process._proclib_path, info_file) + # Fill a dictionary with + # {SubProcessA_1: {VarA11: ValA11, ...}, SubProcessA_2: {...}, SubProcessB_1: ..., ...} + available_subprocesses = {} + with open(info_file) as fh: + for infoline in fh.readlines(): + if " map=" in infoline or " condmap=" in infoline or infoline.startswith("options "): + continue + subprocinfo = Process._parse_infoline(infoline) + subprocnum = subprocinfo[1].keys()[0] # there is only one element here + available_subprocesses[subprocinfo[0] + '_' + str(subprocnum)] = subprocinfo[1][subprocnum] + return dict(available_subprocesses) + # Fill a dictionary with + # {SubProcessA_1: {VarA11: ValA11, ...}, SubProcessA_2: {...}, SubProcessB_1: {...}, ...} + #available_subprocesses = {} + #with open(info_file) as fh: + #for infoline in fh.readlines(): + #subprocinfo = Process._parse_infoline(infoline) + #available_subprocesses[subprocinfo[0]] = subprocinfo[1] + #return available_subprocesses + + + def __init__(self, name, loops="auto"): + library_name = Process._get_library_name(name, loops) + loops = library_name["loops"] + process_library = library_name["process_library"] + + self.name = name # process name + self.loops = loops # loops specification + self.info = Process._get_info(name, loops) + self.subprocesses = sorted(self.info.keys()) + self.external = {} # dictionary of functions + self.nexternal = {} # number of external particles + self.permute = {} # dictionary of functions + self.rambo = {} # dictionary of functions + self.tree = {} # dictionary of functions + self.loop = {} # dictionary of functions + self.ct = {} # dictionary of functions + self.pseudotree = {} # dictionary of functions + self.matrix_element = {} # dictionary pointing to the MatrixElement constructor + + self._library = CDLL(process_library) + self._fortran_external = {} + self._fortran_permutation = {} + self._active_permutation = {} + self._fortran_tree = {} + self._fortran_loop = {} + self._fortran_ct = {} + self._fortran_pseudotree = {} + + self.contains_tree = {} + self.contains_loop = {} + self.contains_pseudotree = {} + self.contains_loopsquared = {} + + if "s" in loops: + self.loop_type = "loopsquared" + elif "l" in loops: + self.loop_type = "loop" + else: + self.loop_type = "tree" + + for subprocess in self.subprocesses: + process_name = (self.name + "_" + subprocess).lower() + + force_loops = self.info[subprocess].get('Type', None) + if not force_loops: + force_loops = loops + self.contains_tree[subprocess] = "t" in force_loops + self.contains_loop[subprocess] = "l" in force_loops + self.contains_pseudotree[subprocess] = "p" in force_loops + self.contains_loopsquared[subprocess] = "s" in force_loops + + n_ext = c_int() + getattr(self._library, pyol_n_particles % (process_name,))(byref(n_ext)) + self.nexternal[subprocess] = n_ext.value + self._active_permutation[subprocess] = range(1, self.nexternal[subprocess] + 1) + + self._fortran_external[subprocess] = getattr(self._library, pyol_get_external_masses % (process_name,)) + + def external_tmp(subprocess=subprocess): + """Get the masses of the external particles in the active permutation.""" + c_masses = (self.nexternal[subprocess]*c_double)() + self._fortran_external[subprocess](byref(c_masses)) + return list(c_masses) + + self.external[subprocess] = external_tmp + del external_tmp + + self._fortran_permutation[subprocess] = getattr(self._library, pyol_set_permutation % (process_name,)) + + def permutation_tmp(permutation=None, subprocess=subprocess): + """ + Set the permutation for the sub-process if it changed and return it. + If no argument is given, the active permutation is returned. + """ + if permutation is not None and permutation != self._active_permutation[subprocess]: + c_perm_type = self.nexternal[subprocess] * c_int + self._fortran_permutation[subprocess](byref(c_perm_type(*permutation))) + self._active_permutation[subprocess] = list(permutation) + return self._active_permutation[subprocess] + + self.permute[subprocess] = permutation_tmp + del permutation_tmp + + def rambo_tmp(energy_or_momenta=None, subprocess=subprocess): + """ + Call the PhaseSpacePoint constructor for the sub-process. + + If no argument is given, None will be used (resulting in default_energy). + If the argument is a phase space point (as a list/array, or as a PhaseSpacePoint instance), + return it as PhaseSpacePoint instance. + """ + if energy_or_momenta is None or isinstance(energy_or_momenta, (int, float)): + return PhaseSpacePoint(self.external[subprocess](), energy_or_momenta) + else: + return PhaseSpacePoint(momenta=energy_or_momenta) + + self.rambo[subprocess] = rambo_tmp + del rambo_tmp + + if self.contains_tree[subprocess]: + self._fortran_tree[subprocess] = getattr(self._library, pyol_amp2tree % (process_name,)) + def tree_tmp(ps_pt=None, permutation=None, subprocess=subprocess): + """ + Calculate a tree matrix element. Return M2tree. + + Arguments: + ps_pt -- either a phase space point (list/array/PhaseSpacePoint), + or the energy, or None (defaults to None, resulting in default_energy) + permutation -- the permutation of the external particles (optional) + """ + self.permute[subprocess](permutation) + ps_pt = self.rambo[subprocess](ps_pt) + + self._fortran_tree[subprocess](byref(ps_pt.momenta), byref(self._m2l0)) + # return a tuple with one element + return (self._m2l0.value,) + + self.tree[subprocess] = tree_tmp + del tree_tmp + + if self.contains_loop[subprocess]: + self._fortran_loop[subprocess] = getattr(self._library, pyol_vamp2 % (process_name,)) + def loop_tmp(ps_pt=None, permutation=None, subprocess=subprocess): + """ + Calculate a loop matrix element. Return (M2L0, M2L1(0:2), IRL1(0:2), M2L2(0:4), IRL2(0:4)). + + M2L1(0)..M2L1(2) are the finite, 1/ep and 1/ep^2 parts of the loop matrix element. + IRL1(0)..IRL1(2) are the finite, 1/ep and 1/ep^2 parts of the i-operator. + M2L2(0)..M2L2(4) and IRL2_0..IRL2_4 are the loop^2 matrix element and IR contribution + as a Laurant series. + + Arguments: + ps_pt -- either a phase space point (list/array/PhaseSpacePoint), + or the energy, or None (defaults to None, resulting in default_energy) + permutation -- the permutation of the external particles (optional) + """ + self.permute[subprocess](permutation) + ps_pt = self.rambo[subprocess](ps_pt) + + self._fortran_loop[subprocess](byref(ps_pt.momenta), byref(self._m2l0), + byref(self._m2l1), byref(self._irl1), + byref(self._m2l2), byref(self._irl2)) + + return (self._m2l0.value, list(self._m2l1), list(self._irl1), + list(self._m2l2), list(self._irl2)) + + self.loop[subprocess] = loop_tmp + del loop_tmp + + self._fortran_ct[subprocess] = getattr(self._library, pyol_ctamp2 % (process_name,)) + def ct_tmp(ps_pt=None, permutation=None, subprocess=subprocess): + """ + Calculate a counter-term matrix element. Return (M2tree, M2ct). + + Arguments: + ps_pt -- either a phase space point (list/array/PhaseSpacePoint), + or the energy, or None (defaults to None, resulting in default_energy) + permutation -- the permutation of the external particles (optional) + """ + self.permute[subprocess](permutation) + ps_pt = self.rambo[subprocess](ps_pt) + + self._fortran_ct[subprocess](byref(ps_pt.momenta), byref(self._m2l0), byref(self._m2ct)) + + return (self._m2l0.value, self._m2ct.value) + + self.ct[subprocess] = ct_tmp + del ct_tmp + + if self.contains_pseudotree[subprocess]: + self._fortran_pseudotree[subprocess] = getattr(self._library, pyol_ptamp2 % (process_name,)) + def pseudotree_tmp(ps_pt=None, permutation=None, subprocess=subprocess): + """ + Calculate a pseudo-tree matrix element. Return (M2tree, M2pt, M2loop). + + Arguments: + ps_pt -- either a phase space point (list/array/PhaseSpacePoint), + or the energy, or None (defaults to None, resulting in default_energy) + permutation -- the permutation of the external particles (optional) + """ + self.permute[subprocess](permutation) + ps_pt = self.rambo[subprocess](ps_pt) + + self._fortran_pseudotree[subprocess](byref(ps_pt.momenta), byref(self._m2l0), + byref(self._m2pt), byref(self._m2ct)) # loop --> ct + + return (self._m2l0.value, self._m2pt.value, self._m2ct.value) + + self.pseudotree[subprocess] = pseudotree_tmp + del pseudotree_tmp + + def matrix_element_tmp(ps_point=None, permutation=None, subprocess=subprocess): + """ + Call the MatrixElement constructor. + """ + return MatrixElement(self, SubprocessID(subprocess, permutation), ps_point) + self.matrix_element[subprocess] = matrix_element_tmp + del matrix_element_tmp + + def __repr__(self): + return "Process(name={}, loops={})".format(self.name, self.loops) + + def __str__(self): + return "process name: {}\nloops: {}\nsub-processes: {}\n".format( + self.name, self.loops, ", ".join(self.subprocesses)) + + + +class SubprocessID: + + def __init__(self, subprocess, permutation=None): + if not isinstance(subprocess, str): + raise ValueError("Invalid sub-process identifier: " + repr(subprocess)) + subprocess = subprocess.split("[", 1) + permutation_from_subprocess = None + if len(subprocess) == 2: + permutation_from_subprocess = valid_permutation("[" + subprocess[1]) + subprocess = subprocess[0] + + if not subprocess.split("_")[-1].isdigit(): + subprocess = subprocess + "_1" + if permutation is None: + permutation = permutation_from_subprocess + else: + valid_permutation(permutation) + if permutation_from_subprocess is not None: + raise ValueError("Permutation cannot be given twice for a sub-process.") + + self.name = subprocess + self.permutation = permutation + + def validate(self, process, default_permutation=None): + # Check if self.name is in process.subprocesses + # and if set(self.permutation) == set(range(1, n_particles+1)). + # If self.permutation == None, replace it by default_permutation, + # if present, otherwise range(1, n_particles+1). + if not isinstance(process, Process): + raise ValueError("process must be a process instance.") + if not self.name in process.subprocesses: + raise OpenLoopsError("Process " + repr(process.name) + + " does not contain a sub-processes " + repr(self.name)) + if self.permutation is None: + if default_permutation is None: + self.permutation = range(1, process.nexternal[self.name] + 1) + else: + self.permutation = valid_permutation(default_permutation) + else: + if set(self.permutation) != set(range(1, process.nexternal[self.name] + 1)): + raise ValueError("Invalid permutation: " + str(self.permutation) + " for sub-process " + self.name) + return self + + def __str__(self): + if self.permutation is None: + perm = "" + else: + perm = str(self.permutation).replace(" ", "") + return self.name + perm + + def __repr__(self): + return "SubprocessID(" + repr(self.name) + ", " + str(self.permutation).replace(" ", "") + ")" + + + +class MatrixElement: + """ + Store a phase space point and the matrix elements at this point for a partonic process. + + Members: + ps_point -- a PhaseSpacePoint instance + value -- the matrix elements as returned by Fortran + (float for tree process, 7-tuple for loop) + + Does NOT contain any further information like the process, parameters, permutation, ... + """ + def __init__(self, process=None, subprocess=None, ps_point=None, + tree=True, loop=True, value=None, verbose=0): + """ + Calculate matrix a element. + + Arguments: + process -- a Process instance + subprocess -- a (permuted) sub-process as SubprocessID() or as a string; + if omitted or None and there is only one sub-process, use this one + ps_point -- if omitted or None, use default_energy, + the energy if it is a number, + or a phase space point, either as an array, or as a PhaseSpacePoint instance + tree -- calculate the tree matrix element, if a tree routine is available + loop -- calculate the loop matrix element, if a loop routine is available + value -- set the matrix element to value instead of calculating it; + only makes sense if ps_point is actually a phase space point. + """ + if process is not None: + if subprocess is None: + if len(process.subprocesses) == 1: + subprocess = list(process.subprocesses)[0] + else: + raise OpenLoopsError("sub-process not unique") + if not isinstance(subprocess, SubprocessID): + subprocess = SubprocessID(subprocess) + subprocess.validate(process) + permutation = subprocess.permutation + subprocess_name = subprocess.name + + looptree = tree and not loop and not process.contains_tree[subprocess_name] + tree = tree and process.contains_tree[subprocess_name] + loop = loop and process.contains_loop[subprocess_name] + + process.permute[subprocess_name](permutation) + self.ps_point = process.rambo[subprocess_name](ps_point) + if loop: + self.value = process.loop[subprocess_name](self.ps_point) + if tree: + tree = process.tree[subprocess_name](self.ps_point) + consistency = common_digits(self.value[0], tree[0]) + if consistency < tree_accuracy_warn: + if consistency < tree_accuracy_fatal: + raise OpenLoopsError("inconsistent tree matrix element from tree and loop routines, agreement: " + repr(consistency) + " digits.") + else: + print ("WARNING: tree matrix element from tree and loop routines only consistent to" + + str(consistency) + " digits.") + if process.contains_loopsquared[subprocess_name]: + # flatten tuple + self.value = (self.value[0],) + tuple(self.value[1]) + tuple(self.value[2]) + tuple(self.value[3]) + tuple(self.value[4]) + else: + # flatten tuple and discard loop^2 information + self.value = (self.value[0],) + tuple(self.value[1]) + tuple(self.value[2]) + elif tree: + self.value = process.tree[subprocess_name](self.ps_point) + elif looptree: + self.value = (process.loop[subprocess_name](self.ps_point)[0],) + else: + raise OpenLoopsError("tree/loop request is not satisfiable.") + elif process is None and value is not None: + self.ps_point = ps_point + self.value = value + else: + OpenLoopsError("Process or value needed to initialise matrix element.") + if verbose > 1: + print self.ps_point + if verbose > 0: + print float_list_string(self.value) + + #if process is not None and value is not None: + #value_is_loop = isinstance() + + def compare(self, other): + if len(self.value) == len(other.value): + agreement = [common_digits(*vals) for vals in zip(self.value, other.value)] + else: + raise OpenLoopsError("Cannot compare matrix elements of different types.") + return min(agreement) + + def __repr__(self): + return "MatrixElement(ps_point=\n{!r},\nvalue={})".format(self.ps_point, self.value) + + def __str__(self): + return str(self.value) + + + +class ProcessTestData: + """ + Proecss test data: store a sample matrix elements for a process + and the environment that was used to generate them. + + Members: + version -- version information as a tuple of two integers. + process_name -- the process name. + loop_type -- "tree", "loop", or "loopsquared". + parameters -- the Parameters instance used to calculate the matrix elements. + subprocess -- a list SubprocessID instances. + all_subprocesses -- True if all sub-processes of the process are contained. + matrix_elements -- a list of MatrixElement instances + Temporary members: + check_successful: set by validate(), deleted by dump()/dumps(). + """ + def __init__(self, process, subprocess=None, phasespace=None, n=None, + parameters=None, verbose=0): + """ + Create sample data for a process. + + subprocess -- a list of (permuted) sub-processes as a string, + or a list of strings (possibly as a string) + or SubprocessID instances. + phasespace -- a list of phase space points (as accepted by PhaseSpacePoint), + or a list of energies, or the energy. + n -- number of matrix elements per sub-process. + parameters -- the Parameters instance to be used. + verbose -- 0: print nothing, 1: print matrix elements, 2: also pront phase space points. + """ + self.version = version + self.matrix_elements = {} + + if isinstance(process, str): + process = Process(process) + + if n is None: + n = default_sample_size + + if process is None: + pass + else: + self.process_name = process.name + self.loop_type = process.loop_type + if parameters is None: + self.parameters = Parameters() + else: + self.parameters = parameters + self.all_subprocesses = subprocess is None + + self.parameters.set() + + if self.all_subprocesses: + subprocess = process.subprocesses + + self.subprocesses = parse_subprocess_argument(subprocess, process) + + if phasespace is None or isinstance(phasespace, (int, float)): + phasespace = n * [phasespace] + + for subprocess in self.subprocesses: + if verbose > 0: + print "sub-process:", str(subprocess) + self.matrix_elements[subprocess.name] = [ + MatrixElement(process, subprocess, ps_point, verbose=verbose) + for ps_point in phasespace] + if verbose > 0: + print + + def dump(self, filename=None): + """Write a pickled representation to the file 'filename' (default 'processname.pkl')""" + try: + del self.check_successful + except AttributeError: + pass + if filename is None: + filename = self.process_name + ".pkl" + try: + os.remove(filename) + except OSError: + pass + dump_dir = os.path.dirname(filename) + if not os.path.exists(dump_dir): + os.mkdir(dump_dir) + with open(filename, "w") as fh: + pickle.dump(self, fh) + + def dumps(self): + """Return a pickled representation as a string.""" + try: + del self.check_successful + except AttributeError: + pass + return pickle.dumps(self) + + @staticmethod + def load(filename): + """Load pickled ProcessTestData from a file.""" + with open(filename, "r") as fh: + ptd = pickle.load(fh) + return ptd + + def validate(self, new_process_name=None, verbose=0): + """ + Validate ProcessTestData. + + Calculates matrix elements with the settings stored in 'self' + and compares the results to those in 'self'. + + new_process_name: set if the name of the process changed. + verbose: see __init__. + """ + + agrees = True + + if new_process_name is None: + new_process_name = self.process_name + + process = Process(new_process_name) + new_ptd = ProcessTestData(process=None) + + new_ptd.process_name = new_process_name + new_ptd.loop_type = process.loop_type + new_ptd.parameters = self.parameters + new_ptd.all_subprocesses = self.all_subprocesses + + if new_ptd.loop_type != self.loop_type: + raise OpenLoopsError("ProcessTestData.validate(): loops regression in " + repr(new_ptd.process_name)) + + new_ptd.parameters.set() + + self_sp_names = set([sp.name for sp in self.subprocesses]) + + if self.all_subprocesses: + new_ptd.subprocesses = parse_subprocess_argument(process.subprocesses, process) + missing_sps = self_sp_names - set(process.subprocesses) + new_sps = set(process.subprocesses) - self_sp_names + if missing_sps: + print "WARNING: subprocesses were removed from", self.process_name + ":", missing_sps + if new_sps: + print "WARNING: subprocesses were added to", self.process_name + ":", new_sps + else: + missing_sps = self_sp_names - set(process.subprocesses) + if missing_sps: + print "WARNING: subprocesses were removed from", self.process_name + ":", missing_sps + new_ptd.subprocesses = [sp for sp in self.subprocesses if sp.name not in missing_sps] + + for subprocess in new_ptd.subprocesses: + if verbose > 0: + print "sub-process:", str(subprocess) + subprocess_name = subprocess.name + new_ptd.matrix_elements[subprocess_name] = [] + me_count = 0 + for me in self.matrix_elements[subprocess_name]: + new_me = MatrixElement(process, subprocess, me.ps_point, verbose=verbose) + if me.compare(new_me) < matrix_element_agreement: + if verbose > 0: + print float_list_string(me.value), "(old)" + print "WARNING: {}_{}: Matrix element {} disagrees:\n{}\n{}".format( + new_ptd.process_name, subprocess, me_count+1, me, new_me) + agrees = False + new_ptd.matrix_elements[subprocess_name].append(new_me) + me_count = me_count + 1 + if verbose > 0: + print + + new_ptd.check_successful = agrees + + return new_ptd + + def show(self, verbose=1): + """ + Print ProcessTestData. + + verbose -- 0: only process, loop type, version + 1: also matrix elements + 2: also phase space points + 3: also used parameters + """ + print "Process:", self.process_name, "loop_type", self.loop_type, "version", self.version + print + if verbose > 2: + print self.parameters + print + for subprocess in self.subprocesses: + if verbose > 0: + print "sub-process:", str(subprocess) + for me in self.matrix_elements[subprocess.name]: + if verbose > 1: + print me.ps_point + print float_list_string(me.value) + print + + #def __repr__(self): + + #def __str__(self):