mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 14:01:46 +02:00
Revert "Merge..."
This commit is contained in:
parent
64f0869486
commit
b24968ac48
10
.travis.yml
10
.travis.yml
@ -9,12 +9,12 @@ sudo: false
|
||||
addons:
|
||||
apt:
|
||||
packages:
|
||||
- zlib1g-dev
|
||||
- libgmp3-dev
|
||||
- gfortran
|
||||
- gcc
|
||||
- liblapack-dev
|
||||
- graphviz
|
||||
# - zlib1g-dev
|
||||
# - libgmp3-dev
|
||||
|
||||
cache:
|
||||
directories:
|
||||
@ -25,8 +25,8 @@ python:
|
||||
- "2.6"
|
||||
|
||||
script:
|
||||
- ./configure --production ./config/travis.cfg
|
||||
- source ./quantum_package.rc ; qp_module.py install Full_CI Full_CI_ZMQ Hartree_Fock CAS_SD_ZMQ mrcepa0 All_singles
|
||||
- ./configure --production ./config/gfortran.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 ; ninja
|
||||
- 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
|
||||
* GNU make
|
||||
* Bash
|
||||
* Blas/Lapack
|
||||
* Blast/Lapack
|
||||
* unzip
|
||||
* g++ (For ninja)
|
||||
|
||||
|
@ -13,7 +13,7 @@
|
||||
FC : gfortran -g -ffree-line-length-none -I . -static-libgcc
|
||||
LAPACK_LIB : -llapack -lblas
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32
|
||||
IRPF90_FLAGS : --ninja --assert --align=32
|
||||
|
||||
# Global options
|
||||
################
|
||||
|
@ -38,7 +38,7 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g
|
||||
#################
|
||||
#
|
||||
[PROFILE]
|
||||
FC : -p -g
|
||||
FC : -p -g -traceback
|
||||
FCFLAGS : -xSSE4.2 -O2 -ip -ftz
|
||||
|
||||
# Debugging flags
|
||||
@ -53,6 +53,7 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz
|
||||
[DEBUG]
|
||||
FC : -g -traceback
|
||||
FCFLAGS : -xSSE2 -C -fpe0
|
||||
IRPF90_FLAGS : --openmp
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
|
@ -1,62 +0,0 @@
|
||||
# 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
|
||||
|
25
configure
vendored
25
configure
vendored
@ -71,8 +71,8 @@ d_dependency = {
|
||||
"emsl": ["python"],
|
||||
"gcc": [],
|
||||
"g++": [],
|
||||
"zeromq" : [ "g++", "make" ],
|
||||
"f77zmq" : [ "zeromq", "python", "make" ],
|
||||
"zeromq" : [ "g++" ],
|
||||
"f77zmq" : [ "zeromq", "python" ],
|
||||
"python": [],
|
||||
"ninja": ["g++", "python"],
|
||||
"make": [],
|
||||
@ -102,7 +102,7 @@ curl = Info(
|
||||
default_path=join(QP_ROOT_BIN, "curl"))
|
||||
|
||||
zlib = Info(
|
||||
url='http://www.zlib.net/zlib-1.2.11.tar.gz',
|
||||
url='http://zlib.net/zlib-1.2.8.tar.gz',
|
||||
description=' zlib',
|
||||
default_path=join(QP_ROOT_LIB, "libz.a"))
|
||||
|
||||
@ -150,6 +150,7 @@ f77zmq = Info(
|
||||
url='{head}/zeromq/f77_zmq/{tail}'.format(**path_github),
|
||||
description=' F77-ZeroMQ',
|
||||
default_path=join(QP_ROOT_LIB, "libf77zmq.a") )
|
||||
# join(QP_ROOT, "src", "ZMQ", "f77zmq.h") )
|
||||
|
||||
p_graphviz = Info(
|
||||
url='https://github.com/xflr6/graphviz/archive/master.tar.gz',
|
||||
@ -165,7 +166,7 @@ d_info = dict()
|
||||
|
||||
for m in ["ocaml", "m4", "curl", "zlib", "patch", "irpf90", "docopt",
|
||||
"resultsFile", "ninja", "emsl", "ezfio", "p_graphviz",
|
||||
"zeromq", "f77zmq","bats"]:
|
||||
"zeromq", "f77zmq","bats" ]:
|
||||
exec ("d_info['{0}']={0}".format(m))
|
||||
|
||||
|
||||
@ -493,24 +494,16 @@ def create_ninja_and_rc(l_installed):
|
||||
'export PYTHONPATH="${QP_EZFIO}/Python":"${QP_PYTHON}":"${PYTHONPATH}"',
|
||||
'export PATH="${QP_PYTHON}":"${QP_ROOT}"/bin:"${QP_ROOT}"/ocaml:"${PATH}"',
|
||||
'export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}"',
|
||||
'export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"',
|
||||
'export C_INCLUDE_PATH="${C_INCLUDE_PATH}":"${QP_ROOT}"/include',
|
||||
'',
|
||||
'source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh',
|
||||
'export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"', "",
|
||||
'source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh', "",
|
||||
'source ${HOME}/.opam/opam-init/init.sh > /dev/null 2> /dev/null || true',
|
||||
'',
|
||||
'# 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")
|
||||
with open(path, "w+") as f:
|
||||
f.write("\n".join(l_rc))
|
||||
|
@ -4,11 +4,7 @@
|
||||
BUILD=_build/${TARGET}
|
||||
rm -rf -- ${BUILD}
|
||||
mkdir ${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
|
||||
tar -zxf Downloads/${TARGET}.tar.gz --strip-components=1 --directory=${BUILD} || exit 1
|
||||
_install || exit 1
|
||||
rm -rf -- ${BUILD} _build/${TARGET}.log
|
||||
exit 0
|
||||
|
@ -10,4 +10,10 @@ function _install()
|
||||
mv curl.ermine ${QP_ROOT}/bin/curl || return 1
|
||||
}
|
||||
|
||||
source scripts/build.sh
|
||||
BUILD=_build/${TARGET}
|
||||
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,9 +7,10 @@ function _install()
|
||||
cd ..
|
||||
QP_ROOT=$PWD
|
||||
cd -
|
||||
export C_INCLUDE_PATH="${C_INCLUDE_PATH}":"${QP_ROOT}"/lib
|
||||
set -e
|
||||
set -u
|
||||
export ZMQ_H="${QP_ROOT}"/include/zmq.h
|
||||
export ZMQ_H="${QP_ROOT}"/lib/zmq.h
|
||||
cd "${BUILD}"
|
||||
make -j 8 || exit 1
|
||||
mv libf77zmq.a "${QP_ROOT}"/lib || exit 1
|
||||
|
@ -1,17 +0,0 @@
|
||||
#!/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,7 +8,8 @@ function _install()
|
||||
QP_ROOT=$PWD
|
||||
cd -
|
||||
cd ${BUILD}
|
||||
./configure --prefix=$QP_ROOT && make || exit 1
|
||||
./configure && make || exit 1
|
||||
ln -sf ${PWD}/src/m4 ${QP_ROOT}/bin || exit 1
|
||||
}
|
||||
|
||||
source scripts/build.sh
|
||||
|
@ -5,11 +5,11 @@ QP_ROOT=$PWD
|
||||
cd -
|
||||
|
||||
# Normal installation
|
||||
PACKAGES="core cryptokit.1.10 ocamlfind sexplib ZMQ"
|
||||
PACKAGES="core cryptokit zarith ocamlfind sexplib ZMQ"
|
||||
#ppx_sexp_conv
|
||||
|
||||
# Needed for ZeroMQ
|
||||
export C_INCLUDE_PATH="${QP_ROOT}"/include:"${C_INCLUDE_PATH}"
|
||||
export C_INCLUDE_PATH="${QP_ROOT}"/lib:"${C_INCLUDE_PATH}"
|
||||
export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"
|
||||
export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}"
|
||||
|
||||
|
@ -9,11 +9,11 @@ function _install()
|
||||
QP_ROOT=$PWD
|
||||
cd -
|
||||
cd ${BUILD}
|
||||
./configure --prefix=${QP_ROOT} && make || exit 1
|
||||
./configure --prefix=${QP_ROOT}/install/${TARGET} && make || exit 1
|
||||
make install || exit 1
|
||||
cd -
|
||||
cp ${TARGET}/bin/${TARGET} ${QP_ROOT}/bin || exit 1
|
||||
rm -R -- ${TARGET} || exit 1
|
||||
}
|
||||
|
||||
source scripts/build.sh
|
||||
source scripts/build.sh
|
@ -7,13 +7,22 @@ function _install()
|
||||
cd ..
|
||||
QP_ROOT=$PWD
|
||||
cd -
|
||||
export C_INCLUDE_PATH="${C_INCLUDE_PATH}":./
|
||||
set -e
|
||||
set -u
|
||||
ORIG=$(pwd)
|
||||
cd "${BUILD}"
|
||||
./configure --prefix=$QP_ROOT --without-libsodium || exit 1
|
||||
./configure --without-libsodium || exit 1
|
||||
make -j 8 || exit 1
|
||||
make install || exit 1
|
||||
rm -f -- "${QP_ROOT}"/lib/libzmq.a "${QP_ROOT}"/lib/libzmq.so "${QP_ROOT}"/lib/libzmq.so.?
|
||||
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}
|
||||
return 0
|
||||
}
|
||||
|
@ -11,8 +11,11 @@ function _install()
|
||||
cd -
|
||||
cd ${BUILD}
|
||||
./configure && make || exit 1
|
||||
./configure --prefix=$QP_ROOT && make || exit 1
|
||||
make install || exit 1
|
||||
make install prefix=$QP_ROOT/install/${TARGET} || exit 1
|
||||
ln -s -f $QP_ROOT/install/${TARGET}/lib/libz.so $QP_ROOT/lib || 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
|
||||
|
256
ocaml/Pseudo.ml
256
ocaml/Pseudo.ml
@ -124,27 +124,23 @@ let to_string t =
|
||||
let find in_channel element =
|
||||
In_channel.seek in_channel 0L;
|
||||
|
||||
let loop, element_read, old_pos =
|
||||
ref true,
|
||||
ref None,
|
||||
let element_read, old_pos =
|
||||
ref Element.X,
|
||||
ref (In_channel.pos in_channel)
|
||||
in
|
||||
|
||||
while !loop
|
||||
while !element_read <> element
|
||||
do
|
||||
let buffer =
|
||||
old_pos := In_channel.pos in_channel;
|
||||
match In_channel.input_line in_channel with
|
||||
| Some line -> String.split ~on:' ' line
|
||||
|> List.hd_exn
|
||||
| None -> ""
|
||||
in
|
||||
try
|
||||
let buffer =
|
||||
old_pos := In_channel.pos in_channel;
|
||||
match In_channel.input_line in_channel with
|
||||
| Some line -> String.split ~on:' ' line
|
||||
|> List.hd_exn
|
||||
| None -> raise End_of_file
|
||||
in
|
||||
element_read := Some (Element.of_string buffer);
|
||||
loop := !element_read <> (Some element)
|
||||
element_read := Element.of_string buffer
|
||||
with
|
||||
| Element.ElementError _ -> ()
|
||||
| End_of_file -> loop := false
|
||||
done ;
|
||||
In_channel.seek in_channel !old_pos;
|
||||
!element_read
|
||||
@ -152,126 +148,124 @@ let find in_channel element =
|
||||
|
||||
(** Read the Pseudopotential in GAMESS format *)
|
||||
let read_element in_channel element =
|
||||
match find in_channel element with
|
||||
| Some e when e = element ->
|
||||
ignore (find in_channel element);
|
||||
|
||||
let rec read result =
|
||||
match In_channel.input_line in_channel with
|
||||
| None -> result
|
||||
| Some line ->
|
||||
if (String.strip line = "") then
|
||||
result
|
||||
else
|
||||
read (line::result)
|
||||
in
|
||||
|
||||
let data =
|
||||
read []
|
||||
|> List.rev
|
||||
in
|
||||
|
||||
let debug_data =
|
||||
String.concat ~sep:"\n" data
|
||||
in
|
||||
|
||||
let decode_first_line = function
|
||||
| first_line :: rest ->
|
||||
begin
|
||||
let rec read result =
|
||||
match In_channel.input_line in_channel with
|
||||
| None -> result
|
||||
| Some line ->
|
||||
if (String.strip line = "") then
|
||||
result
|
||||
else
|
||||
read (line::result)
|
||||
let first_line_split =
|
||||
String.split first_line ~on:' '
|
||||
|> List.filter ~f:(fun x -> (String.strip x) <> "")
|
||||
in
|
||||
|
||||
let data =
|
||||
read []
|
||||
|> List.rev
|
||||
in
|
||||
|
||||
let debug_data =
|
||||
String.concat ~sep:"\n" data
|
||||
in
|
||||
|
||||
let decode_first_line = function
|
||||
| first_line :: rest ->
|
||||
begin
|
||||
let first_line_split =
|
||||
String.split first_line ~on:' '
|
||||
|> List.filter ~f:(fun x -> (String.strip x) <> "")
|
||||
in
|
||||
match first_line_split with
|
||||
| e :: "GEN" :: n :: p ->
|
||||
{ element = Element.of_string e ;
|
||||
n_elec = Int.of_string n |> Positive_int.of_int ;
|
||||
local = [] ;
|
||||
non_local = []
|
||||
}, rest
|
||||
| _ -> failwith (
|
||||
Printf.sprintf "Unable to read Pseudopotential : \n%s\n"
|
||||
debug_data )
|
||||
end
|
||||
| _ -> failwith ("Error reading pseudopotential\n"^debug_data)
|
||||
in
|
||||
|
||||
let rec loop create_primitive accu = function
|
||||
| (0,rest) -> List.rev accu, rest
|
||||
| (n,line::rest) ->
|
||||
begin
|
||||
match
|
||||
String.split line ~on:' '
|
||||
|> List.filter ~f:(fun x -> String.strip x <> "")
|
||||
with
|
||||
| c :: i :: e :: [] ->
|
||||
let i =
|
||||
Int.of_string i
|
||||
in
|
||||
let elem =
|
||||
( create_primitive
|
||||
(Float.of_string e |> AO_expo.of_float)
|
||||
(i-2 |> R_power.of_int),
|
||||
Float.of_string c |> AO_coef.of_float
|
||||
)
|
||||
in
|
||||
loop create_primitive (elem::accu) (n-1, rest)
|
||||
| _ -> failwith ("Error reading pseudopotential\n"^debug_data)
|
||||
end
|
||||
| _ -> failwith ("Error reading pseudopotential\n"^debug_data)
|
||||
in
|
||||
|
||||
let decode_local (pseudo,data) =
|
||||
let decode_local_n n rest =
|
||||
let result, rest =
|
||||
loop Primitive_local.of_expo_r_power [] (Positive_int.to_int n,rest)
|
||||
in
|
||||
{ pseudo with local = result }, rest
|
||||
in
|
||||
match data with
|
||||
| n :: rest ->
|
||||
let n =
|
||||
String.strip n
|
||||
|> Int.of_string
|
||||
|> Positive_int.of_int
|
||||
in
|
||||
decode_local_n n rest
|
||||
| _ -> failwith ("Unable to read (non-)local pseudopotential\n"^debug_data)
|
||||
in
|
||||
|
||||
let decode_non_local (pseudo,data) =
|
||||
let decode_non_local_n proj n (pseudo,data) =
|
||||
let result, rest =
|
||||
loop (Primitive_non_local.of_proj_expo_r_power proj)
|
||||
[] (Positive_int.to_int n, data)
|
||||
in
|
||||
{ pseudo with non_local = pseudo.non_local @ result }, rest
|
||||
in
|
||||
let rec new_proj (pseudo,data) proj =
|
||||
match data with
|
||||
| n :: rest ->
|
||||
let n =
|
||||
String.strip n
|
||||
|> Int.of_string
|
||||
|> Positive_int.of_int
|
||||
in
|
||||
let result =
|
||||
decode_non_local_n proj n (pseudo,rest)
|
||||
and proj_next =
|
||||
(Positive_int.to_int proj)+1
|
||||
|> Positive_int.of_int
|
||||
in
|
||||
new_proj result proj_next
|
||||
| _ -> pseudo
|
||||
in
|
||||
new_proj (pseudo,data) (Positive_int.of_int 0)
|
||||
in
|
||||
|
||||
decode_first_line data
|
||||
|> decode_local
|
||||
|> decode_non_local
|
||||
match first_line_split with
|
||||
| e :: "GEN" :: n :: p ->
|
||||
{ element = Element.of_string e ;
|
||||
n_elec = Int.of_string n |> Positive_int.of_int ;
|
||||
local = [] ;
|
||||
non_local = []
|
||||
}, rest
|
||||
| _ -> failwith (
|
||||
Printf.sprintf "Unable to read Pseudopotential : \n%s\n"
|
||||
debug_data )
|
||||
end
|
||||
| _ -> empty element
|
||||
| _ -> failwith ("Error reading pseudopotential\n"^debug_data)
|
||||
in
|
||||
|
||||
let rec loop create_primitive accu = function
|
||||
| (0,rest) -> List.rev accu, rest
|
||||
| (n,line::rest) ->
|
||||
begin
|
||||
match
|
||||
String.split line ~on:' '
|
||||
|> List.filter ~f:(fun x -> String.strip x <> "")
|
||||
with
|
||||
| c :: i :: e :: [] ->
|
||||
let i =
|
||||
Int.of_string i
|
||||
in
|
||||
let elem =
|
||||
( create_primitive
|
||||
(Float.of_string e |> AO_expo.of_float)
|
||||
(i-2 |> R_power.of_int),
|
||||
Float.of_string c |> AO_coef.of_float
|
||||
)
|
||||
in
|
||||
loop create_primitive (elem::accu) (n-1, rest)
|
||||
| _ -> failwith ("Error reading pseudopotential\n"^debug_data)
|
||||
end
|
||||
| _ -> failwith ("Error reading pseudopotential\n"^debug_data)
|
||||
in
|
||||
|
||||
let decode_local (pseudo,data) =
|
||||
let decode_local_n n rest =
|
||||
let result, rest =
|
||||
loop Primitive_local.of_expo_r_power [] (Positive_int.to_int n,rest)
|
||||
in
|
||||
{ pseudo with local = result }, rest
|
||||
in
|
||||
match data with
|
||||
| n :: rest ->
|
||||
let n =
|
||||
String.strip n
|
||||
|> Int.of_string
|
||||
|> Positive_int.of_int
|
||||
in
|
||||
decode_local_n n rest
|
||||
| _ -> failwith ("Unable to read (non-)local pseudopotential\n"^debug_data)
|
||||
in
|
||||
|
||||
let decode_non_local (pseudo,data) =
|
||||
let decode_non_local_n proj n (pseudo,data) =
|
||||
let result, rest =
|
||||
loop (Primitive_non_local.of_proj_expo_r_power proj)
|
||||
[] (Positive_int.to_int n, data)
|
||||
in
|
||||
{ pseudo with non_local = pseudo.non_local @ result }, rest
|
||||
in
|
||||
let rec new_proj (pseudo,data) proj =
|
||||
match data with
|
||||
| n :: rest ->
|
||||
let n =
|
||||
String.strip n
|
||||
|> Int.of_string
|
||||
|> Positive_int.of_int
|
||||
in
|
||||
let result =
|
||||
decode_non_local_n proj n (pseudo,rest)
|
||||
and proj_next =
|
||||
(Positive_int.to_int proj)+1
|
||||
|> Positive_int.of_int
|
||||
in
|
||||
new_proj result proj_next
|
||||
| _ -> pseudo
|
||||
in
|
||||
new_proj (pseudo,data) (Positive_int.of_int 0)
|
||||
in
|
||||
|
||||
decode_first_line data
|
||||
|> decode_local
|
||||
|> decode_non_local
|
||||
|
||||
|
||||
|
||||
|
||||
include To_md5
|
||||
|
@ -88,9 +88,8 @@ let run ~multiplicity ezfio_file =
|
||||
~alpha:(Elec_alpha_number.of_int alpha_new)
|
||||
~beta:(Elec_beta_number.of_int beta_new) pair )
|
||||
in
|
||||
|
||||
let c =
|
||||
Array.init (List.length determinants) (fun _ -> Det_coef.of_float ((Random.float 2.)-.1.))
|
||||
Array.create ~len:(List.length determinants) (Det_coef.of_float 1.)
|
||||
in
|
||||
|
||||
determinants
|
||||
|
@ -8,13 +8,6 @@ s.unset_skip()
|
||||
s.filter_only_1h1p()
|
||||
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.set_selection_pt2("epstein_nesbet_2x2")
|
||||
s.unset_skip()
|
||||
|
@ -15,7 +15,6 @@ Needed Modules
|
||||
* `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>`_
|
||||
* `Utils <http://github.com/LCPQ/quantum_package/tree/master/src/Utils>`_
|
||||
* `Davidson <http://github.com/LCPQ/quantum_package/tree/master/src/Davidson>`_
|
||||
|
||||
Documentation
|
||||
=============
|
||||
|
@ -49,7 +49,7 @@ subroutine routine
|
||||
endif
|
||||
call save_wavefunction
|
||||
if(n_det_before == N_det)then
|
||||
selection_criterion_factor = selection_criterion_factor * 0.5d0
|
||||
selection_criterion = selection_criterion * 0.5d0
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
@ -1,76 +0,0 @@
|
||||
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
|
1
plugins/CAS_SD/.gitignore
vendored
1
plugins/CAS_SD/.gitignore
vendored
@ -3,7 +3,6 @@
|
||||
.ninja_log
|
||||
AO_Basis
|
||||
Bitmask
|
||||
Davidson
|
||||
Determinants
|
||||
Electrons
|
||||
Ezfio_files
|
||||
|
@ -107,7 +107,6 @@ Needed Modules
|
||||
* `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_CAS <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_CAS>`_
|
||||
* `Davidson <http://github.com/LCPQ/quantum_package/tree/master/src/Davidson>`_
|
||||
|
||||
Documentation
|
||||
=============
|
||||
@ -194,6 +193,31 @@ h_apply_cas_s_selected_monoexc
|
||||
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
|
||||
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.
|
||||
|
@ -93,8 +93,8 @@ program full_ci
|
||||
call diagonalize_CI
|
||||
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)
|
||||
threshold_selectors = 1.d0
|
||||
threshold_generators = 0.999d0
|
||||
call H_apply_CAS_SD_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
||||
|
||||
print *, 'Final step'
|
||||
|
@ -1,10 +0,0 @@
|
||||
[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
|
||||
|
@ -1,2 +0,0 @@
|
||||
Generators_CAS Perturbation Selectors_CASSD ZMQ
|
||||
|
@ -1,14 +0,0 @@
|
||||
==========
|
||||
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.
|
@ -1,255 +0,0 @@
|
||||
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
|
||||
|
@ -1,79 +0,0 @@
|
||||
|
||||
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
|
@ -1,11 +0,0 @@
|
||||
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
|
||||
|
@ -1,4 +0,0 @@
|
||||
! 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
|
||||
|
@ -1,156 +0,0 @@
|
||||
|
||||
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,70 +0,0 @@
|
||||
|
||||
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
|
||||
|
@ -1,93 +0,0 @@
|
||||
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
|
||||
|
@ -1,9 +0,0 @@
|
||||
module selection_types
|
||||
type selection_buffer
|
||||
integer :: N, cur
|
||||
integer(8), allocatable :: det(:,:,:)
|
||||
double precision, allocatable :: val(:)
|
||||
double precision :: mini
|
||||
endtype
|
||||
end module
|
||||
|
@ -1,4 +0,0 @@
|
||||
[energy]
|
||||
type: double precision
|
||||
doc: Calculated energy
|
||||
interface: ezfio
|
@ -1 +0,0 @@
|
||||
Determinants
|
@ -1,165 +0,0 @@
|
||||
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
|
||||
|
@ -1,54 +0,0 @@
|
||||
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
|
||||
|
@ -1,109 +0,0 @@
|
||||
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
|
@ -1,219 +0,0 @@
|
||||
|
||||
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
|
@ -1,24 +0,0 @@
|
||||
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,15 +19,10 @@ default: 0.00001
|
||||
|
||||
[do_it_perturbative]
|
||||
type: logical
|
||||
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
|
||||
doc: if true, you do the FOBOCI calculation perturbatively
|
||||
interface: ezfio,provider,ocaml
|
||||
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]
|
||||
type: logical
|
||||
@ -54,9 +49,3 @@ doc: if true, you do all 2p type excitation on the LMCT
|
||||
interface: ezfio,provider,ocaml
|
||||
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.
|
||||
|
||||
|
@ -1,889 +0,0 @@
|
||||
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,25 +1,13 @@
|
||||
subroutine all_single(e_pt2)
|
||||
subroutine all_single
|
||||
implicit none
|
||||
double precision, intent(in) :: e_pt2
|
||||
integer :: i,k
|
||||
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
||||
integer :: N_st, degree
|
||||
double precision,allocatable :: E_before(:)
|
||||
N_st = N_states
|
||||
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
|
||||
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
|
||||
selection_criterion = 0.d0
|
||||
soft_touch selection_criterion
|
||||
threshold_davidson = 1.d-9
|
||||
soft_touch threshold_davidson davidson_criterion
|
||||
i = 0
|
||||
@ -29,8 +17,6 @@ subroutine all_single(e_pt2)
|
||||
print*,'pt2_max = ',pt2_max
|
||||
print*,'N_det_generators = ',N_det_generators
|
||||
pt2=-1.d0
|
||||
print*, 'ref_bitmask_energy =',ref_bitmask_energy
|
||||
print*, 'CI_expectation_value =',psi_energy(1)
|
||||
E_before = ref_bitmask_energy
|
||||
|
||||
print*,'Initial Step '
|
||||
@ -43,7 +29,7 @@ subroutine all_single(e_pt2)
|
||||
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
||||
enddo
|
||||
n_det_max = 100000
|
||||
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > dabs(pt2_max))
|
||||
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
||||
i += 1
|
||||
print*,'-----------------------'
|
||||
print*,'i = ',i
|
||||
@ -53,8 +39,6 @@ subroutine all_single(e_pt2)
|
||||
print*,'E = ',CI_energy(1)
|
||||
print*,'pt2 = ',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
|
||||
print*,'Variational Energy difference'
|
||||
do i = 2, N_st
|
||||
@ -69,6 +53,7 @@ subroutine all_single(e_pt2)
|
||||
endif
|
||||
E_before = CI_energy
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!! DOING ONLY ONE ITERATION OF SELECTION AS THE SELECTION CRITERION IS SET TO ZERO
|
||||
exit
|
||||
enddo
|
||||
! threshold_davidson = 1.d-8
|
||||
! soft_touch threshold_davidson davidson_criterion
|
||||
|
@ -15,7 +15,7 @@
|
||||
integer(bit_kind) :: key_tmp(N_int,2)
|
||||
integer :: i,j,k,l
|
||||
integer :: i_hole,j_hole,k_part,l_part
|
||||
double precision :: get_mo_bielec_integral,hij,delta_e,exc,contrib
|
||||
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
|
||||
double precision :: diag_H_mat_elem
|
||||
integer :: i_ok,ispin
|
||||
! Alpha - Beta correlation energy
|
||||
@ -46,7 +46,7 @@
|
||||
if(i_ok .ne.1)cycle
|
||||
delta_e = (ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
contrib = hij*hij/delta_e
|
||||
total_corr_e_2h2p += contrib
|
||||
! Single orbital contribution
|
||||
@ -81,8 +81,8 @@
|
||||
k_part = list_virt(k)
|
||||
do l = k+1,n_virt_orb
|
||||
l_part = list_virt(l)
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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)
|
||||
key_tmp = ref_bitmask
|
||||
ispin = 1
|
||||
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
||||
@ -114,8 +114,8 @@
|
||||
k_part = list_virt(k)
|
||||
do l = k+1,n_virt_orb
|
||||
l_part = list_virt(l)
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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)
|
||||
key_tmp = ref_bitmask
|
||||
ispin = 2
|
||||
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 :: i,j,k,l
|
||||
integer :: i_hole,j_hole,k_part,l_part
|
||||
double precision :: get_mo_bielec_integral,hij,delta_e,exc,contrib
|
||||
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
|
||||
double precision :: diag_H_mat_elem
|
||||
integer :: i_ok,ispin
|
||||
! Alpha - Beta correlation energy
|
||||
@ -191,7 +191,7 @@ END_PROVIDER
|
||||
if(i_ok .ne.1)cycle
|
||||
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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))
|
||||
total_corr_e_2h1p += 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)
|
||||
do l = 1,n_virt_orb
|
||||
l_part = list_virt(l)
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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)
|
||||
key_tmp = ref_bitmask
|
||||
ispin = 1
|
||||
call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok)
|
||||
@ -241,8 +241,8 @@ END_PROVIDER
|
||||
k_part = list_act(k)
|
||||
do l = 1,n_virt_orb
|
||||
l_part = list_virt(l)
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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)
|
||||
key_tmp = ref_bitmask
|
||||
ispin = 2
|
||||
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 :: i,j,k,l
|
||||
integer :: i_hole,j_hole,k_part,l_part
|
||||
double precision :: get_mo_bielec_integral,hij,delta_e,exc,contrib
|
||||
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
|
||||
double precision :: diag_H_mat_elem
|
||||
integer :: i_ok,ispin
|
||||
! Alpha - Beta correlation energy
|
||||
@ -302,7 +302,7 @@ END_PROVIDER
|
||||
if(i_ok .ne.1)cycle
|
||||
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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))
|
||||
|
||||
total_corr_e_1h2p += contrib
|
||||
@ -324,8 +324,8 @@ END_PROVIDER
|
||||
k_part = list_act(k)
|
||||
do l = i+1,n_virt_orb
|
||||
l_part = list_virt(l)
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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)
|
||||
|
||||
key_tmp = ref_bitmask
|
||||
ispin = 1
|
||||
@ -356,8 +356,8 @@ END_PROVIDER
|
||||
k_part = list_act(k)
|
||||
do l = i+1,n_virt_orb
|
||||
l_part = list_virt(l)
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
exc = get_mo_bielec_integral(i_hole,j_hole,l_part,k_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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)
|
||||
|
||||
key_tmp = ref_bitmask
|
||||
ispin = 2
|
||||
@ -388,7 +388,7 @@ END_PROVIDER
|
||||
integer(bit_kind) :: key_tmp(N_int,2)
|
||||
integer :: i,j,k,l
|
||||
integer :: i_hole,j_hole,k_part,l_part
|
||||
double precision :: get_mo_bielec_integral,hij,delta_e,exc,contrib
|
||||
double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib
|
||||
double precision :: diag_H_mat_elem
|
||||
integer :: i_ok,ispin
|
||||
! Alpha - Beta correlation energy
|
||||
@ -412,7 +412,7 @@ END_PROVIDER
|
||||
if(i_ok .ne.1)cycle
|
||||
delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int))
|
||||
|
||||
hij = get_mo_bielec_integral(i_hole,j_hole,k_part,l_part,mo_integrals_map)
|
||||
hij = get_mo_bielec_integral_schwartz(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))
|
||||
|
||||
total_corr_e_1h1p_spin_flip += contrib
|
||||
|
@ -68,9 +68,7 @@ subroutine create_restart_and_1h(i_hole)
|
||||
|
||||
SOFT_TOUCH N_det psi_det psi_coef
|
||||
logical :: found_duplicates
|
||||
if(n_act_orb.gt.1)then
|
||||
call remove_duplicates_in_psi_det(found_duplicates)
|
||||
endif
|
||||
end
|
||||
|
||||
subroutine create_restart_and_1p(i_particle)
|
||||
@ -215,8 +213,6 @@ subroutine create_restart_1h_1p(i_hole,i_part)
|
||||
|
||||
SOFT_TOUCH N_det psi_det psi_coef
|
||||
logical :: found_duplicates
|
||||
if(n_act_orb.gt.1)then
|
||||
call remove_duplicates_in_psi_det(found_duplicates)
|
||||
endif
|
||||
|
||||
end
|
||||
|
@ -38,7 +38,7 @@ end
|
||||
subroutine diag_inactive_virt_new_and_update_mos
|
||||
implicit none
|
||||
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
|
||||
double precision :: tmp(mo_tot_num_align,mo_tot_num),accu,get_mo_bielec_integral_schwartz
|
||||
character*(64) :: label
|
||||
tmp = 0.d0
|
||||
do i = 1, mo_tot_num
|
||||
@ -52,8 +52,8 @@ subroutine diag_inactive_virt_new_and_update_mos
|
||||
accu =0.d0
|
||||
do k = 1, n_act_orb
|
||||
k_act = list_act(k)
|
||||
accu += get_mo_bielec_integral(i_inact,k_act,j_inact,k_act,mo_integrals_map)
|
||||
accu -= get_mo_bielec_integral(i_inact,k_act,k_act,j_inact,mo_integrals_map)
|
||||
accu += get_mo_bielec_integral_schwartz(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)
|
||||
enddo
|
||||
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
|
||||
@ -67,7 +67,7 @@ subroutine diag_inactive_virt_new_and_update_mos
|
||||
accu =0.d0
|
||||
do k = 1, n_act_orb
|
||||
k_act = list_act(k)
|
||||
accu += get_mo_bielec_integral(i_virt,k_act,j_virt,k_act,mo_integrals_map)
|
||||
accu += get_mo_bielec_integral_schwartz(i_virt,k_act,j_virt,k_act,mo_integrals_map)
|
||||
enddo
|
||||
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
|
||||
|
@ -58,7 +58,24 @@ 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)
|
||||
f = 1.d0/(E_ref-haa)
|
||||
|
||||
! if(second_order_h)then
|
||||
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)
|
||||
contrib = H_array(idx(k)) * H_array(idx(k)) * lambda_i
|
||||
delta_ij_generators_(idx(k), idx(k)) += contrib
|
||||
@ -72,21 +89,20 @@ subroutine standard_dress(delta_ij_generators_,size_buffer,Ndet_generators,i_gen
|
||||
end
|
||||
|
||||
|
||||
subroutine is_a_good_candidate(threshold,is_ok,e_pt2,verbose,exit_loop,is_ok_perturbative)
|
||||
subroutine is_a_good_candidate(threshold,is_ok,verbose)
|
||||
use bitmasks
|
||||
implicit none
|
||||
double precision, intent(in) :: threshold
|
||||
double precision, intent(out):: e_pt2
|
||||
logical, intent(out) :: is_ok,exit_loop,is_ok_perturbative
|
||||
logical, intent(out) :: is_ok
|
||||
logical, intent(in) :: verbose
|
||||
|
||||
integer :: l,k,m
|
||||
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(:,:,:)
|
||||
double precision :: hij
|
||||
|
||||
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_det_generators_input(N_int,2,N_det_generators),dressed_H_matrix(N_det_generators,N_det_generators))
|
||||
allocate(psi_coef_diagonalized_tmp(N_det_generators,N_states))
|
||||
dressed_H_matrix = 0.d0
|
||||
do k = 1, N_det_generators
|
||||
do l = 1, N_int
|
||||
@ -95,20 +111,9 @@ subroutine is_a_good_candidate(threshold,is_ok,e_pt2,verbose,exit_loop,is_ok_per
|
||||
enddo
|
||||
enddo
|
||||
!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,exit_loop,is_ok_perturbative)
|
||||
!do m = 1, N_states
|
||||
! 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
|
||||
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)
|
||||
if(do_it_perturbative)then
|
||||
if(is_ok)then
|
||||
N_det = N_det_generators
|
||||
do m = 1, N_states
|
||||
do k = 1, N_det_generators
|
||||
@ -117,19 +122,11 @@ subroutine is_a_good_candidate(threshold,is_ok,e_pt2,verbose,exit_loop,is_ok_per
|
||||
psi_det(l,2,k) = psi_det_generators_input(l,2,k)
|
||||
enddo
|
||||
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
|
||||
touch psi_coef psi_det N_det
|
||||
endif
|
||||
!endif
|
||||
endif
|
||||
|
||||
deallocate(psi_det_generators_input,dressed_H_matrix,psi_coef_diagonalized_tmp)
|
||||
|
||||
@ -138,14 +135,14 @@ subroutine is_a_good_candidate(threshold,is_ok,e_pt2,verbose,exit_loop,is_ok_per
|
||||
|
||||
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,exit_loop,is_ok_perturbative)
|
||||
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)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators)
|
||||
integer, intent(in) :: Ndet_generators
|
||||
double precision, intent(in) :: threshold
|
||||
logical, intent(in) :: verbose
|
||||
logical, intent(out) :: is_ok,exit_loop,is_ok_perturbative
|
||||
logical, intent(out) :: is_ok
|
||||
double precision, intent(out) :: psi_coef_diagonalized_tmp(Ndet_generators,N_states)
|
||||
double precision, intent(inout) :: dressed_H_matrix(Ndet_generators, Ndet_generators)
|
||||
|
||||
@ -154,7 +151,6 @@ 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 :: psi_coef_ref(Ndet_generators,N_states),diag_h_mat_average,diag_h_mat_no_ref_average
|
||||
logical :: is_a_ref_det(Ndet_generators)
|
||||
exit_loop = .False.
|
||||
|
||||
is_a_ref_det = .False.
|
||||
do i = 1, N_det_generators
|
||||
@ -195,7 +191,6 @@ 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(diag_h_mat_average - dressed_H_matrix(index_ref_generators_restart,index_ref_generators_restart) .gt.2.d0)then
|
||||
is_ok = .False.
|
||||
exit_loop = .True.
|
||||
return
|
||||
endif
|
||||
endif
|
||||
@ -283,11 +278,9 @@ subroutine dress_H_matrix_from_psi_det_input(psi_det_generators_input,Ndet_gener
|
||||
do k = 1, N_states
|
||||
accu = 0.d0
|
||||
do j =1, Ndet_generators
|
||||
print*,'',eigvectors(j,i) , psi_coef_ref(j,k)
|
||||
accu += eigvectors(j,i) * psi_coef_ref(j,k)
|
||||
enddo
|
||||
print*,'accu = ',accu
|
||||
if(dabs(accu).ge.0.72d0)then
|
||||
if(dabs(accu).ge.0.8d0)then
|
||||
i_good_state(0) +=1
|
||||
i_good_state(i_good_state(0)) = i
|
||||
endif
|
||||
@ -328,124 +321,10 @@ subroutine dress_H_matrix_from_psi_det_input(psi_det_generators_input,Ndet_gener
|
||||
exit
|
||||
endif
|
||||
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
|
||||
print*,'is_ok = ',is_ok
|
||||
print*,'is_ok_perturbative = ',is_ok_perturbative
|
||||
print*,'is_ok = ',is_ok
|
||||
endif
|
||||
|
||||
|
||||
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,13 +1,8 @@
|
||||
program foboscf
|
||||
implicit none
|
||||
!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
|
||||
call run_prepare
|
||||
no_oa_or_av_opt = .True.
|
||||
touch no_oa_or_av_opt
|
||||
call run_prepare
|
||||
call routine_fobo_scf
|
||||
call save_mos
|
||||
|
||||
@ -15,8 +10,8 @@ end
|
||||
|
||||
subroutine run_prepare
|
||||
implicit none
|
||||
! no_oa_or_av_opt = .False.
|
||||
! touch no_oa_or_av_opt
|
||||
no_oa_or_av_opt = .False.
|
||||
touch no_oa_or_av_opt
|
||||
call damping_SCF
|
||||
call diag_inactive_virt_and_update_mos
|
||||
end
|
||||
@ -32,7 +27,6 @@ subroutine routine_fobo_scf
|
||||
print*,'*******************************************************************************'
|
||||
print*,'*******************************************************************************'
|
||||
print*,'FOBO-SCF Iteration ',i
|
||||
print*, 'ao_bielec_integrals_in_map = ',ao_bielec_integrals_in_map
|
||||
print*,'*******************************************************************************'
|
||||
print*,'*******************************************************************************'
|
||||
if(speed_up_convergence_foboscf)then
|
||||
@ -52,7 +46,7 @@ subroutine routine_fobo_scf
|
||||
soft_touch threshold_lmct threshold_mlct
|
||||
endif
|
||||
endif
|
||||
call FOBOCI_lmct_mlct_old_thr(i)
|
||||
call FOBOCI_lmct_mlct_old_thr
|
||||
call save_osoci_natural_mos
|
||||
call damping_SCF
|
||||
call diag_inactive_virt_and_update_mos
|
||||
|
@ -1,8 +1,7 @@
|
||||
|
||||
subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
subroutine FOBOCI_lmct_mlct_old_thr
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer, intent(in) :: iter
|
||||
integer :: i,j,k,l
|
||||
integer(bit_kind),allocatable :: unpaired_bitmask(:,:)
|
||||
integer, allocatable :: occ(:,:)
|
||||
@ -11,7 +10,7 @@ subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
logical :: test_sym
|
||||
double precision :: thr,hij
|
||||
double precision, allocatable :: dressing_matrix(:,:)
|
||||
logical :: verbose,is_ok,is_ok_perturbative
|
||||
logical :: verbose,is_ok
|
||||
verbose = .True.
|
||||
thr = 1.d-12
|
||||
allocate(unpaired_bitmask(N_int,2))
|
||||
@ -39,7 +38,6 @@ subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
integer(bit_kind) , allocatable :: psi_singles(:,:,:)
|
||||
logical :: lmct
|
||||
double precision, allocatable :: psi_singles_coef(:,:)
|
||||
logical :: exit_loop
|
||||
allocate( zero_bitmask(N_int,2) )
|
||||
do i = 1, n_inact_orb
|
||||
lmct = .True.
|
||||
@ -47,45 +45,87 @@ subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
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
|
||||
call check_symetry(i_hole_osoci,thr,test_sym)
|
||||
if(.not.test_sym)cycle
|
||||
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)
|
||||
call is_a_good_candidate(threshold_lmct,is_ok,verbose)
|
||||
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
|
||||
if(.not.is_ok)cycle
|
||||
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
||||
dressing_matrix = 0.d0
|
||||
if(.not.do_it_perturbative)then
|
||||
|
||||
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
|
||||
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
|
||||
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
|
||||
! if(dressing_2h2p)then
|
||||
! call diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_hole_osoci,lmct)
|
||||
! endif
|
||||
|
||||
! ! 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
|
||||
call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators)
|
||||
hkl = dressing_matrix(1,1)
|
||||
@ -96,10 +136,7 @@ subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
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
|
||||
! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
|
||||
endif
|
||||
call set_intermediate_normalization_lmct_old(norm_tmp,i_hole_osoci)
|
||||
|
||||
@ -108,6 +145,7 @@ subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
norm_total(k) += norm_tmp(k)
|
||||
enddo
|
||||
call update_density_matrix_osoci
|
||||
deallocate(dressing_matrix)
|
||||
enddo
|
||||
|
||||
if(.True.)then
|
||||
@ -121,10 +159,10 @@ subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
|
||||
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
|
||||
call check_symetry(i_particl_osoci,thr,test_sym)
|
||||
if(.not.test_sym)cycle
|
||||
print*,'i_particl_osoci= ',i_particl_osoci
|
||||
! Initialize the bitmask to the restart ones
|
||||
call initialize_bitmask_to_restart_ones
|
||||
@ -140,33 +178,24 @@ subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
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)
|
||||
call is_a_good_candidate(threshold_mlct,is_ok,verbose)
|
||||
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
|
||||
if(.not.is_ok)cycle
|
||||
allocate(dressing_matrix(N_det_generators,N_det_generators))
|
||||
if(.not.do_it_perturbative)then
|
||||
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
|
||||
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
|
||||
enddo
|
||||
! call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix)
|
||||
! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix)
|
||||
call all_single
|
||||
! if(dressing_2h2p)then
|
||||
! call diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_particl_osoci,lmct)
|
||||
! endif
|
||||
endif
|
||||
call set_intermediate_normalization_mlct_old(norm_tmp,i_particl_osoci)
|
||||
do k = 1, N_states
|
||||
@ -174,6 +203,7 @@ subroutine FOBOCI_lmct_mlct_old_thr(iter)
|
||||
norm_total(k) += norm_tmp(k)
|
||||
enddo
|
||||
call update_density_matrix_osoci
|
||||
deallocate(dressing_matrix)
|
||||
enddo
|
||||
endif
|
||||
|
||||
@ -200,7 +230,7 @@ subroutine FOBOCI_mlct_old
|
||||
double precision :: norm_tmp,norm_total
|
||||
logical :: test_sym
|
||||
double precision :: thr
|
||||
logical :: verbose,is_ok,exit_loop
|
||||
logical :: verbose,is_ok
|
||||
verbose = .False.
|
||||
thr = 1.d-12
|
||||
allocate(unpaired_bitmask(N_int,2))
|
||||
@ -240,7 +270,7 @@ subroutine FOBOCI_mlct_old
|
||||
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,verbose,exit_loop)
|
||||
call is_a_good_candidate(threshold_mlct,is_ok,verbose)
|
||||
print*,'is_ok = ',is_ok
|
||||
is_ok =.True.
|
||||
if(.not.is_ok)cycle
|
||||
@ -274,7 +304,7 @@ subroutine FOBOCI_lmct_old
|
||||
double precision :: norm_tmp,norm_total
|
||||
logical :: test_sym
|
||||
double precision :: thr
|
||||
logical :: verbose,is_ok,exit_loop
|
||||
logical :: verbose,is_ok
|
||||
verbose = .False.
|
||||
thr = 1.d-12
|
||||
allocate(unpaired_bitmask(N_int,2))
|
||||
@ -312,7 +342,7 @@ subroutine FOBOCI_lmct_old
|
||||
call set_generators_to_psi_det
|
||||
call set_bitmask_particl_as_input(reunion_of_bitmask)
|
||||
call set_bitmask_hole_as_input(reunion_of_bitmask)
|
||||
call is_a_good_candidate(threshold_lmct,is_ok,verbose,exit_loop)
|
||||
call is_a_good_candidate(threshold_lmct,is_ok,verbose)
|
||||
print*,'is_ok = ',is_ok
|
||||
if(.not.is_ok)cycle
|
||||
! ! so all the mono excitation on the new generators
|
||||
@ -335,303 +365,3 @@ subroutine FOBOCI_lmct_old
|
||||
enddo
|
||||
print*,'accu = ',accu
|
||||
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,7 +9,6 @@ BEGIN_PROVIDER [ integer, N_det_generators_restart ]
|
||||
integer :: i
|
||||
integer, save :: ifirst = 0
|
||||
double precision :: norm
|
||||
print*, ' Providing N_det_generators_restart'
|
||||
if(ifirst == 0)then
|
||||
call ezfio_get_determinants_n_det(N_det_generators_restart)
|
||||
ifirst = 1
|
||||
@ -31,7 +30,6 @@ END_PROVIDER
|
||||
integer :: i, k
|
||||
integer, save :: ifirst = 0
|
||||
double precision, allocatable :: psi_coef_read(:,:)
|
||||
print*, ' Providing psi_det_generators_restart'
|
||||
if(ifirst == 0)then
|
||||
call read_dets(psi_det_generators_restart,N_int,N_det_generators_restart)
|
||||
do k = 1, N_int
|
||||
|
82
plugins/FOBOCI/hcc_1h1p.irp.f
Normal file
82
plugins/FOBOCI/hcc_1h1p.irp.f
Normal file
@ -0,0 +1,82 @@
|
||||
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,50 +212,12 @@ subroutine update_density_matrix_osoci
|
||||
integer :: iorb,jorb
|
||||
do i = 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_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_average(i,j) - one_body_dm_mo_beta_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(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))
|
||||
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
|
||||
|
||||
|
||||
@ -425,14 +387,14 @@ subroutine save_osoci_natural_mos
|
||||
print*,'ACTIVE ORBITAL ',iorb
|
||||
do j = 1, n_inact_orb
|
||||
jorb = list_inact(j)
|
||||
if(dabs(tmp(iorb,jorb)).gt.0.0001d0)then
|
||||
if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then
|
||||
print*,'INACTIVE '
|
||||
print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
|
||||
endif
|
||||
enddo
|
||||
do j = 1, n_virt_orb
|
||||
jorb = list_virt(j)
|
||||
if(dabs(tmp(iorb,jorb)).gt.0.0001d0)then
|
||||
if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then
|
||||
print*,'VIRT '
|
||||
print*,'DM ',iorb,jorb,(tmp(iorb,jorb))
|
||||
endif
|
||||
@ -450,10 +412,6 @@ subroutine save_osoci_natural_mos
|
||||
label = "Natural"
|
||||
|
||||
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
|
||||
deallocate(tmp,occ)
|
||||
|
||||
@ -630,14 +588,14 @@ end
|
||||
integer :: i
|
||||
double precision :: accu_tot,accu_sd
|
||||
print*,'touched the one_body_dm_mo_beta'
|
||||
one_body_dm_mo_alpha_average = one_body_dm_mo_alpha_osoci
|
||||
one_body_dm_mo_beta_average = one_body_dm_mo_beta_osoci
|
||||
one_body_dm_mo_alpha = one_body_dm_mo_alpha_osoci
|
||||
one_body_dm_mo_beta = one_body_dm_mo_beta_osoci
|
||||
touch one_body_dm_mo_alpha one_body_dm_mo_beta
|
||||
accu_tot = 0.d0
|
||||
accu_sd = 0.d0
|
||||
do i = 1, mo_tot_num
|
||||
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_average(i,i) - one_body_dm_mo_beta_average(i,i)
|
||||
accu_tot += one_body_dm_mo_alpha(i,i) + one_body_dm_mo_beta(i,i)
|
||||
accu_sd += one_body_dm_mo_alpha(i,i) - one_body_dm_mo_beta(i,i)
|
||||
enddo
|
||||
print*,'accu_tot = ',accu_tot
|
||||
print*,'accu_sdt = ',accu_sd
|
||||
|
2
plugins/Full_CI/.gitignore
vendored
2
plugins/Full_CI/.gitignore
vendored
@ -3,7 +3,6 @@
|
||||
.ninja_log
|
||||
AO_Basis
|
||||
Bitmask
|
||||
Davidson
|
||||
Determinants
|
||||
Electrons
|
||||
Ezfio_files
|
||||
@ -29,6 +28,7 @@ full_ci
|
||||
full_ci_no_skip
|
||||
irpf90.make
|
||||
irpf90_entities
|
||||
micro_pt2
|
||||
tags
|
||||
target_pt2
|
||||
var_pt2_ratio
|
@ -7,17 +7,16 @@ s.set_selection_pt2("epstein_nesbet_2x2")
|
||||
#s.unset_openmp()
|
||||
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.unset_openmp()
|
||||
print s
|
||||
|
||||
s = H_apply("FCI_PT2_new")
|
||||
s.set_perturbation("decontracted")
|
||||
s.unset_openmp()
|
||||
print s
|
||||
|
||||
|
||||
s = H_apply("FCI_no_skip")
|
||||
s.set_selection_pt2("epstein_nesbet_2x2")
|
||||
s.unset_skip()
|
||||
|
@ -16,7 +16,6 @@ Needed Modules
|
||||
* `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>`_
|
||||
* `Davidson <http://github.com/LCPQ/quantum_package/tree/master/src/Davidson>`_
|
||||
|
||||
Documentation
|
||||
=============
|
||||
@ -78,31 +77,6 @@ h_apply_fci_monoexc
|
||||
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.
|
||||
@ -170,6 +144,118 @@ h_apply_fci_pt2_slave_tcp
|
||||
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>`_
|
||||
Undocumented
|
||||
|
||||
|
@ -92,9 +92,8 @@ program full_ci
|
||||
call diagonalize_CI
|
||||
if(do_pt2_end)then
|
||||
print*,'Last iteration only to compute the PT2'
|
||||
threshold_generators = threshold_generators_pt2
|
||||
threshold_selectors = threshold_selectors_pt2
|
||||
SOFT_TOUCH threshold_generators threshold_selectors
|
||||
threshold_selectors = 1.d0
|
||||
threshold_generators = 0.999d0
|
||||
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
||||
|
||||
print *, 'Final step'
|
||||
|
@ -73,11 +73,9 @@ program full_ci
|
||||
call diagonalize_CI
|
||||
if(do_pt2_end)then
|
||||
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'
|
||||
threshold_selectors = 1.d0
|
||||
threshold_generators = 0.999d0
|
||||
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
||||
|
||||
print *, 'Final step'
|
||||
|
@ -1,11 +0,0 @@
|
||||
[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
|
||||
Perturbation Selectors_full Generators_full ZMQ Full_CI
|
||||
|
@ -1,11 +0,0 @@
|
||||
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,15 +5,11 @@ program fci_zmq
|
||||
|
||||
double precision, allocatable :: pt2(:)
|
||||
integer :: degree
|
||||
integer :: n_det_before, to_select
|
||||
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
|
||||
diag_algorithm = "Lapack"
|
||||
|
||||
if (N_det > N_det_max) then
|
||||
call diagonalize_CI
|
||||
@ -37,11 +33,29 @@ program fci_zmq
|
||||
double precision :: E_CI_before(N_states)
|
||||
|
||||
|
||||
integer :: n_det_before
|
||||
print*,'Beginning the selection ...'
|
||||
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) )
|
||||
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_states = ', N_states
|
||||
@ -65,40 +79,13 @@ program fci_zmq
|
||||
enddo
|
||||
endif
|
||||
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 = 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))
|
||||
call ezfio_set_full_ci_energy(CI_energy)
|
||||
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
|
||||
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
|
||||
threshold_selectors = 1.d0
|
||||
threshold_generators = 0.9999d0
|
||||
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||
call ZMQ_selection(0, pt2)
|
||||
print *, 'Final step'
|
||||
@ -111,11 +98,9 @@ program fci_zmq
|
||||
print *, 'E+PT2 = ', E_CI_before+pt2
|
||||
print *, '-----'
|
||||
enddo
|
||||
call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1))
|
||||
call ezfio_set_full_ci_energy_pt2(E_CI_before+pt2)
|
||||
endif
|
||||
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
|
||||
|
||||
|
||||
@ -136,43 +121,38 @@ subroutine ZMQ_selection(N_in, pt2)
|
||||
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
|
||||
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= 1, N_det_generators,step
|
||||
i_generator_start = i
|
||||
i_generator_max = min(i+step-1,N_det_generators)
|
||||
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(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 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')
|
||||
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
|
||||
|
||||
@ -181,7 +161,7 @@ subroutine selection_slave_inproc(i)
|
||||
implicit none
|
||||
integer, intent(in) :: i
|
||||
|
||||
call run_selection_slave(1,i,pt2_e0_denominator)
|
||||
call run_selection_slave(1,i,ci_electronic_energy)
|
||||
end
|
||||
|
||||
subroutine selection_collector(b, pt2)
|
||||
|
@ -4,7 +4,7 @@ subroutine run_selection_slave(thread,iproc,energy)
|
||||
use selection_types
|
||||
implicit none
|
||||
|
||||
double precision, intent(in) :: energy(N_states)
|
||||
double precision, intent(in) :: energy(N_states_diag)
|
||||
integer, intent(in) :: thread, iproc
|
||||
integer :: rc, i
|
||||
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -13,7 +13,7 @@ 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 mo_mono_elec_integral
|
||||
! PROVIDE pt2_e0_denominator mo_tot_num N_int
|
||||
! PROVIDE ci_electronic_energy mo_tot_num N_int
|
||||
end
|
||||
|
||||
subroutine run_wf
|
||||
@ -22,7 +22,7 @@ subroutine run_wf
|
||||
|
||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||
double precision :: energy(N_states)
|
||||
double precision :: energy(N_states_diag)
|
||||
character*(64) :: states(2)
|
||||
integer :: rc, i
|
||||
|
||||
@ -48,7 +48,7 @@ subroutine run_wf
|
||||
! ---------
|
||||
|
||||
print *, 'Selection'
|
||||
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
|
||||
|
||||
!$OMP PARALLEL PRIVATE(i)
|
||||
i = omp_get_thread_num()
|
||||
@ -76,7 +76,7 @@ end
|
||||
|
||||
subroutine update_energy(energy)
|
||||
implicit none
|
||||
double precision, intent(in) :: energy(N_states)
|
||||
double precision, intent(in) :: energy(N_states_diag)
|
||||
BEGIN_DOC
|
||||
! Update energy when it is received from ZMQ
|
||||
END_DOC
|
||||
@ -88,7 +88,7 @@ subroutine update_energy(energy)
|
||||
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
|
||||
do k=1,size(ci_electronic_energy)
|
||||
ci_electronic_energy(k) = energy(k)
|
||||
enddo
|
||||
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
|
||||
@ -99,7 +99,7 @@ end
|
||||
|
||||
subroutine selection_slave_tcp(i,energy)
|
||||
implicit none
|
||||
double precision, intent(in) :: energy(N_states)
|
||||
double precision, intent(in) :: energy(N_states_diag)
|
||||
integer, intent(in) :: i
|
||||
|
||||
call run_selection_slave(0,i,energy)
|
||||
|
File diff suppressed because it is too large
Load Diff
354
plugins/Full_CI_ZMQ/selection_single.irp.f
Normal file
354
plugins/Full_CI_ZMQ/selection_single.irp.f
Normal file
@ -0,0 +1,354 @@
|
||||
|
||||
|
||||
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_det_sorted, 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
|
||||
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)
|
||||
delta_E = E0(istate) - Hii
|
||||
if (delta_E < 0.d0) then
|
||||
e_pert = 0.5d0 * (-dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
||||
else
|
||||
e_pert = 0.5d0 * ( dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
||||
endif
|
||||
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) call add_to_selection_buffer(buf, det, max_e_pert)
|
||||
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
|
||||
|
||||
genl : 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 genl
|
||||
end subroutine
|
||||
|
||||
|
||||
|
@ -13,7 +13,7 @@ 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
|
||||
! PROVIDE ci_electronic_energy mo_tot_num N_int
|
||||
end
|
||||
|
||||
subroutine run_wf
|
||||
@ -22,7 +22,7 @@ subroutine run_wf
|
||||
|
||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||
double precision :: energy(N_states)
|
||||
double precision :: energy(N_states_diag)
|
||||
character*(64) :: states(1)
|
||||
integer :: rc, i
|
||||
|
||||
@ -47,7 +47,7 @@ subroutine run_wf
|
||||
! ---------
|
||||
|
||||
print *, 'Selection'
|
||||
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
|
||||
|
||||
!$OMP PARALLEL PRIVATE(i)
|
||||
i = omp_get_thread_num()
|
||||
@ -62,7 +62,7 @@ end
|
||||
|
||||
subroutine update_energy(energy)
|
||||
implicit none
|
||||
double precision, intent(in) :: energy(N_states)
|
||||
double precision, intent(in) :: energy(N_states_diag)
|
||||
BEGIN_DOC
|
||||
! Update energy when it is received from ZMQ
|
||||
END_DOC
|
||||
@ -74,7 +74,7 @@ subroutine update_energy(energy)
|
||||
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
|
||||
do k=1,size(ci_electronic_energy)
|
||||
ci_electronic_energy(k) = energy(k)
|
||||
enddo
|
||||
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
|
||||
@ -85,7 +85,7 @@ end
|
||||
|
||||
subroutine selection_slave_tcp(i,energy)
|
||||
implicit none
|
||||
double precision, intent(in) :: energy(N_states)
|
||||
double precision, intent(in) :: energy(N_states_diag)
|
||||
integer, intent(in) :: i
|
||||
|
||||
call run_selection_slave(0,i,energy)
|
||||
|
@ -33,7 +33,7 @@ Documentation
|
||||
.. by the `update_README.py` script.
|
||||
|
||||
|
||||
`degree_max_generators <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L45>`_
|
||||
`degree_max_generators <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L43>`_
|
||||
Max degree of excitation (respect to HF) of the generators
|
||||
|
||||
|
||||
@ -52,10 +52,10 @@ Documentation
|
||||
Hartree-Fock determinant
|
||||
|
||||
|
||||
`select_max <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L68>`_
|
||||
`select_max <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L66>`_
|
||||
Memo to skip useless selectors
|
||||
|
||||
|
||||
`size_select_max <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L60>`_
|
||||
`size_select_max <http://github.com/LCPQ/quantum_package/tree/master/plugins/Generators_full/generators.irp.f#L58>`_
|
||||
Size of the select_max array
|
||||
|
||||
|
@ -67,11 +67,11 @@ Documentation
|
||||
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#L269>`_
|
||||
`fock_matrix_alpha_mo <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L268>`_
|
||||
Fock matrix on the MO basis
|
||||
|
||||
|
||||
`fock_matrix_ao <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L327>`_
|
||||
`fock_matrix_ao <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L326>`_
|
||||
Fock matrix in AO basis set
|
||||
|
||||
|
||||
@ -79,7 +79,7 @@ Documentation
|
||||
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#L289>`_
|
||||
`fock_matrix_beta_mo <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L288>`_
|
||||
Fock matrix on the MO basis
|
||||
|
||||
|
||||
@ -115,7 +115,7 @@ Documentation
|
||||
.br
|
||||
|
||||
|
||||
`fock_mo_to_ao <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L389>`_
|
||||
`fock_mo_to_ao <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L388>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
@ -135,7 +135,7 @@ Documentation
|
||||
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#L308>`_
|
||||
`hf_energy <http://github.com/LCPQ/quantum_package/tree/master/plugins/Hartree_Fock/Fock_matrix.irp.f#L307>`_
|
||||
Hartree-Fock energy
|
||||
|
||||
|
||||
|
@ -1,10 +1,4 @@
|
||||
program mp2
|
||||
no_vvvv_integrals = .True.
|
||||
SOFT_TOUCH no_vvvv_integrals
|
||||
call run
|
||||
end
|
||||
|
||||
subroutine run
|
||||
implicit none
|
||||
double precision, allocatable :: pt2(:), norm_pert(:)
|
||||
double precision :: H_pert_diag, E_old
|
||||
|
@ -1,10 +1,4 @@
|
||||
program mp2_wf
|
||||
no_vvvv_integrals = .True.
|
||||
SOFT_TOUCH no_vvvv_integrals
|
||||
call run
|
||||
end
|
||||
|
||||
subroutine run
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Save the MP2 wave function
|
||||
|
1
plugins/MRCC_Utils/.gitignore
vendored
1
plugins/MRCC_Utils/.gitignore
vendored
@ -3,7 +3,6 @@
|
||||
.ninja_log
|
||||
AO_Basis
|
||||
Bitmask
|
||||
Davidson
|
||||
Determinants
|
||||
Electrons
|
||||
Ezfio_files
|
||||
|
@ -36,19 +36,11 @@ Documentation
|
||||
Compute 1st dimension such that it is aligned for vectorization.
|
||||
|
||||
|
||||
`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_rotation <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L283>`_
|
||||
Apply the rotation found by find_rotation
|
||||
|
||||
|
||||
`approx_dble <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L371>`_
|
||||
`approx_dble <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L382>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
@ -71,23 +63,23 @@ Documentation
|
||||
Binomial coefficients
|
||||
|
||||
|
||||
`ci_eigenvectors_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L120>`_
|
||||
Eigenvectors/values of the dressed CI matrix
|
||||
`ci_eigenvectors_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L105>`_
|
||||
Eigenvectors/values of the CI matrix
|
||||
|
||||
|
||||
`ci_eigenvectors_s2_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L121>`_
|
||||
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>`_
|
||||
Eigenvectors/values of the CI matrix
|
||||
|
||||
|
||||
`ci_electronic_energy_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L119>`_
|
||||
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>`_
|
||||
Eigenvectors/values of the CI matrix
|
||||
|
||||
|
||||
`ci_energy_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L247>`_
|
||||
`ci_energy_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L171>`_
|
||||
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#L57>`_
|
||||
`davidson_diag_hjj_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L59>`_
|
||||
Davidson diagonalization with specific diagonal elements of the H matrix
|
||||
.br
|
||||
H_jj : specific diagonal H matrix elements to diagonalize de Davidson
|
||||
@ -103,39 +95,12 @@ Documentation
|
||||
.br
|
||||
N_st : Number of eigenstates
|
||||
.br
|
||||
N_st_diag : Number of states in which H is diagonalized
|
||||
.br
|
||||
iunit : Unit for the I/O
|
||||
.br
|
||||
Initial guess vectors are not necessarily orthonormal
|
||||
|
||||
|
||||
`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_diag_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L4>`_
|
||||
Davidson diagonalization.
|
||||
.br
|
||||
dets_in : bitmasks corresponding to determinants
|
||||
@ -154,38 +119,19 @@ Documentation
|
||||
Initial guess vectors are not necessarily orthonormal
|
||||
|
||||
|
||||
`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>`_
|
||||
`dble_fact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L138>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
`dble_fact_even <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L153>`_
|
||||
`dble_fact_even <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L155>`_
|
||||
n!!
|
||||
|
||||
|
||||
`dble_fact_odd <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L197>`_
|
||||
`dble_fact_odd <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L176>`_
|
||||
n!!
|
||||
|
||||
|
||||
`dble_logfact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L231>`_
|
||||
`dble_logfact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L210>`_
|
||||
n!!
|
||||
|
||||
|
||||
@ -193,23 +139,19 @@ Documentation
|
||||
Undocumented
|
||||
|
||||
|
||||
`dec_exc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L532>`_
|
||||
Undocumented
|
||||
`delta_ii <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L68>`_
|
||||
Dressing matrix in N_det basis
|
||||
|
||||
|
||||
`diagonalize_ci_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L265>`_
|
||||
`delta_ij <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L67>`_
|
||||
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
|
||||
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>`_
|
||||
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.
|
||||
@ -228,26 +170,10 @@ Documentation
|
||||
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>`_
|
||||
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>`_
|
||||
function that calculates the following integral
|
||||
\int_{\-infty}^{+\infty} x^n \exp(-p x^2) dx
|
||||
@ -257,19 +183,19 @@ Documentation
|
||||
n!
|
||||
|
||||
|
||||
`fact_inv <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L123>`_
|
||||
`fact_inv <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L125>`_
|
||||
1/n!
|
||||
|
||||
|
||||
`find_rotation <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L301>`_
|
||||
`find_rotation <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L264>`_
|
||||
Find A.C = B
|
||||
|
||||
|
||||
`find_triples_and_quadruples <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L286>`_
|
||||
`find_triples_and_quadruples <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L315>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
`find_triples_and_quadruples_micro <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L346>`_
|
||||
`find_triples_and_quadruples_micro <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_dress.irp.f#L375>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
@ -295,15 +221,7 @@ Documentation
|
||||
Undocumented
|
||||
|
||||
|
||||
`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>`_
|
||||
`get_pseudo_inverse <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L210>`_
|
||||
Find C = A^-1
|
||||
|
||||
|
||||
@ -388,63 +306,11 @@ h_apply_mrcc_pt2_monoexc
|
||||
Assume N_int is already provided.
|
||||
|
||||
|
||||
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>`_
|
||||
`h_matrix_dressed <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L79>`_
|
||||
Dressed H with Delta_ij
|
||||
|
||||
|
||||
`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>`_
|
||||
`h_u_0_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/davidson.irp.f#L367>`_
|
||||
Computes v_0 = H|u_0>
|
||||
.br
|
||||
n : number of determinants
|
||||
@ -526,15 +392,7 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
Hermite polynomial
|
||||
|
||||
|
||||
`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>`_
|
||||
`hij_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L53>`_
|
||||
< ref | H | Non-ref > matrix
|
||||
|
||||
|
||||
@ -665,7 +523,7 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
to be in integer*8 format
|
||||
|
||||
|
||||
`inv_int <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L278>`_
|
||||
`inv_int <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L257>`_
|
||||
1/i
|
||||
|
||||
|
||||
@ -683,10 +541,6 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
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>`_
|
||||
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.
|
||||
@ -705,19 +559,15 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
contains the new order of the elements.
|
||||
|
||||
|
||||
`lambda_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L8>`_
|
||||
`lambda_mrcc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L1>`_
|
||||
cm/<Psi_0|H|D_m> or perturbative 1/Delta_E(m)
|
||||
|
||||
|
||||
`lambda_mrcc_kept <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L10>`_
|
||||
`lambda_mrcc_pt2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L2>`_
|
||||
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#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>`_
|
||||
`lapack_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L362>`_
|
||||
Diagonalize matrix H
|
||||
.br
|
||||
H is untouched between input and ouptut
|
||||
@ -728,7 +578,7 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
.br
|
||||
|
||||
|
||||
`lapack_diag_s2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L462>`_
|
||||
`lapack_diag_s2 <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L425>`_
|
||||
Diagonalize matrix H
|
||||
.br
|
||||
H is untouched between input and ouptut
|
||||
@ -739,7 +589,7 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
.br
|
||||
|
||||
|
||||
`lapack_diagd <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L332>`_
|
||||
`lapack_diagd <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L295>`_
|
||||
Diagonalize matrix H
|
||||
.br
|
||||
H is untouched between input and ouptut
|
||||
@ -750,7 +600,7 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
.br
|
||||
|
||||
|
||||
`lapack_partial_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L528>`_
|
||||
`lapack_partial_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L491>`_
|
||||
Diagonalize matrix H
|
||||
.br
|
||||
H is untouched between input and ouptut
|
||||
@ -761,27 +611,19 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
.br
|
||||
|
||||
|
||||
`logfact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L91>`_
|
||||
`logfact <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L93>`_
|
||||
n!
|
||||
|
||||
|
||||
`lowercase <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L395>`_
|
||||
`lowercase <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L406>`_
|
||||
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>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
`mrmode <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_utils.irp.f#L3>`_
|
||||
`mrcc_iterations <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_general.irp.f#L7>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
@ -790,24 +632,12 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
D(t) =! D(t) +( B(t)*C(t))
|
||||
|
||||
|
||||
`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>`_
|
||||
`normalize <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L358>`_
|
||||
Normalizes vector u
|
||||
u is expected to be aligned in memory.
|
||||
|
||||
|
||||
`nproc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L304>`_
|
||||
`nproc <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L283>`_
|
||||
Number of current OpenMP threads
|
||||
|
||||
|
||||
@ -829,7 +659,7 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
.br
|
||||
|
||||
|
||||
`ortho_lowdin <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L162>`_
|
||||
`ortho_lowdin <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L128>`_
|
||||
Compute C_new=C_old.S^-1/2 orthogonalization.
|
||||
.br
|
||||
overlap : overlap matrix
|
||||
@ -847,19 +677,6 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
.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>`_
|
||||
Undocumented
|
||||
|
||||
@ -890,10 +707,6 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
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>`_
|
||||
Current status for displaying progress bars. Global variable.
|
||||
|
||||
@ -914,14 +727,6 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
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>`_
|
||||
Locks on ref determinants to fill delta_ij
|
||||
|
||||
@ -930,10 +735,6 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
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>`_
|
||||
.. math::
|
||||
.br
|
||||
@ -961,6 +762,10 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
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>`_
|
||||
Display a progress bar with documentation of what is happening
|
||||
|
||||
@ -969,15 +774,7 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
Undocumented
|
||||
|
||||
|
||||
`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>`_
|
||||
`set_generators_bitmasks_as_holes_and_particles <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/mrcc_general.irp.f#L59>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
@ -993,7 +790,7 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
to be in integer*8 format
|
||||
|
||||
|
||||
`set_zero_extra_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L585>`_
|
||||
`set_zero_extra_diag <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/LinearAlgebra.irp.f#L548>`_
|
||||
Undocumented
|
||||
|
||||
|
||||
@ -1003,14 +800,6 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
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>`_
|
||||
Starts the progress bar
|
||||
|
||||
@ -1028,37 +817,18 @@ h_apply_mrcepa_pt2_slave_tcp
|
||||
.br
|
||||
|
||||
|
||||
`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>`_
|
||||
`u_dot_u <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L326>`_
|
||||
Compute <u|u>
|
||||
|
||||
|
||||
`u_dot_v <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L320>`_
|
||||
`u_dot_v <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L299>`_
|
||||
Compute <u|v>
|
||||
|
||||
|
||||
`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>`_
|
||||
`wall_time <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L268>`_
|
||||
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#L264>`_
|
||||
`write_git_log <http://github.com/LCPQ/quantum_package/tree/master/plugins/MRCC_Utils/util.irp.f#L243>`_
|
||||
Write the last git commit in file iunit.
|
||||
|
||||
|
@ -1,238 +0,0 @@
|
||||
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,6 +94,7 @@ 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 :: u_dot_v, u_dot_u
|
||||
|
||||
integer, allocatable :: kl_pairs(:,:)
|
||||
integer :: k_pairs, kl
|
||||
|
||||
integer :: iter2
|
||||
@ -143,6 +144,7 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
||||
sze_8 = align_double(sze)
|
||||
|
||||
allocate( &
|
||||
kl_pairs(2,N_st_diag*(N_st_diag+1)/2), &
|
||||
W(sze_8,N_st_diag,davidson_sze_max), &
|
||||
U(sze_8,N_st_diag,davidson_sze_max), &
|
||||
R(sze_8,N_st_diag), &
|
||||
@ -207,6 +209,19 @@ 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, &
|
||||
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))
|
||||
@ -315,10 +330,20 @@ 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
|
||||
energies(k) = lambda(k)
|
||||
do i=1,sze
|
||||
u_in(i,k) = 0.d0
|
||||
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, &
|
||||
U, size(U,1), y, N_st_diag*davidson_sze_max, &
|
||||
@ -326,9 +351,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
||||
|
||||
enddo
|
||||
|
||||
do k=1,N_st_diag
|
||||
energies(k) = lambda(k)
|
||||
enddo
|
||||
write_buffer = '===== '
|
||||
do i=1,N_st
|
||||
write_buffer = trim(write_buffer)//' ================ ================'
|
||||
@ -338,6 +360,7 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
|
||||
call write_time(iunit)
|
||||
|
||||
deallocate ( &
|
||||
kl_pairs, &
|
||||
W, residual_norm, &
|
||||
U, overlap, &
|
||||
R, c, &
|
||||
@ -550,7 +573,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(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||
double precision, intent(inout) :: u_in(dim_in,N_st_diag)
|
||||
double precision, intent(out) :: energies(N_st_diag)
|
||||
double precision, intent(out) :: energies(N_st)
|
||||
double precision, allocatable :: H_jj(:), S2_jj(:)
|
||||
|
||||
double precision :: diag_h_mat_elem
|
||||
@ -623,12 +646,14 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
integer :: i,j,k,l,m
|
||||
logical :: converged
|
||||
|
||||
double precision, allocatable :: overlap(:,:)
|
||||
double precision :: u_dot_v, u_dot_u
|
||||
|
||||
integer, allocatable :: kl_pairs(:,:)
|
||||
integer :: k_pairs, kl
|
||||
|
||||
integer :: iter2
|
||||
double precision, allocatable :: W(:,:), U(:,:), S(:,:), overlap(:,:)
|
||||
double precision, allocatable :: W(:,:), U(:,:), R(:,:), S(:,:)
|
||||
double precision, allocatable :: y(:,:), h(:,:), lambda(:), s2(:)
|
||||
double precision, allocatable :: c(:), s_(:,:), s_tmp(:,:)
|
||||
double precision :: diag_h_mat_elem
|
||||
@ -636,14 +661,12 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
character*(16384) :: write_buffer
|
||||
double precision :: to_print(3,N_st)
|
||||
double precision :: cpu, wall
|
||||
integer :: shift, shift2, itermax
|
||||
integer :: shift, shift2
|
||||
include 'constants.include.F'
|
||||
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, S, y, h, lambda
|
||||
if (N_st_diag*3 > sze) then
|
||||
print *, 'error in Davidson :'
|
||||
print *, 'Increase n_det_max_jacobi to ', N_st_diag*3
|
||||
stop -1
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, R, S, y, h, lambda
|
||||
if (N_st_diag > sze) then
|
||||
stop 'error in Davidson : N_st_diag > sze'
|
||||
endif
|
||||
|
||||
PROVIDE nuclear_repulsion
|
||||
@ -668,7 +691,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_buffer = ' Iter'
|
||||
do i=1,N_st
|
||||
write_buffer = trim(write_buffer)//' Energy S^2 Residual '
|
||||
write_buffer = trim(write_buffer)//' Energy S^2 Residual'
|
||||
enddo
|
||||
write(iunit,'(A)') trim(write_buffer)
|
||||
write_buffer = '===== '
|
||||
@ -680,30 +703,30 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
integer, external :: align_double
|
||||
sze_8 = align_double(sze)
|
||||
|
||||
itermax = min(davidson_sze_max, sze/N_st_diag)
|
||||
double precision :: delta
|
||||
|
||||
if (s2_eig) then
|
||||
delta = 1.d0
|
||||
else
|
||||
delta = 0.d0
|
||||
endif
|
||||
|
||||
allocate( &
|
||||
W(sze_8,N_st_diag*itermax), &
|
||||
U(sze_8,N_st_diag*itermax), &
|
||||
S(sze_8,N_st_diag*itermax), &
|
||||
h(N_st_diag*itermax,N_st_diag*itermax), &
|
||||
y(N_st_diag*itermax,N_st_diag*itermax), &
|
||||
s_(N_st_diag*itermax,N_st_diag*itermax), &
|
||||
s_tmp(N_st_diag*itermax,N_st_diag*itermax), &
|
||||
kl_pairs(2,N_st_diag*(N_st_diag+1)/2), &
|
||||
W(sze_8,N_st_diag*davidson_sze_max), &
|
||||
U(sze_8,N_st_diag*davidson_sze_max), &
|
||||
R(sze_8,N_st_diag), &
|
||||
S(sze_8,N_st_diag*davidson_sze_max), &
|
||||
h(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
||||
y(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
||||
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), &
|
||||
c(N_st_diag*itermax), &
|
||||
s2(N_st_diag*itermax), &
|
||||
overlap(N_st_diag*itermax,N_st_diag*itermax), &
|
||||
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
|
||||
|
||||
|
||||
overlap(N_st_diag,N_st_diag), &
|
||||
c(N_st_diag*davidson_sze_max), &
|
||||
s2(N_st_diag*davidson_sze_max), &
|
||||
lambda(N_st_diag*davidson_sze_max))
|
||||
|
||||
ASSERT (N_st > 0)
|
||||
ASSERT (N_st_diag >= N_st)
|
||||
ASSERT (sze > 0)
|
||||
@ -715,19 +738,25 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
|
||||
converged = .False.
|
||||
|
||||
double precision :: r1, r2
|
||||
do k=1,N_st
|
||||
call normalize(u_in(1,k),sze)
|
||||
enddo
|
||||
|
||||
do k=N_st+1,N_st_diag
|
||||
u_in(k,k) = 10.d0
|
||||
do i=1,sze
|
||||
double precision :: r1, r2
|
||||
call random_number(r1)
|
||||
call random_number(r2)
|
||||
r1 = dsqrt(-2.d0*dlog(r1))
|
||||
r2 = dtwo_pi*r2
|
||||
u_in(i,k) = r1*dcos(r2)
|
||||
u_in(i,k) = dsqrt(-2.d0*dlog(r1))*dcos(dtwo_pi*r2)
|
||||
enddo
|
||||
enddo
|
||||
do k=1,N_st_diag
|
||||
call normalize(u_in(1,k),sze)
|
||||
|
||||
! Gram-Schmidt
|
||||
! ------------
|
||||
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)
|
||||
enddo
|
||||
|
||||
|
||||
@ -744,10 +773,10 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
shift = N_st_diag*(iter-1)
|
||||
shift2 = N_st_diag*iter
|
||||
|
||||
call ortho_qr(U,size(U,1),sze,shift2)
|
||||
|
||||
! 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,&
|
||||
istate,N_st_diag,sze_8)
|
||||
@ -757,57 +786,31 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
! -------------------------------------------
|
||||
|
||||
|
||||
call dgemm('T','N', shift2, shift2, sze, &
|
||||
1.d0, U, size(U,1), W, size(W,1), &
|
||||
0.d0, h, size(h,1))
|
||||
|
||||
call dgemm('T','N', shift2, shift2, sze, &
|
||||
1.d0, U, size(U,1), S, size(S,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
|
||||
! 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
|
||||
!
|
||||
! ! 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), W(1,shift+1), size(W,1), &
|
||||
0.d0, h(1,shift+1), 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
|
||||
! -------------
|
||||
call lapack_diag(lambda,y,h,size(h,1),shift2)
|
||||
|
||||
|
||||
! Compute S2 for each eigenvector
|
||||
! -------------------------------
|
||||
|
||||
@ -824,81 +827,46 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
enddo
|
||||
|
||||
if (s2_eig) then
|
||||
logical :: state_ok(N_st_diag*davidson_sze_max)
|
||||
do k=1,shift2
|
||||
state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0)
|
||||
enddo
|
||||
else
|
||||
do k=1,size(state_ok)
|
||||
state_ok(k) = .True.
|
||||
enddo
|
||||
endif
|
||||
|
||||
do k=1,shift2
|
||||
if (.not. state_ok(k)) then
|
||||
do l=k+1,shift2
|
||||
if (state_ok(l)) then
|
||||
call dswap(shift2, y(1,k), 1, y(1,l), 1)
|
||||
call dswap(1, s2(k), 1, s2(l), 1)
|
||||
call dswap(1, lambda(k), 1, lambda(l), 1)
|
||||
state_ok(k) = .True.
|
||||
state_ok(l) = .False.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
|
||||
if (state_following) then
|
||||
|
||||
! Compute overlap with U_in
|
||||
! -------------------------
|
||||
|
||||
integer :: order(N_st_diag)
|
||||
double precision :: cmax
|
||||
overlap = -1.d0
|
||||
logical :: state_ok(N_st_diag*davidson_sze_max)
|
||||
do k=1,shift2
|
||||
do i=1,shift2
|
||||
overlap(k,i) = dabs(y(k,i))
|
||||
enddo
|
||||
state_ok(k) = (dabs(s2(k)-expected_s2) < 0.3d0)
|
||||
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)
|
||||
do k=1,shift2
|
||||
if (.not. state_ok(k)) then
|
||||
do l=k+1,shift2
|
||||
if (state_ok(l)) then
|
||||
call dswap(shift2, y(1,k), 1, y(1,l), 1)
|
||||
call dswap(1, s2(k), 1, s2(l), 1)
|
||||
call dswap(1, lambda(k), 1, lambda(l), 1)
|
||||
state_ok(k) = .True.
|
||||
state_ok(l) = .False.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
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
|
||||
|
||||
|
||||
! 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, &
|
||||
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, &
|
||||
@ -908,65 +876,102 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
|
||||
! 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
|
||||
! if (state_ok(k)) then
|
||||
do i=1,sze
|
||||
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 &
|
||||
)/max(H_jj(i) - lambda (k),1.d-2)
|
||||
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
|
||||
|
||||
do i=1,sze
|
||||
R(i,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)
|
||||
enddo
|
||||
if (k <= N_st) then
|
||||
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
|
||||
residual_norm(k) = u_dot_u(R(1,k),sze)
|
||||
to_print(1,k) = lambda(k) + nuclear_repulsion
|
||||
to_print(2,k) = s2(k)
|
||||
to_print(3,k) = residual_norm(k)
|
||||
if (residual_norm(k) > 1.e9) then
|
||||
stop 'Davidson failed'
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
|
||||
write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(1:3,1:N_st)
|
||||
write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(:,1:N_st)
|
||||
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
|
||||
exit
|
||||
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
|
||||
|
||||
! 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
|
||||
! -----------
|
||||
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
|
||||
do k=1,N_st_diag
|
||||
energies(k) = lambda(k)
|
||||
enddo
|
||||
|
||||
enddo
|
||||
! do k=1,N_st_diag
|
||||
! do i=1,sze
|
||||
! 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))
|
||||
|
||||
do k=1,N_st_diag
|
||||
energies(k) = lambda(k)
|
||||
enddo
|
||||
|
||||
write_buffer = '===== '
|
||||
@ -978,9 +983,10 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
|
||||
call write_time(iunit)
|
||||
|
||||
deallocate ( &
|
||||
kl_pairs, &
|
||||
W, residual_norm, &
|
||||
U, overlap, &
|
||||
c, S, &
|
||||
R, c, S, &
|
||||
h, &
|
||||
y, s_, s_tmp, &
|
||||
lambda &
|
||||
@ -1042,16 +1048,15 @@ 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_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 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 N_det_ref, idx_ref, N_det_non_ref, idx_non_ref, delta_ij, delta_ij_s2,istate_in)
|
||||
!$OMP N_det_ref, idx_ref, N_det_non_ref, idx_non_ref, delta_ij,istate_in)
|
||||
allocate(vt(N_st_8,n),st(N_st_8,n))
|
||||
Vt = 0.d0
|
||||
St = 0.d0
|
||||
|
||||
!$OMP DO SCHEDULE(guided)
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do sh=1,shortcut(0,1)
|
||||
do sh2=sh,shortcut(0,1)
|
||||
exa = 0
|
||||
@ -1093,8 +1098,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
|
||||
!$OMP END DO
|
||||
!$OMP DO SCHEDULE(guided)
|
||||
!$OMP END DO NOWAIT
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do sh=1,shortcut(0,2)
|
||||
do i=shortcut(sh,2),shortcut(sh+1,2)-1
|
||||
org_i = sort_idx(i,2)
|
||||
@ -1117,7 +1122,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
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
! --------------------------
|
||||
! Begin Specific to dressing
|
||||
@ -1131,8 +1136,6 @@ 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
|
||||
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)
|
||||
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
|
||||
|
4
plugins/MRCC_Utils/mrcc_dummy.irp.f
Normal file
4
plugins/MRCC_Utils/mrcc_dummy.irp.f
Normal file
@ -0,0 +1,4 @@
|
||||
program pouet
|
||||
|
||||
|
||||
end
|
@ -33,7 +33,6 @@ END_PROVIDER
|
||||
if (ihpsi_current(k) == 0.d0) then
|
||||
ihpsi_current(k) = 1.d-32
|
||||
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_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii)
|
||||
if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then
|
||||
@ -78,6 +77,19 @@ BEGIN_PROVIDER [ double precision, hij_mrcc, (N_det_non_ref,N_det_ref) ]
|
||||
|
||||
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
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ]
|
||||
implicit none
|
||||
@ -127,6 +139,7 @@ END_PROVIDER
|
||||
|
||||
integer :: mrcc_state
|
||||
|
||||
mrcc_state = N_states
|
||||
do j=1,min(N_states,N_det)
|
||||
do i=1,N_det
|
||||
CI_eigenvectors_dressed(i,j) = psi_coef(i,j)
|
||||
@ -135,34 +148,17 @@ END_PROVIDER
|
||||
|
||||
if (diag_algorithm == "Davidson") then
|
||||
|
||||
allocate (eigenvectors(size(CI_eigenvectors_dressed,1),size(CI_eigenvectors_dressed,2)), &
|
||||
eigenvalues(size(CI_electronic_energy_dressed,1)))
|
||||
do j=1,min(N_states,N_det)
|
||||
do i=1,N_det
|
||||
eigenvectors(i,j) = psi_coef(i,j)
|
||||
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)
|
||||
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,&
|
||||
N_states_diag,size(CI_eigenvectors_dressed,1))
|
||||
! call davidson_diag_mrcc(psi_det,CI_eigenvectors_dressed,CI_electronic_energy_dressed,&
|
||||
! size(CI_eigenvectors_dressed,1),N_det,N_states,N_states_diag,N_int,output_determinants,mrcc_state)
|
||||
|
||||
call davidson_diag_mrcc_HS2(psi_det,CI_eigenvectors_dressed,&
|
||||
size(CI_eigenvectors_dressed,1), &
|
||||
CI_electronic_energy_dressed,N_det,N_states,N_states_diag,N_int, &
|
||||
output_determinants,mrcc_state)
|
||||
|
||||
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))
|
||||
|
||||
deallocate (eigenvectors,eigenvalues)
|
||||
|
||||
else if (diag_algorithm == "Lapack") then
|
||||
|
||||
@ -618,52 +614,207 @@ END_PROVIDER
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, dIj_unique, (hh_nex, N_states) ]
|
||||
BEGIN_PROVIDER [ double precision, dIj_unique, (hh_shortcut(hh_shortcut(0)+1)-1, N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, rho_mrcc, (N_det_non_ref, N_states) ]
|
||||
implicit none
|
||||
logical :: ok
|
||||
integer :: i, j, k, s, II, pp, ppp, hh, ind, wk, a_col, at_row
|
||||
integer :: i, j, k, s, II, pp, ppp, hh, ind, wk, nex, a_col, at_row
|
||||
integer, external :: searchDet, unsortedSearchDet
|
||||
integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2)
|
||||
integer :: N, INFO, r1, r2
|
||||
double precision , allocatable :: AtB(:), x(:), x_new(:), A_val_mwen(:,:), t(:)
|
||||
double precision :: norm, cx, res
|
||||
integer, allocatable :: lref(:), A_ind_mwen(:)
|
||||
integer :: N, INFO, AtA_size, r1, r2
|
||||
double precision , allocatable :: AtB(:), AtA_val(:), A_val(:,:), x(:), x_new(:), A_val_mwen(:)
|
||||
double precision :: t, norm, cx, res
|
||||
integer, allocatable :: A_ind(:,:), lref(:), AtA_ind(:), A_ind_mwen(:), col_shortcut(:), N_col(:)
|
||||
double precision :: phase
|
||||
|
||||
|
||||
double precision, allocatable :: rho_mrcc_init(:)
|
||||
integer :: a_coll, at_roww
|
||||
integer, allocatable :: pathTo(:), active_hh_idx(:), active_pp_idx(:)
|
||||
logical, allocatable :: active(:)
|
||||
double precision, allocatable :: rho_mrcc_init(:,:)
|
||||
integer :: nactive
|
||||
|
||||
print *, "TI", hh_nex, N_det_non_ref
|
||||
|
||||
allocate(rho_mrcc_init(N_det_non_ref))
|
||||
allocate(x_new(hh_nex))
|
||||
allocate(x(hh_nex), AtB(hh_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)
|
||||
do at_roww = 1, n_exc_active ! hh_nex
|
||||
at_row = active_pp_idx(at_roww)
|
||||
do i=1,active_excitation_to_determinants_idx(0,at_roww)
|
||||
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)
|
||||
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
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP END PARALLEL
|
||||
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))
|
||||
|
||||
|
||||
X(:) = 0d0
|
||||
|
||||
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
|
||||
|
||||
|
||||
do a_coll = 1, n_exc_active
|
||||
print *, 'Done building A_val, A_ind'
|
||||
|
||||
AtA_size = 0
|
||||
col_shortcut = 0
|
||||
N_col = 0
|
||||
integer :: a_coll, at_roww
|
||||
|
||||
|
||||
!$OMP PARALLEL default(none) shared(k, psi_non_ref_coef, A_ind, A_val, x, N_det_ref, nex, 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)&
|
||||
!$OMP shared(col_shortcut, N_col, AtB, AtA_size, AtA_val, AtA_ind, s, nactive, active_pp_idx)
|
||||
allocate(A_val_mwen(nex), A_ind_mwen(nex))
|
||||
|
||||
!$OMP DO schedule(dynamic, 100)
|
||||
do at_roww = 1, nactive ! nex
|
||||
at_row = active_pp_idx(at_roww)
|
||||
wk = 0
|
||||
if(mod(at_roww, 100) == 0) print *, "AtA", at_row, "/", nex
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
print *, "ATA SIZE", ata_size
|
||||
x = 0d0
|
||||
|
||||
|
||||
do a_coll = 1, nactive
|
||||
a_col = active_pp_idx(a_coll)
|
||||
X(a_col) = AtB(a_col)
|
||||
end do
|
||||
@ -671,11 +822,12 @@ END_PROVIDER
|
||||
rho_mrcc_init = 0d0
|
||||
|
||||
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 pp = hh_shortcut(hh), hh_shortcut(hh+1)-1
|
||||
if(is_active_exc(pp)) cycle
|
||||
if(active(pp)) cycle
|
||||
lref = 0
|
||||
AtB(pp) = 0.d0
|
||||
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
|
||||
@ -685,75 +837,79 @@ END_PROVIDER
|
||||
if(ind == -1) cycle
|
||||
ind = psi_non_ref_sorted_idx(ind)
|
||||
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
|
||||
lref(II) = ind
|
||||
if(phase < 0.d0) lref(II) = -ind
|
||||
if(phase < 0d0) lref(II) = -ind
|
||||
end do
|
||||
X(pp) = AtB(pp)
|
||||
X(pp) = AtB(pp) / X(pp)
|
||||
do II=1,N_det_ref
|
||||
if(lref(II) > 0) then
|
||||
rho_mrcc_init(lref(II)) = psi_ref_coef(II,s) * X(pp)
|
||||
rho_mrcc_init(lref(II),s) = psi_ref_coef(II,s) * X(pp)
|
||||
else if(lref(II) < 0) then
|
||||
rho_mrcc_init(-lref(II)) = -psi_ref_coef(II,s) * X(pp)
|
||||
rho_mrcc_init(-lref(II),s) = -psi_ref_coef(II,s) * X(pp)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
deallocate(lref)
|
||||
|
||||
do i=1,N_det_non_ref
|
||||
rho_mrcc(i,s) = rho_mrcc_init(i)
|
||||
enddo
|
||||
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
x_new = x
|
||||
|
||||
double precision :: factor, resold
|
||||
factor = 1.d0
|
||||
resold = huge(1.d0)
|
||||
|
||||
do k=0,10*hh_nex
|
||||
res = 0.d0
|
||||
!$OMP PARALLEL default(shared) private(cx, i, a_col, a_coll) reduction(+:res)
|
||||
do k=0,100000
|
||||
!$OMP PARALLEL default(shared) private(cx, i, j, a_col, a_coll)
|
||||
|
||||
!$OMP DO
|
||||
do a_coll = 1, n_exc_active
|
||||
do i=1,N_det_non_ref
|
||||
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)
|
||||
cx = 0.d0
|
||||
do i=mrcc_col_shortcut(a_coll), mrcc_col_shortcut(a_coll) + mrcc_N_col(a_coll) - 1
|
||||
cx = cx + x(mrcc_AtA_ind(i)) * mrcc_AtA_val(s,i)
|
||||
cx = 0d0
|
||||
do i=col_shortcut(a_coll), col_shortcut(a_coll) + N_col(a_coll) - 1
|
||||
cx = cx + x(AtA_ind(i)) * AtA_val(i)
|
||||
end do
|
||||
x_new(a_col) = AtB(a_col) + cx * factor
|
||||
res = res + (X_new(a_col) - X(a_col))*(X_new(a_col) - X(a_col))
|
||||
X(a_col) = X_new(a_col)
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
if (res > resold) then
|
||||
factor = factor * 0.5d0
|
||||
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))
|
||||
X(a_col) = X_new(a_col)
|
||||
end do
|
||||
factor = 1.d0
|
||||
else
|
||||
factor = -factor * 0.5d0
|
||||
endif
|
||||
resold = res
|
||||
|
||||
if(iand(k, 4095) == 0) then
|
||||
if(mod(k, 100) == 0) then
|
||||
print *, "res ", k, res
|
||||
end if
|
||||
|
||||
if(res < 1d-10) exit
|
||||
if(res < 1d-9) exit
|
||||
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
|
||||
do i=1,N_det_non_ref
|
||||
norm = norm + rho_mrcc(i,s)*rho_mrcc(i,s)
|
||||
@ -765,11 +921,122 @@ END_PROVIDER
|
||||
enddo
|
||||
! Norm now contains the norm of Psi + A.X
|
||||
|
||||
print *, "norm : ", sqrt(norm)
|
||||
enddo
|
||||
|
||||
print *, k, "res : ", res, "norm : ", sqrt(norm)
|
||||
|
||||
do s=1,N_states
|
||||
!---------------
|
||||
! double precision :: e_0, overlap
|
||||
! double precision, allocatable :: u_0(:)
|
||||
! integer(bit_kind), allocatable :: keys_tmp(:,:,:)
|
||||
! allocate (u_0(N_det), keys_tmp(N_int,2,N_det) )
|
||||
! k=0
|
||||
! overlap = 0.d0
|
||||
! do i=1,N_det_ref
|
||||
! k = k+1
|
||||
! u_0(k) = psi_ref_coef(i,1)
|
||||
! keys_tmp(:,:,k) = psi_ref(:,:,i)
|
||||
! overlap += u_0(k)*psi_ref_coef(i,1)
|
||||
! enddo
|
||||
! norm = 0.d0
|
||||
! do i=1,N_det_non_ref
|
||||
! k = k+1
|
||||
! u_0(k) = psi_non_ref_coef(i,1)
|
||||
! keys_tmp(:,:,k) = psi_non_ref(:,:,i)
|
||||
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||
! enddo
|
||||
!
|
||||
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||
! print *, 'Energy of |Psi_CASSD> : ', e_0 + nuclear_repulsion, overlap
|
||||
!
|
||||
! k=0
|
||||
! overlap = 0.d0
|
||||
! do i=1,N_det_ref
|
||||
! k = k+1
|
||||
! u_0(k) = psi_ref_coef(i,1)
|
||||
! keys_tmp(:,:,k) = psi_ref(:,:,i)
|
||||
! overlap += u_0(k)*psi_ref_coef(i,1)
|
||||
! enddo
|
||||
! norm = 0.d0
|
||||
! do i=1,N_det_non_ref
|
||||
! k = k+1
|
||||
! ! f is such that f.\tilde{c_i} = c_i
|
||||
! f = psi_non_ref_coef(i,1) / rho_mrcc(i,1)
|
||||
!
|
||||
! ! Avoid numerical instabilities
|
||||
! f = min(f,2.d0)
|
||||
! f = max(f,-2.d0)
|
||||
!
|
||||
! f = 1.d0
|
||||
!
|
||||
! u_0(k) = rho_mrcc(i,1)*f
|
||||
! keys_tmp(:,:,k) = psi_non_ref(:,:,i)
|
||||
! norm += u_0(k)**2
|
||||
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||
! enddo
|
||||
!
|
||||
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||
! print *, 'Energy of |(1+T)Psi_0> : ', e_0 + nuclear_repulsion, overlap
|
||||
!
|
||||
! f = 1.d0/norm
|
||||
! norm = 1.d0
|
||||
! do i=1,N_det_ref
|
||||
! norm = norm - psi_ref_coef(i,s)*psi_ref_coef(i,s)
|
||||
! enddo
|
||||
! f = dsqrt(f*norm)
|
||||
! overlap = norm
|
||||
! do i=1,N_det_non_ref
|
||||
! u_0(k) = rho_mrcc(i,1)*f
|
||||
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||
! enddo
|
||||
!
|
||||
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||
! print *, 'Energy of |(1+T)Psi_0> (normalized) : ', e_0 + nuclear_repulsion, overlap
|
||||
!
|
||||
! k=0
|
||||
! overlap = 0.d0
|
||||
! do i=1,N_det_ref
|
||||
! k = k+1
|
||||
! u_0(k) = psi_ref_coef(i,1)
|
||||
! keys_tmp(:,:,k) = psi_ref(:,:,i)
|
||||
! overlap += u_0(k)*psi_ref_coef(i,1)
|
||||
! enddo
|
||||
! norm = 0.d0
|
||||
! do i=1,N_det_non_ref
|
||||
! k = k+1
|
||||
! ! f is such that f.\tilde{c_i} = c_i
|
||||
! f = psi_non_ref_coef(i,1) / rho_mrcc(i,1)
|
||||
!
|
||||
! ! Avoid numerical instabilities
|
||||
! f = min(f,2.d0)
|
||||
! f = max(f,-2.d0)
|
||||
!
|
||||
! u_0(k) = rho_mrcc(i,1)*f
|
||||
! keys_tmp(:,:,k) = psi_non_ref(:,:,i)
|
||||
! norm += u_0(k)**2
|
||||
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||
! enddo
|
||||
!
|
||||
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||
! print *, 'Energy of |(1+T)Psi_0> (mu_i): ', e_0 + nuclear_repulsion, overlap
|
||||
!
|
||||
! f = 1.d0/norm
|
||||
! norm = 1.d0
|
||||
! do i=1,N_det_ref
|
||||
! norm = norm - psi_ref_coef(i,s)*psi_ref_coef(i,s)
|
||||
! enddo
|
||||
! overlap = norm
|
||||
! f = dsqrt(f*norm)
|
||||
! do i=1,N_det_non_ref
|
||||
! u_0(k) = rho_mrcc(i,1)*f
|
||||
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||
! enddo
|
||||
!
|
||||
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||
! print *, 'Energy of |(1+T)Psi_0> (normalized mu_i) : ', e_0 + nuclear_repulsion, overlap
|
||||
!
|
||||
! deallocate(u_0, keys_tmp)
|
||||
!
|
||||
!---------------
|
||||
|
||||
norm = 0.d0
|
||||
double precision :: f
|
||||
do i=1,N_det_non_ref
|
||||
@ -777,16 +1044,12 @@ END_PROVIDER
|
||||
rho_mrcc(i,s) = 1.d-32
|
||||
endif
|
||||
|
||||
if (lambda_type == 2) then
|
||||
f = 1.d0
|
||||
else
|
||||
! f is such that f.\tilde{c_i} = c_i
|
||||
f = psi_non_ref_coef(i,s) / rho_mrcc(i,s)
|
||||
! f is such that f.\tilde{c_i} = c_i
|
||||
f = psi_non_ref_coef(i,s) / rho_mrcc(i,s)
|
||||
|
||||
! Avoid numerical instabilities
|
||||
f = min(f,2.d0)
|
||||
f = max(f,-2.d0)
|
||||
endif
|
||||
! Avoid numerical instabilities
|
||||
f = min(f,2.d0)
|
||||
f = max(f,-2.d0)
|
||||
|
||||
norm = norm + f*f *rho_mrcc(i,s)*rho_mrcc(i,s)
|
||||
rho_mrcc(i,s) = f
|
||||
@ -807,9 +1070,6 @@ END_PROVIDER
|
||||
|
||||
norm = norm*f
|
||||
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
|
||||
norm = norm + psi_ref_coef(i,s)*psi_ref_coef(i,s)
|
||||
@ -821,6 +1081,7 @@ END_PROVIDER
|
||||
! rho_mrcc now contains the product of the scaling factors and the
|
||||
! normalization constant
|
||||
|
||||
dIj_unique(:size(X), s) = X(:)
|
||||
end do
|
||||
|
||||
END_PROVIDER
|
||||
@ -832,14 +1093,17 @@ BEGIN_PROVIDER [ double precision, dij, (N_det_ref, N_det_non_ref, N_states) ]
|
||||
integer :: s,i,j
|
||||
double precision, external :: get_dij_index
|
||||
print *, "computing amplitudes..."
|
||||
!$OMP PARALLEL DEFAULT(shared) PRIVATE(s,i,j)
|
||||
do s=1, N_states
|
||||
!$OMP DO
|
||||
do i=1, N_det_non_ref
|
||||
do j=1, N_det_ref
|
||||
!DIR$ FORCEINLINE
|
||||
dij(j, i, s) = get_dij_index(j, i, s, N_int)
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
end do
|
||||
!$OMP END PARALLEL
|
||||
print *, "done computing amplitudes"
|
||||
END_PROVIDER
|
||||
|
||||
@ -855,13 +1119,9 @@ 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)
|
||||
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)
|
||||
else if(lambda_type == 1) then
|
||||
else
|
||||
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)
|
||||
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 function
|
||||
|
||||
@ -919,21 +1179,9 @@ end function
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_hh_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 ]
|
||||
&BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_pp_exists) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
!
|
||||
! hh_exists :
|
||||
!
|
||||
! pp_exists :
|
||||
!
|
||||
! hh_shortcut :
|
||||
!
|
||||
! hh_nex : Total number of excitation operators
|
||||
!
|
||||
END_DOC
|
||||
integer*2,allocatable :: num(:,:)
|
||||
integer :: exc(0:2, 2, 2), degree, n, on, s, l, i
|
||||
integer*2 :: h1, h2, p1, p2
|
||||
@ -999,7 +1247,6 @@ end function
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
hh_nex = hh_shortcut(hh_shortcut(0)+1)-1
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
@ -1,101 +0,0 @@
|
||||
subroutine multi_state(CI_electronic_energy_dressed_,CI_eigenvectors_dressed_,LDA)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Multi-state mixing
|
||||
END_DOC
|
||||
integer, intent(in) :: LDA
|
||||
double precision, intent(inout) :: CI_electronic_energy_dressed_(N_states)
|
||||
double precision, intent(inout) :: CI_eigenvectors_dressed_(LDA,N_states)
|
||||
double precision, allocatable :: h(:,:,:), s(:,:), Psi(:,:), H_Psi(:,:,:), H_jj(:)
|
||||
|
||||
allocate( h(N_states,N_states,0:N_states), s(N_states,N_states) )
|
||||
allocate( Psi(LDA,N_states), H_Psi(LDA,N_states,0:N_states) )
|
||||
allocate (H_jj(LDA) )
|
||||
|
||||
! e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n)
|
||||
|
||||
integer :: i,j,k,istate
|
||||
double precision :: U(N_states,N_states), Vt(N_states,N_states), D(N_states)
|
||||
double precision, external :: diag_H_mat_elem
|
||||
do istate=1,N_states
|
||||
do i=1,N_det
|
||||
H_jj(i) = diag_H_mat_elem(psi_det(1,1,i),N_int)
|
||||
enddo
|
||||
|
||||
do i=1,N_det_ref
|
||||
H_jj(idx_ref(i)) += delta_ii(istate,i)
|
||||
enddo
|
||||
|
||||
do k=1,N_states
|
||||
do i=1,N_det
|
||||
Psi(i,k) = CI_eigenvectors_dressed_(i,k)
|
||||
enddo
|
||||
enddo
|
||||
call H_u_0_mrcc_nstates(H_Psi(1,1,istate),Psi,H_jj,N_det,psi_det,N_int,istate,N_states,LDA)
|
||||
|
||||
do k=1,N_states
|
||||
do i=1,N_states
|
||||
double precision, external :: u_dot_v
|
||||
h(i,k,istate) = u_dot_v(Psi(1,i), H_Psi(1,k,istate), N_det)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do k=1,N_states
|
||||
do i=1,N_states
|
||||
s(i,k) = u_dot_v(Psi(1,i), Psi(1,k), N_det)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
print *, s(:,:)
|
||||
print *, ''
|
||||
|
||||
h(:,:,0) = h(:,:,1)
|
||||
do istate=2,N_states
|
||||
U(:,:) = h(:,:,0)
|
||||
call dgemm('N','N',N_states,N_states,N_states,1.d0,&
|
||||
U, size(U,1), h(1,1,istate), size(h,1), 0.d0, &
|
||||
h(1,1,0), size(Vt,1))
|
||||
enddo
|
||||
|
||||
call svd(h(1,1,0), size(h,1), U, size(U,1), D, Vt, size(Vt,1), N_states, N_states)
|
||||
do k=1,N_states
|
||||
D(k) = D(k)**(1./dble(N_states))
|
||||
if (D(k) > 0.d0) then
|
||||
D(k) = -D(k)
|
||||
endif
|
||||
enddo
|
||||
|
||||
do j=1,N_states
|
||||
do i=1,N_states
|
||||
h(i,j,0) = 0.d0
|
||||
do k=1,N_states
|
||||
h(i,j,0) += U(i,k) * D(k) * Vt(k,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
print *, h(:,:,0)
|
||||
print *,''
|
||||
|
||||
integer :: LWORK, INFO
|
||||
double precision, allocatable :: WORK(:)
|
||||
LWORK=3*N_states
|
||||
allocate (WORK(LWORK))
|
||||
call dsygv(1, 'V', 'U', N_states, h(1,1,0), size(h,1), s, size(s,1), D, WORK, LWORK, INFO)
|
||||
deallocate(WORK)
|
||||
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
CI_eigenvectors_dressed_(i,j) = 0.d0
|
||||
do k=1,N_states
|
||||
CI_eigenvectors_dressed_(i,j) += Psi(i,k) * h(k,j,0)
|
||||
enddo
|
||||
enddo
|
||||
CI_electronic_energy_dressed_(j) = D(j)
|
||||
enddo
|
||||
|
||||
|
||||
deallocate (h,s, H_jj)
|
||||
deallocate( Psi, H_Psi )
|
||||
end
|
@ -1,43 +0,0 @@
|
||||
program MRPT_Utils
|
||||
implicit none
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
! call routine
|
||||
! call routine_2
|
||||
call routine_3
|
||||
end
|
||||
|
||||
|
||||
subroutine routine_3
|
||||
implicit none
|
||||
!provide fock_virt_total_spin_trace
|
||||
provide delta_ij
|
||||
|
||||
print *, 'N_det = ', N_det
|
||||
print *, 'N_states = ', N_states
|
||||
print *, 'PT2 = ', second_order_pt_new(1)
|
||||
print *, 'E = ', CI_energy(1)
|
||||
print *, 'E+PT2 = ', CI_energy(1)+second_order_pt_new(1)
|
||||
print *,'****** DIAGONALIZATION OF DRESSED MATRIX ******'
|
||||
print *, 'E dressed= ', CI_dressed_pt2_new_energy(1)
|
||||
|
||||
end
|
||||
|
||||
subroutine routine_2
|
||||
implicit none
|
||||
integer :: i
|
||||
do i = 1, n_core_inact_orb
|
||||
print*,fock_core_inactive_total(i,1,1),fock_core_inactive(i)
|
||||
enddo
|
||||
double precision :: accu
|
||||
accu = 0.d0
|
||||
do i = 1, n_act_orb
|
||||
integer :: j_act_orb
|
||||
j_act_orb = list_act(i)
|
||||
accu += one_body_dm_mo_alpha(j_act_orb,j_act_orb,1)
|
||||
print*,one_body_dm_mo_alpha(j_act_orb,j_act_orb,1),one_body_dm_mo_beta(j_act_orb,j_act_orb,1)
|
||||
enddo
|
||||
print*,'accu = ',accu
|
||||
|
||||
end
|
||||
|
@ -1 +0,0 @@
|
||||
MRPT_Utils Selectors_full Generators_full
|
@ -1,14 +0,0 @@
|
||||
====
|
||||
MRPT
|
||||
====
|
||||
|
||||
Executables for Multi-reference perturbation.
|
||||
|
||||
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.
|
@ -1,38 +0,0 @@
|
||||
program MRPT
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! TODO
|
||||
END_DOC
|
||||
print *, ' _/ '
|
||||
print *, ' -:\_?, _Jm####La '
|
||||
print *, 'J"(:" > _]#AZ#Z#UUZ##, '
|
||||
print *, '_,::./ %(|i%12XmX1*1XL _?, '
|
||||
print *, ' \..\ _\(vmWQwodY+ia%lnL _",/ ( '
|
||||
print *, ' .:< ]J=mQD?WXn<uQWmmvd, -.-:=!'
|
||||
print *, ' "{Z jC]QW|=3Zv)Bi3BmXv3 = _7'
|
||||
print *, ' ]h[Z6)WQ;)jZs]C;|$BZv+, : ./ '
|
||||
print *, ' -#sJX%$Wmm#ev]hinW#Xi:` c ; '
|
||||
print *, ' #X#X23###1}vI$WWmX1>|,)nr" '
|
||||
print *, ' 4XZ#Xov1v}=)vnXAX1nnv;1n" '
|
||||
print *, ' ]XX#ZXoovvvivnnnlvvo2*i7 '
|
||||
print *, ' "23Z#1S2oo2XXSnnnoSo2>v" '
|
||||
print *, ' miX#L -~`""!!1}oSoe|i7 '
|
||||
print *, ' 4cn#m, v221=|v[ '
|
||||
print *, ' ]hI3Zma,;..__wXSe=+vo '
|
||||
print *, ' ]Zov*XSUXXZXZXSe||vo2 '
|
||||
print *, ' ]Z#><iiii|i||||==vn2( '
|
||||
print *, ' ]Z#i<ii||+|=||=:{no2[ '
|
||||
print *, ' ]ZUsiiiiivi|=||=vo22[ '
|
||||
print *, ' ]XZvlliiIi|i=|+|vooo '
|
||||
print *, ' =v1llli||||=|||||lii( '
|
||||
print *, ' ]iillii||||||||=>=|< '
|
||||
print *, ' -ziiiii||||||+||==+> '
|
||||
print *, ' -%|+++||=|=+|=|==/ '
|
||||
print *, ' -a>====+|====-:- '
|
||||
print *, ' "~,- -- /- '
|
||||
print *, ' -. )> '
|
||||
print *, ' .~ +- '
|
||||
print *, ' . .... : . '
|
||||
print *, ' -------~ '
|
||||
print *, ''
|
||||
end
|
@ -1,51 +0,0 @@
|
||||
program print_1h2p
|
||||
implicit none
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
call routine
|
||||
end
|
||||
|
||||
subroutine routine
|
||||
implicit none
|
||||
double precision,allocatable :: matrix_1h2p(:,:,:)
|
||||
allocate (matrix_1h2p(N_det,N_det,N_states))
|
||||
integer :: i,j,istate
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
do istate = 1, N_states
|
||||
matrix_1h2p(i,j,istate) = 0.d0
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
if(.False.)then
|
||||
call give_1h2p_contrib(matrix_1h2p)
|
||||
double precision :: accu
|
||||
accu = 0.d0
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu += matrix_1h2p(i,j,1) * psi_coef(i,1) * psi_coef(j,1)
|
||||
enddo
|
||||
enddo
|
||||
print*, 'second order ', accu
|
||||
endif
|
||||
|
||||
if(.True.)then
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
do istate = 1, N_states
|
||||
matrix_1h2p(i,j,istate) = 0.d0
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
call give_1h2p_new(matrix_1h2p)
|
||||
accu = 0.d0
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu += matrix_1h2p(i,j,1) * psi_coef(i,1) * psi_coef(j,1)
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
print*, 'third order ', accu
|
||||
|
||||
deallocate (matrix_1h2p)
|
||||
end
|
@ -1,7 +0,0 @@
|
||||
[do_third_order_1h1p]
|
||||
type: logical
|
||||
doc: If true, compute the third order contribution for the 1h1p
|
||||
interface: ezfio,provider,ocaml
|
||||
default: True
|
||||
|
||||
|
@ -1,187 +0,0 @@
|
||||
use bitmasks
|
||||
BEGIN_SHELL [ /usr/bin/env python ]
|
||||
from generate_h_apply import *
|
||||
|
||||
s = H_apply("mrpt")
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
s = H_apply("mrpt_1h")
|
||||
s.filter_only_1h()
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
s = H_apply("mrpt_1p")
|
||||
s.filter_only_1p()
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
s = H_apply("mrpt_1h1p")
|
||||
s.filter_only_1h1p()
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
s = H_apply("mrpt_2p")
|
||||
s.filter_only_2p()
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
s = H_apply("mrpt_2h")
|
||||
s.filter_only_2h()
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
|
||||
s = H_apply("mrpt_1h2p")
|
||||
s.filter_only_1h2p()
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
s = H_apply("mrpt_2h1p")
|
||||
s.filter_only_2h1p()
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
s = H_apply("mrpt_2h2p")
|
||||
s.filter_only_2h2p()
|
||||
s.data["parameters"] = ", delta_ij_, Ndet"
|
||||
s.data["declarations"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["keys_work"] = "call mrpt_dress(delta_ij_,Ndet,i_generator,key_idx,keys_out,N_int,iproc,key_mask)"
|
||||
s.data["params_post"] += ", delta_ij_, Ndet"
|
||||
s.data["params_main"] += "delta_ij_, Ndet"
|
||||
s.data["decls_main"] += """
|
||||
integer, intent(in) :: Ndet
|
||||
double precision, intent(in) :: delta_ij_(Ndet,Ndet,*)
|
||||
"""
|
||||
s.data["finalization"] = ""
|
||||
s.data["copy_buffer"] = ""
|
||||
s.data["generate_psi_guess"] = ""
|
||||
s.data["size_max"] = "3072"
|
||||
print s
|
||||
|
||||
|
||||
END_SHELL
|
||||
|
@ -1 +0,0 @@
|
||||
Determinants Davidson
|
@ -1,13 +0,0 @@
|
||||
==========
|
||||
MRPT_Utils
|
||||
==========
|
||||
|
||||
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.
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -1,708 +0,0 @@
|
||||
subroutine apply_exc_to_psi(orb,hole_particle,spin_exc, &
|
||||
norm_out,psi_in_out,psi_in_out_coef, ndet,dim_psi_in,dim_psi_coef,N_states_in)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer, intent(in) :: orb, hole_particle,spin_exc,N_states_in,ndet,dim_psi_in,dim_psi_coef
|
||||
double precision, intent(out) :: norm_out(N_states_in)
|
||||
integer(bit_kind), intent(inout) :: psi_in_out(N_int,2,dim_psi_in)
|
||||
double precision, intent(inout) :: psi_in_out_coef(dim_psi_coef,N_states_in)
|
||||
BEGIN_DOC
|
||||
! apply a contracted excitation to psi_in_out whose coefficients
|
||||
! are psi_in_out_coef
|
||||
! hole_particle = 1 ===> creation of an electron in psi_in_out
|
||||
! = -1 ===> annhilation of an electron in psi_in_out
|
||||
! orb ===> is the index of orbital where you want wether to create or
|
||||
! annhilate an electron
|
||||
! spin_exc ===> is the spin of the electron (1 == alpha) (2 == beta)
|
||||
! the wave function gets out normalized to unity
|
||||
!
|
||||
! norm_out is the sum of the squared of the coefficients
|
||||
! on which the excitation has been possible
|
||||
END_DOC
|
||||
|
||||
integer :: elec_num_tab_local(2)
|
||||
integer :: i,j,accu_elec,k
|
||||
integer :: det_tmp(N_int), det_tmp_bis(N_int)
|
||||
double precision :: phase
|
||||
double precision :: norm_factor
|
||||
|
||||
elec_num_tab_local = 0
|
||||
do i = 1, ndet
|
||||
if( psi_in_out_coef (i,1) .ne. 0.d0)then
|
||||
do j = 1, N_int
|
||||
elec_num_tab_local(1) += popcnt(psi_in_out(j,1,i))
|
||||
elec_num_tab_local(2) += popcnt(psi_in_out(j,2,i))
|
||||
enddo
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if(hole_particle == 1)then
|
||||
do i = 1, ndet
|
||||
call set_bit_to_integer(orb,psi_in_out(1,spin_exc,i),N_int)
|
||||
accu_elec = 0
|
||||
do j = 1, N_int
|
||||
accu_elec += popcnt(psi_in_out(j,spin_exc,i))
|
||||
enddo
|
||||
if(accu_elec .ne. elec_num_tab_local(spin_exc)+1)then
|
||||
do j = 1, N_int
|
||||
psi_in_out(j,1,i) = 0_bit_kind
|
||||
psi_in_out(j,2,i) = 0_bit_kind
|
||||
enddo
|
||||
do j = 1, N_states_in
|
||||
psi_in_out_coef(i,j) = 0.d0
|
||||
enddo
|
||||
endif
|
||||
phase = 1.d0
|
||||
do k = 1, orb
|
||||
do j = 1, N_int
|
||||
det_tmp(j) = 0_bit_kind
|
||||
enddo
|
||||
call set_bit_to_integer(k,det_tmp,N_int)
|
||||
accu_elec = 0
|
||||
do j = 1, N_int
|
||||
det_tmp_bis(j) = iand(det_tmp(j),(psi_in_out(j,spin_exc,i)))
|
||||
accu_elec += popcnt(det_tmp_bis(j))
|
||||
enddo
|
||||
if(accu_elec == 1)then
|
||||
phase = -phase
|
||||
endif
|
||||
enddo
|
||||
do j = 1, N_states_in
|
||||
psi_in_out_coef(i,j) = psi_in_out_coef(i,j) * phase
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else if (hole_particle == -1)then
|
||||
|
||||
do i = 1, ndet
|
||||
call clear_bit_to_integer(orb,psi_in_out(1,spin_exc,i),N_int)
|
||||
accu_elec = 0
|
||||
do j = 1, N_int
|
||||
accu_elec += popcnt(psi_in_out(j,spin_exc,i))
|
||||
enddo
|
||||
if(accu_elec .ne. elec_num_tab_local(spin_exc)-1)then
|
||||
do j = 1, N_int
|
||||
psi_in_out(j,1,i) = 0_bit_kind
|
||||
psi_in_out(j,2,i) = 0_bit_kind
|
||||
enddo
|
||||
do j = 1, N_states_in
|
||||
psi_in_out_coef(i,j) = 0.d0
|
||||
enddo
|
||||
endif
|
||||
|
||||
phase = 1.d0
|
||||
do k = 1, orb-1
|
||||
do j = 1, N_int
|
||||
det_tmp(j) = 0_bit_kind
|
||||
enddo
|
||||
call set_bit_to_integer(k,det_tmp,N_int)
|
||||
accu_elec = 0
|
||||
do j = 1, N_int
|
||||
det_tmp_bis(j) = iand(det_tmp(j),(psi_in_out(j,spin_exc,i)))
|
||||
accu_elec += popcnt(det_tmp_bis(j))
|
||||
enddo
|
||||
if(accu_elec == 1)then
|
||||
phase = -phase
|
||||
endif
|
||||
enddo
|
||||
do j = 1, N_states_in
|
||||
psi_in_out_coef(i,j) = psi_in_out_coef(i,j) * phase
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
norm_out = 0.d0
|
||||
do j = 1, N_states_in
|
||||
do i = 1, ndet
|
||||
norm_out(j) += psi_in_out_coef(i,j) * psi_in_out_coef(i,j)
|
||||
enddo
|
||||
if(norm_out(j).le.1.d-10)then
|
||||
norm_factor = 0.d0
|
||||
else
|
||||
norm_factor = 1.d0/(dsqrt(norm_out(j)))
|
||||
endif
|
||||
do i = 1, ndet
|
||||
psi_in_out_coef(i,j) = psi_in_out_coef(i,j) * norm_factor
|
||||
enddo
|
||||
enddo
|
||||
end
|
||||
|
||||
|
||||
double precision function diag_H_mat_elem_no_elec_check(det_in,Nint)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Computes <i|H|i>
|
||||
END_DOC
|
||||
integer,intent(in) :: Nint
|
||||
integer(bit_kind),intent(in) :: det_in(Nint,2)
|
||||
|
||||
integer :: i, j, iorb, jorb
|
||||
integer :: occ(Nint*bit_kind_size,2)
|
||||
integer :: elec_num_tab_local(2)
|
||||
|
||||
double precision :: core_act
|
||||
double precision :: alpha_alpha
|
||||
double precision :: alpha_beta
|
||||
double precision :: beta_beta
|
||||
double precision :: mono_elec
|
||||
core_act = 0.d0
|
||||
alpha_alpha = 0.d0
|
||||
alpha_beta = 0.d0
|
||||
beta_beta = 0.d0
|
||||
mono_elec = 0.d0
|
||||
|
||||
diag_H_mat_elem_no_elec_check = 0.d0
|
||||
call bitstring_to_list(det_in(1,1), occ(1,1), elec_num_tab_local(1), N_int)
|
||||
call bitstring_to_list(det_in(1,2), occ(1,2), elec_num_tab_local(2), N_int)
|
||||
! alpha - alpha
|
||||
! print*, 'elec_num_tab_local(1)',elec_num_tab_local(1)
|
||||
! print*, 'elec_num_tab_local(2)',elec_num_tab_local(2)
|
||||
do i = 1, elec_num_tab_local(1)
|
||||
iorb = occ(i,1)
|
||||
diag_H_mat_elem_no_elec_check += mo_mono_elec_integral(iorb,iorb)
|
||||
mono_elec += mo_mono_elec_integral(iorb,iorb)
|
||||
do j = i+1, elec_num_tab_local(1)
|
||||
jorb = occ(j,1)
|
||||
diag_H_mat_elem_no_elec_check += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||
alpha_alpha += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! beta - beta
|
||||
do i = 1, elec_num_tab_local(2)
|
||||
iorb = occ(i,2)
|
||||
diag_H_mat_elem_no_elec_check += mo_mono_elec_integral(iorb,iorb)
|
||||
mono_elec += mo_mono_elec_integral(iorb,iorb)
|
||||
do j = i+1, elec_num_tab_local(2)
|
||||
jorb = occ(j,2)
|
||||
diag_H_mat_elem_no_elec_check += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||
beta_beta += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
! alpha - beta
|
||||
do i = 1, elec_num_tab_local(2)
|
||||
iorb = occ(i,2)
|
||||
do j = 1, elec_num_tab_local(1)
|
||||
jorb = occ(j,1)
|
||||
diag_H_mat_elem_no_elec_check += mo_bielec_integral_jj(jorb,iorb)
|
||||
alpha_beta += mo_bielec_integral_jj(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
! alpha - core-act
|
||||
do i = 1, elec_num_tab_local(1)
|
||||
iorb = occ(i,1)
|
||||
do j = 1, n_core_inact_orb
|
||||
jorb = list_core_inact(j)
|
||||
diag_H_mat_elem_no_elec_check += 2.d0 * mo_bielec_integral_jj(jorb,iorb) - mo_bielec_integral_jj_exchange(jorb,iorb)
|
||||
core_act += 2.d0 * mo_bielec_integral_jj(jorb,iorb) - mo_bielec_integral_jj_exchange(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! beta - core-act
|
||||
do i = 1, elec_num_tab_local(2)
|
||||
iorb = occ(i,2)
|
||||
do j = 1, n_core_inact_orb
|
||||
jorb = list_core_inact(j)
|
||||
diag_H_mat_elem_no_elec_check += 2.d0 * mo_bielec_integral_jj(jorb,iorb) - mo_bielec_integral_jj_exchange(jorb,iorb)
|
||||
core_act += 2.d0 * mo_bielec_integral_jj(jorb,iorb) - mo_bielec_integral_jj_exchange(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
! print*,'core_act = ',core_act
|
||||
! print*,'alpha_alpha = ',alpha_alpha
|
||||
! print*,'alpha_beta = ',alpha_beta
|
||||
! print*,'beta_beta = ',beta_beta
|
||||
! print*,'mono_elec = ',mono_elec
|
||||
|
||||
! do i = 1, n_core_inact_orb
|
||||
! iorb = list_core_inact(i)
|
||||
! diag_H_mat_elem_no_elec_check += 2.d0 * fock_core_inactive_total_spin_trace(iorb,1)
|
||||
! enddo
|
||||
|
||||
|
||||
!!!!!!!!!!!!
|
||||
return
|
||||
!!!!!!!!!!!!
|
||||
|
||||
|
||||
! alpha - alpha
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
diag_H_mat_elem_no_elec_check += 1.d0 * mo_mono_elec_integral(iorb,iorb)
|
||||
do j = i+1, n_core_inact_orb
|
||||
jorb = list_core_inact(j)
|
||||
diag_H_mat_elem_no_elec_check += 1.d0 * mo_bielec_integral_jj(jorb,iorb) - 1.d0 * mo_bielec_integral_jj_exchange(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
diag_H_mat_elem_no_elec_check += 1.d0 * mo_mono_elec_integral(iorb,iorb)
|
||||
do j = i+1, n_core_inact_orb
|
||||
jorb = list_core_inact(j)
|
||||
diag_H_mat_elem_no_elec_check += 1.d0 * mo_bielec_integral_jj(jorb,iorb) - 1.d0 * mo_bielec_integral_jj_exchange(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
do j = 1, n_core_inact_orb
|
||||
jorb = list_core_inact(j)
|
||||
diag_H_mat_elem_no_elec_check += 1.d0 * mo_bielec_integral_jj(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
subroutine i_H_j_dyall(key_i,key_j,Nint,hij)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Returns <i|H|j> where i and j are determinants
|
||||
END_DOC
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||
double precision, intent(out) :: hij
|
||||
|
||||
integer :: exc(0:2,2,2)
|
||||
integer :: degree
|
||||
double precision :: get_mo_bielec_integral
|
||||
integer :: m,n,p,q
|
||||
integer :: i,j,k
|
||||
integer :: occ(Nint*bit_kind_size,2)
|
||||
double precision :: diag_H_mat_elem_no_elec_check, phase,phase_2
|
||||
integer :: n_occ_ab(2)
|
||||
logical :: has_mipi(Nint*bit_kind_size)
|
||||
double precision :: mipi(Nint*bit_kind_size), miip(Nint*bit_kind_size)
|
||||
PROVIDE mo_bielec_integrals_in_map mo_integrals_map
|
||||
|
||||
ASSERT (Nint > 0)
|
||||
ASSERT (Nint == N_int)
|
||||
|
||||
hij = 0.d0
|
||||
!DIR$ FORCEINLINE
|
||||
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||
select case (degree)
|
||||
case (2)
|
||||
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha, mono beta
|
||||
hij = phase*get_mo_bielec_integral( &
|
||||
exc(1,1,1), &
|
||||
exc(1,1,2), &
|
||||
exc(1,2,1), &
|
||||
exc(1,2,2) ,mo_integrals_map)
|
||||
else if (exc(0,1,1) == 2) then
|
||||
! Double alpha
|
||||
hij = phase*(get_mo_bielec_integral( &
|
||||
exc(1,1,1), &
|
||||
exc(2,1,1), &
|
||||
exc(1,2,1), &
|
||||
exc(2,2,1) ,mo_integrals_map) - &
|
||||
get_mo_bielec_integral( &
|
||||
exc(1,1,1), &
|
||||
exc(2,1,1), &
|
||||
exc(2,2,1), &
|
||||
exc(1,2,1) ,mo_integrals_map) )
|
||||
else if (exc(0,1,2) == 2) then
|
||||
! Double beta
|
||||
hij = phase*(get_mo_bielec_integral( &
|
||||
exc(1,1,2), &
|
||||
exc(2,1,2), &
|
||||
exc(1,2,2), &
|
||||
exc(2,2,2) ,mo_integrals_map) - &
|
||||
get_mo_bielec_integral( &
|
||||
exc(1,1,2), &
|
||||
exc(2,1,2), &
|
||||
exc(2,2,2), &
|
||||
exc(1,2,2) ,mo_integrals_map) )
|
||||
endif
|
||||
case (1)
|
||||
call get_mono_excitation(key_i,key_j,exc,phase,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||
has_mipi = .False.
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha
|
||||
m = exc(1,1,1)
|
||||
p = exc(1,2,1)
|
||||
do k = 1, n_occ_ab(1)
|
||||
i = occ(k,1)
|
||||
if (.not.has_mipi(i)) then
|
||||
mipi(i) = get_mo_bielec_integral(m,i,p,i,mo_integrals_map)
|
||||
miip(i) = get_mo_bielec_integral(m,i,i,p,mo_integrals_map)
|
||||
has_mipi(i) = .True.
|
||||
endif
|
||||
enddo
|
||||
do k = 1, n_occ_ab(2)
|
||||
i = occ(k,2)
|
||||
if (.not.has_mipi(i)) then
|
||||
mipi(i) = get_mo_bielec_integral(m,i,p,i,mo_integrals_map)
|
||||
has_mipi(i) = .True.
|
||||
endif
|
||||
enddo
|
||||
|
||||
do k = 1, n_occ_ab(1)
|
||||
hij = hij + mipi(occ(k,1)) - miip(occ(k,1))
|
||||
enddo
|
||||
do k = 1, n_occ_ab(2)
|
||||
hij = hij + mipi(occ(k,2))
|
||||
enddo
|
||||
|
||||
else
|
||||
! Mono beta
|
||||
m = exc(1,1,2)
|
||||
p = exc(1,2,2)
|
||||
do k = 1, n_occ_ab(2)
|
||||
i = occ(k,2)
|
||||
if (.not.has_mipi(i)) then
|
||||
mipi(i) = get_mo_bielec_integral(m,i,p,i,mo_integrals_map)
|
||||
miip(i) = get_mo_bielec_integral(m,i,i,p,mo_integrals_map)
|
||||
has_mipi(i) = .True.
|
||||
endif
|
||||
enddo
|
||||
do k = 1, n_occ_ab(1)
|
||||
i = occ(k,1)
|
||||
if (.not.has_mipi(i)) then
|
||||
mipi(i) = get_mo_bielec_integral(m,i,p,i,mo_integrals_map)
|
||||
has_mipi(i) = .True.
|
||||
endif
|
||||
enddo
|
||||
|
||||
do k = 1, n_occ_ab(1)
|
||||
hij = hij + mipi(occ(k,1))
|
||||
enddo
|
||||
do k = 1, n_occ_ab(2)
|
||||
hij = hij + mipi(occ(k,2)) - miip(occ(k,2))
|
||||
enddo
|
||||
|
||||
endif
|
||||
hij = phase*(hij + mo_mono_elec_integral(m,p) + fock_operator_active_from_core_inact(m,p) )
|
||||
|
||||
case (0)
|
||||
hij = diag_H_mat_elem_no_elec_check(key_i,Nint)
|
||||
end select
|
||||
end
|
||||
|
||||
|
||||
subroutine u0_H_dyall_u0(energies,psi_in,psi_in_coef,ndet,dim_psi_in,dim_psi_coef,N_states_in,state_target)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer, intent(in) :: N_states_in,ndet,dim_psi_in,dim_psi_coef,state_target
|
||||
integer(bit_kind), intent(in) :: psi_in(N_int,2,dim_psi_in)
|
||||
double precision, intent(in) :: psi_in_coef(dim_psi_coef,N_states_in)
|
||||
double precision, intent(out) :: energies(N_states_in)
|
||||
|
||||
integer :: i,j
|
||||
double precision :: hij,accu
|
||||
energies = 0.d0
|
||||
accu = 0.d0
|
||||
double precision, allocatable :: psi_coef_tmp(:)
|
||||
allocate(psi_coef_tmp(ndet))
|
||||
|
||||
do i = 1, ndet
|
||||
psi_coef_tmp(i) = psi_in_coef(i,state_target)
|
||||
enddo
|
||||
|
||||
double precision :: hij_bis
|
||||
do i = 1, ndet
|
||||
if(psi_coef_tmp(i)==0.d0)cycle
|
||||
do j = 1, ndet
|
||||
if(psi_coef_tmp(j)==0.d0)cycle
|
||||
call i_H_j_dyall(psi_in(1,1,i),psi_in(1,1,j),N_int,hij)
|
||||
accu += psi_coef_tmp(i) * psi_coef_tmp(j) * hij
|
||||
enddo
|
||||
enddo
|
||||
energies(state_target) = accu
|
||||
deallocate(psi_coef_tmp)
|
||||
end
|
||||
|
||||
|
||||
double precision function coulomb_value_no_check(det_in,Nint)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Computes <i|H|i>
|
||||
END_DOC
|
||||
integer,intent(in) :: Nint
|
||||
integer(bit_kind),intent(in) :: det_in(Nint,2)
|
||||
|
||||
integer :: i, j, iorb, jorb
|
||||
integer :: occ(Nint*bit_kind_size,2)
|
||||
integer :: elec_num_tab_local(2)
|
||||
|
||||
double precision :: core_act
|
||||
double precision :: alpha_alpha
|
||||
double precision :: alpha_beta
|
||||
double precision :: beta_beta
|
||||
double precision :: mono_elec
|
||||
core_act = 0.d0
|
||||
alpha_alpha = 0.d0
|
||||
alpha_beta = 0.d0
|
||||
beta_beta = 0.d0
|
||||
mono_elec = 0.d0
|
||||
|
||||
coulomb_value_no_check = 0.d0
|
||||
call bitstring_to_list(det_in(1,1), occ(1,1), elec_num_tab_local(1), N_int)
|
||||
call bitstring_to_list(det_in(1,2), occ(1,2), elec_num_tab_local(2), N_int)
|
||||
! alpha - alpha
|
||||
do i = 1, elec_num_tab_local(1)
|
||||
iorb = occ(i,1)
|
||||
do j = i+1, elec_num_tab_local(1)
|
||||
jorb = occ(j,1)
|
||||
coulomb_value_no_check += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||
alpha_alpha += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! beta - beta
|
||||
do i = 1, elec_num_tab_local(2)
|
||||
iorb = occ(i,2)
|
||||
do j = i+1, elec_num_tab_local(2)
|
||||
jorb = occ(j,2)
|
||||
coulomb_value_no_check += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||
beta_beta += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
! alpha - beta
|
||||
do i = 1, elec_num_tab_local(2)
|
||||
iorb = occ(i,2)
|
||||
do j = 1, elec_num_tab_local(1)
|
||||
jorb = occ(j,1)
|
||||
coulomb_value_no_check += mo_bielec_integral_jj(jorb,iorb)
|
||||
alpha_beta += mo_bielec_integral_jj(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
end
|
||||
|
||||
subroutine i_H_j_dyall_no_exchange(key_i,key_j,Nint,hij)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Returns <i|H|j> where i and j are determinants
|
||||
END_DOC
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||
double precision, intent(out) :: hij
|
||||
|
||||
integer :: exc(0:2,2,2)
|
||||
integer :: degree
|
||||
double precision :: get_mo_bielec_integral
|
||||
integer :: m,n,p,q
|
||||
integer :: i,j,k
|
||||
integer :: occ(Nint*bit_kind_size,2)
|
||||
double precision :: diag_H_mat_elem_no_elec_check_no_exchange, phase,phase_2
|
||||
integer :: n_occ_ab(2)
|
||||
logical :: has_mipi(Nint*bit_kind_size)
|
||||
double precision :: mipi(Nint*bit_kind_size)
|
||||
PROVIDE mo_bielec_integrals_in_map mo_integrals_map
|
||||
|
||||
ASSERT (Nint > 0)
|
||||
ASSERT (Nint == N_int)
|
||||
|
||||
hij = 0.d0
|
||||
!DIR$ FORCEINLINE
|
||||
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||
select case (degree)
|
||||
case (2)
|
||||
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha, mono beta
|
||||
if(exc(1,1,1) == exc(1,2,2) .and. exc(1,2,1) == exc(1,1,2))then
|
||||
hij = 0.d0
|
||||
else
|
||||
hij = phase*get_mo_bielec_integral( &
|
||||
exc(1,1,1), &
|
||||
exc(1,1,2), &
|
||||
exc(1,2,1), &
|
||||
exc(1,2,2) ,mo_integrals_map)
|
||||
endif
|
||||
else if (exc(0,1,1) == 2) then
|
||||
! Double alpha
|
||||
hij = phase*get_mo_bielec_integral( &
|
||||
exc(1,1,1), &
|
||||
exc(2,1,1), &
|
||||
exc(1,2,1), &
|
||||
exc(2,2,1) ,mo_integrals_map)
|
||||
else if (exc(0,1,2) == 2) then
|
||||
! Double beta
|
||||
hij = phase*get_mo_bielec_integral( &
|
||||
exc(1,1,2), &
|
||||
exc(2,1,2), &
|
||||
exc(1,2,2), &
|
||||
exc(2,2,2) ,mo_integrals_map)
|
||||
endif
|
||||
case (1)
|
||||
call get_mono_excitation(key_i,key_j,exc,phase,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||
has_mipi = .False.
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha
|
||||
m = exc(1,1,1)
|
||||
p = exc(1,2,1)
|
||||
do k = 1, n_occ_ab(1)
|
||||
i = occ(k,1)
|
||||
if (.not.has_mipi(i)) then
|
||||
mipi(i) = get_mo_bielec_integral(m,i,p,i,mo_integrals_map)
|
||||
has_mipi(i) = .True.
|
||||
endif
|
||||
enddo
|
||||
do k = 1, n_occ_ab(2)
|
||||
i = occ(k,2)
|
||||
if (.not.has_mipi(i)) then
|
||||
mipi(i) = get_mo_bielec_integral(m,i,p,i,mo_integrals_map)
|
||||
has_mipi(i) = .True.
|
||||
endif
|
||||
enddo
|
||||
|
||||
do k = 1, n_occ_ab(1)
|
||||
hij = hij + mipi(occ(k,1))
|
||||
enddo
|
||||
do k = 1, n_occ_ab(2)
|
||||
hij = hij + mipi(occ(k,2))
|
||||
enddo
|
||||
|
||||
else
|
||||
! Mono beta
|
||||
m = exc(1,1,2)
|
||||
p = exc(1,2,2)
|
||||
do k = 1, n_occ_ab(2)
|
||||
i = occ(k,2)
|
||||
if (.not.has_mipi(i)) then
|
||||
mipi(i) = get_mo_bielec_integral(m,i,p,i,mo_integrals_map)
|
||||
has_mipi(i) = .True.
|
||||
endif
|
||||
enddo
|
||||
do k = 1, n_occ_ab(1)
|
||||
i = occ(k,1)
|
||||
if (.not.has_mipi(i)) then
|
||||
mipi(i) = get_mo_bielec_integral(m,i,p,i,mo_integrals_map)
|
||||
has_mipi(i) = .True.
|
||||
endif
|
||||
enddo
|
||||
|
||||
do k = 1, n_occ_ab(1)
|
||||
hij = hij + mipi(occ(k,1))
|
||||
enddo
|
||||
do k = 1, n_occ_ab(2)
|
||||
hij = hij + mipi(occ(k,2))
|
||||
enddo
|
||||
|
||||
endif
|
||||
hij = phase*(hij + mo_mono_elec_integral(m,p) + fock_operator_active_from_core_inact(m,p) )
|
||||
|
||||
case (0)
|
||||
hij = diag_H_mat_elem_no_elec_check_no_exchange(key_i,Nint)
|
||||
end select
|
||||
end
|
||||
|
||||
|
||||
double precision function diag_H_mat_elem_no_elec_check_no_exchange(det_in,Nint)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Computes <i|H|i>
|
||||
END_DOC
|
||||
integer,intent(in) :: Nint
|
||||
integer(bit_kind),intent(in) :: det_in(Nint,2)
|
||||
|
||||
integer :: i, j, iorb, jorb
|
||||
integer :: occ(Nint*bit_kind_size,2)
|
||||
integer :: elec_num_tab_local(2)
|
||||
|
||||
double precision :: core_act_exchange(2)
|
||||
core_act_exchange = 0.d0
|
||||
diag_H_mat_elem_no_elec_check_no_exchange = 0.d0
|
||||
call bitstring_to_list(det_in(1,1), occ(1,1), elec_num_tab_local(1), N_int)
|
||||
call bitstring_to_list(det_in(1,2), occ(1,2), elec_num_tab_local(2), N_int)
|
||||
! alpha - alpha
|
||||
do i = 1, elec_num_tab_local(1)
|
||||
iorb = occ(i,1)
|
||||
diag_H_mat_elem_no_elec_check_no_exchange += mo_mono_elec_integral(iorb,iorb)
|
||||
do j = i+1, elec_num_tab_local(1)
|
||||
jorb = occ(j,1)
|
||||
diag_H_mat_elem_no_elec_check_no_exchange += mo_bielec_integral_jj(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! beta - beta
|
||||
do i = 1, elec_num_tab_local(2)
|
||||
iorb = occ(i,2)
|
||||
diag_H_mat_elem_no_elec_check_no_exchange += mo_mono_elec_integral(iorb,iorb)
|
||||
do j = i+1, elec_num_tab_local(2)
|
||||
jorb = occ(j,2)
|
||||
diag_H_mat_elem_no_elec_check_no_exchange += mo_bielec_integral_jj(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
! alpha - beta
|
||||
do i = 1, elec_num_tab_local(2)
|
||||
iorb = occ(i,2)
|
||||
do j = 1, elec_num_tab_local(1)
|
||||
jorb = occ(j,1)
|
||||
diag_H_mat_elem_no_elec_check_no_exchange += mo_bielec_integral_jj(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
! alpha - core-act
|
||||
do i = 1, elec_num_tab_local(1)
|
||||
iorb = occ(i,1)
|
||||
do j = 1, n_core_inact_orb
|
||||
jorb = list_core_inact(j)
|
||||
diag_H_mat_elem_no_elec_check_no_exchange += 2.d0 * mo_bielec_integral_jj(jorb,iorb)
|
||||
core_act_exchange(1) += - mo_bielec_integral_jj_exchange(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! beta - core-act
|
||||
do i = 1, elec_num_tab_local(2)
|
||||
iorb = occ(i,2)
|
||||
do j = 1, n_core_inact_orb
|
||||
jorb = list_core_inact(j)
|
||||
diag_H_mat_elem_no_elec_check_no_exchange += 2.d0 * mo_bielec_integral_jj(jorb,iorb)
|
||||
core_act_exchange(2) += - mo_bielec_integral_jj_exchange(jorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
subroutine u0_H_dyall_u0_no_exchange(energies,psi_in,psi_in_coef,ndet,dim_psi_in,dim_psi_coef,N_states_in,state_target)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer, intent(in) :: N_states_in,ndet,dim_psi_in,dim_psi_coef,state_target
|
||||
integer(bit_kind), intent(in) :: psi_in(N_int,2,dim_psi_in)
|
||||
double precision, intent(in) :: psi_in_coef(dim_psi_coef,N_states_in)
|
||||
double precision, intent(out) :: energies(N_states_in)
|
||||
|
||||
integer :: i,j
|
||||
double precision :: hij,accu
|
||||
energies = 0.d0
|
||||
accu = 0.d0
|
||||
double precision, allocatable :: psi_coef_tmp(:)
|
||||
allocate(psi_coef_tmp(ndet))
|
||||
|
||||
do i = 1, ndet
|
||||
psi_coef_tmp(i) = psi_in_coef(i,state_target)
|
||||
enddo
|
||||
|
||||
double precision :: hij_bis
|
||||
do i = 1, ndet
|
||||
if(psi_coef_tmp(i)==0.d0)cycle
|
||||
do j = 1, ndet
|
||||
if(psi_coef_tmp(j)==0.d0)cycle
|
||||
call i_H_j_dyall_no_exchange(psi_in(1,1,i),psi_in(1,1,j),N_int,hij)
|
||||
accu += psi_coef_tmp(i) * psi_coef_tmp(j) * hij
|
||||
enddo
|
||||
enddo
|
||||
energies(state_target) = accu
|
||||
deallocate(psi_coef_tmp)
|
||||
end
|
@ -1,23 +0,0 @@
|
||||
! DO NOT MODIFY BY HAND
|
||||
! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py
|
||||
! from file /home/scemama/quantum_package/src/MRPT_Utils/EZFIO.cfg
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ logical, do_third_order_1h1p ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! If true, compute the third order contribution for the 1h1p
|
||||
END_DOC
|
||||
|
||||
logical :: has
|
||||
PROVIDE ezfio_filename
|
||||
|
||||
call ezfio_has_mrpt_utils_do_third_order_1h1p(has)
|
||||
if (has) then
|
||||
call ezfio_get_mrpt_utils_do_third_order_1h1p(do_third_order_1h1p)
|
||||
else
|
||||
print *, 'mrpt_utils/do_third_order_1h1p not found in EZFIO file'
|
||||
stop 1
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
@ -1,210 +0,0 @@
|
||||
BEGIN_PROVIDER [double precision, fock_core_inactive, (mo_tot_num)]
|
||||
BEGIN_DOC
|
||||
! inactive part of the fock operator with contributions only from the inactive
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j
|
||||
double precision :: accu
|
||||
|
||||
integer :: j_inact_core_orb,i_inact_core_orb
|
||||
do i = 1, n_core_inact_orb
|
||||
accu = 0.d0
|
||||
i_inact_core_orb = list_core_inact(i)
|
||||
do j = 1, n_core_inact_orb
|
||||
j_inact_core_orb = list_core_inact(j)
|
||||
accu += 2.d0 * mo_bielec_integral_jj(i_inact_core_orb,j_inact_core_orb) &
|
||||
- mo_bielec_integral_jj_exchange(i_inact_core_orb,j_inact_core_orb)
|
||||
enddo
|
||||
fock_core_inactive(i_inact_core_orb) = accu + mo_mono_elec_integral(i_inact_core_orb,i_inact_core_orb)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_virt_from_core_inact, (mo_tot_num)]
|
||||
BEGIN_DOC
|
||||
! fock operator for the virtuals that comes from the doubly occupied orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j
|
||||
double precision :: accu
|
||||
|
||||
integer :: j_inact_core_orb,i_virt_orb
|
||||
do i = 1, n_virt_orb
|
||||
accu = 0.d0
|
||||
i_virt_orb = list_virt(i)
|
||||
do j = 1, n_core_inact_orb
|
||||
! do j = 1, elec_alpha_num
|
||||
! j_inact_core_orb = j
|
||||
j_inact_core_orb = list_core_inact(j)
|
||||
accu += 2.d0 * mo_bielec_integral_jj(i_virt_orb,j_inact_core_orb) &
|
||||
- mo_bielec_integral_jj_exchange(i_virt_orb,j_inact_core_orb)
|
||||
enddo
|
||||
fock_virt_from_core_inact(i_virt_orb) = accu
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_core_inactive_from_act, (mo_tot_num,2,N_states)]
|
||||
BEGIN_DOC
|
||||
! inactive part of the fock operator with contributions only from the active
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k
|
||||
double precision :: accu_coulomb,accu_exchange(2)
|
||||
double precision :: na,nb,ntot
|
||||
double precision :: coulomb, exchange
|
||||
double precision :: get_mo_bielec_integral
|
||||
integer :: j_act_orb,k_act_orb,i_inact_core_orb
|
||||
integer :: i_state
|
||||
|
||||
do i_state = 1,N_states
|
||||
do i = 1, n_core_inact_orb
|
||||
accu_coulomb = 0.d0
|
||||
accu_exchange = 0.d0
|
||||
i_inact_core_orb = list_core_inact(i)
|
||||
do j = 1, n_act_orb
|
||||
j_act_orb = list_act(j)
|
||||
na = one_body_dm_mo_alpha(j_act_orb,j_act_orb,i_state)
|
||||
nb = one_body_dm_mo_beta(j_act_orb,j_act_orb,i_state)
|
||||
ntot = na + nb
|
||||
coulomb = mo_bielec_integral_jj(i_inact_core_orb,j_act_orb)
|
||||
exchange = mo_bielec_integral_jj_exchange(i_inact_core_orb,j_act_orb)
|
||||
accu_coulomb += ntot * coulomb
|
||||
accu_exchange(1) += na * exchange
|
||||
accu_exchange(2) += nb * exchange
|
||||
do k = j+1, n_act_orb
|
||||
k_act_orb = list_act(k)
|
||||
na = one_body_dm_mo_alpha(j_act_orb,k_act_orb,i_state)
|
||||
nb = one_body_dm_mo_beta(j_act_orb,k_act_orb,i_state)
|
||||
ntot = na + nb
|
||||
coulomb = get_mo_bielec_integral(j_act_orb,i_inact_core_orb,k_act_orb,i_inact_core_orb,mo_integrals_map)
|
||||
exchange = get_mo_bielec_integral(j_act_orb,k_act_orb,i_inact_core_orb,i_inact_core_orb,mo_integrals_map)
|
||||
accu_coulomb += 2.d0 * ntot * coulomb
|
||||
accu_exchange(1) += 2.d0 * na * exchange
|
||||
accu_exchange(2) += 2.d0 * nb * exchange
|
||||
enddo
|
||||
enddo
|
||||
fock_core_inactive_from_act(i_inact_core_orb,1,i_state) = accu_coulomb - accu_exchange(1)
|
||||
fock_core_inactive_from_act(i_inact_core_orb,2,i_state) = accu_coulomb - accu_exchange(2)
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_virt_from_act, (mo_tot_num,2,N_states)]
|
||||
BEGIN_DOC
|
||||
! virtual part of the fock operator with contributions only from the active
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k
|
||||
double precision :: accu_coulomb,accu_exchange(2)
|
||||
double precision :: na,nb,ntot
|
||||
double precision :: coulomb, exchange
|
||||
double precision :: get_mo_bielec_integral
|
||||
integer :: j_act_orb,i_virt_orb,k_act_orb
|
||||
integer :: i_state
|
||||
! TODO : inverse loop of i_state
|
||||
|
||||
do i_state = 1, N_states
|
||||
do i = 1, n_virt_orb
|
||||
accu_coulomb = 0.d0
|
||||
accu_exchange = 0.d0
|
||||
i_virt_orb = list_virt(i)
|
||||
do j = 1, n_act_orb
|
||||
j_act_orb = list_act(j)
|
||||
na = one_body_dm_mo_alpha(j_act_orb,j_act_orb,i_state)
|
||||
nb = one_body_dm_mo_beta(j_act_orb,j_act_orb,i_state)
|
||||
ntot = na + nb
|
||||
coulomb = mo_bielec_integral_jj(i_virt_orb,j_act_orb)
|
||||
exchange = mo_bielec_integral_jj_exchange(i_virt_orb,j_act_orb)
|
||||
accu_coulomb += ntot * coulomb
|
||||
accu_exchange(1) += na * exchange
|
||||
accu_exchange(2) += nb * exchange
|
||||
do k = j+1, n_act_orb
|
||||
k_act_orb = list_act(k)
|
||||
na = one_body_dm_mo_alpha(j_act_orb,k_act_orb,i_state)
|
||||
nb = one_body_dm_mo_beta(j_act_orb,k_act_orb,i_state)
|
||||
ntot = na + nb
|
||||
coulomb = get_mo_bielec_integral(j_act_orb,i_virt_orb,k_act_orb,i_virt_orb,mo_integrals_map)
|
||||
exchange = get_mo_bielec_integral(j_act_orb,k_act_orb,i_virt_orb,i_virt_orb,mo_integrals_map)
|
||||
accu_coulomb += 2.d0 * ntot * coulomb
|
||||
accu_exchange(1) += 2.d0 * na * exchange
|
||||
accu_exchange(2) += 2.d0 * nb * exchange
|
||||
enddo
|
||||
enddo
|
||||
fock_virt_from_act(i_virt_orb,1,i_state) = accu_coulomb - accu_exchange(1)
|
||||
fock_virt_from_act(i_virt_orb,2,i_state) = accu_coulomb - accu_exchange(2)
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_core_inactive_total, (mo_tot_num,2,N_states)]
|
||||
&BEGIN_PROVIDER [double precision, fock_core_inactive_total_spin_trace, (mo_tot_num,N_states)]
|
||||
BEGIN_DOC
|
||||
! inactive part of the fock operator
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i
|
||||
integer :: i_inact_core_orb
|
||||
integer :: i_state
|
||||
do i_state = 1, N_states
|
||||
do i = 1, n_core_inact_orb
|
||||
i_inact_core_orb = list_core_inact(i)
|
||||
fock_core_inactive_total(i_inact_core_orb,1,i_state) = fock_core_inactive(i_inact_core_orb) + fock_core_inactive_from_act(i_inact_core_orb,1,i_state)
|
||||
fock_core_inactive_total(i_inact_core_orb,2,i_state) = fock_core_inactive(i_inact_core_orb) + fock_core_inactive_from_act(i_inact_core_orb,2,i_state)
|
||||
fock_core_inactive_total_spin_trace(i_inact_core_orb,i_state) = 0.5d0 * (fock_core_inactive_total(i_inact_core_orb,1,i_state) + fock_core_inactive_total(i_inact_core_orb,2,i_state))
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_virt_total, (mo_tot_num,2,N_states)]
|
||||
&BEGIN_PROVIDER [double precision, fock_virt_total_spin_trace, (mo_tot_num,N_states)]
|
||||
BEGIN_DOC
|
||||
! inactive part of the fock operator
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i
|
||||
integer :: i_virt_orb
|
||||
integer :: i_state
|
||||
do i_state = 1, N_states
|
||||
do i = 1, n_virt_orb
|
||||
i_virt_orb= list_virt(i)
|
||||
fock_virt_total(i_virt_orb,1,i_state) = fock_virt_from_core_inact(i_virt_orb) + fock_virt_from_act(i_virt_orb,1,i_state)+ mo_mono_elec_integral(i_virt_orb,i_virt_orb)
|
||||
fock_virt_total(i_virt_orb,2,i_state) = fock_virt_from_core_inact(i_virt_orb) + fock_virt_from_act(i_virt_orb,2,i_state)+ mo_mono_elec_integral(i_virt_orb,i_virt_orb)
|
||||
fock_virt_total_spin_trace(i_virt_orb,i_state) = 0.5d0 * ( fock_virt_total(i_virt_orb,1,i_state) + fock_virt_total(i_virt_orb,2,i_state) )
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_operator_active_from_core_inact, (mo_tot_num,mo_tot_num)]
|
||||
BEGIN_DOC
|
||||
! active part of the fock operator with contributions only from the inactive
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,k_inact_core_orb
|
||||
integer :: iorb,jorb
|
||||
double precision :: accu
|
||||
double precision :: get_mo_bielec_integral,coulomb, exchange
|
||||
PROVIDE mo_bielec_integrals_in_map
|
||||
fock_operator_active_from_core_inact = 0.d0
|
||||
do i = 1, n_act_orb
|
||||
iorb = list_act(i)
|
||||
do j = 1, n_act_orb
|
||||
jorb = list_act(j)
|
||||
accu = 0.d0
|
||||
do k = 1, n_core_inact_orb
|
||||
k_inact_core_orb = list_core_inact(k)
|
||||
coulomb = get_mo_bielec_integral(k_inact_core_orb,iorb,k_inact_core_orb,jorb,mo_integrals_map)
|
||||
exchange = get_mo_bielec_integral(k_inact_core_orb,jorb,iorb,k_inact_core_orb,mo_integrals_map)
|
||||
accu += 2.d0 * coulomb - exchange
|
||||
enddo
|
||||
fock_operator_active_from_core_inact(iorb,jorb) = accu
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
|
@ -1,35 +0,0 @@
|
||||
subroutine give_2h2p(contrib_2h2p)
|
||||
implicit none
|
||||
double precision, intent(out) :: contrib_2h2p(N_states)
|
||||
integer :: i,j,k,l,m
|
||||
integer :: iorb,jorb,korb,lorb
|
||||
|
||||
double precision :: get_mo_bielec_integral
|
||||
double precision :: direct_int,exchange_int
|
||||
double precision :: numerator,denominator(N_states)
|
||||
|
||||
contrib_2h2p = 0.d0
|
||||
do i = 1, n_inact_orb
|
||||
iorb = list_inact(i)
|
||||
do j = 1, n_inact_orb
|
||||
jorb = list_inact(j)
|
||||
do k = 1, n_virt_orb
|
||||
korb = list_virt(k)
|
||||
do l = 1, n_virt_orb
|
||||
lorb = list_virt(l)
|
||||
direct_int = get_mo_bielec_integral(iorb,jorb,korb,lorb ,mo_integrals_map)
|
||||
exchange_int = get_mo_bielec_integral(iorb,jorb,lorb,korb ,mo_integrals_map)
|
||||
numerator = 3.d0 * direct_int*direct_int + exchange_int*exchange_int -2.d0 * exchange_int * direct_int
|
||||
do m = 1, N_states
|
||||
denominator(m) = fock_core_inactive_total_spin_trace(iorb,m) + fock_core_inactive_total_spin_trace(jorb,m) &
|
||||
-fock_virt_total_spin_trace(korb,m) - fock_virt_total_spin_trace(lorb,m)
|
||||
contrib_2h2p(m) += numerator / denominator(m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
contrib_2h2p = contrib_2h2p*0.5d0
|
||||
|
||||
end
|
||||
|
@ -1,186 +0,0 @@
|
||||
use omp_lib
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [ integer(omp_lock_kind), psi_ref_bis_lock, (psi_det_size) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Locks on ref determinants to fill delta_ij
|
||||
END_DOC
|
||||
integer :: i
|
||||
do i=1,psi_det_size
|
||||
call omp_init_lock( psi_ref_bis_lock(i) )
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
subroutine mrpt_dress(delta_ij_, Ndet,i_generator,n_selected,det_buffer,Nint,iproc,key_mask)
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_generator,n_selected, Nint, iproc
|
||||
integer, intent(in) :: Ndet
|
||||
integer(bit_kind),intent(in) :: key_mask(Nint, 2)
|
||||
integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected)
|
||||
double precision, intent(inout) :: delta_ij_(Ndet,Ndet,*)
|
||||
|
||||
|
||||
integer :: i,j,k,l
|
||||
integer :: idx_alpha(0:psi_det_size)
|
||||
integer :: degree_alpha(psi_det_size)
|
||||
logical :: fullMatch
|
||||
|
||||
double precision :: delta_e_inv_array(psi_det_size,N_states)
|
||||
double precision :: hij_array(psi_det_size)
|
||||
|
||||
integer(bit_kind) :: tq(Nint,2,n_selected)
|
||||
integer :: N_tq
|
||||
|
||||
double precision :: hialpha,hij
|
||||
integer :: i_state, i_alpha
|
||||
|
||||
integer(bit_kind),allocatable :: miniList(:,:,:)
|
||||
integer,allocatable :: idx_miniList(:)
|
||||
integer :: N_miniList, leng
|
||||
double precision :: delta_e(N_states),hij_tmp
|
||||
integer :: index_i,index_j
|
||||
double precision :: phase_array(N_det),phase
|
||||
integer :: exc(0:2,2,2),degree
|
||||
|
||||
|
||||
leng = max(N_det_generators, N_det)
|
||||
allocate(miniList(Nint, 2, leng), idx_miniList(leng))
|
||||
|
||||
!create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint)
|
||||
call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint)
|
||||
|
||||
if(fullMatch) then
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call find_connections_previous(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist)
|
||||
|
||||
if(N_tq > 0) then
|
||||
call create_minilist(key_mask, psi_det, miniList, idx_miniList, N_det, N_minilist, Nint)
|
||||
end if
|
||||
|
||||
|
||||
do i_alpha=1,N_tq
|
||||
call get_excitation_degree_vector(miniList,tq(1,1,i_alpha),degree_alpha,Nint,N_minilist,idx_alpha)
|
||||
|
||||
do j=1,idx_alpha(0)
|
||||
idx_alpha(j) = idx_miniList(idx_alpha(j))
|
||||
enddo
|
||||
|
||||
! double precision :: ihpsi0,coef_pert
|
||||
! ihpsi0 = 0.d0
|
||||
! coef_pert = 0.d0
|
||||
phase_array =0.d0
|
||||
do i = 1,idx_alpha(0)
|
||||
index_i = idx_alpha(i)
|
||||
call i_h_j(tq(1,1,i_alpha),psi_det(1,1,index_i),Nint,hialpha)
|
||||
double precision :: coef_array(N_states)
|
||||
do i_state = 1, N_states
|
||||
coef_array(i_state) = psi_coef(index_i,i_state)
|
||||
enddo
|
||||
call get_delta_e_dyall(psi_det(1,1,index_i),tq(1,1,i_alpha),coef_array,hialpha,delta_e)
|
||||
hij_array(index_i) = hialpha
|
||||
call get_excitation(psi_det(1,1,index_i),tq(1,1,i_alpha),exc,degree,phase,N_int)
|
||||
! phase_array(index_i) = phase
|
||||
do i_state = 1,N_states
|
||||
delta_e_inv_array(index_i,i_state) = 1.d0/delta_e(i_state)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i=1,idx_alpha(0)
|
||||
index_i = idx_alpha(i)
|
||||
hij_tmp = hij_array(index_i)
|
||||
call omp_set_lock( psi_ref_bis_lock(index_i) )
|
||||
do j = 1, idx_alpha(0)
|
||||
index_j = idx_alpha(j)
|
||||
! call get_excitation(psi_det(1,1,index_i),psi_det(1,1,index_i),exc,degree,phase,N_int)
|
||||
! if(index_j.ne.index_i)then
|
||||
! if(phase_array(index_j) * phase_array(index_i) .ne. phase)then
|
||||
! print*, phase_array(index_j) , phase_array(index_i) ,phase
|
||||
! call debug_det(psi_det(1,1,index_i),N_int)
|
||||
! call debug_det(psi_det(1,1,index_j),N_int)
|
||||
! call debug_det(tq(1,1,i_alpha),N_int)
|
||||
! stop
|
||||
! endif
|
||||
! endif
|
||||
do i_state=1,N_states
|
||||
! standard dressing first order
|
||||
delta_ij_(index_i,index_j,i_state) += hij_array(index_j) * hij_tmp * delta_e_inv_array(index_j,i_state)
|
||||
enddo
|
||||
enddo
|
||||
call omp_unset_lock( psi_ref_bis_lock(index_i))
|
||||
enddo
|
||||
enddo
|
||||
deallocate(miniList, idx_miniList)
|
||||
end
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), gen_det_sorted, (N_int,2,N_det_generators,2) ]
|
||||
&BEGIN_PROVIDER [ integer, gen_det_shortcut, (0:N_det_generators,2) ]
|
||||
&BEGIN_PROVIDER [ integer, gen_det_version, (N_int, N_det_generators,2) ]
|
||||
&BEGIN_PROVIDER [ integer, gen_det_idx, (N_det_generators,2) ]
|
||||
gen_det_sorted(:,:,:,1) = psi_det_generators(:,:,:N_det_generators)
|
||||
gen_det_sorted(:,:,:,2) = psi_det_generators(:,:,:N_det_generators)
|
||||
call sort_dets_ab_v(gen_det_sorted(:,:,:,1), gen_det_idx(:,1), gen_det_shortcut(0:,1), gen_det_version(:,:,1), N_det_generators, N_int)
|
||||
call sort_dets_ba_v(gen_det_sorted(:,:,:,2), gen_det_idx(:,2), gen_det_shortcut(0:,2), gen_det_version(:,:,2), N_det_generators, N_int)
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
subroutine find_connections_previous(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_miniList)
|
||||
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_generator,n_selected, Nint
|
||||
|
||||
integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected)
|
||||
integer :: i,j,k,m
|
||||
logical :: is_in_wavefunction
|
||||
integer :: degree(psi_det_size)
|
||||
integer :: idx(0:psi_det_size)
|
||||
logical :: good
|
||||
|
||||
integer(bit_kind), intent(out) :: tq(Nint,2,n_selected)
|
||||
integer, intent(out) :: N_tq
|
||||
|
||||
|
||||
integer :: nt,ni
|
||||
logical, external :: is_connected_to
|
||||
|
||||
|
||||
integer(bit_kind),intent(in) :: miniList(Nint,2,N_det_generators)
|
||||
integer,intent(in) :: N_miniList
|
||||
|
||||
|
||||
|
||||
N_tq = 0
|
||||
|
||||
|
||||
i_loop : do i=1,N_selected
|
||||
if(is_connected_to(det_buffer(1,1,i), miniList, Nint, N_miniList)) then
|
||||
cycle
|
||||
end if
|
||||
|
||||
if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint,N_det)) then
|
||||
N_tq += 1
|
||||
do k=1,N_int
|
||||
tq(k,1,N_tq) = det_buffer(k,1,i)
|
||||
tq(k,2,N_tq) = det_buffer(k,2,i)
|
||||
enddo
|
||||
endif
|
||||
enddo i_loop
|
||||
end
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -1,367 +0,0 @@
|
||||
|
||||
BEGIN_PROVIDER [ double precision, delta_ij, (N_det,N_det,N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new, (N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new_1h, (N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new_1p, (N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new_1h1p, (N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new_2h, (N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new_2p, (N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new_1h2p, (N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new_2h1p, (N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, second_order_pt_new_2h2p, (N_states) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Dressing matrix in N_det basis
|
||||
END_DOC
|
||||
integer :: i,j,m
|
||||
integer :: i_state
|
||||
double precision :: accu(N_states)
|
||||
double precision, allocatable :: delta_ij_tmp(:,:,:)
|
||||
|
||||
|
||||
delta_ij = 0.d0
|
||||
|
||||
allocate (delta_ij_tmp(N_det,N_det,N_states))
|
||||
|
||||
|
||||
! 1h
|
||||
delta_ij_tmp = 0.d0
|
||||
call H_apply_mrpt_1h(delta_ij_tmp,N_det)
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new_1h(i_state) = accu(i_state)
|
||||
enddo
|
||||
print*, '1h = ',accu
|
||||
|
||||
! 1p
|
||||
delta_ij_tmp = 0.d0
|
||||
call H_apply_mrpt_1p(delta_ij_tmp,N_det)
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new_1p(i_state) = accu(i_state)
|
||||
enddo
|
||||
print*, '1p = ',accu
|
||||
|
||||
! 1h1p
|
||||
delta_ij_tmp = 0.d0
|
||||
call H_apply_mrpt_1h1p(delta_ij_tmp,N_det)
|
||||
double precision :: e_corr_from_1h1p_singles(N_states)
|
||||
!call give_singles_and_partial_doubles_1h1p_contrib(delta_ij_tmp,e_corr_from_1h1p_singles)
|
||||
!call give_1h1p_only_doubles_spin_cross(delta_ij_tmp)
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new_1h1p(i_state) = accu(i_state)
|
||||
enddo
|
||||
print*, '1h1p = ',accu
|
||||
|
||||
! 1h1p third order
|
||||
if(do_third_order_1h1p)then
|
||||
delta_ij_tmp = 0.d0
|
||||
call give_1h1p_sec_order_singles_contrib(delta_ij_tmp)
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new_1h1p(i_state) = accu(i_state)
|
||||
enddo
|
||||
print*, '1h1p(3)',accu
|
||||
endif
|
||||
|
||||
! 2h
|
||||
delta_ij_tmp = 0.d0
|
||||
call H_apply_mrpt_2h(delta_ij_tmp,N_det)
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new_2h(i_state) = accu(i_state)
|
||||
enddo
|
||||
print*, '2h = ',accu
|
||||
|
||||
! 2p
|
||||
delta_ij_tmp = 0.d0
|
||||
call H_apply_mrpt_2p(delta_ij_tmp,N_det)
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new_2p(i_state) = accu(i_state)
|
||||
enddo
|
||||
print*, '2p = ',accu
|
||||
|
||||
! 1h2p
|
||||
delta_ij_tmp = 0.d0
|
||||
!call give_1h2p_contrib(delta_ij_tmp)
|
||||
call H_apply_mrpt_1h2p(delta_ij_tmp,N_det)
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new_1h2p(i_state) = accu(i_state)
|
||||
enddo
|
||||
print*, '1h2p = ',accu
|
||||
|
||||
! 2h1p
|
||||
delta_ij_tmp = 0.d0
|
||||
!call give_2h1p_contrib(delta_ij_tmp)
|
||||
call H_apply_mrpt_2h1p(delta_ij_tmp,N_det)
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new_2h1p(i_state) = accu(i_state)
|
||||
enddo
|
||||
print*, '2h1p = ',accu
|
||||
|
||||
! 2h2p
|
||||
!delta_ij_tmp = 0.d0
|
||||
!call H_apply_mrpt_2h2p(delta_ij_tmp,N_det)
|
||||
!accu = 0.d0
|
||||
!do i_state = 1, N_states
|
||||
!do i = 1, N_det
|
||||
! do j = 1, N_det
|
||||
! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state)
|
||||
! enddo
|
||||
!enddo
|
||||
!second_order_pt_new_2h2p(i_state) = accu(i_state)
|
||||
!enddo
|
||||
!print*, '2h2p = ',accu
|
||||
|
||||
double precision :: contrib_2h2p(N_states)
|
||||
call give_2h2p(contrib_2h2p)
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
delta_ij(i,i,i_state) += contrib_2h2p(i_state)
|
||||
enddo
|
||||
second_order_pt_new_2h2p(i_state) = contrib_2h2p(i_state)
|
||||
enddo
|
||||
print*, '2h2p = ',contrib_2h2p(1)
|
||||
|
||||
|
||||
! total
|
||||
accu = 0.d0
|
||||
do i_state = 1, N_states
|
||||
do i = 1, N_det
|
||||
! write(*,'(1000(F16.10,x))')delta_ij(i,:,:)
|
||||
do j = i_state, N_det
|
||||
accu(i_state) += delta_ij(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state)
|
||||
enddo
|
||||
enddo
|
||||
second_order_pt_new(i_state) = accu(i_state)
|
||||
print*, 'total= ',accu(i_state)
|
||||
enddo
|
||||
|
||||
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, Hmatrix_dressed_pt2_new, (N_det,N_det,N_states)]
|
||||
implicit none
|
||||
integer :: i,j,i_state
|
||||
do i_state = 1, N_states
|
||||
do i = 1,N_det
|
||||
do j = 1,N_det
|
||||
Hmatrix_dressed_pt2_new(j,i,i_state) = H_matrix_all_dets(j,i) + delta_ij(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, Hmatrix_dressed_pt2_new_symmetrized, (N_det,N_det,N_states)]
|
||||
implicit none
|
||||
integer :: i,j,i_state
|
||||
do i_state = 1, N_states
|
||||
do i = 1,N_det
|
||||
do j = i,N_det
|
||||
Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state) = H_matrix_all_dets(j,i) &
|
||||
+ 0.5d0 * ( delta_ij(j,i,i_state) + delta_ij(i,j,i_state) )
|
||||
Hmatrix_dressed_pt2_new_symmetrized(i,j,i_state) = Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, CI_electronic_dressed_pt2_new_energy, (N_states_diag) ]
|
||||
&BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors, (N_det,N_states_diag) ]
|
||||
&BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors_s2, (N_states_diag) ]
|
||||
BEGIN_DOC
|
||||
! Eigenvectors/values of the CI matrix
|
||||
END_DOC
|
||||
implicit none
|
||||
double precision :: ovrlp,u_dot_v
|
||||
integer :: i_good_state
|
||||
integer, allocatable :: index_good_state_array(:)
|
||||
logical, allocatable :: good_state_array(:)
|
||||
double precision, allocatable :: s2_values_tmp(:)
|
||||
integer :: i_other_state
|
||||
double precision, allocatable :: eigenvectors(:,:), eigenvalues(:)
|
||||
integer :: i_state
|
||||
double precision :: s2,e_0
|
||||
integer :: i,j,k
|
||||
double precision, allocatable :: s2_eigvalues(:)
|
||||
double precision, allocatable :: e_array(:)
|
||||
integer, allocatable :: iorder(:)
|
||||
|
||||
! Guess values for the "N_states_diag" states of the CI_dressed_pt2_new_eigenvectors
|
||||
do j=1,min(N_states_diag,N_det)
|
||||
do i=1,N_det
|
||||
CI_dressed_pt2_new_eigenvectors(i,j) = psi_coef(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do j=N_det+1,N_states_diag
|
||||
do i=1,N_det
|
||||
CI_dressed_pt2_new_eigenvectors(i,j) = 0.d0
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if (diag_algorithm == "Davidson") then
|
||||
|
||||
print*, 'Davidson not yet implemented for the dressing ... '
|
||||
stop
|
||||
|
||||
else if (diag_algorithm == "Lapack") then
|
||||
|
||||
allocate (eigenvectors(size(H_matrix_all_dets,1),N_det))
|
||||
allocate (eigenvalues(N_det))
|
||||
call lapack_diag(eigenvalues,eigenvectors, &
|
||||
H_matrix_all_dets,size(H_matrix_all_dets,1),N_det)
|
||||
CI_electronic_energy(:) = 0.d0
|
||||
if (s2_eig) then
|
||||
i_state = 0
|
||||
allocate (s2_eigvalues(N_det))
|
||||
allocate(index_good_state_array(N_det),good_state_array(N_det))
|
||||
good_state_array = .False.
|
||||
call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,&
|
||||
N_det,size(eigenvectors,1))
|
||||
do j=1,N_det
|
||||
! Select at least n_states states with S^2 values closed to "expected_s2"
|
||||
if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then
|
||||
i_state +=1
|
||||
index_good_state_array(i_state) = j
|
||||
good_state_array(j) = .True.
|
||||
endif
|
||||
if(i_state.eq.N_states) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if(i_state .ne.0)then
|
||||
! Fill the first "i_state" states that have a correct S^2 value
|
||||
do j = 1, i_state
|
||||
do i=1,N_det
|
||||
CI_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j))
|
||||
enddo
|
||||
CI_electronic_energy(j) = eigenvalues(index_good_state_array(j))
|
||||
CI_eigenvectors_s2(j) = s2_eigvalues(index_good_state_array(j))
|
||||
enddo
|
||||
i_other_state = 0
|
||||
do j = 1, N_det
|
||||
if(good_state_array(j))cycle
|
||||
i_other_state +=1
|
||||
if(i_state+i_other_state.gt.n_states_diag)then
|
||||
exit
|
||||
endif
|
||||
do i=1,N_det
|
||||
CI_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j)
|
||||
enddo
|
||||
CI_electronic_energy(i_state+i_other_state) = eigenvalues(j)
|
||||
CI_eigenvectors_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state)
|
||||
enddo
|
||||
|
||||
else
|
||||
print*,''
|
||||
print*,'!!!!!!!! WARNING !!!!!!!!!'
|
||||
print*,' Within the ',N_det,'determinants selected'
|
||||
print*,' and the ',N_states_diag,'states requested'
|
||||
print*,' We did not find any state with S^2 values close to ',expected_s2
|
||||
print*,' We will then set the first N_states eigenvectors of the H matrix'
|
||||
print*,' as the CI_eigenvectors'
|
||||
print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space'
|
||||
print*,''
|
||||
do j=1,min(N_states_diag,N_det)
|
||||
do i=1,N_det
|
||||
CI_eigenvectors(i,j) = eigenvectors(i,j)
|
||||
enddo
|
||||
CI_electronic_energy(j) = eigenvalues(j)
|
||||
CI_eigenvectors_s2(j) = s2_eigvalues(j)
|
||||
enddo
|
||||
endif
|
||||
deallocate(index_good_state_array,good_state_array)
|
||||
deallocate(s2_eigvalues)
|
||||
else
|
||||
call u_0_S2_u_0(CI_eigenvectors_s2,eigenvectors,N_det,psi_det,N_int,&
|
||||
min(N_det,N_states_diag),size(eigenvectors,1))
|
||||
! Select the "N_states_diag" states of lowest energy
|
||||
do j=1,min(N_det,N_states_diag)
|
||||
do i=1,N_det
|
||||
CI_eigenvectors(i,j) = eigenvectors(i,j)
|
||||
enddo
|
||||
CI_electronic_energy(j) = eigenvalues(j)
|
||||
enddo
|
||||
endif
|
||||
deallocate(eigenvectors,eigenvalues)
|
||||
endif
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states_diag) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! N_states lowest eigenvalues of the CI matrix
|
||||
END_DOC
|
||||
|
||||
integer :: j
|
||||
character*(8) :: st
|
||||
call write_time(output_determinants)
|
||||
do j=1,N_states_diag
|
||||
CI_dressed_pt2_new_energy(j) = CI_electronic_dressed_pt2_new_energy(j) + nuclear_repulsion
|
||||
write(st,'(I4)') j
|
||||
call write_double(output_determinants,CI_dressed_pt2_new_energy(j),'Energy of state '//trim(st))
|
||||
call write_double(output_determinants,CI_eigenvectors_s2(j),'S^2 of state '//trim(st))
|
||||
enddo
|
||||
|
||||
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