mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-24 21:41:46 +02:00
Merge branch 'LCPQ-master'
This commit is contained in:
commit
5b3fbf792d
@ -27,4 +27,4 @@ script:
|
|||||||
- source ./quantum_package.rc ; qp_module.py install Full_CI Hartree_Fock CAS_SD MRCC_CASSD All_singles
|
- source ./quantum_package.rc ; qp_module.py install Full_CI Hartree_Fock CAS_SD MRCC_CASSD All_singles
|
||||||
- source ./quantum_package.rc ; ninja
|
- source ./quantum_package.rc ; ninja
|
||||||
- source ./quantum_package.rc ; cd ocaml ; make ; cd -
|
- source ./quantum_package.rc ; cd ocaml ; make ; cd -
|
||||||
- source ./quantum_package.rc ; cd tests ; bats bats/qp.bats
|
- source ./quantum_package.rc ; cd tests ; ./run_tests.sh #-v
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
#
|
#
|
||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : gfortran -g -ffree-line-length-none -I . -static-libgcc
|
FC : gfortran -ffree-line-length-none -I .
|
||||||
LAPACK_LIB : -llapack -lblas
|
LAPACK_LIB : -llapack -lblas
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32
|
IRPF90_FLAGS : --ninja --align=32
|
||||||
@ -35,7 +35,7 @@ OPENMP : 1 ; Append OpenMP flags
|
|||||||
# -ffast-math and the Fortran-specific
|
# -ffast-math and the Fortran-specific
|
||||||
# -fno-protect-parens and -fstack-arrays.
|
# -fno-protect-parens and -fstack-arrays.
|
||||||
[OPT]
|
[OPT]
|
||||||
FCFLAGS : -Ofast -march=native
|
FCFLAGS : -Ofast
|
||||||
|
|
||||||
# Profiling flags
|
# Profiling flags
|
||||||
#################
|
#################
|
||||||
|
62
config/gfortran_avx.cfg
Normal file
62
config/gfortran_avx.cfg
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
# Common flags
|
||||||
|
##############
|
||||||
|
#
|
||||||
|
# -ffree-line-length-none : Needed for IRPF90 which produces long lines
|
||||||
|
# -lblas -llapack : Link with libblas and liblapack libraries provided by the system
|
||||||
|
# -I . : Include the curent directory (Mandatory)
|
||||||
|
#
|
||||||
|
# --ninja : Allow the utilisation of ninja. (Mandatory)
|
||||||
|
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||||
|
#
|
||||||
|
#
|
||||||
|
[COMMON]
|
||||||
|
FC : gfortran -ffree-line-length-none -I . -mavx
|
||||||
|
LAPACK_LIB : -llapack -lblas
|
||||||
|
IRPF90 : irpf90
|
||||||
|
IRPF90_FLAGS : --ninja --align=32
|
||||||
|
|
||||||
|
# Global options
|
||||||
|
################
|
||||||
|
#
|
||||||
|
# 1 : Activate
|
||||||
|
# 0 : Deactivate
|
||||||
|
#
|
||||||
|
[OPTION]
|
||||||
|
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||||
|
CACHE : 1 ; Enable cache_compile.py
|
||||||
|
OPENMP : 1 ; Append OpenMP flags
|
||||||
|
|
||||||
|
# Optimization flags
|
||||||
|
####################
|
||||||
|
#
|
||||||
|
# -Ofast : Disregard strict standards compliance. Enables all -O3 optimizations.
|
||||||
|
# It also enables optimizations that are not valid
|
||||||
|
# for all standard-compliant programs. It turns on
|
||||||
|
# -ffast-math and the Fortran-specific
|
||||||
|
# -fno-protect-parens and -fstack-arrays.
|
||||||
|
[OPT]
|
||||||
|
FCFLAGS : -Ofast
|
||||||
|
|
||||||
|
# Profiling flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
[PROFILE]
|
||||||
|
FC : -p -g
|
||||||
|
FCFLAGS : -Ofast
|
||||||
|
|
||||||
|
# Debugging flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
# -fcheck=all : Checks uninitialized variables, array subscripts, etc...
|
||||||
|
# -g : Extra debugging information
|
||||||
|
#
|
||||||
|
[DEBUG]
|
||||||
|
FCFLAGS : -fcheck=all -g
|
||||||
|
|
||||||
|
# OpenMP flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
[OPENMP]
|
||||||
|
FC : -fopenmp
|
||||||
|
IRPF90_FLAGS : --openmp
|
||||||
|
|
62
config/gfortran_debug.cfg
Normal file
62
config/gfortran_debug.cfg
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
# Common flags
|
||||||
|
##############
|
||||||
|
#
|
||||||
|
# -ffree-line-length-none : Needed for IRPF90 which produces long lines
|
||||||
|
# -lblas -llapack : Link with libblas and liblapack libraries provided by the system
|
||||||
|
# -I . : Include the curent directory (Mandatory)
|
||||||
|
#
|
||||||
|
# --ninja : Allow the utilisation of ninja. (Mandatory)
|
||||||
|
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||||
|
#
|
||||||
|
#
|
||||||
|
[COMMON]
|
||||||
|
FC : gfortran -g -ffree-line-length-none -I . -static-libgcc
|
||||||
|
LAPACK_LIB : -llapack -lblas
|
||||||
|
IRPF90 : irpf90
|
||||||
|
IRPF90_FLAGS : --ninja --assert --align=32
|
||||||
|
|
||||||
|
# Global options
|
||||||
|
################
|
||||||
|
#
|
||||||
|
# 1 : Activate
|
||||||
|
# 0 : Deactivate
|
||||||
|
#
|
||||||
|
[OPTION]
|
||||||
|
MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||||
|
CACHE : 0 ; Enable cache_compile.py
|
||||||
|
OPENMP : 1 ; Append OpenMP flags
|
||||||
|
|
||||||
|
# Optimization flags
|
||||||
|
####################
|
||||||
|
#
|
||||||
|
# -Ofast : Disregard strict standards compliance. Enables all -O3 optimizations.
|
||||||
|
# It also enables optimizations that are not valid
|
||||||
|
# for all standard-compliant programs. It turns on
|
||||||
|
# -ffast-math and the Fortran-specific
|
||||||
|
# -fno-protect-parens and -fstack-arrays.
|
||||||
|
[OPT]
|
||||||
|
FCFLAGS : -Ofast
|
||||||
|
|
||||||
|
# Profiling flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
[PROFILE]
|
||||||
|
FC : -p -g
|
||||||
|
FCFLAGS : -Ofast
|
||||||
|
|
||||||
|
# Debugging flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
# -fcheck=all : Checks uninitialized variables, array subscripts, etc...
|
||||||
|
# -g : Extra debugging information
|
||||||
|
#
|
||||||
|
[DEBUG]
|
||||||
|
FCFLAGS : -g -pedantic -msse4.2
|
||||||
|
|
||||||
|
# OpenMP flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
[OPENMP]
|
||||||
|
FC : -fopenmp
|
||||||
|
IRPF90_FLAGS : --openmp
|
||||||
|
|
9
configure
vendored
9
configure
vendored
@ -144,8 +144,8 @@ zeromq = Info(
|
|||||||
f77zmq = Info(
|
f77zmq = Info(
|
||||||
url='{head}/zeromq/f77_zmq/{tail}'.format(**path_github),
|
url='{head}/zeromq/f77_zmq/{tail}'.format(**path_github),
|
||||||
description=' F77-ZeroMQ',
|
description=' F77-ZeroMQ',
|
||||||
default_path=join(QP_ROOT_LIB, "libf77zmq.a") + " " + \
|
default_path=join(QP_ROOT_LIB, "libf77zmq.a") )
|
||||||
join(QP_ROOT, "src", "ZMQ", "f77zmq.h") )
|
# join(QP_ROOT, "src", "ZMQ", "f77zmq.h") )
|
||||||
|
|
||||||
p_graphviz = Info(
|
p_graphviz = Info(
|
||||||
url='https://github.com/xflr6/graphviz/archive/master.tar.gz',
|
url='https://github.com/xflr6/graphviz/archive/master.tar.gz',
|
||||||
@ -328,7 +328,7 @@ def installation(l_install_descendant):
|
|||||||
|
|
||||||
l_rules += [
|
l_rules += [
|
||||||
"rule install_verbose",
|
"rule install_verbose",
|
||||||
" command = ./scripts/install_${target}.sh | tee _build/${target}.log 2>&1",
|
' command = bash -o pipefail -c "./scripts/install_${target}.sh | tee _build/${target}.log 2>&1" ',
|
||||||
" description = Installing ${descr}", " pool = console", ""
|
" description = Installing ${descr}", " pool = console", ""
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -482,10 +482,11 @@ def create_ninja_and_rc(l_installed):
|
|||||||
|
|
||||||
l_rc = [
|
l_rc = [
|
||||||
'export QP_ROOT={0}'.format(QP_ROOT),
|
'export QP_ROOT={0}'.format(QP_ROOT),
|
||||||
|
'#export QP_NIC=ib0 # Choose the correct network inuterface',
|
||||||
'export QP_EZFIO={0}'.format(path_ezfio.replace(QP_ROOT,"${QP_ROOT}")),
|
'export QP_EZFIO={0}'.format(path_ezfio.replace(QP_ROOT,"${QP_ROOT}")),
|
||||||
|
'export QP_PYTHON={0}'.format(":".join(l_python)), "",
|
||||||
'export IRPF90={0}'.format(path_irpf90.replace(QP_ROOT,"${QP_ROOT}")),
|
'export IRPF90={0}'.format(path_irpf90.replace(QP_ROOT,"${QP_ROOT}")),
|
||||||
'export NINJA={0}'.format(path_ninja.replace(QP_ROOT,"${QP_ROOT}")),
|
'export NINJA={0}'.format(path_ninja.replace(QP_ROOT,"${QP_ROOT}")),
|
||||||
'export QP_PYTHON={0}'.format(":".join(l_python)), "",
|
|
||||||
'export PYTHONPATH="${QP_EZFIO}/Python":"${QP_PYTHON}":"${PYTHONPATH}"',
|
'export PYTHONPATH="${QP_EZFIO}/Python":"${QP_PYTHON}":"${PYTHONPATH}"',
|
||||||
'export PATH="${QP_PYTHON}":"${QP_ROOT}"/bin:"${QP_ROOT}"/ocaml:"${PATH}"',
|
'export PATH="${QP_PYTHON}":"${QP_ROOT}"/bin:"${QP_ROOT}"/ocaml:"${PATH}"',
|
||||||
'export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}"',
|
'export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}"',
|
||||||
|
@ -1,3 +1,735 @@
|
|||||||
|
BORON
|
||||||
|
S 11
|
||||||
|
1 210400.0000000 0.00000583
|
||||||
|
2 31500.0000000 0.00004532
|
||||||
|
3 7169.0000000 0.00023838
|
||||||
|
4 2030.0000000 0.00100570
|
||||||
|
5 662.5000000 0.00364496
|
||||||
|
6 239.2000000 0.01173628
|
||||||
|
7 93.2600000 0.03380702
|
||||||
|
8 38.6400000 0.08556593
|
||||||
|
9 16.7800000 0.18260322
|
||||||
|
10 7.5410000 0.30583760
|
||||||
|
11 3.4820000 0.34080347
|
||||||
|
S 11
|
||||||
|
1 210400.0000000 -0.00000118
|
||||||
|
2 31500.0000000 -0.00000915
|
||||||
|
3 7169.0000000 -0.00004819
|
||||||
|
4 2030.0000000 -0.00020306
|
||||||
|
5 662.5000000 -0.00073917
|
||||||
|
6 239.2000000 -0.00238603
|
||||||
|
7 93.2600000 -0.00698654
|
||||||
|
8 38.6400000 -0.01811594
|
||||||
|
9 16.7800000 -0.04123129
|
||||||
|
10 7.5410000 -0.07781353
|
||||||
|
11 3.4820000 -0.12123181
|
||||||
|
S 1
|
||||||
|
1 1.6180000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.6270000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.2934000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.1310000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.0581500 1.0000000
|
||||||
|
S 1
|
||||||
|
1 127.6200000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 63.6510000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 31.7460000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 15.8330000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 7.8970000 1.0000000
|
||||||
|
P 5
|
||||||
|
1 192.5000000 0.00013490
|
||||||
|
2 45.6400000 0.00114741
|
||||||
|
3 14.7500000 0.00584793
|
||||||
|
4 5.5030000 0.02117091
|
||||||
|
5 2.2220000 0.06266872
|
||||||
|
P 1
|
||||||
|
1 0.9590000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.4314000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.1969000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.0903300 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.0406600 1.0000000
|
||||||
|
P 1
|
||||||
|
1 144.2110000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 63.6980000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 28.1350000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 12.4270000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 5.4890000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 2.8860000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 1.2670000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.5560000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.2440000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.1070000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 100.3980000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 43.1630000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 18.5570000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 7.9780000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 1.6510000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.8002000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.3878000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.1880000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 56.0930000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 20.3090000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 7.3530000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 1.6469000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 0.7889000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 0.3779000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 43.0160000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 14.4690000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 1.3120000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 0.5806000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 29.5550000 1.0000000
|
||||||
|
I 1
|
||||||
|
1 0.9847000 1.0000000
|
||||||
|
|
||||||
|
CARBON
|
||||||
|
S 11
|
||||||
|
1 312100.0000000 0.00000567
|
||||||
|
2 46740.0000000 0.00004410
|
||||||
|
3 10640.0000000 0.00023190
|
||||||
|
4 3013.0000000 0.00097897
|
||||||
|
5 982.8000000 0.00355163
|
||||||
|
6 354.8000000 0.01144061
|
||||||
|
7 138.4000000 0.03299855
|
||||||
|
8 57.3500000 0.08405347
|
||||||
|
9 24.9200000 0.18067613
|
||||||
|
10 11.2300000 0.30491140
|
||||||
|
11 5.2010000 0.34141570
|
||||||
|
S 11
|
||||||
|
1 312100.0000000 -0.00000121
|
||||||
|
2 46740.0000000 -0.00000939
|
||||||
|
3 10640.0000000 -0.00004947
|
||||||
|
4 3013.0000000 -0.00020857
|
||||||
|
5 982.8000000 -0.00076015
|
||||||
|
6 354.8000000 -0.00245469
|
||||||
|
7 138.4000000 -0.00720153
|
||||||
|
8 57.3500000 -0.01880742
|
||||||
|
9 24.9200000 -0.04325001
|
||||||
|
10 11.2300000 -0.08259733
|
||||||
|
11 5.2010000 -0.12857592
|
||||||
|
S 1
|
||||||
|
1 2.4260000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.9673000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.4456000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.1971000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.0863500 1.0000000
|
||||||
|
S 1
|
||||||
|
1 183.0760000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 91.9980000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 46.2300000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 23.2310000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 11.6740000 1.0000000
|
||||||
|
P 5
|
||||||
|
1 295.2000000 0.00014249
|
||||||
|
2 69.9800000 0.00122010
|
||||||
|
3 22.6400000 0.00633696
|
||||||
|
4 8.4850000 0.02351875
|
||||||
|
5 3.4590000 0.06990447
|
||||||
|
P 1
|
||||||
|
1 1.5040000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.6783000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.3087000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.1400000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.0617800 1.0000000
|
||||||
|
P 1
|
||||||
|
1 206.5670000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 92.5890000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 41.5010000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 18.6020000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 8.3380000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 4.5420000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 1.9790000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.8621000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.3756000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.1636000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 145.5240000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 62.9160000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 27.2010000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 11.7600000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 2.6310000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 1.2550000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.5988000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.2857000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 78.5650000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 28.0590000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 10.0210000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 2.6520000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 1.2040000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 0.5470000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 55.1450000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 17.6070000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 2.0300000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 0.8511000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 40.7100000 1.0000000
|
||||||
|
I 1
|
||||||
|
1 1.4910000 1.0000000
|
||||||
|
|
||||||
|
NITROGEN
|
||||||
|
S 11
|
||||||
|
1 432300.0000000 0.00000559
|
||||||
|
2 64700.0000000 0.00004351
|
||||||
|
3 14720.0000000 0.00022893
|
||||||
|
4 4170.0000000 0.00096502
|
||||||
|
5 1361.0000000 0.00350219
|
||||||
|
6 491.2000000 0.01129212
|
||||||
|
7 191.6000000 0.03261283
|
||||||
|
8 79.4100000 0.08329727
|
||||||
|
9 34.5300000 0.17998566
|
||||||
|
10 15.5800000 0.30500351
|
||||||
|
11 7.2320000 0.34115932
|
||||||
|
S 11
|
||||||
|
1 432300.0000000 -0.00000123
|
||||||
|
2 64700.0000000 -0.00000958
|
||||||
|
3 14720.0000000 -0.00005051
|
||||||
|
4 4170.0000000 -0.00021264
|
||||||
|
5 1361.0000000 -0.00077534
|
||||||
|
6 491.2000000 -0.00250624
|
||||||
|
7 191.6000000 -0.00736529
|
||||||
|
8 79.4100000 -0.01930167
|
||||||
|
9 34.5300000 -0.04471738
|
||||||
|
10 15.5800000 -0.08606647
|
||||||
|
11 7.2320000 -0.13329627
|
||||||
|
S 1
|
||||||
|
1 3.3820000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 1.3690000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.6248000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.2747000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.1192000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 246.2620000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 124.1870000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 62.6260000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 31.5810000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 15.9260000 1.0000000
|
||||||
|
P 5
|
||||||
|
1 415.9000000 0.00014841
|
||||||
|
2 98.6100000 0.00127634
|
||||||
|
3 31.9200000 0.00670242
|
||||||
|
4 12.0000000 0.02526170
|
||||||
|
5 4.9190000 0.07518943
|
||||||
|
P 1
|
||||||
|
1 2.1480000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.9696000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.4399000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.1978000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.0860300 1.0000000
|
||||||
|
P 1
|
||||||
|
1 270.1420000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 123.4650000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 56.4280000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 25.7900000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 11.7870000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 6.7170000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 2.8960000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 1.2490000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.5380000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.2320000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 199.9200000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 87.1110000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 37.9570000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 16.5390000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 3.8290000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 1.7950000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.8410000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.3940000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 105.3460000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 37.5300000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 13.3700000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 3.8560000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 1.7020000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 0.7510000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 67.1880000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 20.3600000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 2.8750000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 1.1700000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 52.0500000 1.0000000
|
||||||
|
I 1
|
||||||
|
1 2.0990000 1.0000000
|
||||||
|
|
||||||
|
OXYGEN
|
||||||
|
S 11
|
||||||
|
1 570800.0000000 0.00000555
|
||||||
|
2 85480.0000000 0.00004311
|
||||||
|
3 19460.0000000 0.00022667
|
||||||
|
4 5512.0000000 0.00095637
|
||||||
|
5 1798.0000000 0.00347320
|
||||||
|
6 648.9000000 0.01119778
|
||||||
|
7 253.1000000 0.03238766
|
||||||
|
8 104.9000000 0.08285977
|
||||||
|
9 45.6500000 0.17958381
|
||||||
|
10 20.6200000 0.30522110
|
||||||
|
11 9.5870000 0.34089349
|
||||||
|
S 11
|
||||||
|
1 570800.0000000 -0.00000126
|
||||||
|
2 85480.0000000 -0.00000977
|
||||||
|
3 19460.0000000 -0.00005148
|
||||||
|
4 5512.0000000 -0.00021696
|
||||||
|
5 1798.0000000 -0.00079162
|
||||||
|
6 648.9000000 -0.00255900
|
||||||
|
7 253.1000000 -0.00753313
|
||||||
|
8 104.9000000 -0.01978897
|
||||||
|
9 45.6500000 -0.04606288
|
||||||
|
10 20.6200000 -0.08919560
|
||||||
|
11 9.5870000 -0.13754216
|
||||||
|
S 1
|
||||||
|
1 4.4930000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 1.8370000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.8349000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.3658000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.1570000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 317.0960000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 160.3930000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 81.1290000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 41.0370000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 20.7570000 1.0000000
|
||||||
|
P 5
|
||||||
|
1 525.6000000 0.00016664
|
||||||
|
2 124.6000000 0.00143336
|
||||||
|
3 40.3400000 0.00754762
|
||||||
|
4 15.1800000 0.02859456
|
||||||
|
5 6.2450000 0.08438858
|
||||||
|
P 1
|
||||||
|
1 2.7320000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 1.2270000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.5492000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.2418000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.1025000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 358.9110000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 161.8180000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 72.9570000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 32.8930000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 14.8300000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 8.2530000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 3.5970000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 1.5680000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.6840000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.2980000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 250.8300000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 108.1630000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 46.6420000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 20.1130000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 5.4300000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 2.4160000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 1.0750000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.4780000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 136.1110000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 48.8550000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 17.5360000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 5.2110000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 2.1900000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 0.9200000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 81.6280000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 24.0650000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 3.8720000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 1.5050000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 62.8500000 1.0000000
|
||||||
|
I 1
|
||||||
|
1 2.7730000 1.0000000
|
||||||
|
|
||||||
|
FLUORINE
|
||||||
|
S 11
|
||||||
|
1 723500.0000000 0.00000556
|
||||||
|
2 108400.0000000 0.00004318
|
||||||
|
3 24680.0000000 0.00022700
|
||||||
|
4 6990.0000000 0.00095803
|
||||||
|
5 2282.0000000 0.00347015
|
||||||
|
6 824.6000000 0.01118526
|
||||||
|
7 321.8000000 0.03232880
|
||||||
|
8 133.5000000 0.08279545
|
||||||
|
9 58.1100000 0.17988024
|
||||||
|
10 26.2800000 0.30557831
|
||||||
|
11 12.2400000 0.34026839
|
||||||
|
S 11
|
||||||
|
1 723500.0000000 -0.00000129
|
||||||
|
2 108400.0000000 -0.00000999
|
||||||
|
3 24680.0000000 -0.00005260
|
||||||
|
4 6990.0000000 -0.00022172
|
||||||
|
5 2282.0000000 -0.00080692
|
||||||
|
6 824.6000000 -0.00260817
|
||||||
|
7 321.8000000 -0.00767402
|
||||||
|
8 133.5000000 -0.02019353
|
||||||
|
9 58.1100000 -0.04718752
|
||||||
|
10 26.2800000 -0.09158009
|
||||||
|
11 12.2400000 -0.14048558
|
||||||
|
S 1
|
||||||
|
1 5.7470000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 2.3650000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 1.0710000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.4681000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.1994000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 397.5440000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 201.5940000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 102.2280000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 51.8400000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 26.2880000 1.0000000
|
||||||
|
P 5
|
||||||
|
1 660.0000000 0.00017721
|
||||||
|
2 156.4000000 0.00152691
|
||||||
|
3 50.6400000 0.00807207
|
||||||
|
4 19.0800000 0.03074021
|
||||||
|
5 7.8720000 0.09011914
|
||||||
|
P 1
|
||||||
|
1 3.4490000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 1.5450000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.6864000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.2986000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.1245000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 446.5700000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 201.3390000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 90.7750000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 40.9270000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 18.4520000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 10.5730000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 4.6130000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 2.0130000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.8780000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.3830000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 313.7310000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 135.4040000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 58.4390000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 25.2220000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 7.5630000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 3.3300000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 1.4660000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.6450000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 177.2200000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 64.3500000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 23.3660000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 6.7350000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 2.7830000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 1.1500000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 99.3840000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 29.5170000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 5.0880000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 1.9370000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 67.8200000 1.0000000
|
||||||
|
I 1
|
||||||
|
1 3.5810000 1.0000000
|
||||||
|
|
||||||
|
NEON
|
||||||
|
S 11
|
||||||
|
1 902400.0000000 0.00000551
|
||||||
|
2 135100.0000000 0.00004282
|
||||||
|
3 30750.0000000 0.00022514
|
||||||
|
4 8710.0000000 0.00095016
|
||||||
|
5 2842.0000000 0.00344719
|
||||||
|
6 1026.0000000 0.01112545
|
||||||
|
7 400.1000000 0.03220568
|
||||||
|
8 165.9000000 0.08259891
|
||||||
|
9 72.2100000 0.17990564
|
||||||
|
10 32.6600000 0.30605208
|
||||||
|
11 15.2200000 0.34012559
|
||||||
|
S 11
|
||||||
|
1 902400.0000000 -0.00000129
|
||||||
|
2 135100.0000000 -0.00001005
|
||||||
|
3 30750.0000000 -0.00005293
|
||||||
|
4 8710.0000000 -0.00022312
|
||||||
|
5 2842.0000000 -0.00081338
|
||||||
|
6 1026.0000000 -0.00263230
|
||||||
|
7 400.1000000 -0.00775910
|
||||||
|
8 165.9000000 -0.02045277
|
||||||
|
9 72.2100000 -0.04797505
|
||||||
|
10 32.6600000 -0.09340086
|
||||||
|
11 15.2200000 -0.14277215
|
||||||
|
S 1
|
||||||
|
1 7.1490000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 2.9570000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 1.3350000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.5816000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 0.2463000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 526.1367000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 264.9976000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 133.4704000 1.0000000
|
||||||
|
S 1
|
||||||
|
1 67.2246200 1.0000000
|
||||||
|
S 1
|
||||||
|
1 33.8588000 1.0000000
|
||||||
|
P 5
|
||||||
|
1 815.6000000 0.00018376
|
||||||
|
2 193.3000000 0.00158509
|
||||||
|
3 62.6000000 0.00841464
|
||||||
|
4 23.6100000 0.03220033
|
||||||
|
5 9.7620000 0.09396390
|
||||||
|
P 1
|
||||||
|
1 4.2810000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 1.9150000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.8476000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.3660000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 0.1510000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 558.8741000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 250.2470000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 112.0531000 1.0000000
|
||||||
|
P 1
|
||||||
|
1 50.1739900 1.0000000
|
||||||
|
P 1
|
||||||
|
1 22.4664000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 13.3170000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 5.8030000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 2.5290000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 1.1020000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 0.4800000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 392.7164000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 169.5564000 1.0000000
|
||||||
|
D 1
|
||||||
|
1 73.2064700 1.0000000
|
||||||
|
D 1
|
||||||
|
1 31.6071000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 10.3560000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 4.5380000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 1.9890000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 0.8710000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 224.9657000 1.0000000
|
||||||
|
F 1
|
||||||
|
1 82.4518500 1.0000000
|
||||||
|
F 1
|
||||||
|
1 30.2193000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 8.3450000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 3.4170000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 1.3990000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 119.8449000 1.0000000
|
||||||
|
G 1
|
||||||
|
1 33.5255000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 6.5190000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 2.4470000 1.0000000
|
||||||
|
H 1
|
||||||
|
1 50.9084700 1.0000000
|
||||||
|
I 1
|
||||||
|
1 4.4890000 1.0000000
|
||||||
|
|
||||||
ALUMINUM
|
ALUMINUM
|
||||||
S 11
|
S 11
|
||||||
1 3652000.0000000 0.0000019
|
1 3652000.0000000 0.0000019
|
||||||
|
118
data/list_element.txt
Normal file
118
data/list_element.txt
Normal file
@ -0,0 +1,118 @@
|
|||||||
|
1 H Hydrogen
|
||||||
|
2 He Helium
|
||||||
|
3 Li Lithium
|
||||||
|
4 Be Beryllium
|
||||||
|
5 B Boron
|
||||||
|
6 C Carbon
|
||||||
|
7 N Nitrogen
|
||||||
|
8 O Oxygen
|
||||||
|
9 F Fluorine
|
||||||
|
10 Ne Neon
|
||||||
|
11 Na Sodium
|
||||||
|
12 Mg Magnesium
|
||||||
|
13 Al Aluminum
|
||||||
|
14 Si Silicon
|
||||||
|
15 P Phosphorus
|
||||||
|
16 S Sulfur
|
||||||
|
17 Cl Chlorine
|
||||||
|
18 Ar Argon
|
||||||
|
19 K Potassium
|
||||||
|
20 Ca Calcium
|
||||||
|
21 Sc Scandium
|
||||||
|
22 Ti Titanium
|
||||||
|
23 V Vanadium
|
||||||
|
24 Cr Chromium
|
||||||
|
25 Mn Manganese
|
||||||
|
26 Fe Iron
|
||||||
|
27 Co Cobalt
|
||||||
|
28 Ni Nickel
|
||||||
|
29 Cu Copper
|
||||||
|
30 Zn Zinc
|
||||||
|
31 Ga Gallium
|
||||||
|
32 Ge Germanium
|
||||||
|
33 As Arsenic
|
||||||
|
34 Se Selenium
|
||||||
|
35 Br Bromine
|
||||||
|
36 Kr Krypton
|
||||||
|
37 Rb Rubidium
|
||||||
|
38 Sr Strontium
|
||||||
|
39 Y Yttrium
|
||||||
|
40 Zr Zirconium
|
||||||
|
41 Nb Niobium
|
||||||
|
42 Mo Molybdenum
|
||||||
|
43 Tc Technetium
|
||||||
|
44 Ru Ruthenium
|
||||||
|
45 Rh Rhodium
|
||||||
|
46 Pd Palladium
|
||||||
|
47 Ag Silver
|
||||||
|
48 Cd Cadmium
|
||||||
|
49 In Indium
|
||||||
|
50 Sn Tin
|
||||||
|
51 Sb Antimony
|
||||||
|
52 Te Tellurium
|
||||||
|
53 I Iodine
|
||||||
|
54 Xe Xenon
|
||||||
|
55 Cs Cesium
|
||||||
|
56 Ba Barium
|
||||||
|
57 La Lanthanum
|
||||||
|
58 Ce Cerium
|
||||||
|
59 Pr Praseodymium
|
||||||
|
60 Nd Neodymium
|
||||||
|
61 Pm Promethium
|
||||||
|
62 Sm Samarium
|
||||||
|
63 Eu Europium
|
||||||
|
64 Gd Gadolinium
|
||||||
|
65 Tb Terbium
|
||||||
|
66 Dy Dysprosium
|
||||||
|
67 Ho Holmium
|
||||||
|
68 Er Erbium
|
||||||
|
69 Tm Thulium
|
||||||
|
70 Yb Ytterbium
|
||||||
|
71 Lu Lutetium
|
||||||
|
72 Hf Hafnium
|
||||||
|
73 Ta Tantalum
|
||||||
|
74 W Tungsten
|
||||||
|
75 Re Rhenium
|
||||||
|
76 Os Osmium
|
||||||
|
77 Ir Iridium
|
||||||
|
78 Pt Platinum
|
||||||
|
79 Au Gold
|
||||||
|
80 Hg Mercury
|
||||||
|
81 Tl Thallium
|
||||||
|
82 Pb Lead
|
||||||
|
83 Bi Bismuth
|
||||||
|
84 Po Polonium
|
||||||
|
85 At Astatine
|
||||||
|
86 Rn Radon
|
||||||
|
87 Fr Francium
|
||||||
|
88 Ra Radium
|
||||||
|
89 Ac Actinium
|
||||||
|
90 Th Thorium
|
||||||
|
91 Pa Protactinium
|
||||||
|
92 U Uranium
|
||||||
|
93 Np Neptunium
|
||||||
|
94 Pu Plutonium
|
||||||
|
95 Am Americium
|
||||||
|
96 Cm Curium
|
||||||
|
97 Bk Berkelium
|
||||||
|
98 Cf Californium
|
||||||
|
99 Es Einsteinium
|
||||||
|
100 Fm Fermium
|
||||||
|
101 Md Mendelevium
|
||||||
|
102 No Nobelium
|
||||||
|
103 Lr Lawrencium
|
||||||
|
104 Rf Rutherfordium
|
||||||
|
105 Db Dubnium
|
||||||
|
106 Sg Seaborgium
|
||||||
|
107 Bh Bohrium
|
||||||
|
108 Hs Hassium
|
||||||
|
109 Mt Meitnerium
|
||||||
|
110 Ds Darmstadtium
|
||||||
|
111 Rg Roentgenium
|
||||||
|
112 Cn Copernicium
|
||||||
|
113 Uut Ununtrium
|
||||||
|
114 Fl Flerovium
|
||||||
|
115 Uup Ununpentium
|
||||||
|
116 Lv Livermorium
|
||||||
|
117 Uus Ununseptium
|
||||||
|
118 Uuo Ununoctium
|
61
ocaml/.gitignore
vendored
61
ocaml/.gitignore
vendored
@ -1,61 +0,0 @@
|
|||||||
_build
|
|
||||||
ezfio.ml
|
|
||||||
.gitignore
|
|
||||||
Git.ml
|
|
||||||
Input_auto_generated.ml
|
|
||||||
Input_determinants.ml
|
|
||||||
Input_foboci.ml
|
|
||||||
Input_hartree_fock.ml
|
|
||||||
Input_integrals_bielec.ml
|
|
||||||
Input_perturbation.ml
|
|
||||||
Input_properties.ml
|
|
||||||
Input_pseudo.ml
|
|
||||||
qp_basis_clean
|
|
||||||
qp_basis_clean.native
|
|
||||||
qp_create_ezfio_from_xyz
|
|
||||||
qp_create_ezfio_from_xyz.native
|
|
||||||
qp_edit
|
|
||||||
qp_edit.ml
|
|
||||||
qp_edit.native
|
|
||||||
qp_print
|
|
||||||
qp_print_basis
|
|
||||||
qp_print_basis.native
|
|
||||||
qp_print.native
|
|
||||||
qp_run
|
|
||||||
qp_run.native
|
|
||||||
qp_set_ddci
|
|
||||||
qp_set_ddci.native
|
|
||||||
qp_set_mo_class
|
|
||||||
qp_set_mo_class.native
|
|
||||||
qptypes_generator.byte
|
|
||||||
Qptypes.ml
|
|
||||||
test_atom
|
|
||||||
test_atom.byte
|
|
||||||
test_basis
|
|
||||||
test_basis.byte
|
|
||||||
test_bitlist
|
|
||||||
test_bitlist.byte
|
|
||||||
test_determinants
|
|
||||||
test_determinants.byte
|
|
||||||
test_elements
|
|
||||||
test_elements.byte
|
|
||||||
test_excitation
|
|
||||||
test_excitation.byte
|
|
||||||
test_gto
|
|
||||||
test_gto.byte
|
|
||||||
test_message
|
|
||||||
test_message.byte
|
|
||||||
test_mo_label
|
|
||||||
test_mo_label.byte
|
|
||||||
test_molecule
|
|
||||||
test_molecule.byte
|
|
||||||
test_point3d
|
|
||||||
test_point3d.byte
|
|
||||||
test_pseudo
|
|
||||||
test_pseudo.byte
|
|
||||||
test_queuing_system
|
|
||||||
test_queuing_system.byte
|
|
||||||
test_symmetry
|
|
||||||
test_symmetry.byte
|
|
||||||
test_task_server
|
|
||||||
test_task_server.byte
|
|
@ -4,11 +4,15 @@ module Tcp : sig
|
|||||||
type t
|
type t
|
||||||
val of_string : string -> t
|
val of_string : string -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
|
val create : host:string -> port:int -> t
|
||||||
end = struct
|
end = struct
|
||||||
type t = string
|
type t = string
|
||||||
let of_string x =
|
let of_string x =
|
||||||
assert (String.is_prefix ~prefix:"tcp://" x);
|
assert (String.is_prefix ~prefix:"tcp://" x);
|
||||||
x
|
x
|
||||||
|
let create ~host ~port =
|
||||||
|
assert (port > 0);
|
||||||
|
Printf.sprintf "tcp://%s:%d" host port
|
||||||
let to_string x = x
|
let to_string x = x
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -16,11 +20,14 @@ module Ipc : sig
|
|||||||
type t
|
type t
|
||||||
val of_string : string -> t
|
val of_string : string -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
|
val create : string -> t
|
||||||
end = struct
|
end = struct
|
||||||
type t = string
|
type t = string
|
||||||
let of_string x =
|
let of_string x =
|
||||||
assert (String.is_prefix ~prefix:"ipc://" x);
|
assert (String.is_prefix ~prefix:"ipc://" x);
|
||||||
x
|
x
|
||||||
|
let create name =
|
||||||
|
Printf.sprintf "ipc://%s" name
|
||||||
let to_string x = x
|
let to_string x = x
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -28,11 +35,14 @@ module Inproc : sig
|
|||||||
type t
|
type t
|
||||||
val of_string : string -> t
|
val of_string : string -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
|
val create : string -> t
|
||||||
end = struct
|
end = struct
|
||||||
type t = string
|
type t = string
|
||||||
let of_string x =
|
let of_string x =
|
||||||
assert (String.is_prefix ~prefix:"inproc://" x);
|
assert (String.is_prefix ~prefix:"inproc://" x);
|
||||||
x
|
x
|
||||||
|
let create name =
|
||||||
|
Printf.sprintf "ipc://%s" name
|
||||||
let to_string x = x
|
let to_string x = x
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
open Qptypes;;
|
open Qptypes
|
||||||
open Core.Std;;
|
open Core.Std
|
||||||
|
|
||||||
(*
|
(*
|
||||||
Type for bits strings
|
Type for bits strings
|
||||||
@ -19,39 +19,50 @@ let to_string b =
|
|||||||
in do_work new_accu tail
|
in do_work new_accu tail
|
||||||
in
|
in
|
||||||
do_work "" b
|
do_work "" b
|
||||||
;;
|
|
||||||
|
|
||||||
let of_string ?(zero='0') ?(one='1') s =
|
let of_string ?(zero='0') ?(one='1') s =
|
||||||
String.to_list s
|
String.to_list s
|
||||||
|> List.rev_map ~f:( fun c ->
|
|> List.rev_map ~f:( fun c ->
|
||||||
if (c = zero) then Bit.Zero
|
if (c = zero) then Bit.Zero
|
||||||
else if (c = one) then Bit.One
|
else if (c = one) then Bit.One
|
||||||
else (failwith ("Error in string "^s) ) )
|
else (failwith ("Error in bitstring ") ) )
|
||||||
;;
|
|
||||||
|
let of_string_mp s =
|
||||||
|
String.to_list s
|
||||||
|
|> List.rev_map ~f:(function
|
||||||
|
| '-' -> Bit.Zero
|
||||||
|
| '+' -> Bit.One
|
||||||
|
| _ -> failwith ("Error in bitstring ") )
|
||||||
|
|
||||||
|
|
||||||
(* Create a bit list from an int64 *)
|
(* Create a bit list from an int64 *)
|
||||||
let of_int64 i =
|
let of_int64 i =
|
||||||
let rec do_work = function
|
|
||||||
| 0L -> [ Bit.Zero ]
|
let rec do_work accu = function
|
||||||
| 1L -> [ Bit.One ]
|
| 0L -> Bit.Zero :: accu |> List.rev
|
||||||
| i -> let b =
|
| 1L -> Bit.One :: accu |> List.rev
|
||||||
|
| i ->
|
||||||
|
let b =
|
||||||
match (Int64.bit_and i 1L ) with
|
match (Int64.bit_and i 1L ) with
|
||||||
| 0L -> Bit.Zero
|
| 0L -> Bit.Zero
|
||||||
| 1L -> Bit.One
|
| 1L -> Bit.One
|
||||||
| _ -> raise (Failure "i land 1 not in (0,1)")
|
| _ -> raise (Failure "i land 1 not in (0,1)")
|
||||||
in b:: ( do_work (Int64.shift_right_logical i 1) )
|
|
||||||
in
|
in
|
||||||
|
do_work (b :: accu) (Int64.shift_right_logical i 1)
|
||||||
|
in
|
||||||
|
|
||||||
let adjust_length result =
|
let adjust_length result =
|
||||||
let rec do_work accu = function
|
let rec do_work accu = function
|
||||||
| 64 -> accu
|
| 64 -> List.rev accu
|
||||||
| i when i>64 -> raise (Failure "Error in of_int64 > 64")
|
| i when i>64 -> raise (Failure "Error in of_int64 > 64")
|
||||||
| i when i<0 -> raise (Failure "Error in of_int64 < 0")
|
| i when i<0 -> raise (Failure "Error in of_int64 < 0")
|
||||||
| i -> do_work (accu@[Bit.Zero]) (i+1)
|
| i -> do_work (Bit.Zero :: accu) (i+1)
|
||||||
in
|
in
|
||||||
do_work result (List.length result)
|
do_work (List.rev result) (List.length result)
|
||||||
in
|
in
|
||||||
adjust_length (do_work i)
|
adjust_length (do_work [] i)
|
||||||
;;
|
|
||||||
|
|
||||||
(* Create an int64 from a bit list *)
|
(* Create an int64 from a bit list *)
|
||||||
let to_int64 l =
|
let to_int64 l =
|
||||||
@ -61,26 +72,32 @@ let to_int64 l =
|
|||||||
| Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail
|
| Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail
|
||||||
| Bit.One::tail -> do_work Int64.(bit_or one (shift_left accu 1)) tail
|
| Bit.One::tail -> do_work Int64.(bit_or one (shift_left accu 1)) tail
|
||||||
in do_work Int64.zero (List.rev l)
|
in do_work Int64.zero (List.rev l)
|
||||||
;;
|
|
||||||
|
|
||||||
(* Create a bit list from a list of int64 *)
|
(* Create a bit list from a list of int64 *)
|
||||||
let of_int64_list l =
|
let of_int64_list l =
|
||||||
List.map ~f:of_int64 l
|
List.map ~f:of_int64 l
|
||||||
|> List.concat
|
|> List.concat
|
||||||
;;
|
|
||||||
|
(* Create a bit list from an array of int64 *)
|
||||||
|
let of_int64_array l =
|
||||||
|
Array.map ~f:of_int64 l
|
||||||
|
|> Array.to_list
|
||||||
|
|> List.concat
|
||||||
|
|
||||||
|
|
||||||
(* Compute n_int *)
|
(* Compute n_int *)
|
||||||
let n_int_of_mo_tot_num mo_tot_num =
|
let n_int_of_mo_tot_num mo_tot_num =
|
||||||
let bit_kind_size = Bit_kind_size.to_int (Lazy.force Qpackage.bit_kind_size) in
|
let bit_kind_size = Bit_kind_size.to_int (Lazy.force Qpackage.bit_kind_size) in
|
||||||
N_int_number.of_int ( (mo_tot_num-1)/bit_kind_size + 1 )
|
N_int_number.of_int ( (mo_tot_num-1)/bit_kind_size + 1 )
|
||||||
;;
|
|
||||||
|
|
||||||
(* Create a zero bit list *)
|
(* Create a zero bit list *)
|
||||||
let zero n_int =
|
let zero n_int =
|
||||||
let n_int = N_int_number.to_int n_int in
|
let n_int = N_int_number.to_int n_int in
|
||||||
let a = Array.init n_int (fun i-> 0L) in
|
let a = Array.init n_int (fun i-> 0L) in
|
||||||
of_int64_list ( Array.to_list a )
|
of_int64_list ( Array.to_list a )
|
||||||
;;
|
|
||||||
|
|
||||||
(* Create an int64 list from a bit list *)
|
(* Create an int64 list from a bit list *)
|
||||||
let to_int64_list l =
|
let to_int64_list l =
|
||||||
@ -100,7 +117,11 @@ let to_int64_list l =
|
|||||||
let l = do_work [] [] 1 l
|
let l = do_work [] [] 1 l
|
||||||
in
|
in
|
||||||
List.rev_map ~f:to_int64 l
|
List.rev_map ~f:to_int64 l
|
||||||
;;
|
|
||||||
|
(* Create an array of int64 from a bit list *)
|
||||||
|
let to_int64_array l =
|
||||||
|
to_int64_list l
|
||||||
|
|> Array.of_list
|
||||||
|
|
||||||
(* Create a bit list from a list of MO indices *)
|
(* Create a bit list from a list of MO indices *)
|
||||||
let of_mo_number_list n_int l =
|
let of_mo_number_list n_int l =
|
||||||
@ -109,7 +130,7 @@ let of_mo_number_list n_int l =
|
|||||||
let a = Array.create length (Bit.Zero) in
|
let a = Array.create length (Bit.Zero) in
|
||||||
List.iter ~f:(fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l;
|
List.iter ~f:(fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l;
|
||||||
Array.to_list a
|
Array.to_list a
|
||||||
;;
|
|
||||||
|
|
||||||
let to_mo_number_list l =
|
let to_mo_number_list l =
|
||||||
let a = Array.of_list l in
|
let a = Array.of_list l in
|
||||||
@ -127,7 +148,7 @@ let to_mo_number_list l =
|
|||||||
end
|
end
|
||||||
in
|
in
|
||||||
do_work [] (List.length l)
|
do_work [] (List.length l)
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -142,7 +163,7 @@ let logical_operator2 op a b =
|
|||||||
in do_work_binary (newbit::result) ta tb
|
in do_work_binary (newbit::result) ta tb
|
||||||
in
|
in
|
||||||
List.rev (do_work_binary [] a b)
|
List.rev (do_work_binary [] a b)
|
||||||
;;
|
|
||||||
|
|
||||||
let logical_operator1 op b =
|
let logical_operator1 op b =
|
||||||
let rec do_work_unary result b =
|
let rec do_work_unary result b =
|
||||||
@ -153,20 +174,19 @@ let logical_operator1 op b =
|
|||||||
in do_work_unary (newbit::result) tb
|
in do_work_unary (newbit::result) tb
|
||||||
in
|
in
|
||||||
List.rev (do_work_unary [] b)
|
List.rev (do_work_unary [] b)
|
||||||
;;
|
|
||||||
|
|
||||||
let and_operator a b = logical_operator2 Bit.and_operator a b;;
|
|
||||||
let xor_operator a b = logical_operator2 Bit.xor_operator a b;;
|
let and_operator a b = logical_operator2 Bit.and_operator a b
|
||||||
let or_operator a b = logical_operator2 Bit.or_operator a b;;
|
let xor_operator a b = logical_operator2 Bit.xor_operator a b
|
||||||
let not_operator b = logical_operator1 Bit.not_operator b ;;
|
let or_operator a b = logical_operator2 Bit.or_operator a b
|
||||||
|
let not_operator b = logical_operator1 Bit.not_operator b
|
||||||
|
|
||||||
|
|
||||||
let popcnt b =
|
let popcnt b =
|
||||||
let rec popcnt accu = function
|
List.fold_left b ~init:0 ~f:(fun accu -> function
|
||||||
| [] -> accu
|
| Bit.One -> accu+1
|
||||||
| Bit.One::rest -> popcnt (accu+1) rest
|
| Bit.Zero -> accu
|
||||||
| Bit.Zero::rest -> popcnt (accu) rest
|
)
|
||||||
in popcnt 0 b
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -6,16 +6,21 @@ val zero : Qptypes.N_int_number.t -> t
|
|||||||
(** Convert to a string for printing *)
|
(** Convert to a string for printing *)
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
|
|
||||||
(** Convert to a string for printing *)
|
(** Read from a string *)
|
||||||
val of_string : ?zero:char -> ?one:char -> string -> t
|
val of_string : ?zero:char -> ?one:char -> string -> t
|
||||||
|
|
||||||
|
(** Read from a string with the ++-- notation *)
|
||||||
|
val of_string_mp : string -> t
|
||||||
|
|
||||||
(** int64 conversion functions *)
|
(** int64 conversion functions *)
|
||||||
|
|
||||||
val of_int64 : int64 -> t
|
val of_int64 : int64 -> t
|
||||||
val to_int64 : t -> int64
|
val to_int64 : t -> int64
|
||||||
|
|
||||||
val of_int64_list : int64 list -> t
|
val of_int64_list : int64 list -> t
|
||||||
|
val of_int64_array : int64 array -> t
|
||||||
val to_int64_list : t -> int64 list
|
val to_int64_list : t -> int64 list
|
||||||
|
val to_int64_array : t -> int64 array
|
||||||
|
|
||||||
(** Get the number of needed int64 elements to encode the bit list *)
|
(** Get the number of needed int64 elements to encode the bit list *)
|
||||||
val n_int_of_mo_tot_num : int -> Qptypes.N_int_number.t
|
val n_int_of_mo_tot_num : int -> Qptypes.N_int_number.t
|
||||||
|
@ -4,33 +4,37 @@ open Qptypes;;
|
|||||||
type t = int64 array with sexp
|
type t = int64 array with sexp
|
||||||
|
|
||||||
let to_int64_array (x:t) = (x:int64 array)
|
let to_int64_array (x:t) = (x:int64 array)
|
||||||
;;
|
|
||||||
|
|
||||||
let to_alpha_beta x =
|
let to_alpha_beta x =
|
||||||
let x = to_int64_array x in
|
let x = to_int64_array x in
|
||||||
let n_int = (Array.length x)/2 in
|
let n_int = (Array.length x)/2 in
|
||||||
( Array.init n_int ~f:(fun i -> x.(i)) ,
|
( Array.init n_int ~f:(fun i -> x.(i)) ,
|
||||||
Array.init n_int ~f:(fun i -> x.(i+n_int)) )
|
Array.init n_int ~f:(fun i -> x.(i+n_int)) )
|
||||||
;;
|
|
||||||
|
|
||||||
let to_bitlist_couple x =
|
let to_bitlist_couple x =
|
||||||
let (xa,xb) = to_alpha_beta x in
|
let (xa,xb) = to_alpha_beta x in
|
||||||
let xa = to_int64_array xa
|
let xa =
|
||||||
|> Array.to_list
|
to_int64_array xa
|
||||||
|> Bitlist.of_int64_list
|
|> Bitlist.of_int64_array
|
||||||
and xb = to_int64_array xb
|
and xb =
|
||||||
|> Array.to_list
|
to_int64_array xb
|
||||||
|> Bitlist.of_int64_list
|
|> Bitlist.of_int64_array
|
||||||
in (xa,xb)
|
in (xa,xb)
|
||||||
;;
|
|
||||||
|
|
||||||
let bitlist_to_string ~mo_tot_num x =
|
let bitlist_to_string ~mo_tot_num x =
|
||||||
List.map x ~f:(fun i -> match i with
|
let len =
|
||||||
|
MO_number.to_int mo_tot_num
|
||||||
|
in
|
||||||
|
List.map x ~f:(function
|
||||||
| Bit.Zero -> "-"
|
| Bit.Zero -> "-"
|
||||||
| Bit.One -> "+" )
|
| Bit.One -> "+"
|
||||||
|
)
|
||||||
|> String.concat
|
|> String.concat
|
||||||
|> String.sub ~pos:0 ~len:(MO_number.to_int mo_tot_num)
|
|> String.sub ~pos:0 ~len
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
let of_int64_array ~n_int ~alpha ~beta x =
|
let of_int64_array ~n_int ~alpha ~beta x =
|
||||||
@ -54,20 +58,25 @@ let of_int64_array ~n_int ~alpha ~beta x =
|
|||||||
%s" beta (bitlist_to_string ~mo_tot_num:mo_tot_num b) )
|
%s" beta (bitlist_to_string ~mo_tot_num:mo_tot_num b) )
|
||||||
end;
|
end;
|
||||||
x
|
x
|
||||||
;;
|
|
||||||
|
|
||||||
let of_bitlist_couple ~alpha ~beta (xa,xb) =
|
let of_int64_array_no_check x = x
|
||||||
let ba = Bitlist.to_int64_list xa in
|
|
||||||
let bb = Bitlist.to_int64_list xb in
|
let of_bitlist_couple ?n_int ~alpha ~beta (xa,xb) =
|
||||||
let n_int = Bitlist.n_int_of_mo_tot_num (List.length xa) in
|
let ba, bb =
|
||||||
of_int64_array ~n_int:n_int ~alpha:alpha ~beta:beta (Array.of_list (ba@bb))
|
Bitlist.to_int64_array xa ,
|
||||||
;;
|
Bitlist.to_int64_array xb
|
||||||
|
and n_int =
|
||||||
|
match n_int with
|
||||||
|
| Some x -> x
|
||||||
|
| None -> Bitlist.n_int_of_mo_tot_num (List.length xa)
|
||||||
|
in
|
||||||
|
of_int64_array ~n_int ~alpha ~beta (Array.concat [ba;bb])
|
||||||
|
|
||||||
|
|
||||||
let to_string ~mo_tot_num x =
|
let to_string ~mo_tot_num x =
|
||||||
let (xa,xb) = to_bitlist_couple x in
|
let (xa,xb) = to_bitlist_couple x in
|
||||||
[ bitlist_to_string ~mo_tot_num:mo_tot_num xa ;
|
[ " " ; bitlist_to_string ~mo_tot_num xa ; "\n" ;
|
||||||
bitlist_to_string ~mo_tot_num:mo_tot_num xb ]
|
" " ; bitlist_to_string ~mo_tot_num xb ]
|
||||||
|> String.concat ~sep:"\n"
|
|> String.concat
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -24,7 +24,8 @@ val to_alpha_beta : t -> (int64 array)*(int64 array)
|
|||||||
val to_bitlist_couple : t -> Bitlist.t * Bitlist.t
|
val to_bitlist_couple : t -> Bitlist.t * Bitlist.t
|
||||||
|
|
||||||
(** Create from a bit list *)
|
(** Create from a bit list *)
|
||||||
val of_bitlist_couple : alpha:Qptypes.Elec_alpha_number.t ->
|
val of_bitlist_couple : ?n_int:Qptypes.N_int_number.t ->
|
||||||
|
alpha:Qptypes.Elec_alpha_number.t ->
|
||||||
beta:Qptypes.Elec_beta_number.t ->
|
beta:Qptypes.Elec_beta_number.t ->
|
||||||
Bitlist.t * Bitlist.t -> t
|
Bitlist.t * Bitlist.t -> t
|
||||||
|
|
||||||
|
@ -11,11 +11,13 @@ module Determinants_by_hand : sig
|
|||||||
psi_coef : Det_coef.t array;
|
psi_coef : Det_coef.t array;
|
||||||
psi_det : Determinant.t array;
|
psi_det : Determinant.t array;
|
||||||
} with sexp
|
} with sexp
|
||||||
val read : unit -> t option
|
val read : unit -> t
|
||||||
|
val read_maybe : unit -> t option
|
||||||
val write : t -> unit
|
val write : t -> unit
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
val to_rst : t -> Rst_string.t
|
val to_rst : t -> Rst_string.t
|
||||||
val of_rst : Rst_string.t -> t option
|
val of_rst : Rst_string.t -> t option
|
||||||
|
val read_n_int : unit -> N_int_number.t
|
||||||
end = struct
|
end = struct
|
||||||
type t =
|
type t =
|
||||||
{ n_int : N_int_number.t;
|
{ n_int : N_int_number.t;
|
||||||
@ -29,6 +31,8 @@ end = struct
|
|||||||
|
|
||||||
let get_default = Qpackage.get_ezfio_default "determinants";;
|
let get_default = Qpackage.get_ezfio_default "determinants";;
|
||||||
|
|
||||||
|
let n_det_read_max = 10_000 ;;
|
||||||
|
|
||||||
let read_n_int () =
|
let read_n_int () =
|
||||||
if not (Ezfio.has_determinants_n_int()) then
|
if not (Ezfio.has_determinants_n_int()) then
|
||||||
Ezfio.get_mo_basis_mo_tot_num ()
|
Ezfio.get_mo_basis_mo_tot_num ()
|
||||||
@ -207,7 +211,6 @@ end = struct
|
|||||||
|
|
||||||
let read () =
|
let read () =
|
||||||
if (Ezfio.has_mo_basis_mo_tot_num ()) then
|
if (Ezfio.has_mo_basis_mo_tot_num ()) then
|
||||||
Some
|
|
||||||
{ n_int = read_n_int () ;
|
{ n_int = read_n_int () ;
|
||||||
bit_kind = read_bit_kind () ;
|
bit_kind = read_bit_kind () ;
|
||||||
n_det = read_n_det () ;
|
n_det = read_n_det () ;
|
||||||
@ -215,6 +218,17 @@ end = struct
|
|||||||
psi_coef = read_psi_coef () ;
|
psi_coef = read_psi_coef () ;
|
||||||
psi_det = read_psi_det () ;
|
psi_det = read_psi_det () ;
|
||||||
}
|
}
|
||||||
|
else
|
||||||
|
failwith "No molecular orbitals, so no determinants"
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_maybe () =
|
||||||
|
let n_det =
|
||||||
|
read_n_det ()
|
||||||
|
in
|
||||||
|
if ( (Det_number.to_int n_det) < n_det_read_max ) then
|
||||||
|
try Some (read ()) with
|
||||||
|
| Failure _ -> None
|
||||||
else
|
else
|
||||||
None
|
None
|
||||||
;;
|
;;
|
||||||
@ -236,11 +250,16 @@ end = struct
|
|||||||
|
|
||||||
|
|
||||||
let to_rst b =
|
let to_rst b =
|
||||||
let mo_tot_num = Ezfio.get_mo_basis_mo_tot_num () in
|
let max =
|
||||||
let mo_tot_num = MO_number.of_int mo_tot_num ~max:mo_tot_num in
|
Ezfio.get_mo_basis_mo_tot_num ()
|
||||||
|
in
|
||||||
|
let mo_tot_num =
|
||||||
|
MO_number.of_int ~max max
|
||||||
|
in
|
||||||
let det_text =
|
let det_text =
|
||||||
let nstates =
|
let nstates =
|
||||||
read_n_states () |> States_number.to_int
|
read_n_states ()
|
||||||
|
|> States_number.to_int
|
||||||
and ndet =
|
and ndet =
|
||||||
Det_number.to_int b.n_det
|
Det_number.to_int b.n_det
|
||||||
in
|
in
|
||||||
@ -393,29 +412,47 @@ psi_det = %s
|
|||||||
in
|
in
|
||||||
let rec read_dets accu = function
|
let rec read_dets accu = function
|
||||||
| [] -> List.rev accu
|
| [] -> List.rev accu
|
||||||
| ""::c::alpha::beta::tail ->
|
| ""::_::alpha::beta::tail ->
|
||||||
begin
|
begin
|
||||||
let alpha = String.rev alpha |> Bitlist.of_string ~zero:'-' ~one:'+'
|
let newdet =
|
||||||
and beta = String.rev beta |> Bitlist.of_string ~zero:'-' ~one:'+'
|
(Bitlist.of_string ~zero:'-' ~one:'+' alpha ,
|
||||||
in
|
Bitlist.of_string ~zero:'-' ~one:'+' beta)
|
||||||
let newdet = Determinant.of_bitlist_couple
|
|> Determinant.of_bitlist_couple ~alpha:n_alpha ~beta:n_beta
|
||||||
~alpha:n_alpha ~beta:n_beta (alpha,beta)
|
|> Determinant.sexp_of_t
|
||||||
|> Determinant.sexp_of_t |> Sexplib.Sexp.to_string
|
|> Sexplib.Sexp.to_string
|
||||||
in
|
in
|
||||||
read_dets (newdet::accu) tail
|
read_dets (newdet::accu) tail
|
||||||
end
|
end
|
||||||
| _::tail -> read_dets accu tail
|
| _::tail -> read_dets accu tail
|
||||||
in
|
in
|
||||||
let a = read_dets [] dets
|
let dets =
|
||||||
|
List.map ~f:String.rev dets
|
||||||
|
in
|
||||||
|
let sze =
|
||||||
|
List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) dets
|
||||||
|
in
|
||||||
|
let control =
|
||||||
|
Gc.get ()
|
||||||
|
in
|
||||||
|
Gc.tune ~minor_heap_size:(sze) ~space_overhead:(sze/10)
|
||||||
|
~max_overhead:100000 ~major_heap_increment:(sze/10) ();
|
||||||
|
let a =
|
||||||
|
read_dets [] dets
|
||||||
|> String.concat
|
|> String.concat
|
||||||
in
|
in
|
||||||
|
Gc.set control;
|
||||||
"(psi_det ("^a^"))"
|
"(psi_det ("^a^"))"
|
||||||
in
|
in
|
||||||
|
|
||||||
let bitkind = Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind
|
|
||||||
|
let bitkind =
|
||||||
|
Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind
|
||||||
|> Bit_kind.to_int)
|
|> Bit_kind.to_int)
|
||||||
and n_int = Printf.sprintf "(n_int %d)" (N_int_number.get_max ()) in
|
and n_int =
|
||||||
let s = String.concat [ header ; bitkind ; n_int ; psi_coef ; psi_det]
|
Printf.sprintf "(n_int %d)" (N_int_number.get_max ())
|
||||||
|
in
|
||||||
|
let s =
|
||||||
|
String.concat [ header ; bitkind ; n_int ; psi_coef ; psi_det]
|
||||||
in
|
in
|
||||||
|
|
||||||
Generic_input_of_rst.evaluate_sexp t_of_sexp s
|
Generic_input_of_rst.evaluate_sexp t_of_sexp s
|
||||||
|
343
ocaml/Message.ml
343
ocaml/Message.ml
@ -1,4 +1,5 @@
|
|||||||
open Core.Std
|
open Core.Std
|
||||||
|
open Qptypes
|
||||||
|
|
||||||
(** New job : Request to create a new multi-tasked job *)
|
(** New job : Request to create a new multi-tasked job *)
|
||||||
|
|
||||||
@ -32,12 +33,30 @@ end = struct
|
|||||||
address_inproc = Address.Inproc.of_string address_inproc ;
|
address_inproc = Address.Inproc.of_string address_inproc ;
|
||||||
}
|
}
|
||||||
let to_string t =
|
let to_string t =
|
||||||
Printf.sprintf "newjob %s %s %s"
|
Printf.sprintf "new_job %s %s %s"
|
||||||
( State.to_string t.state )
|
( State.to_string t.state )
|
||||||
( Address.Tcp.to_string t.address_tcp )
|
( Address.Tcp.to_string t.address_tcp )
|
||||||
( Address.Inproc.to_string t.address_inproc )
|
( Address.Inproc.to_string t.address_inproc )
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Endjob_msg : sig
|
||||||
|
type t =
|
||||||
|
{ state: State.t;
|
||||||
|
}
|
||||||
|
val create : state:string -> t
|
||||||
|
val to_string : t -> string
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{ state: State.t;
|
||||||
|
}
|
||||||
|
let create ~state =
|
||||||
|
{ state = State.of_string state;
|
||||||
|
}
|
||||||
|
let to_string t =
|
||||||
|
Printf.sprintf "end_job %s"
|
||||||
|
( State.to_string t.state )
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
(** Connect : connect a new client to the task server *)
|
(** Connect : connect a new client to the task server *)
|
||||||
|
|
||||||
@ -108,22 +127,21 @@ end
|
|||||||
|
|
||||||
module DisconnectReply_msg : sig
|
module DisconnectReply_msg : sig
|
||||||
type t =
|
type t =
|
||||||
{ finished: bool ;
|
{
|
||||||
state: State.t ;
|
state: State.t ;
|
||||||
}
|
}
|
||||||
val create : state:State.t -> finished:bool -> t
|
val create : state:State.t -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
end = struct
|
end = struct
|
||||||
type t =
|
type t =
|
||||||
{ finished: bool;
|
{
|
||||||
state: State.t ;
|
state: State.t ;
|
||||||
}
|
}
|
||||||
let create ~state ~finished =
|
let create ~state =
|
||||||
{ state ; finished }
|
{ state }
|
||||||
let to_string x =
|
let to_string x =
|
||||||
Printf.sprintf "disconnect_reply %s %d"
|
Printf.sprintf "disconnect_reply %s"
|
||||||
(State.to_string x.state)
|
(State.to_string x.state)
|
||||||
(if x.finished then 1 else 0)
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -160,6 +178,52 @@ end = struct
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
(** DelTask : Remove a task from the queue *)
|
||||||
|
module DelTask_msg : sig
|
||||||
|
type t =
|
||||||
|
{ state: State.t;
|
||||||
|
task_id: Id.Task.t
|
||||||
|
}
|
||||||
|
val create : state:string -> task_id:string -> t
|
||||||
|
val to_string : t -> string
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{ state: State.t;
|
||||||
|
task_id: Id.Task.t
|
||||||
|
}
|
||||||
|
let create ~state ~task_id =
|
||||||
|
{ state = State.of_string state ;
|
||||||
|
task_id = Id.Task.of_string task_id
|
||||||
|
}
|
||||||
|
let to_string x =
|
||||||
|
Printf.sprintf "del_task %s %d"
|
||||||
|
(State.to_string x.state)
|
||||||
|
(Id.Task.to_int x.task_id)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
(** DelTaskReply : Reply to the DelTask message *)
|
||||||
|
module DelTaskReply_msg : sig
|
||||||
|
type t
|
||||||
|
val create : task_id:Id.Task.t -> more:bool -> t
|
||||||
|
val to_string : t -> string
|
||||||
|
end = struct
|
||||||
|
type t = {
|
||||||
|
task_id : Id.Task.t ;
|
||||||
|
more : bool;
|
||||||
|
}
|
||||||
|
let create ~task_id ~more = { task_id ; more }
|
||||||
|
let to_string x =
|
||||||
|
let more =
|
||||||
|
if x.more then "more"
|
||||||
|
else "done"
|
||||||
|
in
|
||||||
|
Printf.sprintf "del_task_reply %s %d"
|
||||||
|
more (Id.Task.to_int x.task_id)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(** GetTask : get a new task to do *)
|
(** GetTask : get a new task to do *)
|
||||||
module GetTask_msg : sig
|
module GetTask_msg : sig
|
||||||
type t =
|
type t =
|
||||||
@ -196,13 +260,239 @@ end = struct
|
|||||||
Printf.sprintf "get_task_reply %d %s" (Id.Task.to_int x.task_id) x.task
|
Printf.sprintf "get_task_reply %d %s" (Id.Task.to_int x.task_id) x.task
|
||||||
end
|
end
|
||||||
|
|
||||||
|
(** GetPsi : get the current variational wave function *)
|
||||||
|
module GetPsi_msg : sig
|
||||||
|
type t =
|
||||||
|
{ client_id: Id.Client.t ;
|
||||||
|
}
|
||||||
|
val create : client_id:string -> t
|
||||||
|
val to_string : t -> string
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{ client_id: Id.Client.t ;
|
||||||
|
}
|
||||||
|
let create ~client_id =
|
||||||
|
{ client_id = Id.Client.of_string client_id }
|
||||||
|
let to_string x =
|
||||||
|
Printf.sprintf "get_psi %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
end
|
||||||
|
|
||||||
|
module Psi : sig
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
n_state : Strictly_positive_int.t ;
|
||||||
|
n_det : Strictly_positive_int.t ;
|
||||||
|
psi_det_size : Strictly_positive_int.t ;
|
||||||
|
n_det_generators : Strictly_positive_int.t option;
|
||||||
|
n_det_selectors : Strictly_positive_int.t option;
|
||||||
|
psi_det : string ;
|
||||||
|
psi_coef : string ;
|
||||||
|
}
|
||||||
|
val create : n_state:Strictly_positive_int.t
|
||||||
|
-> n_det:Strictly_positive_int.t
|
||||||
|
-> psi_det_size:Strictly_positive_int.t
|
||||||
|
-> n_det_generators:Strictly_positive_int.t option
|
||||||
|
-> n_det_selectors:Strictly_positive_int.t option
|
||||||
|
-> psi_det:string -> psi_coef:string -> t
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
n_state : Strictly_positive_int.t ;
|
||||||
|
n_det : Strictly_positive_int.t ;
|
||||||
|
psi_det_size : Strictly_positive_int.t ;
|
||||||
|
n_det_generators : Strictly_positive_int.t option;
|
||||||
|
n_det_selectors : Strictly_positive_int.t option;
|
||||||
|
psi_det : string ;
|
||||||
|
psi_coef : string ;
|
||||||
|
}
|
||||||
|
let create ~n_state ~n_det ~psi_det_size
|
||||||
|
~n_det_generators ~n_det_selectors ~psi_det ~psi_coef =
|
||||||
|
assert (Strictly_positive_int.to_int n_det <=
|
||||||
|
Strictly_positive_int.to_int psi_det_size );
|
||||||
|
{ n_state; n_det ; psi_det_size ;
|
||||||
|
n_det_generators ; n_det_selectors ;
|
||||||
|
psi_det ; psi_coef }
|
||||||
|
end
|
||||||
|
|
||||||
|
(** GetPsiReply_msg : Reply to the GetPsi message *)
|
||||||
|
module GetPsiReply_msg : sig
|
||||||
|
type t =
|
||||||
|
{ client_id : Id.Client.t ;
|
||||||
|
psi : Psi.t }
|
||||||
|
val create : client_id:Id.Client.t -> psi:Psi.t -> t
|
||||||
|
val to_string_list : t -> string list
|
||||||
|
val to_string : t -> string
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{ client_id : Id.Client.t ;
|
||||||
|
psi : Psi.t }
|
||||||
|
let create ~client_id ~psi =
|
||||||
|
{ client_id ; psi }
|
||||||
|
let to_string_list x =
|
||||||
|
let g, s =
|
||||||
|
match x.psi.Psi.n_det_generators, x.psi.Psi.n_det_selectors with
|
||||||
|
| Some g, Some s -> Strictly_positive_int.to_int g, Strictly_positive_int.to_int s
|
||||||
|
| _ -> -1, -1
|
||||||
|
in
|
||||||
|
[ Printf.sprintf "get_psi_reply %d %d %d %d %d %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
(Strictly_positive_int.to_int x.psi.Psi.n_state)
|
||||||
|
(Strictly_positive_int.to_int x.psi.Psi.n_det)
|
||||||
|
(Strictly_positive_int.to_int x.psi.Psi.psi_det_size)
|
||||||
|
g s ;
|
||||||
|
x.psi.Psi.psi_det ; x.psi.Psi.psi_coef ]
|
||||||
|
let to_string x =
|
||||||
|
let g, s =
|
||||||
|
match x.psi.Psi.n_det_generators, x.psi.Psi.n_det_selectors with
|
||||||
|
| Some g, Some s -> Strictly_positive_int.to_int g, Strictly_positive_int.to_int s
|
||||||
|
| _ -> -1, -1
|
||||||
|
in
|
||||||
|
Printf.sprintf "get_psi_reply %d %d %d %d %d %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
(Strictly_positive_int.to_int x.psi.Psi.n_state)
|
||||||
|
(Strictly_positive_int.to_int x.psi.Psi.n_det)
|
||||||
|
(Strictly_positive_int.to_int x.psi.Psi.psi_det_size)
|
||||||
|
g s
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
(** PutPsi : put the current variational wave function *)
|
||||||
|
module PutPsi_msg : sig
|
||||||
|
type t =
|
||||||
|
{ client_id : Id.Client.t ;
|
||||||
|
n_state : Strictly_positive_int.t ;
|
||||||
|
n_det : Strictly_positive_int.t ;
|
||||||
|
psi_det_size : Strictly_positive_int.t ;
|
||||||
|
n_det_generators : Strictly_positive_int.t option;
|
||||||
|
n_det_selectors : Strictly_positive_int.t option;
|
||||||
|
psi : Psi.t option }
|
||||||
|
val create :
|
||||||
|
client_id:string ->
|
||||||
|
n_state:string ->
|
||||||
|
n_det:string ->
|
||||||
|
psi_det_size:string ->
|
||||||
|
psi_det:string option ->
|
||||||
|
psi_coef:string option ->
|
||||||
|
n_det_generators: string option ->
|
||||||
|
n_det_selectors:string option -> t
|
||||||
|
val to_string_list : t -> string list
|
||||||
|
val to_string : t -> string
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{ client_id : Id.Client.t ;
|
||||||
|
n_state : Strictly_positive_int.t ;
|
||||||
|
n_det : Strictly_positive_int.t ;
|
||||||
|
psi_det_size : Strictly_positive_int.t ;
|
||||||
|
n_det_generators : Strictly_positive_int.t option;
|
||||||
|
n_det_selectors : Strictly_positive_int.t option;
|
||||||
|
psi : Psi.t option }
|
||||||
|
let create ~client_id ~n_state ~n_det ~psi_det_size ~psi_det ~psi_coef
|
||||||
|
~n_det_generators ~n_det_selectors =
|
||||||
|
let n_state, n_det, psi_det_size =
|
||||||
|
Int.of_string n_state
|
||||||
|
|> Strictly_positive_int.of_int ,
|
||||||
|
Int.of_string n_det
|
||||||
|
|> Strictly_positive_int.of_int ,
|
||||||
|
Int.of_string psi_det_size
|
||||||
|
|> Strictly_positive_int.of_int
|
||||||
|
in
|
||||||
|
assert (Strictly_positive_int.to_int psi_det_size >=
|
||||||
|
Strictly_positive_int.to_int n_det);
|
||||||
|
let n_det_generators, n_det_selectors =
|
||||||
|
match n_det_generators, n_det_selectors with
|
||||||
|
| Some x, Some y ->
|
||||||
|
Some (Strictly_positive_int.of_int @@ Int.of_string x),
|
||||||
|
Some (Strictly_positive_int.of_int @@ Int.of_string y)
|
||||||
|
| _ -> None, None
|
||||||
|
in
|
||||||
|
let psi =
|
||||||
|
match (psi_det, psi_coef) with
|
||||||
|
| (Some psi_det, Some psi_coef) ->
|
||||||
|
Some (Psi.create ~n_state ~n_det ~psi_det_size ~psi_det
|
||||||
|
~psi_coef ~n_det_generators ~n_det_selectors)
|
||||||
|
| _ -> None
|
||||||
|
in
|
||||||
|
{ client_id = Id.Client.of_string client_id ;
|
||||||
|
n_state ; n_det ; psi_det_size ; n_det_generators ;
|
||||||
|
n_det_selectors ; psi }
|
||||||
|
let to_string_list x =
|
||||||
|
match x.n_det_generators, x.n_det_selectors, x.psi with
|
||||||
|
| Some g, Some s, Some psi ->
|
||||||
|
[ Printf.sprintf "put_psi %d %d %d %d %d %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
(Strictly_positive_int.to_int x.n_state)
|
||||||
|
(Strictly_positive_int.to_int x.n_det)
|
||||||
|
(Strictly_positive_int.to_int x.psi_det_size)
|
||||||
|
(Strictly_positive_int.to_int g)
|
||||||
|
(Strictly_positive_int.to_int s) ;
|
||||||
|
psi.Psi.psi_det ; psi.Psi.psi_coef ]
|
||||||
|
| Some g, Some s, None ->
|
||||||
|
[ Printf.sprintf "put_psi %d %d %d %d %d %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
(Strictly_positive_int.to_int x.n_state)
|
||||||
|
(Strictly_positive_int.to_int x.n_det)
|
||||||
|
(Strictly_positive_int.to_int x.psi_det_size)
|
||||||
|
(Strictly_positive_int.to_int g)
|
||||||
|
(Strictly_positive_int.to_int s) ;
|
||||||
|
"None" ; "None" ]
|
||||||
|
| _ ->
|
||||||
|
[ Printf.sprintf "put_psi %d %d %d %d -1 -1"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
(Strictly_positive_int.to_int x.n_state)
|
||||||
|
(Strictly_positive_int.to_int x.n_det)
|
||||||
|
(Strictly_positive_int.to_int x.psi_det_size) ;
|
||||||
|
"None" ; "None" ]
|
||||||
|
let to_string x =
|
||||||
|
match x.n_det_generators, x.n_det_selectors, x.psi with
|
||||||
|
| Some g, Some s, Some psi ->
|
||||||
|
Printf.sprintf "put_psi %d %d %d %d %d %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
(Strictly_positive_int.to_int x.n_state)
|
||||||
|
(Strictly_positive_int.to_int x.n_det)
|
||||||
|
(Strictly_positive_int.to_int x.psi_det_size)
|
||||||
|
(Strictly_positive_int.to_int g)
|
||||||
|
(Strictly_positive_int.to_int s)
|
||||||
|
| Some g, Some s, None ->
|
||||||
|
Printf.sprintf "put_psi %d %d %d %d %d %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
(Strictly_positive_int.to_int x.n_state)
|
||||||
|
(Strictly_positive_int.to_int x.n_det)
|
||||||
|
(Strictly_positive_int.to_int x.psi_det_size)
|
||||||
|
(Strictly_positive_int.to_int g)
|
||||||
|
(Strictly_positive_int.to_int s)
|
||||||
|
| _, _, _ ->
|
||||||
|
Printf.sprintf "put_psi %d %d %d %d %d %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
(Strictly_positive_int.to_int x.n_state)
|
||||||
|
(Strictly_positive_int.to_int x.n_det)
|
||||||
|
(Strictly_positive_int.to_int x.psi_det_size)
|
||||||
|
(-1) (-1)
|
||||||
|
end
|
||||||
|
|
||||||
|
(** PutPsiReply_msg : Reply to the PutPsi message *)
|
||||||
|
module PutPsiReply_msg : sig
|
||||||
|
type t
|
||||||
|
val create : client_id:Id.Client.t -> t
|
||||||
|
val to_string : t -> string
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{ client_id : Id.Client.t ;
|
||||||
|
}
|
||||||
|
let create ~client_id =
|
||||||
|
{ client_id; }
|
||||||
|
let to_string x =
|
||||||
|
Printf.sprintf "put_psi_reply %d"
|
||||||
|
(Id.Client.to_int x.client_id)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
(** TaskDone : Inform the server that a task is finished *)
|
(** TaskDone : Inform the server that a task is finished *)
|
||||||
module TaskDone_msg : sig
|
module TaskDone_msg : sig
|
||||||
type t =
|
type t =
|
||||||
{ client_id: Id.Client.t ;
|
{ client_id: Id.Client.t ;
|
||||||
state: State.t ;
|
state: State.t ;
|
||||||
task_id: Id.Task.t;
|
task_id: Id.Task.t ;
|
||||||
}
|
}
|
||||||
val create : state:string -> client_id:string -> task_id:string -> t
|
val create : state:string -> client_id:string -> task_id:string -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
@ -215,7 +505,9 @@ end = struct
|
|||||||
let create ~state ~client_id ~task_id =
|
let create ~state ~client_id ~task_id =
|
||||||
{ client_id = Id.Client.of_string client_id ;
|
{ client_id = Id.Client.of_string client_id ;
|
||||||
state = State.of_string state ;
|
state = State.of_string state ;
|
||||||
task_id = Id.Task.of_string task_id }
|
task_id = Id.Task.of_string task_id;
|
||||||
|
}
|
||||||
|
|
||||||
let to_string x =
|
let to_string x =
|
||||||
Printf.sprintf "task_done %s %d %d"
|
Printf.sprintf "task_done %s %d %d"
|
||||||
(State.to_string x.state)
|
(State.to_string x.state)
|
||||||
@ -262,13 +554,20 @@ end
|
|||||||
(** Message *)
|
(** Message *)
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
|
| GetPsi of GetPsi_msg.t
|
||||||
|
| PutPsi of PutPsi_msg.t
|
||||||
|
| GetPsiReply of GetPsiReply_msg.t
|
||||||
|
| PutPsiReply of PutPsiReply_msg.t
|
||||||
| Newjob of Newjob_msg.t
|
| Newjob of Newjob_msg.t
|
||||||
|
| Endjob of Endjob_msg.t
|
||||||
| Connect of Connect_msg.t
|
| Connect of Connect_msg.t
|
||||||
| ConnectReply of ConnectReply_msg.t
|
| ConnectReply of ConnectReply_msg.t
|
||||||
| Disconnect of Disconnect_msg.t
|
| Disconnect of Disconnect_msg.t
|
||||||
| DisconnectReply of DisconnectReply_msg.t
|
| DisconnectReply of DisconnectReply_msg.t
|
||||||
| GetTask of GetTask_msg.t
|
| GetTask of GetTask_msg.t
|
||||||
| GetTaskReply of GetTaskReply_msg.t
|
| GetTaskReply of GetTaskReply_msg.t
|
||||||
|
| DelTask of DelTask_msg.t
|
||||||
|
| DelTaskReply of DelTaskReply_msg.t
|
||||||
| AddTask of AddTask_msg.t
|
| AddTask of AddTask_msg.t
|
||||||
| AddTaskReply of AddTaskReply_msg.t
|
| AddTaskReply of AddTaskReply_msg.t
|
||||||
| TaskDone of TaskDone_msg.t
|
| TaskDone of TaskDone_msg.t
|
||||||
@ -286,6 +585,8 @@ let of_string s =
|
|||||||
match l with
|
match l with
|
||||||
| "add_task" :: state :: task ->
|
| "add_task" :: state :: task ->
|
||||||
AddTask (AddTask_msg.create ~state ~task:(String.concat ~sep:" " task) )
|
AddTask (AddTask_msg.create ~state ~task:(String.concat ~sep:" " task) )
|
||||||
|
| "del_task" :: state :: task_id :: [] ->
|
||||||
|
DelTask (DelTask_msg.create ~state ~task_id)
|
||||||
| "get_task" :: state :: client_id :: [] ->
|
| "get_task" :: state :: client_id :: [] ->
|
||||||
GetTask (GetTask_msg.create ~state ~client_id)
|
GetTask (GetTask_msg.create ~state ~client_id)
|
||||||
| "task_done" :: state :: client_id :: task_id :: [] ->
|
| "task_done" :: state :: client_id :: task_id :: [] ->
|
||||||
@ -296,8 +597,19 @@ let of_string s =
|
|||||||
Connect (Connect_msg.create t)
|
Connect (Connect_msg.create t)
|
||||||
| "new_job" :: state :: push_address_tcp :: push_address_inproc :: [] ->
|
| "new_job" :: state :: push_address_tcp :: push_address_inproc :: [] ->
|
||||||
Newjob (Newjob_msg.create push_address_tcp push_address_inproc state)
|
Newjob (Newjob_msg.create push_address_tcp push_address_inproc state)
|
||||||
|
| "end_job" :: state :: [] ->
|
||||||
|
Endjob (Endjob_msg.create state)
|
||||||
| "terminate" :: [] ->
|
| "terminate" :: [] ->
|
||||||
Terminate (Terminate_msg.create () )
|
Terminate (Terminate_msg.create () )
|
||||||
|
| "get_psi" :: client_id :: [] ->
|
||||||
|
GetPsi (GetPsi_msg.create ~client_id)
|
||||||
|
| "put_psi" :: client_id :: n_state :: n_det :: psi_det_size :: n_det_generators :: n_det_selectors :: [] ->
|
||||||
|
PutPsi (PutPsi_msg.create ~client_id ~n_state ~n_det ~psi_det_size
|
||||||
|
~n_det_generators:(Some n_det_generators) ~n_det_selectors:(Some n_det_selectors)
|
||||||
|
~psi_det:None ~psi_coef:None )
|
||||||
|
| "put_psi" :: client_id :: n_state :: n_det :: psi_det_size :: [] ->
|
||||||
|
PutPsi (PutPsi_msg.create ~client_id ~n_state ~n_det ~psi_det_size ~n_det_generators:None
|
||||||
|
~n_det_selectors:None ~psi_det:None ~psi_coef:None )
|
||||||
| "ok" :: [] ->
|
| "ok" :: [] ->
|
||||||
Ok (Ok_msg.create ())
|
Ok (Ok_msg.create ())
|
||||||
| "error" :: rest ->
|
| "error" :: rest ->
|
||||||
@ -306,18 +618,29 @@ let of_string s =
|
|||||||
|
|
||||||
|
|
||||||
let to_string = function
|
let to_string = function
|
||||||
|
| GetPsi x -> GetPsi_msg.to_string x
|
||||||
|
| PutPsiReply x -> PutPsiReply_msg.to_string x
|
||||||
| Newjob x -> Newjob_msg.to_string x
|
| Newjob x -> Newjob_msg.to_string x
|
||||||
|
| Endjob x -> Endjob_msg.to_string x
|
||||||
| Connect x -> Connect_msg.to_string x
|
| Connect x -> Connect_msg.to_string x
|
||||||
| ConnectReply x -> ConnectReply_msg.to_string x
|
| ConnectReply x -> ConnectReply_msg.to_string x
|
||||||
| Disconnect x -> Disconnect_msg.to_string x
|
| Disconnect x -> Disconnect_msg.to_string x
|
||||||
| DisconnectReply x -> DisconnectReply_msg.to_string x
|
| DisconnectReply x -> DisconnectReply_msg.to_string x
|
||||||
| GetTask x -> GetTask_msg.to_string x
|
| GetTask x -> GetTask_msg.to_string x
|
||||||
| GetTaskReply x -> GetTaskReply_msg.to_string x
|
| GetTaskReply x -> GetTaskReply_msg.to_string x
|
||||||
|
| DelTask x -> DelTask_msg.to_string x
|
||||||
|
| DelTaskReply x -> DelTaskReply_msg.to_string x
|
||||||
| AddTask x -> AddTask_msg.to_string x
|
| AddTask x -> AddTask_msg.to_string x
|
||||||
| AddTaskReply x -> AddTaskReply_msg.to_string x
|
| AddTaskReply x -> AddTaskReply_msg.to_string x
|
||||||
| TaskDone x -> TaskDone_msg.to_string x
|
| TaskDone x -> TaskDone_msg.to_string x
|
||||||
| Terminate x -> Terminate_msg.to_string x
|
| Terminate x -> Terminate_msg.to_string x
|
||||||
| Ok x -> Ok_msg.to_string x
|
| Ok x -> Ok_msg.to_string x
|
||||||
| Error x -> Error_msg.to_string x
|
| Error x -> Error_msg.to_string x
|
||||||
|
| PutPsi x -> PutPsi_msg.to_string x
|
||||||
|
| GetPsiReply x -> GetPsiReply_msg.to_string x
|
||||||
|
|
||||||
|
|
||||||
|
let to_string_list = function
|
||||||
|
| PutPsi x -> PutPsi_msg.to_string_list x
|
||||||
|
| GetPsiReply x -> GetPsiReply_msg.to_string_list x
|
||||||
|
| _ -> assert false
|
||||||
|
108
ocaml/Progress_bar.ml
Normal file
108
ocaml/Progress_bar.ml
Normal file
@ -0,0 +1,108 @@
|
|||||||
|
open Core.Std
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
title: string;
|
||||||
|
start_value: float;
|
||||||
|
cur_value : float;
|
||||||
|
end_value : float;
|
||||||
|
bar_length : int;
|
||||||
|
init_time : Time.t;
|
||||||
|
dirty : bool;
|
||||||
|
next : Time.t;
|
||||||
|
}
|
||||||
|
|
||||||
|
let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title =
|
||||||
|
{ title ; start_value ; end_value ; bar_length ; cur_value=start_value ;
|
||||||
|
init_time= Time.now () ; dirty = true ; next = Time.now () }
|
||||||
|
|
||||||
|
let update ~cur_value bar =
|
||||||
|
{ bar with cur_value ; dirty=true }
|
||||||
|
|
||||||
|
let increment_end bar =
|
||||||
|
{ bar with end_value=(bar.end_value +. 1.) ; dirty=true }
|
||||||
|
|
||||||
|
let increment_cur bar =
|
||||||
|
{ bar with cur_value=(bar.cur_value +. 1.) ; dirty=true }
|
||||||
|
|
||||||
|
let display_tty bar =
|
||||||
|
let percent =
|
||||||
|
100. *. (bar.cur_value -. bar.start_value) /.
|
||||||
|
(bar.end_value -. bar.start_value)
|
||||||
|
in
|
||||||
|
let n_hashes =
|
||||||
|
(Float.of_int bar.bar_length) *. percent /. 100.
|
||||||
|
|> Float.to_int
|
||||||
|
in
|
||||||
|
let hashes =
|
||||||
|
String.init bar.bar_length ~f:(fun i ->
|
||||||
|
if (i < n_hashes) then '#'
|
||||||
|
else ' '
|
||||||
|
)
|
||||||
|
in
|
||||||
|
let now =
|
||||||
|
Time.now ()
|
||||||
|
in
|
||||||
|
let running_time =
|
||||||
|
Time.abs_diff now bar.init_time
|
||||||
|
in
|
||||||
|
let stop_time =
|
||||||
|
let x =
|
||||||
|
Time.Span.to_float running_time
|
||||||
|
in
|
||||||
|
if (percent > 0.) then
|
||||||
|
x *. 100. /. percent -. x
|
||||||
|
|> Time.Span.of_float
|
||||||
|
else
|
||||||
|
Time.Span.of_float 0.
|
||||||
|
in
|
||||||
|
Printf.printf "%s : [%s] %4.1f%% | %10s, ~%10s left\r%!"
|
||||||
|
bar.title
|
||||||
|
hashes
|
||||||
|
percent
|
||||||
|
(Time.Span.to_string running_time)
|
||||||
|
(stop_time |> Time.Span.to_string );
|
||||||
|
{ bar with dirty = false ; next = Time.add now (Time.Span.of_float 0.1) }
|
||||||
|
|
||||||
|
|
||||||
|
let display_file bar =
|
||||||
|
let percent =
|
||||||
|
100. *. (bar.cur_value -. bar.start_value) /.
|
||||||
|
(bar.end_value -. bar.start_value)
|
||||||
|
in
|
||||||
|
let running_time =
|
||||||
|
Time.abs_diff (Time.now ()) bar.init_time
|
||||||
|
in
|
||||||
|
let stop_time =
|
||||||
|
let x =
|
||||||
|
Time.Span.to_float running_time
|
||||||
|
in
|
||||||
|
if (percent > 0.) then
|
||||||
|
x *. 100. /. percent -. x
|
||||||
|
|> Time.Span.of_float
|
||||||
|
else
|
||||||
|
Time.Span.of_float 0.
|
||||||
|
in
|
||||||
|
Printf.printf "%5.2f %% in %20s, ~%20s left\n%!"
|
||||||
|
percent
|
||||||
|
(Time.Span.to_string running_time)
|
||||||
|
(Time.Span.to_string stop_time);
|
||||||
|
{ bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_float 2.) }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let display bar =
|
||||||
|
if (not bar.dirty) then
|
||||||
|
bar
|
||||||
|
else if (Time.now () < bar.next) then
|
||||||
|
bar
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (Unix.isatty Unix.stdout) then
|
||||||
|
display_tty bar
|
||||||
|
else
|
||||||
|
display_file bar
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,4 +1,5 @@
|
|||||||
open Core.Std
|
open Core.Std
|
||||||
|
open Qptypes
|
||||||
|
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
@ -32,7 +33,7 @@ let add_task ~task q =
|
|||||||
queued = task_id :: q.queued ;
|
queued = task_id :: q.queued ;
|
||||||
tasks = Map.add q.tasks ~key:task_id ~data:task ;
|
tasks = Map.add q.tasks ~key:task_id ~data:task ;
|
||||||
next_task_id = Id.Task.increment task_id ;
|
next_task_id = Id.Task.increment task_id ;
|
||||||
}, task_id
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -81,13 +82,25 @@ let end_task ~task_id ~client_id q =
|
|||||||
in
|
in
|
||||||
{ q with
|
{ q with
|
||||||
running = Map.remove running task_id ;
|
running = Map.remove running task_id ;
|
||||||
|
}
|
||||||
|
|
||||||
|
let del_task ~task_id q =
|
||||||
|
let { tasks ; _ } =
|
||||||
|
q
|
||||||
|
in
|
||||||
|
|
||||||
|
if (Map.mem tasks task_id) then
|
||||||
|
{ q with
|
||||||
tasks = Map.remove tasks task_id ;
|
tasks = Map.remove tasks task_id ;
|
||||||
}
|
}
|
||||||
|
else
|
||||||
|
Printf.sprintf "Task %d is already deleted" (Id.Task.to_int task_id)
|
||||||
|
|> failwith
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let number_of_queued q =
|
let number_of_queued q =
|
||||||
List.length q.queued
|
Map.length q.tasks
|
||||||
|
|
||||||
let number_of_running q =
|
let number_of_running q =
|
||||||
Map.length q.running
|
Map.length q.running
|
||||||
|
@ -1,47 +1,60 @@
|
|||||||
open Core.Std
|
open Core.Std
|
||||||
open Qptypes
|
open Qptypes
|
||||||
|
|
||||||
(**
|
|
||||||
The tasks server listens on a REQ socket and accepts the following commands:
|
|
||||||
|
|
||||||
* "new_job %s %s %s" state push_address_tcp push_address_inproc -> "OK"
|
type t =
|
||||||
-> "OK"
|
{
|
||||||
|
queue : Queuing_system.t ;
|
||||||
|
state : Message.State.t option ;
|
||||||
|
address_tcp : Address.Tcp.t option ;
|
||||||
|
address_inproc : Address.Inproc.t option ;
|
||||||
|
psi : Message.Psi.t option;
|
||||||
|
progress_bar : Progress_bar.t option ;
|
||||||
|
running : bool;
|
||||||
|
}
|
||||||
|
|
||||||
* "connect %s" ["tcp"|"inproc"]
|
|
||||||
-> "%d %s %s" id state push_address
|
|
||||||
|
|
||||||
* "disconnect %d" id
|
|
||||||
-> "OK"
|
|
||||||
|
|
||||||
* "get_task %d %s" id state
|
let debug_env =
|
||||||
-> "%d %s" task_id task
|
match Sys.getenv "QP_TASK_DEBUG" with
|
||||||
|
| Some x -> x <> ""
|
||||||
|
| None -> false
|
||||||
|
|
||||||
* "task_done %d task_id %s" id state
|
|
||||||
-> "%d %s" task_id task
|
|
||||||
|
|
||||||
*)
|
let debug str =
|
||||||
|
if debug_env then
|
||||||
|
Printf.printf "TASK : %s%!" str
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let zmq_context =
|
||||||
|
ZMQ.Context.create ()
|
||||||
|
|
||||||
|
|
||||||
let bind_socket ~socket_type ~socket ~address =
|
let bind_socket ~socket_type ~socket ~address =
|
||||||
|
let rec loop = function
|
||||||
|
| 0 -> failwith @@ Printf.sprintf
|
||||||
|
"Unable to bind the %s socket : %s "
|
||||||
|
socket_type address
|
||||||
|
| -1 -> ()
|
||||||
|
| i ->
|
||||||
try
|
try
|
||||||
ZMQ.Socket.bind socket address
|
ZMQ.Socket.bind socket address;
|
||||||
|
loop (-1)
|
||||||
with
|
with
|
||||||
| Unix.Unix_error (_, message, f) ->
|
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_float 1. ; loop (i-1) )
|
||||||
failwith @@ Printf.sprintf
|
|
||||||
"\n%s\nUnable to bind the %s socket :\n %s\n%s"
|
|
||||||
f socket_type address message
|
|
||||||
| other_exception -> raise other_exception
|
| other_exception -> raise other_exception
|
||||||
|
in loop 10
|
||||||
|
|
||||||
|
|
||||||
(** Name of the host on which the server runs *)
|
|
||||||
let hostname = lazy (
|
let hostname = lazy (
|
||||||
try
|
try
|
||||||
Unix.gethostname ()
|
Unix.gethostname ()
|
||||||
with
|
with
|
||||||
| _ -> "localhost"
|
| _ -> "localhost"
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
(** IP address *)
|
|
||||||
let ip_address = lazy (
|
let ip_address = lazy (
|
||||||
match Sys.getenv "QP_NIC" with
|
match Sys.getenv "QP_NIC" with
|
||||||
| None ->
|
| None ->
|
||||||
@ -67,20 +80,32 @@ let ip_address = lazy (
|
|||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
let reply_ok rep_socket =
|
||||||
|
Message.Ok_msg.create ()
|
||||||
|
|> Message.Ok_msg.to_string
|
||||||
|
|> ZMQ.Socket.send rep_socket
|
||||||
|
|
||||||
|
let reply_wrong_state rep_socket =
|
||||||
|
Printf.printf "WRONG STATE\n%!";
|
||||||
|
Message.Error_msg.create "Wrong state"
|
||||||
|
|> Message.Error_msg.to_string
|
||||||
|
|> ZMQ.Socket.send rep_socket
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let stop ~port =
|
let stop ~port =
|
||||||
let zmq_context =
|
debug "STOP";
|
||||||
ZMQ.Context.create ()
|
|
||||||
in
|
|
||||||
let req_socket =
|
let req_socket =
|
||||||
ZMQ.Socket.create zmq_context ZMQ.Socket.req
|
ZMQ.Socket.create zmq_context ZMQ.Socket.req
|
||||||
and address =
|
and address =
|
||||||
Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) port
|
Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) port
|
||||||
in
|
in
|
||||||
|
ZMQ.Socket.set_linger_period req_socket 1_000_000;
|
||||||
ZMQ.Socket.connect req_socket address;
|
ZMQ.Socket.connect req_socket address;
|
||||||
|
|
||||||
Message.Terminate (Message.Terminate_msg.create ())
|
Message.Terminate (Message.Terminate_msg.create ())
|
||||||
|> Message.to_string
|
|> Message.to_string
|
||||||
|> ZMQ.Socket.send ~block:false req_socket ;
|
|> ZMQ.Socket.send req_socket ;
|
||||||
|
|
||||||
let msg =
|
let msg =
|
||||||
ZMQ.Socket.recv req_socket
|
ZMQ.Socket.recv req_socket
|
||||||
@ -91,24 +116,427 @@ let stop ~port =
|
|||||||
| Message.Ok _ -> ()
|
| Message.Ok _ -> ()
|
||||||
| _ -> failwith "Problem in termination"
|
| _ -> failwith "Problem in termination"
|
||||||
in
|
in
|
||||||
ZMQ.Socket.set_linger_period req_socket 1000;
|
ZMQ.Socket.set_linger_period req_socket 1_000;
|
||||||
ZMQ.Socket.close req_socket
|
ZMQ.Socket.close req_socket
|
||||||
|
|
||||||
|
|
||||||
(** Run the task server *)
|
let new_job msg program_state rep_socket =
|
||||||
let run ~port =
|
|
||||||
|
|
||||||
let zmq_context =
|
let state =
|
||||||
ZMQ.Context.create ()
|
msg.Message.Newjob_msg.state
|
||||||
in
|
in
|
||||||
|
|
||||||
|
let progress_bar =
|
||||||
|
Progress_bar.init
|
||||||
|
~start_value:0.
|
||||||
|
~end_value:1.
|
||||||
|
~bar_length:20
|
||||||
|
~title:(Message.State.to_string state)
|
||||||
|
in
|
||||||
|
|
||||||
|
let result =
|
||||||
|
{ program_state with
|
||||||
|
state = Some state ;
|
||||||
|
progress_bar = Some progress_bar ;
|
||||||
|
address_tcp = Some msg.Message.Newjob_msg.address_tcp;
|
||||||
|
address_inproc = Some msg.Message.Newjob_msg.address_inproc;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
reply_ok rep_socket;
|
||||||
|
result
|
||||||
|
|
||||||
|
|
||||||
|
let end_job msg program_state rep_socket =
|
||||||
|
|
||||||
|
let failure () =
|
||||||
|
reply_wrong_state rep_socket;
|
||||||
|
program_state
|
||||||
|
|
||||||
|
and success state =
|
||||||
|
reply_ok rep_socket;
|
||||||
|
{ program_state with
|
||||||
|
state = None ;
|
||||||
|
progress_bar = None ;
|
||||||
|
}
|
||||||
|
|
||||||
|
in
|
||||||
|
match program_state.state with
|
||||||
|
| None -> failure ()
|
||||||
|
| Some state ->
|
||||||
|
begin
|
||||||
|
if (msg.Message.Endjob_msg.state = state) then
|
||||||
|
success state
|
||||||
|
else
|
||||||
|
failure ()
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
let connect msg program_state rep_socket =
|
||||||
|
|
||||||
|
let state =
|
||||||
|
match program_state.state with
|
||||||
|
| Some state -> state
|
||||||
|
| None -> assert false
|
||||||
|
in
|
||||||
|
|
||||||
|
let push_address =
|
||||||
|
match msg with
|
||||||
|
| Message.Connect_msg.Tcp ->
|
||||||
|
begin
|
||||||
|
match program_state.address_tcp with
|
||||||
|
| Some address -> Address.Tcp address
|
||||||
|
| None -> failwith "Error: No TCP address"
|
||||||
|
end
|
||||||
|
| Message.Connect_msg.Inproc ->
|
||||||
|
begin
|
||||||
|
match program_state.address_inproc with
|
||||||
|
| Some address -> Address.Inproc address
|
||||||
|
| None -> failwith "Error: No inproc address"
|
||||||
|
end
|
||||||
|
| Message.Connect_msg.Ipc -> assert false
|
||||||
|
in
|
||||||
|
|
||||||
|
let new_queue, client_id =
|
||||||
|
Queuing_system.add_client program_state.queue
|
||||||
|
in
|
||||||
|
Message.ConnectReply (Message.ConnectReply_msg.create
|
||||||
|
~state:state ~client_id ~push_address)
|
||||||
|
|> Message.to_string
|
||||||
|
|> ZMQ.Socket.send rep_socket ;
|
||||||
|
{ program_state with
|
||||||
|
queue = new_queue
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
let disconnect msg program_state rep_socket =
|
||||||
|
|
||||||
|
let state, client_id =
|
||||||
|
msg.Message.Disconnect_msg.state,
|
||||||
|
msg.Message.Disconnect_msg.client_id
|
||||||
|
in
|
||||||
|
|
||||||
|
let failure () =
|
||||||
|
reply_wrong_state rep_socket;
|
||||||
|
program_state
|
||||||
|
|
||||||
|
and success () =
|
||||||
|
|
||||||
|
let new_program_state =
|
||||||
|
{ program_state with
|
||||||
|
queue = Queuing_system.del_client ~client_id program_state.queue
|
||||||
|
}
|
||||||
|
in
|
||||||
|
Message.DisconnectReply (Message.DisconnectReply_msg.create ~state)
|
||||||
|
|> Message.to_string
|
||||||
|
|> ZMQ.Socket.send rep_socket ;
|
||||||
|
new_program_state
|
||||||
|
|
||||||
|
in
|
||||||
|
|
||||||
|
match program_state.state with
|
||||||
|
| None -> assert false
|
||||||
|
| Some state' ->
|
||||||
|
begin
|
||||||
|
if (state = state') then
|
||||||
|
success ()
|
||||||
|
else
|
||||||
|
failure ()
|
||||||
|
end
|
||||||
|
|
||||||
|
let del_task msg program_state rep_socket =
|
||||||
|
|
||||||
|
let state, task_id =
|
||||||
|
msg.Message.DelTask_msg.state,
|
||||||
|
msg.Message.DelTask_msg.task_id
|
||||||
|
in
|
||||||
|
|
||||||
|
let failure () =
|
||||||
|
reply_wrong_state rep_socket;
|
||||||
|
program_state
|
||||||
|
|
||||||
|
and success () =
|
||||||
|
|
||||||
|
let new_program_state =
|
||||||
|
{ program_state with
|
||||||
|
queue = Queuing_system.del_task ~task_id program_state.queue
|
||||||
|
}
|
||||||
|
in
|
||||||
|
let more =
|
||||||
|
(Queuing_system.number_of_queued new_program_state.queue +
|
||||||
|
Queuing_system.number_of_running new_program_state.queue) > 0
|
||||||
|
in
|
||||||
|
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_id ~more)
|
||||||
|
|> Message.to_string
|
||||||
|
|> ZMQ.Socket.send ~block:true rep_socket ; (** /!\ Has to be blocking *)
|
||||||
|
new_program_state
|
||||||
|
|
||||||
|
in
|
||||||
|
|
||||||
|
match program_state.state with
|
||||||
|
| None -> assert false
|
||||||
|
| Some state' ->
|
||||||
|
begin
|
||||||
|
if (state = state') then
|
||||||
|
success ()
|
||||||
|
else
|
||||||
|
failure ()
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let add_task msg program_state rep_socket =
|
||||||
|
|
||||||
|
let state, task =
|
||||||
|
msg.Message.AddTask_msg.state,
|
||||||
|
msg.Message.AddTask_msg.task
|
||||||
|
in
|
||||||
|
|
||||||
|
let increment_progress_bar = function
|
||||||
|
| Some bar -> Some (Progress_bar.increment_end bar)
|
||||||
|
| None -> None
|
||||||
|
in
|
||||||
|
|
||||||
|
let rec add_task_triangle program_state imax = function
|
||||||
|
| 0 -> program_state
|
||||||
|
| i ->
|
||||||
|
let task =
|
||||||
|
Printf.sprintf "%d %d" i imax
|
||||||
|
in
|
||||||
|
let new_program_state =
|
||||||
|
{ program_state with
|
||||||
|
queue = Queuing_system.add_task ~task program_state.queue ;
|
||||||
|
progress_bar = increment_progress_bar program_state.progress_bar ;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
add_task_triangle new_program_state imax (i-1)
|
||||||
|
in
|
||||||
|
|
||||||
|
let rec add_task_range program_state i = function
|
||||||
|
| j when (j < i) -> program_state
|
||||||
|
| j ->
|
||||||
|
let task =
|
||||||
|
Printf.sprintf "%d" j
|
||||||
|
in
|
||||||
|
let new_program_state =
|
||||||
|
{ program_state with
|
||||||
|
queue = Queuing_system.add_task ~task program_state.queue ;
|
||||||
|
progress_bar = increment_progress_bar program_state.progress_bar ;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
add_task_range new_program_state i (j-1)
|
||||||
|
in
|
||||||
|
|
||||||
|
let new_program_state = function
|
||||||
|
| "triangle" :: i_str :: [] ->
|
||||||
|
let imax =
|
||||||
|
Int.of_string i_str
|
||||||
|
in
|
||||||
|
add_task_triangle program_state imax imax
|
||||||
|
| "range" :: i_str :: j_str :: [] ->
|
||||||
|
let i, j =
|
||||||
|
Int.of_string i_str,
|
||||||
|
Int.of_string j_str
|
||||||
|
in
|
||||||
|
add_task_range program_state i j
|
||||||
|
| _ ->
|
||||||
|
{ program_state with
|
||||||
|
queue = Queuing_system.add_task ~task program_state.queue ;
|
||||||
|
progress_bar = increment_progress_bar program_state.progress_bar ;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
|
||||||
|
let result =
|
||||||
|
String.split ~on:' ' task
|
||||||
|
|> List.filter ~f:(fun x -> x <> "")
|
||||||
|
|> new_program_state
|
||||||
|
in
|
||||||
|
reply_ok rep_socket;
|
||||||
|
result
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let get_task msg program_state rep_socket =
|
||||||
|
|
||||||
|
let state, client_id =
|
||||||
|
msg.Message.GetTask_msg.state,
|
||||||
|
msg.Message.GetTask_msg.client_id
|
||||||
|
in
|
||||||
|
|
||||||
|
let failure () =
|
||||||
|
reply_wrong_state rep_socket;
|
||||||
|
program_state
|
||||||
|
|
||||||
|
and success () =
|
||||||
|
|
||||||
|
let new_queue, task_id, task =
|
||||||
|
Queuing_system.pop_task ~client_id program_state.queue
|
||||||
|
in
|
||||||
|
|
||||||
|
let new_program_state =
|
||||||
|
{ program_state with
|
||||||
|
queue = new_queue
|
||||||
|
}
|
||||||
|
in
|
||||||
|
|
||||||
|
match (task, task_id) with
|
||||||
|
| Some task, Some task_id ->
|
||||||
|
begin
|
||||||
|
Message.GetTaskReply (Message.GetTaskReply_msg.create ~task ~task_id)
|
||||||
|
|> Message.to_string
|
||||||
|
|> ZMQ.Socket.send rep_socket ;
|
||||||
|
new_program_state
|
||||||
|
end
|
||||||
|
| _ ->
|
||||||
|
begin
|
||||||
|
Message.Terminate (Message.Terminate_msg.create ())
|
||||||
|
|> Message.to_string
|
||||||
|
|> ZMQ.Socket.send rep_socket ;
|
||||||
|
program_state
|
||||||
|
end
|
||||||
|
|
||||||
|
in
|
||||||
|
|
||||||
|
match program_state.state with
|
||||||
|
| None -> assert false
|
||||||
|
| Some state' ->
|
||||||
|
begin
|
||||||
|
if (state = state') then
|
||||||
|
success ()
|
||||||
|
else
|
||||||
|
failure ()
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let task_done msg program_state rep_socket =
|
||||||
|
|
||||||
|
let state, client_id, task_id =
|
||||||
|
msg.Message.TaskDone_msg.state,
|
||||||
|
msg.Message.TaskDone_msg.client_id,
|
||||||
|
msg.Message.TaskDone_msg.task_id
|
||||||
|
in
|
||||||
|
|
||||||
|
let increment_progress_bar = function
|
||||||
|
| Some bar -> Some (Progress_bar.increment_cur bar)
|
||||||
|
| None -> None
|
||||||
|
in
|
||||||
|
|
||||||
|
let failure () =
|
||||||
|
reply_wrong_state rep_socket;
|
||||||
|
program_state
|
||||||
|
|
||||||
|
and success () =
|
||||||
|
let result =
|
||||||
|
{ program_state with
|
||||||
|
queue = Queuing_system.end_task ~task_id ~client_id program_state.queue ;
|
||||||
|
progress_bar = increment_progress_bar program_state.progress_bar ;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
reply_ok rep_socket;
|
||||||
|
result
|
||||||
|
in
|
||||||
|
|
||||||
|
match program_state.state with
|
||||||
|
| None -> assert false
|
||||||
|
| Some state' ->
|
||||||
|
begin
|
||||||
|
if (state = state') then
|
||||||
|
success ()
|
||||||
|
else
|
||||||
|
failure ()
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
let put_psi msg rest_of_msg program_state rep_socket =
|
||||||
|
|
||||||
|
let psi_local =
|
||||||
|
match msg.Message.PutPsi_msg.psi with
|
||||||
|
| Some x -> x
|
||||||
|
| None ->
|
||||||
|
begin
|
||||||
|
let psi_det, psi_coef =
|
||||||
|
match rest_of_msg with
|
||||||
|
| [ x ; y ] -> x, y
|
||||||
|
| _ -> failwith "Badly formed put_psi message"
|
||||||
|
in
|
||||||
|
Message.Psi.create
|
||||||
|
~n_state:msg.Message.PutPsi_msg.n_state
|
||||||
|
~n_det:msg.Message.PutPsi_msg.n_det
|
||||||
|
~psi_det_size:msg.Message.PutPsi_msg.psi_det_size
|
||||||
|
~n_det_generators:msg.Message.PutPsi_msg.n_det_generators
|
||||||
|
~n_det_selectors:msg.Message.PutPsi_msg.n_det_selectors
|
||||||
|
~psi_det
|
||||||
|
~psi_coef
|
||||||
|
end
|
||||||
|
in
|
||||||
|
let new_program_state =
|
||||||
|
{ program_state with
|
||||||
|
psi = Some psi_local
|
||||||
|
}
|
||||||
|
and client_id =
|
||||||
|
msg.Message.PutPsi_msg.client_id
|
||||||
|
in
|
||||||
|
Message.PutPsiReply (Message.PutPsiReply_msg.create ~client_id)
|
||||||
|
|> Message.to_string
|
||||||
|
|> ZMQ.Socket.send rep_socket;
|
||||||
|
|
||||||
|
new_program_state
|
||||||
|
|
||||||
|
|
||||||
|
let get_psi msg program_state rep_socket =
|
||||||
|
|
||||||
|
let client_id =
|
||||||
|
msg.Message.GetPsi_msg.client_id
|
||||||
|
in
|
||||||
|
match program_state.psi with
|
||||||
|
| None -> failwith "No wave function saved in TaskServer"
|
||||||
|
| Some psi ->
|
||||||
|
Message.GetPsiReply (Message.GetPsiReply_msg.create ~client_id ~psi)
|
||||||
|
|> Message.to_string_list
|
||||||
|
|> ZMQ.Socket.send_all rep_socket;
|
||||||
|
program_state
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let terminate program_state rep_socket =
|
||||||
|
reply_ok rep_socket;
|
||||||
|
{ program_state with
|
||||||
|
running = false
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
let error msg program_state rep_socket =
|
||||||
|
Printf.printf "%s\n%!" msg;
|
||||||
|
Message.Error (Message.Error_msg.create msg)
|
||||||
|
|> Message.to_string
|
||||||
|
|> ZMQ.Socket.send rep_socket ;
|
||||||
|
program_state
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let run ~port =
|
||||||
|
|
||||||
|
(** Bind REP socket *)
|
||||||
let rep_socket =
|
let rep_socket =
|
||||||
ZMQ.Socket.create zmq_context ZMQ.Socket.rep
|
ZMQ.Socket.create zmq_context ZMQ.Socket.rep
|
||||||
and address =
|
and address =
|
||||||
Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) port
|
Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) port
|
||||||
in
|
in
|
||||||
bind_socket "REP" rep_socket address;
|
bind_socket "REP" rep_socket address;
|
||||||
|
ZMQ.Socket.set_linger_period rep_socket 1_000_000;
|
||||||
|
|
||||||
|
let initial_program_state =
|
||||||
|
{ queue = Queuing_system.create () ;
|
||||||
|
running = true ;
|
||||||
|
psi = None;
|
||||||
|
state = None;
|
||||||
|
address_tcp = None;
|
||||||
|
address_inproc = None;
|
||||||
|
progress_bar = None ;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
|
||||||
|
(** ZMR polling item *)
|
||||||
let pollitem =
|
let pollitem =
|
||||||
ZMQ.Poll.mask_of
|
ZMQ.Poll.mask_of
|
||||||
[| (rep_socket, ZMQ.Poll.In) |]
|
[| (rep_socket, ZMQ.Poll.In) |]
|
||||||
@ -116,222 +544,76 @@ let run ~port =
|
|||||||
|
|
||||||
Printf.printf "Task server running : %s\n%!" address;
|
Printf.printf "Task server running : %s\n%!" address;
|
||||||
|
|
||||||
(** State variables *)
|
|
||||||
let q = ref
|
|
||||||
(Queuing_system.create ())
|
|
||||||
and running =
|
|
||||||
ref true
|
|
||||||
and job =
|
|
||||||
ref None
|
|
||||||
in
|
|
||||||
|
|
||||||
let get_state () =
|
(** Main loop *)
|
||||||
match !job with
|
let rec main_loop program_state = function
|
||||||
| None -> None
|
| false -> ()
|
||||||
| Some j -> Some j.Message.Newjob_msg.state
|
| true ->
|
||||||
in
|
let polling =
|
||||||
|
|
||||||
let get_tcp_address () =
|
|
||||||
match !job with
|
|
||||||
| Some j -> Address.Tcp j.Message.Newjob_msg.address_tcp
|
|
||||||
| None -> assert false
|
|
||||||
in
|
|
||||||
|
|
||||||
let get_inproc_address () =
|
|
||||||
match !job with
|
|
||||||
| Some j -> Address.Inproc j.Message.Newjob_msg.address_inproc
|
|
||||||
| None -> assert false
|
|
||||||
in
|
|
||||||
|
|
||||||
let ok =
|
|
||||||
Message.Ok (Message.Ok_msg.create ())
|
|
||||||
in
|
|
||||||
|
|
||||||
while ( !running )
|
|
||||||
do
|
|
||||||
let state =
|
|
||||||
get_state ()
|
|
||||||
and polling =
|
|
||||||
ZMQ.Poll.poll ~timeout:1000 pollitem
|
ZMQ.Poll.poll ~timeout:1000 pollitem
|
||||||
in
|
in
|
||||||
|
if (polling.(0) <> Some ZMQ.Poll.In) then
|
||||||
let terminate () =
|
main_loop program_state true
|
||||||
running := false;
|
else
|
||||||
Message.to_string ok
|
|
||||||
|> ZMQ.Socket.send ~block:false rep_socket
|
|
||||||
|
|
||||||
and newjob x =
|
|
||||||
q := Queuing_system.create ();
|
|
||||||
job := Some x;
|
|
||||||
Message.to_string ok
|
|
||||||
|> ZMQ.Socket.send ~block:false rep_socket
|
|
||||||
|
|
||||||
and connect state msg =
|
|
||||||
let push_address =
|
|
||||||
match msg with
|
|
||||||
| Message.Connect_msg.Tcp -> get_tcp_address ()
|
|
||||||
| Message.Connect_msg.Inproc -> get_inproc_address ()
|
|
||||||
| Message.Connect_msg.Ipc -> assert false
|
|
||||||
in
|
|
||||||
let new_q, client_id =
|
|
||||||
Queuing_system.add_client !q
|
|
||||||
in
|
|
||||||
q := new_q;
|
|
||||||
Message.ConnectReply (Message.ConnectReply_msg.create
|
|
||||||
~state ~client_id ~push_address)
|
|
||||||
|> Message.to_string
|
|
||||||
|> ZMQ.Socket.send ~block:false rep_socket
|
|
||||||
|
|
||||||
and disconnect state msg =
|
|
||||||
let s, c =
|
|
||||||
msg.Message.Disconnect_msg.state ,
|
|
||||||
msg.Message.Disconnect_msg.client_id
|
|
||||||
in
|
|
||||||
assert (s = state);
|
|
||||||
let new_q =
|
|
||||||
Queuing_system.del_client ~client_id:c !q
|
|
||||||
in
|
|
||||||
q := new_q;
|
|
||||||
let finished =
|
|
||||||
Queuing_system.number_of_queued !q +
|
|
||||||
Queuing_system.number_of_running !q = 0
|
|
||||||
in
|
|
||||||
Message.DisconnectReply (Message.DisconnectReply_msg.create
|
|
||||||
~state ~finished)
|
|
||||||
|> Message.to_string
|
|
||||||
|> ZMQ.Socket.send ~block:false rep_socket
|
|
||||||
|
|
||||||
and add_task state msg =
|
|
||||||
let s, task =
|
|
||||||
msg.Message.AddTask_msg.state,
|
|
||||||
msg.Message.AddTask_msg.task
|
|
||||||
in
|
|
||||||
assert (s = state);
|
|
||||||
Message.to_string ok
|
|
||||||
|> ZMQ.Socket.send ~block:false rep_socket
|
|
||||||
;
|
|
||||||
begin
|
begin
|
||||||
match
|
let program_state =
|
||||||
String.split ~on:' ' msg.Message.AddTask_msg.task
|
match program_state.progress_bar with
|
||||||
|> List.filter ~f:(fun x -> x <> "")
|
| None -> program_state
|
||||||
with
|
| Some bar ->
|
||||||
| "triangle" :: str_l :: [] ->
|
if bar.Progress_bar.dirty then
|
||||||
begin
|
{ program_state with
|
||||||
let l =
|
progress_bar = Some (Progress_bar.display bar)
|
||||||
Int.of_string str_l
|
}
|
||||||
in
|
else
|
||||||
for j=1 to l
|
program_state
|
||||||
do
|
|
||||||
let task =
|
|
||||||
Printf.sprintf "%d %s" j str_l
|
|
||||||
in
|
|
||||||
let new_q, _ =
|
|
||||||
Queuing_system.add_task ~task !q
|
|
||||||
in
|
|
||||||
q := new_q
|
|
||||||
done
|
|
||||||
end
|
|
||||||
| "range" :: str_i :: str_j :: [] ->
|
|
||||||
begin
|
|
||||||
let i, j =
|
|
||||||
Int.of_string str_i,
|
|
||||||
Int.of_string str_j
|
|
||||||
in
|
|
||||||
for k=i to (j+1)
|
|
||||||
do
|
|
||||||
let task =
|
|
||||||
Int.to_string k
|
|
||||||
in
|
|
||||||
let new_q, task_id =
|
|
||||||
Queuing_system.add_task ~task !q
|
|
||||||
in
|
|
||||||
q := new_q
|
|
||||||
done
|
|
||||||
end
|
|
||||||
| _ ->
|
|
||||||
let new_q, task_id =
|
|
||||||
Queuing_system.add_task ~task !q
|
|
||||||
in
|
|
||||||
q := new_q
|
|
||||||
end
|
|
||||||
|
|
||||||
and get_task state msg =
|
|
||||||
let s, client_id =
|
|
||||||
msg.Message.GetTask_msg.state,
|
|
||||||
msg.Message.GetTask_msg.client_id
|
|
||||||
in
|
|
||||||
assert (s = state);
|
|
||||||
let new_q, task_id, task =
|
|
||||||
Queuing_system.pop_task ~client_id !q
|
|
||||||
in
|
|
||||||
q := new_q;
|
|
||||||
let reply =
|
|
||||||
match (task, task_id) with
|
|
||||||
| Some task, Some task_id ->
|
|
||||||
Message.GetTaskReply (Message.GetTaskReply_msg.create ~task ~task_id)
|
|
||||||
| _ -> Message.Terminate (Message.Terminate_msg.create ())
|
|
||||||
in
|
|
||||||
Message.to_string reply
|
|
||||||
|> ZMQ.Socket.send ~block:false rep_socket
|
|
||||||
|
|
||||||
and task_done state msg =
|
|
||||||
let s, client_id, task_id =
|
|
||||||
msg.Message.TaskDone_msg.state,
|
|
||||||
msg.Message.TaskDone_msg.client_id,
|
|
||||||
msg.Message.TaskDone_msg.task_id
|
|
||||||
in
|
|
||||||
assert (s = state);
|
|
||||||
let new_q =
|
|
||||||
Queuing_system.end_task ~task_id ~client_id !q
|
|
||||||
in
|
|
||||||
q := new_q;
|
|
||||||
Message.to_string ok
|
|
||||||
|> ZMQ.Socket.send ~block:false rep_socket
|
|
||||||
|
|
||||||
and error msg =
|
|
||||||
Message.Error (Message.Error_msg.create msg)
|
|
||||||
|> Message.to_string
|
|
||||||
|> ZMQ.Socket.send ~block:false rep_socket
|
|
||||||
in
|
in
|
||||||
|
|
||||||
if (polling.(0) = Some ZMQ.Poll.In) then
|
(** Extract message *)
|
||||||
let raw_message =
|
let raw_message, rest =
|
||||||
ZMQ.Socket.recv rep_socket
|
match ZMQ.Socket.recv_all rep_socket with
|
||||||
|
| x :: rest -> x, rest
|
||||||
|
| [] -> failwith "Badly formed message"
|
||||||
in
|
in
|
||||||
try
|
|
||||||
let message =
|
let message =
|
||||||
Message.of_string raw_message
|
Message.of_string raw_message
|
||||||
in
|
in
|
||||||
(*
|
|
||||||
Printf.printf "%d %d : %s\n%!"
|
(** Debug input *)
|
||||||
(Queuing_system.number_of_queued !q)
|
Printf.sprintf "%d %d : %s\n%!"
|
||||||
(Queuing_system.number_of_running !q)
|
(Queuing_system.number_of_queued program_state.queue)
|
||||||
(Message.to_string message);
|
(Queuing_system.number_of_running program_state.queue)
|
||||||
Printf.printf "%s\n%!" (Queuing_system.to_string !q); *)
|
(Message.to_string message)
|
||||||
match (state, message) with
|
|> debug;
|
||||||
| _ , Message.Terminate _ -> terminate ()
|
|
||||||
| None , Message.Newjob x -> newjob x
|
let new_program_state =
|
||||||
| None , _ -> error "No job is running"
|
try
|
||||||
| _ , Message.Newjob _ -> error "A job is already running"
|
match program_state.state, message with
|
||||||
| Some s, Message.Connect x -> connect s x
|
| _ , Message.Terminate _ -> terminate program_state rep_socket
|
||||||
| Some s, Message.Disconnect x -> disconnect s x
|
| _ , Message.PutPsi x -> put_psi x rest program_state rep_socket
|
||||||
| Some s, Message.AddTask x -> add_task s x
|
| _ , Message.GetPsi x -> get_psi x program_state rep_socket
|
||||||
| Some s, Message.GetTask x -> get_task s x
|
| None , Message.Newjob x -> new_job x program_state rep_socket
|
||||||
| Some s, Message.TaskDone x -> task_done s x
|
| _ , Message.Newjob _ -> error "A job is already running" program_state rep_socket
|
||||||
|
| Some _, Message.Endjob x -> end_job x program_state rep_socket
|
||||||
|
| None , _ -> error "No job is running" program_state rep_socket
|
||||||
|
| Some _, Message.Connect x -> connect x program_state rep_socket
|
||||||
|
| Some _, Message.Disconnect x -> disconnect x program_state rep_socket
|
||||||
|
| Some _, Message.AddTask x -> add_task x program_state rep_socket
|
||||||
|
| Some _, Message.DelTask x -> del_task x program_state rep_socket
|
||||||
|
| Some _, Message.GetTask x -> get_task x program_state rep_socket
|
||||||
|
| Some _, Message.TaskDone x -> task_done x program_state rep_socket
|
||||||
| _ , _ ->
|
| _ , _ ->
|
||||||
error ("Invalid message : "^(Message.to_string message))
|
error ("Invalid message : "^(Message.to_string message)) program_state rep_socket
|
||||||
with
|
with
|
||||||
| Failure f -> error (f^" : "^raw_message)
|
| Failure f ->
|
||||||
| Assert_failure (f,i,j) -> error (Printf.sprintf "%s:%d:%d : %s" f i j raw_message)
|
error (f^" : "^raw_message) program_state rep_socket
|
||||||
|
| Assert_failure (f,i,j) ->
|
||||||
|
error (Printf.sprintf "%s:%d:%d : %s" f i j raw_message) program_state rep_socket
|
||||||
|
|
||||||
done;
|
in
|
||||||
ZMQ.Socket.set_linger_period rep_socket 1000;
|
main_loop new_program_state new_program_state.running
|
||||||
ZMQ.Socket.close rep_socket
|
end
|
||||||
|
in main_loop initial_program_state true;
|
||||||
|
|
||||||
|
|
||||||
(*
|
|
||||||
let () =
|
|
||||||
Printf.printf "export QP_RUN_ADDRESS=tcp://%s:%d\n%!" (Lazy.force ip_address) (Lazy.force port)
|
|
||||||
*)
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,2 +1,3 @@
|
|||||||
true: package(core,sexplib.syntax,cryptokit,ZMQ)
|
true: package(core,sexplib.syntax,cryptokit,ZMQ)
|
||||||
true: thread
|
true: thread
|
||||||
|
false: profile
|
||||||
|
314
ocaml/qp_edit.ml
314
ocaml/qp_edit.ml
@ -1,314 +0,0 @@
|
|||||||
open Qputils;;
|
|
||||||
open Qptypes;;
|
|
||||||
open Core.Std;;
|
|
||||||
|
|
||||||
(** Interactive editing of the input.
|
|
||||||
|
|
||||||
WARNING
|
|
||||||
This file is autogenerad by
|
|
||||||
`${QP_ROOT}/script/ezfio_interface/ei_handler.py`
|
|
||||||
*)
|
|
||||||
|
|
||||||
|
|
||||||
(** Keywords used to define input sections *)
|
|
||||||
type keyword =
|
|
||||||
| Ao_basis
|
|
||||||
| Determinants_by_hand
|
|
||||||
| Electrons
|
|
||||||
| Mo_basis
|
|
||||||
| Nuclei
|
|
||||||
| Hartree_fock
|
|
||||||
| Pseudo
|
|
||||||
| Integrals_bielec
|
|
||||||
| Perturbation
|
|
||||||
| Properties
|
|
||||||
| Foboci
|
|
||||||
| Determinants
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
let keyword_to_string = function
|
|
||||||
| Ao_basis -> "AO basis"
|
|
||||||
| Determinants_by_hand -> "Determinants_by_hand"
|
|
||||||
| Electrons -> "Electrons"
|
|
||||||
| Mo_basis -> "MO basis"
|
|
||||||
| Nuclei -> "Molecule"
|
|
||||||
| Hartree_fock -> "Hartree_fock"
|
|
||||||
| Pseudo -> "Pseudo"
|
|
||||||
| Integrals_bielec -> "Integrals_bielec"
|
|
||||||
| Perturbation -> "Perturbation"
|
|
||||||
| Properties -> "Properties"
|
|
||||||
| Foboci -> "Foboci"
|
|
||||||
| Determinants -> "Determinants"
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(** Create the header of the temporary file *)
|
|
||||||
let file_header filename =
|
|
||||||
Printf.sprintf "
|
|
||||||
==================================================================
|
|
||||||
Quantum Package
|
|
||||||
==================================================================
|
|
||||||
|
|
||||||
Editing file `%s`
|
|
||||||
|
|
||||||
" filename
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
(** Creates the header of a section *)
|
|
||||||
let make_header kw =
|
|
||||||
let s = keyword_to_string kw in
|
|
||||||
let l = String.length s in
|
|
||||||
"\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n"
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
(** Returns the rst string of section [s] *)
|
|
||||||
let get s =
|
|
||||||
let header = (make_header s) in
|
|
||||||
let f (read,to_rst) =
|
|
||||||
match read () with
|
|
||||||
| Some text -> header ^ (Rst_string.to_string (to_rst text))
|
|
||||||
| None -> ""
|
|
||||||
in
|
|
||||||
let rst =
|
|
||||||
try
|
|
||||||
begin
|
|
||||||
let open Input in
|
|
||||||
match s with
|
|
||||||
| Mo_basis ->
|
|
||||||
f Mo_basis.(read, to_rst)
|
|
||||||
| Electrons ->
|
|
||||||
f Electrons.(read, to_rst)
|
|
||||||
| Nuclei ->
|
|
||||||
f Nuclei.(read, to_rst)
|
|
||||||
| Ao_basis ->
|
|
||||||
f Ao_basis.(read, to_rst)
|
|
||||||
| Determinants_by_hand ->
|
|
||||||
f Determinants_by_hand.(read, to_rst)
|
|
||||||
| Hartree_fock ->
|
|
||||||
f Hartree_fock.(read, to_rst)
|
|
||||||
| Pseudo ->
|
|
||||||
f Pseudo.(read, to_rst)
|
|
||||||
| Integrals_bielec ->
|
|
||||||
f Integrals_bielec.(read, to_rst)
|
|
||||||
| Perturbation ->
|
|
||||||
f Perturbation.(read, to_rst)
|
|
||||||
| Properties ->
|
|
||||||
f Properties.(read, to_rst)
|
|
||||||
| Foboci ->
|
|
||||||
f Foboci.(read, to_rst)
|
|
||||||
| Determinants ->
|
|
||||||
f Determinants.(read, to_rst)
|
|
||||||
end
|
|
||||||
with
|
|
||||||
| Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "")
|
|
||||||
in
|
|
||||||
rst
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
(** Applies the changes from the string [str] corresponding to section [s] *)
|
|
||||||
let set str s =
|
|
||||||
let header = (make_header s) in
|
|
||||||
match String.substr_index ~pos:0 ~pattern:header str with
|
|
||||||
| None -> ()
|
|
||||||
| Some idx ->
|
|
||||||
begin
|
|
||||||
let index_begin = idx + (String.length header) in
|
|
||||||
let index_end =
|
|
||||||
match ( String.substr_index ~pos:(index_begin+(String.length header)+1)
|
|
||||||
~pattern:"==" str) with
|
|
||||||
| Some i -> i
|
|
||||||
| None -> String.length str
|
|
||||||
in
|
|
||||||
let l = index_end - index_begin in
|
|
||||||
let str = String.sub ~pos:index_begin ~len:l str
|
|
||||||
|> Rst_string.of_string
|
|
||||||
in
|
|
||||||
let write (of_rst,w) s =
|
|
||||||
try
|
|
||||||
match of_rst str with
|
|
||||||
| Some data -> w data
|
|
||||||
| None -> ()
|
|
||||||
with
|
|
||||||
| _ -> (Printf.eprintf "Info: Read error in %s\n%!"
|
|
||||||
(keyword_to_string s); ignore (of_rst str) )
|
|
||||||
in
|
|
||||||
let open Input in
|
|
||||||
match s with
|
|
||||||
| Hartree_fock -> write Hartree_fock.(of_rst, write) s
|
|
||||||
| Pseudo -> write Pseudo.(of_rst, write) s
|
|
||||||
| Integrals_bielec -> write Integrals_bielec.(of_rst, write) s
|
|
||||||
| Perturbation -> write Perturbation.(of_rst, write) s
|
|
||||||
| Properties -> write Properties.(of_rst, write) s
|
|
||||||
| Foboci -> write Foboci.(of_rst, write) s
|
|
||||||
| Determinants -> write Determinants.(of_rst, write) s
|
|
||||||
| Electrons -> write Electrons.(of_rst, write) s
|
|
||||||
| Determinants_by_hand -> write Determinants_by_hand.(of_rst, write) s
|
|
||||||
| Nuclei -> write Nuclei.(of_rst, write) s
|
|
||||||
| Ao_basis -> () (* TODO *)
|
|
||||||
| Mo_basis -> () (* TODO *)
|
|
||||||
end
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
(** Creates the temporary file for interactive editing *)
|
|
||||||
let create_temp_file ezfio_filename fields =
|
|
||||||
let temp_filename = Filename.temp_file "qp_edit_" ".rst" in
|
|
||||||
begin
|
|
||||||
Out_channel.with_file temp_filename ~f:(fun out_channel ->
|
|
||||||
(file_header ezfio_filename) :: (List.map ~f:get fields)
|
|
||||||
|> String.concat ~sep:"\n"
|
|
||||||
|> Out_channel.output_string out_channel
|
|
||||||
)
|
|
||||||
end
|
|
||||||
; temp_filename
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let run check_only ezfio_filename =
|
|
||||||
|
|
||||||
(* Open EZFIO *)
|
|
||||||
if (not (Sys.file_exists_exn ezfio_filename)) then
|
|
||||||
failwith (ezfio_filename^" does not exists");
|
|
||||||
|
|
||||||
Ezfio.set_file ezfio_filename;
|
|
||||||
|
|
||||||
(*
|
|
||||||
let output = (file_header ezfio_filename) :: (
|
|
||||||
List.map ~f:get [
|
|
||||||
Ao_basis ;
|
|
||||||
Mo_basis ;
|
|
||||||
])
|
|
||||||
in
|
|
||||||
String.concat output
|
|
||||||
|> print_string
|
|
||||||
*)
|
|
||||||
|
|
||||||
let tasks = [
|
|
||||||
Nuclei ;
|
|
||||||
Ao_basis;
|
|
||||||
Electrons ;
|
|
||||||
Hartree_fock ;
|
|
||||||
Pseudo ;
|
|
||||||
Integrals_bielec ;
|
|
||||||
Perturbation ;
|
|
||||||
Properties ;
|
|
||||||
Foboci ;
|
|
||||||
Determinants ;
|
|
||||||
Mo_basis;
|
|
||||||
Determinants_by_hand ;
|
|
||||||
]
|
|
||||||
in
|
|
||||||
|
|
||||||
(* Create the temp file *)
|
|
||||||
let temp_filename = create_temp_file ezfio_filename tasks in
|
|
||||||
|
|
||||||
(* Open the temp file with external editor *)
|
|
||||||
let editor =
|
|
||||||
match Sys.getenv "EDITOR" with
|
|
||||||
| Some editor -> editor
|
|
||||||
| None -> "vi"
|
|
||||||
in
|
|
||||||
|
|
||||||
match check_only with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
Printf.sprintf "%s %s" editor temp_filename
|
|
||||||
|> Sys.command_exn
|
|
||||||
;
|
|
||||||
|
|
||||||
(* Re-read the temp file *)
|
|
||||||
let temp_string =
|
|
||||||
In_channel.with_file temp_filename ~f:(fun in_channel ->
|
|
||||||
In_channel.input_all in_channel)
|
|
||||||
in
|
|
||||||
List.iter ~f:(fun x -> set temp_string x) tasks;
|
|
||||||
|
|
||||||
(* Remove temp_file *)
|
|
||||||
Sys.remove temp_filename;
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
(** Create a backup file in case of an exception *)
|
|
||||||
let create_backup ezfio_filename =
|
|
||||||
Printf.sprintf "
|
|
||||||
rm -f %s/backup.tgz ;
|
|
||||||
tar -zcf .backup.tgz %s && mv .backup.tgz %s/backup.tgz
|
|
||||||
"
|
|
||||||
ezfio_filename ezfio_filename ezfio_filename
|
|
||||||
|> Sys.command_exn
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
(** Restore the backup file when an exception occuprs *)
|
|
||||||
let restore_backup ezfio_filename =
|
|
||||||
Printf.sprintf "tar -zxf %s/backup.tgz"
|
|
||||||
ezfio_filename
|
|
||||||
|> Sys.command_exn
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
let spec =
|
|
||||||
let open Command.Spec in
|
|
||||||
empty
|
|
||||||
+> flag "-c" no_arg
|
|
||||||
~doc:"Checks the input data"
|
|
||||||
(*
|
|
||||||
+> flag "o" (optional string)
|
|
||||||
~doc:"Prints output data"
|
|
||||||
*)
|
|
||||||
+> anon ("ezfio_file" %: string)
|
|
||||||
;;
|
|
||||||
|
|
||||||
let command =
|
|
||||||
Command.basic
|
|
||||||
~summary: "Quantum Package command"
|
|
||||||
~readme:(fun () ->
|
|
||||||
"
|
|
||||||
Edit input data
|
|
||||||
")
|
|
||||||
spec
|
|
||||||
(* (fun i o ezfio_file () -> *)
|
|
||||||
(*fun ezfio_file () ->
|
|
||||||
try
|
|
||||||
run ezfio_file
|
|
||||||
with
|
|
||||||
| _ msg -> print_string ("\n\nError\n\n"^msg^"\n\n")
|
|
||||||
*)
|
|
||||||
(fun c ezfio_file () ->
|
|
||||||
try
|
|
||||||
run c ezfio_file ;
|
|
||||||
(* create_backup ezfio_file; *)
|
|
||||||
with
|
|
||||||
| Failure exc
|
|
||||||
| Invalid_argument exc as e ->
|
|
||||||
begin
|
|
||||||
Printf.eprintf "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n";
|
|
||||||
Printf.eprintf "%s\n\n" exc;
|
|
||||||
Printf.eprintf "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n";
|
|
||||||
(* restore_backup ezfio_file; *)
|
|
||||||
raise e
|
|
||||||
end
|
|
||||||
| Assert_failure (file, line, ch) as e ->
|
|
||||||
begin
|
|
||||||
Printf.eprintf "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n";
|
|
||||||
Printf.eprintf "Assert error in file $QP_ROOT/ocaml/%s, line %d, character %d\n\n" file line ch;
|
|
||||||
Printf.eprintf "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n";
|
|
||||||
(* restore_backup ezfio_file; *)
|
|
||||||
raise e
|
|
||||||
end
|
|
||||||
)
|
|
||||||
;;
|
|
||||||
|
|
||||||
let () =
|
|
||||||
Command.run command;
|
|
||||||
exit 0
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -35,7 +35,24 @@ let mo () =
|
|||||||
|> print_endline
|
|> print_endline
|
||||||
|
|
||||||
|
|
||||||
|
let psi_det () =
|
||||||
|
let ezfio_filename =
|
||||||
|
Sys.argv.(1)
|
||||||
|
in
|
||||||
|
if (not (Sys.file_exists_exn ezfio_filename)) then
|
||||||
|
failwith "Error reading EZFIO file";
|
||||||
|
Ezfio.set_file ezfio_filename;
|
||||||
|
let psi_det =
|
||||||
|
Input.Determinants_by_hand.read ()
|
||||||
|
in
|
||||||
|
Input.Determinants_by_hand.to_rst psi_det
|
||||||
|
|> Rst_string.to_string
|
||||||
|
|> print_endline
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
basis ();
|
basis ();
|
||||||
mo ()
|
mo ();
|
||||||
|
psi_det ()
|
||||||
|
|
||||||
|
@ -1,21 +1,64 @@
|
|||||||
open Core.Std;;
|
open Core.Std
|
||||||
open Qputils;;
|
open Qputils
|
||||||
|
|
||||||
|
(* Environment variables :
|
||||||
|
|
||||||
|
QP_PREFIX=gdb : to run gdb (or valgrind, or whatever)
|
||||||
|
QP_TASK_DEBUG=1 : debug task server
|
||||||
|
|
||||||
|
*)
|
||||||
|
|
||||||
let print_list () =
|
let print_list () =
|
||||||
Lazy.force Qpackage.executables
|
Lazy.force Qpackage.executables
|
||||||
|> List.iter ~f:(fun (x,_) -> Printf.printf " * %s\n" x)
|
|> List.iter ~f:(fun (x,_) -> Printf.printf " * %s\n" x)
|
||||||
;;
|
|
||||||
|
|
||||||
let run exe ezfio_file =
|
let () =
|
||||||
|
Random.self_init ()
|
||||||
|
|
||||||
let time_start = Time.now() in
|
let run ~master exe ezfio_file =
|
||||||
|
|
||||||
|
|
||||||
|
(** Check availability of the ports *)
|
||||||
|
let port_number =
|
||||||
|
let zmq_context =
|
||||||
|
ZMQ.Context.create ()
|
||||||
|
in
|
||||||
|
let dummy_socket =
|
||||||
|
ZMQ.Socket.create zmq_context ZMQ.Socket.rep
|
||||||
|
in
|
||||||
|
let rec try_new_port port_number =
|
||||||
|
try
|
||||||
|
List.iter [ 0;1;2;3;4 ] ~f:(fun i ->
|
||||||
|
let address =
|
||||||
|
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) (port_number+i)
|
||||||
|
in
|
||||||
|
ZMQ.Socket.bind dummy_socket address;
|
||||||
|
ZMQ.Socket.unbind dummy_socket address;
|
||||||
|
);
|
||||||
|
port_number
|
||||||
|
with
|
||||||
|
| Unix.Unix_error _ -> try_new_port (port_number+100)
|
||||||
|
in
|
||||||
|
let result =
|
||||||
|
try_new_port 41279
|
||||||
|
in
|
||||||
|
ZMQ.Socket.close dummy_socket;
|
||||||
|
result
|
||||||
|
in
|
||||||
|
let time_start =
|
||||||
|
Time.now ()
|
||||||
|
in
|
||||||
|
|
||||||
if (not (Sys.file_exists_exn ezfio_file)) then
|
if (not (Sys.file_exists_exn ezfio_file)) then
|
||||||
failwith ("EZFIO directory "^ezfio_file^" not found");
|
failwith ("EZFIO directory "^ezfio_file^" not found");
|
||||||
|
|
||||||
let executables = Lazy.force Qpackage.executables in
|
let executables = Lazy.force Qpackage.executables in
|
||||||
if (not (List.exists ~f:(fun (x,_) -> x = exe) executables)) then
|
if (not (List.exists ~f:(fun (x,_) -> x = exe) executables)) then
|
||||||
failwith ("Executable "^exe^" not found");
|
begin
|
||||||
|
Printf.printf "\nPossible choices:\n";
|
||||||
|
List.iter executables ~f:(fun (x,_) -> Printf.printf "* %s\n%!" x);
|
||||||
|
failwith ("Executable "^exe^" not found")
|
||||||
|
end;
|
||||||
|
|
||||||
Printf.printf "%s\n" (Time.to_string time_start);
|
Printf.printf "%s\n" (Time.to_string time_start);
|
||||||
Printf.printf "===============\nQuantum Package\n===============\n\n";
|
Printf.printf "===============\nQuantum Package\n===============\n\n";
|
||||||
@ -26,16 +69,18 @@ let run exe ezfio_file =
|
|||||||
|
|
||||||
|
|
||||||
(** Check input *)
|
(** Check input *)
|
||||||
|
begin
|
||||||
match (Sys.command ("qp_edit -c "^ezfio_file)) with
|
match (Sys.command ("qp_edit -c "^ezfio_file)) with
|
||||||
| 0 -> ()
|
| 0 -> ()
|
||||||
| i -> failwith "Error: Input inconsistent\n";
|
| i -> failwith "Error: Input inconsistent\n"
|
||||||
;
|
end;
|
||||||
|
begin
|
||||||
|
match master with
|
||||||
|
| Some address -> Unix.putenv ~key:"QP_RUN_ADDRESS_MASTER" ~data:address
|
||||||
|
| None -> ()
|
||||||
|
end;
|
||||||
|
|
||||||
(** Start task server *)
|
(** Start task server *)
|
||||||
let port_number =
|
|
||||||
12345
|
|
||||||
in
|
|
||||||
let address =
|
let address =
|
||||||
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) port_number
|
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) port_number
|
||||||
in
|
in
|
||||||
@ -49,12 +94,16 @@ let run exe ezfio_file =
|
|||||||
Unix.putenv ~key:"QP_RUN_ADDRESS" ~data:address;
|
Unix.putenv ~key:"QP_RUN_ADDRESS" ~data:address;
|
||||||
|
|
||||||
(** Run executable *)
|
(** Run executable *)
|
||||||
let exe =
|
let prefix =
|
||||||
|
match Sys.getenv "QP_PREFIX" with
|
||||||
|
| Some x -> x^" "
|
||||||
|
| None -> ""
|
||||||
|
and exe =
|
||||||
match (List.find ~f:(fun (x,_) -> x = exe) executables) with
|
match (List.find ~f:(fun (x,_) -> x = exe) executables) with
|
||||||
|
| Some (_,x) -> x^" "
|
||||||
| None -> assert false
|
| None -> assert false
|
||||||
| Some (_,x) -> x
|
|
||||||
in
|
in
|
||||||
match (Sys.command (exe^" "^ezfio_file)) with
|
match (Sys.command (prefix^exe^ezfio_file)) with
|
||||||
| 0 -> ()
|
| 0 -> ()
|
||||||
| i -> Printf.printf "Program exited with code %d.\n%!" i;
|
| i -> Printf.printf "Program exited with code %d.\n%!" i;
|
||||||
;
|
;
|
||||||
@ -64,16 +113,19 @@ let run exe ezfio_file =
|
|||||||
|
|
||||||
let duration = Time.diff (Time.now()) time_start
|
let duration = Time.diff (Time.now()) time_start
|
||||||
|> Core.Span.to_string in
|
|> Core.Span.to_string in
|
||||||
Printf.printf "Wall time : %s\n\n" duration;
|
Printf.printf "Wall time : %s\n\n" duration
|
||||||
;;
|
|
||||||
|
|
||||||
let spec =
|
let spec =
|
||||||
let open Command.Spec in
|
let open Command.Spec in
|
||||||
empty
|
empty
|
||||||
|
+> flag "master" (optional string)
|
||||||
|
~doc:("address Address of the master process")
|
||||||
+> anon ("executable" %: string)
|
+> anon ("executable" %: string)
|
||||||
+> anon ("ezfio_file" %: string)
|
+> anon ("ezfio_file" %: string)
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
Command.basic
|
Command.basic
|
||||||
~summary: "Quantum Package command"
|
~summary: "Quantum Package command"
|
||||||
@ -85,10 +137,9 @@ Executes a Quantum Package binary file among these:\n\n"
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
spec
|
spec
|
||||||
(fun exe ezfio_file () ->
|
(fun master exe ezfio_file () ->
|
||||||
run exe ezfio_file
|
run ~master exe ezfio_file
|
||||||
)
|
)
|
||||||
|> Command.run ~version: Git.sha1 ~build_info: Git.message
|
|> Command.run ~version: Git.sha1 ~build_info: Git.message
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -13,6 +13,9 @@ let input_data = "
|
|||||||
* Strictly_negative_float : float
|
* Strictly_negative_float : float
|
||||||
assert (x < 0.) ;
|
assert (x < 0.) ;
|
||||||
|
|
||||||
|
* Positive_int64 : int64
|
||||||
|
assert (x >= 0L) ;
|
||||||
|
|
||||||
* Positive_int : int
|
* Positive_int : int
|
||||||
assert (x >= 0) ;
|
assert (x >= 0) ;
|
||||||
|
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
open Core.Std
|
open Core.Std
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
Message.of_string "new_job tcp://127.0.0.1 inproc://ao_ints:12345 ao_integrals"
|
Message.of_string "new_job ao_integrals tcp://127.0.0.1 inproc://ao_ints:12345"
|
||||||
|> Message.to_string
|
|> Message.to_string
|
||||||
|> print_endline
|
|> print_endline
|
||||||
;
|
;
|
||||||
@ -37,7 +37,7 @@ let () =
|
|||||||
;
|
;
|
||||||
|
|
||||||
try
|
try
|
||||||
Message.of_string "new_job inproc://ao_ints tcp://127.0.0.1:12345 ao_integrals"
|
Message.of_string "new_job ao_integrals inproc://ao_ints tcp://127.0.0.1:12345"
|
||||||
|> Message.to_string
|
|> Message.to_string
|
||||||
|> print_endline
|
|> print_endline
|
||||||
;
|
;
|
||||||
|
@ -3,7 +3,6 @@
|
|||||||
import zmq
|
import zmq
|
||||||
import sys, os
|
import sys, os
|
||||||
|
|
||||||
|
|
||||||
def main():
|
def main():
|
||||||
context = zmq.Context()
|
context = zmq.Context()
|
||||||
socket = context.socket(zmq.REQ)
|
socket = context.socket(zmq.REQ)
|
||||||
@ -11,9 +10,11 @@ def main():
|
|||||||
|
|
||||||
def send(msg,expected):
|
def send(msg,expected):
|
||||||
print "Send : ", msg
|
print "Send : ", msg
|
||||||
print " -> ", socket.send(msg)
|
socket.send(msg)
|
||||||
reply = socket.recv()
|
reply = socket.recv()
|
||||||
print "Reply : ", reply
|
print "Reply : ", ':'+reply+':'
|
||||||
|
if (reply != expected):
|
||||||
|
print "Expected: ", ':'+expected+':'
|
||||||
print ""
|
print ""
|
||||||
assert (reply == expected)
|
assert (reply == expected)
|
||||||
|
|
||||||
@ -23,23 +24,59 @@ def main():
|
|||||||
send("new_job ao_integrals tcp://130.120.229.139:12345 inproc://ao_integrals",
|
send("new_job ao_integrals tcp://130.120.229.139:12345 inproc://ao_integrals",
|
||||||
"error A job is already running")
|
"error A job is already running")
|
||||||
|
|
||||||
send("connect","error Message not understood : connect")
|
# send("connect","error Message not understood : connect")
|
||||||
|
|
||||||
send("connect tcp","connect_reply ao_integrals 1 tcp://130.120.229.139:12345")
|
send("connect tcp","connect_reply ao_integrals 1 tcp://130.120.229.139:12345")
|
||||||
send("connect inproc","connect_reply ao_integrals 2 inproc://ao_integrals")
|
send("connect inproc","connect_reply ao_integrals 2 inproc://ao_integrals")
|
||||||
send("disconnect ao_integrals 3","error Queuing_system.ml:65:2 : disconnect ao_integrals 3")
|
send("disconnect ao_integrals 3","error Queuing_system.ml:68:2 : disconnect ao_integrals 3")
|
||||||
send("disconnect ao_integrals 2","disconnect_reply ao_integrals 1")
|
send("disconnect ao_integrals 2","disconnect_reply ao_integrals")
|
||||||
send("connect inproc","connect_reply ao_integrals 3 inproc://ao_integrals")
|
send("connect inproc","connect_reply ao_integrals 3 inproc://ao_integrals")
|
||||||
|
|
||||||
for i in range(10):
|
send("add_task ao_integrals triangle 3", "ok")
|
||||||
|
send("add_task ao_integrals range 4 7", "ok")
|
||||||
|
|
||||||
|
for i in range(8,11):
|
||||||
send("add_task ao_integrals %d %d"%(i,i+10), "ok")
|
send("add_task ao_integrals %d %d"%(i,i+10), "ok")
|
||||||
|
|
||||||
for i in range(10):
|
send("get_task ao_integrals 3", "get_task_reply 10 10 20")
|
||||||
send("get_task ao_integrals 3", "get_task_reply %d %d %d"%(i+1,i,i+10))
|
send("get_task ao_integrals 3", "get_task_reply 9 9 19")
|
||||||
send("task_done ao_integrals 3 %d"%(i+1), "ok")
|
send("get_task ao_integrals 3", "get_task_reply 8 8 18")
|
||||||
|
|
||||||
send("get_task ao_integrals 3", "terminate")
|
send("task_done ao_integrals 3 10", "ok")
|
||||||
|
send("task_done ao_integrals 3 9", "ok")
|
||||||
|
send("task_done ao_integrals 3 8", "ok")
|
||||||
|
send("del_task ao_integrals 10", "del_task_reply more 10")
|
||||||
|
send("del_task ao_integrals 9", "del_task_reply more 9")
|
||||||
|
send("del_task ao_integrals 8", "del_task_reply more 8")
|
||||||
|
send("del_task ao_integrals 10", "error Task 10 is already deleted : del_task ao_integrals 10")
|
||||||
|
|
||||||
|
send("get_task ao_integrals 1", "get_task_reply 7 4")
|
||||||
|
send("get_task ao_integrals 3", "get_task_reply 6 5")
|
||||||
|
send("get_task ao_integrals 1", "get_task_reply 5 6")
|
||||||
|
send("get_task ao_integrals 3", "get_task_reply 4 7")
|
||||||
|
send("get_task ao_integrals 3", "get_task_reply 3 1 3")
|
||||||
|
send("get_task ao_integrals 1", "get_task_reply 2 2 3")
|
||||||
|
send("get_task ao_integrals 1", "get_task_reply 1 3 3")
|
||||||
|
|
||||||
|
send("task_done ao_integrals 1 1", "ok")
|
||||||
|
send("task_done ao_integrals 1 2", "ok")
|
||||||
|
send("task_done ao_integrals 3 3", "ok")
|
||||||
|
send("task_done ao_integrals 3 4", "ok")
|
||||||
|
send("task_done ao_integrals 1 5", "ok")
|
||||||
|
send("task_done ao_integrals 1 6", "error Queuing_system.ml:81:30 : task_done ao_integrals 1 6")
|
||||||
|
send("task_done ao_integrals 3 6", "ok")
|
||||||
|
send("task_done ao_integrals 1 7", "ok")
|
||||||
|
|
||||||
|
send("del_task ao_integrals 1", "del_task_reply more 1")
|
||||||
|
send("del_task ao_integrals 2", "del_task_reply more 2")
|
||||||
|
send("del_task ao_integrals 3", "del_task_reply more 3")
|
||||||
|
send("del_task ao_integrals 4", "del_task_reply more 4")
|
||||||
|
send("del_task ao_integrals 5", "del_task_reply more 5")
|
||||||
|
send("del_task ao_integrals 6", "del_task_reply more 6")
|
||||||
|
send("del_task ao_integrals 7", "del_task_reply done 7")
|
||||||
|
|
||||||
|
send("end_job ao_integrals","ok")
|
||||||
|
send("end_job ao_integrals","error No job is running")
|
||||||
send("terminate","ok")
|
send("terminate","ok")
|
||||||
|
|
||||||
if __name__ == '__main__':
|
if __name__ == '__main__':
|
||||||
|
@ -119,9 +119,6 @@ program casscf
|
|||||||
E_CI = sum(CI_energy(1:N_states)+pt2(1:N_states))/dble(N_states)
|
E_CI = sum(CI_energy(1:N_states)+pt2(1:N_states))/dble(N_states)
|
||||||
|
|
||||||
call ezfio_set_casscf_energy(CI_energy(1))
|
call ezfio_set_casscf_energy(CI_energy(1))
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
if (N_det == N_det_old) then
|
if (N_det == N_det_old) then
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
|
@ -54,9 +54,6 @@ program full_ci
|
|||||||
print *, 'E+PT2 = ', CI_energy+pt2
|
print *, 'E+PT2 = ', CI_energy+pt2
|
||||||
print *, '-----'
|
print *, '-----'
|
||||||
call ezfio_set_cas_sd_energy(CI_energy(1))
|
call ezfio_set_cas_sd_energy(CI_energy(1))
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
if (N_det == N_det_old) then
|
if (N_det == N_det_old) then
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
|
@ -51,9 +51,6 @@ program full_ci
|
|||||||
print *, 'E+PT2 = ', CI_energy+pt2
|
print *, 'E+PT2 = ', CI_energy+pt2
|
||||||
print *, '-----'
|
print *, '-----'
|
||||||
call ezfio_set_cas_sd_energy(CI_energy(1))
|
call ezfio_set_cas_sd_energy(CI_energy(1))
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
|
||||||
|
@ -54,9 +54,6 @@ program full_ci
|
|||||||
print *, 'E+PT2 = ', CI_energy+pt2
|
print *, 'E+PT2 = ', CI_energy+pt2
|
||||||
print *, '-----'
|
print *, '-----'
|
||||||
call ezfio_set_cas_sd_energy(CI_energy(1))
|
call ezfio_set_cas_sd_energy(CI_energy(1))
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
if (N_det == N_det_old) then
|
if (N_det == N_det_old) then
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
|
@ -51,9 +51,6 @@ program full_ci
|
|||||||
print *, 'E+PT2 = ', CI_energy+pt2
|
print *, 'E+PT2 = ', CI_energy+pt2
|
||||||
print *, '-----'
|
print *, '-----'
|
||||||
call ezfio_set_cas_sd_energy(CI_energy(1))
|
call ezfio_set_cas_sd_energy(CI_energy(1))
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
|
||||||
|
@ -13,7 +13,7 @@ program cisd_sc2_selected
|
|||||||
pt2 = 1.d0
|
pt2 = 1.d0
|
||||||
perturbation = "epstein_nesbet_sc2_projected"
|
perturbation = "epstein_nesbet_sc2_projected"
|
||||||
E_old(1) = HF_energy
|
E_old(1) = HF_energy
|
||||||
davidson_threshold = 1.d-6
|
threshold_davidson = 1.d-6
|
||||||
|
|
||||||
do while (maxval(abs(pt2(1:N_st))) > 1.d-4)
|
do while (maxval(abs(pt2(1:N_st))) > 1.d-4)
|
||||||
print*,'----'
|
print*,'----'
|
||||||
@ -33,14 +33,11 @@ program cisd_sc2_selected
|
|||||||
E_old(i) = CI_SC2_energy(i)
|
E_old(i) = CI_SC2_energy(i)
|
||||||
enddo
|
enddo
|
||||||
! print *, 'E corr = ', (E_old(1)) - HF_energy
|
! print *, 'E corr = ', (E_old(1)) - HF_energy
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
pt2 = 0.d0
|
pt2 = 0.d0
|
||||||
call H_apply_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
call H_apply_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
||||||
davidson_threshold = 1.d-10
|
threshold_davidson = 1.d-10
|
||||||
touch davidson_threshold davidson_criterion
|
touch threshold_davidson davidson_criterion
|
||||||
do i = 1, N_st
|
do i = 1, N_st
|
||||||
max = 0.d0
|
max = 0.d0
|
||||||
|
|
||||||
|
@ -26,9 +26,6 @@ program cisd
|
|||||||
! print *, 'E+PT2_new= ', (E_old(1)+1.d0*pt2(1)+H_pert_diag(1))/(1.d0 +norm_pert(1))
|
! print *, 'E+PT2_new= ', (E_old(1)+1.d0*pt2(1)+H_pert_diag(1))/(1.d0 +norm_pert(1))
|
||||||
enddo
|
enddo
|
||||||
E_old = CI_energy
|
E_old = CI_energy
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
deallocate(pt2,norm_pert,H_pert_diag)
|
deallocate(pt2,norm_pert,H_pert_diag)
|
||||||
end
|
end
|
@ -13,11 +13,11 @@ subroutine super_CI
|
|||||||
character :: save_char
|
character :: save_char
|
||||||
|
|
||||||
call write_time(output_hartree_fock)
|
call write_time(output_hartree_fock)
|
||||||
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )'), &
|
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )') &
|
||||||
'====','================','================','================'
|
'====','================','================','================'
|
||||||
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )'), &
|
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )') &
|
||||||
' N ', 'Energy ', 'Energy diff ', 'Save '
|
' N ', 'Energy ', 'Energy diff ', 'Save '
|
||||||
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )'), &
|
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )') &
|
||||||
'====','================','================','================'
|
'====','================','================','================'
|
||||||
|
|
||||||
E = HF_energy + 1.d0
|
E = HF_energy + 1.d0
|
||||||
@ -39,7 +39,7 @@ subroutine super_CI
|
|||||||
save_char = ' '
|
save_char = ' '
|
||||||
endif
|
endif
|
||||||
E_min = min(E,E_min)
|
E_min = min(E,E_min)
|
||||||
write(output_hartree_fock,'(I4,X,F16.10, X, F16.10, X, A8 )'),&
|
write(output_hartree_fock,'(I4,X,F16.10, X, F16.10, X, A8 )') &
|
||||||
k, E, delta_E, save_char
|
k, E, delta_E, save_char
|
||||||
if ( (delta_E < 0.d0).and.(dabs(delta_E) < thresh_scf) ) then
|
if ( (delta_E < 0.d0).and.(dabs(delta_E) < thresh_scf) ) then
|
||||||
exit
|
exit
|
||||||
@ -55,7 +55,7 @@ subroutine super_CI
|
|||||||
TOUCH mo_coef
|
TOUCH mo_coef
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )'), &
|
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )') &
|
||||||
'====','================','================','================'
|
'====','================','================','================'
|
||||||
call write_time(output_hartree_fock)
|
call write_time(output_hartree_fock)
|
||||||
end
|
end
|
||||||
|
@ -14,7 +14,7 @@ program cisd_sc2_selected
|
|||||||
perturbation = "epstein_nesbet_sc2_projected"
|
perturbation = "epstein_nesbet_sc2_projected"
|
||||||
|
|
||||||
E_old(1) = HF_energy
|
E_old(1) = HF_energy
|
||||||
davidson_threshold = 1.d-10
|
threshold_davidson = 1.d-10
|
||||||
if (N_det > N_det_max) then
|
if (N_det > N_det_max) then
|
||||||
call diagonalize_CI_SC2
|
call diagonalize_CI_SC2
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
@ -59,9 +59,6 @@ program cisd_sc2_selected
|
|||||||
else
|
else
|
||||||
i_count = 0
|
i_count = 0
|
||||||
endif
|
endif
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
|
|
||||||
! =~=~=~=~=~=~=~=~=~=~=~=~=~!
|
! =~=~=~=~=~=~=~=~=~=~=~=~=~!
|
||||||
! W r i t e _ o n _ d i s k !
|
! W r i t e _ o n _ d i s k !
|
||||||
@ -71,8 +68,8 @@ program cisd_sc2_selected
|
|||||||
|
|
||||||
enddo
|
enddo
|
||||||
N_det = min(N_det_max,N_det)
|
N_det = min(N_det_max,N_det)
|
||||||
davidson_threshold = 1.d-10
|
threshold_davidson = 1.d-10
|
||||||
touch N_det psi_det psi_coef davidson_threshold davidson_criterion
|
touch N_det psi_det psi_coef threshold_davidson davidson_criterion
|
||||||
call diagonalize_CI_SC2
|
call diagonalize_CI_SC2
|
||||||
pt2 = 0.d0
|
pt2 = 0.d0
|
||||||
|
|
||||||
|
@ -34,9 +34,6 @@ program cisd
|
|||||||
enddo
|
enddo
|
||||||
E_old = CI_energy
|
E_old = CI_energy
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
N_det = min(N_det,N_det_max)
|
N_det = min(N_det,N_det_max)
|
||||||
touch N_det psi_det psi_coef
|
touch N_det psi_det psi_coef
|
||||||
|
@ -65,9 +65,6 @@ program ddci
|
|||||||
endif
|
endif
|
||||||
E_before = CI_energy
|
E_before = CI_energy
|
||||||
call ezfio_set_ddci_selected_energy(CI_energy)
|
call ezfio_set_ddci_selected_energy(CI_energy)
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
if(do_pt2_end)then
|
if(do_pt2_end)then
|
||||||
call H_apply_DDCI_pt2(pt2, norm_pert, H_pert_diag, N_st)
|
call H_apply_DDCI_pt2(pt2, norm_pert, H_pert_diag, N_st)
|
||||||
|
@ -117,14 +117,8 @@ subroutine H_apply_dressed_pert_diexc(key_in, hole_1,particl_1, hole_2, particl_
|
|||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
other_spin = iand(ispin,1)+1
|
other_spin = iand(ispin,1)+1
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
! !$OMP DO SCHEDULE (static)
|
! !$OMP DO SCHEDULE (static)
|
||||||
do ii=1,ia_ja_pairs(1,0,ispin)
|
do ii=1,ia_ja_pairs(1,0,ispin)
|
||||||
if (abort_here) then
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
i_a = ia_ja_pairs(1,ii,ispin)
|
i_a = ia_ja_pairs(1,ii,ispin)
|
||||||
ASSERT (i_a > 0)
|
ASSERT (i_a > 0)
|
||||||
ASSERT (i_a <= mo_tot_num)
|
ASSERT (i_a <= mo_tot_num)
|
||||||
@ -202,9 +196,6 @@ subroutine H_apply_dressed_pert_diexc(key_in, hole_1,particl_1, hole_2, particl_
|
|||||||
call standard_dress(delta_ij_generators_,size_max,Ndet_generators,i_generator,key_idx,keys_out,N_int,iproc,psi_det_generators_input,E_ref)
|
call standard_dress(delta_ij_generators_,size_max,Ndet_generators,i_generator,key_idx,keys_out,N_int,iproc,psi_det_generators_input,E_ref)
|
||||||
key_idx = 0
|
key_idx = 0
|
||||||
endif
|
endif
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -253,9 +244,6 @@ subroutine H_apply_dressed_pert_diexc(key_in, hole_1,particl_1, hole_2, particl_
|
|||||||
call standard_dress(delta_ij_generators_,size_max,Ndet_generators,i_generator,key_idx,keys_out,N_int,iproc,psi_det_generators_input,E_ref)
|
call standard_dress(delta_ij_generators_,size_max,Ndet_generators,i_generator,key_idx,keys_out,N_int,iproc,psi_det_generators_input,E_ref)
|
||||||
key_idx = 0
|
key_idx = 0
|
||||||
endif
|
endif
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo ! kk
|
enddo ! kk
|
||||||
|
|
||||||
enddo ! ii
|
enddo ! ii
|
||||||
@ -467,22 +455,12 @@ subroutine H_apply_dressed_pert(delta_ij_generators_, Ndet_generators,psi_det_g
|
|||||||
|
|
||||||
|
|
||||||
! !$ call omp_init_lock(lck)
|
! !$ call omp_init_lock(lck)
|
||||||
call start_progress(Ndet_generators,'Selection (norm)',0.d0)
|
|
||||||
|
|
||||||
call wall_time(wall_0)
|
call wall_time(wall_0)
|
||||||
|
|
||||||
iproc = 0
|
iproc = 0
|
||||||
allocate( mask(N_int,2,6) )
|
allocate( mask(N_int,2,6) )
|
||||||
do i_generator=1,nmax
|
do i_generator=1,nmax
|
||||||
|
|
||||||
progress_bar(1) = i_generator
|
|
||||||
|
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
! ! Create bit masks for holes and particles
|
! ! Create bit masks for holes and particles
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
@ -535,14 +513,6 @@ subroutine H_apply_dressed_pert(delta_ij_generators_, Ndet_generators,psi_det_g
|
|||||||
allocate( mask(N_int,2,6) )
|
allocate( mask(N_int,2,6) )
|
||||||
! !$OMP DO SCHEDULE(dynamic,1)
|
! !$OMP DO SCHEDULE(dynamic,1)
|
||||||
do i_generator=nmax+1,Ndet_generators
|
do i_generator=nmax+1,Ndet_generators
|
||||||
if (iproc == 0) then
|
|
||||||
progress_bar(1) = i_generator
|
|
||||||
endif
|
|
||||||
if (abort_here) then
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
! Create bit masks for holes and particles
|
! Create bit masks for holes and particles
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
@ -594,11 +564,6 @@ subroutine H_apply_dressed_pert(delta_ij_generators_, Ndet_generators,psi_det_g
|
|||||||
! !$OMP END PARALLEL
|
! !$OMP END PARALLEL
|
||||||
! !$ call omp_destroy_lock(lck)
|
! !$ call omp_destroy_lock(lck)
|
||||||
|
|
||||||
abort_here = abort_all
|
|
||||||
call stop_progress
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -2,41 +2,49 @@ use bitmasks
|
|||||||
BEGIN_SHELL [ /usr/bin/env python ]
|
BEGIN_SHELL [ /usr/bin/env python ]
|
||||||
from generate_h_apply import *
|
from generate_h_apply import *
|
||||||
|
|
||||||
s = H_apply("FCI")
|
s = H_apply_zmq("FCI")
|
||||||
s.set_selection_pt2("epstein_nesbet_2x2")
|
s.set_selection_pt2("epstein_nesbet_2x2")
|
||||||
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
s = H_apply("FCI_PT2")
|
s = H_apply_zmq("FCI_PT2")
|
||||||
s.set_perturbation("epstein_nesbet_2x2")
|
s.set_perturbation("epstein_nesbet_2x2")
|
||||||
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
s = H_apply("FCI_no_skip")
|
s = H_apply_zmq("FCI_no_skip")
|
||||||
s.set_selection_pt2("epstein_nesbet_2x2")
|
s.set_selection_pt2("epstein_nesbet_2x2")
|
||||||
s.unset_skip()
|
s.unset_skip()
|
||||||
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
s = H_apply("FCI_mono")
|
s = H_apply("FCI_mono")
|
||||||
s.set_selection_pt2("epstein_nesbet_2x2")
|
s.set_selection_pt2("epstein_nesbet_2x2")
|
||||||
s.unset_double_excitations()
|
s.unset_double_excitations()
|
||||||
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
|
|
||||||
s = H_apply("select_mono_delta_rho")
|
s = H_apply("select_mono_delta_rho")
|
||||||
s.unset_double_excitations()
|
s.unset_double_excitations()
|
||||||
s.set_selection_pt2("delta_rho_one_point")
|
s.set_selection_pt2("delta_rho_one_point")
|
||||||
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
s = H_apply("pt2_mono_delta_rho")
|
s = H_apply("pt2_mono_delta_rho")
|
||||||
s.unset_double_excitations()
|
s.unset_double_excitations()
|
||||||
s.set_perturbation("delta_rho_one_point")
|
s.set_perturbation("delta_rho_one_point")
|
||||||
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
s = H_apply("select_mono_di_delta_rho")
|
s = H_apply("select_mono_di_delta_rho")
|
||||||
s.set_selection_pt2("delta_rho_one_point")
|
s.set_selection_pt2("delta_rho_one_point")
|
||||||
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
s = H_apply("pt2_mono_di_delta_rho")
|
s = H_apply("pt2_mono_di_delta_rho")
|
||||||
s.set_perturbation("delta_rho_one_point")
|
s.set_perturbation("delta_rho_one_point")
|
||||||
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
|
|
||||||
|
@ -64,9 +64,9 @@ program full_ci
|
|||||||
print *, 'N_states = ', N_states
|
print *, 'N_states = ', N_states
|
||||||
do k = 1, N_states
|
do k = 1, N_states
|
||||||
print*,'State ',k
|
print*,'State ',k
|
||||||
print *, 'PT2 = ', pt2
|
print *, 'PT2 = ', pt2(k)
|
||||||
print *, 'E = ', CI_energy
|
print *, 'E = ', CI_energy(k)
|
||||||
print *, 'E(before)+PT2 = ', E_CI_before+pt2
|
print *, 'E(before)+PT2 = ', E_CI_before(k)+pt2(k)
|
||||||
enddo
|
enddo
|
||||||
print *, '-----'
|
print *, '-----'
|
||||||
E_CI_before = CI_energy
|
E_CI_before = CI_energy
|
||||||
@ -84,9 +84,6 @@ program full_ci
|
|||||||
endif
|
endif
|
||||||
E_CI_before = CI_energy
|
E_CI_before = CI_energy
|
||||||
call ezfio_set_full_ci_energy(CI_energy)
|
call ezfio_set_full_ci_energy(CI_energy)
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
N_det = min(N_det_max,N_det)
|
N_det = min(N_det_max,N_det)
|
||||||
touch N_det psi_det psi_coef
|
touch N_det psi_det psi_coef
|
||||||
|
@ -67,9 +67,6 @@ program full_ci
|
|||||||
print *, '-----'
|
print *, '-----'
|
||||||
E_CI_before = CI_energy
|
E_CI_before = CI_energy
|
||||||
call ezfio_set_full_ci_energy(CI_energy)
|
call ezfio_set_full_ci_energy(CI_energy)
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
N_det = min(N_det_max,N_det)
|
N_det = min(N_det_max,N_det)
|
||||||
touch N_det psi_det psi_coef
|
touch N_det psi_det psi_coef
|
||||||
|
42
plugins/Full_CI/micro_pt2.irp.f
Normal file
42
plugins/Full_CI/micro_pt2.irp.f
Normal file
@ -0,0 +1,42 @@
|
|||||||
|
program micro_pt2
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Helper program to compute the PT2 in distributed mode.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
read_wf = .False.
|
||||||
|
SOFT_TOUCH read_wf
|
||||||
|
call provide_everything
|
||||||
|
call switch_qp_run_to_master
|
||||||
|
call run_wf
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine provide_everything
|
||||||
|
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine run_wf
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
|
||||||
|
print *, 'Getting wave function'
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket, 1)
|
||||||
|
call write_double(6,ci_energy,'Energy')
|
||||||
|
zmq_state = 'h_apply_fci_pt2'
|
||||||
|
|
||||||
|
call provide_everything
|
||||||
|
integer :: rc, i
|
||||||
|
|
||||||
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call H_apply_FCI_PT2_slave_tcp(i)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
|
||||||
|
end
|
@ -73,9 +73,6 @@ program var_pt2_ratio_run
|
|||||||
print *, 'N_det = ', N_det
|
print *, 'N_det = ', N_det
|
||||||
print *, 'E = ', CI_energy(1)
|
print *, 'E = ', CI_energy(1)
|
||||||
call ezfio_set_full_ci_energy(CI_energy)
|
call ezfio_set_full_ci_energy(CI_energy)
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
deallocate(pt2,norm_pert)
|
deallocate(pt2,norm_pert)
|
||||||
end
|
end
|
||||||
|
@ -63,9 +63,6 @@ program var_pt2_ratio_run
|
|||||||
print *, 'N_det = ', N_det
|
print *, 'N_det = ', N_det
|
||||||
print *, 'E = ', CI_energy(1)
|
print *, 'E = ', CI_energy(1)
|
||||||
call ezfio_set_full_ci_energy(CI_energy)
|
call ezfio_set_full_ci_energy(CI_energy)
|
||||||
if (abort_all) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
deallocate(pt2,norm_pert)
|
deallocate(pt2,norm_pert)
|
||||||
end
|
end
|
||||||
|
@ -30,11 +30,11 @@ subroutine damping_SCF
|
|||||||
|
|
||||||
call write_time(output_hartree_fock)
|
call write_time(output_hartree_fock)
|
||||||
|
|
||||||
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16, X, A4 )'), &
|
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
|
||||||
'====','================','================','================', '===='
|
'====','================','================','================', '===='
|
||||||
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16, X, A4 )'), &
|
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
|
||||||
' N ', 'Energy ', 'Energy diff ', 'Density diff ', 'Save'
|
' N ', 'Energy ', 'Energy diff ', 'Density diff ', 'Save'
|
||||||
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16, X, A4 )'), &
|
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
|
||||||
'====','================','================','================', '===='
|
'====','================','================','================', '===='
|
||||||
|
|
||||||
E = HF_energy + 1.d0
|
E = HF_energy + 1.d0
|
||||||
@ -58,7 +58,7 @@ subroutine damping_SCF
|
|||||||
save_char = ' '
|
save_char = ' '
|
||||||
endif
|
endif
|
||||||
|
|
||||||
write(output_hartree_fock,'(I4,X,F16.10, X, F16.10, X, F16.10, 3X, A )'), &
|
write(output_hartree_fock,'(I4,1X,F16.10, 1X, F16.10, 1X, F16.10, 3X, A )') &
|
||||||
k, E, delta_E, delta_D, save_char
|
k, E, delta_E, delta_D, save_char
|
||||||
|
|
||||||
D_alpha = HF_density_matrix_ao_alpha
|
D_alpha = HF_density_matrix_ao_alpha
|
||||||
@ -116,7 +116,7 @@ subroutine damping_SCF
|
|||||||
|
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16, X, A4 )'), '====','================','================','================', '===='
|
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') '====','================','================','================', '===='
|
||||||
write(output_hartree_fock,*)
|
write(output_hartree_fock,*)
|
||||||
|
|
||||||
if(.not.no_oa_or_av_opt)then
|
if(.not.no_oa_or_av_opt)then
|
||||||
|
@ -359,7 +359,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nin
|
|||||||
y, &
|
y, &
|
||||||
lambda &
|
lambda &
|
||||||
)
|
)
|
||||||
abort_here = abort_all
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -3,7 +3,6 @@ import perturbation
|
|||||||
END_SHELL
|
END_SHELL
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp)
|
subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -18,7 +17,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st)
|
double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st)
|
||||||
double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st)
|
double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st)
|
||||||
double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st)
|
double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st)
|
||||||
integer :: i,k, c_ref, ni, ex
|
integer :: i,k,l, c_ref, ni, ex
|
||||||
integer, external :: connected_to_ref
|
integer, external :: connected_to_ref
|
||||||
logical, external :: is_in_wavefunction
|
logical, external :: is_in_wavefunction
|
||||||
|
|
||||||
@ -59,6 +58,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
deallocate( minilist, minilist_gen, idx_minilist )
|
deallocate( minilist, minilist_gen, idx_minilist )
|
||||||
return
|
return
|
||||||
end if
|
end if
|
||||||
|
|
||||||
call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint)
|
call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint)
|
||||||
allocate( microlist(Nint,2,N_minilist*4), &
|
allocate( microlist(Nint,2,N_minilist*4), &
|
||||||
idx_microlist(N_minilist*4), &
|
idx_microlist(N_minilist*4), &
|
||||||
@ -87,8 +87,18 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
|
|
||||||
|
|
||||||
if(N_microlist(0) > 0) then
|
if(N_microlist(0) > 0) then
|
||||||
microlist_zero(:,:,1:N_microlist(0)) = microlist(:,:,1:N_microlist(0))
|
! TODO OLD
|
||||||
idx_microlist_zero(1:N_microlist(0)) = idx_microlist(1:N_microlist(0))
|
! microlist_zero(:,:,1:N_microlist(0)) = microlist(:,:,1:N_microlist(0))
|
||||||
|
! idx_microlist_zero(1:N_microlist(0)) = idx_microlist(1:N_microlist(0))
|
||||||
|
! TODO OLD
|
||||||
|
ASSERT (N_microlist(0) <= N_minilist)
|
||||||
|
do l=1,N_microlist(0)
|
||||||
|
do k=1,Nint
|
||||||
|
microlist_zero(k,1,l) = microlist(k,1,l)
|
||||||
|
microlist_zero(k,2,l) = microlist(k,2,l)
|
||||||
|
enddo
|
||||||
|
idx_microlist_zero(l) = idx_microlist(l)
|
||||||
|
enddo
|
||||||
end if
|
end if
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -100,7 +110,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
if(key_mask(1,1) /= 0) then
|
if(key_mask(1,1) /= 0) then
|
||||||
call getMobiles(buffer(:,:,i), key_mask, mobiles, Nint)
|
call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint)
|
||||||
if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then
|
if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then
|
||||||
smallerlist = mobiles(1)
|
smallerlist = mobiles(1)
|
||||||
else
|
else
|
||||||
@ -108,24 +118,44 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
end if
|
end if
|
||||||
|
|
||||||
if(N_microlist_gen(smallerlist) > 0) then
|
if(N_microlist_gen(smallerlist) > 0) then
|
||||||
if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,ptr_microlist_gen(smallerlist):ptr_microlist_gen(smallerlist+1)-1), Nint, N_microlist_gen(smallerlist))) then
|
! TODO OLD
|
||||||
|
! if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,ptr_microlist_gen(smallerlist):ptr_microlist_gen(smallerlist+1)-1), Nint, N_microlist_gen(smallerlist))) then
|
||||||
|
! TODO OLD
|
||||||
|
ASSERT (ptr_microlist_gen(smallerlist) <= N_minilist_gen*4)
|
||||||
|
if(is_connected_to(buffer(1,1,i), microlist_gen(1,1,ptr_microlist_gen(smallerlist)), Nint, N_microlist_gen(smallerlist))) then
|
||||||
cycle
|
cycle
|
||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
if(N_microlist_gen(0) > 0) then
|
if(N_microlist_gen(0) > 0) then
|
||||||
if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,1:ptr_microlist_gen(1)-1), Nint, N_microlist_gen(0))) then
|
! TODO OLD
|
||||||
|
! if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,1:ptr_microlist_gen(1)-1), Nint, N_microlist_gen(0))) then
|
||||||
|
! TODO OLD
|
||||||
|
ASSERT ( N_microlist_gen(0) <= buffer_size)
|
||||||
|
if(is_connected_to(buffer(1,1,i), microlist_gen(1,1,1), Nint, N_microlist_gen(0))) then
|
||||||
cycle
|
cycle
|
||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
|
|
||||||
if(N_microlist(smallerlist) > 0) then
|
if(N_microlist(smallerlist) > 0) then
|
||||||
microlist_zero(:,:,ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = microlist(:,:,ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1)
|
! TODO OLD
|
||||||
idx_microlist_zero(ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = idx_microlist(ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1)
|
! microlist_zero(:,:,ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = microlist(:,:,ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1)
|
||||||
! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0))
|
! idx_microlist_zero(ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = idx_microlist(ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1)
|
||||||
|
! TODO OLD
|
||||||
|
ASSERT ( ptr_microlist(1)+N_microlist(smallerlist)-1 <= N_minilist )
|
||||||
|
ASSERT ( ptr_microlist(smallerlist)+N_microlist(smallerlist)-1 <= N_minilist*4 )
|
||||||
|
do l=0, N_microlist(smallerlist)-1
|
||||||
|
do k=1,Nint
|
||||||
|
microlist_zero(k,1,ptr_microlist(1)+l) = microlist(k,1,ptr_microlist(smallerlist)+l)
|
||||||
|
microlist_zero(k,2,ptr_microlist(1)+l) = microlist(k,2,ptr_microlist(smallerlist)+l)
|
||||||
|
enddo
|
||||||
|
idx_microlist_zero(ptr_microlist(1)+l) = idx_microlist(ptr_microlist(smallerlist)+l)
|
||||||
|
enddo
|
||||||
end if
|
end if
|
||||||
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
|
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
|
||||||
c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist_zero(:,:,:),idx_microlist_zero(:),N_microlist(smallerlist)+N_microlist(0))
|
c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0), &
|
||||||
|
n_st,microlist_zero,idx_microlist_zero,N_microlist(smallerlist)+N_microlist(0))
|
||||||
else
|
else
|
||||||
|
ASSERT (N_minilist_gen <= N_det_generators)
|
||||||
if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then
|
if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then
|
||||||
cycle
|
cycle
|
||||||
end if
|
end if
|
||||||
@ -146,9 +176,9 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
deallocate( minilist, minilist_gen, idx_minilist )
|
deallocate( minilist, minilist_gen, idx_minilist, &
|
||||||
deallocate( microlist, idx_microlist, N_microlist,ptr_microlist )
|
microlist, idx_microlist, N_microlist,ptr_microlist, &
|
||||||
deallocate( microlist_gen, idx_microlist_gen,N_microlist_gen,ptr_microlist_gen )
|
microlist_gen, idx_microlist_gen,N_microlist_gen,ptr_microlist_gen )
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -61,100 +61,3 @@ END_PROVIDER
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), psi_selectors_ab, (N_int,2,psi_selectors_size) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, psi_selectors_coef_ab, (psi_selectors_size,N_states) ]
|
|
||||||
&BEGIN_PROVIDER [ integer, psi_selectors_next_ab, (2,psi_selectors_size) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Determinants on which we apply <i|H|j>.
|
|
||||||
! They are sorted by the 3 highest electrons in the alpha part,
|
|
||||||
! then by the 3 highest electrons in the beta part to accelerate
|
|
||||||
! the research of connected determinants.
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,k
|
|
||||||
integer, allocatable :: iorder(:)
|
|
||||||
integer*8, allocatable :: bit_tmp(:)
|
|
||||||
integer*8, external :: det_search_key
|
|
||||||
|
|
||||||
allocate ( iorder(N_det_selectors), bit_tmp(N_det_selectors) )
|
|
||||||
|
|
||||||
! Sort alpha dets
|
|
||||||
! ---------------
|
|
||||||
|
|
||||||
integer(bit_kind) :: det_tmp(N_int)
|
|
||||||
|
|
||||||
do i=1,N_det_selectors
|
|
||||||
iorder(i) = i
|
|
||||||
call int_of_3_highest_electrons(psi_selectors(1,1,i),bit_tmp(i),N_int)
|
|
||||||
enddo
|
|
||||||
call i8sort(bit_tmp,iorder,N_det_selectors)
|
|
||||||
!DIR$ IVDEP
|
|
||||||
do i=1,N_det_selectors
|
|
||||||
do j=1,N_int
|
|
||||||
psi_selectors_ab(j,1,i) = psi_selectors(j,1,iorder(i))
|
|
||||||
psi_selectors_ab(j,2,i) = psi_selectors(j,2,iorder(i))
|
|
||||||
enddo
|
|
||||||
do k=1,N_states
|
|
||||||
psi_coef_sorted_ab(i,k) = psi_selectors_coef(iorder(i),k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Find next alpha
|
|
||||||
! ---------------
|
|
||||||
|
|
||||||
integer :: next
|
|
||||||
|
|
||||||
next = N_det_selectors+1
|
|
||||||
psi_selectors_next_ab(1,N_det_selectors) = next
|
|
||||||
do i=N_det_selectors-1,1,-1
|
|
||||||
if (bit_tmp(i) /= bit_tmp(i+1)) then
|
|
||||||
next = i+1
|
|
||||||
endif
|
|
||||||
psi_selectors_next_ab(1,i) = next
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Sort beta dets
|
|
||||||
! --------------
|
|
||||||
|
|
||||||
integer :: istart, iend
|
|
||||||
integer(bit_kind), allocatable :: psi_selectors_ab_temp (:,:)
|
|
||||||
|
|
||||||
allocate ( psi_selectors_ab_temp (N_int,N_det_selectors) )
|
|
||||||
do i=1,N_det_selectors
|
|
||||||
do j=1,N_int
|
|
||||||
psi_selectors_ab_temp(j,i) = psi_selectors_ab(j,2,i)
|
|
||||||
enddo
|
|
||||||
iorder(i) = i
|
|
||||||
call int_of_3_highest_electrons(psi_selectors_ab_temp(1,i),bit_tmp(i),N_int)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
istart=1
|
|
||||||
do while ( istart<N_det_selectors )
|
|
||||||
|
|
||||||
iend = psi_selectors_next_ab(1,istart)
|
|
||||||
call i8sort(bit_tmp(istart),iorder(istart),iend-istart)
|
|
||||||
!DIR$ IVDEP
|
|
||||||
do i=istart,iend-1
|
|
||||||
do j=1,N_int
|
|
||||||
psi_selectors_ab(j,2,i) = psi_selectors_ab_temp(j,iorder(i))
|
|
||||||
enddo
|
|
||||||
do k=1,N_states
|
|
||||||
psi_coef_sorted_ab(i,k) = psi_coef(iorder(i),k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
next = iend
|
|
||||||
psi_selectors_next_ab(2,iend-1) = next
|
|
||||||
do i=iend-2,1,-1
|
|
||||||
if (bit_tmp(i) /= bit_tmp(i+1)) then
|
|
||||||
next = i+1
|
|
||||||
endif
|
|
||||||
psi_selectors_next_ab(2,i) = next
|
|
||||||
enddo
|
|
||||||
|
|
||||||
istart = iend
|
|
||||||
enddo
|
|
||||||
|
|
||||||
deallocate(iorder, bit_tmp, psi_selectors_ab_temp)
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
105
plugins/Selectors_full/zmq.irp.f
Normal file
105
plugins/Selectors_full/zmq.irp.f
Normal file
@ -0,0 +1,105 @@
|
|||||||
|
subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Put the wave function on the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: rc
|
||||||
|
character*(256) :: msg
|
||||||
|
|
||||||
|
write(msg,*) 'put_psi ', worker_id, N_states, N_det, psi_det_size, n_det_generators, n_det_selectors
|
||||||
|
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
|
||||||
|
if (rc /= len(trim(msg))) then
|
||||||
|
print *, 'f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)
|
||||||
|
if (rc /= N_int*2*N_det*bit_kind) then
|
||||||
|
print *, 'f77_zmq_send(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,0)
|
||||||
|
if (rc /= psi_det_size*N_states*8) then
|
||||||
|
print *, 'f77_zmq_send(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
|
if (msg(1:rc) /= 'put_psi_reply 1') then
|
||||||
|
print *, rc, trim(msg)
|
||||||
|
print *, 'Error in put_psi_reply'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Get the wave function from the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: rc
|
||||||
|
character*(64) :: msg
|
||||||
|
|
||||||
|
write(msg,*) 'get_psi ', worker_id
|
||||||
|
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
|
||||||
|
if (rc /= len(trim(msg))) then
|
||||||
|
print *, 'f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
|
if (msg(1:13) /= 'get_psi_reply') then
|
||||||
|
print *, rc, trim(msg)
|
||||||
|
print *, 'Error in get_psi_reply'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
integer :: N_states_read, N_det_read, psi_det_size_read
|
||||||
|
integer :: N_det_selectors_read, N_det_generators_read
|
||||||
|
read(msg(14:rc),*) rc, N_states_read, N_det_read, psi_det_size_read, &
|
||||||
|
N_det_selectors_read, N_det_generators_read
|
||||||
|
if (rc /= worker_id) then
|
||||||
|
print *, 'Wrong worker ID'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
N_states = N_states_read
|
||||||
|
N_det = N_det_read
|
||||||
|
psi_det_size = psi_det_size_read
|
||||||
|
TOUCH psi_det_size N_det N_states
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)
|
||||||
|
if (rc /= N_int*2*N_det*bit_kind) then
|
||||||
|
print *, 'f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,0)
|
||||||
|
if (rc /= psi_det_size*N_states*8) then
|
||||||
|
print *, '77_zmq_recv(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (N_det_generators_read > 0) then
|
||||||
|
N_det_generators = N_det_generators_read
|
||||||
|
endif
|
||||||
|
if (N_det_selectors_read > 0) then
|
||||||
|
N_det_selectors = N_det_selectors_read
|
||||||
|
endif
|
||||||
|
SOFT_TOUCH psi_det psi_coef N_det_selectors N_det_generators
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
@ -57,100 +57,3 @@ END_PROVIDER
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), psi_selectors_ab, (N_int,2,psi_selectors_size) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, psi_selectors_coef_ab, (psi_selectors_size,N_states) ]
|
|
||||||
&BEGIN_PROVIDER [ integer, psi_selectors_next_ab, (2,psi_selectors_size) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Determinants on which we apply <i|H|j>.
|
|
||||||
! They are sorted by the 3 highest electrons in the alpha part,
|
|
||||||
! then by the 3 highest electrons in the beta part to accelerate
|
|
||||||
! the research of connected determinants.
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,k
|
|
||||||
integer, allocatable :: iorder(:)
|
|
||||||
integer*8, allocatable :: bit_tmp(:)
|
|
||||||
integer*8, external :: det_search_key
|
|
||||||
|
|
||||||
allocate ( iorder(N_det_selectors), bit_tmp(N_det_selectors) )
|
|
||||||
|
|
||||||
! Sort alpha dets
|
|
||||||
! ---------------
|
|
||||||
|
|
||||||
integer(bit_kind) :: det_tmp(N_int)
|
|
||||||
|
|
||||||
do i=1,N_det_selectors
|
|
||||||
iorder(i) = i
|
|
||||||
call int_of_3_highest_electrons(psi_selectors(1,1,i),bit_tmp(i),N_int)
|
|
||||||
enddo
|
|
||||||
call i8sort(bit_tmp,iorder,N_det_selectors)
|
|
||||||
!DIR$ IVDEP
|
|
||||||
do i=1,N_det_selectors
|
|
||||||
do j=1,N_int
|
|
||||||
psi_selectors_ab(j,1,i) = psi_selectors(j,1,iorder(i))
|
|
||||||
psi_selectors_ab(j,2,i) = psi_selectors(j,2,iorder(i))
|
|
||||||
enddo
|
|
||||||
do k=1,N_states
|
|
||||||
psi_coef_sorted_ab(i,k) = psi_selectors_coef(iorder(i),k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Find next alpha
|
|
||||||
! ---------------
|
|
||||||
|
|
||||||
integer :: next
|
|
||||||
|
|
||||||
next = N_det_selectors+1
|
|
||||||
psi_selectors_next_ab(1,N_det_selectors) = next
|
|
||||||
do i=N_det_selectors-1,1,-1
|
|
||||||
if (bit_tmp(i) /= bit_tmp(i+1)) then
|
|
||||||
next = i+1
|
|
||||||
endif
|
|
||||||
psi_selectors_next_ab(1,i) = next
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Sort beta dets
|
|
||||||
! --------------
|
|
||||||
|
|
||||||
integer :: istart, iend
|
|
||||||
integer(bit_kind), allocatable :: psi_selectors_ab_temp (:,:)
|
|
||||||
|
|
||||||
allocate ( psi_selectors_ab_temp (N_int,N_det_selectors) )
|
|
||||||
do i=1,N_det_selectors
|
|
||||||
do j=1,N_int
|
|
||||||
psi_selectors_ab_temp(j,i) = psi_selectors_ab(j,2,i)
|
|
||||||
enddo
|
|
||||||
iorder(i) = i
|
|
||||||
call int_of_3_highest_electrons(psi_selectors_ab_temp(1,i),bit_tmp(i),N_int)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
istart=1
|
|
||||||
do while ( istart<N_det_selectors )
|
|
||||||
|
|
||||||
iend = psi_selectors_next_ab(1,istart)
|
|
||||||
call i8sort(bit_tmp(istart),iorder(istart),iend-istart)
|
|
||||||
!DIR$ IVDEP
|
|
||||||
do i=istart,iend-1
|
|
||||||
do j=1,N_int
|
|
||||||
psi_selectors_ab(j,2,i) = psi_selectors_ab_temp(j,iorder(i))
|
|
||||||
enddo
|
|
||||||
do k=1,N_states
|
|
||||||
psi_coef_sorted_ab(i,k) = psi_coef(iorder(i),k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
next = iend
|
|
||||||
psi_selectors_next_ab(2,iend-1) = next
|
|
||||||
do i=iend-2,1,-1
|
|
||||||
if (bit_tmp(i) /= bit_tmp(i+1)) then
|
|
||||||
next = i+1
|
|
||||||
endif
|
|
||||||
psi_selectors_next_ab(2,i) = next
|
|
||||||
enddo
|
|
||||||
|
|
||||||
istart = iend
|
|
||||||
enddo
|
|
||||||
|
|
||||||
deallocate(iorder, bit_tmp, psi_selectors_ab_temp)
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
@ -9,6 +9,7 @@ print "#QP -> QMCPACK"
|
|||||||
|
|
||||||
from ezfio import ezfio
|
from ezfio import ezfio
|
||||||
|
|
||||||
|
import os
|
||||||
import sys
|
import sys
|
||||||
ezfio_path = sys.argv[1]
|
ezfio_path = sys.argv[1]
|
||||||
|
|
||||||
@ -17,7 +18,15 @@ ezfio.set_file(ezfio_path)
|
|||||||
do_pseudo = ezfio.get_pseudo_do_pseudo()
|
do_pseudo = ezfio.get_pseudo_do_pseudo()
|
||||||
if do_pseudo:
|
if do_pseudo:
|
||||||
print "do_pseudo True"
|
print "do_pseudo True"
|
||||||
zcore = ezfio.get_pseudo_nucl_charge_remove()
|
from qp_path import QP_ROOT
|
||||||
|
|
||||||
|
l_ele_path = os.path.join(QP_ROOT,"data","list_element.txt")
|
||||||
|
with open(l_ele_path, "r") as f:
|
||||||
|
data_raw = f.read()
|
||||||
|
|
||||||
|
l_element_raw = data_raw.split("\n")
|
||||||
|
l_element = [element_raw.split() for element_raw in l_element_raw]
|
||||||
|
d_z = dict((abr, z) for (z, abr, ele) in l_element)
|
||||||
else:
|
else:
|
||||||
print "do_pseudo False"
|
print "do_pseudo False"
|
||||||
|
|
||||||
@ -68,11 +77,10 @@ print "nucl_num", len(l_label)
|
|||||||
print "Atomic coord in Bohr"
|
print "Atomic coord in Bohr"
|
||||||
|
|
||||||
for i, t in enumerate(zip(l_label, l_charge, l_coord_str)):
|
for i, t in enumerate(zip(l_label, l_charge, l_coord_str)):
|
||||||
try:
|
t_1 = d_z[t[0]] if do_pseudo else t[1]
|
||||||
l = (t[0], t[1] + zcore[i], t[2])
|
|
||||||
except NameError:
|
t_new = [t[0],t_1,t[2]]
|
||||||
l = t
|
print list_to_string(t_new)
|
||||||
print list_to_string(l)
|
|
||||||
|
|
||||||
#
|
#
|
||||||
# Call externet process to get the sysmetry
|
# Call externet process to get the sysmetry
|
||||||
@ -83,7 +91,7 @@ process = subprocess.Popen(
|
|||||||
stdout=subprocess.PIPE)
|
stdout=subprocess.PIPE)
|
||||||
out, err = process.communicate()
|
out, err = process.communicate()
|
||||||
|
|
||||||
basis_raw, sym_raw, _= out.split("\n\n\n")
|
basis_raw, sym_raw, _ , det_raw, _ = out.split("\n\n\n")
|
||||||
|
|
||||||
# _ __
|
# _ __
|
||||||
# |_) _. _ o _ (_ _ _|_
|
# |_) _. _ o _ (_ _ _|_
|
||||||
@ -248,7 +256,7 @@ def print_mo_coef(mo_coef_block, l_l_sym):
|
|||||||
i_a = int(l[1]) - 1
|
i_a = int(l[1]) - 1
|
||||||
sym = l[2]
|
sym = l[2]
|
||||||
|
|
||||||
print l_label[i_a], sym, " ".join('{: 3.8f}'.format(i)
|
print l_label[i_a], sym, " ".join('{0: 3.8f}'.format(i)
|
||||||
for i in a[i])
|
for i in a[i])
|
||||||
|
|
||||||
if i_block != nb_block - 1:
|
if i_block != nb_block - 1:
|
||||||
@ -306,7 +314,7 @@ if do_pseudo:
|
|||||||
l_str.append(l_dump)
|
l_str.append(l_dump)
|
||||||
|
|
||||||
str_ = "PARAMETERS FOR {0} ON ATOM {1} WITH ZCORE {2} AND LMAX {3} ARE"
|
str_ = "PARAMETERS FOR {0} ON ATOM {1} WITH ZCORE {2} AND LMAX {3} ARE"
|
||||||
print str_.format(a, i + 1, int(zcore[i]), int(len(l_str) - 1))
|
print str_.format(a, i + 1, int(d_z[a])-int(l_charge[i]), int(len(l_str) - 1))
|
||||||
|
|
||||||
for i, l in enumerate(l_str):
|
for i, l in enumerate(l_str):
|
||||||
str_ = "FOR L= {0} COEFF N ZETA"
|
str_ = "FOR L= {0} COEFF N ZETA"
|
||||||
@ -315,7 +323,7 @@ if do_pseudo:
|
|||||||
print " ", ii + 1, ll
|
print " ", ii + 1, ll
|
||||||
|
|
||||||
str_ = "THE ECP RUN REMOVES {0} CORE ELECTRONS, AND THE SAME NUMBER OF PROTONS."
|
str_ = "THE ECP RUN REMOVES {0} CORE ELECTRONS, AND THE SAME NUMBER OF PROTONS."
|
||||||
print str_.format(sum(zcore))
|
print str_.format(sum([int(d_z[a])-int(l_charge[i]) for i,a in enumerate(l_label)]))
|
||||||
print "END_PSEUDO"
|
print "END_PSEUDO"
|
||||||
|
|
||||||
# _
|
# _
|
||||||
@ -329,31 +337,26 @@ print "mo_num", mo_num
|
|||||||
print "det_num", n_det
|
print "det_num", n_det
|
||||||
print ""
|
print ""
|
||||||
|
|
||||||
psi_det = ezfio.get_determinants_psi_det()
|
|
||||||
psi_coef = ezfio.get_determinants_psi_coef()[0]
|
|
||||||
|
|
||||||
for c, (l_det_bit_alpha, l_det_bit_beta) in zip(psi_coef, psi_det):
|
|
||||||
print c
|
|
||||||
|
|
||||||
bin_det = ""
|
token = "Determinants ::"
|
||||||
for i,int_det in enumerate(l_det_bit_alpha):
|
pos = det_raw.rfind(token) + len(token)
|
||||||
bin_det_raw = "{0:b}".format(int_det)[::-1]
|
|
||||||
if mo_num - 64*(i+1) > 0:
|
|
||||||
bin_det += bin_det_raw + "0" * (64*(i+1) - len(bin_det_raw))
|
|
||||||
else:
|
|
||||||
bin_det += bin_det_raw + "0" * (mo_num-64*i - len(bin_det_raw))
|
|
||||||
|
|
||||||
print bin_det
|
det_without_header = det_raw[pos+2::]
|
||||||
|
|
||||||
bin_det = ""
|
d_rep={"+":"1","-":"0"}
|
||||||
for i,int_det in enumerate(l_det_bit_beta):
|
|
||||||
bin_det_raw = "{0:b}".format(int_det)[::-1]
|
|
||||||
if mo_num - 64*(i+1) > 0:
|
|
||||||
bin_det += bin_det_raw + "0" * (64*(i+1) - len(bin_det_raw))
|
|
||||||
else:
|
|
||||||
bin_det += bin_det_raw + "0" * (mo_num-64*i - len(bin_det_raw))
|
|
||||||
|
|
||||||
print bin_det
|
det_without_header = det_raw[pos+2::]
|
||||||
print ""
|
|
||||||
|
for line_raw in det_without_header.split("\n"):
|
||||||
|
line = line_raw
|
||||||
|
|
||||||
|
if line_raw:
|
||||||
|
try:
|
||||||
|
float(line)
|
||||||
|
except ValueError:
|
||||||
|
line= "".join([d_rep[x] if x in d_rep else x for x in line_raw])
|
||||||
|
|
||||||
|
print line.strip()
|
||||||
|
|
||||||
print "END_DET"
|
print "END_DET"
|
||||||
|
@ -14,6 +14,12 @@ program qmcpack
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
call ezfio_set_ao_basis_ao_coef(ao_coef)
|
call ezfio_set_ao_basis_ao_coef(ao_coef)
|
||||||
|
do j=1,mo_tot_num
|
||||||
|
do i=1,ao_num
|
||||||
|
mo_coef(i,j) *= 1.d0/ao_coef_normalization_factor(i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call save_mos
|
||||||
call system('rm '//trim(ezfio_filename)//'/mo_basis/ao_md5')
|
call system('rm '//trim(ezfio_filename)//'/mo_basis/ao_md5')
|
||||||
call system('$QP_ROOT/src/qmcpack/qp_convert_qmcpack_to_ezfio.py '//trim(ezfio_filename))
|
call system('$QP_ROOT/src/qmcpack/qp_convert_qmcpack_to_ezfio.py '//trim(ezfio_filename))
|
||||||
|
|
||||||
|
@ -126,6 +126,7 @@ def get_type_dict():
|
|||||||
fancy_type['integer*8'] = Type(None, "int", "integer*8")
|
fancy_type['integer*8'] = Type(None, "int", "integer*8")
|
||||||
|
|
||||||
fancy_type['int'] = Type(None, "int", "integer")
|
fancy_type['int'] = Type(None, "int", "integer")
|
||||||
|
fancy_type['int64'] = Type(None, "int64", "integer*8")
|
||||||
|
|
||||||
fancy_type['float'] = Type(None, "float", "double precision")
|
fancy_type['float'] = Type(None, "float", "double precision")
|
||||||
fancy_type['double precision'] = Type(None, "float", "double precision")
|
fancy_type['double precision'] = Type(None, "float", "double precision")
|
||||||
@ -143,6 +144,7 @@ def get_type_dict():
|
|||||||
|
|
||||||
# Dict to change ocaml LowLevel type into FortranLowLevel type
|
# Dict to change ocaml LowLevel type into FortranLowLevel type
|
||||||
ocaml_to_fortran = {"int": "integer",
|
ocaml_to_fortran = {"int": "integer",
|
||||||
|
"int64": "integer*8",
|
||||||
"float": "double precision",
|
"float": "double precision",
|
||||||
"logical": "logical",
|
"logical": "logical",
|
||||||
"string": "character*32"}
|
"string": "character*32"}
|
||||||
|
@ -75,7 +75,7 @@ let get s =
|
|||||||
| Ao_basis ->
|
| Ao_basis ->
|
||||||
f Ao_basis.(read, to_rst)
|
f Ao_basis.(read, to_rst)
|
||||||
| Determinants_by_hand ->
|
| Determinants_by_hand ->
|
||||||
f Determinants_by_hand.(read, to_rst)
|
f Determinants_by_hand.(read_maybe, to_rst)
|
||||||
{section_to_rst}
|
{section_to_rst}
|
||||||
end
|
end
|
||||||
with
|
with
|
||||||
|
@ -1,24 +1,12 @@
|
|||||||
#!/usr/bin/env python
|
#!/usr/bin/env python
|
||||||
|
|
||||||
import os
|
import os
|
||||||
file = open(os.environ["QP_ROOT"]+'/src/Determinants/H_apply.template.f','r')
|
|
||||||
template = file.read()
|
|
||||||
file.close()
|
|
||||||
|
|
||||||
keywords = """
|
keywords = """
|
||||||
subroutine
|
check_double_excitation
|
||||||
parameters
|
copy_buffer
|
||||||
params_main
|
|
||||||
initialization
|
|
||||||
declarations
|
declarations
|
||||||
decls_main
|
decls_main
|
||||||
keys_work
|
|
||||||
copy_buffer
|
|
||||||
finalization
|
|
||||||
generate_psi_guess
|
|
||||||
init_thread
|
|
||||||
printout_now
|
|
||||||
printout_always
|
|
||||||
deinit_thread
|
deinit_thread
|
||||||
skip
|
skip
|
||||||
init_main
|
init_main
|
||||||
@ -37,15 +25,46 @@ filter_only_1h2p_double
|
|||||||
filter_only_2h2p_single
|
filter_only_2h2p_single
|
||||||
filter_only_2h2p_double
|
filter_only_2h2p_double
|
||||||
filterhole
|
filterhole
|
||||||
|
filter_integrals
|
||||||
|
filter_only_1h1p_double
|
||||||
|
filter_only_1h1p_single
|
||||||
filterparticle
|
filterparticle
|
||||||
do_double_excitations
|
|
||||||
check_double_excitation
|
|
||||||
filter_vvvv_excitation
|
filter_vvvv_excitation
|
||||||
|
finalization
|
||||||
|
generate_psi_guess
|
||||||
|
initialization
|
||||||
|
init_main
|
||||||
|
init_thread
|
||||||
|
keys_work
|
||||||
|
omp_barrier
|
||||||
|
omp_do
|
||||||
|
omp_enddo
|
||||||
|
omp_end_master
|
||||||
|
omp_end_parallel
|
||||||
|
omp_master
|
||||||
|
omp_parallel
|
||||||
|
only_2p_double
|
||||||
|
only_2p_single
|
||||||
|
parameters
|
||||||
|
params_main
|
||||||
|
printout_always
|
||||||
|
printout_now
|
||||||
|
skip
|
||||||
|
subroutine
|
||||||
""".split()
|
""".split()
|
||||||
|
|
||||||
class H_apply(object):
|
class H_apply(object):
|
||||||
|
|
||||||
|
def read_template(self):
|
||||||
|
file = open(os.environ["QP_ROOT"]+'/src/Determinants/H_apply.template.f','r')
|
||||||
|
self.template = file.read()
|
||||||
|
file.close()
|
||||||
|
file = open(os.environ["QP_ROOT"]+'/src/Determinants/H_apply_nozmq.template.f','r')
|
||||||
|
self.template += file.read()
|
||||||
|
file.close()
|
||||||
|
|
||||||
def __init__(self,sub,SingleRef=False,do_mono_exc=True, do_double_exc=True):
|
def __init__(self,sub,SingleRef=False,do_mono_exc=True, do_double_exc=True):
|
||||||
|
self.read_template()
|
||||||
s = {}
|
s = {}
|
||||||
for k in keywords:
|
for k in keywords:
|
||||||
s[k] = ""
|
s[k] = ""
|
||||||
@ -129,7 +148,7 @@ class H_apply(object):
|
|||||||
return self.data[key]
|
return self.data[key]
|
||||||
|
|
||||||
def __repr__(self):
|
def __repr__(self):
|
||||||
buffer = template
|
buffer = self.template
|
||||||
for key,value in self.data.items():
|
for key,value in self.data.items():
|
||||||
buffer = buffer.replace('$'+key, value)
|
buffer = buffer.replace('$'+key, value)
|
||||||
return buffer
|
return buffer
|
||||||
@ -181,11 +200,11 @@ class H_apply(object):
|
|||||||
def filter_only_2p(self):
|
def filter_only_2p(self):
|
||||||
self["only_2p_single"] = """
|
self["only_2p_single"] = """
|
||||||
! ! DIR$ FORCEINLINE
|
! ! DIR$ FORCEINLINE
|
||||||
if (is_a_2p(hole).eq..False.) cycle
|
if (.not. is_a_2p(hole)) cycle
|
||||||
"""
|
"""
|
||||||
self["only_2p_double"] = """
|
self["only_2p_double"] = """
|
||||||
! ! DIR$ FORCEINLINE
|
! ! DIR$ FORCEINLINE
|
||||||
if (is_a_2p(key).eq..False.) cycle
|
if (.not. is_a_2p(key)) cycle
|
||||||
"""
|
"""
|
||||||
|
|
||||||
|
|
||||||
@ -281,11 +300,7 @@ class H_apply(object):
|
|||||||
! if(check_double_excitation)then
|
! if(check_double_excitation)then
|
||||||
call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
|
call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
|
||||||
sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp)
|
sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp)
|
||||||
! else
|
"""%(pert)
|
||||||
! call perturb_buffer_by_mono_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
|
|
||||||
! sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp)
|
|
||||||
! endif
|
|
||||||
"""%(pert,pert)
|
|
||||||
else:
|
else:
|
||||||
self.data["keys_work"] = """
|
self.data["keys_work"] = """
|
||||||
call perturb_buffer_by_mono_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
|
call perturb_buffer_by_mono_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
|
||||||
@ -314,9 +329,9 @@ class H_apply(object):
|
|||||||
delta_pt2(k) = 0.d0
|
delta_pt2(k) = 0.d0
|
||||||
pt2_old(k) = 0.d0
|
pt2_old(k) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
write(output_determinants,'(A12, X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
|
write(output_determinants,'(A12, 1X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
|
||||||
'N_generators', 'Norm', 'Delta PT2', 'PT2', 'Est. PT2', 'secs'
|
'N_generators', 'Norm', 'Delta PT2', 'PT2', 'Est. PT2', 'secs'
|
||||||
write(output_determinants,'(A12, X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
|
write(output_determinants,'(A12, 1X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
|
||||||
'============', '========', '=========', '=========', '=========', &
|
'============', '========', '=========', '=========', '=========', &
|
||||||
'========='
|
'========='
|
||||||
"""
|
"""
|
||||||
@ -335,7 +350,6 @@ class H_apply(object):
|
|||||||
wall_1-wall_0
|
wall_1-wall_0
|
||||||
pt2_old(k) = pt2(k)
|
pt2_old(k) = pt2(k)
|
||||||
enddo
|
enddo
|
||||||
progress_value = norm_psi(1)
|
|
||||||
"""
|
"""
|
||||||
self.data["omp_parallel"] += """&
|
self.data["omp_parallel"] += """&
|
||||||
!$OMP SHARED(N_st) PRIVATE(e_2_pert_buffer,coef_pert_buffer) &
|
!$OMP SHARED(N_st) PRIVATE(e_2_pert_buffer,coef_pert_buffer) &
|
||||||
@ -379,9 +393,7 @@ class H_apply(object):
|
|||||||
!$ call omp_set_lock(lck)
|
!$ call omp_set_lock(lck)
|
||||||
do k=1,N_st
|
do k=1,N_st
|
||||||
norm_psi(k) = norm_psi(k) + psi_coef_generators(i_generator,k)*psi_coef_generators(i_generator,k)
|
norm_psi(k) = norm_psi(k) + psi_coef_generators(i_generator,k)*psi_coef_generators(i_generator,k)
|
||||||
! delta_pt2(k) = 0.d0
|
|
||||||
pt2_old(k) = 0.d0
|
pt2_old(k) = 0.d0
|
||||||
! pt2(k) = select_max(i_generator)
|
|
||||||
enddo
|
enddo
|
||||||
!$ call omp_unset_lock(lck)
|
!$ call omp_unset_lock(lck)
|
||||||
cycle
|
cycle
|
||||||
@ -391,3 +403,50 @@ class H_apply(object):
|
|||||||
"""
|
"""
|
||||||
|
|
||||||
|
|
||||||
|
def unset_openmp(self):
|
||||||
|
for k in keywords:
|
||||||
|
if k.startswith("omp_"):
|
||||||
|
self[k] = ""
|
||||||
|
|
||||||
|
|
||||||
|
class H_apply_zmq(H_apply):
|
||||||
|
|
||||||
|
def read_template(self):
|
||||||
|
file = open(os.environ["QP_ROOT"]+'/src/Determinants/H_apply.template.f','r')
|
||||||
|
self.template = file.read()
|
||||||
|
file.close()
|
||||||
|
file = open(os.environ["QP_ROOT"]+'/src/Determinants/H_apply_zmq.template.f','r')
|
||||||
|
self.template += file.read()
|
||||||
|
file.close()
|
||||||
|
|
||||||
|
def set_perturbation(self,pert):
|
||||||
|
H_apply.set_perturbation(self,pert)
|
||||||
|
self.data["printout_now"] = ""
|
||||||
|
self.data["printout_always"] = ""
|
||||||
|
self.data["decls_main"] = """ integer, intent(in) :: N_st
|
||||||
|
double precision, intent(inout):: pt2(N_st)
|
||||||
|
double precision, intent(inout):: norm_pert(N_st)
|
||||||
|
double precision, intent(inout):: H_pert_diag(N_st)
|
||||||
|
double precision :: delta_pt2(N_st), norm_psi(N_st), pt2_old(N_st)
|
||||||
|
PROVIDE N_det_generators
|
||||||
|
do k=1,N_st
|
||||||
|
pt2(k) = 0.d0
|
||||||
|
norm_pert(k) = 0.d0
|
||||||
|
H_pert_diag(k) = 0.d0
|
||||||
|
norm_psi(k) = 0.d0
|
||||||
|
enddo
|
||||||
|
"""
|
||||||
|
|
||||||
|
def set_selection_pt2(self,pert):
|
||||||
|
H_apply.set_selection_pt2(self,pert)
|
||||||
|
self.data["skip"] = """
|
||||||
|
if (i_generator < size_select_max) then
|
||||||
|
if (select_max(i_generator) < selection_criterion_min*selection_criterion_factor) then
|
||||||
|
do k=1,N_st
|
||||||
|
pt2(k) = select_max(i_generator)
|
||||||
|
enddo
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
select_max(i_generator) = 0.d0
|
||||||
|
endif
|
||||||
|
"""
|
||||||
|
@ -59,7 +59,8 @@ def save_new_module(path, l_child):
|
|||||||
|
|
||||||
with open(os.path.join(path, "%s.main.irp.f"%(module_name) ), "w") as f:
|
with open(os.path.join(path, "%s.main.irp.f"%(module_name) ), "w") as f:
|
||||||
f.write("program {0}".format(module_name) )
|
f.write("program {0}".format(module_name) )
|
||||||
f.write(""" implicit none
|
f.write("""
|
||||||
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! TODO
|
! TODO
|
||||||
END_DOC
|
END_DOC
|
||||||
|
@ -50,9 +50,6 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
ao_coef_normalization_factor(i) = 1.d0/sqrt(norm)
|
ao_coef_normalization_factor(i) = 1.d0/sqrt(norm)
|
||||||
do j=1,ao_prim_num(i)
|
|
||||||
ao_coef_normalized(i,j) = ao_coef_normalized(i,j) * ao_coef_normalization_factor(i)
|
|
||||||
enddo
|
|
||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -9,7 +9,7 @@ BEGIN_PROVIDER [ integer, N_int ]
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask, (N_int,4) ]
|
BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask, (N_int) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Bitmask to include all possible MOs
|
! Bitmask to include all possible MOs
|
||||||
@ -18,26 +18,23 @@ BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask, (N_int,4) ]
|
|||||||
integer :: i,j,n
|
integer :: i,j,n
|
||||||
n = mod(mo_tot_num-1,bit_kind_size)+1
|
n = mod(mo_tot_num-1,bit_kind_size)+1
|
||||||
full_ijkl_bitmask = 0_bit_kind
|
full_ijkl_bitmask = 0_bit_kind
|
||||||
do j=1,4
|
|
||||||
do i=1,N_int-1
|
do i=1,N_int-1
|
||||||
full_ijkl_bitmask(i,j) = not(0_bit_kind)
|
full_ijkl_bitmask(i) = not(0_bit_kind)
|
||||||
enddo
|
enddo
|
||||||
do i=1,n
|
do i=1,n
|
||||||
full_ijkl_bitmask(N_int,j) = ibset(full_ijkl_bitmask(N_int,j),i-1)
|
full_ijkl_bitmask(N_int) = ibset(full_ijkl_bitmask(N_int),i-1)
|
||||||
enddo
|
|
||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask_4, (N_int,4) ]
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), cis_ijkl_bitmask, (N_int,4) ]
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
integer :: i
|
||||||
! Bitmask to include all possible single excitations from Hartree-Fock
|
do i=1,N_int
|
||||||
END_DOC
|
full_ijkl_bitmask_4(i,1) = full_ijkl_bitmask(i)
|
||||||
|
full_ijkl_bitmask_4(i,2) = full_ijkl_bitmask(i)
|
||||||
integer :: i,j,n
|
full_ijkl_bitmask_4(i,3) = full_ijkl_bitmask(i)
|
||||||
cis_ijkl_bitmask = full_ijkl_bitmask
|
full_ijkl_bitmask_4(i,4) = full_ijkl_bitmask(i)
|
||||||
cis_ijkl_bitmask(:,1) = HF_bitmask(:,1)
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
@ -162,12 +159,14 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_gen
|
|||||||
integer :: k, ispin
|
integer :: k, ispin
|
||||||
do k=1,N_generators_bitmask
|
do k=1,N_generators_bitmask
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
generators_bitmask_restart(:,ispin,s_hole ,k) = full_ijkl_bitmask(:,d_hole1)
|
do i=1,N_int
|
||||||
generators_bitmask_restart(:,ispin,s_part ,k) = full_ijkl_bitmask(:,d_part1)
|
generators_bitmask_restart(i,ispin,s_hole ,k) = full_ijkl_bitmask(i)
|
||||||
generators_bitmask_restart(:,ispin,d_hole1,k) = full_ijkl_bitmask(:,d_hole1)
|
generators_bitmask_restart(i,ispin,s_part ,k) = full_ijkl_bitmask(i)
|
||||||
generators_bitmask_restart(:,ispin,d_part1,k) = full_ijkl_bitmask(:,d_part1)
|
generators_bitmask_restart(i,ispin,d_hole1,k) = full_ijkl_bitmask(i)
|
||||||
generators_bitmask_restart(:,ispin,d_hole2,k) = full_ijkl_bitmask(:,d_hole2)
|
generators_bitmask_restart(i,ispin,d_part1,k) = full_ijkl_bitmask(i)
|
||||||
generators_bitmask_restart(:,ispin,d_part2,k) = full_ijkl_bitmask(:,d_part2)
|
generators_bitmask_restart(i,ispin,d_hole2,k) = full_ijkl_bitmask(i)
|
||||||
|
generators_bitmask_restart(i,ispin,d_part2,k) = full_ijkl_bitmask(i)
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
@ -176,12 +175,12 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_gen
|
|||||||
do k=1,N_generators_bitmask
|
do k=1,N_generators_bitmask
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
do i=1,N_int
|
do i=1,N_int
|
||||||
generators_bitmask_restart(i,ispin,s_hole ,k) = iand(full_ijkl_bitmask(i,d_hole1),generators_bitmask_restart(i,ispin,s_hole,k) )
|
generators_bitmask_restart(i,ispin,s_hole ,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,s_hole,k) )
|
||||||
generators_bitmask_restart(i,ispin,s_part ,k) = iand(full_ijkl_bitmask(i,d_part1),generators_bitmask_restart(i,ispin,s_part,k) )
|
generators_bitmask_restart(i,ispin,s_part ,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,s_part,k) )
|
||||||
generators_bitmask_restart(i,ispin,d_hole1,k) = iand(full_ijkl_bitmask(i,d_hole1),generators_bitmask_restart(i,ispin,d_hole1,k) )
|
generators_bitmask_restart(i,ispin,d_hole1,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,d_hole1,k) )
|
||||||
generators_bitmask_restart(i,ispin,d_part1,k) = iand(full_ijkl_bitmask(i,d_part1),generators_bitmask_restart(i,ispin,d_part1,k) )
|
generators_bitmask_restart(i,ispin,d_part1,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,d_part1,k) )
|
||||||
generators_bitmask_restart(i,ispin,d_hole2,k) = iand(full_ijkl_bitmask(i,d_hole2),generators_bitmask_restart(i,ispin,d_hole2,k) )
|
generators_bitmask_restart(i,ispin,d_hole2,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,d_hole2,k) )
|
||||||
generators_bitmask_restart(i,ispin,d_part2,k) = iand(full_ijkl_bitmask(i,d_part2),generators_bitmask_restart(i,ispin,d_part2,k) )
|
generators_bitmask_restart(i,ispin,d_part2,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,d_part2,k) )
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -219,12 +218,14 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_
|
|||||||
integer :: k, ispin, i
|
integer :: k, ispin, i
|
||||||
do k=1,N_generators_bitmask
|
do k=1,N_generators_bitmask
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
generators_bitmask(:,ispin,s_hole ,k) = full_ijkl_bitmask(:,d_hole1)
|
do i=1,N_int
|
||||||
generators_bitmask(:,ispin,s_part ,k) = full_ijkl_bitmask(:,d_part1)
|
generators_bitmask(i,ispin,s_hole ,k) = full_ijkl_bitmask(i)
|
||||||
generators_bitmask(:,ispin,d_hole1,k) = full_ijkl_bitmask(:,d_hole1)
|
generators_bitmask(i,ispin,s_part ,k) = full_ijkl_bitmask(i)
|
||||||
generators_bitmask(:,ispin,d_part1,k) = full_ijkl_bitmask(:,d_part1)
|
generators_bitmask(i,ispin,d_hole1,k) = full_ijkl_bitmask(i)
|
||||||
generators_bitmask(:,ispin,d_hole2,k) = full_ijkl_bitmask(:,d_hole2)
|
generators_bitmask(i,ispin,d_part1,k) = full_ijkl_bitmask(i)
|
||||||
generators_bitmask(:,ispin,d_part2,k) = full_ijkl_bitmask(:,d_part2)
|
generators_bitmask(i,ispin,d_hole2,k) = full_ijkl_bitmask(i)
|
||||||
|
generators_bitmask(i,ispin,d_part2,k) = full_ijkl_bitmask(i)
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
@ -232,12 +233,12 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_
|
|||||||
do k=1,N_generators_bitmask
|
do k=1,N_generators_bitmask
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
do i=1,N_int
|
do i=1,N_int
|
||||||
generators_bitmask(i,ispin,s_hole ,k) = iand(full_ijkl_bitmask(i,d_hole1),generators_bitmask(i,ispin,s_hole,k) )
|
generators_bitmask(i,ispin,s_hole ,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,s_hole,k) )
|
||||||
generators_bitmask(i,ispin,s_part ,k) = iand(full_ijkl_bitmask(i,d_part1),generators_bitmask(i,ispin,s_part,k) )
|
generators_bitmask(i,ispin,s_part ,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,s_part,k) )
|
||||||
generators_bitmask(i,ispin,d_hole1,k) = iand(full_ijkl_bitmask(i,d_hole1),generators_bitmask(i,ispin,d_hole1,k) )
|
generators_bitmask(i,ispin,d_hole1,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,d_hole1,k) )
|
||||||
generators_bitmask(i,ispin,d_part1,k) = iand(full_ijkl_bitmask(i,d_part1),generators_bitmask(i,ispin,d_part1,k) )
|
generators_bitmask(i,ispin,d_part1,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,d_part1,k) )
|
||||||
generators_bitmask(i,ispin,d_hole2,k) = iand(full_ijkl_bitmask(i,d_hole2),generators_bitmask(i,ispin,d_hole2,k) )
|
generators_bitmask(i,ispin,d_hole2,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,d_hole2,k) )
|
||||||
generators_bitmask(i,ispin,d_part2,k) = iand(full_ijkl_bitmask(i,d_part2),generators_bitmask(i,ispin,d_part2,k) )
|
generators_bitmask(i,ispin,d_part2,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,d_part2,k) )
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -289,9 +290,12 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ]
|
|||||||
call ezfio_get_bitmasks_cas(cas_bitmask)
|
call ezfio_get_bitmasks_cas(cas_bitmask)
|
||||||
print*,'---------------------'
|
print*,'---------------------'
|
||||||
else
|
else
|
||||||
if(N_generators_bitmask_restart == 1)then
|
if(N_generators_bitmask == 1)then
|
||||||
do i=1,N_cas_bitmask
|
do j=1, N_cas_bitmask
|
||||||
cas_bitmask(:,:,i) = iand(not(HF_bitmask(:,:)),full_ijkl_bitmask(:,:))
|
do i=1, N_int
|
||||||
|
cas_bitmask(i,1,j) = iand(not(HF_bitmask(i,1)),full_ijkl_bitmask(i))
|
||||||
|
cas_bitmask(i,2,j) = iand(not(HF_bitmask(i,2)),full_ijkl_bitmask(i))
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
else
|
else
|
||||||
i_part = 2
|
i_part = 2
|
||||||
@ -307,7 +311,7 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ]
|
|||||||
do i=1,N_cas_bitmask
|
do i=1,N_cas_bitmask
|
||||||
do j = 1, N_cas_bitmask
|
do j = 1, N_cas_bitmask
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
cas_bitmask(k,j,i) = iand(cas_bitmask(k,j,i),full_ijkl_bitmask(k,j))
|
cas_bitmask(k,j,i) = iand(cas_bitmask(k,j,i),full_ijkl_bitmask(k))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
@ -263,6 +263,7 @@ subroutine remove_duplicates_in_psi_det(found_duplicates)
|
|||||||
deallocate (duplicate,bit_tmp)
|
deallocate (duplicate,bit_tmp)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
|
subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
@ -306,3 +307,116 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Push PT2 calculation to the collector
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
|
integer, intent(in) :: N_st
|
||||||
|
double precision, intent(in) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st)
|
||||||
|
integer, intent(in) :: task_id
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, 1, 4, ZMQ_SNDMORE)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, 1, 4, ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, pt2, 8*N_st, ZMQ_SNDMORE)
|
||||||
|
if (rc /= 8*N_st) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, pt2, 8*N_st, ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, norm_pert, 8*N_st, ZMQ_SNDMORE)
|
||||||
|
if (rc /= 8*N_st) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, norm_pert, 8*N_st, ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, H_pert_diag, 8*N_st, ZMQ_SNDMORE)
|
||||||
|
if (rc /= 8*N_st) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, H_pert_diag, 8*N_st, ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, task_id, 4, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Activate if zmq_socket_push is a REQ
|
||||||
|
! integer :: idummy
|
||||||
|
! rc = f77_zmq_recv( zmq_socket_push, idummy, 4, 0)
|
||||||
|
! if (rc /= 4) then
|
||||||
|
! print *, irp_here, 'f77_zmq_send( zmq_socket_push, idummy, 4, 0)'
|
||||||
|
! stop 'error'
|
||||||
|
! endif
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Pull PT2 calculation in the collector
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
||||||
|
integer, intent(in) :: N_st
|
||||||
|
double precision, intent(out) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st)
|
||||||
|
integer, intent(out) :: task_id
|
||||||
|
integer, intent(out) :: n
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
n=0
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, n, 4, 0)
|
||||||
|
if (rc == -1) then
|
||||||
|
n=9
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, n, 4, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (n > 0) then
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, pt2(1), 8*N_st, 0)
|
||||||
|
if (rc /= 8*N_st) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, pt2(1,1) , 8*N_st, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, norm_pert(1), 8*N_st, 0)
|
||||||
|
if (rc /= 8*N_st) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, norm_pert(1,1), 8*N_st)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, H_pert_diag(1), 8*N_st, 0)
|
||||||
|
if (rc /= 8*N_st) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, H_pert_diag(1,1), 8*N_st)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Activate if zmq_socket_pull is a REP
|
||||||
|
! rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
|
||||||
|
! if (rc /= 4) then
|
||||||
|
! print *, irp_here, 'f77_zmq_send( zmq_socket_pull, 0, 4, 0)'
|
||||||
|
! stop 'error'
|
||||||
|
! endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,13 +1,12 @@
|
|||||||
|
|
||||||
|
|
||||||
subroutine $subroutine_diexc(key_in, key_prev, hole_1,particl_1, hole_2, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters )
|
subroutine $subroutine_diexc(key_in, key_prev, hole_1,particl_1, hole_2, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters )
|
||||||
|
implicit none
|
||||||
integer(bit_kind), intent(in) :: key_in(N_int, 2), hole_1(N_int, 2), hole_2(N_int, 2)
|
integer(bit_kind), intent(in) :: key_in(N_int, 2), hole_1(N_int, 2), hole_2(N_int, 2)
|
||||||
integer(bit_kind), intent(in) :: particl_1(N_int, 2), particl_2(N_int, 2)
|
integer(bit_kind), intent(in) :: particl_1(N_int, 2), particl_2(N_int, 2)
|
||||||
integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), tmp
|
integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), tmp
|
||||||
integer,intent(in) :: i_generator,iproc_in
|
integer,intent(in) :: i_generator,iproc_in
|
||||||
integer(bit_kind) :: status(N_int*bit_kind_size, 2)
|
integer :: status(N_int*bit_kind_size, 2)
|
||||||
integer :: highest, p1,p2,sp,ni,i,mi,nt,ns
|
integer :: highest, p1,p2,sp,ni,i,mi,nt,ns,k
|
||||||
double precision, intent(in) :: fock_diag_tmp(2,mo_tot_num+1)
|
double precision, intent(in) :: fock_diag_tmp(2,mo_tot_num+1)
|
||||||
integer(bit_kind), intent(in) :: key_prev(N_int, 2, *)
|
integer(bit_kind), intent(in) :: key_prev(N_int, 2, *)
|
||||||
PROVIDE N_int
|
PROVIDE N_int
|
||||||
@ -17,16 +16,19 @@ subroutine $subroutine_diexc(key_in, key_prev, hole_1,particl_1, hole_2, particl
|
|||||||
|
|
||||||
|
|
||||||
highest = 0
|
highest = 0
|
||||||
status(:,:) = 0
|
do k=1,N_int*bit_kind_size
|
||||||
|
status(k,1) = 0
|
||||||
|
status(k,2) = 0
|
||||||
|
enddo
|
||||||
do sp=1,2
|
do sp=1,2
|
||||||
do ni=1,N_int
|
do ni=1,N_int
|
||||||
do i=1,bit_kind_size
|
do i=1,bit_kind_size
|
||||||
if(iand(1,ishft(key_in(ni, sp), -(i-1))) == 0) then
|
if(iand(1_bit_kind,ishft(key_in(ni, sp), -(i-1))) == 0) then
|
||||||
cycle
|
cycle
|
||||||
end if
|
end if
|
||||||
mi = (ni-1)*bit_kind_size+i
|
mi = (ni-1)*bit_kind_size+i
|
||||||
status(mi, sp) = iand(1,ishft(hole_1(ni, sp), -(i-1)))
|
status(mi, sp) = int(iand(1_bit_kind,ishft(hole_1(ni, sp), -(i-1))),4)
|
||||||
status(mi, sp) = status(mi, sp) + 2*iand(1,ishft(hole_2(ni, sp), -(i-1)))
|
status(mi, sp) = status(mi, sp) + 2*int(iand(1_bit_kind,ishft(hole_2(ni, sp), -(i-1))),4)
|
||||||
if(status(mi, sp) /= 0 .and. mi > highest) then
|
if(status(mi, sp) /= 0 .and. mi > highest) then
|
||||||
highest = mi
|
highest = mi
|
||||||
end if
|
end if
|
||||||
@ -103,16 +105,23 @@ subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2,
|
|||||||
integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), key_mask(N_int, 2)
|
integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), key_mask(N_int, 2)
|
||||||
integer,intent(in) :: fs1,fs2,i_generator,iproc_in, fh1,fh2
|
integer,intent(in) :: fs1,fs2,i_generator,iproc_in, fh1,fh2
|
||||||
integer(bit_kind) :: miniList(N_int, 2, N_det)
|
integer(bit_kind) :: miniList(N_int, 2, N_det)
|
||||||
integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni
|
integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni, k
|
||||||
$declarations
|
$declarations
|
||||||
integer(bit_kind), parameter :: one = 1_bit_kind
|
integer(bit_kind), parameter :: one = 1_bit_kind
|
||||||
|
|
||||||
p1_mask(:,:) = 0_bit_kind
|
do k=1,N_int
|
||||||
p2_mask(:,:) = 0_bit_kind
|
p1_mask(k,1) = 0_bit_kind
|
||||||
|
p1_mask(k,2) = 0_bit_kind
|
||||||
|
p2_mask(k,1) = 0_bit_kind
|
||||||
|
p2_mask(k,2) = 0_bit_kind
|
||||||
|
enddo
|
||||||
p1_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) = ishft(one,iand(fh1-1,bit_kind_size-1))
|
p1_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) = ishft(one,iand(fh1-1,bit_kind_size-1))
|
||||||
p2_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) = ishft(one,iand(fh2-1,bit_kind_size-1))
|
p2_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) = ishft(one,iand(fh2-1,bit_kind_size-1))
|
||||||
|
|
||||||
key_mask(:,:) = key_in(:,:)
|
do k=1,N_int
|
||||||
|
key_mask(k,1) = key_in(k,1)
|
||||||
|
key_mask(k,2) = key_in(k,2)
|
||||||
|
enddo
|
||||||
|
|
||||||
key_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) -= ishft(one,iand(fh1-1,bit_kind_size-1))
|
key_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) -= ishft(one,iand(fh1-1,bit_kind_size-1))
|
||||||
key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= ishft(one,iand(fh2-1,bit_kind_size-1))
|
key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= ishft(one,iand(fh2-1,bit_kind_size-1))
|
||||||
@ -230,14 +239,8 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
|||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
other_spin = iand(ispin,1)+1
|
other_spin = iand(ispin,1)+1
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
$omp_do
|
$omp_do
|
||||||
do ii=1,ia_ja_pairs(1,0,ispin)
|
do ii=1,ia_ja_pairs(1,0,ispin)
|
||||||
if (abort_here) then
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
i_a = ia_ja_pairs(1,ii,ispin)
|
i_a = ia_ja_pairs(1,ii,ispin)
|
||||||
ASSERT (i_a > 0)
|
ASSERT (i_a > 0)
|
||||||
ASSERT (i_a <= mo_tot_num)
|
ASSERT (i_a <= mo_tot_num)
|
||||||
@ -317,9 +320,6 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
|||||||
$keys_work
|
$keys_work
|
||||||
key_idx = 0
|
key_idx = 0
|
||||||
endif
|
endif
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -371,9 +371,6 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
|||||||
$keys_work
|
$keys_work
|
||||||
key_idx = 0
|
key_idx = 0
|
||||||
endif
|
endif
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo ! kk
|
enddo ! kk
|
||||||
|
|
||||||
enddo ! ii
|
enddo ! ii
|
||||||
@ -437,7 +434,10 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato
|
|||||||
logical :: is_a_1p
|
logical :: is_a_1p
|
||||||
logical :: is_a_2p
|
logical :: is_a_2p
|
||||||
|
|
||||||
key_mask(:,:) = 0_bit_kind
|
do k=1,N_int
|
||||||
|
key_mask(k,1) = 0_bit_kind
|
||||||
|
key_mask(k,2) = 0_bit_kind
|
||||||
|
enddo
|
||||||
|
|
||||||
iproc = iproc_in
|
iproc = iproc_in
|
||||||
|
|
||||||
@ -540,178 +540,3 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine $subroutine($params_main)
|
|
||||||
implicit none
|
|
||||||
use omp_lib
|
|
||||||
use bitmasks
|
|
||||||
BEGIN_DOC
|
|
||||||
! Calls H_apply on the HF determinant and selects all connected single and double
|
|
||||||
! excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script.
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
$decls_main
|
|
||||||
|
|
||||||
integer :: i_generator, nmax
|
|
||||||
double precision :: wall_0, wall_1
|
|
||||||
integer(omp_lock_kind) :: lck
|
|
||||||
integer(bit_kind), allocatable :: mask(:,:,:)
|
|
||||||
integer :: ispin, k
|
|
||||||
integer :: iproc
|
|
||||||
double precision, allocatable :: fock_diag_tmp(:,:)
|
|
||||||
|
|
||||||
$initialization
|
|
||||||
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators
|
|
||||||
|
|
||||||
|
|
||||||
nmax = mod( N_det_generators,nproc )
|
|
||||||
|
|
||||||
!$ call omp_init_lock(lck)
|
|
||||||
call start_progress(N_det_generators,'Selection (norm)',0.d0)
|
|
||||||
|
|
||||||
call wall_time(wall_0)
|
|
||||||
|
|
||||||
iproc = 0
|
|
||||||
allocate( mask(N_int,2,6), fock_diag_tmp(2,mo_tot_num+1) )
|
|
||||||
do i_generator=1,nmax
|
|
||||||
progress_bar(1) = i_generator
|
|
||||||
|
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
$skip
|
|
||||||
|
|
||||||
! Compute diagonal of the Fock matrix
|
|
||||||
call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int)
|
|
||||||
|
|
||||||
! Create bit masks for holes and particles
|
|
||||||
do ispin=1,2
|
|
||||||
do k=1,N_int
|
|
||||||
mask(k,ispin,s_hole) = &
|
|
||||||
iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), &
|
|
||||||
psi_det_generators(k,ispin,i_generator) )
|
|
||||||
mask(k,ispin,s_part) = &
|
|
||||||
iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), &
|
|
||||||
not(psi_det_generators(k,ispin,i_generator)) )
|
|
||||||
mask(k,ispin,d_hole1) = &
|
|
||||||
iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), &
|
|
||||||
psi_det_generators(k,ispin,i_generator) )
|
|
||||||
mask(k,ispin,d_part1) = &
|
|
||||||
iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), &
|
|
||||||
not(psi_det_generators(k,ispin,i_generator)) )
|
|
||||||
mask(k,ispin,d_hole2) = &
|
|
||||||
iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), &
|
|
||||||
psi_det_generators(k,ispin,i_generator) )
|
|
||||||
mask(k,ispin,d_part2) = &
|
|
||||||
iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), &
|
|
||||||
not(psi_det_generators(k,ispin,i_generator)) )
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
! print*,'generator in '
|
|
||||||
! call debug_det(psi_det_generators(1,1,i_generator),N_int)
|
|
||||||
! print*,'hole 1'
|
|
||||||
! call debug_det(mask(1,1,d_hole1),N_int)
|
|
||||||
! print*,'hole 2'
|
|
||||||
! call debug_det(mask(1,1,d_hole2),N_int)
|
|
||||||
! print*,'part 1'
|
|
||||||
! call debug_det(mask(1,1,d_part1),N_int)
|
|
||||||
! print*,'part 2'
|
|
||||||
! call debug_det(mask(1,1,d_part2),N_int)
|
|
||||||
if($do_double_excitations)then
|
|
||||||
call $subroutine_diexc(psi_det_generators(1,1,i_generator), &
|
|
||||||
psi_det_generators(1,1,1), &
|
|
||||||
mask(1,1,d_hole1), mask(1,1,d_part1), &
|
|
||||||
mask(1,1,d_hole2), mask(1,1,d_part2), &
|
|
||||||
fock_diag_tmp, i_generator, iproc $params_post)
|
|
||||||
endif
|
|
||||||
if($do_mono_excitations)then
|
|
||||||
call $subroutine_monoexc(psi_det_generators(1,1,i_generator), &
|
|
||||||
mask(1,1,s_hole ), mask(1,1,s_part ), &
|
|
||||||
fock_diag_tmp, i_generator, iproc $params_post)
|
|
||||||
endif
|
|
||||||
call wall_time(wall_1)
|
|
||||||
$printout_always
|
|
||||||
if (wall_1 - wall_0 > 2.d0) then
|
|
||||||
$printout_now
|
|
||||||
wall_0 = wall_1
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
deallocate( mask, fock_diag_tmp )
|
|
||||||
|
|
||||||
!$OMP PARALLEL DEFAULT(SHARED) &
|
|
||||||
!$OMP PRIVATE(i_generator,wall_1,wall_0,ispin,k,mask,iproc,fock_diag_tmp)
|
|
||||||
call wall_time(wall_0)
|
|
||||||
!$ iproc = omp_get_thread_num()
|
|
||||||
allocate( mask(N_int,2,6), fock_diag_tmp(2,mo_tot_num+1) )
|
|
||||||
!$OMP DO SCHEDULE(dynamic,1)
|
|
||||||
do i_generator=nmax+1,N_det_generators
|
|
||||||
if (iproc == 0) then
|
|
||||||
progress_bar(1) = i_generator
|
|
||||||
endif
|
|
||||||
if (abort_here) then
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
$skip
|
|
||||||
|
|
||||||
! Compute diagonal of the Fock matrix
|
|
||||||
call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int)
|
|
||||||
|
|
||||||
! Create bit masks for holes and particles
|
|
||||||
do ispin=1,2
|
|
||||||
do k=1,N_int
|
|
||||||
mask(k,ispin,s_hole) = &
|
|
||||||
iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), &
|
|
||||||
psi_det_generators(k,ispin,i_generator) )
|
|
||||||
mask(k,ispin,s_part) = &
|
|
||||||
iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), &
|
|
||||||
not(psi_det_generators(k,ispin,i_generator)) )
|
|
||||||
mask(k,ispin,d_hole1) = &
|
|
||||||
iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), &
|
|
||||||
psi_det_generators(k,ispin,i_generator) )
|
|
||||||
mask(k,ispin,d_part1) = &
|
|
||||||
iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), &
|
|
||||||
not(psi_det_generators(k,ispin,i_generator)) )
|
|
||||||
mask(k,ispin,d_hole2) = &
|
|
||||||
iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), &
|
|
||||||
psi_det_generators(k,ispin,i_generator) )
|
|
||||||
mask(k,ispin,d_part2) = &
|
|
||||||
iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), &
|
|
||||||
not (psi_det_generators(k,ispin,i_generator)) )
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
if($do_double_excitations)then
|
|
||||||
call $subroutine_diexc(psi_det_generators(1,1,i_generator), &
|
|
||||||
psi_det_generators(1,1,1), &
|
|
||||||
mask(1,1,d_hole1), mask(1,1,d_part1), &
|
|
||||||
mask(1,1,d_hole2), mask(1,1,d_part2), &
|
|
||||||
fock_diag_tmp, i_generator, iproc $params_post)
|
|
||||||
endif
|
|
||||||
if($do_mono_excitations)then
|
|
||||||
call $subroutine_monoexc(psi_det_generators(1,1,i_generator), &
|
|
||||||
mask(1,1,s_hole ), mask(1,1,s_part ), &
|
|
||||||
fock_diag_tmp, i_generator, iproc $params_post)
|
|
||||||
endif
|
|
||||||
!$ call omp_set_lock(lck)
|
|
||||||
call wall_time(wall_1)
|
|
||||||
$printout_always
|
|
||||||
if (wall_1 - wall_0 > 2.d0) then
|
|
||||||
$printout_now
|
|
||||||
wall_0 = wall_1
|
|
||||||
endif
|
|
||||||
!$ call omp_unset_lock(lck)
|
|
||||||
enddo
|
|
||||||
!$OMP END DO
|
|
||||||
deallocate( mask, fock_diag_tmp )
|
|
||||||
!$OMP END PARALLEL
|
|
||||||
!$ call omp_destroy_lock(lck)
|
|
||||||
|
|
||||||
abort_here = abort_all
|
|
||||||
call stop_progress
|
|
||||||
|
|
||||||
$copy_buffer
|
|
||||||
$generate_psi_guess
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
|
150
src/Determinants/H_apply_nozmq.template.f
Normal file
150
src/Determinants/H_apply_nozmq.template.f
Normal file
@ -0,0 +1,150 @@
|
|||||||
|
subroutine $subroutine($params_main)
|
||||||
|
implicit none
|
||||||
|
use omp_lib
|
||||||
|
use bitmasks
|
||||||
|
BEGIN_DOC
|
||||||
|
! Calls H_apply on the HF determinant and selects all connected single and double
|
||||||
|
! excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
$decls_main
|
||||||
|
|
||||||
|
integer :: i_generator, nmax
|
||||||
|
double precision :: wall_0, wall_1
|
||||||
|
integer(omp_lock_kind) :: lck
|
||||||
|
integer(bit_kind), allocatable :: mask(:,:,:)
|
||||||
|
integer :: ispin, k
|
||||||
|
integer :: iproc
|
||||||
|
double precision, allocatable :: fock_diag_tmp(:,:)
|
||||||
|
|
||||||
|
$initialization
|
||||||
|
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators
|
||||||
|
|
||||||
|
|
||||||
|
nmax = mod( N_det_generators,nproc )
|
||||||
|
|
||||||
|
!$ call omp_init_lock(lck)
|
||||||
|
|
||||||
|
call wall_time(wall_0)
|
||||||
|
|
||||||
|
iproc = 0
|
||||||
|
allocate( mask(N_int,2,6), fock_diag_tmp(2,mo_tot_num+1) )
|
||||||
|
do i_generator=1,nmax
|
||||||
|
|
||||||
|
$skip
|
||||||
|
|
||||||
|
! Compute diagonal of the Fock matrix
|
||||||
|
call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int)
|
||||||
|
|
||||||
|
! Create bit masks for holes and particles
|
||||||
|
do ispin=1,2
|
||||||
|
do k=1,N_int
|
||||||
|
mask(k,ispin,s_hole) = &
|
||||||
|
iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,s_part) = &
|
||||||
|
iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), &
|
||||||
|
not(psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
mask(k,ispin,d_hole1) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,d_part1) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), &
|
||||||
|
not(psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
mask(k,ispin,d_hole2) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,d_part2) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), &
|
||||||
|
not(psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
if($do_double_excitations)then
|
||||||
|
call $subroutine_diexc(psi_det_generators(1,1,i_generator), &
|
||||||
|
psi_det_generators(1,1,1), &
|
||||||
|
mask(1,1,d_hole1), mask(1,1,d_part1), &
|
||||||
|
mask(1,1,d_hole2), mask(1,1,d_part2), &
|
||||||
|
fock_diag_tmp, i_generator, iproc $params_post)
|
||||||
|
endif
|
||||||
|
if($do_mono_excitations)then
|
||||||
|
call $subroutine_monoexc(psi_det_generators(1,1,i_generator), &
|
||||||
|
mask(1,1,s_hole ), mask(1,1,s_part ), &
|
||||||
|
fock_diag_tmp, i_generator, iproc $params_post)
|
||||||
|
endif
|
||||||
|
call wall_time(wall_1)
|
||||||
|
$printout_always
|
||||||
|
if (wall_1 - wall_0 > 2.d0) then
|
||||||
|
$printout_now
|
||||||
|
wall_0 = wall_1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate( mask, fock_diag_tmp )
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(SHARED) &
|
||||||
|
!$OMP PRIVATE(i_generator,wall_1,wall_0,ispin,k,mask,iproc,fock_diag_tmp)
|
||||||
|
call wall_time(wall_0)
|
||||||
|
!$ iproc = omp_get_thread_num()
|
||||||
|
allocate( mask(N_int,2,6), fock_diag_tmp(2,mo_tot_num+1) )
|
||||||
|
!$OMP DO SCHEDULE(dynamic,1)
|
||||||
|
do i_generator=nmax+1,N_det_generators
|
||||||
|
$skip
|
||||||
|
|
||||||
|
! Compute diagonal of the Fock matrix
|
||||||
|
call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int)
|
||||||
|
|
||||||
|
! Create bit masks for holes and particles
|
||||||
|
do ispin=1,2
|
||||||
|
do k=1,N_int
|
||||||
|
mask(k,ispin,s_hole) = &
|
||||||
|
iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,s_part) = &
|
||||||
|
iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), &
|
||||||
|
not(psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
mask(k,ispin,d_hole1) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,d_part1) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), &
|
||||||
|
not(psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
mask(k,ispin,d_hole2) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,d_part2) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), &
|
||||||
|
not (psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if($do_double_excitations)then
|
||||||
|
call $subroutine_diexc(psi_det_generators(1,1,i_generator), &
|
||||||
|
psi_det_generators(1,1,1), &
|
||||||
|
mask(1,1,d_hole1), mask(1,1,d_part1), &
|
||||||
|
mask(1,1,d_hole2), mask(1,1,d_part2), &
|
||||||
|
fock_diag_tmp, i_generator, iproc $params_post)
|
||||||
|
endif
|
||||||
|
if($do_mono_excitations)then
|
||||||
|
call $subroutine_monoexc(psi_det_generators(1,1,i_generator), &
|
||||||
|
mask(1,1,s_hole ), mask(1,1,s_part ), &
|
||||||
|
fock_diag_tmp, i_generator, iproc $params_post)
|
||||||
|
endif
|
||||||
|
!$ call omp_set_lock(lck)
|
||||||
|
call wall_time(wall_1)
|
||||||
|
$printout_always
|
||||||
|
if (wall_1 - wall_0 > 2.d0) then
|
||||||
|
$printout_now
|
||||||
|
wall_0 = wall_1
|
||||||
|
endif
|
||||||
|
!$ call omp_unset_lock(lck)
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
deallocate( mask, fock_diag_tmp )
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
!$ call omp_destroy_lock(lck)
|
||||||
|
|
||||||
|
$copy_buffer
|
||||||
|
$generate_psi_guess
|
||||||
|
|
||||||
|
end
|
||||||
|
|
245
src/Determinants/H_apply_zmq.template.f
Normal file
245
src/Determinants/H_apply_zmq.template.f
Normal file
@ -0,0 +1,245 @@
|
|||||||
|
subroutine $subroutine($params_main)
|
||||||
|
implicit none
|
||||||
|
use omp_lib
|
||||||
|
use bitmasks
|
||||||
|
use f77_zmq
|
||||||
|
BEGIN_DOC
|
||||||
|
! Calls H_apply on the HF determinant and selects all connected single and double
|
||||||
|
! excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
$decls_main
|
||||||
|
|
||||||
|
integer :: i_generator
|
||||||
|
double precision :: wall_0, wall_1
|
||||||
|
integer(omp_lock_kind) :: lck
|
||||||
|
integer(bit_kind), allocatable :: mask(:,:,:)
|
||||||
|
integer :: ispin, k
|
||||||
|
integer :: rc
|
||||||
|
character*(512) :: task
|
||||||
|
double precision, allocatable :: fock_diag_tmp(:,:)
|
||||||
|
|
||||||
|
$initialization
|
||||||
|
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_pair_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_socket_pair
|
||||||
|
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
call new_parallel_job(zmq_to_qp_run_socket,'$subroutine')
|
||||||
|
zmq_socket_pair = new_zmq_pair_socket(.True.)
|
||||||
|
|
||||||
|
call zmq_put_psi(zmq_to_qp_run_socket,1)
|
||||||
|
|
||||||
|
do i_generator=N_det_generators,1,-1
|
||||||
|
$skip
|
||||||
|
write(task,*) i_generator
|
||||||
|
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
integer(ZMQ_PTR) :: collector_thread
|
||||||
|
external :: $subroutine_collector
|
||||||
|
rc = pthread_create(collector_thread, $subroutine_collector)
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(private)
|
||||||
|
!$OMP TASK PRIVATE(rc)
|
||||||
|
rc = omp_get_thread_num()
|
||||||
|
call $subroutine_slave_inproc(rc)
|
||||||
|
!$OMP END TASK
|
||||||
|
!$OMP TASKWAIT
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
|
||||||
|
integer :: n, task_id
|
||||||
|
call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, N_st, n, task_id)
|
||||||
|
|
||||||
|
rc = pthread_join(collector_thread)
|
||||||
|
|
||||||
|
call end_zmq_pair_socket(zmq_socket_pair)
|
||||||
|
call end_parallel_job(zmq_to_qp_run_socket,'$subroutine')
|
||||||
|
|
||||||
|
|
||||||
|
$copy_buffer
|
||||||
|
$generate_psi_guess
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine $subroutine_slave_tcp(iproc)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: iproc
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes a buffer over the network
|
||||||
|
END_DOC
|
||||||
|
call $subroutine_slave(0,iproc)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine $subroutine_slave_inproc(iproc)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: iproc
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes a buffer using threads
|
||||||
|
END_DOC
|
||||||
|
call $subroutine_slave(1,iproc)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine $subroutine_slave(thread, iproc)
|
||||||
|
implicit none
|
||||||
|
use omp_lib
|
||||||
|
use bitmasks
|
||||||
|
use f77_zmq
|
||||||
|
integer, intent(in) :: thread
|
||||||
|
BEGIN_DOC
|
||||||
|
! Calls H_apply on the HF determinant and selects all connected single and double
|
||||||
|
! excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: iproc
|
||||||
|
integer :: i_generator
|
||||||
|
double precision :: wall_0, wall_1
|
||||||
|
integer(bit_kind), allocatable :: mask(:,:,:)
|
||||||
|
integer :: ispin, k
|
||||||
|
double precision, allocatable :: fock_diag_tmp(:,:)
|
||||||
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
||||||
|
|
||||||
|
integer :: worker_id, task_id, rc, N_st
|
||||||
|
character*(512) :: task
|
||||||
|
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR),external :: new_zmq_push_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_socket_push
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
zmq_socket_push = new_zmq_push_socket(thread)
|
||||||
|
|
||||||
|
|
||||||
|
N_st = N_states
|
||||||
|
allocate( pt2(N_st), norm_pert(N_st), H_pert_diag(N_st), &
|
||||||
|
mask(N_int,2,6), fock_diag_tmp(2,mo_tot_num+1) )
|
||||||
|
|
||||||
|
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||||
|
|
||||||
|
do
|
||||||
|
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
|
||||||
|
if (task_id == 0) exit
|
||||||
|
read(task,*) i_generator
|
||||||
|
|
||||||
|
! Compute diagonal of the Fock matrix
|
||||||
|
call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int)
|
||||||
|
|
||||||
|
pt2 = 0.d0
|
||||||
|
norm_pert = 0.d0
|
||||||
|
H_pert_diag = 0.d0
|
||||||
|
|
||||||
|
! Create bit masks for holes and particles
|
||||||
|
do ispin=1,2
|
||||||
|
do k=1,N_int
|
||||||
|
mask(k,ispin,s_hole) = &
|
||||||
|
iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,s_part) = &
|
||||||
|
iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), &
|
||||||
|
not(psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
mask(k,ispin,d_hole1) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,d_part1) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), &
|
||||||
|
not(psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
mask(k,ispin,d_hole2) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), &
|
||||||
|
psi_det_generators(k,ispin,i_generator) )
|
||||||
|
mask(k,ispin,d_part2) = &
|
||||||
|
iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), &
|
||||||
|
not (psi_det_generators(k,ispin,i_generator)) )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if($do_double_excitations)then
|
||||||
|
call $subroutine_diexc(psi_det_generators(1,1,i_generator), &
|
||||||
|
psi_det_generators(1,1,1), &
|
||||||
|
mask(1,1,d_hole1), mask(1,1,d_part1), &
|
||||||
|
mask(1,1,d_hole2), mask(1,1,d_part2), &
|
||||||
|
fock_diag_tmp, i_generator, iproc $params_post)
|
||||||
|
endif
|
||||||
|
if($do_mono_excitations)then
|
||||||
|
call $subroutine_monoexc(psi_det_generators(1,1,i_generator), &
|
||||||
|
mask(1,1,s_hole ), mask(1,1,s_part ), &
|
||||||
|
fock_diag_tmp, i_generator, iproc $params_post)
|
||||||
|
endif
|
||||||
|
|
||||||
|
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,1)
|
||||||
|
call push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
|
||||||
|
|
||||||
|
deallocate( mask, fock_diag_tmp, pt2, norm_pert, H_pert_diag )
|
||||||
|
|
||||||
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine $subroutine_collector
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Collects results from the selection
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: k, rc
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_pull_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_socket_pull
|
||||||
|
integer*8 :: control, accu
|
||||||
|
integer :: n, more, task_id
|
||||||
|
|
||||||
|
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
zmq_socket_pull = new_zmq_pull_socket()
|
||||||
|
|
||||||
|
double precision, allocatable :: pt2(:,:), norm_pert(:,:), H_pert_diag(:,:)
|
||||||
|
allocate ( pt2(N_states,2), norm_pert(N_states,2), H_pert_diag(N_states,2))
|
||||||
|
|
||||||
|
pt2 = 0.d0
|
||||||
|
norm_pert = 0.d0
|
||||||
|
H_pert_diag = 0.d0
|
||||||
|
accu = 0_8
|
||||||
|
more = 1
|
||||||
|
do while (more == 1)
|
||||||
|
|
||||||
|
call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, N_states, n, task_id)
|
||||||
|
if (n > 0) then
|
||||||
|
do k=1,N_states
|
||||||
|
pt2(k,2) = pt2(k,1) + pt2(k,2)
|
||||||
|
norm_pert(k,2) = norm_pert(k,1) + norm_pert(k,2)
|
||||||
|
H_pert_diag(k,2) = H_pert_diag(k,1) + H_pert_diag(k,2)
|
||||||
|
enddo
|
||||||
|
accu = accu + 1_8
|
||||||
|
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more)
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call end_zmq_pull_socket(zmq_socket_pull)
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_pair_socket
|
||||||
|
integer(ZMQ_PTR) :: socket_result
|
||||||
|
|
||||||
|
socket_result = new_zmq_pair_socket(.False.)
|
||||||
|
|
||||||
|
call push_pt2(socket_result, pt2(1,2), norm_pert(1,2), H_pert_diag(1,2), N_states,0)
|
||||||
|
|
||||||
|
deallocate ( pt2, norm_pert, H_pert_diag)
|
||||||
|
|
||||||
|
call end_zmq_pair_socket(socket_result)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
@ -92,9 +92,6 @@ subroutine CISD_SC2(dets_in,u_in,energies,diag_H_elements,dim_in,sze,N_st,Nint,c
|
|||||||
e_corr_double_before = e_corr_double
|
e_corr_double_before = e_corr_double
|
||||||
iter = 0
|
iter = 0
|
||||||
do while (.not.converged)
|
do while (.not.converged)
|
||||||
if (abort_here) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
iter +=1
|
iter +=1
|
||||||
!$OMP PARALLEL DEFAULT(NONE) &
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
!$OMP PRIVATE(i,j,degree,accu) &
|
!$OMP PRIVATE(i,j,degree,accu) &
|
||||||
@ -192,14 +189,14 @@ subroutine CISD_SC2(dets_in,u_in,energies,diag_H_elements,dim_in,sze,N_st,Nint,c
|
|||||||
write(output_determinants,'(A)') 'State Energy '
|
write(output_determinants,'(A)') 'State Energy '
|
||||||
write(output_determinants,'(A)') '===== ================'
|
write(output_determinants,'(A)') '===== ================'
|
||||||
do i=1,N_st
|
do i=1,N_st
|
||||||
write(output_determinants,'(I5,X,F16.10)') i, energies(i)+nuclear_repulsion
|
write(output_determinants,'(I5,1X,F16.10)') i, energies(i)+nuclear_repulsion
|
||||||
enddo
|
enddo
|
||||||
write(output_determinants,'(A)') '===== ================'
|
write(output_determinants,'(A)') '===== ================'
|
||||||
write(output_determinants,'(A)') ''
|
write(output_determinants,'(A)') ''
|
||||||
call write_double(output_determinants,(e_corr_double - e_corr_double_before),&
|
call write_double(output_determinants,(e_corr_double - e_corr_double_before),&
|
||||||
'Delta(E_corr)')
|
'Delta(E_corr)')
|
||||||
converged = dabs(e_corr_double - e_corr_double_before) < convergence
|
converged = dabs(e_corr_double - e_corr_double_before) < convergence
|
||||||
converged = converged .or. abort_here
|
converged = converged
|
||||||
if (converged) then
|
if (converged) then
|
||||||
do i = 1, dim_in
|
do i = 1, dim_in
|
||||||
diag_H_elements(i) = H_jj_dressed(i) - H_jj_ref(i)
|
diag_H_elements(i) = H_jj_dressed(i) - H_jj_ref(i)
|
||||||
|
@ -69,8 +69,8 @@ end
|
|||||||
logical function det_inf(key1, key2, Nint)
|
logical function det_inf(key1, key2, Nint)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
integer(bit_kind),intent(in) :: key1(Nint, 2), key2(Nint, 2)
|
|
||||||
integer,intent(in) :: Nint
|
integer,intent(in) :: Nint
|
||||||
|
integer(bit_kind),intent(in) :: key1(Nint, 2), key2(Nint, 2)
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
|
|
||||||
det_inf = .false.
|
det_inf = .false.
|
||||||
@ -239,10 +239,10 @@ subroutine sort_dets_ab(key, idx, shortcut, N_key, Nint)
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Uncodumented : TODO
|
! Uncodumented : TODO
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint, N_key
|
||||||
integer(bit_kind),intent(inout) :: key(Nint,2,N_key)
|
integer(bit_kind),intent(inout) :: key(Nint,2,N_key)
|
||||||
integer,intent(out) :: idx(N_key)
|
integer,intent(out) :: idx(N_key)
|
||||||
integer,intent(out) :: shortcut(0:N_key+1)
|
integer,intent(out) :: shortcut(0:N_key+1)
|
||||||
integer, intent(in) :: Nint, N_key
|
|
||||||
integer(bit_kind) :: tmp(Nint, 2)
|
integer(bit_kind) :: tmp(Nint, 2)
|
||||||
integer :: tmpidx,i,ni
|
integer :: tmpidx,i,ni
|
||||||
|
|
||||||
@ -498,7 +498,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun
|
|||||||
to_print(2,k) = residual_norm(k)
|
to_print(2,k) = residual_norm(k)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
write(iunit,'(X,I3,X,100(X,F16.10,X,E16.6))'), iter, to_print(:,1:N_st)
|
write(iunit,'(X,I3,X,100(X,F16.10,X,E16.6))') iter, to_print(:,1:N_st)
|
||||||
call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged)
|
call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged)
|
||||||
if (converged) then
|
if (converged) then
|
||||||
exit
|
exit
|
||||||
@ -590,7 +590,6 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun
|
|||||||
y, &
|
y, &
|
||||||
lambda &
|
lambda &
|
||||||
)
|
)
|
||||||
abort_here = abort_all
|
|
||||||
end
|
end
|
||||||
|
|
||||||
BEGIN_PROVIDER [ character(64), davidson_criterion ]
|
BEGIN_PROVIDER [ character(64), davidson_criterion ]
|
||||||
@ -636,5 +635,4 @@ subroutine davidson_converged(energy,residual,wall,iterations,cpu,N_st,converged
|
|||||||
else if (davidson_criterion == 'iterations') then
|
else if (davidson_criterion == 'iterations') then
|
||||||
converged = iterations >= int(threshold_davidson)
|
converged = iterations >= int(threshold_davidson)
|
||||||
endif
|
endif
|
||||||
converged = converged.or.abort_here
|
|
||||||
end
|
end
|
||||||
|
@ -386,66 +386,6 @@ subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, det_out, coef_out)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine int_of_3_highest_electrons( det_in, res, Nint )
|
|
||||||
implicit none
|
|
||||||
use bitmasks
|
|
||||||
integer,intent(in) :: Nint
|
|
||||||
integer(bit_kind) :: det_in(Nint)
|
|
||||||
integer*8 :: res
|
|
||||||
BEGIN_DOC
|
|
||||||
! Returns an integer*8 as :
|
|
||||||
!
|
|
||||||
! |_<--- 21 bits ---><--- 21 bits ---><--- 21 bits --->|
|
|
||||||
!
|
|
||||||
! |0<--- i1 ---><--- i2 ---><--- i3 --->|
|
|
||||||
!
|
|
||||||
! It encodes the value of the indices of the 3 highest MOs
|
|
||||||
! in descending order
|
|
||||||
!
|
|
||||||
END_DOC
|
|
||||||
integer :: i, k, icount
|
|
||||||
integer(bit_kind) :: ix
|
|
||||||
res = 0_8
|
|
||||||
icount = 3
|
|
||||||
do k=Nint,1,-1
|
|
||||||
ix = det_in(k)
|
|
||||||
do while (ix /= 0_bit_kind)
|
|
||||||
i = bit_kind_size-1-leadz(ix)
|
|
||||||
ix = ibclr(ix,i)
|
|
||||||
res = ior(ishft(res, 21), i+ishft(k-1,bit_kind_shift))
|
|
||||||
icount -= 1
|
|
||||||
if (icount == 0) then
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine filter_3_highest_electrons( det_in, det_out, Nint )
|
|
||||||
implicit none
|
|
||||||
use bitmasks
|
|
||||||
integer,intent(in) :: Nint
|
|
||||||
integer(bit_kind) :: det_in(Nint), det_out(Nint)
|
|
||||||
BEGIN_DOC
|
|
||||||
! Returns a determinant with only the 3 highest electrons
|
|
||||||
END_DOC
|
|
||||||
integer :: i, k, icount
|
|
||||||
integer(bit_kind) :: ix
|
|
||||||
det_out = 0_8
|
|
||||||
icount = 3
|
|
||||||
do k=Nint,1,-1
|
|
||||||
ix = det_in(k)
|
|
||||||
do while (ix /= 0_bit_kind)
|
|
||||||
i = bit_kind_size-1-leadz(ix)
|
|
||||||
ix = ibclr(ix,i)
|
|
||||||
det_out(k) = ibset(det_out(k),i)
|
|
||||||
icount -= 1
|
|
||||||
if (icount == 0) then
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
end
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, psi_coef_max, (N_states) ]
|
BEGIN_PROVIDER [ double precision, psi_coef_max, (N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, psi_coef_min, (N_states) ]
|
&BEGIN_PROVIDER [ double precision, psi_coef_min, (N_states) ]
|
||||||
@ -465,130 +405,6 @@ end
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_ab, (N_int,2,psi_det_size) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_ab, (N_det,N_states) ]
|
|
||||||
&BEGIN_PROVIDER [ integer, psi_det_sorted_next_ab, (2,psi_det_size) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Determinants on which we apply <i|H|j>.
|
|
||||||
! They are sorted by the 3 highest electrons in the alpha part,
|
|
||||||
! then by the 3 highest electrons in the beta part to accelerate
|
|
||||||
! the research of connected determinants.
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
call sort_dets_by_3_highest_electrons( &
|
|
||||||
psi_det, &
|
|
||||||
psi_coef, &
|
|
||||||
psi_det_sorted_ab, &
|
|
||||||
psi_coef_sorted_ab, &
|
|
||||||
psi_det_sorted_next_ab, &
|
|
||||||
N_det, N_states, N_int, &
|
|
||||||
psi_det_size )
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
subroutine sort_dets_by_3_highest_electrons(det_in,coef_in,det_out,coef_out, &
|
|
||||||
det_next, Ndet, Nstates, Nint, LDA)
|
|
||||||
implicit none
|
|
||||||
integer, intent(in) :: Ndet, Nstates, Nint, LDA
|
|
||||||
integer(bit_kind), intent(in) :: det_in (Nint,2,Ndet)
|
|
||||||
integer(bit_kind), intent(out) :: det_out (Nint,2,Ndet)
|
|
||||||
integer, intent(out) :: det_next (2,Ndet)
|
|
||||||
double precision, intent(in) :: coef_in (LDA,Nstates)
|
|
||||||
double precision, intent(out) :: coef_out (LDA,Nstates)
|
|
||||||
BEGIN_DOC
|
|
||||||
! Determinants on which we apply <i|H|j>.
|
|
||||||
! They are sorted by the 3 highest electrons in the alpha part,
|
|
||||||
! then by the 3 highest electrons in the beta part to accelerate
|
|
||||||
! the research of connected determinants.
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,k
|
|
||||||
integer, allocatable :: iorder(:)
|
|
||||||
integer*8, allocatable :: bit_tmp(:)
|
|
||||||
integer*8, external :: det_search_key
|
|
||||||
|
|
||||||
allocate ( iorder(Ndet), bit_tmp(Ndet) )
|
|
||||||
|
|
||||||
! Sort alpha dets
|
|
||||||
! ---------------
|
|
||||||
|
|
||||||
integer(bit_kind) :: det_tmp(Nint)
|
|
||||||
|
|
||||||
do i=1,Ndet
|
|
||||||
iorder(i) = i
|
|
||||||
call int_of_3_highest_electrons(psi_det(1,1,i),bit_tmp(i),N_int)
|
|
||||||
enddo
|
|
||||||
call i8sort(bit_tmp,iorder,Ndet)
|
|
||||||
!DIR$ IVDEP
|
|
||||||
do i=1,Ndet
|
|
||||||
do j=1,N_int
|
|
||||||
det_out(j,1,i) = psi_det(j,1,iorder(i))
|
|
||||||
det_out(j,2,i) = psi_det(j,2,iorder(i))
|
|
||||||
enddo
|
|
||||||
do k=1,Nstates
|
|
||||||
coef_out(i,k) = psi_coef(iorder(i),k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Find next alpha
|
|
||||||
! ---------------
|
|
||||||
|
|
||||||
integer :: next
|
|
||||||
|
|
||||||
next = Ndet+1
|
|
||||||
det_next(1,Ndet) = next
|
|
||||||
do i=Ndet-1,1,-1
|
|
||||||
if (bit_tmp(i) /= bit_tmp(i+1)) then
|
|
||||||
next = i+1
|
|
||||||
endif
|
|
||||||
det_next(1,i) = next
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Sort beta dets
|
|
||||||
! --------------
|
|
||||||
|
|
||||||
integer :: istart, iend
|
|
||||||
integer(bit_kind), allocatable :: det_sorted_temp (:,:)
|
|
||||||
|
|
||||||
allocate ( det_sorted_temp (N_int,Ndet) )
|
|
||||||
do i=1,Ndet
|
|
||||||
do j=1,N_int
|
|
||||||
det_sorted_temp(j,i) = det_out(j,2,i)
|
|
||||||
enddo
|
|
||||||
iorder(i) = i
|
|
||||||
call int_of_3_highest_electrons(det_sorted_temp(1,i),bit_tmp(i),N_int)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
istart=1
|
|
||||||
do while ( istart<Ndet )
|
|
||||||
|
|
||||||
iend = det_next(1,istart)
|
|
||||||
call i8sort(bit_tmp(istart),iorder(istart),iend-istart)
|
|
||||||
!DIR$ IVDEP
|
|
||||||
do i=istart,iend-1
|
|
||||||
do j=1,N_int
|
|
||||||
det_out(j,2,i) = det_sorted_temp(j,iorder(i))
|
|
||||||
enddo
|
|
||||||
do k=1,Nstates
|
|
||||||
coef_out(i,k) = psi_coef(iorder(i),k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
next = iend
|
|
||||||
det_next(2,iend-1) = next
|
|
||||||
do i=iend-2,1,-1
|
|
||||||
if (bit_tmp(i) /= bit_tmp(i+1)) then
|
|
||||||
next = i+1
|
|
||||||
endif
|
|
||||||
det_next(2,i) = next
|
|
||||||
enddo
|
|
||||||
|
|
||||||
istart = iend
|
|
||||||
enddo
|
|
||||||
|
|
||||||
deallocate(iorder, bit_tmp, det_sorted_temp)
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
!==============================================================================!
|
!==============================================================================!
|
||||||
! !
|
! !
|
||||||
@ -645,7 +461,9 @@ end
|
|||||||
subroutine save_ref_determinant
|
subroutine save_ref_determinant
|
||||||
implicit none
|
implicit none
|
||||||
use bitmasks
|
use bitmasks
|
||||||
call save_wavefunction_general(1,1,ref_bitmask,1,1.d0)
|
double precision :: buffer(1,1)
|
||||||
|
buffer(1,1) = 1.d0
|
||||||
|
call save_wavefunction_general(1,1,ref_bitmask,1,buffer)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -112,16 +112,16 @@ subroutine getMobiles(key,key_mask, mobiles,Nint)
|
|||||||
mobileMask(j,2) = xor(key(j,2), key_mask(j,2))
|
mobileMask(j,2) = xor(key(j,2), key_mask(j,2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint)
|
call bitstring_to_list(mobileMask(1,1), list, nel, Nint)
|
||||||
if(nel == 2) then
|
if(nel == 2) then
|
||||||
mobiles(1) = list(1)
|
mobiles(1) = list(1)
|
||||||
mobiles(2) = list(2)
|
mobiles(2) = list(2)
|
||||||
else if(nel == 1) then
|
else if(nel == 1) then
|
||||||
mobiles(1) = list(1)
|
mobiles(1) = list(1)
|
||||||
call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint)
|
call bitstring_to_list(mobileMask(1,2), list, nel, Nint)
|
||||||
mobiles(2) = list(1) + mo_tot_num
|
mobiles(2) = list(1) + mo_tot_num
|
||||||
else
|
else
|
||||||
call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint)
|
call bitstring_to_list(mobileMask(1,2), list, nel, Nint)
|
||||||
mobiles(1) = list(1) + mo_tot_num
|
mobiles(1) = list(1) + mo_tot_num
|
||||||
mobiles(2) = list(2) + mo_tot_num
|
mobiles(2) = list(2) + mo_tot_num
|
||||||
end if
|
end if
|
||||||
@ -139,6 +139,8 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||||||
integer :: i,j,k,nt,n_element(2)
|
integer :: i,j,k,nt,n_element(2)
|
||||||
integer :: list(Nint*bit_kind_size,2), cur_microlist(0:mo_tot_num*2+1)
|
integer :: list(Nint*bit_kind_size,2), cur_microlist(0:mo_tot_num*2+1)
|
||||||
integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2)
|
integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2)
|
||||||
|
integer :: mo_tot_num_2
|
||||||
|
mo_tot_num_2 = mo_tot_num+mo_tot_num
|
||||||
|
|
||||||
|
|
||||||
do i=1,Nint
|
do i=1,Nint
|
||||||
@ -146,7 +148,9 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||||||
key_mask_neg(i,2) = not(key_mask(i,2))
|
key_mask_neg(i,2) = not(key_mask(i,2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
N_microlist(:) = 0
|
do i=0,mo_tot_num_2
|
||||||
|
N_microlist(i) = 0
|
||||||
|
enddo
|
||||||
|
|
||||||
do i=1, N_minilist
|
do i=1, N_minilist
|
||||||
do j=1,Nint
|
do j=1,Nint
|
||||||
@ -154,8 +158,8 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||||||
mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i))
|
mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint)
|
call bitstring_to_list(mobileMask(1,1), list(1,1), n_element(1), Nint)
|
||||||
call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint)
|
call bitstring_to_list(mobileMask(1,2), list(1,2), n_element(2), Nint)
|
||||||
|
|
||||||
if(n_element(1) + n_element(2) /= 4) then
|
if(n_element(1) + n_element(2) /= 4) then
|
||||||
N_microlist(0) = N_microlist(0) + 1
|
N_microlist(0) = N_microlist(0) + 1
|
||||||
@ -173,11 +177,14 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||||||
end do
|
end do
|
||||||
|
|
||||||
ptr_microlist(0) = 1
|
ptr_microlist(0) = 1
|
||||||
do i=1,mo_tot_num*2+1
|
do i=1,mo_tot_num_2+1
|
||||||
ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1)
|
ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1)
|
||||||
end do
|
end do
|
||||||
|
|
||||||
cur_microlist(:) = ptr_microlist(:)
|
do i=0,mo_tot_num_2+1
|
||||||
|
cur_microlist(i) = ptr_microlist(i)
|
||||||
|
end do
|
||||||
|
|
||||||
|
|
||||||
do i=1, N_minilist
|
do i=1, N_minilist
|
||||||
do j=1,Nint
|
do j=1,Nint
|
||||||
@ -185,26 +192,35 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||||||
mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i))
|
mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint)
|
call bitstring_to_list(mobileMask(1,1), list(1,1), n_element(1), Nint)
|
||||||
call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint)
|
call bitstring_to_list(mobileMask(1,2), list(1,2), n_element(2), Nint)
|
||||||
|
|
||||||
|
|
||||||
if(n_element(1) + n_element(2) /= 4) then
|
if(n_element(1) + n_element(2) /= 4) then
|
||||||
idx_microlist(cur_microlist(0)) = i
|
idx_microlist(cur_microlist(0)) = i
|
||||||
microlist(:,:,cur_microlist(0)) = minilist(:,:,i)
|
do k=1,Nint
|
||||||
|
microlist(k,1,cur_microlist(0)) = minilist(k,1,i)
|
||||||
|
microlist(k,2,cur_microlist(0)) = minilist(k,2,i)
|
||||||
|
enddo
|
||||||
cur_microlist(0) = cur_microlist(0) + 1
|
cur_microlist(0) = cur_microlist(0) + 1
|
||||||
else
|
else
|
||||||
do j=1,n_element(1)
|
do j=1,n_element(1)
|
||||||
nt = list(j,1)
|
nt = list(j,1)
|
||||||
idx_microlist(cur_microlist(nt)) = i
|
idx_microlist(cur_microlist(nt)) = i
|
||||||
microlist(:,:,cur_microlist(nt)) = minilist(:,:,i)
|
do k=1,Nint
|
||||||
|
microlist(k,1,cur_microlist(nt)) = minilist(k,1,i)
|
||||||
|
microlist(k,2,cur_microlist(nt)) = minilist(k,2,i)
|
||||||
|
enddo
|
||||||
cur_microlist(nt) = cur_microlist(nt) + 1
|
cur_microlist(nt) = cur_microlist(nt) + 1
|
||||||
end do
|
end do
|
||||||
|
|
||||||
do j=1,n_element(2)
|
do j=1,n_element(2)
|
||||||
nt = list(j,2) + mo_tot_num
|
nt = list(j,2) + mo_tot_num
|
||||||
idx_microlist(cur_microlist(nt)) = i
|
idx_microlist(cur_microlist(nt)) = i
|
||||||
microlist(:,:,cur_microlist(nt)) = minilist(:,:,i)
|
do k=1,Nint
|
||||||
|
microlist(k,1,cur_microlist(nt)) = minilist(k,1,i)
|
||||||
|
microlist(k,2,cur_microlist(nt)) = minilist(k,2,i)
|
||||||
|
enddo
|
||||||
cur_microlist(nt) = cur_microlist(nt) + 1
|
cur_microlist(nt) = cur_microlist(nt) + 1
|
||||||
end do
|
end do
|
||||||
end if
|
end if
|
||||||
@ -212,16 +228,6 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine merdge(mic, idx_mic, N_mic, mic0, idx_mic0, N_mic0, Nint)
|
|
||||||
use bitmasks
|
|
||||||
integer(bit_kind) :: mic(Nint,2,N_mic), mic0(Nint,2,*)
|
|
||||||
integer :: idx_mic(N_mic), idx_mic0(N_mic0), N_mic, N_mic0
|
|
||||||
|
|
||||||
mic0(:,:,N_mic0+1:N_mic0+N_mic) = mic(:,:,:)
|
|
||||||
idx_mic0(N_mic0+1:N_mic0+N_mic) = idx_mic(:)
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
|
subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -82,8 +82,8 @@ END_PROVIDER
|
|||||||
subroutine get_s2_u0_old(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2)
|
subroutine get_s2_u0_old(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2)
|
||||||
implicit none
|
implicit none
|
||||||
use bitmasks
|
use bitmasks
|
||||||
integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax)
|
|
||||||
integer, intent(in) :: n,nmax
|
integer, intent(in) :: n,nmax
|
||||||
|
integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax)
|
||||||
double precision, intent(in) :: psi_coefs_tmp(nmax)
|
double precision, intent(in) :: psi_coefs_tmp(nmax)
|
||||||
double precision, intent(out) :: s2
|
double precision, intent(out) :: s2
|
||||||
integer :: i,j,l
|
integer :: i,j,l
|
||||||
@ -109,8 +109,8 @@ end
|
|||||||
subroutine get_s2_u0(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2)
|
subroutine get_s2_u0(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2)
|
||||||
implicit none
|
implicit none
|
||||||
use bitmasks
|
use bitmasks
|
||||||
integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax)
|
|
||||||
integer, intent(in) :: n,nmax
|
integer, intent(in) :: n,nmax
|
||||||
|
integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax)
|
||||||
double precision, intent(in) :: psi_coefs_tmp(nmax)
|
double precision, intent(in) :: psi_coefs_tmp(nmax)
|
||||||
double precision, intent(out) :: s2
|
double precision, intent(out) :: s2
|
||||||
double precision :: s2_tmp
|
double precision :: s2_tmp
|
||||||
|
@ -845,25 +845,30 @@ subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullLis
|
|||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList)
|
|
||||||
integer, intent(in) :: N_fullList
|
integer, intent(in) :: N_fullList
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList)
|
||||||
integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList)
|
integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList)
|
||||||
integer,intent(out) :: idx_miniList(N_fullList), N_miniList
|
integer,intent(out) :: idx_miniList(N_fullList), N_miniList
|
||||||
integer, intent(in) :: Nint
|
|
||||||
integer(bit_kind) :: key_mask(Nint, 2)
|
integer(bit_kind) :: key_mask(Nint, 2)
|
||||||
integer :: ni, i, n_a, n_b, e_a, e_b
|
integer :: ni, k, i, n_a, n_b, e_a, e_b
|
||||||
|
|
||||||
|
|
||||||
n_a = 0
|
n_a = popcnt(key_mask(1,1))
|
||||||
n_b = 0
|
n_b = popcnt(key_mask(1,2))
|
||||||
do ni=1,nint
|
do ni=2,nint
|
||||||
n_a = n_a + popcnt(key_mask(ni,1))
|
n_a = n_a + popcnt(key_mask(ni,1))
|
||||||
n_b = n_b + popcnt(key_mask(ni,2))
|
n_b = n_b + popcnt(key_mask(ni,2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if(n_a == 0) then
|
if(n_a == 0) then
|
||||||
N_miniList = N_fullList
|
N_miniList = N_fullList
|
||||||
miniList(:,:,:) = fullList(:,:,:)
|
do k=1,N_fullList
|
||||||
|
do ni=1,Nint
|
||||||
|
miniList(ni,1,k) = fullList(ni,1,k)
|
||||||
|
miniList(ni,2,k) = fullList(ni,2,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
do i=1,N_fullList
|
do i=1,N_fullList
|
||||||
idx_miniList(i) = i
|
idx_miniList(i) = i
|
||||||
end do
|
end do
|
||||||
@ -873,16 +878,19 @@ subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullLis
|
|||||||
N_miniList = 0
|
N_miniList = 0
|
||||||
|
|
||||||
do i=1,N_fullList
|
do i=1,N_fullList
|
||||||
e_a = n_a
|
e_a = n_a - popcnt(iand(fullList(1, 1, i), key_mask(1, 1)))
|
||||||
e_b = n_b
|
e_b = n_b - popcnt(iand(fullList(1, 2, i), key_mask(1, 2)))
|
||||||
do ni=1,nint
|
do ni=2,nint
|
||||||
e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1)))
|
e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1)))
|
||||||
e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2)))
|
e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2)))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if(e_a + e_b <= 2) then
|
if(e_a + e_b <= 2) then
|
||||||
N_miniList = N_miniList + 1
|
N_miniList = N_miniList + 1
|
||||||
miniList(:,:,N_miniList) = fullList(:,:,i)
|
do ni=1,Nint
|
||||||
|
miniList(ni,1,N_miniList) = fullList(ni,1,i)
|
||||||
|
miniList(ni,2,N_miniList) = fullList(ni,2,i)
|
||||||
|
enddo
|
||||||
idx_miniList(N_miniList) = i
|
idx_miniList(N_miniList) = i
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
@ -892,29 +900,34 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis
|
|||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList)
|
|
||||||
integer, intent(in) :: N_fullList
|
integer, intent(in) :: N_fullList
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList)
|
||||||
integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList)
|
integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList)
|
||||||
integer(bit_kind) :: subList(Nint, 2, N_fullList)
|
integer(bit_kind) :: subList(Nint, 2, N_fullList)
|
||||||
logical,intent(out) :: fullMatch
|
logical,intent(out) :: fullMatch
|
||||||
integer,intent(out) :: N_miniList
|
integer,intent(out) :: N_miniList
|
||||||
integer, intent(in) :: Nint
|
|
||||||
integer(bit_kind) :: key_mask(Nint, 2)
|
integer(bit_kind) :: key_mask(Nint, 2)
|
||||||
integer :: ni, i, k, l, N_subList
|
integer :: ni, i, k, l, N_subList
|
||||||
|
|
||||||
|
|
||||||
fullMatch = .false.
|
fullMatch = .false.
|
||||||
l = 0
|
|
||||||
N_miniList = 0
|
N_miniList = 0
|
||||||
N_subList = 0
|
N_subList = 0
|
||||||
|
|
||||||
do ni = 1,Nint
|
l = popcnt(key_mask(1,1)) + popcnt(key_mask(1,2))
|
||||||
l += popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2))
|
do ni = 2,Nint
|
||||||
|
l = l + popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if(l == 0) then
|
if(l == 0) then
|
||||||
N_miniList = N_fullList
|
N_miniList = N_fullList
|
||||||
miniList(:,:,:N_miniList) = fullList(:,:,:N_minilist)
|
do k=1,N_fullList
|
||||||
|
do ni=1,Nint
|
||||||
|
miniList(ni,1,k) = fullList(ni,1,k)
|
||||||
|
miniList(ni,2,k) = fullList(ni,2,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
else
|
else
|
||||||
do i=N_fullList,1,-1
|
do i=N_fullList,1,-1
|
||||||
k = l
|
k = l
|
||||||
@ -923,10 +936,16 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis
|
|||||||
end do
|
end do
|
||||||
if(k == 2) then
|
if(k == 2) then
|
||||||
N_subList += 1
|
N_subList += 1
|
||||||
subList(:,:,N_subList) = fullList(:,:,i)
|
do ni=1,Nint
|
||||||
|
subList(ni,1,N_subList) = fullList(ni,1,i)
|
||||||
|
subList(ni,2,N_subList) = fullList(ni,2,i)
|
||||||
|
enddo
|
||||||
else if(k == 1) then
|
else if(k == 1) then
|
||||||
N_minilist += 1
|
N_minilist += 1
|
||||||
miniList(:,:,N_minilist) = fullList(:,:,i)
|
do ni=1,Nint
|
||||||
|
miniList(ni,1,N_minilist) = fullList(ni,1,i)
|
||||||
|
miniList(ni,2,N_minilist) = fullList(ni,2,i)
|
||||||
|
enddo
|
||||||
else if(k == 0) then
|
else if(k == 0) then
|
||||||
fullMatch = .true.
|
fullMatch = .true.
|
||||||
return
|
return
|
||||||
@ -935,7 +954,12 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis
|
|||||||
end if
|
end if
|
||||||
|
|
||||||
if(N_subList > 0) then
|
if(N_subList > 0) then
|
||||||
miniList(:,:,N_minilist+1:N_minilist+N_subList) = sublist(:,:,:N_subList)
|
do k=1,N_subList
|
||||||
|
do ni=1,Nint
|
||||||
|
miniList(ni,1,N_minilist+k) = sublist(ni,1,k)
|
||||||
|
miniList(ni,2,N_minilist+k) = sublist(ni,2,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
N_minilist = N_minilist + N_subList
|
N_minilist = N_minilist + N_subList
|
||||||
end if
|
end if
|
||||||
end subroutine
|
end subroutine
|
||||||
@ -972,6 +996,17 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
|
|||||||
i_H_psi_array = 0.d0
|
i_H_psi_array = 0.d0
|
||||||
|
|
||||||
call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx)
|
call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx)
|
||||||
|
if (Nstate == 1) then
|
||||||
|
|
||||||
|
do ii=1,idx(0)
|
||||||
|
i = idx(ii)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call i_H_j(keys(1,1,i),key,Nint,hij)
|
||||||
|
i_H_psi_array(1) = i_H_psi_array(1) + coef(i,1)*hij
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
do ii=1,idx(0)
|
do ii=1,idx(0)
|
||||||
i = idx(ii)
|
i = idx(ii)
|
||||||
!DIR$ FORCEINLINE
|
!DIR$ FORCEINLINE
|
||||||
@ -980,6 +1015,9 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
|
|||||||
i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij
|
i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -1012,6 +1050,18 @@ subroutine i_H_psi_minilist(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,
|
|||||||
i_H_psi_array = 0.d0
|
i_H_psi_array = 0.d0
|
||||||
|
|
||||||
call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx)
|
call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx)
|
||||||
|
if (Nstate == 1) then
|
||||||
|
|
||||||
|
do ii=1,idx(0)
|
||||||
|
i_in_key = idx(ii)
|
||||||
|
i_in_coef = idx_key(idx(ii))
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call i_H_j(keys(1,1,i_in_key),key,Nint,hij)
|
||||||
|
i_H_psi_array(1) = i_H_psi_array(1) + coef(i_in_coef,1)*hij
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
do ii=1,idx(0)
|
do ii=1,idx(0)
|
||||||
i_in_key = idx(ii)
|
i_in_key = idx(ii)
|
||||||
i_in_coef = idx_key(idx(ii))
|
i_in_coef = idx_key(idx(ii))
|
||||||
@ -1021,6 +1071,9 @@ subroutine i_H_psi_minilist(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,
|
|||||||
i_H_psi_array(j) = i_H_psi_array(j) + coef(i_in_coef,j)*hij
|
i_H_psi_array(j) = i_H_psi_array(j) + coef(i_in_coef,j)*hij
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine i_H_psi_sec_ord(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array,idx_interaction,interactions)
|
subroutine i_H_psi_sec_ord(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array,idx_interaction,interactions)
|
||||||
@ -1497,8 +1550,8 @@ subroutine get_occ_from_key(key,occ,Nint)
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Returns a list of occupation numbers from a bitstring
|
! Returns a list of occupation numbers from a bitstring
|
||||||
END_DOC
|
END_DOC
|
||||||
integer(bit_kind), intent(in) :: key(Nint,2)
|
|
||||||
integer , intent(in) :: Nint
|
integer , intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key(Nint,2)
|
||||||
integer , intent(out) :: occ(Nint*bit_kind_size,2)
|
integer , intent(out) :: occ(Nint*bit_kind_size,2)
|
||||||
integer :: tmp(2)
|
integer :: tmp(2)
|
||||||
|
|
||||||
|
@ -14,13 +14,13 @@ integer*8 function spin_det_search_key(det,Nint)
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: Nint
|
integer, intent(in) :: Nint
|
||||||
integer(bit_kind), intent(in) :: det(Nint)
|
integer(bit_kind), intent(in) :: det(Nint)
|
||||||
integer(bit_kind), parameter :: unsigned_shift = not(huge(1_bit_kind)) ! 100...00
|
integer(bit_kind), parameter :: unsigned_shift = -huge(1_bit_kind) ! 100...00
|
||||||
integer :: i
|
integer :: i
|
||||||
spin_det_search_key = det(1)
|
spin_det_search_key = det(1)
|
||||||
do i=2,Nint
|
do i=2,Nint
|
||||||
spin_det_search_key = ieor(spin_det_search_key,det(i))
|
spin_det_search_key = ieor(spin_det_search_key,det(i))
|
||||||
enddo
|
enddo
|
||||||
spin_det_search_key = spin_det_search_key-unsigned_shift
|
spin_det_search_key = spin_det_search_key+1_bit_kind-unsigned_shift
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -365,20 +365,31 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
|
|||||||
call cpu_time(cpu_1)
|
call cpu_time(cpu_1)
|
||||||
|
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
call new_parallel_job(zmq_to_qp_run_socket,'ao_integrals')
|
|
||||||
|
|
||||||
|
|
||||||
character*(32) :: task
|
character*(32) :: task
|
||||||
|
|
||||||
|
call new_parallel_job(zmq_to_qp_run_socket,'ao_integrals')
|
||||||
|
|
||||||
do l=1,ao_num
|
do l=1,ao_num
|
||||||
write(task,*) 'triangle', l
|
write(task,*) l
|
||||||
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
external :: ao_bielec_integrals_in_map_slave_inproc, ao_bielec_integrals_in_map_collector
|
integer(ZMQ_PTR) :: collector_thread
|
||||||
call new_parallel_threads(ao_bielec_integrals_in_map_slave_inproc, ao_bielec_integrals_in_map_collector)
|
external :: ao_bielec_integrals_in_map_collector
|
||||||
|
rc = pthread_create(collector_thread, ao_bielec_integrals_in_map_collector)
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(private)
|
||||||
|
!$OMP TASK PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call ao_bielec_integrals_in_map_slave_inproc(i)
|
||||||
|
!$OMP END TASK
|
||||||
|
!$OMP TASKWAIT
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
rc = pthread_join(collector_thread)
|
||||||
|
|
||||||
|
call end_parallel_job(zmq_to_qp_run_socket, 'ao_integrals')
|
||||||
|
|
||||||
call end_parallel_job(zmq_to_qp_run_socket,'ao_integrals')
|
|
||||||
|
|
||||||
print*, 'Sorting the map'
|
print*, 'Sorting the map'
|
||||||
call map_sort(ao_integrals_map)
|
call map_sort(ao_integrals_map)
|
||||||
|
@ -1,20 +1,73 @@
|
|||||||
subroutine ao_bielec_integrals_in_map_slave_tcp
|
subroutine ao_bielec_integrals_in_map_slave_tcp(i)
|
||||||
implicit none
|
implicit none
|
||||||
|
integer, intent(in) :: i
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Computes a buffer of integrals
|
! Computes a buffer of integrals. i is the ID of the current thread.
|
||||||
END_DOC
|
END_DOC
|
||||||
call ao_bielec_integrals_in_map_slave(0)
|
call ao_bielec_integrals_in_map_slave(0,i)
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine ao_bielec_integrals_in_map_slave_inproc
|
|
||||||
|
subroutine ao_bielec_integrals_in_map_slave_inproc(i)
|
||||||
implicit none
|
implicit none
|
||||||
|
integer, intent(in) :: i
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Computes a buffer of integrals
|
! Computes a buffer of integrals. i is the ID of the current thread.
|
||||||
END_DOC
|
END_DOC
|
||||||
call ao_bielec_integrals_in_map_slave(1)
|
call ao_bielec_integrals_in_map_slave(1,i)
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine ao_bielec_integrals_in_map_slave(thread)
|
|
||||||
|
subroutine push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
|
||||||
|
use f77_zmq
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Push integrals in the push socket
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
|
integer, intent(in) :: n_integrals
|
||||||
|
integer(key_kind), intent(in) :: buffer_i(*)
|
||||||
|
real(integral_kind), intent(in) :: buffer_value(*)
|
||||||
|
integer, intent(in) :: task_id
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, n_integrals, 4, ZMQ_SNDMORE)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, n_integrals, 4, ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE)
|
||||||
|
if (rc /= key_kind*n_integrals) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, ZMQ_SNDMORE)
|
||||||
|
if (rc /= integral_kind*n_integrals) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, 'f77_zmq_send( zmq_socket_push, task_id, 4, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Activate is zmq_socket_push is a REQ
|
||||||
|
! integer :: idummy
|
||||||
|
! rc = f77_zmq_recv( zmq_socket_push, idummy, 4, 0)
|
||||||
|
! if (rc /= 4) then
|
||||||
|
! print *, irp_here, 'f77_zmq_send( zmq_socket_push, idummy, 4, 0)'
|
||||||
|
! stop 'error'
|
||||||
|
! endif
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ao_bielec_integrals_in_map_slave(thread,iproc)
|
||||||
use map_module
|
use map_module
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
@ -22,7 +75,7 @@ subroutine ao_bielec_integrals_in_map_slave(thread)
|
|||||||
! Computes a buffer of integrals
|
! Computes a buffer of integrals
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
integer, intent(in) :: thread
|
integer, intent(in) :: thread, iproc
|
||||||
|
|
||||||
integer :: j,l,n_integrals
|
integer :: j,l,n_integrals
|
||||||
integer :: rc
|
integer :: rc
|
||||||
@ -35,19 +88,11 @@ subroutine ao_bielec_integrals_in_map_slave(thread)
|
|||||||
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
integer(ZMQ_PTR), external :: new_zmq_push_socket
|
||||||
|
|
||||||
integer(ZMQ_PTR) :: zmq_socket_push
|
integer(ZMQ_PTR) :: zmq_socket_push
|
||||||
! zmq_socket_push = f77_zmq_socket(zmq_context, ZMQ_PUSH)
|
|
||||||
zmq_socket_push = f77_zmq_socket(zmq_context, ZMQ_REQ )
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
if (thread == 1) then
|
zmq_socket_push = new_zmq_push_socket(thread)
|
||||||
rc = f77_zmq_connect(zmq_socket_push, trim(zmq_socket_pull_inproc_address))
|
|
||||||
else
|
|
||||||
rc = f77_zmq_connect(zmq_socket_push, trim(zmq_socket_push_tcp_address))
|
|
||||||
endif
|
|
||||||
if (rc /= 0) then
|
|
||||||
stop 'Unable to connect zmq_socket_push_tcp'
|
|
||||||
endif
|
|
||||||
|
|
||||||
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
|
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
|
||||||
|
|
||||||
@ -55,31 +100,78 @@ subroutine ao_bielec_integrals_in_map_slave(thread)
|
|||||||
|
|
||||||
do
|
do
|
||||||
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
|
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
|
||||||
if (task_id == 0) then
|
if (task_id == 0) exit
|
||||||
exit
|
read(task,*) l
|
||||||
endif
|
do j=1,l-1
|
||||||
read(task,*) j, l
|
|
||||||
call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
|
call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
|
||||||
rc = f77_zmq_send( zmq_socket_push, n_integrals, 4, ZMQ_SNDMORE)
|
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, 0)
|
||||||
rc = f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE)
|
enddo
|
||||||
rc = f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, 0)
|
call compute_ao_integrals_jl(l,l,n_integrals,buffer_i,buffer_value)
|
||||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_integrals)
|
||||||
character*(2) :: ok
|
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
|
||||||
rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
deallocate( buffer_i, buffer_value )
|
deallocate( buffer_i, buffer_value )
|
||||||
|
|
||||||
integer :: finished
|
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
|
||||||
call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id,finished)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
|
|
||||||
if (finished /= 0) then
|
end
|
||||||
rc = f77_zmq_send( zmq_socket_push, -1, 4, 0)
|
|
||||||
rc = f77_zmq_recv( zmq_socket_push, ok, 2, ZMQ_NOBLOCK)
|
|
||||||
|
subroutine pull_integrals(zmq_socket_pull, n_integrals, buffer_i, buffer_value, task_id)
|
||||||
|
use f77_zmq
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! How the collector pulls the computed integrals
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(out) :: zmq_socket_pull
|
||||||
|
integer, intent(out) :: n_integrals
|
||||||
|
integer(key_kind), intent(out) :: buffer_i(*)
|
||||||
|
real(integral_kind), intent(out) :: buffer_value(*)
|
||||||
|
integer, intent(out) :: task_id
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
|
||||||
|
if (rc == -1) then
|
||||||
|
n_integrals = 0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)'
|
||||||
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_disconnect(zmq_socket_push,trim(zmq_socket_push_tcp_address))
|
if (n_integrals >= 0) then
|
||||||
rc = f77_zmq_close(zmq_socket_push)
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
|
||||||
|
if (rc /= key_kind*n_integrals) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
|
||||||
|
if (rc /= integral_kind*n_integrals) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Activate if zmq_socket_pull is a REP
|
||||||
|
! rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
|
||||||
|
! if (rc /= 4) then
|
||||||
|
! print *, irp_here, ' f77_zmq_send (zmq_socket_pull,...'
|
||||||
|
! stop 'error'
|
||||||
|
! endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -94,27 +186,54 @@ subroutine ao_bielec_integrals_in_map_collector
|
|||||||
|
|
||||||
integer :: j,l,n_integrals
|
integer :: j,l,n_integrals
|
||||||
integer :: rc
|
integer :: rc
|
||||||
|
|
||||||
real(integral_kind), allocatable :: buffer_value(:)
|
real(integral_kind), allocatable :: buffer_value(:)
|
||||||
integer(key_kind), allocatable :: buffer_i(:)
|
integer(key_kind), allocatable :: buffer_i(:)
|
||||||
|
|
||||||
|
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_pull_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_socket_pull
|
||||||
|
|
||||||
|
integer*8 :: control, accu
|
||||||
|
integer :: task_id, more
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
zmq_socket_pull = new_zmq_pull_socket()
|
||||||
|
|
||||||
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
|
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
|
||||||
|
|
||||||
n_integrals = 0
|
accu = 0_8
|
||||||
do while (n_integrals >= 0)
|
more = 1
|
||||||
|
do while (more == 1)
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
|
call pull_integrals(zmq_socket_pull, n_integrals, buffer_i, buffer_value, task_id)
|
||||||
if (n_integrals >= 0) then
|
if (n_integrals >= 0) then
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
|
|
||||||
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
|
|
||||||
call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value)
|
call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value)
|
||||||
else
|
accu += n_integrals
|
||||||
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
|
if (task_id /= 0) then
|
||||||
|
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more)
|
||||||
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
deallocate( buffer_i, buffer_value )
|
deallocate( buffer_i, buffer_value )
|
||||||
|
|
||||||
|
integer (map_size_kind) :: get_ao_map_size
|
||||||
|
control = get_ao_map_size(ao_integrals_map)
|
||||||
|
|
||||||
|
if (control /= accu) then
|
||||||
|
print *, irp_here, 'Control : ', control
|
||||||
|
print *, 'Accu : ', accu
|
||||||
|
print *, 'Some integrals were lost during the parallel computation. (2)'
|
||||||
|
print *, 'Try to reduce the number of threads.'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
call end_zmq_pull_socket(zmq_socket_pull)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -36,7 +36,7 @@ BEGIN_PROVIDER [ logical, mo_bielec_integrals_in_map ]
|
|||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
||||||
call add_integrals_to_map(full_ijkl_bitmask)
|
call add_integrals_to_map(full_ijkl_bitmask_4)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
subroutine add_integrals_to_map(mask_ijkl)
|
subroutine add_integrals_to_map(mask_ijkl)
|
||||||
@ -90,8 +90,6 @@ subroutine add_integrals_to_map(mask_ijkl)
|
|||||||
|
|
||||||
call wall_time(wall_1)
|
call wall_time(wall_1)
|
||||||
call cpu_time(cpu_1)
|
call cpu_time(cpu_1)
|
||||||
PROVIDE progress_bar
|
|
||||||
call start_progress(ao_num,'MO integrals (MB)',0.d0)
|
|
||||||
|
|
||||||
!$OMP PARALLEL PRIVATE(l1,k1,j1,i1,i2,i3,i4,i,j,k,l,c, ii1,kmax, &
|
!$OMP PARALLEL PRIVATE(l1,k1,j1,i1,i2,i3,i4,i,j,k,l,c, ii1,kmax, &
|
||||||
!$OMP bielec_tmp_0_idx, bielec_tmp_0, bielec_tmp_1,bielec_tmp_2,bielec_tmp_3,&
|
!$OMP bielec_tmp_0_idx, bielec_tmp_0, bielec_tmp_1,bielec_tmp_2,bielec_tmp_3,&
|
||||||
@ -101,9 +99,10 @@ subroutine add_integrals_to_map(mask_ijkl)
|
|||||||
!$OMP SHARED(size_buffer,ao_num,mo_tot_num,n_i,n_j,n_k,n_l,mo_tot_num_align,&
|
!$OMP SHARED(size_buffer,ao_num,mo_tot_num,n_i,n_j,n_k,n_l,mo_tot_num_align,&
|
||||||
!$OMP mo_coef_transp, &
|
!$OMP mo_coef_transp, &
|
||||||
!$OMP mo_coef_transp_is_built, list_ijkl, &
|
!$OMP mo_coef_transp_is_built, list_ijkl, &
|
||||||
!$OMP mo_coef_is_built, wall_1, abort_here, &
|
!$OMP mo_coef_is_built, wall_1, &
|
||||||
!$OMP mo_coef,mo_integrals_threshold,mo_integrals_map,progress_bar,progress_value)
|
!$OMP mo_coef,mo_integrals_threshold,mo_integrals_map)
|
||||||
n_integrals = 0
|
n_integrals = 0
|
||||||
|
wall_0 = wall_1
|
||||||
allocate(bielec_tmp_3(mo_tot_num_align, n_j, n_k), &
|
allocate(bielec_tmp_3(mo_tot_num_align, n_j, n_k), &
|
||||||
bielec_tmp_1(mo_tot_num_align), &
|
bielec_tmp_1(mo_tot_num_align), &
|
||||||
bielec_tmp_0(ao_num,ao_num), &
|
bielec_tmp_0(ao_num,ao_num), &
|
||||||
@ -112,20 +111,15 @@ subroutine add_integrals_to_map(mask_ijkl)
|
|||||||
buffer_i(size_buffer), &
|
buffer_i(size_buffer), &
|
||||||
buffer_value(size_buffer) )
|
buffer_value(size_buffer) )
|
||||||
|
|
||||||
|
thread_num = 0
|
||||||
!$ thread_num = omp_get_thread_num()
|
!$ thread_num = omp_get_thread_num()
|
||||||
!$OMP DO SCHEDULE(guided)
|
!$OMP DO SCHEDULE(guided)
|
||||||
do l1 = 1,ao_num
|
do l1 = 1,ao_num
|
||||||
if (thread_num == 0) then
|
!IRP_IF COARRAY
|
||||||
progress_bar(1) = l1
|
! if (mod(l1-this_image(),num_images()) /= 0 ) then
|
||||||
endif
|
! cycle
|
||||||
IRP_IF COARRAY
|
! endif
|
||||||
if (mod(l1-this_image(),num_images()) /= 0 ) then
|
!IRP_ENDIF
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
IRP_ENDIF
|
|
||||||
if (abort_here) then
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
!DEC$ VECTOR ALIGNED
|
!DEC$ VECTOR ALIGNED
|
||||||
bielec_tmp_3 = 0.d0
|
bielec_tmp_3 = 0.d0
|
||||||
do k1 = 1,ao_num
|
do k1 = 1,ao_num
|
||||||
@ -274,8 +268,6 @@ IRP_ENDIF
|
|||||||
wall_0 = wall_2
|
wall_0 = wall_2
|
||||||
print*, 100.*float(l1)/float(ao_num), '% in ', &
|
print*, 100.*float(l1)/float(ao_num), '% in ', &
|
||||||
wall_2-wall_1, 's', map_mb(mo_integrals_map) ,'MB'
|
wall_2-wall_1, 's', map_mb(mo_integrals_map) ,'MB'
|
||||||
progress_value = dble(map_mb(mo_integrals_map))
|
|
||||||
|
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
@ -286,14 +278,10 @@ IRP_ENDIF
|
|||||||
real(mo_integrals_threshold,integral_kind))
|
real(mo_integrals_threshold,integral_kind))
|
||||||
deallocate(buffer_i, buffer_value)
|
deallocate(buffer_i, buffer_value)
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
call stop_progress
|
!IRP_IF COARRAY
|
||||||
if (abort_here) then
|
! print*, 'Communicating the map'
|
||||||
stop 'Aborting in MO integrals calculation'
|
! call communicate_mo_integrals()
|
||||||
endif
|
!IRP_ENDIF
|
||||||
IRP_IF COARRAY
|
|
||||||
print*, 'Communicating the map'
|
|
||||||
call communicate_mo_integrals()
|
|
||||||
IRP_ENDIF
|
|
||||||
call map_unique(mo_integrals_map)
|
call map_unique(mo_integrals_map)
|
||||||
|
|
||||||
call wall_time(wall_2)
|
call wall_time(wall_2)
|
||||||
@ -354,7 +342,7 @@ end
|
|||||||
!$OMP PRIVATE (i,j,p,q,r,s,integral,c,n,pp,int_value,int_idx, &
|
!$OMP PRIVATE (i,j,p,q,r,s,integral,c,n,pp,int_value,int_idx, &
|
||||||
!$OMP iqrs, iqsr,iqri,iqis) &
|
!$OMP iqrs, iqsr,iqri,iqis) &
|
||||||
!$OMP SHARED(mo_tot_num,mo_coef_transp,mo_tot_num_align,ao_num,&
|
!$OMP SHARED(mo_tot_num,mo_coef_transp,mo_tot_num_align,ao_num,&
|
||||||
!$OMP ao_integrals_threshold,do_direct_integrals,abort_here) &
|
!$OMP ao_integrals_threshold,do_direct_integrals) &
|
||||||
!$OMP REDUCTION(+:mo_bielec_integral_jj_from_ao,mo_bielec_integral_jj_exchange_from_ao)
|
!$OMP REDUCTION(+:mo_bielec_integral_jj_from_ao,mo_bielec_integral_jj_exchange_from_ao)
|
||||||
|
|
||||||
allocate( int_value(ao_num), int_idx(ao_num), &
|
allocate( int_value(ao_num), int_idx(ao_num), &
|
||||||
@ -363,9 +351,6 @@ end
|
|||||||
|
|
||||||
!$OMP DO SCHEDULE (guided)
|
!$OMP DO SCHEDULE (guided)
|
||||||
do s=1,ao_num
|
do s=1,ao_num
|
||||||
if (abort_here) then
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
do q=1,ao_num
|
do q=1,ao_num
|
||||||
|
|
||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
@ -451,9 +436,6 @@ end
|
|||||||
!$OMP END DO NOWAIT
|
!$OMP END DO NOWAIT
|
||||||
deallocate(iqrs,iqsr,int_value,int_idx)
|
deallocate(iqrs,iqsr,int_value,int_idx)
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
if (abort_here) then
|
|
||||||
stop 'Aborting in MO integrals calculation'
|
|
||||||
endif
|
|
||||||
|
|
||||||
mo_bielec_integral_jj_anti_from_ao = mo_bielec_integral_jj_from_ao - mo_bielec_integral_jj_exchange_from_ao
|
mo_bielec_integral_jj_anti_from_ao = mo_bielec_integral_jj_from_ao - mo_bielec_integral_jj_exchange_from_ao
|
||||||
|
|
||||||
|
@ -1,9 +1,14 @@
|
|||||||
program qp_ao_ints
|
program qp_ao_ints
|
||||||
|
use omp_lib
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Increments a running calculation to compute AO integrals
|
! Increments a running calculation to compute AO integrals
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
|
||||||
|
call switch_qp_run_to_master
|
||||||
|
|
||||||
|
PROVIDE zmq_context
|
||||||
! Set the state of the ZMQ
|
! Set the state of the ZMQ
|
||||||
zmq_state = 'ao_integrals'
|
zmq_state = 'ao_integrals'
|
||||||
|
|
||||||
@ -11,8 +16,9 @@ program qp_ao_ints
|
|||||||
double precision :: integral, ao_bielec_integral
|
double precision :: integral, ao_bielec_integral
|
||||||
integral = ao_bielec_integral(1,1,1,1)
|
integral = ao_bielec_integral(1,1,1,1)
|
||||||
|
|
||||||
!$OMP PARALLEL DEFAULT(PRIVATE)
|
!$OMP PARALLEL DEFAULT(PRIVATE) PRIVATE(i)
|
||||||
call ao_bielec_integrals_in_map_slave_tcp
|
i = omp_get_thread_num()
|
||||||
|
call ao_bielec_integrals_in_map_slave_tcp(i)
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
print *, 'Done'
|
print *, 'Done'
|
||||||
|
@ -139,6 +139,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
|
|||||||
! int{dr} of (x-A_x)^ax (x-B_X)^bx exp(-alpha (x-A_x)^2 - beta (x-B_x)^2 ) 1/(r-R_c)
|
! int{dr} of (x-A_x)^ax (x-B_X)^bx exp(-alpha (x-A_x)^2 - beta (x-B_x)^2 ) 1/(r-R_c)
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
integer, intent(in) :: n_pt_in
|
||||||
double precision,intent(in) :: C_center(3),A_center(3),B_center(3),alpha,beta
|
double precision,intent(in) :: C_center(3),A_center(3),B_center(3),alpha,beta
|
||||||
integer :: power_A(3),power_B(3)
|
integer :: power_A(3),power_B(3)
|
||||||
integer :: i,j,k,l,n_pt
|
integer :: i,j,k,l,n_pt
|
||||||
@ -146,6 +147,8 @@ double precision :: P_center(3)
|
|||||||
double precision :: d(0:n_pt_in),pouet,coeff,rho,dist,const,pouet_2,p,p_inv,factor
|
double precision :: d(0:n_pt_in),pouet,coeff,rho,dist,const,pouet_2,p,p_inv,factor
|
||||||
double precision :: I_n_special_exact,integrate_bourrin,I_n_bibi
|
double precision :: I_n_special_exact,integrate_bourrin,I_n_bibi
|
||||||
double precision :: V_e_n,const_factor,dist_integral,tmp
|
double precision :: V_e_n,const_factor,dist_integral,tmp
|
||||||
|
double precision :: accu,epsilo,rint
|
||||||
|
integer :: n_pt_out,lmax
|
||||||
include 'Utils/constants.include.F'
|
include 'Utils/constants.include.F'
|
||||||
if ( (A_center(1)/=B_center(1)).or. &
|
if ( (A_center(1)/=B_center(1)).or. &
|
||||||
(A_center(2)/=B_center(2)).or. &
|
(A_center(2)/=B_center(2)).or. &
|
||||||
@ -198,8 +201,6 @@ include 'Utils/constants.include.F'
|
|||||||
NAI_pol_mult = 0.d0
|
NAI_pol_mult = 0.d0
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
double precision :: accu,epsilo,rint
|
|
||||||
integer :: n_pt_in,n_pt_out,lmax
|
|
||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
|
|
||||||
! 1/r1 standard attraction integral
|
! 1/r1 standard attraction integral
|
||||||
|
@ -146,9 +146,9 @@ subroutine ao_to_mo(A_ao,LDA_ao,A_mo,LDA_mo)
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Transform A from the AO basis to the MO basis
|
! Transform A from the AO basis to the MO basis
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
double precision, intent(in) :: A_ao(LDA_ao)
|
double precision, intent(in) :: A_ao(LDA_ao)
|
||||||
double precision, intent(out) :: A_mo(LDA_mo)
|
double precision, intent(out) :: A_mo(LDA_mo)
|
||||||
integer, intent(in) :: LDA_ao,LDA_mo
|
|
||||||
double precision, allocatable :: T(:,:)
|
double precision, allocatable :: T(:,:)
|
||||||
|
|
||||||
allocate ( T(ao_num_align,mo_tot_num) )
|
allocate ( T(ao_num_align,mo_tot_num) )
|
||||||
@ -172,9 +172,9 @@ subroutine mo_to_ao(A_mo,LDA_mo,A_ao,LDA_ao)
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Transform A from the MO basis to the AO basis
|
! Transform A from the MO basis to the AO basis
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
double precision, intent(in) :: A_mo(LDA_mo)
|
double precision, intent(in) :: A_mo(LDA_mo)
|
||||||
double precision, intent(out) :: A_ao(LDA_ao)
|
double precision, intent(out) :: A_ao(LDA_ao)
|
||||||
integer, intent(in) :: LDA_ao,LDA_mo
|
|
||||||
double precision, allocatable :: T(:,:), SC(:,:)
|
double precision, allocatable :: T(:,:), SC(:,:)
|
||||||
|
|
||||||
allocate ( SC(ao_num_align,mo_tot_num) )
|
allocate ( SC(ao_num_align,mo_tot_num) )
|
||||||
@ -204,9 +204,9 @@ subroutine mo_to_ao_no_overlap(A_mo,LDA_mo,A_ao,LDA_ao)
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Transform A from the MO basis to the S^-1 AO basis
|
! Transform A from the MO basis to the S^-1 AO basis
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
double precision, intent(in) :: A_mo(LDA_mo)
|
double precision, intent(in) :: A_mo(LDA_mo)
|
||||||
double precision, intent(out) :: A_ao(LDA_ao)
|
double precision, intent(out) :: A_ao(LDA_ao)
|
||||||
integer, intent(in) :: LDA_ao,LDA_mo
|
|
||||||
double precision, allocatable :: T(:,:)
|
double precision, allocatable :: T(:,:)
|
||||||
|
|
||||||
allocate ( T(mo_tot_num_align,ao_num) )
|
allocate ( T(mo_tot_num_align,ao_num) )
|
||||||
|
@ -76,22 +76,22 @@ subroutine mo_as_eigvectors_of_mo_matrix(matrix,n,m,label,sign)
|
|||||||
mo_coef_new = mo_coef
|
mo_coef_new = mo_coef
|
||||||
|
|
||||||
call lapack_diag(eigvalues,R,A,n,m)
|
call lapack_diag(eigvalues,R,A,n,m)
|
||||||
write (output_mo_basis,'(A)'), 'MOs are now **'//trim(label)//'**'
|
write (output_mo_basis,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
write (output_mo_basis,'(A)'), 'Eigenvalues'
|
write (output_mo_basis,'(A)') 'Eigenvalues'
|
||||||
write (output_mo_basis,'(A)'), '-----------'
|
write (output_mo_basis,'(A)') '-----------'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
write (output_mo_basis,'(A)'), '======== ================'
|
write (output_mo_basis,'(A)') '======== ================'
|
||||||
if (sign == -1) then
|
if (sign == -1) then
|
||||||
do i=1,m
|
do i=1,m
|
||||||
eigvalues(i) = -eigvalues(i)
|
eigvalues(i) = -eigvalues(i)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
do i=1,m
|
do i=1,m
|
||||||
write (output_mo_basis,'(I8,X,F16.10)'), i,eigvalues(i)
|
write (output_mo_basis,'(I8,X,F16.10)') i,eigvalues(i)
|
||||||
enddo
|
enddo
|
||||||
write (output_mo_basis,'(A)'), '======== ================'
|
write (output_mo_basis,'(A)') '======== ================'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
|
|
||||||
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),R,size(R,1),0.d0,mo_coef,size(mo_coef,1))
|
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),R,size(R,1),0.d0,mo_coef,size(mo_coef,1))
|
||||||
deallocate(A,mo_coef_new,R,eigvalues)
|
deallocate(A,mo_coef_new,R,eigvalues)
|
||||||
@ -127,18 +127,18 @@ subroutine mo_as_svd_vectors_of_mo_matrix(matrix,lda,m,n,label)
|
|||||||
|
|
||||||
call svd(A,lda,U,lda,D,Vt,lda,m,n)
|
call svd(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
write (output_mo_basis,'(A)'), 'MOs are now **'//trim(label)//'**'
|
write (output_mo_basis,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
write (output_mo_basis,'(A)'), 'Eigenvalues'
|
write (output_mo_basis,'(A)') 'Eigenvalues'
|
||||||
write (output_mo_basis,'(A)'), '-----------'
|
write (output_mo_basis,'(A)') '-----------'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
write (output_mo_basis,'(A)'), '======== ================'
|
write (output_mo_basis,'(A)') '======== ================'
|
||||||
|
|
||||||
do i=1,m
|
do i=1,m
|
||||||
write (output_mo_basis,'(I8,X,F16.10)'), i,D(i)
|
write (output_mo_basis,'(I8,X,F16.10)') i,D(i)
|
||||||
enddo
|
enddo
|
||||||
write (output_mo_basis,'(A)'), '======== ================'
|
write (output_mo_basis,'(A)') '======== ================'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
|
|
||||||
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),U,size(U,1),0.d0,mo_coef,size(mo_coef,1))
|
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),U,size(U,1),0.d0,mo_coef,size(mo_coef,1))
|
||||||
deallocate(A,mo_coef_new,U,Vt,D)
|
deallocate(A,mo_coef_new,U,Vt,D)
|
||||||
@ -208,17 +208,17 @@ subroutine mo_as_eigvectors_of_mo_matrix_sort_by_observable(matrix,observable,n,
|
|||||||
print*,''
|
print*,''
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
write (output_mo_basis,'(A)'), 'MOs are now **'//trim(label)//'**'
|
write (output_mo_basis,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
write (output_mo_basis,'(A)'), 'Eigenvalues'
|
write (output_mo_basis,'(A)') 'Eigenvalues'
|
||||||
write (output_mo_basis,'(A)'), '-----------'
|
write (output_mo_basis,'(A)') '-----------'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
write (output_mo_basis,'(A)'), '======== ================'
|
write (output_mo_basis,'(A)') '======== ================'
|
||||||
do i = 1, m
|
do i = 1, m
|
||||||
write (output_mo_basis,'(I8,X,F16.10)'), i,eigvalues(i)
|
write (output_mo_basis,'(I8,X,F16.10)') i,eigvalues(i)
|
||||||
enddo
|
enddo
|
||||||
write (output_mo_basis,'(A)'), '======== ================'
|
write (output_mo_basis,'(A)') '======== ================'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
|
|
||||||
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),R,size(R,1),0.d0,mo_coef,size(mo_coef,1))
|
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),R,size(R,1),0.d0,mo_coef,size(mo_coef,1))
|
||||||
deallocate(mo_coef_new,R,eigvalues)
|
deallocate(mo_coef_new,R,eigvalues)
|
||||||
@ -256,8 +256,8 @@ subroutine mo_sort_by_observable(observable,label)
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
write (output_mo_basis,'(A)'), 'MOs are now **'//trim(label)//'**'
|
write (output_mo_basis,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
write (output_mo_basis,'(A)'), ''
|
write (output_mo_basis,'(A)') ''
|
||||||
|
|
||||||
|
|
||||||
deallocate(mo_coef_new,value)
|
deallocate(mo_coef_new,value)
|
||||||
|
@ -277,10 +277,10 @@ subroutine apply_rotation(A,LDA,R,LDR,B,LDB,m,n)
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Apply the rotation found by find_rotation
|
! Apply the rotation found by find_rotation
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer, intent(in) :: m,n, LDA, LDB, LDR
|
||||||
double precision, intent(in) :: R(LDR,n)
|
double precision, intent(in) :: R(LDR,n)
|
||||||
double precision, intent(in) :: A(LDA,n)
|
double precision, intent(in) :: A(LDA,n)
|
||||||
double precision, intent(out) :: B(LDB,n)
|
double precision, intent(out) :: B(LDB,n)
|
||||||
integer, intent(in) :: m,n, LDA, LDB, LDR
|
|
||||||
call dgemm('N','N',m,n,n,1.d0,A,LDA,R,LDR,0.d0,B,LDB)
|
call dgemm('N','N',m,n,n,1.d0,A,LDA,R,LDR,0.d0,B,LDB)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -1,47 +0,0 @@
|
|||||||
BEGIN_PROVIDER [ logical, abort_all ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! If True, all the calculation is aborted
|
|
||||||
END_DOC
|
|
||||||
call trap_signals
|
|
||||||
abort_all = .False.
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ logical, abort_here ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! If True, all the calculation is aborted
|
|
||||||
END_DOC
|
|
||||||
abort_here = abort_all
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
subroutine trap_signals
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! What to do when a signal is caught. Here, trap Ctrl-C and call the control_C subroutine.
|
|
||||||
END_DOC
|
|
||||||
integer, external :: catch_signal
|
|
||||||
integer :: sigusr2, status
|
|
||||||
sigusr2 = 12
|
|
||||||
call signal (sigusr2, catch_signal,status)
|
|
||||||
end subroutine trap_signals
|
|
||||||
|
|
||||||
integer function catch_signal(signum)
|
|
||||||
implicit none
|
|
||||||
integer, intent(in) :: signum
|
|
||||||
BEGIN_DOC
|
|
||||||
! What to do on Ctrl-C. If two Ctrl-C are pressed within 1 sec, the calculation if aborted.
|
|
||||||
END_DOC
|
|
||||||
double precision, save :: last_time
|
|
||||||
double precision :: this_time
|
|
||||||
catch_signal = 0
|
|
||||||
call wall_time(this_time)
|
|
||||||
if (this_time - last_time < 1.d0) then
|
|
||||||
print *, 'Caught Signal ', signum
|
|
||||||
abort_all = .True.
|
|
||||||
endif
|
|
||||||
last_time = this_time
|
|
||||||
abort_here = .True.
|
|
||||||
end
|
|
||||||
|
|
@ -76,7 +76,6 @@ subroutine cache_map_init(map,sze)
|
|||||||
NULLIFY(map%value, map%key)
|
NULLIFY(map%value, map%key)
|
||||||
call cache_map_reallocate(map,sze)
|
call cache_map_reallocate(map,sze)
|
||||||
call omp_unset_lock(map%lock)
|
call omp_unset_lock(map%lock)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine map_init(map,keymax)
|
subroutine map_init(map,keymax)
|
||||||
|
@ -59,8 +59,8 @@ recursive subroutine run_progress
|
|||||||
write(unit=0,fmt="(a1,a1,a70)") '+',char(13), bar
|
write(unit=0,fmt="(a1,a1,a70)") '+',char(13), bar
|
||||||
else
|
else
|
||||||
prog = int( progress_bar(1)*100./progress_bar(2) )
|
prog = int( progress_bar(1)*100./progress_bar(2) )
|
||||||
write(bar(1:25),'(A)'),progress_title
|
write(bar(1:25),'(A)') progress_title
|
||||||
write(bar(29:47),'(G17.10)'),progress_value
|
write(bar(29:47),'(G17.10)') progress_value
|
||||||
write(bar(72:74),'(i3)') prog
|
write(bar(72:74),'(i3)') prog
|
||||||
|
|
||||||
integer :: k,j
|
integer :: k,j
|
||||||
|
@ -6,9 +6,9 @@ BEGIN_TEMPLATE
|
|||||||
! iorder in input should be (1,2,3,...,isize), and in output
|
! iorder in input should be (1,2,3,...,isize), and in output
|
||||||
! contains the new order of the elements.
|
! contains the new order of the elements.
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer,intent(in) :: isize
|
||||||
$type,intent(inout) :: x(isize)
|
$type,intent(inout) :: x(isize)
|
||||||
integer,intent(inout) :: iorder(isize)
|
integer,intent(inout) :: iorder(isize)
|
||||||
integer,intent(in) :: isize
|
|
||||||
$type :: xtmp
|
$type :: xtmp
|
||||||
integer :: i, i0, j, jmax
|
integer :: i, i0, j, jmax
|
||||||
|
|
||||||
@ -36,9 +36,9 @@ BEGIN_TEMPLATE
|
|||||||
! iorder in input should be (1,2,3,...,isize), and in output
|
! iorder in input should be (1,2,3,...,isize), and in output
|
||||||
! contains the new order of the elements.
|
! contains the new order of the elements.
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer,intent(in) :: isize
|
||||||
$type,intent(inout) :: x(isize)
|
$type,intent(inout) :: x(isize)
|
||||||
integer,intent(inout) :: iorder(isize)
|
integer,intent(inout) :: iorder(isize)
|
||||||
integer,intent(in) :: isize
|
|
||||||
|
|
||||||
integer :: i, k, j, l, i0
|
integer :: i, k, j, l, i0
|
||||||
$type :: xtemp
|
$type :: xtemp
|
||||||
@ -101,9 +101,9 @@ BEGIN_TEMPLATE
|
|||||||
! This is a version for very large arrays where the indices need
|
! This is a version for very large arrays where the indices need
|
||||||
! to be in integer*8 format
|
! to be in integer*8 format
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer*8,intent(in) :: isize
|
||||||
$type,intent(inout) :: x(isize)
|
$type,intent(inout) :: x(isize)
|
||||||
integer*8,intent(inout) :: iorder(isize)
|
integer*8,intent(inout) :: iorder(isize)
|
||||||
integer*8,intent(in) :: isize
|
|
||||||
|
|
||||||
integer*8 :: i, k, j, l, i0
|
integer*8 :: i, k, j, l, i0
|
||||||
$type :: xtemp
|
$type :: xtemp
|
||||||
@ -165,9 +165,9 @@ BEGIN_TEMPLATE
|
|||||||
! iorder in input should be (1,2,3,...,isize), and in output
|
! iorder in input should be (1,2,3,...,isize), and in output
|
||||||
! contains the new order of the elements.
|
! contains the new order of the elements.
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer,intent(in) :: isize
|
||||||
$type,intent(inout) :: x(isize)
|
$type,intent(inout) :: x(isize)
|
||||||
integer,intent(inout) :: iorder(isize)
|
integer,intent(inout) :: iorder(isize)
|
||||||
integer,intent(in) :: isize
|
|
||||||
if (isize < 32) then
|
if (isize < 32) then
|
||||||
call insertion_$Xsort(x,iorder,isize)
|
call insertion_$Xsort(x,iorder,isize)
|
||||||
else
|
else
|
||||||
@ -226,9 +226,9 @@ BEGIN_TEMPLATE
|
|||||||
! This is a version for very large arrays where the indices need
|
! This is a version for very large arrays where the indices need
|
||||||
! to be in integer*8 format
|
! to be in integer*8 format
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer*8,intent(in) :: isize
|
||||||
$type,intent(inout) :: x(isize)
|
$type,intent(inout) :: x(isize)
|
||||||
integer*8,intent(inout) :: iorder(isize)
|
integer*8,intent(inout) :: iorder(isize)
|
||||||
integer*8,intent(in) :: isize
|
|
||||||
$type :: xtmp
|
$type :: xtmp
|
||||||
integer*8 :: i, i0, j, jmax
|
integer*8 :: i, i0, j, jmax
|
||||||
|
|
||||||
@ -298,6 +298,7 @@ BEGIN_TEMPLATE
|
|||||||
integer, intent(in) :: iradix
|
integer, intent(in) :: iradix
|
||||||
integer :: iradix_new
|
integer :: iradix_new
|
||||||
$type, allocatable :: x2(:), x1(:)
|
$type, allocatable :: x2(:), x1(:)
|
||||||
|
$type :: i4
|
||||||
$int_type, allocatable :: iorder1(:),iorder2(:)
|
$int_type, allocatable :: iorder1(:),iorder2(:)
|
||||||
$int_type :: i0, i1, i2, i3, i
|
$int_type :: i0, i1, i2, i3, i
|
||||||
integer, parameter :: integer_size=$octets
|
integer, parameter :: integer_size=$octets
|
||||||
@ -311,11 +312,12 @@ BEGIN_TEMPLATE
|
|||||||
! Find most significant bit
|
! Find most significant bit
|
||||||
|
|
||||||
i0 = 0_8
|
i0 = 0_8
|
||||||
i3 = -1_8
|
i4 = -1_8
|
||||||
|
|
||||||
do i=1,isize
|
do i=1,isize
|
||||||
i3 = max(i3,x(i))
|
i4 = max(i4,x(i))
|
||||||
enddo
|
enddo
|
||||||
|
i3 = i4 ! Type conversion
|
||||||
|
|
||||||
iradix_new = integer_size-1-leadz(i3)
|
iradix_new = integer_size-1-leadz(i3)
|
||||||
mask = ibset(zero,iradix_new)
|
mask = ibset(zero,iradix_new)
|
||||||
|
@ -295,6 +295,18 @@ BEGIN_PROVIDER [ integer, nproc ]
|
|||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, iproc_save, (nproc) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! iproc_save(i) = i-1. Used to start threads with pthreads.
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
do i=1,nproc
|
||||||
|
iproc_save(i) = i-1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
double precision function u_dot_v(u,v,sze)
|
double precision function u_dot_v(u,v,sze)
|
||||||
implicit none
|
implicit none
|
||||||
@ -401,5 +413,21 @@ end
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine lowercase(txt,n)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform to lower case
|
||||||
|
END_DOC
|
||||||
|
character*(*), intent(inout) :: txt
|
||||||
|
integer, intent(in) :: n
|
||||||
|
character( * ), PARAMETER :: LOWER_CASE = 'abcdefghijklmnopqrstuvwxyz'
|
||||||
|
character( * ), PARAMETER :: UPPER_CASE = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||||
|
integer :: i, ic
|
||||||
|
do i=1,n
|
||||||
|
ic = index( UPPER_CASE, txt(i:i) )
|
||||||
|
if (ic /= 0) then
|
||||||
|
txt(i:i) = LOWER_CASE(ic:ic)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
759
src/ZMQ/utils.irp.f
Normal file
759
src/ZMQ/utils.irp.f
Normal file
@ -0,0 +1,759 @@
|
|||||||
|
use f77_zmq
|
||||||
|
use omp_lib
|
||||||
|
|
||||||
|
integer, pointer :: thread_id
|
||||||
|
integer(omp_lock_kind) :: zmq_lock
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_context ]
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Context for the ZeroMQ library
|
||||||
|
END_DOC
|
||||||
|
call omp_init_lock(zmq_lock)
|
||||||
|
zmq_context = 0_ZMQ_PTR
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ character*(128), qp_run_address ]
|
||||||
|
&BEGIN_PROVIDER [ integer, zmq_port_start ]
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Address of the qp_run socket
|
||||||
|
! Example : tcp://130.120.229.139:12345
|
||||||
|
END_DOC
|
||||||
|
character*(128) :: buffer
|
||||||
|
call getenv('QP_RUN_ADDRESS',buffer)
|
||||||
|
if (trim(buffer) == '') then
|
||||||
|
print *, 'This run should be started with the qp_run command'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
do i=len(buffer),1,-1
|
||||||
|
if ( buffer(i:i) == ':') then
|
||||||
|
qp_run_address = trim(buffer(1:i-1))
|
||||||
|
read(buffer(i+1:), *) zmq_port_start
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ character*(128), zmq_socket_pull_tcp_address ]
|
||||||
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_pair_inproc_address ]
|
||||||
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_push_tcp_address ]
|
||||||
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_pull_inproc_address ]
|
||||||
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_push_inproc_address ]
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Socket which pulls the results (2)
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
zmq_socket_pull_tcp_address = 'tcp://*:'//zmq_port(1)//' '
|
||||||
|
zmq_socket_push_tcp_address = trim(qp_run_address)//':'//zmq_port(1)//' '
|
||||||
|
zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(1)//' '
|
||||||
|
zmq_socket_push_inproc_address = zmq_socket_pull_inproc_address
|
||||||
|
zmq_socket_pair_inproc_address = 'inproc://'//zmq_port(2)//' '
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine reset_zmq_addresses
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
|
||||||
|
zmq_socket_pull_tcp_address = 'tcp://*:'//zmq_port(1)//' '
|
||||||
|
zmq_socket_push_tcp_address = trim(qp_run_address)//':'//zmq_port(1)//' '
|
||||||
|
zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(1)//' '
|
||||||
|
zmq_socket_push_inproc_address = zmq_socket_pull_inproc_address
|
||||||
|
zmq_socket_pair_inproc_address = 'inproc://'//zmq_port(2)//' '
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine switch_qp_run_to_master
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Address of the master qp_run socket
|
||||||
|
! Example : tcp://130.120.229.139:12345
|
||||||
|
END_DOC
|
||||||
|
character*(128) :: buffer
|
||||||
|
call getenv('QP_RUN_ADDRESS_MASTER',buffer)
|
||||||
|
if (trim(buffer) == '') then
|
||||||
|
print *, 'This run should be started with the qp_run command'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
qp_run_address = trim(buffer)
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
do i=len(buffer),1,-1
|
||||||
|
if ( buffer(i:i) == ':') then
|
||||||
|
qp_run_address = trim(buffer(1:i-1))
|
||||||
|
read(buffer(i+1:), *) zmq_port_start
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call reset_zmq_addresses
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
function zmq_port(ishift)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Return the value of the ZMQ port from the corresponding integer
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: ishift
|
||||||
|
character*(8) :: zmq_port
|
||||||
|
write(zmq_port,'(I8)') zmq_port_start+ishift
|
||||||
|
zmq_port = adjustl(trim(zmq_port))
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
function new_zmq_to_qp_run_socket()
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Socket on which the qp_run process replies
|
||||||
|
END_DOC
|
||||||
|
integer :: rc
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
integer(ZMQ_PTR) :: new_zmq_to_qp_run_socket
|
||||||
|
|
||||||
|
call omp_set_lock(zmq_lock)
|
||||||
|
new_zmq_to_qp_run_socket = f77_zmq_socket(zmq_context, ZMQ_REQ)
|
||||||
|
call omp_unset_lock(zmq_lock)
|
||||||
|
if (new_zmq_to_qp_run_socket == 0_ZMQ_PTR) then
|
||||||
|
stop 'Unable to create zmq req socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_connect(new_zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0)))
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to connect new_zmq_to_qp_run_socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 120000, 4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set send timout in new_zmq_to_qp_run_socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 120000, 4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set recv timout in new_zmq_to_qp_run_socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
function new_zmq_pair_socket(bind)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Socket on which the collector and the main communicate
|
||||||
|
END_DOC
|
||||||
|
logical :: bind
|
||||||
|
integer :: rc
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
integer(ZMQ_PTR) :: new_zmq_pair_socket
|
||||||
|
|
||||||
|
call omp_set_lock(zmq_lock)
|
||||||
|
new_zmq_pair_socket = f77_zmq_socket(zmq_context, ZMQ_PAIR)
|
||||||
|
call omp_unset_lock(zmq_lock)
|
||||||
|
if (new_zmq_pair_socket == 0_ZMQ_PTR) then
|
||||||
|
stop 'Unable to create zmq pair socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (bind) then
|
||||||
|
rc = f77_zmq_bind(new_zmq_pair_socket,zmq_socket_pair_inproc_address)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'f77_zmq_bind(new_zmq_pair_socket, zmq_socket_pair_inproc_address)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
rc = f77_zmq_connect(new_zmq_pair_socket,zmq_socket_pair_inproc_address)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to connect new_zmq_pair_socket'
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 0, 4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 0, 4)'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 0, 4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 0, 4)'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_IMMEDIATE, 1, 4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_IMMEDIATE, 1, 4)'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_LINGER, 600000, 4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_LINGER, 60000, 4)'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function new_zmq_pull_socket()
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Socket on which the results are sent. If thread is 1, use inproc
|
||||||
|
END_DOC
|
||||||
|
integer :: rc
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
integer(ZMQ_PTR) :: new_zmq_pull_socket
|
||||||
|
|
||||||
|
call omp_set_lock(zmq_lock)
|
||||||
|
new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_PULL)
|
||||||
|
! new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_REP)
|
||||||
|
call omp_unset_lock(zmq_lock)
|
||||||
|
if (new_zmq_pull_socket == 0_ZMQ_PTR) then
|
||||||
|
stop 'Unable to create zmq pull socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_LINGER,300000,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_LINGER on pull socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,100000,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_RCVHWM on pull socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_IMMEDIATE,1,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_IMMEDIATE on pull socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_bind(new_zmq_pull_socket, zmq_socket_pull_tcp_address)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'Unable to bind new_zmq_pull_socket (tcp)', zmq_socket_pull_tcp_address
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_bind(new_zmq_pull_socket, zmq_socket_pull_inproc_address)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to bind new_zmq_pull_socket (inproc)'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function new_zmq_push_socket(thread)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Socket on which the results are sent. If thread is 1, use inproc
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: thread
|
||||||
|
integer :: rc
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
integer(ZMQ_PTR) :: new_zmq_push_socket
|
||||||
|
|
||||||
|
call omp_set_lock(zmq_lock)
|
||||||
|
new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_PUSH)
|
||||||
|
! new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_REQ)
|
||||||
|
call omp_unset_lock(zmq_lock)
|
||||||
|
if (new_zmq_push_socket == 0_ZMQ_PTR) then
|
||||||
|
stop 'Unable to create zmq push socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_LINGER,300000,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_LINGER on push socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,100,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_SNDHWM on push socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,1,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_IMMEDIATE on push socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 100000, 4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set send timout in new_zmq_push_socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (thread == 1) then
|
||||||
|
rc = f77_zmq_connect(new_zmq_push_socket, zmq_socket_push_inproc_address)
|
||||||
|
else
|
||||||
|
rc = f77_zmq_connect(new_zmq_push_socket, zmq_socket_push_tcp_address)
|
||||||
|
endif
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to connect new_zmq_push_socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine end_zmq_pair_socket(zmq_socket_pair)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Terminate socket on which the results are sent.
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_pair
|
||||||
|
integer :: rc
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
|
||||||
|
rc = f77_zmq_unbind(zmq_socket_pair,zmq_socket_pair_inproc_address)
|
||||||
|
! if (rc /= 0) then
|
||||||
|
! print *, rc
|
||||||
|
! print *, irp_here, 'f77_zmq_unbind(zmq_socket_pair,zmq_socket_pair_inproc_address)'
|
||||||
|
! stop 'error'
|
||||||
|
! endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(zmq_socket_pair,ZMQ_LINGER,0,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_LINGER on zmq_socket_pair'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_close(zmq_socket_pair)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'f77_zmq_close(zmq_socket_pair)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine end_zmq_pull_socket(zmq_socket_pull)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Terminate socket on which the results are sent.
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
||||||
|
integer :: rc
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
|
||||||
|
rc = f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_inproc_address)
|
||||||
|
! if (rc /= 0) then
|
||||||
|
! print *, rc
|
||||||
|
! print *, irp_here, 'f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_inproc_address)'
|
||||||
|
! stop 'error'
|
||||||
|
! endif
|
||||||
|
|
||||||
|
rc = f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, rc
|
||||||
|
print *, irp_here, 'f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(zmq_socket_pull,ZMQ_LINGER,0,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_LINGER on zmq_socket_pull'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_close(zmq_socket_pull)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'f77_zmq_close(zmq_socket_pull)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
|
implicit none
|
||||||
|
use f77_zmq
|
||||||
|
BEGIN_DOC
|
||||||
|
! Terminate socket on which the results are sent.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: thread
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
|
integer :: rc
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
|
||||||
|
if (thread == 1) then
|
||||||
|
rc = f77_zmq_disconnect(zmq_socket_push,zmq_socket_push_inproc_address)
|
||||||
|
! if (rc /= 0) then
|
||||||
|
! print *, 'f77_zmq_disconnect(zmq_socket_push,zmq_socket_push_inproc_address)'
|
||||||
|
! stop 'error'
|
||||||
|
! endif
|
||||||
|
else
|
||||||
|
rc = f77_zmq_disconnect(zmq_socket_push,zmq_socket_push_tcp_address)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'f77_zmq_disconnect(zmq_socket_push,zmq_socket_push_tcp_address)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(zmq_socket_push,ZMQ_LINGER,0,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_LINGER on push socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_close(zmq_socket_push)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'f77_zmq_close(zmq_socket_push)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ character*(128), zmq_state ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Threads executing work through the ZeroMQ interface
|
||||||
|
END_DOC
|
||||||
|
zmq_state = 'No_state'
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine new_parallel_job(zmq_to_qp_run_socket,name_in)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Start a new parallel job with name 'name'. The slave tasks execute subroutine 'slave'
|
||||||
|
END_DOC
|
||||||
|
character*(*), intent(in) :: name_in
|
||||||
|
|
||||||
|
character*(512) :: message, name
|
||||||
|
integer :: rc, sze
|
||||||
|
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR), intent(out) :: zmq_to_qp_run_socket
|
||||||
|
|
||||||
|
zmq_context = f77_zmq_ctx_new ()
|
||||||
|
if (zmq_context == 0_ZMQ_PTR) then
|
||||||
|
stop 'ZMQ_PTR is null'
|
||||||
|
endif
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
name = name_in
|
||||||
|
sze = len(trim(name))
|
||||||
|
call lowercase(name,sze)
|
||||||
|
message = 'new_job '//trim(name)//' '//zmq_socket_push_tcp_address//' '//zmq_socket_pull_inproc_address
|
||||||
|
sze = len(trim(message))
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)
|
||||||
|
if (rc /= sze) then
|
||||||
|
print *, irp_here, ':f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0)
|
||||||
|
message = trim(message(1:rc))
|
||||||
|
if (message(1:2) /= 'ok') then
|
||||||
|
print *, message
|
||||||
|
print *, 'Unable to start parallel job : '//name
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
zmq_state = trim(name)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine end_parallel_job(zmq_to_qp_run_socket,name_in)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! End a new parallel job with name 'name'. The slave tasks execute subroutine 'slave'
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
character*(*), intent(in) :: name_in
|
||||||
|
|
||||||
|
character*(512) :: message, name
|
||||||
|
integer :: i,rc, sze
|
||||||
|
|
||||||
|
name = name_in
|
||||||
|
sze = len(trim(name))
|
||||||
|
call lowercase(name,sze)
|
||||||
|
if (name /= zmq_state) then
|
||||||
|
stop 'Wrong end of job'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job '//trim(zmq_state),8+len(trim(zmq_state)),0)
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, zmq_state, 2, 0)
|
||||||
|
if (rc /= 2) then
|
||||||
|
print *, 'f77_zmq_recv(zmq_to_qp_run_socket, zmq_state, 2, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
zmq_state = 'No_state'
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
|
||||||
|
rc = f77_zmq_ctx_term(zmq_context)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'Unable to terminate ZMQ context'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Connect to the task server and obtain the worker ID
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(out) :: worker_id
|
||||||
|
integer, intent(in) :: thread
|
||||||
|
|
||||||
|
character*(512) :: message
|
||||||
|
character*(128) :: reply, state, address
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
if (thread == 1) then
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket, "connect inproc", 14, 0)
|
||||||
|
if (rc /= 14) then
|
||||||
|
print *, 'f77_zmq_send(zmq_to_qp_run_socket, "connect inproc", 14, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket, "connect tcp", 11, 0)
|
||||||
|
if (rc /= 11) then
|
||||||
|
print *, 'f77_zmq_send(zmq_to_qp_run_socket, "connect tcp", 11, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
||||||
|
message = trim(message(1:rc))
|
||||||
|
read(message,*) reply, state, worker_id, address
|
||||||
|
if ( (trim(reply) /= 'connect_reply') .and. &
|
||||||
|
(trim(state) /= trim(zmq_state)) ) then
|
||||||
|
print *, 'Reply: ', trim(reply)
|
||||||
|
print *, 'State: ', trim(state), '/', trim(zmq_state)
|
||||||
|
print *, 'Address: ', trim(address)
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine disconnect_from_taskserver(zmq_to_qp_run_socket, &
|
||||||
|
zmq_socket_push, worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Disconnect from the task server
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
|
||||||
|
integer :: rc, sze
|
||||||
|
character*(64) :: message, reply, state
|
||||||
|
write(message,*) 'disconnect '//trim(zmq_state), worker_id
|
||||||
|
|
||||||
|
sze = len(trim(message))
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
|
||||||
|
if (rc /= sze) then
|
||||||
|
print *, rc, sze
|
||||||
|
print *, irp_here, 'f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
||||||
|
message = trim(message(1:rc))
|
||||||
|
|
||||||
|
read(message,*) reply, state
|
||||||
|
if ( (trim(reply) /= 'disconnect_reply').or. &
|
||||||
|
(trim(state) /= zmq_state) ) then
|
||||||
|
print *, 'Unable to disconnect : ', zmq_state
|
||||||
|
print *, trim(message)
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Get a task from the task server
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
character*(*), intent(in) :: task
|
||||||
|
|
||||||
|
integer :: rc, sze
|
||||||
|
character*(512) :: message
|
||||||
|
write(message,*) 'add_task '//trim(zmq_state)//' '//trim(task)
|
||||||
|
|
||||||
|
sze = len(trim(message))
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
|
||||||
|
if (rc /= sze) then
|
||||||
|
print *, rc, sze
|
||||||
|
print *, irp_here,': f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
||||||
|
message = trim(message(1:rc))
|
||||||
|
if (trim(message) /= 'ok') then
|
||||||
|
print *, trim(task)
|
||||||
|
print *, 'Unable to add the next task'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine task_done_to_taskserver(zmq_to_qp_run_socket,worker_id, task_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Get a task from the task server
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id, task_id
|
||||||
|
|
||||||
|
integer :: rc, sze
|
||||||
|
character*(512) :: message
|
||||||
|
write(message,*) 'task_done '//trim(zmq_state), worker_id, task_id
|
||||||
|
|
||||||
|
sze = len(trim(message))
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
|
||||||
|
if (rc /= sze) then
|
||||||
|
print *, irp_here, 'f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
||||||
|
message = trim(message(1:rc))
|
||||||
|
if (trim(message) /= 'ok') then
|
||||||
|
print *, 'Unable to send task_done message'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine get_task_from_taskserver(zmq_to_qp_run_socket,worker_id,task_id,task)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Get a task from the task server
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer, intent(out) :: task_id
|
||||||
|
character*(512), intent(out) :: task
|
||||||
|
|
||||||
|
character*(512) :: message
|
||||||
|
character*(64) :: reply
|
||||||
|
integer :: rc, sze
|
||||||
|
|
||||||
|
write(message,*) 'get_task '//trim(zmq_state), worker_id
|
||||||
|
|
||||||
|
sze = len(trim(message))
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
|
||||||
|
if (rc /= sze) then
|
||||||
|
print *, irp_here, ':f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
||||||
|
message = trim(message(1:rc))
|
||||||
|
read(message,*) reply
|
||||||
|
if (trim(reply) == 'get_task_reply') then
|
||||||
|
read(message,*) reply, task_id
|
||||||
|
rc = 15
|
||||||
|
do while (message(rc:rc) == ' ')
|
||||||
|
rc += 1
|
||||||
|
enddo
|
||||||
|
do while (message(rc:rc) /= ' ')
|
||||||
|
rc += 1
|
||||||
|
enddo
|
||||||
|
rc += 1
|
||||||
|
task = message(rc:)
|
||||||
|
else if (trim(reply) == 'terminate') then
|
||||||
|
task_id = 0
|
||||||
|
task = 'terminate'
|
||||||
|
else
|
||||||
|
print *, 'Unable to get the next task'
|
||||||
|
print *, trim(message)
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Terminate the socket from the application to qp_run
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
character*(8), external :: zmq_port
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
rc = f77_zmq_disconnect(zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0)))
|
||||||
|
! if (rc /= 0) then
|
||||||
|
! print *, 'f77_zmq_disconnect(zmq_to_qp_run_socket, trim(qp_run_address)//'':''//trim(zmq_port(0)))'
|
||||||
|
! stop 'error'
|
||||||
|
! endif
|
||||||
|
|
||||||
|
rc = f77_zmq_setsockopt(zmq_to_qp_run_socket,ZMQ_LINGER,0,4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
stop 'Unable to set ZMQ_LINGER on zmq_to_qp_run_socket'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_close(zmq_to_qp_run_socket)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'f77_zmq_close(zmq_to_qp_run_socket)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! When a task is done, it has to be removed from the list of tasks on the qp_run
|
||||||
|
! queue. This guarantees that the results have been received in the pull.
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_socket_pull
|
||||||
|
integer, intent(in) :: task_id
|
||||||
|
integer, intent(out) :: more
|
||||||
|
integer :: rc
|
||||||
|
character*(512) :: msg
|
||||||
|
|
||||||
|
write(msg,*) 'del_task ', zmq_state, task_id
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,msg,512,0)
|
||||||
|
if (rc /= 512) then
|
||||||
|
print *, 'f77_zmq_send(zmq_to_qp_run_socket,task_id,4,0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
character*(64) :: reply
|
||||||
|
reply = ''
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,reply,64,0)
|
||||||
|
|
||||||
|
if (reply(16:19) == 'more') then
|
||||||
|
more = 1
|
||||||
|
else if (reply(16:19) == 'done') then
|
||||||
|
more = 0
|
||||||
|
rc = f77_zmq_setsockopt(zmq_socket_pull, ZMQ_RCVTIMEO, 1000, 4)
|
||||||
|
if (rc /= 0) then
|
||||||
|
print *, 'f77_zmq_setsockopt(zmq_socket_pull, ZMQ_RCVTIMEO, 3000, 4)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
print *, reply
|
||||||
|
print *, 'f77_zmq_recv(zmq_to_qp_run_socket,reply,64,0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
@ -1,344 +0,0 @@
|
|||||||
use f77_zmq
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_context ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Context for the ZeroMQ library
|
|
||||||
END_DOC
|
|
||||||
zmq_context = f77_zmq_ctx_new ()
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ character*(128), qp_run_address ]
|
|
||||||
&BEGIN_PROVIDER [ integer, zmq_port_start ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Address of the qp_run socket
|
|
||||||
! Example : tcp://130.120.229.139:12345
|
|
||||||
END_DOC
|
|
||||||
character*(128) :: buffer
|
|
||||||
call getenv('QP_RUN_ADDRESS',buffer)
|
|
||||||
if (trim(buffer) == '') then
|
|
||||||
print *, 'This run should be started with the qp_run command'
|
|
||||||
stop -1
|
|
||||||
endif
|
|
||||||
|
|
||||||
integer :: i
|
|
||||||
do i=len(buffer),1,-1
|
|
||||||
if ( buffer(i:i) == ':') then
|
|
||||||
qp_run_address = trim(buffer(1:i-1))
|
|
||||||
read(buffer(i+1:), *) zmq_port_start
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
function zmq_port(ishift)
|
|
||||||
implicit none
|
|
||||||
integer, intent(in) :: ishift
|
|
||||||
character*(8) :: zmq_port
|
|
||||||
write(zmq_port,'(I8)') zmq_port_start+ishift
|
|
||||||
zmq_port = adjustl(trim(zmq_port))
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
function new_zmq_to_qp_run_socket()
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Socket on which the qp_run process replies
|
|
||||||
END_DOC
|
|
||||||
integer :: rc
|
|
||||||
character*(8), external :: zmq_port
|
|
||||||
integer(ZMQ_PTR) :: new_zmq_to_qp_run_socket
|
|
||||||
|
|
||||||
new_zmq_to_qp_run_socket = f77_zmq_socket(zmq_context, ZMQ_REQ)
|
|
||||||
rc = f77_zmq_connect(new_zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0)))
|
|
||||||
if (rc /= 0) then
|
|
||||||
stop 'Unable to connect new_zmq_to_qp_run_socket'
|
|
||||||
endif
|
|
||||||
integer :: i
|
|
||||||
i=4
|
|
||||||
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 120000, i)
|
|
||||||
if (rc /= 0) then
|
|
||||||
stop 'Unable to set send timout in new_zmq_to_qp_run_socket'
|
|
||||||
endif
|
|
||||||
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 120000, i)
|
|
||||||
if (rc /= 0) then
|
|
||||||
stop 'Unable to set recv timout in new_zmq_to_qp_run_socket'
|
|
||||||
endif
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_socket_pull ]
|
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_socket_pull_tcp_address ]
|
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_socket_push_tcp_address ]
|
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_socket_pull_inproc_address ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Socket which pulls the results (2)
|
|
||||||
END_DOC
|
|
||||||
integer :: rc
|
|
||||||
character*(8), external :: zmq_port
|
|
||||||
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
|
||||||
|
|
||||||
zmq_socket_pull_tcp_address = 'tcp://*:'//zmq_port(1)
|
|
||||||
zmq_socket_push_tcp_address = trim(qp_run_address)//':'//zmq_port(1)
|
|
||||||
zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(1)
|
|
||||||
|
|
||||||
! zmq_socket_pull = f77_zmq_socket(zmq_context, ZMQ_PULL)
|
|
||||||
zmq_socket_pull = f77_zmq_socket(zmq_context, ZMQ_REP )
|
|
||||||
rc = f77_zmq_bind(zmq_socket_pull, zmq_socket_pull_tcp_address)
|
|
||||||
rc = f77_zmq_bind(zmq_socket_pull, zmq_socket_pull_inproc_address)
|
|
||||||
if (rc /= 0) then
|
|
||||||
stop 'Unable to bind zmq_socket_pull (tcp)'
|
|
||||||
endif
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_thread, (0:nproc) ]
|
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_state ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Threads executing work through the ZeroMQ interface
|
|
||||||
END_DOC
|
|
||||||
zmq_thread = 0_ZMQ_PTR
|
|
||||||
zmq_state = 'No_state'
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
subroutine new_parallel_job(zmq_to_qp_run_socket,name)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Start a new parallel job with name 'name'. The slave tasks execute subroutine 'slave'
|
|
||||||
END_DOC
|
|
||||||
character*(*), intent(in) :: name
|
|
||||||
|
|
||||||
character*(512) :: message
|
|
||||||
integer :: rc
|
|
||||||
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
|
||||||
integer(ZMQ_PTR), intent(out) :: zmq_to_qp_run_socket
|
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
|
||||||
message = 'new_job '//name//' '//zmq_socket_push_tcp_address//' '//zmq_socket_pull_inproc_address
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,message,len(trim(message)),0)
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0)
|
|
||||||
message = trim(message(1:rc))
|
|
||||||
if (message(1:2) /= 'ok') then
|
|
||||||
print *, 'Unable to start parallel job : '//name
|
|
||||||
stop 1
|
|
||||||
endif
|
|
||||||
|
|
||||||
zmq_state = name
|
|
||||||
SOFT_TOUCH zmq_state zmq_thread
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine new_parallel_threads(slave,collector)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Start a new parallel job with name 'name'. The slave tasks execute subroutine 'slave'
|
|
||||||
END_DOC
|
|
||||||
external :: slave, collector
|
|
||||||
integer :: i,rc
|
|
||||||
|
|
||||||
|
|
||||||
rc = pthread_create( zmq_thread(0), collector)
|
|
||||||
do i=1,nproc
|
|
||||||
rc = pthread_create( zmq_thread(i), slave )
|
|
||||||
enddo
|
|
||||||
SOFT_TOUCH zmq_thread zmq_state
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Connect to the task server and obtain the worker ID
|
|
||||||
END_DOC
|
|
||||||
integer, intent(out) :: worker_id
|
|
||||||
integer, intent(in) :: thread
|
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
|
||||||
|
|
||||||
character*(512) :: message
|
|
||||||
character*(128) :: reply, state, address
|
|
||||||
integer :: rc
|
|
||||||
|
|
||||||
if (thread == 1) then
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket, "connect inproc", 14, 0)
|
|
||||||
else
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket, "connect tcp", 11, 0)
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
|
||||||
message = trim(message(1:rc))
|
|
||||||
read(message,*) reply, state, worker_id, address
|
|
||||||
if ( (trim(reply) /= 'connect_reply') .and. &
|
|
||||||
(trim(state) /= trim(zmq_state)) ) then
|
|
||||||
print *, 'Reply: ', trim(reply)
|
|
||||||
print *, 'State: ', trim(state), '/', trim(zmq_state)
|
|
||||||
print *, 'Address: ', trim(address)
|
|
||||||
stop -1
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id,finished)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Disconnect from the task server
|
|
||||||
END_DOC
|
|
||||||
integer, intent(in) :: worker_id
|
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
|
||||||
integer, intent(out) :: finished
|
|
||||||
|
|
||||||
integer :: rc
|
|
||||||
character*(64) :: message, reply, state
|
|
||||||
write(message,*) 'disconnect '//trim(zmq_state), worker_id
|
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), len(trim(message)), 0)
|
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
|
||||||
message = trim(message(1:rc))
|
|
||||||
|
|
||||||
read(message,*) reply, state, finished
|
|
||||||
if ( (trim(reply) /= 'disconnect_reply').or. &
|
|
||||||
(trim(state) /= zmq_state) ) then
|
|
||||||
print *, 'Unable to disconnect'
|
|
||||||
print *, trim(message)
|
|
||||||
stop -1
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Get a task from the task server
|
|
||||||
END_DOC
|
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
|
||||||
character*(*), intent(in) :: task
|
|
||||||
|
|
||||||
integer :: rc
|
|
||||||
character*(512) :: message
|
|
||||||
write(message,*) 'add_task '//trim(zmq_state)//' '//trim(task)
|
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), len(trim(message)), 0)
|
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
|
||||||
message = trim(message(1:rc))
|
|
||||||
if (trim(message) /= 'ok') then
|
|
||||||
print *, trim(task)
|
|
||||||
print *, 'Unable to add the next task'
|
|
||||||
stop -1
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine task_done_to_taskserver(zmq_to_qp_run_socket,worker_id, task_id)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Get a task from the task server
|
|
||||||
END_DOC
|
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
|
||||||
integer, intent(in) :: worker_id, task_id
|
|
||||||
|
|
||||||
integer :: rc
|
|
||||||
character*(512) :: message
|
|
||||||
write(message,*) 'task_done '//trim(zmq_state), worker_id, task_id
|
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), len(trim(message)), 0)
|
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
|
||||||
message = trim(message(1:rc))
|
|
||||||
if (trim(message) /= 'ok') then
|
|
||||||
print *, 'Unable to send task_done message'
|
|
||||||
stop -1
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine get_task_from_taskserver(zmq_to_qp_run_socket,worker_id,task_id,task)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Get a task from the task server
|
|
||||||
END_DOC
|
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
|
||||||
integer, intent(in) :: worker_id
|
|
||||||
integer, intent(out) :: task_id
|
|
||||||
character*(512), intent(out) :: task
|
|
||||||
|
|
||||||
character*(512) :: message
|
|
||||||
character*(64) :: reply
|
|
||||||
integer :: rc
|
|
||||||
|
|
||||||
write(message,*) 'get_task '//trim(zmq_state), worker_id
|
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), len(trim(message)), 0)
|
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
|
||||||
message = trim(message(1:rc))
|
|
||||||
read(message,*) reply
|
|
||||||
if (trim(reply) == 'get_task_reply') then
|
|
||||||
read(message,*) reply, task_id
|
|
||||||
rc = 15
|
|
||||||
do while (message(rc:rc) == ' ')
|
|
||||||
rc += 1
|
|
||||||
enddo
|
|
||||||
do while (message(rc:rc) /= ' ')
|
|
||||||
rc += 1
|
|
||||||
enddo
|
|
||||||
rc += 1
|
|
||||||
task = message(rc:)
|
|
||||||
else if (trim(reply) == 'terminate') then
|
|
||||||
task_id = 0
|
|
||||||
task = 'terminate'
|
|
||||||
else
|
|
||||||
print *, 'Unable to get the next task'
|
|
||||||
print *, trim(message)
|
|
||||||
stop -1
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
subroutine end_parallel_job(zmq_to_qp_run_socket,name)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! End a new parallel job with name 'name'. The slave tasks execute subroutine 'slave'
|
|
||||||
END_DOC
|
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
|
||||||
character*(*), intent(in) :: name
|
|
||||||
|
|
||||||
character*(512) :: message
|
|
||||||
integer :: i,rc
|
|
||||||
|
|
||||||
if (name /= zmq_state) then
|
|
||||||
stop 'Wrong end of job'
|
|
||||||
endif
|
|
||||||
|
|
||||||
! Wait for Slaves
|
|
||||||
do i=1,nproc
|
|
||||||
rc = pthread_join( zmq_thread(i) )
|
|
||||||
if (rc /= 0) then
|
|
||||||
print *, 'Unable to join thread : ', i
|
|
||||||
stop -1
|
|
||||||
endif
|
|
||||||
zmq_thread(i) = 0
|
|
||||||
print *, 'joined ', i
|
|
||||||
enddo
|
|
||||||
! Wait for collector
|
|
||||||
rc = pthread_join( zmq_thread(0) )
|
|
||||||
zmq_thread(0) = 0
|
|
||||||
print *, 'joined ', 0
|
|
||||||
zmq_state = 'No_state'
|
|
||||||
character*(8), external :: zmq_port
|
|
||||||
rc = f77_zmq_disconnect(zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0)))
|
|
||||||
rc = f77_zmq_close(zmq_to_qp_run_socket)
|
|
||||||
|
|
||||||
|
|
||||||
SOFT_TOUCH zmq_thread zmq_state
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
@ -24,8 +24,6 @@ function eq() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
# ___
|
# ___
|
||||||
# | ._ o _|_
|
# | ._ o _|_
|
||||||
# _|_ | | | |_
|
# _|_ | | | |_
|
||||||
@ -65,7 +63,7 @@ function run_HF() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
function run_FCI() {
|
function run_FCI() {
|
||||||
thresh=1.e-5
|
thresh=5.e-5
|
||||||
test_exe full_ci || skip
|
test_exe full_ci || skip
|
||||||
ezfio set_file $1
|
ezfio set_file $1
|
||||||
ezfio set perturbation do_pt2_end True
|
ezfio set perturbation do_pt2_end True
|
||||||
@ -132,7 +130,8 @@ function run_all_1h_1p() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
@test "FCI H2O cc-pVDZ" {
|
@test "FCI H2O cc-pVDZ" {
|
||||||
run_FCI h2o.ezfio 10000 -0.762382562429778E+02 -0.762433933485226E+02
|
qp_set_mo_class h2o.ezfio -core "[1]" -act "[2-12]" -del "[13-24]"
|
||||||
|
run_FCI h2o.ezfio 2000 -0.761255633582109E+02 -0.761258377850042E+02
|
||||||
}
|
}
|
||||||
|
|
||||||
@test "CAS_SD H2O cc-pVDZ" {
|
@test "CAS_SD H2O cc-pVDZ" {
|
||||||
@ -171,7 +170,8 @@ function run_all_1h_1p() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
@test "FCI H2O VDZ pseudo" {
|
@test "FCI H2O VDZ pseudo" {
|
||||||
run_FCI h2o_pseudo.ezfio 2000 -0.171550015498807E+02 -0.171645044185009E+02
|
qp_set_mo_class h2o_pseudo.ezfio -core "[1]" -act "[2-12]" -del "[13-23]"
|
||||||
|
run_FCI h2o_pseudo.ezfio 2000 -0.170399597228904E+02 -0.170400168816800E+02
|
||||||
}
|
}
|
||||||
|
|
||||||
#=== Convert
|
#=== Convert
|
||||||
|
27
tests/bats_to_sh.py
Executable file
27
tests/bats_to_sh.py
Executable file
@ -0,0 +1,27 @@
|
|||||||
|
#!/usr/bin/env python
|
||||||
|
|
||||||
|
with open('bats/qp.bats','r') as f:
|
||||||
|
raw_data = f.read()
|
||||||
|
|
||||||
|
output = []
|
||||||
|
inside = False
|
||||||
|
level = 0
|
||||||
|
for i in raw_data:
|
||||||
|
new_i = i
|
||||||
|
if i == "@":
|
||||||
|
inside = True
|
||||||
|
elif i == "{" and inside and level == 0:
|
||||||
|
new_i = ""
|
||||||
|
elif i == "}" and inside and level == 1:
|
||||||
|
inside = False
|
||||||
|
new_i = ""
|
||||||
|
if i == "{":
|
||||||
|
level += 1
|
||||||
|
elif i == "}":
|
||||||
|
level -= 1
|
||||||
|
output.append(new_i)
|
||||||
|
|
||||||
|
print "".join(output).replace("@test","echo").replace("|| skip","|| return")
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,6 +1,18 @@
|
|||||||
#!/bin/bash
|
#!/bin/bash
|
||||||
|
|
||||||
rm -rf work
|
export QP_PREFIX="timeout -s 9 300"
|
||||||
exec bats bats/qp.bats
|
export QP_TASK_DEBUG=1
|
||||||
|
|
||||||
|
BATS_FILE=bats/qp.bats
|
||||||
|
|
||||||
|
rm -rf work output
|
||||||
|
|
||||||
|
if [[ "$1" == "-v" ]]
|
||||||
|
then
|
||||||
|
echo "Verbose mode"
|
||||||
|
./bats_to_sh.py $BATS_FILE | bash
|
||||||
|
else
|
||||||
|
bats $BATS_FILE
|
||||||
|
fi
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user