mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Merge branch 'master' of https://github.com/scemama/quantum_package into scemama-master
Conflicts: plugins/Full_CI_ZMQ/selection_double.irp.f src/Davidson/diagonalization_hs2.irp.f
This commit is contained in:
commit
9e11ebdc72
@ -13,6 +13,8 @@ addons:
|
|||||||
- gcc
|
- gcc
|
||||||
- liblapack-dev
|
- liblapack-dev
|
||||||
- graphviz
|
- graphviz
|
||||||
|
# - zlib1g-dev
|
||||||
|
# - libgmp3-dev
|
||||||
|
|
||||||
cache:
|
cache:
|
||||||
directories:
|
directories:
|
||||||
@ -23,8 +25,8 @@ python:
|
|||||||
- "2.6"
|
- "2.6"
|
||||||
|
|
||||||
script:
|
script:
|
||||||
- ./configure --production ./config/gfortran.cfg
|
- ./configure --production ./config/travis.cfg
|
||||||
- source ./quantum_package.rc ; qp_module.py install Full_CI Full_CI_ZMQ Hartree_Fock CAS_SD mrcepa0 All_singles
|
- source ./quantum_package.rc ; qp_module.py install Full_CI Full_CI_ZMQ Hartree_Fock CAS_SD_ZMQ mrcepa0 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 ; ./run_tests.sh #-v
|
- source ./quantum_package.rc ; cd tests ; ./run_tests.sh -v
|
||||||
|
@ -24,7 +24,7 @@ Demo
|
|||||||
* Python >= 2.6
|
* Python >= 2.6
|
||||||
* GNU make
|
* GNU make
|
||||||
* Bash
|
* Bash
|
||||||
* Blast/Lapack
|
* Blas/Lapack
|
||||||
* unzip
|
* unzip
|
||||||
* g++ (For ninja)
|
* g++ (For ninja)
|
||||||
|
|
||||||
@ -137,6 +137,10 @@ interface: ezfio
|
|||||||
|
|
||||||
#FAQ
|
#FAQ
|
||||||
|
|
||||||
|
### Opam error: cryptokit
|
||||||
|
|
||||||
|
You need to install `gmp-dev`.
|
||||||
|
|
||||||
### Error: ezfio_* is already defined.
|
### Error: ezfio_* is already defined.
|
||||||
|
|
||||||
#### Why ?
|
#### Why ?
|
||||||
|
@ -13,7 +13,7 @@
|
|||||||
FC : gfortran -g -ffree-line-length-none -I . -static-libgcc
|
FC : gfortran -g -ffree-line-length-none -I . -static-libgcc
|
||||||
LAPACK_LIB : -llapack -lblas
|
LAPACK_LIB : -llapack -lblas
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --assert --align=32
|
IRPF90_FLAGS : --ninja --align=32
|
||||||
|
|
||||||
# Global options
|
# Global options
|
||||||
################
|
################
|
||||||
|
@ -38,7 +38,7 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g
|
|||||||
#################
|
#################
|
||||||
#
|
#
|
||||||
[PROFILE]
|
[PROFILE]
|
||||||
FC : -p -g -traceback
|
FC : -p -g
|
||||||
FCFLAGS : -xSSE4.2 -O2 -ip -ftz
|
FCFLAGS : -xSSE4.2 -O2 -ip -ftz
|
||||||
|
|
||||||
# Debugging flags
|
# Debugging flags
|
||||||
@ -53,7 +53,6 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz
|
|||||||
[DEBUG]
|
[DEBUG]
|
||||||
FC : -g -traceback
|
FC : -g -traceback
|
||||||
FCFLAGS : -xSSE2 -C -fpe0
|
FCFLAGS : -xSSE2 -C -fpe0
|
||||||
IRPF90_FLAGS : --openmp
|
|
||||||
|
|
||||||
# OpenMP flags
|
# OpenMP flags
|
||||||
#################
|
#################
|
||||||
|
62
config/travis.cfg
Normal file
62
config/travis.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 . -g
|
||||||
|
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 -march=native
|
||||||
|
|
||||||
|
# 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
|
||||||
|
|
30
configure
vendored
30
configure
vendored
@ -71,8 +71,8 @@ d_dependency = {
|
|||||||
"emsl": ["python"],
|
"emsl": ["python"],
|
||||||
"gcc": [],
|
"gcc": [],
|
||||||
"g++": [],
|
"g++": [],
|
||||||
"zeromq" : [ "g++" ],
|
"zeromq" : [ "g++", "make" ],
|
||||||
"f77zmq" : [ "zeromq", "python" ],
|
"f77zmq" : [ "zeromq", "python", "make" ],
|
||||||
"python": [],
|
"python": [],
|
||||||
"ninja": ["g++", "python"],
|
"ninja": ["g++", "python"],
|
||||||
"make": [],
|
"make": [],
|
||||||
@ -102,7 +102,7 @@ curl = Info(
|
|||||||
default_path=join(QP_ROOT_BIN, "curl"))
|
default_path=join(QP_ROOT_BIN, "curl"))
|
||||||
|
|
||||||
zlib = Info(
|
zlib = Info(
|
||||||
url='http://zlib.net/zlib-1.2.8.tar.gz',
|
url='http://www.zlib.net/zlib-1.2.10.tar.gz',
|
||||||
description=' zlib',
|
description=' zlib',
|
||||||
default_path=join(QP_ROOT_LIB, "libz.a"))
|
default_path=join(QP_ROOT_LIB, "libz.a"))
|
||||||
|
|
||||||
@ -150,7 +150,6 @@ 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") )
|
|
||||||
|
|
||||||
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',
|
||||||
@ -166,7 +165,7 @@ d_info = dict()
|
|||||||
|
|
||||||
for m in ["ocaml", "m4", "curl", "zlib", "patch", "irpf90", "docopt",
|
for m in ["ocaml", "m4", "curl", "zlib", "patch", "irpf90", "docopt",
|
||||||
"resultsFile", "ninja", "emsl", "ezfio", "p_graphviz",
|
"resultsFile", "ninja", "emsl", "ezfio", "p_graphviz",
|
||||||
"zeromq", "f77zmq","bats" ]:
|
"zeromq", "f77zmq","bats"]:
|
||||||
exec ("d_info['{0}']={0}".format(m))
|
exec ("d_info['{0}']={0}".format(m))
|
||||||
|
|
||||||
|
|
||||||
@ -487,7 +486,6 @@ 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 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}")),
|
||||||
@ -495,12 +493,24 @@ def create_ninja_and_rc(l_installed):
|
|||||||
'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}"',
|
||||||
'export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"', "",
|
'export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"',
|
||||||
'source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh', "",
|
'export C_INCLUDE_PATH="${C_INCLUDE_PATH}":"${QP_ROOT}"/include',
|
||||||
'source ${HOME}/.opam/opam-init/init.sh > /dev/null 2> /dev/null || true',
|
'',
|
||||||
""
|
'source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh',
|
||||||
|
'',
|
||||||
|
'# Choose the correct network interface',
|
||||||
|
'# export QP_NIC=ib0',
|
||||||
|
'# export QP_NIC=eth0',
|
||||||
|
''
|
||||||
]
|
]
|
||||||
|
|
||||||
|
qp_opam_root = os.getenv('OPAMROOT')
|
||||||
|
if not qp_opam_root:
|
||||||
|
qp_opam_root = '${HOME}/.opam'
|
||||||
|
l_rc.append('export QP_OPAM={0}'.format(qp_opam_root))
|
||||||
|
l_rc.append('source ${QP_OPAM}/opam-init/init.sh > /dev/null 2> /dev/null || true')
|
||||||
|
l_rc.append('')
|
||||||
|
|
||||||
path = join(QP_ROOT, "quantum_package.rc")
|
path = join(QP_ROOT, "quantum_package.rc")
|
||||||
with open(path, "w+") as f:
|
with open(path, "w+") as f:
|
||||||
f.write("\n".join(l_rc))
|
f.write("\n".join(l_rc))
|
||||||
|
@ -25,7 +25,7 @@ import sys, os
|
|||||||
|
|
||||||
# Add any Sphinx extension module names here, as strings. They can be extensions
|
# Add any Sphinx extension module names here, as strings. They can be extensions
|
||||||
# coming with Sphinx (named 'sphinx.ext.*') or your custom ones.
|
# coming with Sphinx (named 'sphinx.ext.*') or your custom ones.
|
||||||
extensions = ['sphinx.ext.autodoc', 'sphinx.ext.doctest', 'sphinx.ext.todo', 'sphinx.ext.pngmath', 'sphinx.ext.mathjax', 'sphinx.ext.viewcode']
|
extensions = ['sphinx.ext.autodoc', 'sphinx.ext.doctest', 'sphinx.ext.todo', 'sphinx.ext.mathjax', 'sphinx.ext.viewcode']
|
||||||
|
|
||||||
# Add any paths that contain templates here, relative to this directory.
|
# Add any paths that contain templates here, relative to this directory.
|
||||||
templates_path = ['_templates']
|
templates_path = ['_templates']
|
||||||
|
0
include/.empty
Normal file
0
include/.empty
Normal file
@ -4,7 +4,11 @@
|
|||||||
BUILD=_build/${TARGET}
|
BUILD=_build/${TARGET}
|
||||||
rm -rf -- ${BUILD}
|
rm -rf -- ${BUILD}
|
||||||
mkdir ${BUILD} || exit 1
|
mkdir ${BUILD} || exit 1
|
||||||
tar -zxf Downloads/${TARGET}.tar.gz --strip-components=1 --directory=${BUILD} || exit 1
|
if [[ -f Downloads/${TARGET}.tar.gz ]] ; then
|
||||||
|
tar -zxf Downloads/${TARGET}.tar.gz --strip-components=1 --directory=${BUILD} || exit 1
|
||||||
|
elif [[ -f Downloads/${TARGET}.tar.bz2 ]] ; then
|
||||||
|
tar -jxf Downloads/${TARGET}.tar.bz2 --strip-components=1 --directory=${BUILD} || exit 1
|
||||||
|
fi
|
||||||
_install || exit 1
|
_install || exit 1
|
||||||
rm -rf -- ${BUILD} _build/${TARGET}.log
|
rm -rf -- ${BUILD} _build/${TARGET}.log
|
||||||
exit 0
|
exit 0
|
||||||
|
@ -10,10 +10,4 @@ function _install()
|
|||||||
mv curl.ermine ${QP_ROOT}/bin/curl || return 1
|
mv curl.ermine ${QP_ROOT}/bin/curl || return 1
|
||||||
}
|
}
|
||||||
|
|
||||||
BUILD=_build/${TARGET}
|
source scripts/build.sh
|
||||||
rm -rf -- ${BUILD}
|
|
||||||
mkdir ${BUILD} || exit 1
|
|
||||||
tar -xvjf Downloads/${TARGET}.tar.bz2 --strip-components=1 --directory=${BUILD} || exit 1
|
|
||||||
_install || exit 1
|
|
||||||
rm -rf -- ${BUILD} _build/${TARGET}.log
|
|
||||||
exit 0
|
|
||||||
|
@ -7,10 +7,9 @@ function _install()
|
|||||||
cd ..
|
cd ..
|
||||||
QP_ROOT=$PWD
|
QP_ROOT=$PWD
|
||||||
cd -
|
cd -
|
||||||
export C_INCLUDE_PATH="${C_INCLUDE_PATH}":"${QP_ROOT}"/lib
|
|
||||||
set -e
|
set -e
|
||||||
set -u
|
set -u
|
||||||
export ZMQ_H="${QP_ROOT}"/lib/zmq.h
|
export ZMQ_H="${QP_ROOT}"/include/zmq.h
|
||||||
cd "${BUILD}"
|
cd "${BUILD}"
|
||||||
make -j 8 || exit 1
|
make -j 8 || exit 1
|
||||||
mv libf77zmq.a "${QP_ROOT}"/lib || exit 1
|
mv libf77zmq.a "${QP_ROOT}"/lib || exit 1
|
||||||
|
17
install/scripts/install_gmp.sh
Executable file
17
install/scripts/install_gmp.sh
Executable file
@ -0,0 +1,17 @@
|
|||||||
|
#!/bin/bash -x
|
||||||
|
|
||||||
|
TARGET=gmp
|
||||||
|
|
||||||
|
function _install()
|
||||||
|
{
|
||||||
|
rm -rf -- ${TARGET}
|
||||||
|
mkdir ${TARGET} || exit 1
|
||||||
|
cd ..
|
||||||
|
QP_ROOT=$PWD
|
||||||
|
cd -
|
||||||
|
cd ${BUILD}
|
||||||
|
./configure --prefix=$QP_ROOT && make -j 8 || exit 1
|
||||||
|
make install || exit 1
|
||||||
|
}
|
||||||
|
|
||||||
|
source scripts/build.sh
|
@ -8,8 +8,7 @@ function _install()
|
|||||||
QP_ROOT=$PWD
|
QP_ROOT=$PWD
|
||||||
cd -
|
cd -
|
||||||
cd ${BUILD}
|
cd ${BUILD}
|
||||||
./configure && make || exit 1
|
./configure --prefix=$QP_ROOT && make || exit 1
|
||||||
ln -sf ${PWD}/src/m4 ${QP_ROOT}/bin || exit 1
|
|
||||||
}
|
}
|
||||||
|
|
||||||
source scripts/build.sh
|
source scripts/build.sh
|
||||||
|
@ -5,11 +5,11 @@ QP_ROOT=$PWD
|
|||||||
cd -
|
cd -
|
||||||
|
|
||||||
# Normal installation
|
# Normal installation
|
||||||
PACKAGES="core cryptokit ocamlfind sexplib ZMQ"
|
PACKAGES="core cryptokit.1.10 ocamlfind sexplib ZMQ"
|
||||||
#ppx_sexp_conv
|
#ppx_sexp_conv
|
||||||
|
|
||||||
# Needed for ZeroMQ
|
# Needed for ZeroMQ
|
||||||
export C_INCLUDE_PATH="${QP_ROOT}"/lib:"${C_INCLUDE_PATH}"
|
export C_INCLUDE_PATH="${QP_ROOT}"/include:"${C_INCLUDE_PATH}"
|
||||||
export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"
|
export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"
|
||||||
export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}"
|
export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}"
|
||||||
|
|
||||||
|
@ -9,7 +9,7 @@ function _install()
|
|||||||
QP_ROOT=$PWD
|
QP_ROOT=$PWD
|
||||||
cd -
|
cd -
|
||||||
cd ${BUILD}
|
cd ${BUILD}
|
||||||
./configure --prefix=${QP_ROOT}/install/${TARGET} && make || exit 1
|
./configure --prefix=${QP_ROOT} && make || exit 1
|
||||||
make install || exit 1
|
make install || exit 1
|
||||||
cd -
|
cd -
|
||||||
cp ${TARGET}/bin/${TARGET} ${QP_ROOT}/bin || exit 1
|
cp ${TARGET}/bin/${TARGET} ${QP_ROOT}/bin || exit 1
|
||||||
|
@ -7,22 +7,13 @@ function _install()
|
|||||||
cd ..
|
cd ..
|
||||||
QP_ROOT=$PWD
|
QP_ROOT=$PWD
|
||||||
cd -
|
cd -
|
||||||
export C_INCLUDE_PATH="${C_INCLUDE_PATH}":./
|
|
||||||
set -e
|
set -e
|
||||||
set -u
|
set -u
|
||||||
ORIG=$(pwd)
|
ORIG=$(pwd)
|
||||||
cd "${BUILD}"
|
cd "${BUILD}"
|
||||||
./configure --without-libsodium || exit 1
|
./configure --prefix=$QP_ROOT --without-libsodium || exit 1
|
||||||
make -j 8 || exit 1
|
make -j 8 || exit 1
|
||||||
rm -f -- "${QP_ROOT}"/lib/libzmq.a "${QP_ROOT}"/lib/libzmq.so "${QP_ROOT}"/lib/libzmq.so.?
|
make install || exit 1
|
||||||
cp .libs/libzmq.a "${QP_ROOT}"/lib
|
|
||||||
cp .libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.5
|
|
||||||
# cp src/.libs/libzmq.a "${QP_ROOT}"/lib
|
|
||||||
# cp src/.libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.4
|
|
||||||
cp include/{zmq.h,zmq_utils.h} "${QP_ROOT}"/lib
|
|
||||||
cd "${QP_ROOT}"/lib
|
|
||||||
ln -s libzmq.so.5 libzmq.so
|
|
||||||
# ln -s libzmq.so.4 libzmq.so
|
|
||||||
cd ${ORIG}
|
cd ${ORIG}
|
||||||
return 0
|
return 0
|
||||||
}
|
}
|
||||||
|
@ -11,11 +11,8 @@ function _install()
|
|||||||
cd -
|
cd -
|
||||||
cd ${BUILD}
|
cd ${BUILD}
|
||||||
./configure && make || exit 1
|
./configure && make || exit 1
|
||||||
make install prefix=$QP_ROOT/install/${TARGET} || exit 1
|
./configure --prefix=$QP_ROOT && make || exit 1
|
||||||
ln -s -f $QP_ROOT/install/${TARGET}/lib/libz.so $QP_ROOT/lib || exit 1
|
make install || exit 1
|
||||||
ln -s -f $QP_ROOT/install/${TARGET}/lib/libz.a $QP_ROOT/lib || exit 1
|
|
||||||
ln -s -f $QP_ROOT/install/${TARGET}/include/zlib.h $QP_ROOT/lib || exit 1
|
|
||||||
ln -s -f $QP_ROOT/install/${TARGET}/include/zconf.h $QP_ROOT/lib || exit 1
|
|
||||||
}
|
}
|
||||||
|
|
||||||
source scripts/build.sh
|
source scripts/build.sh
|
||||||
|
@ -42,7 +42,7 @@ end = struct
|
|||||||
assert (String.is_prefix ~prefix:"inproc://" x);
|
assert (String.is_prefix ~prefix:"inproc://" x);
|
||||||
x
|
x
|
||||||
let create name =
|
let create name =
|
||||||
Printf.sprintf "ipc://%s" name
|
Printf.sprintf "inproc://%s" name
|
||||||
let to_string x = x
|
let to_string x = x
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -36,9 +36,11 @@ let read_element in_channel at_number element =
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
let to_string_general ~fmt ~atom_sep b =
|
let to_string_general ~fmt ~atom_sep ?ele_array b =
|
||||||
let new_nucleus n =
|
let new_nucleus n =
|
||||||
Printf.sprintf "Atom %d" n
|
match ele_array with
|
||||||
|
| None -> Printf.sprintf "Atom %d" n
|
||||||
|
| Some x -> Printf.sprintf "%s" (Element.to_string x.(n-1))
|
||||||
in
|
in
|
||||||
let rec do_work accu current_nucleus = function
|
let rec do_work accu current_nucleus = function
|
||||||
| [] -> List.rev accu
|
| [] -> List.rev accu
|
||||||
@ -56,12 +58,12 @@ let to_string_general ~fmt ~atom_sep b =
|
|||||||
do_work [new_nucleus 1] 1 b
|
do_work [new_nucleus 1] 1 b
|
||||||
|> String.concat ~sep:"\n"
|
|> String.concat ~sep:"\n"
|
||||||
|
|
||||||
let to_string_gamess =
|
let to_string_gamess ?ele_array =
|
||||||
to_string_general ~fmt:Gto.Gamess ~atom_sep:""
|
to_string_general ?ele_array ~fmt:Gto.Gamess ~atom_sep:""
|
||||||
|
|
||||||
let to_string_gaussian b =
|
let to_string_gaussian ?ele_array b =
|
||||||
String.concat ~sep:"\n"
|
String.concat ~sep:"\n"
|
||||||
[ to_string_general ~fmt:Gto.Gaussian ~atom_sep:"****" b ; "****" ]
|
[ to_string_general ?ele_array ~fmt:Gto.Gaussian ~atom_sep:"****" b ; "****" ]
|
||||||
|
|
||||||
let to_string ?(fmt=Gto.Gamess) =
|
let to_string ?(fmt=Gto.Gamess) =
|
||||||
match fmt with
|
match fmt with
|
||||||
|
@ -14,7 +14,7 @@ val read_element :
|
|||||||
in_channel -> Nucl_number.t -> Element.t -> (Gto.t * Nucl_number.t) list
|
in_channel -> Nucl_number.t -> Element.t -> (Gto.t * Nucl_number.t) list
|
||||||
|
|
||||||
(** Convert the basis to a string *)
|
(** Convert the basis to a string *)
|
||||||
val to_string : ?fmt:Gto.fmt -> (Gto.t * Nucl_number.t) list -> string
|
val to_string : ?fmt:Gto.fmt -> ?ele_array:Element.t array -> (Gto.t * Nucl_number.t) list -> string
|
||||||
|
|
||||||
(** Convert the basis to an MD5 hash *)
|
(** Convert the basis to an MD5 hash *)
|
||||||
val to_md5 : (Gto.t * Nucl_number.t) list -> MD5.t
|
val to_md5 : (Gto.t * Nucl_number.t) list -> MD5.t
|
||||||
|
24
ocaml/Id.ml
24
ocaml/Id.ml
@ -1,26 +1,22 @@
|
|||||||
open Core.Std
|
module Id = struct
|
||||||
|
|
||||||
module Id : sig
|
|
||||||
type t
|
|
||||||
val of_int : int -> t
|
|
||||||
val to_int : t -> int
|
|
||||||
val of_string : string -> t
|
|
||||||
val to_string : t -> string
|
|
||||||
val increment : t -> t
|
|
||||||
val decrement : t -> t
|
|
||||||
end
|
|
||||||
= struct
|
|
||||||
type t = int
|
type t = int
|
||||||
|
|
||||||
let of_int x =
|
let of_int x =
|
||||||
assert (x>0); x
|
assert (x>0); x
|
||||||
|
|
||||||
let to_int x = x
|
let to_int x = x
|
||||||
|
|
||||||
let of_string x =
|
let of_string x =
|
||||||
Int.of_string x
|
int_of_string x
|
||||||
|> of_int
|
|> of_int
|
||||||
|
|
||||||
let to_string x =
|
let to_string x =
|
||||||
Int.to_string x
|
string_of_int x
|
||||||
|
|
||||||
let increment x = x + 1
|
let increment x = x + 1
|
||||||
let decrement x = x - 1
|
let decrement x = x - 1
|
||||||
|
|
||||||
|
let compare = compare
|
||||||
end
|
end
|
||||||
|
|
||||||
module Task = struct
|
module Task = struct
|
||||||
|
23
ocaml/Id.mli
Normal file
23
ocaml/Id.mli
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
module Id :
|
||||||
|
sig
|
||||||
|
type t
|
||||||
|
val of_int : int -> t
|
||||||
|
val to_int : t -> int
|
||||||
|
val of_string : string -> t
|
||||||
|
val to_string : t -> string
|
||||||
|
val increment : t -> t
|
||||||
|
val decrement : t -> t
|
||||||
|
val compare : t -> t -> int
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module Task :
|
||||||
|
sig
|
||||||
|
include (module type of Id)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module Client :
|
||||||
|
sig
|
||||||
|
include (module type of Id)
|
||||||
|
end
|
@ -14,13 +14,13 @@ type t =
|
|||||||
|
|
||||||
let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title =
|
let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title =
|
||||||
{ title ; start_value ; end_value ; bar_length ; cur_value=start_value ;
|
{ title ; start_value ; end_value ; bar_length ; cur_value=start_value ;
|
||||||
init_time= Time.now () ; dirty = true ; next = Time.now () }
|
init_time= Time.now () ; dirty = false ; next = Time.now () }
|
||||||
|
|
||||||
let update ~cur_value bar =
|
let update ~cur_value bar =
|
||||||
{ bar with cur_value ; dirty=true }
|
{ bar with cur_value ; dirty=true }
|
||||||
|
|
||||||
let increment_end bar =
|
let increment_end bar =
|
||||||
{ bar with end_value=(bar.end_value +. 1.) ; dirty=true }
|
{ bar with end_value=(bar.end_value +. 1.) ; dirty=false }
|
||||||
|
|
||||||
let increment_cur bar =
|
let increment_cur bar =
|
||||||
{ bar with cur_value=(bar.cur_value +. 1.) ; dirty=true }
|
{ bar with cur_value=(bar.cur_value +. 1.) ; dirty=true }
|
||||||
|
@ -124,23 +124,27 @@ let to_string t =
|
|||||||
let find in_channel element =
|
let find in_channel element =
|
||||||
In_channel.seek in_channel 0L;
|
In_channel.seek in_channel 0L;
|
||||||
|
|
||||||
let element_read, old_pos =
|
let loop, element_read, old_pos =
|
||||||
ref Element.X,
|
ref true,
|
||||||
|
ref None,
|
||||||
ref (In_channel.pos in_channel)
|
ref (In_channel.pos in_channel)
|
||||||
in
|
in
|
||||||
while !element_read <> element
|
|
||||||
|
while !loop
|
||||||
do
|
do
|
||||||
|
try
|
||||||
let buffer =
|
let buffer =
|
||||||
old_pos := In_channel.pos in_channel;
|
old_pos := In_channel.pos in_channel;
|
||||||
match In_channel.input_line in_channel with
|
match In_channel.input_line in_channel with
|
||||||
| Some line -> String.split ~on:' ' line
|
| Some line -> String.split ~on:' ' line
|
||||||
|> List.hd_exn
|
|> List.hd_exn
|
||||||
| None -> ""
|
| None -> raise End_of_file
|
||||||
in
|
in
|
||||||
try
|
element_read := Some (Element.of_string buffer);
|
||||||
element_read := Element.of_string buffer
|
loop := !element_read <> (Some element)
|
||||||
with
|
with
|
||||||
| Element.ElementError _ -> ()
|
| Element.ElementError _ -> ()
|
||||||
|
| End_of_file -> loop := false
|
||||||
done ;
|
done ;
|
||||||
In_channel.seek in_channel !old_pos;
|
In_channel.seek in_channel !old_pos;
|
||||||
!element_read
|
!element_read
|
||||||
@ -148,8 +152,9 @@ let find in_channel element =
|
|||||||
|
|
||||||
(** Read the Pseudopotential in GAMESS format *)
|
(** Read the Pseudopotential in GAMESS format *)
|
||||||
let read_element in_channel element =
|
let read_element in_channel element =
|
||||||
ignore (find in_channel element);
|
match find in_channel element with
|
||||||
|
| Some e when e = element ->
|
||||||
|
begin
|
||||||
let rec read result =
|
let rec read result =
|
||||||
match In_channel.input_line in_channel with
|
match In_channel.input_line in_channel with
|
||||||
| None -> result
|
| None -> result
|
||||||
@ -264,7 +269,8 @@ let read_element in_channel element =
|
|||||||
decode_first_line data
|
decode_first_line data
|
||||||
|> decode_local
|
|> decode_local
|
||||||
|> decode_non_local
|
|> decode_non_local
|
||||||
|
end
|
||||||
|
| _ -> empty element
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -127,3 +127,14 @@ let get_ezfio_default directory data =
|
|||||||
|> aux
|
|> aux
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
let ezfio_work ezfio_file =
|
||||||
|
let result =
|
||||||
|
Filename.concat ezfio_file "work"
|
||||||
|
in
|
||||||
|
begin
|
||||||
|
match Sys.is_directory result with
|
||||||
|
| `Yes -> ()
|
||||||
|
| _ -> Unix.mkdir result
|
||||||
|
end;
|
||||||
|
result
|
||||||
|
;;
|
||||||
|
@ -1,27 +1,35 @@
|
|||||||
open Core.Std
|
module RunningMap = Map.Make (Id.Task)
|
||||||
open Qptypes
|
module TasksMap = Map.Make (Id.Task)
|
||||||
|
module ClientsSet = Set.Make (Id.Client)
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ queued : Id.Task.t list ;
|
{ queued_front : Id.Task.t list ;
|
||||||
running : (Id.Task.t, Id.Client.t) Map.Poly.t ;
|
queued_back : Id.Task.t list ;
|
||||||
tasks : (Id.Task.t, string) Map.Poly.t;
|
running : Id.Client.t RunningMap.t;
|
||||||
clients : Id.Client.t Set.Poly.t;
|
tasks : string TasksMap.t;
|
||||||
|
clients : ClientsSet.t;
|
||||||
next_client_id : Id.Client.t;
|
next_client_id : Id.Client.t;
|
||||||
next_task_id : Id.Task.t;
|
next_task_id : Id.Task.t;
|
||||||
number_of_queued : int;
|
number_of_queued : int;
|
||||||
|
number_of_running : int;
|
||||||
|
number_of_tasks : int;
|
||||||
|
number_of_clients : int;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let create () =
|
let create () =
|
||||||
{ queued = [] ;
|
{ queued_front = [] ;
|
||||||
running = Map.Poly.empty ;
|
queued_back = [] ;
|
||||||
tasks = Map.Poly.empty;
|
running = RunningMap.empty ;
|
||||||
clients = Set.Poly.empty;
|
tasks = TasksMap.empty;
|
||||||
|
clients = ClientsSet.empty;
|
||||||
next_client_id = Id.Client.of_int 1;
|
next_client_id = Id.Client.of_int 1;
|
||||||
next_task_id = Id.Task.of_int 1;
|
next_task_id = Id.Task.of_int 1;
|
||||||
number_of_queued = 0;
|
number_of_queued = 0;
|
||||||
|
number_of_running = 0;
|
||||||
|
number_of_tasks = 0;
|
||||||
|
number_of_clients = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -32,10 +40,11 @@ let add_task ~task q =
|
|||||||
q.next_task_id
|
q.next_task_id
|
||||||
in
|
in
|
||||||
{ q with
|
{ q with
|
||||||
queued = task_id :: q.queued ;
|
queued_front = task_id :: q.queued_front ;
|
||||||
tasks = Map.add q.tasks ~key:task_id ~data:task ;
|
tasks = TasksMap.add task_id task q.tasks;
|
||||||
next_task_id = Id.Task.increment task_id ;
|
next_task_id = Id.Task.increment task_id ;
|
||||||
number_of_queued = q.number_of_queued + 1;
|
number_of_queued = q.number_of_queued + 1;
|
||||||
|
number_of_tasks = q.number_of_tasks + 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -46,46 +55,62 @@ let add_client q =
|
|||||||
q.next_client_id
|
q.next_client_id
|
||||||
in
|
in
|
||||||
{ q with
|
{ q with
|
||||||
clients = Set.add q.clients client_id;
|
clients = ClientsSet.add client_id q.clients;
|
||||||
next_client_id = Id.Client.increment client_id;
|
next_client_id = Id.Client.increment client_id;
|
||||||
|
number_of_clients = q.number_of_clients + 1;
|
||||||
}, client_id
|
}, client_id
|
||||||
|
|
||||||
|
|
||||||
let pop_task ~client_id q =
|
let pop_task ~client_id q =
|
||||||
let { queued ; running ; _ } =
|
let { queued_front ; queued_back ; running ; _ } =
|
||||||
q
|
q
|
||||||
in
|
in
|
||||||
assert (Set.mem q.clients client_id);
|
assert (ClientsSet.mem client_id q.clients);
|
||||||
match queued with
|
let queued_front', queued_back' =
|
||||||
|
match queued_front, queued_back with
|
||||||
|
| (l, []) -> ( [], List.rev l)
|
||||||
|
| t -> t
|
||||||
|
in
|
||||||
|
match queued_back' with
|
||||||
| task_id :: new_queue ->
|
| task_id :: new_queue ->
|
||||||
let new_q =
|
let new_q =
|
||||||
{ q with
|
{ q with
|
||||||
queued = new_queue ;
|
queued_front= queued_front' ;
|
||||||
running = Map.add running ~key:task_id ~data:client_id ;
|
queued_back = new_queue ;
|
||||||
|
running = RunningMap.add task_id client_id running;
|
||||||
number_of_queued = q.number_of_queued - 1;
|
number_of_queued = q.number_of_queued - 1;
|
||||||
|
number_of_running = q.number_of_running + 1;
|
||||||
}
|
}
|
||||||
in new_q, Some task_id, (Map.find q.tasks task_id)
|
and found =
|
||||||
|
try Some (TasksMap.find task_id q.tasks)
|
||||||
|
with Not_found -> None
|
||||||
|
in new_q, Some task_id, found
|
||||||
| [] -> q, None, None
|
| [] -> q, None, None
|
||||||
|
|
||||||
|
|
||||||
let del_client ~client_id q =
|
let del_client ~client_id q =
|
||||||
assert (Set.mem q.clients client_id);
|
assert (ClientsSet.mem client_id q.clients);
|
||||||
{ q with
|
{ q with
|
||||||
clients = Set.remove q.clients client_id }
|
clients = ClientsSet.remove client_id q.clients;
|
||||||
|
number_of_clients = q.number_of_clients - 1
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
let end_task ~task_id ~client_id q =
|
let end_task ~task_id ~client_id q =
|
||||||
let { running ; tasks ; _ } =
|
let { running ; tasks ; _ } =
|
||||||
q
|
q
|
||||||
in
|
in
|
||||||
assert (Set.mem q.clients client_id);
|
assert (ClientsSet.mem client_id q.clients);
|
||||||
let () =
|
let () =
|
||||||
match Map.Poly.find running task_id with
|
let client_id_check =
|
||||||
| None -> failwith "Task already finished"
|
try RunningMap.find task_id running with
|
||||||
| Some client_id_check -> assert (client_id_check = client_id)
|
Not_found -> failwith "Task already finished"
|
||||||
|
in
|
||||||
|
assert (client_id_check = client_id)
|
||||||
in
|
in
|
||||||
{ q with
|
{ q with
|
||||||
running = Map.remove running task_id ;
|
running = RunningMap.remove task_id running ;
|
||||||
|
number_of_running = q.number_of_running - 1
|
||||||
}
|
}
|
||||||
|
|
||||||
let del_task ~task_id q =
|
let del_task ~task_id q =
|
||||||
@ -93,9 +118,10 @@ let del_task ~task_id q =
|
|||||||
q
|
q
|
||||||
in
|
in
|
||||||
|
|
||||||
if (Map.mem tasks task_id) then
|
if (TasksMap.mem task_id tasks) then
|
||||||
{ q with
|
{ q with
|
||||||
tasks = Map.remove tasks task_id ;
|
tasks = TasksMap.remove task_id tasks;
|
||||||
|
number_of_tasks = q.number_of_tasks - 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
Printf.sprintf "Task %d is already deleted" (Id.Task.to_int task_id)
|
Printf.sprintf "Task %d is already deleted" (Id.Task.to_int task_id)
|
||||||
@ -103,36 +129,81 @@ let del_task ~task_id q =
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
let number q =
|
let number_of_tasks q =
|
||||||
Map.length q.tasks
|
assert (q.number_of_tasks >= 0);
|
||||||
|
q.number_of_tasks
|
||||||
|
|
||||||
let number_of_queued q =
|
let number_of_queued q =
|
||||||
|
assert (q.number_of_queued >= 0);
|
||||||
q.number_of_queued
|
q.number_of_queued
|
||||||
|
|
||||||
let number_of_running q =
|
let number_of_running q =
|
||||||
Map.length q.running
|
assert (q.number_of_running >= 0);
|
||||||
|
q.number_of_running
|
||||||
|
|
||||||
|
let number_of_clients q =
|
||||||
|
assert (q.number_of_clients >= 0);
|
||||||
|
q.number_of_clients
|
||||||
|
|
||||||
|
|
||||||
let to_string { queued ; running ; tasks ; _ } =
|
let to_string qs =
|
||||||
|
let { queued_back ; queued_front ; running ; tasks ; _ } = qs in
|
||||||
let q =
|
let q =
|
||||||
List.map ~f:Id.Task.to_string queued
|
(List.map Id.Task.to_string queued_front) @
|
||||||
|> String.concat ~sep:" ; "
|
(List.map Id.Task.to_string @@ List.rev queued_back)
|
||||||
|
|> String.concat " ; "
|
||||||
and r =
|
and r =
|
||||||
Map.Poly.to_alist running
|
RunningMap.bindings running
|
||||||
|> List.map ~f:(fun (t,c) -> "("^(Id.Task.to_string t)^", "
|
|> List.map (fun (t,c) -> "("^(Id.Task.to_string t)^", "
|
||||||
^(Id.Client.to_string c)^")")
|
^(Id.Client.to_string c)^")")
|
||||||
|> String.concat ~sep:" ; "
|
|> String.concat " ; "
|
||||||
and t =
|
and t =
|
||||||
Map.Poly.to_alist tasks
|
TasksMap.bindings tasks
|
||||||
|> List.map ~f:(fun (t,c) -> "("^(Id.Task.to_string t)^", \""
|
|> List.map (fun (t,c) -> "("^(Id.Task.to_string t)^", \""
|
||||||
^c^"\")")
|
^c^"\")")
|
||||||
|> String.concat ~sep:" ; "
|
|> String.concat " ; "
|
||||||
in
|
in
|
||||||
Printf.sprintf "{
|
Printf.sprintf "{
|
||||||
|
Tasks : %d Queued : %d Running : %d Clients : %d
|
||||||
queued : { %s }
|
queued : { %s }
|
||||||
running : { %s }
|
running : { %s }
|
||||||
tasks : [ %s
|
tasks : [ %s
|
||||||
]
|
]
|
||||||
}" q r t
|
}"
|
||||||
|
(number_of_tasks qs) (number_of_queued qs) (number_of_running qs) (number_of_clients qs)
|
||||||
|
q r t
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let test () =
|
||||||
|
let q =
|
||||||
|
create ()
|
||||||
|
|> add_task ~task:"First Task"
|
||||||
|
|> add_task ~task:"Second Task"
|
||||||
|
in
|
||||||
|
let q, client_id =
|
||||||
|
add_client q
|
||||||
|
in
|
||||||
|
let q, task_id, task_content =
|
||||||
|
match pop_task ~client_id q with
|
||||||
|
| q, Some x, Some y -> q, Id.Task.to_int x, y
|
||||||
|
| _ -> assert false
|
||||||
|
in
|
||||||
|
Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content;
|
||||||
|
to_string q |> print_endline ;
|
||||||
|
let q, task_id, task_content =
|
||||||
|
match pop_task ~client_id q with
|
||||||
|
| q, Some x, Some y -> q, Id.Task.to_int x, y
|
||||||
|
| _ -> assert false
|
||||||
|
in
|
||||||
|
Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content;
|
||||||
|
let q, task_id, task_content =
|
||||||
|
match pop_task ~client_id q with
|
||||||
|
| q, None, None -> q, 0, "None"
|
||||||
|
| _ -> assert false
|
||||||
|
in
|
||||||
|
Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content;
|
||||||
|
q
|
||||||
|
|> to_string
|
||||||
|
|> print_endline
|
||||||
|
|
||||||
|
63
ocaml/Queuing_system.mli
Normal file
63
ocaml/Queuing_system.mli
Normal file
@ -0,0 +1,63 @@
|
|||||||
|
module RunningMap : Map.S with type key = Id.Task.t
|
||||||
|
module TasksMap : Map.S with type key = Id.Task.t
|
||||||
|
module ClientsSet : Set.S with type elt = Id.Client.t
|
||||||
|
|
||||||
|
type t = {
|
||||||
|
queued_front : Id.Task.t list ;
|
||||||
|
queued_back : Id.Task.t list ;
|
||||||
|
running : Id.Client.t RunningMap.t ;
|
||||||
|
tasks : string TasksMap.t ;
|
||||||
|
clients : ClientsSet.t ;
|
||||||
|
next_client_id : Id.Client.t ;
|
||||||
|
next_task_id : Id.Task.t ;
|
||||||
|
number_of_queued : int ;
|
||||||
|
number_of_running : int ;
|
||||||
|
number_of_tasks : int ;
|
||||||
|
number_of_clients : int ;
|
||||||
|
}
|
||||||
|
|
||||||
|
(** Creates a new queuing system. Returns the new queue. *)
|
||||||
|
val create : unit -> t
|
||||||
|
|
||||||
|
(** Add a new task represented as a string. Returns the queue with the added task. *)
|
||||||
|
val add_task : task:string -> t -> t
|
||||||
|
|
||||||
|
(** Add a new client. Returns the queue and a new client_id. *)
|
||||||
|
val add_client : t -> t * Id.Client.t
|
||||||
|
|
||||||
|
(** Pops a task from the queue. The task is set as running on client client_id.
|
||||||
|
Returns the queue, a task_id and the content of the task. If the queue contains
|
||||||
|
no task, the task_id and the task content are None. *)
|
||||||
|
val pop_task :
|
||||||
|
client_id:ClientsSet.elt -> t -> t * Id.Task.t option * string option
|
||||||
|
|
||||||
|
(** Deletes a client from the queuing system *)
|
||||||
|
val del_client : client_id:ClientsSet.elt -> t -> t
|
||||||
|
|
||||||
|
(** Deletes a client from the queuing system. The client is assumed to be a member
|
||||||
|
of the set of clients. Returns the queue without the removed client. *)
|
||||||
|
val end_task : task_id:RunningMap.key -> client_id:ClientsSet.elt -> t -> t
|
||||||
|
|
||||||
|
(** Deletes a task from the queuing system. The task is assumed to be a member
|
||||||
|
of the map of tasks. Returns the queue without the removed task. *)
|
||||||
|
val del_task : task_id:TasksMap.key -> t -> t
|
||||||
|
|
||||||
|
(** Returns the number of tasks, assumed >= 0 *)
|
||||||
|
val number_of_tasks : t -> int
|
||||||
|
|
||||||
|
(** Returns the number of queued tasks, assumed >= 0 *)
|
||||||
|
val number_of_queued : t -> int
|
||||||
|
|
||||||
|
(** Returns the number of running tasks, assumed >= 0 *)
|
||||||
|
val number_of_running : t -> int
|
||||||
|
|
||||||
|
(** Returns the number of connected clients, assumed >= 0 *)
|
||||||
|
val number_of_clients : t -> int
|
||||||
|
|
||||||
|
(** Prints the content of the queue *)
|
||||||
|
val to_string : t -> string
|
||||||
|
|
||||||
|
(** Test function for debug *)
|
||||||
|
val test : unit -> unit
|
||||||
|
|
||||||
|
|
@ -48,20 +48,21 @@ let zmq_context =
|
|||||||
ZMQ.Context.create ()
|
ZMQ.Context.create ()
|
||||||
|
|
||||||
|
|
||||||
let bind_socket ~socket_type ~socket ~address =
|
let bind_socket ~socket_type ~socket ~port =
|
||||||
let rec loop = function
|
let rec loop = function
|
||||||
| 0 -> failwith @@ Printf.sprintf
|
| 0 -> failwith @@ Printf.sprintf
|
||||||
"Unable to bind the %s socket : %s "
|
"Unable to bind the %s socket to port : %d "
|
||||||
socket_type address
|
socket_type port
|
||||||
| -1 -> ()
|
| -1 -> ()
|
||||||
| i ->
|
| i ->
|
||||||
try
|
try
|
||||||
ZMQ.Socket.bind socket address;
|
ZMQ.Socket.bind socket @@ Printf.sprintf "tcp://*:%d" port;
|
||||||
loop (-1)
|
loop (-1)
|
||||||
with
|
with
|
||||||
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_float 1. ; loop (i-1) )
|
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_float 1. ; loop (i-1) )
|
||||||
| other_exception -> raise other_exception
|
| other_exception -> raise other_exception
|
||||||
in loop 60
|
in loop 60;
|
||||||
|
ZMQ.Socket.bind socket @@ Printf.sprintf "ipc:///tmp/qp_run:%d" port
|
||||||
|
|
||||||
|
|
||||||
let hostname = lazy (
|
let hostname = lazy (
|
||||||
@ -115,7 +116,7 @@ let stop ~port =
|
|||||||
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 "ipc:///tmp/qp_run:%d" port
|
||||||
in
|
in
|
||||||
ZMQ.Socket.set_linger_period req_socket 1_000_000;
|
ZMQ.Socket.set_linger_period req_socket 1_000_000;
|
||||||
ZMQ.Socket.connect req_socket address;
|
ZMQ.Socket.connect req_socket address;
|
||||||
@ -305,7 +306,7 @@ let del_task msg program_state rep_socket =
|
|||||||
}
|
}
|
||||||
in
|
in
|
||||||
let more =
|
let more =
|
||||||
(Queuing_system.number new_program_state.queue > 0)
|
(Queuing_system.number_of_tasks new_program_state.queue > 0)
|
||||||
in
|
in
|
||||||
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_id ~more)
|
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_id ~more)
|
||||||
|> Message.to_string
|
|> Message.to_string
|
||||||
@ -567,10 +568,8 @@ let start_pub_thread ~port =
|
|||||||
|
|
||||||
let pub_socket =
|
let pub_socket =
|
||||||
ZMQ.Socket.create zmq_context ZMQ.Socket.pub
|
ZMQ.Socket.create zmq_context ZMQ.Socket.pub
|
||||||
and address =
|
|
||||||
Printf.sprintf "tcp://*:%d" port
|
|
||||||
in
|
in
|
||||||
bind_socket ~socket_type:"PUB" ~socket:pub_socket ~address;
|
bind_socket ~socket_type:"PUB" ~socket:pub_socket ~port;
|
||||||
|
|
||||||
let pollitem =
|
let pollitem =
|
||||||
ZMQ.Poll.mask_of
|
ZMQ.Poll.mask_of
|
||||||
@ -608,7 +607,7 @@ let run ~port =
|
|||||||
and address =
|
and address =
|
||||||
"inproc://pair"
|
"inproc://pair"
|
||||||
in
|
in
|
||||||
bind_socket "PAIR" pair_socket address;
|
ZMQ.Socket.bind pair_socket address;
|
||||||
|
|
||||||
let pub_thread =
|
let pub_thread =
|
||||||
start_pub_thread ~port:(port+1) ()
|
start_pub_thread ~port:(port+1) ()
|
||||||
@ -617,11 +616,9 @@ let run ~port =
|
|||||||
(** Bind REP socket *)
|
(** 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 =
|
|
||||||
Printf.sprintf "tcp://*:%d" port
|
|
||||||
in
|
in
|
||||||
ZMQ.Socket.set_linger_period rep_socket 1_000_000;
|
ZMQ.Socket.set_linger_period rep_socket 1_000_000;
|
||||||
bind_socket "REP" rep_socket address;
|
bind_socket "REP" rep_socket port;
|
||||||
|
|
||||||
let initial_program_state =
|
let initial_program_state =
|
||||||
{ queue = Queuing_system.create () ;
|
{ queue = Queuing_system.create () ;
|
||||||
@ -683,7 +680,7 @@ let run ~port =
|
|||||||
Printf.sprintf "q:%d r:%d n:%d : %s\n%!"
|
Printf.sprintf "q:%d r:%d n:%d : %s\n%!"
|
||||||
(Queuing_system.number_of_queued program_state.queue)
|
(Queuing_system.number_of_queued program_state.queue)
|
||||||
(Queuing_system.number_of_running program_state.queue)
|
(Queuing_system.number_of_running program_state.queue)
|
||||||
(Queuing_system.number program_state.queue)
|
(Queuing_system.number_of_tasks program_state.queue)
|
||||||
(Message.to_string message)
|
(Message.to_string message)
|
||||||
|> debug;
|
|> debug;
|
||||||
|
|
||||||
@ -721,6 +718,7 @@ let run ~port =
|
|||||||
|
|
||||||
ZMQ.Socket.send pair_socket @@ string_of_pub_state Stopped;
|
ZMQ.Socket.send pair_socket @@ string_of_pub_state Stopped;
|
||||||
Thread.join pub_thread;
|
Thread.join pub_thread;
|
||||||
|
ZMQ.Socket.close rep_socket
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -23,9 +23,9 @@ val debug : string -> unit
|
|||||||
(** ZeroMQ context *)
|
(** ZeroMQ context *)
|
||||||
val zmq_context : ZMQ.Context.t
|
val zmq_context : ZMQ.Context.t
|
||||||
|
|
||||||
(** Bind a ZMQ socket *)
|
(** Bind a ZMQ socket to a TCP port and to an IPC file /tmp/qp_run.<port> *)
|
||||||
val bind_socket :
|
val bind_socket :
|
||||||
socket_type:string -> socket:'a ZMQ.Socket.t -> address:string -> unit
|
socket_type:string -> socket:'a ZMQ.Socket.t -> port:int -> unit
|
||||||
|
|
||||||
(** Name of the host on which the server runs *)
|
(** Name of the host on which the server runs *)
|
||||||
val hostname : string lazy_t
|
val hostname : string lazy_t
|
||||||
|
@ -88,8 +88,9 @@ let run ~multiplicity ezfio_file =
|
|||||||
~alpha:(Elec_alpha_number.of_int alpha_new)
|
~alpha:(Elec_alpha_number.of_int alpha_new)
|
||||||
~beta:(Elec_beta_number.of_int beta_new) pair )
|
~beta:(Elec_beta_number.of_int beta_new) pair )
|
||||||
in
|
in
|
||||||
|
|
||||||
let c =
|
let c =
|
||||||
Array.create ~len:(List.length determinants) (Det_coef.of_float 1.)
|
Array.init (List.length determinants) (fun _ -> Det_coef.of_float ((Random.float 2.)-.1.))
|
||||||
in
|
in
|
||||||
|
|
||||||
determinants
|
determinants
|
||||||
|
@ -15,7 +15,7 @@ let print_list () =
|
|||||||
let () =
|
let () =
|
||||||
Random.self_init ()
|
Random.self_init ()
|
||||||
|
|
||||||
let run ~master exe ezfio_file =
|
let run slave exe ezfio_file =
|
||||||
|
|
||||||
|
|
||||||
(** Check availability of the ports *)
|
(** Check availability of the ports *)
|
||||||
@ -28,7 +28,7 @@ let run ~master exe ezfio_file =
|
|||||||
in
|
in
|
||||||
let rec try_new_port port_number =
|
let rec try_new_port port_number =
|
||||||
try
|
try
|
||||||
List.iter [ 0;1;2;3;4 ] ~f:(fun i ->
|
List.iter [ 0;1;2;3;4;5;6;7;8;9 ] ~f:(fun i ->
|
||||||
let address =
|
let address =
|
||||||
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) (port_number+i)
|
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) (port_number+i)
|
||||||
in
|
in
|
||||||
@ -75,16 +75,23 @@ let run ~master exe ezfio_file =
|
|||||||
| 0 -> ()
|
| 0 -> ()
|
||||||
| i -> failwith "Error: Input inconsistent\n"
|
| i -> failwith "Error: Input inconsistent\n"
|
||||||
end;
|
end;
|
||||||
begin
|
|
||||||
match master with
|
let qp_run_address_filename =
|
||||||
| Some address -> Unix.putenv ~key:"QP_RUN_ADDRESS_MASTER" ~data:address
|
Filename.concat (Qpackage.ezfio_work ezfio_file) "qp_run_address"
|
||||||
| None -> ()
|
in
|
||||||
end;
|
|
||||||
|
let () =
|
||||||
|
if slave then
|
||||||
|
try
|
||||||
|
let address =
|
||||||
|
In_channel.read_all qp_run_address_filename
|
||||||
|
|> String.strip
|
||||||
|
in
|
||||||
|
Unix.putenv ~key:"QP_RUN_ADDRESS_MASTER" ~data:address
|
||||||
|
with Sys_error _ -> failwith "No master is not running"
|
||||||
|
in
|
||||||
|
|
||||||
(** Start task server *)
|
(** Start task server *)
|
||||||
let address =
|
|
||||||
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) port_number
|
|
||||||
in
|
|
||||||
let task_thread =
|
let task_thread =
|
||||||
let thread =
|
let thread =
|
||||||
Thread.create ( fun () ->
|
Thread.create ( fun () ->
|
||||||
@ -92,7 +99,16 @@ let run ~master exe ezfio_file =
|
|||||||
in
|
in
|
||||||
thread ();
|
thread ();
|
||||||
in
|
in
|
||||||
|
let address =
|
||||||
|
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) port_number
|
||||||
|
in
|
||||||
Unix.putenv ~key:"QP_RUN_ADDRESS" ~data:address;
|
Unix.putenv ~key:"QP_RUN_ADDRESS" ~data:address;
|
||||||
|
let () =
|
||||||
|
if (not slave) then
|
||||||
|
Out_channel.with_file qp_run_address_filename ~f:(
|
||||||
|
fun oc -> Out_channel.output_lines oc [address])
|
||||||
|
in
|
||||||
|
|
||||||
|
|
||||||
(** Run executable *)
|
(** Run executable *)
|
||||||
let prefix =
|
let prefix =
|
||||||
@ -111,6 +127,8 @@ let run ~master exe ezfio_file =
|
|||||||
|
|
||||||
TaskServer.stop ~port:port_number;
|
TaskServer.stop ~port:port_number;
|
||||||
Thread.join task_thread;
|
Thread.join task_thread;
|
||||||
|
if (not slave) then
|
||||||
|
Sys.remove qp_run_address_filename;
|
||||||
|
|
||||||
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
|
||||||
@ -119,8 +137,8 @@ let run ~master exe ezfio_file =
|
|||||||
let spec =
|
let spec =
|
||||||
let open Command.Spec in
|
let open Command.Spec in
|
||||||
empty
|
empty
|
||||||
+> flag "master" (optional string)
|
+> flag "slave" no_arg
|
||||||
~doc:("address Address of the master process")
|
~doc:(" Needed for slave tasks")
|
||||||
+> anon ("executable" %: string)
|
+> anon ("executable" %: string)
|
||||||
+> anon ("ezfio_file" %: string)
|
+> anon ("ezfio_file" %: string)
|
||||||
;;
|
;;
|
||||||
@ -138,8 +156,8 @@ Executes a Quantum Package binary file among these:\n\n"
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
spec
|
spec
|
||||||
(fun master exe ezfio_file () ->
|
(fun slave exe ezfio_file () ->
|
||||||
run ~master exe ezfio_file
|
run slave exe ezfio_file
|
||||||
)
|
)
|
||||||
|> Command.run ~version: Git.sha1 ~build_info: Git.message
|
|> Command.run ~version: Git.sha1 ~build_info: Git.message
|
||||||
|
|
||||||
|
@ -8,6 +8,13 @@ s.unset_skip()
|
|||||||
s.filter_only_1h1p()
|
s.filter_only_1h1p()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
|
s = H_apply("just_1h_1p_singles",do_double_exc=False)
|
||||||
|
s.set_selection_pt2("epstein_nesbet_2x2")
|
||||||
|
s.unset_skip()
|
||||||
|
s.filter_only_1h1p()
|
||||||
|
print s
|
||||||
|
|
||||||
|
|
||||||
s = H_apply("just_mono",do_double_exc=False)
|
s = H_apply("just_mono",do_double_exc=False)
|
||||||
s.set_selection_pt2("epstein_nesbet_2x2")
|
s.set_selection_pt2("epstein_nesbet_2x2")
|
||||||
s.unset_skip()
|
s.unset_skip()
|
||||||
|
@ -15,6 +15,7 @@ Needed Modules
|
|||||||
* `Properties <http://github.com/LCPQ/quantum_package/tree/master/plugins/Properties>`_
|
* `Properties <http://github.com/LCPQ/quantum_package/tree/master/plugins/Properties>`_
|
||||||
* `Selectors_no_sorted <http://github.com/LCPQ/quantum_package/tree/master/plugins/Selectors_no_sorted>`_
|
* `Selectors_no_sorted <http://github.com/LCPQ/quantum_package/tree/master/plugins/Selectors_no_sorted>`_
|
||||||
* `Utils <http://github.com/LCPQ/quantum_package/tree/master/src/Utils>`_
|
* `Utils <http://github.com/LCPQ/quantum_package/tree/master/src/Utils>`_
|
||||||
|
* `Davidson <http://github.com/LCPQ/quantum_package/tree/master/src/Davidson>`_
|
||||||
|
|
||||||
Documentation
|
Documentation
|
||||||
=============
|
=============
|
||||||
|
@ -49,7 +49,7 @@ subroutine routine
|
|||||||
endif
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
if(n_det_before == N_det)then
|
if(n_det_before == N_det)then
|
||||||
selection_criterion = selection_criterion * 0.5d0
|
selection_criterion_factor = selection_criterion_factor * 0.5d0
|
||||||
endif
|
endif
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
76
plugins/All_singles/all_1h_1p_singles.irp.f
Normal file
76
plugins/All_singles/all_1h_1p_singles.irp.f
Normal file
@ -0,0 +1,76 @@
|
|||||||
|
program restart_more_singles
|
||||||
|
BEGIN_DOC
|
||||||
|
! Generates and select single and double excitations of type 1h-1p
|
||||||
|
! on the top of a given restart wave function of type CAS
|
||||||
|
END_DOC
|
||||||
|
read_wf = .true.
|
||||||
|
touch read_wf
|
||||||
|
print*,'ref_bitmask_energy = ',ref_bitmask_energy
|
||||||
|
call routine
|
||||||
|
|
||||||
|
end
|
||||||
|
subroutine routine
|
||||||
|
implicit none
|
||||||
|
integer :: i,k
|
||||||
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:),E_before(:)
|
||||||
|
integer :: N_st, degree
|
||||||
|
integer :: n_det_before
|
||||||
|
N_st = N_states
|
||||||
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
||||||
|
i = 0
|
||||||
|
print*,'N_det = ',N_det
|
||||||
|
print*,'n_det_max = ',n_det_max
|
||||||
|
print*,'pt2_max = ',pt2_max
|
||||||
|
pt2=-1.d0
|
||||||
|
E_before = ref_bitmask_energy
|
||||||
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
||||||
|
n_det_before = N_det
|
||||||
|
i += 1
|
||||||
|
print*,'-----------------------'
|
||||||
|
print*,'i = ',i
|
||||||
|
call H_apply_just_1h_1p_singles(pt2, norm_pert, H_pert_diag, N_st)
|
||||||
|
call diagonalize_CI
|
||||||
|
print*,'N_det = ',N_det
|
||||||
|
print*,'E = ',CI_energy(1)
|
||||||
|
print*,'pt2 = ',pt2(1)
|
||||||
|
print*,'E+PT2 = ',E_before + pt2(1)
|
||||||
|
E_before = CI_energy
|
||||||
|
if(N_states_diag.gt.1)then
|
||||||
|
print*,'Variational Energy difference'
|
||||||
|
do i = 2, N_st
|
||||||
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
if(N_states.gt.1)then
|
||||||
|
print*,'Variational + perturbative Energy difference'
|
||||||
|
do i = 2, N_st
|
||||||
|
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
call save_wavefunction
|
||||||
|
if(n_det_before == N_det)then
|
||||||
|
selection_criterion_factor = selection_criterion_factor * 0.5d0
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
threshold_davidson = 1.d-10
|
||||||
|
soft_touch threshold_davidson davidson_criterion
|
||||||
|
call diagonalize_CI
|
||||||
|
if(N_states_diag.gt.1)then
|
||||||
|
print*,'Variational Energy difference'
|
||||||
|
do i = 2, N_st
|
||||||
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
if(N_states.gt.1)then
|
||||||
|
print*,'Variational + perturbative Energy difference'
|
||||||
|
do i = 2, N_st
|
||||||
|
print*,'Delta E = ',CI_energy(i)+ pt2(i) - (CI_energy(1) + pt2(1))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
call ezfio_set_all_singles_energy(CI_energy)
|
||||||
|
|
||||||
|
call save_wavefunction
|
||||||
|
deallocate(pt2,norm_pert)
|
||||||
|
end
|
0
plugins/All_singles/tree_dependency.png
Normal file
0
plugins/All_singles/tree_dependency.png
Normal file
1
plugins/CAS_SD/.gitignore
vendored
1
plugins/CAS_SD/.gitignore
vendored
@ -3,6 +3,7 @@
|
|||||||
.ninja_log
|
.ninja_log
|
||||||
AO_Basis
|
AO_Basis
|
||||||
Bitmask
|
Bitmask
|
||||||
|
Davidson
|
||||||
Determinants
|
Determinants
|
||||||
Electrons
|
Electrons
|
||||||
Ezfio_files
|
Ezfio_files
|
||||||
|
@ -107,6 +107,7 @@ Needed Modules
|
|||||||
* `Perturbation <http://github.com/LCPQ/quantum_package/tree/master/plugins/Perturbation>`_
|
* `Perturbation <http://github.com/LCPQ/quantum_package/tree/master/plugins/Perturbation>`_
|
||||||
* `Selectors_full <http://github.com/LCPQ/quantum_package/tree/master/plugins/Selectors_full>`_
|
* `Selectors_full <http://github.com/LCPQ/quantum_package/tree/master/plugins/Selectors_full>`_
|
||||||
* `Generators_CAS <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_CAS>`_
|
* `Generators_CAS <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_CAS>`_
|
||||||
|
* `Davidson <http://github.com/LCPQ/quantum_package/tree/master/src/Davidson>`_
|
||||||
|
|
||||||
Documentation
|
Documentation
|
||||||
=============
|
=============
|
||||||
@ -193,31 +194,6 @@ h_apply_cas_s_selected_monoexc
|
|||||||
Assume N_int is already provided.
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
h_apply_cas_s_selected_no_skip
|
|
||||||
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.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_cas_s_selected_no_skip_diexc
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_cas_s_selected_no_skip_diexcorg
|
|
||||||
Generate all double excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_cas_s_selected_no_skip_diexcp
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_cas_s_selected_no_skip_monoexc
|
|
||||||
Generate all single excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_cas_sd
|
h_apply_cas_sd
|
||||||
Calls H_apply on the HF determinant and selects all connected single and double
|
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.
|
excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script.
|
||||||
|
@ -93,8 +93,8 @@ program full_ci
|
|||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
if(do_pt2_end)then
|
if(do_pt2_end)then
|
||||||
print*,'Last iteration only to compute the PT2'
|
print*,'Last iteration only to compute the PT2'
|
||||||
threshold_selectors = 1.d0
|
threshold_selectors = max(threshold_selectors,threshold_selectors_pt2)
|
||||||
threshold_generators = 0.999d0
|
threshold_generators = max(threshold_generators,threshold_generators_pt2)
|
||||||
call H_apply_CAS_SD_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
call H_apply_CAS_SD_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
||||||
|
|
||||||
print *, 'Final step'
|
print *, 'Final step'
|
||||||
|
10
plugins/CAS_SD_ZMQ/EZFIO.cfg
Normal file
10
plugins/CAS_SD_ZMQ/EZFIO.cfg
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
[energy]
|
||||||
|
type: double precision
|
||||||
|
doc: "Calculated CAS-SD energy"
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[energy_pt2]
|
||||||
|
type: double precision
|
||||||
|
doc: "Calculated selected CAS-SD energy with PT2 correction"
|
||||||
|
interface: ezfio
|
||||||
|
|
2
plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES
Normal file
2
plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
Generators_CAS Perturbation Selectors_CASSD ZMQ
|
||||||
|
|
14
plugins/CAS_SD_ZMQ/README.rst
Normal file
14
plugins/CAS_SD_ZMQ/README.rst
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
==========
|
||||||
|
CAS_SD_ZMQ
|
||||||
|
==========
|
||||||
|
|
||||||
|
Selected CAS+SD module with Zero-MQ parallelization.
|
||||||
|
|
||||||
|
Needed Modules
|
||||||
|
==============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
||||||
|
Documentation
|
||||||
|
=============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
255
plugins/CAS_SD_ZMQ/cassd_zmq.irp.f
Normal file
255
plugins/CAS_SD_ZMQ/cassd_zmq.irp.f
Normal file
@ -0,0 +1,255 @@
|
|||||||
|
program fci_zmq
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k
|
||||||
|
logical, external :: detEq
|
||||||
|
|
||||||
|
double precision, allocatable :: pt2(:)
|
||||||
|
integer :: degree
|
||||||
|
double precision :: threshold_davidson_in
|
||||||
|
|
||||||
|
allocate (pt2(N_states))
|
||||||
|
|
||||||
|
pt2 = 1.d0
|
||||||
|
threshold_davidson_in = threshold_davidson
|
||||||
|
threshold_davidson = threshold_davidson_in * 100.d0
|
||||||
|
SOFT_TOUCH threshold_davidson
|
||||||
|
|
||||||
|
|
||||||
|
if (N_det > N_det_max) then
|
||||||
|
call diagonalize_CI
|
||||||
|
call save_wavefunction
|
||||||
|
psi_det = psi_det_sorted
|
||||||
|
psi_coef = psi_coef_sorted
|
||||||
|
N_det = N_det_max
|
||||||
|
soft_touch N_det psi_det psi_coef
|
||||||
|
call diagonalize_CI
|
||||||
|
call save_wavefunction
|
||||||
|
print *, 'N_det = ', N_det
|
||||||
|
print *, 'N_states = ', N_states
|
||||||
|
do k=1,N_states
|
||||||
|
print*,'State ',k
|
||||||
|
print *, 'PT2 = ', pt2(k)
|
||||||
|
print *, 'E = ', CI_energy(k)
|
||||||
|
print *, 'E+PT2 = ', CI_energy(k) + pt2(k)
|
||||||
|
print *, '-----'
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
double precision :: E_CI_before(N_states)
|
||||||
|
|
||||||
|
|
||||||
|
integer :: n_det_before, to_select
|
||||||
|
print*,'Beginning the selection ...'
|
||||||
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
|
|
||||||
|
do while ( (N_det < N_det_max) .and. (maxval(abs(pt2(1:N_states))) > pt2_max) )
|
||||||
|
|
||||||
|
print *, 'N_det = ', N_det
|
||||||
|
print *, 'N_states = ', N_states
|
||||||
|
do k=1, N_states
|
||||||
|
print*,'State ',k
|
||||||
|
print *, 'PT2 = ', pt2(k)
|
||||||
|
print *, 'E = ', CI_energy(k)
|
||||||
|
print *, 'E(before)+PT2 = ', E_CI_before(k)+pt2(k)
|
||||||
|
enddo
|
||||||
|
print *, '-----'
|
||||||
|
if(N_states.gt.1)then
|
||||||
|
print*,'Variational Energy difference'
|
||||||
|
do i = 2, N_states
|
||||||
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
if(N_states.gt.1)then
|
||||||
|
print*,'Variational + perturbative Energy difference'
|
||||||
|
do i = 2, N_states
|
||||||
|
print*,'Delta E = ',E_CI_before(i)+ pt2(i) - (E_CI_before(1) + pt2(1))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
|
call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
|
||||||
|
|
||||||
|
n_det_before = N_det
|
||||||
|
to_select = 2*N_det
|
||||||
|
to_select = max(64-to_select, to_select)
|
||||||
|
to_select = min(to_select,N_det_max-n_det_before)
|
||||||
|
call ZMQ_selection(to_select, pt2)
|
||||||
|
|
||||||
|
PROVIDE psi_coef
|
||||||
|
PROVIDE psi_det
|
||||||
|
PROVIDE psi_det_sorted
|
||||||
|
|
||||||
|
if (N_det == N_det_max) then
|
||||||
|
threshold_davidson = threshold_davidson_in
|
||||||
|
SOFT_TOUCH threshold_davidson
|
||||||
|
endif
|
||||||
|
call diagonalize_CI
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (N_det < N_det_max) then
|
||||||
|
threshold_davidson = threshold_davidson_in
|
||||||
|
SOFT_TOUCH threshold_davidson
|
||||||
|
call diagonalize_CI
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
|
||||||
|
endif
|
||||||
|
|
||||||
|
integer :: exc_max, degree_min
|
||||||
|
exc_max = 0
|
||||||
|
print *, 'CAS determinants : ', N_det_cas
|
||||||
|
do i=1,min(N_det_cas,20)
|
||||||
|
do k=i,N_det_cas
|
||||||
|
call get_excitation_degree(psi_cas(1,1,k),psi_cas(1,1,i),degree,N_int)
|
||||||
|
exc_max = max(exc_max,degree)
|
||||||
|
enddo
|
||||||
|
print *, psi_cas_coef(i,:)
|
||||||
|
call debug_det(psi_cas(1,1,i),N_int)
|
||||||
|
print *, ''
|
||||||
|
enddo
|
||||||
|
print *, 'Max excitation degree in the CAS :', exc_max
|
||||||
|
|
||||||
|
if(do_pt2_end)then
|
||||||
|
print*,'Last iteration only to compute the PT2'
|
||||||
|
threshold_selectors = max(threshold_selectors,threshold_selectors_pt2)
|
||||||
|
threshold_generators = max(threshold_generators,threshold_generators_pt2)
|
||||||
|
TOUCH threshold_selectors threshold_generators
|
||||||
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
|
call ZMQ_selection(0, pt2)
|
||||||
|
print *, 'Final step'
|
||||||
|
print *, 'N_det = ', N_det
|
||||||
|
print *, 'N_states = ', N_states
|
||||||
|
do k=1,N_states
|
||||||
|
print *, 'State', k
|
||||||
|
print *, 'PT2 = ', pt2(k)
|
||||||
|
print *, 'E = ', E_CI_before(k)
|
||||||
|
print *, 'E+PT2 = ', E_CI_before(k)+pt2(k)
|
||||||
|
print *, '-----'
|
||||||
|
enddo
|
||||||
|
call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before+pt2)
|
||||||
|
endif
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
|
||||||
|
call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before(1)+pt2(1))
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ZMQ_selection(N_in, pt2)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
character*(512) :: task
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: N_in
|
||||||
|
type(selection_buffer) :: b
|
||||||
|
integer :: i, N
|
||||||
|
integer, external :: omp_get_thread_num
|
||||||
|
double precision, intent(out) :: pt2(N_states)
|
||||||
|
|
||||||
|
|
||||||
|
if (.True.) then
|
||||||
|
PROVIDE pt2_e0_denominator
|
||||||
|
N = max(N_in,1)
|
||||||
|
provide nproc
|
||||||
|
call new_parallel_job(zmq_to_qp_run_socket,"selection")
|
||||||
|
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
|
||||||
|
call zmq_set_running(zmq_to_qp_run_socket)
|
||||||
|
call create_selection_buffer(N, N*2, b)
|
||||||
|
endif
|
||||||
|
|
||||||
|
integer :: i_generator, i_generator_start, i_generator_max, step
|
||||||
|
! step = int(max(1.,10*elec_num/mo_tot_num)
|
||||||
|
|
||||||
|
step = int(5000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num ))
|
||||||
|
step = max(1,step)
|
||||||
|
do i= 1, N_det_generators,step
|
||||||
|
i_generator_start = i
|
||||||
|
i_generator_max = min(i+step-1,N_det_generators)
|
||||||
|
write(task,*) i_generator_start, i_generator_max, 1, N
|
||||||
|
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
||||||
|
end do
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
if (i==0) then
|
||||||
|
call selection_collector(b, pt2)
|
||||||
|
else
|
||||||
|
call selection_slave_inproc(i)
|
||||||
|
endif
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
call end_parallel_job(zmq_to_qp_run_socket, 'selection')
|
||||||
|
if (N_in > 0) then
|
||||||
|
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) !!! PAS DE ROBIN
|
||||||
|
call copy_H_apply_buffer_to_wf()
|
||||||
|
if (s2_eig) then
|
||||||
|
call make_s2_eigenfunction
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine selection_slave_inproc(i)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i
|
||||||
|
|
||||||
|
call run_selection_slave(1,i,pt2_e0_denominator)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine selection_collector(b, pt2)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
|
||||||
|
type(selection_buffer), intent(inout) :: b
|
||||||
|
double precision, intent(out) :: pt2(N_states)
|
||||||
|
double precision :: pt2_mwen(N_states)
|
||||||
|
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 :: msg_size, rc, more
|
||||||
|
integer :: acc, i, j, robin, N, ntask
|
||||||
|
double precision, allocatable :: val(:)
|
||||||
|
integer(bit_kind), allocatable :: det(:,:,:)
|
||||||
|
integer, allocatable :: task_id(:)
|
||||||
|
integer :: done
|
||||||
|
real :: time, time0
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
zmq_socket_pull = new_zmq_pull_socket()
|
||||||
|
allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det))
|
||||||
|
done = 0
|
||||||
|
more = 1
|
||||||
|
pt2(:) = 0d0
|
||||||
|
call CPU_TIME(time0)
|
||||||
|
do while (more == 1)
|
||||||
|
call pull_selection_results(zmq_socket_pull, pt2_mwen, val(1), det(1,1,1), N, task_id, ntask)
|
||||||
|
pt2 += pt2_mwen
|
||||||
|
do i=1, N
|
||||||
|
call add_to_selection_buffer(b, det(1,1,i), val(i))
|
||||||
|
end do
|
||||||
|
|
||||||
|
do i=1, ntask
|
||||||
|
if(task_id(i) == 0) then
|
||||||
|
print *, "Error in collector"
|
||||||
|
endif
|
||||||
|
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
|
||||||
|
end do
|
||||||
|
done += ntask
|
||||||
|
call CPU_TIME(time)
|
||||||
|
! print *, "DONE" , done, time - time0
|
||||||
|
end do
|
||||||
|
|
||||||
|
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
call end_zmq_pull_socket(zmq_socket_pull)
|
||||||
|
call sort_selection_buffer(b)
|
||||||
|
end subroutine
|
||||||
|
|
79
plugins/CAS_SD_ZMQ/e_corr_selectors.irp.f
Normal file
79
plugins/CAS_SD_ZMQ/e_corr_selectors.irp.f
Normal file
@ -0,0 +1,79 @@
|
|||||||
|
|
||||||
|
use bitmasks
|
||||||
|
BEGIN_PROVIDER [integer, exc_degree_per_selectors, (N_det_selectors)]
|
||||||
|
&BEGIN_PROVIDER [integer, double_index_selectors, (N_det_selectors)]
|
||||||
|
&BEGIN_PROVIDER [integer, n_double_selectors]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! degree of excitation respect to Hartree Fock for the wave function
|
||||||
|
!
|
||||||
|
! for the all the selectors determinants
|
||||||
|
!
|
||||||
|
! double_index_selectors = list of the index of the double excitations
|
||||||
|
!
|
||||||
|
! n_double_selectors = number of double excitations in the selectors determinants
|
||||||
|
END_DOC
|
||||||
|
integer :: i,degree
|
||||||
|
n_double_selectors = 0
|
||||||
|
do i = 1, N_det_selectors
|
||||||
|
call get_excitation_degree(psi_selectors(1,1,i),ref_bitmask,degree,N_int)
|
||||||
|
exc_degree_per_selectors(i) = degree
|
||||||
|
if(degree==2)then
|
||||||
|
n_double_selectors += 1
|
||||||
|
double_index_selectors(n_double_selectors) =i
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER[double precision, coef_hf_selector]
|
||||||
|
&BEGIN_PROVIDER[double precision, inv_selectors_coef_hf]
|
||||||
|
&BEGIN_PROVIDER[double precision, inv_selectors_coef_hf_squared]
|
||||||
|
&BEGIN_PROVIDER[double precision, E_corr_per_selectors, (N_det_selectors)]
|
||||||
|
&BEGIN_PROVIDER[double precision, i_H_HF_per_selectors, (N_det_selectors)]
|
||||||
|
&BEGIN_PROVIDER[double precision, Delta_E_per_selector, (N_det_selectors)]
|
||||||
|
&BEGIN_PROVIDER[double precision, E_corr_double_only ]
|
||||||
|
&BEGIN_PROVIDER[double precision, E_corr_second_order ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! energy of correlation per determinant respect to the Hartree Fock determinant
|
||||||
|
!
|
||||||
|
! for the all the double excitations in the selectors determinants
|
||||||
|
!
|
||||||
|
! E_corr_per_selectors(i) = <D_i|H|HF> * c(D_i)/c(HF) if |D_i> is a double excitation
|
||||||
|
!
|
||||||
|
! E_corr_per_selectors(i) = -1000.d0 if it is not a double excitation
|
||||||
|
!
|
||||||
|
! coef_hf_selector = coefficient of the Hartree Fock determinant in the selectors determinants
|
||||||
|
END_DOC
|
||||||
|
PROVIDE ref_bitmask_energy psi_selectors ref_bitmask N_int psi_selectors
|
||||||
|
integer :: i,degree
|
||||||
|
double precision :: hij,diag_H_mat_elem
|
||||||
|
E_corr_double_only = 0.d0
|
||||||
|
E_corr_second_order = 0.d0
|
||||||
|
do i = 1, N_det_selectors
|
||||||
|
if(exc_degree_per_selectors(i)==2)then
|
||||||
|
call i_H_j(ref_bitmask,psi_selectors(1,1,i),N_int,hij)
|
||||||
|
i_H_HF_per_selectors(i) = hij
|
||||||
|
E_corr_per_selectors(i) = psi_selectors_coef(i,1) * hij
|
||||||
|
E_corr_double_only += E_corr_per_selectors(i)
|
||||||
|
! E_corr_second_order += hij * hij /(ref_bitmask_energy - diag_H_mat_elem(psi_selectors(1,1,i),N_int))
|
||||||
|
elseif(exc_degree_per_selectors(i) == 0)then
|
||||||
|
coef_hf_selector = psi_selectors_coef(i,1)
|
||||||
|
E_corr_per_selectors(i) = -1000.d0
|
||||||
|
Delta_E_per_selector(i) = 0.d0
|
||||||
|
else
|
||||||
|
E_corr_per_selectors(i) = -1000.d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (dabs(coef_hf_selector) > 1.d-8) then
|
||||||
|
inv_selectors_coef_hf = 1.d0/coef_hf_selector
|
||||||
|
inv_selectors_coef_hf_squared = inv_selectors_coef_hf * inv_selectors_coef_hf
|
||||||
|
else
|
||||||
|
inv_selectors_coef_hf = 0.d0
|
||||||
|
inv_selectors_coef_hf_squared = 0.d0
|
||||||
|
endif
|
||||||
|
do i = 1,n_double_selectors
|
||||||
|
E_corr_per_selectors(double_index_selectors(i)) *=inv_selectors_coef_hf
|
||||||
|
enddo
|
||||||
|
E_corr_double_only = E_corr_double_only * inv_selectors_coef_hf
|
||||||
|
END_PROVIDER
|
11
plugins/CAS_SD_ZMQ/energy.irp.f
Normal file
11
plugins/CAS_SD_ZMQ/energy.irp.f
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! E0 in the denominator of the PT2
|
||||||
|
END_DOC
|
||||||
|
pt2_E0_denominator(1:N_states) = CI_electronic_energy(1:N_states)
|
||||||
|
! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion
|
||||||
|
! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states)
|
||||||
|
call write_double(6,pt2_E0_denominator(1)+nuclear_repulsion, 'PT2 Energy denominator')
|
||||||
|
END_PROVIDER
|
||||||
|
|
4
plugins/CAS_SD_ZMQ/ezfio_interface.irp.f
Normal file
4
plugins/CAS_SD_ZMQ/ezfio_interface.irp.f
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
! DO NOT MODIFY BY HAND
|
||||||
|
! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py
|
||||||
|
! from file /home/scemama/quantum_package/src/CAS_SD_ZMQ/EZFIO.cfg
|
||||||
|
|
156
plugins/CAS_SD_ZMQ/run_selection_slave.irp.f
Normal file
156
plugins/CAS_SD_ZMQ/run_selection_slave.irp.f
Normal file
@ -0,0 +1,156 @@
|
|||||||
|
|
||||||
|
subroutine run_selection_slave(thread,iproc,energy)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision, intent(in) :: energy(N_states)
|
||||||
|
integer, intent(in) :: thread, iproc
|
||||||
|
integer :: rc, i
|
||||||
|
|
||||||
|
integer :: worker_id, task_id(1), ctask, ltask
|
||||||
|
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
|
||||||
|
|
||||||
|
type(selection_buffer) :: buf, buf2
|
||||||
|
logical :: done
|
||||||
|
double precision :: pt2(N_states)
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
zmq_socket_push = new_zmq_push_socket(thread)
|
||||||
|
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||||
|
if(worker_id == -1) then
|
||||||
|
print *, "WORKER -1"
|
||||||
|
!call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
|
return
|
||||||
|
end if
|
||||||
|
buf%N = 0
|
||||||
|
ctask = 1
|
||||||
|
pt2 = 0d0
|
||||||
|
|
||||||
|
do
|
||||||
|
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id(ctask), task)
|
||||||
|
done = task_id(ctask) == 0
|
||||||
|
if (done) then
|
||||||
|
ctask = ctask - 1
|
||||||
|
else
|
||||||
|
integer :: i_generator, i_generator_start, i_generator_max, step, N
|
||||||
|
read (task,*) i_generator_start, i_generator_max, step, N
|
||||||
|
if(buf%N == 0) then
|
||||||
|
! Only first time
|
||||||
|
call create_selection_buffer(N, N*2, buf)
|
||||||
|
call create_selection_buffer(N, N*3, buf2)
|
||||||
|
else
|
||||||
|
if(N /= buf%N) stop "N changed... wtf man??"
|
||||||
|
end if
|
||||||
|
!print *, "psi_selectors_coef ", psi_selectors_coef(N_det_selectors-5:N_det_selectors, 1)
|
||||||
|
!call debug_det(psi_selectors(1,1,N_det_selectors), N_int)
|
||||||
|
do i_generator=i_generator_start,i_generator_max,step
|
||||||
|
call select_connected(i_generator,energy,pt2,buf)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(done .or. ctask == size(task_id)) then
|
||||||
|
if(buf%N == 0 .and. ctask > 0) stop "uninitialized selection_buffer"
|
||||||
|
do i=1, ctask
|
||||||
|
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i))
|
||||||
|
end do
|
||||||
|
if(ctask > 0) then
|
||||||
|
call push_selection_results(zmq_socket_push, pt2, buf, task_id(1), ctask)
|
||||||
|
do i=1,buf%cur
|
||||||
|
call add_to_selection_buffer(buf2, buf%det(1,1,i), buf%val(i))
|
||||||
|
enddo
|
||||||
|
call sort_selection_buffer(buf2)
|
||||||
|
buf%mini = buf2%mini
|
||||||
|
pt2 = 0d0
|
||||||
|
buf%cur = 0
|
||||||
|
end if
|
||||||
|
ctask = 0
|
||||||
|
end if
|
||||||
|
|
||||||
|
if(done) exit
|
||||||
|
ctask = ctask + 1
|
||||||
|
end do
|
||||||
|
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine push_selection_results(zmq_socket_push, pt2, b, task_id, ntask)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
|
double precision, intent(in) :: pt2(N_states)
|
||||||
|
type(selection_buffer), intent(inout) :: b
|
||||||
|
integer, intent(in) :: ntask, task_id(*)
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
call sort_selection_buffer(b)
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop "push"
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, pt2, 8*N_states, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 8*N_states) stop "push"
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 8*b%cur) stop "push"
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE)
|
||||||
|
if(rc /= bit_kind*N_int*2*b%cur) stop "push"
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, ntask, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop "push"
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, task_id(1), ntask*4, 0)
|
||||||
|
if(rc /= 4*ntask) stop "push"
|
||||||
|
|
||||||
|
! Activate is zmq_socket_push is a REQ
|
||||||
|
! rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0)
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine pull_selection_results(zmq_socket_pull, pt2, val, det, N, task_id, ntask)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
||||||
|
double precision, intent(inout) :: pt2(N_states)
|
||||||
|
double precision, intent(out) :: val(*)
|
||||||
|
integer(bit_kind), intent(out) :: det(N_int, 2, *)
|
||||||
|
integer, intent(out) :: N, ntask, task_id(*)
|
||||||
|
integer :: rc, rn, i
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0)
|
||||||
|
if(rc /= 4) stop "pull"
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, pt2, N_states*8, 0)
|
||||||
|
if(rc /= 8*N_states) stop "pull"
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0)
|
||||||
|
if(rc /= 8*N) stop "pull"
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0)
|
||||||
|
if(rc /= bit_kind*N_int*2*N) stop "pull"
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, 0)
|
||||||
|
if(rc /= 4) stop "pull"
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntask*4, 0)
|
||||||
|
if(rc /= 4*ntask) stop "pull"
|
||||||
|
|
||||||
|
! Activate is zmq_socket_pull is a REP
|
||||||
|
! rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0)
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,3 +1,480 @@
|
|||||||
|
use bitmasks
|
||||||
|
|
||||||
|
|
||||||
|
double precision function integral8(i,j,k,l)
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i,j,k,l
|
||||||
|
double precision, external :: get_mo_bielec_integral
|
||||||
|
integer :: ii
|
||||||
|
ii = l-mo_integrals_cache_min
|
||||||
|
ii = ior(ii, k-mo_integrals_cache_min)
|
||||||
|
ii = ior(ii, j-mo_integrals_cache_min)
|
||||||
|
ii = ior(ii, i-mo_integrals_cache_min)
|
||||||
|
if (iand(ii, -64) /= 0) then
|
||||||
|
integral8 = get_mo_bielec_integral(i,j,k,l,mo_integrals_map)
|
||||||
|
else
|
||||||
|
ii = l-mo_integrals_cache_min
|
||||||
|
ii = ior( ishft(ii,6), k-mo_integrals_cache_min)
|
||||||
|
ii = ior( ishft(ii,6), j-mo_integrals_cache_min)
|
||||||
|
ii = ior( ishft(ii,6), i-mo_integrals_cache_min)
|
||||||
|
integral8 = mo_integrals_cache(ii)
|
||||||
|
endif
|
||||||
|
end function
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(1), psi_phasemask, (N_int*bit_kind_size, 2, N_det)]
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
do i=1, N_det
|
||||||
|
call get_mask_phase(psi_selectors(1,1,i), psi_phasemask(1,1,i))
|
||||||
|
end do
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
subroutine assert(cond, msg)
|
||||||
|
character(*), intent(in) :: msg
|
||||||
|
logical, intent(in) :: cond
|
||||||
|
|
||||||
|
if(.not. cond) then
|
||||||
|
print *, "assert fail: "//msg
|
||||||
|
stop
|
||||||
|
end if
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_mask_phase(det, phasemask)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(bit_kind), intent(in) :: det(N_int, 2)
|
||||||
|
integer(1), intent(out) :: phasemask(N_int*bit_kind_size, 2)
|
||||||
|
integer :: s, ni, i
|
||||||
|
logical :: change
|
||||||
|
|
||||||
|
phasemask = 0_1
|
||||||
|
do s=1,2
|
||||||
|
change = .false.
|
||||||
|
do ni=1,N_int
|
||||||
|
do i=0,bit_kind_size-1
|
||||||
|
if(BTEST(det(ni, s), i)) change = .not. change
|
||||||
|
if(change) phasemask((ni-1)*bit_kind_size + i + 1, s) = 1_1
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine select_connected(i_generator,E0,pt2,b)
|
||||||
|
use bitmasks
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i_generator
|
||||||
|
type(selection_buffer), intent(inout) :: b
|
||||||
|
double precision, intent(inout) :: pt2(N_states)
|
||||||
|
integer :: k,l
|
||||||
|
double precision, intent(in) :: E0(N_states)
|
||||||
|
|
||||||
|
integer(bit_kind) :: hole_mask(N_int,2), particle_mask(N_int,2)
|
||||||
|
double precision :: fock_diag_tmp(2,mo_tot_num+1)
|
||||||
|
|
||||||
|
call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int)
|
||||||
|
|
||||||
|
do l=1,N_generators_bitmask
|
||||||
|
do k=1,N_int
|
||||||
|
hole_mask(k,1) = iand(generators_bitmask(k,1,s_hole,l), psi_det_generators(k,1,i_generator))
|
||||||
|
hole_mask(k,2) = iand(generators_bitmask(k,2,s_hole,l), psi_det_generators(k,2,i_generator))
|
||||||
|
particle_mask(k,1) = iand(generators_bitmask(k,1,s_part,l), not(psi_det_generators(k,1,i_generator)) )
|
||||||
|
particle_mask(k,2) = iand(generators_bitmask(k,2,s_part,l), not(psi_det_generators(k,2,i_generator)) )
|
||||||
|
|
||||||
|
enddo
|
||||||
|
call select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b)
|
||||||
|
call select_singles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b)
|
||||||
|
enddo
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
|
||||||
|
integer, intent(in) :: s1, s2, h1, h2, p1, p2
|
||||||
|
logical :: change
|
||||||
|
integer(1) :: np
|
||||||
|
double precision, parameter :: res(0:1) = (/1d0, -1d0/)
|
||||||
|
|
||||||
|
np = phasemask(h1,s1) + phasemask(p1,s1) + phasemask(h2,s2) + phasemask(p2,s2)
|
||||||
|
if(p1 < h1) np = np + 1_1
|
||||||
|
if(p2 < h2) np = np + 1_1
|
||||||
|
|
||||||
|
if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1_1
|
||||||
|
get_phase_bi = res(iand(np,1_1))
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Selection single
|
||||||
|
! ----------------
|
||||||
|
|
||||||
|
subroutine select_singles(i_gen,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf)
|
||||||
|
use bitmasks
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Select determinants connected to i_det by H
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i_gen
|
||||||
|
integer(bit_kind), intent(in) :: hole_mask(N_int,2), particle_mask(N_int,2)
|
||||||
|
double precision, intent(in) :: fock_diag_tmp(mo_tot_num)
|
||||||
|
double precision, intent(in) :: E0(N_states)
|
||||||
|
double precision, intent(inout) :: pt2(N_states)
|
||||||
|
type(selection_buffer), intent(inout) :: buf
|
||||||
|
|
||||||
|
double precision :: vect(N_states, mo_tot_num)
|
||||||
|
logical :: bannedOrb(mo_tot_num)
|
||||||
|
integer :: i, j, k
|
||||||
|
integer :: h1,h2,s1,s2,i1,i2,ib,sp
|
||||||
|
integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2)
|
||||||
|
logical :: fullMatch, ok
|
||||||
|
|
||||||
|
|
||||||
|
do k=1,N_int
|
||||||
|
hole (k,1) = iand(psi_det_generators(k,1,i_gen), hole_mask(k,1))
|
||||||
|
hole (k,2) = iand(psi_det_generators(k,2,i_gen), hole_mask(k,2))
|
||||||
|
particle(k,1) = iand(not(psi_det_generators(k,1,i_gen)), particle_mask(k,1))
|
||||||
|
particle(k,2) = iand(not(psi_det_generators(k,2,i_gen)), particle_mask(k,2))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Create lists of holes and particles
|
||||||
|
! -----------------------------------
|
||||||
|
|
||||||
|
integer :: N_holes(2), N_particles(2)
|
||||||
|
integer :: hole_list(N_int*bit_kind_size,2)
|
||||||
|
integer :: particle_list(N_int*bit_kind_size,2)
|
||||||
|
|
||||||
|
call bitstring_to_list_ab(hole , hole_list , N_holes , N_int)
|
||||||
|
call bitstring_to_list_ab(particle, particle_list, N_particles, N_int)
|
||||||
|
|
||||||
|
do sp=1,2
|
||||||
|
do i=1, N_holes(sp)
|
||||||
|
h1 = hole_list(i,sp)
|
||||||
|
call apply_hole(psi_det_generators(1,1,i_gen), sp, h1, mask, ok, N_int)
|
||||||
|
bannedOrb = .true.
|
||||||
|
do j=1,N_particles(sp)
|
||||||
|
bannedOrb(particle_list(j, sp)) = .false.
|
||||||
|
end do
|
||||||
|
call spot_hasBeen(mask, sp, psi_selectors, i_gen, N_det, bannedOrb, fullMatch)
|
||||||
|
if(fullMatch) cycle
|
||||||
|
vect = 0d0
|
||||||
|
call splash_p(mask, sp, psi_selectors(1,1,i_gen), psi_phasemask(1,1,i_gen), psi_selectors_coef_transp(1,i_gen), N_det_selectors - i_gen + 1, bannedOrb, vect)
|
||||||
|
call fill_buffer_single(i_gen, sp, h1, bannedOrb, fock_diag_tmp, E0, pt2, vect, buf)
|
||||||
|
end do
|
||||||
|
enddo
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine fill_buffer_single(i_generator, sp, h1, bannedOrb, fock_diag_tmp, E0, pt2, vect, buf)
|
||||||
|
use bitmasks
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i_generator, sp, h1
|
||||||
|
double precision, intent(in) :: vect(N_states, mo_tot_num)
|
||||||
|
logical, intent(in) :: bannedOrb(mo_tot_num)
|
||||||
|
double precision, intent(in) :: fock_diag_tmp(mo_tot_num)
|
||||||
|
double precision, intent(in) :: E0(N_states)
|
||||||
|
double precision, intent(inout) :: pt2(N_states)
|
||||||
|
type(selection_buffer), intent(inout) :: buf
|
||||||
|
logical :: ok
|
||||||
|
integer :: s1, s2, p1, p2, ib, istate
|
||||||
|
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
||||||
|
double precision :: e_pert, delta_E, val, Hii, max_e_pert, tmp
|
||||||
|
double precision, external :: diag_H_mat_elem_fock
|
||||||
|
|
||||||
|
|
||||||
|
call apply_hole(psi_det_generators(1,1,i_generator), sp, h1, mask, ok, N_int)
|
||||||
|
|
||||||
|
do p1=1,mo_tot_num
|
||||||
|
if(bannedOrb(p1)) cycle
|
||||||
|
if(vect(1, p1) == 0d0) cycle
|
||||||
|
call apply_particle(mask, sp, p1, det, ok, N_int)
|
||||||
|
|
||||||
|
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
||||||
|
max_e_pert = 0d0
|
||||||
|
|
||||||
|
do istate=1,N_states
|
||||||
|
val = vect(istate, p1) + vect(istate, p1)
|
||||||
|
delta_E = E0(istate) - Hii
|
||||||
|
tmp = dsqrt(delta_E * delta_E + val * val)
|
||||||
|
if (delta_E < 0.d0) then
|
||||||
|
tmp = -tmp
|
||||||
|
endif
|
||||||
|
e_pert = 0.5d0 * ( tmp - delta_E)
|
||||||
|
pt2(istate) += e_pert
|
||||||
|
if(dabs(e_pert) > dabs(max_e_pert)) max_e_pert = e_pert
|
||||||
|
end do
|
||||||
|
|
||||||
|
if(dabs(max_e_pert) > buf%mini) then
|
||||||
|
call add_to_selection_buffer(buf, det, max_e_pert)
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine splash_p(mask, sp, det, phasemask, coefs, N_sel, bannedOrb, vect)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int,2,N_sel)
|
||||||
|
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2, N_sel)
|
||||||
|
double precision, intent(in) :: coefs(N_states, N_sel)
|
||||||
|
integer, intent(in) :: sp, N_sel
|
||||||
|
logical, intent(inout) :: bannedOrb(mo_tot_num)
|
||||||
|
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
||||||
|
|
||||||
|
integer :: i, j, h(0:2,2), p(0:3,2), nt
|
||||||
|
integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2)
|
||||||
|
|
||||||
|
do i=1,N_int
|
||||||
|
negMask(i,1) = not(mask(i,1))
|
||||||
|
negMask(i,2) = not(mask(i,2))
|
||||||
|
end do
|
||||||
|
|
||||||
|
do i=1, N_sel
|
||||||
|
nt = 0
|
||||||
|
do j=1,N_int
|
||||||
|
mobMask(j,1) = iand(negMask(j,1), det(j,1,i))
|
||||||
|
mobMask(j,2) = iand(negMask(j,2), det(j,2,i))
|
||||||
|
nt += popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
||||||
|
end do
|
||||||
|
|
||||||
|
if(nt > 3) cycle
|
||||||
|
|
||||||
|
do j=1,N_int
|
||||||
|
perMask(j,1) = iand(mask(j,1), not(det(j,1,i)))
|
||||||
|
perMask(j,2) = iand(mask(j,2), not(det(j,2,i)))
|
||||||
|
end do
|
||||||
|
|
||||||
|
call bitstring_to_list(perMask(1,1), h(1,1), h(0,1), N_int)
|
||||||
|
call bitstring_to_list(perMask(1,2), h(1,2), h(0,2), N_int)
|
||||||
|
|
||||||
|
call bitstring_to_list(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||||
|
call bitstring_to_list(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||||
|
|
||||||
|
if(nt == 3) then
|
||||||
|
call get_m2(det(1,1,i), phasemask(1,1,i), bannedOrb, vect, mask, h, p, sp, coefs(1, i))
|
||||||
|
else if(nt == 2) then
|
||||||
|
call get_m1(det(1,1,i), phasemask(1,1,i), bannedOrb, vect, mask, h, p, sp, coefs(1, i))
|
||||||
|
else
|
||||||
|
call get_m0(det(1,1,i), phasemask(1,1,i), bannedOrb, vect, mask, h, p, sp, coefs(1, i))
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
||||||
|
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
|
||||||
|
logical, intent(in) :: bannedOrb(mo_tot_num)
|
||||||
|
double precision, intent(in) :: coefs(N_states)
|
||||||
|
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
||||||
|
integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2)
|
||||||
|
integer :: i, j, h1, h2, p1, p2, sfix, hfix, pfix, hmob, pmob, puti
|
||||||
|
double precision :: hij
|
||||||
|
double precision, external :: get_phase_bi, integral8
|
||||||
|
|
||||||
|
integer, parameter :: turn3_2(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/))
|
||||||
|
integer, parameter :: turn2(2) = (/2,1/)
|
||||||
|
|
||||||
|
if(h(0,sp) == 2) then
|
||||||
|
h1 = h(1, sp)
|
||||||
|
h2 = h(2, sp)
|
||||||
|
do i=1,3
|
||||||
|
puti = p(i, sp)
|
||||||
|
if(bannedOrb(puti)) cycle
|
||||||
|
p1 = p(turn3_2(1,i), sp)
|
||||||
|
p2 = p(turn3_2(2,i), sp)
|
||||||
|
hij = integral8(p1, p2, h1, h2) - integral8(p2, p1, h1, h2)
|
||||||
|
hij *= get_phase_bi(phasemask, sp, sp, h1, p1, h2, p2)
|
||||||
|
vect(:, puti) += hij * coefs
|
||||||
|
end do
|
||||||
|
else if(h(0,sp) == 1) then
|
||||||
|
sfix = turn2(sp)
|
||||||
|
hfix = h(1,sfix)
|
||||||
|
pfix = p(1,sfix)
|
||||||
|
hmob = h(1,sp)
|
||||||
|
do j=1,2
|
||||||
|
puti = p(j, sp)
|
||||||
|
if(bannedOrb(puti)) cycle
|
||||||
|
pmob = p(turn2(j), sp)
|
||||||
|
hij = integral8(pfix, pmob, hfix, hmob)
|
||||||
|
hij *= get_phase_bi(phasemask, sp, sfix, hmob, pmob, hfix, pfix)
|
||||||
|
vect(:, puti) += hij * coefs
|
||||||
|
end do
|
||||||
|
else
|
||||||
|
puti = p(1,sp)
|
||||||
|
if(.not. bannedOrb(puti)) then
|
||||||
|
sfix = turn2(sp)
|
||||||
|
p1 = p(1,sfix)
|
||||||
|
p2 = p(2,sfix)
|
||||||
|
h1 = h(1,sfix)
|
||||||
|
h2 = h(2,sfix)
|
||||||
|
hij = (integral8(p1,p2,h1,h2) - integral8(p2,p1,h1,h2))
|
||||||
|
hij *= get_phase_bi(phasemask, sfix, sfix, h1, p1, h2, p2)
|
||||||
|
vect(:, puti) += hij * coefs
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
||||||
|
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
|
||||||
|
logical, intent(in) :: bannedOrb(mo_tot_num)
|
||||||
|
double precision, intent(in) :: coefs(N_states)
|
||||||
|
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
||||||
|
integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2)
|
||||||
|
integer :: i, hole, p1, p2, sh
|
||||||
|
logical :: ok, lbanned(mo_tot_num)
|
||||||
|
integer(bit_kind) :: det(N_int, 2)
|
||||||
|
double precision :: hij
|
||||||
|
double precision, external :: get_phase_bi, integral8
|
||||||
|
|
||||||
|
lbanned = bannedOrb
|
||||||
|
sh = 1
|
||||||
|
if(h(0,2) == 1) sh = 2
|
||||||
|
hole = h(1, sh)
|
||||||
|
lbanned(p(1,sp)) = .true.
|
||||||
|
if(p(0,sp) == 2) lbanned(p(2,sp)) = .true.
|
||||||
|
!print *, "SPm1", sp, sh
|
||||||
|
|
||||||
|
p1 = p(1, sp)
|
||||||
|
|
||||||
|
if(sp == sh) then
|
||||||
|
p2 = p(2, sp)
|
||||||
|
lbanned(p2) = .true.
|
||||||
|
|
||||||
|
do i=1,hole-1
|
||||||
|
if(lbanned(i)) cycle
|
||||||
|
hij = (integral8(p1, p2, i, hole) - integral8(p2, p1, i, hole))
|
||||||
|
hij *= get_phase_bi(phasemask, sp, sp, i, p1, hole, p2)
|
||||||
|
vect(:,i) += hij * coefs
|
||||||
|
end do
|
||||||
|
do i=hole+1,mo_tot_num
|
||||||
|
if(lbanned(i)) cycle
|
||||||
|
hij = (integral8(p1, p2, hole, i) - integral8(p2, p1, hole, i))
|
||||||
|
hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2)
|
||||||
|
vect(:,i) += hij * coefs
|
||||||
|
end do
|
||||||
|
|
||||||
|
call apply_particle(mask, sp, p2, det, ok, N_int)
|
||||||
|
call i_h_j(gen, det, N_int, hij)
|
||||||
|
vect(:, p2) += hij * coefs
|
||||||
|
else
|
||||||
|
p2 = p(1, sh)
|
||||||
|
do i=1,mo_tot_num
|
||||||
|
if(lbanned(i)) cycle
|
||||||
|
hij = integral8(p1, p2, i, hole)
|
||||||
|
hij *= get_phase_bi(phasemask, sp, sh, i, p1, hole, p2)
|
||||||
|
vect(:,i) += hij * coefs
|
||||||
|
end do
|
||||||
|
end if
|
||||||
|
|
||||||
|
call apply_particle(mask, sp, p1, det, ok, N_int)
|
||||||
|
call i_h_j(gen, det, N_int, hij)
|
||||||
|
vect(:, p1) += hij * coefs
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
||||||
|
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
|
||||||
|
logical, intent(in) :: bannedOrb(mo_tot_num)
|
||||||
|
double precision, intent(in) :: coefs(N_states)
|
||||||
|
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
||||||
|
integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2)
|
||||||
|
integer :: i
|
||||||
|
logical :: ok, lbanned(mo_tot_num)
|
||||||
|
integer(bit_kind) :: det(N_int, 2)
|
||||||
|
double precision :: hij
|
||||||
|
|
||||||
|
lbanned = bannedOrb
|
||||||
|
lbanned(p(1,sp)) = .true.
|
||||||
|
do i=1,mo_tot_num
|
||||||
|
if(lbanned(i)) cycle
|
||||||
|
call apply_particle(mask, sp, i, det, ok, N_int)
|
||||||
|
call i_h_j(gen, det, N_int, hij)
|
||||||
|
vect(:, i) += hij * coefs
|
||||||
|
end do
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine spot_hasBeen(mask, sp, det, i_gen, N, banned, fullMatch)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N)
|
||||||
|
integer, intent(in) :: i_gen, N, sp
|
||||||
|
logical, intent(inout) :: banned(mo_tot_num)
|
||||||
|
logical, intent(out) :: fullMatch
|
||||||
|
|
||||||
|
|
||||||
|
integer :: i, j, na, nb, list(3), nt
|
||||||
|
integer(bit_kind) :: myMask(N_int, 2), negMask(N_int, 2)
|
||||||
|
|
||||||
|
fullMatch = .false.
|
||||||
|
|
||||||
|
do i=1,N_int
|
||||||
|
negMask(i,1) = not(mask(i,1))
|
||||||
|
negMask(i,2) = not(mask(i,2))
|
||||||
|
end do
|
||||||
|
|
||||||
|
do i=1, N
|
||||||
|
nt = 0
|
||||||
|
|
||||||
|
do j=1, N_int
|
||||||
|
myMask(j, 1) = iand(det(j, 1, i), negMask(j, 1))
|
||||||
|
myMask(j, 2) = iand(det(j, 2, i), negMask(j, 2))
|
||||||
|
nt += popcnt(myMask(j, 1)) + popcnt(myMask(j, 2))
|
||||||
|
end do
|
||||||
|
|
||||||
|
if(nt > 3) cycle
|
||||||
|
|
||||||
|
if(nt <= 2 .and. i < i_gen) then
|
||||||
|
fullMatch = .true.
|
||||||
|
return
|
||||||
|
end if
|
||||||
|
|
||||||
|
call bitstring_to_list(myMask(1,sp), list(1), na, N_int)
|
||||||
|
|
||||||
|
if(nt == 3 .and. i < i_gen) then
|
||||||
|
do j=1,na
|
||||||
|
banned(list(j)) = .true.
|
||||||
|
end do
|
||||||
|
else if(nt == 1 .and. na == 1) then
|
||||||
|
banned(list(1)) = .true.
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Selection double
|
||||||
|
! ----------------
|
||||||
|
|
||||||
subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf)
|
subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
@ -20,11 +497,6 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
|||||||
integer,allocatable :: preinteresting(:), prefullinteresting(:), interesting(:), fullinteresting(:)
|
integer,allocatable :: preinteresting(:), prefullinteresting(:), interesting(:), fullinteresting(:)
|
||||||
integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :)
|
integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :)
|
||||||
|
|
||||||
logical :: monoAdo, monoBdo;
|
|
||||||
|
|
||||||
monoAdo = .true.
|
|
||||||
monoBdo = .true.
|
|
||||||
|
|
||||||
allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det))
|
allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det))
|
||||||
allocate(preinteresting(0:N_det_selectors), prefullinteresting(0:N_det), interesting(0:N_det_selectors), fullinteresting(0:N_det))
|
allocate(preinteresting(0:N_det_selectors), prefullinteresting(0:N_det), interesting(0:N_det_selectors), fullinteresting(0:N_det))
|
||||||
|
|
||||||
@ -54,8 +526,8 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
|||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
nt = 0
|
nt = 0
|
||||||
do j=1,N_int
|
do j=1,N_int
|
||||||
mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i))
|
mobMask(j,1) = iand(negMask(j,1), psi_selectors(j,1,i))
|
||||||
mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i))
|
mobMask(j,2) = iand(negMask(j,2), psi_selectors(j,2,i))
|
||||||
nt += popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
nt += popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
@ -88,19 +560,19 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
|||||||
i = preinteresting(ii)
|
i = preinteresting(ii)
|
||||||
nt = 0
|
nt = 0
|
||||||
do j=1,N_int
|
do j=1,N_int
|
||||||
mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i))
|
mobMask(j,1) = iand(negMask(j,1), psi_selectors(j,1,i))
|
||||||
mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i))
|
mobMask(j,2) = iand(negMask(j,2), psi_selectors(j,2,i))
|
||||||
nt += popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
nt += popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if(nt <= 4) then
|
if(nt <= 4) then
|
||||||
interesting(0) += 1
|
interesting(0) += 1
|
||||||
interesting(interesting(0)) = i
|
interesting(interesting(0)) = i
|
||||||
minilist(:,:,interesting(0)) = psi_det_sorted(:,:,i)
|
minilist(:,:,interesting(0)) = psi_selectors(:,:,i)
|
||||||
if(nt <= 2) then
|
if(nt <= 2) then
|
||||||
fullinteresting(0) += 1
|
fullinteresting(0) += 1
|
||||||
fullinteresting(fullinteresting(0)) = i
|
fullinteresting(fullinteresting(0)) = i
|
||||||
fullminilist(:,:,fullinteresting(0)) = psi_det_sorted(:,:,i)
|
fullminilist(:,:,fullinteresting(0)) = psi_selectors(:,:,i)
|
||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
@ -109,28 +581,24 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
|||||||
i = prefullinteresting(ii)
|
i = prefullinteresting(ii)
|
||||||
nt = 0
|
nt = 0
|
||||||
do j=1,N_int
|
do j=1,N_int
|
||||||
mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i))
|
mobMask(j,1) = iand(negMask(j,1), psi_selectors(j,1,i))
|
||||||
mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i))
|
mobMask(j,2) = iand(negMask(j,2), psi_selectors(j,2,i))
|
||||||
nt += popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
nt += popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if(nt <= 2) then
|
if(nt <= 2) then
|
||||||
fullinteresting(0) += 1
|
fullinteresting(0) += 1
|
||||||
fullinteresting(fullinteresting(0)) = i
|
fullinteresting(fullinteresting(0)) = i
|
||||||
fullminilist(:,:,fullinteresting(0)) = psi_det_sorted(:,:,i)
|
fullminilist(:,:,fullinteresting(0)) = psi_selectors(:,:,i)
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
do s2=s1,2
|
do s2=s1,2
|
||||||
sp = s1
|
sp = s1
|
||||||
|
|
||||||
if(s1 /= s2) sp = 3
|
if(s1 /= s2) sp = 3
|
||||||
|
|
||||||
ib = 1
|
ib = 1
|
||||||
if(s1 == s2) ib = i1+1
|
if(s1 == s2) ib = i1+1
|
||||||
monoAdo = .true.
|
|
||||||
do i2=N_holes(s2),ib,-1 ! Generate low excitations first
|
do i2=N_holes(s2),ib,-1 ! Generate low excitations first
|
||||||
|
|
||||||
h2 = hole_list(i2,s2)
|
h2 = hole_list(i2,s2)
|
||||||
@ -152,23 +620,10 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if(s1 /= s2) then
|
|
||||||
if(monoBdo) then
|
|
||||||
bannedOrb(h1,s1) = .false.
|
|
||||||
end if
|
|
||||||
if(monoAdo) then
|
|
||||||
bannedOrb(h2,s2) = .false.
|
|
||||||
monoAdo = .false.
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
|
|
||||||
|
|
||||||
mat = 0d0
|
mat = 0d0
|
||||||
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting)
|
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting)
|
||||||
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf)
|
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf)
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
if(s1 /= s2) monoBdo = .false.
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -190,7 +645,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
logical :: ok
|
logical :: ok
|
||||||
integer :: s1, s2, p1, p2, ib, j, istate
|
integer :: s1, s2, p1, p2, ib, j, istate
|
||||||
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
||||||
double precision :: e_pert, delta_E, val, Hii, max_e_pert
|
double precision :: e_pert, delta_E, val, Hii, max_e_pert,tmp
|
||||||
double precision, external :: diag_H_mat_elem_fock
|
double precision, external :: diag_H_mat_elem_fock
|
||||||
|
|
||||||
logical, external :: detEq
|
logical, external :: detEq
|
||||||
@ -215,6 +670,10 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
if(banned(p1,p2)) cycle
|
if(banned(p1,p2)) cycle
|
||||||
if(mat(1, p1, p2) == 0d0) cycle
|
if(mat(1, p1, p2) == 0d0) cycle
|
||||||
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
||||||
|
logical, external :: is_in_wavefunction
|
||||||
|
if (is_in_wavefunction(det,N_int)) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
||||||
@ -222,14 +681,14 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
|
|
||||||
do istate=1,N_states
|
do istate=1,N_states
|
||||||
delta_E = E0(istate) - Hii
|
delta_E = E0(istate) - Hii
|
||||||
val = mat(istate, p1, p2)
|
val = mat(istate, p1, p2) + mat(istate, p1, p2)
|
||||||
|
tmp = dsqrt(delta_E * delta_E + val * val)
|
||||||
if (delta_E < 0.d0) then
|
if (delta_E < 0.d0) then
|
||||||
e_pert = 0.5d0 * (-dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
tmp = -tmp
|
||||||
else
|
|
||||||
e_pert = 0.5d0 * ( dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
|
||||||
endif
|
endif
|
||||||
pt2(istate) += e_pert
|
e_pert = 0.5d0 * ( tmp - delta_E)
|
||||||
if(dabs(e_pert) > dabs(max_e_pert)) max_e_pert = e_pert
|
pt2(istate) = pt2(istate) + e_pert
|
||||||
|
max_e_pert = min(e_pert,max_e_pert)
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if(dabs(max_e_pert) > buf%mini) then
|
if(dabs(max_e_pert) > buf%mini) then
|
70
plugins/CAS_SD_ZMQ/selection_buffer.irp.f
Normal file
70
plugins/CAS_SD_ZMQ/selection_buffer.irp.f
Normal file
@ -0,0 +1,70 @@
|
|||||||
|
|
||||||
|
subroutine create_selection_buffer(N, siz, res)
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: N, siz
|
||||||
|
type(selection_buffer), intent(out) :: res
|
||||||
|
|
||||||
|
allocate(res%det(N_int, 2, siz), res%val(siz))
|
||||||
|
|
||||||
|
res%val = 0d0
|
||||||
|
res%det = 0_8
|
||||||
|
res%N = N
|
||||||
|
res%mini = 0d0
|
||||||
|
res%cur = 0
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine add_to_selection_buffer(b, det, val)
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
type(selection_buffer), intent(inout) :: b
|
||||||
|
integer(bit_kind), intent(in) :: det(N_int, 2)
|
||||||
|
double precision, intent(in) :: val
|
||||||
|
integer :: i
|
||||||
|
|
||||||
|
if(dabs(val) >= b%mini) then
|
||||||
|
b%cur += 1
|
||||||
|
b%det(:,:,b%cur) = det(:,:)
|
||||||
|
b%val(b%cur) = val
|
||||||
|
if(b%cur == size(b%val)) then
|
||||||
|
call sort_selection_buffer(b)
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine sort_selection_buffer(b)
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
type(selection_buffer), intent(inout) :: b
|
||||||
|
double precision, allocatable :: vals(:), absval(:)
|
||||||
|
integer, allocatable :: iorder(:)
|
||||||
|
integer(bit_kind), allocatable :: detmp(:,:,:)
|
||||||
|
integer :: i, nmwen
|
||||||
|
logical, external :: detEq
|
||||||
|
nmwen = min(b%N, b%cur)
|
||||||
|
|
||||||
|
|
||||||
|
allocate(iorder(b%cur), detmp(N_int, 2, nmwen), absval(b%cur), vals(nmwen))
|
||||||
|
absval = -dabs(b%val(:b%cur))
|
||||||
|
do i=1,b%cur
|
||||||
|
iorder(i) = i
|
||||||
|
end do
|
||||||
|
call dsort(absval, iorder, b%cur)
|
||||||
|
|
||||||
|
do i=1, nmwen
|
||||||
|
detmp(:,:,i) = b%det(:,:,iorder(i))
|
||||||
|
vals(i) = b%val(iorder(i))
|
||||||
|
end do
|
||||||
|
b%det(:,:,:nmwen) = detmp(:,:,:)
|
||||||
|
b%det(:,:,nmwen+1:) = 0_bit_kind
|
||||||
|
b%val(:nmwen) = vals(:)
|
||||||
|
b%val(nmwen+1:) = 0d0
|
||||||
|
b%mini = max(b%mini,dabs(b%val(b%N)))
|
||||||
|
b%cur = nmwen
|
||||||
|
end subroutine
|
||||||
|
|
93
plugins/CAS_SD_ZMQ/selection_cassd_slave.irp.f
Normal file
93
plugins/CAS_SD_ZMQ/selection_cassd_slave.irp.f
Normal file
@ -0,0 +1,93 @@
|
|||||||
|
program selection_slave
|
||||||
|
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
|
||||||
|
PROVIDE pt2_e0_denominator mo_tot_num N_int
|
||||||
|
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
|
||||||
|
double precision :: energy(N_states)
|
||||||
|
character*(64) :: states(1)
|
||||||
|
integer :: rc, i
|
||||||
|
|
||||||
|
call provide_everything
|
||||||
|
|
||||||
|
zmq_context = f77_zmq_ctx_new ()
|
||||||
|
states(1) = 'selection'
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
|
do
|
||||||
|
|
||||||
|
call wait_for_states(states,zmq_state,1)
|
||||||
|
|
||||||
|
if(trim(zmq_state) == 'Stopped') then
|
||||||
|
|
||||||
|
exit
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'selection') then
|
||||||
|
|
||||||
|
! Selection
|
||||||
|
! ---------
|
||||||
|
|
||||||
|
print *, 'Selection'
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
|
||||||
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call selection_slave_tcp(i, energy)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
print *, 'Selection done'
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
end do
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine update_energy(energy)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: energy(N_states)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Update energy when it is received from ZMQ
|
||||||
|
END_DOC
|
||||||
|
integer :: j,k
|
||||||
|
do j=1,N_states
|
||||||
|
do k=1,N_det
|
||||||
|
CI_eigenvectors(k,j) = psi_coef(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
|
||||||
|
if (.True.) then
|
||||||
|
do k=1,N_states
|
||||||
|
ci_electronic_energy(k) = energy(k)
|
||||||
|
enddo
|
||||||
|
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
|
||||||
|
endif
|
||||||
|
|
||||||
|
call write_double(6,ci_energy,'Energy')
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine selection_slave_tcp(i,energy)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: energy(N_states)
|
||||||
|
integer, intent(in) :: i
|
||||||
|
|
||||||
|
call run_selection_slave(0,i,energy)
|
||||||
|
end
|
||||||
|
|
9
plugins/CAS_SD_ZMQ/selection_types.f90
Normal file
9
plugins/CAS_SD_ZMQ/selection_types.f90
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
module selection_types
|
||||||
|
type selection_buffer
|
||||||
|
integer :: N, cur
|
||||||
|
integer(8), allocatable :: det(:,:,:)
|
||||||
|
double precision, allocatable :: val(:)
|
||||||
|
double precision :: mini
|
||||||
|
endtype
|
||||||
|
end module
|
||||||
|
|
4
plugins/DFT_Utils/EZFIO.cfg
Normal file
4
plugins/DFT_Utils/EZFIO.cfg
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
[energy]
|
||||||
|
type: double precision
|
||||||
|
doc: Calculated energy
|
||||||
|
interface: ezfio
|
1
plugins/DFT_Utils/NEEDED_CHILDREN_MODULES
Normal file
1
plugins/DFT_Utils/NEEDED_CHILDREN_MODULES
Normal file
@ -0,0 +1 @@
|
|||||||
|
Determinants
|
165
plugins/DFT_Utils/grid_density.irp.f
Normal file
165
plugins/DFT_Utils/grid_density.irp.f
Normal file
@ -0,0 +1,165 @@
|
|||||||
|
BEGIN_PROVIDER [integer, n_points_angular_grid]
|
||||||
|
implicit none
|
||||||
|
n_points_angular_grid = 50
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, n_points_radial_grid]
|
||||||
|
implicit none
|
||||||
|
n_points_radial_grid = 10000
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, angular_quadrature_points, (n_points_angular_grid,3) ]
|
||||||
|
&BEGIN_PROVIDER [double precision, weights_angular_points, (n_points_angular_grid)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! weights and grid points for the integration on the angular variables on
|
||||||
|
! the unit sphere centered on (0,0,0)
|
||||||
|
! According to the LEBEDEV scheme
|
||||||
|
END_DOC
|
||||||
|
call cal_quad(n_points_angular_grid, angular_quadrature_points,weights_angular_points)
|
||||||
|
include 'constants.include.F'
|
||||||
|
integer :: i
|
||||||
|
double precision :: accu
|
||||||
|
double precision :: degre_rad
|
||||||
|
!degre_rad = 180.d0/pi
|
||||||
|
!accu = 0.d0
|
||||||
|
!do i = 1, n_points_integration_angular_lebedev
|
||||||
|
! accu += weights_angular_integration_lebedev(i)
|
||||||
|
! weights_angular_points(i) = weights_angular_integration_lebedev(i) * 2.d0 * pi
|
||||||
|
! angular_quadrature_points(i,1) = dcos ( degre_rad * theta_angular_integration_lebedev(i)) &
|
||||||
|
! * dsin ( degre_rad * phi_angular_integration_lebedev(i))
|
||||||
|
! angular_quadrature_points(i,2) = dsin ( degre_rad * theta_angular_integration_lebedev(i)) &
|
||||||
|
! * dsin ( degre_rad * phi_angular_integration_lebedev(i))
|
||||||
|
! angular_quadrature_points(i,3) = dcos ( degre_rad * phi_angular_integration_lebedev(i))
|
||||||
|
!enddo
|
||||||
|
!print*,'ANGULAR'
|
||||||
|
!print*,''
|
||||||
|
!print*,'accu = ',accu
|
||||||
|
!ASSERT( dabs(accu - 1.D0) < 1.d-10)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer , m_knowles]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! value of the "m" parameter in the equation (7) of the paper of Knowles (JCP, 104, 1996)
|
||||||
|
END_DOC
|
||||||
|
m_knowles = 3
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, grid_points_radial, (n_points_radial_grid)]
|
||||||
|
&BEGIN_PROVIDER [double precision, dr_radial_integral]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! points in [0,1] to map the radial integral [0,\infty]
|
||||||
|
END_DOC
|
||||||
|
dr_radial_integral = 1.d0/dble(n_points_radial_grid-1)
|
||||||
|
integer :: i
|
||||||
|
do i = 1, n_points_radial_grid-1
|
||||||
|
grid_points_radial(i) = (i-1) * dr_radial_integral
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_angular_grid,n_points_radial_grid,nucl_num)]
|
||||||
|
BEGIN_DOC
|
||||||
|
! points for integration over space
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: dr,x_ref,y_ref,z_ref
|
||||||
|
double precision :: knowles_function
|
||||||
|
do i = 1, nucl_num
|
||||||
|
x_ref = nucl_coord(i,1)
|
||||||
|
y_ref = nucl_coord(i,2)
|
||||||
|
z_ref = nucl_coord(i,3)
|
||||||
|
do j = 1, n_points_radial_grid-1
|
||||||
|
double precision :: x,r
|
||||||
|
x = grid_points_radial(j) ! x value for the mapping of the [0, +\infty] to [0,1]
|
||||||
|
r = knowles_function(alpha_knowles(int(nucl_charge(i))),m_knowles,x) ! value of the radial coordinate for the integration
|
||||||
|
do k = 1, n_points_angular_grid ! explicit values of the grid points centered around each atom
|
||||||
|
grid_points_per_atom(1,k,j,i) = x_ref + angular_quadrature_points(k,1) * r
|
||||||
|
grid_points_per_atom(2,k,j,i) = y_ref + angular_quadrature_points(k,2) * r
|
||||||
|
grid_points_per_atom(3,k,j,i) = z_ref + angular_quadrature_points(k,3) * r
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, weight_functions_at_grid_points, (n_points_angular_grid,n_points_radial_grid,nucl_num) ]
|
||||||
|
BEGIN_DOC
|
||||||
|
! Weight function at grid points : w_n(r) according to the equation (22) of Becke original paper (JCP, 88, 1988)
|
||||||
|
! the "n" discrete variable represents the nucleis which in this array is represented by the last dimension
|
||||||
|
! and the points are labelled by the other dimensions
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k,l,m
|
||||||
|
double precision :: r(3)
|
||||||
|
double precision :: accu,cell_function_becke
|
||||||
|
double precision :: tmp_array(nucl_num)
|
||||||
|
! run over all points in space
|
||||||
|
do j = 1, nucl_num ! that are referred to each atom
|
||||||
|
do k = 1, n_points_radial_grid -1 !for each radial grid attached to the "jth" atom
|
||||||
|
do l = 1, n_points_angular_grid ! for each angular point attached to the "jth" atom
|
||||||
|
r(1) = grid_points_per_atom(1,l,k,j)
|
||||||
|
r(2) = grid_points_per_atom(2,l,k,j)
|
||||||
|
r(3) = grid_points_per_atom(3,l,k,j)
|
||||||
|
accu = 0.d0
|
||||||
|
do i = 1, nucl_num ! For each of these points in space, ou need to evaluate the P_n(r)
|
||||||
|
! function defined for each atom "i" by equation (13) and (21) with k == 3
|
||||||
|
tmp_array(i) = cell_function_becke(r,i) ! P_n(r)
|
||||||
|
! Then you compute the summ the P_n(r) function for each of the "r" points
|
||||||
|
accu += tmp_array(i)
|
||||||
|
enddo
|
||||||
|
accu = 1.d0/accu
|
||||||
|
weight_functions_at_grid_points(l,k,j) = tmp_array(j) * accu
|
||||||
|
! print*,weight_functions_at_grid_points(l,k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, one_body_dm_mo_alpha_at_grid_points, (n_points_angular_grid,n_points_radial_grid,nucl_num) ]
|
||||||
|
&BEGIN_PROVIDER [double precision, one_body_dm_mo_beta_at_grid_points, (n_points_angular_grid,n_points_radial_grid,nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k,l,m
|
||||||
|
double precision :: contrib
|
||||||
|
double precision :: r(3)
|
||||||
|
double precision :: aos_array(ao_num),mos_array(mo_tot_num)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
do k = 1, n_points_radial_grid -1
|
||||||
|
do l = 1, n_points_angular_grid
|
||||||
|
one_body_dm_mo_alpha_at_grid_points(l,k,j) = 0.d0
|
||||||
|
one_body_dm_mo_beta_at_grid_points(l,k,j) = 0.d0
|
||||||
|
r(1) = grid_points_per_atom(1,l,k,j)
|
||||||
|
r(2) = grid_points_per_atom(2,l,k,j)
|
||||||
|
r(3) = grid_points_per_atom(3,l,k,j)
|
||||||
|
|
||||||
|
! call give_all_aos_at_r(r,aos_array)
|
||||||
|
! do i = 1, ao_num
|
||||||
|
! do m = 1, ao_num
|
||||||
|
! contrib = aos_array(i) * aos_array(m)
|
||||||
|
! one_body_dm_mo_alpha_at_grid_points(l,k,j) += one_body_dm_ao_alpha(i,m) * contrib
|
||||||
|
! one_body_dm_mo_beta_at_grid_points(l,k,j) += one_body_dm_ao_beta(i,m) * contrib
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
call give_all_mos_at_r(r,mos_array)
|
||||||
|
do i = 1, mo_tot_num
|
||||||
|
do m = 1, mo_tot_num
|
||||||
|
contrib = mos_array(i) * mos_array(m)
|
||||||
|
one_body_dm_mo_alpha_at_grid_points(l,k,j) += one_body_dm_mo_alpha(i,m) * contrib
|
||||||
|
one_body_dm_mo_beta_at_grid_points(l,k,j) += one_body_dm_mo_beta(i,m) * contrib
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
54
plugins/DFT_Utils/integration_3d.irp.f
Normal file
54
plugins/DFT_Utils/integration_3d.irp.f
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
double precision function step_function_becke(x)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: x
|
||||||
|
double precision :: f_function_becke
|
||||||
|
integer :: i,n_max_becke
|
||||||
|
|
||||||
|
!if(x.lt.-1.d0)then
|
||||||
|
! step_function_becke = 0.d0
|
||||||
|
!else if (x .gt.1)then
|
||||||
|
! step_function_becke = 0.d0
|
||||||
|
!else
|
||||||
|
step_function_becke = f_function_becke(x)
|
||||||
|
!!n_max_becke = 1
|
||||||
|
do i = 1, 4
|
||||||
|
step_function_becke = f_function_becke(step_function_becke)
|
||||||
|
enddo
|
||||||
|
step_function_becke = 0.5d0*(1.d0 - step_function_becke)
|
||||||
|
!endif
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function f_function_becke(x)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: x
|
||||||
|
f_function_becke = 1.5d0 * x - 0.5d0 * x*x*x
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function cell_function_becke(r,atom_number)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: r(3)
|
||||||
|
integer, intent(in) :: atom_number
|
||||||
|
BEGIN_DOC
|
||||||
|
! atom_number :: atom on which the cell function of Becke (1988, JCP,88(4))
|
||||||
|
! r(1:3) :: x,y,z coordinantes of the current point
|
||||||
|
END_DOC
|
||||||
|
double precision :: mu_ij,nu_ij
|
||||||
|
double precision :: distance_i,distance_j,step_function_becke
|
||||||
|
integer :: j
|
||||||
|
distance_i = (r(1) - nucl_coord_transp(1,atom_number) ) * (r(1) - nucl_coord_transp(1,atom_number))
|
||||||
|
distance_i += (r(2) - nucl_coord_transp(2,atom_number) ) * (r(2) - nucl_coord_transp(2,atom_number))
|
||||||
|
distance_i += (r(3) - nucl_coord_transp(3,atom_number) ) * (r(3) - nucl_coord_transp(3,atom_number))
|
||||||
|
distance_i = dsqrt(distance_i)
|
||||||
|
cell_function_becke = 1.d0
|
||||||
|
do j = 1, nucl_num
|
||||||
|
if(j==atom_number)cycle
|
||||||
|
distance_j = (r(1) - nucl_coord_transp(1,j) ) * (r(1) - nucl_coord_transp(1,j))
|
||||||
|
distance_j+= (r(2) - nucl_coord_transp(2,j) ) * (r(2) - nucl_coord_transp(2,j))
|
||||||
|
distance_j+= (r(3) - nucl_coord_transp(3,j) ) * (r(3) - nucl_coord_transp(3,j))
|
||||||
|
distance_j = dsqrt(distance_j)
|
||||||
|
mu_ij = (distance_i - distance_j)/nucl_dist(atom_number,j)
|
||||||
|
nu_ij = mu_ij + slater_bragg_type_inter_distance_ua(atom_number,j) * (1.d0 - mu_ij*mu_ij)
|
||||||
|
cell_function_becke *= step_function_becke(nu_ij)
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
109
plugins/DFT_Utils/integration_radial.irp.f
Normal file
109
plugins/DFT_Utils/integration_radial.irp.f
Normal file
@ -0,0 +1,109 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, integral_density_alpha_knowles_becke_per_atom, (nucl_num)]
|
||||||
|
&BEGIN_PROVIDER [ double precision, integral_density_beta_knowles_becke_per_atom, (nucl_num)]
|
||||||
|
implicit none
|
||||||
|
double precision :: accu
|
||||||
|
integer :: i,j,k,l
|
||||||
|
double precision :: x
|
||||||
|
double precision :: integrand(n_points_angular_grid), weights(n_points_angular_grid)
|
||||||
|
double precision :: f_average_angular_alpha,f_average_angular_beta
|
||||||
|
double precision :: derivative_knowles_function,knowles_function
|
||||||
|
|
||||||
|
! Run over all nuclei in order to perform the Voronoi partition
|
||||||
|
! according ot equation (6) of the paper of Becke (JCP, (88), 1988)
|
||||||
|
! Here the m index is referred to the w_m(r) weight functions of equation (22)
|
||||||
|
! Run over all points of integrations : there are
|
||||||
|
! n_points_radial_grid (i) * n_points_angular_grid (k)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
integral_density_alpha_knowles_becke_per_atom(j) = 0.d0
|
||||||
|
integral_density_beta_knowles_becke_per_atom(j) = 0.d0
|
||||||
|
do i = 1, n_points_radial_grid-1
|
||||||
|
! Angular integration over the solid angle Omega for a FIXED angular coordinate "r"
|
||||||
|
f_average_angular_alpha = 0.d0
|
||||||
|
f_average_angular_beta = 0.d0
|
||||||
|
do k = 1, n_points_angular_grid
|
||||||
|
f_average_angular_alpha += weights_angular_points(k) * one_body_dm_mo_alpha_at_grid_points(k,i,j) * weight_functions_at_grid_points(k,i,j)
|
||||||
|
f_average_angular_beta += weights_angular_points(k) * one_body_dm_mo_beta_at_grid_points(k,i,j) * weight_functions_at_grid_points(k,i,j)
|
||||||
|
enddo
|
||||||
|
!
|
||||||
|
x = grid_points_radial(i) ! x value for the mapping of the [0, +\infty] to [0,1]
|
||||||
|
double precision :: contrib_integration
|
||||||
|
! print*,m_knowles
|
||||||
|
contrib_integration = derivative_knowles_function(alpha_knowles(int(nucl_charge(j))),m_knowles,x) &
|
||||||
|
*knowles_function(alpha_knowles(int(nucl_charge(j))),m_knowles,x)**2
|
||||||
|
integral_density_alpha_knowles_becke_per_atom(j) += contrib_integration *f_average_angular_alpha
|
||||||
|
integral_density_beta_knowles_becke_per_atom(j) += contrib_integration *f_average_angular_beta
|
||||||
|
enddo
|
||||||
|
integral_density_alpha_knowles_becke_per_atom(j) *= dr_radial_integral
|
||||||
|
integral_density_beta_knowles_becke_per_atom(j) *= dr_radial_integral
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
double precision function knowles_function(alpha,m,x)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! function proposed by Knowles (JCP, 104, 1996) for distributing the radial points :
|
||||||
|
! the Log "m" function ( equation (7) in the paper )
|
||||||
|
END_DOC
|
||||||
|
double precision, intent(in) :: alpha,x
|
||||||
|
integer, intent(in) :: m
|
||||||
|
knowles_function = -alpha * dlog(1.d0-x**m)
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function derivative_knowles_function(alpha,m,x)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! derivative of the function proposed by Knowles (JCP, 104, 1996) for distributing the radial points
|
||||||
|
END_DOC
|
||||||
|
double precision, intent(in) :: alpha,x
|
||||||
|
integer, intent(in) :: m
|
||||||
|
derivative_knowles_function = alpha * dble(m) * x**(m-1) / (1.d0 - x**m)
|
||||||
|
end
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, alpha_knowles, (100)]
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
BEGIN_DOC
|
||||||
|
! recommended values for the alpha parameters according to the paper of Knowles (JCP, 104, 1996)
|
||||||
|
! as a function of the nuclear charge
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
! H-He
|
||||||
|
alpha_knowles(1) = 5.d0
|
||||||
|
alpha_knowles(2) = 5.d0
|
||||||
|
|
||||||
|
! Li-Be
|
||||||
|
alpha_knowles(3) = 7.d0
|
||||||
|
alpha_knowles(4) = 7.d0
|
||||||
|
|
||||||
|
! B-Ne
|
||||||
|
do i = 5, 10
|
||||||
|
alpha_knowles(i) = 5.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Na-Mg
|
||||||
|
do i = 11, 12
|
||||||
|
alpha_knowles(i) = 7.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Al-Ar
|
||||||
|
do i = 13, 18
|
||||||
|
alpha_knowles(i) = 5.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! K-Ca
|
||||||
|
do i = 19, 20
|
||||||
|
alpha_knowles(i) = 7.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Sc-Zn
|
||||||
|
do i = 21, 30
|
||||||
|
alpha_knowles(i) = 5.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Ga-Kr
|
||||||
|
do i = 31, 36
|
||||||
|
alpha_knowles(i) = 7.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
219
plugins/DFT_Utils/routines_roland.irp.f
Normal file
219
plugins/DFT_Utils/routines_roland.irp.f
Normal file
@ -0,0 +1,219 @@
|
|||||||
|
|
||||||
|
subroutine cal_quad(n_quad, quad, weight)
|
||||||
|
! --------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! Arguments : subroutine cal_quad
|
||||||
|
! Description: evaluates quadrature points an weights
|
||||||
|
!
|
||||||
|
! Authors : B. Lévy, P. Pernot
|
||||||
|
! Date : 15 Nov 2000
|
||||||
|
! --------------------------------------------------------------------------------
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: n_quad
|
||||||
|
double precision, intent(out) :: weight(n_quad)
|
||||||
|
double precision, intent(out) :: quad(n_quad,3)
|
||||||
|
|
||||||
|
! local:
|
||||||
|
double precision, parameter :: zero=0.d0, one= 1.d0
|
||||||
|
|
||||||
|
double precision, parameter :: p=0.707106781186547462d0
|
||||||
|
double precision, parameter :: q=0.577350269189625842d0
|
||||||
|
double precision, parameter :: r=0.301511344577763629d0
|
||||||
|
double precision, parameter :: s=0.904534033733290888d0
|
||||||
|
|
||||||
|
double precision, parameter :: fourpi= 12.5663706143591725d0
|
||||||
|
|
||||||
|
double precision, parameter :: a6=0.166666666666666657d0
|
||||||
|
double precision, parameter :: a18=0.333333333333333329d-01
|
||||||
|
double precision, parameter :: b18=0.666666666666666657d-01
|
||||||
|
double precision, parameter :: a26=0.476190476190476164d-01
|
||||||
|
double precision, parameter :: b26=0.380952380952380987d-01
|
||||||
|
double precision, parameter :: c26=0.321428571428571397d-01
|
||||||
|
double precision, parameter :: a50=0.126984126984126984d-01
|
||||||
|
double precision, parameter :: b50=0.225749559082892431d-01
|
||||||
|
double precision, parameter :: c50=0.210937500000000014d-01
|
||||||
|
double precision, parameter :: d50=0.201733355379188697d-01
|
||||||
|
|
||||||
|
double precision :: apt(3,6),bpt(3,12),cpt(3,8),dpt(3,24)
|
||||||
|
double precision :: awght,bwght,cwght,dwght
|
||||||
|
double precision :: s1, s2, s3
|
||||||
|
integer :: idim, ipt, i1, i2, i3, is1, is2, is3
|
||||||
|
integer :: iquad
|
||||||
|
|
||||||
|
! begin:
|
||||||
|
! l_here ='cal_quad'
|
||||||
|
! call enter (l_here,3)
|
||||||
|
|
||||||
|
! verifications:
|
||||||
|
! message = 'in '//trim(l_here)//', number of dimensions='//&
|
||||||
|
! trim(encode(dimensions_nb))//', must be 3'
|
||||||
|
! call ensure(message, dimensions_nb .eq. 3 )
|
||||||
|
|
||||||
|
! message = 'in '//trim(l_here)//', invalid number of quadrature points ='&
|
||||||
|
! //trim(encode(n_quad))
|
||||||
|
! call ensure(message,(n_quad-2)*(n_quad-6)*(n_quad-18)*(n_quad-26)*(n_quad-50) .eq. 0)
|
||||||
|
|
||||||
|
! initialize weights
|
||||||
|
awght = zero
|
||||||
|
bwght = zero
|
||||||
|
cwght = zero
|
||||||
|
dwght = zero
|
||||||
|
|
||||||
|
! type A points : (+/-1,0,0)
|
||||||
|
awght=a6*fourpi
|
||||||
|
ipt= 1
|
||||||
|
apt=0.
|
||||||
|
do idim = 1, 3
|
||||||
|
apt(idim,ipt)=one
|
||||||
|
ipt=ipt+1
|
||||||
|
apt(idim,ipt)=-one
|
||||||
|
ipt=ipt+1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! type B points : (+/-p,+/-p,0) with p= 1/sqrt(2)
|
||||||
|
if(n_quad.gt.6) then
|
||||||
|
|
||||||
|
awght=a18*fourpi
|
||||||
|
bwght=b18*fourpi
|
||||||
|
|
||||||
|
s1=p
|
||||||
|
s2=p
|
||||||
|
ipt= 1
|
||||||
|
bpt=0.
|
||||||
|
do idim = 1, 3
|
||||||
|
i1=idim+1
|
||||||
|
if(i1.gt.3) i1=i1-3
|
||||||
|
i2=idim+2
|
||||||
|
if(i2.gt.3) i2=i2-3
|
||||||
|
do is1= 1,2
|
||||||
|
do is2= 1,2
|
||||||
|
bpt(i1,ipt)=s1
|
||||||
|
bpt(i2,ipt)=s2
|
||||||
|
s2=-s2
|
||||||
|
ipt=ipt+1
|
||||||
|
enddo
|
||||||
|
s1=-s1
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
! type C points : (+/-q,+/-q,+/-q) with q= 1/sqrt(3)
|
||||||
|
if(n_quad.gt.18) then
|
||||||
|
|
||||||
|
awght=a26*fourpi
|
||||||
|
bwght=b26*fourpi
|
||||||
|
cwght=c26*fourpi
|
||||||
|
|
||||||
|
s1=q
|
||||||
|
s2=q
|
||||||
|
s3=q
|
||||||
|
ipt= 1
|
||||||
|
cpt=0.
|
||||||
|
do is1= 1,2
|
||||||
|
do is2= 1,2
|
||||||
|
do is3= 1,2
|
||||||
|
cpt(1,ipt)=s1
|
||||||
|
cpt(2,ipt)=s2
|
||||||
|
cpt(3,ipt)=s3
|
||||||
|
s3=-s3
|
||||||
|
ipt=ipt+1
|
||||||
|
enddo
|
||||||
|
s2=-s2
|
||||||
|
enddo
|
||||||
|
s1=-s1
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
! type D points : (+/-r,+/-r,+/-s)
|
||||||
|
if(n_quad.gt.26) then
|
||||||
|
|
||||||
|
awght=a50*fourpi
|
||||||
|
bwght=b50*fourpi
|
||||||
|
cwght=c50*fourpi
|
||||||
|
dwght=d50*fourpi
|
||||||
|
|
||||||
|
ipt= 1
|
||||||
|
dpt=0.
|
||||||
|
do i1= 1, 3
|
||||||
|
s1=s
|
||||||
|
s2=r
|
||||||
|
s3=r
|
||||||
|
i2=i1+1
|
||||||
|
if(i2.gt.3) i2=i2-3
|
||||||
|
i3=i1+2
|
||||||
|
if(i3.gt.3) i3=i3-3
|
||||||
|
do is1= 1,2
|
||||||
|
do is2= 1,2
|
||||||
|
do is3= 1,2
|
||||||
|
dpt(i1,ipt)=s1
|
||||||
|
dpt(i2,ipt)=s2
|
||||||
|
dpt(i3,ipt)=s3
|
||||||
|
s3=-s3
|
||||||
|
ipt=ipt+1
|
||||||
|
enddo
|
||||||
|
s2=-s2
|
||||||
|
enddo
|
||||||
|
s1=-s1
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
! fill the points and weights tables
|
||||||
|
iquad= 1
|
||||||
|
do ipt= 1, 6
|
||||||
|
do idim = 1, 3
|
||||||
|
quad(iquad,idim)=apt(idim,ipt)
|
||||||
|
enddo
|
||||||
|
weight(iquad)=awght
|
||||||
|
iquad=iquad+1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if(n_quad.gt.6) then
|
||||||
|
do ipt= 1,12
|
||||||
|
do idim = 1, 3
|
||||||
|
quad(iquad,idim)=bpt(idim,ipt)
|
||||||
|
enddo
|
||||||
|
weight(iquad)=bwght
|
||||||
|
iquad=iquad+1
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(n_quad.gt.18) then
|
||||||
|
do ipt= 1,8
|
||||||
|
do idim = 1, 3
|
||||||
|
quad(iquad,idim)=cpt(idim,ipt)
|
||||||
|
enddo
|
||||||
|
weight(iquad)=cwght
|
||||||
|
iquad=iquad+1
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(n_quad.gt.26) then
|
||||||
|
do ipt= 1,24
|
||||||
|
do idim = 1, 3
|
||||||
|
quad(iquad,idim)=dpt(idim,ipt)
|
||||||
|
enddo
|
||||||
|
weight(iquad)=dwght
|
||||||
|
iquad=iquad+1
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
! if (debug) then
|
||||||
|
! write(6,*)
|
||||||
|
! write(6,'(1X,a)') trim(l_here)//'-d : '//&
|
||||||
|
! '------------------------------------------------------'
|
||||||
|
! write(6,'(1X,a)') trim(l_here)//'-d : '//' I Weight Quad_points'
|
||||||
|
! write(6,'(1X,a)') trim(l_here)//'-d : '//&
|
||||||
|
! '----- ---------- -----------------------------------'
|
||||||
|
! do iquad= 1, n_quad
|
||||||
|
! write(6,'(1X,A,i5,4e12.3)') trim(l_here)//'-d : ',&
|
||||||
|
! iquad,weight(iquad),quad(iquad,1:3)
|
||||||
|
! enddo
|
||||||
|
! write(6,'(1X,a)') trim(l_here)//'-d : '//&
|
||||||
|
! '------------------------------------------------------'
|
||||||
|
! write(6,*)
|
||||||
|
! endif
|
||||||
|
|
||||||
|
! call exit (l_here,3)
|
||||||
|
|
||||||
|
end subroutine cal_quad
|
24
plugins/DFT_Utils/test_integration_3d_density.irp.f
Normal file
24
plugins/DFT_Utils/test_integration_3d_density.irp.f
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
program pouet
|
||||||
|
print*,'coucou'
|
||||||
|
read_wf = .True.
|
||||||
|
touch read_wf
|
||||||
|
print*,'m_knowles = ',m_knowles
|
||||||
|
call routine
|
||||||
|
|
||||||
|
end
|
||||||
|
subroutine routine
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
double precision :: accu(2)
|
||||||
|
accu = 0.d0
|
||||||
|
do i = 1, nucl_num
|
||||||
|
accu(1) += integral_density_alpha_knowles_becke_per_atom(i)
|
||||||
|
accu(2) += integral_density_beta_knowles_becke_per_atom(i)
|
||||||
|
enddo
|
||||||
|
print*,'accu(1) = ',accu(1)
|
||||||
|
print*,'Nalpha = ',elec_alpha_num
|
||||||
|
print*,'accu(2) = ',accu(2)
|
||||||
|
print*,'Nalpha = ',elec_beta_num
|
||||||
|
|
||||||
|
|
||||||
|
end
|
@ -19,10 +19,15 @@ default: 0.00001
|
|||||||
|
|
||||||
[do_it_perturbative]
|
[do_it_perturbative]
|
||||||
type: logical
|
type: logical
|
||||||
doc: if true, you do the FOBOCI calculation perturbatively
|
doc: if true, when a given 1h or 1p determinant is not selected because of its perturbation estimate, then if its coefficient is lower than threshold_perturbative, it is acounted in the FOBOCI differential density matrices
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: .False.
|
default: .False.
|
||||||
|
|
||||||
|
[threshold_perturbative]
|
||||||
|
type: double precision
|
||||||
|
doc: when do_it_perturbative is True, threshold_perturbative select if a given determinant ia selected or not for beign taken into account in the FOBO-SCF treatment. In practive, if the coefficient is larger then threshold_perturbative it means that it not selected as the perturbation should not be too importan. A value of 0.01 is in general OK.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.001
|
||||||
|
|
||||||
[speed_up_convergence_foboscf]
|
[speed_up_convergence_foboscf]
|
||||||
type: logical
|
type: logical
|
||||||
@ -49,3 +54,9 @@ doc: if true, you do all 2p type excitation on the LMCT
|
|||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: .True.
|
default: .True.
|
||||||
|
|
||||||
|
[selected_fobo_ci]
|
||||||
|
type: logical
|
||||||
|
doc: if true, for each CI step you will run a CIPSI calculation that stops at pt2_max
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: .False.
|
||||||
|
|
||||||
|
889
plugins/FOBOCI/SC2_1h1p.irp.f
Normal file
889
plugins/FOBOCI/SC2_1h1p.irp.f
Normal file
@ -0,0 +1,889 @@
|
|||||||
|
subroutine dressing_1h1p(dets_in,u_in,diag_H_elements,dim_in,sze,N_st,Nint,convergence)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! CISD+SC2 method :: take off all the disconnected terms of a ROHF+1h1p (selected or not)
|
||||||
|
!
|
||||||
|
! dets_in : bitmasks corresponding to determinants
|
||||||
|
!
|
||||||
|
! u_in : guess coefficients on the various states. Overwritten
|
||||||
|
! on exit
|
||||||
|
!
|
||||||
|
! dim_in : leftmost dimension of u_in
|
||||||
|
!
|
||||||
|
! sze : Number of determinants
|
||||||
|
!
|
||||||
|
! N_st : Number of eigenstates
|
||||||
|
!
|
||||||
|
! Initial guess vectors are not necessarily orthonormal
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: dim_in, sze, N_st, Nint
|
||||||
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
|
double precision, intent(inout) :: u_in(dim_in,N_st)
|
||||||
|
double precision, intent(out) :: diag_H_elements(dim_in)
|
||||||
|
double precision, intent(in) :: convergence
|
||||||
|
|
||||||
|
integer :: i,j,k,l
|
||||||
|
integer :: n_singles
|
||||||
|
integer :: index_singles(sze),hole_particles_singles(sze,3)
|
||||||
|
integer :: n_doubles
|
||||||
|
integer :: index_doubles(sze),hole_particles_doubles(sze,2)
|
||||||
|
integer :: index_hf
|
||||||
|
double precision :: e_corr_singles(mo_tot_num,2)
|
||||||
|
double precision :: e_corr_doubles(mo_tot_num)
|
||||||
|
double precision :: e_corr_singles_total(2)
|
||||||
|
double precision :: e_corr_doubles_1h1p
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2),degree
|
||||||
|
integer :: h1,h2,p1,p2,s1,s2
|
||||||
|
integer :: other_spin(2)
|
||||||
|
double precision :: phase
|
||||||
|
integer(bit_kind) :: key_tmp(N_int,2)
|
||||||
|
integer :: i_ok
|
||||||
|
double precision :: phase_single_double,phase_double_hf,get_mo_bielec_integral
|
||||||
|
double precision :: hij,c_ref,contrib
|
||||||
|
integer :: iorb
|
||||||
|
|
||||||
|
other_spin(1) = 2
|
||||||
|
other_spin(2) = 1
|
||||||
|
|
||||||
|
n_singles = 0
|
||||||
|
n_doubles = 0
|
||||||
|
do i = 1,sze
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,i),exc,degree,phase,N_int)
|
||||||
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
|
call i_H_j(dets_in(1,1,i),dets_in(1,1,i),N_int,hij)
|
||||||
|
diag_H_elements(i) = hij
|
||||||
|
if(degree == 0)then
|
||||||
|
index_hf = i
|
||||||
|
else if (degree == 1)then
|
||||||
|
n_singles +=1
|
||||||
|
index_singles(n_singles) = i
|
||||||
|
! h1 = inactive orbital of the hole
|
||||||
|
hole_particles_singles(n_singles,1) = h1
|
||||||
|
! p1 = virtual orbital of the particle
|
||||||
|
hole_particles_singles(n_singles,2) = p1
|
||||||
|
! s1 = spin of the electron excited
|
||||||
|
hole_particles_singles(n_singles,3) = s1
|
||||||
|
else if (degree == 2)then
|
||||||
|
n_doubles +=1
|
||||||
|
index_doubles(n_doubles) = i
|
||||||
|
! h1 = inactive orbital of the hole (beta of course)
|
||||||
|
hole_particles_doubles(n_doubles,1) = h1
|
||||||
|
! p1 = virtual orbital of the particle (alpha of course)
|
||||||
|
hole_particles_doubles(n_doubles,2) = p2
|
||||||
|
else
|
||||||
|
print*,'PB !! found out other thing than a single or double'
|
||||||
|
print*,'stopping ..'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
e_corr_singles = 0.d0
|
||||||
|
e_corr_doubles = 0.d0
|
||||||
|
e_corr_singles_total = 0.d0
|
||||||
|
e_corr_doubles_1h1p = 0.d0
|
||||||
|
c_ref = 1.d0/u_in(index_hf,1)
|
||||||
|
print*,'c_ref = ',c_ref
|
||||||
|
do i = 1,sze
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,i),exc,degree,phase,N_int)
|
||||||
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
|
call i_H_j(ref_bitmask,dets_in(1,1,i),N_int,hij)
|
||||||
|
contrib = hij * u_in(i,1) * c_ref
|
||||||
|
if (degree == 1)then
|
||||||
|
e_corr_singles(h1,s1) += contrib
|
||||||
|
e_corr_singles(p1,s1) += contrib
|
||||||
|
e_corr_singles_total(s1)+= contrib
|
||||||
|
else if (degree == 2)then
|
||||||
|
e_corr_doubles_1h1p += contrib
|
||||||
|
e_corr_doubles(h1) += contrib
|
||||||
|
e_corr_doubles(p2) += contrib
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,'e_corr_singles alpha = ',e_corr_singles_total(1)
|
||||||
|
print*,'e_corr_singles beta = ',e_corr_singles_total(2)
|
||||||
|
print*,'e_corr_doubles_1h1p = ',e_corr_doubles_1h1p
|
||||||
|
|
||||||
|
! repeat all the correlation energy on the singles
|
||||||
|
do i = 1,n_singles
|
||||||
|
! you can repeat all the correlation energy of the single excitation of the other spin
|
||||||
|
diag_H_elements(index_singles(i)) += e_corr_singles_total(other_spin(hole_particles_singles(i,3)))
|
||||||
|
|
||||||
|
! you can repeat all the correlation energy of the single excitation of the same spin
|
||||||
|
do j = 1, n_inact_orb
|
||||||
|
iorb = list_inact(j)
|
||||||
|
! except the one of the hole
|
||||||
|
if(iorb == hole_particles_singles(i,1))cycle
|
||||||
|
! ispin = hole_particles_singles(i,3)
|
||||||
|
diag_H_elements(index_singles(i)) += e_corr_singles(iorb,hole_particles_singles(i,3))
|
||||||
|
enddo
|
||||||
|
! also exclude all the energy coming from the virtual orbital
|
||||||
|
diag_H_elements(index_singles(i)) -= e_corr_singles(hole_particles_singles(i,2),hole_particles_singles(i,3))
|
||||||
|
|
||||||
|
! If it is a single excitation alpha, you can repeat :
|
||||||
|
! +) all the double excitation 1h1p, appart the part involving the virtual orbital "r"
|
||||||
|
! If it is a single excitation alpha, you can repeat :
|
||||||
|
! +) all the double excitation 1h1p, appart the part involving the inactive orbital "i"
|
||||||
|
diag_H_elements(index_singles(i)) += e_corr_doubles_1h1p
|
||||||
|
if(hole_particles_singles(i,3) == 1)then ! alpha single excitation
|
||||||
|
diag_H_elements(index_singles(i)) -= e_corr_doubles(hole_particles_singles(i,2))
|
||||||
|
else ! beta single exctitation
|
||||||
|
diag_H_elements(index_singles(i)) -= e_corr_doubles(hole_particles_singles(i,1))
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! repeat all the correlation energy on the doubles
|
||||||
|
! as all the doubles involve the active space, you cannot repeat any of them one on another
|
||||||
|
do i = 1, n_doubles
|
||||||
|
! on a given double, you can repeat all the correlation energy of the singles alpha
|
||||||
|
do j = 1, n_inact_orb
|
||||||
|
iorb = list_inact(j)
|
||||||
|
! ispin = hole_particles_singles(i,3)
|
||||||
|
diag_H_elements(index_doubles(i)) += e_corr_singles(iorb,1)
|
||||||
|
enddo
|
||||||
|
! except the part involving the virtual orbital "hole_particles_doubles(i,2)"
|
||||||
|
diag_H_elements(index_doubles(i)) -= e_corr_singles(hole_particles_doubles(i,2),1)
|
||||||
|
! on a given double, you can repeat all the correlation energy of the singles beta
|
||||||
|
do j = 1, n_inact_orb
|
||||||
|
iorb = list_inact(j)
|
||||||
|
! except the one of the hole
|
||||||
|
if(iorb == hole_particles_doubles(i,1))cycle
|
||||||
|
! ispin = hole_particles_singles(i,3)
|
||||||
|
diag_H_elements(index_doubles(i)) += e_corr_singles(iorb,2)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
! Taking into account the connected part of the 2h2p on the HF determinant
|
||||||
|
! 1/2 \sum_{ir,js} c_{ir}^{sigma} c_{js}^{sigma}
|
||||||
|
|
||||||
|
! diag_H_elements(index_hf) += total_corr_e_2h2p
|
||||||
|
return
|
||||||
|
c_ref = c_ref * c_ref
|
||||||
|
print*,'diag_H_elements(index_hf) = ',diag_H_elements(index_hf)
|
||||||
|
do i = 1, n_singles
|
||||||
|
! start on the single excitation "|i>"
|
||||||
|
h1 = hole_particles_singles(i,1)
|
||||||
|
p1 = hole_particles_singles(i,2)
|
||||||
|
do j = 1, n_singles
|
||||||
|
do k = 1, N_int
|
||||||
|
key_tmp(k,1) = dets_in(k,1,index_singles(i))
|
||||||
|
key_tmp(k,2) = dets_in(k,2,index_singles(i))
|
||||||
|
enddo
|
||||||
|
h2 = hole_particles_singles(j,1)
|
||||||
|
p2 = hole_particles_singles(j,2)
|
||||||
|
call do_mono_excitation(key_tmp,h2,p2,hole_particles_singles(j,3),i_ok)
|
||||||
|
! apply the excitation operator from the single excitation "|j>"
|
||||||
|
if(i_ok .ne. 1)cycle
|
||||||
|
double precision :: phase_ref_other_single,diag_H_mat_elem,hijj,contrib_e2,coef_1
|
||||||
|
call get_excitation(key_tmp,dets_in(1,1,index_singles(i)),exc,degree,phase_single_double,N_int)
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,index_singles(j)),exc,degree,phase_ref_other_single,N_int)
|
||||||
|
call i_H_j(ref_bitmask,key_tmp,N_int,hij)
|
||||||
|
diag_H_elements(index_hf) += u_in(index_singles(i),1) * u_in(index_singles(j),1) * c_ref * hij &
|
||||||
|
* phase_single_double * phase_ref_other_single
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'diag_H_elements(index_hf) = ',diag_H_elements(index_hf)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine dressing_1h1p_by_2h2p(dets_in,u_in,diag_H_elements,dim_in,sze,N_st,Nint,convergence)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! CISD+SC2 method :: take off all the disconnected terms of a ROHF+1h1p (selected or not)
|
||||||
|
!
|
||||||
|
! dets_in : bitmasks corresponding to determinants
|
||||||
|
!
|
||||||
|
! u_in : guess coefficients on the various states. Overwritten
|
||||||
|
! on exit
|
||||||
|
!
|
||||||
|
! dim_in : leftmost dimension of u_in
|
||||||
|
!
|
||||||
|
! sze : Number of determinants
|
||||||
|
!
|
||||||
|
! N_st : Number of eigenstates
|
||||||
|
!
|
||||||
|
! Initial guess vectors are not necessarily orthonormal
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: dim_in, sze, N_st, Nint
|
||||||
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
|
double precision, intent(inout) :: u_in(dim_in,N_st)
|
||||||
|
double precision, intent(out) :: diag_H_elements(0:dim_in)
|
||||||
|
double precision, intent(in) :: convergence
|
||||||
|
|
||||||
|
integer :: i,j,k,l
|
||||||
|
integer :: r,s,i0,j0,r0,s0
|
||||||
|
integer :: n_singles
|
||||||
|
integer :: index_singles(sze),hole_particles_singles(sze,3)
|
||||||
|
integer :: n_doubles
|
||||||
|
integer :: index_doubles(sze),hole_particles_doubles(sze,2)
|
||||||
|
integer :: index_hf
|
||||||
|
double precision :: e_corr_singles(mo_tot_num,2)
|
||||||
|
double precision :: e_corr_doubles(mo_tot_num)
|
||||||
|
double precision :: e_corr_singles_total(2)
|
||||||
|
double precision :: e_corr_doubles_1h1p
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2),degree
|
||||||
|
integer :: h1,h2,p1,p2,s1,s2
|
||||||
|
integer :: other_spin(2)
|
||||||
|
double precision :: phase
|
||||||
|
integer(bit_kind) :: key_tmp(N_int,2)
|
||||||
|
integer :: i_ok
|
||||||
|
double precision :: phase_single_double,phase_double_hf,get_mo_bielec_integral
|
||||||
|
double precision :: hij,c_ref,contrib
|
||||||
|
integer :: iorb
|
||||||
|
|
||||||
|
other_spin(1) = 2
|
||||||
|
other_spin(2) = 1
|
||||||
|
|
||||||
|
n_singles = 0
|
||||||
|
n_doubles = 0
|
||||||
|
do i = 1,sze
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,i),exc,degree,phase,N_int)
|
||||||
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
|
call i_H_j(dets_in(1,1,i),dets_in(1,1,i),N_int,hij)
|
||||||
|
diag_H_elements(i) = hij
|
||||||
|
if(degree == 0)then
|
||||||
|
index_hf = i
|
||||||
|
else if (degree == 1)then
|
||||||
|
n_singles +=1
|
||||||
|
index_singles(n_singles) = i
|
||||||
|
! h1 = inactive orbital of the hole
|
||||||
|
hole_particles_singles(n_singles,1) = h1
|
||||||
|
! p1 = virtual orbital of the particle
|
||||||
|
hole_particles_singles(n_singles,2) = p1
|
||||||
|
! s1 = spin of the electron excited
|
||||||
|
hole_particles_singles(n_singles,3) = s1
|
||||||
|
else if (degree == 2)then
|
||||||
|
n_doubles +=1
|
||||||
|
index_doubles(n_doubles) = i
|
||||||
|
! h1 = inactive orbital of the hole (beta of course)
|
||||||
|
hole_particles_doubles(n_doubles,1) = h1
|
||||||
|
! p1 = virtual orbital of the particle (alpha of course)
|
||||||
|
hole_particles_doubles(n_doubles,2) = p2
|
||||||
|
else
|
||||||
|
print*,'PB !! found out other thing than a single or double'
|
||||||
|
print*,'stopping ..'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
double precision :: delta_e
|
||||||
|
double precision :: coef_ijrs
|
||||||
|
diag_H_elements = 0.d0
|
||||||
|
do i0 = 1, n_core_inact_orb
|
||||||
|
i= list_core_inact(i0)
|
||||||
|
do j0 = i0+1, n_core_inact_orb
|
||||||
|
j = list_core_inact(j0)
|
||||||
|
print*, i,j
|
||||||
|
do r0 = 1, n_virt_orb
|
||||||
|
r = list_virt(r0)
|
||||||
|
do s0 = r0+1, n_virt_orb
|
||||||
|
s = list_virt(s0)
|
||||||
|
!!! alpha (i-->r) / beta (j-->s)
|
||||||
|
s1 = 1
|
||||||
|
s2 = 2
|
||||||
|
key_tmp = ref_bitmask
|
||||||
|
call do_mono_excitation(key_tmp,i,r,s1,i_ok)
|
||||||
|
if(i_ok .ne.1)then
|
||||||
|
print*, 'pb !!'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
call do_mono_excitation(key_tmp,j,s,s2,i_ok)
|
||||||
|
if(i_ok .ne.1)then
|
||||||
|
print*, 'pb !!'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
call i_H_j(ref_bitmask, key_tmp, N_int,hij)
|
||||||
|
delta_e = Fock_matrix_diag_mo(i) + Fock_matrix_diag_mo(j) - Fock_matrix_diag_mo(r) - Fock_matrix_diag_mo(s)
|
||||||
|
coef_ijrs = hij/delta_e
|
||||||
|
do k = 1, n_singles
|
||||||
|
l = index_singles(k)
|
||||||
|
call i_H_j(dets_in(1,1,l), key_tmp, N_int,hij)
|
||||||
|
diag_H_elements(l) += coef_ijrs * hij
|
||||||
|
enddo
|
||||||
|
!if(i>j.and.r>s)then
|
||||||
|
!! alpha (i-->r) / alpha (j-->s)
|
||||||
|
s1 = 1
|
||||||
|
s2 = 1
|
||||||
|
key_tmp = ref_bitmask
|
||||||
|
call do_mono_excitation(key_tmp,i,r,s1,i_ok)
|
||||||
|
if(i_ok .ne.1)then
|
||||||
|
print*, 'pb !!'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
call do_mono_excitation(key_tmp,j,s,s2,i_ok)
|
||||||
|
if(i_ok .ne.1)then
|
||||||
|
print*, 'pb !!'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
call i_H_j(ref_bitmask, key_tmp, N_int,hij)
|
||||||
|
delta_e = Fock_matrix_diag_mo(i) + Fock_matrix_diag_mo(j) - Fock_matrix_diag_mo(r) - Fock_matrix_diag_mo(s)
|
||||||
|
coef_ijrs = hij/delta_e
|
||||||
|
do k = 1, n_singles
|
||||||
|
l = index_singles(k)
|
||||||
|
call i_H_j(dets_in(1,1,l), key_tmp, N_int,hij)
|
||||||
|
diag_H_elements(l) += coef_ijrs * hij
|
||||||
|
enddo
|
||||||
|
!! beta (i-->r) / beta (j-->s)
|
||||||
|
s1 = 2
|
||||||
|
s2 = 2
|
||||||
|
key_tmp = ref_bitmask
|
||||||
|
call do_mono_excitation(key_tmp,i,r,s1,i_ok)
|
||||||
|
if(i_ok .ne.1)then
|
||||||
|
print*, 'pb !!'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
call do_mono_excitation(key_tmp,j,s,s2,i_ok)
|
||||||
|
if(i_ok .ne.1)then
|
||||||
|
print*, 'pb !!'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
call i_H_j(ref_bitmask, key_tmp, N_int,hij)
|
||||||
|
delta_e = Fock_matrix_diag_mo(i) + Fock_matrix_diag_mo(j) - Fock_matrix_diag_mo(r) - Fock_matrix_diag_mo(s)
|
||||||
|
coef_ijrs = hij/delta_e
|
||||||
|
do k = 1, n_singles
|
||||||
|
l = index_singles(k)
|
||||||
|
call i_H_j(dets_in(1,1,l), key_tmp, N_int,hij)
|
||||||
|
diag_H_elements(l) += coef_ijrs * hij
|
||||||
|
enddo
|
||||||
|
!endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
c_ref = 1.d0/u_in(index_hf,1)
|
||||||
|
do k = 1, n_singles
|
||||||
|
l = index_singles(k)
|
||||||
|
diag_H_elements(0) -= diag_H_elements(l)
|
||||||
|
enddo
|
||||||
|
! do k = 1, n_doubles
|
||||||
|
! l = index_doubles(k)
|
||||||
|
! diag_H_elements(0) += diag_H_elements(l)
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine dressing_1h1p_full(dets_in,u_in,H_matrix,dim_in,sze,N_st,Nint,convergence)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! CISD+SC2 method :: take off all the disconnected terms of a ROHF+1h1p (selected or not)
|
||||||
|
!
|
||||||
|
! dets_in : bitmasks corresponding to determinants
|
||||||
|
!
|
||||||
|
! u_in : guess coefficients on the various states. Overwritten
|
||||||
|
! on exit
|
||||||
|
!
|
||||||
|
! dim_in : leftmost dimension of u_in
|
||||||
|
!
|
||||||
|
! sze : Number of determinants
|
||||||
|
!
|
||||||
|
! N_st : Number of eigenstates
|
||||||
|
!
|
||||||
|
! Initial guess vectors are not necessarily orthonormal
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: dim_in, sze, N_st, Nint
|
||||||
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
|
double precision, intent(in) :: u_in(dim_in,N_st)
|
||||||
|
double precision, intent(inout) :: H_matrix(sze,sze)
|
||||||
|
double precision, intent(in) :: convergence
|
||||||
|
|
||||||
|
integer :: i,j,k,l
|
||||||
|
integer :: n_singles
|
||||||
|
integer :: index_singles(sze),hole_particles_singles(sze,3)
|
||||||
|
integer :: n_doubles
|
||||||
|
integer :: index_doubles(sze),hole_particles_doubles(sze,2)
|
||||||
|
integer :: index_hf
|
||||||
|
double precision :: e_corr_singles(mo_tot_num,2)
|
||||||
|
double precision :: e_corr_doubles(mo_tot_num)
|
||||||
|
double precision :: e_corr_singles_total(2)
|
||||||
|
double precision :: e_corr_doubles_1h1p
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2),degree
|
||||||
|
integer :: h1,h2,p1,p2,s1,s2
|
||||||
|
integer :: other_spin(2)
|
||||||
|
double precision :: phase
|
||||||
|
integer(bit_kind) :: key_tmp(N_int,2)
|
||||||
|
integer :: i_ok
|
||||||
|
double precision :: phase_single_double,phase_double_hf,get_mo_bielec_integral
|
||||||
|
double precision :: hij,c_ref,contrib
|
||||||
|
integer :: iorb
|
||||||
|
|
||||||
|
other_spin(1) = 2
|
||||||
|
other_spin(2) = 1
|
||||||
|
|
||||||
|
n_singles = 0
|
||||||
|
n_doubles = 0
|
||||||
|
do i = 1,sze
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,i),exc,degree,phase,N_int)
|
||||||
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
|
if(degree == 0)then
|
||||||
|
index_hf = i
|
||||||
|
else if (degree == 1)then
|
||||||
|
n_singles +=1
|
||||||
|
index_singles(n_singles) = i
|
||||||
|
! h1 = inactive orbital of the hole
|
||||||
|
hole_particles_singles(n_singles,1) = h1
|
||||||
|
! p1 = virtual orbital of the particle
|
||||||
|
hole_particles_singles(n_singles,2) = p1
|
||||||
|
! s1 = spin of the electron excited
|
||||||
|
hole_particles_singles(n_singles,3) = s1
|
||||||
|
else if (degree == 2)then
|
||||||
|
n_doubles +=1
|
||||||
|
index_doubles(n_doubles) = i
|
||||||
|
! h1 = inactive orbital of the hole (beta of course)
|
||||||
|
hole_particles_doubles(n_doubles,1) = h1
|
||||||
|
! p1 = virtual orbital of the particle (alpha of course)
|
||||||
|
hole_particles_doubles(n_doubles,2) = p2
|
||||||
|
else
|
||||||
|
print*,'PB !! found out other thing than a single or double'
|
||||||
|
print*,'stopping ..'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
double precision, allocatable :: dressing_H_mat_elem(:)
|
||||||
|
allocate(dressing_H_mat_elem(N_det))
|
||||||
|
logical :: lmct
|
||||||
|
dressing_H_mat_elem = 0.d0
|
||||||
|
call dress_diag_elem_2h2p(dressing_H_mat_elem,N_det)
|
||||||
|
lmct = .False.
|
||||||
|
call dress_diag_elem_2h1p(dressing_H_mat_elem,N_det,lmct,1000)
|
||||||
|
lmct = .true.
|
||||||
|
call dress_diag_elem_1h2p(dressing_H_mat_elem,N_det,lmct,1000)
|
||||||
|
do i = 1, N_det
|
||||||
|
H_matrix(i,i) += dressing_H_mat_elem(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
e_corr_singles = 0.d0
|
||||||
|
e_corr_doubles = 0.d0
|
||||||
|
e_corr_singles_total = 0.d0
|
||||||
|
e_corr_doubles_1h1p = 0.d0
|
||||||
|
c_ref = 1.d0/u_in(index_hf,1)
|
||||||
|
print*,'c_ref = ',c_ref
|
||||||
|
do i = 1,sze
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,i),exc,degree,phase,N_int)
|
||||||
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
|
call i_H_j(ref_bitmask,dets_in(1,1,i),N_int,hij)
|
||||||
|
contrib = hij * u_in(i,1) * c_ref
|
||||||
|
if (degree == 1)then
|
||||||
|
e_corr_singles(h1,s1) += contrib
|
||||||
|
e_corr_singles(p1,s1) += contrib
|
||||||
|
e_corr_singles_total(s1)+= contrib
|
||||||
|
else if (degree == 2)then
|
||||||
|
e_corr_doubles_1h1p += contrib
|
||||||
|
e_corr_doubles(h1) += contrib
|
||||||
|
e_corr_doubles(p2) += contrib
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,'e_corr_singles alpha = ',e_corr_singles_total(1)
|
||||||
|
print*,'e_corr_singles beta = ',e_corr_singles_total(2)
|
||||||
|
print*,'e_corr_doubles_1h1p = ',e_corr_doubles_1h1p
|
||||||
|
|
||||||
|
|
||||||
|
! repeat all the correlation energy on the singles
|
||||||
|
! do i = 1,n_singles
|
||||||
|
! ! you can repeat all the correlation energy of the single excitation of the other spin
|
||||||
|
! H_matrix(index_singles(i),index_singles(i)) += e_corr_singles_total(other_spin(hole_particles_singles(i,3)))
|
||||||
|
|
||||||
|
! ! you can repeat all the correlation energy of the single excitation of the same spin
|
||||||
|
! do j = 1, n_inact_orb
|
||||||
|
! iorb = list_inact(j)
|
||||||
|
! ! except the one of the hole
|
||||||
|
! if(iorb == hole_particles_singles(i,1))cycle
|
||||||
|
! ! ispin = hole_particles_singles(i,3)
|
||||||
|
! H_matrix(index_singles(i),index_singles(i)) += e_corr_singles(iorb,hole_particles_singles(i,3))
|
||||||
|
! enddo
|
||||||
|
! ! also exclude all the energy coming from the virtual orbital
|
||||||
|
! H_matrix(index_singles(i),index_singles(i)) -= e_corr_singles(hole_particles_singles(i,2),hole_particles_singles(i,3))
|
||||||
|
!
|
||||||
|
! ! If it is a single excitation alpha, you can repeat :
|
||||||
|
! ! +) all the double excitation 1h1p, appart the part involving the virtual orbital "r"
|
||||||
|
! ! If it is a single excitation alpha, you can repeat :
|
||||||
|
! ! +) all the double excitation 1h1p, appart the part involving the inactive orbital "i"
|
||||||
|
! H_matrix(index_singles(i),index_singles(i)) += e_corr_doubles_1h1p
|
||||||
|
! if(hole_particles_singles(i,3) == 1)then ! alpha single excitation
|
||||||
|
! H_matrix(index_singles(i),index_singles(i)) -= e_corr_doubles(hole_particles_singles(i,2))
|
||||||
|
! else ! beta single exctitation
|
||||||
|
! H_matrix(index_singles(i),index_singles(i)) -= e_corr_doubles(hole_particles_singles(i,1))
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
! ! repeat all the correlation energy on the doubles
|
||||||
|
! ! as all the doubles involve the active space, you cannot repeat any of them one on another
|
||||||
|
! do i = 1, n_doubles
|
||||||
|
! ! on a given double, you can repeat all the correlation energy of the singles alpha
|
||||||
|
! do j = 1, n_inact_orb
|
||||||
|
! iorb = list_inact(j)
|
||||||
|
! ! ispin = hole_particles_singles(i,3)
|
||||||
|
! H_matrix(index_doubles(i),index_doubles(i)) += e_corr_singles(iorb,1)
|
||||||
|
! enddo
|
||||||
|
! ! except the part involving the virtual orbital "hole_particles_doubles(i,2)"
|
||||||
|
! H_matrix(index_doubles(i),index_doubles(i)) -= e_corr_singles(hole_particles_doubles(i,2),1)
|
||||||
|
! ! on a given double, you can repeat all the correlation energy of the singles beta
|
||||||
|
! do j = 1, n_inact_orb
|
||||||
|
! iorb = list_inact(j)
|
||||||
|
! ! except the one of the hole
|
||||||
|
! if(iorb == hole_particles_doubles(i,1))cycle
|
||||||
|
! ! ispin = hole_particles_singles(i,3)
|
||||||
|
! H_matrix(index_doubles(i),index_doubles(i)) += e_corr_singles(iorb,2)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
|
||||||
|
! Taking into account the connected part of the 2h2p on the HF determinant
|
||||||
|
! 1/2 \sum_{ir,js} c_{ir}^{sigma} c_{js}^{sigma}
|
||||||
|
|
||||||
|
! H_matrix(index_hf) += total_corr_e_2h2p
|
||||||
|
print*,'H_matrix(index_hf,index_hf) = ',H_matrix(index_hf,index_hf)
|
||||||
|
do i = 1, n_singles
|
||||||
|
! start on the single excitation "|i>"
|
||||||
|
h1 = hole_particles_singles(i,1)
|
||||||
|
p1 = hole_particles_singles(i,2)
|
||||||
|
print*,'i = ',i
|
||||||
|
do j = i+1, n_singles
|
||||||
|
do k = 1, N_int
|
||||||
|
key_tmp(k,1) = dets_in(k,1,index_singles(i))
|
||||||
|
key_tmp(k,2) = dets_in(k,2,index_singles(i))
|
||||||
|
enddo
|
||||||
|
h2 = hole_particles_singles(j,1)
|
||||||
|
p2 = hole_particles_singles(j,2)
|
||||||
|
call do_mono_excitation(key_tmp,h2,p2,hole_particles_singles(j,3),i_ok)
|
||||||
|
! apply the excitation operator from the single excitation "|j>"
|
||||||
|
if(i_ok .ne. 1)cycle
|
||||||
|
double precision :: H_array(sze),diag_H_mat_elem,hjj
|
||||||
|
do k = 1, sze
|
||||||
|
call get_excitation_degree(dets_in(1,1,k),key_tmp,degree,N_int)
|
||||||
|
H_array(k) = 0.d0
|
||||||
|
if(degree > 2)cycle
|
||||||
|
call i_H_j(dets_in(1,1,k),key_tmp,N_int,hij)
|
||||||
|
H_array(k) = hij
|
||||||
|
enddo
|
||||||
|
hjj = 1.d0/(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||||
|
! contrib_e2 = 0.5d0 * (delta_e + dsqrt(delta_e * delta_e + 4.d0 * hij * hij))
|
||||||
|
do l = 2, sze
|
||||||
|
! pause
|
||||||
|
H_matrix(l,l) += H_array(l) * H_array(l) * hjj
|
||||||
|
! H_matrix(1,l) += H_array(1) * H_array(l) * hjj
|
||||||
|
! H_matrix(l,1) += H_array(1) * H_array(l) * hjj
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'H_matrix(index_hf,index_hf) = ',H_matrix(index_hf,index_hf)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine SC2_1h1p_full(dets_in,u_in,energies,H_matrix,dim_in,sze,N_st,Nint,convergence)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! CISD+SC2 method :: take off all the disconnected terms of a CISD (selected or not)
|
||||||
|
!
|
||||||
|
! dets_in : bitmasks corresponding to determinants
|
||||||
|
!
|
||||||
|
! u_in : guess coefficients on the various states. Overwritten
|
||||||
|
! on exit
|
||||||
|
!
|
||||||
|
! dim_in : leftmost dimension of u_in
|
||||||
|
!
|
||||||
|
! sze : Number of determinants
|
||||||
|
!
|
||||||
|
! N_st : Number of eigenstates
|
||||||
|
!
|
||||||
|
! Initial guess vectors are not necessarily orthonormal
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: dim_in, sze, N_st, Nint
|
||||||
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
|
double precision, intent(inout) :: u_in(dim_in,N_st)
|
||||||
|
double precision, intent(out) :: energies(N_st)
|
||||||
|
double precision, intent(out) :: H_matrix(sze,sze)
|
||||||
|
double precision, intent(in) :: convergence
|
||||||
|
integer :: i,j,iter
|
||||||
|
print*,'sze = ',sze
|
||||||
|
H_matrix = 0.d0
|
||||||
|
do iter = 1, 1
|
||||||
|
! if(sze<=N_det_max_jacobi)then
|
||||||
|
double precision, allocatable :: eigenvectors(:,:), eigenvalues(:),H_matrix_tmp(:,:)
|
||||||
|
allocate (H_matrix_tmp(size(H_matrix_all_dets,1),sze),eigenvalues(sze),eigenvectors(size(H_matrix_all_dets,1),sze))
|
||||||
|
H_matrix_tmp = 0.d0
|
||||||
|
call dressing_1h1p_full(dets_in,u_in,H_matrix_tmp,dim_in,sze,N_st,Nint,convergence)
|
||||||
|
do j=1,sze
|
||||||
|
do i=1,sze
|
||||||
|
H_matrix_tmp(i,j) += H_matrix_all_dets(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'passed the dressing'
|
||||||
|
call lapack_diag(eigenvalues,eigenvectors, &
|
||||||
|
H_matrix_tmp,size(H_matrix_all_dets,1),sze)
|
||||||
|
do j=1,min(N_states_diag,sze)
|
||||||
|
do i=1,sze
|
||||||
|
u_in(i,j) = eigenvectors(i,j)
|
||||||
|
enddo
|
||||||
|
energies(j) = eigenvalues(j)
|
||||||
|
enddo
|
||||||
|
deallocate (H_matrix_tmp, eigenvalues, eigenvectors)
|
||||||
|
! else
|
||||||
|
! call davidson_diag_hjj(dets_in,u_in,diag_H_elements,energies,dim_in,sze,N_st,Nint,output_determinants)
|
||||||
|
! endif
|
||||||
|
print*,'E = ',energies(1) + nuclear_repulsion
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine SC2_1h1p(dets_in,u_in,energies,diag_H_elements,dim_in,sze,N_st,Nint,convergence)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! CISD+SC2 method :: take off all the disconnected terms of a CISD (selected or not)
|
||||||
|
!
|
||||||
|
! dets_in : bitmasks corresponding to determinants
|
||||||
|
!
|
||||||
|
! u_in : guess coefficients on the various states. Overwritten
|
||||||
|
! on exit
|
||||||
|
!
|
||||||
|
! dim_in : leftmost dimension of u_in
|
||||||
|
!
|
||||||
|
! sze : Number of determinants
|
||||||
|
!
|
||||||
|
! N_st : Number of eigenstates
|
||||||
|
!
|
||||||
|
! Initial guess vectors are not necessarily orthonormal
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: dim_in, sze, N_st, Nint
|
||||||
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
|
double precision, intent(inout) :: u_in(dim_in,N_st)
|
||||||
|
double precision, intent(out) :: energies(N_st)
|
||||||
|
double precision, intent(out) :: diag_H_elements(dim_in)
|
||||||
|
double precision :: extra_diag_H_elements(dim_in)
|
||||||
|
double precision, intent(in) :: convergence
|
||||||
|
integer :: i,j,iter
|
||||||
|
DIAG_H_ELEMENTS = 0.d0
|
||||||
|
do iter = 1, 1
|
||||||
|
! call dressing_1h1p(dets_in,u_in,diag_H_elements,dim_in,sze,N_st,Nint,convergence)
|
||||||
|
call dressing_1h1p_by_2h2p(dets_in,u_in,extra_diag_H_elements,dim_in,sze,N_st,Nint,convergence)
|
||||||
|
! if(sze<=N_det_max_jacobi)then
|
||||||
|
double precision, allocatable :: eigenvectors(:,:), eigenvalues(:),H_matrix_tmp(:,:)
|
||||||
|
allocate (H_matrix_tmp(size(H_matrix_all_dets,1),sze),eigenvalues(sze),eigenvectors(size(H_matrix_all_dets,1),sze))
|
||||||
|
do j=1,sze
|
||||||
|
do i=1,sze
|
||||||
|
H_matrix_tmp(i,j) = H_matrix_all_dets(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
H_matrix_tmp(1,1) += extra_diag_H_elements(1)
|
||||||
|
do i = 2,sze
|
||||||
|
H_matrix_tmp(1,i) += extra_diag_H_elements(i)
|
||||||
|
H_matrix_tmp(i,1) += extra_diag_H_elements(i)
|
||||||
|
enddo
|
||||||
|
!do i = 1,sze
|
||||||
|
! H_matrix_tmp(i,i) = diag_H_elements(i)
|
||||||
|
!enddo
|
||||||
|
call lapack_diag(eigenvalues,eigenvectors, &
|
||||||
|
H_matrix_tmp,size(H_matrix_all_dets,1),sze)
|
||||||
|
do j=1,min(N_states_diag,sze)
|
||||||
|
do i=1,sze
|
||||||
|
u_in(i,j) = eigenvectors(i,j)
|
||||||
|
enddo
|
||||||
|
energies(j) = eigenvalues(j)
|
||||||
|
enddo
|
||||||
|
deallocate (H_matrix_tmp, eigenvalues, eigenvectors)
|
||||||
|
! else
|
||||||
|
! call davidson_diag_hjj(dets_in,u_in,diag_H_elements,energies,dim_in,sze,N_st,Nint,output_determinants)
|
||||||
|
! endif
|
||||||
|
print*,'E = ',energies(1) + nuclear_repulsion
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine density_matrix_1h1p(dets_in,u_in,density_matrix_alpha,density_matrix_beta,norm,dim_in,sze,N_st,Nint)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! CISD+SC2 method :: take off all the disconnected terms of a ROHF+1h1p (selected or not)
|
||||||
|
!
|
||||||
|
! dets_in : bitmasks corresponding to determinants
|
||||||
|
!
|
||||||
|
! u_in : guess coefficients on the various states. Overwritten
|
||||||
|
! on exit
|
||||||
|
!
|
||||||
|
! dim_in : leftmost dimension of u_in
|
||||||
|
!
|
||||||
|
! sze : Number of determinants
|
||||||
|
!
|
||||||
|
! N_st : Number of eigenstates
|
||||||
|
!
|
||||||
|
! Initial guess vectors are not necessarily orthonormal
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: dim_in, sze, N_st, Nint
|
||||||
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
|
double precision, intent(inout) :: u_in(dim_in,N_st)
|
||||||
|
double precision, intent(inout) :: density_matrix_alpha(mo_tot_num_align,mo_tot_num)
|
||||||
|
double precision, intent(inout) :: density_matrix_beta(mo_tot_num_align,mo_tot_num)
|
||||||
|
double precision, intent(inout) :: norm
|
||||||
|
|
||||||
|
integer :: i,j,k,l
|
||||||
|
integer :: n_singles
|
||||||
|
integer :: index_singles(sze),hole_particles_singles(sze,3)
|
||||||
|
integer :: n_doubles
|
||||||
|
integer :: index_doubles(sze),hole_particles_doubles(sze,2)
|
||||||
|
integer :: index_hf
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2),degree
|
||||||
|
integer :: h1,h2,p1,p2,s1,s2
|
||||||
|
integer :: other_spin(2)
|
||||||
|
double precision :: phase
|
||||||
|
integer(bit_kind) :: key_tmp(N_int,2)
|
||||||
|
integer :: i_ok
|
||||||
|
double precision :: phase_single_double,phase_double_hf,get_mo_bielec_integral
|
||||||
|
double precision :: hij,c_ref,contrib
|
||||||
|
integer :: iorb
|
||||||
|
|
||||||
|
other_spin(1) = 2
|
||||||
|
other_spin(2) = 1
|
||||||
|
|
||||||
|
n_singles = 0
|
||||||
|
n_doubles = 0
|
||||||
|
norm = 0.d0
|
||||||
|
do i = 1,sze
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,i),exc,degree,phase,N_int)
|
||||||
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
|
norm += u_in(i,1)* u_in(i,1)
|
||||||
|
if(degree == 0)then
|
||||||
|
index_hf = i
|
||||||
|
c_ref = 1.d0/psi_coef(i,1)
|
||||||
|
else if (degree == 1)then
|
||||||
|
n_singles +=1
|
||||||
|
index_singles(n_singles) = i
|
||||||
|
! h1 = inactive orbital of the hole
|
||||||
|
hole_particles_singles(n_singles,1) = h1
|
||||||
|
! p1 = virtual orbital of the particle
|
||||||
|
hole_particles_singles(n_singles,2) = p1
|
||||||
|
! s1 = spin of the electron excited
|
||||||
|
hole_particles_singles(n_singles,3) = s1
|
||||||
|
else if (degree == 2)then
|
||||||
|
n_doubles +=1
|
||||||
|
index_doubles(n_doubles) = i
|
||||||
|
! h1 = inactive orbital of the hole (beta of course)
|
||||||
|
hole_particles_doubles(n_doubles,1) = h1
|
||||||
|
! p1 = virtual orbital of the particle (alpha of course)
|
||||||
|
hole_particles_doubles(n_doubles,2) = p2
|
||||||
|
else
|
||||||
|
print*,'PB !! found out other thing than a single or double'
|
||||||
|
print*,'stopping ..'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,'norm = ',norm
|
||||||
|
|
||||||
|
! Taking into account the connected part of the 2h2p on the HF determinant
|
||||||
|
! 1/2 \sum_{ir,js} c_{ir}^{sigma} c_{js}^{sigma}
|
||||||
|
|
||||||
|
do i = 1, n_singles
|
||||||
|
! start on the single excitation "|i>"
|
||||||
|
h1 = hole_particles_singles(i,1)
|
||||||
|
p1 = hole_particles_singles(i,2)
|
||||||
|
do j = 1, n_singles
|
||||||
|
do k = 1, N_int
|
||||||
|
key_tmp(k,1) = dets_in(k,1,index_singles(i))
|
||||||
|
key_tmp(k,2) = dets_in(k,2,index_singles(i))
|
||||||
|
enddo
|
||||||
|
h2 = hole_particles_singles(j,1)
|
||||||
|
p2 = hole_particles_singles(j,2)
|
||||||
|
call do_mono_excitation(key_tmp,h2,p2,hole_particles_singles(j,3),i_ok)
|
||||||
|
! apply the excitation operator from the single excitation "|j>"
|
||||||
|
if(i_ok .ne. 1)cycle
|
||||||
|
double precision :: coef_ijrs,phase_other_single_ref
|
||||||
|
integer :: occ(N_int*bit_kind_size,2),n_occ(2)
|
||||||
|
call get_excitation(key_tmp,dets_in(1,1,index_singles(i)),exc,degree,phase_single_double,N_int)
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,index_singles(j)),exc,degree,phase_other_single_ref,N_int)
|
||||||
|
call get_excitation(key_tmp,dets_in(1,1,index_singles(j)),exc,degree,phase_other_single_ref,N_int)
|
||||||
|
coef_ijrs = u_in(index_singles(i),1) * u_in(index_singles(j),1) * c_ref * c_ref &
|
||||||
|
* phase_single_double * phase_other_single_ref
|
||||||
|
call bitstring_to_list_ab(key_tmp, occ, n_occ, N_int)
|
||||||
|
do k=1,elec_alpha_num
|
||||||
|
l = occ(k,1)
|
||||||
|
density_matrix_alpha(l,l) += coef_ijrs*coef_ijrs
|
||||||
|
enddo
|
||||||
|
do k=1,elec_beta_num
|
||||||
|
l = occ(k,1)
|
||||||
|
density_matrix_beta(l,l) += coef_ijrs*coef_ijrs
|
||||||
|
enddo
|
||||||
|
norm += coef_ijrs* coef_ijrs
|
||||||
|
if(hole_particles_singles(j,3) == 1)then ! single alpha
|
||||||
|
density_matrix_alpha(h2,p2) += coef_ijrs * phase_single_double * u_in(index_singles(i),1) * c_ref
|
||||||
|
density_matrix_alpha(p2,h2) += coef_ijrs * phase_single_double * u_in(index_singles(i),1) * c_ref
|
||||||
|
else
|
||||||
|
density_matrix_beta(h2,p2) += coef_ijrs * phase_single_double * u_in(index_singles(i),1) * c_ref
|
||||||
|
density_matrix_beta(p2,h2) += coef_ijrs * phase_single_double * u_in(index_singles(i),1) * c_ref
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
do i = 1, n_doubles
|
||||||
|
! start on the double excitation "|i>"
|
||||||
|
h1 = hole_particles_doubles(i,1)
|
||||||
|
p1 = hole_particles_doubles(i,2)
|
||||||
|
do j = 1, n_singles
|
||||||
|
do k = 1, N_int
|
||||||
|
key_tmp(k,1) = dets_in(k,1,index_doubles(i))
|
||||||
|
key_tmp(k,2) = dets_in(k,2,index_doubles(i))
|
||||||
|
enddo
|
||||||
|
h2 = hole_particles_singles(j,1)
|
||||||
|
p2 = hole_particles_singles(j,2)
|
||||||
|
call do_mono_excitation(key_tmp,h2,p2,hole_particles_singles(j,3),i_ok)
|
||||||
|
! apply the excitation operator from the single excitation "|j>"
|
||||||
|
if(i_ok .ne. 1)cycle
|
||||||
|
double precision :: coef_ijrs_kv,phase_double_triple
|
||||||
|
call get_excitation(key_tmp,dets_in(1,1,index_singles(i)),exc,degree,phase_double_triple,N_int)
|
||||||
|
call get_excitation(ref_bitmask,dets_in(1,1,index_singles(j)),exc,degree,phase_other_single_ref,N_int)
|
||||||
|
call get_excitation(key_tmp,dets_in(1,1,index_singles(j)),exc,degree,phase_other_single_ref,N_int)
|
||||||
|
coef_ijrs_kv = u_in(index_doubles(i),1) * u_in(index_singles(j),1) * c_ref * c_ref &
|
||||||
|
* phase_double_triple * phase_other_single_ref
|
||||||
|
call bitstring_to_list_ab(key_tmp, occ, n_occ, N_int)
|
||||||
|
do k=1,elec_alpha_num
|
||||||
|
l = occ(k,1)
|
||||||
|
density_matrix_alpha(l,l) += coef_ijrs_kv*coef_ijrs_kv
|
||||||
|
enddo
|
||||||
|
do k=1,elec_beta_num
|
||||||
|
l = occ(k,1)
|
||||||
|
density_matrix_beta(l,l) += coef_ijrs_kv*coef_ijrs_kv
|
||||||
|
enddo
|
||||||
|
norm += coef_ijrs_kv* coef_ijrs_kv
|
||||||
|
if(hole_particles_singles(j,3) == 1)then ! single alpha
|
||||||
|
density_matrix_alpha(h2,p2) += coef_ijrs_kv * phase_double_triple * u_in(index_doubles(i),1) * c_ref
|
||||||
|
density_matrix_alpha(p2,h2) += coef_ijrs_kv * phase_double_triple * u_in(index_doubles(i),1) * c_ref
|
||||||
|
else
|
||||||
|
density_matrix_beta(h2,p2) += coef_ijrs_kv * phase_double_triple * u_in(index_doubles(i),1) * c_ref
|
||||||
|
density_matrix_beta(p2,h2) += coef_ijrs_kv * phase_double_triple * u_in(index_doubles(i),1) * c_ref
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
print*,'norm = ',norm
|
||||||
|
norm = 1.d0/norm
|
||||||
|
do i = 1, mo_tot_num
|
||||||
|
do j = 1, mo_tot_num
|
||||||
|
density_matrix_alpha(i,j) *= norm
|
||||||
|
density_matrix_beta(i,j) *= norm
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
coef_ijrs = 0.d0
|
||||||
|
do i = 1, mo_tot_num
|
||||||
|
coef_ijrs += density_matrix_beta(i,i) + density_matrix_beta(i,i)
|
||||||
|
enddo
|
||||||
|
print*,'accu = ',coef_ijrs
|
||||||
|
|
||||||
|
end
|
||||||
|
|
@ -1,13 +1,25 @@
|
|||||||
subroutine all_single
|
subroutine all_single(e_pt2)
|
||||||
implicit none
|
implicit none
|
||||||
|
double precision, intent(in) :: e_pt2
|
||||||
integer :: i,k
|
integer :: i,k
|
||||||
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
||||||
integer :: N_st, degree
|
integer :: N_st, degree
|
||||||
double precision,allocatable :: E_before(:)
|
double precision,allocatable :: E_before(:)
|
||||||
N_st = N_states
|
N_st = N_states
|
||||||
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
||||||
|
if(.not.selected_fobo_ci)then
|
||||||
selection_criterion = 0.d0
|
selection_criterion = 0.d0
|
||||||
soft_touch selection_criterion
|
soft_touch selection_criterion
|
||||||
|
else
|
||||||
|
selection_criterion = 0.1d0
|
||||||
|
selection_criterion_factor = 0.01d0
|
||||||
|
selection_criterion_min = selection_criterion
|
||||||
|
soft_touch selection_criterion
|
||||||
|
endif
|
||||||
|
print*, 'e_pt2 = ',e_pt2
|
||||||
|
pt2_max = 0.15d0 * e_pt2
|
||||||
|
soft_touch pt2_max
|
||||||
|
print*, 'pt2_max = ',pt2_max
|
||||||
threshold_davidson = 1.d-9
|
threshold_davidson = 1.d-9
|
||||||
soft_touch threshold_davidson davidson_criterion
|
soft_touch threshold_davidson davidson_criterion
|
||||||
i = 0
|
i = 0
|
||||||
@ -17,6 +29,8 @@ subroutine all_single
|
|||||||
print*,'pt2_max = ',pt2_max
|
print*,'pt2_max = ',pt2_max
|
||||||
print*,'N_det_generators = ',N_det_generators
|
print*,'N_det_generators = ',N_det_generators
|
||||||
pt2=-1.d0
|
pt2=-1.d0
|
||||||
|
print*, 'ref_bitmask_energy =',ref_bitmask_energy
|
||||||
|
print*, 'CI_expectation_value =',psi_energy(1)
|
||||||
E_before = ref_bitmask_energy
|
E_before = ref_bitmask_energy
|
||||||
|
|
||||||
print*,'Initial Step '
|
print*,'Initial Step '
|
||||||
@ -29,7 +43,7 @@ subroutine all_single
|
|||||||
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
||||||
enddo
|
enddo
|
||||||
n_det_max = 100000
|
n_det_max = 100000
|
||||||
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > dabs(pt2_max))
|
||||||
i += 1
|
i += 1
|
||||||
print*,'-----------------------'
|
print*,'-----------------------'
|
||||||
print*,'i = ',i
|
print*,'i = ',i
|
||||||
@ -39,6 +53,8 @@ subroutine all_single
|
|||||||
print*,'E = ',CI_energy(1)
|
print*,'E = ',CI_energy(1)
|
||||||
print*,'pt2 = ',pt2(1)
|
print*,'pt2 = ',pt2(1)
|
||||||
print*,'E+PT2 = ',E_before + pt2(1)
|
print*,'E+PT2 = ',E_before + pt2(1)
|
||||||
|
print*,'pt2_max = ',pt2_max
|
||||||
|
print*, maxval(abs(pt2(1:N_st))) > dabs(pt2_max)
|
||||||
if(N_states_diag.gt.1)then
|
if(N_states_diag.gt.1)then
|
||||||
print*,'Variational Energy difference'
|
print*,'Variational Energy difference'
|
||||||
do i = 2, N_st
|
do i = 2, N_st
|
||||||
@ -53,7 +69,6 @@ subroutine all_single
|
|||||||
endif
|
endif
|
||||||
E_before = CI_energy
|
E_before = CI_energy
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!! DOING ONLY ONE ITERATION OF SELECTION AS THE SELECTION CRITERION IS SET TO ZERO
|
!!!!!!!!!!!!!!!!!!!!!!!!!!! DOING ONLY ONE ITERATION OF SELECTION AS THE SELECTION CRITERION IS SET TO ZERO
|
||||||
exit
|
|
||||||
enddo
|
enddo
|
||||||
! threshold_davidson = 1.d-8
|
! threshold_davidson = 1.d-8
|
||||||
! soft_touch threshold_davidson davidson_criterion
|
! soft_touch threshold_davidson davidson_criterion
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
integer(bit_kind) :: key_tmp(N_int,2)
|
integer(bit_kind) :: key_tmp(N_int,2)
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
integer :: i_hole,j_hole,k_part,l_part
|
integer :: i_hole,j_hole,k_part,l_part
|
||||||
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
|
double precision :: get_mo_bielec_integral,hij,delta_e,exc,contrib
|
||||||
double precision :: diag_H_mat_elem
|
double precision :: diag_H_mat_elem
|
||||||
integer :: i_ok,ispin
|
integer :: i_ok,ispin
|
||||||
! Alpha - Beta correlation energy
|
! Alpha - Beta correlation energy
|
||||||
@ -46,7 +46,7 @@
|
|||||||
if(i_ok .ne.1)cycle
|
if(i_ok .ne.1)cycle
|
||||||
delta_e = (ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
delta_e = (ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||||
|
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
contrib = hij*hij/delta_e
|
contrib = hij*hij/delta_e
|
||||||
total_corr_e_2h2p += contrib
|
total_corr_e_2h2p += contrib
|
||||||
! Single orbital contribution
|
! Single orbital contribution
|
||||||
@ -81,8 +81,8 @@
|
|||||||
k_part = list_virt(k)
|
k_part = list_virt(k)
|
||||||
do l = k+1,n_virt_orb
|
do l = k+1,n_virt_orb
|
||||||
l_part = list_virt(l)
|
l_part = list_virt(l)
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||||
key_tmp = ref_bitmask
|
key_tmp = ref_bitmask
|
||||||
ispin = 1
|
ispin = 1
|
||||||
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
||||||
@ -114,8 +114,8 @@
|
|||||||
k_part = list_virt(k)
|
k_part = list_virt(k)
|
||||||
do l = k+1,n_virt_orb
|
do l = k+1,n_virt_orb
|
||||||
l_part = list_virt(l)
|
l_part = list_virt(l)
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||||
key_tmp = ref_bitmask
|
key_tmp = ref_bitmask
|
||||||
ispin = 2
|
ispin = 2
|
||||||
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
||||||
@ -161,7 +161,7 @@ END_PROVIDER
|
|||||||
integer(bit_kind) :: key_tmp(N_int,2)
|
integer(bit_kind) :: key_tmp(N_int,2)
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
integer :: i_hole,j_hole,k_part,l_part
|
integer :: i_hole,j_hole,k_part,l_part
|
||||||
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
|
double precision :: get_mo_bielec_integral,hij,delta_e,exc,contrib
|
||||||
double precision :: diag_H_mat_elem
|
double precision :: diag_H_mat_elem
|
||||||
integer :: i_ok,ispin
|
integer :: i_ok,ispin
|
||||||
! Alpha - Beta correlation energy
|
! Alpha - Beta correlation energy
|
||||||
@ -191,7 +191,7 @@ END_PROVIDER
|
|||||||
if(i_ok .ne.1)cycle
|
if(i_ok .ne.1)cycle
|
||||||
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||||
|
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
|
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
|
||||||
total_corr_e_2h1p += contrib
|
total_corr_e_2h1p += contrib
|
||||||
corr_energy_2h1p_ab_bb_per_2_orb(i_hole,j_hole) += contrib
|
corr_energy_2h1p_ab_bb_per_2_orb(i_hole,j_hole) += contrib
|
||||||
@ -211,8 +211,8 @@ END_PROVIDER
|
|||||||
k_part = list_act(k)
|
k_part = list_act(k)
|
||||||
do l = 1,n_virt_orb
|
do l = 1,n_virt_orb
|
||||||
l_part = list_virt(l)
|
l_part = list_virt(l)
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||||
key_tmp = ref_bitmask
|
key_tmp = ref_bitmask
|
||||||
ispin = 1
|
ispin = 1
|
||||||
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
||||||
@ -241,8 +241,8 @@ END_PROVIDER
|
|||||||
k_part = list_act(k)
|
k_part = list_act(k)
|
||||||
do l = 1,n_virt_orb
|
do l = 1,n_virt_orb
|
||||||
l_part = list_virt(l)
|
l_part = list_virt(l)
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||||
key_tmp = ref_bitmask
|
key_tmp = ref_bitmask
|
||||||
ispin = 2
|
ispin = 2
|
||||||
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
||||||
@ -276,7 +276,7 @@ END_PROVIDER
|
|||||||
integer(bit_kind) :: key_tmp(N_int,2)
|
integer(bit_kind) :: key_tmp(N_int,2)
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
integer :: i_hole,j_hole,k_part,l_part
|
integer :: i_hole,j_hole,k_part,l_part
|
||||||
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
|
double precision :: get_mo_bielec_integral,hij,delta_e,exc,contrib
|
||||||
double precision :: diag_H_mat_elem
|
double precision :: diag_H_mat_elem
|
||||||
integer :: i_ok,ispin
|
integer :: i_ok,ispin
|
||||||
! Alpha - Beta correlation energy
|
! Alpha - Beta correlation energy
|
||||||
@ -302,7 +302,7 @@ END_PROVIDER
|
|||||||
if(i_ok .ne.1)cycle
|
if(i_ok .ne.1)cycle
|
||||||
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||||
|
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
|
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
|
||||||
|
|
||||||
total_corr_e_1h2p += contrib
|
total_corr_e_1h2p += contrib
|
||||||
@ -324,8 +324,8 @@ END_PROVIDER
|
|||||||
k_part = list_act(k)
|
k_part = list_act(k)
|
||||||
do l = i+1,n_virt_orb
|
do l = i+1,n_virt_orb
|
||||||
l_part = list_virt(l)
|
l_part = list_virt(l)
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||||
|
|
||||||
key_tmp = ref_bitmask
|
key_tmp = ref_bitmask
|
||||||
ispin = 1
|
ispin = 1
|
||||||
@ -356,8 +356,8 @@ END_PROVIDER
|
|||||||
k_part = list_act(k)
|
k_part = list_act(k)
|
||||||
do l = i+1,n_virt_orb
|
do l = i+1,n_virt_orb
|
||||||
l_part = list_virt(l)
|
l_part = list_virt(l)
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||||
|
|
||||||
key_tmp = ref_bitmask
|
key_tmp = ref_bitmask
|
||||||
ispin = 2
|
ispin = 2
|
||||||
@ -388,7 +388,7 @@ END_PROVIDER
|
|||||||
integer(bit_kind) :: key_tmp(N_int,2)
|
integer(bit_kind) :: key_tmp(N_int,2)
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
integer :: i_hole,j_hole,k_part,l_part
|
integer :: i_hole,j_hole,k_part,l_part
|
||||||
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
|
double precision :: get_mo_bielec_integral,hij,delta_e,exc,contrib
|
||||||
double precision :: diag_H_mat_elem
|
double precision :: diag_H_mat_elem
|
||||||
integer :: i_ok,ispin
|
integer :: i_ok,ispin
|
||||||
! Alpha - Beta correlation energy
|
! Alpha - Beta correlation energy
|
||||||
@ -412,7 +412,7 @@ END_PROVIDER
|
|||||||
if(i_ok .ne.1)cycle
|
if(i_ok .ne.1)cycle
|
||||||
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||||
|
|
||||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||||
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
|
contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij))
|
||||||
|
|
||||||
total_corr_e_1h1p_spin_flip += contrib
|
total_corr_e_1h1p_spin_flip += contrib
|
||||||
|
@ -68,7 +68,9 @@ subroutine create_restart_and_1h(i_hole)
|
|||||||
|
|
||||||
SOFT_TOUCH N_det psi_det psi_coef
|
SOFT_TOUCH N_det psi_det psi_coef
|
||||||
logical :: found_duplicates
|
logical :: found_duplicates
|
||||||
|
if(n_act_orb.gt.1)then
|
||||||
call remove_duplicates_in_psi_det(found_duplicates)
|
call remove_duplicates_in_psi_det(found_duplicates)
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine create_restart_and_1p(i_particle)
|
subroutine create_restart_and_1p(i_particle)
|
||||||
@ -213,6 +215,8 @@ subroutine create_restart_1h_1p(i_hole,i_part)
|
|||||||
|
|
||||||
SOFT_TOUCH N_det psi_det psi_coef
|
SOFT_TOUCH N_det psi_det psi_coef
|
||||||
logical :: found_duplicates
|
logical :: found_duplicates
|
||||||
|
if(n_act_orb.gt.1)then
|
||||||
call remove_duplicates_in_psi_det(found_duplicates)
|
call remove_duplicates_in_psi_det(found_duplicates)
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -38,7 +38,7 @@ end
|
|||||||
subroutine diag_inactive_virt_new_and_update_mos
|
subroutine diag_inactive_virt_new_and_update_mos
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j,i_inact,j_inact,i_virt,j_virt,k,k_act
|
integer :: i,j,i_inact,j_inact,i_virt,j_virt,k,k_act
|
||||||
double precision :: tmp(mo_tot_num_align,mo_tot_num),accu,get_mo_bielec_integral_schwartz
|
double precision :: tmp(mo_tot_num_align,mo_tot_num),accu,get_mo_bielec_integral
|
||||||
character*(64) :: label
|
character*(64) :: label
|
||||||
tmp = 0.d0
|
tmp = 0.d0
|
||||||
do i = 1, mo_tot_num
|
do i = 1, mo_tot_num
|
||||||
@ -52,8 +52,8 @@ subroutine diag_inactive_virt_new_and_update_mos
|
|||||||
accu =0.d0
|
accu =0.d0
|
||||||
do k = 1, n_act_orb
|
do k = 1, n_act_orb
|
||||||
k_act = list_act(k)
|
k_act = list_act(k)
|
||||||
accu += get_mo_bielec_integral_schwartz(i_inact,k_act,j_inact,k_act,mo_integrals_map)
|
accu += get_mo_bielec_integral(i_inact,k_act,j_inact,k_act,mo_integrals_map)
|
||||||
accu -= get_mo_bielec_integral_schwartz(i_inact,k_act,k_act,j_inact,mo_integrals_map)
|
accu -= get_mo_bielec_integral(i_inact,k_act,k_act,j_inact,mo_integrals_map)
|
||||||
enddo
|
enddo
|
||||||
tmp(i_inact,j_inact) = Fock_matrix_mo(i_inact,j_inact) + accu
|
tmp(i_inact,j_inact) = Fock_matrix_mo(i_inact,j_inact) + accu
|
||||||
tmp(j_inact,i_inact) = Fock_matrix_mo(j_inact,i_inact) + accu
|
tmp(j_inact,i_inact) = Fock_matrix_mo(j_inact,i_inact) + accu
|
||||||
@ -67,7 +67,7 @@ subroutine diag_inactive_virt_new_and_update_mos
|
|||||||
accu =0.d0
|
accu =0.d0
|
||||||
do k = 1, n_act_orb
|
do k = 1, n_act_orb
|
||||||
k_act = list_act(k)
|
k_act = list_act(k)
|
||||||
accu += get_mo_bielec_integral_schwartz(i_virt,k_act,j_virt,k_act,mo_integrals_map)
|
accu += get_mo_bielec_integral(i_virt,k_act,j_virt,k_act,mo_integrals_map)
|
||||||
enddo
|
enddo
|
||||||
tmp(i_virt,j_virt) = Fock_matrix_mo(i_virt,j_virt) - accu
|
tmp(i_virt,j_virt) = Fock_matrix_mo(i_virt,j_virt) - accu
|
||||||
tmp(j_virt,i_virt) = Fock_matrix_mo(j_virt,i_virt) - accu
|
tmp(j_virt,i_virt) = Fock_matrix_mo(j_virt,i_virt) - accu
|
||||||
|
@ -58,24 +58,7 @@ subroutine standard_dress(delta_ij_generators_,size_buffer,Ndet_generators,i_gen
|
|||||||
call i_h_j(det_buffer(1,1,i),det_buffer(1,1,i),Nint,haa)
|
call i_h_j(det_buffer(1,1,i),det_buffer(1,1,i),Nint,haa)
|
||||||
f = 1.d0/(E_ref-haa)
|
f = 1.d0/(E_ref-haa)
|
||||||
|
|
||||||
! if(second_order_h)then
|
|
||||||
lambda_i = f
|
lambda_i = f
|
||||||
! else
|
|
||||||
! ! You write the new Hamiltonian matrix
|
|
||||||
! do k = 1, Ndet_generators
|
|
||||||
! H_matrix_tmp(k,Ndet_generators+1) = H_array(k)
|
|
||||||
! H_matrix_tmp(Ndet_generators+1,k) = H_array(k)
|
|
||||||
! enddo
|
|
||||||
! H_matrix_tmp(Ndet_generators+1,Ndet_generators+1) = haa
|
|
||||||
! ! Then diagonalize it
|
|
||||||
! call lapack_diag(eigenvalues,eigenvectors,H_matrix_tmp,Ndet_generators+1,Ndet_generators+1)
|
|
||||||
! ! Then you extract the effective denominator
|
|
||||||
! accu = 0.d0
|
|
||||||
! do k = 1, Ndet_generators
|
|
||||||
! accu += eigenvectors(k,1) * H_array(k)
|
|
||||||
! enddo
|
|
||||||
! lambda_i = eigenvectors(Ndet_generators+1,1)/accu
|
|
||||||
! endif
|
|
||||||
do k=1,idx(0)
|
do k=1,idx(0)
|
||||||
contrib = H_array(idx(k)) * H_array(idx(k)) * lambda_i
|
contrib = H_array(idx(k)) * H_array(idx(k)) * lambda_i
|
||||||
delta_ij_generators_(idx(k), idx(k)) += contrib
|
delta_ij_generators_(idx(k), idx(k)) += contrib
|
||||||
@ -89,20 +72,21 @@ subroutine standard_dress(delta_ij_generators_,size_buffer,Ndet_generators,i_gen
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine is_a_good_candidate(threshold,is_ok,verbose)
|
subroutine is_a_good_candidate(threshold,is_ok,e_pt2,verbose,exit_loop,is_ok_perturbative)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
double precision, intent(in) :: threshold
|
double precision, intent(in) :: threshold
|
||||||
logical, intent(out) :: is_ok
|
double precision, intent(out):: e_pt2
|
||||||
|
logical, intent(out) :: is_ok,exit_loop,is_ok_perturbative
|
||||||
logical, intent(in) :: verbose
|
logical, intent(in) :: verbose
|
||||||
|
|
||||||
integer :: l,k,m
|
integer :: l,k,m
|
||||||
double precision,allocatable :: dressed_H_matrix(:,:)
|
double precision,allocatable :: dressed_H_matrix(:,:)
|
||||||
double precision,allocatable :: psi_coef_diagonalized_tmp(:,:)
|
double precision, allocatable :: psi_coef_diagonalized_tmp(:,:)
|
||||||
integer(bit_kind), allocatable :: psi_det_generators_input(:,:,:)
|
integer(bit_kind), allocatable :: psi_det_generators_input(:,:,:)
|
||||||
|
double precision :: hij
|
||||||
|
|
||||||
allocate(psi_det_generators_input(N_int,2,N_det_generators),dressed_H_matrix(N_det_generators,N_det_generators))
|
allocate(psi_det_generators_input(N_int,2,N_det_generators),dressed_H_matrix(N_det_generators,N_det_generators),psi_coef_diagonalized_tmp(N_det_generators,N_states))
|
||||||
allocate(psi_coef_diagonalized_tmp(N_det_generators,N_states))
|
|
||||||
dressed_H_matrix = 0.d0
|
dressed_H_matrix = 0.d0
|
||||||
do k = 1, N_det_generators
|
do k = 1, N_det_generators
|
||||||
do l = 1, N_int
|
do l = 1, N_int
|
||||||
@ -111,9 +95,20 @@ subroutine is_a_good_candidate(threshold,is_ok,verbose)
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!call H_apply_dressed_pert(dressed_H_matrix,N_det_generators,psi_det_generators_input)
|
!call H_apply_dressed_pert(dressed_H_matrix,N_det_generators,psi_det_generators_input)
|
||||||
call dress_H_matrix_from_psi_det_input(psi_det_generators_input,N_det_generators,is_ok,psi_coef_diagonalized_tmp, dressed_H_matrix,threshold,verbose)
|
call dress_H_matrix_from_psi_det_input(psi_det_generators_input,N_det_generators,is_ok,psi_coef_diagonalized_tmp, dressed_H_matrix,threshold,verbose,exit_loop,is_ok_perturbative)
|
||||||
if(do_it_perturbative)then
|
!do m = 1, N_states
|
||||||
if(is_ok)then
|
! do k = 1, N_det_generators
|
||||||
|
! do l = 1, N_int
|
||||||
|
! psi_selectors(l,1,k) = psi_det_generators_input(l,1,k)
|
||||||
|
! psi_selectors(l,2,k) = psi_det_generators_input(l,2,k)
|
||||||
|
! enddo
|
||||||
|
! psi_selectors_coef(k,m) = psi_coef_diagonalized_tmp(k,m)
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
!soft_touch psi_selectors psi_selectors_coef
|
||||||
|
!if(do_it_perturbative)then
|
||||||
|
print*, 'is_ok_perturbative',is_ok_perturbative
|
||||||
|
if(is_ok.or.is_ok_perturbative)then
|
||||||
N_det = N_det_generators
|
N_det = N_det_generators
|
||||||
do m = 1, N_states
|
do m = 1, N_states
|
||||||
do k = 1, N_det_generators
|
do k = 1, N_det_generators
|
||||||
@ -122,11 +117,19 @@ subroutine is_a_good_candidate(threshold,is_ok,verbose)
|
|||||||
psi_det(l,2,k) = psi_det_generators_input(l,2,k)
|
psi_det(l,2,k) = psi_det_generators_input(l,2,k)
|
||||||
enddo
|
enddo
|
||||||
psi_coef(k,m) = psi_coef_diagonalized_tmp(k,m)
|
psi_coef(k,m) = psi_coef_diagonalized_tmp(k,m)
|
||||||
|
print*, 'psi_coef(k,m)',psi_coef(k,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
soft_touch psi_det psi_coef N_det
|
||||||
|
e_pt2 = 0.d0
|
||||||
|
do m =1, N_det_generators
|
||||||
|
do l = 1, N_det_generators
|
||||||
|
call i_h_j(psi_det_generators_input(1,1,m),psi_det_generators_input(1,1,l),N_int,hij) ! Fill the zeroth order H matrix
|
||||||
|
e_pt2 += (dressed_H_matrix(m,l) - hij)* psi_coef_diagonalized_tmp(m,1)* psi_coef_diagonalized_tmp(l,1)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
touch psi_coef psi_det N_det
|
|
||||||
endif
|
|
||||||
endif
|
endif
|
||||||
|
!endif
|
||||||
|
|
||||||
deallocate(psi_det_generators_input,dressed_H_matrix,psi_coef_diagonalized_tmp)
|
deallocate(psi_det_generators_input,dressed_H_matrix,psi_coef_diagonalized_tmp)
|
||||||
|
|
||||||
@ -135,14 +138,14 @@ subroutine is_a_good_candidate(threshold,is_ok,verbose)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine dress_H_matrix_from_psi_det_input(psi_det_generators_input,Ndet_generators,is_ok,psi_coef_diagonalized_tmp, dressed_H_matrix,threshold,verbose)
|
subroutine dress_H_matrix_from_psi_det_input(psi_det_generators_input,Ndet_generators,is_ok,psi_coef_diagonalized_tmp, dressed_H_matrix,threshold,verbose,exit_loop,is_ok_perturbative)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators)
|
integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators)
|
||||||
integer, intent(in) :: Ndet_generators
|
integer, intent(in) :: Ndet_generators
|
||||||
double precision, intent(in) :: threshold
|
double precision, intent(in) :: threshold
|
||||||
logical, intent(in) :: verbose
|
logical, intent(in) :: verbose
|
||||||
logical, intent(out) :: is_ok
|
logical, intent(out) :: is_ok,exit_loop,is_ok_perturbative
|
||||||
double precision, intent(out) :: psi_coef_diagonalized_tmp(Ndet_generators,N_states)
|
double precision, intent(out) :: psi_coef_diagonalized_tmp(Ndet_generators,N_states)
|
||||||
double precision, intent(inout) :: dressed_H_matrix(Ndet_generators, Ndet_generators)
|
double precision, intent(inout) :: dressed_H_matrix(Ndet_generators, Ndet_generators)
|
||||||
|
|
||||||
@ -151,6 +154,7 @@ subroutine dress_H_matrix_from_psi_det_input(psi_det_generators_input,Ndet_gener
|
|||||||
double precision :: eigvalues(Ndet_generators), eigvectors(Ndet_generators,Ndet_generators),hij
|
double precision :: eigvalues(Ndet_generators), eigvectors(Ndet_generators,Ndet_generators),hij
|
||||||
double precision :: psi_coef_ref(Ndet_generators,N_states),diag_h_mat_average,diag_h_mat_no_ref_average
|
double precision :: psi_coef_ref(Ndet_generators,N_states),diag_h_mat_average,diag_h_mat_no_ref_average
|
||||||
logical :: is_a_ref_det(Ndet_generators)
|
logical :: is_a_ref_det(Ndet_generators)
|
||||||
|
exit_loop = .False.
|
||||||
|
|
||||||
is_a_ref_det = .False.
|
is_a_ref_det = .False.
|
||||||
do i = 1, N_det_generators
|
do i = 1, N_det_generators
|
||||||
@ -191,6 +195,7 @@ subroutine dress_H_matrix_from_psi_det_input(psi_det_generators_input,Ndet_gener
|
|||||||
if(number_of_holes(psi_det_generators_input(1,1,i)).eq.0 .and. number_of_particles(psi_det_generators_input(1,1,i)).eq.1)then
|
if(number_of_holes(psi_det_generators_input(1,1,i)).eq.0 .and. number_of_particles(psi_det_generators_input(1,1,i)).eq.1)then
|
||||||
if(diag_h_mat_average - dressed_H_matrix(index_ref_generators_restart,index_ref_generators_restart) .gt.2.d0)then
|
if(diag_h_mat_average - dressed_H_matrix(index_ref_generators_restart,index_ref_generators_restart) .gt.2.d0)then
|
||||||
is_ok = .False.
|
is_ok = .False.
|
||||||
|
exit_loop = .True.
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
@ -278,9 +283,11 @@ subroutine dress_H_matrix_from_psi_det_input(psi_det_generators_input,Ndet_gener
|
|||||||
do k = 1, N_states
|
do k = 1, N_states
|
||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
do j =1, Ndet_generators
|
do j =1, Ndet_generators
|
||||||
|
print*,'',eigvectors(j,i) , psi_coef_ref(j,k)
|
||||||
accu += eigvectors(j,i) * psi_coef_ref(j,k)
|
accu += eigvectors(j,i) * psi_coef_ref(j,k)
|
||||||
enddo
|
enddo
|
||||||
if(dabs(accu).ge.0.8d0)then
|
print*,'accu = ',accu
|
||||||
|
if(dabs(accu).ge.0.72d0)then
|
||||||
i_good_state(0) +=1
|
i_good_state(0) +=1
|
||||||
i_good_state(i_good_state(0)) = i
|
i_good_state(i_good_state(0)) = i
|
||||||
endif
|
endif
|
||||||
@ -321,10 +328,124 @@ subroutine dress_H_matrix_from_psi_det_input(psi_det_generators_input,Ndet_gener
|
|||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
if(.not.is_ok)then
|
||||||
|
is_ok_perturbative = .True.
|
||||||
|
do i = 1, Ndet_generators
|
||||||
|
if(is_a_ref_det(i))cycle
|
||||||
|
do k = 1, N_states
|
||||||
|
print*, psi_coef_diagonalized_tmp(i,k),threshold_perturbative
|
||||||
|
if(dabs(psi_coef_diagonalized_tmp(i,k)) .gt.threshold_perturbative)then
|
||||||
|
is_ok_perturbative = .False.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if(.not.is_ok_perturbative)then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
if(verbose)then
|
if(verbose)then
|
||||||
print*,'is_ok = ',is_ok
|
print*,'is_ok = ',is_ok
|
||||||
|
print*,'is_ok_perturbative = ',is_ok_perturbative
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
subroutine fill_H_apply_buffer_no_selection_first_order_coef(n_selected,det_buffer,Nint,iproc)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Fill the H_apply buffer with determiants for CISD
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: n_selected, Nint, iproc
|
||||||
|
integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected)
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: new_size
|
||||||
|
PROVIDE H_apply_buffer_allocated
|
||||||
|
call omp_set_lock(H_apply_buffer_lock(1,iproc))
|
||||||
|
new_size = H_apply_buffer(iproc)%N_det + n_selected
|
||||||
|
if (new_size > H_apply_buffer(iproc)%sze) then
|
||||||
|
call resize_h_apply_buffer(max(2*H_apply_buffer(iproc)%sze,new_size),iproc)
|
||||||
|
endif
|
||||||
|
do i=1,H_apply_buffer(iproc)%N_det
|
||||||
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num)
|
||||||
|
enddo
|
||||||
|
do i=1,n_selected
|
||||||
|
do j=1,N_int
|
||||||
|
H_apply_buffer(iproc)%det(j,1,i+H_apply_buffer(iproc)%N_det) = det_buffer(j,1,i)
|
||||||
|
H_apply_buffer(iproc)%det(j,2,i+H_apply_buffer(iproc)%N_det) = det_buffer(j,2,i)
|
||||||
|
enddo
|
||||||
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i+H_apply_buffer(iproc)%N_det)) )== elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i+H_apply_buffer(iproc)%N_det))) == elec_beta_num)
|
||||||
|
enddo
|
||||||
|
double precision :: i_H_psi_array(N_states),h,diag_H_mat_elem_fock,delta_e
|
||||||
|
do i=1,N_selected
|
||||||
|
call i_H_psi(det_buffer(1,1,i),psi_selectors,psi_selectors_coef,N_int,N_det_selectors,psi_selectors_size,N_states,i_H_psi_array)
|
||||||
|
call i_H_j(det_buffer(1,1,i),det_buffer(1,1,i),N_int,h)
|
||||||
|
do j=1,N_states
|
||||||
|
delta_e = -1.d0 /(h - psi_energy(j))
|
||||||
|
H_apply_buffer(iproc)%coef(i+H_apply_buffer(iproc)%N_det,j) = i_H_psi_array(j) * delta_e
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
H_apply_buffer(iproc)%N_det = new_size
|
||||||
|
do i=1,H_apply_buffer(iproc)%N_det
|
||||||
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num)
|
||||||
|
enddo
|
||||||
|
call omp_unset_lock(H_apply_buffer_lock(1,iproc))
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine make_s2_eigenfunction_first_order
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: smax, s
|
||||||
|
integer(bit_kind), allocatable :: d(:,:,:), det_buffer(:,:,:)
|
||||||
|
integer :: N_det_new
|
||||||
|
integer, parameter :: bufsze = 1000
|
||||||
|
logical, external :: is_in_wavefunction
|
||||||
|
|
||||||
|
allocate (d(N_int,2,1), det_buffer(N_int,2,bufsze) )
|
||||||
|
smax = 1
|
||||||
|
N_det_new = 0
|
||||||
|
|
||||||
|
do i=1,N_occ_pattern
|
||||||
|
call occ_pattern_to_dets_size(psi_occ_pattern(1,1,i),s,elec_alpha_num,N_int)
|
||||||
|
s += 1
|
||||||
|
if (s > smax) then
|
||||||
|
deallocate(d)
|
||||||
|
allocate ( d(N_int,2,s) )
|
||||||
|
smax = s
|
||||||
|
endif
|
||||||
|
call occ_pattern_to_dets(psi_occ_pattern(1,1,i),d,s,elec_alpha_num,N_int)
|
||||||
|
do j=1,s
|
||||||
|
if (.not. is_in_wavefunction(d(1,1,j), N_int) ) then
|
||||||
|
N_det_new += 1
|
||||||
|
do k=1,N_int
|
||||||
|
det_buffer(k,1,N_det_new) = d(k,1,j)
|
||||||
|
det_buffer(k,2,N_det_new) = d(k,2,j)
|
||||||
|
enddo
|
||||||
|
if (N_det_new == bufsze) then
|
||||||
|
call fill_H_apply_buffer_no_selection(bufsze,det_buffer,N_int,0)
|
||||||
|
N_det_new = 0
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (N_det_new > 0) then
|
||||||
|
call fill_H_apply_buffer_no_selection_first_order_coef(N_det_new,det_buffer,N_int,0)
|
||||||
|
call copy_H_apply_buffer_to_wf
|
||||||
|
SOFT_TOUCH N_det psi_coef psi_det
|
||||||
|
endif
|
||||||
|
|
||||||
|
deallocate(d,det_buffer)
|
||||||
|
|
||||||
|
call write_int(output_determinants,N_det_new, 'Added deteminants for S^2')
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
@ -1,8 +1,13 @@
|
|||||||
program foboscf
|
program foboscf
|
||||||
implicit none
|
implicit none
|
||||||
call run_prepare
|
!if(disk_access_ao_integrals == "None" .or. disk_access_ao_integrals == "Read" )then
|
||||||
|
! disk_access_ao_integrals = "Write"
|
||||||
|
! touch disk_access_ao_integrals
|
||||||
|
!endif
|
||||||
|
!print*, 'disk_access_ao_integrals',disk_access_ao_integrals
|
||||||
no_oa_or_av_opt = .True.
|
no_oa_or_av_opt = .True.
|
||||||
touch no_oa_or_av_opt
|
touch no_oa_or_av_opt
|
||||||
|
call run_prepare
|
||||||
call routine_fobo_scf
|
call routine_fobo_scf
|
||||||
call save_mos
|
call save_mos
|
||||||
|
|
||||||
@ -10,8 +15,8 @@ end
|
|||||||
|
|
||||||
subroutine run_prepare
|
subroutine run_prepare
|
||||||
implicit none
|
implicit none
|
||||||
no_oa_or_av_opt = .False.
|
! no_oa_or_av_opt = .False.
|
||||||
touch no_oa_or_av_opt
|
! touch no_oa_or_av_opt
|
||||||
call damping_SCF
|
call damping_SCF
|
||||||
call diag_inactive_virt_and_update_mos
|
call diag_inactive_virt_and_update_mos
|
||||||
end
|
end
|
||||||
@ -27,6 +32,7 @@ subroutine routine_fobo_scf
|
|||||||
print*,'*******************************************************************************'
|
print*,'*******************************************************************************'
|
||||||
print*,'*******************************************************************************'
|
print*,'*******************************************************************************'
|
||||||
print*,'FOBO-SCF Iteration ',i
|
print*,'FOBO-SCF Iteration ',i
|
||||||
|
print*, 'ao_bielec_integrals_in_map = ',ao_bielec_integrals_in_map
|
||||||
print*,'*******************************************************************************'
|
print*,'*******************************************************************************'
|
||||||
print*,'*******************************************************************************'
|
print*,'*******************************************************************************'
|
||||||
if(speed_up_convergence_foboscf)then
|
if(speed_up_convergence_foboscf)then
|
||||||
@ -46,7 +52,7 @@ subroutine routine_fobo_scf
|
|||||||
soft_touch threshold_lmct threshold_mlct
|
soft_touch threshold_lmct threshold_mlct
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
call FOBOCI_lmct_mlct_old_thr
|
call FOBOCI_lmct_mlct_old_thr(i)
|
||||||
call save_osoci_natural_mos
|
call save_osoci_natural_mos
|
||||||
call damping_SCF
|
call damping_SCF
|
||||||
call diag_inactive_virt_and_update_mos
|
call diag_inactive_virt_and_update_mos
|
||||||
|
@ -1,7 +1,8 @@
|
|||||||
|
|
||||||
subroutine FOBOCI_lmct_mlct_old_thr
|
subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
|
integer, intent(in) :: iter
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
integer(bit_kind),allocatable :: unpaired_bitmask(:,:)
|
integer(bit_kind),allocatable :: unpaired_bitmask(:,:)
|
||||||
integer, allocatable :: occ(:,:)
|
integer, allocatable :: occ(:,:)
|
||||||
@ -10,7 +11,7 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
logical :: test_sym
|
logical :: test_sym
|
||||||
double precision :: thr,hij
|
double precision :: thr,hij
|
||||||
double precision, allocatable :: dressing_matrix(:,:)
|
double precision, allocatable :: dressing_matrix(:,:)
|
||||||
logical :: verbose,is_ok
|
logical :: verbose,is_ok,is_ok_perturbative
|
||||||
verbose = .True.
|
verbose = .True.
|
||||||
thr = 1.d-12
|
thr = 1.d-12
|
||||||
allocate(unpaired_bitmask(N_int,2))
|
allocate(unpaired_bitmask(N_int,2))
|
||||||
@ -38,6 +39,7 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
integer(bit_kind) , allocatable :: psi_singles(:,:,:)
|
integer(bit_kind) , allocatable :: psi_singles(:,:,:)
|
||||||
logical :: lmct
|
logical :: lmct
|
||||||
double precision, allocatable :: psi_singles_coef(:,:)
|
double precision, allocatable :: psi_singles_coef(:,:)
|
||||||
|
logical :: exit_loop
|
||||||
allocate( zero_bitmask(N_int,2) )
|
allocate( zero_bitmask(N_int,2) )
|
||||||
do i = 1, n_inact_orb
|
do i = 1, n_inact_orb
|
||||||
lmct = .True.
|
lmct = .True.
|
||||||
@ -45,23 +47,22 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
i_hole_osoci = list_inact(i)
|
i_hole_osoci = list_inact(i)
|
||||||
print*,'--------------------------'
|
print*,'--------------------------'
|
||||||
! First set the current generators to the one of restart
|
! First set the current generators to the one of restart
|
||||||
call set_generators_to_generators_restart
|
|
||||||
call set_psi_det_to_generators
|
|
||||||
call check_symetry(i_hole_osoci,thr,test_sym)
|
call check_symetry(i_hole_osoci,thr,test_sym)
|
||||||
if(.not.test_sym)cycle
|
if(.not.test_sym)cycle
|
||||||
|
call set_generators_to_generators_restart
|
||||||
|
call set_psi_det_to_generators
|
||||||
print*,'i_hole_osoci = ',i_hole_osoci
|
print*,'i_hole_osoci = ',i_hole_osoci
|
||||||
call create_restart_and_1h(i_hole_osoci)
|
call create_restart_and_1h(i_hole_osoci)
|
||||||
call set_generators_to_psi_det
|
call set_generators_to_psi_det
|
||||||
print*,'Passed set generators'
|
print*,'Passed set generators'
|
||||||
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
call is_a_good_candidate(threshold_lmct,is_ok,verbose)
|
double precision :: e_pt2
|
||||||
|
call is_a_good_candidate(threshold_lmct,is_ok,e_pt2,verbose,exit_loop,is_ok_perturbative)
|
||||||
print*,'is_ok = ',is_ok
|
print*,'is_ok = ',is_ok
|
||||||
if(.not.is_ok)cycle
|
if(is_ok)then
|
||||||
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
||||||
dressing_matrix = 0.d0
|
dressing_matrix = 0.d0
|
||||||
if(.not.do_it_perturbative)then
|
|
||||||
|
|
||||||
do k = 1, N_det_generators
|
do k = 1, N_det_generators
|
||||||
do l = 1, N_det_generators
|
do l = 1, N_det_generators
|
||||||
call i_h_j(psi_det_generators(1,1,k),psi_det_generators(1,1,l),N_int,hkl)
|
call i_h_j(psi_det_generators(1,1,k),psi_det_generators(1,1,l),N_int,hkl)
|
||||||
@ -80,52 +81,11 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
! Do all the single excitations on top of the CAS and 1h determinants
|
! Do all the single excitations on top of the CAS and 1h determinants
|
||||||
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
call all_single
|
call all_single(e_pt2)
|
||||||
! if(dressing_2h2p)then
|
call make_s2_eigenfunction_first_order
|
||||||
! call diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_hole_osoci,lmct)
|
threshold_davidson = 1.d-6
|
||||||
! endif
|
soft_touch threshold_davidson davidson_criterion
|
||||||
|
call diagonalize_ci
|
||||||
! ! Change the mask of the holes and particles to perform all the
|
|
||||||
! ! double excitations that starts from the active space in order
|
|
||||||
! ! to introduce the Coulomb hole in the active space
|
|
||||||
! ! These are the 1h2p excitations that have the i_hole_osoci hole in common
|
|
||||||
! ! and the 2p if there is more than one electron in the active space
|
|
||||||
! do k = 1, N_int
|
|
||||||
! zero_bitmask(k,1) = 0_bit_kind
|
|
||||||
! zero_bitmask(k,2) = 0_bit_kind
|
|
||||||
! enddo
|
|
||||||
! ! hole is possible only in the orbital i_hole_osoci
|
|
||||||
! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,1),N_int)
|
|
||||||
! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,2),N_int)
|
|
||||||
! ! and in the active space
|
|
||||||
! do k = 1, n_act_orb
|
|
||||||
! call set_bit_to_integer(list_act(k),zero_bitmask(1,1),N_int)
|
|
||||||
! call set_bit_to_integer(list_act(k),zero_bitmask(1,2),N_int)
|
|
||||||
! enddo
|
|
||||||
! call set_bitmask_hole_as_input(zero_bitmask)
|
|
||||||
|
|
||||||
! call set_bitmask_particl_as_input(reunion_of_bitmask)
|
|
||||||
|
|
||||||
! call all_1h2p
|
|
||||||
! call diagonalize_CI_SC2
|
|
||||||
! call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators)
|
|
||||||
|
|
||||||
! ! Change the mask of the holes and particles to perform all the
|
|
||||||
! ! double excitations that from the orbital i_hole_osoci
|
|
||||||
! do k = 1, N_int
|
|
||||||
! zero_bitmask(k,1) = 0_bit_kind
|
|
||||||
! zero_bitmask(k,2) = 0_bit_kind
|
|
||||||
! enddo
|
|
||||||
! ! hole is possible only in the orbital i_hole_osoci
|
|
||||||
! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,1),N_int)
|
|
||||||
! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,2),N_int)
|
|
||||||
! call set_bitmask_hole_as_input(zero_bitmask)
|
|
||||||
|
|
||||||
! call set_bitmask_particl_as_input(reunion_of_bitmask)
|
|
||||||
|
|
||||||
! call set_psi_det_to_generators
|
|
||||||
! call all_2h2p
|
|
||||||
! call diagonalize_CI_SC2
|
|
||||||
double precision :: hkl
|
double precision :: hkl
|
||||||
call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators)
|
call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators)
|
||||||
hkl = dressing_matrix(1,1)
|
hkl = dressing_matrix(1,1)
|
||||||
@ -136,7 +96,10 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
do k = 1, N_det_generators
|
do k = 1, N_det_generators
|
||||||
write(*,'(100(F12.5,X))')dressing_matrix(k,:)
|
write(*,'(100(F12.5,X))')dressing_matrix(k,:)
|
||||||
enddo
|
enddo
|
||||||
! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
|
deallocate(dressing_matrix)
|
||||||
|
else
|
||||||
|
if(.not.do_it_perturbative)cycle
|
||||||
|
if(.not. is_ok_perturbative)cycle
|
||||||
endif
|
endif
|
||||||
call set_intermediate_normalization_lmct_old(norm_tmp,i_hole_osoci)
|
call set_intermediate_normalization_lmct_old(norm_tmp,i_hole_osoci)
|
||||||
|
|
||||||
@ -145,7 +108,6 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
norm_total(k) += norm_tmp(k)
|
norm_total(k) += norm_tmp(k)
|
||||||
enddo
|
enddo
|
||||||
call update_density_matrix_osoci
|
call update_density_matrix_osoci
|
||||||
deallocate(dressing_matrix)
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if(.True.)then
|
if(.True.)then
|
||||||
@ -159,10 +121,10 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
|
|
||||||
print*,'--------------------------'
|
print*,'--------------------------'
|
||||||
! First set the current generators to the one of restart
|
! First set the current generators to the one of restart
|
||||||
call set_generators_to_generators_restart
|
|
||||||
call set_psi_det_to_generators
|
|
||||||
call check_symetry(i_particl_osoci,thr,test_sym)
|
call check_symetry(i_particl_osoci,thr,test_sym)
|
||||||
if(.not.test_sym)cycle
|
if(.not.test_sym)cycle
|
||||||
|
call set_generators_to_generators_restart
|
||||||
|
call set_psi_det_to_generators
|
||||||
print*,'i_particl_osoci= ',i_particl_osoci
|
print*,'i_particl_osoci= ',i_particl_osoci
|
||||||
! Initialize the bitmask to the restart ones
|
! Initialize the bitmask to the restart ones
|
||||||
call initialize_bitmask_to_restart_ones
|
call initialize_bitmask_to_restart_ones
|
||||||
@ -178,11 +140,10 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
!! ! so all the mono excitation on the new generators
|
!! ! so all the mono excitation on the new generators
|
||||||
call is_a_good_candidate(threshold_mlct,is_ok,verbose)
|
call is_a_good_candidate(threshold_mlct,is_ok,e_pt2,verbose,exit_loop,is_ok_perturbative)
|
||||||
print*,'is_ok = ',is_ok
|
print*,'is_ok = ',is_ok
|
||||||
if(.not.is_ok)cycle
|
if(is_ok)then
|
||||||
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
||||||
if(.not.do_it_perturbative)then
|
|
||||||
dressing_matrix = 0.d0
|
dressing_matrix = 0.d0
|
||||||
do k = 1, N_det_generators
|
do k = 1, N_det_generators
|
||||||
do l = 1, N_det_generators
|
do l = 1, N_det_generators
|
||||||
@ -190,12 +151,22 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
dressing_matrix(k,l) = hkl
|
dressing_matrix(k,l) = hkl
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
! call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix)
|
call all_single(e_pt2)
|
||||||
! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
|
call make_s2_eigenfunction_first_order
|
||||||
call all_single
|
threshold_davidson = 1.d-6
|
||||||
! if(dressing_2h2p)then
|
soft_touch threshold_davidson davidson_criterion
|
||||||
! call diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_particl_osoci,lmct)
|
|
||||||
! endif
|
call diagonalize_ci
|
||||||
|
deallocate(dressing_matrix)
|
||||||
|
else
|
||||||
|
if(exit_loop)then
|
||||||
|
call set_generators_to_generators_restart
|
||||||
|
call set_psi_det_to_generators
|
||||||
|
exit
|
||||||
|
else
|
||||||
|
if(.not.do_it_perturbative)cycle
|
||||||
|
if(.not. is_ok_perturbative)cycle
|
||||||
|
endif
|
||||||
endif
|
endif
|
||||||
call set_intermediate_normalization_mlct_old(norm_tmp,i_particl_osoci)
|
call set_intermediate_normalization_mlct_old(norm_tmp,i_particl_osoci)
|
||||||
do k = 1, N_states
|
do k = 1, N_states
|
||||||
@ -203,7 +174,6 @@ subroutine FOBOCI_lmct_mlct_old_thr
|
|||||||
norm_total(k) += norm_tmp(k)
|
norm_total(k) += norm_tmp(k)
|
||||||
enddo
|
enddo
|
||||||
call update_density_matrix_osoci
|
call update_density_matrix_osoci
|
||||||
deallocate(dressing_matrix)
|
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -230,7 +200,7 @@ subroutine FOBOCI_mlct_old
|
|||||||
double precision :: norm_tmp,norm_total
|
double precision :: norm_tmp,norm_total
|
||||||
logical :: test_sym
|
logical :: test_sym
|
||||||
double precision :: thr
|
double precision :: thr
|
||||||
logical :: verbose,is_ok
|
logical :: verbose,is_ok,exit_loop
|
||||||
verbose = .False.
|
verbose = .False.
|
||||||
thr = 1.d-12
|
thr = 1.d-12
|
||||||
allocate(unpaired_bitmask(N_int,2))
|
allocate(unpaired_bitmask(N_int,2))
|
||||||
@ -270,7 +240,7 @@ subroutine FOBOCI_mlct_old
|
|||||||
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
! ! so all the mono excitation on the new generators
|
! ! so all the mono excitation on the new generators
|
||||||
call is_a_good_candidate(threshold_mlct,is_ok,verbose)
|
call is_a_good_candidate(threshold_mlct,is_ok,verbose,exit_loop)
|
||||||
print*,'is_ok = ',is_ok
|
print*,'is_ok = ',is_ok
|
||||||
is_ok =.True.
|
is_ok =.True.
|
||||||
if(.not.is_ok)cycle
|
if(.not.is_ok)cycle
|
||||||
@ -304,7 +274,7 @@ subroutine FOBOCI_lmct_old
|
|||||||
double precision :: norm_tmp,norm_total
|
double precision :: norm_tmp,norm_total
|
||||||
logical :: test_sym
|
logical :: test_sym
|
||||||
double precision :: thr
|
double precision :: thr
|
||||||
logical :: verbose,is_ok
|
logical :: verbose,is_ok,exit_loop
|
||||||
verbose = .False.
|
verbose = .False.
|
||||||
thr = 1.d-12
|
thr = 1.d-12
|
||||||
allocate(unpaired_bitmask(N_int,2))
|
allocate(unpaired_bitmask(N_int,2))
|
||||||
@ -342,7 +312,7 @@ subroutine FOBOCI_lmct_old
|
|||||||
call set_generators_to_psi_det
|
call set_generators_to_psi_det
|
||||||
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
call is_a_good_candidate(threshold_lmct,is_ok,verbose)
|
call is_a_good_candidate(threshold_lmct,is_ok,verbose,exit_loop)
|
||||||
print*,'is_ok = ',is_ok
|
print*,'is_ok = ',is_ok
|
||||||
if(.not.is_ok)cycle
|
if(.not.is_ok)cycle
|
||||||
! ! so all the mono excitation on the new generators
|
! ! so all the mono excitation on the new generators
|
||||||
@ -365,3 +335,303 @@ subroutine FOBOCI_lmct_old
|
|||||||
enddo
|
enddo
|
||||||
print*,'accu = ',accu
|
print*,'accu = ',accu
|
||||||
end
|
end
|
||||||
|
|
||||||
|
subroutine FOBOCI_lmct_mlct_old_thr_restart(iter)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: iter
|
||||||
|
integer :: i,j,k,l
|
||||||
|
integer(bit_kind),allocatable :: unpaired_bitmask(:,:)
|
||||||
|
integer, allocatable :: occ(:,:)
|
||||||
|
integer :: n_occ_alpha, n_occ_beta
|
||||||
|
double precision :: norm_tmp(N_states),norm_total(N_states)
|
||||||
|
logical :: test_sym
|
||||||
|
double precision :: thr,hij
|
||||||
|
double precision, allocatable :: dressing_matrix(:,:)
|
||||||
|
logical :: verbose,is_ok,is_ok_perturbative
|
||||||
|
verbose = .True.
|
||||||
|
thr = 1.d-12
|
||||||
|
allocate(unpaired_bitmask(N_int,2))
|
||||||
|
allocate (occ(N_int*bit_kind_size,2))
|
||||||
|
do i = 1, N_int
|
||||||
|
unpaired_bitmask(i,1) = unpaired_alpha_electrons(i)
|
||||||
|
unpaired_bitmask(i,2) = unpaired_alpha_electrons(i)
|
||||||
|
enddo
|
||||||
|
norm_total = 0.d0
|
||||||
|
call initialize_density_matrix_osoci
|
||||||
|
call bitstring_to_list(inact_bitmask(1,1), occ(1,1), n_occ_beta, N_int)
|
||||||
|
print*,''
|
||||||
|
print*,''
|
||||||
|
print*,'mulliken spin population analysis'
|
||||||
|
accu =0.d0
|
||||||
|
do i = 1, nucl_num
|
||||||
|
accu += mulliken_spin_densities(i)
|
||||||
|
print*,i,nucl_charge(i),mulliken_spin_densities(i)
|
||||||
|
enddo
|
||||||
|
print*,''
|
||||||
|
print*,''
|
||||||
|
print*,'DOING FIRST LMCT !!'
|
||||||
|
print*,'Threshold_lmct = ',threshold_lmct
|
||||||
|
integer(bit_kind) , allocatable :: zero_bitmask(:,:)
|
||||||
|
integer(bit_kind) , allocatable :: psi_singles(:,:,:)
|
||||||
|
logical :: lmct
|
||||||
|
double precision, allocatable :: psi_singles_coef(:,:)
|
||||||
|
logical :: exit_loop
|
||||||
|
allocate( zero_bitmask(N_int,2) )
|
||||||
|
if(iter.ne.1)then
|
||||||
|
do i = 1, n_inact_orb
|
||||||
|
lmct = .True.
|
||||||
|
integer :: i_hole_osoci
|
||||||
|
i_hole_osoci = list_inact(i)
|
||||||
|
print*,'--------------------------'
|
||||||
|
! First set the current generators to the one of restart
|
||||||
|
call check_symetry(i_hole_osoci,thr,test_sym)
|
||||||
|
if(.not.test_sym)cycle
|
||||||
|
call set_generators_to_generators_restart
|
||||||
|
call set_psi_det_to_generators
|
||||||
|
print*,'i_hole_osoci = ',i_hole_osoci
|
||||||
|
call create_restart_and_1h(i_hole_osoci)
|
||||||
|
call set_generators_to_psi_det
|
||||||
|
print*,'Passed set generators'
|
||||||
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
|
double precision :: e_pt2
|
||||||
|
call is_a_good_candidate(threshold_lmct,is_ok,e_pt2,verbose,exit_loop,is_ok_perturbative)
|
||||||
|
print*,'is_ok = ',is_ok
|
||||||
|
if(is_ok)then
|
||||||
|
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
||||||
|
dressing_matrix = 0.d0
|
||||||
|
do k = 1, N_det_generators
|
||||||
|
do l = 1, N_det_generators
|
||||||
|
call i_h_j(psi_det_generators(1,1,k),psi_det_generators(1,1,l),N_int,hkl)
|
||||||
|
dressing_matrix(k,l) = hkl
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
hkl = dressing_matrix(1,1)
|
||||||
|
do k = 1, N_det_generators
|
||||||
|
dressing_matrix(k,k) = dressing_matrix(k,k) - hkl
|
||||||
|
enddo
|
||||||
|
print*,'Naked matrix'
|
||||||
|
do k = 1, N_det_generators
|
||||||
|
write(*,'(100(F12.5,X))')dressing_matrix(k,:)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Do all the single excitations on top of the CAS and 1h determinants
|
||||||
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
|
call all_single(e_pt2)
|
||||||
|
call make_s2_eigenfunction_first_order
|
||||||
|
threshold_davidson = 1.d-6
|
||||||
|
soft_touch threshold_davidson davidson_criterion
|
||||||
|
call diagonalize_ci
|
||||||
|
double precision :: hkl
|
||||||
|
call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators)
|
||||||
|
hkl = dressing_matrix(1,1)
|
||||||
|
do k = 1, N_det_generators
|
||||||
|
dressing_matrix(k,k) = dressing_matrix(k,k) - hkl
|
||||||
|
enddo
|
||||||
|
print*,'Dressed matrix'
|
||||||
|
do k = 1, N_det_generators
|
||||||
|
write(*,'(100(F12.5,X))')dressing_matrix(k,:)
|
||||||
|
enddo
|
||||||
|
deallocate(dressing_matrix)
|
||||||
|
else
|
||||||
|
if(.not.do_it_perturbative)cycle
|
||||||
|
if(.not. is_ok_perturbative)cycle
|
||||||
|
endif
|
||||||
|
call set_intermediate_normalization_lmct_old(norm_tmp,i_hole_osoci)
|
||||||
|
|
||||||
|
do k = 1, N_states
|
||||||
|
print*,'norm_tmp = ',norm_tmp(k)
|
||||||
|
norm_total(k) += norm_tmp(k)
|
||||||
|
enddo
|
||||||
|
call update_density_matrix_osoci
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
double precision :: array_dm(mo_tot_num)
|
||||||
|
call read_dm_from_lmct(array_dm)
|
||||||
|
call update_density_matrix_beta_osoci_read(array_dm)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(iter.ne.1)then
|
||||||
|
if(.True.)then
|
||||||
|
print*,''
|
||||||
|
print*,'DOING THEN THE MLCT !!'
|
||||||
|
print*,'Threshold_mlct = ',threshold_mlct
|
||||||
|
lmct = .False.
|
||||||
|
do i = 1, n_virt_orb
|
||||||
|
integer :: i_particl_osoci
|
||||||
|
i_particl_osoci = list_virt(i)
|
||||||
|
|
||||||
|
print*,'--------------------------'
|
||||||
|
! First set the current generators to the one of restart
|
||||||
|
call check_symetry(i_particl_osoci,thr,test_sym)
|
||||||
|
if(.not.test_sym)cycle
|
||||||
|
call set_generators_to_generators_restart
|
||||||
|
call set_psi_det_to_generators
|
||||||
|
print*,'i_particl_osoci= ',i_particl_osoci
|
||||||
|
! Initialize the bitmask to the restart ones
|
||||||
|
call initialize_bitmask_to_restart_ones
|
||||||
|
! Impose that only the hole i_hole_osoci can be done
|
||||||
|
call modify_bitmasks_for_particl(i_particl_osoci)
|
||||||
|
call print_generators_bitmasks_holes
|
||||||
|
! Impose that only the active part can be reached
|
||||||
|
call set_bitmask_hole_as_input(unpaired_bitmask)
|
||||||
|
!!! call all_single_h_core
|
||||||
|
call create_restart_and_1p(i_particl_osoci)
|
||||||
|
!!! ! Update the generators
|
||||||
|
call set_generators_to_psi_det
|
||||||
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
|
!!! ! so all the mono excitation on the new generators
|
||||||
|
call is_a_good_candidate(threshold_mlct,is_ok,e_pt2,verbose,exit_loop,is_ok_perturbative)
|
||||||
|
print*,'is_ok = ',is_ok
|
||||||
|
if(is_ok)then
|
||||||
|
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
||||||
|
dressing_matrix = 0.d0
|
||||||
|
do k = 1, N_det_generators
|
||||||
|
do l = 1, N_det_generators
|
||||||
|
call i_h_j(psi_det_generators(1,1,k),psi_det_generators(1,1,l),N_int,hkl)
|
||||||
|
dressing_matrix(k,l) = hkl
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call all_single(e_pt2)
|
||||||
|
call make_s2_eigenfunction_first_order
|
||||||
|
threshold_davidson = 1.d-6
|
||||||
|
soft_touch threshold_davidson davidson_criterion
|
||||||
|
|
||||||
|
call diagonalize_ci
|
||||||
|
deallocate(dressing_matrix)
|
||||||
|
else
|
||||||
|
if(exit_loop)then
|
||||||
|
call set_generators_to_generators_restart
|
||||||
|
call set_psi_det_to_generators
|
||||||
|
exit
|
||||||
|
else
|
||||||
|
if(.not.do_it_perturbative)cycle
|
||||||
|
if(.not. is_ok_perturbative)cycle
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
call set_intermediate_normalization_mlct_old(norm_tmp,i_particl_osoci)
|
||||||
|
do k = 1, N_states
|
||||||
|
print*,'norm_tmp = ',norm_tmp(k)
|
||||||
|
norm_total(k) += norm_tmp(k)
|
||||||
|
enddo
|
||||||
|
call update_density_matrix_osoci
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
integer :: norb
|
||||||
|
call read_dm_from_mlct(array_dm,norb)
|
||||||
|
call update_density_matrix_alpha_osoci_read(array_dm)
|
||||||
|
do i = norb+1, n_virt_orb
|
||||||
|
i_particl_osoci = list_virt(i)
|
||||||
|
|
||||||
|
print*,'--------------------------'
|
||||||
|
! First set the current generators to the one of restart
|
||||||
|
call check_symetry(i_particl_osoci,thr,test_sym)
|
||||||
|
if(.not.test_sym)cycle
|
||||||
|
call set_generators_to_generators_restart
|
||||||
|
call set_psi_det_to_generators
|
||||||
|
print*,'i_particl_osoci= ',i_particl_osoci
|
||||||
|
! Initialize the bitmask to the restart ones
|
||||||
|
call initialize_bitmask_to_restart_ones
|
||||||
|
! Impose that only the hole i_hole_osoci can be done
|
||||||
|
call modify_bitmasks_for_particl(i_particl_osoci)
|
||||||
|
call print_generators_bitmasks_holes
|
||||||
|
! Impose that only the active part can be reached
|
||||||
|
call set_bitmask_hole_as_input(unpaired_bitmask)
|
||||||
|
!!! call all_single_h_core
|
||||||
|
call create_restart_and_1p(i_particl_osoci)
|
||||||
|
!!! ! Update the generators
|
||||||
|
call set_generators_to_psi_det
|
||||||
|
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||||
|
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||||
|
!!! ! so all the mono excitation on the new generators
|
||||||
|
call is_a_good_candidate(threshold_mlct,is_ok,e_pt2,verbose,exit_loop,is_ok_perturbative)
|
||||||
|
print*,'is_ok = ',is_ok
|
||||||
|
if(is_ok)then
|
||||||
|
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
||||||
|
dressing_matrix = 0.d0
|
||||||
|
do k = 1, N_det_generators
|
||||||
|
do l = 1, N_det_generators
|
||||||
|
call i_h_j(psi_det_generators(1,1,k),psi_det_generators(1,1,l),N_int,hkl)
|
||||||
|
dressing_matrix(k,l) = hkl
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call all_single(e_pt2)
|
||||||
|
call make_s2_eigenfunction_first_order
|
||||||
|
threshold_davidson = 1.d-6
|
||||||
|
soft_touch threshold_davidson davidson_criterion
|
||||||
|
|
||||||
|
call diagonalize_ci
|
||||||
|
deallocate(dressing_matrix)
|
||||||
|
else
|
||||||
|
if(exit_loop)then
|
||||||
|
call set_generators_to_generators_restart
|
||||||
|
call set_psi_det_to_generators
|
||||||
|
exit
|
||||||
|
else
|
||||||
|
if(.not.do_it_perturbative)cycle
|
||||||
|
if(.not. is_ok_perturbative)cycle
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
call set_intermediate_normalization_mlct_old(norm_tmp,i_particl_osoci)
|
||||||
|
do k = 1, N_states
|
||||||
|
print*,'norm_tmp = ',norm_tmp(k)
|
||||||
|
norm_total(k) += norm_tmp(k)
|
||||||
|
enddo
|
||||||
|
call update_density_matrix_osoci
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,'norm_total = ',norm_total
|
||||||
|
norm_total = norm_generators_restart
|
||||||
|
norm_total = 1.d0/norm_total
|
||||||
|
! call rescale_density_matrix_osoci(norm_total)
|
||||||
|
double precision :: accu
|
||||||
|
accu = 0.d0
|
||||||
|
do i = 1, mo_tot_num
|
||||||
|
accu += one_body_dm_mo_alpha_osoci(i,i) + one_body_dm_mo_beta_osoci(i,i)
|
||||||
|
enddo
|
||||||
|
print*,'accu = ',accu
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine read_dm_from_lmct(array)
|
||||||
|
implicit none
|
||||||
|
integer :: i,iunit ,getUnitAndOpen
|
||||||
|
double precision :: stuff
|
||||||
|
double precision, intent(out) :: array(mo_tot_num)
|
||||||
|
character*(128) :: input
|
||||||
|
input=trim("fort.33")
|
||||||
|
iunit= getUnitAndOpen(input,'r')
|
||||||
|
print*, iunit
|
||||||
|
array = 0.d0
|
||||||
|
do i = 1, n_inact_orb
|
||||||
|
read(iunit,*) stuff
|
||||||
|
print*, list_inact(i),stuff
|
||||||
|
array(list_inact(i)) = stuff
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine read_dm_from_mlct(array,norb)
|
||||||
|
implicit none
|
||||||
|
integer :: i,iunit ,getUnitAndOpen
|
||||||
|
double precision :: stuff
|
||||||
|
double precision, intent(out) :: array(mo_tot_num)
|
||||||
|
character*(128) :: input
|
||||||
|
input=trim("fort.35")
|
||||||
|
iunit= getUnitAndOpen(input,'r')
|
||||||
|
integer,intent(out) :: norb
|
||||||
|
read(iunit,*)norb
|
||||||
|
print*, iunit
|
||||||
|
input=trim("fort.34")
|
||||||
|
iunit= getUnitAndOpen(input,'r')
|
||||||
|
array = 0.d0
|
||||||
|
print*, 'norb = ',norb
|
||||||
|
do i = 1, norb
|
||||||
|
read(iunit,*) stuff
|
||||||
|
print*, list_virt(i),stuff
|
||||||
|
array(list_virt(i)) = stuff
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
@ -9,6 +9,7 @@ BEGIN_PROVIDER [ integer, N_det_generators_restart ]
|
|||||||
integer :: i
|
integer :: i
|
||||||
integer, save :: ifirst = 0
|
integer, save :: ifirst = 0
|
||||||
double precision :: norm
|
double precision :: norm
|
||||||
|
print*, ' Providing N_det_generators_restart'
|
||||||
if(ifirst == 0)then
|
if(ifirst == 0)then
|
||||||
call ezfio_get_determinants_n_det(N_det_generators_restart)
|
call ezfio_get_determinants_n_det(N_det_generators_restart)
|
||||||
ifirst = 1
|
ifirst = 1
|
||||||
@ -30,6 +31,7 @@ END_PROVIDER
|
|||||||
integer :: i, k
|
integer :: i, k
|
||||||
integer, save :: ifirst = 0
|
integer, save :: ifirst = 0
|
||||||
double precision, allocatable :: psi_coef_read(:,:)
|
double precision, allocatable :: psi_coef_read(:,:)
|
||||||
|
print*, ' Providing psi_det_generators_restart'
|
||||||
if(ifirst == 0)then
|
if(ifirst == 0)then
|
||||||
call read_dets(psi_det_generators_restart,N_int,N_det_generators_restart)
|
call read_dets(psi_det_generators_restart,N_int,N_det_generators_restart)
|
||||||
do k = 1, N_int
|
do k = 1, N_int
|
||||||
|
@ -1,82 +0,0 @@
|
|||||||
program test_sc2
|
|
||||||
implicit none
|
|
||||||
read_wf = .True.
|
|
||||||
touch read_wf
|
|
||||||
call routine
|
|
||||||
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine routine
|
|
||||||
implicit none
|
|
||||||
double precision, allocatable :: energies(:),diag_H_elements(:)
|
|
||||||
double precision, allocatable :: H_matrix(:,:)
|
|
||||||
allocate(energies(N_states),diag_H_elements(N_det))
|
|
||||||
call diagonalize_CI
|
|
||||||
call test_hcc
|
|
||||||
call test_mulliken
|
|
||||||
allocate(H_matrix(N_det,N_det))
|
|
||||||
stop 'SC2_1h1p_full is not in the git!'
|
|
||||||
! call SC2_1h1p_full(psi_det,psi_coef,energies, &
|
|
||||||
! H_matrix,size(psi_coef,1),N_det,N_states_diag,N_int,threshold_convergence_SC2)
|
|
||||||
deallocate(H_matrix)
|
|
||||||
integer :: i,j
|
|
||||||
double precision :: accu,coef_hf
|
|
||||||
! coef_hf = 1.d0/psi_coef(1,1)
|
|
||||||
! do i = 1, N_det
|
|
||||||
! psi_coef(i,1) *= coef_hf
|
|
||||||
! enddo
|
|
||||||
touch psi_coef
|
|
||||||
call pouet
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine pouet
|
|
||||||
implicit none
|
|
||||||
double precision :: accu,coef_hf
|
|
||||||
! provide one_body_dm_mo_alpha one_body_dm_mo_beta
|
|
||||||
! call density_matrix_1h1p(psi_det,psi_coef,one_body_dm_mo_alpha,one_body_dm_mo_beta,accu,size(psi_coef,1),N_det,N_states_diag,N_int)
|
|
||||||
! touch one_body_dm_mo_alpha one_body_dm_mo_beta
|
|
||||||
call test_hcc
|
|
||||||
call test_mulliken
|
|
||||||
! call save_wavefunction
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine test_hcc
|
|
||||||
implicit none
|
|
||||||
double precision :: accu
|
|
||||||
integer :: i,j
|
|
||||||
print*,'Z AU GAUSS MHZ cm^-1'
|
|
||||||
do i = 1, nucl_num
|
|
||||||
write(*,'(I2,X,F3.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine test_mulliken
|
|
||||||
double precision :: accu
|
|
||||||
integer :: i
|
|
||||||
integer :: j
|
|
||||||
accu= 0.d0
|
|
||||||
do i = 1, nucl_num
|
|
||||||
print*,i,nucl_charge(i),mulliken_spin_densities(i)
|
|
||||||
accu += mulliken_spin_densities(i)
|
|
||||||
enddo
|
|
||||||
print*,'Sum of Mulliken SD = ',accu
|
|
||||||
!print*,'AO SPIN POPULATIONS'
|
|
||||||
accu = 0.d0
|
|
||||||
!do i = 1, ao_num
|
|
||||||
! accu += spin_gross_orbital_product(i)
|
|
||||||
! write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i)
|
|
||||||
!enddo
|
|
||||||
!print*,'sum = ',accu
|
|
||||||
!accu = 0.d0
|
|
||||||
!print*,'Angular momentum analysis'
|
|
||||||
!do i = 0, ao_l_max
|
|
||||||
! accu += spin_population_angular_momentum(i)
|
|
||||||
! print*,' ',trim(l_to_charater(i)),spin_population_angular_momentum(i)
|
|
||||||
!print*,'sum = ',accu
|
|
||||||
!enddo
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
@ -212,12 +212,50 @@ subroutine update_density_matrix_osoci
|
|||||||
integer :: iorb,jorb
|
integer :: iorb,jorb
|
||||||
do i = 1, mo_tot_num
|
do i = 1, mo_tot_num
|
||||||
do j = 1, mo_tot_num
|
do j = 1, mo_tot_num
|
||||||
one_body_dm_mo_alpha_osoci(i,j) = one_body_dm_mo_alpha_osoci(i,j) + (one_body_dm_mo_alpha(i,j) - one_body_dm_mo_alpha_generators_restart(i,j))
|
one_body_dm_mo_alpha_osoci(i,j) = one_body_dm_mo_alpha_osoci(i,j) + (one_body_dm_mo_alpha_average(i,j) - one_body_dm_mo_alpha_generators_restart(i,j))
|
||||||
one_body_dm_mo_beta_osoci(i,j) = one_body_dm_mo_beta_osoci(i,j) + (one_body_dm_mo_beta(i,j) - one_body_dm_mo_beta_generators_restart(i,j))
|
one_body_dm_mo_beta_osoci(i,j) = one_body_dm_mo_beta_osoci(i,j) + (one_body_dm_mo_beta_average(i,j) - one_body_dm_mo_beta_generators_restart(i,j))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine update_density_matrix_beta_osoci_read(array)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! one_body_dm_mo_alpha_osoci += Delta rho alpha
|
||||||
|
! one_body_dm_mo_beta_osoci += Delta rho beta
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
integer :: iorb,jorb
|
||||||
|
double precision :: array(mo_tot_num)
|
||||||
|
do i = 1, mo_tot_num
|
||||||
|
j = list_act(1)
|
||||||
|
one_body_dm_mo_beta_osoci(i,j) += array(i)
|
||||||
|
one_body_dm_mo_beta_osoci(j,i) += array(i)
|
||||||
|
one_body_dm_mo_beta_osoci(i,i) += array(i) * array(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine update_density_matrix_alpha_osoci_read(array)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! one_body_dm_mo_alpha_osoci += Delta rho alpha
|
||||||
|
! one_body_dm_mo_beta_osoci += Delta rho beta
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
integer :: iorb,jorb
|
||||||
|
double precision :: array(mo_tot_num)
|
||||||
|
do i = 1, mo_tot_num
|
||||||
|
j = list_act(1)
|
||||||
|
one_body_dm_mo_alpha_osoci(i,j) += array(i)
|
||||||
|
one_body_dm_mo_alpha_osoci(j,i) += array(i)
|
||||||
|
one_body_dm_mo_alpha_osoci(i,i) += array(i) * array(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -387,14 +425,14 @@ subroutine save_osoci_natural_mos
|
|||||||
print*,'ACTIVE ORBITAL ',iorb
|
print*,'ACTIVE ORBITAL ',iorb
|
||||||
do j = 1, n_inact_orb
|
do j = 1, n_inact_orb
|
||||||
jorb = list_inact(j)
|
jorb = list_inact(j)
|
||||||
if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then
|
if(dabs(tmp(iorb,jorb)).gt.0.0001d0)then
|
||||||
print*,'INACTIVE '
|
print*,'INACTIVE '
|
||||||
print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
|
print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
do j = 1, n_virt_orb
|
do j = 1, n_virt_orb
|
||||||
jorb = list_virt(j)
|
jorb = list_virt(j)
|
||||||
if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then
|
if(dabs(tmp(iorb,jorb)).gt.0.0001d0)then
|
||||||
print*,'VIRT '
|
print*,'VIRT '
|
||||||
print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
|
print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
|
||||||
endif
|
endif
|
||||||
@ -412,6 +450,10 @@ subroutine save_osoci_natural_mos
|
|||||||
label = "Natural"
|
label = "Natural"
|
||||||
|
|
||||||
call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1)
|
call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1)
|
||||||
|
!if(disk_access_ao_integrals == "None" .or. disk_access_ao_integrals == "Write" )then
|
||||||
|
! disk_access_ao_integrals = "Read"
|
||||||
|
! touch disk_access_ao_integrals
|
||||||
|
!endif
|
||||||
!soft_touch mo_coef
|
!soft_touch mo_coef
|
||||||
deallocate(tmp,occ)
|
deallocate(tmp,occ)
|
||||||
|
|
||||||
@ -588,14 +630,14 @@ end
|
|||||||
integer :: i
|
integer :: i
|
||||||
double precision :: accu_tot,accu_sd
|
double precision :: accu_tot,accu_sd
|
||||||
print*,'touched the one_body_dm_mo_beta'
|
print*,'touched the one_body_dm_mo_beta'
|
||||||
one_body_dm_mo_alpha = one_body_dm_mo_alpha_osoci
|
one_body_dm_mo_alpha_average = one_body_dm_mo_alpha_osoci
|
||||||
one_body_dm_mo_beta = one_body_dm_mo_beta_osoci
|
one_body_dm_mo_beta_average = one_body_dm_mo_beta_osoci
|
||||||
touch one_body_dm_mo_alpha one_body_dm_mo_beta
|
touch one_body_dm_mo_alpha one_body_dm_mo_beta
|
||||||
accu_tot = 0.d0
|
accu_tot = 0.d0
|
||||||
accu_sd = 0.d0
|
accu_sd = 0.d0
|
||||||
do i = 1, mo_tot_num
|
do i = 1, mo_tot_num
|
||||||
accu_tot += one_body_dm_mo_alpha(i,i) + one_body_dm_mo_beta(i,i)
|
accu_tot += one_body_dm_mo_alpha_average(i,i) + one_body_dm_mo_beta_average(i,i)
|
||||||
accu_sd += one_body_dm_mo_alpha(i,i) - one_body_dm_mo_beta(i,i)
|
accu_sd += one_body_dm_mo_alpha_average(i,i) - one_body_dm_mo_beta_average(i,i)
|
||||||
enddo
|
enddo
|
||||||
print*,'accu_tot = ',accu_tot
|
print*,'accu_tot = ',accu_tot
|
||||||
print*,'accu_sdt = ',accu_sd
|
print*,'accu_sdt = ',accu_sd
|
||||||
|
2
plugins/Full_CI/.gitignore
vendored
2
plugins/Full_CI/.gitignore
vendored
@ -3,6 +3,7 @@
|
|||||||
.ninja_log
|
.ninja_log
|
||||||
AO_Basis
|
AO_Basis
|
||||||
Bitmask
|
Bitmask
|
||||||
|
Davidson
|
||||||
Determinants
|
Determinants
|
||||||
Electrons
|
Electrons
|
||||||
Ezfio_files
|
Ezfio_files
|
||||||
@ -28,7 +29,6 @@ full_ci
|
|||||||
full_ci_no_skip
|
full_ci_no_skip
|
||||||
irpf90.make
|
irpf90.make
|
||||||
irpf90_entities
|
irpf90_entities
|
||||||
micro_pt2
|
|
||||||
tags
|
tags
|
||||||
target_pt2
|
target_pt2
|
||||||
var_pt2_ratio
|
var_pt2_ratio
|
@ -7,16 +7,17 @@ s.set_selection_pt2("epstein_nesbet_2x2")
|
|||||||
#s.unset_openmp()
|
#s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
#s = H_apply("FCI_PT2")
|
s = H_apply("FCI_PT2")
|
||||||
#s.set_perturbation("epstein_nesbet_2x2")
|
|
||||||
#s.unset_openmp()
|
|
||||||
#print s
|
|
||||||
|
|
||||||
s = H_apply_zmq("FCI_PT2")
|
|
||||||
s.set_perturbation("epstein_nesbet_2x2")
|
s.set_perturbation("epstein_nesbet_2x2")
|
||||||
s.unset_openmp()
|
s.unset_openmp()
|
||||||
print s
|
print s
|
||||||
|
|
||||||
|
s = H_apply("FCI_PT2_new")
|
||||||
|
s.set_perturbation("decontracted")
|
||||||
|
s.unset_openmp()
|
||||||
|
print s
|
||||||
|
|
||||||
|
|
||||||
s = H_apply("FCI_no_skip")
|
s = H_apply("FCI_no_skip")
|
||||||
s.set_selection_pt2("epstein_nesbet_2x2")
|
s.set_selection_pt2("epstein_nesbet_2x2")
|
||||||
s.unset_skip()
|
s.unset_skip()
|
||||||
|
@ -16,6 +16,7 @@ Needed Modules
|
|||||||
* `Perturbation <http://github.com/LCPQ/quantum_package/tree/master/plugins/Perturbation>`_
|
* `Perturbation <http://github.com/LCPQ/quantum_package/tree/master/plugins/Perturbation>`_
|
||||||
* `Selectors_full <http://github.com/LCPQ/quantum_package/tree/master/plugins/Selectors_full>`_
|
* `Selectors_full <http://github.com/LCPQ/quantum_package/tree/master/plugins/Selectors_full>`_
|
||||||
* `Generators_full <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full>`_
|
* `Generators_full <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full>`_
|
||||||
|
* `Davidson <http://github.com/LCPQ/quantum_package/tree/master/src/Davidson>`_
|
||||||
|
|
||||||
Documentation
|
Documentation
|
||||||
=============
|
=============
|
||||||
@ -77,6 +78,31 @@ h_apply_fci_monoexc
|
|||||||
Assume N_int is already provided.
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection_diexc
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection_diexcorg
|
||||||
|
Generate all double excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection_diexcp
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection_monoexc
|
||||||
|
Generate all single excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
h_apply_fci_no_skip
|
h_apply_fci_no_skip
|
||||||
Calls H_apply on the HF determinant and selects all connected single and double
|
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.
|
excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script.
|
||||||
@ -144,118 +170,6 @@ h_apply_fci_pt2_slave_tcp
|
|||||||
Computes a buffer over the network
|
Computes a buffer over the network
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_delta_rho
|
|
||||||
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.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_delta_rho_diexc
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_delta_rho_diexcorg
|
|
||||||
Generate all double excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_delta_rho_diexcp
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_delta_rho_monoexc
|
|
||||||
Generate all single excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_di_delta_rho
|
|
||||||
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.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_di_delta_rho_diexc
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_di_delta_rho_diexcorg
|
|
||||||
Generate all double excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_di_delta_rho_diexcp
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_pt2_mono_di_delta_rho_monoexc
|
|
||||||
Generate all single excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_delta_rho
|
|
||||||
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.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_delta_rho_diexc
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_delta_rho_diexcorg
|
|
||||||
Generate all double excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_delta_rho_diexcp
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_delta_rho_monoexc
|
|
||||||
Generate all single excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_di_delta_rho
|
|
||||||
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.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_di_delta_rho_diexc
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_di_delta_rho_diexcorg
|
|
||||||
Generate all double excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_di_delta_rho_diexcp
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
h_apply_select_mono_di_delta_rho_monoexc
|
|
||||||
Generate all single excitations of key_in using the bit masks of holes and
|
|
||||||
particles.
|
|
||||||
Assume N_int is already provided.
|
|
||||||
|
|
||||||
|
|
||||||
`micro_pt2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI/micro_pt2.irp.f#L1>`_
|
|
||||||
Helper program to compute the PT2 in distributed mode.
|
|
||||||
|
|
||||||
|
|
||||||
`provide_everything <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI/micro_pt2.irp.f#L15>`_
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
`run_wf <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI/micro_pt2.irp.f#L19>`_
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
`var_pt2_ratio_run <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI/var_pt2_ratio.irp.f#L1>`_
|
`var_pt2_ratio_run <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI/var_pt2_ratio.irp.f#L1>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
@ -92,8 +92,9 @@ program full_ci
|
|||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
if(do_pt2_end)then
|
if(do_pt2_end)then
|
||||||
print*,'Last iteration only to compute the PT2'
|
print*,'Last iteration only to compute the PT2'
|
||||||
threshold_selectors = 1.d0
|
threshold_generators = threshold_generators_pt2
|
||||||
threshold_generators = 0.999d0
|
threshold_selectors = threshold_selectors_pt2
|
||||||
|
SOFT_TOUCH threshold_generators threshold_selectors
|
||||||
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
||||||
|
|
||||||
print *, 'Final step'
|
print *, 'Final step'
|
||||||
|
@ -73,9 +73,11 @@ program full_ci
|
|||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
if(do_pt2_end)then
|
if(do_pt2_end)then
|
||||||
print*,'Last iteration only to compute the PT2'
|
print*,'Last iteration only to compute the PT2'
|
||||||
|
threshold_generators = threshold_generators_pt2
|
||||||
|
threshold_selectors = threshold_selectors_pt2
|
||||||
|
SOFT_TOUCH threshold_generators threshold_selectors
|
||||||
|
|
||||||
! print*,'The thres'
|
! print*,'The thres'
|
||||||
threshold_selectors = 1.d0
|
|
||||||
threshold_generators = 0.999d0
|
|
||||||
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
||||||
|
|
||||||
print *, 'Final step'
|
print *, 'Final step'
|
||||||
|
11
plugins/Full_CI_ZMQ/EZFIO.cfg
Normal file
11
plugins/Full_CI_ZMQ/EZFIO.cfg
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
[energy]
|
||||||
|
type: double precision
|
||||||
|
doc: Calculated Selected FCI energy
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[energy_pt2]
|
||||||
|
type: double precision
|
||||||
|
doc: Calculated FCI energy + PT2
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
|
@ -1 +1 @@
|
|||||||
Perturbation Selectors_full Generators_full ZMQ Full_CI
|
Perturbation Selectors_full Generators_full ZMQ
|
||||||
|
461
plugins/Full_CI_ZMQ/README.rst
Normal file
461
plugins/Full_CI_ZMQ/README.rst
Normal file
@ -0,0 +1,461 @@
|
|||||||
|
Needed Modules
|
||||||
|
==============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
||||||
|
|
||||||
|
|
||||||
|
.. image:: tree_dependency.png
|
||||||
|
|
||||||
|
* `Perturbation <http://github.com/LCPQ/quantum_package/tree/master/plugins/Perturbation>`_
|
||||||
|
* `Selectors_full <http://github.com/LCPQ/quantum_package/tree/master/plugins/Selectors_full>`_
|
||||||
|
* `Generators_full <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full>`_
|
||||||
|
* `ZMQ <http://github.com/LCPQ/quantum_package/tree/master/src/ZMQ>`_
|
||||||
|
* `Full_CI <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI>`_
|
||||||
|
|
||||||
|
Documentation
|
||||||
|
=============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
||||||
|
|
||||||
|
|
||||||
|
`add_task_to_taskserver <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L677>`_
|
||||||
|
Get a task from the task server
|
||||||
|
|
||||||
|
|
||||||
|
`add_to_selection_buffer <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_buffer.irp.f#L19>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`assert <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection.irp.f#L25>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`connect_to_taskserver <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L594>`_
|
||||||
|
Connect to the task server and obtain the worker ID
|
||||||
|
|
||||||
|
|
||||||
|
`create_selection_buffer <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_buffer.irp.f#L2>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`disconnect_from_taskserver <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L637>`_
|
||||||
|
Disconnect from the task server
|
||||||
|
|
||||||
|
|
||||||
|
`end_parallel_job <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L559>`_
|
||||||
|
End a new parallel job with name 'name'. The slave tasks execute subroutine 'slave'
|
||||||
|
|
||||||
|
|
||||||
|
`end_zmq_pair_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L419>`_
|
||||||
|
Terminate socket on which the results are sent.
|
||||||
|
|
||||||
|
|
||||||
|
`end_zmq_pull_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L437>`_
|
||||||
|
Terminate socket on which the results are sent.
|
||||||
|
|
||||||
|
|
||||||
|
`end_zmq_push_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L456>`_
|
||||||
|
Terminate socket on which the results are sent.
|
||||||
|
|
||||||
|
|
||||||
|
`end_zmq_sub_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L401>`_
|
||||||
|
Terminate socket on which the results are sent.
|
||||||
|
|
||||||
|
|
||||||
|
`end_zmq_to_qp_run_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L790>`_
|
||||||
|
Terminate the socket from the application to qp_run
|
||||||
|
|
||||||
|
|
||||||
|
`fci_zmq <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/fci_zmq.irp.f#L1>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`fill_buffer_double <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L156>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`fill_buffer_single <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_single.irp.f#L60>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`full_ci <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/full_ci_no_skip.irp.f#L1>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_d0 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L582>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_d1 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L413>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_d2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L295>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_m0 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_single.irp.f#L279>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_m1 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_single.irp.f#L217>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_m2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_single.irp.f#L158>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_mask_phase <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection.irp.f#L36>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_phase_bi <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection.irp.f#L87>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_task_from_taskserver <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L737>`_
|
||||||
|
Get a task from the task server
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_diexc
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_diexcorg
|
||||||
|
Generate all double excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_diexcp
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_mono
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_mono_diexc
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_mono_diexcorg
|
||||||
|
Generate all double excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_mono_diexcp
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_mono_monoexc
|
||||||
|
Generate all single excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_monoexc
|
||||||
|
Generate all single excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection_diexc
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection_diexcorg
|
||||||
|
Generate all double excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection_diexcp
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_selection_monoexc
|
||||||
|
Generate all single excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_skip
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_skip_diexc
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_skip_diexcorg
|
||||||
|
Generate all double excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_skip_diexcp
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_no_skip_monoexc
|
||||||
|
Generate all single excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2_collector
|
||||||
|
Collects results from the selection in an array of generators
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2_diexc
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2_diexcorg
|
||||||
|
Generate all double excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2_diexcp
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2_monoexc
|
||||||
|
Generate all single excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2_slave
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2_slave_inproc
|
||||||
|
Computes a buffer using threads
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_fci_pt2_slave_tcp
|
||||||
|
Computes a buffer over the network
|
||||||
|
|
||||||
|
|
||||||
|
`integral8 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection.irp.f#L4>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`new_parallel_job <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L490>`_
|
||||||
|
Start a new parallel job with name 'name'. The slave tasks execute subroutine 'slave'
|
||||||
|
|
||||||
|
|
||||||
|
`new_zmq_pair_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L164>`_
|
||||||
|
Socket on which the collector and the main communicate
|
||||||
|
|
||||||
|
|
||||||
|
`new_zmq_pull_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L224>`_
|
||||||
|
Socket on which the results are sent. If thread is 1, use inproc
|
||||||
|
|
||||||
|
|
||||||
|
`new_zmq_push_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L300>`_
|
||||||
|
Socket on which the results are sent. If thread is 1, use inproc
|
||||||
|
|
||||||
|
|
||||||
|
`new_zmq_sub_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L360>`_
|
||||||
|
Socket to read the state published by the Task server
|
||||||
|
|
||||||
|
|
||||||
|
`new_zmq_to_qp_run_socket <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L126>`_
|
||||||
|
Socket on which the qp_run process replies
|
||||||
|
|
||||||
|
|
||||||
|
`past_d1 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L642>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`past_d2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L658>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`provide_everything <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_slave.irp.f#L14>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`psi_phasemask <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection.irp.f#L14>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`pull_selection_results <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/run_selection_slave.irp.f#L122>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`push_selection_results <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/run_selection_slave.irp.f#L87>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`qp_run_address <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L19>`_
|
||||||
|
Address of the qp_run socket
|
||||||
|
Example : tcp://130.120.229.139:12345
|
||||||
|
|
||||||
|
|
||||||
|
`reset_zmq_addresses <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L67>`_
|
||||||
|
Socket which pulls the results (2)
|
||||||
|
|
||||||
|
|
||||||
|
`run_selection_slave <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/run_selection_slave.irp.f#L2>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`run_wf <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_slave.irp.f#L19>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`select_connected <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection.irp.f#L58>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`select_doubles <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L2>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`select_singles <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_single.irp.f#L3>`_
|
||||||
|
Select determinants connected to i_det by H
|
||||||
|
|
||||||
|
|
||||||
|
`selection_collector <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/fci_zmq.irp.f#L167>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`selection_slave <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_slave.irp.f#L1>`_
|
||||||
|
Helper program to compute the PT2 in distributed mode.
|
||||||
|
|
||||||
|
|
||||||
|
`selection_slave_inproc <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/fci_zmq.irp.f#L160>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`selection_slave_tcp <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_slave.irp.f#L86>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`sort_selection_buffer <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_buffer.irp.f#L39>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`splash_p <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_single.irp.f#L107>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`splash_pq <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L221>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`spot_hasbeen <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_single.irp.f#L305>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`spot_isinwf <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_double.irp.f#L684>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`switch_qp_run_to_master <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L84>`_
|
||||||
|
Address of the master qp_run socket
|
||||||
|
Example : tcp://130.120.229.139:12345
|
||||||
|
|
||||||
|
|
||||||
|
`task_done_to_taskserver <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L708>`_
|
||||||
|
Get a task from the task server
|
||||||
|
|
||||||
|
|
||||||
|
`update_energy <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/selection_slave.irp.f#L63>`_
|
||||||
|
Update energy when it is received from ZMQ
|
||||||
|
|
||||||
|
|
||||||
|
`var_pt2_ratio_run <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/var_pt2_ratio.irp.f#L1>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`wait_for_next_state <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L855>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`wait_for_state <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L879>`_
|
||||||
|
Wait for the ZMQ state to be ready
|
||||||
|
|
||||||
|
|
||||||
|
`wait_for_states <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L907>`_
|
||||||
|
Wait for the ZMQ state to be ready
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_context <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L8>`_
|
||||||
|
Context for the ZeroMQ library
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_delete_task <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L813>`_
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_port <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L113>`_
|
||||||
|
Return the value of the ZMQ port from the corresponding integer
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_port_start <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L20>`_
|
||||||
|
Address of the qp_run socket
|
||||||
|
Example : tcp://130.120.229.139:12345
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_selection <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/fci_zmq.irp.f#L109>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_set_running <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L530>`_
|
||||||
|
Set the job to Running in QP-run
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_socket_pair_inproc_address <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L45>`_
|
||||||
|
Socket which pulls the results (2)
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_socket_pull_inproc_address <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L47>`_
|
||||||
|
Socket which pulls the results (2)
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_socket_pull_tcp_address <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L44>`_
|
||||||
|
Socket which pulls the results (2)
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_socket_push_inproc_address <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L48>`_
|
||||||
|
Socket which pulls the results (2)
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_socket_push_tcp_address <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L46>`_
|
||||||
|
Socket which pulls the results (2)
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_socket_sub_tcp_address <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L49>`_
|
||||||
|
Socket which pulls the results (2)
|
||||||
|
|
||||||
|
|
||||||
|
`zmq_state <http://github.com/LCPQ/quantum_package/tree/master/plugins/Full_CI_ZMQ/utils.irp.f#L482>`_
|
||||||
|
Threads executing work through the ZeroMQ interface
|
||||||
|
|
11
plugins/Full_CI_ZMQ/energy.irp.f
Normal file
11
plugins/Full_CI_ZMQ/energy.irp.f
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! E0 in the denominator of the PT2
|
||||||
|
END_DOC
|
||||||
|
pt2_E0_denominator(1:N_states) = CI_electronic_energy(1:N_states)
|
||||||
|
! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion
|
||||||
|
! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states)
|
||||||
|
call write_double(6,pt2_E0_denominator(1)+nuclear_repulsion, 'PT2 Energy denominator')
|
||||||
|
END_PROVIDER
|
||||||
|
|
@ -5,11 +5,15 @@ program fci_zmq
|
|||||||
|
|
||||||
double precision, allocatable :: pt2(:)
|
double precision, allocatable :: pt2(:)
|
||||||
integer :: degree
|
integer :: degree
|
||||||
|
integer :: n_det_before, to_select
|
||||||
|
double precision :: threshold_davidson_in
|
||||||
|
|
||||||
allocate (pt2(N_states))
|
allocate (pt2(N_states))
|
||||||
|
|
||||||
pt2 = 1.d0
|
pt2 = 1.d0
|
||||||
diag_algorithm = "Lapack"
|
threshold_davidson_in = threshold_davidson
|
||||||
|
threshold_davidson = threshold_davidson_in * 100.d0
|
||||||
|
SOFT_TOUCH threshold_davidson
|
||||||
|
|
||||||
if (N_det > N_det_max) then
|
if (N_det > N_det_max) then
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
@ -33,29 +37,11 @@ program fci_zmq
|
|||||||
double precision :: E_CI_before(N_states)
|
double precision :: E_CI_before(N_states)
|
||||||
|
|
||||||
|
|
||||||
integer :: n_det_before
|
|
||||||
print*,'Beginning the selection ...'
|
print*,'Beginning the selection ...'
|
||||||
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
|
n_det_before = 0
|
||||||
|
|
||||||
do while ( (N_det < N_det_max) .and. (maxval(abs(pt2(1:N_states))) > pt2_max) )
|
do while ( (N_det < N_det_max) .and. (maxval(abs(pt2(1:N_states))) > pt2_max) )
|
||||||
n_det_before = N_det
|
|
||||||
call ZMQ_selection(max(1024-N_det, N_det), pt2)
|
|
||||||
|
|
||||||
PROVIDE psi_coef
|
|
||||||
PROVIDE psi_det
|
|
||||||
PROVIDE psi_det_sorted
|
|
||||||
|
|
||||||
call diagonalize_CI
|
|
||||||
call save_wavefunction
|
|
||||||
|
|
||||||
if (N_det > N_det_max) then
|
|
||||||
psi_det = psi_det_sorted
|
|
||||||
psi_coef = psi_coef_sorted
|
|
||||||
N_det = N_det_max
|
|
||||||
soft_touch N_det psi_det psi_coef
|
|
||||||
call diagonalize_CI
|
|
||||||
call save_wavefunction
|
|
||||||
endif
|
|
||||||
|
|
||||||
print *, 'N_det = ', N_det
|
print *, 'N_det = ', N_det
|
||||||
print *, 'N_states = ', N_states
|
print *, 'N_states = ', N_states
|
||||||
@ -79,13 +65,40 @@ program fci_zmq
|
|||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
call ezfio_set_full_ci_energy(CI_energy)
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
|
||||||
|
n_det_before = N_det
|
||||||
|
to_select = 2*N_det
|
||||||
|
to_select = max(64-to_select, to_select)
|
||||||
|
to_select = min(to_select, N_det_max-n_det_before)
|
||||||
|
call ZMQ_selection(to_select, pt2)
|
||||||
|
|
||||||
|
PROVIDE psi_coef
|
||||||
|
PROVIDE psi_det
|
||||||
|
PROVIDE psi_det_sorted
|
||||||
|
|
||||||
|
if (N_det == N_det_max) then
|
||||||
|
threshold_davidson = threshold_davidson_in
|
||||||
|
SOFT_TOUCH threshold_davidson
|
||||||
|
endif
|
||||||
|
call diagonalize_CI
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
if (N_det < N_det_max) then
|
||||||
|
threshold_davidson = threshold_davidson_in
|
||||||
|
SOFT_TOUCH threshold_davidson
|
||||||
|
call diagonalize_CI
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
endif
|
||||||
|
|
||||||
if(do_pt2_end)then
|
if(do_pt2_end)then
|
||||||
print*,'Last iteration only to compute the PT2'
|
print*,'Last iteration only to compute the PT2'
|
||||||
threshold_selectors = 1.d0
|
threshold_selectors = max(threshold_selectors,threshold_selectors_pt2)
|
||||||
threshold_generators = 0.9999d0
|
threshold_generators = max(threshold_generators,threshold_generators_pt2)
|
||||||
|
TOUCH threshold_selectors threshold_generators
|
||||||
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
call ZMQ_selection(0, pt2)
|
call ZMQ_selection(0, pt2)
|
||||||
print *, 'Final step'
|
print *, 'Final step'
|
||||||
@ -98,123 +111,9 @@ program fci_zmq
|
|||||||
print *, 'E+PT2 = ', E_CI_before+pt2
|
print *, 'E+PT2 = ', E_CI_before+pt2
|
||||||
print *, '-----'
|
print *, '-----'
|
||||||
enddo
|
enddo
|
||||||
call ezfio_set_full_ci_energy_pt2(E_CI_before+pt2)
|
call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1))
|
||||||
endif
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1))
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine ZMQ_selection(N_in, pt2)
|
|
||||||
use f77_zmq
|
|
||||||
use selection_types
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
character*(512) :: task
|
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
|
||||||
integer, intent(in) :: N_in
|
|
||||||
type(selection_buffer) :: b
|
|
||||||
integer :: i, N
|
|
||||||
integer, external :: omp_get_thread_num
|
|
||||||
double precision, intent(out) :: pt2(N_states)
|
|
||||||
|
|
||||||
|
|
||||||
N = max(N_in,1)
|
|
||||||
provide nproc
|
|
||||||
provide ci_electronic_energy
|
|
||||||
call new_parallel_job(zmq_to_qp_run_socket,"selection")
|
|
||||||
call zmq_put_psi(zmq_to_qp_run_socket,1,ci_electronic_energy,size(ci_electronic_energy))
|
|
||||||
call zmq_set_running(zmq_to_qp_run_socket)
|
|
||||||
call create_selection_buffer(N, N*2, b)
|
|
||||||
|
|
||||||
integer :: i_generator, i_generator_start, i_generator_max, step
|
|
||||||
! step = int(max(1.,10*elec_num/mo_tot_num)
|
|
||||||
|
|
||||||
step = int(5000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num ))
|
|
||||||
step = max(1,step)
|
|
||||||
do i= N_det_generators, 1, -step
|
|
||||||
i_generator_start = max(i-step+1,1)
|
|
||||||
i_generator_max = i
|
|
||||||
write(task,*) i_generator_start, i_generator_max, 1, N
|
|
||||||
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
|
||||||
end do
|
|
||||||
|
|
||||||
!$OMP PARALLEL DEFAULT(none) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) shared(ci_electronic_energy_is_built, n_det_generators_is_built, n_states_is_built, n_int_is_built, nproc_is_built)
|
|
||||||
i = omp_get_thread_num()
|
|
||||||
if (i==0) then
|
|
||||||
call selection_collector(b, pt2)
|
|
||||||
else
|
|
||||||
call selection_slave_inproc(i)
|
|
||||||
endif
|
|
||||||
!$OMP END PARALLEL
|
|
||||||
call end_parallel_job(zmq_to_qp_run_socket, 'selection')
|
|
||||||
if (N_in > 0) then
|
|
||||||
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) !!! PAS DE ROBIN
|
|
||||||
call copy_H_apply_buffer_to_wf()
|
|
||||||
endif
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
subroutine selection_slave_inproc(i)
|
|
||||||
implicit none
|
|
||||||
integer, intent(in) :: i
|
|
||||||
|
|
||||||
call run_selection_slave(1,i,ci_electronic_energy)
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine selection_collector(b, pt2)
|
|
||||||
use f77_zmq
|
|
||||||
use selection_types
|
|
||||||
use bitmasks
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
|
|
||||||
type(selection_buffer), intent(inout) :: b
|
|
||||||
double precision, intent(out) :: pt2(N_states)
|
|
||||||
double precision :: pt2_mwen(N_states)
|
|
||||||
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 :: msg_size, rc, more
|
|
||||||
integer :: acc, i, j, robin, N, ntask
|
|
||||||
double precision, allocatable :: val(:)
|
|
||||||
integer(bit_kind), allocatable :: det(:,:,:)
|
|
||||||
integer, allocatable :: task_id(:)
|
|
||||||
integer :: done
|
|
||||||
real :: time, time0
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
|
||||||
zmq_socket_pull = new_zmq_pull_socket()
|
|
||||||
allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det))
|
|
||||||
done = 0
|
|
||||||
more = 1
|
|
||||||
pt2(:) = 0d0
|
|
||||||
call CPU_TIME(time0)
|
|
||||||
do while (more == 1)
|
|
||||||
call pull_selection_results(zmq_socket_pull, pt2_mwen, val(1), det(1,1,1), N, task_id, ntask)
|
|
||||||
pt2 += pt2_mwen
|
|
||||||
do i=1, N
|
|
||||||
call add_to_selection_buffer(b, det(1,1,i), val(i))
|
|
||||||
end do
|
|
||||||
|
|
||||||
do i=1, ntask
|
|
||||||
if(task_id(i) == 0) then
|
|
||||||
print *, "Error in collector"
|
|
||||||
endif
|
|
||||||
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
|
|
||||||
end do
|
|
||||||
done += ntask
|
|
||||||
call CPU_TIME(time)
|
|
||||||
! print *, "DONE" , done, time - time0
|
|
||||||
end do
|
|
||||||
|
|
||||||
|
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
|
||||||
call end_zmq_pull_socket(zmq_socket_pull)
|
|
||||||
call sort_selection_buffer(b)
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
@ -4,7 +4,7 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
use selection_types
|
use selection_types
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
double precision, intent(in) :: energy(N_states_diag)
|
double precision, intent(in) :: energy(N_states)
|
||||||
integer, intent(in) :: thread, iproc
|
integer, intent(in) :: thread, iproc
|
||||||
integer :: rc, i
|
integer :: rc, i
|
||||||
|
|
||||||
|
File diff suppressed because it is too large
Load Diff
@ -13,7 +13,7 @@ end
|
|||||||
|
|
||||||
subroutine provide_everything
|
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 mo_mono_elec_integral
|
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 mo_mono_elec_integral
|
||||||
! PROVIDE ci_electronic_energy mo_tot_num N_int
|
! PROVIDE pt2_e0_denominator mo_tot_num N_int
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine run_wf
|
subroutine run_wf
|
||||||
@ -22,7 +22,7 @@ subroutine run_wf
|
|||||||
|
|
||||||
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
|
||||||
double precision :: energy(N_states_diag)
|
double precision :: energy(N_states)
|
||||||
character*(64) :: states(2)
|
character*(64) :: states(2)
|
||||||
integer :: rc, i
|
integer :: rc, i
|
||||||
|
|
||||||
@ -48,7 +48,7 @@ subroutine run_wf
|
|||||||
! ---------
|
! ---------
|
||||||
|
|
||||||
print *, 'Selection'
|
print *, 'Selection'
|
||||||
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
|
||||||
!$OMP PARALLEL PRIVATE(i)
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
i = omp_get_thread_num()
|
i = omp_get_thread_num()
|
||||||
@ -76,7 +76,7 @@ end
|
|||||||
|
|
||||||
subroutine update_energy(energy)
|
subroutine update_energy(energy)
|
||||||
implicit none
|
implicit none
|
||||||
double precision, intent(in) :: energy(N_states_diag)
|
double precision, intent(in) :: energy(N_states)
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Update energy when it is received from ZMQ
|
! Update energy when it is received from ZMQ
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -88,7 +88,7 @@ subroutine update_energy(energy)
|
|||||||
enddo
|
enddo
|
||||||
call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
|
call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
|
||||||
if (.True.) then
|
if (.True.) then
|
||||||
do k=1,size(ci_electronic_energy)
|
do k=1,N_states
|
||||||
ci_electronic_energy(k) = energy(k)
|
ci_electronic_energy(k) = energy(k)
|
||||||
enddo
|
enddo
|
||||||
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
|
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
|
||||||
@ -99,7 +99,7 @@ end
|
|||||||
|
|
||||||
subroutine selection_slave_tcp(i,energy)
|
subroutine selection_slave_tcp(i,energy)
|
||||||
implicit none
|
implicit none
|
||||||
double precision, intent(in) :: energy(N_states_diag)
|
double precision, intent(in) :: energy(N_states)
|
||||||
integer, intent(in) :: i
|
integer, intent(in) :: i
|
||||||
|
|
||||||
call run_selection_slave(0,i,energy)
|
call run_selection_slave(0,i,energy)
|
||||||
|
@ -13,7 +13,7 @@ end
|
|||||||
|
|
||||||
subroutine provide_everything
|
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
|
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
|
||||||
! PROVIDE ci_electronic_energy mo_tot_num N_int
|
PROVIDE pt2_e0_denominator mo_tot_num N_int
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine run_wf
|
subroutine run_wf
|
||||||
@ -22,7 +22,7 @@ subroutine run_wf
|
|||||||
|
|
||||||
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
|
||||||
double precision :: energy(N_states_diag)
|
double precision :: energy(N_states)
|
||||||
character*(64) :: states(1)
|
character*(64) :: states(1)
|
||||||
integer :: rc, i
|
integer :: rc, i
|
||||||
|
|
||||||
@ -47,7 +47,7 @@ subroutine run_wf
|
|||||||
! ---------
|
! ---------
|
||||||
|
|
||||||
print *, 'Selection'
|
print *, 'Selection'
|
||||||
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
|
||||||
!$OMP PARALLEL PRIVATE(i)
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
i = omp_get_thread_num()
|
i = omp_get_thread_num()
|
||||||
@ -62,7 +62,7 @@ end
|
|||||||
|
|
||||||
subroutine update_energy(energy)
|
subroutine update_energy(energy)
|
||||||
implicit none
|
implicit none
|
||||||
double precision, intent(in) :: energy(N_states_diag)
|
double precision, intent(in) :: energy(N_states)
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Update energy when it is received from ZMQ
|
! Update energy when it is received from ZMQ
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -74,7 +74,7 @@ subroutine update_energy(energy)
|
|||||||
enddo
|
enddo
|
||||||
call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
|
call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
|
||||||
if (.True.) then
|
if (.True.) then
|
||||||
do k=1,size(ci_electronic_energy)
|
do k=1,N_states
|
||||||
ci_electronic_energy(k) = energy(k)
|
ci_electronic_energy(k) = energy(k)
|
||||||
enddo
|
enddo
|
||||||
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
|
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
|
||||||
@ -85,7 +85,7 @@ end
|
|||||||
|
|
||||||
subroutine selection_slave_tcp(i,energy)
|
subroutine selection_slave_tcp(i,energy)
|
||||||
implicit none
|
implicit none
|
||||||
double precision, intent(in) :: energy(N_states_diag)
|
double precision, intent(in) :: energy(N_states)
|
||||||
integer, intent(in) :: i
|
integer, intent(in) :: i
|
||||||
|
|
||||||
call run_selection_slave(0,i,energy)
|
call run_selection_slave(0,i,energy)
|
||||||
|
105
plugins/Full_CI_ZMQ/target_pt2_ratio_zmq.irp.f
Normal file
105
plugins/Full_CI_ZMQ/target_pt2_ratio_zmq.irp.f
Normal file
@ -0,0 +1,105 @@
|
|||||||
|
program fci_zmq
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k
|
||||||
|
logical, external :: detEq
|
||||||
|
|
||||||
|
double precision, allocatable :: pt2(:)
|
||||||
|
integer :: Nmin, Nmax
|
||||||
|
integer :: n_det_before, to_select
|
||||||
|
double precision :: threshold_davidson_in, ratio, E_ref
|
||||||
|
|
||||||
|
double precision, allocatable :: psi_coef_ref(:,:)
|
||||||
|
integer(bit_kind), allocatable :: psi_det_ref(:,:,:)
|
||||||
|
|
||||||
|
|
||||||
|
allocate (pt2(N_states))
|
||||||
|
|
||||||
|
pt2 = 1.d0
|
||||||
|
threshold_davidson_in = threshold_davidson
|
||||||
|
threshold_davidson = threshold_davidson_in * 100.d0
|
||||||
|
SOFT_TOUCH threshold_davidson
|
||||||
|
|
||||||
|
! Stopping criterion is the PT2max
|
||||||
|
|
||||||
|
double precision :: E_CI_before(N_states)
|
||||||
|
do while (dabs(pt2(1)) > pt2_max)
|
||||||
|
print *, 'N_det = ', N_det
|
||||||
|
print *, 'N_states = ', N_states
|
||||||
|
do k=1, N_states
|
||||||
|
print*,'State ',k
|
||||||
|
print *, 'PT2 = ', pt2(k)
|
||||||
|
print *, 'E = ', CI_energy(k)
|
||||||
|
print *, 'E(before)+PT2 = ', E_CI_before(k)+pt2(k)
|
||||||
|
enddo
|
||||||
|
print *, '-----'
|
||||||
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
|
||||||
|
n_det_before = N_det
|
||||||
|
to_select = N_det
|
||||||
|
to_select = max(64-to_select, to_select)
|
||||||
|
call ZMQ_selection(to_select, pt2)
|
||||||
|
|
||||||
|
PROVIDE psi_coef
|
||||||
|
PROVIDE psi_det
|
||||||
|
PROVIDE psi_det_sorted
|
||||||
|
|
||||||
|
call diagonalize_CI
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
threshold_selectors = max(threshold_selectors,threshold_selectors_pt2)
|
||||||
|
threshold_generators = max(threshold_generators,threshold_generators_pt2)
|
||||||
|
threshold_davidson = threshold_davidson_in
|
||||||
|
TOUCH threshold_selectors threshold_generators threshold_davidson
|
||||||
|
call diagonalize_CI
|
||||||
|
call ZMQ_selection(0, pt2)
|
||||||
|
|
||||||
|
E_ref = CI_energy(1) + pt2(1)
|
||||||
|
print *, 'Est FCI = ', E_ref
|
||||||
|
|
||||||
|
Nmax = N_det
|
||||||
|
Nmin = 2
|
||||||
|
allocate (psi_coef_ref(size(psi_coef_sorted,1),size(psi_coef_sorted,2)))
|
||||||
|
allocate (psi_det_ref(N_int,2,size(psi_det_sorted,3)))
|
||||||
|
psi_coef_ref = psi_coef_sorted
|
||||||
|
psi_det_ref = psi_det_sorted
|
||||||
|
psi_det = psi_det_sorted
|
||||||
|
psi_coef = psi_coef_sorted
|
||||||
|
TOUCH psi_coef psi_det
|
||||||
|
do while (Nmax-Nmin > 1)
|
||||||
|
psi_coef = psi_coef_ref
|
||||||
|
psi_det = psi_det_ref
|
||||||
|
TOUCH psi_det psi_coef
|
||||||
|
call diagonalize_CI
|
||||||
|
ratio = (CI_energy(1) - HF_energy) / (E_ref - HF_energy)
|
||||||
|
if (ratio < var_pt2_ratio) then
|
||||||
|
Nmin = N_det
|
||||||
|
else
|
||||||
|
Nmax = N_det
|
||||||
|
endif
|
||||||
|
N_det = Nmin + (Nmax-Nmin)/2
|
||||||
|
print *, '-----'
|
||||||
|
print *, 'Det min, Det max: ', Nmin, Nmax
|
||||||
|
print *, 'Ratio : ', ratio, ' ~ ', var_pt2_ratio
|
||||||
|
print *, 'N_det = ', N_det
|
||||||
|
print *, 'E = ', CI_energy(1)
|
||||||
|
enddo
|
||||||
|
call ZMQ_selection(0, pt2)
|
||||||
|
print *, '------'
|
||||||
|
print *, 'HF_energy = ', HF_energy
|
||||||
|
print *, 'Est FCI = ', E_ref
|
||||||
|
print *, 'E = ', CI_energy(1)
|
||||||
|
print *, 'PT2 = ', pt2(1)
|
||||||
|
print *, 'E+PT2 = ', CI_energy(1)+pt2(1)
|
||||||
|
|
||||||
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1))
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
95
plugins/Full_CI_ZMQ/target_pt2_zmq.irp.f
Normal file
95
plugins/Full_CI_ZMQ/target_pt2_zmq.irp.f
Normal file
@ -0,0 +1,95 @@
|
|||||||
|
program fci_zmq
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k
|
||||||
|
logical, external :: detEq
|
||||||
|
|
||||||
|
double precision, allocatable :: pt2(:)
|
||||||
|
integer :: Nmin, Nmax
|
||||||
|
integer :: n_det_before, to_select
|
||||||
|
double precision :: threshold_davidson_in, ratio, E_ref, pt2_ratio
|
||||||
|
|
||||||
|
allocate (pt2(N_states))
|
||||||
|
|
||||||
|
pt2 = 1.d0
|
||||||
|
threshold_davidson_in = threshold_davidson
|
||||||
|
threshold_davidson = threshold_davidson_in * 100.d0
|
||||||
|
SOFT_TOUCH threshold_davidson
|
||||||
|
|
||||||
|
double precision :: E_CI_before(N_states)
|
||||||
|
do while (dabs(pt2(1)) > pt2_max)
|
||||||
|
print *, 'N_det = ', N_det
|
||||||
|
print *, 'N_states = ', N_states
|
||||||
|
do k=1, N_states
|
||||||
|
print*,'State ',k
|
||||||
|
print *, 'PT2 = ', pt2(k)
|
||||||
|
print *, 'E = ', CI_energy(k)
|
||||||
|
print *, 'E(before)+PT2 = ', E_CI_before(k)+pt2(k)
|
||||||
|
enddo
|
||||||
|
print *, '-----'
|
||||||
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
|
||||||
|
n_det_before = N_det
|
||||||
|
to_select = N_det
|
||||||
|
to_select = max(64-to_select, to_select)
|
||||||
|
call ZMQ_selection(to_select, pt2)
|
||||||
|
|
||||||
|
PROVIDE psi_coef
|
||||||
|
PROVIDE psi_det
|
||||||
|
PROVIDE psi_det_sorted
|
||||||
|
|
||||||
|
call diagonalize_CI
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
threshold_selectors = max(threshold_selectors,threshold_selectors_pt2)
|
||||||
|
threshold_generators = max(threshold_generators,threshold_generators_pt2)
|
||||||
|
threshold_davidson = threshold_davidson_in
|
||||||
|
TOUCH threshold_selectors threshold_generators threshold_davidson
|
||||||
|
call diagonalize_CI
|
||||||
|
call ZMQ_selection(0, pt2)
|
||||||
|
|
||||||
|
E_ref = CI_energy(1) + pt2(1)
|
||||||
|
pt2_ratio = (E_ref + pt2_max - HF_energy) / (E_ref - HF_energy)
|
||||||
|
print *, 'Est FCI = ', E_ref
|
||||||
|
|
||||||
|
Nmax = N_det
|
||||||
|
Nmin = N_det/8
|
||||||
|
do while (Nmax-Nmin > 1)
|
||||||
|
call diagonalize_CI
|
||||||
|
ratio = (CI_energy(1) - HF_energy) / (E_ref - HF_energy)
|
||||||
|
psi_det = psi_det_sorted
|
||||||
|
psi_coef = psi_coef_sorted
|
||||||
|
TOUCH psi_coef psi_det
|
||||||
|
if (ratio < pt2_ratio) then
|
||||||
|
Nmin = N_det
|
||||||
|
to_select = (Nmax-Nmin)/2
|
||||||
|
call ZMQ_selection(to_select, pt2)
|
||||||
|
else
|
||||||
|
Nmax = N_det
|
||||||
|
N_det = Nmin + (Nmax-Nmin)/2
|
||||||
|
endif
|
||||||
|
print *, '-----'
|
||||||
|
print *, 'Det min, Det max: ', Nmin, Nmax
|
||||||
|
print *, 'Ratio : ', ratio, ' ~ ', pt2_ratio
|
||||||
|
print *, 'HF_energy = ', HF_energy
|
||||||
|
print *, 'Est FCI = ', E_ref
|
||||||
|
print *, 'N_det = ', N_det
|
||||||
|
print *, 'E = ', CI_energy(1)
|
||||||
|
print *, 'PT2 = ', pt2(1)
|
||||||
|
enddo
|
||||||
|
call ZMQ_selection(0, pt2)
|
||||||
|
print *, '------'
|
||||||
|
print *, 'E = ', CI_energy(1)
|
||||||
|
print *, 'PT2 = ', pt2(1)
|
||||||
|
|
||||||
|
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||||
|
call save_wavefunction
|
||||||
|
call ezfio_set_full_ci_zmq_energy(CI_energy(1))
|
||||||
|
call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1))
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
0
plugins/Full_CI_ZMQ/tree_dependency.png
Normal file
0
plugins/Full_CI_ZMQ/tree_dependency.png
Normal file
117
plugins/Full_CI_ZMQ/zmq_selection.irp.f
Normal file
117
plugins/Full_CI_ZMQ/zmq_selection.irp.f
Normal file
@ -0,0 +1,117 @@
|
|||||||
|
subroutine ZMQ_selection(N_in, pt2)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
character*(512) :: task
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: N_in
|
||||||
|
type(selection_buffer) :: b
|
||||||
|
integer :: i, N
|
||||||
|
integer, external :: omp_get_thread_num
|
||||||
|
double precision, intent(out) :: pt2(N_states)
|
||||||
|
|
||||||
|
|
||||||
|
if (.True.) then
|
||||||
|
PROVIDE pt2_e0_denominator
|
||||||
|
N = max(N_in,1)
|
||||||
|
provide nproc
|
||||||
|
call new_parallel_job(zmq_to_qp_run_socket,"selection")
|
||||||
|
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
|
||||||
|
call zmq_set_running(zmq_to_qp_run_socket)
|
||||||
|
call create_selection_buffer(N, N*2, b)
|
||||||
|
endif
|
||||||
|
|
||||||
|
integer :: i_generator, i_generator_start, i_generator_max, step
|
||||||
|
! step = int(max(1.,10*elec_num/mo_tot_num)
|
||||||
|
|
||||||
|
step = int(5000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num ))
|
||||||
|
step = max(1,step)
|
||||||
|
do i= 1, N_det_generators,step
|
||||||
|
i_generator_start = i
|
||||||
|
i_generator_max = min(i+step-1,N_det_generators)
|
||||||
|
write(task,*) i_generator_start, i_generator_max, 1, N
|
||||||
|
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
||||||
|
end do
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
if (i==0) then
|
||||||
|
call selection_collector(b, pt2)
|
||||||
|
else
|
||||||
|
call selection_slave_inproc(i)
|
||||||
|
endif
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
call end_parallel_job(zmq_to_qp_run_socket, 'selection')
|
||||||
|
if (N_in > 0) then
|
||||||
|
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) !!! PAS DE ROBIN
|
||||||
|
call copy_H_apply_buffer_to_wf()
|
||||||
|
if (s2_eig) then
|
||||||
|
call make_s2_eigenfunction
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine selection_slave_inproc(i)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i
|
||||||
|
|
||||||
|
call run_selection_slave(1,i,pt2_e0_denominator)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine selection_collector(b, pt2)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
|
||||||
|
type(selection_buffer), intent(inout) :: b
|
||||||
|
double precision, intent(out) :: pt2(N_states)
|
||||||
|
double precision :: pt2_mwen(N_states)
|
||||||
|
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 :: msg_size, rc, more
|
||||||
|
integer :: acc, i, j, robin, N, ntask
|
||||||
|
double precision, allocatable :: val(:)
|
||||||
|
integer(bit_kind), allocatable :: det(:,:,:)
|
||||||
|
integer, allocatable :: task_id(:)
|
||||||
|
integer :: done
|
||||||
|
real :: time, time0
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
zmq_socket_pull = new_zmq_pull_socket()
|
||||||
|
allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det))
|
||||||
|
done = 0
|
||||||
|
more = 1
|
||||||
|
pt2(:) = 0d0
|
||||||
|
call CPU_TIME(time0)
|
||||||
|
do while (more == 1)
|
||||||
|
call pull_selection_results(zmq_socket_pull, pt2_mwen, val(1), det(1,1,1), N, task_id, ntask)
|
||||||
|
pt2 += pt2_mwen
|
||||||
|
do i=1, N
|
||||||
|
call add_to_selection_buffer(b, det(1,1,i), val(i))
|
||||||
|
end do
|
||||||
|
|
||||||
|
do i=1, ntask
|
||||||
|
if(task_id(i) == 0) then
|
||||||
|
print *, "Error in collector"
|
||||||
|
endif
|
||||||
|
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
|
||||||
|
end do
|
||||||
|
done += ntask
|
||||||
|
call CPU_TIME(time)
|
||||||
|
! print *, "DONE" , done, time - time0
|
||||||
|
end do
|
||||||
|
|
||||||
|
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
call end_zmq_pull_socket(zmq_socket_pull)
|
||||||
|
call sort_selection_buffer(b)
|
||||||
|
end subroutine
|
||||||
|
|
@ -33,7 +33,7 @@ Documentation
|
|||||||
.. by the `update_README.py` script.
|
.. by the `update_README.py` script.
|
||||||
|
|
||||||
|
|
||||||
`degree_max_generators <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L43>`_
|
`degree_max_generators <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L45>`_
|
||||||
Max degree of excitation (respect to HF) of the generators
|
Max degree of excitation (respect to HF) of the generators
|
||||||
|
|
||||||
|
|
||||||
@ -52,10 +52,10 @@ Documentation
|
|||||||
Hartree-Fock determinant
|
Hartree-Fock determinant
|
||||||
|
|
||||||
|
|
||||||
`select_max <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L66>`_
|
`select_max <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L68>`_
|
||||||
Memo to skip useless selectors
|
Memo to skip useless selectors
|
||||||
|
|
||||||
|
|
||||||
`size_select_max <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L58>`_
|
`size_select_max <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L60>`_
|
||||||
Size of the select_max array
|
Size of the select_max array
|
||||||
|
|
||||||
|
0
plugins/Generators_restart/tree_dependency.png
Normal file
0
plugins/Generators_restart/tree_dependency.png
Normal file
@ -67,11 +67,11 @@ Documentation
|
|||||||
Alpha Fock matrix in AO basis set
|
Alpha Fock matrix in AO basis set
|
||||||
|
|
||||||
|
|
||||||
`fock_matrix_alpha_mo <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L268>`_
|
`fock_matrix_alpha_mo <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L269>`_
|
||||||
Fock matrix on the MO basis
|
Fock matrix on the MO basis
|
||||||
|
|
||||||
|
|
||||||
`fock_matrix_ao <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L326>`_
|
`fock_matrix_ao <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L327>`_
|
||||||
Fock matrix in AO basis set
|
Fock matrix in AO basis set
|
||||||
|
|
||||||
|
|
||||||
@ -79,7 +79,7 @@ Documentation
|
|||||||
Alpha Fock matrix in AO basis set
|
Alpha Fock matrix in AO basis set
|
||||||
|
|
||||||
|
|
||||||
`fock_matrix_beta_mo <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L288>`_
|
`fock_matrix_beta_mo <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L289>`_
|
||||||
Fock matrix on the MO basis
|
Fock matrix on the MO basis
|
||||||
|
|
||||||
|
|
||||||
@ -115,7 +115,7 @@ Documentation
|
|||||||
.br
|
.br
|
||||||
|
|
||||||
|
|
||||||
`fock_mo_to_ao <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L388>`_
|
`fock_mo_to_ao <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L389>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
@ -135,7 +135,7 @@ Documentation
|
|||||||
S^-1 Beta density matrix in the AO basis x S^-1
|
S^-1 Beta density matrix in the AO basis x S^-1
|
||||||
|
|
||||||
|
|
||||||
`hf_energy <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L307>`_
|
`hf_energy <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L308>`_
|
||||||
Hartree-Fock energy
|
Hartree-Fock energy
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,4 +1,10 @@
|
|||||||
program mp2
|
program mp2
|
||||||
|
no_vvvv_integrals = .True.
|
||||||
|
SOFT_TOUCH no_vvvv_integrals
|
||||||
|
call run
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine run
|
||||||
implicit none
|
implicit none
|
||||||
double precision, allocatable :: pt2(:), norm_pert(:)
|
double precision, allocatable :: pt2(:), norm_pert(:)
|
||||||
double precision :: H_pert_diag, E_old
|
double precision :: H_pert_diag, E_old
|
||||||
|
@ -1,4 +1,10 @@
|
|||||||
program mp2_wf
|
program mp2_wf
|
||||||
|
no_vvvv_integrals = .True.
|
||||||
|
SOFT_TOUCH no_vvvv_integrals
|
||||||
|
call run
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine run
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Save the MP2 wave function
|
! Save the MP2 wave function
|
||||||
|
1
plugins/MRCC_Utils/.gitignore
vendored
1
plugins/MRCC_Utils/.gitignore
vendored
@ -3,6 +3,7 @@
|
|||||||
.ninja_log
|
.ninja_log
|
||||||
AO_Basis
|
AO_Basis
|
||||||
Bitmask
|
Bitmask
|
||||||
|
Davidson
|
||||||
Determinants
|
Determinants
|
||||||
Electrons
|
Electrons
|
||||||
Ezfio_files
|
Ezfio_files
|
||||||
|
@ -36,11 +36,19 @@ Documentation
|
|||||||
Compute 1st dimension such that it is aligned for vectorization.
|
Compute 1st dimension such that it is aligned for vectorization.
|
||||||
|
|
||||||
|
|
||||||
`apply_rotation <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L283>`_
|
`apply_hole_local <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1282>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`apply_particle_local <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1319>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`apply_rotation <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L320>`_
|
||||||
Apply the rotation found by find_rotation
|
Apply the rotation found by find_rotation
|
||||||
|
|
||||||
|
|
||||||
`approx_dble <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L382>`_
|
`approx_dble <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L371>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
@ -63,23 +71,23 @@ Documentation
|
|||||||
Binomial coefficients
|
Binomial coefficients
|
||||||
|
|
||||||
|
|
||||||
`ci_eigenvectors_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L105>`_
|
`ci_eigenvectors_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L120>`_
|
||||||
Eigenvectors/values of the CI matrix
|
Eigenvectors/values of the dressed CI matrix
|
||||||
|
|
||||||
|
|
||||||
`ci_eigenvectors_s2_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L106>`_
|
`ci_eigenvectors_s2_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L121>`_
|
||||||
Eigenvectors/values of the CI matrix
|
Eigenvectors/values of the dressed CI matrix
|
||||||
|
|
||||||
|
|
||||||
`ci_electronic_energy_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L104>`_
|
`ci_electronic_energy_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L119>`_
|
||||||
Eigenvectors/values of the CI matrix
|
Eigenvectors/values of the dressed CI matrix
|
||||||
|
|
||||||
|
|
||||||
`ci_energy_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L171>`_
|
`ci_energy_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L247>`_
|
||||||
N_states lowest eigenvalues of the dressed CI matrix
|
N_states lowest eigenvalues of the dressed CI matrix
|
||||||
|
|
||||||
|
|
||||||
`davidson_diag_hjj_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L59>`_
|
`davidson_diag_hjj_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L57>`_
|
||||||
Davidson diagonalization with specific diagonal elements of the H matrix
|
Davidson diagonalization with specific diagonal elements of the H matrix
|
||||||
.br
|
.br
|
||||||
H_jj : specific diagonal H matrix elements to diagonalize de Davidson
|
H_jj : specific diagonal H matrix elements to diagonalize de Davidson
|
||||||
@ -95,12 +103,39 @@ Documentation
|
|||||||
.br
|
.br
|
||||||
N_st : Number of eigenstates
|
N_st : Number of eigenstates
|
||||||
.br
|
.br
|
||||||
|
N_st_diag : Number of states in which H is diagonalized
|
||||||
|
.br
|
||||||
iunit : Unit for the I/O
|
iunit : Unit for the I/O
|
||||||
.br
|
.br
|
||||||
Initial guess vectors are not necessarily orthonormal
|
Initial guess vectors are not necessarily orthonormal
|
||||||
|
|
||||||
|
|
||||||
`davidson_diag_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L4>`_
|
`davidson_diag_hjj_sjj_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L610>`_
|
||||||
|
Davidson diagonalization with specific diagonal elements of the H matrix
|
||||||
|
.br
|
||||||
|
H_jj : specific diagonal H matrix elements to diagonalize de Davidson
|
||||||
|
.br
|
||||||
|
S2_jj : specific diagonal S^2 matrix elements
|
||||||
|
.br
|
||||||
|
dets_in : bitmasks corresponding to determinants
|
||||||
|
.br
|
||||||
|
u_in : guess coefficients on the various states. Overwritten
|
||||||
|
on exit
|
||||||
|
.br
|
||||||
|
dim_in : leftmost dimension of u_in
|
||||||
|
.br
|
||||||
|
sze : Number of determinants
|
||||||
|
.br
|
||||||
|
N_st : Number of eigenstates
|
||||||
|
.br
|
||||||
|
N_st_diag : Number of states in which H is diagonalized. Assumed > sze
|
||||||
|
.br
|
||||||
|
iunit : Unit for the I/O
|
||||||
|
.br
|
||||||
|
Initial guess vectors are not necessarily orthonormal
|
||||||
|
|
||||||
|
|
||||||
|
`davidson_diag_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L1>`_
|
||||||
Davidson diagonalization.
|
Davidson diagonalization.
|
||||||
.br
|
.br
|
||||||
dets_in : bitmasks corresponding to determinants
|
dets_in : bitmasks corresponding to determinants
|
||||||
@ -119,19 +154,38 @@ Documentation
|
|||||||
Initial guess vectors are not necessarily orthonormal
|
Initial guess vectors are not necessarily orthonormal
|
||||||
|
|
||||||
|
|
||||||
`dble_fact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L138>`_
|
`davidson_diag_mrcc_hs2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L552>`_
|
||||||
|
Davidson diagonalization.
|
||||||
|
.br
|
||||||
|
dets_in : bitmasks corresponding to determinants
|
||||||
|
.br
|
||||||
|
u_in : guess coefficients on the various states. Overwritten
|
||||||
|
on exit
|
||||||
|
.br
|
||||||
|
dim_in : leftmost dimension of u_in
|
||||||
|
.br
|
||||||
|
sze : Number of determinants
|
||||||
|
.br
|
||||||
|
N_st : Number of eigenstates
|
||||||
|
.br
|
||||||
|
iunit : Unit number for the I/O
|
||||||
|
.br
|
||||||
|
Initial guess vectors are not necessarily orthonormal
|
||||||
|
|
||||||
|
|
||||||
|
`dble_fact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L136>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`dble_fact_even <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L155>`_
|
`dble_fact_even <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L153>`_
|
||||||
n!!
|
n!!
|
||||||
|
|
||||||
|
|
||||||
`dble_fact_odd <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L176>`_
|
`dble_fact_odd <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L197>`_
|
||||||
n!!
|
n!!
|
||||||
|
|
||||||
|
|
||||||
`dble_logfact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L210>`_
|
`dble_logfact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L231>`_
|
||||||
n!!
|
n!!
|
||||||
|
|
||||||
|
|
||||||
@ -139,19 +193,23 @@ Documentation
|
|||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`delta_ii <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L68>`_
|
`dec_exc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L532>`_
|
||||||
Dressing matrix in N_det basis
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`delta_ij <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L67>`_
|
`diagonalize_ci_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L265>`_
|
||||||
Dressing matrix in N_det basis
|
|
||||||
|
|
||||||
|
|
||||||
`diagonalize_ci_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L186>`_
|
|
||||||
Replace the coefficients of the CI states by the coefficients of the
|
Replace the coefficients of the CI states by the coefficients of the
|
||||||
eigenstates of the CI matrix
|
eigenstates of the CI matrix
|
||||||
|
|
||||||
|
|
||||||
|
`dij <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1092>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`dij_unique <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L617>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`dset_order <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/sort.irp.f_template_216#L27>`_
|
`dset_order <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/sort.irp.f_template_216#L27>`_
|
||||||
array A has already been sorted, and iorder has contains the new order of
|
array A has already been sorted, and iorder has contains the new order of
|
||||||
elements of A. This subroutine changes the order of x to match the new order of A.
|
elements of A. This subroutine changes the order of x to match the new order of A.
|
||||||
@ -170,10 +228,26 @@ Documentation
|
|||||||
contains the new order of the elements.
|
contains the new order of the elements.
|
||||||
|
|
||||||
|
|
||||||
|
`dtranspose <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/transpose.irp.f#L41>`_
|
||||||
|
Transpose input matrix A into output matrix B
|
||||||
|
|
||||||
|
|
||||||
`erf0 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/need.irp.f#L105>`_
|
`erf0 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/need.irp.f#L105>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`exc_inf <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L479>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`exccmp <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1265>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`exceq <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1253>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`f_integral <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/integration.irp.f#L408>`_
|
`f_integral <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/integration.irp.f#L408>`_
|
||||||
function that calculates the following integral
|
function that calculates the following integral
|
||||||
\int_{\-infty}^{+\infty} x^n \exp(-p x^2) dx
|
\int_{\-infty}^{+\infty} x^n \exp(-p x^2) dx
|
||||||
@ -183,19 +257,19 @@ Documentation
|
|||||||
n!
|
n!
|
||||||
|
|
||||||
|
|
||||||
`fact_inv <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L125>`_
|
`fact_inv <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L123>`_
|
||||||
1/n!
|
1/n!
|
||||||
|
|
||||||
|
|
||||||
`find_rotation <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L264>`_
|
`find_rotation <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L301>`_
|
||||||
Find A.C = B
|
Find A.C = B
|
||||||
|
|
||||||
|
|
||||||
`find_triples_and_quadruples <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L315>`_
|
`find_triples_and_quadruples <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L286>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`find_triples_and_quadruples_micro <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L375>`_
|
`find_triples_and_quadruples_micro <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L346>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
@ -221,7 +295,15 @@ Documentation
|
|||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`get_pseudo_inverse <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L210>`_
|
`get_dij <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1129>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_dij_index <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1113>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`get_pseudo_inverse <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L247>`_
|
||||||
Find C = A^-1
|
Find C = A^-1
|
||||||
|
|
||||||
|
|
||||||
@ -306,11 +388,63 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
Assume N_int is already provided.
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
`h_matrix_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L79>`_
|
h_apply_mrcepa_pt2
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_mrcepa_pt2_collector
|
||||||
|
Collects results from the selection in an array of generators
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_mrcepa_pt2_diexc
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_mrcepa_pt2_diexcorg
|
||||||
|
Generate all double excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_mrcepa_pt2_diexcp
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_mrcepa_pt2_monoexc
|
||||||
|
Generate all single excitations of key_in using the bit masks of holes and
|
||||||
|
particles.
|
||||||
|
Assume N_int is already provided.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_mrcepa_pt2_slave
|
||||||
|
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.
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_mrcepa_pt2_slave_inproc
|
||||||
|
Computes a buffer using threads
|
||||||
|
|
||||||
|
|
||||||
|
h_apply_mrcepa_pt2_slave_tcp
|
||||||
|
Computes a buffer over the network
|
||||||
|
|
||||||
|
|
||||||
|
`h_matrix_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L94>`_
|
||||||
Dressed H with Delta_ij
|
Dressed H with Delta_ij
|
||||||
|
|
||||||
|
|
||||||
`h_u_0_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L367>`_
|
`h_s2_u_0_mrcc_nstates <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L997>`_
|
||||||
|
Computes v_0 = H|u_0> and s_0 = S^2 |u_0>
|
||||||
|
.br
|
||||||
|
n : number of determinants
|
||||||
|
.br
|
||||||
|
H_jj : array of <j|H|j>
|
||||||
|
.br
|
||||||
|
S2_jj : array of <j|S^2|j>
|
||||||
|
|
||||||
|
|
||||||
|
`h_u_0_mrcc_nstates <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L409>`_
|
||||||
Computes v_0 = H|u_0>
|
Computes v_0 = H|u_0>
|
||||||
.br
|
.br
|
||||||
n : number of determinants
|
n : number of determinants
|
||||||
@ -392,7 +526,15 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
Hermite polynomial
|
Hermite polynomial
|
||||||
|
|
||||||
|
|
||||||
`hij_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L53>`_
|
`hh_exists <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1181>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`hh_shortcut <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1182>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`hij_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L66>`_
|
||||||
< ref | H | Non-ref > matrix
|
< ref | H | Non-ref > matrix
|
||||||
|
|
||||||
|
|
||||||
@ -523,7 +665,7 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
to be in integer*8 format
|
to be in integer*8 format
|
||||||
|
|
||||||
|
|
||||||
`inv_int <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L257>`_
|
`inv_int <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L278>`_
|
||||||
1/i
|
1/i
|
||||||
|
|
||||||
|
|
||||||
@ -541,6 +683,10 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
iradix should be -1 in input.
|
iradix should be -1 in input.
|
||||||
|
|
||||||
|
|
||||||
|
`is_generable <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L284>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`iset_order <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/sort.irp.f_template_216#L52>`_
|
`iset_order <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/sort.irp.f_template_216#L52>`_
|
||||||
array A has already been sorted, and iorder has contains the new order of
|
array A has already been sorted, and iorder has contains the new order of
|
||||||
elements of A. This subroutine changes the order of x to match the new order of A.
|
elements of A. This subroutine changes the order of x to match the new order of A.
|
||||||
@ -559,15 +705,19 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
contains the new order of the elements.
|
contains the new order of the elements.
|
||||||
|
|
||||||
|
|
||||||
`lambda_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1>`_
|
`lambda_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L8>`_
|
||||||
cm/<Psi_0|H|D_m> or perturbative 1/Delta_E(m)
|
cm/<Psi_0|H|D_m> or perturbative 1/Delta_E(m)
|
||||||
|
|
||||||
|
|
||||||
`lambda_mrcc_pt2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L2>`_
|
`lambda_mrcc_kept <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L10>`_
|
||||||
cm/<Psi_0|H|D_m> or perturbative 1/Delta_E(m)
|
cm/<Psi_0|H|D_m> or perturbative 1/Delta_E(m)
|
||||||
|
|
||||||
|
|
||||||
`lapack_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L362>`_
|
`lambda_mrcc_pt2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L9>`_
|
||||||
|
cm/<Psi_0|H|D_m> or perturbative 1/Delta_E(m)
|
||||||
|
|
||||||
|
|
||||||
|
`lapack_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L399>`_
|
||||||
Diagonalize matrix H
|
Diagonalize matrix H
|
||||||
.br
|
.br
|
||||||
H is untouched between input and ouptut
|
H is untouched between input and ouptut
|
||||||
@ -578,7 +728,7 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
.br
|
.br
|
||||||
|
|
||||||
|
|
||||||
`lapack_diag_s2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L425>`_
|
`lapack_diag_s2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L462>`_
|
||||||
Diagonalize matrix H
|
Diagonalize matrix H
|
||||||
.br
|
.br
|
||||||
H is untouched between input and ouptut
|
H is untouched between input and ouptut
|
||||||
@ -589,7 +739,7 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
.br
|
.br
|
||||||
|
|
||||||
|
|
||||||
`lapack_diagd <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L295>`_
|
`lapack_diagd <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L332>`_
|
||||||
Diagonalize matrix H
|
Diagonalize matrix H
|
||||||
.br
|
.br
|
||||||
H is untouched between input and ouptut
|
H is untouched between input and ouptut
|
||||||
@ -600,7 +750,7 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
.br
|
.br
|
||||||
|
|
||||||
|
|
||||||
`lapack_partial_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L491>`_
|
`lapack_partial_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L528>`_
|
||||||
Diagonalize matrix H
|
Diagonalize matrix H
|
||||||
.br
|
.br
|
||||||
H is untouched between input and ouptut
|
H is untouched between input and ouptut
|
||||||
@ -611,19 +761,27 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
.br
|
.br
|
||||||
|
|
||||||
|
|
||||||
`logfact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L93>`_
|
`logfact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L91>`_
|
||||||
n!
|
n!
|
||||||
|
|
||||||
|
|
||||||
`lowercase <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L406>`_
|
`lowercase <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L395>`_
|
||||||
Transform to lower case
|
Transform to lower case
|
||||||
|
|
||||||
|
|
||||||
|
`map_load_from_disk <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/map_functions.irp.f#L70>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`map_save_to_disk <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/map_functions.irp.f#L1>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`mrcc_dress <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L17>`_
|
`mrcc_dress <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L17>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`mrcc_iterations <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_general.irp.f#L7>`_
|
`mrmode <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L3>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
@ -632,12 +790,24 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
D(t) =! D(t) +( B(t)*C(t))
|
D(t) =! D(t) +( B(t)*C(t))
|
||||||
|
|
||||||
|
|
||||||
`normalize <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L358>`_
|
`n_ex_exists <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L575>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`n_hh_exists <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L573>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`n_pp_exists <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L574>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`normalize <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L348>`_
|
||||||
Normalizes vector u
|
Normalizes vector u
|
||||||
u is expected to be aligned in memory.
|
u is expected to be aligned in memory.
|
||||||
|
|
||||||
|
|
||||||
`nproc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L283>`_
|
`nproc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L304>`_
|
||||||
Number of current OpenMP threads
|
Number of current OpenMP threads
|
||||||
|
|
||||||
|
|
||||||
@ -659,7 +829,7 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
.br
|
.br
|
||||||
|
|
||||||
|
|
||||||
`ortho_lowdin <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L128>`_
|
`ortho_lowdin <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L162>`_
|
||||||
Compute C_new=C_old.S^-1/2 orthogonalization.
|
Compute C_new=C_old.S^-1/2 orthogonalization.
|
||||||
.br
|
.br
|
||||||
overlap : overlap matrix
|
overlap : overlap matrix
|
||||||
@ -677,6 +847,19 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
.br
|
.br
|
||||||
|
|
||||||
|
|
||||||
|
`ortho_qr <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L128>`_
|
||||||
|
Orthogonalization using Q.R factorization
|
||||||
|
.br
|
||||||
|
A : matrix to orthogonalize
|
||||||
|
.br
|
||||||
|
LDA : leftmost dimension of A
|
||||||
|
.br
|
||||||
|
n : Number of rows of A
|
||||||
|
.br
|
||||||
|
m : Number of columns of A
|
||||||
|
.br
|
||||||
|
|
||||||
|
|
||||||
`overlap_a_b_c <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/one_e_integration.irp.f#L35>`_
|
`overlap_a_b_c <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/one_e_integration.irp.f#L35>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
@ -707,6 +890,10 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`pp_exists <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1183>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`progress_active <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/progress.irp.f#L29>`_
|
`progress_active <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/progress.irp.f#L29>`_
|
||||||
Current status for displaying progress bars. Global variable.
|
Current status for displaying progress bars. Global variable.
|
||||||
|
|
||||||
@ -727,6 +914,14 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
Current status for displaying progress bars. Global variable.
|
Current status for displaying progress bars. Global variable.
|
||||||
|
|
||||||
|
|
||||||
|
`psi_non_ref_sorted <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L609>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`psi_non_ref_sorted_idx <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L610>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`psi_ref_lock <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L4>`_
|
`psi_ref_lock <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L4>`_
|
||||||
Locks on ref determinants to fill delta_ij
|
Locks on ref determinants to fill delta_ij
|
||||||
|
|
||||||
@ -735,6 +930,10 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
Recenter two polynomials
|
Recenter two polynomials
|
||||||
|
|
||||||
|
|
||||||
|
`rho_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L618>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`rint <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/integration.irp.f#L436>`_
|
`rint <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/integration.irp.f#L436>`_
|
||||||
.. math::
|
.. math::
|
||||||
.br
|
.br
|
||||||
@ -762,10 +961,6 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`run_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_general.irp.f#L1>`_
|
|
||||||
Undocumented
|
|
||||||
|
|
||||||
|
|
||||||
`run_progress <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/progress.irp.f#L45>`_
|
`run_progress <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/progress.irp.f#L45>`_
|
||||||
Display a progress bar with documentation of what is happening
|
Display a progress bar with documentation of what is happening
|
||||||
|
|
||||||
@ -774,7 +969,15 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`set_generators_bitmasks_as_holes_and_particles <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_general.irp.f#L59>`_
|
`searchdet <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L337>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`searchexc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L388>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`set_generators_bitmasks_as_holes_and_particles <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_general.irp.f#L2>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
@ -790,7 +993,7 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
to be in integer*8 format
|
to be in integer*8 format
|
||||||
|
|
||||||
|
|
||||||
`set_zero_extra_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L548>`_
|
`set_zero_extra_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L585>`_
|
||||||
Undocumented
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
@ -800,6 +1003,14 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
contains the new order of the elements.
|
contains the new order of the elements.
|
||||||
|
|
||||||
|
|
||||||
|
`sort_det <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L417>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`sort_exc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L453>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
`start_progress <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/progress.irp.f#L1>`_
|
`start_progress <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/progress.irp.f#L1>`_
|
||||||
Starts the progress bar
|
Starts the progress bar
|
||||||
|
|
||||||
@ -817,18 +1028,37 @@ h_apply_mrcc_pt2_monoexc
|
|||||||
.br
|
.br
|
||||||
|
|
||||||
|
|
||||||
`u_dot_u <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L326>`_
|
`tamise_exc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L495>`_
|
||||||
|
Uncodumented : TODO
|
||||||
|
|
||||||
|
|
||||||
|
`transpose <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/transpose.irp.f#L2>`_
|
||||||
|
Transpose input matrix A into output matrix B
|
||||||
|
|
||||||
|
|
||||||
|
`u_0_h_u_0_mrcc_nstates <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L374>`_
|
||||||
|
Computes e_0 = <u_0|H|u_0>/<u_0|u_0>
|
||||||
|
.br
|
||||||
|
n : number of determinants
|
||||||
|
.br
|
||||||
|
|
||||||
|
|
||||||
|
`u_dot_u <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L334>`_
|
||||||
Compute <u|u>
|
Compute <u|u>
|
||||||
|
|
||||||
|
|
||||||
`u_dot_v <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L299>`_
|
`u_dot_v <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L320>`_
|
||||||
Compute <u|v>
|
Compute <u|v>
|
||||||
|
|
||||||
|
|
||||||
`wall_time <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L268>`_
|
`unsortedsearchdet <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L368>`_
|
||||||
|
Undocumented
|
||||||
|
|
||||||
|
|
||||||
|
`wall_time <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L289>`_
|
||||||
The equivalent of cpu_time, but for the wall time.
|
The equivalent of cpu_time, but for the wall time.
|
||||||
|
|
||||||
|
|
||||||
`write_git_log <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L243>`_
|
`write_git_log <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L264>`_
|
||||||
Write the last git commit in file iunit.
|
Write the last git commit in file iunit.
|
||||||
|
|
||||||
|
238
plugins/MRCC_Utils/amplitudes.irp.f
Normal file
238
plugins/MRCC_Utils/amplitudes.irp.f
Normal file
@ -0,0 +1,238 @@
|
|||||||
|
BEGIN_PROVIDER [ integer, n_exc_active ]
|
||||||
|
&BEGIN_PROVIDER [ integer, active_pp_idx, (hh_nex) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, active_hh_idx, (hh_nex) ]
|
||||||
|
&BEGIN_PROVIDER [ logical, is_active_exc, (hh_nex) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! is_active_exc : True if the excitation involves at least one active MO
|
||||||
|
!
|
||||||
|
! n_exc_active : Number of active excitations : Number of excitations without the inactive ones.
|
||||||
|
!
|
||||||
|
! active_hh_idx :
|
||||||
|
!
|
||||||
|
! active_pp_idx :
|
||||||
|
END_DOC
|
||||||
|
integer :: hh, pp, II
|
||||||
|
integer :: ind
|
||||||
|
logical :: ok
|
||||||
|
integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2)
|
||||||
|
|
||||||
|
integer, allocatable :: pathTo(:)
|
||||||
|
integer, external :: searchDet
|
||||||
|
|
||||||
|
allocate(pathTo(N_det_non_ref))
|
||||||
|
|
||||||
|
pathTo(:) = 0
|
||||||
|
is_active_exc(:) = .false.
|
||||||
|
n_exc_active = 0
|
||||||
|
|
||||||
|
do hh = 1, hh_shortcut(0)
|
||||||
|
do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1
|
||||||
|
do II = 1, N_det_ref
|
||||||
|
|
||||||
|
call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int)
|
||||||
|
if(.not. ok) cycle
|
||||||
|
|
||||||
|
call apply_particle_local(myMask, pp_exists(1, pp), myDet, ok, N_int)
|
||||||
|
if(.not. ok) cycle
|
||||||
|
|
||||||
|
ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int)
|
||||||
|
if(ind == -1) cycle
|
||||||
|
|
||||||
|
ind = psi_non_ref_sorted_idx(ind)
|
||||||
|
if(pathTo(ind) == 0) then
|
||||||
|
pathTo(ind) = pp
|
||||||
|
else
|
||||||
|
is_active_exc(pp) = .true.
|
||||||
|
is_active_exc(pathTo(ind)) = .true.
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
!is_active_exc=.true.
|
||||||
|
do hh = 1, hh_shortcut(0)
|
||||||
|
do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1
|
||||||
|
if(is_active_exc(pp)) then
|
||||||
|
n_exc_active = n_exc_active + 1
|
||||||
|
active_hh_idx(n_exc_active) = hh
|
||||||
|
active_pp_idx(n_exc_active) = pp
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
|
deallocate(pathTo)
|
||||||
|
|
||||||
|
print *, n_exc_active, "active excitations /", hh_nex
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_exc_active_sze ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Dimension of arrays to avoid zero-sized arrays
|
||||||
|
END_DOC
|
||||||
|
n_exc_active_sze = max(n_exc_active,1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, active_excitation_to_determinants_idx, (0:N_det_ref+1, n_exc_active_sze) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, active_excitation_to_determinants_val, (N_states,N_det_ref+1, n_exc_active_sze) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Sparse matrix A containing the matrix to transform the active excitations to
|
||||||
|
! determinants : A | \Psi_0 > = | \Psi_SD >
|
||||||
|
END_DOC
|
||||||
|
integer :: s, ppp, pp, hh, II, ind, wk, i
|
||||||
|
integer, allocatable :: lref(:)
|
||||||
|
integer(bit_kind) :: myDet(N_int,2), myMask(N_int,2)
|
||||||
|
double precision :: phase
|
||||||
|
logical :: ok
|
||||||
|
integer, external :: searchDet
|
||||||
|
|
||||||
|
|
||||||
|
!$OMP PARALLEL default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int,&
|
||||||
|
!$OMP active_excitation_to_determinants_val, active_excitation_to_determinants_idx)&
|
||||||
|
!$OMP shared(hh_shortcut, psi_ref_coef, N_det_non_ref, psi_non_ref_sorted, &
|
||||||
|
!$OMP psi_non_ref_sorted_idx, psi_ref, N_det_ref, N_states)&
|
||||||
|
!$OMP shared(is_active_exc, active_hh_idx, active_pp_idx, n_exc_active)&
|
||||||
|
!$OMP private(lref, pp, II, ok, myMask, myDet, ind, phase, wk, ppp, hh, s)
|
||||||
|
allocate(lref(N_det_non_ref))
|
||||||
|
!$OMP DO schedule(dynamic)
|
||||||
|
do ppp=1,n_exc_active
|
||||||
|
active_excitation_to_determinants_val(:,:,ppp) = 0d0
|
||||||
|
active_excitation_to_determinants_idx(:,ppp) = 0
|
||||||
|
pp = active_pp_idx(ppp)
|
||||||
|
hh = active_hh_idx(ppp)
|
||||||
|
lref = 0
|
||||||
|
do II = 1, N_det_ref
|
||||||
|
call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int)
|
||||||
|
if(.not. ok) cycle
|
||||||
|
call apply_particle_local(myMask, pp_exists(1, pp), myDet, ok, N_int)
|
||||||
|
if(.not. ok) cycle
|
||||||
|
ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int)
|
||||||
|
if(ind /= -1) then
|
||||||
|
call get_phase(myDet(1,1), psi_ref(1,1,II), phase, N_int)
|
||||||
|
if (phase > 0.d0) then
|
||||||
|
lref(psi_non_ref_sorted_idx(ind)) = II
|
||||||
|
else
|
||||||
|
lref(psi_non_ref_sorted_idx(ind)) = -II
|
||||||
|
endif
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
wk = 0
|
||||||
|
do i=1, N_det_non_ref
|
||||||
|
if(lref(i) > 0) then
|
||||||
|
wk += 1
|
||||||
|
do s=1,N_states
|
||||||
|
active_excitation_to_determinants_val(s,wk, ppp) = psi_ref_coef(lref(i), s)
|
||||||
|
enddo
|
||||||
|
active_excitation_to_determinants_idx(wk, ppp) = i
|
||||||
|
else if(lref(i) < 0) then
|
||||||
|
wk += 1
|
||||||
|
do s=1,N_states
|
||||||
|
active_excitation_to_determinants_val(s,wk, ppp) = -psi_ref_coef(-lref(i), s)
|
||||||
|
enddo
|
||||||
|
active_excitation_to_determinants_idx(wk, ppp) = i
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
active_excitation_to_determinants_idx(0,ppp) = wk
|
||||||
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
deallocate(lref)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, mrcc_AtA_ind, (N_det_ref * n_exc_active_sze) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, mrcc_AtA_val, (N_states, N_det_ref * n_exc_active_sze) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, mrcc_col_shortcut, (n_exc_active_sze) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, mrcc_N_col, (n_exc_active_sze) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! A is active_excitation_to_determinants in At.A
|
||||||
|
END_DOC
|
||||||
|
integer :: AtA_size, i,k
|
||||||
|
integer :: at_roww, at_row, wk, a_coll, a_col, r1, r2, s
|
||||||
|
double precision, allocatable :: t(:), A_val_mwen(:,:), As2_val_mwen(:,:)
|
||||||
|
integer, allocatable :: A_ind_mwen(:)
|
||||||
|
double precision :: sij
|
||||||
|
PROVIDE psi_non_ref
|
||||||
|
|
||||||
|
mrcc_AtA_ind(:) = 0
|
||||||
|
mrcc_AtA_val(:,:) = 0.d0
|
||||||
|
mrcc_col_shortcut(:) = 0
|
||||||
|
mrcc_N_col(:) = 0
|
||||||
|
AtA_size = 0
|
||||||
|
|
||||||
|
|
||||||
|
!$OMP PARALLEL default(none) shared(k, active_excitation_to_determinants_idx,&
|
||||||
|
!$OMP active_excitation_to_determinants_val, hh_nex) &
|
||||||
|
!$OMP private(at_row, a_col, t, i, r1, r2, wk, A_ind_mwen, A_val_mwen,&
|
||||||
|
!$OMP As2_val_mwen, a_coll, at_roww,sij) &
|
||||||
|
!$OMP shared(N_states,mrcc_col_shortcut, mrcc_N_col, AtA_size, mrcc_AtA_val, mrcc_AtA_ind, &
|
||||||
|
!$OMP n_exc_active, active_pp_idx,psi_non_ref)
|
||||||
|
allocate(A_val_mwen(N_states,hh_nex), As2_val_mwen(N_states,hh_nex), A_ind_mwen(hh_nex), t(N_states) )
|
||||||
|
|
||||||
|
!$OMP DO schedule(dynamic, 100)
|
||||||
|
do at_roww = 1, n_exc_active ! hh_nex
|
||||||
|
at_row = active_pp_idx(at_roww)
|
||||||
|
wk = 0
|
||||||
|
|
||||||
|
do a_coll = 1, n_exc_active
|
||||||
|
a_col = active_pp_idx(a_coll)
|
||||||
|
t(:) = 0d0
|
||||||
|
r1 = 1
|
||||||
|
r2 = 1
|
||||||
|
do while ((active_excitation_to_determinants_idx(r1, at_roww) /= 0).and.(active_excitation_to_determinants_idx(r2, a_coll) /= 0))
|
||||||
|
if(active_excitation_to_determinants_idx(r1, at_roww) > active_excitation_to_determinants_idx(r2, a_coll)) then
|
||||||
|
r2 = r2+1
|
||||||
|
else if(active_excitation_to_determinants_idx(r1, at_roww) < active_excitation_to_determinants_idx(r2, a_coll)) then
|
||||||
|
r1 = r1+1
|
||||||
|
else
|
||||||
|
do s=1,N_states
|
||||||
|
t(s) = t(s) - active_excitation_to_determinants_val(s,r1, at_roww) * active_excitation_to_determinants_val(s,r2, a_coll)
|
||||||
|
enddo
|
||||||
|
r1 = r1+1
|
||||||
|
r2 = r2+1
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
|
||||||
|
if (a_col == at_row) then
|
||||||
|
t(:) = t(:) + 1.d0
|
||||||
|
endif
|
||||||
|
if (sum(dabs(t(:))) > 0.d0) then
|
||||||
|
wk = wk+1
|
||||||
|
A_ind_mwen(wk) = a_col
|
||||||
|
A_val_mwen(:,wk) = t(:)
|
||||||
|
endif
|
||||||
|
|
||||||
|
end do
|
||||||
|
|
||||||
|
if(wk /= 0) then
|
||||||
|
!$OMP CRITICAL
|
||||||
|
mrcc_col_shortcut(at_roww) = AtA_size+1
|
||||||
|
mrcc_N_col(at_roww) = wk
|
||||||
|
if (AtA_size+wk > size(mrcc_AtA_ind,1)) then
|
||||||
|
print *, AtA_size+wk , size(mrcc_AtA_ind,1)
|
||||||
|
stop 'too small'
|
||||||
|
endif
|
||||||
|
do i=1,wk
|
||||||
|
mrcc_AtA_ind(AtA_size+i) = A_ind_mwen(i)
|
||||||
|
do s=1,N_states
|
||||||
|
mrcc_AtA_val(s,AtA_size+i) = A_val_mwen(s,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
AtA_size += wk
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
deallocate (A_ind_mwen, A_val_mwen, As2_val_mwen, t)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
print *, "At.A SIZE", ata_size
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
@ -94,7 +94,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
|||||||
double precision, allocatable :: overlap(:,:)
|
double precision, allocatable :: overlap(:,:)
|
||||||
double precision :: u_dot_v, u_dot_u
|
double precision :: u_dot_v, u_dot_u
|
||||||
|
|
||||||
integer, allocatable :: kl_pairs(:,:)
|
|
||||||
integer :: k_pairs, kl
|
integer :: k_pairs, kl
|
||||||
|
|
||||||
integer :: iter2
|
integer :: iter2
|
||||||
@ -144,7 +143,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
|||||||
sze_8 = align_double(sze)
|
sze_8 = align_double(sze)
|
||||||
|
|
||||||
allocate( &
|
allocate( &
|
||||||
kl_pairs(2,N_st_diag*(N_st_diag+1)/2), &
|
|
||||||
W(sze_8,N_st_diag,davidson_sze_max), &
|
W(sze_8,N_st_diag,davidson_sze_max), &
|
||||||
U(sze_8,N_st_diag,davidson_sze_max), &
|
U(sze_8,N_st_diag,davidson_sze_max), &
|
||||||
R(sze_8,N_st_diag), &
|
R(sze_8,N_st_diag), &
|
||||||
@ -209,19 +207,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
|||||||
! -------------------------------------------
|
! -------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
! do l=1,N_st_diag
|
|
||||||
! do k=1,N_st_diag
|
|
||||||
! do iter2=1,iter-1
|
|
||||||
! h(k,iter2,l,iter) = u_dot_v(U(1,k,iter2),W(1,l,iter),sze)
|
|
||||||
! h(k,iter,l,iter2) = h(k,iter2,l,iter)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! do k=1,l
|
|
||||||
! h(k,iter,l,iter) = u_dot_v(U(1,k,iter),W(1,l,iter),sze)
|
|
||||||
! h(l,iter,k,iter) = h(k,iter,l,iter)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
|
|
||||||
call dgemm('T','N', N_st_diag*iter, N_st_diag, sze, &
|
call dgemm('T','N', N_st_diag*iter, N_st_diag, sze, &
|
||||||
1.d0, U, size(U,1), W(1,1,iter), size(W,1), &
|
1.d0, U, size(U,1), W(1,1,iter), size(W,1), &
|
||||||
0.d0, h(1,1,1,iter), size(h,1)*size(h,2))
|
0.d0, h(1,1,1,iter), size(h,1)*size(h,2))
|
||||||
@ -330,20 +315,10 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
|||||||
! -----------
|
! -----------
|
||||||
|
|
||||||
do k=1,N_st_diag
|
do k=1,N_st_diag
|
||||||
energies(k) = lambda(k)
|
|
||||||
do i=1,sze
|
do i=1,sze
|
||||||
u_in(i,k) = 0.d0
|
u_in(i,k) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
! do k=1,N_st_diag
|
|
||||||
! do i=1,sze
|
|
||||||
! do iter2=1,iter
|
|
||||||
! do l=1,N_st_diag
|
|
||||||
! u_in(i,k) += U(i,l,iter2)*y(l,iter2,k,1)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
|
|
||||||
call dgemm('N','N', sze, N_st_diag, N_st_diag*iter, 1.d0, &
|
call dgemm('N','N', sze, N_st_diag, N_st_diag*iter, 1.d0, &
|
||||||
U, size(U,1), y, N_st_diag*davidson_sze_max, &
|
U, size(U,1), y, N_st_diag*davidson_sze_max, &
|
||||||
@ -351,6 +326,9 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
|||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
do k=1,N_st_diag
|
||||||
|
energies(k) = lambda(k)
|
||||||
|
enddo
|
||||||
write_buffer = '===== '
|
write_buffer = '===== '
|
||||||
do i=1,N_st
|
do i=1,N_st
|
||||||
write_buffer = trim(write_buffer)//' ================ ================'
|
write_buffer = trim(write_buffer)//' ================ ================'
|
||||||
@ -360,7 +338,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
|||||||
call write_time(iunit)
|
call write_time(iunit)
|
||||||
|
|
||||||
deallocate ( &
|
deallocate ( &
|
||||||
kl_pairs, &
|
|
||||||
W, residual_norm, &
|
W, residual_norm, &
|
||||||
U, overlap, &
|
U, overlap, &
|
||||||
R, c, &
|
R, c, &
|
||||||
@ -573,7 +550,7 @@ subroutine davidson_diag_mrcc_hs2(dets_in,u_in,dim_in,energies,sze,N_st,N_st_dia
|
|||||||
integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, iunit, istate
|
integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, iunit, istate
|
||||||
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
double precision, intent(inout) :: u_in(dim_in,N_st_diag)
|
double precision, intent(inout) :: u_in(dim_in,N_st_diag)
|
||||||
double precision, intent(out) :: energies(N_st)
|
double precision, intent(out) :: energies(N_st_diag)
|
||||||
double precision, allocatable :: H_jj(:), S2_jj(:)
|
double precision, allocatable :: H_jj(:), S2_jj(:)
|
||||||
|
|
||||||
double precision :: diag_h_mat_elem
|
double precision :: diag_h_mat_elem
|
||||||
@ -646,14 +623,12 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
integer :: i,j,k,l,m
|
integer :: i,j,k,l,m
|
||||||
logical :: converged
|
logical :: converged
|
||||||
|
|
||||||
double precision, allocatable :: overlap(:,:)
|
|
||||||
double precision :: u_dot_v, u_dot_u
|
double precision :: u_dot_v, u_dot_u
|
||||||
|
|
||||||
integer, allocatable :: kl_pairs(:,:)
|
|
||||||
integer :: k_pairs, kl
|
integer :: k_pairs, kl
|
||||||
|
|
||||||
integer :: iter2
|
integer :: iter2
|
||||||
double precision, allocatable :: W(:,:), U(:,:), R(:,:), S(:,:)
|
double precision, allocatable :: W(:,:), U(:,:), S(:,:), overlap(:,:)
|
||||||
double precision, allocatable :: y(:,:), h(:,:), lambda(:), s2(:)
|
double precision, allocatable :: y(:,:), h(:,:), lambda(:), s2(:)
|
||||||
double precision, allocatable :: c(:), s_(:,:), s_tmp(:,:)
|
double precision, allocatable :: c(:), s_(:,:), s_tmp(:,:)
|
||||||
double precision :: diag_h_mat_elem
|
double precision :: diag_h_mat_elem
|
||||||
@ -661,12 +636,14 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
character*(16384) :: write_buffer
|
character*(16384) :: write_buffer
|
||||||
double precision :: to_print(3,N_st)
|
double precision :: to_print(3,N_st)
|
||||||
double precision :: cpu, wall
|
double precision :: cpu, wall
|
||||||
integer :: shift, shift2
|
integer :: shift, shift2, itermax
|
||||||
include 'constants.include.F'
|
include 'constants.include.F'
|
||||||
|
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, R, S, y, h, lambda
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, S, y, h, lambda
|
||||||
if (N_st_diag > sze) then
|
if (N_st_diag*3 > sze) then
|
||||||
stop 'error in Davidson : N_st_diag > sze'
|
print *, 'error in Davidson :'
|
||||||
|
print *, 'Increase n_det_max_jacobi to ', N_st_diag*3
|
||||||
|
stop -1
|
||||||
endif
|
endif
|
||||||
|
|
||||||
PROVIDE nuclear_repulsion
|
PROVIDE nuclear_repulsion
|
||||||
@ -691,7 +668,7 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
write(iunit,'(A)') trim(write_buffer)
|
write(iunit,'(A)') trim(write_buffer)
|
||||||
write_buffer = ' Iter'
|
write_buffer = ' Iter'
|
||||||
do i=1,N_st
|
do i=1,N_st
|
||||||
write_buffer = trim(write_buffer)//' Energy S^2 Residual'
|
write_buffer = trim(write_buffer)//' Energy S^2 Residual '
|
||||||
enddo
|
enddo
|
||||||
write(iunit,'(A)') trim(write_buffer)
|
write(iunit,'(A)') trim(write_buffer)
|
||||||
write_buffer = '===== '
|
write_buffer = '===== '
|
||||||
@ -703,29 +680,29 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
integer, external :: align_double
|
integer, external :: align_double
|
||||||
sze_8 = align_double(sze)
|
sze_8 = align_double(sze)
|
||||||
|
|
||||||
double precision :: delta
|
itermax = min(davidson_sze_max, sze/N_st_diag)
|
||||||
|
|
||||||
if (s2_eig) then
|
|
||||||
delta = 1.d0
|
|
||||||
else
|
|
||||||
delta = 0.d0
|
|
||||||
endif
|
|
||||||
|
|
||||||
allocate( &
|
allocate( &
|
||||||
kl_pairs(2,N_st_diag*(N_st_diag+1)/2), &
|
W(sze_8,N_st_diag*itermax), &
|
||||||
W(sze_8,N_st_diag*davidson_sze_max), &
|
U(sze_8,N_st_diag*itermax), &
|
||||||
U(sze_8,N_st_diag*davidson_sze_max), &
|
S(sze_8,N_st_diag*itermax), &
|
||||||
R(sze_8,N_st_diag), &
|
h(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
S(sze_8,N_st_diag*davidson_sze_max), &
|
y(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
h(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
s_(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
y(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
s_tmp(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
s_(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
|
||||||
s_tmp(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
|
||||||
residual_norm(N_st_diag), &
|
residual_norm(N_st_diag), &
|
||||||
overlap(N_st_diag,N_st_diag), &
|
c(N_st_diag*itermax), &
|
||||||
c(N_st_diag*davidson_sze_max), &
|
s2(N_st_diag*itermax), &
|
||||||
s2(N_st_diag*davidson_sze_max), &
|
overlap(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
lambda(N_st_diag*davidson_sze_max))
|
lambda(N_st_diag*itermax))
|
||||||
|
|
||||||
|
h = 0.d0
|
||||||
|
s_ = 0.d0
|
||||||
|
s_tmp = 0.d0
|
||||||
|
U = 0.d0
|
||||||
|
W = 0.d0
|
||||||
|
S = 0.d0
|
||||||
|
y = 0.d0
|
||||||
|
|
||||||
|
|
||||||
ASSERT (N_st > 0)
|
ASSERT (N_st > 0)
|
||||||
ASSERT (N_st_diag >= N_st)
|
ASSERT (N_st_diag >= N_st)
|
||||||
@ -738,24 +715,18 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
|
|
||||||
converged = .False.
|
converged = .False.
|
||||||
|
|
||||||
do k=1,N_st
|
|
||||||
call normalize(u_in(1,k),sze)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do k=N_st+1,N_st_diag
|
|
||||||
do i=1,sze
|
|
||||||
double precision :: r1, r2
|
double precision :: r1, r2
|
||||||
|
do k=N_st+1,N_st_diag
|
||||||
|
u_in(k,k) = 10.d0
|
||||||
|
do i=1,sze
|
||||||
call random_number(r1)
|
call random_number(r1)
|
||||||
call random_number(r2)
|
call random_number(r2)
|
||||||
u_in(i,k) = dsqrt(-2.d0*dlog(r1))*dcos(dtwo_pi*r2)
|
r1 = dsqrt(-2.d0*dlog(r1))
|
||||||
|
r2 = dtwo_pi*r2
|
||||||
|
u_in(i,k) = r1*dcos(r2)
|
||||||
enddo
|
enddo
|
||||||
|
enddo
|
||||||
! Gram-Schmidt
|
do k=1,N_st_diag
|
||||||
! ------------
|
|
||||||
call dgemv('T',sze,k-1,1.d0,u_in,size(u_in,1), &
|
|
||||||
u_in(1,k),1,0.d0,c,1)
|
|
||||||
call dgemv('N',sze,k-1,-1.d0,u_in,size(u_in,1), &
|
|
||||||
c,1,1.d0,u_in(1,k),1)
|
|
||||||
call normalize(u_in(1,k),sze)
|
call normalize(u_in(1,k),sze)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -773,11 +744,11 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
shift = N_st_diag*(iter-1)
|
shift = N_st_diag*(iter-1)
|
||||||
shift2 = N_st_diag*iter
|
shift2 = N_st_diag*iter
|
||||||
|
|
||||||
|
call ortho_qr(U,size(U,1),sze,shift2)
|
||||||
|
|
||||||
! Compute |W_k> = \sum_i |i><i|H|u_k>
|
! Compute |W_k> = \sum_i |i><i|H|u_k>
|
||||||
! -----------------------------------------
|
! -----------------------------------------
|
||||||
|
|
||||||
|
|
||||||
call H_S2_u_0_mrcc_nstates(W(1,shift+1),S(1,shift+1),U(1,shift+1),H_jj,S2_jj,sze,dets_in,Nint,&
|
call H_S2_u_0_mrcc_nstates(W(1,shift+1),S(1,shift+1),U(1,shift+1),H_jj,S2_jj,sze,dets_in,Nint,&
|
||||||
istate,N_st_diag,sze_8)
|
istate,N_st_diag,sze_8)
|
||||||
|
|
||||||
@ -786,26 +757,52 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
! -------------------------------------------
|
! -------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
! do l=1,N_st_diag
|
call dgemm('T','N', shift2, shift2, sze, &
|
||||||
! do k=1,N_st_diag
|
1.d0, U, size(U,1), W, size(W,1), &
|
||||||
! do iter2=1,iter-1
|
0.d0, h, size(h,1))
|
||||||
! h(k,iter2,l,iter) = u_dot_v(U(1,k,iter2),W(1,l,iter),sze)
|
|
||||||
! h(k,iter,l,iter2) = h(k,iter2,l,iter)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! do k=1,l
|
|
||||||
! h(k,iter,l,iter) = u_dot_v(U(1,k,iter),W(1,l,iter),sze)
|
|
||||||
! h(l,iter,k,iter) = h(k,iter,l,iter)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
|
|
||||||
call dgemm('T','N', shift2, N_st_diag, sze, &
|
call dgemm('T','N', shift2, shift2, sze, &
|
||||||
1.d0, U, size(U,1), W(1,shift+1), size(W,1), &
|
1.d0, U, size(U,1), S, size(S,1), &
|
||||||
0.d0, h(1,shift+1), size(h,1))
|
0.d0, s_, size(s_,1))
|
||||||
|
|
||||||
|
! ! Diagonalize S^2
|
||||||
|
! ! ---------------
|
||||||
|
!
|
||||||
|
! call lapack_diag(s2,y,s_,size(s_,1),shift2)
|
||||||
|
!
|
||||||
|
! ! Rotate H in the basis of eigenfunctions of s2
|
||||||
|
! ! ---------------------------------------------
|
||||||
|
!
|
||||||
|
! call dgemm('N','N',shift2,shift2,shift2, &
|
||||||
|
! 1.d0, h, size(h,1), y, size(y,1), &
|
||||||
|
! 0.d0, s_tmp, size(s_tmp,1))
|
||||||
|
!
|
||||||
|
! call dgemm('T','N',shift2,shift2,shift2, &
|
||||||
|
! 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), &
|
||||||
|
! 0.d0, h, size(h,1))
|
||||||
|
!
|
||||||
|
! ! Damp interaction between different spin states
|
||||||
|
! ! ------------------------------------------------
|
||||||
|
!
|
||||||
|
! do k=1,shift2
|
||||||
|
! do l=1,shift2
|
||||||
|
! if (dabs(s2(k) - s2(l)) > 1.d0) then
|
||||||
|
! h(k,l) = h(k,l)*(max(0.d0,1.d0 - dabs(s2(k) - s2(l))))
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! ! Rotate back H
|
||||||
|
! ! -------------
|
||||||
|
!
|
||||||
|
! call dgemm('N','T',shift2,shift2,shift2, &
|
||||||
|
! 1.d0, h, size(h,1), y, size(y,1), &
|
||||||
|
! 0.d0, s_tmp, size(s_tmp,1))
|
||||||
|
!
|
||||||
|
! call dgemm('N','N',shift2,shift2,shift2, &
|
||||||
|
! 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), &
|
||||||
|
! 0.d0, h, size(h,1))
|
||||||
|
|
||||||
call dgemm('T','N', shift2, N_st_diag, sze, &
|
|
||||||
1.d0, U, size(U,1), S(1,shift+1), size(S,1), &
|
|
||||||
0.d0, s_(1,shift+1), size(s_,1))
|
|
||||||
|
|
||||||
! Diagonalize h
|
! Diagonalize h
|
||||||
! -------------
|
! -------------
|
||||||
@ -829,8 +826,14 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
if (s2_eig) then
|
if (s2_eig) then
|
||||||
logical :: state_ok(N_st_diag*davidson_sze_max)
|
logical :: state_ok(N_st_diag*davidson_sze_max)
|
||||||
do k=1,shift2
|
do k=1,shift2
|
||||||
state_ok(k) = (dabs(s2(k)-expected_s2) < 0.3d0)
|
state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0)
|
||||||
enddo
|
enddo
|
||||||
|
else
|
||||||
|
do k=1,size(state_ok)
|
||||||
|
state_ok(k) = .True.
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
do k=1,shift2
|
do k=1,shift2
|
||||||
if (.not. state_ok(k)) then
|
if (.not. state_ok(k)) then
|
||||||
do l=k+1,shift2
|
do l=k+1,shift2
|
||||||
@ -845,28 +848,57 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
if (state_following) then
|
||||||
|
|
||||||
|
! Compute overlap with U_in
|
||||||
|
! -------------------------
|
||||||
|
|
||||||
|
integer :: order(N_st_diag)
|
||||||
|
double precision :: cmax
|
||||||
|
overlap = -1.d0
|
||||||
|
do k=1,shift2
|
||||||
|
do i=1,shift2
|
||||||
|
overlap(k,i) = dabs(y(k,i))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do k=1,N_st
|
||||||
|
cmax = -1.d0
|
||||||
|
do i=1,N_st
|
||||||
|
if (overlap(i,k) > cmax) then
|
||||||
|
cmax = overlap(i,k)
|
||||||
|
order(k) = i
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
do i=1,shift2
|
||||||
|
overlap(order(k),i) = -1.d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
overlap = y
|
||||||
|
do k=1,N_st
|
||||||
|
l = order(k)
|
||||||
|
if (k /= l) then
|
||||||
|
y(1:shift2,k) = overlap(1:shift2,l)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
do k=1,N_st
|
||||||
|
overlap(k,1) = lambda(k)
|
||||||
|
overlap(k,2) = s2(k)
|
||||||
|
enddo
|
||||||
|
do k=1,N_st
|
||||||
|
l = order(k)
|
||||||
|
if (k /= l) then
|
||||||
|
lambda(k) = overlap(l,1)
|
||||||
|
s2(k) = overlap(l,2)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
||||||
! Express eigenvectors of h in the determinant basis
|
! Express eigenvectors of h in the determinant basis
|
||||||
! --------------------------------------------------
|
! --------------------------------------------------
|
||||||
|
|
||||||
! do k=1,N_st_diag
|
|
||||||
! do i=1,sze
|
|
||||||
! U(i,shift2+k) = 0.d0
|
|
||||||
! W(i,shift2+k) = 0.d0
|
|
||||||
! S(i,shift2+k) = 0.d0
|
|
||||||
! enddo
|
|
||||||
! do l=1,N_st_diag*iter
|
|
||||||
! do i=1,sze
|
|
||||||
! U(i,shift2+k) = U(i,shift2+k) + U(i,l)*y(l,k)
|
|
||||||
! W(i,shift2+k) = W(i,shift2+k) + W(i,l)*y(l,k)
|
|
||||||
! S(i,shift2+k) = S(i,shift2+k) + S(i,l)*y(l,k)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
!
|
|
||||||
!
|
|
||||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
|
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
|
||||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||||
@ -877,101 +909,64 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
! Compute residual vector
|
! Compute residual vector
|
||||||
! -----------------------
|
! -----------------------
|
||||||
|
|
||||||
! do k=1,N_st_diag
|
|
||||||
! print *, s2(k)
|
|
||||||
! s2(k) = u_dot_v(U(1,shift2+k), S(1,shift2+k), sze) + S_z2_Sz
|
|
||||||
! print *, s2(k)
|
|
||||||
! print *, ''
|
|
||||||
! pause
|
|
||||||
! enddo
|
|
||||||
do k=1,N_st_diag
|
do k=1,N_st_diag
|
||||||
|
! if (state_ok(k)) then
|
||||||
do i=1,sze
|
do i=1,sze
|
||||||
R(i,k) = (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) &
|
U(i,shift2+k) = (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) &
|
||||||
* (1.d0 + s2(k) * U(i,shift2+k) - S(i,shift2+k) - S_z2_Sz)
|
* (1.d0 + s2(k) * U(i,shift2+k) - S(i,shift2+k) - S_z2_Sz &
|
||||||
|
)/max(H_jj(i) - lambda (k),1.d-2)
|
||||||
enddo
|
enddo
|
||||||
|
! else
|
||||||
|
! ! Randomize components with bad <S2>
|
||||||
|
! do i=1,sze-2,2
|
||||||
|
! call random_number(r1)
|
||||||
|
! call random_number(r2)
|
||||||
|
! r1 = dsqrt(-2.d0*dlog(r1))
|
||||||
|
! r2 = dtwo_pi*r2
|
||||||
|
! U(i,shift2+k) = r1*dcos(r2)
|
||||||
|
! U(i+1,shift2+k) = r1*dsin(r2)
|
||||||
|
! enddo
|
||||||
|
! do i=sze-2+1,sze
|
||||||
|
! call random_number(r1)
|
||||||
|
! call random_number(r2)
|
||||||
|
! r1 = dsqrt(-2.d0*dlog(r1))
|
||||||
|
! r2 = dtwo_pi*r2
|
||||||
|
! U(i,shift2+k) = r1*dcos(r2)
|
||||||
|
! enddo
|
||||||
|
! endif
|
||||||
|
|
||||||
if (k <= N_st) then
|
if (k <= N_st) then
|
||||||
residual_norm(k) = u_dot_u(R(1,k),sze)
|
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
|
||||||
to_print(1,k) = lambda(k) + nuclear_repulsion
|
to_print(1,k) = lambda(k) + nuclear_repulsion
|
||||||
to_print(2,k) = s2(k)
|
to_print(2,k) = s2(k)
|
||||||
to_print(3,k) = residual_norm(k)
|
to_print(3,k) = residual_norm(k)
|
||||||
if (residual_norm(k) > 1.e9) then
|
|
||||||
stop 'Davidson failed'
|
|
||||||
endif
|
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(:,1:N_st)
|
write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(1:3,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)
|
||||||
|
do k=1,N_st
|
||||||
|
if (residual_norm(k) > 1.e8) then
|
||||||
|
print *, ''
|
||||||
|
stop 'Davidson failed'
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
if (converged) then
|
if (converged) then
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
|
|
||||||
! Davidson step
|
|
||||||
! -------------
|
|
||||||
|
|
||||||
do k=1,N_st_diag
|
|
||||||
do i=1,sze
|
|
||||||
U(i,shift2+k) = - R(i,k)/max(H_jj(i) - lambda(k),1.d-2)
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
|
||||||
|
|
||||||
! Gram-Schmidt
|
|
||||||
! ------------
|
|
||||||
|
|
||||||
do k=1,N_st_diag
|
|
||||||
|
|
||||||
! do l=1,N_st_diag*iter
|
|
||||||
! c(1) = u_dot_v(U(1,shift2+k),U(1,l),sze)
|
|
||||||
! do i=1,sze
|
|
||||||
! U(i,k,iter+1) = U(i,shift2+k) - c(1) * U(i,l)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
!
|
|
||||||
call dgemv('T',sze,N_st_diag*iter,1.d0,U,size(U,1), &
|
|
||||||
U(1,shift2+k),1,0.d0,c,1)
|
|
||||||
call dgemv('N',sze,N_st_diag*iter,-1.d0,U,size(U,1), &
|
|
||||||
c,1,1.d0,U(1,shift2+k),1)
|
|
||||||
!
|
|
||||||
! do l=1,k-1
|
|
||||||
! c(1) = u_dot_v(U(1,shift2+k),U(1,shift2+l),sze)
|
|
||||||
! do i=1,sze
|
|
||||||
! U(i,k,iter+1) = U(i,shift2+k) - c(1) * U(i,shift2+l)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
!
|
|
||||||
call dgemv('T',sze,k-1,1.d0,U(1,shift2+1),size(U,1), &
|
|
||||||
U(1,shift2+k),1,0.d0,c,1)
|
|
||||||
call dgemv('N',sze,k-1,-1.d0,U(1,shift2+1),size(U,1), &
|
|
||||||
c,1,1.d0,U(1,shift2+k),1)
|
|
||||||
|
|
||||||
call normalize( U(1,shift2+k), sze )
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
if (.not.converged) then
|
|
||||||
iter = davidson_sze_max-1
|
|
||||||
endif
|
|
||||||
|
|
||||||
! Re-contract to u_in
|
! Re-contract to u_in
|
||||||
! -----------
|
! -----------
|
||||||
|
|
||||||
do k=1,N_st_diag
|
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||||
energies(k) = lambda(k)
|
1.d0, U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
! do k=1,N_st_diag
|
do k=1,N_st_diag
|
||||||
! do i=1,sze
|
energies(k) = lambda(k)
|
||||||
! do l=1,iter*N_st_diag
|
|
||||||
! u_in(i,k) += U(i,l)*y(l,k)
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
|
|
||||||
call dgemm('N','N', sze, N_st_diag, N_st_diag*iter, 1.d0, &
|
|
||||||
U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
|
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
write_buffer = '===== '
|
write_buffer = '===== '
|
||||||
@ -983,10 +978,9 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
|||||||
call write_time(iunit)
|
call write_time(iunit)
|
||||||
|
|
||||||
deallocate ( &
|
deallocate ( &
|
||||||
kl_pairs, &
|
|
||||||
W, residual_norm, &
|
W, residual_norm, &
|
||||||
U, overlap, &
|
U, overlap, &
|
||||||
R, c, S, &
|
c, S, &
|
||||||
h, &
|
h, &
|
||||||
y, s_, s_tmp, &
|
y, s_, s_tmp, &
|
||||||
lambda &
|
lambda &
|
||||||
@ -1048,15 +1042,16 @@ subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_i
|
|||||||
call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint)
|
call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint)
|
||||||
call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint)
|
call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint)
|
||||||
|
|
||||||
|
PROVIDE delta_ij_s2
|
||||||
!$OMP PARALLEL DEFAULT(NONE) &
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
!$OMP PRIVATE(i,hij,s2,j,k,jj,vt,st,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)&
|
!$OMP PRIVATE(i,hij,s2,j,k,jj,vt,st,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)&
|
||||||
!$OMP SHARED(n,keys_tmp,ut,Nint,v_0,s_0,sorted,shortcut,sort_idx,version,N_st,N_st_8, &
|
!$OMP SHARED(n,keys_tmp,ut,Nint,v_0,s_0,sorted,shortcut,sort_idx,version,N_st,N_st_8, &
|
||||||
!$OMP N_det_ref, idx_ref, N_det_non_ref, idx_non_ref, delta_ij,istate_in)
|
!$OMP N_det_ref, idx_ref, N_det_non_ref, idx_non_ref, delta_ij, delta_ij_s2,istate_in)
|
||||||
allocate(vt(N_st_8,n),st(N_st_8,n))
|
allocate(vt(N_st_8,n),st(N_st_8,n))
|
||||||
Vt = 0.d0
|
Vt = 0.d0
|
||||||
St = 0.d0
|
St = 0.d0
|
||||||
|
|
||||||
!$OMP DO SCHEDULE(dynamic)
|
!$OMP DO SCHEDULE(guided)
|
||||||
do sh=1,shortcut(0,1)
|
do sh=1,shortcut(0,1)
|
||||||
do sh2=sh,shortcut(0,1)
|
do sh2=sh,shortcut(0,1)
|
||||||
exa = 0
|
exa = 0
|
||||||
@ -1098,8 +1093,8 @@ subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_i
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END DO NOWAIT
|
!$OMP END DO
|
||||||
!$OMP DO SCHEDULE(dynamic)
|
!$OMP DO SCHEDULE(guided)
|
||||||
do sh=1,shortcut(0,2)
|
do sh=1,shortcut(0,2)
|
||||||
do i=shortcut(sh,2),shortcut(sh+1,2)-1
|
do i=shortcut(sh,2),shortcut(sh+1,2)-1
|
||||||
org_i = sort_idx(i,2)
|
org_i = sort_idx(i,2)
|
||||||
@ -1122,7 +1117,7 @@ subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_i
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
enddo
|
enddo
|
||||||
!$OMP END DO NOWAIT
|
!$OMP END DO
|
||||||
|
|
||||||
! --------------------------
|
! --------------------------
|
||||||
! Begin Specific to dressing
|
! Begin Specific to dressing
|
||||||
@ -1136,6 +1131,8 @@ subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_i
|
|||||||
do istate=1,N_st
|
do istate=1,N_st
|
||||||
vt (istate,i) = vt (istate,i) + delta_ij(istate_in,jj,ii)*ut(istate,j)
|
vt (istate,i) = vt (istate,i) + delta_ij(istate_in,jj,ii)*ut(istate,j)
|
||||||
vt (istate,j) = vt (istate,j) + delta_ij(istate_in,jj,ii)*ut(istate,i)
|
vt (istate,j) = vt (istate,j) + delta_ij(istate_in,jj,ii)*ut(istate,i)
|
||||||
|
st (istate,i) = st (istate,i) + delta_ij_s2(istate_in,jj,ii)*ut(istate,j)
|
||||||
|
st (istate,j) = st (istate,j) + delta_ij_s2(istate_in,jj,ii)*ut(istate,i)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
@ -271,7 +271,7 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge
|
|||||||
!delta_ii_(i_state,i_I) = 0.d0
|
!delta_ii_(i_state,i_I) = 0.d0
|
||||||
do l_sd=1,idx_alpha(0)
|
do l_sd=1,idx_alpha(0)
|
||||||
k_sd = idx_alpha(l_sd)
|
k_sd = idx_alpha(l_sd)
|
||||||
delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd)
|
delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + 0.5d0 * dIa_hla(i_state,k_sd)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
@ -1,4 +0,0 @@
|
|||||||
program pouet
|
|
||||||
|
|
||||||
|
|
||||||
end
|
|
@ -33,6 +33,7 @@ END_PROVIDER
|
|||||||
if (ihpsi_current(k) == 0.d0) then
|
if (ihpsi_current(k) == 0.d0) then
|
||||||
ihpsi_current(k) = 1.d-32
|
ihpsi_current(k) = 1.d-32
|
||||||
endif
|
endif
|
||||||
|
! lambda_mrcc(k,i) = psi_non_ref_coef(i,k)/ihpsi_current(k)
|
||||||
lambda_mrcc(k,i) = min(-1.d-32,psi_non_ref_coef(i,k)/ihpsi_current(k) )
|
lambda_mrcc(k,i) = min(-1.d-32,psi_non_ref_coef(i,k)/ihpsi_current(k) )
|
||||||
lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii)
|
lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii)
|
||||||
if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then
|
if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then
|
||||||
@ -75,19 +76,6 @@ BEGIN_PROVIDER [ double precision, hij_mrcc, (N_det_non_ref,N_det_ref) ]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref,N_det_ref) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, delta_ii, (N_states,N_det_ref) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Dressing matrix in N_det basis
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,m
|
|
||||||
delta_ij = 0.d0
|
|
||||||
delta_ii = 0.d0
|
|
||||||
call H_apply_mrcc(delta_ij,delta_ii,N_states,N_det_non_ref,N_det_ref)
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
@ -139,7 +127,6 @@ END_PROVIDER
|
|||||||
|
|
||||||
integer :: mrcc_state
|
integer :: mrcc_state
|
||||||
|
|
||||||
mrcc_state = N_states
|
|
||||||
do j=1,min(N_states,N_det)
|
do j=1,min(N_states,N_det)
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors_dressed(i,j) = psi_coef(i,j)
|
CI_eigenvectors_dressed(i,j) = psi_coef(i,j)
|
||||||
@ -148,17 +135,34 @@ END_PROVIDER
|
|||||||
|
|
||||||
if (diag_algorithm == "Davidson") then
|
if (diag_algorithm == "Davidson") then
|
||||||
|
|
||||||
! call davidson_diag_mrcc(psi_det,CI_eigenvectors_dressed,CI_electronic_energy_dressed,&
|
allocate (eigenvectors(size(CI_eigenvectors_dressed,1),size(CI_eigenvectors_dressed,2)), &
|
||||||
! size(CI_eigenvectors_dressed,1),N_det,N_states,N_states_diag,N_int,output_determinants,mrcc_state)
|
eigenvalues(size(CI_electronic_energy_dressed,1)))
|
||||||
|
do j=1,min(N_states,N_det)
|
||||||
call davidson_diag_mrcc_HS2(psi_det,CI_eigenvectors_dressed,&
|
do i=1,N_det
|
||||||
size(CI_eigenvectors_dressed,1), &
|
eigenvectors(i,j) = psi_coef(i,j)
|
||||||
CI_electronic_energy_dressed,N_det,N_states,N_states_diag,N_int, &
|
enddo
|
||||||
|
enddo
|
||||||
|
do mrcc_state=1,N_states
|
||||||
|
do j=mrcc_state,min(N_states,N_det)
|
||||||
|
do i=1,N_det
|
||||||
|
eigenvectors(i,j) = psi_coef(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call davidson_diag_mrcc_HS2(psi_det,eigenvectors,&
|
||||||
|
size(eigenvectors,1), &
|
||||||
|
eigenvalues,N_det,N_states,N_states_diag,N_int, &
|
||||||
output_determinants,mrcc_state)
|
output_determinants,mrcc_state)
|
||||||
|
CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,mrcc_state)
|
||||||
|
CI_electronic_energy_dressed(mrcc_state) = eigenvalues(mrcc_state)
|
||||||
|
enddo
|
||||||
|
do k=N_states+1,N_states_diag
|
||||||
|
CI_eigenvectors_dressed(1:N_det,k) = eigenvectors(1:N_det,k)
|
||||||
|
CI_electronic_energy_dressed(k) = eigenvalues(k)
|
||||||
|
enddo
|
||||||
call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,&
|
call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,&
|
||||||
N_states_diag,size(CI_eigenvectors_dressed,1))
|
N_states_diag,size(CI_eigenvectors_dressed,1))
|
||||||
|
|
||||||
|
deallocate (eigenvectors,eigenvalues)
|
||||||
|
|
||||||
else if (diag_algorithm == "Lapack") then
|
else if (diag_algorithm == "Lapack") then
|
||||||
|
|
||||||
@ -614,207 +618,52 @@ END_PROVIDER
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, dIj_unique, (hh_shortcut(hh_shortcut(0)+1)-1, N_states) ]
|
BEGIN_PROVIDER [ double precision, dIj_unique, (hh_nex, N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, rho_mrcc, (N_det_non_ref, N_states) ]
|
&BEGIN_PROVIDER [ double precision, rho_mrcc, (N_det_non_ref, N_states) ]
|
||||||
implicit none
|
implicit none
|
||||||
logical :: ok
|
logical :: ok
|
||||||
integer :: i, j, k, s, II, pp, ppp, hh, ind, wk, nex, a_col, at_row
|
integer :: i, j, k, s, II, pp, ppp, hh, ind, wk, a_col, at_row
|
||||||
integer, external :: searchDet, unsortedSearchDet
|
integer, external :: searchDet, unsortedSearchDet
|
||||||
integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2)
|
integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2)
|
||||||
integer :: N, INFO, AtA_size, r1, r2
|
integer :: N, INFO, r1, r2
|
||||||
double precision , allocatable :: AtB(:), AtA_val(:), A_val(:,:), x(:), x_new(:), A_val_mwen(:)
|
double precision , allocatable :: AtB(:), x(:), x_new(:), A_val_mwen(:,:), t(:)
|
||||||
double precision :: t, norm, cx, res
|
double precision :: norm, cx, res
|
||||||
integer, allocatable :: A_ind(:,:), lref(:), AtA_ind(:), A_ind_mwen(:), col_shortcut(:), N_col(:)
|
integer, allocatable :: lref(:), A_ind_mwen(:)
|
||||||
double precision :: phase
|
double precision :: phase
|
||||||
|
|
||||||
|
|
||||||
integer, allocatable :: pathTo(:), active_hh_idx(:), active_pp_idx(:)
|
double precision, allocatable :: rho_mrcc_init(:)
|
||||||
logical, allocatable :: active(:)
|
|
||||||
double precision, allocatable :: rho_mrcc_init(:,:)
|
|
||||||
integer :: nactive
|
|
||||||
|
|
||||||
nex = hh_shortcut(hh_shortcut(0)+1)-1
|
|
||||||
print *, "TI", nex, N_det_non_ref
|
|
||||||
|
|
||||||
allocate(pathTo(N_det_non_ref), active(nex))
|
|
||||||
allocate(active_pp_idx(nex), active_hh_idx(nex))
|
|
||||||
allocate(rho_mrcc_init(N_det_non_ref, N_states))
|
|
||||||
|
|
||||||
pathTo = 0
|
|
||||||
active = .false.
|
|
||||||
nactive = 0
|
|
||||||
|
|
||||||
|
|
||||||
do hh = 1, hh_shortcut(0)
|
|
||||||
do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1
|
|
||||||
do II = 1, N_det_ref
|
|
||||||
call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int)
|
|
||||||
if(.not. ok) cycle
|
|
||||||
call apply_particle_local(myMask, pp_exists(1, pp), myDet, ok, N_int)
|
|
||||||
if(.not. ok) cycle
|
|
||||||
ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int)
|
|
||||||
if(ind == -1) cycle
|
|
||||||
ind = psi_non_ref_sorted_idx(ind)
|
|
||||||
if(pathTo(ind) == 0) then
|
|
||||||
pathTo(ind) = pp
|
|
||||||
else
|
|
||||||
active(pp) = .true.
|
|
||||||
active(pathTo(ind)) = .true.
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
do hh = 1, hh_shortcut(0)
|
|
||||||
do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1
|
|
||||||
if(active(pp)) then
|
|
||||||
nactive = nactive + 1
|
|
||||||
active_hh_idx(nactive) = hh
|
|
||||||
active_pp_idx(nactive) = pp
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
print *, nactive, "inact/", size(active)
|
|
||||||
|
|
||||||
allocate(A_ind(0:N_det_ref+1, nactive), A_val(N_det_ref+1, nactive))
|
|
||||||
allocate(AtA_ind(N_det_ref * nactive), AtA_val(N_det_ref * nactive))
|
|
||||||
allocate(x(nex), AtB(nex))
|
|
||||||
allocate(N_col(nactive), col_shortcut(nactive))
|
|
||||||
allocate(x_new(nex))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
do s = 1, N_states
|
|
||||||
|
|
||||||
A_val = 0d0
|
|
||||||
A_ind = 0
|
|
||||||
AtA_ind = 0
|
|
||||||
AtB = 0d0
|
|
||||||
AtA_val = 0d0
|
|
||||||
x = 0d0
|
|
||||||
N_col = 0
|
|
||||||
col_shortcut = 0
|
|
||||||
|
|
||||||
!$OMP PARALLEL default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int, A_val, A_ind)&
|
|
||||||
!$OMP shared(s, hh_shortcut, psi_ref_coef, N_det_non_ref, psi_non_ref_sorted, psi_non_ref_sorted_idx, psi_ref, N_det_ref)&
|
|
||||||
!$OMP shared(active, active_hh_idx, active_pp_idx, nactive)&
|
|
||||||
!$OMP private(lref, pp, II, ok, myMask, myDet, ind, phase, wk, ppp, hh)
|
|
||||||
allocate(lref(N_det_non_ref))
|
|
||||||
!$OMP DO schedule(static,10)
|
|
||||||
do ppp=1,nactive
|
|
||||||
pp = active_pp_idx(ppp)
|
|
||||||
hh = active_hh_idx(ppp)
|
|
||||||
lref = 0
|
|
||||||
do II = 1, N_det_ref
|
|
||||||
call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int)
|
|
||||||
if(.not. ok) cycle
|
|
||||||
call apply_particle_local(myMask, pp_exists(1, pp), myDet, ok, N_int)
|
|
||||||
if(.not. ok) cycle
|
|
||||||
ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int)
|
|
||||||
if(ind /= -1) then
|
|
||||||
call get_phase(myDet(1,1), psi_ref(1,1,II), phase, N_int)
|
|
||||||
if (phase > 0.d0) then
|
|
||||||
lref(psi_non_ref_sorted_idx(ind)) = II
|
|
||||||
else
|
|
||||||
lref(psi_non_ref_sorted_idx(ind)) = -II
|
|
||||||
endif
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
wk = 0
|
|
||||||
do i=1, N_det_non_ref
|
|
||||||
if(lref(i) > 0) then
|
|
||||||
wk += 1
|
|
||||||
A_val(wk, ppp) = psi_ref_coef(lref(i), s)
|
|
||||||
A_ind(wk, ppp) = i
|
|
||||||
else if(lref(i) < 0) then
|
|
||||||
wk += 1
|
|
||||||
A_val(wk, ppp) = -psi_ref_coef(-lref(i), s)
|
|
||||||
A_ind(wk, ppp) = i
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
A_ind(0,ppp) = wk
|
|
||||||
end do
|
|
||||||
!$OMP END DO
|
|
||||||
deallocate(lref)
|
|
||||||
!$OMP END PARALLEL
|
|
||||||
|
|
||||||
|
|
||||||
print *, 'Done building A_val, A_ind'
|
|
||||||
|
|
||||||
AtA_size = 0
|
|
||||||
col_shortcut = 0
|
|
||||||
N_col = 0
|
|
||||||
integer :: a_coll, at_roww
|
integer :: a_coll, at_roww
|
||||||
|
|
||||||
|
print *, "TI", hh_nex, N_det_non_ref
|
||||||
|
|
||||||
!$OMP PARALLEL default(none) shared(k, psi_non_ref_coef, A_ind, A_val, x, N_det_ref, nex, N_det_non_ref)&
|
allocate(rho_mrcc_init(N_det_non_ref))
|
||||||
!$OMP private(at_row, a_col, t, i, j, r1, r2, wk, A_ind_mwen, A_val_mwen, a_coll, at_roww)&
|
allocate(x_new(hh_nex))
|
||||||
!$OMP shared(col_shortcut, N_col, AtB, AtA_size, AtA_val, AtA_ind, s, nactive, active_pp_idx)
|
allocate(x(hh_nex), AtB(hh_nex))
|
||||||
allocate(A_val_mwen(nex), A_ind_mwen(nex))
|
|
||||||
|
do s=1,N_states
|
||||||
|
|
||||||
|
AtB(:) = 0.d0
|
||||||
|
!$OMP PARALLEL default(none) shared(k, psi_non_ref_coef, active_excitation_to_determinants_idx,&
|
||||||
|
!$OMP active_excitation_to_determinants_val, N_det_ref, hh_nex, N_det_non_ref) &
|
||||||
|
!$OMP private(at_row, a_col, i, j, r1, r2, wk, A_ind_mwen, A_val_mwen, a_coll, at_roww)&
|
||||||
|
!$OMP shared(N_states,mrcc_col_shortcut, mrcc_N_col, AtB, mrcc_AtA_val, mrcc_AtA_ind, s, n_exc_active, active_pp_idx)
|
||||||
|
|
||||||
!$OMP DO schedule(dynamic, 100)
|
!$OMP DO schedule(dynamic, 100)
|
||||||
do at_roww = 1, nactive ! nex
|
do at_roww = 1, n_exc_active ! hh_nex
|
||||||
at_row = active_pp_idx(at_roww)
|
at_row = active_pp_idx(at_roww)
|
||||||
wk = 0
|
do i=1,active_excitation_to_determinants_idx(0,at_roww)
|
||||||
if(mod(at_roww, 100) == 0) print *, "AtA", at_row, "/", nex
|
AtB(at_row) = AtB(at_row) + psi_non_ref_coef(active_excitation_to_determinants_idx(i, at_roww), s) * active_excitation_to_determinants_val(s,i, at_roww)
|
||||||
do i=1,A_ind(0,at_roww)
|
|
||||||
j = active_pp_idx(i)
|
|
||||||
AtB(at_row) = AtB(at_row) + psi_non_ref_coef(A_ind(i, at_roww), s) * A_val(i, at_roww)
|
|
||||||
end do
|
end do
|
||||||
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
do a_coll = 1, nactive
|
|
||||||
a_col = active_pp_idx(a_coll)
|
|
||||||
t = 0d0
|
|
||||||
r1 = 1
|
|
||||||
r2 = 1
|
|
||||||
do while ((A_ind(r1, at_roww) /= 0).and.(A_ind(r2, a_coll) /= 0))
|
|
||||||
if(A_ind(r1, at_roww) > A_ind(r2, a_coll)) then
|
|
||||||
r2 = r2+1
|
|
||||||
else if(A_ind(r1, at_roww) < A_ind(r2, a_coll)) then
|
|
||||||
r1 = r1+1
|
|
||||||
else
|
|
||||||
t = t - A_val(r1, at_roww) * A_val(r2, a_coll)
|
|
||||||
r1 = r1+1
|
|
||||||
r2 = r2+1
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
|
|
||||||
if(a_col == at_row) then
|
|
||||||
t = t + 1.d0
|
|
||||||
end if
|
|
||||||
if(t /= 0.d0) then
|
|
||||||
wk += 1
|
|
||||||
A_ind_mwen(wk) = a_col
|
|
||||||
A_val_mwen(wk) = t
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
|
|
||||||
if(wk /= 0) then
|
|
||||||
!$OMP CRITICAL
|
|
||||||
col_shortcut(at_roww) = AtA_size+1
|
|
||||||
N_col(at_roww) = wk
|
|
||||||
if (AtA_size+wk > size(AtA_ind,1)) then
|
|
||||||
print *, AtA_size+wk , size(AtA_ind,1)
|
|
||||||
stop 'too small'
|
|
||||||
endif
|
|
||||||
do i=1,wk
|
|
||||||
AtA_ind(AtA_size+i) = A_ind_mwen(i)
|
|
||||||
AtA_val(AtA_size+i) = A_val_mwen(i)
|
|
||||||
enddo
|
|
||||||
AtA_size += wk
|
|
||||||
!$OMP END CRITICAL
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
!$OMP END DO NOWAIT
|
|
||||||
deallocate (A_ind_mwen, A_val_mwen)
|
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
print *, "ATA SIZE", ata_size
|
X(:) = 0d0
|
||||||
x = 0d0
|
|
||||||
|
|
||||||
|
|
||||||
do a_coll = 1, nactive
|
do a_coll = 1, n_exc_active
|
||||||
a_col = active_pp_idx(a_coll)
|
a_col = active_pp_idx(a_coll)
|
||||||
X(a_col) = AtB(a_col)
|
X(a_col) = AtB(a_col)
|
||||||
end do
|
end do
|
||||||
@ -822,12 +671,11 @@ END_PROVIDER
|
|||||||
rho_mrcc_init = 0d0
|
rho_mrcc_init = 0d0
|
||||||
|
|
||||||
allocate(lref(N_det_ref))
|
allocate(lref(N_det_ref))
|
||||||
!$OMP PARALLEL DO default(shared) schedule(static, 1) &
|
|
||||||
!$OMP private(lref, hh, pp, II, myMask, myDet, ok, ind, phase)
|
|
||||||
do hh = 1, hh_shortcut(0)
|
do hh = 1, hh_shortcut(0)
|
||||||
do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1
|
do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1
|
||||||
if(active(pp)) cycle
|
if(is_active_exc(pp)) cycle
|
||||||
lref = 0
|
lref = 0
|
||||||
|
AtB(pp) = 0.d0
|
||||||
do II=1,N_det_ref
|
do II=1,N_det_ref
|
||||||
call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int)
|
call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int)
|
||||||
if(.not. ok) cycle
|
if(.not. ok) cycle
|
||||||
@ -837,78 +685,74 @@ END_PROVIDER
|
|||||||
if(ind == -1) cycle
|
if(ind == -1) cycle
|
||||||
ind = psi_non_ref_sorted_idx(ind)
|
ind = psi_non_ref_sorted_idx(ind)
|
||||||
call get_phase(myDet(1,1), psi_ref(1,1,II), phase, N_int)
|
call get_phase(myDet(1,1), psi_ref(1,1,II), phase, N_int)
|
||||||
X(pp) += psi_ref_coef(II,s)**2
|
|
||||||
AtB(pp) += psi_non_ref_coef(ind, s) * psi_ref_coef(II, s) * phase
|
AtB(pp) += psi_non_ref_coef(ind, s) * psi_ref_coef(II, s) * phase
|
||||||
lref(II) = ind
|
lref(II) = ind
|
||||||
if(phase < 0d0) lref(II) = -ind
|
if(phase < 0.d0) lref(II) = -ind
|
||||||
end do
|
end do
|
||||||
X(pp) = AtB(pp) / X(pp)
|
X(pp) = AtB(pp)
|
||||||
do II=1,N_det_ref
|
do II=1,N_det_ref
|
||||||
if(lref(II) > 0) then
|
if(lref(II) > 0) then
|
||||||
rho_mrcc_init(lref(II),s) = psi_ref_coef(II,s) * X(pp)
|
rho_mrcc_init(lref(II)) = psi_ref_coef(II,s) * X(pp)
|
||||||
else if(lref(II) < 0) then
|
else if(lref(II) < 0) then
|
||||||
rho_mrcc_init(-lref(II),s) = -psi_ref_coef(II,s) * X(pp)
|
rho_mrcc_init(-lref(II)) = -psi_ref_coef(II,s) * X(pp)
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
!$OMP END PARALLEL DO
|
deallocate(lref)
|
||||||
|
|
||||||
|
do i=1,N_det_non_ref
|
||||||
|
rho_mrcc(i,s) = rho_mrcc_init(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
x_new = x
|
x_new = x
|
||||||
|
|
||||||
double precision :: factor, resold
|
double precision :: factor, resold
|
||||||
factor = 1.d0
|
factor = 1.d0
|
||||||
resold = huge(1.d0)
|
resold = huge(1.d0)
|
||||||
do k=0,100000
|
|
||||||
!$OMP PARALLEL default(shared) private(cx, i, j, a_col, a_coll)
|
|
||||||
|
|
||||||
|
do k=0,10*hh_nex
|
||||||
|
res = 0.d0
|
||||||
|
!$OMP PARALLEL default(shared) private(cx, i, a_col, a_coll) reduction(+:res)
|
||||||
!$OMP DO
|
!$OMP DO
|
||||||
do i=1,N_det_non_ref
|
do a_coll = 1, n_exc_active
|
||||||
rho_mrcc(i,s) = rho_mrcc_init(i,s) ! 0d0
|
|
||||||
enddo
|
|
||||||
!$OMP END DO
|
|
||||||
|
|
||||||
!$OMP DO
|
|
||||||
do a_coll = 1, nactive !: nex
|
|
||||||
a_col = active_pp_idx(a_coll)
|
a_col = active_pp_idx(a_coll)
|
||||||
cx = 0d0
|
cx = 0.d0
|
||||||
do i=col_shortcut(a_coll), col_shortcut(a_coll) + N_col(a_coll) - 1
|
do i=mrcc_col_shortcut(a_coll), mrcc_col_shortcut(a_coll) + mrcc_N_col(a_coll) - 1
|
||||||
cx = cx + x(AtA_ind(i)) * AtA_val(i)
|
cx = cx + x(mrcc_AtA_ind(i)) * mrcc_AtA_val(s,i)
|
||||||
end do
|
end do
|
||||||
x_new(a_col) = AtB(a_col) + cx * factor
|
x_new(a_col) = AtB(a_col) + cx * factor
|
||||||
end do
|
|
||||||
!$OMP END DO
|
|
||||||
|
|
||||||
!$OMP END PARALLEL
|
|
||||||
|
|
||||||
res = 0.d0
|
|
||||||
|
|
||||||
|
|
||||||
if (res < resold) then
|
|
||||||
do a_coll=1,nactive ! nex
|
|
||||||
a_col = active_pp_idx(a_coll)
|
|
||||||
do j=1,N_det_non_ref
|
|
||||||
i = A_ind(j,a_coll)
|
|
||||||
if (i==0) exit
|
|
||||||
rho_mrcc(i,s) = rho_mrcc(i,s) + A_val(j,a_coll) * X_new(a_col)
|
|
||||||
enddo
|
|
||||||
res = res + (X_new(a_col) - X(a_col))*(X_new(a_col) - X(a_col))
|
res = res + (X_new(a_col) - X(a_col))*(X_new(a_col) - X(a_col))
|
||||||
X(a_col) = X_new(a_col)
|
X(a_col) = X_new(a_col)
|
||||||
end do
|
end do
|
||||||
factor = 1.d0
|
!$OMP END DO
|
||||||
else
|
!$OMP END PARALLEL
|
||||||
factor = -factor * 0.5d0
|
|
||||||
|
if (res > resold) then
|
||||||
|
factor = factor * 0.5d0
|
||||||
endif
|
endif
|
||||||
resold = res
|
resold = res
|
||||||
|
|
||||||
if(mod(k, 5) == 0) then
|
if(iand(k, 4095) == 0) then
|
||||||
print *, "res ", k, res
|
print *, "res ", k, res
|
||||||
end if
|
end if
|
||||||
|
|
||||||
if(res < 1d-12) exit
|
if(res < 1d-10) exit
|
||||||
end do
|
end do
|
||||||
|
dIj_unique(1:size(X), s) = X(1:size(X))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do s=1,N_states
|
||||||
|
|
||||||
|
do a_coll=1,n_exc_active
|
||||||
|
a_col = active_pp_idx(a_coll)
|
||||||
|
do j=1,N_det_non_ref
|
||||||
|
i = active_excitation_to_determinants_idx(j,a_coll)
|
||||||
|
if (i==0) exit
|
||||||
|
rho_mrcc(i,s) = rho_mrcc(i,s) + active_excitation_to_determinants_val(s,j,a_coll) * dIj_unique(a_col,s)
|
||||||
|
enddo
|
||||||
|
end do
|
||||||
|
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
do i=1,N_det_non_ref
|
do i=1,N_det_non_ref
|
||||||
@ -921,10 +765,11 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
! Norm now contains the norm of Psi + A.X
|
! Norm now contains the norm of Psi + A.X
|
||||||
|
|
||||||
print *, k, "res : ", res, "norm : ", sqrt(norm)
|
print *, "norm : ", sqrt(norm)
|
||||||
|
enddo
|
||||||
|
|
||||||
!dIj_unique(:size(X), s) = X(:)
|
|
||||||
|
|
||||||
|
do s=1,N_states
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
double precision :: f
|
double precision :: f
|
||||||
do i=1,N_det_non_ref
|
do i=1,N_det_non_ref
|
||||||
@ -932,12 +777,16 @@ END_PROVIDER
|
|||||||
rho_mrcc(i,s) = 1.d-32
|
rho_mrcc(i,s) = 1.d-32
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
if (lambda_type == 2) then
|
||||||
|
f = 1.d0
|
||||||
|
else
|
||||||
! f is such that f.\tilde{c_i} = c_i
|
! f is such that f.\tilde{c_i} = c_i
|
||||||
f = psi_non_ref_coef(i,s) / rho_mrcc(i,s)
|
f = psi_non_ref_coef(i,s) / rho_mrcc(i,s)
|
||||||
|
|
||||||
! Avoid numerical instabilities
|
! Avoid numerical instabilities
|
||||||
f = min(f,2.d0)
|
f = min(f,2.d0)
|
||||||
f = max(f,-2.d0)
|
f = max(f,-2.d0)
|
||||||
|
endif
|
||||||
|
|
||||||
norm = norm + f*f *rho_mrcc(i,s)*rho_mrcc(i,s)
|
norm = norm + f*f *rho_mrcc(i,s)*rho_mrcc(i,s)
|
||||||
rho_mrcc(i,s) = f
|
rho_mrcc(i,s) = f
|
||||||
@ -958,6 +807,9 @@ END_PROVIDER
|
|||||||
|
|
||||||
norm = norm*f
|
norm = norm*f
|
||||||
print *, 'norm of |T Psi_0> = ', dsqrt(norm)
|
print *, 'norm of |T Psi_0> = ', dsqrt(norm)
|
||||||
|
if (dsqrt(norm) > 1.d0) then
|
||||||
|
stop 'Error : Norm of the SD larger than the norm of the reference.'
|
||||||
|
endif
|
||||||
|
|
||||||
do i=1,N_det_ref
|
do i=1,N_det_ref
|
||||||
norm = norm + psi_ref_coef(i,s)*psi_ref_coef(i,s)
|
norm = norm + psi_ref_coef(i,s)*psi_ref_coef(i,s)
|
||||||
@ -969,8 +821,8 @@ END_PROVIDER
|
|||||||
! rho_mrcc now contains the product of the scaling factors and the
|
! rho_mrcc now contains the product of the scaling factors and the
|
||||||
! normalization constant
|
! normalization constant
|
||||||
|
|
||||||
dIj_unique(:size(X), s) = X(:)
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
@ -980,17 +832,14 @@ BEGIN_PROVIDER [ double precision, dij, (N_det_ref, N_det_non_ref, N_states) ]
|
|||||||
integer :: s,i,j
|
integer :: s,i,j
|
||||||
double precision, external :: get_dij_index
|
double precision, external :: get_dij_index
|
||||||
print *, "computing amplitudes..."
|
print *, "computing amplitudes..."
|
||||||
!$OMP PARALLEL DEFAULT(shared) PRIVATE(s,i,j)
|
|
||||||
do s=1, N_states
|
do s=1, N_states
|
||||||
!$OMP DO
|
|
||||||
do i=1, N_det_non_ref
|
do i=1, N_det_non_ref
|
||||||
do j=1, N_det_ref
|
do j=1, N_det_ref
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
dij(j, i, s) = get_dij_index(j, i, s, N_int)
|
dij(j, i, s) = get_dij_index(j, i, s, N_int)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
!$OMP END DO
|
|
||||||
end do
|
end do
|
||||||
!$OMP END PARALLEL
|
|
||||||
print *, "done computing amplitudes"
|
print *, "done computing amplitudes"
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
@ -1006,9 +855,13 @@ double precision function get_dij_index(II, i, s, Nint)
|
|||||||
call get_phase(psi_ref(1,1,II), psi_non_ref(1,1,i), phase, N_int)
|
call get_phase(psi_ref(1,1,II), psi_non_ref(1,1,i), phase, N_int)
|
||||||
get_dij_index = get_dij(psi_ref(1,1,II), psi_non_ref(1,1,i), s, Nint) * phase
|
get_dij_index = get_dij(psi_ref(1,1,II), psi_non_ref(1,1,i), s, Nint) * phase
|
||||||
get_dij_index = get_dij_index * rho_mrcc(i,s)
|
get_dij_index = get_dij_index * rho_mrcc(i,s)
|
||||||
else
|
else if(lambda_type == 1) then
|
||||||
call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,i), Nint, HIi)
|
call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,i), Nint, HIi)
|
||||||
get_dij_index = HIi * lambda_mrcc(s, i)
|
get_dij_index = HIi * lambda_mrcc(s, i)
|
||||||
|
else if(lambda_type == 2) then
|
||||||
|
call get_phase(psi_ref(1,1,II), psi_non_ref(1,1,i), phase, N_int)
|
||||||
|
get_dij_index = get_dij(psi_ref(1,1,II), psi_non_ref(1,1,i), s, Nint) * phase
|
||||||
|
get_dij_index = get_dij_index * rho_mrcc(i,s)
|
||||||
end if
|
end if
|
||||||
end function
|
end function
|
||||||
|
|
||||||
@ -1066,9 +919,21 @@ end function
|
|||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_hh_exists) ]
|
BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_hh_exists) ]
|
||||||
&BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_hh_exists + 1) ]
|
|
||||||
&BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_pp_exists) ]
|
&BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_pp_exists) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_hh_exists + 1) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, hh_nex ]
|
||||||
implicit none
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! hh_exists :
|
||||||
|
!
|
||||||
|
! pp_exists :
|
||||||
|
!
|
||||||
|
! hh_shortcut :
|
||||||
|
!
|
||||||
|
! hh_nex : Total number of excitation operators
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
integer*2,allocatable :: num(:,:)
|
integer*2,allocatable :: num(:,:)
|
||||||
integer :: exc(0:2, 2, 2), degree, n, on, s, l, i
|
integer :: exc(0:2, 2, 2), degree, n, on, s, l, i
|
||||||
integer*2 :: h1, h2, p1, p2
|
integer*2 :: h1, h2, p1, p2
|
||||||
@ -1134,6 +999,7 @@ end function
|
|||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
hh_nex = hh_shortcut(hh_shortcut(0)+1)-1
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user