Page MenuHomeHEPForge

No OneTemporary

File Metadata

Created
Sun, Apr 5, 2:29 PM
This file is larger than 256 KB, so syntax highlighting was skipped.
This document is not UTF8. It was detected as ISO-8859-1 (Latin 1) and converted to UTF8 for display.
Index: trunk/.gitlab-ci.yml
===================================================================
--- trunk/.gitlab-ci.yml (revision 8371)
+++ trunk/.gitlab-ci.yml (revision 8372)
@@ -1,616 +1,615 @@
stages:
- build
- deploy
- report
- daily
- weekly
- weekly-applications
- weekly-report
variables:
NAGFOR_OPTIONS: "-w=all -gline -C=all -nan -f2008"
GFORTRAN_OPTIONS: "-fbacktrace -fcheck=array-temps,bounds,do,mem,pointer"
JOBS: "-j2"
JOBS_NAGFOR: "-j4"
.default_template: &default_definition
stage: build
before_script:
- ./build_master.sh
- autoreconf
- command -v opam && eval $(opam config env --root=/opt/opam)
- mkdir build || true
- cd build
except:
- production
- schedules
- /^.*xfail.*$/
artifacts:
expire_in: 3 weeks
when: always
paths:
- build/configure.log
- build/make.log
- build/make-install.log
- build/circe2/tests/test-suite.log
- build/omega/tests/test-suite.log
- build/vamp/tests/test-suite.log
- build/tests/unit_tests/test-suite.log
- build/tests/unit_tests/err-output/*
- build/tests/functional_tests/test-suite.log
.docker_template: &docker_definition
variables:
GIT_SSL_NO_VERIFY: "1"
tags:
- docker
# SMALL TEST SUITE (BRANCHES)
gfortran-5.5.0-fully:
<<: *default_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-tools
script:
- export LD_LIBRARY_PATH=/home/whizard/OpenLoops/lib:$LD_LIBRARY_PATH
- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" --enable-hoppet --enable-fastjet --enable-openloops --enable-pythia8 > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
nagfor-6:
<<: *default_definition
script:
- ../configure FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor --disable-static --prefix="`pwd`/install" --enable-distribution > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS_NAGFOR -s V=0 check
tags:
- nagfor
- latex
ifort-20:
<<: *default_definition
script:
- source /opt/intel/2020/bin/compilervars.sh intel64
- ../configure FC=ifort2020 FCFLAGS="-O1" F77=ifort2020 --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
tags:
- ifort
# BIG TEST SUITE (MASTER + TESTING BRANCHES)
.extra_template: &extra_definition
<<: *default_definition
only:
- master
- /^testing.*$/
.distcheck_template: &distcheck_script
script:
- ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 DISTCHECK_CONFIGURE_FLAGS='FC=gfortran F77=gfortran --enable-distribution --disable-noweb-force' distcheck > make-distcheck.log
.distcheck_template: &distcheck_definition
<<: *default_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-9.2.0
<<: *distcheck_script
<<: *docker_definition
only:
- master
- /^testing.*$/
artifacts:
expire_in: 3 weeks
when: always
paths:
- build/configure.log
- build/make.log
- build/make-install.log
- build/circe2/tests/test-suite.log
- build/omega/tests/test-suite.log
- build/vamp/tests/test-suite.log
- build/tests/unit_tests/test-suite.log
- build/tests/unit_tests/err-output/*
- build/tests/functional_tests/test-suite.log
- "build/whizard*.tar.gz"
- build/make-distcheck.log
after_script:
- find . -type f -exec chmod 644 {} +
- find . -type d -exec chmod 755 {} +
- rm whizard*/ -rf
distcheck.static.gfortran-9.2.0:
<<: *distcheck_definition
gfortran-6.4.0:
<<: *extra_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-6.4.0
script:
- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
gfortran-7.5.0:
<<: *extra_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-7.5.0
script:
- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
gfortran-8.3.0:
<<: *extra_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-8.3.0
script:
- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
gfortran-9.2.0:
<<: *extra_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-9.2.0
script:
- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
osx.gfortran:
<<: *extra_definition
script:
- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --prefix="`pwd`/install" --enable-distribution --enable-hepmc --enable-lcio --enable-lhapdf --enable-hoppet --enable-fastjet --enable-looptools LOOPTOOLS_DIR=/usr/local/lib --enable-gosam --enable-openloops --enable-recola --enable-pythia8 > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
tags:
- osx
disabled.static.nagfor-6:
<<: *extra_definition
script:
- ../configure --disable-lhapdf --disable-hepmc --disable-lcio --disable-pythia8 --disable-fastjet --disable-hoppet --disable-gosam --disable-openloops --disable-looptools --disable-pythia6 --enable-distribution FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS_NAGFOR -s V=0 check
tags:
- nagfor
- latex
nagfor-7:
<<: *extra_definition
script:
- ../configure FC=nagfor7 FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor7 --disable-static --prefix="`pwd`/install" --enable-distribution > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS_NAGFOR -s V=0 check
tags:
- nagfor7
- latex
extended.gfortran-5.5.0-fully:
<<: *extra_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-tools
script:
- export LD_LIBRARY_PATH=/home/whizard/OpenLoops/lib:$LD_LIBRARY_PATH
- ../configure --with-precision=extended FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" --enable-hoppet --enable-fastjet --enable-openloops --enable-pythia8 > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
openmp.gfortran-5.5.0:
<<: *extra_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0
script:
- ../configure --enable-fc-openmp FC=gfortran FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
mpi.gfortran-5.5.0:
<<: *extra_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0-openmpi-2.1.1
script:
- ../configure --enable-fc-mpi FC=mpifort FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=mpifort --disable-static --prefix="`pwd`/install" > configure.log
- sed -i.bak 's/mpirun="mpirun -np 1"/mpirun="mpirun -np 1 --allow-run-as-root"/' tests/functional_tests/run_whizard.sh
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
parallel.gfortran-5.5.0:
<<: *extra_definition
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0-openmpi-2.1.1
script:
- ../configure --enable-fc-openmp --enable-fc-mpi FC=mpifort FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=mpifort --disable-static --prefix="`pwd`/install" > configure.log
- sed -i.bak 's/mpirun="mpirun -np 1"/mpirun="mpirun -np 1 --allow-run-as-root"/' tests/functional_tests/run_whizard.sh
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
<<: *docker_definition
ifort-18:
<<: *extra_definition
script:
- source /opt/intel/2018/bin/compilervars.sh intel64
- ../configure FC=ifort2018 F77=ifort2018 --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
tags:
- ifort
ifort-19:
<<: *extra_definition
script:
- source /opt/intel/2019/bin/compilervars.sh intel64
- ../configure FC=ifort2019 F77=ifort2019 --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
tags:
- ifort
quadruple.ifort-20:
<<: *extra_definition
script:
- source /opt/intel/2020/bin/compilervars.sh intel64
- ../configure --with-precision=quadruple FC=ifort2020 FCFLAGS="-O1" F77=ifort2020 --disable-static --prefix="`pwd`/install" --enable-fastjet --enable-openloops > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
tags:
- ifort
# DEPLOY (MASTER)
.deploy_template: &deploy_definition
stage: deploy
tags:
- deployment
only:
- master
before_script:
- eval `ssh-agent -s`
- ssh-add /nfs/theoc/data1/whizard/sl7/gitlab_runner/id_rsa /nfs/theoc/data1/whizard/sl7/gitlab_runner/id_rsa_runner_wgs
except:
- production
- schedules
- /^.*xfail.*$/
notify slack:
stage: report
tags:
- deployment
only:
- master
before_script:
- eval `ssh-agent -s`
- ssh-add /nfs/theoc/data1/whizard/sl7/gitlab_runner/id_rsa /nfs/theoc/data1/whizard/sl7/gitlab_runner/id_rsa_runner_wgs
when: on_failure
script:
- echo "Build on \`$CI_BUILD_REF_NAME\` failed! Commit \`$(git log -1 --oneline)\` See pipeline $CI_PIPELINE_URL" | slacktee.sh -a "danger" -p --config /nfs/theoc/data1/whizard/sl7/gitlab_runner/.slacktee
deploy to production:
<<: *deploy_definition
environment: production
script:
- export GIT_SSH=/nfs/theoc/data1/whizard/sl7/gitlab_runner/ssh.sh
- git remote set-url --push origin git@gitlab.tp.nt.uni-siegen.de:whizard/development.git
- git checkout master
- git pull
- git checkout production
- git merge master --ff-only
- git push
deploy to public git:
<<: *deploy_definition
environment: public_git
dependencies: []
script:
- export GIT_SSH=/nfs/theoc/data1/whizard/sl7/gitlab_runner/ssh.sh
- git log --format="%h %s" -n 1 HEAD > `pwd`/../git_public.msg
- cd ..
- rm -rf public/
- git clone git@gitlab.tp.nt.uni-siegen.de:whizard/public.git
- rsync -r --delete --log-file=rsync.log --out-format='%i %n%L' --exclude=.git* development/ public
- diff -r --exclude=.git* development public || exit 1
- cp development/.gitignore public/
- mv rsync.log development/
- cd public
- echo -e ".gitignore" >> .gitignore
- echo -e ".gitlab/issue_templates" >> .gitignore
- - echo -e "src/muli/doc/*" >> .gitignore
- echo -e ".gitlab-ci.yml" >> .gitignore
- echo -e "CONTRIBUTING.md" >> .gitignore
- echo -e "synchronize.sh" >> .gitignore
- echo -e "share/debug/*" >> .gitignore
- echo -e "build/*" >> .gitignore
- echo -e "install/*" >> .gitignore
- git add --all
- git diff-index --exit-code HEAD || git commit --file=`pwd`/../git_public.msg
- git push
artifacts:
expire_in: 3 weeks
when: always
paths:
- rsync.log
deploy to svn:
<<: *deploy_definition
environment: svn
script:
- svn co --config-dir /nfs/theoc/data1/whizard/sl7/gitlab_runner/.subversion/ svn+ssh://vcs@phab.hepforge.org/source/whizardsvn/trunk trunk
- cp .git trunk/ -r
- cd trunk
- git status
- git checkout -- .
- git clean -d -f
- svn diff --config-dir /nfs/theoc/data1/whizard/sl7/gitlab_runner/.subversion/ > ../svndiff.log || true
- svn status --config-dir /nfs/theoc/data1/whizard/sl7/gitlab_runner/.subversion/ | grep "^?" | grep -v '.git$' | awk '{print $2}' >| ../svn-add-files.log || true
- svn status --config-dir /nfs/theoc/data1/whizard/sl7/gitlab_runner/.subversion/ | grep "^\!" | grep -v '.git$' | awk '{print $2}' >| ../svn-del-files.log || true
- if test -s ../svn-add-files.log ; then cat ../svn-add-files.log | xargs svn add --config-dir /nfs/theoc/data1/whizard/sl7/gitlab_runner/.subversion/ ; fi
- if test -s ../svn-del-files.log ; then cat ../svn-del-files.log | xargs svn rm --config-dir /nfs/theoc/data1/whizard/sl7/gitlab_runner/.subversion/ ; fi
- git log --format="%h %s" -n 1 HEAD > svn-commit.msg
- svn commit --config-dir /nfs/theoc/data1/whizard/sl7/gitlab_runner/.subversion/ --file=svn-commit.msg
artifacts:
paths:
- svndiff.log
- svn-add-files.log
- svn-del-files.log
# NIGHTLY BUILD (DAILY)
build whizard tarball:
stage: daily
environment: nightly
only:
refs:
- schedules
variables:
- $type == "nightly"
before_script:
- ./build_master.sh
- autoreconf
- command -v opam && eval $(opam config env --root=/opt/opam)
- mkdir build || true
- cd build
script:
- ../configure --enable-distribution FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 dist > make-dist.log
- mv "$(ls whizard-*.tar.gz)" "$(basename $(ls whizard-*.tar.gz) .tar.gz)-$(date -Idate)-$(git rev-parse --short HEAD).tar.gz"
- ssh whizard@beryllium 'cd tarballs && rm -f whizard-nightly-latest.tar.gz'
- ssh whizard@beryllium 'cd tarballs && (for f in $(ls -1t *.tar.gz | tail -n +5); do rm -f "${f}"; done)'
- rsync whizard*.tar.gz whizard@beryllium:~/tarballs
- ssh whizard@beryllium 'cd tarballs && rm -f *.sig; for f in $(ls -tr1 *.tar.gz); do sha256sum "${f}" > "${f}.sig"; done'
- ssh whizard@beryllium 'cd tarballs && ln -sfn "$(ls -1t whizard-*.tar.gz | head -n1)" whizard-nightly-latest.tar.gz'
- ssh whizard@beryllium 'cd tarballs && ln -sfn "$(ls -1t whizard-*.tar.gz.sig | head -n1)" whizard-nightly-latest.tar.gz.sig'
artifacts:
expire_in: 3 weeks
when: always
paths:
- configure.log
- make.log
- make-dist.log
tags:
- jenkins2
- nagfor
- latex
# WHIZARD IMAGE (WEEKLY)
build whizard image:
stage: weekly
script:
- git clone https://${WHIZARD_DOCKER_USER}:${WHIZARD_DOCKER_PASSWORD}@gitlab.tp.nt.uni-siegen.de/whizard/docker.git
- docker build -t gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master -f docker/whizard-master/Dockerfile .
- docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} https://gitlab.tp.nt.uni-siegen.de:4567
- docker push gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master
tags:
- whizard
only:
refs:
- schedules
variables:
- $type == "weekly"
# GCC TRUNK IMAGE (WEEKLY)
build gcc-trunk image:
stage: weekly
script:
- git clone https://${WHIZARD_DOCKER_USER}:${WHIZARD_DOCKER_PASSWORD}@gitlab.tp.nt.uni-siegen.de/whizard/docker.git
- cd docker/whizard-gcc-trunk
- wget http://mirrors.ctan.org/install/fonts/doublestroke.tds.zip
- docker build --no-cache=true -t gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk .
- docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} gitlab.tp.nt.uni-siegen.de:4567
- docker push gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk
tags:
- whizard
only:
refs:
- schedules
variables:
- $type == "weekly"
# SUBPACKAGES (WEEKLY)
.subpackage_template: &subpackage_definition
<<: *distcheck_definition
stage: weekly
only:
refs:
- schedules
variables:
- $type == "weekly"
except:
circe1.distcheck.static.gfortran-9.2.0:
<<: *subpackage_definition
before_script:
- command -v opam && eval $(opam config env --root=/opt/opam)
- ./build_master.sh CIRCE1
- autoreconf
- mkdir -p build
- cd build
circe2.distcheck.static.gfortran-9.2.0:
<<: *subpackage_definition
before_script:
- command -v opam && eval $(opam config env --root=/opt/opam)
- ./build_master.sh CIRCE2
- autoreconf
- mkdir -p build
- cd build
vamp.distcheck.static.gfortran-9.2.0:
<<: *subpackage_definition
before_script:
- command -v opam && eval $(opam config env --root=/opt/opam)
- ./build_master.sh VAMP
- autoreconf
- mkdir -p build
- cd build
omega.distcheck.static.gfortran-9.2.0:
<<: *subpackage_definition
before_script:
- command -v opam && eval $(opam config env --root=/opt/opam)
- ./build_master.sh OMEGA
- autoreconf
- mkdir -p build
- cd build
script:
- ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
- make $JOBS -s V=0 extra-distcheck > make-distcheck.log
whizard.distcheck.static.gfortran-9.2.0:
<<: *subpackage_definition
before_script:
- command -v opam && eval $(opam config env --root=/opt/opam)
- ./build_master.sh
- autoreconf
- mkdir -p build
- cd build
script:
- ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
- make $JOBS -s V=0 extra-distcheck > make-distcheck.log
# EXAMPLES (WEEKLY)
.examples_template: &examples_definition
stage: weekly-applications
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master
only:
refs:
- schedules
variables:
- $type == "weekly"
before_script:
- source /home/whizard/GoSam/local/bin/gosam_setup_env.sh
- eval $(opam config env --root=/opt/opam)
- cd /home/whizard/whizard/share/examples
<<: *docker_definition
run matching examples:
<<: *examples_definition
script:
- for s in *Matching*.sin ; do whizard $s; done
run NLO examples:
<<: *examples_definition
script:
- for s in *NLO*OpenLoops.sin ; do whizard $s; done
# - for s in *NLO*GoSam.sin ; do whizard $s; done
run collider examples:
<<: *examples_definition
script:
- for s in HERA_DIS.sin LEP_cc10.sin LEP_higgs.sin W-endpoint.sin Z-lineshape.sin ; do whizard $s; done
run other examples:
<<: *examples_definition
script:
- for s in Zprime.sin casc_dec.sin circe1.sin eeww_polarized.sin fourjetsLO.sin ; do whizard $s; done
# Extended Tests (WEEKLY)
.ext_tests_template: &ext_tests_definition
stage: weekly-applications
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master
only:
refs:
- schedules
variables:
- $type == "weekly"
before_script:
- source /home/whizard/GoSam/local/bin/gosam_setup_env.sh
- eval $(opam config env --root=/opt/opam)
- cd /home/whizard/whizard/_build/tests
<<: *docker_definition
run extended NLO tests:
<<: *ext_tests_definition
script:
- cd ext_tests_nlo
- make $JOBS -s V=0 check
- cp /home/whizard/whizard/_build/tests/ext_tests_nlo/test-suite.log $CI_PROJECT_DIR/test-suite_ext_nlo.log
artifacts:
expire_in: 3 weeks
when: always
paths:
- test-suite_ext_nlo.log
build whizard with gcc-trunk:
<<: *default_definition
<<: *docker_definition
stage: weekly-applications
image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk
only:
refs:
- schedules
variables:
- $type == "weekly"
except:
dependencies:
script:
- ../configure --disable-static --prefix="`pwd`/install" > configure.log
- make $JOBS -s V=0 > make.log
- make $JOBS -s V=0 install > make-install.log
- make $JOBS -s V=0 check
notify slack weekly:
stage: weekly-report
tags:
- deployment
only:
refs:
- schedules
variables:
- $type == "weekly"
before_script:
- eval `ssh-agent -s`
- ssh-add /nfs/theoc/data1/whizard/sl7/gitlab_runner/id_rsa /nfs/theoc/data1/whizard/sl7/gitlab_runner/id_rsa_runner_wgs
when: on_failure
script:
- echo "Weekly build on \`$CI_BUILD_REF_NAME\` failed! Commit \`$(git log -1 --oneline)\`. See pipeline $CI_PIPELINE_URL" | slacktee.sh -a "warning" -p --config /nfs/theoc/data1/whizard/sl7/gitlab_runner/.slacktee
Index: trunk/src/muli/doc/muli_fibonacci_tree.tex
===================================================================
--- trunk/src/muli/doc/muli_fibonacci_tree.tex (revision 8371)
+++ trunk/src/muli/doc/muli_fibonacci_tree.tex (revision 8372)
@@ -1,2028 +0,0 @@
-\Module{muli\_fibonacci\_tree}
-%\begin{figure}
-% \centering{\includegraphics{uml-module-tree-11.mps}}
-% \caption{\label{fig:\ThisModule:Types}Klassendiagramm des Moduls \ThisModule}
-%\end{figure}
-\section{Abhängigkeiten}
-\use{muli\_basic}
-\section{Parameter}
-\begin{Verbatim}
- character(*),parameter,private :: no_par = "edge={\textbackslash}noparent"
- character(*),parameter,private :: no_ret = "edge={\textbackslash}noreturn"
- character(*),parameter,private :: no_kid = "edge={\textbackslash}nochild"
- character(*),parameter,private :: le_kid = "edge={\textbackslash}childofleave"
-\end{Verbatim}
-
-\section{Derived Types}
-\TypeDef{fibonacci\_node\_type}
-\begin{Verbatim}
- type,\Extends{measurable\_class} :: fibonacci_node_type
-! private
- class(\TypeRef{fibonacci\_node\_type}), pointer :: \TC{up} => null()
- class(\TypeRef{measurable\_class}), pointer :: \TC{down} => null()
- class(\TypeRef{fibonacci\_node\_type}), pointer :: \TC{left} => null()
- class(\TypeRef{fibonacci\_node\_type}), pointer :: \TC{right} => null()
- integer :: depth = 0
- contains
- ! overridden serializable_class procedures
- procedure::\TbpDec{write\_to\_marker}{fibonacci\_node\_write\_to\_marker}
- procedure::\TbpDec{read\_from\_marker}{fibonacci\_node\_read\_from\_marker}
- procedure::\TbpDec{read\_target\_from\_marker}{fibonacci\_node\_read\_target\_from\_marker}
- procedure::\TbpDec{print\_to\_unit}{fibonacci\_node\_print\_to\_unit}
- procedure,nopass::\TbpDec{get\_type}{fibonacci\_node\_get\_type}
- procedure::\TbpDec{deserialize\_from\_marker}{fibonacci\_node\_deserialize\_from\_marker}
- ! overridden measurable_class procedures
- procedure::\TbpDec{measure}{fibonacci\_node\_measure}
- ! init/final
- procedure,public ::\TbpDec{deallocate\_tree}{fibonacci\_node\_deallocate\_tree}
- procedure,public ::\TbpDec{deallocate\_all}{fibonacci\_node\_deallocate\_all}
-! interface
- procedure,public ::\TbpDec{get\_depth}{fibonacci\_node\_get\_depth}
- procedure,public ::\TbpDec{count\_leaves}{fibonacci\_node\_count\_leaves}
-! public tests
- procedure,public,nopass ::\TbpDec{is\_leave}{fibonacci\_node\_is\_leave}
- procedure,public,nopass ::\TbpDec{is\_root}{fibonacci\_node\_is\_root}
- procedure,public,nopass ::\TbpDec{is\_inner}{fibonacci\_node\_is\_inner}
-! print methods
- procedure,public ::\TbpDec{write\_association}{fibonacci\_node\_write\_association}
- procedure,public ::\TbpDec{write\_contents}{fibonacci\_node\_write\_contents}
- procedure,public ::\TbpDec{write\_values}{fibonacci\_node\_write\_values}
- procedure,public ::\TbpDec{write\_leaves}{fibonacci\_node\_write\_leaves}
- !procedure,public ::\TbpDec{write}{fibonacci\_node\_write\_contents}
-! write methods
- procedure,public ::\TbpDec{write\_pstricks}{fibonacci\_node\_write\_pstricks}
-! elaborated functions
- procedure,public ::\TbpDec{copy\_node}{fibonacci\_node\_copy\_node}
- procedure,public ::\TbpDec{find\_root}{fibonacci\_node\_find\_root}
- procedure,public ::\TbpDec{find\_leftmost}{fibonacci\_node\_find\_leftmost}
- procedure,public ::\TbpDec{find\_rightmost}{fibonacci\_node\_find\_rightmost}
- procedure,public ::\TbpDec{find}{fibonacci\_node\_find}
- procedure,public ::\TbpDec{find\_left\_leave}{fibonacci\_node\_find\_left\_leave}
- procedure,public ::\TbpDec{find\_right\_leave}{fibonacci\_node\_find\_right\_leave}
- procedure,public ::\TbpDec{apply\_to\_leaves}{fibonacci\_node\_apply\_to\_leaves}
- procedure,public ::\TbpDec{apply\_to\_leaves\_rl}{fibonacci\_node\_apply\_to\_leaves\_rl}
-! private procedures: these are unsafe!
- procedure ::\TbpDec{set\_depth}{fibonacci\_node\_set\_depth}
- procedure ::\TbpDec{append\_left}{fibonacci\_node\_append\_left}
- procedure ::\TbpDec{append\_right}{fibonacci\_node\_append\_right}
- procedure ::\TbpDec{replace}{fibonacci\_node\_replace}
- procedure ::\TbpDec{swap}{fibonacci\_node\_swap\_nodes}
- procedure ::\TbpDec{flip}{fibonacci\_node\_flip\_children}
- procedure ::\TbpDec{rip}{fibonacci\_node\_rip}
- procedure ::\TbpDec{remove\_and\_keep\_parent}{fibonacci\_node\_remove\_and\_keep\_parent}
- procedure ::\TbpDec{remove\_and\_keep\_twin}{fibonacci\_node\_remove\_and\_keep\_twin}
- procedure ::\TbpDec{rotate\_left}{fibonacci\_node\_rotate\_left}
- procedure ::\TbpDec{rotate\_right}{fibonacci\_node\_rotate\_right}
- procedure ::\TbpDec{rotate}{fibonacci\_node\_rotate}
- procedure ::\TbpDec{balance\_node}{fibonacci\_node\_balance\_node}
- procedure ::\TbpDec{update\_depth\_save}{fibonacci\_node\_update\_depth\_save}
- procedure ::\TbpDec{update\_depth\_unsave}{fibonacci\_node\_update\_depth\_unsave}
- procedure ::\TbpDec{repair}{fibonacci\_node\_repair}
-! tests: these are save when type is fibonacci_node_type and else unsafe.
- procedure ::\TbpDec{is\_left\_short}{fibonacci\_node\_is\_left\_short}
- procedure ::\TbpDec{is\_right\_short}{fibonacci\_node\_is\_right\_short}
- procedure ::\TbpDec{is\_unbalanced}{fibonacci\_node\_is\_unbalanced}
- procedure ::\TbpDec{is\_left\_too\_short}{fibonacci\_node\_is\_left\_too\_short}
- procedure ::\TbpDec{is\_right\_too\_short}{fibonacci\_node\_is\_right\_too\_short}
- procedure ::\TbpDec{is\_too\_unbalanced}{fibonacci\_node\_is\_too\_unbalanced}
- procedure ::\TbpDec{is\_left\_child}{fibonacci\_node\_is\_left\_child}
- procedure ::\TbpDec{is\_right\_child}{fibonacci\_node\_is\_right\_child}
- end type fibonacci_node_type
-\end{Verbatim}
-\TypeDef{fibonacci\_leave\_type}
-\begin{Verbatim}
- type,\Extends{fibonacci\_node\_type} :: fibonacci_leave_type
-! class(\TypeRef{measurable\_class}),pointer :: \TC{content}
- contains
- ! overridden serializable_class procedures
- procedure::\TbpDec{print\_to\_unit}{fibonacci\_leave\_print\_to\_unit}
- procedure,nopass::\TbpDec{get\_type}{fibonacci\_leave\_get\_type}
- procedure,public ::\TbpDec{deallocate\_all}{fibonacci\_leave\_deallocate\_all}
- ! new procedures
- procedure,public ::\TbpDec{pick}{fibonacci\_leave\_pick}
- procedure,public ::\TbpDec{get\_left}{fibonacci\_leave\_get\_left}
- procedure,public ::\TbpDec{get\_right}{fibonacci\_leave\_get\_right}
- procedure,public ::\TbpDec{write\_pstricks}{fibonacci\_leave\_write\_pstricks}
- procedure,public ::\TbpDec{copy\_content}{fibonacci\_leave\_copy\_content}
- procedure,public ::\TbpDec{set\_content}{fibonacci\_leave\_set\_content}
- procedure,public ::\TbpDec{get\_content}{fibonacci\_leave\_get\_content}
- procedure,public,nopass ::\TbpDec{is\_inner}{fibonacci\_leave\_is\_inner}
- procedure,public,nopass ::\TbpDec{is\_leave}{fibonacci\_leave\_is\_leave}
- procedure ::\TbpDec{insert\_leave\_by\_node}{fibonacci\_leave\_insert\_leave\_by\_node}
- procedure ::\TbpDec{is\_left\_short}{fibonacci\_leave\_is\_left\_short}
- procedure ::\TbpDec{is\_right\_short}{fibonacci\_leave\_is\_right\_short}
- procedure ::\TbpDec{is\_unbalanced}{fibonacci\_leave\_is\_unbalanced}
- procedure ::\TbpDec{is\_left\_too\_short}{fibonacci\_leave\_is\_left\_too\_short}
- procedure ::\TbpDec{is\_right\_too\_short}{fibonacci\_leave\_is\_right\_too\_short}
- procedure ::\TbpDec{is\_too\_unbalanced}{fibonacci\_leave\_is\_too\_unbalanced}
- end type fibonacci_leave_type
-\end{Verbatim}
-\TypeDef{fibonacci\_root\_type}
-\begin{Verbatim}
- type,\Extends{fibonacci\_node\_type} :: fibonacci_root_type
- logical::\TC{is\_valid\_c}=.false.
- class(\TypeRef{fibonacci\_leave\_type}),pointer ::\TC{leftmost}=>null()
- class(\TypeRef{fibonacci\_leave\_type}),pointer ::\TC{rightmost}=>null()
- contains
- ! overridden serializable_class procedures
- procedure::\TbpDec{write\_to\_marker}{fibonacci\_root\_write\_to\_marker}
- procedure::\TbpDec{read\_target\_from\_marker}{fibonacci\_root\_read\_target\_from\_marker}
- procedure::\TbpDec{print\_to\_unit}{fibonacci\_root\_print\_to\_unit}
- procedure,nopass::\TbpDec{get\_type}{fibonacci\_root\_get\_type}
- ! new procedures
- procedure::\TbpDec{get\_leftmost}{fibonacci\_root\_get\_leftmost}
- procedure::\TbpDec{get\_rightmost}{fibonacci\_root\_get\_rightmost}
-! public tests
- procedure,public,nopass ::\TbpDec{is\_root}{fibonacci\_root\_is\_root}
- procedure,public,nopass ::\TbpDec{is\_inner}{fibonacci\_root\_is\_inner}
- procedure,public ::\TbpDec{is\_valid}{fibonacci\_root\_is\_valid}
- procedure,public ::\TbpDec{count\_leaves}{fibonacci\_root\_count\_leaves}
- procedure,public ::\TbpDec{write\_pstricks}{fibonacci\_root\_write\_pstricks}
- procedure,public ::\TbpDec{copy\_root}{fibonacci\_root\_copy\_root}
- procedure,public ::\TbpDec{push\_by\_content}{fibonacci\_root\_push\_by\_content}
- procedure,public ::\TbpDec{push\_by\_leave}{fibonacci\_root\_push\_by\_leave}
- procedure,public ::\TbpDec{pop\_left}{fibonacci\_root\_pop\_left}
- procedure,public ::\TbpDec{pop\_right}{fibonacci\_root\_pop\_right}
- procedure,public ::\TbpDec{merge}{fibonacci\_root\_merge}
- procedure,public ::\TbpDec{set\_leftmost}{fibonacci\_root\_set\_leftmost}
- procedure,public ::\TbpDec{set\_rightmost}{fibonacci\_root\_set\_rightmost}
- procedure,public ::\TbpDec{init\_by\_leave}{fibonacci\_root\_init\_by\_leave}
- procedure,public ::\TbpDec{init\_by\_content}{fibonacci\_root\_init\_by\_content}
- procedure,public ::\TbpDec{reset}{fibonacci\_root\_reset}
- ! init/final
- procedure,public ::\TbpDec{deallocate\_tree}{fibonacci\_root\_deallocate\_tree}
- procedure,public ::\TbpDec{deallocate\_all}{fibonacci\_root\_deallocate\_all}
- procedure ::\TbpDec{is\_left\_child}{fibonacci\_root\_is\_left\_child}
- procedure ::\TbpDec{is\_right\_child}{fibonacci\_root\_is\_right\_child}
- end type fibonacci_root_type
-\end{Verbatim}
-\TypeDef{fibonacci\_stub\_type}
-\begin{Verbatim}
- type,\Extends{fibonacci\_root\_type} :: fibonacci_stub_type
- contains
- ! overridden serializable_class procedures
- procedure,nopass::\TbpDec{get\_type}{fibonacci\_stub\_get\_type}
- ! overridden fibonacci_root_type procedures
- procedure,public ::\TbpDec{push\_by\_content}{fibonacci\_stub\_push\_by\_content}
- procedure,public ::\TbpDec{push\_by\_leave}{fibonacci\_stub\_push\_by\_leave}
- procedure,public ::\TbpDec{pop\_left}{fibonacci\_stub\_pop\_left}
- procedure,public ::\TbpDec{pop\_right}{fibonacci\_stub\_pop\_right}
- end type fibonacci_stub_type
-\end{Verbatim}
-\TypeDef{fibonacci\_leave\_list\_type}
-\begin{Verbatim}
- type fibonacci_leave_list_type
- class(\TypeRef{fibonacci\_leave\_type}),pointer ::\TC{leave}=>null()
- class(\TypeRef{fibonacci\_leave\_list\_type}),pointer :: \TC{next} => null()
- end type fibonacci_leave_list_type
-\end{Verbatim}
-\Methods
-\MethodsFor{fibonacci\_node\_type}
-\OverridesSection{serializable\_class}
-
-\TbpImp{fibonacci\_node\_write\_to\_marker}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_write_to_marker(this,marker,status)
- class(fibonacci_node_type), intent(in) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
-! local variables
- class(serializable_class),pointer::ser
- call marker%mark_begin("fibonacci_node_type")
- ser=>this%left
- call marker%mark_pointer("left",ser)
- ser=>this%right
- call marker%mark_pointer("right",ser)
- ser=>this%xxxx
- call marker%mark_pointer("down",ser)
- call marker%mark_end("fibonacci_node_type")
- end subroutine fibonacci_node_write_to_marker
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_read\_from\_marker}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_read_from_marker (this,marker,status)
- class(fibonacci_node_type), intent(out) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
- print *,"fibonacci_node_read_from_marker: You cannot deserialize a list with this subroutine."
- print *,"Use fibonacci_node_read_target_from_marker instead."
- end subroutine fibonacci_node_read_from_marker
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_read\_target\_from\_marker}
-\begin{Verbatim}
-recursive subroutine fibonacci_node_read_target_from_marker(this,marker,status)
- class(fibonacci_node_type),target,intent(out) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
-! local variables
- class(serializable_class),pointer::ser
- call marker%pick_begin("fibonacci_node_type",status=status)
- call marker%pick_pointer("left",ser)
- if(status==0)then
- select type(ser)
- class is (fibonacci_node_type)
- this%left=>ser
- this%left%up=>this
- end select
- end if
- call marker%pick_pointer("right",ser)
- if(status==0)then
- select type(ser)
- class is (fibonacci_node_type)
- this%right=>ser
- this%right%up=>this
- end select
- end if
- call marker%pick_pointer("down",ser)
- if(status==0)then
- select type(ser)
- class is (measurable_class)
- this%xxxx=>ser
- end select
- end if
- call marker%pick_end("fibonacci_node_type",status)
- end subroutine fibonacci_node_read_target_from_marker
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_get\_type}
-\begin{Verbatim}
- pure subroutine fibonacci_node_get_type(type)
- character(:),allocatable,intent(out)::type
- allocate(type,source="fibonacci_node_type")
- end subroutine fibonacci_node_get_type
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_deserialize\_from\_marker}
-\begin{Verbatim}
- subroutine fibonacci_node_deserialize_from_marker(this,name,marker)
- class(fibonacci_node_type),intent(out)::this
- character(*),intent(in)::name
- class(marker_type),intent(inout)::marker
- class(serializable_class),pointer::ser
- allocate(fibonacci_leave_type::ser)
- call marker%push_reference(ser)
- allocate(fibonacci_node_type::ser)
- call marker%push_reference(ser)
- call serializable_deserialize_from_marker(this,name,marker)
- call marker%pop_reference(ser)
- deallocate(ser)
- call marker%pop_reference(ser)
- deallocate(ser)
- end subroutine fibonacci_node_deserialize_from_marker
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_print\_to\_unit}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_print_to_unit(this,unit,parents,components,peers)
- class(fibonacci_node_type),intent(in)::this
- integer,intent(in)::unit
- integer(kind=dik),intent(in)::parents,components,peers
- class(serializable_class),pointer::ser
- write(unit,'("Components of fibonacci_node_type:")')
- write(unit,'("Depth: ",I22)')this%depth
- write(unit,'("Value: ",E23.16)')this%measure()
- ser=>this%up
- call serialize_print_comp_pointer(ser,unit,parents,-one,-one,"Up: ")
- ser=>this%left
- call serialize_print_peer_pointer(ser,unit,parents,components,peers,"Left: ")
- ser=>this%right
- call serialize_print_peer_pointer(ser,unit,parents,components,peers,"Right: ")
- end subroutine fibonacci_node_print_to_unit
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_measure}
-\begin{Verbatim}
- elemental function fibonacci_node_measure(this)
- class(fibonacci_node_type),intent(in)::this
- real(kind=double)::fibonacci_node_measure
- fibonacci_node_measure=this%down%measure()
- end function fibonacci_node_measure
-\end{Verbatim}
-
- ! init/final
-
-\TbpImp{fibonacci\_node\_deallocate\_tree}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_deallocate_tree(this)
- class(fibonacci_node_type),intent(inout) :: this
- if (associated(this%left)) then
- call this%left%deallocate_tree()
- deallocate(this%left)
- end if
- if (associated(this%right)) then
- call this%right%deallocate_tree()
- deallocate(this%right)
- end if
- call this%set_depth(0)
- end subroutine fibonacci_node_deallocate_tree
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_deallocate\_all}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_deallocate_all(this)
- class(fibonacci_node_type),intent(inout) :: this
- if (associated(this%left)) then
- call this%left%deallocate_all()
- deallocate(this%left)
- end if
- if (associated(this%right)) then
- call this%right%deallocate_all()
- deallocate(this%right)
- end if
- call this%set_depth(0)
- end subroutine fibonacci_node_deallocate_all
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_set\_depth}
-\begin{Verbatim}
- subroutine fibonacci_node_set_depth(this,depth)
- class(fibonacci_node_type),intent(inout) :: this
- integer,intent(in) :: depth
- this%depth=depth
- end subroutine fibonacci_node_set_depth
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_get\_depth}
-\begin{Verbatim}
- elemental function fibonacci_node_get_depth(this)
- class(fibonacci_node_type),intent(in) :: this
- integer :: fibonacci_node_get_depth
- fibonacci_node_get_depth = this%depth
- end function fibonacci_node_get_depth
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_leave}
-\begin{Verbatim}
- elemental function fibonacci_node_is_leave()
- logical :: fibonacci_node_is_leave
- fibonacci_node_is_leave = .false.
- end function fibonacci_node_is_leave
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_root}
-\begin{Verbatim}
- elemental function fibonacci_node_is_root()
- logical :: fibonacci_node_is_root
- fibonacci_node_is_root = .false.
- end function fibonacci_node_is_root
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_inner}
-\begin{Verbatim}
- elemental function fibonacci_node_is_inner()
- logical :: fibonacci_node_is_inner
- fibonacci_node_is_inner = .true.
- end function fibonacci_node_is_inner
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_write\_leaves}
-\begin{Verbatim}
- subroutine fibonacci_node_write_leaves(this,unit)
- class(fibonacci_node_type),intent(in),target :: this
- integer,intent(in),optional :: unit
- call this%apply_to_leaves(fibonacci_leave_write,unit)
- end subroutine fibonacci_node_write_leaves
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_write\_contents}
-\begin{Verbatim}
- subroutine fibonacci_node_write_contents(this,unit)
- class(fibonacci_node_type),intent(in),target :: this
- integer,intent(in),optional :: unit
- call this%apply_to_leaves(fibonacci_leave_write_content,unit)
- end subroutine fibonacci_node_write_contents
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_write\_values}
-\begin{Verbatim}
- subroutine fibonacci_node_write_values(this,unit)
- class(fibonacci_node_type),intent(in),target :: this
- integer,intent(in),optional :: unit
- call this%apply_to_leaves(fibonacci_leave_write_value,unit)
- end subroutine fibonacci_node_write_values
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_write\_association}
-\begin{Verbatim}
- subroutine fibonacci_node_write_association(this,that)
- class(fibonacci_node_type),intent(in),target :: this
- class(fibonacci_node_type),intent(in),target :: that
- if (associated(that%left,this)) then
- write(*,'("this is left child of that")')
- end if
- if (associated(that%right,this)) then
- write(*,'("this is right child of that")')
- end if
- if (associated(that%up,this)) then
- write(*,'("this is parent of that")')
- end if
- if (associated(this%left,that)) then
- write(*,'("that is left child of this")')
- end if
- if (associated(this%right,that)) then
- write(*,'("that is right child of this")')
- end if
- if (associated(this%up,that)) then
- write(*,'("that is parent of this")')
- end if
- end subroutine fibonacci_node_write_association
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_write\_pstricks}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_write_pstricks(this,unitnr)
- class(fibonacci_node_type),intent(in),target :: this
- integer,intent(in) :: unitnr
- if (associated(this%up)) then
- if (associated(this%up%left,this).neqv.(associated(this%up%right,this))) then
- write(unitnr,'("{\textbackslash}begin{psTree}{{\textbackslash}Toval{{\textbackslash}node{",i3,"}{",f9.3,"}}}")')&
- int(this%depth),this%measure()
- else
- write(unitnr,'("{\textbackslash}begin{psTree}{{\textbackslash}Toval[",a,"]{{\textbackslash}node{",i3,"}{",f9.3,"}}}")')&
- no_ret,int(this%depth),this%measure()
- end if
- else
- write(unitnr,'("{\textbackslash}begin{psTree}{{\textbackslash}Toval[",a,"]{{\textbackslash}node{",i3,"}{",f9.3,"}}}")')&
- no_par,int(this%depth),this%measure()
- end if
- if (associated(this%left)) then
- call this%left%write_pstricks(unitnr)
- else
- write(unitnr,'("{\textbackslash}Tr[edge=brokenline]{}")')
- end if
- if (associated(this%right)) then
- call this%right%write_pstricks(unitnr)
- else
- write(unitnr,'("{\textbackslash}Tr[edge=brokenline]{}")')
- end if
- write(unitnr,'("{\textbackslash}end{psTree}")')
- end subroutine fibonacci_node_write_pstricks
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_copy\_node}
-\begin{Verbatim}
- subroutine fibonacci_node_copy_node(this,primitive)
- class(fibonacci_node_type),intent(out) :: this
- class(fibonacci_node_type),intent(in) :: primitive
- this%up => primitive%up
- this%left => primitive%left
- this%right => primitive%right
- this%depth = primitive%depth
- this%down=> primitive%down
- end subroutine fibonacci_node_copy_node
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_find\_root}
-\begin{Verbatim}
- subroutine fibonacci_node_find_root(this,root)
- class(fibonacci_node_type),intent(in),target :: this
- class(fibonacci_root_type),pointer,intent(out) :: root
- class(fibonacci_node_type),pointer :: node
- node=>this
- do while(associated(node%up))
- node=>node%up
- end do
- select type (node)
- class is (fibonacci_root_type)
- root=>node
- class default
- nullify(root)
- print *,"fibonacci_node_find_root: root is not type compatible to&
- & fibonacci_root_type. Retured NULL()."
- end select
- end subroutine fibonacci_node_find_root
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_find\_leftmost}
-\begin{Verbatim}
- subroutine fibonacci_node_find_leftmost(this,leave)
- class(fibonacci_node_type),intent(in), target :: this
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- class(fibonacci_node_type), pointer :: node
- node=>this
- do while(associated(node%left))
- node=>node%left
- end do
- select type (node)
- class is (fibonacci_leave_type)
- leave => node
- class default
- leave => null()
- end select
- end subroutine fibonacci_node_find_leftmost
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_find\_rightmost}
-\begin{Verbatim}
- subroutine fibonacci_node_find_rightmost(this,leave)
- class(fibonacci_node_type),intent(in), target :: this
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- class(fibonacci_node_type), pointer :: node
- node=>this
- do while(associated(node%right))
- node=>node%right
- end do
- select type (node)
- class is (fibonacci_leave_type)
- leave => node
- class default
- leave => null()
- end select
- end subroutine fibonacci_node_find_rightmost
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_find}
-\begin{Verbatim}
- subroutine fibonacci_node_find(this,value,leave)
- class(fibonacci_node_type),intent(in),target :: this
- real(kind=double),intent(in) :: value
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- class(fibonacci_node_type), pointer :: node
- node=>this
- do
- if (node>=value) then
- if (associated(node%left)) then
- node=>node%left
- else
- print *,"fibonacci_node_find: broken tree!"
- leave => null()
- return
- end if
- else
- if (associated(node%right)) then
- node=>node%right
- else
- print *,"fibonacci_node_find: broken tree!"
- leave => null()
- return
- end if
- end if
- select type (node)
- class is (fibonacci_leave_type)
- leave => node
- exit
- end select
- end do
- end subroutine fibonacci_node_find
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_find\_left\_leave}
-\begin{Verbatim}
- subroutine fibonacci_node_find_left_leave(this,leave)
- class(fibonacci_node_type),intent(in),target :: this
- class(fibonacci_node_type),pointer :: node
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- nullify(leave)
- node=>this
- do while (associated(node%up))
- if (associated(node%up%right,node)) then
- node=>node%up%left
- do while (associated(node%right))
- node=>node%right
- end do
- select type (node)
- class is (fibonacci_leave_type)
- leave=>node
- end select
- exit
- end if
- node=>node%up
- end do
- end subroutine fibonacci_node_find_left_leave
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_find\_right\_leave}
-\begin{Verbatim}
- subroutine fibonacci_node_find_right_leave(this,leave)
- class(fibonacci_node_type),intent(in),target :: this
- class(fibonacci_node_type),pointer :: node
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- nullify(leave)
- node=>this
- do while (associated(node%up))
- if (associated(node%up%left,node)) then
- node=>node%up%right
- do while (associated(node%left))
- node=>node%left
- end do
- select type (node)
- class is (fibonacci_leave_type)
- leave=>node
- end select
- exit
- end if
- node=>node%up
- end do
- end subroutine fibonacci_node_find_right_leave
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_replace}
-\begin{Verbatim}
- subroutine fibonacci_node_replace(this,old_node)
- class(fibonacci_node_type),intent(inout),target :: this
- class(fibonacci_node_type),target :: old_node
- if (associated(old_node%up)) then
- if (old_node%is_left_child()) then
- old_node%up%left => this
- else
- if (old_node%is_right_child()) then
- old_node%up%right => this
- end if
- end if
- this%up => old_node%up
- else
- nullify(this%up)
- end if
- end subroutine fibonacci_node_replace
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_swap\_nodes}
-\begin{Verbatim}
- subroutine fibonacci_node_swap_nodes(left,right)
- class(fibonacci_node_type),target,intent(inout) :: left,right
- class(fibonacci_node_type),pointer :: left_left,right_right
- class(measurable_class),pointer::down
- ! swap branches
- left_left =>left%left
- right_right=>right%right
- left%left =>right%right
- right%right=>left_left
- ! repair up components
- right_right%up=>left
- left_left%up =>right
- ! repair down components
- down => left%down
- left%down => right%down
- right%down => down
- end subroutine fibonacci_node_swap_nodes
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_swap\_nodes}
-\begin{Verbatim}
-! subroutine fibonacci_node_swap_nodes(this,that)
-! class(fibonacci_node_type),target :: this
-! class(fibonacci_node_type),pointer,intent(in) :: that
-! class(fibonacci_node_type),pointer :: par_i,par_a
-! par_i => this%up
-! par_a => that%up
-! if (associated(par_i%left,this)) then
-! par_i%left => that
-! else
-! par_i%right => that
-! end if
-! if (associated(par_a%left,that)) then
-! par_a%left => this
-! else
-! par_a%right => this
-! end if
-! this%up => par_a
-! that%up => par_i
-! end subroutine fibonacci_node_swap_nodes
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_flip\_children}
-\begin{Verbatim}
- subroutine fibonacci_node_flip_children(this)
- class(fibonacci_node_type),intent(inout) :: this
- class(fibonacci_node_type),pointer :: child
- child => this%left
- this%left=>this%right
- this%right => child
- end subroutine fibonacci_node_flip_children
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_rip}
-\begin{Verbatim}
- subroutine fibonacci_node_rip(this)
- class(fibonacci_node_type),intent(inout),target :: this
- if (this%is_left_child()) then
- nullify(this%up%left)
- end if
- if (this%is_right_child()) then
- nullify(this%up%right)
- end if
- nullify(this%up)
- end subroutine fibonacci_node_rip
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_remove\_and\_keep\_twin}
-\begin{Verbatim}
- subroutine fibonacci_node_remove_and_keep_twin(this,twin)
- class(fibonacci_node_type),intent(inout),target :: this
- class(fibonacci_node_type),intent(out),pointer :: twin
- class(fibonacci_node_type),pointer :: pa
- if (.not. (this%is_root())) then
- pa=>this%up
- if (.not. pa%is_root()) then
- if (this%is_left_child()) then
- twin => pa%right
- else
- twin => pa%left
- end if
- if (pa%is_left_child()) then
- pa%up%left => twin
- else
- pa%up%right => twin
- end if
- end if
- twin%up => pa%up
- if(associated(this%right))then
- this%right%left=>this%left
- end if
- if(associated(this%left))then
- this%left%right=>this%right
- end if
- nullify(this%left)
- nullify(this%right)
- nullify(this%up)
- deallocate(pa)
- end if
- end subroutine fibonacci_node_remove_and_keep_twin
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_remove\_and\_keep\_parent}
-\begin{Verbatim}
- subroutine fibonacci_node_remove_and_keep_parent(this,pa)
- class(fibonacci_node_type),intent(inout),target :: this
- class(fibonacci_node_type),intent(out),pointer :: pa
- class(fibonacci_node_type),pointer :: twin
- if (.not. (this%is_root())) then
- pa=>this%up
- if (this%is_left_child()) then
- twin => pa%right
- else
- twin => pa%left
- end if
- twin%up=>pa%up
- if (associated(twin%left)) then
- twin%left%up => pa
- end if
- if (associated(twin%right)) then
- twin%right%up => pa
- end if
- call pa%copy_node(twin)
- select type(pa)
- class is (fibonacci_root_type)
- call pa%set_leftmost()
- call pa%set_rightmost()
- end select
- if(associated(this%right))then
- this%right%left=>this%left
- end if
- if(associated(this%left))then
- this%left%right=>this%right
- end if
- nullify(this%left)
- nullify(this%right)
- nullify(this%up)
- deallocate(twin)
- else
- pa=>this
- end if
- end subroutine fibonacci_node_remove_and_keep_parent
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_pick}
-\begin{Verbatim}
- subroutine fibonacci_leave_pick(this)
- class(fibonacci_leave_type),target,intent(inout) :: this
- class(fibonacci_node_type),pointer :: other
- class(fibonacci_root_type),pointer :: root
-! call this%up%print_parents()
- call this%find_root(root)
- if(associated(this%up,root))then
- if(this%up%depth<2)then
- print *,"fibonacci_leave_pick: Cannot pick leave. &
- &Tree must have at least three leaves."
- return
- else
- call this%remove_and_keep_parent(other)
- call other%repair()
- end if
- else
- call this%remove_and_keep_twin(other)
- call other%up%repair()
- end if
- if(associated(root%leftmost,this))call root%set_leftmost()
- if(associated(root%rightmost,this))call root%set_rightmost()
- end subroutine fibonacci_leave_pick
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_append\_left}
-\begin{Verbatim}
- subroutine fibonacci_node_append_left(this,new_branch)
- class(fibonacci_node_type),target :: this
- class(fibonacci_node_type),target :: new_branch
- this%left => new_branch
- new_branch%up => this
- end subroutine fibonacci_node_append_left
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_append\_right}
-\begin{Verbatim}
- subroutine fibonacci_node_append_right(this,new_branch)
- class(fibonacci_node_type),intent(inout),target :: this
- class(fibonacci_node_type),target :: new_branch
- this%right => new_branch
- new_branch%up => this
- end subroutine fibonacci_node_append_right
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_rotate\_left}
-\begin{Verbatim}
- subroutine fibonacci_node_rotate_left(this)
- class(fibonacci_node_type),intent(inout),target :: this
- call this%swap(this%right)
- call this%right%flip()
- call this%right%update_depth_unsave()
- call this%flip()
-! value = this%value
-! this%value = this%left%value
-! this%left%value = value
- end subroutine fibonacci_node_rotate_left
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_rotate\_right}
-\begin{Verbatim}
- subroutine fibonacci_node_rotate_right(this)
- class(fibonacci_node_type),intent(inout),target :: this
- call this%left%swap(this)
- call this%left%flip()
- call this%left%update_depth_unsave()
- call this%flip()
-! value = this%value
-! this%value = this%right%value
-! this%right%value = value
- end subroutine fibonacci_node_rotate_right
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_rotate}
-\begin{Verbatim}
- subroutine fibonacci_node_rotate(this)
- class(fibonacci_node_type),intent(inout),target :: this
- if (this%is_left_short()) then
- call this%rotate_left()
- else
- if (this%is_right_short()) then
- call this%rotate_right()
- end if
- end if
- end subroutine fibonacci_node_rotate
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_balance\_node}
-\begin{Verbatim}
- subroutine fibonacci_node_balance_node(this,changed)
- class(fibonacci_node_type),intent(inout),target :: this
- logical,intent(out) :: changed
- changed=.false.
- if (this%is_left_too_short()) then
- if (this%right%is_right_short()) then
- call this%right%rotate_right
- end if
- call this%rotate_left()
- changed=.true.
- else
- if (this%is_right_too_short()) then
- if (this%left%is_left_short()) then
- call this%left%rotate_left
- end if
- call this%rotate_right()
- changed=.true.
- end if
- end if
- end subroutine fibonacci_node_balance_node
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_update\_depth\_unsave}
-\begin{Verbatim}
- subroutine fibonacci_node_update_depth_unsave(this)
- class(fibonacci_node_type),intent(inout) :: this
- this%depth=max(this%left%depth+1,this%right%depth+1)
- end subroutine fibonacci_node_update_depth_unsave
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_update\_depth\_save}
-\begin{Verbatim}
- subroutine fibonacci_node_update_depth_save(this,updated)
- class(fibonacci_node_type),intent(inout) :: this
- logical,intent(out) :: updated
- integer :: left,right,new_depth
- if (associated(this%left)) then
- left=this%left%depth+1
- else
- left=-1
- end if
- if (associated(this%right)) then
- right=this%right%depth+1
- else
- right=-1
- end if
- new_depth=max(left,right)
- if (this%depth == new_depth) then
- updated = .false.
- else
- this%depth=new_depth
- updated = .true.
- end if
- end subroutine fibonacci_node_update_depth_save
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_repair}
-\begin{Verbatim}
- subroutine fibonacci_node_repair(this)
- class(fibonacci_node_type),intent(inout),target :: this
- class(fibonacci_node_type),pointer:: node
- logical :: new_depth,new_balance
- new_depth = .true.
- node=>this
- do while((new_depth .or. new_balance) .and. (associated(node)))
- call node%balance_node(new_balance)
- call node%update_depth_save(new_depth)
- node=>node%up
- end do
- end subroutine fibonacci_node_repair
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_left\_short}
-\begin{Verbatim}
- elemental logical function fibonacci_node_is_left_short(this)
- class(fibonacci_node_type),intent(in) :: this
- fibonacci_node_is_left_short = (this%left%depth<this%right%depth)
- end function fibonacci_node_is_left_short
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_right\_short}
-\begin{Verbatim}
- elemental logical function fibonacci_node_is_right_short(this)
- class(fibonacci_node_type),intent(in) :: this
- fibonacci_node_is_right_short = (this%right%depth<this%left%depth)
- end function fibonacci_node_is_right_short
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_unbalanced}
-\begin{Verbatim}
- elemental logical function fibonacci_node_is_unbalanced(this)
- class(fibonacci_node_type),intent(in) :: this
- fibonacci_node_is_unbalanced = (this%is_left_short() .or. this%is_right_short())
- end function fibonacci_node_is_unbalanced
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_left\_too\_short}
-\begin{Verbatim}
- elemental logical function fibonacci_node_is_left_too_short(this)
- class(fibonacci_node_type),intent(in) :: this
- fibonacci_node_is_left_too_short = (this%left%depth+1<this%right%depth)
- end function fibonacci_node_is_left_too_short
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_right\_too\_short}
-\begin{Verbatim}
- elemental logical function fibonacci_node_is_right_too_short(this)
- class(fibonacci_node_type),intent(in) :: this
- fibonacci_node_is_right_too_short = (this%right%depth+1<this%left%depth)
- end function fibonacci_node_is_right_too_short
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_too\_unbalanced}
-\begin{Verbatim}
- elemental logical function fibonacci_node_is_too_unbalanced(this)
- class(fibonacci_node_type),intent(in) :: this
- fibonacci_node_is_too_unbalanced = (this%is_left_too_short() .or. this%is_right_too_short())
- end function fibonacci_node_is_too_unbalanced
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_left\_child}
-\begin{Verbatim}
- elemental logical function fibonacci_node_is_left_child(this)
- class(fibonacci_node_type),intent(in),target :: this
- fibonacci_node_is_left_child = associated(this%up%left,this)
- end function fibonacci_node_is_left_child
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_is\_right\_child}
-\begin{Verbatim}
- elemental logical function fibonacci_node_is_right_child(this)
- class(fibonacci_node_type),intent(in),target :: this
- fibonacci_node_is_right_child = associated(this%up%right,this)
- end function fibonacci_node_is_right_child
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_apply\_to\_leaves}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_apply_to_leaves(node,func,unit)
- class(fibonacci_node_type),intent(in),target :: node
- interface
- subroutine func(this,unit)
- import fibonacci_leave_type
- class(fibonacci_leave_type),intent(in),target :: this
- integer,intent(in),optional :: unit
- end subroutine func
- end interface
- integer,intent(in),optional :: unit
- select type (node)
- class is (fibonacci_leave_type)
- call func(node,unit)
- class default
- call node%left%apply_to_leaves(func,unit)
- call node%right%apply_to_leaves(func,unit)
- end select
- end subroutine fibonacci_node_apply_to_leaves
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_apply\_to\_leaves\_rl}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_apply_to_leaves_RL(node,func,unit)
- class(fibonacci_node_type),intent(in),target :: node
- interface
- subroutine func(this,unit)
- import fibonacci_leave_type
- class(fibonacci_leave_type),intent(in),target :: this
- integer,intent(in),optional :: unit
- end subroutine func
- end interface
- integer,intent(in),optional :: unit
- select type (node)
- class is (fibonacci_leave_type)
- call func(node,unit)
- class default
- call node%right%apply_to_leaves_rl(func,unit)
- call node%left%apply_to_leaves_rl(func,unit)
- end select
- end subroutine fibonacci_node_apply_to_leaves_RL
-\end{Verbatim}
-
-\TbpImp{fibonacci\_node\_count\_leaves}
-\begin{Verbatim}
- recursive subroutine fibonacci_node_count_leaves(this,n)
- class(fibonacci_node_type),intent(in) :: this
- integer,intent(out) :: n
- integer::n1,n2
- if(associated(this%left).and.associated(this%right)) then
- call fibonacci_node_count_leaves(this%left,n1)
- call fibonacci_node_count_leaves(this%right,n2)
- n=n1+n2
- else
- n=1
- end if
- end subroutine fibonacci_node_count_leaves
-\end{Verbatim}
-
-\MethodsFor{fibonacci\_root\_type}
-\TbpImp{fibonacci\_root\_write\_to\_marker}
-\begin{Verbatim}
- SUBROUTINE fibonacci_root_write_to_marker(this,marker,status)
- CLASS(fibonacci_root_type), INTENT(IN) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
-! call marker%mark_begin("FIBONACCI_ROOT_TYPE")
- call fibonacci_node_write_to_marker(this,marker,status)
-! marker%mark_end("FIBONACCI_ROOT_TYPE")
- end SUBROUTINE fibonacci_root_write_to_marker
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_read\_target\_from\_marker}
-\begin{Verbatim}
- SUBROUTINE fibonacci_root_read_target_from_marker(this,marker,status)
- CLASS(fibonacci_root_type),target,INTENT(out) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
-! call marker%pick_begin("FIBONACCI_ROOT_TYPE",status)
- call fibonacci_node_read_from_marker(this,marker,status)
- call this%find_leftmost(this%leftmost)
- call this%find_rightmost(this%rightmost)
-! call marker%pick_end("FIBONACCI_ROOT_TYPE",status)
- end SUBROUTINE fibonacci_root_read_target_from_marker
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_print\_to\_unit}
-\begin{Verbatim}
- subroutine fibonacci_root_print_to_unit(this,unit,parents,components,peers)
- class(fibonacci_root_type),intent(in)::this
- integer,intent(in)::unit
- integer(kind=dik),intent(in)::parents,components,peers
- class(serializable_class),pointer::ser
- if(parents>0)call fibonacci_node_print_to_unit(this,unit,parents-1,components,peers)
- write(unit,'("Components of fibonacci_root_type:")')
- ser=>this%leftmost
- call serialize_print_peer_pointer(ser,unit,parents,components,min(peers,one),"Leftmost: ")
- ser=>this%rightmost
- call serialize_print_peer_pointer(ser,unit,parents,components,min(peers,one),"Rightmost:")
- end subroutine fibonacci_root_print_to_unit
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_get\_type}
-\begin{Verbatim}
- pure subroutine fibonacci_root_get_type(type)
- character(:),allocatable,intent(out)::type
- allocate(type,source="fibonacci_root_type")
- end subroutine fibonacci_root_get_type
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_get\_leftmost}
-\begin{Verbatim}
- subroutine fibonacci_root_get_leftmost(this,leftmost)
- class(fibonacci_root_type),intent(in)::this
- class(fibonacci_leave_type),pointer::leftmost
- leftmost=>this%leftmost
- end subroutine fibonacci_root_get_leftmost
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_get\_rightmost}
-\begin{Verbatim}
- subroutine fibonacci_root_get_rightmost(this,rightmost)
- class(fibonacci_root_type),intent(in)::this
- class(fibonacci_leave_type),pointer::rightmost
- rightmost=>this%rightmost
- end subroutine fibonacci_root_get_rightmost
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_is\_inner}
-\begin{Verbatim}
- elemental function fibonacci_root_is_inner()
- logical::fibonacci_root_is_inner
- fibonacci_root_is_inner=.false.
- end function fibonacci_root_is_inner
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_is\_root}
-\begin{Verbatim}
- elemental function fibonacci_root_is_root()
- logical::fibonacci_root_is_root
- fibonacci_root_is_root=.true.
- end function fibonacci_root_is_root
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_is\_valid}
-\begin{Verbatim}
- elemental function fibonacci_root_is_valid(this)
- class(fibonacci_root_type),intent(in) :: this
- logical :: fibonacci_root_is_valid
- fibonacci_root_is_valid=this%is_valid_c
- end function fibonacci_root_is_valid
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_count\_leaves}
-\begin{Verbatim}
- subroutine fibonacci_root_count_leaves(this,n)
- class(fibonacci_root_type),intent(in) :: this
- integer,intent(out) :: n
- n=0
- call fibonacci_node_count_leaves(this,n)
- end subroutine fibonacci_root_count_leaves
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_write\_pstricks}
-\begin{Verbatim}
- subroutine fibonacci_root_write_pstricks(this,unitnr)
- class(fibonacci_root_type),intent(in),target :: this
- integer,intent(in) :: unitnr
- logical :: is_opened
- character :: is_sequential,is_formatted,is_writeable
- print *,"pstricks"
- inquire(unitnr,opened=is_opened,&
- &sequential=is_sequential,formatted=is_formatted,write=is_writeable)
- if (is_opened) then
- if (is_sequential=="Y" .and. is_formatted=="Y" .and. is_writeable=="Y") then
- write(unitnr,'("{\textbackslash}begin{psTree}{{\textbackslash}Toval[linecolor=blue]{{\textbackslash}node{",i3,"}{",f9.3,"}}}")')&
- this%depth,this%measure()
- if (associated(this%leftmost)) then
- call this%leftmost%write_pstricks(unitnr)
- else
- write(unitnr,'("{\textbackslash}Tr[",a,"]{}")') no_kid
- end if
- if (associated(this%left)) then
- call this%left%write_pstricks(unitnr)
- else
- write(unitnr,'("{\textbackslash}Tr[",a,"]{}")') no_kid
- end if
- if (associated(this%right)) then
- call this%right%write_pstricks(unitnr)
- else
- write(unitnr,'("{\textbackslash}Tr[",a,"]{}")') no_kid
- end if
- if (associated(this%rightmost)) then
- call this%rightmost%write_pstricks(unitnr)
- else
- write(unitnr,'("{\textbackslash}Tr[",a,"]{}")') no_kid
- end if
- write(unitnr,'("{\textbackslash}end{psTree}")')
- write(unitnr,'("\textbackslash\textbackslash")')
- else
- print '("fibonacci_node_write_pstricks: Unit ",I2," is not opened properly.")',unitnr
- print '("No output is written to unit.")'
- end if
- else
- print '("fibonacci_node_write_pstricks: Unit ",I2," is not opened.")',unitnr
- print '("No output is written to unit.")'
- end if
- end subroutine fibonacci_root_write_pstricks
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_copy\_root}
-\begin{Verbatim}
- subroutine fibonacci_root_copy_root(this,primitive)
- class(fibonacci_root_type),intent(out) :: this
- class(fibonacci_root_type),intent(in) :: primitive
- call fibonacci_node_copy_node(this,primitive)
- this%leftmost => primitive%leftmost
- this%rightmost => primitive%rightmost
- end subroutine fibonacci_root_copy_root
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_push\_by\_content}
-\begin{Verbatim}
- subroutine fibonacci_root_push_by_content(this,content)
- class(fibonacci_root_type),target,intent(inout) :: this
- class(measurable_class),target,intent(in)::content
- class(fibonacci_leave_type),pointer :: node
-! print *,"fibonacci_root_push_by_content: ",content%measure()
- allocate(node)
- node%down=>content
- call this%push_by_leave(node)
- end subroutine fibonacci_root_push_by_content
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_push\_by\_leave}
-\begin{Verbatim}
- ! this is a workaround for BUG 44696. This subroutine is a merge of
- ! fibonacci_tree_push_by_node
- ! fibonacci_node_find
- ! fibonacci_leave_insert_leave_by_node
- subroutine fibonacci_root_push_by_leave(this,new_leave)
- class(fibonacci_root_type),target,intent(inout) :: this
- class(fibonacci_leave_type),pointer,intent(inout) :: new_leave
- class(fibonacci_leave_type),pointer :: old_leave
- class(fibonacci_node_type), pointer :: node,new_node,leave_c
- if (new_leave<=this%leftmost) then
- old_leave=>this%leftmost
- this%leftmost=>new_leave
- node=>old_leave%up
- call fibonacci_node_spawn&
- (new_node,new_leave,old_leave,old_leave%left,old_leave%right)
- call node%append_left(new_node)
- else
- if (new_leave>this%rightmost) then
- old_leave=>this%rightmost
- this%rightmost=>new_leave
- node=>old_leave%up
- call fibonacci_node_spawn&
- (new_node,old_leave,new_leave,old_leave%left,old_leave%right)
- call node%append_right(new_node)
- else
- node=>this
- do
- if (new_leave<=node) then
- leave_c=>node%left
- select type (leave_c)
- class is (fibonacci_leave_type)
- if(new_leave<=leave_c)then
- call fibonacci_node_spawn&
- (new_node,new_leave,leave_c,leave_c%left,leave_c%right)
- else
- call fibonacci_node_spawn&
- (new_node,leave_c,new_leave,leave_c%left,leave_c%right)
- end if
- call node%append_left(new_node)
- exit
- class default
- node=>node%left
- end select
- else
- leave_c=>node%right
- select type (leave_c)
- class is (fibonacci_leave_type)
- if(new_leave<=leave_c)then
- call fibonacci_node_spawn&
- (new_node,new_leave,leave_c,leave_c%left,leave_c%right)
- else
- call fibonacci_node_spawn&
- (new_node,leave_c,new_leave,leave_c%left,leave_c%right)
- end if
- call node%append_right(new_node)
- exit
- class default
- node=>node%right
- end select
- end if
- end do
- end if
- end if
- call node%repair()
- end subroutine fibonacci_root_push_by_leave
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_pop\_left}
-\begin{Verbatim}
- subroutine fibonacci_root_pop_left(this,leave)
- class(fibonacci_root_type),intent(inout),target :: this
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- class(fibonacci_node_type),pointer :: parent,grand
- !write(11,fmt=*)"fibonacci root pop left\\"!PSTRICKS
- !flush(11)!PSTRICKS
- leave => this%leftmost
- if (this%left%depth>=1) then
- parent => leave%up
- grand=>parent%up
- grand%left => parent%right
- parent%right%up=>grand
- deallocate(parent)
- parent=>grand%left
- if (.not.parent%is_leave())then
- parent=>parent%left
- end if
- select type (parent)
- class is (fibonacci_leave_type)
- this%leftmost => parent
- class default
- print *,"fibonacci_root_pop_left: ERROR: leftmost is no leave."
- call parent%print_all()
- STOP
- end select
- !call this%write_pstricks(11)!PSTRICKS
- !flush(11)!PSTRICKS
- !write(11,fmt=*)"fibonacci node repair\\"!PSTRICKS
- !flush(11)!PSTRICKS
- call grand%repair()
- else
- if (this%left%depth==0.and.this%right%depth==1) then
- parent => this%right
- parent%right%up=>this
- parent%left%up=>this
- this%left=>parent%left
- this%right=>parent%right
- this%depth=1
- deallocate(parent)
- parent=>this%left
- select type (parent)
- class is (fibonacci_leave_type)
- this%leftmost => parent
- end select
- this%down=>this%leftmost%down
- end if
- end if
- nullify(leave%right%left)
- nullify(leave%up)
- nullify(leave%right)
- nullify(this%leftmost%left)
- !call this%write_pstricks(11)!PSTRICKS
- !flush(11)!PSTRICKS
- end subroutine fibonacci_root_pop_left
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_pop\_right}
-\begin{Verbatim}
- subroutine fibonacci_root_pop_right(this,leave)
- class(fibonacci_root_type),intent(inout),target :: this
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- class(fibonacci_node_type),pointer :: parent,grand
- leave => this%rightmost
- if (this%right%depth>=1) then
- parent => leave%up
- grand=>parent%up
- grand%right => parent%left
- parent%left%up=>grand
- deallocate(parent)
- parent=>grand%right
- if (.not.parent%is_leave())then
- parent=>parent%right
- end if
- select type (parent)
- class is (fibonacci_leave_type)
- this%rightmost => parent
- class default
- print *,"fibonacci_root_pop_left: ERROR: leftmost is no leave."
- call parent%print_all()
- STOP
- end select
- call grand%repair()
- else
- if (this%right%depth==0.and.this%left%depth==1) then
- parent => this%left
- parent%left%up=>this
- parent%right%up=>this
- this%right=>parent%right
- this%left=>parent%left
- this%depth=1
- deallocate(parent)
- parent=>this%right
- select type (parent)
- class is (fibonacci_leave_type)
- this%rightmost => parent
- end select
- this%down=>this%rightmost%down
- end if
- end if
- end subroutine fibonacci_root_pop_right
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_merge}
-\begin{Verbatim}
- subroutine fibonacci_root_merge(this_tree,that_tree,merge_tree)
- ! I neither used nor revised this procedure for a long time, so it might be broken.
- class(fibonacci_root_type),intent(in) :: this_tree
- class(fibonacci_root_type),intent(in) :: that_tree
- class(fibonacci_root_type),pointer,intent(out) :: merge_tree
- class(fibonacci_leave_type),pointer :: this_leave,that_leave,old_leave
- type(fibonacci_leave_list_type),target :: leave_list
- class(fibonacci_leave_list_type),pointer :: last_leave
- integer :: n_leaves
- if (associated(this_tree%leftmost).and.associated(that_tree%leftmost)) then
- n_leaves=1
- this_leave=>this_tree%leftmost
- that_leave=>that_tree%leftmost
- if (this_leave < that_leave) then
- allocate(leave_list%leave,source=this_leave)
- call this_leave%find_right_leave(this_leave)
- else
- allocate(leave_list%leave,source=that_leave)
- call that_leave%find_right_leave(that_leave)
- end if
- last_leave=>leave_list
- do while (associated(this_leave).and.associated(that_leave))
- if (this_leave < that_leave) then
- old_leave=>this_leave
- call this_leave%find_right_leave(this_leave)
- else
- old_leave=>that_leave
- call that_leave%find_right_leave(that_leave)
- end if
- allocate(last_leave%next)
- last_leave=>last_leave%next
- allocate(last_leave%leave,source=old_leave)
- n_leaves=n_leaves+1
- end do
- if (associated(this_leave)) then
- old_leave=>this_leave
- else
- old_leave=>that_leave
- end if
- do while (associated(old_leave))
- allocate(last_leave%next)
- last_leave=>last_leave%next
- allocate(last_leave%leave,source=old_leave)
- n_leaves=n_leaves+1
- call old_leave%find_right_leave(old_leave)
- end do
- allocate(merge_tree)
- call fibonacci_root_list_to_tree(merge_tree,n_leaves,leave_list)
- else
- n_leaves=0
- end if
- if(associated(leave_list%next)) then
- last_leave=>leave_list%next
- do while (associated(last_leave%next))
- leave_list%next=>last_leave%next
- deallocate(last_leave)
- last_leave=>leave_list%next
- end do
- deallocate(last_leave)
- end if
- end subroutine fibonacci_root_merge
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_set\_leftmost}
-\begin{Verbatim}
- subroutine fibonacci_root_set_leftmost(this)
- class(fibonacci_root_type) :: this
- call this%find_leftmost(this%leftmost)
- end subroutine fibonacci_root_set_leftmost
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_set\_rightmost}
-\begin{Verbatim}
- subroutine fibonacci_root_set_rightmost(this)
- class(fibonacci_root_type) :: this
- call this%find_rightmost(this%rightmost)
- end subroutine fibonacci_root_set_rightmost
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_init\_by\_leave}
-\begin{Verbatim}
- subroutine fibonacci_root_init_by_leave(this,left_leave,right_leave)
- class(fibonacci_root_type),target,intent(out) :: this
- class(fibonacci_leave_type),target,intent(in) :: left_leave,right_leave
- if (left_leave <= right_leave) then
- this%left => left_leave
- this%right => right_leave
- this%leftmost => left_leave
- this%rightmost => right_leave
- else
- this%left => right_leave
- this%right => left_leave
- this%leftmost => right_leave
- this%rightmost => left_leave
- end if
- this%left%up => this
- this%right%up => this
- this%down=>this%leftmost%down
- this%depth = 1
- this%leftmost%right=>this%rightmost
- this%rightmost%left=>this%leftmost
- this%is_valid_c=.true.
- end subroutine fibonacci_root_init_by_leave
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_init\_by\_content}
-\begin{Verbatim}
- subroutine fibonacci_root_init_by_content(this,left_content,right_content)
- class(fibonacci_root_type),target,intent(out) :: this
- class(measurable_class),intent(in),target :: left_content,right_content
- call fibonacci_root_reset(this)
- print *,"fibonacci_root_init_by_content: ",left_content%measure(),right_content%measure()
- if (left_content<right_content) then
- call this%leftmost%set_content(left_content)
- call this%rightmost%set_content(right_content)
- else
- call this%leftmost%set_content(right_content)
- call this%rightmost%set_content(left_content)
- end if
- this%down=>this%leftmost%down
- this%is_valid_c=.true.
- end subroutine fibonacci_root_init_by_content
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_reset}
-\begin{Verbatim}
- subroutine fibonacci_root_reset(this)
- class(fibonacci_root_type),target,intent(inout) :: this
- call fibonacci_root_deallocate_tree(this)
- allocate (this%leftmost)
- allocate (this%rightmost)
- this%depth=1
- this%leftmost%depth=0
- this%rightmost%depth=0
- this%left=>this%leftmost
- this%right=>this%rightmost
- this%left%up=>this
- this%right%up=>this
- this%leftmost%right=>this%rightmost
- this%rightmost%left=>this%leftmost
- end subroutine fibonacci_root_reset
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_deallocate\_tree}
-\begin{Verbatim}
- recursive subroutine fibonacci_root_deallocate_tree(this)
- class(fibonacci_root_type),intent(inout) :: this
- call fibonacci_node_deallocate_tree(this)
- nullify(this%leftmost)
- nullify(this%rightmost)
- end subroutine fibonacci_root_deallocate_tree
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_deallocate\_all}
-\begin{Verbatim}
- recursive subroutine fibonacci_root_deallocate_all(this)
- class(fibonacci_root_type),intent(inout) :: this
- call fibonacci_node_deallocate_all(this)
- nullify(this%leftmost)
- nullify(this%rightmost)
- end subroutine fibonacci_root_deallocate_all
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_is\_left\_child}
-\begin{Verbatim}
- elemental logical function fibonacci_root_is_left_child(this)
- class(fibonacci_root_type),target,intent(in) :: this
- fibonacci_root_is_left_child = .false.
- end function fibonacci_root_is_left_child
-\end{Verbatim}
-
-\TbpImp{fibonacci\_root\_is\_right\_child}
-\begin{Verbatim}
- elemental logical function fibonacci_root_is_right_child(this)
- class(fibonacci_root_type),target,intent(in) :: this
- fibonacci_root_is_right_child = .false.
- end function fibonacci_root_is_right_child
-\end{Verbatim}
-
-\MethodsFor{fibonacci\_stub\_type}
-\TbpImp{fibonacci\_stub\_get\_type}
-\begin{Verbatim}
- pure subroutine fibonacci_stub_get_type(type)
- character(:),allocatable,intent(out)::type
- allocate(type,source="fibonacci_stub_type")
- end subroutine fibonacci_stub_get_type
-\end{Verbatim}
-
-\TbpImp{fibonacci\_stub\_push\_by\_content}
-\begin{Verbatim}
- subroutine fibonacci_stub_push_by_content(this,content)
- class(fibonacci_stub_type),target,intent(inout) :: this
- class(measurable_class),target,intent(in)::content
- class(fibonacci_leave_type),pointer::leave
- allocate(leave)
- call leave%set_content(content)
- call this%push_by_leave(leave)
- end subroutine fibonacci_stub_push_by_content
-\end{Verbatim}
-
-\TbpImp{fibonacci\_stub\_push\_by\_leave}
-\begin{Verbatim}
- subroutine fibonacci_stub_push_by_leave(this,new_leave)
- class(fibonacci_stub_type),target,intent(inout) :: this
- class(fibonacci_leave_type),pointer,intent(inout) :: new_leave
- class(fibonacci_leave_type),pointer::old_leave
- if(this%depth<1)then
- if(associated(this%leftmost))then
- old_leave=>this%leftmost
- call this%init_by_leave(old_leave,new_leave)
- else
- this%leftmost=>new_leave
- end if
- else
- call fibonacci_root_push_by_leave(this,new_leave)
- end if
- end subroutine fibonacci_stub_push_by_leave
-\end{Verbatim}
-
-\TbpImp{fibonacci\_stub\_pop\_left}
-\begin{Verbatim}
- subroutine fibonacci_stub_pop_left(this,leave)
- class(fibonacci_stub_type),intent(inout),target :: this
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- if(this%depth<2)then
- if(this%depth==1)then
- leave=>this%leftmost
- this%leftmost=>this%rightmost
- nullify(this%rightmost)
- nullify(this%right)
- nullify(this%left)
- this%depth=0
- this%is_valid_c=.false.
- else
- if(associated(this%leftmost))then
- leave=>this%leftmost
- nullify(this%leftmost)
- end if
- end if
- else
- call fibonacci_root_pop_left(this,leave)
- end if
- end subroutine fibonacci_stub_pop_left
-\end{Verbatim}
-
-\TbpImp{fibonacci\_stub\_pop\_right}
-\begin{Verbatim}
- subroutine fibonacci_stub_pop_right(this,leave)
- class(fibonacci_stub_type),intent(inout),target :: this
- class(fibonacci_leave_type),pointer,intent(out) :: leave
- if(this%depth<2)then
- if(this%depth==1)then
- this%is_valid_c=.false.
- if(associated(this%rightmost))then
- leave=>this%rightmost
- nullify(this%rightmost)
- nullify(this%right)
- else
- if(associated(this%leftmost))then
- leave=>this%leftmost
- nullify(this%leftmost)
- nullify(this%left)
- else
- nullify(leave)
- end if
- end if
- end if
- else
- call fibonacci_root_pop_right(this,leave)
- end if
- end subroutine fibonacci_stub_pop_right
-\end{Verbatim}
-
-\MethodsFor{fibonacci\_leave\_type}
-
-\TbpImp{fibonacci\_leave\_get\_type}
-\begin{Verbatim}
- pure subroutine fibonacci_leave_get_type(type)
- character(:),allocatable,intent(out)::type
- allocate(type,source="fibonacci_leave_type")
- end subroutine fibonacci_leave_get_type
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_print\_to\_unit}
-\begin{Verbatim}
- subroutine fibonacci_leave_print_to_unit(this,unit,parents,components,peers)
- class(fibonacci_leave_type),intent(in)::this
- integer,intent(in)::unit
- integer(kind=dik),intent(in)::parents,components,peers
- class(serializable_class),pointer::ser
- if(parents>0)call fibonacci_node_print_to_unit(this,unit,parents-one,components,-one)
- write(unit,'("Components of fibonacci_leave_type:")')
- ser=>this%down
- call serialize_print_comp_pointer(ser,unit,parents,components,peers,"Content:")
- end subroutine fibonacci_leave_print_to_unit
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_get\_left}
-\begin{Verbatim}
- subroutine fibonacci_leave_get_left(this,leave)
- class(fibonacci_leave_type),intent(in) :: this
- class(fibonacci_leave_type),intent(out),pointer :: leave
- class(fibonacci_node_type),pointer::node
- node=>this%left
- select type(node)
- class is (fibonacci_leave_type)
- leave=>node
- end select
- end subroutine fibonacci_leave_get_left
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_get\_right}
-\begin{Verbatim}
- subroutine fibonacci_leave_get_right(this,leave)
- class(fibonacci_leave_type),intent(in) :: this
- class(fibonacci_leave_type),intent(out),pointer :: leave
- class(fibonacci_node_type),pointer::node
-! print *,"fibonacci_leave_get_right"
-! call this%down%print_little
- if(associated(this%right))then
- node=>this%right
-! call node%down%print_little
- select type(node)
- class is (fibonacci_leave_type)
- leave=>node
- end select
- else
-! print *,"no right leave"
- nullify(leave)
- end if
- end subroutine fibonacci_leave_get_right
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_deallocate\_all}
-\begin{Verbatim}
- subroutine fibonacci_leave_deallocate_all(this)
- class(fibonacci_leave_type),intent(inout) :: this
- if (associated(this%down)) then
- deallocate(this%down)
- end if
- end subroutine fibonacci_leave_deallocate_all
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_write\_pstricks}
-\begin{Verbatim}
- subroutine fibonacci_leave_write_pstricks(this,unitnr)
- class(fibonacci_leave_type),intent(in),target :: this
- integer,intent(in) :: unitnr
- write(unitnr,'("{\textbackslash}begin{psTree}{{\textbackslash}Toval[linecolor=green]{{\textbackslash}node{",i3,"}{",f9.3,"}}}")')&
- this%depth,this%measure()
- if (associated(this%left)) then
- write(unitnr,'("{\textbackslash}Tr[",a,"]{}")') le_kid
- end if
- if (associated(this%right)) then
- write(unitnr,'("{\textbackslash}Tr[",a,"]{}")') le_kid
- end if
- write(unitnr,'("{\textbackslash}end{psTree}")')
- end subroutine fibonacci_leave_write_pstricks
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_insert\_leave\_by\_node}
-\begin{Verbatim}
- subroutine fibonacci_leave_insert_leave_by_node(this,new_leave)
- class(fibonacci_leave_type),target,intent(inout) :: this,new_leave
- class(fibonacci_node_type),pointer :: parent,new_node
- parent=>this%up
- !print *,associated(this%left),associated(this%right)
- if(this<new_leave)then
- call fibonacci_node_spawn(new_node,this,new_leave,this%left,this%right)
- !print *,"Repair! ",this%measure(),new_leave%measure()
- else
- call fibonacci_node_spawn(new_node,new_leave,this,this%left,this%right)
- end if
- if(associated(parent%left,this))then
- call parent%append_left(new_node)
- else
- call parent%append_right(new_node)
- end if
- call parent%repair()
- end subroutine fibonacci_leave_insert_leave_by_node
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_copy\_content}
-\begin{Verbatim}
- subroutine fibonacci_leave_copy_content(this,content)
- class(fibonacci_leave_type) :: this
- class(measurable_class),intent(in) :: content
- allocate(this%down,source=content)
- end subroutine fibonacci_leave_copy_content
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_set\_content}
-\begin{Verbatim}
- subroutine fibonacci_leave_set_content(this,content)
- class(fibonacci_leave_type) :: this
- class(measurable_class),target,intent(in) :: content
- this%down => content
- end subroutine fibonacci_leave_set_content
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_get\_content}
-\begin{Verbatim}
- subroutine fibonacci_leave_get_content(this,content)
- class(fibonacci_leave_type),intent(in) :: this
- class(measurable_class),pointer :: content
- content => this%down
- end subroutine fibonacci_leave_get_content
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_is\_inner}
-\begin{Verbatim}
- elemental logical function fibonacci_leave_is_inner()
- fibonacci_leave_is_inner = .false.
- end function fibonacci_leave_is_inner
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_is\_leave}
-\begin{Verbatim}
- elemental logical function fibonacci_leave_is_leave()
- fibonacci_leave_is_leave = .true.
- end function fibonacci_leave_is_leave
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_is\_left\_short}
-\begin{Verbatim}
- elemental logical function fibonacci_leave_is_left_short(this)
- class(fibonacci_leave_type),intent(in) :: this
- fibonacci_leave_is_left_short = .false.
- end function fibonacci_leave_is_left_short
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_is\_right\_short}
-\begin{Verbatim}
- elemental logical function fibonacci_leave_is_right_short(this)
- class(fibonacci_leave_type),intent(in) :: this
- fibonacci_leave_is_right_short = .false.
- end function fibonacci_leave_is_right_short
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_is\_unbalanced}
-\begin{Verbatim}
- elemental logical function fibonacci_leave_is_unbalanced(this)
- class(fibonacci_leave_type),intent(in) :: this
- fibonacci_leave_is_unbalanced = .false.
- end function fibonacci_leave_is_unbalanced
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_is\_left\_too\_short}
-\begin{Verbatim}
- elemental logical function fibonacci_leave_is_left_too_short(this)
- class(fibonacci_leave_type),intent(in) :: this
- fibonacci_leave_is_left_too_short = .false.
- end function fibonacci_leave_is_left_too_short
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_is\_right\_too\_short}
-\begin{Verbatim}
- elemental logical function fibonacci_leave_is_right_too_short(this)
- class(fibonacci_leave_type),intent(in) :: this
- fibonacci_leave_is_right_too_short = .false.
- end function fibonacci_leave_is_right_too_short
-\end{Verbatim}
-
-\TbpImp{fibonacci\_leave\_is\_too\_unbalanced}
-\begin{Verbatim}
- elemental logical function fibonacci_leave_is_too_unbalanced(this)
- class(fibonacci_leave_type),intent(in) :: this
- fibonacci_leave_is_too_unbalanced = .false.
- end function fibonacci_leave_is_too_unbalanced
-\end{Verbatim}
-\MethodsNTB
-
-\ProcImp{fibonacci\_leave\_write\_content}
-\begin{Verbatim}
- subroutine fibonacci_leave_write_content(this,unit)
- class(fibonacci_leave_type),intent(in),target :: this
- integer,optional,intent(in)::unit
- call this%down%print_all(unit)
- end subroutine fibonacci_leave_write_content
-\end{Verbatim}
-
-\ProcImp{fibonacci\_leave\_write}
-\begin{Verbatim}
- subroutine fibonacci_leave_write(this,unit)
- class(fibonacci_leave_type),intent(in),target :: this
- integer,optional,intent(in)::unit
- call this%print_all(unit)
- end subroutine fibonacci_leave_write
-\end{Verbatim}
-
-\ProcImp{fibonacci\_leave\_write\_value}
-\begin{Verbatim}
- subroutine fibonacci_leave_write_value(this,unit)
- class(fibonacci_leave_type),intent(in),target :: this
- integer,intent(in),optional::unit
- if(present(unit))then
- write(unit,fmt=*)this%measure()
- else
- print *,this%measure()
- end if
-! call this%print_little(unit)
- end subroutine fibonacci_leave_write_value
-\end{Verbatim}
-
-\ProcImp{fibonacci\_node\_spawn}
-\begin{Verbatim}
- subroutine fibonacci_node_spawn&
- (new_node,left_leave,right_leave,left_left_leave,right_right_leave)
- class(fibonacci_node_type),pointer,intent(out) :: new_node
- class(fibonacci_leave_type),target,intent(inout) :: left_leave,right_leave
- class(fibonacci_node_type),pointer,intent(inout) :: left_left_leave,right_right_leave
- allocate(new_node)
- new_node%depth=1
- if(associated(left_left_leave))then
- left_left_leave%right=>left_leave
- left_leave%left=>left_left_leave
- else
- nullify(left_leave%left)
- end if
- if(associated(right_right_leave))then
- right_right_leave%left=>right_leave
- right_leave%right=>right_right_leave
- else
- nullify(right_leave%right)
- end if
- new_node%left=>left_leave
- new_node%right=>right_leave
- new_node%down=>left_leave%down
- new_node%depth=1
- left_leave%up=>new_node
- right_leave%up=>new_node
- left_leave%right=>right_leave
- right_leave%left=>left_leave
- end subroutine fibonacci_node_spawn
-\end{Verbatim}
-
-\ProcImp{fibonacci\_root\_list\_to\_tree}
-\begin{Verbatim}
- subroutine fibonacci_root_list_to_tree(this,n_leaves,leave_list_target)
- class(fibonacci_root_type),target :: this
- integer,intent(in) :: n_leaves
- type(fibonacci_leave_list_type),target,intent(in) :: leave_list_target
-! class(fibonacci_root_type),pointer,intent(out) :: tree
- integer:: depth,n_deep,n_merge
- class(fibonacci_node_type),pointer :: node
- class(fibonacci_leave_list_type),pointer :: leave_list
- class(fibonacci_leave_type),pointer::content
- real(kind=double) :: up_value
- leave_list=>leave_list_target
- call ilog2(n_leaves,depth,n_deep)
- n_deep=n_deep*2
- n_merge=0
- this%depth=depth
- node=>this
- outer: do
- do while(depth>1)
- depth=depth-1
- allocate(node%left)
- node%left%up=>node
- node=>node%left
- node%depth=depth
- end do
- node%left=>leave_list%leave
- node%down=>leave_list%leave%down
- leave_list=>leave_list%next
- node%right=>leave_list%leave
- content => leave_list%leave
- leave_list=>leave_list%next
- n_merge=n_merge+2
- inner: do
- if (associated(node%up)) then
- if (node%is_left_child()) then
- if (n_merge==n_deep.and.depth==1) then
- node=>node%up
- node%right=>leave_list%leave
- node%right%up=>node
- node%down=>content%down
- content=>leave_list%leave
- leave_list=>leave_list%next
- n_merge=n_merge+1
- cycle
- end if
- exit inner
- else
- node=>node%up
- depth=depth+1
- end if
- else
- exit outer
- end if
- end do inner
- node=>node%up
- node%down=>content%down
- allocate(node%right)
- node%right%up => node
- node=>node%right
- if (n_deep==n_merge) then
- depth=depth-1
- end if
- node%depth=depth
- end do outer
- call this%set_leftmost
- call this%set_rightmost
- end subroutine fibonacci_root_list_to_tree
-\end{Verbatim}
-
Index: trunk/src/muli/doc/uneben.pdf
===================================================================
--- trunk/src/muli/doc/uneben.pdf (revision 8371)
+++ trunk/src/muli/doc/uneben.pdf (revision 8372)
@@ -1,72 +0,0 @@
-%PDF-1.5
-%µí®û
-3 0 obj
-<< /Length 4 0 R
- /Filter /FlateDecode
->>
-stream
-xœeR;O1ìý+¶FbcïËv›)R
-Ò¢ÑEE¡àï3öÙD€N'ßܾfÆû”
-çß=}ù•éþ9eϏÊ,ôø ïßt÷?2ýNFßé #ëzÞY]›
-IYs¿ÄI¸4Û°pnAÞ8uìRÉ+‡£®Ñ\Q­QÚÐÙDv®±¹"W3÷6ÚEït!-ì¦Hªj¤Âa£{ÉBI•«·…Phܪ/¨Î=ú.‹9âlyPĜ°&^(E3ŸN²;yK6yÓÎ
-k–)Œ¥ø†=|tìëݦÌmú‹[9ÅƟê'*ÜK›”‡¨Lúˆ—Ô³¯oLùŸf+ ^eÑA<O•À
-{¦Nð.「]N¦§—æõ-ì\`û.…M0f5>†Ý|Ín¾*œ8Ù®Ì-ÐûÖëz±%~YVæC*ØW\a]N-Â֖8‘æ+|ùœÿçjm></ ®²8¡ ±vÖP‹žúÏt@ã¨A XP|4 ˜mùѹžw€åÉ1£u®aèìdE†-g#­kñ­O^jBÒçê¢TqH`QæG¿ƒD¸ÙŒB~;(i}¯oz÷^0¼¸M¯4½Ëg
-endstream
-endobj
-4 0 obj
- 469
-endobj
-2 0 obj
-<<
- /ExtGState <<
- /a0 << /CA 1 /ca 1 >>
- >>
->>
-endobj
-5 0 obj
-<< /Type /Page
- /Parent 1 0 R
- /MediaBox [ 0 0 67.514877 59.353832 ]
- /Contents 3 0 R
- /Group <<
- /Type /Group
- /S /Transparency
- /CS /DeviceRGB
- >>
- /Resources 2 0 R
->>
-endobj
-1 0 obj
-<< /Type /Pages
- /Kids [ 5 0 R ]
- /Count 1
->>
-endobj
-6 0 obj
-<< /Creator (cairo 1.10.2 (http://cairographics.org))
- /Producer (cairo 1.10.2 (http://cairographics.org))
->>
-endobj
-7 0 obj
-<< /Type /Catalog
- /Pages 1 0 R
->>
-endobj
-xref
-0 8
-0000000000 65535 f
-0000000867 00000 n
-0000000583 00000 n
-0000000015 00000 n
-0000000561 00000 n
-0000000655 00000 n
-0000000932 00000 n
-0000001059 00000 n
-trailer
-<< /Size 8
- /Root 7 0 R
- /Info 6 0 R
->>
-startxref
-1111
-%%EOF
Index: trunk/src/muli/doc/Allgemeines.tex
===================================================================
--- trunk/src/muli/doc/Allgemeines.tex (revision 8371)
+++ trunk/src/muli/doc/Allgemeines.tex (revision 8372)
@@ -1,263 +0,0 @@
-\part{Allgemeines}
-\begin{figure}
- \includegraphics[scale=0.75,angle=90]{uml-module-tree-1.mps}
-\end{figure}
-\chapter{Nomenklatur}
-\begin{figure}
- \includegraphics{diagrams-1.mps}
- \includegraphics{diagrams-2.mps}
- \caption{\label{fig:nomen:had}Links: Impulsvariablen $P_x$ der Remnants, Impulsvariablen $\hat{p}_x$ der Partonen und Flavorindizes $a^{(k)},b^{(k)},c^{(k)},d^{(k)}$ der Partonen in der $k$-ten Iteration des Multiple Interactions Algorithmus. Rechts: Die Prozeduren zur Generierung der Ereignisse kennen üblicherweise nicht die Ordnungszahl $k$ nur einen Teil der Impulsinformation, nämlich die hadronischen Impulsanteile $X$ mit $P^{(k)}=XP$ und die partonischen Impulsanteile $\xi$ mit $\hat{p}^{(k)}=\xi P^{(k)}=x P$. Anstatt der Flavorindizes $a^{(k)},b^{(k)},c^{(k)},d^{(k)}$ ist die festgelegte Position in dem Flavorquadrupel eingetragen.}
-\end{figure}
-\section{n-te Wechselwirkung}
-Durch den Algorithmus werden iterativ harte, partonische, treelevel, QCD $2\rightarrow 2$ Wechselwirkungen mit absteigenden Wechselwirkungsskalen $\pperp^{(n)}$ generiert. Variablen, die nach jeder harten Wechselwirkung einen neuen Wert erhalten, führen die Ordnungszahl $n$ der aktuellen Wechselwirkung hochgestellt in runden Klammern, um Verwechslungen mit Potenzen zu vermeiden.
-
-Diese Ordnungszahl wird mit $k$ bezeichnet, wenn sie sich nicht auf die aktuelle Wechselwirkung bezieht, sondern Summations- oder Produktindex über alle bisherigen Wechselwirkungen ist. Die Ordnungszahl der letzten Wechselwirkung wird mit $N$ notiert. Bevor eine harte Wechselwirkung stattfindet, ist die Ordnungszahl gleich Null und kann weggelassen werden.
-\section{Impulse}
-Die Viererimpulse der Remnants sind $P_1^{(n)}$ bzw. $P_2^{(n)}$ für das erste bzw. das zweite Proton. Die Viererimpulse der Partonen sind $\hat{p}_1^{(n)}$ bzw. $\hat{p}_2^{(n)}$ für das erste bzw. das zweite Proton. Die Viererimpulse der Teilchen im Endzustand der partonischen Wechselwirkung sind für MulI nicht von Bedeutung.
-
-Die Kinematik eines partonischen Ereignisses wird vollständig durch das kartesische Quadrupel $p_{\cart}^{(n)}=\left[x_1^{(n)},x_2^{(n)},\pperp^{(n)};s^{(n)}\right]$ bzw. das hyperbolische Quadrupel $p_{\hyp}^{(n)}=\left[h_1^{(n)},h_2^{(n)},h_3^{(n)};s^{(n)}\right]$ definiert. Die entsprechende Koordinatentransformation ist in \eqref{eq:all:imp:trafo} angegeben. Es wird nicht zwischen der Bjorken-Scaling-Variable $x$ und dem Impulsanteil mit $xP=\hat{p}$ unterschieden. Wir nehmen an, dass die kinetische Energie der Protonen viel größer als die Ruhemasse der Protonen ist. In diesem Grenzwert stimmen beide Variablen überein.
-\section{Flavor}
-Quarks und Gluonen der $n$-ten harten Wechselwirkung haben Flavorindizes $a^{(n)}, b^{(n)},c^{(n)},d^{(n)}$, wobei $a$ das Flavor des Partons aus dem Remnant 1 und $b$ das Flavor des Partons aus dem Remnant 2 ist. Wenn nicht anders angegeben, wird das LHAPDF-Schema verwendet, mit $[\overline{t},\overline{b},\overline{c},\overline{s},\overline{u},\overline{d},g,d,u,s,c,b,t]=[-6,-5,-4,-3,-2,-1,0,1,2,3,4,5,6]$.
-\section{Strukturfunktionen}
-\mip{Strukturfunktionen $f(x,\mu)$ sind in diesem Dokument synonym zu Flavor-Strukturfunktionen, die Impuls-Strukturfunktionen ergeben sich dann aus $xf(x,\mu)$. Im Gegensatz dazu liefert evolvePDF aus LHAPDF die Impulsstrukturfunktion. MulI hat diesbezüglich die gleiche Konvention wie die Builtin-PDFs aus WHIZARD, welche ebenfalls Flavor-PDFs liefern.}
-
-Da beide Remnants eine verscheidene Historie haben können, sind im Allgemeinen auch beide Remnant-Strukturfunktionen verschieden. Die Zugehörigkeit wird durch den Flavorindex $a$ für das erste und $b$ für das zweite Proton notiert. Wir verzichten auf die Indizierung der Flavorindizes, also $a^{(n)}\rightarrow a$, da die Strukturfunktionen bereits Ordnungsindizes ${(n)}$ haben. Wir erhalten $f_a^{(n)}\big(x_1^{(n)},\mu_F^{(n)}\big)$ für das erste Proton und $f_b^{(n)}\big(x_2^{(n)},\mu_F^{(n)}\big)$ für das zweite Proton.
-
-\wip{Derzeit sind im Modul \ModuleRef{muli\_remnant} Proton-Strukturfunktionen fest implementiert, es können also ohne Eingriff in den Code z.B. keine Proton-Antiproton Streuungen generiert werden. Allerdings sollte die Verallgemeinerung auf Hadronen mit maximal zwei verschiedenen Valenzquarks kaum Probleme bereiten, da die Infrastruktur des Moduls nicht geändert werden muss.}
-
-\section{Wirkungsquerschnitte}
-Wie die Strukturfunktionen ändern sich auch die Wirkungsquerschnitte $\sigma$ mit jeder Iteration. Allerdings können wir die Abhängigkeit komplett in die Änderung der invarianten Masse $s^{(n)}$ der $n$-ten Iteration absorbieren. Wir notieren also keinen Ordnungsindex $(n)$, sondern fügen die invariante Masse als Parameter durch ein Semikolon getrennt in die Liste der Argumente ein. Wir erhalten für den hadronischen Wirkungsquerschnitt ${\sigma}$
-\begin{equation}
- {\sigma}_{ab\rightarrow cd}^{(n)}\left(x_1^{(n)},x_2^{(n)},\pperp^{(n)}\right)
- ={\sigma}_{ab\rightarrow cd}\left(x_1^{(n)},x_2^{(n)},\pperp^{(n)};s^{(n)}\right).
-\end{equation}
-Der hadronische Wirkungsquerschnitt $\sigma$ bezieht sich auf das Streuereignis, wie in Abbildung \ref{fig:nomen:had} dargestellt. Der partonische Wirkungsquerschnitt hingegen ist $\widehat{\sigma}$.
-\section{Übersicht}
-\begin{align}
- s&=s^{(1)}=P_1\cdot P_2\\
- s^{(n)}&=P_1^{(n)}\cdot P_2^{(n)}\\
- \hat{p}_1^{(n)}&=P_1^{(n)}x_1^{(n)}\\
- P_1^{(n+1)}&=P_1^{(n)}\big(1-x_1^{(n)}\big)\\
- X^{(n)}&=\prod_{k=1}^{n}\left(1-x^{(k)}\right)\\
- P_1^{(n+1)}&=X_1^{(n)}P^{(1)}\\
- \pperp&=\frac{\hat{t}\hat{u}}{\hat{s}}
-\end{align}
-\chapter{Der Algorithmus}
-Der Algorithmus ist in meiner Dissertation in Kapitel 5 bereits dokumentiert, deswegen werde ich hier nicht alle Aspekte wiederholen. In der Dissertation wird allerdings nicht sorgfältig zwischen fertigen und geplanten Eigenschaften getrennt, deswegen gebe ich hier einen groben Überblick über den aktuellen Stand.
-
-MulI wird derzeit ausschließlich von dem shower\_interface aus dem interleaved Branch aus dem schmidtboschmann Verzeichnis des WHIZARD-Repositories aufgerufen. Es ist noch kein MulI-Code in den WHIZARD-Core übertragen worden, stattdessen sind alle relevanten Daten in einem erweiterten Datentyp \TypeRef{muli\_type} gekapselt. \TypeRef{muli\_type} stellt ebenfalls eine vollständige Schnittstelle bereit, um MPI zu generieren und Remnant-PDFs abzurufen. Die derzeit verwendeten Methoden dieser Schnittstelle sind in Tabelle \ref{tab:all:interface} aufgeführt.
-\begin{table}
-\begin{center}
-\begin{tabular}{ll}
-Generischer Name & Spezifischer Name\\
-\midrule
-\TbpRef{muli\_type}{initialize} & \ProcRef{muli\_initialize}\\
-\TbpRef{muli\_type}{restart} & \ProcRef{muli\_restart}\\
-\TbpRef{muli\_type}{finalize} & \ProcRef{muli\_finalize}\\
-\TbpRef{muli\_type}{apply\_initial\_interaction} & \ProcRef{muli\_apply\_initial\_interaction}\\
-\TbpRef{muli\_type}{generate\_gev2\_pt2} & \ProcRef{muli\_generate\_gev2\_pt2}\\
-\TbpRef{muli\_type}{generate\_partons} & \ProcRef{muli\_generate\_partons}\\
-\TbpRef{qcd\_2\_2\_type}{get\_color\_correlations} & \ProcRef{qcd\_2\_2\_get\_color\_correlations}\\
-\TbpRef{muli\_type}{replace\_parton} & \ProcRef{muli\_replace\_parton}\\
-\TbpRef{muli\_type}{get\_parton\_pdf} & \ProcRef{muli\_get\_parton\_pdf}\\
-\TbpRef{muli\_type}{get\_momentum\_pdf} & \ProcRef{muli\_get\_momentum\_pdf}
-\end{tabular}
-\caption{\label{tab:all:interface}Die Methoden der MulI Schnittstelle für den Interleaved-Algorithmus.}
-\end{center}
-\end{table}
-\begin{figure}
-\begin{center}
-\includegraphics{uml-1.mps}
-\end{center}
-\caption{Flussdiagramm des Interleaved-Algorithmus. Eingetragen sind ausschließlich die Aufrufe der MulI-Schnittstelle, mit Ausnahme von get\_parton\_pdf und get\_momentum\_pdf, da diese nur für Interna des Partonshowers relevant sind und das Diagramm unnötig kompliziert machen würden. Die Generierung der Showerskalen und -Teilchen ist hier nicht dargestellt. Parallel zu generate\_gev2\_pt2 wird von dem ISR-Modul eine Showerskala $t$ generiert und unmittelbar vor replace\_parton wird von dem ISR-Modul ein neues Showerteilchen generiert, dass durch replace\_parton in die Beschreibung des Remnants aufgenommen wird. $m_E$ ist die Zahl der zu generierenden Events.}
-\end{figure}
-\section{Stratified Sampling}
-\label{sec:all:alg:stra}
-Die Wahrscheinlichkeit dafür, dass die Wechselwirkung aus dem Stratum $\{\alpha,\beta\}$ mit der größten Skala $\pperp\leq\pperp^{(n-1)}$ bei der Skala $\pperp^{(n-1)}$ stattfindet, ist durch
-\begin{equation}
-\mathcal{P}_{\text{next},a,b}^{(n)}\left(\pperp^{(n)};\pperp^{(n-1)}\!\!,s^{(n)}\right):=\exp\left[W_a^{(n)}W_b^{(n)}
-\left[
-\mathcal{S}_{\alpha\beta}\left(\pperp^{(n)};s^{(n)}\right)
--
-\mathcal{S}_{\alpha\beta}\left(\pperp^{(n-1)};s^{(n)}\right)
-\right]
-\right]\label{eq:imp:pnextab}
-\end{equation}
-gegeben. $s^{(n)}$ ist die invariante Masse des Remnant-Remnant-Systems, $W_\alpha^{(n)}$ und $W_\beta^{(n)}$ sind die Wichtungsfaktoren des Stratums $\alpha$ bzw. $\beta$ und $\mathcal{S}_{\alpha\beta}$ ist das Stammstratum mit
-\begin{equation}
- \mathcal{S}_{\alpha\beta}\left(\pperp^{(n)};s^{(n)}\right):=\int_{\pperp^{\max}}^{\pperp^{(n)}}\der\pperp\overline{S}_{\alpha\beta}\left(\pperp;s^{(n)}\right)\label{eq:all:strati_root_def}.
-\end{equation}
-Das Stammstratum ist demnach eine negative Stammfunktion des integrierten Stratums $\overline{S}_{\alpha\beta}$ mit ${\pperp^{\max}}=s/4$ und
-\begin{equation}
- \overline{S}_{\alpha\beta}\left(\pperp;s^{(n)}\right):=\int_{x_{\min}}^{1}\der x_1\int_{x_{\min}}^{1}\der x_2\ S_{\alpha\beta}\left(x_1,x_2,\pperp;s^{(n)}\right)\label{eq:imp:double_strati_int}.
-\end{equation}
-Schließlich sind die Branchingstrati $S_{\alpha\beta}$ mit
-\begin{equation}
- S_{\alpha\beta}:=\frac{1}{\sigma_{\nd}}\sum_{k\in S_a}\sum_{l\in S_b}\sum_{m,n}\frac{\partial^3\sigma_{kl\to mn}\left(x_1,x_2,\pperp;s\right)}{\partial x_1\ \partial x_2\ \partial \pperp}
-\end{equation}
-als bedingte Wahrscheinlichkeit dafür definiert, dass eine hadronische Wechselwirkung aus dem Stratum $\{\alpha,\beta\}$ stattfindet, gegeben dass eine nicht-diffraktive hadronische Wechselwirkung stattfindet. $\sigma_{\nd}$ ist der totale, nicht-diffraktive Wirkungsquerschnitt und einer der freien Parameter des MPI-Modells. Die einfachen Strati $S_a$ sind in Tabelle \ref{tab:all:strati:strati} dargestellt.
-
-\wip{In Tabelle \eqref{tab:all:strati:strati} sind zwei Varianten angegeben. In der ersten fehlen offensichtlich die Quasivalezquarks. Diese werden zwar vollkommen korrekt in den Remnant-Strukturfunktionen berücksichtigt, werden aber für die eigentliche Generierung der MPI aus technischen Gründen komplett ignoriert. In der Dissertation ist in Kapitel 5.2 ein Vorschlag gemacht, wie Quasivalenzquarks mitgenommen werden können. Diese Umsetzung bedeutet aber einen erheblichen Eingriff in den Quellcode.}
-
-
-\begin{table}
-\begin{center}
-\subfloat[]{
-\begin{tabular}{ccc}
- Stratum&Name&Partonen\\
- \midrule
- $S_1$&Gluon&$g$\\
- $S_2$&See&$\{q^S:\ \forall q\}$\\
- $S_3$&Valenz-Down&$d^V$\\
- $S_4$&Valenz-Up&$u^V$
-\end{tabular}}\qquad
-\subfloat[]{
-\begin{tabular}{ccc}
- Stratum&Name&Partonen\\
- \midrule
- $S_1$&Gluon&$g$\\
- $S_2$&See&$\{q^S:\ \forall q\}$\\
- $S_3$&Valenz-Down&$d^V$\\
- $S_4$&Valenz-Up&$u^V$\\
- $S_5$&Quasivalenz&$\{q^Q:\ \forall q\}$
-\end{tabular}}
-\end{center}
-\caption{\label{tab:all:strati:strati}(a): Strati zur Berechnung der nächsten Skala. (b) Strati für die Wichtungsfaktoren in \eqref{eq:all:rem:sumrule}}
-\end{table}
-In \CompRef{muli\_interactions}{valid\_processes} ist für jedes Feynmandiagramm in der fünften Komponente valid\_processes(5,:) die Nummer des Stratums eingetragen, zu dem das Diagramm gehört.
-
-\mip{Die einfachen Strati $S_\alpha$ heißen im Quellcode pdf\_int\_kind. Sie sind in \CompRef{muli\_interactions}{pdf\_int\_kind\_gluon} und folgende definiert. Entsprechend sind die doppelten Strati $\{\alpha,\beta\}$ in \CompRef{muli\_interactions}{double\_pdf\_kinds} hinterlegt.}
-
-Wir bestimmen die nächste Skala des Stratums $\{\alpha,\beta\}$ über
-\begin{equation}
- \label{eq:all:genpt-a}
- \widehat{p}_{\perp,a,b}^{(n)}=\mathcal{S}_{\alpha\beta}^{-1}\left(\ \cdot\ ;s^{(n)}\right)\left(\zeta_{\alpha\beta}^{(n)}\right)
-\end{equation}
-mit
-\begin{equation}
- \label{eq:all:genpt-b}
- \zeta_{\alpha\beta}^{(n)}:=
- \frac{
- \ln(z_{\alpha\beta}^{(n)})
- }
- {W_a^{(n)}W_b^{(n)}}
- +
- \mathcal{S}_{\alpha\beta}\left(\pperp^{(n-1)};s^{(n)}\right)
- =
- \mathcal{S}_{\alpha\beta}\left(\pperp^{(n)};s^{(n)}\right)
-\end{equation}
-und
-\begin{equation}
- \label{eq:all:genpt-c}
- z_{\alpha\beta}^{(n)} \in (0,1],\quad \text{zufällig und gleichverteilt.}
-\end{equation}
-Durch einsetzen von $s^{(n)}$ in $\mathcal{S}_{\alpha\beta}$ erhalten wir eine einstellige, umkehrbare Funktion $\mathcal{S}_{\alpha\beta}\left(\ \cdot\ ;s^{(n)}\right)$. Somit ist $\mathcal{S}_{\alpha\beta}^{-1}\left(\ \cdot\ ;s^{(n)}\right)\left(\zeta_{\alpha\beta}^{(n)}\right)$ eben diese Umkehrfunktion, ausgewertet bei $\zeta_{\alpha\beta}^{(n)}$.
-
-Der größte Wert von $\widehat{p}_{\perp,a,b}^{(n)}$ unter allen Strati ist die neue Skala $\widehat{p}_{\perp}^{(n)}$, das Stratum mit der größten Skala ist das neue Stratum $\{\alpha^{(n)},\beta^{(n)}\}$
-
-\wip{Die Stammstrati in \eqref{eq:all:strati_root_def} hängen offensichtlich von der aktuellen hadronischen invarianten Masse $s^{(n)}$ ab. Derzeit werden die $\mathcal{S}_{\alpha\beta}$ aber als eindimensionale Funktionen in \CompRef{muli\_type}{dsigma} ohne $s$-Abhängigkeit gespeichert. Geht man zu einer zweidimensionalen Dastellung über, dann kommt man zu den Performance- und Speicherproblemen, die in der Dissertation in Kapitel 5.2 beschrieben sind. Dynamische Werte von $s^{(n)}$ sind also nicht durch einen trivialen Patch implementierbar. Das Problem wird teilweise dadurch entschärft, dass die Skala später auf die invariante Masse normiert wird. Quotienten $\pperp/s$ werden also korrekt behandelt, nur durch Faktoren von $s$ ohne $\pperp$ werden die Matrixelemente inkonsistent.}
-\section{Importance Sampling}\label{sec:all:alg:imp}
-Das Stratum $\{\alpha,\beta\}$ sowie die Skala $\pperp$ liegen fest. Wie auch in der Dissertation unterdrücken wir hier die Indizes $^{(n)}$, da hier nur Werte aus der aktuellen Iteration vorkommen. Wir generieren die hyperbolischen Impulsanteile $h_1,h_2$, indem wir die Gleichung
-\begin{equation}
- zs\overline{S}_{ab}\left(\pperp(h_3,s^{(n)}),s^{(n)}\right)\overset{?}{<}H_{ab}\left(h_1,h_2,h_3,s^{(n)}\right)
-\end{equation}
-mit
-\begin{equation}
- h_1,h_2,z\in(0,1],\quad \text{zufällig und gleichverteilt}
-\end{equation}
-solange mit neu generierten $h_1,h_2,z$ auswerten, bis sie erfüllt ist. $H$ ist eine regularisierte Form der divergenten Branchingstrati $S$, mit
-\begin{equation}
- H_{ab}\left(h_1,h_2,h_3,s^{(n)}\right)=S_{ab}\left(x_1(h_1,h_2),x_2(h_1,h_2),\pperp(h_1,h_2,s^{(n)}),s^{(n)}\right)\left(\frac{\partial h_1}{\partial x_1}\frac{\partial h_2}{\partial x_2}-\frac{\partial h_1}{\partial x_2}\frac{\partial h_2}{\partial x_1}\right)
-\end{equation}
-und
-\begin{align}\label{eq:all:imp:trafo}
- h_1&:=\frac{x_1x_2 - h_3}{(1 - h_3)^{1/4}}\\
- h_2&:=\frac{1+(x_2^2 - x_1^2)^{1/3}}{2}\\
- h_3&:=\frac{4\pperp}{\widehat{s}^{(n)}}\\
- x_1&=\sqrt{\sqrt{(h_1^4(1-h_3)+h_3)^2+(4(h_2-1/2)^3)^2}-4(h_2-1/2)^3}\\
- x_2&=\sqrt{\sqrt{(h_1^4(1-h_3)+h_3)^2+(4(h_2-1/2)^3)^2}+4(h_2-1/2)^3}\\
- \pperp&=\frac{h_3\widehat{s}^{(n)}}{4}.
-\end{align}
-$\overline{S}_{ab}$ ist der Mittelwert von $H_{ab}$, gemittelt über $h_1$ und $h_2$. Mit dem willkürlichen reellen Faktor $s$ wird $s\overline{S}_{ab}$ damit zu einer, von $\pperp$ abhängigen, Majorante von $H_{ab}$.
-
-Um $H$ noch weiter zu glätten, wird in \CompRef{muli\_type}{samples} eine Einteilung des $\{h_1,h_2,h_3\}$-Einheits\-quaders und Unterquader abgelegt. Dabei wird der Quader zuerst so in $h_3$-Richtung in endlich viele Scheiben geschnitten, dass das Integral über $H$ in jeder Scheibe etwa gleich ist. Anschließend wird jede Scheibe simultan in $h_1$ und $h_2$ so in Unterquader zerlegt, dass das Integral über jedes dieser Unterquader etwa gleich groß ist und die Varianz in jedem Unterquader klein wird. Jeder Unterquader hat einen Index $q_i$ und einen Flächeninhalt in der $h_1-h_2$-Ebene von $a_i$.
-
-Weiterhin werden alle Feynmandiagramme, die in dem Stratus $\{\alpha,\beta\}$ enthalten sind, mit einem Wicht\-ungs\-faktor $d_j$ versehen. Die tatsächliche Vorgehensweise zur Generierung der Impulse und der Flavor ist dann wie folgt:
-
-\begin{enumerate}
- \item Es wird ein Diagramm mit der Wahrscheinlichkeit $W_j/\sum_k W_k$ gewählt.
- \item Es wird zufällig und gleichverteilt ein Quader $q_i$ mit der Fläche $a_i$ aus derjenigen Scheibe gewählt, die $h_3$ enthält.
- \item Es werden zufällig und gleichverteilt reelle Zahlen $h_1,h_2$ und $z$ aus dem Einheitsintervall gewählt
- \item Es wird
- \begin{equation}\label{eq:all:importance}
- zsW_j\overline{S}_{ab}\left(\pperp(h_3,s^{(n)}),s^{(n)}\right)\overset{?}{<}a_iH_{ab}\left(h_1,h_2,h_3,s^{(n)}\right)
- \end{equation}
- ausgewertet und bei 1 begonnen, bis die Ungleichung erfüllt ist.
- \item
- Aus $h_1$ und $h_2$ ergeben sich die Impulsanteile $x_1$ und $x_2$, aus dem Diagramm $j$ ergeben sich die Flavor $a,b,c$ und $d$.
-\end{enumerate}
-\section{Remnants}
-Abweichend von der Dissertation (Gl. 4.49) werden hier fünf verschiedene Wichtungsfaktoren für die vier Strati $\{$Gluon, See, Valenz-down, Valenz-up, Quasivalenz$\}$ zugelassen:
-\begin{equation}
- \begin{split}
- 1=\\
- W_G^{(n)}\int_{\xi_{\min}^{(n)}}^{1}\der \xi^{(n)}f_g(\xi^{(n)},Q^2)+\\
- +W_S^{(n)}\sum_q\int_{\xi_{\min}^{(n)}}^{1}\der \xi^{(n)}f_{q^{S}}(\xi^{(n)},Q^2)+\\
- +\sum_qW_{q^V}^{(n)}\frac{N_{q^V}^{(n)}}{N_{q^V}^{(0)}}\int_{\xi_{\min}^{(n)}}^{1}\der \xi^{(n)}f_q^v(\xi^{(n)},Q^2)+\\
- +W_Q^{(n)}\sum_q\int_{\xi_{\min}^{(n)}}^{1}\der \xi^{(n)}f_q^Q(\xi^{(n)},Q^2)\label{eq:all:rem:sumrule}
- \end{split}
-\end{equation}
-Da wir nur eine Gleichung für vier Wichtungsfaktoren haben, müssen wir weitere Beziehungen festlegen. Durch den Parameter \CompRef{muli\_remnant}{remnant\_weight\_model} wird entschieden, welche Wichtungsfaktoren auf Eins gesetzt werden. Die jeweils anderen werden gleich gesetzt. Für das Quadrupel $[W_G,W_S,W_{d^V},W_{u^V},W_Q]$ erhalten wir:
-
-\begin{table}
- \begin{center}
- \begin{tabular}{cc}
- remnant\_weight\_model&$[W_G,W_S,W_d,W_u,W_Q]$\\
- \midrule
- $0$&$[1,\ 1,\ 1,\ 1,\ 1\ ]$\\
- $1$&$[w,w,w,w,w]$\\
- $2$&$[w,w,1,\ 1,\ 1\ ]$\\
- $3$&$[1,\ 1,\ w,w,w]$\\
- $4$&$[1,\ w,1,\ 1,\ w]$
- \end{tabular}
- \end{center}
- \caption{\label{tab:all:rem:weight_models}remnant\_weight\_models}
-\end{table}
-In \eqref{eq:all:rem:sumrule} eingesetzt kann $w$ eindeutig bestimmt werden.
-
-\mip{Für remnant\_weight\_model=0 ist \eqref{eq:all:rem:sumrule} nicht lösbar, es ist also streng genommen kein gültiges Wichtungsmodell. Stattdessen wird dadurch die Gewichtung deaktiviert.}
-
-\section{Programmfluss}
-Die einzeilnen Methoden sind ausführlich in \ModuleRef{muli} beschrieben. Wir geben hier nur eine kurze Übersicht an:
-\begin{itemize}
-\item initialize
-
- Der Monte-Carlo-Generator von MulI und die Datenstruktur der Proton-Remnants werden initialisiert.
-\item apply\_initial\_interaction
-
- Eine von WHIZARD generierte harte Wechselwirkung wird an MulI übergeben. Die Remnants werden entsprechend angepasst.
-\item generate\_gev2\_pt2
-
- Mittels \eqref{eq:all:genpt-a} wird eine Skala $\widehat{p}_{\perp,a,b}^{(n)}$ und ein Stratum $\{\alpha^{(n)},\beta^{(n)}\}$ generiert.
-\item generate\_partons
-
- Mittels \eqref{eq:all:importance} werden die Impulsanteile $x_1$ und $x_2$ und die Flavor $a,b,c$ und $d$ generiert. Außerdem wird eine interne Darstellung der Farbflüsse generiert.
-\item get\_correlations
-
-Die interne Darstellung der Farbflüsse wird in der vom shower\_interface gewünschten Form von Farbkorrelationen ausgegeben.
-\item replace\_parton
-
- Der ISR-Algorithmus hat ein Branching eines aktiven Showerteilchens generiert. Dieses Showerteilchen ist fortan kein aktives Teilchen mehr, sondern ein inneres Teilchen der perturbativen Wechselwirkung. Entsprechend muss es durch replace\_parton in der Beschreibung des Remnants durch das neue aktive Teilchen ersetzt werden. Siehe Abbildung \ref{fig:all:flow:isr}
- \begin{figure}
- \begin{center}
- \includegraphics{diagrams-4.mps}\includegraphics{diagrams-5.mps}\includegraphics{diagrams-6.mps}
- \caption{\label{fig:all:flow:isr}Ersetzung des aktiven ISR-Partons durch den ISR-Algorithmus. Links: Durch die härteste WW wurde ein Parton aus dem Hadron entfert. Dieses Parton ist ein "`aktives"' Parton, da ISR-Branchings für dieses Teilchen generiert werden. Alle Teilchen, die jemals generiert werden, bekommen eine eindeutige Nummer, hier die Nummer 1. Die Eigenschaften des Remants und des Teichens \#1 müssen in der Summe die Eigenschaften des Protons ergeben. Rechts: Durch den ISR-Algorithmus wurde ein Branching der Teilches \#1 erzeugt. Das Mutterparton hat die Nummer 2 bekommen, das andere Tochterparton hat die Nummer 3 bekommen. Jetzt müssen die Eigenschaften des Remnants und des Teilchens \#2 in der Summe die Eigenschaften des Protons ergeben. In diesem Sinne müssen wir das Teilchen \#1 wieder "`zurücklegen"' und das Teilchen \#2 "`herausnehmen"'.}
- \end{center}
- \end{figure}
-\item restart
-
- Es werden einige interne Variablen zurückgesetzt, wie z.B. das "finished"-Flag. Außerdem werden die Remnants zurückgesetzt.
-\item finalize
-
- Der Monte-Carlo-Generator von MulI, die vorgenerierten Wirkungsquerschnitte und die Remnants werden deallociert.
-\end{itemize}
Index: trunk/src/muli/doc/Module.tex
===================================================================
--- trunk/src/muli/doc/Module.tex (revision 8371)
+++ trunk/src/muli/doc/Module.tex (revision 8372)
@@ -1,12 +0,0 @@
-\part{Module}
-\input{muli}
-\input{muli_momentum}
-\input{muli_remnant}
-\input{muli_dsigma}
-\input{muli_aq}
-\input{muli_trapezium}
-\input{muli_fibonacci_tree}
-\input{muli_interactions}
-\input{muli_mcint}
-\input{muli_cuba}
-\input{muli_basic}
Index: trunk/src/muli/doc/muli_aq.tex
===================================================================
--- trunk/src/muli/doc/muli_aq.tex (revision 8371)
+++ trunk/src/muli/doc/muli_aq.tex (revision 8372)
@@ -1,802 +0,0 @@
-\Module{muli\_aq}
-%\begin{figure}
-% \centering{\includegraphics{uml-module-tree-3.mps}}
-% \caption{\label{fig:\ThisModule:Types}Klassendiagramm des Moduls \ThisModule}
-%\end{figure}
-aq ist eine Abkürzung für adaptive Quadratur. Mit aq\_class kann für eine beliebige Funktion $f:\mathbb{R}\rightarrow\mathbb{R}^n$ die Quasistammfunktion $F(x)=\int_x^1 f(y)\ \der\!y$ mittels adaptiver Quadratur ausgewertet und als Binärbaum von Segmenten $s_j=[x_{j-1},x_j]$ gespeichert werden. Zu jedem Segment werden $f(x_j),F(x_j)$ und $\exp[-F(x_j)]$ gespeichert.
-
-$f$ wird mit der Trapezregel approximiert, entsprechend wird $F$ durch Parabeln approximiert. Dennoch ist die Approximation von $F$ nicht gleich Simpsons Regel, denn wir haben nur zwei Stützstellen $x_{j-1}$ und $x_j$ für jede Parabel.
-
-Der Integrationsfehler $delta$ $\delta^\prime$ bzw. $\delta^\prime$ ergibt sich bei der Spaltung des Segments $s_j$ in zwei Untersegmente $s_j^\prime=[x_{j-1},y]$ und $s_j^{\prime\prime}=[y,x_j]$ durch die Differenz des alten und des neuen Integrals:
-\begin{align}
- \delta^{\prime}&=\left|\frac{\big(f(y)-f_j(y)\big)\big(x_{j-1}-y\big)}{2}\right|\\
- \delta^{\prime\prime}&=\left|\frac{\big(f(y)-f_j(y)\big)\big(x_j-y\big)}{2}\right|
-\end{align}
-mit der alten Approximation $f_j$ des alten Segments $j$
-\begin{equation}
- f_j(y)=f(x_j)-y\ \frac{f(x_j)-f(x_{j-1})}{x_j-x_{j-1}}.
-\end{equation}
-\section{Abhängigkeiten}
-\use{muli\_basic}
-\use{muli\_cuba}
-\use{muli\_trapezium}
-\use{muli\_fibonacci\_tree}
-\section{Derived Types}
-\TypeDef{aq\_class}
-\begin{Verbatim}
- type,\Extends{identified\_type},abstract :: aq_class
- ! private
- \IC{Erweiterungen müssen durch is\_deferred\_initialised signalisieren, dass sie bereit sind.}
- logical :: \TC{is\_deferred\_initialised} = .false.
- \IC{Ist \CompRef{aq\_class}{err\_tree} bereit?}
- logical :: \TC{is\_error\_tree\_initialised} = .false.
- \IC{Wurden die internen Fehlerziele bestimmt?}
- logical :: \TC{is\_goal\_set} = .false.
- \IC{Ist alles bereit zur Integration?}
- logical :: \TC{is\_initialised} = .false.
- \IC{Wurde die Integration durchgeführt?}
- logical :: \TC{is\_run} = .false.
- \IC{Wurde das Fehlerziel erreicht?}
- logical :: \TC{is\_goal\_reached} = .false.
- \IC{Wurde \CompRef{aq\_class}{err\_tree} nach \CompRef{aq\_class}{int\_list} konvertiert?}
- logical :: \TC{is\_integrated} = .false.
- \IC{Die aktuelle Anzahl von Segmenten}
- integer(kind=dik) :: \TC{n\_nodes} = 0
- \IC{Die maximale Anzahl von Segmenten}
- integer(kind=dik) :: \TC{max\_nodes} = 10000
- \IC{Die Dimension von f}
- integer :: \TC{dim\_integral} = 1
- \IC{Das gegebene absolute Fehlerziel}
- real(kind=double) :: \TC{abs\_error\_goal} = 0D0
- \IC{Das gegebene relative Fehlerziel}
- real(kind=double) :: \TC{rel\_error\_goal} = 0.1D0
- \IC{Das berechnete absolute Fehlerziel, basierend auf der aktuellen}
- \IC{Schätzung des Integrals}
- real(kind=double) :: \TC{scaled\_error\_goal} = 0.0D0
- \IC{Schätzung des Integrals F(x_min)}
- real(kind=double) :: \TC{integral} = 1D0
- \IC{Aktueller absoluter Integrationsfehler}
- real(kind=double) :: \TC{integral\_error} = 0D0
- \IC{Integrationsintervall}
- real(kind=double),dimension(2) :: \TC{region} = (/0D0,1D0/)
- \IC{Zu Debuggingzwecken wird die Historie des Integrationsfehlers gespeichert.}
- \IC{Wenn die Historie oszilliert, dann ist der Fehler in f, also in der}
- \IC{Cuba-Integration zu groß.}
- real(kind=double),dimension(:,:),allocatable :: \TC{convergence}
- \IC{time stamps um die Performance des Allgorithmus zu überwachen.}
- real(kind=double) :: \TC{total\_time} = 0
- real(kind=double) :: \TC{loop\_time} = 0
- real(kind=double) :: \TC{int\_time} = 0
- real(kind=double) :: \TC{cuba\_time} = 0
- real(kind=double) :: \TC{init\_time} = 0
- real(kind=double) :: \TC{cpu\_time} = 0
-
- \IC{These variables *must* be initialised before the main loop may be called.}
- \IC{Additionaly the nodes and segments should be preprocessed by first_run}
- \IC{before the main loop may be called.}
-
- \IC{Das tatsächliche Fehlerziel.}
- real(kind=double) :: \TC{error\_goal} = 0D0
- \IC{Während der Integration werden die Segmente des Integranden nach ihrem}
- \IC{Integrationsfehler sortiert in diesem Binärbaum gespeichert.}
- class(\TypeRef{fibonacci\_root\_type}),pointer ::\TC{err\_tree}=>null()
- \IC{Nach erfolgreicher Integration werden die Segmente nach dem Skalenparameter}
- \IC{sortiert in dieser Liste gespeichert.}
- class(\TypeRef{muli\_trapezium\_list\_type}),pointer ::\TC{int\_list}=>null()
- contains
- \OverridesDeclaration{serializable\_class}
- procedure::\TbpDec{write\_to\_marker}{aq\_write\_to\_marker}
- procedure::\TbpDec{read\_from\_marker}{aq\_read\_from\_marker}
- procedure::\TbpDec{print\_to\_unit}{aq\_print\_to\_unit}
- procedure,nopass::\TbpDec{get\_type}{aq\_get\_type}
- procedure::\TbpDec{deserialize\_from\_marker}{aq\_deserialize\_from\_marker}
- \OriginalDeclaration
- procedure :: aq_initialize
- generic ::\TbpDec{initialize}{aq\_initialize}
- procedure ::\TbpDec{print\_times}{aq\_print\_times}
- procedure ::\TbpDec{write\_convergence}{aq\_write\_convergence}
- ! init/ de-init
- procedure ::\TbpDec{reset}{aq\_reset}
- procedure ::\TbpDec{dealloc\_trees}{aq\_dealloc\_trees}
- procedure ::\TbpDec{finalize}{aq\_dealloc\_trees}
- procedure ::\TbpDec{init\_error\_tree}{aq\_init\_error\_tree}
- procedure ::\TbpDec{set\_rel\_goal}{aq\_set\_rel\_goal}
- procedure ::\TbpDec{set\_abs\_goal}{aq\_set\_abs\_goal}
- procedure ::\TbpDec{set\_goal}{aq\_set\_goal}
- procedure ::\TbpDec{check\_init}{aq\_check\_init}
- ! calculation
- procedure ::\TbpDec{main\_loop}{aq\_main\_loop}
- procedure ::\TbpDec{run}{aq\_run}
- procedure ::\TbpDec{integrate}{aq\_integrate}
- ! deferred
- procedure(evaluate_if),deferred :: evaluate
- end type aq_class
-\end{Verbatim}
-\section{Interfaces}
-\begin{Verbatim}
- interface
- subroutine evaluate_if(this,x,y)
- use kinds!NODEP!
- import aq_class
- class(aq_class),intent(inout) :: this
- real(kind=double), intent(in) :: x
- real(kind=double), intent(out) ,dimension(:):: y
- end subroutine evaluate_if
- \end{Verbatim}
-\Methods
-\MethodsFor{aq\_class}
-\OverridesSection{serializable\_class}
-
-\TbpImp{aq\_write\_to\_marker}
-\begin{Verbatim}
- subroutine aq_write_to_marker(this,marker,status)
- class(aq_class), intent(in) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
- class(serializable_class),pointer::ser
- call marker%mark_begin("aq_class")
- call identified_write_to_marker(this,marker,status)
- call marker%mark("is_deferred_initialised",this&
- &%is_deferred_initialised)
- call marker%mark("is_error_tree_initialised",this&
- &%is_error_tree_initialised)
- call marker%mark("is_goal_set",this%is_goal_set)
- call marker%mark("is_initialised",this%is_initialised)
- call marker%mark("is_run",this%is_run)
- call marker%mark("is_goal_reached",this%is_goal_reached)
- call marker%mark("is_integrated",this%is_integrated)
- call marker%mark("n_nodes",this%n_nodes)
- call marker%mark("max_nodes",this%max_nodes)
- call marker%mark("dim_integral",this%dim_integral)
- call marker%mark("abs_error_goal",this%abs_error_goal)
- call marker%mark("rel_error_goal",this%rel_error_goal)
- call marker%mark("scaled_error_goal",this%scaled_error_goal)
- call marker%mark("error_goal",this%error_goal)
- call marker%mark("integral",this%integral)
- call marker%mark("integral_error",this%integral_error)
- call marker%mark("region",this%region(1:2))
- ser=>this%err_tree
- call marker%mark_pointer("err_tree",ser)
- ser=>this%int_list
- call marker%mark_pointer("int_list",ser)
- call marker%mark_end("aq_class")
- end subroutine aq_write_to_marker
-\end{Verbatim}
-
-\TbpImp{aq\_read\_from\_marker}
-\begin{Verbatim}
- subroutine aq_read_from_marker(this,marker,status)
- class(aq_class), intent(out) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
- class(serializable_class),pointer::ser
- call marker%pick_begin("aq_class",status=status)
- call identified_read_from_marker(this,marker,status)
- call marker%pick("is_deferred_initialised",this%is_deferred_initialised&
- &,status)
- call marker%pick("is_error_tree_initialised",this&
- &%is_error_tree_initialised,status)
- call marker%pick("is_goal_set",this%is_goal_set,status)
- call marker%pick("is_initialised",this%is_initialised,status)
- call marker%pick("is_run",this%is_run,status)
- call marker%pick("is_goal_reached",this%is_goal_reached,status)
- call marker%pick("is_integrated",this%is_integrated,status)
- call marker%pick("n_nodes",this%n_nodes,status)
- call marker%pick("max_nodes",this%max_nodes,status)
- call marker%pick("dim_integral",this%dim_integral,status)
- call marker%pick("abs_error_goal",this%abs_error_goal,status)
- call marker%pick("rel_error_goal",this%rel_error_goal,status)
- call marker%pick("scaled_error_goal",this%scaled_error_goal,status)
- call marker%pick("error_goal",this%error_goal,status)
- call marker%pick("integral",this%integral,status)
- call marker%pick("integral_error",this%integral_error,status)
- call marker%pick("region",this%region(1:2),status)
- call marker%pick_pointer("err_tree",ser)
- if(associated(ser))then
- select type(ser)
- class is (fibonacci_root_type)
- this%err_tree=>ser
- class default
- nullify(this%err_tree)
- end select
- end if
- call marker%pick_pointer("int_list",ser)
- if(associated(ser))then
- select type(ser)
- class is (muli_trapezium_list_type)
- this%int_list=>ser
- class default
- nullify(this%int_list)
- end select
- end if
- call marker%pick_end("aq_class",status)
- end subroutine aq_read_from_marker
-\end{Verbatim}
-
-\TbpImp{aq\_print\_to\_unit}
-\begin{Verbatim}
- subroutine aq_print_to_unit(this,unit,parents,components,peers)
- class(aq_class),intent(in)::this
- integer,intent(in)::unit
- integer(kind=dik),intent(in)::parents,components,peers
- integer::ite
- class(serializable_class),pointer::ser
- if(parents>0)call identified_print_to_unit(this,unit,parents-1,components&
- &,peers)
- write(unit,'("Components of aq_class")')
- write(unit,'(a,L1)')"Deferred class initialised: ",this&
- &%is_deferred_initialised
- write(unit,'(a,L1)')"Error tree initialised: ",this&
- &%is_error_tree_initialised
- write(unit,'(a,L1)')"Accuracy goal set: ",this%is_goal_set
- write(unit,'(a,L1)')"Ready for run: ",this%is_initialised
- write(unit,'(a,L1)')"Is run: ",this%is_run
- write(unit,'(a,L1)')"Accuracy goal reached: ",this%is_goal_reached
- write(unit,'(a,L1)')"Integral calculated: ",this%is_integrated
- write(unit,'(a,I10)')"Number of nodes: ",this%n_nodes
- write(unit,'(a,I10)')"Maximal number of nodes: ",this%max_nodes
- write(unit,'(a,I10)')"Dimension of integral: ",this%dim_integral
- write(unit,'(a,E20.10)')"Given abs. error goal: ",this%abs_error_goal
- write(unit,'(a,E20.10)')"Given rel. error goal: ",this%rel_error_goal
- write(unit,'(a,E20.10)')"Guessed abs error goal:",this%scaled_error_goal
- write(unit,'(a,E20.10)')"Actual abs error goal: ",this%error_goal
- write(unit,'(a,E20.10)')"Integral ",this%integral
- write(unit,'(a,E20.10)')"Estimated abs. error: ",this%integral_error
- write(unit,'(a,E10.5,a,E10.5,a)')"Integration region = (",this%region(1)&
- &," : ",this%region(2),")"
- ser=>this%err_tree
- call serialize_print_comp_pointer(ser,unit,parents,components,peers&
- &,"error tree")
- ser=>this%int_list
- call serialize_print_comp_pointer(ser,unit,parents,components,peers&
- &,"integral list")
- end subroutine aq_print_to_unit
-\end{Verbatim}
-
-\TbpImp{aq\_get\_type}
-\begin{Verbatim}
- pure subroutine aq_get_type(type)
- character(:),allocatable,intent(out)::type
- allocate(type,source="aq_type")
- end subroutine aq_get_type
-\end{Verbatim}
-
-\TbpImp{aq\_deserialize\_from\_marker}
-\begin{Verbatim}
- subroutine aq_deserialize_from_marker(this,name,marker)
- class(aq_class),intent(out)::this
- character(*),intent(in)::name
- class(marker_type),intent(inout)::marker
- class(serializable_class),pointer::ser
- allocate(muli_trapezium_type::ser)
- call marker%push_reference(ser)
- allocate(fibonacci_root_type::ser)
- call marker%push_reference(ser)
- allocate(fibonacci_leave_type::ser)
- call marker%push_reference(ser)
- allocate(fibonacci_node_type::ser)
- call marker%push_reference(ser)
- call serializable_deserialize_from_marker(this,name,marker)
- call marker%pop_reference(ser)
- deallocate(ser)
- call marker%pop_reference(ser)
- deallocate(ser)
- call marker%pop_reference(ser)
- deallocate(ser)
- call marker%pop_reference(ser)
- deallocate(ser)
- end subroutine aq_deserialize_from_marker
-\end{Verbatim}
-\OriginalSection{aq\_class}
-\TbpImp{aq\_initialize}
-\begin{Verbatim}
- subroutine aq_initialize(this,id,name,goal,max_nodes,dim,init)
- class(aq_class),intent(out) :: this
- integer(kind=dik),intent(in)::id,max_nodes
- integer,intent(in)::dim
- character,intent(in)::name
- real(kind=double)::goal
- real(kind=double),dimension(:),intent(in)::init
- call identified_initialize(this,id,name)
- this%rel_error_goal = goal!1d-4
- this%max_nodes=max_nodes
- call this%init_error_tree(dim,init)
- end subroutine aq_initialize
-\end{Verbatim}
-\TbpImp{aq\_print\_times}
-\begin{Verbatim}
- subroutine aq_print_times(this)
- class(aq_class),intent(in) :: this
- print '(a,E20.10)',"Initialization time: ",this%init_time
- print '(a,E20.10)',"Main loop time: ",this%loop_time
- print '(a,E20.10)',"Integration time: ",this%int_time
- print '(a,E20.10)',"Overall run time: ",this%total_time
- print '(a,E20.10)',"Cuba integration time:",this%cuba_time
- end subroutine aq_print_times
-\end{Verbatim}
-\TbpImp{aq\_write\_convergence}
-\begin{Verbatim}
- subroutine aq_write_convergence(this,unit)
- class(aq_class),intent(in) :: this
- integer,intent(in)::unit
- integer,dimension(2)::s
- integer::node
- if(allocated(this%convergence))then
- s=shape(this%convergence)
- do node=1,s(2)
- write(unit,fmt=*)node,this%convergence(1:2,node)
- end do
- end if
- end subroutine aq_write_convergence
-\end{Verbatim}
-! init/ de-init
-
-\TbpImp{aq\_reset}
-\begin{Verbatim}
- subroutine aq_reset(this)
- class(aq_class) :: this
- this%is_deferred_initialised = .false.
- this%is_error_tree_initialised = .false.
- this%is_goal_set = .false.
- this%is_initialised = .false.
- this%is_run = .false.
- this%is_goal_reached = .false.
- this%is_integrated = .false.
- this%n_nodes = 0
- this%max_nodes = 10000
- this%dim_integral=1
- this%abs_error_goal = 1D0
- this%rel_error_goal = 0.1D0
- this%scaled_error_goal = 0.0D0
- this%error_goal = 0.0D0
- this%integral = 0D0
- this%integral_error = 0D0
- this%region = (/0D0,1D0/)
- this%total_time = 0
- this%loop_time = 0
- this%int_time = 0
- this%init_time = 0
- call this%dealloc_trees()
- end subroutine aq_reset
-\end{Verbatim}
-\TbpImp{aq\_check\_init}
-\begin{Verbatim}
- subroutine aq_check_init(this)
- class(aq_class) :: this
- this%is_initialised = this%is_error_tree_initialised .and. this%is_deferred_initialised
- end subroutine aq_check_init
-\end{Verbatim}
-\TbpImp{aq\_dealloc\_trees}
-\begin{Verbatim}
- subroutine aq_dealloc_trees(this)
- class(aq_class) :: this
- if(associated(this%err_tree))then
- call this%err_tree%deallocate_all()
- deallocate(this%err_tree)
- end if
- if(associated(this%int_list))then
- call this%int_list%finalize()
- deallocate(this%int_list)
- end if
- end subroutine aq_dealloc_trees
-\end{Verbatim}
-
-\TbpImp{aq\_init\_error\_tree}
-\begin{Verbatim}
- subroutine aq_init_error_tree(this,dim_integral,x_array)
- class(aq_class) :: this
- \IC{Wie viele Einträge hat der Rückgabewert von evaluate?}
- integer,intent(in)::dim_integral
- \IC{Eine geordnete Liste von Skalenparametern}
- real(kind=double), dimension(:), intent(in) :: x_array
- \IC{(x_j - x_\{j-1\})/2}
- real(kind=double) :: center
- \IC{Die Funktionswerte am linken Rand, in der Mitte und am rechten Rand des Intervalls.}
- real(kind=double), dimension(:),allocatable::l_val,c_val,r_val
- \IC{Jedes der gegebenen Intervalle wird in zwei Unterintervalle zerlegt, um eine}
- \IC{Abschätzung des Integrationsfehlees zu bekommen. In left\_node und right\_node}
- \IC{werden diese Intervalle gespeichert und in den Binärbaum eingefügt.}
- class(\TypeRef{muli\_trapezium\_type}),pointer :: left_node => null()
- class(\TypeRef{muli\_trapezium\_type}),pointer :: right_node => null()
- \IC{Die Anzahl der gegebenen x-Werte und die Nummer des aktuellen x-Werts.}
- integer :: x_size,pos
- \IC{Timer Start}
- call cpu_time(this%init_time)
- \IC{Signalisieren, dass die Bäume in einem undefinierten Zustand sind.}
- this%is_initialised=.false.
- this%integral=0D0
- this%dim_integral=dim_integral
- x_size = size(x_array)
- if (x_size<2) then
- write (*,'("aq_init_error_tree: I need at least two real values")')
- else
- \IC{In der Null-Komponente wird die Summe aller anderen Einträge gespeichert.}
- allocate(l_val(0:dim_integral-1))
- allocate(c_val(0:dim_integral-1))
- allocate(r_val(0:dim_integral-1))
- \IC{Der Integrationsbereich wird festgelegt.}
- this%region=(/x_array(1),x_array(x_size)/)
- if (x_size<3) then
- \IC{Wir haben nur ein Startsegment, das sich über den gesamten Integrationsbereich}
- \IC{erstreckt. Wir Teilen in der Mitte, denn der Binärbaum}
- \IC{\CompRef{aq\_class}{error\_tree} muss mindestens zwei Blätter haben.}
- center=(x_array(2)-x_array(1))/2D0
- \IC{Wir fordern die Funktionswerte an.}
- call this%evaluate(x_array(1),l_val)
- call this%evaluate(center, c_val)
- call this%evaluate(x_array(2),r_val)
- \IC{Wir erzeugen ein neues Segment [x\_1,c].}
- allocate(left_node)
- call left_node%initialize(&
- &dim=dim_integral,&
- &r_position=center,&
- &d_position=center-x_array(1))
- call left_node%set_r_value(c_val)
- call left_node%set_d_value(c_val-l_val)
- \IC{Wir erzeugen ein neues Segment [c,x\_2].}
- allocate(right_node)
- call right_node%initialize(&
- &dim=dim_integral,&
- &r_position=x_array(2),&
- &d_position=x_array(2)-center)
- call right_node%set_r_value(r_val)
- call right_node%set_d_value(r_val-c_val)
- else
- \IC{wir haben genügend x-Werte, um einen minimalen Baum}
- \IC{\CompRef{aq\_class}{error\_tree} mit zwei Blättern zu initialisieren.}
- call this%evaluate(x_array(1),l_val)
- call this%evaluate(x_array(2),c_val)
- call this%evaluate(x_array(3),r_val)
- allocate(left_node)
- call left_node%initialize(&
- &dim=dim_integral,&
- &r_position=x_array(2),&
- &d_position=x_array(2)-x_array(1))
- call left_node%set_r_value(c_val)
- call left_node%set_d_value(c_val-l_val)
- allocate(right_node)
- call right_node%initialize(&
- &dim=dim_integral,&
- &r_position=x_array(3),&
- &d_position=x_array(3)-x_array(2))
- call right_node%set_r_value(r_val)
- call right_node%set_d_value(r_val-c_val)
- end if
- \IC{Die beiden Startblätter des Baums werden bereitgemacht}
- call left_node%update()
- call right_node%update()
- \IC{Der Wert für das Integral über diese Blätter wird abgeschätzt.}
- this%integral=sum(left_node%get_d_integral()+right_node%get_d_integral())
- if (.not. associated(this%err_tree)) then
- allocate(this%err_tree)
- end if
- \IC{Debugging}
- print *,left_node%measure()
- print *,right_node%measure()
- \IC{Der Baum wird mit den beiden Blättern initialisiert.}
- call this%err_tree%init_by_content(left_node,right_node)
- \IC{Wenn wir noch mehr Segmente haben, dann werden sie in den Baum aufgenommen.}
- if (x_size > 3) then
- do pos=4,x_size
- \IC{Fortschrittsanzeige. Die Intagrationen können einige Minuten dauern.}
- print *,"aq_init_error_tree",pos,"/",x_size
- \IC{Wir merken uns den Funktionswert am rechen Rand des letzten Segments.}
- \IC{Das ist der neue linke Funktionswert des neuen Segments.}
- l_val=right_node%get_r_value_array()
- \IC{Wir forden den Funktionswert am rechten Rand des neuen Intervalls an.}
- call this%evaluate(x_array(pos),r_val)
- \IC{Ein Missbrauch der Variablen, c\_val ist jetzt die Intervallänge.}
- c_val=r_val-l_val
- allocate(right_node)
- call right_node%initialize(&
- &dim=dim_integral,&
- &r_position=x_array(pos),&
- &d_position=x_array(pos)-x_array(pos-1))
- call right_node%set_r_value(r_val)
- call right_node%set_d_value(c_val)
- call right_node%update()
- call this%err_tree%push_by_content(right_node)
- \IC{Das Gesamtintegral wird um das Integral über das neue Segment erhöht.}
- this%integral=this%integral+sum(right_node%get_d_integral())
- end do
- \IC{So viele Blätter hat der Baum jetzt.}
- this%n_nodes = x_size
- end if
- \IC{Der Baum ist wieder in einem definierten Zustand.}
- this%is_error_tree_initialised=.true.
- end if
- \IC{Da wir jetzt eine erste Abschätzung für das Integral haben, können wir}
- \IC{eine Abschätzung für das absolute Fehlerziel machen.}
- call this%set_goal()
- \IC{Damit ist alles Bereit für die adaptive Integration.}
- this%is_initialised=.true.
- \IC{Timer Stopp}
- call cpu_time(this%cpu_time)
- this%init_time=this%cpu_time-this%init_time
- this%cuba_time=this%init_time
- \IC{Debugging: Ab jetzt schreiben wir den aktuellen Integrationsfehler mit.}
- allocate(this%convergence(2,this%n_nodes:this%max_nodes))
- end subroutine aq_init_error_tree
-\end{Verbatim}
-\TbpImp{aq\_set\_abs\_goal}
-\begin{Verbatim}
- subroutine aq_set_abs_goal(this,goal)
- class(aq_class) :: this
- real(kind=double) :: goal
- this%abs_error_goal = goal
- call this%set_goal
- end subroutine aq_set_abs_goal
-\end{Verbatim}
-\TbpImp{aq\_set\_rel\_goal}
-\begin{Verbatim}
- subroutine aq_set_rel_goal(this,goal)
- class(aq_class) :: this
- real(kind=double) :: goal
- this%rel_error_goal = goal
- call this%set_goal
- end subroutine aq_set_rel_goal
-\end{Verbatim}
-\TbpImp{aq\_set\_goal}
-Die angegebenen Fehlerziele werden auf Konsistenz geprüft. Aus dem relativen Fehler wird mithilfe der aktuellen Abschätzung des Integrals ein absoluter Fehler scaled\_error\_goal berechnet. Das Minimum aus abs\_error\_goal und scaled\_error\_goal wird das tatsächliche absulute Fehlerziel error\_goal.
-\begin{Verbatim}
- subroutine aq_set_goal(this)
- class(aq_class) :: this
- this%scaled_error_goal = this%rel_error_goal*abs(this%integral)
- if ((this%scaled_error_goal==0D0).and.(this%abs_error_goal==0D0)) then
- this%is_goal_set = .false.
- this%error_goal = 0D0
- else
- if (this%scaled_error_goal == 0D0) then
- this%error_goal = this%abs_error_goal
- else
- if (this%abs_error_goal == 0D0) then
- this%error_goal = this%scaled_error_goal
- else
- this%error_goal = max(this%scaled_error_goal,this%abs_error_goal)
- end if
- end if
- if (this%error_goal > 0D0) then
- this%is_goal_set = .true.
- else
- this%is_goal_set = .false.
- end if
- end if
- end subroutine aq_set_goal
-\end{Verbatim}
-! calculation
-
-\TbpImp{aq\_main\_loop}
-Die eigentliche adaptive Quadratur findet in dieser Prozedur statt.
-\begin{Verbatim}
- subroutine aq_main_loop(this)
- ! unsafe, when n_nodes < 4
- class(aq_class) :: this
- \IC{Das Blatt mit dem größten Integrationsfehler}
- class(\TypeRef{fibonacci\_leave\_type}), pointer :: rightmost
-
- class(\TypeRef{measurable\_class}), pointer :: content
- class(\TypeRef{muli\_trapezium\_type}),pointer :: new_node
- \IC{Wurde die maximale Anzahl von Blättern erreicht?}
- logical :: limit = .false.
- \IC{Die Stelle, bei der das Segment geteilt wird.}
- real(kind=double) :: center
- \IC{Der Funktionswert an dieser Stelle.}
- real(kind=double),dimension(:),allocatable::c_val
- allocate(c_val(0:this%dim_integral-1))
- loop:do
- \IC{Wir holen uns das Blatt mit den größten Integrationsfehler.}
- call this%err_tree%pop_right(rightmost)
- \IC{Wenn diese Bedingung erfüllt ist, dann ist auch der gesammte Fehler}
- \IC{kleiner als this\%error\_goal}
- if (rightmost < this%error_goal/this%n_nodes) then
- this%is_goal_reached = .true.
- exit loop
- else
- \IC{Wir holen uns das Integrationssegment aus dem Blatt.}
- call rightmost%get_content(content)
- \IC{Zugriff auf die speziellen Methoden von \TypeRef{muli\_trapezium\_type}}
- select type (content)
- class is (muli_trapezium_type)
- \IC{Fortschrittsanzeige}
- print&
- ('("nodes: ",I5," error: ",E14.7," goal: ",E14.7," node at: ",E14.7,"-",E14.7)'),&
- this%n_nodes,&
- rightmost%measure()*this%n_nodes,&
- this%error_goal,&
- content%get_l_position(),&
- content%get_r_position()
- \IC{Debugging: Wir schreiben den Forschritt in den Abbruchbedingung mit.}
- this%convergence(1,this%n_nodes)=this%error_goal/this%n_nodes
- this%convergence(2,this%n_nodes)=rightmost%measure()
- \IC{Wir wollen das Segment in der Mitte teilen.}
- center = content%get_r_position()-content%get_d_position()/2D0
- call cpu_time(this%cpu_time)
- this%cuba_time=this%cuba_time-this%cpu_time
- \IC{Wir fordern den Funktionswert in der Mitte des Segments an.}
- call this%evaluate(center,c_val)
- call cpu_time(this%cpu_time)
- this%cuba_time=this%cuba_time+this%cpu_time
- \IC{Wir teilen das Segment in zwei neue Segmente.}
- \IC{Siehe \TbpRef{muli\_trapezium\_type}{split}}
- call content%split(c_val,center,new_node)
- \IC{content ist das rechte Segment und immer noch in rightmost enthalten.}
- \IC{Wir können also das Blatt rightmost wieder in den Baum einfügen.}
- call this%err_tree%push_by_leave(rightmost)
- \IC{Fur das linke Segment new\_node muss noch ein neues Blatt erzeugt werden.}
- call this%err_tree%push_by_content(new_node)
- end select
- this%n_nodes=this%n_nodes+1
- \IC{Wenn die maximale Zahl von Blättern erreicht ist, dann müssen wir erfolglos aufhören.}
- if (this%n_nodes > this%max_nodes) then
- limit = .true.
- exit loop
- end if
- end if
- end do loop
- \IC{Ein Blatt halten wir noch in der Hand, wir legen es in den Baum zurück.}
- call this%err_tree%push_by_leave(rightmost)
- end subroutine aq_main_loop
-\end{Verbatim}
-
-\TbpImp{aq\_run}
-Wrapper für \ProcRef{aq\_main\_loop}.
-\begin{Verbatim}
- subroutine aq_run(this)
- class(aq_class) :: this
- call cpu_time(this%total_time)
- if (.not. this%is_error_tree_initialised) then
- call this%init_error_tree(this%dim_integral,this%region)
- end if
- this%is_run = .false.
- this%is_goal_reached = .false.
- call aq_main_loop(this)
- this%is_run = .true.
- call cpu_time(this%cpu_time)
- this%total_time=this%cpu_time-this%total_time
- end subroutine aq_run
-\end{Verbatim}
-
-\TbpImp{aq\_integrate}
-Die eigentliche Integration ist schon fertig, aber die Integrationssegmente sind nach Integrationsfehler sortiert. Wir wollen jetzt einen Binärbaum erzeugen, in dem die Segmente nach den x-Werten sortiert sind.
-\begin{Verbatim}
- subroutine aq_integrate(this,int_tree)
- class(aq_class) :: this
- class(\TypeRef{muli\_trapezium\_node\_class}),pointer :: node
- type(\TypeRef{muli\_trapezium\_tree\_type}),intent(out)::int_tree
- real(kind=double) :: sum
- this%is_integrated=.false.
- this%integral_error=0D0
- if (this%is_run) then
- call cpu_time(this%int_time)
- \IC{Umsortieren}
- call fibonacci_tree_resort_and_convert_to_trapezium_list&
- (this%err_tree,this%int_list)
- \IC{Die Integrale über die einzelnen Segmente aufaddieren}
- call muli_trapezium_list_integrate(this%int_list,this%integral,this%integral_error)
- \IC{Einen Baum aus der Liste machen}
- call this%int_list%to_tree(int_tree)
- this%is_integrated=.true.
- call cpu_time(this%cpu_time)
- this%int_time=this%cpu_time-this%int_time
- end if
- end subroutine aq_integrate
-\end{Verbatim}
-\MethodsNTB
-\ProcImp{fibonacci\_tree\_resort\_and\_convert\_to\_trapezium\_list}
-\begin{Verbatim}
- recursive subroutine fibonacci_tree_resort_and_convert_to_trapezium_list&
- (fib_tree,lin_list)
- \IC{usually, the tree is sorted by the sum of errors.}
- \IC{now it shall be sorted by the right position.}
- class(\TypeRef{fibonacci\_node\_type}),intent(in) :: fib_tree
- class(\TypeRef{fibonacci\_node\_type}),pointer :: leave
- class(\TypeRef{muli\_trapezium\_list\_type}),pointer,intent(out) :: lin_list
- class(\TypeRef{muli\_trapezium\_list\_type}),pointer :: left_list,right_list
- class(\TypeRef{muli\_trapezium\_node\_class}),pointer :: left_node,right_node,last_node
- class(\TypeRef{measurable\_class}),pointer :: content
- \IC{When at least one branch of the tree is itself a tree, i.e. each branch has}
- \IC{got at least two leaves, then process each branch and merge the results.}
- if (fib_tree%depth>1) then
- call fibonacci_tree_resort_and_convert_to_trapezium_list(fib_tree%left,left_list)
- call fibonacci_tree_resort_and_convert_to_trapezium_list(fib_tree%right,right_list)
- \IC{Now we got two sortet lists.}
- \IC{Which one's leftmost node has got the lowest value of "r_position"?}
- \IC{That one shall be the beginning of the merged list "lin_list".}
- if(left_list%is_left_of(right_list))then
- lin_list => left_list
- call left_list%get_right(left_node)
- right_node=>right_list
- else
- lin_list => right_list
- left_node=>left_list
- call right_list%get_right(right_node)
- end if
- last_node=>lin_list
- \IC{Everything is prepared for the algorithm: lin_list is the beginning of the}
- \IC{sorted list, last_node is it's end. left_node and right_node are the leftmost}
- \IC{nodes of the remainders of left_list and right_list. The latter will get}
- \IC{stripped from left to right, until one of them ends.}
- do while(associated(left_node).and.associated(right_node))
- if (left_node%is_left_of(right_node)) then
- call last_node%append(left_node)
- call last_node%get_right(last_node)
- call left_node%get_right(left_node)
- else
- call last_node%append(right_node)
- call last_node%get_right(last_node)
- call right_node%get_right(right_node)
- end if
- end do
- \IC{Either left_list or right_list is completely merged into lin_list. The other}
- \IC{one gets appended to lin_list.}
- if (associated(left_node)) then
- call last_node%append(left_node)
- else
- call last_node%append(right_node)
- end if
- \IC{It's done.}
- else
- \IC{The tree has got two leaves at most. Is it more than one?}
- if (fib_tree%depth == 0) then
- \IC{Here fib_tree is a single leave with an allocated "content" componet of}
- \IC{type muli_trapezium_type. If "content" is not type compatible with}
- \IC{muli_trapezium_type, then this whole conversion cannot succeed. }
- \IC{We allocate a new node of type muli_trapezium_list_type. This list does}
- \IC{not contain the content of fib_tree, it *IS* a copy of the content, for}
- \IC{muli_trapezium_list_type is an extension of muli_trapezium_type.}
- select type (fib_tree)
- class is (fibonacci_leave_type)
- call fib_tree%get_content(content)
- select type (content)
- class is (muli_trapezium_type)
- call muli_trapezium_to_node(content,content%get_r_position(),list=lin_list)
- class default
- print *,"fibonacci_tree_resort_and_convert_to_trapezium_list: &
- &Content of fibonacci_tree is not type compatible to &
- &muli_trapezium_type"
- end select
- end select
- else
- \IC{Each branch of fib_tree is a single leave. We could call this soubroutine}
- \IC{for each branch, but we do copy and paste for each branch instead.}
- leave=>fib_tree%left
- select type (leave)
- class is (fibonacci_leave_type)
- call leave%get_content(content)
- select type (content)
- class is (muli_trapezium_type)
- call muli_trapezium_to_node(content,content%get_r_position(),list=left_list)
- class default
- print *,"fibonacci_tree_resort_and_convert_to_trapezium_list: &
- &Content of fibonacci_tree is not type compatible to &
- &muli_trapezium_type"
- end select
- end select
- leave=>fib_tree%right
- select type (leave)
- class is (fibonacci_leave_type)
- call leave%get_content(content)
- select type (content)
- class is (muli_trapezium_type)
- call muli_trapezium_to_node%
- (content,content%get_r_position(),list=right_list)
- class default
- print *,"fibonacci_tree_resort_and_convert_to_trapezium_list: &
- &Content of fibonacci_tree is not type compatible to &
- &muli_trapezium_type"
- end select
- end select
- \IC{Finally we append one list to the other, the lowest value of "r_position"}
- \IC{comes first.}
- if (left_list%is_left_of(right_list)) then
- call left_list%append(right_list)
- lin_list=>left_list
- else
- call right_list%append(left_list)
- lin_list=>right_list
- end if
- end if
- end if
- end subroutine fibonacci_tree_resort_and_convert_to_trapezium_list
-\end{Verbatim}
-
Index: trunk/src/muli/doc/icons.mp
===================================================================
--- trunk/src/muli/doc/icons.mp (revision 8371)
+++ trunk/src/muli/doc/icons.mp (revision 8372)
@@ -1,8 +0,0 @@
-input common;
-
-beginfig(1)
- numeric unit;
- unit=7;
- draw_extends((0,0),(0,1),(0,0));
-endfig;
-end;
Index: trunk/src/muli/doc/muli_momentum.tex
===================================================================
--- trunk/src/muli/doc/muli_momentum.tex (revision 8371)
+++ trunk/src/muli/doc/muli_momentum.tex (revision 8372)
@@ -1,324 +0,0 @@
-\Module{muli\_momentum}
-%\begin{figure}
-% \centering{\includegraphics{uml-module-tree-6.mps}}
-% \caption{\label{fig:\ThisModule:Types}Klassendiagramm des Moduls \ThisModule}
-%\end{figure}
-\section{Abhängigkeiten}
-\use{muli\_basic}
-\section{Derived Types}
-\TypeDef{transversal\_momentum\_type}
-Dieser Datentyp abstrahiert den Entwicklungsparameter $\pperp$. Intern wird $\pperp$ durch die Komponente \LocalVar{momentum} dargestellt. Dieser enthält die fünf Einträge $\big[s, \sqrt{\pperp}, \pperp, \sqrt{4*\pperp/s}, 4*\pperp/s\big]$. Für jeden Eintrag werden get und set Methoden bereitgestellt. Wenn statt eines Werts von $\pperp$ eine Instanz vom Typ \LocalVar{transversal\_momentum\_type} übergeben wird, werden Fehler durch falsche Einheiten vermieden.
-
-Nach MulI-Konvention wird die Einheit immer vor den Namen der Variable gestellt, also GeV\_scale für $\sqrt{\pperp}$ und GeV2\_scale für $\pperp$ usw. Hier wird bei dimensionslosen Größen $\sim\sqrt{\pperp}$ das Prefix unit und bei dimensionslosen Größen $\sim\pperp$ das prefix unit2 vorangestellt, damit immer klar ist, was gemeint ist.
-
-\LocalVar{MaxScale} ist der größtmögliche Wert für $\pperp$, mit $\pperp^{\max}=s/2$.
-
-\wip{Die invariante Masse $s$ wird hier \LocalVar{initial\_cme} genannt. Letzteres ist die invariante Masse des Proton-Proton-Systems vor der ersten (WHIZARD) Wechselwirkung. Das spiegelt die Tatsache wider, dass dynamische Energieen der Remnants noch nicht implementiert sind. Dieser Datentyp ist der richtige Ort, um die aktuelle CME zu speichern. Da alle anderen Module auf die get-Methoden dieses Moduls zurückgreifen, sollte es ausreichen, die interne Darstellung hier anzupassen.}
-
-\begin{Verbatim}
-implicit none
- type,\Extends{serializable\_class}::transversal_momentum_type
- private
- real(kind=drk),dimension(0:4)::\TC{momentum}=[0D0,0D0,0D0,0D0,0D0]
- contains
- \OverridesDeclaration{serializable\_class}
- procedure,public::\TbpDec{write\_to\_marker}{transversal\_momentum\_write\_to\_marker}
- procedure,public::\TbpDec{read\_from\_marker}{transversal\_momentum\_read\_from\_marker}
- procedure,public::\TbpDec{print\_to\_unit}{transversal\_momentum\_print\_to\_unit}
- procedure,public,nopass::\TbpDec{get\_type}{transversal\_momentum\_get\_type}
- \OriginalDeclaration{transversal\_momentum\_type}
- procedure,public::\TbpDec{get\_gev\_initial\_cme}{transversal\_momentum\_get\_gev\_initial\_cme}
- procedure,public::\TbpDec{get\_gev\_max\_scale}{transversal\_momentum\_get\_gev\_max\_scale}
- procedure,public::\TbpDec{get\_gev2\_max\_scale}{transversal\_momentum\_get\_gev2\_max\_scale}
- procedure,public::\TbpDec{get\_gev\_scale}{transversal\_momentum\_get\_gev\_scale}
- procedure,public::\TbpDec{get\_gev2\_scale}{transversal\_momentum\_get\_gev2\_scale}
- procedure,public::\TbpDec{get\_unit\_scale}{transversal\_momentum\_get\_unit\_scale}
- procedure,public::\TbpDec{get\_unit2\_scale}{transversal\_momentum\_get\_unit2\_scale}
- procedure,public::\TbpDec{set\_gev\_initial\_cme}{transversal\_momentum\_set\_gev\_initial\_cme}
- procedure,public::\TbpDec{set\_gev\_max\_scale}{transversal\_momentum\_set\_gev\_max\_scale}
- procedure,public::\TbpDec{set\_gev2\_max\_scale}{transversal\_momentum\_set\_gev2\_max\_scale}
- procedure,public::\TbpDec{set\_gev\_scale}{transversal\_momentum\_set\_gev\_scale}
- procedure,public::\TbpDec{set\_gev2\_scale}{transversal\_momentum\_set\_gev2\_scale}
- procedure,public::\TbpDec{set\_unit\_scale}{transversal\_momentum\_set\_unit\_scale}
- procedure,public::\TbpDec{set\_unit2\_scale}{transversal\_momentum\_set\_unit2\_scale}
- procedure,public::\TbpDecS{transversal\_momentum\_initialize}
- generic,public::\TbpDec{initialize}{transversal\_momentum\_initialize}
- end type transversal_momentum_type
-\end{Verbatim}
-\TypeDef{qcd\_2\_2\_class}
-Abstrakte Klasse, die eine QCD-2$\rightarrow$2-Wechselwirkung abstrahiert. \TypeRef{pp\_remnant\_type} greift auf Eigenschaften einer solchen Wechselwirkung zurück, allerdings werden die Methoden in dem Modul \ModuleRef{muli} implementiert, auf das \ModuleRef{muli\_remnant} keinen Zugriff hat. Zwar könnte man dieses Problem durch eine andere Hierarchie von Modulen lösen, aber ich nehme an, dass dieses Problem wieder auftaucht, wenn die Remnants als WHIZARD-Strukturfunktionen implementiert werden. Deswegen habe ich diese Lösung gewählt.
-\begin{Verbatim}
- type,Extends{transversal\_momentum\_type},abstract::qcd_2_2_class
- contains
- procedure(qcd_get_int),deferred::\TbpDef{get\_process\_id}
- procedure(qcd_get_int),deferred::\TbpDef{get\_integrand\_id}
- procedure(qcd_get_int),deferred::\TbpDef{get\_diagram\_kind}
- procedure(qcd_get_int_4),deferred::\TbpDef{get\_lha\_flavors}
- procedure(qcd_get_int_4),deferred::\TbpDef{get\_pdg\_flavors}
- procedure(qcd_get_int_by_int),deferred::\TbpDef{get\_parton\_id}
- procedure(qcd_get_int_2),deferred::\TbpDef{get\_parton\_kinds}
- procedure(qcd_get_int_2),deferred::\TbpDef{get\_pdf\_int\_kinds}
- procedure(qcd_get_drk),deferred::\TbpDef{get\_momentum\_boost}
- procedure(qcd_get_drk_2),deferred::\TbpDef{get\_remnant\_momentum\_fractions}
- procedure(qcd_get_drk_2),deferred::\TbpDef{get\_total\_momentum\_fractions}
- end type qcd_2_2_class
-\end{Verbatim}
-\section{Interfaces}
-\begin{Verbatim}
- abstract interface
- subroutine qcd_none(this)
- import qcd_2_2_class
- class(qcd_2_2_class),target,intent(in)::this
- end subroutine qcd_none
- elemental function qcd_get_drk(this)
- use muli_basic, only: drk
- import qcd_2_2_class
- class(qcd_2_2_class),intent(in)::this
- real(kind=drk)::qcd_get_drk
- end function qcd_get_drk
- pure function qcd_get_drk_2(this)
- use muli_basic, only: drk
- import qcd_2_2_class
- class(qcd_2_2_class),intent(in)::this
- real(kind=drk),dimension(2)::qcd_get_drk_2
- end function qcd_get_drk_2
- pure function qcd_get_drk_3(this)
- use muli_basic, only: drk
- import qcd_2_2_class
- class(qcd_2_2_class),intent(in)::this
- real(kind=drk),dimension(3)::qcd_get_drk_3
- end function qcd_get_drk_3
- elemental function qcd_get_int(this)
- use muli_basic, only: drk
- import qcd_2_2_class
- class(qcd_2_2_class),intent(in)::this
- integer::qcd_get_int
- end function qcd_get_int
- elemental function qcd_get_int_by_int(this,n)
- use muli_basic, only: drk
- import qcd_2_2_class
- class(qcd_2_2_class),intent(in)::this
- integer,intent(in)::n
- integer::qcd_get_int_by_int
- end function qcd_get_int_by_int
- pure function qcd_get_int_2(this)
- use muli_basic, only: drk
- import qcd_2_2_class
- class(qcd_2_2_class),intent(in)::this
- integer,dimension(2)::qcd_get_int_2
- end function qcd_get_int_2
- pure function qcd_get_int_4(this)
- use muli_basic, only: drk
- import qcd_2_2_class
- class(qcd_2_2_class),intent(in)::this
- integer,dimension(4)::qcd_get_int_4
- end function qcd_get_int_4
- end interface
-\end{Verbatim}
-\Methods
-\MethodsFor{transversal\_momentum\_type}
-\OverridesSection{serializable\_class}
-\TbpImp{transversal\_momentum\_write\_to\_marker}
-\begin{Verbatim}
- subroutine transversal_momentum_write_to_marker(this,marker,status)
- class(transversal_momentum_type),intent(in)::this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
- call marker%mark_begin("transversal_momentum_type")
- call marker%mark("gev_momenta",this%momentum(0:1))
- call marker%mark_end("transversal_momentum_type")
- end subroutine transversal_momentum_write_to_marker
-\end{Verbatim}
-\TbpImp{transversal\_momentum\_read\_from\_marker}
-\begin{Verbatim}
- subroutine transversal_momentum_read_from_marker(this,marker,status)
- class(transversal_momentum_type),intent(out)::this
- class(marker_type),intent(inout)::marker
- integer(kind=dik),intent(out)::status
- call marker%pick_begin("transversal_momentum_type",status=status)
- call marker%pick("gev_momenta",this%momentum(0:1),status)
- this%momentum(2:4)=[&
- this%momentum(1)**2,&
- this%momentum(1)/this%momentum(0),&
- (this%momentum(1)/this%momentum(0))**2]
- call marker%pick_end("transversal_momentum_type",status=status)
- end subroutine transversal_momentum_read_from_marker
-\end{Verbatim}
-\TbpImp{transversal\_momentum\_print\_to\_unit}
-\begin{Verbatim}
- subroutine transversal_momentum_print_to_unit(this,unit,parents,components,peers)
- class(transversal_momentum_type),intent(in)::this
- integer,intent(in)::unit
- integer(kind=dik),intent(in)::parents,components,peers
- write(unit,'("Components of transversal_momentum_type:")')
- write(unit,fmt='("Actual energy scale:")')
- write(unit,fmt='("Max scale (MeV) :",E20.10)')this%momentum(0)
- write(unit,fmt='("Scale (MeV) :",E20.10)')this%momentum(1)
- write(unit,fmt='("Scale^2 (MeV^2) :",E20.10)')this%momentum(2)
- write(unit,fmt='("Scale normalized :",E20.10)')this%momentum(3)
- write(unit,fmt='("Scale^2 normalized:",E20.10)')this%momentum(4)
- end subroutine transversal_momentum_print_to_unit
- \end{Verbatim}
-\TbpImp{transversal\_momentum\_get\_type}
-\begin{Verbatim}
- pure subroutine transversal_momentum_get_type(type)
- character(:),allocatable,intent(out)::type
- allocate(type,source="transversal_momentum_type")
- end subroutine transversal_momentum_get_type
-\end{Verbatim}
-\OriginalSection{transversal\_momentum\_type}
-\TbpImp{transversal\_momentum\_get\_gev\_initial\_cme}
-\begin{Verbatim}
- elemental function transversal_momentum_get_gev_initial_cme(this) result(scale)
- class(transversal_momentum_type),intent(in)::this
- real(kind=drk)::scale
- scale=this%momentum(0)*2D0
- end function transversal_momentum_get_gev_initial_cme
-\end{Verbatim}
-\TbpImp{transversal\_momentum\_get\_gev\_max\_scale}
-
-\TbpImp{transversal\_momentum\_get\_gev\_max\_scale}
-\begin{Verbatim}
- elemental function transversal_momentum_get_gev_max_scale(this) result(scale)
- class(transversal_momentum_type),intent(in)::this
- real(kind=drk)::scale
- scale=this%momentum(0)
- end function transversal_momentum_get_gev_max_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_get\_gev2\_max\_scale}
-\begin{Verbatim}
- elemental function transversal_momentum_get_gev2_max_scale(this) result(scale)
- class(transversal_momentum_type),intent(in)::this
- real(kind=drk)::scale
- scale=this%momentum(0)**2
- end function transversal_momentum_get_gev2_max_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_get\_gev\_scale}
-\begin{Verbatim}
- elemental function transversal_momentum_get_gev_scale(this) result(scale)
- class(transversal_momentum_type),intent(in)::this
- real(kind=drk)::scale
- scale=this%momentum(1)
- end function transversal_momentum_get_gev_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_get\_gev2\_scale}
-\begin{Verbatim}
- elemental function transversal_momentum_get_gev2_scale(this) result(scale)
- class(transversal_momentum_type),intent(in)::this
- real(kind=drk)::scale
- scale=this%momentum(2)
- end function transversal_momentum_get_gev2_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_get\_unit\_scale}
-\begin{Verbatim}
- elemental function transversal_momentum_get_unit_scale(this) result(scale)
- class(transversal_momentum_type),intent(in)::this
- real(kind=drk)::scale
- scale=this%momentum(3)
- end function transversal_momentum_get_unit_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_get\_unit2\_scale}
-\begin{Verbatim}
- elemental function transversal_momentum_get_unit2_scale(this) result(scale)
- class(transversal_momentum_type),intent(in)::this
- real(kind=drk)::scale
- scale=this%momentum(4)
- end function transversal_momentum_get_unit2_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_set\_gev\_initial\_cme}
-\begin{Verbatim}
- subroutine transversal_momentum_set_gev_initial_cme(this,new_gev_initial_cme)
- class(transversal_momentum_type),intent(inout)::this
- real(kind=drk),intent(in) :: new_gev_initial_cme
- this%momentum(0) = new_gev_initial_cme/2D0
- this%momentum(3) = this%momentum(1)/this%momentum(0)
- this%momentum(4) = this%momentum(3)**2
- end subroutine transversal_momentum_set_gev_initial_cme
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_set\_gev\_max\_scale}
-\begin{Verbatim}
- subroutine transversal_momentum_set_gev_max_scale(this,new_gev_max_scale)
- class(transversal_momentum_type),intent(inout)::this
- real(kind=drk),intent(in) :: new_gev_max_scale
- this%momentum(0) = new_gev_max_scale
- this%momentum(3) = this%momentum(1)/this%momentum(0)
- this%momentum(4) = this%momentum(3)**2
- end subroutine transversal_momentum_set_gev_max_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_set\_gev2\_max\_scale}
-\begin{Verbatim}
- subroutine transversal_momentum_set_gev2_max_scale(this,new_gev2_max_scale)
- class(transversal_momentum_type),intent(inout)::this
- real(kind=drk),intent(in) :: new_gev2_max_scale
- this%momentum(0) = sqrt(new_gev2_max_scale)
- this%momentum(3) = this%momentum(1)/this%momentum(0)
- this%momentum(4) = this%momentum(3)**2
- end subroutine transversal_momentum_set_gev2_max_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_set\_gev\_scale}
-\begin{Verbatim}
- subroutine transversal_momentum_set_gev_scale(this,new_gev_scale)
- class(transversal_momentum_type),intent(inout)::this
- real(kind=drk),intent(in) :: new_gev_scale
- this%momentum(1) = new_gev_scale
- this%momentum(2) = new_gev_scale**2
- this%momentum(3) = new_gev_scale/this%momentum(0)
- this%momentum(4) = this%momentum(3)**2
- end subroutine transversal_momentum_set_gev_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_set\_gev2\_scale}
-\begin{Verbatim}
- subroutine transversal_momentum_set_gev2_scale(this,new_gev2_scale)
- class(transversal_momentum_type),intent(inout)::this
- real(kind=drk),intent(in) :: new_gev2_scale
- this%momentum(1) = sqrt(new_gev2_scale)
- this%momentum(2) = new_gev2_scale
- this%momentum(3) = this%momentum(1)/this%momentum(0)
- this%momentum(4) = this%momentum(3)**2
- end subroutine transversal_momentum_set_gev2_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_set\_unit\_scale}
-\begin{Verbatim}
- subroutine transversal_momentum_set_unit_scale(this,new_unit_scale)
- class(transversal_momentum_type),intent(inout)::this
- real(kind=drk),intent(in) :: new_unit_scale
- this%momentum(1) = new_unit_scale*this%momentum(0)
- this%momentum(2) = this%momentum(1)**2
- this%momentum(3) = new_unit_scale
- this%momentum(4) = this%momentum(3)**2
- end subroutine transversal_momentum_set_unit_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_set\_unit2\_scale}
-\begin{Verbatim}
- subroutine transversal_momentum_set_unit2_scale(this,new_unit2_scale)
- class(transversal_momentum_type),intent(inout)::this
- real(kind=drk),intent(in) :: new_unit2_scale
- this%momentum(3) = sqrt(new_unit2_scale)
- this%momentum(4) = new_unit2_scale
- this%momentum(1) = this%momentum(3)*this%momentum(0)
- this%momentum(2) = this%momentum(1)**2
- end subroutine transversal_momentum_set_unit2_scale
-\end{Verbatim}
-
-\TbpImp{transversal\_momentum\_initialize}
-\begin{Verbatim}
- subroutine transversal_momentum_initialize(this,gev2_s)
- class(transversal_momentum_type),intent(out)::this
- real(kind=drk),intent(in)::gev2_s
- real(kind=drk)::gev_s
- gev_s=sqrt(gev2_s)
- this%momentum=[gev_s/2D0,gev_s/2D0,gev2_s/4D0,1D0,1D0]
- end subroutine transversal_momentum_initialize
-\end{Verbatim}
Index: trunk/src/muli/doc/muli_interactions.tex
===================================================================
--- trunk/src/muli/doc/muli_interactions.tex (revision 8371)
+++ trunk/src/muli/doc/muli_interactions.tex (revision 8372)
@@ -1,1880 +0,0 @@
-\Module{muli\_interactions}
-%\begin{figure}
-% \centering{\includegraphics{uml-module-tree-12.mps}}
-% \caption{\label{fig:\ThisModule:Types}Klassendiagramm des Moduls \ThisModule}
-%\end{figure}
-\section{Abhängigkeiten}
-\use{muli\_momentum}
-\section{Parameter}
-\begin{Verbatim}
- implicit none
- !process parameters
- integer,parameter::hadron_A_kind=2212 ! Proton
- integer,parameter::hadron_B_kind=-2212 ! Anti Proton
- integer,dimension(4),parameter::parton_kind_of_int_kind=[1,1,2,2]
- real(kind=double), parameter :: b_sigma_tot_all = 100 !mb PDG
- real(kind=double), parameter :: b_sigma_tot_nd = 0.5*b_sigma_tot_all !phys.rev.d v49 n5 1994
- real(kind=double), parameter :: gev_cme_tot = 14000 !total center of mass energie
- real(kind=double), parameter :: gev2_cme_tot = gev_cme_tot**2 !s
- real(kind=double), parameter :: gev_pt_max = gev_cme_tot/2D0
- real(kind=double), parameter :: gev2_pt_max = gev2_cme_tot/4D0
- !model parameters
- real(kind=double), parameter :: gev_pt_min = 8D-1
- real(kind=double), parameter :: gev2_pt_min = gev_pt_min**2
- real(kind=double), parameter :: pts_min = gev_pt_min/gev_pt_max
- real(kind=double), parameter :: pts2_min = gev2_pt_min/gev2_pt_max
- real(kind=double), parameter :: gev_p_t_0 = 2.0
- real(kind=double), parameter :: gev2_p_t_0 = gev_p_t_0**2
- real(kind=double), parameter :: norm_p_t_0 = gev_p_t_0/gev_pt_max
- real(kind=double), parameter :: norm2_p_t_0 = gev2_p_t_0/gev2_pt_max
- !mathematical constants
- real(kind=double),private,parameter :: pi = 3.14159265
- real(kind=double),parameter :: euler = exp(1D0)
- !physical constants
- real(kind=double), parameter :: gev2_mbarn = 0.389379304D0
- real(kind=double), parameter :: const_pref=pi*gev2_mbarn/(gev2_cme_tot*b_sigma_tot_nd)
- !parton kind parameters
- integer,parameter,public::lha_flavor_at=-6
- integer,parameter,public::lha_flavor_ab=-5
- integer,parameter,public::lha_flavor_ac=-4
- integer,parameter,public::lha_flavor_as=-3
- integer,parameter,public::lha_flavor_au=-2
- integer,parameter,public::lha_flavor_ad=-1
- integer,parameter,public::lha_flavor_g=0
- integer,parameter,public::lha_flavor_d=1
- integer,parameter,public::lha_flavor_u=2
- integer,parameter,public::lha_flavor_s=3
- integer,parameter,public::lha_flavor_c=4
- integer,parameter,public::lha_flavor_b=5
- integer,parameter,public::lha_flavor_t=6
- integer,parameter,public::pdg_flavor_at=-6
- integer,parameter,public::pdg_flavor_ab=-5
- integer,parameter,public::pdg_flavor_ac=-4
- integer,parameter,public::pdg_flavor_as=-3
- integer,parameter,public::pdg_flavor_au=-2
- integer,parameter,public::pdg_flavor_ad=-1
- integer,parameter,public::pdg_flavor_g=21
- integer,parameter,public::pdg_flavor_d=1
- integer,parameter,public::pdg_flavor_u=2
- integer,parameter,public::pdg_flavor_s=3
- integer,parameter,public::pdg_flavor_c=4
- integer,parameter,public::pdg_flavor_b=5
- integer,parameter,public::pdg_flavor_t=6
- integer,parameter,public::parton_kind_sea=1
- integer,parameter,public::parton_kind_valence=2
- integer,parameter,public::parton_kind_sea_and_valence=3
- integer,parameter,public::parton_kind_twin=4
- integer,parameter,public::parton_kind_sea_and_twin=5
- integer,parameter,public::parton_kind_valence_and_twin=6
- integer,parameter,public::parton_kind_all=7
- integer,parameter,public::\MC{pdf\_int\_kind\_undef}=0
- integer,parameter,public::\MC{pdf\_int\_kind\_gluon}=1
- integer,parameter,public::\MC{pdf\_int\_kind\_sea}=2
- integer,parameter,public::\MC{pdf\_int\_kind\_val\_down}=3
- integer,parameter,public::\MC{pdf\_int\_kind\_val\_up}=4
- integer,parameter,public::\MC{pdf\_int\_kind\_twin}=5
- character(len=2),dimension(-6:6),parameter :: integer_parton_names = &
- &["-6","-5","-4","-3","-2","-1","00","+1","+2","+3","+4","+5","+6"]
- character,dimension(-6:6),parameter :: traditional_parton_names = &
- &["T","B","C","S","U","D","g","d","u","s","c","b","t"]
- !ps polynom coefficients
- ! evolution variable is pt2s/(x1*x2)
- real(kind=double),dimension(1:4,1:5),parameter :: phase_space_coefficients_in&
- = reshape(source=[&
- & 6144D0, -4608D0, +384D0, 0D0,&
- & 6144D0, -5120D0, +384D0, 0D0,&
- & 6144D0, -2048D0, +128D0, -576D0,&
- &13824D0, -9600D0, +1056D0, 0D0,&
- &31104D0,-19872D0, +2160D0, +486D0],&
- &shape=[4,5])
-
- ! evolution variable is pt2s/(x1*x2)
- real(kind=double),dimension(1:4,1:8),parameter :: phase_space_coefficients_inout&
- = reshape(source=[&
- &3072, -2304, +192, 0, &
- &6144, -5120, +384, 0, &
- &0, 0, 192, -96, &
- &3072, -2048, +192, -96, &
- &0, 2048, -2176, +576, &
- &0, 288, -306, +81, &
- &6912, -4800, +528, 0, &
- &31104,-23328, +5832, -486],&
- &shape=[4,8])
-
- integer,dimension(1:4,0:8),parameter :: inout_signatures = reshape(source=[&
- 1, 1, 1, 1,&!1a
- -1, 1,-1, 1,&!1b
- 1, 1, 1, 1,&!2
- 1,-1, 1,-1,&!3
- 1,-1, 1,-1,&!4
- 1,-1, 0, 0,&!5
- 0, 0, 1,-1,&!6
- 1, 0, 1, 0,&!7
- 0, 0, 0, 0],&
- shape=[4,9])
-
- integer,dimension(6,-234:234),parameter::\MC{valid\_processes}=reshape([&
- -6, -6, -6, -6, 2, 2,&!-234
- -6, -5, -6, -5, 1, 1,&!-233
- -6, -5, -5, -6, 1, 1,&!-232
- -6, -4, -6, -4, 1, 1,&!-231
- -6, -4, -4, -6, 1, 1,&!-230
- -6, -3, -6, -3, 1, 1,&!-229
- -6, -3, -3, -6, 1, 1,&!-228
- -6, -2, -6, -2, 1, 1,&!-227
- -6, -2, -2, -6, 1, 1,&!-226
- -6, -1, -6, -1, 1, 1,&!-225
- -6, -1, -1, -6, 1, 1,&!-224
- -6, 0, -6, 0, 4, 7,&!-223
- -6, 0, 0, -6, 4, 7,&!-222
- -6, 1, -6, 1, 1, 1,&!-221
- -6, 1, 1, -6, 1, 1,&!-220
- -6, 2, -6, 2, 1, 1,&!-219
- -6, 2, 2, -6, 1, 1,&!-218
- -6, 3, -6, 3, 1, 1,&!-217
- -6, 3, 3, -6, 1, 1,&!-216
- -6, 4, -6, 4, 1, 1,&!-215
- -6, 4, 4, -6, 1, 1,&!-214
- -6, 5, -6, 5, 1, 1,&!-213
- -6, 5, 5, -6, 1, 1,&!-212
- -6, 6, -6, 6, 3, 4,&!-211
- -6, 6, -5, 5, 3, 3,&!-210
- -6, 6, -4, 4, 3, 3,&!-209
- -6, 6, -3, 3, 3, 3,&!-208
- -6, 6, -2, 2, 3, 3,&!-207
- -6, 6, -1, 1, 3, 3,&!-206
- -6, 6, 0, 0, 3, 5,&!-205
- -6, 6, 1, -1, 3, 3,&!-204
- -6, 6, 2, -2, 3, 3,&!-203
- -6, 6, 3, -3, 3, 3,&!-202
- -6, 6, 4, -4, 3, 3,&!-201
- -6, 6, 5, -5, 3, 3,&!-200
- -6, 6, 6, -6, 3, 4,&!-199
- -5, -6, -6, -5, 1, 1,&!-198
- -5, -6, -5, -6, 1, 1,&!-197
- -5, -5, -5, -5, 2, 2,&!-196
- -5, -4, -5, -4, 1, 1,&!-195
- -5, -4, -4, -5, 1, 1,&!-194
- -5, -3, -5, -3, 1, 1,&!-193
- -5, -3, -3, -5, 1, 1,&!-192
- -5, -2, -5, -2, 1, 1,&!-191
- -5, -2, -2, -5, 1, 1,&!-190
- -5, -1, -5, -1, 1, 1,&!-189
- -5, -1, -1, -5, 1, 1,&!-188
- -5, 0, -5, 0, 4, 7,&!-187
- -5, 0, 0, -5, 4, 7,&!-186
- -5, 1, -5, 1, 1, 1,&!-185
- -5, 1, 1, -5, 1, 1,&!-184
- -5, 2, -5, 2, 1, 1,&!-183
- -5, 2, 2, -5, 1, 1,&!-182
- -5, 3, -5, 3, 1, 1,&!-181
- -5, 3, 3, -5, 1, 1,&!-180
- -5, 4, -5, 4, 1, 1,&!-179
- -5, 4, 4, -5, 1, 1,&!-178
- -5, 5, -6, 6, 3, 3,&!-177
- -5, 5, -5, 5, 3, 4,&!-176
- -5, 5, -4, 4, 3, 3,&!-175
- -5, 5, -3, 3, 3, 3,&!-174
- -5, 5, -2, 2, 3, 3,&!-173
- -5, 5, -1, 1, 3, 3,&!-172
- -5, 5, 0, 0, 3, 5,&!-171
- -5, 5, 1, -1, 3, 3,&!-170
- -5, 5, 2, -2, 3, 3,&!-169
- -5, 5, 3, -3, 3, 3,&!-168
- -5, 5, 4, -4, 3, 3,&!-167
- -5, 5, 5, -5, 3, 4,&!-166
- -5, 5, 6, -6, 3, 3,&!-165
- -5, 6, -5, 6, 1, 1,&!-164
- -5, 6, 6, -5, 1, 1,&!-163
- -4, -6, -6, -4, 1, 1,&!-162
- -4, -6, -4, -6, 1, 1,&!-161
- -4, -5, -5, -4, 1, 1,&!-160
- -4, -5, -4, -5, 1, 1,&!-159
- -4, -4, -4, -4, 2, 2,&!-158
- -4, -3, -4, -3, 1, 1,&!-157
- -4, -3, -3, -4, 1, 1,&!-156
- -4, -2, -4, -2, 1, 1,&!-155
- -4, -2, -2, -4, 1, 1,&!-154
- -4, -1, -4, -1, 1, 1,&!-153
- -4, -1, -1, -4, 1, 1,&!-152
- -4, 0, -4, 0, 4, 7,&!-151
- -4, 0, 0, -4, 4, 7,&!-150
- -4, 1, -4, 1, 1, 1,&!-149
- -4, 1, 1, -4, 1, 1,&!-148
- -4, 2, -4, 2, 1, 1,&!-147
- -4, 2, 2, -4, 1, 1,&!-146
- -4, 3, -4, 3, 1, 1,&!-145
- -4, 3, 3, -4, 1, 1,&!-144
- -4, 4, -6, 6, 3, 3,&!-143
- -4, 4, -5, 5, 3, 3,&!-142
- -4, 4, -4, 4, 3, 4,&!-141
- -4, 4, -3, 3, 3, 3,&!-140
- -4, 4, -2, 2, 3, 3,&!-139
- -4, 4, -1, 1, 3, 3,&!-138
- -4, 4, 0, 0, 3, 5,&!-137
- -4, 4, 1, -1, 3, 3,&!-136
- -4, 4, 2, -2, 3, 3,&!-135
- -4, 4, 3, -3, 3, 3,&!-134
- -4, 4, 4, -4, 3, 4,&!-133
- -4, 4, 5, -5, 3, 3,&!-132
- -4, 4, 6, -6, 3, 3,&!-131
- -4, 5, -4, 5, 1, 1,&!-130
- -4, 5, 5, -4, 1, 1,&!-129
- -4, 6, -4, 6, 1, 1,&!-128
- -4, 6, 6, -4, 1, 1,&!-127
- -3, -6, -6, -3, 1, 1,&!-126
- -3, -6, -3, -6, 1, 1,&!-125
- -3, -5, -5, -3, 1, 1,&!-124
- -3, -5, -3, -5, 1, 1,&!-123
- -3, -4, -4, -3, 1, 1,&!-122
- -3, -4, -3, -4, 1, 1,&!-121
- -3, -3, -3, -3, 2, 2,&!-120
- -3, -2, -3, -2, 1, 1,&!-119
- -3, -2, -2, -3, 1, 1,&!-118
- -3, -1, -3, -1, 1, 1,&!-117
- -3, -1, -1, -3, 1, 1,&!-116
- -3, 0, -3, 0, 4, 7,&!-115
- -3, 0, 0, -3, 4, 7,&!-114
- -3, 1, -3, 1, 1, 1,&!-113
- -3, 1, 1, -3, 1, 1,&!-112
- -3, 2, -3, 2, 1, 1,&!-111
- -3, 2, 2, -3, 1, 1,&!-110
- -3, 3, -6, 6, 3, 3,&!-109
- -3, 3, -5, 5, 3, 3,&!-108
- -3, 3, -4, 4, 3, 3,&!-107
- -3, 3, -3, 3, 3, 4,&!-106
- -3, 3, -2, 2, 3, 3,&!-105
- -3, 3, -1, 1, 3, 3,&!-104
- -3, 3, 0, 0, 3, 5,&!-103
- -3, 3, 1, -1, 3, 3,&!-102
- -3, 3, 2, -2, 3, 3,&!-101
- -3, 3, 3, -3, 3, 4,&!-100
- -3, 3, 4, -4, 3, 3,&! -99
- -3, 3, 5, -5, 3, 3,&! -98
- -3, 3, 6, -6, 3, 3,&! -97
- -3, 4, -3, 4, 1, 1,&! -96
- -3, 4, 4, -3, 1, 1,&! -95
- -3, 5, -3, 5, 1, 1,&! -94
- -3, 5, 5, -3, 1, 1,&! -93
- -3, 6, -3, 6, 1, 1,&! -92
- -3, 6, 6, -3, 1, 1,&! -91
- -2, -6, -6, -2, 1, 1,&! -90
- -2, -6, -2, -6, 1, 1,&! -89
- -2, -5, -5, -2, 1, 1,&! -88
- -2, -5, -2, -5, 1, 1,&! -87
- -2, -4, -4, -2, 1, 1,&! -86
- -2, -4, -2, -4, 1, 1,&! -85
- -2, -3, -3, -2, 1, 1,&! -84
- -2, -3, -2, -3, 1, 1,&! -83
- -2, -2, -2, -2, 2, 2,&! -82
- -2, -1, -2, -1, 1, 1,&! -81
- -2, -1, -1, -2, 1, 1,&! -80
- -2, 0, -2, 0, 4, 7,&! -79
- -2, 0, 0, -2, 4, 7,&! -78
- -2, 1, -2, 1, 1, 1,&! -77
- -2, 1, 1, -2, 1, 1,&! -76
- -2, 2, -6, 6, 3, 3,&! -75
- -2, 2, -5, 5, 3, 3,&! -74
- -2, 2, -4, 4, 3, 3,&! -73
- -2, 2, -3, 3, 3, 3,&! -72
- -2, 2, -2, 2, 3, 4,&! -71
- -2, 2, -1, 1, 3, 3,&! -70
- -2, 2, 0, 0, 3, 5,&! -69
- -2, 2, 1, -1, 3, 3,&! -68
- -2, 2, 2, -2, 3, 4,&! -67
- -2, 2, 3, -3, 3, 3,&! -66
- -2, 2, 4, -4, 3, 3,&! -65
- -2, 2, 5, -5, 3, 3,&! -64
- -2, 2, 6, -6, 3, 3,&! -63
- -2, 3, -2, 3, 1, 1,&! -62
- -2, 3, 3, -2, 1, 1,&! -61
- -2, 4, -2, 4, 1, 1,&! -60
- -2, 4, 4, -2, 1, 1,&! -59
- -2, 5, -2, 5, 1, 1,&! -58
- -2, 5, 5, -2, 1, 1,&! -57
- -2, 6, -2, 6, 1, 1,&! -56
- -2, 6, 6, -2, 1, 1,&! -55
- -1, -6, -6, -1, 1, 1,&! -54
- -1, -6, -1, -6, 1, 1,&! -53
- -1, -5, -5, -1, 1, 1,&! -52
- -1, -5, -1, -5, 1, 1,&! -51
- -1, -4, -4, -1, 1, 1,&! -50
- -1, -4, -1, -4, 1, 1,&! -49
- -1, -3, -3, -1, 1, 1,&! -48
- -1, -3, -1, -3, 1, 1,&! -47
- -1, -2, -2, -1, 1, 1,&! -46
- -1, -2, -1, -2, 1, 1,&! -45
- -1, -1, -1, -1, 2, 2,&! -44
- -1, 0, -1, 0, 4, 7,&! -43
- -1, 0, 0, -1, 4, 7,&! -42
- -1, 1, -6, 6, 3, 3,&! -41
- -1, 1, -5, 5, 3, 3,&! -40
- -1, 1, -4, 4, 3, 3,&! -39
- -1, 1, -3, 3, 3, 3,&! -38
- -1, 1, -2, 2, 3, 3,&! -37
- -1, 1, -1, 1, 3, 4,&! -36
- -1, 1, 0, 0, 3, 5,&! -35
- -1, 1, 1, -1, 3, 4,&! -34
- -1, 1, 2, -2, 3, 3,&! -33
- -1, 1, 3, -3, 3, 3,&! -32
- -1, 1, 4, -4, 3, 3,&! -31
- -1, 1, 5, -5, 3, 3,&! -30
- -1, 1, 6, -6, 3, 3,&! -29
- -1, 2, -1, 2, 1, 1,&! -28
- -1, 2, 2, -1, 1, 1,&! -27
- -1, 3, -1, 3, 1, 1,&! -26
- -1, 3, 3, -1, 1, 1,&! -25
- -1, 4, -1, 4, 1, 1,&! -24
- -1, 4, 4, -1, 1, 1,&! -23
- -1, 5, -1, 5, 1, 1,&! -22
- -1, 5, 5, -1, 1, 1,&! -21
- -1, 6, -1, 6, 1, 1,&! -20
- -1, 6, 6, -1, 1, 1,&! -19
- 0, -6, -6, 0, 4, 7,&! -18
- 0, -6, 0, -6, 4, 7,&! -17
- 0, -5, -5, 0, 4, 7,&! -16
- 0, -5, 0, -5, 4, 7,&! -15
- 0, -4, -4, 0, 4, 7,&! -14
- 0, -4, 0, -4, 4, 7,&! -13
- 0, -3, -3, 0, 4, 7,&! -12
- 0, -3, 0, -3, 4, 7,&! -11
- 0, -2, -2, 0, 4, 7,&! -10
- 0, -2, 0, -2, 4, 7,&! -9
- 0, -1, -1, 0, 4, 7,&! -8
- 0, -1, 0, -1, 4, 7,&! -7
- 0, 0, -6, 6, 5, 6,&! -6
- 0, 0, -5, 5, 5, 6,&! -5
- 0, 0, -4, 4, 5, 6,&! -4
- 0, 0, -3, 3, 5, 6,&! -3
- 0, 0, -2, 2, 5, 6,&! -2
- 0, 0, -1, 1, 5, 6,&! -1
- 0, 0, 0, 0, 5, 8,&! 0
- 0, 0, 1, -1, 5, 6,&! 1
- 0, 0, 2, -2, 5, 6,&! 2
- 0, 0, 3, -3, 5, 6,&! 3
- 0, 0, 4, -4, 5, 6,&! 4
- 0, 0, 5, -5, 5, 6,&! 5
- 0, 0, 6, -6, 5, 6,&! 6
- 0, 1, 0, 1, 4, 7,&! 7
- 0, 1, 1, 0, 4, 7,&! 8
- 0, 2, 0, 2, 4, 7,&! 9
- 0, 2, 2, 0, 4, 7,&! 10
- 0, 3, 0, 3, 4, 7,&! 11
- 0, 3, 3, 0, 4, 7,&! 12
- 0, 4, 0, 4, 4, 7,&! 13
- 0, 4, 4, 0, 4, 7,&! 14
- 0, 5, 0, 5, 4, 7,&! 15
- 0, 5, 5, 0, 4, 7,&! 16
- 0, 6, 0, 6, 4, 7,&! 17
- 0, 6, 6, 0, 4, 7,&! 18
- 1, -6, -6, 1, 1, 1,&! 19
- 1, -6, 1, -6, 1, 1,&! 20
- 1, -5, -5, 1, 1, 1,&! 21
- 1, -5, 1, -5, 1, 1,&! 22
- 1, -4, -4, 1, 1, 1,&! 23
- 1, -4, 1, -4, 1, 1,&! 24
- 1, -3, -3, 1, 1, 1,&! 25
- 1, -3, 1, -3, 1, 1,&! 26
- 1, -2, -2, 1, 1, 1,&! 27
- 1, -2, 1, -2, 1, 1,&! 28
- 1, -1, -6, 6, 3, 3,&! 29
- 1, -1, -5, 5, 3, 3,&! 30
- 1, -1, -4, 4, 3, 3,&! 31
- 1, -1, -3, 3, 3, 3,&! 32
- 1, -1, -2, 2, 3, 3,&! 33
- 1, -1, -1, 1, 3, 4,&! 34
- 1, -1, 0, 0, 3, 5,&! 35
- 1, -1, 1, -1, 3, 4,&! 36
- 1, -1, 2, -2, 3, 3,&! 37
- 1, -1, 3, -3, 3, 3,&! 38
- 1, -1, 4, -4, 3, 3,&! 39
- 1, -1, 5, -5, 3, 3,&! 40
- 1, -1, 6, -6, 3, 3,&! 41
- 1, 0, 0, 1, 4, 7,&! 42
- 1, 0, 1, 0, 4, 7,&! 43
- 1, 1, 1, 1, 2, 2,&! 44
- 1, 2, 1, 2, 1, 1,&! 45
- 1, 2, 2, 1, 1, 1,&! 46
- 1, 3, 1, 3, 1, 1,&! 47
- 1, 3, 3, 1, 1, 1,&! 48
- 1, 4, 1, 4, 1, 1,&! 49
- 1, 4, 4, 1, 1, 1,&! 50
- 1, 5, 1, 5, 1, 1,&! 51
- 1, 5, 5, 1, 1, 1,&! 52
- 1, 6, 1, 6, 1, 1,&! 53
- 1, 6, 6, 1, 1, 1,&! 54
- 2, -6, -6, 2, 1, 1,&! 55
- 2, -6, 2, -6, 1, 1,&! 56
- 2, -5, -5, 2, 1, 1,&! 57
- 2, -5, 2, -5, 1, 1,&! 58
- 2, -4, -4, 2, 1, 1,&! 59
- 2, -4, 2, -4, 1, 1,&! 60
- 2, -3, -3, 2, 1, 1,&! 61
- 2, -3, 2, -3, 1, 1,&! 62
- 2, -2, -6, 6, 3, 3,&! 63
- 2, -2, -5, 5, 3, 3,&! 64
- 2, -2, -4, 4, 3, 3,&! 65
- 2, -2, -3, 3, 3, 3,&! 66
- 2, -2, -2, 2, 3, 4,&! 67
- 2, -2, -1, 1, 3, 3,&! 68
- 2, -2, 0, 0, 3, 5,&! 69
- 2, -2, 1, -1, 3, 3,&! 70
- 2, -2, 2, -2, 3, 4,&! 71
- 2, -2, 3, -3, 3, 3,&! 72
- 2, -2, 4, -4, 3, 3,&! 73
- 2, -2, 5, -5, 3, 3,&! 74
- 2, -2, 6, -6, 3, 3,&! 75
- 2, -1, -1, 2, 1, 1,&! 76
- 2, -1, 2, -1, 1, 1,&! 77
- 2, 0, 0, 2, 4, 7,&! 78
- 2, 0, 2, 0, 4, 7,&! 79
- 2, 1, 1, 2, 1, 1,&! 80
- 2, 1, 2, 1, 1, 1,&! 81
- 2, 2, 2, 2, 2, 2,&! 82
- 2, 3, 2, 3, 1, 1,&! 83
- 2, 3, 3, 2, 1, 1,&! 84
- 2, 4, 2, 4, 1, 1,&! 85
- 2, 4, 4, 2, 1, 1,&! 86
- 2, 5, 2, 5, 1, 1,&! 87
- 2, 5, 5, 2, 1, 1,&! 88
- 2, 6, 2, 6, 1, 1,&! 89
- 2, 6, 6, 2, 1, 1,&! 90
- 3, -6, -6, 3, 1, 1,&! 91
- 3, -6, 3, -6, 1, 1,&! 92
- 3, -5, -5, 3, 1, 1,&! 93
- 3, -5, 3, -5, 1, 1,&! 94
- 3, -4, -4, 3, 1, 1,&! 95
- 3, -4, 3, -4, 1, 1,&! 96
- 3, -3, -6, 6, 3, 3,&! 97
- 3, -3, -5, 5, 3, 3,&! 98
- 3, -3, -4, 4, 3, 3,&! 99
- 3, -3, -3, 3, 3, 4,&! 100
- 3, -3, -2, 2, 3, 3,&! 101
- 3, -3, -1, 1, 3, 3,&! 102
- 3, -3, 0, 0, 3, 5,&! 103
- 3, -3, 1, -1, 3, 3,&! 104
- 3, -3, 2, -2, 3, 3,&! 105
- 3, -3, 3, -3, 3, 4,&! 106
- 3, -3, 4, -4, 3, 3,&! 107
- 3, -3, 5, -5, 3, 3,&! 108
- 3, -3, 6, -6, 3, 3,&! 109
- 3, -2, -2, 3, 1, 1,&! 110
- 3, -2, 3, -2, 1, 1,&! 111
- 3, -1, -1, 3, 1, 1,&! 112
- 3, -1, 3, -1, 1, 1,&! 113
- 3, 0, 0, 3, 4, 7,&! 114
- 3, 0, 3, 0, 4, 7,&! 115
- 3, 1, 1, 3, 1, 1,&! 116
- 3, 1, 3, 1, 1, 1,&! 117
- 3, 2, 2, 3, 1, 1,&! 118
- 3, 2, 3, 2, 1, 1,&! 119
- 3, 3, 3, 3, 2, 2,&! 120
- 3, 4, 3, 4, 1, 1,&! 121
- 3, 4, 4, 3, 1, 1,&! 122
- 3, 5, 3, 5, 1, 1,&! 123
- 3, 5, 5, 3, 1, 1,&! 124
- 3, 6, 3, 6, 1, 1,&! 125
- 3, 6, 6, 3, 1, 1,&! 126
- 4, -6, -6, 4, 1, 1,&! 127
- 4, -6, 4, -6, 1, 1,&! 128
- 4, -5, -5, 4, 1, 1,&! 129
- 4, -5, 4, -5, 1, 1,&! 130
- 4, -4, -6, 6, 3, 3,&! 131
- 4, -4, -5, 5, 3, 3,&! 132
- 4, -4, -4, 4, 3, 4,&! 133
- 4, -4, -3, 3, 3, 3,&! 134
- 4, -4, -2, 2, 3, 3,&! 135
- 4, -4, -1, 1, 3, 3,&! 136
- 4, -4, 0, 0, 3, 5,&! 137
- 4, -4, 1, -1, 3, 3,&! 138
- 4, -4, 2, -2, 3, 3,&! 139
- 4, -4, 3, -3, 3, 3,&! 140
- 4, -4, 4, -4, 3, 4,&! 141
- 4, -4, 5, -5, 3, 3,&! 142
- 4, -4, 6, -6, 3, 3,&! 143
- 4, -3, -3, 4, 1, 1,&! 144
- 4, -3, 4, -3, 1, 1,&! 145
- 4, -2, -2, 4, 1, 1,&! 146
- 4, -2, 4, -2, 1, 1,&! 147
- 4, -1, -1, 4, 1, 1,&! 148
- 4, -1, 4, -1, 1, 1,&! 149
- 4, 0, 0, 4, 4, 7,&! 150
- 4, 0, 4, 0, 4, 7,&! 151
- 4, 1, 1, 4, 1, 1,&! 152
- 4, 1, 4, 1, 1, 1,&! 153
- 4, 2, 2, 4, 1, 1,&! 154
- 4, 2, 4, 2, 1, 1,&! 155
- 4, 3, 3, 4, 1, 1,&! 156
- 4, 3, 4, 3, 1, 1,&! 157
- 4, 4, 4, 4, 2, 2,&! 158
- 4, 5, 4, 5, 1, 1,&! 159
- 4, 5, 5, 4, 1, 1,&! 160
- 4, 6, 4, 6, 1, 1,&! 161
- 4, 6, 6, 4, 1, 1,&! 162
- 5, -6, -6, 5, 1, 1,&! 163
- 5, -6, 5, -6, 1, 1,&! 164
- 5, -5, -6, 6, 3, 3,&! 165
- 5, -5, -5, 5, 3, 4,&! 166
- 5, -5, -4, 4, 3, 3,&! 167
- 5, -5, -3, 3, 3, 3,&! 168
- 5, -5, -2, 2, 3, 3,&! 169
- 5, -5, -1, 1, 3, 3,&! 170
- 5, -5, 0, 0, 3, 5,&! 171
- 5, -5, 1, -1, 3, 3,&! 172
- 5, -5, 2, -2, 3, 3,&! 173
- 5, -5, 3, -3, 3, 3,&! 174
- 5, -5, 4, -4, 3, 3,&! 175
- 5, -5, 5, -5, 3, 4,&! 176
- 5, -5, 6, -6, 3, 3,&! 177
- 5, -4, -4, 5, 1, 1,&! 178
- 5, -4, 5, -4, 1, 1,&! 179
- 5, -3, -3, 5, 1, 1,&! 180
- 5, -3, 5, -3, 1, 1,&! 181
- 5, -2, -2, 5, 1, 1,&! 182
- 5, -2, 5, -2, 1, 1,&! 183
- 5, -1, -1, 5, 1, 1,&! 184
- 5, -1, 5, -1, 1, 1,&! 185
- 5, 0, 0, 5, 4, 7,&! 186
- 5, 0, 5, 0, 4, 7,&! 187
- 5, 1, 1, 5, 1, 1,&! 188
- 5, 1, 5, 1, 1, 1,&! 189
- 5, 2, 2, 5, 1, 1,&! 190
- 5, 2, 5, 2, 1, 1,&! 191
- 5, 3, 3, 5, 1, 1,&! 192
- 5, 3, 5, 3, 1, 1,&! 193
- 5, 4, 4, 5, 1, 1,&! 194
- 5, 4, 5, 4, 1, 1,&! 195
- 5, 5, 5, 5, 2, 2,&! 196
- 5, 6, 5, 6, 1, 1,&! 197
- 5, 6, 6, 5, 1, 1,&! 198
- 6, -6, -6, 6, 3, 4,&! 199
- 6, -6, -5, 5, 3, 3,&! 200
- 6, -6, -4, 4, 3, 3,&! 201
- 6, -6, -3, 3, 3, 3,&! 202
- 6, -6, -2, 2, 3, 3,&! 203
- 6, -6, -1, 1, 3, 3,&! 204
- 6, -6, 0, 0, 3, 5,&! 205
- 6, -6, 1, -1, 3, 3,&! 206
- 6, -6, 2, -2, 3, 3,&! 207
- 6, -6, 3, -3, 3, 3,&! 208
- 6, -6, 4, -4, 3, 3,&! 209
- 6, -6, 5, -5, 3, 3,&! 210
- 6, -6, 6, -6, 3, 4,&! 211
- 6, -5, -5, 6, 1, 1,&! 212
- 6, -5, 6, -5, 1, 1,&! 213
- 6, -4, -4, 6, 1, 1,&! 214
- 6, -4, 6, -4, 1, 1,&! 215
- 6, -3, -3, 6, 1, 1,&! 216
- 6, -3, 6, -3, 1, 1,&! 217
- 6, -2, -2, 6, 1, 1,&! 218
- 6, -2, 6, -2, 1, 1,&! 219
- 6, -1, -1, 6, 1, 1,&! 220
- 6, -1, 6, -1, 1, 1,&! 221
- 6, 0, 0, 6, 4, 7,&! 222
- 6, 0, 6, 0, 4, 7,&! 223
- 6, 1, 1, 6, 1, 1,&! 224
- 6, 1, 6, 1, 1, 1,&! 225
- 6, 2, 2, 6, 1, 1,&! 226
- 6, 2, 6, 2, 1, 1,&! 227
- 6, 3, 3, 6, 1, 1,&! 228
- 6, 3, 6, 3, 1, 1,&! 229
- 6, 4, 4, 6, 1, 1,&! 230
- 6, 4, 6, 4, 1, 1,&! 231
- 6, 5, 5, 6, 1, 1,&! 232
- 6, 5, 6, 5, 1, 1,&! 233
- 6, 6, 6, 6, 2, 2&! 234
-],[6,469])
-
-
- integer,dimension(2,0:16),parameter::\MC{double\_pdf\_kinds}=reshape([&
- &0,0,&
- &1,1,&
- &1,2,&
- &1,3,&
- &1,4,&
- &2,1,&
- &2,2,&
- &2,3,&
- &2,4,&
- &3,1,&
- &3,2,&
- &3,3,&
- &3,4,&
- &4,1,&
- &4,2,&
- &4,3,&
- &4,4&
- &],[2,17])
- integer,parameter,dimension(371)::int_all=[&
- & -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, -14, -13, -12, -11, -10,&
- & -9, -8, -7, 7, 8, 9, 10, 11, 12, 13, 14, 7, 8, 9, 10, -151, -150, -115,&
- &-114, -79, -78, -43, -42, 42, 43, 78, 79, 114, 115, 150, 151, -158, -157, -156, -155, -154,&
- &-153, -152, -149, -148, -147, -146, -145, -144, -143, -142, -141, -140, -139, -138, -137, -136, -135, -134,&
- &-133, -132, -131, -122, -121, -120, -119, -118, -117, -116, -113, -112, -111, -110, -109, -108, -107, -106,&
- &-105, -104, -103, -102, -101, -100, -99, -98, -97, -96, -95, -86, -85, -84, -83, -82, -81, -80,&
- & -77, -76, -75, -74, -73, -72, -71, -70, -69, -68, -67, -66, -65, -64, -63, -62, -61, -60,&
- & -59, -50, -49, -48, -47, -46, -45, -44, -41, -40, -39, -38, -37, -36, -35, -34, -33, -32,&
- & -31, -30, -29, -28, -27, -26, -25, -24, -23, 23, 24, 25, 26, 27, 28, 29, 30, 31,&
- & 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 44, 45, 46, 47, 48, 49, 50, 59,&
- & 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77,&
- & 80, 81, 82, 83, 84, 85, 86, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105,&
- & 106, 107, 108, 109, 110, 111, 112, 113, 116, 117, 118, 119, 120, 121, 122, 131, 132, 133,&
- & 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 152, 153,&
- & 154, 155, 156, 157, 158, -149, -148, -113, -112, -77, -76, -41, -40, -39, -38, -37, -36, -35,&
- & -34, -33, -32, -31, -30, -29, 44, 80, 81, 116, 117, 152, 153, -147, -146, -111, -110, -75,&
- & -74, -73, -72, -71, -70, -69, -68, -67, -66, -65, -64, -63, -28, -27, 45, 46, 82, 118,&
- & 119, 154, 155, 42, 43, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,&
- & 36, 37, 38, 39, 40, 41, 44, 45, 46, 47, 48, 49, 50, 44, 45, 46, 78, 79,&
- & 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76,&
- & 77, 80, 81, 82, 83, 84, 85, 86, 80, 81, 82]
-
- integer,parameter,dimension(16)::int_sizes_all=[13,16,2,2,16,208,26,26,2,26,1,2,2,26,2,1]
-
- integer,parameter,dimension(3,0:8)::muli_flow_stats=&
- reshape([&
- 1, 2,4,&
- 3, 4,4,&
- 5, 6,8,&
- 7, 8,4,&
- 9,10,8,&
- 11,16,16,&
- 17,22,16,&
- 23,28,16,&
- 29,52,96],&
- [3,9])
-
- integer,parameter,dimension(0:4,52)::muli_flows=&
- reshape([&
- 3,0,0,1,2,&!1a
- 1,0,0,2,1,&
- 1,2,0,0,3,&!1b
- 3,3,0,0,2,&
- 4,0,0,1,2,&!2
- 4,0,0,2,1,&
- 3,2,0,0,3,&!3
- 1,3,0,0,2,&
- 4,2,0,0,3,&!4
- 4,3,0,0,2,&
- 4,0,1,3,4,&!5
- 4,0,1,4,3,&
- 2,0,3,1,4,&
- 2,0,4,1,3,&
- 2,0,3,4,1,&
- 2,0,4,3,1,&
- 4,1,2,4,0,&!6
- 2,1,4,2,0,&
- 4,2,1,4,0,&
- 2,4,1,2,0,&
- 2,2,4,1,0,&
- 2,4,2,1,0,&
- 2,0,1,2,4,&!7
- 2,0,1,4,2,&
- 4,0,2,1,4,&
- 4,0,4,1,2,&
- 2,0,2,4,1,&
- 2,0,4,2,1,&
- 9,1,2,3,4,&!8
- 5,1,2,4,3,&
- 5,1,3,2,4,&
- 3,1,4,2,3,&
- 3,1,3,4,2,&
- 5,1,4,3,2,&
- 5,2,1,3,4,&
- 5,2,1,4,3,&
- 3,3,1,2,4,&
- 3,4,1,2,3,&
- 3,3,1,4,2,&
- 3,4,1,3,2,&
- 3,2,3,1,4,&
- 3,2,4,1,3,&
- 5,3,2,1,4,&
- 3,4,2,1,3,&
- 5,3,4,1,2,&
- 3,4,3,1,2,&
- 3,2,3,4,1,&
- 3,2,4,3,1,&
- 3,3,2,4,1,&
- 5,4,2,3,1,&
- 3,3,4,2,1,&
- 5,4,3,2,1],&
- [5,52])
-\end{Verbatim}
-\section{Interfaces}
-\begin{Verbatim}
- abstract interface
- function trafo_in(in)
- use kinds!NODEP!
- real(kind=double),dimension(3)::trafo_in
- real(kind=double),dimension(3),intent(in)::in
- end function trafo_in
- end interface
- abstract interface
- pure function coord_scalar_in(hyp)
- use kinds!NODEP!
- real(kind=double)::coord_scalar_in
- real(kind=double),dimension(3),intent(in)::hyp
- end function coord_scalar_in
- end interface
- abstract interface
- subroutine coord_hcd_in(hyp,cart,denom)
- use kinds!NODEP!
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double),intent(out)::denom
- end subroutine coord_hcd_in
- end interface
- interface
- pure function alphaspdf(Q)
- use kinds!NODEP!
- real(kind=double)::alphaspdf
- real(kind=double),intent(in)::Q
- end function alphaspdf
- end interface
- interface
- pure subroutine evolvepdf(x,q,f)
- use kinds!NODEP!
- real(kind=double),intent(in)::x,q
- real(kind=double),intent(out),dimension(-6:6)::f
- end subroutine evolvepdf
- end interface
- real(kind=double)::pts2_scale
-\end{Verbatim}
-\Methods
-\ProcImp{muli\_get\_state\_transformations(inout\_kind,lha\_flavors) result}
-\begin{Verbatim}
- pure function muli_get_state_transformations(inout_kind,lha_flavors) result(transformations)
- integer,intent(in)::inout_kind
- integer,dimension(4),intent(in)::lha_flavors
- integer,dimension(4)::signature
- logical,dimension(3)::transformations
- where(lha_flavors>0)
- signature=1
- elsewhere(lha_flavors<0)
- signature=-1
- elsewhere
- signature=0
- end where
- !print *,"inout_kind=",inout_kind
- !print *,"lha_flavors=",lha_flavors
- !print *,"signature",signature
- if(&
- (sum(inout_signatures(1:2,inout_kind))==sum(signature(1:2))).and.&
- (sum(inout_signatures(3:4,inout_kind))==sum(signature(3:4)))&
- )then
- transformations(1)=.false.
- else
- transformations(1)=.true.
- signature=-signature
- end if
- if(all(inout_signatures(1:2,inout_kind)==signature(1:2)))then
- transformations(2)=.false.
- else
- transformations(2)=.true.
- end if
- if(all(inout_signatures(3:4,inout_kind)==signature(3:4)))then
- transformations(3)=.false.
- else
- transformations(3)=.true.
- end if
- !print *,"signature",signature
- !print *,"transformations=",transformations
- end function muli_get_state_transformations
-\end{Verbatim}
-
-\ProcImp{id}
-\begin{Verbatim}
- pure function id(a)
- real(kind=double),dimension(:),intent(in)::a
- real(kind=double),dimension(size(a))::id
- id=a
- end function id
-\end{Verbatim}
-
-\ProcImp{h\_to\_c\_ort}
-\begin{Verbatim}
- pure function h_to_c_ort(hyp)
- real(kind=double),dimension(3)::h_to_c_ort
- real(kind=double),dimension(3),intent(in)::hyp
- h_to_c_ort=&
- &[sqrt(sqrt(((hyp(1)*(1D0-hyp(3)))+hyp(3))**2+(hyp(2)-(5D-1))**2)&
- -(hyp(2)-(5D-1)))&
- &,sqrt(sqrt(((hyp(1)*(1D0-hyp(3)))+hyp(3))**2+(hyp(2)-(5D-1))**2)&
- +(hyp(2)-(5D-1)))&
- &,hyp(3)]
- end function h_to_c_ort
-\end{Verbatim}
-
-\ProcImp{c\_to\_h\_ort}
-\begin{Verbatim}
- pure function c_to_h_ort(cart)
- real(kind=double),dimension(3)::c_to_h_ort
- real(kind=double),dimension(3),intent(in)::cart
- c_to_h_ort=[(cart(3)-(cart(1)*cart(2)))/(cart(3)-1D0),&
- (1D0 - cart(1)**2 + cart(2)**2)/2D0,cart(3)]
- end function c_to_h_ort
-\end{Verbatim}
-
-\ProcImp{h\_to\_c\_noparam}
-\begin{Verbatim}
- pure function h_to_c_noparam(hyp)
- real(kind=double),dimension(2)::h_to_c_noparam
- real(kind=double),dimension(2),intent(in)::hyp
- h_to_c_noparam=&
- &[sqrt(sqrt(hyp(1)**8+(((hyp(2)-(5D-1))**3)*4)**2)-((hyp(2)-(5D-1))**3)*4)&
- &,sqrt(sqrt(hyp(1)**8+(((hyp(2)-(5D-1))**3)*4)**2)+((hyp(2)-(5D-1))**3)*4)]
- end function h_to_c_noparam
-\end{Verbatim}
-
-\ProcImp{c\_to\_h\_noparam}
-\begin{Verbatim}
- pure function c_to_h_noparam(cart)
- real(kind=double),dimension(2)::c_to_h_noparam
- real(kind=double),dimension(2),intent(in)::cart
- c_to_h_noparam=&
- &[sqrt(sqrt(cart(1)*cart(2)))&
- &,(1D0+sign(abs((cart(2)**2) - (cart(1)**2))**(1/3D0),cart(2)-cart(1)))/2D0]
- end function c_to_h_noparam
-\end{Verbatim}
-
-\ProcImp{h\_to\_c\_param}
-\begin{Verbatim}
- pure function h_to_c_param(hyp)
- real(kind=double),dimension(3)::h_to_c_param
- real(kind=double),dimension(3),intent(in)::hyp
- h_to_c_param=&
- &[sqrt(sqrt((((hyp(1)**4)*(1D0-hyp(3)))+hyp(3))**2+(((hyp(2)-(5D-1))**3)*4)**2)&
- -((hyp(2)-(5D-1))**3)*4)&
- &,sqrt(sqrt((((hyp(1)**4)*(1D0-hyp(3)))+hyp(3))**2+(((hyp(2)-(5D-1))**3)*4)**2)&
- +((hyp(2)-(5D-1))**3)*4)&
- &,hyp(3)]
- end function h_to_c_param
-\end{Verbatim}
-
-\ProcImp{c\_to\_h\_param}
-\begin{Verbatim}
- pure function c_to_h_param(cart)
- real(kind=double),dimension(3)::c_to_h_param
- real(kind=double),dimension(3),intent(in)::cart
- c_to_h_param=&
- &[(((cart(1)*cart(2)) - cart(3))/(1D0 - cart(3)))**(1/4D0)&
- &,(1D0+sign(abs((cart(2)**2) - (cart(1)**2))**(1/3D0),cart(2)-cart(1)))/2D0&
- &,cart(3)]
- end function c_to_h_param
-\end{Verbatim}
-
-\ProcImp{h\_to\_c\_smooth}
-\begin{Verbatim}
- pure function h_to_c_smooth(hyp)
- real(kind=double),dimension(3)::h_to_c_smooth
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::h2
- h2=(((hyp(2)-5D-1)**3)*4D0+hyp(2)-5D-1)/2D0
- h_to_c_smooth=&
- &[sqrt(sqrt((((hyp(1)**4)*(1D0-hyp(3)))+hyp(3))**2+h2**2)-h2)&
- &,sqrt(sqrt((((hyp(1)**4)*(1D0-hyp(3)))+hyp(3))**2+h2**2)+h2)&
- &,hyp(3)]
- end function h_to_c_smooth
-\end{Verbatim}
-
-\ProcImp{c\_to\_h\_smooth}
-\begin{Verbatim}
- pure function c_to_h_smooth(cart)
- real(kind=double),dimension(3)::c_to_h_smooth
- real(kind=double),dimension(3),intent(in)::cart
- c_to_h_smooth=&
- [((product(cart(1:2))-cart(3))/(1D0-cart(3)))**(1/4D0),&
- (3D0-3D0**(2D0/3)/&
- (-9D0*cart(1)**2 + 9D0*cart(2)**2 + sqrt(3D0+81D0*(cart(1)**2-cart(2)**2)**2))&
- **(1D0/3)&
- + 3**(1D0/3)*(-9D0*cart(1)**2 + 9D0*cart(2)**2 + sqrt(3D0 + 81D0*(cart(1)**2&
- - cart(2)**2)**2))**(1D0/3))/6D0,cart(3)]
- end function c_to_h_smooth
-\end{Verbatim}
-
-\ProcImp{h\_to\_c\_ort\_def}
-\begin{Verbatim}
- pure function h_to_c_ort_def(hyp)
- real(kind=double),dimension(3)::h_to_c_ort_def
- real(kind=double),dimension(3),intent(in)::hyp
- h_to_c_ort_def=h_to_c_ort([hyp(1),hyp(2),pts2_scale])
- end function h_to_c_ort_def
-\end{Verbatim}
-
-\ProcImp{c\_to\_h\_ort\_def}
-\begin{Verbatim}
- pure function c_to_h_ort_def(cart)
- real(kind=double),dimension(3)::c_to_h_ort_def
- real(kind=double),dimension(3),intent(in)::cart
- c_to_h_ort_def=c_to_h_ort([cart(1),cart(2),pts2_scale])
- end function c_to_h_ort_def
-\end{Verbatim}
-
-\ProcImp{h\_to\_c\_param\_def}
-\begin{Verbatim}
- pure function h_to_c_param_def(hyp)
- real(kind=double),dimension(3)::h_to_c_param_def
- real(kind=double),dimension(3),intent(in)::hyp
- h_to_c_param_def=h_to_c_param([hyp(1),hyp(2),pts2_scale])
- end function h_to_c_param_def
-\end{Verbatim}
-
-\ProcImp{c\_to\_h\_param\_def}
-\begin{Verbatim}
- pure function c_to_h_param_def(cart)
- real(kind=double),dimension(3)::c_to_h_param_def
- real(kind=double),dimension(3),intent(in)::cart
- if(product(cart(1:2))>=pts2_scale)then
- c_to_h_param_def=c_to_h_param([cart(1),cart(2),pts2_scale])
- else
- c_to_h_param_def=[-1D0,-1D0,-1D0]
- end if
- end function c_to_h_param_def
-\end{Verbatim}
-
-\ProcImp{h\_to\_c\_smooth\_def}
-\begin{Verbatim}
- pure function h_to_c_smooth_def(hyp)
- real(kind=double),dimension(3)::h_to_c_smooth_def
- real(kind=double),dimension(3),intent(in)::hyp
- h_to_c_smooth_def=h_to_c_smooth([hyp(1),hyp(2),pts2_scale])
- end function h_to_c_smooth_def
-\end{Verbatim}
-
-\ProcImp{c\_to\_h\_smooth\_def}
-\begin{Verbatim}
- pure function c_to_h_smooth_def(cart)
- real(kind=double),dimension(3)::c_to_h_smooth_def
- real(kind=double),dimension(3),intent(in)::cart
- if(product(cart(1:2))>=pts2_scale)then
- c_to_h_smooth_def=c_to_h_smooth([cart(1),cart(2),pts2_scale])
- else
- c_to_h_smooth_def=[-1D0,-1D0,-1D0]
- end if
- end function c_to_h_smooth_def
-\end{Verbatim}
-
-\ProcImp{voxel\_h\_to\_c\_ort}
-\begin{Verbatim}
- pure function voxel_h_to_c_ort(hyp)
- real(kind=double)::voxel_h_to_c_ort
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::T,TH1
- T=1D0-hyp(3)
- TH1=T*(1D0-hyp(1))
- voxel_h_to_c_ort=Sqrt(T**2/(5D0-4D0*(1D0-hyp(2))*hyp(2)-4D0*(2D0-TH1)*TH1))
- end function voxel_h_to_c_ort
-\end{Verbatim}
-
-\ProcImp{voxel\_c\_to\_h\_ort}
-\begin{Verbatim}
- pure function voxel_c_to_h_ort(cart)
- real(kind=double)::voxel_c_to_h_ort
- real(kind=double),dimension(3),intent(in)::cart
- real(kind=double)::P
- P=product(cart(1:2))
- if(P>cart(3))then
- voxel_c_to_h_ort=(cart(1)**2 + cart(2)**2)/(1D0-cart(3))
- else
- voxel_c_to_h_ort=0D0
- end if
- end function voxel_c_to_h_ort
-\end{Verbatim}
-
-\ProcImp{voxel\_h\_to\_c\_noparam}
-\begin{Verbatim}
- pure function voxel_h_to_c_noparam(hyp)
- real(kind=double)::voxel_h_to_c_noparam
- real(kind=double),dimension(3),intent(in)::hyp
- voxel_h_to_c_noparam=&
- 12D0*Sqrt((hyp(1)**6*(1D0-2D0*hyp(2))**4)/(4*hyp(1)**8+(1D0-2D0*hyp(2))**6))
- end function voxel_h_to_c_noparam
-\end{Verbatim}
-
-\ProcImp{voxel\_c\_to\_h\_noparam}
-\begin{Verbatim}
- pure function voxel_c_to_h_noparam(cart)
- real(kind=double)::voxel_c_to_h_noparam
- real(kind=double),dimension(3),intent(in)::cart
- real(kind=double)::P
- voxel_c_to_h_noparam=(cart(1)**2+cart(2)**2)/(12D0*(cart(1)*cart(2))**(3D0/4D0)&
- *(cart(2)**2+cart(1)**2)**(2D0/3D0))
- end function voxel_c_to_h_noparam
-\end{Verbatim}
-
-\ProcImp{voxel\_h\_to\_c\_param}
-\begin{Verbatim}
- pure function voxel_h_to_c_param(hyp)
- real(kind=double)::voxel_h_to_c_param
- real(kind=double),dimension(3),intent(in)::hyp
- voxel_h_to_c_param=12*Sqrt((hyp(1)**6*(1D0-2D0*hyp(2))**4*(hyp(3)-1D0)**2)&
- /((1D0-2D0*hyp(2))**6+4D0*(hyp(3)-(hyp(1)**4*(hyp(3)-1D0)))**2))
- end function voxel_h_to_c_param
-\end{Verbatim}
-
-\ProcImp{voxel\_c\_to\_h\_param}
-\begin{Verbatim}
- pure function voxel_c_to_h_param(cart)
- real(kind=double)::voxel_c_to_h_param
- real(kind=double),dimension(3),intent(in)::cart
- real(kind=double)::P,T,CP,CM
- P=product(cart(1:2))
- if(P>cart(3))then
- P=P-cart(3)
- CP=cart(1)**2+cart(2)**2
- CM=abs(cart(2)**2-cart(1)**2)
- T=1-cart(3)
- voxel_c_to_h_param=(Cp*sqrt(sqrt(P/T)))/(12*Cm**(2D0/3D0)*P)
- else
- voxel_c_to_h_param=0D0
- end if
- end function voxel_c_to_h_param
-\end{Verbatim}
-
-\ProcImp{voxel\_h\_to\_c\_smooth}
-\begin{Verbatim}
- pure function voxel_h_to_c_smooth(hyp)
- real(kind=double)::voxel_h_to_c_smooth
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::T
- T=1D0-hyp(3)
- voxel_h_to_c_smooth=&
- &8D0*(hyp(1)**3*(1D0+3D0*(hyp(2)-1D0)*hyp(2))*T)&
- &/sqrt((1D0-2D0*hyp(2)*(2D0+hyp(2)*(2D0*hyp(2)-3D0)))**2+4D0*(1D0+(hyp(1)**4-1D0)*T)**2)
- end function voxel_h_to_c_smooth
-\end{Verbatim}
-
-\ProcImp{voxel\_c\_to\_h\_smooth}
-\begin{Verbatim}
- pure function voxel_c_to_h_smooth(cart)
- real(kind=double)::voxel_c_to_h_smooth
- real(kind=double),dimension(3),intent(in)::cart
- real(kind=double)::P,S,T,CM,CP
- P=product(cart(1:2))
- if(P>cart(3))then
- P=P-cart(3)
- CP=cart(1)**2+cart(2)**2
- CM=cart(2)**2-cart(1)**2
- T=1-cart(3)
- S=sqrt(3D0+81D0*cm**2)
- voxel_c_to_h_smooth=(3D0**(1D0/3D0)*Cp*(3D0**(1D0/3D0)+(9D0*Cm+S)**(2D0/3D0))&
- *sqrt(sqrt(P/T)))/(4D0*P*S*(9D0*Cm+S)**(1D0/3D0))
- else
- voxel_c_to_h_smooth=0D0
- end if
-end function voxel_c_to_h_smooth
-\end{Verbatim}
-
-!
-
-\ProcImp{voxel\_h\_to\_c\_ort\_def}
-\begin{Verbatim}
- pure function voxel_h_to_c_ort_def(hyp)
- real(kind=double)::voxel_h_to_c_ort_def
- real(kind=double),dimension(3),intent(in)::hyp
- voxel_h_to_c_ort_def=voxel_h_to_c_ort(hyp)
- end function voxel_h_to_c_ort_def
-\end{Verbatim}
-
-\ProcImp{voxel\_c\_to\_h\_ort\_def}
-\begin{Verbatim}
- pure function voxel_c_to_h_ort_def(cart)
- real(kind=double)::voxel_c_to_h_ort_def
- real(kind=double),dimension(3),intent(in)::cart
- voxel_c_to_h_ort_def=voxel_c_to_h_ort(cart)
- end function voxel_c_to_h_ort_def
-\end{Verbatim}
-
-\ProcImp{voxel\_h\_to\_c\_param\_def}
-\begin{Verbatim}
- pure function voxel_h_to_c_param_def(hyp)
- real(kind=double)::voxel_h_to_c_param_def
- real(kind=double),dimension(3),intent(in)::hyp
- voxel_h_to_c_param_def=voxel_h_to_c_param(hyp)
- end function voxel_h_to_c_param_def
-\end{Verbatim}
-
-\ProcImp{voxel\_c\_to\_h\_param\_def}
-\begin{Verbatim}
- pure function voxel_c_to_h_param_def(cart)
- real(kind=double)::voxel_c_to_h_param_def
- real(kind=double),dimension(3),intent(in)::cart
- voxel_c_to_h_param_def=voxel_c_to_h_param(cart)
- end function voxel_c_to_h_param_def
-\end{Verbatim}
-
-\ProcImp{voxel\_h\_to\_c\_smooth\_def}
-\begin{Verbatim}
- pure function voxel_h_to_c_smooth_def(hyp)
- real(kind=double)::voxel_h_to_c_smooth_def
- real(kind=double),dimension(3),intent(in)::hyp
- voxel_h_to_c_smooth_def=voxel_h_to_c_smooth(hyp)
- end function voxel_h_to_c_smooth_def
-\end{Verbatim}
-
-\ProcImp{voxel\_c\_to\_h\_smooth\_def}
-\begin{Verbatim}
- pure function voxel_c_to_h_smooth_def(cart)
- real(kind=double)::voxel_c_to_h_smooth_def
- real(kind=double),dimension(3),intent(in)::cart
- voxel_c_to_h_smooth_def=voxel_c_to_h_smooth(cart)
- end function voxel_c_to_h_smooth_def
-\end{Verbatim}
-
-\ProcImp{denom\_cart}
-\begin{Verbatim}
- pure function denom_cart(cart)
- real(kind=double)::denom_cart
- real(kind=double),dimension(3),intent(in)::cart
- denom_cart=1D0/(864D0*Sqrt(cart(3)**3*(1D0-cart(3)/product(cart(1:2)))))
- end function denom_cart
-\end{Verbatim}
-
-\ProcImp{denom\_ort}
-\begin{Verbatim}
- pure function denom_ort(hyp)
- real(kind=double)::denom_ort
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::Y,P
- Y=(1D0-2D0*hyp(2))**2
- P=1D0-hyp(3)
- if(hyp(1)>0D0.and.hyp(3)>0D0)then
- denom_ort=sqrt((P + (-1 + Hyp(1))*P**2)&
- /(746496*hyp(1)*hyp(3)**3*(4*(1 + (-1 + hyp(1))*P)**2 + Y)))
-
- else
- denom_ort=0D0
- end if
- end function denom_ort
-\end{Verbatim}
-
-\ProcImp{denom\_param}
-\begin{Verbatim}
- pure function denom_param(hyp)
- real(kind=double)::denom_param
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::X,Y,P
- X=hyp(1)**4
- Y=1D0-2D0*hyp(2)
- P=1D0-hyp(3)
- if(hyp(3)>0D0)then
- denom_param=sqrt((P*(1+P*(X-1))*Sqrt(X)*Y**4)/(5184*(4*(1+P*(X-1))**2+Y**6)*hyp(3)**3))
- else
- denom_param=0D0
- end if
- end function denom_param
-\end{Verbatim}
-
-\ProcImp{denom\_param\_reg}
-\begin{Verbatim}
- pure function denom_param_reg(hyp)
- real(kind=double)::denom_param_reg
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::X,Y,P
- X=hyp(1)**4
- Y=1D0-2D0*hyp(2)
- P=1D0-hyp(3)
- if(hyp(3)>0D0)then
- denom_param_reg=sqrt((P*(1+P*(X-1))*Sqrt(X)*Y**4)&
- /(5184*(4*(1+P*(X-1))**2+Y**6)*(hyp(3)+norm2_p_t_0)**3))
- else
- denom_param_reg=0D0
- end if
- end function denom_param_reg
-\end{Verbatim}
-
-\ProcImp{denom\_smooth}
-\begin{Verbatim}
- pure function denom_smooth(hyp)
- real(kind=double)::denom_smooth
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::X,Y,P
- X=hyp(1)**2
- Y=(1D0-2D0*hyp(2))**2
- P=1D0-hyp(3)
- if(hyp(3)>0D0)then
- denom_smooth=sqrt((P*X*(1 + P*(-1 + X**2))*(1 + 3*Y)**2)/(46656*hyp(3)**3&
- *(16*(1 + P*(-1 + X**2))**2 + Y + 2*Y**2 + Y**3)))
- else
- denom_smooth=0D0
- end if
- end function denom_smooth
-\end{Verbatim}
-
-\ProcImp{denom\_smooth\_reg}
-\begin{Verbatim}
- pure function denom_smooth_reg(hyp)
- real(kind=double)::denom_smooth_reg
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::X,Y,P
- X=hyp(1)**2
- Y=(1D0-2D0*hyp(2))**2
- P=1D0-hyp(3)
- if(hyp(3)>0D0)then
- denom_smooth_reg=&
- sqrt((P*X*(1 + P*(-1 + X**2))*(1 + 3*Y)**2)&
- /(46656*(hyp(3)+norm2_p_t_0)**3&
- *(16*(1 + P*(-1 + X**2))**2 + Y + 2*Y**2 + Y**3)))
- else
- denom_smooth_reg=0D0
- end if
- end function denom_smooth_reg
-\end{Verbatim}
-
-\ProcImp{denom\_cart\_save}
-\begin{Verbatim}
- pure function denom_cart_save(cart)
- real(kind=double)::denom_cart_save
- real(kind=double),dimension(3),intent(in)::cart
- if(product(cart(1:2))>cart(3))then
- denom_cart_save=denom_cart(cart)
- else
- denom_cart_save=0D0
- end if
- end function denom_cart_save
-\end{Verbatim}
-
-\ProcImp{denom\_ort\_save}
-\begin{Verbatim}
- pure function denom_ort_save(hyp)
- real(kind=double)::denom_ort_save
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::Y,Z,W
- real(kind=double),dimension(3)::cart
- cart=h_to_c_ort(hyp)
- if(cart(1)>1D0.or.cart(2)>1D0)then
- denom_ort_save=0D0
- else
- denom_ort_save=denom_ort(hyp)
- end if
- end function denom_ort_save
-\end{Verbatim}
-
-\ProcImp{denom\_param\_save}
-\begin{Verbatim}
- pure function denom_param_save(hyp)
- real(kind=double)::denom_param_save
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::Y,Z,W
- real(kind=double),dimension(3)::cart
- cart=h_to_c_param(hyp)
- if(cart(1)>1D0.or.cart(2)>1D0)then
- denom_param_save=0D0
- else
- denom_param_save=denom_param(hyp)
- end if
- end function denom_param_save
-\end{Verbatim}
-
-! pure
-\ProcImp{denom\_smooth\_save}
-\begin{Verbatim}
- function denom_smooth_save(hyp)
- real(kind=double)::denom_smooth_save
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double)::Y,Z,W
- real(kind=double),dimension(3)::cart
- cart=h_to_c_smooth(hyp)
- if(cart(1)>1D0.or.cart(2)>1D0)then
- denom_smooth_save=0D0
- else
- denom_smooth_save=denom_smooth(hyp)
- end if
- end function denom_smooth_save
-\end{Verbatim}
-
-\ProcImp{denom\_cart\_cuba\_int}
-\begin{Verbatim}
- subroutine denom_cart_cuba_int(d_cart,cart,d_denom,denom,pt2s)
- real(kind=double),dimension(3),intent(in)::cart
- real(kind=double),dimension(1),intent(out)::denom
- real(kind=double),intent(in) :: pt2s
- integer,intent(in)::d_cart,d_denom
- denom(1)=denom_cart_save([cart(1),cart(2),pt2s])
- end subroutine denom_cart_cuba_int
-\end{Verbatim}
-
-\ProcImp{denom\_ort\_cuba\_int}
-\begin{Verbatim}
- subroutine denom_ort_cuba_int(d_hyp,hyp,d_denom,denom,pt2s)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(1),intent(out)::denom
- real(kind=double),intent(in) :: pt2s
- integer,intent(in)::d_hyp,d_denom
- denom(1)=denom_ort_save([hyp(1),hyp(2),pt2s])
- end subroutine denom_ort_cuba_int
-\end{Verbatim}
-
-\ProcImp{denom\_param\_cuba\_int}
-\begin{Verbatim}
- subroutine denom_param_cuba_int(d_hyp,hyp,d_denom,denom,pt2s)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(1),intent(out)::denom
- real(kind=double),intent(in) :: pt2s
- integer,intent(in)::d_hyp,d_denom
- denom(1)=denom_param_save([hyp(1),hyp(2),pt2s])
- end subroutine denom_param_cuba_int
-\end{Verbatim}
-
-\ProcImp{denom\_smooth\_cuba\_int}
-\begin{Verbatim}
- subroutine denom_smooth_cuba_int(d_hyp,hyp,d_denom,denom,pt2s)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(1),intent(out)::denom
- real(kind=double),intent(in) :: pt2s
- integer,intent(in)::d_hyp,d_denom
- denom(1)=denom_smooth_save([hyp(1),hyp(2),pt2s])
- end subroutine denom_smooth_cuba_int
-\end{Verbatim}
-
-\ProcImp{coordinates\_hcd\_cart}
-\begin{Verbatim}
- subroutine coordinates_hcd_cart(hyp,cart,denom)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double),intent(out)::denom
- cart=hyp
- denom=denom_cart_save(cart)
- end subroutine coordinates_hcd_cart
-\end{Verbatim}
-
-\ProcImp{coordinates\_hcd\_ort}
-\begin{Verbatim}
- subroutine coordinates_hcd_ort(hyp,cart,denom)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double),intent(out)::denom
- cart=h_to_c_ort(hyp)
- denom=denom_ort(hyp)
- end subroutine coordinates_hcd_ort
-\end{Verbatim}
-
-\ProcImp{coordinates\_hcd\_param}
-\begin{Verbatim}
- subroutine coordinates_hcd_param(hyp,cart,denom)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double),intent(out)::denom
- cart=h_to_c_param(hyp)
- denom=denom_param(hyp)
- end subroutine coordinates_hcd_param
-\end{Verbatim}
-
-\ProcImp{coordinates\_hcd\_param\_reg}
-\begin{Verbatim}
- subroutine coordinates_hcd_param_reg(hyp,cart,denom)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double),intent(out)::denom
- cart=h_to_c_param(hyp)
- denom=denom_param_reg(hyp)
- end subroutine coordinates_hcd_param_reg
-\end{Verbatim}
-
-\ProcImp{coordinates\_hcd\_smooth}
-\begin{Verbatim}
- subroutine coordinates_hcd_smooth(hyp,cart,denom)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double),intent(out)::denom
- cart=h_to_c_smooth(hyp)
- denom=denom_smooth(hyp)
- end subroutine coordinates_hcd_smooth
-\end{Verbatim}
-
-\ProcImp{coordinates\_hcd\_smooth\_reg}
-\begin{Verbatim}
- subroutine coordinates_hcd_smooth_reg(hyp,cart,denom)
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double),intent(out)::denom
- cart=h_to_c_smooth(hyp)
- denom=denom_smooth_reg(hyp)
- end subroutine coordinates_hcd_smooth_reg
-\end{Verbatim}
-
-\ProcImp{pdf\_in\_in\_kind}
-\begin{Verbatim}
- pure function pdf_in_in_kind(process_id,double_pdf_id,c1,c2,gev_pt)
- real(kind=double)::pdf_in_in_kind
- real(kind=double),intent(in)::c1,c2,gev_pt
- integer,intent(in)::process_id,double_pdf_id
- real(kind=double)::pdf1,pdf2
- call single_pdf(valid_processes(1,process_id),&
- double_pdf_kinds(1,double_pdf_id),&
- c1,&
- gev_pt,&
- pdf1)
- call single_pdf(valid_processes(2,process_id),&
- double_pdf_kinds(2,double_pdf_id),&
- c2,&
- gev_pt,&
- pdf2)
- pdf_in_in_kind=pdf1*pdf2
- contains
- pure subroutine single_pdf(flavor,pdf_kind,c,gev_pt,pdf)
- integer,intent(in)::flavor,pdf_kind
- real(kind=double),intent(in)::c,gev_pt
- real(kind=double),intent(out)::pdf
- real(kind=double),dimension(-6:6)::lha_pdf
- call evolvePDF(c,gev_pt,lha_pdf)
- select case(pdf_kind)
- case(1)
- pdf=lha_pdf(0)
- case(2)
- if(flavor==1.or.flavor==2)then
- pdf=lha_pdf(-flavor)
- else
- pdf=lha_pdf(flavor)
- end if
- case(3)
- pdf=lha_pdf(1)-lha_pdf(-1)
- case(4)
- pdf=lha_pdf(2)-lha_pdf(-2)
- end select
- end subroutine single_pdf
- end function pdf_in_in_kind
-\end{Verbatim}
-
-\ProcImp{ps\_io\_pol}
-\begin{Verbatim}
- elemental function ps_io_pol(process_io_id,pt2shat)
- real(kind=double)::ps_io_pol
- integer,intent(in)::process_io_id
- real(kind=double),intent(in)::pt2shat
- ps_io_pol=dot_product(&
- [1D0,pt2shat,pt2shat**2,pt2shat**3]&
- ,phase_space_coefficients_inout(1:4,valid_processes(6,process_io_id)))
- end function ps_io_pol
-\end{Verbatim}
-
-\ProcImp{interactions\_dddsigma}
-\begin{Verbatim}
- pure subroutine interactions_dddsigma(process_id,double_pdf_id,hyp,cart,dddsigma)
- real(kind=double),intent(out)::dddsigma
- integer,intent(in)::process_id,double_pdf_id
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double)::a,pt2shat,gev_pt
- cart=h_to_c_param(hyp)
- a=product(cart(1:2))
- if(cart(1)<=1D0.and.cart(2)<=1D0)then
- pt2shat=hyp(3)/a
- gev_pt=sqrt(hyp(3))*gev_pt_max
-! print *,process_id,pt2shat
- dddsigma=&
- &const_pref&
- &*alphasPDF(gev_pt)**2&
- &*ps_io_pol(process_id,pt2shat)&
- &*pdf_in_in_kind(process_id,double_pdf_id,cart(1),cart(2),gev_pt)&
- &*denom_param(hyp)&
- &/a
- else
- dddsigma=0D0
- end if
- end subroutine interactions_dddsigma
-\end{Verbatim}
-
-\ProcImp{interactions\_dddsigma\_reg}
-\begin{Verbatim}
- pure subroutine interactions_dddsigma_reg(process_id,double_pdf_id,hyp,cart,dddsigma)
- real(kind=double),intent(out)::dddsigma
- integer,intent(in)::process_id,double_pdf_id
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double)::a,pt2shat,gev_pt,gev2_pt
- cart=h_to_c_param(hyp)
- a=product(cart(1:2))
- if(cart(1)<=1D0.and.cart(2)<=1D0)then
- pt2shat=hyp(3)/a
- gev_pt=sqrt(hyp(3))*gev_pt_max
- gev2_pt=hyp(3)*gev2_pt_max
-! print *,process_id,pt2shat
- dddsigma=&
- &const_pref&
- &*alphasPDF(sqrt(gev2_pt+gev2_p_t_0))**2&
- &*ps_io_pol(process_id,pt2shat)&
- &*pdf_in_in_kind(process_id,double_pdf_id,cart(1),cart(2),gev_pt)&
- &*denom_param_reg(hyp)&
- &/a
- else
- dddsigma=0D0
- end if
- end subroutine interactions_dddsigma_reg
-\end{Verbatim}
-
-\ProcImp{interactions\_dddsigma\_print}
-\begin{Verbatim}
- subroutine interactions_dddsigma_print(process_id,double_pdf_id,hyp,cart,dddsigma)
- real(kind=double),intent(out)::dddsigma
- integer,intent(in)::process_id,double_pdf_id
- real(kind=double),dimension(3),intent(in)::hyp
- real(kind=double),dimension(3),intent(out)::cart
- real(kind=double)::a,pt2shat,gev_pt
- cart=h_to_c_param(hyp)
- a=product(cart(1:2))
- if(cart(1)<=1D0.and.cart(2)<=1D0)then
- pt2shat=hyp(3)/a
- gev_pt=sqrt(hyp(3))*gev_pt_max
-! print *,process_id,pt2shat
- dddsigma=&
- &const_pref&
-! &*alphasPDF(gev_pt)**2&
- &*ps_io_pol(process_id,pt2shat)&
- &*pdf_in_in_kind(process_id,double_pdf_id,cart(1),cart(2),gev_pt)&
- &*denom_param(hyp)&
- &/a
- else
- dddsigma=0D0
- end if
- write(11,fmt=*)dddsigma,pt2shat,&
- pdf_in_in_kind(process_id,double_pdf_id,cart(1),cart(2),&
- gev_pt),ps_io_pol(process_id,pt2shat),const_pref,denom_param(hyp),a
- flush(11)
- end subroutine interactions_dddsigma_print
-\end{Verbatim}
-
-\ProcImp{interactions\_dddsigma\_cart}
-\begin{Verbatim}
- pure subroutine interactions_dddsigma_cart(process_id,double_pdf_id,cart,dddsigma)
- real(kind=double),intent(out)::dddsigma
- integer,intent(in)::process_id,double_pdf_id
- real(kind=double),dimension(3),intent(in)::cart
- real(kind=double)::a,pt2shat,gev_pt
- a=product(cart(1:2))
- if(cart(1)<=1D0.and.cart(2)<=1D0)then
- pt2shat=cart(3)/a
- gev_pt=sqrt(cart(3))*gev_pt_max
-! print *,process_id,pt2shat
- dddsigma=&
- &const_pref&
- &*alphasPDF(gev_pt)**2&
- &*ps_io_pol(process_id,pt2shat)&
- &*pdf_in_in_kind(process_id,double_pdf_id,cart(1),cart(2),gev_pt)&
- &*denom_cart(cart)&
- &/a
- else
- dddsigma=0D0
- end if
- end subroutine interactions_dddsigma_cart
-\end{Verbatim}
-
-\ProcImp{cuba\_gg\_me\_smooth}
-\begin{Verbatim}
- subroutine cuba_gg_me_smooth(d_hyp,hyp,d_me,me,pt2s)
- integer,intent(in)::d_hyp,d_me
- real(kind=double),dimension(d_hyp),intent(in)::hyp
- real(kind=double),dimension(1),intent(out)::me
- real(kind=double),dimension(3)::cart
- real(kind=double),intent(in)::pt2s
- real(kind=double)::p,p2
- if(d_hyp==3)then
- p=hyp(3)
- p2=hyp(3)**2
- else
- if(d_hyp==2)then
- p=sqrt(pt2s)
- p2=pt2s
- end if
- end if
- cart=h_to_c_smooth([hyp(1),hyp(2),p2])
- if(p>pts_min.and.product(cart(1:2))>p2)then
- me(1)=&
- &const_pref&
- &*alphasPDF(p*gev_pt_max)**2&
- &*ps_io_pol(109,p2)&
- &*pdf_in_in_kind(109,11,cart(1),cart(2),p2)&
- &*denom_smooth([hyp(1),hyp(2),p2])&
- &/product(cart(1:2))
- else
- me(1)=0D0
- end if
- end subroutine cuba_gg_me_smooth
-\end{Verbatim}
-
-\ProcImp{cuba\_gg\_me\_param}
-\begin{Verbatim}
- subroutine cuba_gg_me_param(d_hyp,hyp,d_me,me,pt2s)
- integer,intent(in)::d_hyp,d_me
- real(kind=double),dimension(d_hyp),intent(in)::hyp
- real(kind=double),dimension(1),intent(out)::me
- real(kind=double),dimension(3)::cart
- real(kind=double),intent(in)::pt2s
- real(kind=double)::p,p2
- if(d_hyp==3)then
- p=hyp(3)
- p2=hyp(3)**2
- else
- if(d_hyp==2)then
- p=sqrt(pt2s)
- p2=pt2s
- end if
- end if
- cart=h_to_c_param([hyp(1),hyp(2),p2])
- if(p>pts_min.and.product(cart(1:2))>p2)then
- me(1)=&
- &const_pref&
- &*alphasPDF(p*gev_pt_max)**2&
- &*ps_io_pol(109,p2)&
- &*pdf_in_in_kind(109,11,cart(1),cart(2),p2)&
- &*denom_param([hyp(1),hyp(2),p2])&
- &/product(cart(1:2))
- else
- me(1)=0D0
- end if
- end subroutine cuba_gg_me_param
-\end{Verbatim}
-
-\ProcImp{cuba\_gg\_me\_ort}
-\begin{Verbatim}
- subroutine cuba_gg_me_ort(d_hyp,hyp,d_me,me,pt2s)
- integer,intent(in)::d_hyp,d_me
- real(kind=double),dimension(d_hyp),intent(in)::hyp
- real(kind=double),dimension(1),intent(out)::me
- real(kind=double),dimension(3)::cart
- real(kind=double),intent(in)::pt2s
- real(kind=double)::p,p2
- if(d_hyp==3)then
- p=hyp(3)
- p2=hyp(3)**2
- else
- if(d_hyp==2)then
- p=sqrt(pt2s)
- p2=pt2s
- end if
- end if
- cart=h_to_c_ort([hyp(1),cart(2),p2])
- if(p>pts_min.and.product(cart(1:2))>p2)then
- me(1)=&
- &const_pref&
- &*alphasPDF(p*gev_pt_max)**2&
- &*ps_io_pol(109,p2)&
- &*pdf_in_in_kind(109,11,cart(1),cart(2),p2)&
- &*denom_ort([hyp(1),hyp(2),p2])&
- &/product(cart(1:2))
- else
- me(1)=0D0
- end if
- end subroutine cuba_gg_me_ort
-\end{Verbatim}
-
-\ProcImp{cuba\_gg\_me\_cart}
-\begin{Verbatim}
- subroutine cuba_gg_me_cart(d_cart,cart,d_me,me,pt2s)
- integer,intent(in)::d_cart,d_me
- real(kind=double),dimension(d_cart),intent(in)::cart
- real(kind=double),dimension(1),intent(out)::me
- real(kind=double),intent(in)::pt2s
- real(kind=double)::a,p,p2
- if(d_cart==3)then
- p=cart(3)
- p2=cart(3)**2
- else
- if(d_cart==2)then
- p=sqrt(pt2s)
- p2=pt2s
- end if
- end if
- a=product(cart(1:2))
- if(p>pts_min.and.a>p2)then
- me(1)=&
- &const_pref&
- &*alphasPDF(p*gev_pt_max)**2&
- &*ps_io_pol(109,p2)&
- &*pdf_in_in_kind(109,11,cart(1),cart(2),p2)&
- &*denom_cart([cart(1),cart(2),p2])&
- &/a
- else
- me(1)=0D0
- end if
- end subroutine cuba_gg_me_cart
-\end{Verbatim}
-
-\ProcImp{interactions\_proton\_proton\_integrand\_generic\_17\_reg}
-\begin{Verbatim}
- subroutine interactions_proton_proton_integrand_generic_17_reg(hyp_2,trafo,f,pt)
- real(kind=double),dimension(2),intent(in)::hyp_2
- procedure(coord_hcd_in)::trafo
- real(kind=double),dimension(17),intent(out)::f
- class(transversal_momentum_type), intent(in) :: pt
- real(kind=double),dimension(3)::cart,hyp_3
- real(kind=double),dimension(5)::psin
- real(kind=double),dimension(-6:6)::c,d
- real(kind=double)::gev_pt,gev2_pt,pts,pt2s,pt2shat,a,&
- pdf_seaquark_seaquark,pdf_seaquark_gluon,pdf_gluon_gluon,&
- pdf_up_seaquark,pdf_up_gluon,pdf_down_seaquark,pdf_down_gluon,&
- v1u,v1d,v2u,v2d,denom
-
- pts=pt%get_unit_scale()
- pt2s=pt%get_unit2_scale()
- gev_pt=pt%get_gev_scale()
- gev2_pt=pt%get_gev2_scale()
-
- hyp_3(1:2)=hyp_2
- hyp_3(3)=pt2s
- call trafo(hyp_3,cart,denom)
- a=product(cart(1:2))
- if(cart(1)<=1D0.and.cart(2)<=1D0.and.a>pt2s)then
- pt2shat=pt2s/a
-
- ! phase space polynom
- psin=matmul([1D0,pt2shat,pt2shat**2,pt2shat**3],phase_space_coefficients_in)
- ! pdf
- call evolvepdf(cart(1),gev_pt,c)
- call evolvepdf(cart(2),gev_pt,d)
- !c=[1,1,1,1,1,1,1,1,1,1,1,1,1]*1D0
- !d=c
- v1d=c(1)-c(-1)
- v1u=c(2)-c(-2)
- v2d=d(1)-d(-1)
- v2u=d(2)-d(-2)
- c(1)=c(-1)
- c(2)=c(-2)
- d(1)=d(-1)
- d(2)=d(-2)
- f(1)=0D0
- !gluon_gluon
- f( 2)=(&
- !type5
- c(0)*d(0)&
- )*psin(5)
- !gluon_seaquark
- f( 3)=(&
- !type4
- c(0)*d(-4)+c(0)*d(-3)+c(0)*d(-2)+c(0)*d(-1)+c(0)*d(1)+c(0)*d(2)+c(0)*d(3)+c(0)*d(4)&
- )*psin(4)
- !gluon_down
- f( 4)=(&
- !type4
- c( 0)*v2d&
- )*psin(4)
- !gluon_up
- f( 5)=(&
- !type4
- c(0)*v2u&
- )*psin(4)
- !seaquark_gluon
- f( 6)=(&
- !type4
- c(-4)*d(0)+c(-3)*d(0)+c(-2)*d(0)+c(-1)*d(0)&
- +c(1)*d(0)+c( 2)*d(0)+c( 3)*d(0)+c( 4)*d(0)&
- )*psin(4)
- !seaquark_seaquark
- f( 7)=&
- !type1
- (c(-4)*d(-3)+c(-4)*d(-2)+c(-4)*d(-1)+c(-4)*d( 1)+c(-4)*d( 2)+c(-4)*d( 3)+&
- c(-3)*d(-4)+c(-3)*d(-2)+c(-3)*d(-1)+c(-3)*d( 1)+c(-3)*d( 2)+c(-3)*d( 4)+&
- c(-2)*d(-4)+c(-2)*d(-3)+c(-2)*d(-1)+c(-2)*d( 1)+c(-2)*d( 3)+c(-2)*d( 4)+&
- c(-1)*d(-4)+c(-1)*d(-3)+c(-1)*d(-2)+c(-1)*d( 2)+c(-1)*d( 3)+c(-1)*d( 4)+&
- c( 1)*d(-4)+c( 1)*d(-3)+c( 1)*d(-2)+c( 1)*d( 2)+c( 1)*d( 3)+c( 1)*d( 4)+&
- c( 2)*d(-4)+c( 2)*d(-3)+c( 2)*d(-1)+c( 2)*d( 1)+c( 2)*d( 3)+c( 2)*d( 4)+&
- c( 3)*d(-4)+c( 3)*d(-2)+c( 3)*d(-1)+c( 3)*d( 1)+c( 3)*d( 2)+c( 3)*d( 4)+&
- c( 4)*d(-3)+c( 4)*d(-2)+c( 4)*d(-1)+c( 4)*d( 1)+c( 4)*d( 2)+c( 4)*d( 3))&
- *psin(1)&
- !type2
- +( c(-4)*d(-4)+c(-3)*d(-3)+c(-2)*d(-2)+c(-1)*d(-1)&
- +c( 4)*d( 4)+c( 3)*d( 3)+c( 2)*d( 2)+c( 1)*d( 1))&
- *psin(2)&
- !type3
- +( c(-4)*d( 4)+c(-3)*d( 3)+c(-2)*d( 2)+c(-1)*d( 1)&
- +c( 4)*d(-4)+c( 3)*d(-3)+c( 2)*d(-2)+c( 1)*d(-1))&
- *psin(3)
- !seaquark_down
- f( 8)=&
- !type1
- (c(-4)*v2d+c(-3)*v2d+c(-2)*v2d+c( 2)*v2d+c( 3)*v2d+c( 4)*v2d)&
- *psin(1)&
- !type2
- +c( 1)*v2d&
- *psin(2)&
- !type3
- +c(-1)*v2d&
- *psin(3)
- !seaquark_up
- f( 9)=&
- !type1
- (c(-4)*v2u+c(-3)*v2u+c(-1)*v2u+c( 1)*v2u+c( 3)*v2u+c( 4)*v2u)&
- *psin(1)&
- !type2
- +c(2)*v2u&
- *psin(2)&
- !type3
- +c(-2)*v2u&
- *psin(3)
- !down_gluon
- f(10)=(&
- !type4
- v1d*d( 0)&
- )*psin(4)
- !down_seaquark
- f(11)=&
- !type1
- (v1d*d(-4)+v1d*d(-3)+v1d*d(-2)+v1d*d( 2)+v1d*d( 3)+v1d*d( 4))&
- *psin(1)&
- !type2
- +v1d*d( 1)&
- *psin(2)&
- !type3
- +v1d*d(-1)&
- *psin(3)
- !down_down
- f(12)=v1d*v2d*psin(2)
- !down_up
- f(13)=v1d*v2u*psin(1)
- !up_gluon
- f(14)=(&
- !type4
- &v1u*d(0)&
- &)*psin(4)
- !up_seaquark
- f(15)=&
- !type1
- (v1u*d(-4)+v1u*d(-3)+v1u*d(-1)+v1u*d( 1)+v1u*d( 3)+v1u*d( 4))&
- *psin(1)&
- !type2
- +v1u*d(2)&
- *psin(2)&
- !type3
- +v1u*d(-2)&
- *psin(3)
- !up_down
- f(16)=v1u*v2d*psin(1)
- !up_up
- f(17)=v1u*v2u*psin(2)
- f=f&
- *const_pref&
- *alphasPDF(sqrt(gev2_pt+gev2_p_t_0))**2&
- *denom&
- /a
- ! print *,const_pref,alphasPDF(gev_pt)**2,denom_smooth(hyp),a
- else
- f=[0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0]
- end if
-! print *,pt2shat,c(0)*d(0),psin(5),const_pref,alphasPDF(gev_pt)**2,denom,a
- end subroutine interactions_proton_proton_integrand_generic_17_reg
-\end{Verbatim}
-
-\ProcImp{interactions\_proton\_proton\_integrand\_param\_17\_reg}
-\begin{Verbatim}
- subroutine interactions_proton_proton_integrand_param_17_reg(d_hyp,hyp_2,d_f,f,pt)
- integer,intent(in)::d_hyp,d_f
- real(kind=double),dimension(2),intent(in)::hyp_2
- real(kind=double),dimension(17),intent(out)::f
- class(transversal_momentum_type), intent(in) :: pt
- call interactions_proton_proton_integrand_generic_17_reg&
- (hyp_2,coordinates_hcd_param_reg,f,pt)
- ! write (53,*)hyp_2,momentum_get_pts_scale(),f
- end subroutine interactions_proton_proton_integrand_param_17_reg
-\end{Verbatim}
-
-\ProcImp{interactions\_proton\_proton\_integrand\_smooth\_17\_reg}
-\begin{Verbatim}
- subroutine interactions_proton_proton_integrand_smooth_17_reg(d_hyp,hyp_2,d_f,f,pt)
- integer,intent(in)::d_hyp,d_f
- real(kind=double),dimension(2),intent(in)::hyp_2
- real(kind=double),dimension(17),intent(out)::f
- class(transversal_momentum_type), intent(in) :: pt
- call interactions_proton_proton_integrand_generic_17_reg&
- (hyp_2,coordinates_hcd_smooth_reg,f,pt)
- ! write (53,*)hyp_2,momentum_get_pts_scale(),f
- end subroutine interactions_proton_proton_integrand_smooth_17_reg
-\end{Verbatim}
Index: trunk/src/muli/doc/Baustelle.pdf
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: trunk/src/muli/doc/uml-module-tree.mp
===================================================================
--- trunk/src/muli/doc/uml-module-tree.mp (revision 8371)
+++ trunk/src/muli/doc/uml-module-tree.mp (revision 8372)
@@ -1,517 +0,0 @@
-input common;
-color extends_color, comp_color;
-extends_color=(1,0,0);
-comp_color=(0,0,1);
-path last_extends_path, mae_ser_path;
-pair last_extends_endpoint, last_extends_beginning;
-numeric last_extends_eangle, last_extends_bangle;
-
-def draw_label(expr px,py,lab,offset)=
- label(TEX(lab),((px*xu,py*yu)+offset));
-enddef;
-
-def draw_line(expr s,ds,e,de,c,offset)=
- draw ((xpart(s)*xu,ypart(s)*yu)+offset){dir ds} .. {dir de}((xpart(e)*xu,ypart(e)*yu)+offset) withcolor c;
-enddef;
-
-def draw_extends_endpoint(expr parent, a, offset)=
- save d;
- save v;
- pair d;
- pair v[];
- pair last_extends_endpoint;
- numeric last_extends_eangle;
- last_extends_eangle=a;
- d=dir(a);
- v1=(xpart(parent)*xu,ypart(parent)*yu)+offset;
- v2=v1+(d rotated 150)*unit;
- v3=v1+(d rotated 210)*unit;
- last_extends_endpoint=(v2+v3)/2;
- draw v2 -- v1 -- v3 -- cycle withcolor extends_color;
-enddef;
-
-def draw_extends_line(expr child, ca, ten, offset)=
- path last_extends_path;
- pair last_extends_beginning;
- numeric last_extends_bangle;
- last_extends_bangle=ca;
- last_extends_beginning=(xpart(child)*xu,ypart(child)*yu)+offset;
- last_extends_path=last_extends_beginning{dir ca} .. tension ten .. {dir last_extends_eangle}last_extends_endpoint;
- draw last_extends_path withcolor extends_color;
-enddef;
-
-def fork_extends_line(expr child, ca, ten, time, offset)=
- save b_v,p;
- pair b_v;
- path p;
- b_v=(xpart(child)*xu,ypart(child)*yu)+offset;
- p=b_v{dir ca} .. tension ten .. {dir (angle (direction time of last_extends_path))}point time of last_extends_path;
- draw p withcolor extends_color;
-enddef;
-
-def fork_push_extends_line(expr child, ca, ten, time, offset)=
- save b_v,p;
- pair b_v;
- path p;
- b_v=(xpart(child)*xu,ypart(child)*yu)+offset;
- p=b_v{dir ca} .. tension ten .. {dir (angle (direction time of last_extends_path))}point time of last_extends_path;
- draw p withcolor extends_color;
- path last_extends_path;
- last_extends_path=p;
- pair last_extends_beginning;
- last_extends_beginning=b_v;
- numeric last_extends_bangle;
- last_extends_bangle = ca;
-enddef;
-
-def push_extends_line(expr child, ca, ten, offset)=
- save b_v,p;
- pair b_v;
- path p[];
- b_v=(xpart(child)*xu,ypart(child)*yu)+offset;
- p2=b_v{dir ca} .. tension ten .. {dir last_extends_bangle}last_extends_beginning;
- draw p2 withcolor extends_color;
- p1=last_extends_path;
- path last_extends_path;
- last_extends_path=p2;
- pair last_extends_beginning;
- last_extends_beginning=b_v;
- numeric last_extends_bangle;
- last_extends_bangle = ca;
-enddef;
-
-def draw_extends(expr child,ca,parent,pa,ten,offset)=
- draw_extends_endpoint(parent,pa,offset);
- draw_extends_line(child,ca,ten,offset);
-enddef;
-
-def draw_comp_endpoint(expr type, a, offset)=
- save d;
- save v;
- pair v[];
- pair d;
- path last_comp_path;
- pair last_comp_endpoint;
- numeric last_comp_eangle;
- v2=(xpart(type)*xu,ypart(type)*yu)+offset;
- last_comp_endpoint = v2 - d*unit;
- last_comp_eangle = a;
- d=dir(a);
- last_comp_path=(v2 -- (v2 + (d rotated 135)*unit/diag) -- (v2 - d*unit) -- (v2+(d rotated 225)*unit/diag) -- cycle);
- draw last_comp_path withcolor comp_color;
- fill last_comp_path withcolor comp_color;
-enddef;
-
-def draw_comp_beginning(expr comp_v, comp_a, ten, comp_n, l_width, offset)=
- save beg_v;
- pair beg_v;
- beg_v=(xpart(comp_v)*xu,ypart(comp_v)*yu)+offset;
- draw beg_v{dir comp_a} .. tension ten .. {dir last_comp_eangle}last_comp_endpoint withcolor comp_color;
- label(TEX(comp_n),beg_v-(dir comp_a)*l_width*unit/2);
-enddef;
-
-def draw_comp_line(expr child, ca, ten, offset)=
- draw ((xpart(child)*xu,ypart(child)*yu)+offset){dir ca} .. tension ten .. {dir last_comp_eangle}last_comp_endpoint withcolor comp_color;
-enddef;
-
-def push_comp_line(expr child, ca, ten, offset)=
- save b_v,p;
- pair b_v;
- path p[];
- b_v=(xpart(child)*xu,ypart(child)*yu)+offset;
- p2=b_v{dir ca} .. tension ten .. {dir last_comp_eangle}last_comp_endpoint;
- draw p2 withcolor comp_color;
- p1=last_comp_path;
- path last_comp_path;
- last_comp_path=p2;
- pair last_comp_endpoint;
- last_comp_endpoint=b_v;
- numeric last_comp_eangle;
- last_comp_eangle = ca;
-enddef;
-
-def draw_comp(expr comp,ca,type,ta,ten,lab,lab_width,offset)=
- draw_comp_endpoint(type,ta,offset);
- draw_comp_beginning(comp,ca,ten,lab,lab_width,offset);
-enddef;
-
-def draw_module(expr lu,ro,lab,offset)=
- save v;
- save lx;
- pair v[];
- lx=8*xu;
- v1=(xpart(lu)*xu,ypart(lu)*yu)+offset;
- v2=(xpart(ro)*xu,ypart(ro)*yu)+offset;
- v3=(xpart(v1),ypart(v2));
- draw v1 -- (xpart(v2),ypart(v1)) -- v2 -- v3 -- cycle;
- draw v3 -- v3+(0,2*yu) -- v3+(lx,2*yu) -- v3+(lx,0);
- label(TEX(lab),v3+(lx/2,yu));
-enddef;
-
-def draw_box(expr lu,ro,lab,offset)=
- draw ((xpart(lu)*xu,ypart(lu)*yu)+offset)
- -- ((xpart(ro)*xu,ypart(lu)*yu)+offset)
- -- ((xpart(ro)*xu,ypart(ro)*yu)+offset)
- -- ((xpart(lu)*xu,ypart(ro)*yu)+offset)
- -- cycle;
- label(TEX(lab),
- ((xpart(lu)+xpart(ro))*xu/2,(ypart(lu)+ypart(ro))*yu/2)+offset);
-enddef;
-
-def basic_module(expr offset)=
- draw_module((-2,-2),(47,12),"muli\_basic",offset);
- draw_box((0,4),(10,6),"measurable\_type",offset);
- draw_box((6,9),(16,11),"serializable\_class",offset);
- draw_box((7,-1),(15,1),"unique\_type",offset);
- draw_box((12,4),(22,6),"identified\_type",offset);
- draw_box((24,0),(34,3),"",offset);
- draw_label(29,1,"next",offset);
- draw_label(29,2,"ref",offset);
- draw_box((24,3),(34,5),"serializable\_ref\_type",offset);
- draw_box((24,7),(34,9),"",offset);
- draw_label(29,8,"next",offset);
- draw_box((24,9),(34,11),"position\_stack\_type",offset);
- draw_box((36,0),(46,3),"",offset);
- draw_label(41,1,"references",offset);
- draw_label(41,2,"heap",offset);
- draw_box((36,3),(46,5),"marker\_type",offset);
- draw_box((36,7),(46,9),"position\_stack",offset);
- draw_box((36,9),(46,11),"page\_ring\_type",offset);
-
- draw_extends((5,6),90,(11,9),90,1.5,offset);
- path mae_ser_path;
- mae_ser_path=last_extends_path;
- draw_extends_line((17,6),90,1.5,offset);
- path id_ser_path;
- id_ser_path=last_extends_path;
-
- draw_extends((11,1),90,(17,4),90,1.5,offset);
- draw_extends((41,5),90,(41,7),90,1,offset);
-
- draw_comp((36,8),180,(34,10),180,1.5,"1",1,offset);
- draw_comp_beginning((34,8),0,1.5,"1",1,offset);
-
- draw_comp((34,1),0,(34,4),180,1.5,"1",1,offset);
- draw_comp_beginning((36,1),180,1.5,"1",1,offset);
- draw_comp_beginning((36,2),180,1.5,"1",1,offset);
-
- draw_comp_endpoint((16,10),180,offset);
- push_comp_line((23,3),90,1,offset);
- draw_comp_beginning((24,2),180,1,"1",1,offset);
-enddef;
-
-def momentum_module(expr offset)=
- draw_module((0,-1),(16,8),"muli\_momentum",offset);
- draw_box((1,1),(15,3),"qcd\_2\_2\_class",offset);
- draw_extends((8,3),90,(8,5),90,1,offset);
- draw_box((1,5),(15,7),"transversal\_momentum\_type",offset);
-enddef;
-
-def aq_module(expr offset)=
- draw_module((0,0),(14,8),"muli\_aq",offset);
- draw_box((1,2),(13,5),"",offset);
- draw_label(7,3,"int\_list",offset);
- draw_label(7,4,"err\_tree",offset);
- draw_box((1,5),(13,7),"aq\_class",offset);
-enddef;
-
-def dsigma_module(expr offset)=
- draw_module((0,0),(14,7),"dsigma",offset);
- draw_box((1,1),(13,4),"",offset);
- draw_label(6,2,"pt",offset);
- draw_label(6,3,"cuba\_int",offset);
- draw_box((1,4),(13,6),"muli\_dsigma\_type",offset);
-enddef;
-
-def cuba_module(expr offset)=
- draw_module((0,0),(32,9),"cuba",offset);
- draw_box((1,1),(7,3),"cuhre\_type",offset);
- draw_box((9,1),(15,3),"suave\_type",offset);
- draw_box((16.8,1),(23.2,3),"divonne\_type",offset);
- draw_box((25,1),(31,3),"vegas\_type",offset);
- draw_box((13,6),(19,8),"cuba\_type",offset);
- draw_extends((4,3),90,(16,6),90,5,offset);
- draw_extends_line((12,3),90,2,offset);
- draw_extends_line((20,3),90,2,offset);
- draw_extends_line((29,3),90,5,offset);
-enddef;
-
-def fibonacci_module(expr offset)=
- draw_module((0,0),(26,21),"fibonacci\_tree",offset);
- draw_box((1,4),(11,6),"fibonacci\_list\_type",offset);
- draw_box((15,1),(25,3),"fibonacci\_stub\_type",offset);
- draw_box((1,8),(11,10),"fibonacci\_leave\_type",offset);
- draw_box((15,8),(25,10),"fibonacci\_root\_type",offset);
- draw_box((8,18),(18,20),"fibonacci\_node\_type",offset);
-
- draw_box((8,13),(18,18),"",offset);
- draw_label(13,14,"down",offset);
- draw_label(13,15,"up",offset);
- draw_label(13,16,"right",offset);
- draw_label(13,17,"left",offset);
- draw_extends((6,10),90,(13,13),90,1.5,offset);
- draw_extends_line((20,10),90,1.5,offset);
- draw_extends((20,3),90,(20,5),90,1,offset);
-
- draw_box((15,5),(25,8),"",offset);
- draw_label(20,6,"rightmost",offset);
- draw_label(20,7,"leftmost",offset);
-
- draw_box((1,1),(11,4),"",offset);
- draw_label(6,2,"leave",offset);
- draw_label(6,3,"next",offset);
- draw_comp((11,3),0,(11,5),180,1.5,"1",1,offset);
-
- draw_comp((11,2),0,(11,9),180,2,"1",1,offset);
- draw_comp_beginning((15,6),180,1,"1",1,offset);
- draw_comp_beginning((15,7),180,1,"1",1,offset);
-
- draw_comp_endpoint((18,19),180,offset);
- draw_comp_beginning((18,17),0,1.5,"1",1,offset);
- draw_comp_beginning((18,16),0,1.5,"1",1,offset);
- draw_comp_beginning((18,15),0,1.5,"1",1,offset);
-enddef;
-
-def muli_module(expr offset)=
- draw_module((0,0),(14,13),"muli",offset);
- draw_box((5,1),(11,6),"",offset);
- draw_label(8,5,"node",offset);
- draw_label(8,4,"beam",offset);
- draw_label(8,3,"samples",offset);
- draw_label(8,2,"dsigma",offset);
- draw_box((5,6),(11,8),"muli\_type",offset);
- draw_box((4,10),(12,12),"qcd\_2\_2\_type",offset);
- draw_extends((8,8),90,(8,10),90,1,offset);
-enddef;
-
-def mcint_module(expr offset)=
- draw_module((0,0),(16,27),"muli\_mcint",offset);
- draw_box((3,1),(13,3),"",offset);
- draw_label(8,2,"int\_kinds",offset);
- draw_box((3,3),(13,5),"sample\_inclusive\_type",offset);
-
- draw_box((3,7),(13,9),"sample\_int\_kind\_type",offset);
-
- draw_box((3,11),(13,13),"",offset);
- draw_label(8,12,"slices",offset);
- draw_box((3,13),(13,15),"sample\_3d\_type",offset);
-
- draw_box((3,17),(13,19),"",offset);
- draw_label(8,18,"regions",offset);
- draw_box((3,19),(13,21),"sample\_2d\_type",offset);
-
- draw_box((3,23),(13,25),"sample\_region\_type",offset);
-
- draw_comp((13,2),0,(13,8),180,2,"1..n",2,offset);
- draw_comp((13,12),0,(13,20),180,2,"1..n",2,offset);
- draw_comp((3,18),180,(3,24),0,2,"1..n",2,offset);
-
- draw_extends((8,9),90,(8,11),90,1,offset);
-enddef;
-
-def trapezium_module(expr offset)=
- draw_module((0,0),(30,18),"muli\_trapezium",offset);
- draw_box((1,3),(13,5),"muli\_trapezium\_list\_type",offset);
- draw_box((15,1),(27,3),"",offset);
- draw_label(21,2,"down",offset);
- draw_box((15,3),(27,5),"muli\_trapezium\_tree\_type",offset);
- draw_box((8,8),(20,11),"",offset);
- draw_label(14,9,"right",offset);
- draw_label(14,10,"left",offset);
-
- draw_box((8,11),(20,13),"muli\_trapezium\_node\_class",offset);
- draw_box((8,15),(20,17),"muli\_trapezium\_type",offset);
-
- draw_extends_endpoint((14,15),90,offset);
- draw_extends_line((14,13),90,1,offset);
- draw_extends_endpoint((14,8),90,offset);
- draw_extends_line ((7,5),90,1.5,offset);
- draw_extends_line ((21,5),90,1.5,offset);
-
- draw_comp_endpoint((20,12),180,offset);
- draw_comp_beginning ((27,2),0,1.5,"1",1,offset);
- draw_comp_beginning ((20,9),0,1.5,"1",1,offset);
- draw_comp_beginning ((20,10),0,1.5,"1",1,offset);
-enddef;
-
-def remnant_module(expr offset)=
- draw_module((0,0),(22,28),"muli\_remnant",offset);
- draw_box((4,1),(16,4),"",offset);
- draw_label(10,2,"pdf\_norm",offset);
- draw_label(10,3,"proton",offset);
- draw_box((4,4),(16,6),"muli\_pp\_remnant\_type",offset);
- draw_box((4,8),(16,13),"",offset);
- draw_label(10,9,"pdf\_norm",offset);
- draw_label(10,10,"twin\_partons",offset);
- draw_label(10,11,"fs\_partons",offset);
- draw_label(10,12,"is\_partons",offset);
- draw_box((4,13),(16,15),"muli\_proton\_remnant\_type",offset);
- draw_box((4,17),(16,20),"",offset);
- draw_label(10,18,"twin",offset);
- draw_label(10,19,"next",offset);
- draw_box((4,20),(16,22),"muli\_parton\_type",offset);
- draw_box((4,24),(16,26),"pdfnorm\_type",offset);
-
- draw_comp((4,3),180,(4,14),0,2,"2",1,offset);
- draw_comp((16,2),0,(16,25),180,2.5,"1",1,offset);
- draw_comp_beginning((16,9),0,2,"1",1,offset);
-
- draw_comp((16,19),0,(16,21),180,1,"0,1",2,offset);
- draw_comp_beginning((16,18),0,1,"0,1",2,offset);
- draw_comp_beginning((16,10),0,2,"1",1,offset);
- draw_comp_beginning((16,11),0,2,"1",1,offset);
- draw_comp_beginning((16,12),0,2,"1",1,offset);
-enddef;
-
-def interactions_module(expr offset)=
- draw_box((0,0),(12,2),"",offset);
- draw_box((0,2),(10,4),"interactions\_module",offset);
-enddef;
-
-beginfig(1)
- pair basic_offset,%
- cuba_offset,%
- remnant_offset,%
- mcint_offset,%
- momentum_offset,%
- aq_offset,%
- dsigma_offset,%
- trapezium_offset,%
- fibonacci_offset,%
- interactions_offset,%
- muli_offset;
- basic_offset=(20*xu,48*yu);
- cuba_offset=(0,30*yu);
- remnant_offset=(72*xu,31*yu);
- mcint_offset=(78*xu,0);
- momentum_offset=(53*xu,27*yu);
- aq_offset=(36*xu,34*yu);
- dsigma_offset=(36*xu,23*yu);
- trapezium_offset=(29*xu,0*yu);
- fibonacci_offset=(0,0);
- interactions_offset=(0,58*yu);
- muli_offset=(61*xu,0);
-
- pickup pencircle scaled 1.5;
-
- basic_module(basic_offset);
-
- interactions_module(interactions_offset);
- cuba_module(cuba_offset);
- fibonacci_module(fibonacci_offset);
-
- aq_module(aq_offset);
- dsigma_module(dsigma_offset);
- trapezium_module(trapezium_offset);
-
- momentum_module(momentum_offset);
- muli_module(muli_offset);
-
- remnant_module(remnant_offset);
- mcint_module(mcint_offset);
-
- path last_extends_path;
- last_extends_path=id_ser_path;
- fork_push_extends_line((20,10),-150,1,0.67,basic_offset);
- push_extends_line((-2,29),90,1,remnant_offset);
- push_extends_line((-2,0),90,1,remnant_offset);
- fork_extends_line((10,26),90,2,1,remnant_offset);
- fork_extends_line((10,22),90,2,25/29,remnant_offset);
- fork_extends_line((10,15),90,2,18/29,remnant_offset);
- fork_extends_line((10,7),90,1,13.5/29,momentum_offset);
- fork_extends_line((10,6),90,2,9/29,remnant_offset);
- push_extends_line((-2,17),110,1,mcint_offset);
- fork_extends_line((8,21),90,4,0.45,mcint_offset);
- fork_extends_line((8,15),90,3,0,mcint_offset);
- push_extends_line((3,6),180,1,mcint_offset);
- fork_extends_line((8,5),90,2,0,mcint_offset);
-
- path last_extends_path;
- last_extends_path=mae_ser_path;
- fork_push_extends_line((-4,4),90,1,0.5,basic_offset);
- push_extends_line((16,8),90,1,cuba_offset);
-
- draw_extends_endpoint((8,1),90,momentum_offset);
- draw_extends_line((10,12),90,1,muli_offset);
-
- draw_extends_endpoint((17,4),90,basic_offset);
- draw_extends_line((7,7),90,1,aq_offset);
-
- draw_extends_endpoint((7,2),90,aq_offset);
- draw_extends_line((10,6),90,1,dsigma_offset);
-
- draw_extends_endpoint((5,4),90,basic_offset);
- draw_extends_line((13,-11),90,1,basic_offset);
- push_extends_line((13,-23),90,1,basic_offset);
- fork_extends_line((13,20),90,1,0.5,fibonacci_offset);
- fork_extends_line((14,17),90,1,0,trapezium_offset);
-
- draw_comp_endpoint((6,10),0,basic_offset);
- draw_comp_beginning((8,14),180,1.2,"1",1,fibonacci_offset);
-
- draw_comp_endpoint((1,6),0,momentum_offset);
- draw_comp_beginning((13,2),0,1,"1",1,dsigma_offset);
-
- draw_comp_endpoint((23.7,2.5),90,cuba_offset);
- draw_comp_beginning((1,3),180,1.2,"1",1,dsigma_offset);
-
- draw_comp_endpoint((27,4),180,trapezium_offset);
- draw_comp_beginning((5,2),180,1,"1",1,muli_offset);
-
- draw_comp_endpoint((3,4),0,mcint_offset);
- draw_comp_beginning((11,3),0,1,"1",1,muli_offset);
-
- draw_comp_endpoint((20,12),180,trapezium_offset);
- draw_comp_beginning((5,4),180,1,"1",1,muli_offset);
-
- draw_comp_endpoint((4,5),0,remnant_offset);
- draw_comp_beginning((11,5),0,1.5,"1",1,muli_offset);
-
- draw_comp_endpoint((25,9),180,fibonacci_offset);
- push_comp_line((27,10),-90,1,fibonacci_offset);
- push_comp_line((27,20),-90,1,fibonacci_offset);
- push_comp_line((-2,-5),-90,1,aq_offset);
- push_comp_line((-2,1),-90,1,aq_offset);
- draw_comp_beginning((1,4),180,1,"1",1,aq_offset);
-
- draw_comp_endpoint((1,4),0,trapezium_offset);
- push_comp_line((-1,5),-90,1,trapezium_offset);
- push_comp_line((-1,19),-90,1,trapezium_offset);
- push_comp_line((-1,-6),-90,1,aq_offset);
- push_comp_line((-1,1),-90,1,aq_offset);
- draw_comp_beginning((1,3),180,1,"1",1,aq_offset);
-endfig;
-beginfig(2)
- basic_module((0,0));
-endfig;
-beginfig(3)
- aq_module((0,0));
-endfig;
-beginfig(4)
- dsigma_module((0,0));
-endfig;
-beginfig(5)
- trapezium_module((0,0));
-endfig;
-beginfig(6)
- momentum_module((0,0));
-endfig;
-beginfig(7)
- muli_module((0,0));
-endfig;
-beginfig(8)
- remnant_module((0,0));
-endfig;
-beginfig(9)
- mcint_module((0,0));
-endfig;
-beginfig(10)
- cuba_module((0,0));
-endfig;
-beginfig(11)
- fibonacci_module((0,0));
-endfig;
-beginfig(12)
- interactions_module((0,0));
-endfig;
-end;
Index: trunk/src/muli/doc/muli_dsigma.tex
===================================================================
--- trunk/src/muli/doc/muli_dsigma.tex (revision 8371)
+++ trunk/src/muli/doc/muli_dsigma.tex (revision 8372)
@@ -1,187 +0,0 @@
-\Module{muli\_dsigma}
-%\begin{figure}
-% \centering{\includegraphics{uml-module-tree-4.mps}}
-% \caption{\label{fig:\ThisModule:types}Klassendiagramm des Moduls \ThisModule}
-%\end{figure}
-Hier wird eine Approximation der Stammstrati $\mathcal{S}(\pperp)$ aus \eqref{eq:all:strati_root_def} bereitgestellt. Die Integrationen in \eqref{eq:imp:double_strati_int} werden mit der externen Bibliothek libcuba ausgewertet, die verbleibende Integration in \eqref{eq:all:strati_root_def} wird mit dem muli-eigenen Modul \ModuleRef{muli\_aq} ausgewertet.
-
-Zu Beginn hatte ich mit verschiedenen Darstellungen der Wirkungsquerschnitte und mit verschiedenen Integrationsparametern und verschiedenen Einteilungen in Strati experimentiert. Um Codevervielfältigung zu vermeiden hatte ich dann den Code für die Integration von den Wirkungsquerschnitten getrennt. Da die Wirkungsquerschnitte auf Parameter zugreifen müssen, die nicht fur alle Darstellungen gleich sind, konnte ich die Integraden nicht als Funktion an \TypeRef{aq\_class} übergeben. Stattdessen habe ich mich entschieden, die verschiedenen Varianten durch Überladen der Methode evaluate zu erzeugen. So konnten die Erweiterung von \TypeRef{aq\_class} komplett verschiedene Methoden zur Auswertung von \eqref{eq:imp:double_strati_int}, und dennoch dieselbe Quadratur für \eqref{eq:all:strati_root_def} verwenden. Heute ist nur noch eine einzige Erweiterung übrig, nämlich \TypeRef{muli\_dsigma\_type} in diesem Modul. Deswegen ist der Sinn zwischen der Aufteilung der Module \ModuleRef{muli\_aq} und \ModuleRef{muli\_dsigma} nicht mehr offensichtlich.
-\section{Abhängigkeiten}
-\use{muli\_momentum}
-\use{muli\_interactions}
-\use{muli\_cuba}
-\use{muli\_aq}
-\section{Parameter}
-\begin{Verbatim}
- \IC{Die Anzahl der Strati plus 1, für die Summe aller Strati.}
- integer,parameter,private::\MC{dim\_f}=17
-\end{Verbatim}
-\section{Derived Types}
-\TypeDef{muli\_dsigma\_type}
-Der Zweck von muli\_dsigma\_type liegt darin, die abstrakte Methode evaluate von \TypeRef{aq\_class} zu implementieren und so einen Integradem für die nummerische Integration bereitzustellen. Weiterhin stellt aq\_class die Methode \TbpRef{muli\_dsigma\_type}{generate} zur Verfügung, um die Integration zu starten.
-
-Für das setzten der Faktorisierungsskala wird eine eigene Instanz \CompRef{muli\_dsigma\_type}{pt} des Datentyps \TypeRef{transversal\_momentum\_type} verwendet. Eigen bedeutet, dass \CompRef{muli\_dsigma\_type}{pt} nicht mit der muli-Skala synchronisiert ist, denn diese Integration findet vor der Eventgenerierung mit MULI statt.
-
-\begin{Verbatim}
- type,public,\Extends{aq\_class} :: muli_dsigma_type
- private
- type(\TypeRef{transversal\_momentum\_type})::pt\TC{pt}
- type(\TypeRef{cuba\_divonne\_type}) :: cuba_int\TC{cuba\_int}
- contains
- \OverridesDeclaration{serializable\_class}
- procedure::\TbpDec{write\_to\_marker}{muli\_dsigma\_write\_to\_marker}
- procedure::\TbpDec{read\_from\_marker}{muli\_dsigma\_read\_from\_marker}
- procedure::\TbpDec{print\_to\_unit}{muli\_dsigma\_print\_to\_unit}
- procedure,nopass::\TbpDec{get\_type}{muli\_dsigma\_get\_type}
- \OriginalDeclaration
- procedure :: \TbpDec{generate}{muli\_dsigma\_generate}
- procedure :: \TbpDec{evaluate}{muli\_dsigma\_evaluate}
- procedure :: muli_dsigma_initialize
- generic :: \TbpDec{initialize}{muli\_dsigma\_initialize}
- end type muli_dsigma_type
-\end{Verbatim}
-\Methods
-\MethodsFor{muli\_dsigma\_type}
-\TbpImp{muli\_dsigma\_write\_to\_marker}
-\begin{Verbatim}
- subroutine muli_dsigma_write_to_marker(this,marker,status)
- class(muli_dsigma_type), intent(in) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik), intent(out) :: status
- ! local variables
- class(serializable_class),pointer::ser
- call marker%mark_begin("muli_dsigma_type")
- call aq_write_to_marker(this,marker,status)
- call this%cuba_int%serialize(marker,"cuba_int")
- call marker%mark_end("muli_dsigma_type")
- end subroutine muli_dsigma_write_to_marker
-\end{Verbatim}
-
-\TbpImp{muli\_dsigma\_read\_from\_marker}
-\begin{Verbatim}
- subroutine muli_dsigma_read_from_marker(this,marker,status)
- class(muli_dsigma_type), intent(out) :: this
- class(marker_type),intent(inout)::marker
- integer(kind=dik), intent(out) :: status
- ! local variables
- call marker%pick_begin("muli_dsigma_type",status=status)
- call aq_read_from_marker(this,marker,status)
- call this%cuba_int%deserialize("cuba_int",marker)
- call marker%pick_end("muli_dsigma_type",status)
- end subroutine muli_dsigma_read_from_marker
-\end{Verbatim}
-
-\TbpImp{muli\_dsigma\_print\_to\_unit}
-\begin{Verbatim}
- subroutine muli_dsigma_print_to_unit(this,unit,parents,components,peers)
- class(muli_dsigma_type),intent(in)::this
- integer,intent(in)::unit
- integer(kind=dik),intent(in)::parents,components,peers
- integer::ite
- if(parents>0)call aq_print_to_unit(this,unit,parents-1,components,peers)
- write(unit,'("Components of muli_dsigma_type")')
- if(components>0)then
- write(unit,fmt=*)"Printing components of cuba_int:"
- call this%cuba_int%print_to_unit(unit,parents,components-1,peers)
- else
- write(unit,fmt=*)"Skipping components of cuba_int:"
- end if
- end subroutine muli_dsigma_print_to_unit
-\end{Verbatim}
-\TbpImp{muli\_dsigma\_get\_type}
-\begin{Verbatim}
- pure subroutine muli_dsigma_get_type(type)
- character(:),allocatable,intent(out)::type
- allocate(type,source="muli_dsigma_type")
- end subroutine muli_dsigma_get_type
-\end{Verbatim}
-\TbpImp{muli\_dsigma\_generate}
-Initialisierung und Generierung der Stammstrati $\mathcal{S}$.
-
-
-Man kann eine Start-Segmentierung des Integrationsbereichs angeben. Dadurch kann die Integration erheblich beschleunigt werden. Wir wählen eine Segmentierung in \emph{initial\_values} so, dass $\mu_j=\mu_0\exp(j)$, solange $\mu_j<\sqrt{s}/2$ und nehmen als letzten Wert $\sqrt{s}/2$ hinzu.
-\begin{Verbatim}
- subroutine muli_dsigma_generate(this,gev2_scale_cutoff,gev2_s,int_tree)
- class(muli_dsigma_type),intent(inout)::this
- real(kind=drk),intent(in)::gev2_scale_cutoff,gev2_s
- type(muli_trapezium_tree_type),intent(out)::int_tree
- real(kind=drk),dimension(ceiling(log(gev2_s/gev2_scale_cutoff)/2D0))::initial_values
- integer::n
- \IC{Debugging}
- print *,gev2_s/gev2_scale_cutoff,ceiling(log(gev2_s/gev2_scale_cutoff)/2D0)
- \IC{Setzen der Start-Segmentierung}
- initial_values(1)=sqrt(gev2_scale_cutoff/gev2_s)*2D0
- do n=2,size(initial_values)-1
- initial_values(n)=initial_values(n-1)*euler
- end do
- initial_values(n)=1D0
- \IC{Debugging}
- print *,initial_values
- \IC{Wir geben dieser Instanz einen Namen und die Nummer 1.}
- call identified_initialize(this,one,"dsigma")
- \IC{Die Skala wird initialisiert.}
- call this%pt%initialize(gev2_s)
- \IC{Die Genauigkeit der Stammfunktion \eqref{eq:all:strati_root_def}}
- this%abs_error_goal = 0D0
- this%rel_error_goal=scale(1D0,-12)!-12
- this%max_nodes=1000
- \IC{Dimension und Genauigkeit der Integration \eqref{eq:imp:double_strati_int}}
- call this%cuba_int%set_common(&
- &dim_f=dim_f,&
- &dim_x=2,&
- &eps_rel=scale(this%rel_error_goal,-8),&!-8
- &flags = 0)
- \IC{Die ungefähre Position der Maxima des Integranden}
- call this%cuba_int%set_deferred&
- (xgiven_flat=[1D-2,5D-1+epsilon(1D0),1D-2,5D-1-epsilon(1D0)])
- print *,"muli_dsigma_generate:"
- print *,"Overall Error Goal: ",this%rel_error_goal
- \IC{Wir initialisieren die Integration mit der Start-Segmentierung}
- call this%init_error_tree(dim_f,initial_values)
- \IC{Die eigentliche Integration}
- call this%run()
- \IC{Konvertierung der internen Darstellung mittels \TypeRef{fibonacci\_root\_type}}
- \IC{in ein bessere Darstellung mittels \TypeRef{muli\_trapezium\_tree\_type}.}
- call this%integrate(int_tree)
- \IC{Aufräumen}
- call this%err_tree%deallocate_all()
- deallocate(this%err_tree)
- nullify(this%int_list)
- end subroutine muli_dsigma_generate
-\end{Verbatim}
-\TbpImp{muli\_dsigma\_evaluate}
-Die Wahl der Integrationsroutine und der Darstellung der Wirkungsquerschnitte.
-\begin{Verbatim}
- subroutine muli_dsigma_evaluate(this,x,y)
- class(muli_dsigma_type),intent(inout) :: this
- real(kind=double), intent(in) :: x