mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-02 06:20:53 +02:00
Merge branch 'master' into daily-test
This commit is contained in:
commit
dcbd24c68f
@ -143,7 +143,7 @@ IRPF90
|
||||
to Parameters (IRP) method.
|
||||
|
||||
* Download the latest version of IRPF90
|
||||
here : `<https://github.com/scemama/irpf90/releases/latest>`_ and move
|
||||
here : `<https://gitlab.com/scemama/irpf90/-/archive/v1.7.2/irpf90-v1.7.2.tar.gz>`_ and move
|
||||
the downloaded archive in the :file:`${QP_ROOT}/external` directory
|
||||
|
||||
* Extract the archive and go into the :file:`irpf90-*` directory to run
|
||||
|
@ -1,8 +1,12 @@
|
||||
# Quantum Package 2.0
|
||||
# Quantum Package 2.1
|
||||
|
||||
<img src="https://raw.githubusercontent.com/QuantumPackage/qp2/master/data/qp2.png" width="250">
|
||||
|
||||
|
||||
[![DOI](https://zenodo.org/badge/167513335.svg)](https://zenodo.org/badge/latestdoi/167513335)
|
||||
|
||||
|
||||
|
||||
[*Quantum package 2.0: an open-source determinant-driven suite of programs*](https://pubs.acs.org/doi/10.1021/acs.jctc.9b00176)\
|
||||
Y. Garniron, K. Gasperich, T. Applencourt, A. Benali, A. Ferté, J. Paquier, B. Pradines, R. Assaraf, P. Reinhardt, J. Toulouse, P. Barbaresco, N. Renon, G. David, J. P. Malrieu, M. Véril, M. Caffarel, P. F. Loos, E. Giner and A. Scemama\
|
||||
[J. Chem. Theory Comput. 2019, 15, 6, 3591-3609](https://doi.org/10.1021/acs.jctc.9b00176)\
|
||||
|
1
REPLACE
1
REPLACE
@ -834,3 +834,4 @@ qp_name potential_sr_c_alpha_ao_pbe --rename=potential_c_alpha_ao_sr_pbe
|
||||
qp_name potential_sr_c_beta_ao_pbe --rename=potential_c_beta_ao_sr_pbe
|
||||
qp_name potential_sr_xc_alpha_ao_pbe --rename=potential_xc_alpha_ao_sr_pbe
|
||||
qp_name potential_sr_xc_beta_ao_pbe --rename=potential_xc_beta_ao_sr_pbe
|
||||
qp_name disk_access_nuclear_repulsion --rename=io_nuclear_repulsion
|
||||
|
41
TODO
41
TODO
@ -2,16 +2,8 @@
|
||||
|
||||
* Faire que le slave de Hartree-fock est le calcul des integrales AO en parallele
|
||||
|
||||
# Web/doc
|
||||
|
||||
* Creer une page web pas trop degueu et la mettre ici : http://lcpq.github.io/quantum_package
|
||||
|
||||
* Creer une page avec la liste de tous les exectuables
|
||||
|
||||
|
||||
# Exterieur
|
||||
|
||||
* Molden format : http://cheminf.cmbi.ru.nl/molden/molden_format.html : read+write. Thomas est dessus
|
||||
* Un module pour lire les integrales Moleculaires depuis un FCIDUMP
|
||||
* Un module pour lire des integrales Atomiques (voir module de Mimi pour lire les AO Slater)
|
||||
* Format Fchk (gaussian)
|
||||
@ -24,51 +16,22 @@
|
||||
|
||||
# User doc:
|
||||
|
||||
* Videos:
|
||||
+) RHF
|
||||
* Renvoyer a la doc des modules : c'est pour les programmeurs au depart!
|
||||
* Mettre le mp2 comme exercice
|
||||
|
||||
* Interfaces : molden/fcidump
|
||||
* Natural orbitals
|
||||
* Parameters for Hartree-Fock
|
||||
* Parameters for Davidson
|
||||
* Running in parallel
|
||||
|
||||
# Programmers doc:
|
||||
|
||||
* Example : Simple Hartree-Fock program from scratch
|
||||
* Examples : subroutine example_module
|
||||
|
||||
# enleverle psi_det_size for all complicated stuffs with dimension of psi_coef
|
||||
|
||||
# Config file for Cray
|
||||
|
||||
# EZFIO sans fork
|
||||
|
||||
Refaire les benchmarks
|
||||
|
||||
# Documentation de qpsh
|
||||
|
||||
# Documentation de /etc
|
||||
|
||||
# Toto
|
||||
Re-design de qp command
|
||||
|
||||
Doc: plugins et qp_plugins
|
||||
|
||||
Ajouter les symetries dans devel
|
||||
|
||||
<<<<<<< HEAD
|
||||
Compiler ezfio avec openmp
|
||||
|
||||
# Parallelize i_H_psi
|
||||
=======
|
||||
|
||||
# Parallelize i_H_psi
|
||||
<<<<<<< HEAD
|
||||
=======
|
||||
|
||||
|
||||
>>>>>>> minor_modifs
|
||||
IMPORTANT:
|
||||
|
||||
Davidson Diagonalization
|
||||
|
@ -1,71 +0,0 @@
|
||||
#!/usr/bin/env python2
|
||||
|
||||
|
||||
"""
|
||||
Creates an ssh tunnel for using slaves on another network.
|
||||
Launch a server on the front-end node of the cluster on which the master
|
||||
process runs. Then start a client ont the front-end node of the distant
|
||||
cluster.
|
||||
|
||||
Usage:
|
||||
qp_tunnel server EZFIO_DIR
|
||||
qp_tunnel client <address> EZFIO_DIR
|
||||
|
||||
Options:
|
||||
-h --help
|
||||
|
||||
"""
|
||||
|
||||
import os
|
||||
import sys
|
||||
import zmq
|
||||
|
||||
try:
|
||||
import qp_path
|
||||
except ImportError:
|
||||
print "source .quantum_package.rc"
|
||||
raise
|
||||
|
||||
from docopt import docopt
|
||||
from ezfio import ezfio
|
||||
|
||||
|
||||
def get_address(filename):
|
||||
with open(os.path.join(filename,'work','qp_run_address'),'r') as f:
|
||||
a = f.readlines()[0].strip()
|
||||
return a
|
||||
|
||||
|
||||
def set_address(filename,address):
|
||||
with open(os.path.join(filename,'work','qp_run_address'),'r') as f:
|
||||
backup = f.readlines()
|
||||
|
||||
with open(os.path.join(filename,'work','qp_run_address'),'w') as f:
|
||||
f.write('\n'.join([address]+backup))
|
||||
|
||||
|
||||
def main_server(arguments,filename):
|
||||
destination = get_address(filename)
|
||||
print destination
|
||||
|
||||
|
||||
def main_client(arguments,filename):
|
||||
destination = arguments["<address>"]
|
||||
print destination
|
||||
|
||||
|
||||
def main(arguments):
|
||||
"""Main function"""
|
||||
|
||||
print arguments
|
||||
filename = arguments["EZFIO_DIR"]
|
||||
|
||||
if arguments["server"]:
|
||||
return main_server(arguments, filename)
|
||||
if arguments["client"]:
|
||||
return main_client(arguments, filename)
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
ARGUMENTS = docopt(__doc__)
|
||||
main(ARGUMENTS)
|
119
configure
vendored
119
configure
vendored
@ -8,6 +8,28 @@ eval set -- "$TEMP"
|
||||
|
||||
export QP_ROOT="$( cd "$(dirname "$0")" ; pwd -P )"
|
||||
echo "QP_ROOT="$QP_ROOT
|
||||
unset CC
|
||||
unset CCXX
|
||||
|
||||
# Force GCC instead of ICC for dependencies
|
||||
export CC=gcc
|
||||
|
||||
|
||||
# /!\ When updating version, update also etc files
|
||||
|
||||
EZFIO_TGZ="EZFIO.1.6.2.tar.gz"
|
||||
BATS_URL="https://github.com/bats-core/bats-core/archive/v1.1.0.tar.gz"
|
||||
BUBBLE_URL="https://github.com/projectatomic/bubblewrap/releases/download/v0.3.3/bubblewrap-0.3.3.tar.xz"
|
||||
DOCOPT_URL="https://github.com/docopt/docopt/archive/0.6.2.tar.gz"
|
||||
F77ZMQ_URL="https://github.com/scemama/f77_zmq/archive/v4.2.5.tar.gz"
|
||||
GMP_URL="ftp://ftp.gnu.org/gnu/gmp/gmp-6.1.2.tar.bz2"
|
||||
IRPF90_URL="https://gitlab.com/scemama/irpf90/-/archive/v1.7.6/irpf90-v1.7.6.tar.gz"
|
||||
LIBCAP_URL="https://git.kernel.org/pub/scm/linux/kernel/git/morgan/libcap.git/snapshot/libcap-2.25.tar.gz"
|
||||
NINJA_URL="https://github.com/ninja-build/ninja/releases/download/v1.8.2/ninja-linux.zip"
|
||||
OCAML_URL="https://raw.githubusercontent.com/ocaml/opam/master/shell/install.sh"
|
||||
RESULTS_URL="https://gitlab.com/scemama/resultsFile/-/archive/v1.0/resultsFile-v1.0.tar.gz"
|
||||
ZEROMQ_URL="https://github.com/zeromq/libzmq/releases/download/v4.2.5/zeromq-4.2.5.tar.gz"
|
||||
ZLIB_URL="https://www.zlib.net/zlib-1.2.11.tar.gz"
|
||||
|
||||
|
||||
function help()
|
||||
@ -60,7 +82,7 @@ function execute () {
|
||||
}
|
||||
|
||||
PACKAGES=""
|
||||
OCAML_PACKAGES="ocamlbuild cryptokit zmq sexplib.v0.11.0 ppx_sexp_conv ppx_deriving getopt"
|
||||
OCAML_PACKAGES="ocamlbuild cryptokit zmq sexplib ppx_sexp_conv ppx_deriving getopt"
|
||||
|
||||
while true ; do
|
||||
case "$1" in
|
||||
@ -155,6 +177,19 @@ function find_dir() {
|
||||
}
|
||||
|
||||
|
||||
# Extract EZFIO if needed
|
||||
EZFIO=$(find_dir "${QP_ROOT}"/external/ezfio)
|
||||
if [[ ${EZFIO} = $(not_found) ]] ; then
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file ${EZFIO_TGZ}
|
||||
rm -rf ezfio
|
||||
mv EZFIO ezfio
|
||||
EOF
|
||||
fi
|
||||
|
||||
|
||||
|
||||
if [[ "${PACKAGES}.x" != ".x" ]] ; then
|
||||
printf "\e[0;31m"
|
||||
echo ""
|
||||
@ -183,9 +218,7 @@ for PACKAGE in ${PACKAGES} ; do
|
||||
|
||||
if [[ ${PACKAGE} = ninja ]] ; then
|
||||
|
||||
download \
|
||||
"https://github.com/ninja-build/ninja/releases/download/v1.8.2/ninja-linux.zip" \
|
||||
"${QP_ROOT}"/external/ninja.zip
|
||||
download ${NINJA_URL} "${QP_ROOT}"/external/ninja.zip
|
||||
execute << EOF
|
||||
rm -f "\${QP_ROOT}"/bin/ninja
|
||||
unzip "\${QP_ROOT}"/external/ninja.zip -d "\${QP_ROOT}"/bin
|
||||
@ -194,9 +227,7 @@ EOF
|
||||
|
||||
elif [[ ${PACKAGE} = gmp ]] ; then
|
||||
|
||||
download \
|
||||
"ftp://ftp.gnu.org/gnu/gmp/gmp-6.1.2.tar.bz2" \
|
||||
"${QP_ROOT}"/external/gmp.tar.bz2
|
||||
download ${GMP_URL} "${QP_ROOT}"/external/gmp.tar.bz2
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --bzip2 --extract --file gmp.tar.bz2
|
||||
@ -208,9 +239,7 @@ EOF
|
||||
|
||||
elif [[ ${PACKAGE} = libcap ]] ; then
|
||||
|
||||
download \
|
||||
"https://git.kernel.org/pub/scm/linux/kernel/git/morgan/libcap.git/snapshot/libcap-2.25.tar.gz" \
|
||||
"${QP_ROOT}"/external/libcap.tar.gz
|
||||
download ${LIBCAP_URL} "${QP_ROOT}"/external/libcap.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file libcap.tar.gz
|
||||
@ -221,9 +250,7 @@ EOF
|
||||
|
||||
elif [[ ${PACKAGE} = bwrap ]] ; then
|
||||
|
||||
download \
|
||||
"https://github.com/projectatomic/bubblewrap/releases/download/v0.3.3/bubblewrap-0.3.3.tar.xz" \
|
||||
"${QP_ROOT}"/external/bwrap.tar.xz
|
||||
download ${BUBBLE_URL} "${QP_ROOT}"/external/bwrap.tar.xz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --xz --extract --file bwrap.tar.xz
|
||||
@ -236,9 +263,7 @@ EOF
|
||||
elif [[ ${PACKAGE} = irpf90 ]] ; then
|
||||
|
||||
# When changing version of irpf90, don't forget to update etc/irpf90.rc
|
||||
download \
|
||||
"https://gitlab.com/scemama/irpf90/-/archive/v1.7.5/irpf90-v1.7.5.tar.gz" \
|
||||
"${QP_ROOT}"/external/irpf90.tar.gz
|
||||
download ${IRPF90_URL} "${QP_ROOT}"/external/irpf90.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file irpf90.tar.gz
|
||||
@ -250,9 +275,7 @@ EOF
|
||||
|
||||
elif [[ ${PACKAGE} = zeromq ]] ; then
|
||||
|
||||
download \
|
||||
"https://github.com/zeromq/libzmq/releases/download/v4.2.5/zeromq-4.2.5.tar.gz" \
|
||||
"${QP_ROOT}"/external/zeromq.tar.gz
|
||||
download ${ZEROMQ_URL} "${QP_ROOT}"/external/zeromq.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file zeromq.tar.gz
|
||||
@ -266,9 +289,7 @@ EOF
|
||||
|
||||
elif [[ ${PACKAGE} = f77zmq ]] ; then
|
||||
|
||||
download \
|
||||
"https://github.com/scemama/f77_zmq/archive/v4.2.5.tar.gz" \
|
||||
"${QP_ROOT}"/external/f77_zmq.tar.gz
|
||||
download ${F77ZMQ_URL} "${QP_ROOT}"/external/f77_zmq.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file f77_zmq.tar.gz
|
||||
@ -284,9 +305,7 @@ EOF
|
||||
|
||||
elif [[ ${PACKAGE} = ocaml ]] ; then
|
||||
|
||||
download \
|
||||
"https://raw.githubusercontent.com/ocaml/opam/master/shell/install.sh" \
|
||||
"${QP_ROOT}"/external/opam_installer.sh
|
||||
download ${OCAML_URL} "${QP_ROOT}"/external/opam_installer.sh
|
||||
|
||||
if [[ -n ${TRAVIS} ]] ; then
|
||||
# Special commands for Travis CI
|
||||
@ -336,24 +355,10 @@ EOF
|
||||
fi
|
||||
|
||||
|
||||
elif [[ ${PACKAGE} = ezfio ]] ; then
|
||||
|
||||
download \
|
||||
"https://gitlab.com/scemama/EZFIO/-/archive/v1.4.0/EZFIO-v1.4.0.tar.gz" \
|
||||
"${QP_ROOT}"/external/ezfio.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file ezfio.tar.gz
|
||||
rm -rf ezfio
|
||||
mv EZFIO-* ezfio
|
||||
EOF
|
||||
|
||||
|
||||
elif [[ ${PACKAGE} = zlib ]] ; then
|
||||
|
||||
download \
|
||||
"https://www.zlib.net/zlib-1.2.11.tar.gz" \
|
||||
"${QP_ROOT}"/external/zlib.tar.gz
|
||||
download ${ZLIB_URL} "${QP_ROOT}"/external/zlib.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file zlib.tar.gz
|
||||
@ -366,9 +371,7 @@ EOF
|
||||
|
||||
elif [[ ${PACKAGE} = docopt ]] ; then
|
||||
|
||||
download \
|
||||
"https://github.com/docopt/docopt/archive/0.6.2.tar.gz" \
|
||||
"${QP_ROOT}"/external/docopt.tar.gz
|
||||
download ${DOCOPT_URL} "${QP_ROOT}"/external/docopt.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file docopt.tar.gz
|
||||
@ -379,21 +382,17 @@ EOF
|
||||
|
||||
elif [[ ${PACKAGE} = resultsFile ]] ; then
|
||||
|
||||
download \
|
||||
"https://gitlab.com/scemama/resultsFile/-/archive/master/resultsFile-master.tar.gz" \
|
||||
"${QP_ROOT}"/external/resultsFile.tar.gz
|
||||
download ${RESULTS_URL} "${QP_ROOT}"/external/resultsFile.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar --gunzip --extract --file resultsFile.tar.gz
|
||||
mv resultsFile-master/resultsFile "\${QP_ROOT}/external/Python/"
|
||||
rm --recursive --force resultsFile-master resultsFile.tar.gz
|
||||
mv resultsFile-*/resultsFile "\${QP_ROOT}/external/Python/"
|
||||
rm --recursive --force resultsFile-* resultsFile.tar.gz
|
||||
EOF
|
||||
|
||||
elif [[ ${PACKAGE} = bats ]] ; then
|
||||
|
||||
download \
|
||||
"https://github.com/bats-core/bats-core/archive/v1.1.0.tar.gz" \
|
||||
"${QP_ROOT}"/external/bats.tar.gz
|
||||
download ${BATS_URL} "${QP_ROOT}"/external/bats.tar.gz
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
tar -zxf bats.tar.gz
|
||||
@ -438,18 +437,18 @@ if [[ ${ZLIB} = $(not_found) ]] ; then
|
||||
fail
|
||||
fi
|
||||
|
||||
BWRAP=$(find_exe bwrap)
|
||||
if [[ ${BWRAP} = $(not_found) ]] ; then
|
||||
error "Bubblewrap (bwrap) is not installed."
|
||||
fail
|
||||
fi
|
||||
|
||||
LIBCAP=$(find_lib -lcap)
|
||||
if [[ ${LIBCAP} = $(not_found) ]] ; then
|
||||
error "Libcap (libcap) is not installed."
|
||||
fail
|
||||
fi
|
||||
|
||||
BWRAP=$(find_exe bwrap)
|
||||
if [[ ${BWRAP} = $(not_found) ]] ; then
|
||||
error "Bubblewrap (bwrap) is not installed."
|
||||
fail
|
||||
fi
|
||||
|
||||
OPAM=$(find_exe opam)
|
||||
if [[ ${OPAM} = $(not_found) ]] ; then
|
||||
error "OPAM (ocaml) package manager is not installed."
|
||||
@ -462,12 +461,6 @@ if [[ ${OCAML} = $(not_found) ]] ; then
|
||||
fail
|
||||
fi
|
||||
|
||||
EZFIO=$(find_dir "${QP_ROOT}"/external/ezfio)
|
||||
if [[ ${EZFIO} = $(not_found) ]] ; then
|
||||
error "EZFIO (ezfio) is not installed."
|
||||
fail
|
||||
fi
|
||||
|
||||
ZLIB=$(find_lib -lz)
|
||||
if [[ ${ZLIB} = $(not_found) ]] ; then
|
||||
error "Zlib (zlib) is not installed."
|
||||
|
@ -1,4 +1,11 @@
|
||||
# Basis sets obtained from EMSL Basis Set Exchange : https://bse.pnl.gov/bse/portal
|
||||
# IMPORTANT NOTICE:
|
||||
# Basis sets were obtained from the old EMSL Basis Set Exchange web site
|
||||
# (https://bse.pnl.gov/bse/portal) in 2015. Today, the new web site
|
||||
# https://www.basissetexchange.org contains updated versions of the basis
|
||||
# sets with eventually the same name, but different data.
|
||||
#
|
||||
# Users are advised to use data from www.basissetexchange.org instead of the
|
||||
# file provided in this directory.
|
||||
|
||||
# File Name on EMSL BSE Description
|
||||
|
||||
|
@ -8,6 +8,16 @@ S 1
|
||||
S 1
|
||||
1 0.0360000 1.0000000
|
||||
|
||||
HELIUM
|
||||
S 3
|
||||
1 0.3842163400E+02 0.4013973935E-01
|
||||
2 0.5778030000E+01 0.2612460970E+00
|
||||
3 0.1241774000E+01 0.7931846246E+00
|
||||
S 1
|
||||
1 0.2979640000E+00 1.0000000
|
||||
S 1
|
||||
1 0.8600000000E-01 0.1000000000E+01
|
||||
|
||||
LITHIUM
|
||||
S 6
|
||||
1 642.4189200 0.0021426
|
||||
|
@ -1,14 +1,27 @@
|
||||
|
||||
HYDROGEN
|
||||
S 3
|
||||
1 18.7311370 0.03349460
|
||||
2 2.8253937 0.23472695
|
||||
3 0.6401217 0.81375733
|
||||
1 0.1873113696E+02 0.3349460434E-01
|
||||
2 0.2825394365E+01 0.2347269535E+00
|
||||
3 0.6401216923E+00 0.8137573261E+00
|
||||
S 1
|
||||
1 0.1612778 1.0000000
|
||||
1 0.1612777588E+00 1.0000000
|
||||
S 1
|
||||
1 0.0360000 1.0000000
|
||||
1 0.3600000000E-01 0.1000000000E+01
|
||||
P 1
|
||||
1 1.1000000 1.0000000
|
||||
1 0.1100000000E+01 1.0000000
|
||||
|
||||
HELIUM
|
||||
S 3
|
||||
1 0.3842163400E+02 0.4013973935E-01
|
||||
2 0.5778030000E+01 0.2612460970E+00
|
||||
3 0.1241774000E+01 0.7931846246E+00
|
||||
S 1
|
||||
1 0.2979640000E+00 1.0000000
|
||||
S 1
|
||||
1 0.8600000000E-01 0.1000000000E+01
|
||||
P 1
|
||||
1 0.1100000000E+01 1.0000000
|
||||
|
||||
LITHIUM
|
||||
S 6
|
||||
|
@ -1,3 +1,19 @@
|
||||
HYDROGEN
|
||||
S 3
|
||||
1 0.1873113696E+02 0.3349460434E-01
|
||||
2 0.2825394365E+01 0.2347269535E+00
|
||||
3 0.6401216923E+00 0.8137573261E+00
|
||||
S 1
|
||||
1 0.1612777588E+00 1.0000000
|
||||
|
||||
HELIUM
|
||||
S 3
|
||||
1 0.3842163400E+02 0.4013973935E-01
|
||||
2 0.5778030000E+01 0.2612460970E+00
|
||||
3 0.1241774000E+01 0.7931846246E+00
|
||||
S 1
|
||||
1 0.2979640000E+00 1.0000000
|
||||
|
||||
LITHIUM
|
||||
S 6
|
||||
1 642.4189200 0.0021426
|
||||
|
@ -14,6 +14,18 @@ P 1
|
||||
P 1
|
||||
1 0.3750000 1.0000000
|
||||
|
||||
HELIUM
|
||||
S 3
|
||||
1 98.12430 0.0287452
|
||||
2 14.76890 0.208061
|
||||
3 3.318830 0.837635
|
||||
S 1
|
||||
1 0.874047 1.000000
|
||||
S 1
|
||||
1 0.244564 1.000000
|
||||
P 1
|
||||
1 0.750 1.000000
|
||||
|
||||
LITHIUM
|
||||
S 6
|
||||
1 900.4600000 0.00228704
|
||||
|
@ -1,3 +1,23 @@
|
||||
HYDROGEN
|
||||
S 3
|
||||
1 33.86500 0.0254938
|
||||
2 5.094790 0.190373
|
||||
3 1.158790 0.852161
|
||||
S 1
|
||||
1 0.325840 1.000000
|
||||
S 1
|
||||
1 0.102741 1.000000
|
||||
|
||||
HELIUM
|
||||
S 3
|
||||
1 98.12430 0.0287452
|
||||
2 14.76890 0.208061
|
||||
3 3.318830 0.837635
|
||||
S 1
|
||||
1 0.874047 1.000000
|
||||
S 1
|
||||
1 0.244564 1.000000
|
||||
|
||||
LITHIUM
|
||||
S 6
|
||||
1 900.4600000 0.00228704
|
||||
|
@ -1,3 +1,23 @@
|
||||
HYDROGEN
|
||||
S 3
|
||||
1 33.86500 0.0254938
|
||||
2 5.094790 0.190373
|
||||
3 1.158790 0.852161
|
||||
S 1
|
||||
1 0.325840 1.000000
|
||||
S 1
|
||||
1 0.102741 1.000000
|
||||
|
||||
HELIUM
|
||||
S 3
|
||||
1 98.12430 0.0287452
|
||||
2 14.76890 0.208061
|
||||
3 3.318830 0.837635
|
||||
S 1
|
||||
1 0.874047 1.000000
|
||||
S 1
|
||||
1 0.244564 1.000000
|
||||
|
||||
LITHIUM
|
||||
S 6
|
||||
1 900.4600000 0.00228704
|
||||
|
@ -1,3 +1,19 @@
|
||||
HYDROGEN
|
||||
S 3
|
||||
1 18.7311370 0.03349460
|
||||
2 2.8253937 0.23472695
|
||||
3 0.6401217 0.81375733
|
||||
S 1
|
||||
1 0.1612778 1.0000000
|
||||
|
||||
HELIUM
|
||||
S 3
|
||||
1 38.4216340 0.0237660
|
||||
2 5.7780300 0.1546790
|
||||
3 1.2417740 0.4696300
|
||||
S 1
|
||||
1 0.2979640 1.0000000
|
||||
|
||||
LITHIUM
|
||||
S 6
|
||||
1 642.4189200 0.0021426
|
||||
|
@ -92,52 +92,58 @@ F 1
|
||||
1 0.0816000 1.0000000
|
||||
|
||||
BERYLLIUM
|
||||
S 9
|
||||
1 6863.0000000 0.0002360
|
||||
2 1030.0000000 0.0018260
|
||||
3 234.7000000 0.0094520
|
||||
4 66.5600000 0.0379570
|
||||
5 21.6900000 0.1199650
|
||||
6 7.7340000 0.2821620
|
||||
7 2.9160000 0.4274040
|
||||
8 1.1300000 0.2662780
|
||||
9 0.1101000 -0.0072750
|
||||
S 9
|
||||
1 6863.0000000 -0.0000430
|
||||
2 1030.0000000 -0.0003330
|
||||
3 234.7000000 -0.0017360
|
||||
4 66.5600000 -0.0070120
|
||||
5 21.6900000 -0.0231260
|
||||
6 7.7340000 -0.0581380
|
||||
7 2.9160000 -0.1145560
|
||||
8 1.1300000 -0.1359080
|
||||
9 0.1101000 0.5774410
|
||||
S 11
|
||||
1 6.863000E+03 2.360000E-04
|
||||
2 1.030000E+03 1.826000E-03
|
||||
3 2.347000E+02 9.452000E-03
|
||||
4 6.656000E+01 3.795700E-02
|
||||
5 2.169000E+01 1.199650E-01
|
||||
6 7.734000E+00 2.821620E-01
|
||||
7 2.916000E+00 4.274040E-01
|
||||
8 1.130000E+00 2.662780E-01
|
||||
9 2.577000E-01 1.819300E-02
|
||||
10 1.101000E-01 -7.275000E-03
|
||||
11 4.409000E-02 1.903000E-03
|
||||
S 11
|
||||
1 6.863000E+03 -4.300000E-05
|
||||
2 1.030000E+03 -3.330000E-04
|
||||
3 2.347000E+02 -1.736000E-03
|
||||
4 6.656000E+01 -7.012000E-03
|
||||
5 2.169000E+01 -2.312600E-02
|
||||
6 7.734000E+00 -5.813800E-02
|
||||
7 2.916000E+00 -1.145560E-01
|
||||
8 1.130000E+00 -1.359080E-01
|
||||
9 2.577000E-01 2.280260E-01
|
||||
10 1.101000E-01 5.774410E-01
|
||||
11 4.409000E-02 3.178730E-01
|
||||
S 1
|
||||
1 0.2577000 1.0000000
|
||||
1 2.577000E-01 1.000000E+00
|
||||
S 1
|
||||
1 0.0440900 1.0000000
|
||||
1 4.409000E-02 1.000000E+00
|
||||
S 1
|
||||
1 0.0150300 1.0000000
|
||||
P 3
|
||||
1 7.4360000 0.0107360
|
||||
2 1.5770000 0.0628540
|
||||
3 0.4352000 0.2481800
|
||||
1 1.470000E-02 1.000000E+00
|
||||
P 5
|
||||
1 7.436000E+00 1.073600E-02
|
||||
2 1.577000E+00 6.285400E-02
|
||||
3 4.352000E-01 2.481800E-01
|
||||
4 1.438000E-01 5.236990E-01
|
||||
5 4.994000E-02 3.534250E-01
|
||||
P 1
|
||||
1 0.1438000 1.0000000
|
||||
1 1.438000E-01 1.000000E+00
|
||||
P 1
|
||||
1 0.0499400 1.0000000
|
||||
1 4.994000E-02 1.000000E+00
|
||||
P 1
|
||||
1 0.0070600 1.0000000
|
||||
1 9.300000E-03 1.000000E+00
|
||||
D 1
|
||||
1 0.3480000 1.0000000
|
||||
1 3.493000E-01 1.000000E+00
|
||||
D 1
|
||||
1 0.1803000 1.0000000
|
||||
1 1.724000E-01 1.000000E+00
|
||||
D 1
|
||||
1 0.0654000 1.0000000
|
||||
1 5.880000E-02 1.000000E+00
|
||||
F 1
|
||||
1 0.3250000 1.0000000
|
||||
1 3.423000E-01 1.0000000
|
||||
F 1
|
||||
1 0.1533000 1.0000000
|
||||
1 1.188000E-01 1.000000E+00
|
||||
|
||||
BORON
|
||||
S 8
|
||||
|
BIN
data/qp2.png
BIN
data/qp2.png
Binary file not shown.
Before Width: | Height: | Size: 5.9 MiB After Width: | Height: | Size: 351 KiB |
BIN
data/qp2_hd.png
Normal file
BIN
data/qp2_hd.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 5.9 MiB |
@ -1,41 +1,92 @@
|
||||
%%% ARXIV TO BE UPDATED %%%
|
||||
@article{Giner2019Jul,
|
||||
author = {Giner, Emmanuel and Scemama, Anthony and Toulouse, Julien and Loos, Pierre-Fran{\c{c}}ois},
|
||||
title = {{Chemically Accurate Excitation Energies With Small Basis Sets}},
|
||||
@article{Loos2020Jan,
|
||||
author = {Loos, Pierre-François and Scemama, Anthony and Jacquemin, Denis},
|
||||
title = {{The Quest For Highly Accurate Excitation Energies: A Computational Perspective}},
|
||||
journal = {arXiv},
|
||||
year = {2020},
|
||||
month = {Jan},
|
||||
eprint = {2001.00416},
|
||||
url = {https://arxiv.org/abs/2001.00416}
|
||||
}
|
||||
|
||||
@article{Loos2019Dec,
|
||||
author = {Loos, Pierre-François and Lipparini, Filippo and Boggio-Pasqua, Martial and Scemama, Anthony and Jacquemin, Denis},
|
||||
title = {{A Mountaineering Strategy to Excited States: Highly-Accurate Energies and Benchmarks for Medium Size Molecules}},
|
||||
journal = {arXiv},
|
||||
year = {2019},
|
||||
month = {Jul},
|
||||
eprint = {1907.01245},
|
||||
url = {https://arxiv.org/abs/1907.01245}
|
||||
month = {Dec},
|
||||
eprint = {1912.04173},
|
||||
url = {https://arxiv.org/abs/1912.04173}
|
||||
}
|
||||
|
||||
|
||||
@article{Burton_2019,
|
||||
doi = {10.1021/acs.jctc.9b00441},
|
||||
url = {https://doi.org/10.1021%2Facs.jctc.9b00441},
|
||||
year = 2019,
|
||||
month = {aug},
|
||||
publisher = {American Chemical Society ({ACS})},
|
||||
author = {Hugh G. A. Burton and Alex J.W. Thom},
|
||||
title = {A General Approach for Multireference Ground and Excited States using Non-Orthogonal Configuration Interaction},
|
||||
journal = {Journal of Chemical Theory and Computation}
|
||||
@article{Loos2019Oct,
|
||||
author = {Loos, Pierre-François and Pradines, Barthélémy and Scemama, Anthony and Giner, Emmanuel and Toulouse, Julien},
|
||||
title = {{A Density-Based Basis-Set Incompleteness Correction for GW Methods}},
|
||||
journal = {arXiv},
|
||||
year = {2019},
|
||||
month = {Oct},
|
||||
eprint = {1910.12238},
|
||||
url = {https://arxiv.org/abs/1910.12238}
|
||||
}
|
||||
|
||||
|
||||
@article{Dash_2019,
|
||||
doi = {10.1021/acs.jctc.9b00476},
|
||||
url = {https://doi.org/10.1021%2Facs.jctc.9b00476},
|
||||
year = 2019,
|
||||
month = {aug},
|
||||
publisher = {American Chemical Society ({ACS})},
|
||||
author = {Monika Dash and Jonas Feldt and Saverio Moroni and Anthony Scemama and Claudia Filippi},
|
||||
title = {Excited States with Selected Configuration Interaction-Quantum Monte Carlo: Chemically Accurate Excitation Energies and Geometries},
|
||||
journal = {Journal of Chemical Theory and Computation}
|
||||
}
|
||||
|
||||
|
||||
|
||||
%%%% PUBLISHED PAPERS
|
||||
@article{Hollett2020Jan,
|
||||
author = {Hollett, Joshua W. and Loos, Pierre-Fran{\c{c}}ois},
|
||||
title = {{Capturing static and dynamic correlation with {$\Delta$}NO-MP2 and {$\Delta$}NO-CCSD}},
|
||||
journal = {J. Chem. Phys.},
|
||||
volume = {152},
|
||||
number = {1},
|
||||
pages = {014101},
|
||||
year = {2020},
|
||||
month = {Jan},
|
||||
issn = {0021-9606},
|
||||
publisher = {American Institute of Physics},
|
||||
doi = {10.1063/1.5140669}
|
||||
}
|
||||
|
||||
@article{Giner2019Oct,
|
||||
author = {Giner, Emmanuel and Scemama, Anthony and Toulouse, Julien and Loos, Pierre-Fran{\c{c}}ois},
|
||||
title = {{Chemically accurate excitation energies with small basis sets}},
|
||||
journal = {J. Chem. Phys.},
|
||||
volume = {151},
|
||||
number = {14},
|
||||
pages = {144118},
|
||||
year = {2019},
|
||||
month = {Oct},
|
||||
issn = {0021-9606},
|
||||
publisher = {American Institute of Physics},
|
||||
doi = {10.1063/1.5122976}
|
||||
}
|
||||
|
||||
|
||||
@article{Burton2019Sep,
|
||||
author = {Burton, Hugh G. A. and Thom, Alex J. W.},
|
||||
title = {{General Approach for Multireference Ground and Excited States Using Nonorthogonal Configuration Interaction}},
|
||||
journal = {J. Chem. Theory Comput.},
|
||||
volume = {15},
|
||||
number = {9},
|
||||
pages = {4851--4861},
|
||||
year = {2019},
|
||||
month = {Sep},
|
||||
issn = {1549-9618},
|
||||
publisher = {American Chemical Society},
|
||||
doi = {10.1021/acs.jctc.9b00441}
|
||||
}
|
||||
|
||||
@article{Dash_2019,
|
||||
author = {Dash, Monika and Feldt, Jonas and Moroni, Saverio and Scemama, Anthony and Filippi, Claudia},
|
||||
title = {{Excited States with Selected Configuration Interaction-Quantum Monte Carlo: Chemically Accurate Excitation Energies and Geometries}},
|
||||
journal = {J. Chem. Theory Comput.},
|
||||
volume = {15},
|
||||
number = {9},
|
||||
pages = {4896--4906},
|
||||
year = {2019},
|
||||
month = {Sep},
|
||||
issn = {1549-9618},
|
||||
publisher = {American Chemical Society},
|
||||
doi = {10.1021/acs.jctc.9b00476}
|
||||
}
|
||||
|
||||
@article{Ferte_2019,
|
||||
doi = {10.1063/1.5082638},
|
||||
url = {https://doi.org/10.1063%2F1.5082638},
|
||||
|
89
docs/source/users_guide/qp_tunnel.rst
Normal file
89
docs/source/users_guide/qp_tunnel.rst
Normal file
@ -0,0 +1,89 @@
|
||||
.. _qp_tunnel:
|
||||
|
||||
=========
|
||||
qp_tunnel
|
||||
=========
|
||||
|
||||
.. TODO
|
||||
|
||||
.. program:: qp_tunnel
|
||||
|
||||
Establishes a tunnel to allow communications between machines within
|
||||
different networks, for example multiple MPI slave jobs running on
|
||||
different clusters.
|
||||
|
||||
|
||||
Usage
|
||||
-----
|
||||
|
||||
.. code:: bash
|
||||
|
||||
qp_tunnel [-g] (ADDRESS|EZFIO_DIR)
|
||||
|
||||
``EZFIO_DIR`` is the name of the |EZFIO| directory containing the data,
|
||||
and ``ADDRESS`` is the address of another tunnel.
|
||||
|
||||
|
||||
.. option:: -h, --help
|
||||
|
||||
Displays the help message
|
||||
|
||||
|
||||
.. option:: -g, --get-input
|
||||
|
||||
Download the EZFIO directory from the remote instance of qp_tunnel.
|
||||
|
||||
|
||||
Example
|
||||
-------
|
||||
|
||||
.. code:: text
|
||||
|
||||
+-------------------+ +------------------+
|
||||
| | | |
|
||||
| N1_1 N1_2 N1_3 | | N2_1 N2_2 N2_3 |
|
||||
| | | | | | | | | |
|
||||
| +----+----+ | | +----+----+ |
|
||||
| | | | | |
|
||||
| C1 F1 | | F2 C2 |
|
||||
| +---------=----=--------+ |
|
||||
| | | |
|
||||
+-------------------+ +------------------+
|
||||
|
||||
|
||||
Imagine you have two clusters, C1 and C2. Each cluster is accessible via SSH
|
||||
on a front-end named respectively F1 and F2. Groups of nodes N1 and N2 have
|
||||
been reserved by the batch scheduling system on both clusters.
|
||||
Each node in N1 is on the same network as the other nodes of N1, but they
|
||||
can't access the network on which the nodes of N2 are.
|
||||
|
||||
1) Start a parallel simulation on the cluster C1, running on nodes N1.
|
||||
We assume that there is a shared file system, such that F1 can access
|
||||
the EZFIO directory. We also assume that F1 can communicate with the
|
||||
nodes of N1.
|
||||
|
||||
2) Run a tunnel on the front-end F1 and keep it running:
|
||||
|
||||
.. code:: bash
|
||||
|
||||
me@f1 $ qp_tunnel my_directory.ezfio
|
||||
Connect to:
|
||||
tcp://31.122.230.47:42379
|
||||
Ready
|
||||
|
||||
3) On the front-end F2, run another instance connecting to the other one,
|
||||
which will fetch the |EZFIO| directory:
|
||||
|
||||
.. code:: bash
|
||||
|
||||
me@f2 $ qp_tunnel --get-input tcp://31.122.230.47:42379
|
||||
Connect to:
|
||||
tcp://31.122.209.139:42379
|
||||
Communication [ OK ]
|
||||
Getting input... my_directory.ezfio ...done
|
||||
Ready
|
||||
|
||||
4) Keep the tunnel running, and you can now run a slave simulation within the
|
||||
nodes N2.
|
||||
|
||||
|
@ -115,7 +115,7 @@ create an |EZFIO| database with the 6-31G basis set:
|
||||
|
||||
.. code:: bash
|
||||
|
||||
qp create_ezfio -b "6-31G" hcn.xyz -o hcn
|
||||
qp create_ezfio -b "6-31g" hcn.xyz -o hcn
|
||||
|
||||
The EZFIO database now contains data relative to the nuclear coordinates
|
||||
and the atomic basis set:
|
||||
|
@ -1,7 +1,7 @@
|
||||
# Configuration of IRPF90 package
|
||||
|
||||
# Set the path of IRPF90 here:
|
||||
export IRPF90_PATH=${QP_ROOT}/external/irpf90-v1.7.5
|
||||
export IRPF90_PATH=${QP_ROOT}/external/irpf90-v1.7.6
|
||||
export PATH=${PATH}:${IRPF90_PATH}/bin
|
||||
|
||||
export IRPF90=${IRPF90_PATH}/bin/irpf90
|
||||
|
BIN
external/EZFIO.1.6.2.tar.gz
vendored
Normal file
BIN
external/EZFIO.1.6.2.tar.gz
vendored
Normal file
Binary file not shown.
139
man/qp_tunnel.1
Normal file
139
man/qp_tunnel.1
Normal file
@ -0,0 +1,139 @@
|
||||
.\" Man page generated from reStructuredText.
|
||||
.
|
||||
.TH "QP_TUNNEL" "1" "Jun 15, 2019" "2.0" "Quantum Package"
|
||||
.SH NAME
|
||||
qp_tunnel \- | Quantum Package >
|
||||
.
|
||||
.nr rst2man-indent-level 0
|
||||
.
|
||||
.de1 rstReportMargin
|
||||
\\$1 \\n[an-margin]
|
||||
level \\n[rst2man-indent-level]
|
||||
level margin: \\n[rst2man-indent\\n[rst2man-indent-level]]
|
||||
-
|
||||
\\n[rst2man-indent0]
|
||||
\\n[rst2man-indent1]
|
||||
\\n[rst2man-indent2]
|
||||
..
|
||||
.de1 INDENT
|
||||
.\" .rstReportMargin pre:
|
||||
. RS \\$1
|
||||
. nr rst2man-indent\\n[rst2man-indent-level] \\n[an-margin]
|
||||
. nr rst2man-indent-level +1
|
||||
.\" .rstReportMargin post:
|
||||
..
|
||||
.de UNINDENT
|
||||
. RE
|
||||
.\" indent \\n[an-margin]
|
||||
.\" old: \\n[rst2man-indent\\n[rst2man-indent-level]]
|
||||
.nr rst2man-indent-level -1
|
||||
.\" new: \\n[rst2man-indent\\n[rst2man-indent-level]]
|
||||
.in \\n[rst2man-indent\\n[rst2man-indent-level]]u
|
||||
..
|
||||
.sp
|
||||
Establishes a tunnel to allow communications between machines within
|
||||
different networks, for example multiple MPI slave jobs running on
|
||||
different clusters.
|
||||
.SH USAGE
|
||||
.INDENT 0.0
|
||||
.INDENT 3.5
|
||||
.sp
|
||||
.nf
|
||||
.ft C
|
||||
qp_tunnel [\-g] (ADDRESS|EZFIO_DIR)
|
||||
.ft P
|
||||
.fi
|
||||
.UNINDENT
|
||||
.UNINDENT
|
||||
.sp
|
||||
\fBEZFIO_DIR\fP is the name of the \fI\%EZFIO\fP directory containing the data,
|
||||
and \fBADDRESS\fP is the address of another tunnel.
|
||||
.INDENT 0.0
|
||||
.TP
|
||||
.B \-h, \-\-help
|
||||
Displays the help message
|
||||
.UNINDENT
|
||||
.INDENT 0.0
|
||||
.TP
|
||||
.B \-g, \-\-get\-input
|
||||
Download the EZFIO directory from the remote instance of qp_tunnel.
|
||||
.UNINDENT
|
||||
.SH EXAMPLE
|
||||
.INDENT 0.0
|
||||
.INDENT 3.5
|
||||
.sp
|
||||
.nf
|
||||
.ft C
|
||||
+\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-+ +\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-+
|
||||
| | | |
|
||||
| N1_1 N1_2 N1_3 | | N2_1 N2_2 N2_3 |
|
||||
| | | | | | | | | |
|
||||
| +\-\-\-\-+\-\-\-\-+ | | +\-\-\-\-+\-\-\-\-+ |
|
||||
| | | | | |
|
||||
| C1 F1 | | F2 C2 |
|
||||
| +\-\-\-\-\-\-\-\-\-=\-\-\-\-=\-\-\-\-\-\-\-\-+ |
|
||||
| | | |
|
||||
+\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-+ +\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-+
|
||||
.ft P
|
||||
.fi
|
||||
.UNINDENT
|
||||
.UNINDENT
|
||||
.sp
|
||||
Imagine you have two clusters, C1 and C2. Each cluster is accessible via SSH
|
||||
on a front\-end named respectively F1 and F2. Groups of nodes N1 and N2 have
|
||||
been reserved by the batch scheduling system on both clusters.
|
||||
Each node in N1 is on the same network as the other nodes of N1, but they
|
||||
can’t access the network on which the nodes of N2 are.
|
||||
.INDENT 0.0
|
||||
.IP 1. 3
|
||||
Start a parallel simulation on the cluster C1, running on nodes N1.
|
||||
We assume that there is a shared file system, such that F1 can access
|
||||
the EZFIO directory. We also assume that F1 can communicate with the
|
||||
nodes of N1.
|
||||
.IP 2. 3
|
||||
Run a tunnel on the front\-end F1 and keep it running:
|
||||
.UNINDENT
|
||||
.INDENT 0.0
|
||||
.INDENT 3.5
|
||||
.sp
|
||||
.nf
|
||||
.ft C
|
||||
me@f1 $ qp_tunnel my_directory.ezfio
|
||||
Connect to:
|
||||
tcp://31.122.230.47:42379
|
||||
Ready
|
||||
.ft P
|
||||
.fi
|
||||
.UNINDENT
|
||||
.UNINDENT
|
||||
.INDENT 0.0
|
||||
.IP 3. 3
|
||||
On the front\-end F2, run another instance connecting to the other one,
|
||||
which will fetch the \fI\%EZFIO\fP directory:
|
||||
.UNINDENT
|
||||
.INDENT 0.0
|
||||
.INDENT 3.5
|
||||
.sp
|
||||
.nf
|
||||
.ft C
|
||||
me@f2 $ qp_tunnel \-\-get\-input tcp://31.122.230.47:42379
|
||||
Connect to:
|
||||
tcp://31.122.209.139:42379
|
||||
Communication [ OK ]
|
||||
Getting input... my_directory.ezfio ...done
|
||||
Ready
|
||||
.ft P
|
||||
.fi
|
||||
.UNINDENT
|
||||
.UNINDENT
|
||||
.INDENT 0.0
|
||||
.IP 4. 3
|
||||
Keep the tunnel running, and you can now run a slave simulation within the
|
||||
nodes N2.
|
||||
.UNINDENT
|
||||
.SH AUTHOR
|
||||
A. Scemama, E. Giner
|
||||
.SH COPYRIGHT
|
||||
2019, A. Scemama, E. Giner
|
||||
.\" Generated by docutils manpage writer.
|
||||
.
|
@ -34,7 +34,7 @@ level margin: \\n[rst2man-indent\\n[rst2man-indent-level]]
|
||||
.INDENT 3.5
|
||||
Rotates molecular orbitals i and j by combining them as
|
||||
$1/sqrt{2} ( phi_i + phi_j )$ and
|
||||
$1/sqrt{2} ( phi_i \- phi_j )$.
|
||||
$1/sqrt{2} ( phi_i - phi_j )$.
|
||||
.sp
|
||||
Needs:
|
||||
.INDENT 0.0
|
||||
|
55
man/test.1
Normal file
55
man/test.1
Normal file
@ -0,0 +1,55 @@
|
||||
.\" Man page generated from reStructuredText.
|
||||
.
|
||||
.TH "TEST" "1" "Jun 15, 2019" "2.0" "Quantum Package"
|
||||
.SH NAME
|
||||
test \- | Quantum Package >
|
||||
.
|
||||
.nr rst2man-indent-level 0
|
||||
.
|
||||
.de1 rstReportMargin
|
||||
\\$1 \\n[an-margin]
|
||||
level \\n[rst2man-indent-level]
|
||||
level margin: \\n[rst2man-indent\\n[rst2man-indent-level]]
|
||||
-
|
||||
\\n[rst2man-indent0]
|
||||
\\n[rst2man-indent1]
|
||||
\\n[rst2man-indent2]
|
||||
..
|
||||
.de1 INDENT
|
||||
.\" .rstReportMargin pre:
|
||||
. RS \\$1
|
||||
. nr rst2man-indent\\n[rst2man-indent-level] \\n[an-margin]
|
||||
. nr rst2man-indent-level +1
|
||||
.\" .rstReportMargin post:
|
||||
..
|
||||
.de UNINDENT
|
||||
. RE
|
||||
.\" indent \\n[an-margin]
|
||||
.\" old: \\n[rst2man-indent\\n[rst2man-indent-level]]
|
||||
.nr rst2man-indent-level -1
|
||||
.\" new: \\n[rst2man-indent\\n[rst2man-indent-level]]
|
||||
.in \\n[rst2man-indent\\n[rst2man-indent-level]]u
|
||||
..
|
||||
.INDENT 0.0
|
||||
.INDENT 3.5
|
||||
Calls:
|
||||
.INDENT 0.0
|
||||
.INDENT 2.0
|
||||
.IP \(bu 2
|
||||
\fBtwo_e_integrals_index()\fP
|
||||
.UNINDENT
|
||||
.INDENT 2.0
|
||||
.IP \(bu 2
|
||||
\fBtwo_e_integrals_index_reverse()\fP
|
||||
.UNINDENT
|
||||
.INDENT 2.0
|
||||
.UNINDENT
|
||||
.UNINDENT
|
||||
.UNINDENT
|
||||
.UNINDENT
|
||||
.SH AUTHOR
|
||||
A. Scemama, E. Giner
|
||||
.SH COPYRIGHT
|
||||
2019, A. Scemama, E. Giner
|
||||
.\" Generated by docutils manpage writer.
|
||||
.
|
@ -1,4 +1,4 @@
|
||||
PKG core ZMQ cryptokit
|
||||
PKG core zmq cryptokit
|
||||
B _build/
|
||||
|
||||
|
||||
|
214
ocaml/Bitlist.ml
214
ocaml/Bitlist.ml
@ -7,82 +7,61 @@ Type for bits strings
|
||||
list of Bits
|
||||
*)
|
||||
|
||||
type t = Bit.t list
|
||||
type t = int64 array
|
||||
|
||||
|
||||
let n_int = Array.length
|
||||
|
||||
(* Create a zero bit list *)
|
||||
let zero n_int =
|
||||
Array.make (N_int_number.to_int n_int) 0L
|
||||
|
||||
(* String representation *)
|
||||
let to_string b =
|
||||
let rec do_work accu = function
|
||||
| [] -> accu
|
||||
| head :: tail ->
|
||||
let new_accu = (Bit.to_string head) ^ accu
|
||||
in do_work new_accu tail
|
||||
let int64_to_string x =
|
||||
String.init 64 (fun i ->
|
||||
if Int64.logand x @@ Int64.shift_left 1L i <> 0L then
|
||||
'+'
|
||||
else
|
||||
'-')
|
||||
in
|
||||
do_work "" b
|
||||
Array.map int64_to_string b
|
||||
|> Array.to_list
|
||||
|> String.concat ""
|
||||
|
||||
|
||||
let of_string ?(zero='0') ?(one='1') s =
|
||||
List.init (String.length s) (String.get s)
|
||||
|> List.rev_map ( fun c ->
|
||||
if (c = zero) then Bit.Zero
|
||||
else if (c = one) then Bit.One
|
||||
else (failwith ("Error in bitstring ") ) )
|
||||
let n_int = ( (String.length s - 1) lsr 6 ) + 1 in
|
||||
let result = Array.make n_int 0L in
|
||||
String.iteri (fun i c ->
|
||||
if c = one then
|
||||
begin
|
||||
let iint = i lsr 6 in (* i / 64 *)
|
||||
let k = i - (iint lsl 6) in
|
||||
result.(iint) <- Int64.logor result.(iint) @@ Int64.shift_left 1L k;
|
||||
end) s;
|
||||
result
|
||||
|
||||
let of_string_mp s =
|
||||
List.init (String.length s) (String.get s)
|
||||
|> List.rev_map (function
|
||||
| '-' -> Bit.Zero
|
||||
| '+' -> Bit.One
|
||||
| _ -> failwith ("Error in bitstring ") )
|
||||
let of_string_mp = of_string ~zero:'-' ~one:'+'
|
||||
|
||||
|
||||
(* Create a bit list from an int64 *)
|
||||
let of_int64 i =
|
||||
|
||||
let rec do_work accu = function
|
||||
| 0L -> Bit.Zero :: accu |> List.rev
|
||||
| 1L -> Bit.One :: accu |> List.rev
|
||||
| i ->
|
||||
let b =
|
||||
match (Int64.logand i 1L ) with
|
||||
| 0L -> Bit.Zero
|
||||
| 1L -> Bit.One
|
||||
| _ -> raise (Failure "i land 1 not in (0,1)")
|
||||
in
|
||||
do_work (b :: accu) (Int64.shift_right_logical i 1)
|
||||
in
|
||||
|
||||
let adjust_length result =
|
||||
let rec do_work accu = function
|
||||
| 64 -> List.rev accu
|
||||
| i when i>64 -> raise (Failure "Error in of_int64 > 64")
|
||||
| i when i<0 -> raise (Failure "Error in of_int64 < 0")
|
||||
| i -> do_work (Bit.Zero :: accu) (i+1)
|
||||
in
|
||||
do_work (List.rev result) (List.length result)
|
||||
in
|
||||
adjust_length (do_work [] i)
|
||||
|
||||
let of_int64 i = [| i |]
|
||||
|
||||
(* Create an int64 from a bit list *)
|
||||
let to_int64 l =
|
||||
assert ( (List.length l) <= 64) ;
|
||||
let rec do_work accu = function
|
||||
| [] -> accu
|
||||
| Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail
|
||||
| Bit.One::tail -> do_work Int64.(logor one (shift_left accu 1)) tail
|
||||
in do_work Int64.zero (List.rev l)
|
||||
let to_int64 = function
|
||||
| [| i |] -> i
|
||||
| _ -> failwith "N_int > 1"
|
||||
|
||||
|
||||
(* Create a bit list from a list of int64 *)
|
||||
let of_int64_list l =
|
||||
List.map of_int64 l
|
||||
|> List.concat
|
||||
|
||||
(* Create a bit list from an array of int64 *)
|
||||
let of_int64_array l =
|
||||
Array.map of_int64 l
|
||||
|> Array.to_list
|
||||
|> List.concat
|
||||
external of_int64_array : int64 array -> t = "%identity"
|
||||
external to_int64_array : t -> int64 array = "%identity"
|
||||
|
||||
|
||||
(* Create a bit list from a list of int64 *)
|
||||
let of_int64_list l =
|
||||
Array.of_list l |> of_int64_array
|
||||
|
||||
|
||||
(* Compute n_int *)
|
||||
@ -91,101 +70,64 @@ let n_int_of_mo_num mo_num =
|
||||
N_int_number.of_int ( (mo_num-1)/bit_kind_size + 1 )
|
||||
|
||||
|
||||
(* Create a zero bit list *)
|
||||
let zero n_int =
|
||||
let n_int = N_int_number.to_int n_int in
|
||||
let a = Array.init n_int (fun i-> 0L) in
|
||||
of_int64_list ( Array.to_list a )
|
||||
|
||||
|
||||
(* Create an int64 list from a bit list *)
|
||||
let to_int64_list l =
|
||||
let rec do_work accu buf counter = function
|
||||
| [] ->
|
||||
begin
|
||||
match buf with
|
||||
| [] -> accu
|
||||
| _ -> (List.rev buf)::accu
|
||||
end
|
||||
| i::tail ->
|
||||
if (counter < 64) then
|
||||
do_work accu (i::buf) (counter+1) tail
|
||||
else
|
||||
do_work ( (List.rev (i::buf))::accu) [] 1 tail
|
||||
in
|
||||
let l = do_work [] [] 1 l
|
||||
in
|
||||
List.rev_map to_int64 l
|
||||
to_int64_array l |> Array.to_list
|
||||
|
||||
(* Create an array of int64 from a bit list *)
|
||||
let to_int64_array l =
|
||||
to_int64_list l
|
||||
|> Array.of_list
|
||||
|
||||
(* Create a bit list from a list of MO indices *)
|
||||
let of_mo_number_list n_int l =
|
||||
let n_int = N_int_number.to_int n_int in
|
||||
let length = n_int*64 in
|
||||
let a = Array.make length (Bit.Zero) in
|
||||
List.iter (fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l;
|
||||
Array.to_list a
|
||||
let result = zero n_int in
|
||||
List.iter (fun j ->
|
||||
let i = (MO_number.to_int j) - 1 in
|
||||
let iint = i lsr 6 in (* i / 64 *)
|
||||
let k = i - (iint lsl 6) in
|
||||
result.(iint) <- Int64.logor result.(iint) @@ Int64.shift_left 1L k;
|
||||
) l;
|
||||
result
|
||||
|
||||
|
||||
let to_mo_number_list l =
|
||||
let a = Array.of_list l in
|
||||
let mo_num = MO_number.get_max () in
|
||||
let rec do_work accu = function
|
||||
| 0 -> accu
|
||||
| i ->
|
||||
begin
|
||||
let new_accu =
|
||||
match a.(i-1) with
|
||||
| Bit.One -> (MO_number.of_int ~max:mo_num i)::accu
|
||||
| Bit.Zero -> accu
|
||||
in
|
||||
do_work new_accu (i-1)
|
||||
end
|
||||
let rec aux_one x shift accu = function
|
||||
| -1 -> accu
|
||||
| i -> if Int64.logand x (Int64.shift_left 1L i) <> 0L then
|
||||
aux_one x shift ( (i+shift) ::accu) (i-1)
|
||||
else
|
||||
aux_one x shift accu (i-1)
|
||||
in
|
||||
do_work [] (List.length l)
|
||||
|
||||
Array.mapi (fun i x ->
|
||||
let shift = (i lsr 6) lsl 6 + 1 in
|
||||
aux_one x shift [] 63
|
||||
) l
|
||||
|> Array.to_list
|
||||
|> List.concat
|
||||
|> List.map MO_number.of_int
|
||||
|
||||
|
||||
|
||||
(* logical operations on bit_list *)
|
||||
let logical_operator2 op a b =
|
||||
let rec do_work_binary result a b =
|
||||
match a, b with
|
||||
| [], [] -> result
|
||||
| [], _ | _ , [] -> raise (Failure "Lists should have same length")
|
||||
| (ha::ta), (hb::tb) ->
|
||||
let newbit = op ha hb
|
||||
in do_work_binary (newbit::result) ta tb
|
||||
let and_operator a b = Array.map2 Int64.logand a b
|
||||
let xor_operator a b = Array.map2 Int64.logxor a b
|
||||
let or_operator a b = Array.map2 Int64.logor a b
|
||||
let not_operator b = Array.map Int64.lognot b
|
||||
|
||||
|
||||
|
||||
let pop_sign =
|
||||
let mask =
|
||||
(Int64.pred (Int64.shift_left 1L 63))
|
||||
in
|
||||
List.rev (do_work_binary [] a b)
|
||||
|
||||
|
||||
let logical_operator1 op b =
|
||||
let rec do_work_unary result b =
|
||||
match b with
|
||||
| [] -> result
|
||||
| (hb::tb) ->
|
||||
let newbit = op hb
|
||||
in do_work_unary (newbit::result) tb
|
||||
in
|
||||
List.rev (do_work_unary [] b)
|
||||
|
||||
|
||||
let and_operator a b = logical_operator2 Bit.and_operator a b
|
||||
let xor_operator a b = logical_operator2 Bit.xor_operator a b
|
||||
let or_operator a b = logical_operator2 Bit.or_operator a b
|
||||
let not_operator b = logical_operator1 Bit.not_operator b
|
||||
fun x -> Int64.logand mask x
|
||||
|
||||
|
||||
let popcnt b =
|
||||
List.fold_left (fun accu -> function
|
||||
| Bit.One -> accu+1
|
||||
| Bit.Zero -> accu
|
||||
) 0 b
|
||||
Array.fold_left (fun accu x ->
|
||||
if x >= 0L then
|
||||
accu + (Z.popcount @@ Z.of_int64 x)
|
||||
else
|
||||
accu + 1 + (Z.popcount @@ Z.of_int64 (pop_sign x))
|
||||
) 0 b
|
||||
|
||||
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
type t = Bit.t list
|
||||
type t
|
||||
|
||||
(** The zero bit list *)
|
||||
val zero : Qptypes.N_int_number.t -> t
|
||||
|
@ -25,19 +25,6 @@ let to_bitlist_couple x =
|
||||
in (xa,xb)
|
||||
|
||||
|
||||
let bitlist_to_string ~mo_num x =
|
||||
let len =
|
||||
MO_number.to_int mo_num
|
||||
in
|
||||
let s =
|
||||
List.map (function
|
||||
| Bit.Zero -> "-"
|
||||
| Bit.One -> "+"
|
||||
) x
|
||||
|> String.concat ""
|
||||
in
|
||||
String.sub s 0 len
|
||||
|
||||
|
||||
|
||||
let of_int64_array ~n_int ~alpha ~beta x =
|
||||
@ -48,37 +35,29 @@ let of_int64_array ~n_int ~alpha ~beta x =
|
||||
in
|
||||
if ( (Bitlist.popcnt a) <> alpha) then
|
||||
begin
|
||||
let mo_num = MO_number.get_max () in
|
||||
let mo_num = MO_number.of_int mo_num ~max:mo_num in
|
||||
failwith (Printf.sprintf "Expected %d electrons in alpha determinant
|
||||
%s" alpha (bitlist_to_string ~mo_num:mo_num a) )
|
||||
%s" alpha (Bitlist.to_string a) )
|
||||
end;
|
||||
if ( (Bitlist.popcnt b) <> beta ) then
|
||||
begin
|
||||
let mo_num = MO_number.get_max () in
|
||||
let mo_num = MO_number.of_int mo_num ~max:mo_num in
|
||||
failwith (Printf.sprintf "Expected %d electrons in beta determinant
|
||||
%s" beta (bitlist_to_string ~mo_num:mo_num b) )
|
||||
%s" beta (Bitlist.to_string b) )
|
||||
end;
|
||||
x
|
||||
|
||||
|
||||
let of_bitlist_couple ?n_int ~alpha ~beta (xa,xb) =
|
||||
let of_bitlist_couple ~n_int ~alpha ~beta (xa,xb) =
|
||||
let ba, bb =
|
||||
Bitlist.to_int64_array xa ,
|
||||
Bitlist.to_int64_array xb
|
||||
and n_int =
|
||||
match n_int with
|
||||
| Some x -> x
|
||||
| None -> Bitlist.n_int_of_mo_num (List.length xa)
|
||||
in
|
||||
of_int64_array ~n_int ~alpha ~beta (Array.concat [ba;bb])
|
||||
|
||||
|
||||
let to_string ~mo_num x =
|
||||
let (xa,xb) = to_bitlist_couple x in
|
||||
[ " " ; bitlist_to_string ~mo_num xa ; "\n" ;
|
||||
" " ; bitlist_to_string ~mo_num xb ]
|
||||
[ " " ; Bitlist.to_string xa ; "\n" ;
|
||||
" " ; Bitlist.to_string xb ]
|
||||
|> String.concat ""
|
||||
|
||||
|
||||
|
@ -24,7 +24,7 @@ val to_alpha_beta : t -> (int64 array)*(int64 array)
|
||||
val to_bitlist_couple : t -> Bitlist.t * Bitlist.t
|
||||
|
||||
(** Create from a bit list *)
|
||||
val of_bitlist_couple : ?n_int:Qptypes.N_int_number.t ->
|
||||
val of_bitlist_couple : n_int:Qptypes.N_int_number.t ->
|
||||
alpha:Qptypes.Elec_alpha_number.t ->
|
||||
beta:Qptypes.Elec_beta_number.t ->
|
||||
Bitlist.t * Bitlist.t -> t
|
||||
|
@ -6,10 +6,6 @@ module Bitmasks : sig
|
||||
type t =
|
||||
{ n_int : N_int_number.t;
|
||||
bit_kind : Bit_kind.t;
|
||||
n_mask_gen : Bitmask_number.t;
|
||||
generators : int64 array;
|
||||
n_mask_cas : Bitmask_number.t;
|
||||
cas : int64 array;
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
val read : unit -> t option
|
||||
@ -18,12 +14,7 @@ end = struct
|
||||
type t =
|
||||
{ n_int : N_int_number.t;
|
||||
bit_kind : Bit_kind.t;
|
||||
n_mask_gen : Bitmask_number.t;
|
||||
generators : int64 array;
|
||||
n_mask_cas : Bitmask_number.t;
|
||||
cas : int64 array;
|
||||
} [@@deriving sexp]
|
||||
;;
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "bitmasks";;
|
||||
|
||||
@ -36,7 +27,6 @@ end = struct
|
||||
;
|
||||
Ezfio.get_bitmasks_n_int ()
|
||||
|> N_int_number.of_int
|
||||
;;
|
||||
|
||||
let read_bit_kind () =
|
||||
if not (Ezfio.has_bitmasks_bit_kind ()) then
|
||||
@ -46,89 +36,12 @@ end = struct
|
||||
;
|
||||
Ezfio.get_bitmasks_bit_kind ()
|
||||
|> Bit_kind.of_int
|
||||
;;
|
||||
|
||||
let read_n_mask_gen () =
|
||||
if not (Ezfio.has_bitmasks_n_mask_gen ()) then
|
||||
Ezfio.set_bitmasks_n_mask_gen 1
|
||||
;
|
||||
Ezfio.get_bitmasks_n_mask_gen ()
|
||||
|> Bitmask_number.of_int
|
||||
;;
|
||||
|
||||
|
||||
let full_mask n_int =
|
||||
let range = "[1-"^
|
||||
(string_of_int (Ezfio.get_mo_basis_mo_num ()))^"]"
|
||||
in
|
||||
MO_class.create_active range
|
||||
|> MO_class.to_bitlist n_int
|
||||
;;
|
||||
|
||||
let read_generators () =
|
||||
if not (Ezfio.has_bitmasks_generators ()) then
|
||||
begin
|
||||
let n_int =
|
||||
read_n_int ()
|
||||
in
|
||||
let act =
|
||||
full_mask n_int
|
||||
in
|
||||
let result = [ act ; act ; act ; act ; act ; act ]
|
||||
|> List.map (fun x ->
|
||||
let y = Bitlist.to_int64_list x in y@y )
|
||||
|> List.concat
|
||||
in
|
||||
let generators = Ezfio.ezfio_array_of_list ~rank:4
|
||||
~dim:([| (N_int_number.to_int n_int) ; 2; 6; 1|]) ~data:result
|
||||
in
|
||||
Ezfio.set_bitmasks_generators generators
|
||||
end;
|
||||
Ezfio.get_bitmasks_generators ()
|
||||
|> Ezfio.flattened_ezfio
|
||||
;;
|
||||
|
||||
let read_n_mask_cas () =
|
||||
if not (Ezfio.has_bitmasks_n_mask_cas ()) then
|
||||
Ezfio.set_bitmasks_n_mask_cas 1
|
||||
;
|
||||
Ezfio.get_bitmasks_n_mask_cas ()
|
||||
|> Bitmask_number.of_int
|
||||
;;
|
||||
|
||||
|
||||
let read_cas () =
|
||||
if not (Ezfio.has_bitmasks_cas ()) then
|
||||
begin
|
||||
let n_int =
|
||||
read_n_int ()
|
||||
in
|
||||
let act =
|
||||
full_mask n_int
|
||||
in
|
||||
let result = [ act ; act ]
|
||||
|> List.map (fun x ->
|
||||
let y = Bitlist.to_int64_list x in y@y )
|
||||
|> List.concat
|
||||
in
|
||||
let cas = Ezfio.ezfio_array_of_list ~rank:3
|
||||
~dim:([| (N_int_number.to_int n_int) ; 2; 1|]) ~data:result
|
||||
in
|
||||
Ezfio.set_bitmasks_cas cas
|
||||
end;
|
||||
Ezfio.get_bitmasks_cas ()
|
||||
|> Ezfio.flattened_ezfio
|
||||
;;
|
||||
|
||||
let read () =
|
||||
if (Ezfio.has_mo_basis_mo_num ()) then
|
||||
Some
|
||||
{ n_int = read_n_int ();
|
||||
bit_kind = read_bit_kind ();
|
||||
n_mask_gen = read_n_mask_gen ();
|
||||
generators = read_generators ();
|
||||
n_mask_cas = read_n_mask_cas ();
|
||||
cas = read_cas ();
|
||||
}
|
||||
else
|
||||
None
|
||||
@ -138,21 +51,9 @@ end = struct
|
||||
Printf.sprintf "
|
||||
n_int = %s
|
||||
bit_kind = %s
|
||||
n_mask_gen = %s
|
||||
generators = %s
|
||||
n_mask_cas = %s
|
||||
cas = %s
|
||||
"
|
||||
(N_int_number.to_string b.n_int)
|
||||
(Bit_kind.to_string b.bit_kind)
|
||||
(Bitmask_number.to_string b.n_mask_gen)
|
||||
(Array.to_list b.generators
|
||||
|> List.map (fun x-> Int64.to_string x)
|
||||
|> String.concat ", ")
|
||||
(Bitmask_number.to_string b.n_mask_cas)
|
||||
(Array.to_list b.cas
|
||||
|> List.map (fun x-> Int64.to_string x)
|
||||
|> String.concat ", ")
|
||||
end
|
||||
|
||||
|
||||
|
@ -7,15 +7,15 @@ module Determinants_by_hand : sig
|
||||
{ n_int : N_int_number.t;
|
||||
bit_kind : Bit_kind.t;
|
||||
n_det : Det_number.t;
|
||||
n_det_qp_edit : Det_number.t;
|
||||
n_states : States_number.t;
|
||||
expected_s2 : Positive_float.t;
|
||||
psi_coef : Det_coef.t array;
|
||||
psi_det : Determinant.t array;
|
||||
state_average_weight : Positive_float.t array;
|
||||
} [@@deriving sexp]
|
||||
val read : unit -> t
|
||||
val read_maybe : unit -> t option
|
||||
val write : t -> unit
|
||||
val read : ?full:bool -> unit -> t option
|
||||
val write : ?force:bool -> t -> unit
|
||||
val to_string : t -> string
|
||||
val to_rst : t -> Rst_string.t
|
||||
val of_rst : Rst_string.t -> t option
|
||||
@ -28,6 +28,7 @@ end = struct
|
||||
{ n_int : N_int_number.t;
|
||||
bit_kind : Bit_kind.t;
|
||||
n_det : Det_number.t;
|
||||
n_det_qp_edit : Det_number.t;
|
||||
n_states : States_number.t;
|
||||
expected_s2 : Positive_float.t;
|
||||
psi_coef : Det_coef.t array;
|
||||
@ -38,8 +39,6 @@ end = struct
|
||||
|
||||
let get_default = Qpackage.get_ezfio_default "determinants";;
|
||||
|
||||
let n_det_read_max = 10_000 ;;
|
||||
|
||||
let read_n_int () =
|
||||
if not (Ezfio.has_determinants_n_int()) then
|
||||
Ezfio.get_mo_basis_mo_num ()
|
||||
@ -80,11 +79,27 @@ end = struct
|
||||
|> Det_number.of_int
|
||||
;;
|
||||
|
||||
let read_n_det_qp_edit () =
|
||||
if not (Ezfio.has_determinants_n_det_qp_edit ()) then
|
||||
begin
|
||||
let n_det = read_n_det () |> Det_number.to_int in
|
||||
Ezfio.set_determinants_n_det_qp_edit n_det
|
||||
end;
|
||||
Ezfio.get_determinants_n_det_qp_edit ()
|
||||
|> Det_number.of_int
|
||||
;;
|
||||
|
||||
let write_n_det n =
|
||||
Det_number.to_int n
|
||||
|> Ezfio.set_determinants_n_det
|
||||
;;
|
||||
|
||||
let write_n_det_qp_edit n =
|
||||
let n_det = read_n_det () |> Det_number.to_int in
|
||||
min n_det (Det_number.to_int n)
|
||||
|> Ezfio.set_determinants_n_det_qp_edit
|
||||
;;
|
||||
|
||||
let read_n_states () =
|
||||
if not (Ezfio.has_determinants_n_states ()) then
|
||||
Ezfio.set_determinants_n_states 1
|
||||
@ -178,7 +193,7 @@ end = struct
|
||||
|> Ezfio.set_determinants_expected_s2
|
||||
;;
|
||||
|
||||
let read_psi_coef () =
|
||||
let read_psi_coef ~read_only () =
|
||||
if not (Ezfio.has_determinants_psi_coef ()) then
|
||||
begin
|
||||
let n_states =
|
||||
@ -189,7 +204,12 @@ end = struct
|
||||
~data:(List.init n_states (fun i -> if (i=0) then 1. else 0. ))
|
||||
|> Ezfio.set_determinants_psi_coef
|
||||
end;
|
||||
Ezfio.get_determinants_psi_coef ()
|
||||
begin
|
||||
if read_only then
|
||||
Ezfio.get_determinants_psi_coef_qp_edit ()
|
||||
else
|
||||
Ezfio.get_determinants_psi_coef ()
|
||||
end
|
||||
|> Ezfio.flattened_ezfio
|
||||
|> Array.map Det_coef.of_float
|
||||
;;
|
||||
@ -202,12 +222,15 @@ end = struct
|
||||
and n_states =
|
||||
States_number.to_int n_states
|
||||
in
|
||||
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c
|
||||
|> Ezfio.set_determinants_psi_coef
|
||||
let r =
|
||||
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c
|
||||
in
|
||||
Ezfio.set_determinants_psi_coef r;
|
||||
Ezfio.set_determinants_psi_coef_qp_edit r
|
||||
;;
|
||||
|
||||
|
||||
let read_psi_det () =
|
||||
let read_psi_det ~read_only () =
|
||||
let n_int = read_n_int ()
|
||||
and n_alpha = Ezfio.get_electrons_elec_alpha_num ()
|
||||
|> Elec_alpha_number.of_int
|
||||
@ -233,13 +256,21 @@ end = struct
|
||||
|> Ezfio.set_determinants_psi_det ;
|
||||
end ;
|
||||
let n_int = N_int_number.to_int n_int in
|
||||
let psi_det_array = Ezfio.get_determinants_psi_det () in
|
||||
let psi_det_array =
|
||||
if read_only then
|
||||
Ezfio.get_determinants_psi_det_qp_edit ()
|
||||
else
|
||||
Ezfio.get_determinants_psi_det ()
|
||||
in
|
||||
let dim = psi_det_array.Ezfio.dim
|
||||
and data = Ezfio.flattened_ezfio psi_det_array
|
||||
in
|
||||
assert (n_int = dim.(0));
|
||||
assert (dim.(1) = 2);
|
||||
assert (dim.(2) = (Det_number.to_int (read_n_det ())));
|
||||
if read_only then
|
||||
assert (dim.(2) = (Det_number.to_int (read_n_det_qp_edit ())))
|
||||
else
|
||||
assert (dim.(2) = (Det_number.to_int (read_n_det ())));
|
||||
Array.init dim.(2) (fun i ->
|
||||
Array.sub data (2*n_int*i) (2*n_int) )
|
||||
|> Array.map (Determinant.of_int64_array
|
||||
@ -252,54 +283,64 @@ end = struct
|
||||
|> Array.concat
|
||||
|> Array.to_list
|
||||
in
|
||||
Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; Det_number.to_int n_det |] ~data:data
|
||||
|> Ezfio.set_determinants_psi_det
|
||||
let r =
|
||||
Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; Det_number.to_int n_det |] ~data:data
|
||||
in
|
||||
Ezfio.set_determinants_psi_det r;
|
||||
Ezfio.set_determinants_psi_det_qp_edit r
|
||||
;;
|
||||
|
||||
|
||||
let read () =
|
||||
let read ?(full=true) () =
|
||||
|
||||
let n_det_qp_edit = read_n_det_qp_edit () in
|
||||
let n_det = read_n_det () in
|
||||
let read_only =
|
||||
if full then false else n_det_qp_edit <> n_det
|
||||
in
|
||||
|
||||
if (Ezfio.has_mo_basis_mo_num ()) then
|
||||
try
|
||||
Some
|
||||
{ n_int = read_n_int () ;
|
||||
bit_kind = read_bit_kind () ;
|
||||
n_det = read_n_det () ;
|
||||
n_det_qp_edit = read_n_det_qp_edit () ;
|
||||
expected_s2 = read_expected_s2 () ;
|
||||
psi_coef = read_psi_coef () ;
|
||||
psi_det = read_psi_det () ;
|
||||
psi_coef = read_psi_coef ~read_only () ;
|
||||
psi_det = read_psi_det ~read_only () ;
|
||||
n_states = read_n_states () ;
|
||||
state_average_weight = read_state_average_weight () ;
|
||||
}
|
||||
with _ -> None
|
||||
else
|
||||
failwith "No molecular orbitals, so no determinants"
|
||||
;;
|
||||
|
||||
let read_maybe () =
|
||||
let n_det =
|
||||
read_n_det ()
|
||||
in
|
||||
if ( (Det_number.to_int n_det) < n_det_read_max ) then
|
||||
try Some (read ()) with
|
||||
| Failure _ -> None
|
||||
else
|
||||
(* No molecular orbitals, so no determinants *)
|
||||
None
|
||||
;;
|
||||
|
||||
let write { n_int ;
|
||||
bit_kind ;
|
||||
n_det ;
|
||||
expected_s2 ;
|
||||
psi_coef ;
|
||||
psi_det ;
|
||||
n_states ;
|
||||
state_average_weight ;
|
||||
} =
|
||||
let write ?(force=false)
|
||||
{ n_int ;
|
||||
bit_kind ;
|
||||
n_det ;
|
||||
n_det_qp_edit ;
|
||||
expected_s2 ;
|
||||
psi_coef ;
|
||||
psi_det ;
|
||||
n_states ;
|
||||
state_average_weight ;
|
||||
} =
|
||||
write_n_int n_int ;
|
||||
write_bit_kind bit_kind;
|
||||
write_n_det n_det;
|
||||
write_n_states n_states;
|
||||
write_expected_s2 expected_s2;
|
||||
write_psi_coef ~n_det:n_det ~n_states:n_states psi_coef ;
|
||||
write_psi_det ~n_int:n_int ~n_det:n_det psi_det;
|
||||
write_state_average_weight state_average_weight;
|
||||
if force || (n_det <= n_det_qp_edit) then
|
||||
begin
|
||||
write_n_det_qp_edit n_det;
|
||||
write_psi_coef ~n_det:n_det ~n_states:n_states psi_coef ;
|
||||
write_psi_det ~n_int:n_int ~n_det:n_det psi_det
|
||||
end;
|
||||
write_state_average_weight state_average_weight
|
||||
;;
|
||||
|
||||
|
||||
@ -316,11 +357,13 @@ end = struct
|
||||
|> States_number.to_int
|
||||
and ndet =
|
||||
Det_number.to_int b.n_det
|
||||
and ndet_qp_edit =
|
||||
Det_number.to_int b.n_det_qp_edit
|
||||
in
|
||||
let coefs_string i =
|
||||
Array.init nstates (fun j ->
|
||||
let ishift =
|
||||
j*ndet
|
||||
j*ndet_qp_edit
|
||||
in
|
||||
if (ishift < Array.length b.psi_coef) then
|
||||
b.psi_coef.(i+ishift)
|
||||
@ -331,7 +374,7 @@ end = struct
|
||||
)
|
||||
|> Array.to_list |> String.concat "\t"
|
||||
in
|
||||
Array.init ndet (fun i ->
|
||||
Array.init ndet_qp_edit (fun i ->
|
||||
Printf.sprintf " %s\n%s\n"
|
||||
(coefs_string i)
|
||||
(Determinant.to_string ~mo_num:mo_num b.psi_det.(i)
|
||||
@ -472,6 +515,7 @@ psi_det = %s
|
||||
|
||||
(* Handle determinants *)
|
||||
let psi_det =
|
||||
let n_int = N_int_number.of_int @@ (MO_number.get_max () - 1) / 64 + 1 in
|
||||
let n_alpha = Ezfio.get_electrons_elec_alpha_num ()
|
||||
|> Elec_alpha_number.of_int
|
||||
and n_beta = Ezfio.get_electrons_elec_beta_num ()
|
||||
@ -483,8 +527,8 @@ psi_det = %s
|
||||
begin
|
||||
let newdet =
|
||||
(Bitlist.of_string ~zero:'-' ~one:'+' alpha ,
|
||||
Bitlist.of_string ~zero:'-' ~one:'+' beta)
|
||||
|> Determinant.of_bitlist_couple ~alpha:n_alpha ~beta:n_beta
|
||||
Bitlist.of_string ~zero:'-' ~one:'+' beta)
|
||||
|> Determinant.of_bitlist_couple ~n_int ~alpha:n_alpha ~beta:n_beta
|
||||
|> Determinant.sexp_of_t
|
||||
|> Sexplib.Sexp.to_string
|
||||
in
|
||||
@ -492,9 +536,6 @@ psi_det = %s
|
||||
end
|
||||
| _::tail -> read_dets accu tail
|
||||
in
|
||||
let dets =
|
||||
List.map String_ext.rev dets
|
||||
in
|
||||
let a =
|
||||
read_dets [] dets
|
||||
|> String.concat ""
|
||||
@ -510,9 +551,11 @@ psi_det = %s
|
||||
Printf.sprintf "(n_int %d)" (N_int_number.get_max ())
|
||||
and n_states =
|
||||
Printf.sprintf "(n_states %d)" (States_number.to_int @@ read_n_states ())
|
||||
and n_det_qp_edit =
|
||||
Printf.sprintf "(n_det_qp_edit %d)" (Det_number.to_int @@ read_n_det_qp_edit ())
|
||||
in
|
||||
let s =
|
||||
String.concat "" [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det]
|
||||
String.concat "" [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ]
|
||||
in
|
||||
|
||||
|
||||
@ -527,7 +570,9 @@ psi_det = %s
|
||||
Det_number.to_int n_det_new
|
||||
in
|
||||
let det =
|
||||
read ()
|
||||
match read () with
|
||||
| Some x -> x
|
||||
| None -> failwith "No determinants in file"
|
||||
in
|
||||
let n_det_old, n_states =
|
||||
Det_number.to_int det.n_det,
|
||||
@ -552,13 +597,15 @@ psi_det = %s
|
||||
let new_det =
|
||||
{ det with n_det = (Det_number.of_int n_det_new) }
|
||||
in
|
||||
write new_det
|
||||
write ~force:true new_det
|
||||
;;
|
||||
|
||||
let extract_state istate =
|
||||
Printf.printf "Extracting state %d\n" (States_number.to_int istate);
|
||||
let det =
|
||||
read ()
|
||||
match read () with
|
||||
| Some x -> x
|
||||
| None -> failwith "No determinants in file"
|
||||
in
|
||||
let n_det, n_states =
|
||||
Det_number.to_int det.n_det,
|
||||
@ -582,13 +629,15 @@ psi_det = %s
|
||||
let new_det =
|
||||
{ det with n_states = (States_number.of_int 1) }
|
||||
in
|
||||
write new_det
|
||||
write ~force:true new_det
|
||||
;;
|
||||
|
||||
let extract_states range =
|
||||
Printf.printf "Extracting states %s\n" (Range.to_string range);
|
||||
let det =
|
||||
read ()
|
||||
match read () with
|
||||
| Some x -> x
|
||||
| None -> failwith "No determinants in file"
|
||||
in
|
||||
let n_det, n_states =
|
||||
Det_number.to_int det.n_det,
|
||||
@ -614,8 +663,10 @@ psi_det = %s
|
||||
j*n_det
|
||||
in
|
||||
for i=0 to (n_det-1) do
|
||||
det.psi_coef.(!state_shift+i) <- det.psi_coef.(i+ishift)
|
||||
det.psi_coef.(!state_shift+i) <-
|
||||
det.psi_coef.(i+ishift)
|
||||
done
|
||||
; Printf.printf "OK\n%!" ;
|
||||
end;
|
||||
state_shift := !state_shift + n_det
|
||||
) sorted_list
|
||||
@ -623,7 +674,7 @@ psi_det = %s
|
||||
let new_det =
|
||||
{ det with n_states = (States_number.of_int @@ List.length sorted_list) }
|
||||
in
|
||||
write new_det
|
||||
write ~force:true new_det
|
||||
;;
|
||||
|
||||
end
|
||||
|
@ -65,8 +65,15 @@ end = struct
|
||||
|
||||
|
||||
let read_mo_num () =
|
||||
Ezfio.get_mo_basis_mo_num ()
|
||||
|> MO_number.of_int
|
||||
let elec_alpha_num =
|
||||
Ezfio.get_electrons_elec_alpha_num ()
|
||||
in
|
||||
let result =
|
||||
Ezfio.get_mo_basis_mo_num ()
|
||||
in
|
||||
if result < elec_alpha_num then
|
||||
failwith "More alpha electrons than MOs";
|
||||
MO_number.of_int result
|
||||
|
||||
|
||||
let read_mo_class () =
|
||||
|
@ -175,7 +175,7 @@ nucl_coord = %s
|
||||
nucl_num
|
||||
) :: (
|
||||
List.init nucl_num (fun i->
|
||||
Printf.sprintf " %-3s %d %s"
|
||||
Printf.sprintf " %-3s %3d %s"
|
||||
(b.nucl_label.(i) |> Element.to_string)
|
||||
(b.nucl_charge.(i) |> Charge.to_int )
|
||||
(b.nucl_coord.(i) |> Point3d.to_string ~units:Units.Angstrom) )
|
||||
|
@ -43,7 +43,7 @@ $(QP_ROOT)/data/executables: remake_executables element_create_db.byte Qptypes.m
|
||||
$(QP_ROOT)/ocaml/element_create_db.byte
|
||||
|
||||
external_libs:
|
||||
opam install cryptokit core
|
||||
opam install cryptokit sexplib
|
||||
|
||||
qpackage.odocl: $(MLIFILES)
|
||||
ls $(MLIFILES) | sed "s/\.mli//" > qpackage.odocl
|
||||
@ -80,7 +80,7 @@ git:
|
||||
./create_git_sha1.sh
|
||||
|
||||
${QP_EZFIO}/Ocaml/ezfio.ml:
|
||||
$(NINJA) -C ${QP_EZFIO}
|
||||
$(NINJA) -C ${QP_ROOT}/config ${QP_ROOT}/lib/libezfio_irp.a
|
||||
|
||||
qp_edit.ml: ../scripts/ezfio_interface/qp_edit_template
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
true: package(cryptokit,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt)
|
||||
true: package(cryptokit,zarith,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt)
|
||||
true: thread
|
||||
false: profile
|
||||
<*byte> : linkdep(c_bindings.o), custom
|
||||
|
@ -644,7 +644,7 @@ If a file with the same name as the basis set exists, this file will be read. O
|
||||
|
||||
{ opt=Optional ; short='c'; long="charge";
|
||||
arg=With_arg "<int>";
|
||||
doc="Total charge of the molecule. Default is 0."} ;
|
||||
doc="Total charge of the molecule. Default is 0. For negative values, use m instead of -, for ex m1"} ;
|
||||
|
||||
{ opt=Optional ; short='d'; long="dummy";
|
||||
arg=With_arg "<float>";
|
||||
@ -686,7 +686,10 @@ If a file with the same name as the basis set exists, this file will be read. O
|
||||
let charge =
|
||||
match Command_line.get "charge" with
|
||||
| None -> 0
|
||||
| Some x -> int_of_string x
|
||||
| Some x -> ( if x.[0] = 'm' then
|
||||
~- (int_of_string (String.sub x 1 (String.length x - 1)))
|
||||
else
|
||||
int_of_string x )
|
||||
in
|
||||
|
||||
let dummy =
|
||||
|
@ -44,9 +44,12 @@ let psi_det () =
|
||||
let psi_det =
|
||||
Input.Determinants_by_hand.read ()
|
||||
in
|
||||
Input.Determinants_by_hand.to_rst psi_det
|
||||
|> Rst_string.to_string
|
||||
|> print_endline
|
||||
match psi_det with
|
||||
| Some psi_det ->
|
||||
Input.Determinants_by_hand.to_rst psi_det
|
||||
|> Rst_string.to_string
|
||||
|> print_endline
|
||||
| None -> ()
|
||||
|
||||
|
||||
|
||||
|
@ -106,95 +106,6 @@ let set ~core ~inact ~act ~virt ~del =
|
||||
MO_class.to_string virt |> print_endline ;
|
||||
MO_class.to_string del |> print_endline ;
|
||||
|
||||
(* Create masks *)
|
||||
let ia = Excitation.create_single inact act
|
||||
and aa = Excitation.create_single act act
|
||||
and av = Excitation.create_single act virt
|
||||
in
|
||||
let single_excitations = [ ia ; aa ; av ]
|
||||
|> List.map (fun x ->
|
||||
let open Excitation in
|
||||
match x with
|
||||
| Single (x,y) ->
|
||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
||||
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
||||
| Double _ -> assert false
|
||||
)
|
||||
|
||||
and double_excitations = [
|
||||
Excitation.double_of_singles ia ia ;
|
||||
Excitation.double_of_singles ia aa ;
|
||||
Excitation.double_of_singles ia av ;
|
||||
Excitation.double_of_singles aa aa ;
|
||||
Excitation.double_of_singles aa av ;
|
||||
Excitation.double_of_singles av av ]
|
||||
|> List.map (fun x ->
|
||||
let open Excitation in
|
||||
match x with
|
||||
| Single _ -> assert false
|
||||
| Double (x,y,z,t) ->
|
||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
||||
MO_class.to_bitlist n_int (Particle.to_mo_class y) ,
|
||||
MO_class.to_bitlist n_int (Hole.to_mo_class z),
|
||||
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
|
||||
)
|
||||
in
|
||||
|
||||
let extract_hole (h,_) = h
|
||||
and extract_particle (_,p) = p
|
||||
and extract_hole1 (h,_,_,_) = h
|
||||
and extract_particle1 (_,p,_,_) = p
|
||||
and extract_hole2 (_,_,h,_) = h
|
||||
and extract_particle2 (_,_,_,p) = p
|
||||
in
|
||||
let init = Bitlist.zero n_int in
|
||||
let result = [
|
||||
List.map extract_hole single_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_particle single_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_hole1 double_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_particle1 double_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_hole2 double_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_particle2 double_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
]
|
||||
in
|
||||
|
||||
(* Debug masks in output
|
||||
List.iter ~f:(fun x-> print_endline (Bitlist.to_string x)) result;
|
||||
*)
|
||||
|
||||
(* Write masks *)
|
||||
let result =
|
||||
List.map (fun x ->
|
||||
let y = Bitlist.to_int64_list x in y@y )
|
||||
result
|
||||
|> List.concat
|
||||
in
|
||||
|
||||
Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
|
||||
Ezfio.set_bitmasks_bit_kind 8;
|
||||
Ezfio.set_bitmasks_n_mask_gen 1;
|
||||
Ezfio.ezfio_array_of_list ~rank:4 ~dim:([| (N_int_number.to_int n_int) ; 2; 6; 1|]) ~data:result
|
||||
|> Ezfio.set_bitmasks_generators ;
|
||||
|
||||
let result =
|
||||
let open Excitation in
|
||||
match aa with
|
||||
| Double _ -> assert false
|
||||
| Single (x,y) ->
|
||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x) ) @
|
||||
( MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
||||
|> Bitlist.to_int64_list
|
||||
in
|
||||
Ezfio.set_bitmasks_n_mask_cas 1;
|
||||
Ezfio.ezfio_array_of_list ~rank:3 ~dim:([| (N_int_number.to_int n_int) ; 2; 1|]) ~data:result
|
||||
|> Ezfio.set_bitmasks_cas;
|
||||
|
||||
let data =
|
||||
Array.to_list mo_class
|
||||
|> List.map (fun x -> match x with
|
||||
|
469
ocaml/qp_tunnel.ml
Normal file
469
ocaml/qp_tunnel.ml
Normal file
@ -0,0 +1,469 @@
|
||||
open Qputils
|
||||
open Qptypes
|
||||
|
||||
type ezfio_or_address = EZFIO of string | ADDRESS of string
|
||||
type req_or_sub = REQ | SUB
|
||||
|
||||
let localport = 42379
|
||||
|
||||
|
||||
let in_time_sum = ref 1.e-9
|
||||
and in_size_sum = ref 0.
|
||||
|
||||
let () =
|
||||
let open Command_line in
|
||||
begin
|
||||
"Creates an ssh tunnel for using slaves on another network. Launch a server on the front-end node of the cluster on which the master process runs. Then start a client ont the front-end node of the distant cluster."
|
||||
|
||||
|> set_footer_doc ;
|
||||
|
||||
[ { short='g' ; long="get-input" ; opt=Optional ;
|
||||
doc="Downloads the EZFIO directory." ;
|
||||
arg=Without_arg; } ;
|
||||
|
||||
{ short='v' ; long="verbose" ; opt=Optional ;
|
||||
doc="Prints the transfer speed." ;
|
||||
arg=Without_arg; } ;
|
||||
|
||||
anonymous
|
||||
"(EZFIO_DIR|ADDRESS)"
|
||||
Mandatory
|
||||
"EZFIO directory or address.";
|
||||
] |> set_specs
|
||||
end;
|
||||
|
||||
let arg =
|
||||
let x =
|
||||
match Command_line.anon_args () with
|
||||
| [x] -> x
|
||||
| _ -> begin
|
||||
Command_line.help () ;
|
||||
failwith "EZFIO_FILE or ADDRESS is missing"
|
||||
end
|
||||
in
|
||||
if Sys.file_exists x && Sys.is_directory x then
|
||||
EZFIO x
|
||||
else
|
||||
ADDRESS x
|
||||
in
|
||||
|
||||
let verbose =
|
||||
Command_line.get_bool "verbose"
|
||||
in
|
||||
|
||||
|
||||
|
||||
let localhost =
|
||||
Lazy.force TaskServer.ip_address
|
||||
in
|
||||
|
||||
|
||||
let long_address =
|
||||
match arg with
|
||||
| ADDRESS x -> x
|
||||
| EZFIO x ->
|
||||
let ic =
|
||||
Filename.concat (Qpackage.ezfio_work x) "qp_run_address"
|
||||
|> open_in
|
||||
in
|
||||
let result =
|
||||
input_line ic
|
||||
|> String.trim
|
||||
in
|
||||
close_in ic;
|
||||
result
|
||||
in
|
||||
|
||||
let protocol, address, port =
|
||||
match String.split_on_char ':' long_address with
|
||||
| t :: a :: p :: [] -> t, a, int_of_string p
|
||||
| _ -> failwith @@
|
||||
Printf.sprintf "%s : Malformed address" long_address
|
||||
in
|
||||
|
||||
|
||||
let zmq_context =
|
||||
Zmq.Context.create ()
|
||||
in
|
||||
|
||||
|
||||
(** Check availability of the ports *)
|
||||
let localport =
|
||||
let dummy_socket =
|
||||
Zmq.Socket.create zmq_context Zmq.Socket.rep
|
||||
in
|
||||
let rec try_new_port port_number =
|
||||
try
|
||||
List.iter (fun i ->
|
||||
let address =
|
||||
Printf.sprintf "tcp://%s:%d" localhost (port_number+i)
|
||||
in
|
||||
Zmq.Socket.bind dummy_socket address;
|
||||
Zmq.Socket.unbind dummy_socket address
|
||||
) [ 0;1;2;3;4;5;6;7;8;9 ] ;
|
||||
port_number
|
||||
with
|
||||
| Unix.Unix_error _ -> try_new_port (port_number+100)
|
||||
in
|
||||
let result =
|
||||
try_new_port localport
|
||||
in
|
||||
Zmq.Socket.close dummy_socket;
|
||||
result
|
||||
in
|
||||
|
||||
|
||||
let create_socket sock_type bind_or_connect addr =
|
||||
let socket =
|
||||
Zmq.Socket.create zmq_context sock_type
|
||||
in
|
||||
let () =
|
||||
try
|
||||
bind_or_connect socket addr
|
||||
with
|
||||
| _ -> failwith @@
|
||||
Printf.sprintf "Unable to establish connection to %s." addr
|
||||
in
|
||||
socket
|
||||
in
|
||||
|
||||
|
||||
(* Handle termination *)
|
||||
let run_status = ref true in
|
||||
let handler =
|
||||
Sys.Signal_handle (fun signum ->
|
||||
run_status := false;
|
||||
Sys.set_signal signum Sys.Signal_default
|
||||
)
|
||||
in
|
||||
Sys.set_signal Sys.sigusr1 handler;
|
||||
Sys.set_signal Sys.sigint handler;
|
||||
|
||||
|
||||
let new_thread req_or_sub addr_in addr_out =
|
||||
let socket_in, socket_out =
|
||||
match req_or_sub with
|
||||
| REQ ->
|
||||
create_socket Zmq.Socket.router Zmq.Socket.bind addr_in,
|
||||
create_socket Zmq.Socket.dealer Zmq.Socket.connect addr_out
|
||||
| SUB ->
|
||||
create_socket Zmq.Socket.sub Zmq.Socket.connect addr_in,
|
||||
create_socket Zmq.Socket.pub Zmq.Socket.bind addr_out
|
||||
in
|
||||
|
||||
if req_or_sub = SUB then
|
||||
Zmq.Socket.subscribe socket_in "";
|
||||
|
||||
|
||||
(*
|
||||
let action =
|
||||
if verbose then
|
||||
begin
|
||||
match req_or_sub with
|
||||
| REQ -> (fun () ->
|
||||
let msg =
|
||||
Zmq.Socket.recv_all socket_in
|
||||
in
|
||||
let t0 = Unix.gettimeofday () in
|
||||
Zmq.Socket.send_all socket_out msg;
|
||||
let in_size =
|
||||
float_of_int ( List.fold_left (fun accu x -> accu + String.length x) 0 msg )
|
||||
/. 8192. /. 1024.
|
||||
in
|
||||
let msg =
|
||||
Zmq.Socket.recv_all socket_out
|
||||
in
|
||||
let t1 = Unix.gettimeofday () in
|
||||
Zmq.Socket.send_all socket_in msg;
|
||||
let in_time = t1 -. t0 in
|
||||
in_time_sum := !in_time_sum +. in_time;
|
||||
in_size_sum := !in_size_sum +. in_size;
|
||||
Printf.printf " %16.2f MiB/s -- %16.2f MiB/s\n%!" (in_size /. in_time) (!in_size_sum /. !in_time_sum);
|
||||
)
|
||||
| SUB -> (fun () ->
|
||||
Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out)
|
||||
end
|
||||
else
|
||||
begin
|
||||
match req_or_sub with
|
||||
| REQ -> (fun () ->
|
||||
Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out;
|
||||
Zmq.Socket.recv_all socket_out |> Zmq.Socket.send_all socket_in )
|
||||
| SUB -> (fun () ->
|
||||
Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out)
|
||||
end
|
||||
in
|
||||
*)
|
||||
|
||||
let action_in =
|
||||
match req_or_sub with
|
||||
| REQ -> (fun () -> Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out)
|
||||
| SUB -> (fun () -> Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out)
|
||||
in
|
||||
|
||||
let action_out =
|
||||
match req_or_sub with
|
||||
| REQ -> (fun () -> Zmq.Socket.recv_all socket_out |> Zmq.Socket.send_all socket_in )
|
||||
| SUB -> (fun () -> () )
|
||||
in
|
||||
|
||||
let pollitem =
|
||||
Zmq.Poll.mask_of
|
||||
[| (socket_in, Zmq.Poll.In) ; (socket_out, Zmq.Poll.In) |]
|
||||
in
|
||||
|
||||
|
||||
while !run_status do
|
||||
|
||||
let polling =
|
||||
Zmq.Poll.poll ~timeout:1000 pollitem
|
||||
in
|
||||
|
||||
match polling with
|
||||
| [| Some Zmq.Poll.In ; Some Zmq.Poll.In |] -> ( action_out () ; action_in () )
|
||||
| [| _ ; Some Zmq.Poll.In |] -> action_out ()
|
||||
| [| Some Zmq.Poll.In ; _ |] -> action_in ()
|
||||
| _ -> ()
|
||||
done;
|
||||
|
||||
Zmq.Socket.close socket_in;
|
||||
Zmq.Socket.close socket_out;
|
||||
in
|
||||
|
||||
|
||||
|
||||
let ocaml_thread =
|
||||
let addr_out =
|
||||
Printf.sprintf "tcp:%s:%d" address port
|
||||
in
|
||||
|
||||
let addr_in =
|
||||
Printf.sprintf "tcp://*:%d" localport
|
||||
in
|
||||
|
||||
let f () =
|
||||
new_thread REQ addr_in addr_out
|
||||
in
|
||||
|
||||
(Thread.create f) ()
|
||||
in
|
||||
Printf.printf "Connect to:\ntcp://%s:%d\n%!" localhost localport;
|
||||
|
||||
|
||||
let fortran_thread =
|
||||
let addr_out =
|
||||
Printf.sprintf "tcp:%s:%d" address (port+2)
|
||||
in
|
||||
|
||||
let addr_in =
|
||||
Printf.sprintf "tcp://*:%d" (localport+2)
|
||||
in
|
||||
|
||||
let f () =
|
||||
new_thread REQ addr_in addr_out
|
||||
in
|
||||
(Thread.create f) ()
|
||||
in
|
||||
|
||||
|
||||
let pub_thread =
|
||||
let addr_in =
|
||||
Printf.sprintf "tcp:%s:%d" address (port+1)
|
||||
in
|
||||
|
||||
let addr_out =
|
||||
Printf.sprintf "tcp://*:%d" (localport+1)
|
||||
in
|
||||
|
||||
let f () =
|
||||
new_thread SUB addr_in addr_out
|
||||
in
|
||||
(Thread.create f) ()
|
||||
in
|
||||
|
||||
|
||||
|
||||
let input_thread =
|
||||
let f () =
|
||||
let addr_out =
|
||||
match arg with
|
||||
| EZFIO _ -> None
|
||||
| ADDRESS _ -> Some (
|
||||
Printf.sprintf "tcp:%s:%d" address (port+9) )
|
||||
in
|
||||
|
||||
let addr_in =
|
||||
Printf.sprintf "tcp://*:%d" (localport+9)
|
||||
in
|
||||
|
||||
let socket_in =
|
||||
create_socket Zmq.Socket.rep Zmq.Socket.bind addr_in
|
||||
in
|
||||
|
||||
let socket_out =
|
||||
match addr_out with
|
||||
| Some addr_out -> Some (
|
||||
create_socket Zmq.Socket.req Zmq.Socket.connect addr_out)
|
||||
| None -> None
|
||||
in
|
||||
|
||||
let temp_file =
|
||||
Filename.temp_file "qp_tunnel" ".tar.gz"
|
||||
in
|
||||
|
||||
let get_ezfio_filename () =
|
||||
match arg with
|
||||
| EZFIO x -> x
|
||||
| ADDRESS _ ->
|
||||
begin
|
||||
match socket_out with
|
||||
| None -> assert false
|
||||
| Some socket_out -> (
|
||||
Zmq.Socket.send socket_out "get_ezfio_filename" ;
|
||||
Zmq.Socket.recv socket_out
|
||||
)
|
||||
end
|
||||
in
|
||||
|
||||
let get_input () =
|
||||
match arg with
|
||||
| EZFIO x ->
|
||||
begin
|
||||
Printf.sprintf "tar --exclude=\"*.gz.*\" -zcf %s %s" temp_file x
|
||||
|> Sys.command |> ignore;
|
||||
let fd =
|
||||
Unix.openfile temp_file [Unix.O_RDONLY] 0o640
|
||||
in
|
||||
let len =
|
||||
Unix.lseek fd 0 Unix.SEEK_END
|
||||
in
|
||||
ignore @@ Unix.lseek fd 0 Unix.SEEK_SET ;
|
||||
let bstr =
|
||||
Unix.map_file fd Bigarray.char
|
||||
Bigarray.c_layout false [| len |]
|
||||
|> Bigarray.array1_of_genarray
|
||||
in
|
||||
let result =
|
||||
String.init len (fun i -> bstr.{i}) ;
|
||||
in
|
||||
Unix.close fd;
|
||||
Sys.remove temp_file;
|
||||
result
|
||||
end
|
||||
| ADDRESS _ ->
|
||||
begin
|
||||
match socket_out with
|
||||
| None -> assert false
|
||||
| Some socket_out -> (
|
||||
Zmq.Socket.send socket_out "get_input" ;
|
||||
Zmq.Socket.recv socket_out
|
||||
)
|
||||
end
|
||||
in
|
||||
|
||||
let () =
|
||||
match socket_out with
|
||||
| None -> ()
|
||||
| Some socket_out ->
|
||||
Zmq.Socket.send socket_out "test";
|
||||
Printf.printf "Communication [ %s ]\n%!" (Zmq.Socket.recv socket_out);
|
||||
in
|
||||
|
||||
(* Download input if asked *)
|
||||
if Command_line.get_bool "get-input" then
|
||||
begin
|
||||
match arg with
|
||||
| EZFIO _ -> ()
|
||||
| ADDRESS _ ->
|
||||
begin
|
||||
Printf.printf "Getting input... %!";
|
||||
let ezfio_filename =
|
||||
get_ezfio_filename ()
|
||||
in
|
||||
Printf.printf "%s%!" ezfio_filename;
|
||||
let oc =
|
||||
open_out temp_file
|
||||
in
|
||||
get_input ()
|
||||
|> output_string oc;
|
||||
close_out oc;
|
||||
Printf.sprintf "tar -zxf %s" temp_file
|
||||
|> Sys.command |> ignore ;
|
||||
let oc =
|
||||
Filename.concat (Qpackage.ezfio_work ezfio_filename) "qp_run_address"
|
||||
|> open_out
|
||||
in
|
||||
Printf.fprintf oc "tcp://%s:%d\n" localhost localport;
|
||||
close_out oc;
|
||||
Printf.printf " ...done\n%!"
|
||||
end
|
||||
end;
|
||||
|
||||
(* Main loop *)
|
||||
let pollitem =
|
||||
Zmq.Poll.mask_of [| (socket_in, Zmq.Poll.In) |]
|
||||
in
|
||||
|
||||
let action () =
|
||||
match Zmq.Socket.recv socket_in with
|
||||
| "get_input" -> get_input ()
|
||||
|> Zmq.Socket.send socket_in
|
||||
| "get_ezfio_filename" -> get_ezfio_filename ()
|
||||
|> Zmq.Socket.send socket_in
|
||||
| "test" -> Zmq.Socket.send socket_in "OK"
|
||||
| x -> Printf.sprintf "Message '%s' not understood" x
|
||||
|> Zmq.Socket.send socket_in
|
||||
in
|
||||
|
||||
Printf.printf "
|
||||
On remote hosts, create ssh tunnel using:
|
||||
ssh -L %d:%s:%d -L %d:%s:%d -L %d:%s:%d -L %d:%s:%d %s &
|
||||
Or from this host connect to clients using:
|
||||
ssh -R %d:localhost:%d -R %d:localhost:%d -R %d:localhost:%d -R %d:localhost:%d <host> &
|
||||
%!"
|
||||
(port ) localhost (localport )
|
||||
(port+1) localhost (localport+1)
|
||||
(port+2) localhost (localport+2)
|
||||
(port+9) localhost (localport+9)
|
||||
(Unix.gethostname ())
|
||||
(port ) (localport )
|
||||
(port+1) (localport+1)
|
||||
(port+2) (localport+2)
|
||||
(port+9) (localport+9);
|
||||
Printf.printf "Ready\n%!";
|
||||
while !run_status do
|
||||
|
||||
let polling =
|
||||
Zmq.Poll.poll ~timeout:1000 pollitem
|
||||
in
|
||||
|
||||
match polling.(0) with
|
||||
| Some Zmq.Poll.In -> action ()
|
||||
| None -> ()
|
||||
| Some Zmq.Poll.In_out
|
||||
| Some Zmq.Poll.Out -> ()
|
||||
|
||||
done;
|
||||
|
||||
let () =
|
||||
match socket_out with
|
||||
| Some socket_out -> Zmq.Socket.close socket_out
|
||||
| None -> ()
|
||||
in
|
||||
Zmq.Socket.close socket_in
|
||||
in
|
||||
|
||||
(Thread.create f) ()
|
||||
in
|
||||
|
||||
(* Termination *)
|
||||
Thread.join input_thread;
|
||||
Thread.join fortran_thread;
|
||||
Thread.join pub_thread;
|
||||
Thread.join ocaml_thread;
|
||||
Zmq.Context.terminate zmq_context;
|
||||
Printf.printf "qp_tunnel exited properly.\n"
|
||||
|
||||
|
||||
|
||||
|
@ -58,7 +58,7 @@ let input_data = "
|
||||
|
||||
* Det_number_max : int
|
||||
assert (x > 0) ;
|
||||
if (x > 50_00_000_000) then
|
||||
if (x > 50_000_000_000) then
|
||||
warning \"More than 50 billion determinants\";
|
||||
|
||||
* States_number : int
|
||||
@ -78,9 +78,6 @@ let input_data = "
|
||||
| _ -> raise (Invalid_argument \"Bit_kind should be (1|2|4|8).\")
|
||||
end;
|
||||
|
||||
* Bitmask_number : int
|
||||
assert (x > 0) ;
|
||||
|
||||
* MO_coef : float
|
||||
|
||||
* MO_occ : float
|
||||
|
@ -839,21 +839,6 @@ if __name__ == "__main__":
|
||||
l_module = d_binaries.keys()
|
||||
|
||||
|
||||
# ~#~#~#~#~#~#~#~#~#~#~#~#~#~#~ #
|
||||
# C h e c k _ c o h e r e n c y #
|
||||
# ~#~#~#~#~#~#~#~#~#~#~#~#~#~#~ #
|
||||
|
||||
for module in dict_root_path.values():
|
||||
|
||||
if module not in d_binaries:
|
||||
l_msg = ["{0} is a root module but does not contain a main file.",
|
||||
"- Create it in {0}",
|
||||
"- Or delete {0} `qp_module uninstall {0}`",
|
||||
"- Or install a module that needs {0} with a main "]
|
||||
|
||||
print "\n".join(l_msg).format(module.rel)
|
||||
sys.exit(1)
|
||||
|
||||
# ~#~#~#~#~#~#~#~#~#~#~#~ #
|
||||
# G l o b a l _ b u i l d #
|
||||
# ~#~#~#~#~#~#~#~#~#~#~#~ #
|
||||
|
@ -79,7 +79,7 @@ let get s =
|
||||
| Ao_basis ->
|
||||
f Ao_basis.(read, to_rst)
|
||||
| Determinants_by_hand ->
|
||||
f Determinants_by_hand.(read_maybe, to_rst)
|
||||
f Determinants_by_hand.(read ~full:false, to_rst)
|
||||
{section_to_rst}
|
||||
end
|
||||
with
|
||||
@ -120,7 +120,7 @@ let set str s =
|
||||
match s with
|
||||
{write}
|
||||
| Electrons -> write Electrons.(of_rst, write) s
|
||||
| Determinants_by_hand -> write Determinants_by_hand.(of_rst, write) s
|
||||
| Determinants_by_hand -> write Determinants_by_hand.(of_rst, write ~force:false) s
|
||||
| Nuclei_by_hand -> write Nuclei_by_hand.(of_rst, write) s
|
||||
| Ao_basis -> () (* TODO *)
|
||||
| Mo_basis -> () (* TODO *)
|
||||
|
@ -6,9 +6,8 @@ All the one-electron integrals in the |AO| basis are here.
|
||||
|
||||
The most important providers for usual quantum-chemistry calculation are:
|
||||
|
||||
* `ao_kinetic_integral` which are the kinetic operator integrals on the |AO| basis (see :file:`kin_ao_ints.irp.f`)
|
||||
* `ao_nucl_elec_integral` which are the nuclear-elctron operator integrals on the |AO| basis (see :file:`pot_ao_ints.irp.f`)
|
||||
* `ao_one_e_integrals` which are the the h_core operator integrals on the |AO| basis (see :file:`ao_mono_ints.irp.f`)
|
||||
* `ao_kinetic_integrals` which are the kinetic operator integrals on the |AO| basis
|
||||
* `ao_integrals_n_e` which are the nuclear-elctron operator integrals on the |AO| basis
|
||||
* `ao_one_e_integrals` which are the the h_core operator integrals on the |AO| basis
|
||||
|
||||
|
||||
Note that you can find other interesting integrals related to the position operator in :file:`spread_dipole_ao.irp.f`.
|
||||
|
@ -64,7 +64,7 @@
|
||||
enddo
|
||||
|
||||
! Ga-Kr
|
||||
do i = 31, 36
|
||||
do i = 31, 100
|
||||
alpha_knowles(i) = 7.d0
|
||||
enddo
|
||||
|
||||
|
@ -2,6 +2,29 @@ use bitmasks
|
||||
integer function number_of_holes(key_in)
|
||||
BEGIN_DOC
|
||||
! Function that returns the number of holes in the inact space
|
||||
!
|
||||
! popcnt(
|
||||
! xor(
|
||||
! iand(
|
||||
! reunion_of_core_inact_bitmask(1,1),
|
||||
! xor(
|
||||
! key_in(1,1),
|
||||
! iand(
|
||||
! key_in(1,1),
|
||||
! act_bitmask(1,1))
|
||||
! )
|
||||
! ),
|
||||
! reunion_of_core_inact_bitmask(1,1)) )
|
||||
!
|
||||
! (key_in && act_bitmask)
|
||||
! +---------------------+
|
||||
! electrons in cas xor key_in
|
||||
! +---------------------------------+
|
||||
! electrons outside of cas && reunion_of_core_inact_bitmask
|
||||
! +------------------------------------------------------------------+
|
||||
! electrons in the core/inact space xor reunion_of_core_inact_bitmask
|
||||
! +---------------------------------------------------------------------------------+
|
||||
! holes
|
||||
END_DOC
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int,2)
|
||||
@ -10,90 +33,32 @@ integer function number_of_holes(key_in)
|
||||
|
||||
if(N_int == 1)then
|
||||
number_of_holes = number_of_holes &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) )
|
||||
else if(N_int == 2)then
|
||||
number_of_holes = number_of_holes &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2)))), reunion_of_core_inact_bitmask(2,2)) )
|
||||
else if(N_int == 3)then
|
||||
number_of_holes = number_of_holes &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2)))), reunion_of_core_inact_bitmask(2,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),act_bitmask(3,1)))), reunion_of_core_inact_bitmask(3,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),act_bitmask(3,2)))), reunion_of_core_inact_bitmask(3,2)) )
|
||||
else if(N_int == 4)then
|
||||
number_of_holes = number_of_holes &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) )
|
||||
else if(N_int == 5)then
|
||||
number_of_holes = number_of_holes &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,1), xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1)))), reunion_of_core_inact_bitmask(5,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,2), xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1)))), reunion_of_core_inact_bitmask(5,2)) )
|
||||
else if(N_int == 6)then
|
||||
number_of_holes = number_of_holes &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,1), xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1)))), reunion_of_core_inact_bitmask(5,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,2), xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1)))), reunion_of_core_inact_bitmask(5,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,1), xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1)))), reunion_of_core_inact_bitmask(6,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,2), xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1)))), reunion_of_core_inact_bitmask(6,2)) )
|
||||
else if(N_int == 7)then
|
||||
number_of_holes = number_of_holes &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,1), xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1)))), reunion_of_core_inact_bitmask(5,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,2), xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1)))), reunion_of_core_inact_bitmask(5,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,1), xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1)))), reunion_of_core_inact_bitmask(6,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,2), xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1)))), reunion_of_core_inact_bitmask(6,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(7,1), xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1)))), reunion_of_core_inact_bitmask(7,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(7,2), xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1)))), reunion_of_core_inact_bitmask(7,2)) )
|
||||
else if(N_int == 8)then
|
||||
number_of_holes = number_of_holes &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,1), xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1)))), reunion_of_core_inact_bitmask(5,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,2), xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1)))), reunion_of_core_inact_bitmask(5,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,1), xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1)))), reunion_of_core_inact_bitmask(6,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,2), xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1)))), reunion_of_core_inact_bitmask(6,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(8,1), xor(key_in(8,1),iand(key_in(8,1),cas_bitmask(8,1,1)))), reunion_of_core_inact_bitmask(8,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(8,2), xor(key_in(8,2),iand(key_in(8,2),cas_bitmask(8,2,1)))), reunion_of_core_inact_bitmask(8,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1)))), reunion_of_core_inact_bitmask(2,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2)))), reunion_of_core_inact_bitmask(2,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),act_bitmask(3,1)))), reunion_of_core_inact_bitmask(3,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),act_bitmask(3,2)))), reunion_of_core_inact_bitmask(3,2)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),act_bitmask(4,1)))), reunion_of_core_inact_bitmask(4,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),act_bitmask(4,2)))), reunion_of_core_inact_bitmask(4,2)) )
|
||||
else
|
||||
do i = 1, N_int
|
||||
number_of_holes = number_of_holes &
|
||||
@ -104,11 +69,11 @@ integer function number_of_holes(key_in)
|
||||
xor( &
|
||||
key_in(i,1), & ! MOs of key_in not in the CAS
|
||||
iand( & ! MOs of key_in in the CAS
|
||||
key_in(i,1), cas_bitmask(i,1,1) &
|
||||
key_in(i,1), act_bitmask(i,1) &
|
||||
) &
|
||||
) &
|
||||
), reunion_of_core_inact_bitmask(i,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(i,1), xor(key_in(i,2),iand(key_in(i,2),cas_bitmask(i,1,1)))), reunion_of_core_inact_bitmask(i,1)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(i,2), xor(key_in(i,2),iand(key_in(i,2),act_bitmask(i,2)))), reunion_of_core_inact_bitmask(i,2)) )
|
||||
enddo
|
||||
endif
|
||||
end
|
||||
@ -124,97 +89,37 @@ integer function number_of_particles(key_in)
|
||||
number_of_particles= 0
|
||||
if(N_int == 1)then
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) )
|
||||
+ popcnt( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) )) &
|
||||
+ popcnt( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) ))
|
||||
else if(N_int == 2)then
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) )
|
||||
+ popcnt( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) ) ) &
|
||||
+ popcnt( iand( xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1))), virt_bitmask(2,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2))), virt_bitmask(2,2) ) )
|
||||
else if(N_int == 3)then
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) )
|
||||
+ popcnt( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) )) &
|
||||
+ popcnt( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) )) &
|
||||
+ popcnt( iand( xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1))), virt_bitmask(2,1) )) &
|
||||
+ popcnt( iand( xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2))), virt_bitmask(2,2) )) &
|
||||
+ popcnt( iand( xor(key_in(3,1),iand(key_in(3,1),act_bitmask(3,1))), virt_bitmask(3,1) )) &
|
||||
+ popcnt( iand( xor(key_in(3,2),iand(key_in(3,2),act_bitmask(3,2))), virt_bitmask(3,2) ))
|
||||
else if(N_int == 4)then
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) )
|
||||
else if(N_int == 5)then
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) )
|
||||
else if(N_int == 6)then
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1))), virt_bitmask(6,1) ), virt_bitmask(6,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1))), virt_bitmask(6,2) ), virt_bitmask(6,2)) )
|
||||
else if(N_int == 7)then
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1))), virt_bitmask(6,1) ), virt_bitmask(6,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1))), virt_bitmask(6,2) ), virt_bitmask(6,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1))), virt_bitmask(7,1) ), virt_bitmask(7,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1))), virt_bitmask(7,2) ), virt_bitmask(7,2)) )
|
||||
else if(N_int == 8)then
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1))), virt_bitmask(6,1) ), virt_bitmask(6,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1))), virt_bitmask(6,2) ), virt_bitmask(6,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1))), virt_bitmask(7,1) ), virt_bitmask(7,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1))), virt_bitmask(7,2) ), virt_bitmask(7,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(8,1),iand(key_in(8,1),cas_bitmask(8,1,1))), virt_bitmask(8,1) ), virt_bitmask(8,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(8,2),iand(key_in(8,2),cas_bitmask(8,2,1))), virt_bitmask(8,2) ), virt_bitmask(8,2)) )
|
||||
+ popcnt( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) ) ) &
|
||||
+ popcnt( iand( xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1))), virt_bitmask(2,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2))), virt_bitmask(2,2) ) ) &
|
||||
+ popcnt( iand( xor(key_in(3,1),iand(key_in(3,1),act_bitmask(3,1))), virt_bitmask(3,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(3,2),iand(key_in(3,2),act_bitmask(3,2))), virt_bitmask(3,2) ) ) &
|
||||
+ popcnt( iand( xor(key_in(4,1),iand(key_in(4,1),act_bitmask(4,1))), virt_bitmask(4,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(4,2),iand(key_in(4,2),act_bitmask(4,2))), virt_bitmask(4,2) ) )
|
||||
else
|
||||
do i = 1, N_int
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( iand( xor(key_in(i,1),iand(key_in(i,1),cas_bitmask(i,1,1))), virt_bitmask(i,1) ), virt_bitmask(i,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(i,2),iand(key_in(i,2),cas_bitmask(i,2,1))), virt_bitmask(i,2) ), virt_bitmask(i,2)) )
|
||||
number_of_particles= number_of_particles &
|
||||
+ popcnt( iand( xor(key_in(i,1),iand(key_in(i,1),act_bitmask(i,1))), virt_bitmask(i,1) )) &
|
||||
+ popcnt( iand( xor(key_in(i,2),iand(key_in(i,2),act_bitmask(i,2))), virt_bitmask(i,2) ))
|
||||
enddo
|
||||
endif
|
||||
end
|
||||
@ -223,7 +128,7 @@ logical function is_a_two_holes_two_particles(key_in)
|
||||
BEGIN_DOC
|
||||
! logical function that returns True if the determinant 'key_in'
|
||||
! belongs to the 2h-2p excitation class of the DDCI space
|
||||
! this is calculated using the CAS_bitmask that defines the active
|
||||
! this is calculated using the act_bitmask that defines the active
|
||||
! orbital space, the inact_bitmasl that defines the inactive oribital space
|
||||
! and the virt_bitmask that defines the virtual orbital space
|
||||
END_DOC
|
||||
@ -239,174 +144,62 @@ logical function is_a_two_holes_two_particles(key_in)
|
||||
i_diff = 0
|
||||
if(N_int == 1)then
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) ) )
|
||||
else if(N_int == 2)then
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) ) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1))), virt_bitmask(2,1) )) &
|
||||
+ popcnt( iand( xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2))), virt_bitmask(2,2) ))
|
||||
|
||||
else if(N_int == 3)then
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) ) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1))), virt_bitmask(2,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2))), virt_bitmask(2,2) ) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),act_bitmask(3,1)))), reunion_of_core_inact_bitmask(3,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),act_bitmask(3,2)))), reunion_of_core_inact_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(3,1),iand(key_in(3,1),act_bitmask(3,1))), virt_bitmask(3,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(3,2),iand(key_in(3,2),act_bitmask(3,2))), virt_bitmask(3,2) ) )
|
||||
else if(N_int == 4)then
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) )
|
||||
else if(N_int == 5)then
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,1), xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1)))), reunion_of_core_inact_bitmask(5,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,2), xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1)))), reunion_of_core_inact_bitmask(5,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) )
|
||||
else if(N_int == 6)then
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,1), xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1)))), reunion_of_core_inact_bitmask(5,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,2), xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1)))), reunion_of_core_inact_bitmask(5,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,1), xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1)))), reunion_of_core_inact_bitmask(6,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,2), xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1)))), reunion_of_core_inact_bitmask(6,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1))), virt_bitmask(6,1) ), virt_bitmask(6,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1))), virt_bitmask(6,2) ), virt_bitmask(6,2)) )
|
||||
else if(N_int == 7)then
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,1), xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1)))), reunion_of_core_inact_bitmask(5,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,2), xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1)))), reunion_of_core_inact_bitmask(5,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,1), xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1)))), reunion_of_core_inact_bitmask(6,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,2), xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1)))), reunion_of_core_inact_bitmask(6,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1))), virt_bitmask(6,1) ), virt_bitmask(6,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1))), virt_bitmask(6,2) ), virt_bitmask(6,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(7,1), xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1)))), reunion_of_core_inact_bitmask(7,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(7,2), xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1)))), reunion_of_core_inact_bitmask(7,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1))), virt_bitmask(7,1) ), virt_bitmask(7,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1))), virt_bitmask(7,2) ), virt_bitmask(7,2)) )
|
||||
else if(N_int == 8)then
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,1),iand(key_in(2,1),cas_bitmask(2,1,1))), virt_bitmask(2,1) ), virt_bitmask(2,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1)))), reunion_of_core_inact_bitmask(3,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1)))), reunion_of_core_inact_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1)))), reunion_of_core_inact_bitmask(4,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1)))), reunion_of_core_inact_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,1), xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1)))), reunion_of_core_inact_bitmask(5,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(5,2), xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1)))), reunion_of_core_inact_bitmask(5,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,1), xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1)))), reunion_of_core_inact_bitmask(6,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(6,2), xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1)))), reunion_of_core_inact_bitmask(6,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1))), virt_bitmask(6,1) ), virt_bitmask(6,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1))), virt_bitmask(6,2) ), virt_bitmask(6,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(7,1), xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1)))), reunion_of_core_inact_bitmask(7,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(7,2), xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1)))), reunion_of_core_inact_bitmask(7,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1))), virt_bitmask(7,1) ), virt_bitmask(7,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1))), virt_bitmask(7,2) ), virt_bitmask(7,2)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(8,1), xor(key_in(8,1),iand(key_in(8,1),cas_bitmask(8,1,1)))), reunion_of_core_inact_bitmask(8,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(8,2), xor(key_in(8,2),iand(key_in(8,2),cas_bitmask(8,2,1)))), reunion_of_core_inact_bitmask(8,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(8,1),iand(key_in(8,1),cas_bitmask(8,1,1))), virt_bitmask(8,1) ), virt_bitmask(8,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(8,2),iand(key_in(8,2),cas_bitmask(8,2,1))), virt_bitmask(8,2) ), virt_bitmask(8,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) ) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,1), xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1)))), reunion_of_core_inact_bitmask(2,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(2,2), xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2)))), reunion_of_core_inact_bitmask(2,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(2,1),iand(key_in(2,1),act_bitmask(2,1))), virt_bitmask(2,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(2,2),iand(key_in(2,2),act_bitmask(2,2))), virt_bitmask(2,2) ) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,1), xor(key_in(3,1),iand(key_in(3,1),act_bitmask(3,1)))), reunion_of_core_inact_bitmask(3,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(3,2), xor(key_in(3,2),iand(key_in(3,2),act_bitmask(3,2)))), reunion_of_core_inact_bitmask(3,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(3,1),iand(key_in(3,1),act_bitmask(3,1))), virt_bitmask(3,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(4,2),iand(key_in(3,2),act_bitmask(3,2))), virt_bitmask(3,2) ) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,1), xor(key_in(4,1),iand(key_in(4,1),act_bitmask(4,1)))), reunion_of_core_inact_bitmask(4,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(4,2), xor(key_in(4,2),iand(key_in(4,2),act_bitmask(4,2)))), reunion_of_core_inact_bitmask(4,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(4,1),iand(key_in(4,1),act_bitmask(4,1))), virt_bitmask(4,1) ) ) &
|
||||
+ popcnt( iand( xor(key_in(4,2),iand(key_in(4,2),act_bitmask(4,2))), virt_bitmask(4,2) ) )
|
||||
|
||||
else
|
||||
|
||||
do i = 1, N_int
|
||||
i_diff = i_diff &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(i,1), xor(key_in(i,1),iand(key_in(i,1),cas_bitmask(i,1,1)))), reunion_of_core_inact_bitmask(i,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(i,2), xor(key_in(i,2),iand(key_in(i,2),cas_bitmask(i,2,1)))), reunion_of_core_inact_bitmask(i,2)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(i,1),iand(key_in(i,1),cas_bitmask(i,1,1))), virt_bitmask(i,1) ), virt_bitmask(i,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(i,2),iand(key_in(i,2),cas_bitmask(i,2,1))), virt_bitmask(i,2) ), virt_bitmask(i,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(i,1), xor(key_in(i,1),iand(key_in(i,1),act_bitmask(i,1)))), reunion_of_core_inact_bitmask(i,1)) ) &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(i,2), xor(key_in(i,2),iand(key_in(i,2),act_bitmask(i,2)))), reunion_of_core_inact_bitmask(i,2)) ) &
|
||||
+ popcnt( iand( xor(key_in(i,1),iand(key_in(i,1),act_bitmask(i,1))), virt_bitmask(i,1) )) &
|
||||
+ popcnt( iand( xor(key_in(i,2),iand(key_in(i,2),act_bitmask(i,2))), virt_bitmask(i,2) ))
|
||||
enddo
|
||||
endif
|
||||
is_a_two_holes_two_particles = (i_diff >3)
|
||||
@ -427,8 +220,8 @@ integer function number_of_holes_verbose(key_in)
|
||||
print*,'jey_in = '
|
||||
call debug_det(key_in,N_int)
|
||||
number_of_holes_verbose = 0
|
||||
key_tmp(1,1) = xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))
|
||||
key_tmp(1,2) = xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,1,1)))
|
||||
key_tmp(1,1) = xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))
|
||||
key_tmp(1,2) = xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,1)))
|
||||
call debug_det(key_tmp,N_int)
|
||||
key_tmp(1,1) = iand(key_tmp(1,1),reunion_of_core_inact_bitmask(1,1))
|
||||
key_tmp(1,2) = iand(key_tmp(1,2),reunion_of_core_inact_bitmask(1,2))
|
||||
@ -439,8 +232,8 @@ integer function number_of_holes_verbose(key_in)
|
||||
! number_of_holes_verbose = number_of_holes_verbose + popcnt(key_tmp(1,1)) &
|
||||
! + popcnt(key_tmp(1,2))
|
||||
number_of_holes_verbose = number_of_holes_verbose &
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), reunion_of_core_inact_bitmask(1,2)) )
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1)))), reunion_of_core_inact_bitmask(1,1)) )&
|
||||
+ popcnt( xor( iand(reunion_of_core_inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2)))), reunion_of_core_inact_bitmask(1,2)) )
|
||||
print*,'----------------------'
|
||||
end
|
||||
|
||||
@ -457,8 +250,8 @@ integer function number_of_particles_verbose(key_in)
|
||||
print*,'jey_in = '
|
||||
call debug_det(key_in,N_int)
|
||||
number_of_particles_verbose = 0
|
||||
key_tmp(1,1) = xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,1,1)))
|
||||
key_tmp(1,2) = xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,1,1)))
|
||||
key_tmp(1,1) = xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,1)))
|
||||
key_tmp(1,2) = xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,1)))
|
||||
call debug_det(key_tmp,N_int)
|
||||
key_tmp(1,1) = iand(key_tmp(1,2),virt_bitmask(1,2))
|
||||
key_tmp(1,2) = iand(key_tmp(1,2),virt_bitmask(1,2))
|
||||
@ -469,18 +262,16 @@ integer function number_of_particles_verbose(key_in)
|
||||
! number_of_particles_verbose = number_of_particles_verbose + popcnt(key_tmp(1,1)) &
|
||||
! + popcnt(key_tmp(1,2))
|
||||
number_of_particles_verbose = number_of_particles_verbose &
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) )
|
||||
+ popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),act_bitmask(1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) &
|
||||
+ popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),act_bitmask(1,2))), virt_bitmask(1,2) ), virt_bitmask(1,2)) )
|
||||
end
|
||||
|
||||
logical function is_a_1h1p(key_in)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int,2)
|
||||
integer :: number_of_particles, number_of_holes
|
||||
is_a_1h1p = .False.
|
||||
if(number_of_holes(key_in).eq.1 .and. number_of_particles(key_in).eq.1)then
|
||||
is_a_1h1p = .True.
|
||||
endif
|
||||
|
||||
is_a_1h1p = (number_of_holes(key_in) == 1) .and. (number_of_particles(key_in) == 1)
|
||||
|
||||
end
|
||||
|
||||
@ -488,10 +279,8 @@ logical function is_a_1h2p(key_in)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int,2)
|
||||
integer :: number_of_particles, number_of_holes
|
||||
is_a_1h2p = .False.
|
||||
if(number_of_holes(key_in).eq.1 .and. number_of_particles(key_in).eq.2)then
|
||||
is_a_1h2p = .True.
|
||||
endif
|
||||
|
||||
is_a_1h2p = (number_of_holes(key_in) == 1) .and. (number_of_particles(key_in) == 2)
|
||||
|
||||
end
|
||||
|
||||
@ -499,10 +288,8 @@ logical function is_a_2h1p(key_in)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int,2)
|
||||
integer :: number_of_particles, number_of_holes
|
||||
is_a_2h1p = .False.
|
||||
if(number_of_holes(key_in).eq.2 .and. number_of_particles(key_in).eq.1)then
|
||||
is_a_2h1p = .True.
|
||||
endif
|
||||
|
||||
is_a_2h1p = (number_of_holes(key_in) == 2) .and. (number_of_particles(key_in) == 1)
|
||||
|
||||
end
|
||||
|
||||
@ -510,10 +297,8 @@ logical function is_a_1h(key_in)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int,2)
|
||||
integer :: number_of_particles, number_of_holes
|
||||
is_a_1h = .False.
|
||||
if(number_of_holes(key_in).eq.1 .and. number_of_particles(key_in).eq.0)then
|
||||
is_a_1h = .True.
|
||||
endif
|
||||
|
||||
is_a_1h = (number_of_holes(key_in) == 1) .and. (number_of_particles(key_in) == 0)
|
||||
|
||||
end
|
||||
|
||||
@ -521,10 +306,8 @@ logical function is_a_1p(key_in)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int,2)
|
||||
integer :: number_of_particles, number_of_holes
|
||||
is_a_1p = .False.
|
||||
if(number_of_holes(key_in).eq.0 .and. number_of_particles(key_in).eq.1)then
|
||||
is_a_1p = .True.
|
||||
endif
|
||||
|
||||
is_a_1p = (number_of_holes(key_in) == 0) .and. (number_of_particles(key_in) == 1)
|
||||
|
||||
end
|
||||
|
||||
@ -532,10 +315,8 @@ logical function is_a_2p(key_in)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int,2)
|
||||
integer :: number_of_particles, number_of_holes
|
||||
is_a_2p = .False.
|
||||
if(number_of_holes(key_in).eq.0 .and. number_of_particles(key_in).eq.2)then
|
||||
is_a_2p = .True.
|
||||
endif
|
||||
|
||||
is_a_2p = (number_of_holes(key_in) == 0) .and. (number_of_particles(key_in) == 2)
|
||||
|
||||
end
|
||||
|
||||
@ -543,10 +324,8 @@ logical function is_a_2h(key_in)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int,2)
|
||||
integer :: number_of_particles, number_of_holes
|
||||
is_a_2h = .False.
|
||||
if(number_of_holes(key_in).eq.2 .and. number_of_particles(key_in).eq.0)then
|
||||
is_a_2h = .True.
|
||||
endif
|
||||
|
||||
is_a_2h = (number_of_holes(key_in) == 2) .and. (number_of_particles(key_in) == 0)
|
||||
|
||||
end
|
||||
|
||||
|
@ -1,8 +1,4 @@
|
||||
bitmasks
|
||||
N_int integer
|
||||
bit_kind integer
|
||||
N_mask_gen integer
|
||||
generators integer*8 (bitmasks_N_int*bitmasks_bit_kind/8,2,6,bitmasks_N_mask_gen)
|
||||
N_mask_cas integer
|
||||
cas integer*8 (bitmasks_N_int*bitmasks_bit_kind/8,2,bitmasks_N_mask_cas)
|
||||
|
||||
|
@ -11,7 +11,7 @@ BEGIN_PROVIDER [ integer, N_int ]
|
||||
if (N_int > N_int_max) then
|
||||
stop 'N_int > N_int_max'
|
||||
endif
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
@ -20,7 +20,7 @@ BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask, (N_int) ]
|
||||
BEGIN_DOC
|
||||
! Bitmask to include all possible MOs
|
||||
END_DOC
|
||||
|
||||
|
||||
integer :: i,j,k
|
||||
k=0
|
||||
do j=1,N_int
|
||||
@ -37,34 +37,34 @@ END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask_4, (N_int,4) ]
|
||||
implicit none
|
||||
integer :: i
|
||||
integer :: i
|
||||
do i=1,N_int
|
||||
full_ijkl_bitmask_4(i,1) = full_ijkl_bitmask(i)
|
||||
full_ijkl_bitmask_4(i,2) = full_ijkl_bitmask(i)
|
||||
full_ijkl_bitmask_4(i,3) = full_ijkl_bitmask(i)
|
||||
full_ijkl_bitmask_4(i,4) = full_ijkl_bitmask(i)
|
||||
full_ijkl_bitmask_4(i,1) = full_ijkl_bitmask(i)
|
||||
full_ijkl_bitmask_4(i,2) = full_ijkl_bitmask(i)
|
||||
full_ijkl_bitmask_4(i,3) = full_ijkl_bitmask(i)
|
||||
full_ijkl_bitmask_4(i,4) = full_ijkl_bitmask(i)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), core_inact_act_bitmask_4, (N_int,4) ]
|
||||
implicit none
|
||||
integer :: i
|
||||
integer :: i
|
||||
do i=1,N_int
|
||||
core_inact_act_bitmask_4(i,1) = reunion_of_core_inact_act_bitmask(i,1)
|
||||
core_inact_act_bitmask_4(i,2) = reunion_of_core_inact_act_bitmask(i,1)
|
||||
core_inact_act_bitmask_4(i,3) = reunion_of_core_inact_act_bitmask(i,1)
|
||||
core_inact_act_bitmask_4(i,4) = reunion_of_core_inact_act_bitmask(i,1)
|
||||
core_inact_act_bitmask_4(i,1) = reunion_of_core_inact_act_bitmask(i,1)
|
||||
core_inact_act_bitmask_4(i,2) = reunion_of_core_inact_act_bitmask(i,1)
|
||||
core_inact_act_bitmask_4(i,3) = reunion_of_core_inact_act_bitmask(i,1)
|
||||
core_inact_act_bitmask_4(i,4) = reunion_of_core_inact_act_bitmask(i,1)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask_4, (N_int,4) ]
|
||||
implicit none
|
||||
integer :: i
|
||||
integer :: i
|
||||
do i=1,N_int
|
||||
virt_bitmask_4(i,1) = virt_bitmask(i,1)
|
||||
virt_bitmask_4(i,2) = virt_bitmask(i,1)
|
||||
virt_bitmask_4(i,3) = virt_bitmask(i,1)
|
||||
virt_bitmask_4(i,4) = virt_bitmask(i,1)
|
||||
virt_bitmask_4(i,1) = virt_bitmask(i,1)
|
||||
virt_bitmask_4(i,2) = virt_bitmask(i,1)
|
||||
virt_bitmask_4(i,3) = virt_bitmask(i,1)
|
||||
virt_bitmask_4(i,4) = virt_bitmask(i,1)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
@ -78,491 +78,165 @@ BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask, (N_int,2)]
|
||||
END_DOC
|
||||
integer :: i,j,n
|
||||
integer :: occ(elec_alpha_num)
|
||||
|
||||
|
||||
HF_bitmask = 0_bit_kind
|
||||
do i=1,elec_alpha_num
|
||||
occ(i) = i
|
||||
occ(i) = i
|
||||
enddo
|
||||
call list_to_bitstring( HF_bitmask(1,1), occ, elec_alpha_num, N_int)
|
||||
! elec_alpha_num <= elec_beta_num, so occ is already OK.
|
||||
call list_to_bitstring( HF_bitmask(1,2), occ, elec_beta_num, N_int)
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), ref_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reference bit mask, used in Slater rules, chosen as Hartree-Fock bitmask
|
||||
END_DOC
|
||||
ref_bitmask = HF_bitmask
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, N_generators_bitmask ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of bitmasks for generators
|
||||
END_DOC
|
||||
logical :: exists
|
||||
PROVIDE ezfio_filename N_int
|
||||
|
||||
if (mpi_master) then
|
||||
call ezfio_has_bitmasks_N_mask_gen(exists)
|
||||
if (exists) then
|
||||
call ezfio_get_bitmasks_N_mask_gen(N_generators_bitmask)
|
||||
integer :: N_int_check
|
||||
integer :: bit_kind_check
|
||||
call ezfio_get_bitmasks_bit_kind(bit_kind_check)
|
||||
if (bit_kind_check /= bit_kind) then
|
||||
print *, bit_kind_check, bit_kind
|
||||
print *, 'Error: bit_kind is not correct in EZFIO file'
|
||||
endif
|
||||
call ezfio_get_bitmasks_N_int(N_int_check)
|
||||
if (N_int_check /= N_int) then
|
||||
print *, N_int_check, N_int
|
||||
print *, 'Error: N_int is not correct in EZFIO file'
|
||||
endif
|
||||
else
|
||||
N_generators_bitmask = 1
|
||||
endif
|
||||
ASSERT (N_generators_bitmask > 0)
|
||||
call write_int(6,N_generators_bitmask,'N_generators_bitmask')
|
||||
endif
|
||||
IRP_IF MPI_DEBUG
|
||||
print *, irp_here, mpi_rank
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
IRP_ENDIF
|
||||
IRP_IF MPI
|
||||
include 'mpif.h'
|
||||
integer :: ierr
|
||||
call MPI_BCAST( N_generators_bitmask, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
stop 'Unable to read N_generators_bitmask with MPI'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, N_generators_bitmask_restart ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of bitmasks for generators
|
||||
END_DOC
|
||||
logical :: exists
|
||||
PROVIDE ezfio_filename N_int
|
||||
|
||||
if (mpi_master) then
|
||||
call ezfio_has_bitmasks_N_mask_gen(exists)
|
||||
if (exists) then
|
||||
call ezfio_get_bitmasks_N_mask_gen(N_generators_bitmask_restart)
|
||||
integer :: N_int_check
|
||||
integer :: bit_kind_check
|
||||
call ezfio_get_bitmasks_bit_kind(bit_kind_check)
|
||||
if (bit_kind_check /= bit_kind) then
|
||||
print *, bit_kind_check, bit_kind
|
||||
print *, 'Error: bit_kind is not correct in EZFIO file'
|
||||
endif
|
||||
call ezfio_get_bitmasks_N_int(N_int_check)
|
||||
if (N_int_check /= N_int) then
|
||||
print *, N_int_check, N_int
|
||||
print *, 'Error: N_int is not correct in EZFIO file'
|
||||
endif
|
||||
else
|
||||
N_generators_bitmask_restart = 1
|
||||
endif
|
||||
ASSERT (N_generators_bitmask_restart > 0)
|
||||
call write_int(6,N_generators_bitmask_restart,'N_generators_bitmask_restart')
|
||||
endif
|
||||
IRP_IF MPI_DEBUG
|
||||
print *, irp_here, mpi_rank
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
IRP_ENDIF
|
||||
IRP_IF MPI
|
||||
include 'mpif.h'
|
||||
integer :: ierr
|
||||
call MPI_BCAST( N_generators_bitmask_restart, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
stop 'Unable to read N_generators_bitmask_restart with MPI'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reference bit mask, used in Slater rules, chosen as Hartree-Fock bitmask
|
||||
END_DOC
|
||||
ref_bitmask = HF_bitmask
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_generators_bitmask_restart) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmasks for generator determinants.
|
||||
! (N_int, alpha/beta, hole/particle, generator).
|
||||
!
|
||||
! 3rd index is :
|
||||
!
|
||||
! * 1 : hole for single exc
|
||||
!
|
||||
! * 2 : particle for single exc
|
||||
!
|
||||
! * 3 : hole for 1st exc of double
|
||||
!
|
||||
! * 4 : particle for 1st exc of double
|
||||
!
|
||||
! * 5 : hole for 2nd exc of double
|
||||
!
|
||||
! * 6 : particle for 2nd exc of double
|
||||
!
|
||||
END_DOC
|
||||
logical :: exists
|
||||
PROVIDE ezfio_filename full_ijkl_bitmask N_generators_bitmask N_int
|
||||
PROVIDE generators_bitmask_restart
|
||||
|
||||
if (mpi_master) then
|
||||
call ezfio_has_bitmasks_generators(exists)
|
||||
if (exists) then
|
||||
call ezfio_get_bitmasks_generators(generators_bitmask_restart)
|
||||
else
|
||||
integer :: k, ispin
|
||||
do k=1,N_generators_bitmask
|
||||
do ispin=1,2
|
||||
do i=1,N_int
|
||||
generators_bitmask_restart(i,ispin,s_hole ,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask_restart(i,ispin,s_part ,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask_restart(i,ispin,d_hole1,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask_restart(i,ispin,d_part1,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask_restart(i,ispin,d_hole2,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask_restart(i,ispin,d_part2,k) = full_ijkl_bitmask(i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
|
||||
integer :: i
|
||||
do k=1,N_generators_bitmask
|
||||
do ispin=1,2
|
||||
BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmasks for generator determinants.
|
||||
! (N_int, alpha/beta, hole/particle, generator).
|
||||
!
|
||||
! 3rd index is :
|
||||
!
|
||||
! * 1 : hole for single exc
|
||||
!
|
||||
! * 2 : particle for single exc
|
||||
!
|
||||
! * 3 : hole for 1st exc of double
|
||||
!
|
||||
! * 4 : particle for 1st exc of double
|
||||
!
|
||||
! * 5 : hole for 2nd exc of double
|
||||
!
|
||||
! * 6 : particle for 2nd exc of double
|
||||
!
|
||||
END_DOC
|
||||
logical :: exists
|
||||
PROVIDE ezfio_filename full_ijkl_bitmask
|
||||
|
||||
integer :: ispin, i
|
||||
do ispin=1,2
|
||||
do i=1,N_int
|
||||
generators_bitmask_restart(i,ispin,s_hole ,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,s_hole,k) )
|
||||
generators_bitmask_restart(i,ispin,s_part ,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,s_part,k) )
|
||||
generators_bitmask_restart(i,ispin,d_hole1,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,d_hole1,k) )
|
||||
generators_bitmask_restart(i,ispin,d_part1,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,d_part1,k) )
|
||||
generators_bitmask_restart(i,ispin,d_hole2,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,d_hole2,k) )
|
||||
generators_bitmask_restart(i,ispin,d_part2,k) = iand(full_ijkl_bitmask(i),generators_bitmask_restart(i,ispin,d_part2,k) )
|
||||
generators_bitmask(i,ispin,s_hole ) = reunion_of_inact_act_bitmask(i,ispin)
|
||||
generators_bitmask(i,ispin,s_part ) = reunion_of_act_virt_bitmask(i,ispin)
|
||||
generators_bitmask(i,ispin,d_hole1) = reunion_of_inact_act_bitmask(i,ispin)
|
||||
generators_bitmask(i,ispin,d_part1) = reunion_of_act_virt_bitmask(i,ispin)
|
||||
generators_bitmask(i,ispin,d_hole2) = reunion_of_inact_act_bitmask(i,ispin)
|
||||
generators_bitmask(i,ispin,d_part2) = reunion_of_act_virt_bitmask(i,ispin)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
IRP_IF MPI_DEBUG
|
||||
print *, irp_here, mpi_rank
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
IRP_ENDIF
|
||||
IRP_IF MPI
|
||||
include 'mpif.h'
|
||||
integer :: ierr
|
||||
call MPI_BCAST( generators_bitmask_restart, N_int*2*6*N_generators_bitmask_restart, MPI_BIT_KIND, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
stop 'Unable to read generators_bitmask_restart with MPI'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_bitmask) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmasks for generator determinants.
|
||||
! (N_int, alpha/beta, hole/particle, generator).
|
||||
!
|
||||
! 3rd index is :
|
||||
!
|
||||
! * 1 : hole for single exc
|
||||
!
|
||||
! * 2 : particle for single exc
|
||||
!
|
||||
! * 3 : hole for 1st exc of double
|
||||
!
|
||||
! * 4 : particle for 1st exc of double
|
||||
!
|
||||
! * 5 : hole for 2nd exc of double
|
||||
!
|
||||
! * 6 : particle for 2nd exc of double
|
||||
!
|
||||
END_DOC
|
||||
logical :: exists
|
||||
PROVIDE ezfio_filename full_ijkl_bitmask N_generators_bitmask
|
||||
|
||||
if (mpi_master) then
|
||||
call ezfio_has_bitmasks_generators(exists)
|
||||
if (exists) then
|
||||
call ezfio_get_bitmasks_generators(generators_bitmask)
|
||||
else
|
||||
integer :: k, ispin, i
|
||||
do k=1,N_generators_bitmask
|
||||
do ispin=1,2
|
||||
do i=1,N_int
|
||||
generators_bitmask(i,ispin,s_hole ,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask(i,ispin,s_part ,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask(i,ispin,d_hole1,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask(i,ispin,d_part1,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask(i,ispin,d_hole2,k) = full_ijkl_bitmask(i)
|
||||
generators_bitmask(i,ispin,d_part2,k) = full_ijkl_bitmask(i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
|
||||
do k=1,N_generators_bitmask
|
||||
do ispin=1,2
|
||||
do i=1,N_int
|
||||
generators_bitmask(i,ispin,s_hole ,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,s_hole,k) )
|
||||
generators_bitmask(i,ispin,s_part ,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,s_part,k) )
|
||||
generators_bitmask(i,ispin,d_hole1,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,d_hole1,k) )
|
||||
generators_bitmask(i,ispin,d_part1,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,d_part1,k) )
|
||||
generators_bitmask(i,ispin,d_hole2,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,d_hole2,k) )
|
||||
generators_bitmask(i,ispin,d_part2,k) = iand(full_ijkl_bitmask(i),generators_bitmask(i,ispin,d_part2,k) )
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
IRP_IF MPI_DEBUG
|
||||
print *, irp_here, mpi_rank
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
IRP_ENDIF
|
||||
IRP_IF MPI
|
||||
include 'mpif.h'
|
||||
integer :: ierr
|
||||
call MPI_BCAST( generators_bitmask, N_int*2*6*N_generators_bitmask, MPI_BIT_KIND, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
stop 'Unable to read generators_bitmask with MPI'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, N_cas_bitmask ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of bitmasks for CAS
|
||||
END_DOC
|
||||
logical :: exists
|
||||
PROVIDE ezfio_filename
|
||||
PROVIDE N_cas_bitmask N_int
|
||||
if (mpi_master) then
|
||||
call ezfio_has_bitmasks_N_mask_cas(exists)
|
||||
if (exists) then
|
||||
call ezfio_get_bitmasks_N_mask_cas(N_cas_bitmask)
|
||||
integer :: N_int_check
|
||||
integer :: bit_kind_check
|
||||
call ezfio_get_bitmasks_bit_kind(bit_kind_check)
|
||||
if (bit_kind_check /= bit_kind) then
|
||||
print *, bit_kind_check, bit_kind
|
||||
print *, 'Error: bit_kind is not correct in EZFIO file'
|
||||
endif
|
||||
call ezfio_get_bitmasks_N_int(N_int_check)
|
||||
if (N_int_check /= N_int) then
|
||||
print *, N_int_check, N_int
|
||||
print *, 'Error: N_int is not correct in EZFIO file'
|
||||
endif
|
||||
else
|
||||
N_cas_bitmask = 1
|
||||
endif
|
||||
call write_int(6,N_cas_bitmask,'N_cas_bitmask')
|
||||
endif
|
||||
ASSERT (N_cas_bitmask > 0)
|
||||
IRP_IF MPI_DEBUG
|
||||
print *, irp_here, mpi_rank
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
IRP_ENDIF
|
||||
IRP_IF MPI
|
||||
include 'mpif.h'
|
||||
integer :: ierr
|
||||
call MPI_BCAST( N_cas_bitmask, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
stop 'Unable to read N_cas_bitmask with MPI'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmasks for CAS reference determinants. (N_int, alpha/beta, CAS reference)
|
||||
END_DOC
|
||||
logical :: exists
|
||||
integer :: i,i_part,i_gen,j,k
|
||||
PROVIDE ezfio_filename generators_bitmask_restart full_ijkl_bitmask
|
||||
PROVIDE n_generators_bitmask HF_bitmask
|
||||
|
||||
if (mpi_master) then
|
||||
call ezfio_has_bitmasks_cas(exists)
|
||||
if (exists) then
|
||||
call ezfio_get_bitmasks_cas(cas_bitmask)
|
||||
else
|
||||
if(N_generators_bitmask == 1)then
|
||||
do j=1, N_cas_bitmask
|
||||
do i=1, N_int
|
||||
cas_bitmask(i,1,j) = iand(not(HF_bitmask(i,1)),full_ijkl_bitmask(i))
|
||||
cas_bitmask(i,2,j) = iand(not(HF_bitmask(i,2)),full_ijkl_bitmask(i))
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
i_part = 2
|
||||
i_gen = 1
|
||||
do j=1, N_cas_bitmask
|
||||
do i=1, N_int
|
||||
cas_bitmask(i,1,j) = generators_bitmask_restart(i,1,i_part,i_gen)
|
||||
cas_bitmask(i,2,j) = generators_bitmask_restart(i,2,i_part,i_gen)
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
endif
|
||||
do i=1,N_cas_bitmask
|
||||
do j = 1, N_cas_bitmask
|
||||
do k=1,N_int
|
||||
cas_bitmask(k,j,i) = iand(cas_bitmask(k,j,i),full_ijkl_bitmask(k))
|
||||
enddo
|
||||
enddo
|
||||
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_core_inact_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the core and inactive and virtual bitmasks
|
||||
END_DOC
|
||||
integer :: i
|
||||
do i = 1, N_int
|
||||
reunion_of_core_inact_bitmask(i,1) = ior(core_bitmask(i,1),inact_bitmask(i,1))
|
||||
reunion_of_core_inact_bitmask(i,2) = ior(core_bitmask(i,2),inact_bitmask(i,2))
|
||||
enddo
|
||||
write(*,*) 'Read CAS bitmask'
|
||||
endif
|
||||
IRP_IF MPI_DEBUG
|
||||
print *, irp_here, mpi_rank
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
IRP_ENDIF
|
||||
IRP_IF MPI
|
||||
include 'mpif.h'
|
||||
integer :: ierr
|
||||
call MPI_BCAST( cas_bitmask, N_int*2*N_cas_bitmask, MPI_BIT_KIND, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
stop 'Unable to read cas_bitmask with MPI'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, n_core_inact_orb ]
|
||||
implicit none
|
||||
integer :: i
|
||||
n_core_inact_orb = 0
|
||||
do i = 1, N_int
|
||||
n_core_inact_orb += popcnt(reunion_of_core_inact_bitmask(i,1))
|
||||
enddo
|
||||
ENd_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_core_inact_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the core and inactive and virtual bitmasks
|
||||
END_DOC
|
||||
integer :: i
|
||||
do i = 1, N_int
|
||||
reunion_of_core_inact_bitmask(i,1) = ior(core_bitmask(i,1),inact_bitmask(i,1))
|
||||
reunion_of_core_inact_bitmask(i,2) = ior(core_bitmask(i,2),inact_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
BEGIN_PROVIDER [integer(bit_kind), reunion_of_inact_act_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the inactive and active bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
|
||||
do i = 1, N_int
|
||||
reunion_of_inact_act_bitmask(i,1) = ior(inact_bitmask(i,1),act_bitmask(i,1))
|
||||
reunion_of_inact_act_bitmask(i,2) = ior(inact_bitmask(i,2),act_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer(bit_kind), reunion_of_act_virt_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the inactive and active bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
|
||||
do i = 1, N_int
|
||||
reunion_of_act_virt_bitmask(i,1) = ior(virt_bitmask(i,1),act_bitmask(i,1))
|
||||
reunion_of_act_virt_bitmask(i,2) = ior(virt_bitmask(i,2),act_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [integer(bit_kind), reunion_of_core_inact_act_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the core, inactive and active bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
|
||||
do i = 1, N_int
|
||||
reunion_of_core_inact_act_bitmask(i,1) = ior(reunion_of_core_inact_bitmask(i,1),act_bitmask(i,1))
|
||||
reunion_of_core_inact_act_bitmask(i,2) = ior(reunion_of_core_inact_bitmask(i,2),act_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
BEGIN_PROVIDER [integer(bit_kind), reunion_of_core_inact_act_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the core, inactive and active bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
|
||||
do i = 1, N_int
|
||||
reunion_of_core_inact_act_bitmask(i,1) = ior(reunion_of_core_inact_bitmask(i,1),act_bitmask(i,1))
|
||||
reunion_of_core_inact_act_bitmask(i,2) = ior(reunion_of_core_inact_bitmask(i,2),act_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the inactive, active and virtual bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
do i = 1, N_int
|
||||
reunion_of_bitmask(i,1) = ior(ior(cas_bitmask(i,1,1),inact_bitmask(i,1)),virt_bitmask(i,1))
|
||||
reunion_of_bitmask(i,2) = ior(ior(cas_bitmask(i,2,1),inact_bitmask(i,2)),virt_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the inactive, active and virtual bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
do i = 1, N_int
|
||||
reunion_of_bitmask(i,1) = ior(ior(act_bitmask(i,1),inact_bitmask(i,1)),virt_bitmask(i,1))
|
||||
reunion_of_bitmask(i,2) = ior(ior(act_bitmask(i,2),inact_bitmask(i,2)),virt_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), inact_virt_bitmask, (N_int,2)]
|
||||
&BEGIN_PROVIDER [ integer(bit_kind), core_inact_virt_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the inactive and virtual bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
do i = 1, N_int
|
||||
inact_virt_bitmask(i,1) = ior(inact_bitmask(i,1),virt_bitmask(i,1))
|
||||
inact_virt_bitmask(i,2) = ior(inact_bitmask(i,2),virt_bitmask(i,2))
|
||||
core_inact_virt_bitmask(i,1) = ior(core_bitmask(i,1),inact_virt_bitmask(i,1))
|
||||
core_inact_virt_bitmask(i,2) = ior(core_bitmask(i,2),inact_virt_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, i_bitmask_gen ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Current bitmask for the generators
|
||||
END_DOC
|
||||
i_bitmask_gen = 1
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the inactive and virtual bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
do i = 1, N_int
|
||||
inact_virt_bitmask(i,1) = ior(inact_bitmask(i,1),virt_bitmask(i,1))
|
||||
inact_virt_bitmask(i,2) = ior(inact_bitmask(i,2),virt_bitmask(i,2))
|
||||
core_inact_virt_bitmask(i,1) = ior(core_bitmask(i,1),inact_virt_bitmask(i,1))
|
||||
core_inact_virt_bitmask(i,2) = ior(core_bitmask(i,2),inact_virt_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), unpaired_alpha_electrons, (N_int)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmask reprenting the unpaired alpha electrons in the HF_bitmask
|
||||
END_DOC
|
||||
integer :: i
|
||||
unpaired_alpha_electrons = 0_bit_kind
|
||||
do i = 1, N_int
|
||||
unpaired_alpha_electrons(i) = xor(HF_bitmask(i,1),HF_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer(bit_kind), closed_shell_ref_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
integer :: i,j
|
||||
do i = 1, N_int
|
||||
closed_shell_ref_bitmask(i,1) = ior(ref_bitmask(i,1),cas_bitmask(i,1,1))
|
||||
closed_shell_ref_bitmask(i,2) = ior(ref_bitmask(i,2),cas_bitmask(i,2,1))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_cas_inact_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Reunion of the inactive, active and virtual bitmasks
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
do i = 1, N_int
|
||||
reunion_of_cas_inact_bitmask(i,1) = ior(act_bitmask(i,1),inact_bitmask(i,1))
|
||||
reunion_of_cas_inact_bitmask(i,2) = ior(act_bitmask(i,2),inact_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [integer, n_core_orb_allocate]
|
||||
implicit none
|
||||
n_core_orb_allocate = max(n_core_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, n_inact_orb_allocate]
|
||||
implicit none
|
||||
n_inact_orb_allocate = max(n_inact_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, n_virt_orb_allocate]
|
||||
implicit none
|
||||
n_virt_orb_allocate = max(n_virt_orb,1)
|
||||
END_PROVIDER
|
||||
BEGIN_PROVIDER [ integer(bit_kind), unpaired_alpha_electrons, (N_int)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmask reprenting the unpaired alpha electrons in the HF_bitmask
|
||||
END_DOC
|
||||
integer :: i
|
||||
unpaired_alpha_electrons = 0_bit_kind
|
||||
do i = 1, N_int
|
||||
unpaired_alpha_electrons(i) = xor(HF_bitmask(i,1),HF_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer(bit_kind), closed_shell_ref_bitmask, (N_int,2)]
|
||||
implicit none
|
||||
integer :: i,j
|
||||
do i = 1, N_int
|
||||
closed_shell_ref_bitmask(i,1) = ior(ref_bitmask(i,1),act_bitmask(i,1))
|
||||
closed_shell_ref_bitmask(i,2) = ior(ref_bitmask(i,2),act_bitmask(i,2))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
@ -33,7 +33,7 @@ subroutine bitstring_to_list( string, list, n_elements, Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Gives the inidices(+1) of the bits set to 1 in the bit string
|
||||
! Gives the indices(+1) of the bits set to 1 in the bit string
|
||||
END_DOC
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: string(Nint)
|
||||
@ -213,3 +213,34 @@ subroutine print_spindet(string,Nint)
|
||||
print *, trim(output(1))
|
||||
|
||||
end
|
||||
|
||||
logical function is_integer_in_string(bite,string,Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer, intent(in) :: bite,Nint
|
||||
integer(bit_kind), intent(in) :: string(Nint)
|
||||
integer(bit_kind) :: string_bite(Nint)
|
||||
integer :: i,itot,itot_and
|
||||
character*(2048) :: output(1)
|
||||
string_bite = 0_bit_kind
|
||||
call set_bit_to_integer(bite,string_bite,Nint)
|
||||
itot = 0
|
||||
itot_and = 0
|
||||
is_integer_in_string = .False.
|
||||
!print*,''
|
||||
!print*,''
|
||||
!print*,'bite = ',bite
|
||||
!call bitstring_to_str( output(1), string_bite, Nint )
|
||||
! print *, trim(output(1))
|
||||
!call bitstring_to_str( output(1), string, Nint )
|
||||
! print *, trim(output(1))
|
||||
do i = 1, Nint
|
||||
itot += popcnt(string(i))
|
||||
itot_and += popcnt(ior(string(i),string_bite(i)))
|
||||
enddo
|
||||
!print*,'itot,itot_and',itot,itot_and
|
||||
if(itot == itot_and)then
|
||||
is_integer_in_string = .True.
|
||||
endif
|
||||
!pause
|
||||
end
|
||||
|
@ -1,246 +1,415 @@
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [ integer, n_core_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of core MOs
|
||||
END_DOC
|
||||
integer :: i
|
||||
|
||||
n_core_orb = 0
|
||||
do i = 1, mo_num
|
||||
if(mo_class(i) == 'Core')then
|
||||
n_core_orb += 1
|
||||
endif
|
||||
enddo
|
||||
|
||||
call write_int(6,n_core_orb, 'Number of core MOs')
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, n_core_orb]
|
||||
&BEGIN_PROVIDER [ integer, n_inact_orb ]
|
||||
&BEGIN_PROVIDER [ integer, n_act_orb]
|
||||
&BEGIN_PROVIDER [ integer, n_virt_orb ]
|
||||
&BEGIN_PROVIDER [ integer, n_del_orb ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! inact_bitmask : Bitmask of the inactive orbitals which are supposed to be doubly excited
|
||||
! in post CAS methods
|
||||
! n_inact_orb : Number of inactive orbitals
|
||||
! virt_bitmask : Bitmaks of vritual orbitals which are supposed to be recieve electrons
|
||||
! in post CAS methods
|
||||
! n_virt_orb : Number of virtual orbitals
|
||||
! list_inact : List of the inactive orbitals which are supposed to be doubly excited
|
||||
! in post CAS methods
|
||||
! list_virt : List of vritual orbitals which are supposed to be recieve electrons
|
||||
! in post CAS methods
|
||||
! list_inact_reverse : reverse list of inactive orbitals
|
||||
! list_inact_reverse(i) = 0 ::> not an inactive
|
||||
! list_inact_reverse(i) = k ::> IS the kth inactive
|
||||
! list_virt_reverse : reverse list of virtual orbitals
|
||||
! list_virt_reverse(i) = 0 ::> not an virtual
|
||||
! list_virt_reverse(i) = k ::> IS the kth virtual
|
||||
! list_act(i) = index of the ith active orbital
|
||||
!
|
||||
! list_act_reverse : reverse list of active orbitals
|
||||
! list_act_reverse(i) = 0 ::> not an active
|
||||
! list_act_reverse(i) = k ::> IS the kth active orbital
|
||||
END_DOC
|
||||
logical :: exists
|
||||
integer :: j,i
|
||||
BEGIN_PROVIDER [ integer, n_inact_orb ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of inactive MOs
|
||||
END_DOC
|
||||
integer :: i
|
||||
|
||||
n_inact_orb = 0
|
||||
do i = 1, mo_num
|
||||
if (mo_class(i) == 'Inactive')then
|
||||
n_inact_orb += 1
|
||||
endif
|
||||
enddo
|
||||
|
||||
call write_int(6,n_inact_orb,'Number of inactive MOs')
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
n_core_orb = 0
|
||||
n_inact_orb = 0
|
||||
n_act_orb = 0
|
||||
n_virt_orb = 0
|
||||
n_del_orb = 0
|
||||
do i = 1, mo_num
|
||||
if(mo_class(i) == 'Core')then
|
||||
n_core_orb += 1
|
||||
else if (mo_class(i) == 'Inactive')then
|
||||
n_inact_orb += 1
|
||||
else if (mo_class(i) == 'Active')then
|
||||
n_act_orb += 1
|
||||
else if (mo_class(i) == 'Virtual')then
|
||||
n_virt_orb += 1
|
||||
else if (mo_class(i) == 'Deleted')then
|
||||
n_del_orb += 1
|
||||
endif
|
||||
enddo
|
||||
BEGIN_PROVIDER [ integer, n_act_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of active MOs
|
||||
END_DOC
|
||||
integer :: i
|
||||
|
||||
n_act_orb = 0
|
||||
do i = 1, mo_num
|
||||
if (mo_class(i) == 'Active')then
|
||||
n_act_orb += 1
|
||||
endif
|
||||
enddo
|
||||
|
||||
call write_int(6,n_act_orb, 'Number of active MOs')
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, n_virt_orb ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of virtual MOs
|
||||
END_DOC
|
||||
integer :: i
|
||||
|
||||
n_virt_orb = 0
|
||||
do i = 1, mo_num
|
||||
if (mo_class(i) == 'Virtual')then
|
||||
n_virt_orb += 1
|
||||
endif
|
||||
enddo
|
||||
|
||||
call write_int(6,n_virt_orb, 'Number of virtual MOs')
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, n_del_orb ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of deleted MOs
|
||||
END_DOC
|
||||
integer :: i
|
||||
|
||||
n_del_orb = 0
|
||||
do i = 1, mo_num
|
||||
if (mo_class(i) == 'Deleted')then
|
||||
n_del_orb += 1
|
||||
endif
|
||||
enddo
|
||||
|
||||
call write_int(6,n_del_orb, 'Number of deleted MOs')
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
call write_int(6,n_core_orb, 'Number of core MOs')
|
||||
call write_int(6,n_inact_orb,'Number of inactive MOs')
|
||||
call write_int(6,n_act_orb, 'Number of active MOs')
|
||||
call write_int(6,n_virt_orb, 'Number of virtual MOs')
|
||||
call write_int(6,n_del_orb, 'Number of deleted MOs')
|
||||
BEGIN_PROVIDER [ integer, n_core_inact_orb ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! n_core + n_inact
|
||||
END_DOC
|
||||
integer :: i
|
||||
n_core_inact_orb = 0
|
||||
do i = 1, N_int
|
||||
n_core_inact_orb += popcnt(reunion_of_core_inact_bitmask(i,1))
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, n_inact_act_orb ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! n_inact + n_act
|
||||
END_DOC
|
||||
n_inact_act_orb = (n_inact_orb+n_act_orb)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, dim_list_core_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! dimensions for the allocation of list_core.
|
||||
! it is at least 1
|
||||
END_DOC
|
||||
dim_list_core_orb = max(n_core_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, dim_list_inact_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! dimensions for the allocation of list_inact.
|
||||
! it is at least 1
|
||||
END_DOC
|
||||
dim_list_inact_orb = max(n_inact_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, dim_list_core_inact_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! dimensions for the allocation of list_core.
|
||||
! it is at least 1
|
||||
END_DOC
|
||||
dim_list_core_inact_orb = max(n_core_inact_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, dim_list_act_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! dimensions for the allocation of list_act.
|
||||
! it is at least 1
|
||||
END_DOC
|
||||
dim_list_act_orb = max(n_act_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, dim_list_virt_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! dimensions for the allocation of list_virt.
|
||||
! it is at least 1
|
||||
END_DOC
|
||||
dim_list_virt_orb = max(n_virt_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, dim_list_del_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! dimensions for the allocation of list_del.
|
||||
! it is at least 1
|
||||
END_DOC
|
||||
dim_list_del_orb = max(n_del_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, n_core_inact_act_orb ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of core inactive and active MOs
|
||||
END_DOC
|
||||
n_core_inact_act_orb = (n_core_orb + n_inact_orb + n_act_orb)
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), core_bitmask , (N_int,2) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmask identifying the core MOs
|
||||
END_DOC
|
||||
core_bitmask = 0_bit_kind
|
||||
if(n_core_orb > 0)then
|
||||
call list_to_bitstring( core_bitmask(1,1), list_core, n_core_orb, N_int)
|
||||
call list_to_bitstring( core_bitmask(1,2), list_core, n_core_orb, N_int)
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), inact_bitmask, (N_int,2) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmask identifying the inactive MOs
|
||||
END_DOC
|
||||
inact_bitmask = 0_bit_kind
|
||||
if(n_inact_orb > 0)then
|
||||
call list_to_bitstring( inact_bitmask(1,1), list_inact, n_inact_orb, N_int)
|
||||
call list_to_bitstring( inact_bitmask(1,2), list_inact, n_inact_orb, N_int)
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), act_bitmask , (N_int,2) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmask identifying the active MOs
|
||||
END_DOC
|
||||
act_bitmask = 0_bit_kind
|
||||
if(n_act_orb > 0)then
|
||||
call list_to_bitstring( act_bitmask(1,1), list_act, n_act_orb, N_int)
|
||||
call list_to_bitstring( act_bitmask(1,2), list_act, n_act_orb, N_int)
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask , (N_int,2) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmask identifying the virtual MOs
|
||||
END_DOC
|
||||
virt_bitmask = 0_bit_kind
|
||||
if(n_virt_orb > 0)then
|
||||
call list_to_bitstring( virt_bitmask(1,1), list_virt, n_virt_orb, N_int)
|
||||
call list_to_bitstring( virt_bitmask(1,2), list_virt, n_virt_orb, N_int)
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), del_bitmask , (N_int,2) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Bitmask identifying the deleted MOs
|
||||
END_DOC
|
||||
|
||||
del_bitmask = 0_bit_kind
|
||||
|
||||
if(n_del_orb > 0)then
|
||||
call list_to_bitstring( del_bitmask(1,1), list_del, n_del_orb, N_int)
|
||||
call list_to_bitstring( del_bitmask(1,2), list_del, n_del_orb, N_int)
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [integer, dim_list_core_orb]
|
||||
&BEGIN_PROVIDER [integer, dim_list_inact_orb]
|
||||
&BEGIN_PROVIDER [integer, dim_list_virt_orb]
|
||||
&BEGIN_PROVIDER [integer, dim_list_act_orb]
|
||||
&BEGIN_PROVIDER [integer, dim_list_del_orb]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! dimensions for the allocation of list_inact, list_virt, list_core and list_act
|
||||
! it is at least 1
|
||||
END_DOC
|
||||
dim_list_core_orb = max(n_core_orb,1)
|
||||
dim_list_inact_orb = max(n_inact_orb,1)
|
||||
dim_list_virt_orb = max(n_virt_orb,1)
|
||||
dim_list_act_orb = max(n_act_orb,1)
|
||||
dim_list_del_orb = max(n_del_orb,1)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_inact, (dim_list_inact_orb)]
|
||||
&BEGIN_PROVIDER [ integer, list_virt, (dim_list_virt_orb)]
|
||||
&BEGIN_PROVIDER [ integer, list_inact_reverse, (mo_num)]
|
||||
&BEGIN_PROVIDER [ integer, list_virt_reverse, (mo_num)]
|
||||
&BEGIN_PROVIDER [ integer, list_del_reverse, (mo_num)]
|
||||
&BEGIN_PROVIDER [ integer, list_del, (mo_num)]
|
||||
&BEGIN_PROVIDER [integer, list_core, (dim_list_core_orb)]
|
||||
&BEGIN_PROVIDER [integer, list_core_reverse, (mo_num)]
|
||||
&BEGIN_PROVIDER [integer, list_act, (dim_list_act_orb)]
|
||||
&BEGIN_PROVIDER [integer, list_act_reverse, (mo_num)]
|
||||
&BEGIN_PROVIDER [ integer(bit_kind), core_bitmask, (N_int,2)]
|
||||
&BEGIN_PROVIDER [ integer(bit_kind), inact_bitmask, (N_int,2) ]
|
||||
&BEGIN_PROVIDER [ integer(bit_kind), act_bitmask, (N_int,2) ]
|
||||
&BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask, (N_int,2) ]
|
||||
&BEGIN_PROVIDER [ integer(bit_kind), del_bitmask, (N_int,2) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! inact_bitmask : Bitmask of the inactive orbitals which are supposed to be doubly excited
|
||||
! in post CAS methods
|
||||
! n_inact_orb : Number of inactive orbitals
|
||||
! virt_bitmask : Bitmaks of vritual orbitals which are supposed to be recieve electrons
|
||||
! in post CAS methods
|
||||
! n_virt_orb : Number of virtual orbitals
|
||||
! list_inact : List of the inactive orbitals which are supposed to be doubly excited
|
||||
! in post CAS methods
|
||||
! list_virt : List of vritual orbitals which are supposed to be recieve electrons
|
||||
! in post CAS methods
|
||||
! list_inact_reverse : reverse list of inactive orbitals
|
||||
! list_inact_reverse(i) = 0 ::> not an inactive
|
||||
! list_inact_reverse(i) = k ::> IS the kth inactive
|
||||
! list_virt_reverse : reverse list of virtual orbitals
|
||||
! list_virt_reverse(i) = 0 ::> not an virtual
|
||||
! list_virt_reverse(i) = k ::> IS the kth virtual
|
||||
! list_act(i) = index of the ith active orbital
|
||||
!
|
||||
! list_act_reverse : reverse list of active orbitals
|
||||
! list_act_reverse(i) = 0 ::> not an active
|
||||
! list_act_reverse(i) = k ::> IS the kth active orbital
|
||||
END_DOC
|
||||
logical :: exists
|
||||
integer :: j,i
|
||||
integer :: n_core_orb_tmp, n_inact_orb_tmp, n_act_orb_tmp, n_virt_orb_tmp,n_del_orb_tmp
|
||||
integer :: list_core_tmp(N_int*bit_kind_size)
|
||||
integer :: list_inact_tmp(N_int*bit_kind_size)
|
||||
integer :: list_act_tmp(N_int*bit_kind_size)
|
||||
integer :: list_virt_tmp(N_int*bit_kind_size)
|
||||
integer :: list_del_tmp(N_int*bit_kind_size)
|
||||
list_core = 0
|
||||
list_inact = 0
|
||||
list_act = 0
|
||||
list_virt = 0
|
||||
list_del = 0
|
||||
list_core_reverse = 0
|
||||
list_inact_reverse = 0
|
||||
list_act_reverse = 0
|
||||
list_virt_reverse = 0
|
||||
list_del_reverse = 0
|
||||
n_core_orb_tmp = 0
|
||||
n_inact_orb_tmp = 0
|
||||
n_act_orb_tmp = 0
|
||||
n_virt_orb_tmp = 0
|
||||
n_del_orb_tmp = 0
|
||||
do i = 1, mo_num
|
||||
if(mo_class(i) == 'Core')then
|
||||
n_core_orb_tmp += 1
|
||||
list_core(n_core_orb_tmp) = i
|
||||
list_core_tmp(n_core_orb_tmp) = i
|
||||
list_core_reverse(i) = n_core_orb_tmp
|
||||
else if (mo_class(i) == 'Inactive')then
|
||||
n_inact_orb_tmp += 1
|
||||
list_inact(n_inact_orb_tmp) = i
|
||||
list_inact_tmp(n_inact_orb_tmp) = i
|
||||
list_inact_reverse(i) = n_inact_orb_tmp
|
||||
else if (mo_class(i) == 'Active')then
|
||||
n_act_orb_tmp += 1
|
||||
list_act(n_act_orb_tmp) = i
|
||||
list_act_tmp(n_act_orb_tmp) = i
|
||||
list_act_reverse(i) = n_act_orb_tmp
|
||||
else if (mo_class(i) == 'Virtual')then
|
||||
n_virt_orb_tmp += 1
|
||||
list_virt(n_virt_orb_tmp) = i
|
||||
list_virt_tmp(n_virt_orb_tmp) = i
|
||||
list_virt_reverse(i) = n_virt_orb_tmp
|
||||
else if (mo_class(i) == 'Deleted')then
|
||||
n_del_orb_tmp += 1
|
||||
list_del(n_del_orb_tmp) = i
|
||||
list_del_tmp(n_del_orb_tmp) = i
|
||||
list_del_reverse(i) = n_del_orb_tmp
|
||||
endif
|
||||
enddo
|
||||
|
||||
if(n_core_orb.ne.0)then
|
||||
call list_to_bitstring( core_bitmask(1,1), list_core, n_core_orb, N_int)
|
||||
call list_to_bitstring( core_bitmask(1,2), list_core, n_core_orb, N_int)
|
||||
endif
|
||||
if(n_inact_orb.ne.0)then
|
||||
call list_to_bitstring( inact_bitmask(1,1), list_inact, n_inact_orb, N_int)
|
||||
call list_to_bitstring( inact_bitmask(1,2), list_inact, n_inact_orb, N_int)
|
||||
endif
|
||||
if(n_act_orb.ne.0)then
|
||||
call list_to_bitstring( act_bitmask(1,1), list_act, n_act_orb, N_int)
|
||||
call list_to_bitstring( act_bitmask(1,2), list_act, n_act_orb, N_int)
|
||||
endif
|
||||
if(n_virt_orb.ne.0)then
|
||||
call list_to_bitstring( virt_bitmask(1,1), list_virt, n_virt_orb, N_int)
|
||||
call list_to_bitstring( virt_bitmask(1,2), list_virt, n_virt_orb, N_int)
|
||||
endif
|
||||
if(n_del_orb.ne.0)then
|
||||
call list_to_bitstring( del_bitmask(1,1), list_del, n_del_orb, N_int)
|
||||
call list_to_bitstring( del_bitmask(1,2), list_del, n_del_orb, N_int)
|
||||
endif
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_core , (dim_list_core_orb) ]
|
||||
&BEGIN_PROVIDER [ integer, list_core_reverse, (mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! List of MO indices which are in the core.
|
||||
END_DOC
|
||||
integer :: i, n
|
||||
list_core = 0
|
||||
list_core_reverse = 0
|
||||
|
||||
BEGIN_PROVIDER [integer, n_inact_act_orb ]
|
||||
implicit none
|
||||
n_inact_act_orb = (n_inact_orb+n_act_orb)
|
||||
n=0
|
||||
do i = 1, mo_num
|
||||
if(mo_class(i) == 'Core')then
|
||||
n += 1
|
||||
list_core(n) = i
|
||||
list_core_reverse(i) = n
|
||||
endif
|
||||
enddo
|
||||
print *, 'Core MOs:'
|
||||
print *, list_core(1:n_core_orb)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_inact , (dim_list_inact_orb) ]
|
||||
&BEGIN_PROVIDER [ integer, list_inact_reverse, (mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! List of MO indices which are inactive.
|
||||
END_DOC
|
||||
integer :: i, n
|
||||
list_inact = 0
|
||||
list_inact_reverse = 0
|
||||
|
||||
END_PROVIDER
|
||||
n=0
|
||||
do i = 1, mo_num
|
||||
if (mo_class(i) == 'Inactive')then
|
||||
n += 1
|
||||
list_inact(n) = i
|
||||
list_inact_reverse(i) = n
|
||||
endif
|
||||
enddo
|
||||
print *, 'Inactive MOs:'
|
||||
print *, list_inact(1:n_inact_orb)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_virt , (dim_list_virt_orb) ]
|
||||
&BEGIN_PROVIDER [ integer, list_virt_reverse, (mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! List of MO indices which are virtual
|
||||
END_DOC
|
||||
integer :: i, n
|
||||
list_virt = 0
|
||||
list_virt_reverse = 0
|
||||
|
||||
BEGIN_PROVIDER [integer, list_inact_act, (n_inact_act_orb)]
|
||||
integer :: i,itmp
|
||||
itmp = 0
|
||||
do i = 1, n_inact_orb
|
||||
itmp += 1
|
||||
list_inact_act(itmp) = list_inact(i)
|
||||
enddo
|
||||
do i = 1, n_act_orb
|
||||
itmp += 1
|
||||
list_inact_act(itmp) = list_act(i)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
n=0
|
||||
do i = 1, mo_num
|
||||
if (mo_class(i) == 'Virtual')then
|
||||
n += 1
|
||||
list_virt(n) = i
|
||||
list_virt_reverse(i) = n
|
||||
endif
|
||||
enddo
|
||||
print *, 'Virtual MOs:'
|
||||
print *, list_virt(1:n_virt_orb)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_del , (dim_list_del_orb) ]
|
||||
&BEGIN_PROVIDER [ integer, list_del_reverse, (mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! List of MO indices which are deleted.
|
||||
END_DOC
|
||||
integer :: i, n
|
||||
list_del = 0
|
||||
list_del_reverse = 0
|
||||
|
||||
BEGIN_PROVIDER [integer, n_core_inact_act_orb ]
|
||||
implicit none
|
||||
n_core_inact_act_orb = (n_core_orb + n_inact_orb + n_act_orb)
|
||||
n=0
|
||||
do i = 1, mo_num
|
||||
if (mo_class(i) == 'Deleted')then
|
||||
n += 1
|
||||
list_del(n) = i
|
||||
list_del_reverse(i) = n
|
||||
endif
|
||||
enddo
|
||||
print *, 'Deleted MOs:'
|
||||
print *, list_del(1:n_del_orb)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_act , (dim_list_act_orb) ]
|
||||
&BEGIN_PROVIDER [ integer, list_act_reverse, (mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! List of MO indices which are in the active.
|
||||
END_DOC
|
||||
integer :: i, n
|
||||
list_act = 0
|
||||
list_act_reverse = 0
|
||||
|
||||
END_PROVIDER
|
||||
n=0
|
||||
do i = 1, mo_num
|
||||
if (mo_class(i) == 'Active')then
|
||||
n += 1
|
||||
list_act(n) = i
|
||||
list_act_reverse(i) = n
|
||||
endif
|
||||
enddo
|
||||
print *, 'Active MOs:'
|
||||
print *, list_act(1:n_act_orb)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [integer, list_core_inact_act, (n_core_inact_act_orb)]
|
||||
&BEGIN_PROVIDER [ integer, list_core_inact_act_reverse, (n_core_inact_act_orb)]
|
||||
integer :: i,itmp
|
||||
itmp = 0
|
||||
do i = 1, n_core_orb
|
||||
itmp += 1
|
||||
list_core_inact_act(itmp) = list_core(i)
|
||||
enddo
|
||||
do i = 1, n_inact_orb
|
||||
itmp += 1
|
||||
list_core_inact_act(itmp) = list_inact(i)
|
||||
enddo
|
||||
do i = 1, n_act_orb
|
||||
itmp += 1
|
||||
list_core_inact_act(itmp) = list_act(i)
|
||||
enddo
|
||||
|
||||
integer :: occ_inact(N_int*bit_kind_size)
|
||||
occ_inact = 0
|
||||
call bitstring_to_list(reunion_of_core_inact_act_bitmask(1,1), occ_inact(1), itest, N_int)
|
||||
list_inact_reverse = 0
|
||||
do i = 1, n_core_inact_act_orb
|
||||
list_core_inact_act_reverse(occ_inact(i)) = i
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_core_inact , (dim_list_core_inact_orb) ]
|
||||
&BEGIN_PROVIDER [ integer, list_core_inact_reverse, (mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! List of indices of the core and inactive MOs
|
||||
END_DOC
|
||||
integer :: i,itmp
|
||||
call bitstring_to_list(reunion_of_core_inact_bitmask(1,1), list_core_inact, itmp, N_int)
|
||||
list_core_inact_reverse = 0
|
||||
ASSERT (itmp == n_core_inact_orb)
|
||||
do i = 1, n_core_inact_orb
|
||||
list_core_inact_reverse(list_core_inact(i)) = i
|
||||
enddo
|
||||
print *, 'Core and Inactive MOs:'
|
||||
print *, list_core_inact(1:n_core_inact_orb)
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_core_inact_act , (n_core_inact_act_orb) ]
|
||||
&BEGIN_PROVIDER [ integer, list_core_inact_act_reverse, (mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! List of indices of the core inactive and active MOs
|
||||
END_DOC
|
||||
integer :: i,itmp
|
||||
call bitstring_to_list(reunion_of_core_inact_act_bitmask(1,1), list_core_inact_act, itmp, N_int)
|
||||
list_core_inact_act_reverse = 0
|
||||
ASSERT (itmp == n_core_inact_act_orb)
|
||||
do i = 1, n_core_inact_act_orb
|
||||
list_core_inact_act_reverse(list_core_inact_act(i)) = i
|
||||
enddo
|
||||
print *, 'Core, Inactive and Active MOs:'
|
||||
print *, list_core_inact_act(1:n_core_inact_act_orb)
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_inact_act , (n_inact_act_orb) ]
|
||||
&BEGIN_PROVIDER [ integer, list_inact_act_reverse, (mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! List of indices of the inactive and active MOs
|
||||
END_DOC
|
||||
integer :: i,itmp
|
||||
call bitstring_to_list(reunion_of_inact_act_bitmask(1,1), list_inact_act, itmp, N_int)
|
||||
list_inact_act_reverse = 0
|
||||
ASSERT (itmp == n_inact_act_orb)
|
||||
do i = 1, n_inact_act_orb
|
||||
list_inact_act_reverse(list_inact_act(i)) = i
|
||||
enddo
|
||||
print *, 'Inactive and Active MOs:'
|
||||
print *, list_inact_act(1:n_inact_act_orb)
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -1,26 +1,5 @@
|
||||
|
||||
use bitmasks
|
||||
subroutine initialize_bitmask_to_restart_ones
|
||||
implicit none
|
||||
integer :: i,j,k,l,m
|
||||
integer :: ispin
|
||||
BEGIN_DOC
|
||||
! Initialization of the generators_bitmask to the restart bitmask
|
||||
END_DOC
|
||||
do i = 1, N_int
|
||||
do k=1,N_generators_bitmask
|
||||
do ispin=1,2
|
||||
generators_bitmask(i,ispin,s_hole ,k) = generators_bitmask_restart(i,ispin,s_hole ,k)
|
||||
generators_bitmask(i,ispin,s_part ,k) = generators_bitmask_restart(i,ispin,s_part ,k)
|
||||
generators_bitmask(i,ispin,d_hole1,k) = generators_bitmask_restart(i,ispin,d_hole1,k)
|
||||
generators_bitmask(i,ispin,d_part1,k) = generators_bitmask_restart(i,ispin,d_part1,k)
|
||||
generators_bitmask(i,ispin,d_hole2,k) = generators_bitmask_restart(i,ispin,d_hole2,k)
|
||||
generators_bitmask(i,ispin,d_part2,k) = generators_bitmask_restart(i,ispin,d_part2,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
end
|
||||
|
||||
|
||||
subroutine modify_bitmasks_for_hole(i_hole)
|
||||
implicit none
|
||||
@ -33,26 +12,22 @@ subroutine modify_bitmasks_for_hole(i_hole)
|
||||
END_DOC
|
||||
|
||||
! Set to Zero the holes
|
||||
do k=1,N_generators_bitmask
|
||||
do l = 1, 3
|
||||
do l = 1, 3
|
||||
i = index_holes_bitmask(l)
|
||||
do ispin=1,2
|
||||
do j = 1, N_int
|
||||
generators_bitmask(j,ispin,i,k) = 0_bit_kind
|
||||
generators_bitmask(j,ispin,i) = 0_bit_kind
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
do m = 1, N_generators_bitmask
|
||||
do l = 1, 3
|
||||
do l = 1, 3
|
||||
i = index_holes_bitmask(l)
|
||||
do ispin=1,2
|
||||
generators_bitmask(k,ispin,i,m) = ibset(generators_bitmask(k,ispin,i,m),j)
|
||||
generators_bitmask(k,ispin,i) = ibset(generators_bitmask(k,ispin,i),j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
@ -69,13 +44,11 @@ subroutine modify_bitmasks_for_hole_in_out(i_hole)
|
||||
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
do m = 1, N_generators_bitmask
|
||||
do l = 1, 3
|
||||
do l = 1, 3
|
||||
i = index_holes_bitmask(l)
|
||||
do ispin=1,2
|
||||
generators_bitmask(k,ispin,i,m) = ibset(generators_bitmask(k,ispin,i,m),j)
|
||||
generators_bitmask(k,ispin,i) = ibset(generators_bitmask(k,ispin,i),j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
@ -91,75 +64,67 @@ subroutine modify_bitmasks_for_particl(i_part)
|
||||
END_DOC
|
||||
|
||||
! Set to Zero the particles
|
||||
do k=1,N_generators_bitmask
|
||||
do l = 1, 3
|
||||
do l = 1, 3
|
||||
i = index_particl_bitmask(l)
|
||||
do ispin=1,2
|
||||
do ispin=1,2
|
||||
do j = 1, N_int
|
||||
generators_bitmask(j,ispin,i,k) = 0_bit_kind
|
||||
generators_bitmask(j,ispin,i) = 0_bit_kind
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
k = shiftr(i_part-1,bit_kind_shift)+1
|
||||
j = i_part-shiftl(k-1,bit_kind_shift)-1
|
||||
do m = 1, N_generators_bitmask
|
||||
do l = 1, 3
|
||||
do l = 1, 3
|
||||
i = index_particl_bitmask(l)
|
||||
do ispin=1,2
|
||||
generators_bitmask(k,ispin,i,m) = ibset(generators_bitmask(k,ispin,i,m),j)
|
||||
generators_bitmask(k,ispin,i) = ibset(generators_bitmask(k,ispin,i),j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
|
||||
subroutine set_bitmask_particl_as_input(input_bimask)
|
||||
subroutine set_bitmask_particl_as_input(input_bitmask)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: input_bimask(N_int,2)
|
||||
integer(bit_kind), intent(in) :: input_bitmask(N_int,2)
|
||||
integer :: i,j,k,l,m
|
||||
integer :: ispin
|
||||
BEGIN_DOC
|
||||
! set the generators_bitmask for the particles
|
||||
! as the input_bimask
|
||||
! as the input_bitmask
|
||||
END_DOC
|
||||
|
||||
do k=1,N_generators_bitmask
|
||||
do l = 1, 3
|
||||
do l = 1, 3
|
||||
i = index_particl_bitmask(l)
|
||||
do ispin=1,2
|
||||
do ispin=1,2
|
||||
do j = 1, N_int
|
||||
generators_bitmask(j,ispin,i,k) = input_bimask(j,ispin)
|
||||
generators_bitmask(j,ispin,i) = input_bitmask(j,ispin)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
touch generators_bitmask
|
||||
|
||||
end
|
||||
|
||||
|
||||
subroutine set_bitmask_hole_as_input(input_bimask)
|
||||
subroutine set_bitmask_hole_as_input(input_bitmask)
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: input_bimask(N_int,2)
|
||||
integer(bit_kind), intent(in) :: input_bitmask(N_int,2)
|
||||
integer :: i,j,k,l,m
|
||||
integer :: ispin
|
||||
BEGIN_DOC
|
||||
! set the generators_bitmask for the holes
|
||||
! as the input_bimask
|
||||
! as the input_bitmask
|
||||
END_DOC
|
||||
|
||||
do k=1,N_generators_bitmask
|
||||
do l = 1, 3
|
||||
do l = 1, 3
|
||||
i = index_holes_bitmask(l)
|
||||
do ispin=1,2
|
||||
do j = 1, N_int
|
||||
generators_bitmask(j,ispin,i,k) = input_bimask(j,ispin)
|
||||
generators_bitmask(j,ispin,i) = input_bitmask(j,ispin)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
touch generators_bitmask
|
||||
|
||||
@ -173,11 +138,10 @@ subroutine print_generators_bitmasks_holes
|
||||
|
||||
allocate(key_tmp(N_int,2))
|
||||
do l = 1, 3
|
||||
k = 1
|
||||
i = index_holes_bitmask(l)
|
||||
i = index_holes_bitmask(l)
|
||||
do j = 1, N_int
|
||||
key_tmp(j,1) = generators_bitmask(j,1,i,k)
|
||||
key_tmp(j,2) = generators_bitmask(j,2,i,k)
|
||||
key_tmp(j,1) = generators_bitmask(j,1,i)
|
||||
key_tmp(j,2) = generators_bitmask(j,2,i)
|
||||
enddo
|
||||
print*,''
|
||||
print*,'index hole = ',i
|
||||
@ -195,57 +159,10 @@ subroutine print_generators_bitmasks_particles
|
||||
|
||||
allocate(key_tmp(N_int,2))
|
||||
do l = 1, 3
|
||||
k = 1
|
||||
i = index_particl_bitmask(l)
|
||||
i = index_particl_bitmask(l)
|
||||
do j = 1, N_int
|
||||
key_tmp(j,1) = generators_bitmask(j,1,i,k)
|
||||
key_tmp(j,2) = generators_bitmask(j,2,i,k)
|
||||
enddo
|
||||
print*,''
|
||||
print*,'index particl ',i
|
||||
call print_det(key_tmp,N_int)
|
||||
print*,''
|
||||
enddo
|
||||
deallocate(key_tmp)
|
||||
|
||||
end
|
||||
|
||||
subroutine print_generators_bitmasks_holes_for_one_generator(i_gen)
|
||||
implicit none
|
||||
integer, intent(in) :: i_gen
|
||||
integer :: i,j,k,l
|
||||
integer(bit_kind),allocatable :: key_tmp(:,:)
|
||||
|
||||
allocate(key_tmp(N_int,2))
|
||||
do l = 1, 3
|
||||
k = i_gen
|
||||
i = index_holes_bitmask(l)
|
||||
do j = 1, N_int
|
||||
key_tmp(j,1) = generators_bitmask(j,1,i,k)
|
||||
key_tmp(j,2) = generators_bitmask(j,2,i,k)
|
||||
enddo
|
||||
print*,''
|
||||
print*,'index hole = ',i
|
||||
call print_det(key_tmp,N_int)
|
||||
print*,''
|
||||
enddo
|
||||
deallocate(key_tmp)
|
||||
|
||||
end
|
||||
|
||||
subroutine print_generators_bitmasks_particles_for_one_generator(i_gen)
|
||||
implicit none
|
||||
integer, intent(in) :: i_gen
|
||||
integer :: i,j,k,l
|
||||
integer(bit_kind),allocatable :: key_tmp(:,:)
|
||||
|
||||
allocate(key_tmp(N_int,2))
|
||||
do l = 1, 3
|
||||
k = i_gen
|
||||
i = index_particl_bitmask(l)
|
||||
do j = 1, N_int
|
||||
key_tmp(j,1) = generators_bitmask(j,1,i,k)
|
||||
key_tmp(j,2) = generators_bitmask(j,2,i,k)
|
||||
key_tmp(j,1) = generators_bitmask(j,1,i)
|
||||
key_tmp(j,2) = generators_bitmask(j,2,i)
|
||||
enddo
|
||||
print*,''
|
||||
print*,'index particl ',i
|
||||
@ -257,7 +174,7 @@ subroutine print_generators_bitmasks_particles_for_one_generator(i_gen)
|
||||
end
|
||||
|
||||
|
||||
BEGIN_PROVIDER [integer, index_holes_bitmask, (3)]
|
||||
BEGIN_PROVIDER [integer, index_holes_bitmask, (3)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Index of the holes in the generators_bitmasks
|
||||
|
49
src/casscf/50.casscf.bats
Normal file
49
src/casscf/50.casscf.bats
Normal file
@ -0,0 +1,49 @@
|
||||
#!/usr/bin/env bats
|
||||
|
||||
source $QP_ROOT/tests/bats/common.bats.sh
|
||||
source $QP_ROOT/quantum_package.rc
|
||||
|
||||
|
||||
function run_stoch() {
|
||||
thresh=$2
|
||||
test_exe casscf || skip
|
||||
qp set perturbation do_pt2 True
|
||||
qp set determinants n_det_max $3
|
||||
qp set davidson threshold_davidson 1.e-10
|
||||
qp set davidson n_states_diag 4
|
||||
qp run casscf | tee casscf.out
|
||||
energy1="$(ezfio get casscf energy_pt2 | tr '[]' ' ' | cut -d ',' -f 1)"
|
||||
eq $energy1 $1 $thresh
|
||||
}
|
||||
|
||||
@test "F2" { # 18.0198s
|
||||
rm -rf f2_casscf
|
||||
qp_create_ezfio -b aug-cc-pvdz ../input/f2.zmt -o f2_casscf
|
||||
qp set_file f2_casscf
|
||||
qp run scf
|
||||
qp set_mo_class --core="[1-6,8-9]" --act="[7,10]" --virt="[11-46]"
|
||||
run_stoch -198.773366970 1.e-4 100000
|
||||
}
|
||||
|
||||
@test "N2" { # 18.0198s
|
||||
rm -rf n2_casscf
|
||||
qp_create_ezfio -b aug-cc-pvdz ../input/n2.xyz -o n2_casscf
|
||||
qp set_file n2_casscf
|
||||
qp run scf
|
||||
qp set_mo_class --core="[1-4]" --act="[5-10]" --virt="[11-46]"
|
||||
run_stoch -109.0961643162 1.e-4 100000
|
||||
}
|
||||
|
||||
@test "N2_stretched" {
|
||||
rm -rf n2_stretched_casscf
|
||||
qp_create_ezfio -b aug-cc-pvdz -m 7 ../input/n2_stretched.xyz -o n2_stretched_casscf
|
||||
qp set_file n2_stretched_casscf
|
||||
qp run scf | tee scf.out
|
||||
qp set_mo_class --core="[1-4]" --act="[5-10]" --virt="[11-46]"
|
||||
qp set electrons elec_alpha_num 7
|
||||
qp set electrons elec_beta_num 7
|
||||
run_stoch -108.7860471300 1.e-4 100000
|
||||
#
|
||||
|
||||
}
|
||||
|
31
src/casscf/EZFIO.cfg
Normal file
31
src/casscf/EZFIO.cfg
Normal file
@ -0,0 +1,31 @@
|
||||
[energy]
|
||||
type: double precision
|
||||
doc: Calculated Selected |FCI| energy
|
||||
interface: ezfio
|
||||
size: (determinants.n_states)
|
||||
|
||||
[energy_pt2]
|
||||
type: double precision
|
||||
doc: Calculated |FCI| energy + |PT2|
|
||||
interface: ezfio
|
||||
size: (determinants.n_states)
|
||||
|
||||
[cisd_guess]
|
||||
type: logical
|
||||
doc: If true, the CASSCF starts with a CISD wave function
|
||||
interface: ezfio,provider,ocaml
|
||||
default: True
|
||||
|
||||
[state_following_casscf]
|
||||
type: logical
|
||||
doc: If |true|, the CASSCF will try to follow the guess CI vector and orbitals
|
||||
interface: ezfio,provider,ocaml
|
||||
default: False
|
||||
|
||||
|
||||
[level_shift_casscf]
|
||||
type: Positive_float
|
||||
doc: Energy shift on the virtual MOs to improve SCF convergence
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 0.005
|
||||
|
1
src/casscf/MORALITY
Normal file
1
src/casscf/MORALITY
Normal file
@ -0,0 +1 @@
|
||||
the CASCF can be obtained if a proper guess is given to the WF part
|
4
src/casscf/NEED
Normal file
4
src/casscf/NEED
Normal file
@ -0,0 +1,4 @@
|
||||
cipsi
|
||||
selectors_full
|
||||
generators_cas
|
||||
two_body_rdm
|
5
src/casscf/README.rst
Normal file
5
src/casscf/README.rst
Normal file
@ -0,0 +1,5 @@
|
||||
======
|
||||
casscf
|
||||
======
|
||||
|
||||
|CASSCF| program with the CIPSI algorithm.
|
6
src/casscf/bavard.irp.f
Normal file
6
src/casscf/bavard.irp.f
Normal file
@ -0,0 +1,6 @@
|
||||
! -*- F90 -*-
|
||||
BEGIN_PROVIDER [logical, bavard]
|
||||
! bavard=.true.
|
||||
bavard=.false.
|
||||
END_PROVIDER
|
||||
|
155
src/casscf/bielec.irp.f
Normal file
155
src/casscf/bielec.irp.f
Normal file
@ -0,0 +1,155 @@
|
||||
BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_act_orb,n_core_inact_act_orb)]
|
||||
BEGIN_DOC
|
||||
! bielec_PQxx : integral (pq|xx) with p,q arbitrary, x core or active
|
||||
! indices are unshifted orbital numbers
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,ii,jj,p,q,i3,j3,t3,v3
|
||||
real*8 :: mo_two_e_integral
|
||||
|
||||
bielec_PQxx(:,:,:,:) = 0.d0
|
||||
PROVIDE mo_two_e_integrals_in_map
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i,ii,j,jj,i3,j3) &
|
||||
!$OMP SHARED(n_core_inact_orb,list_core_inact,mo_num,bielec_PQxx, &
|
||||
!$OMP n_act_orb,mo_integrals_map,list_act)
|
||||
|
||||
!$OMP DO
|
||||
do i=1,n_core_inact_orb
|
||||
ii=list_core_inact(i)
|
||||
do j=i,n_core_inact_orb
|
||||
jj=list_core_inact(j)
|
||||
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j),mo_integrals_map)
|
||||
bielec_PQxx(:,:,j,i)=bielec_PQxx(:,:,i,j)
|
||||
end do
|
||||
do j=1,n_act_orb
|
||||
jj=list_act(j)
|
||||
j3=j+n_core_inact_orb
|
||||
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j3),mo_integrals_map)
|
||||
bielec_PQxx(:,:,j3,i)=bielec_PQxx(:,:,i,j3)
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
!$OMP DO
|
||||
do i=1,n_act_orb
|
||||
ii=list_act(i)
|
||||
i3=i+n_core_inact_orb
|
||||
do j=i,n_act_orb
|
||||
jj=list_act(j)
|
||||
j3=j+n_core_inact_orb
|
||||
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i3,j3),mo_integrals_map)
|
||||
bielec_PQxx(:,:,j3,i3)=bielec_PQxx(:,:,i3,j3)
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_inact_act_orb,n_core_inact_act_orb, mo_num)]
|
||||
BEGIN_DOC
|
||||
! bielec_PxxQ : integral (px|xq) with p,q arbitrary, x core or active
|
||||
! indices are unshifted orbital numbers
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,ii,jj,p,q,i3,j3,t3,v3
|
||||
double precision, allocatable :: integrals_array(:,:)
|
||||
real*8 :: mo_two_e_integral
|
||||
|
||||
PROVIDE mo_two_e_integrals_in_map
|
||||
bielec_PxxQ = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i,ii,j,jj,i3,j3,integrals_array) &
|
||||
!$OMP SHARED(n_core_inact_orb,list_core_inact,mo_num,bielec_PxxQ, &
|
||||
!$OMP n_act_orb,mo_integrals_map,list_act)
|
||||
|
||||
allocate(integrals_array(mo_num,mo_num))
|
||||
|
||||
!$OMP DO
|
||||
do i=1,n_core_inact_orb
|
||||
ii=list_core_inact(i)
|
||||
do j=i,n_core_inact_orb
|
||||
jj=list_core_inact(j)
|
||||
call get_mo_two_e_integrals_ij(ii,jj,mo_num,integrals_array,mo_integrals_map)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
bielec_PxxQ(p,i,j,q)=integrals_array(p,q)
|
||||
bielec_PxxQ(p,j,i,q)=integrals_array(q,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
do j=1,n_act_orb
|
||||
jj=list_act(j)
|
||||
j3=j+n_core_inact_orb
|
||||
call get_mo_two_e_integrals_ij(ii,jj,mo_num,integrals_array,mo_integrals_map)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
bielec_PxxQ(p,i,j3,q)=integrals_array(p,q)
|
||||
bielec_PxxQ(p,j3,i,q)=integrals_array(q,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! (ip|qj)
|
||||
!$OMP DO
|
||||
do i=1,n_act_orb
|
||||
ii=list_act(i)
|
||||
i3=i+n_core_inact_orb
|
||||
do j=i,n_act_orb
|
||||
jj=list_act(j)
|
||||
j3=j+n_core_inact_orb
|
||||
call get_mo_two_e_integrals_ij(ii,jj,mo_num,integrals_array,mo_integrals_map)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
bielec_PxxQ(p,i3,j3,q)=integrals_array(p,q)
|
||||
bielec_PxxQ(p,j3,i3,q)=integrals_array(q,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
deallocate(integrals_array)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, bielecCI, (n_act_orb,n_act_orb,n_act_orb, mo_num)]
|
||||
BEGIN_DOC
|
||||
! bielecCI : integrals (tu|vp) with p arbitrary, tuv active
|
||||
! index p runs over the whole basis, t,u,v only over the active orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,p,t,u,v
|
||||
double precision, external :: mo_two_e_integral
|
||||
PROVIDE mo_two_e_integrals_in_map
|
||||
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i,j,k,p,t,u,v) &
|
||||
!$OMP SHARED(mo_num,n_act_orb,list_act,bielecCI)
|
||||
do p=1,mo_num
|
||||
do j=1,n_act_orb
|
||||
u=list_act(j)
|
||||
do k=1,n_act_orb
|
||||
v=list_act(k)
|
||||
do i=1,n_act_orb
|
||||
t=list_act(i)
|
||||
bielecCI(i,k,j,p) = mo_two_e_integral(t,u,v,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
END_PROVIDER
|
369
src/casscf/bielec_natorb.irp.f
Normal file
369
src/casscf/bielec_natorb.irp.f
Normal file
@ -0,0 +1,369 @@
|
||||
BEGIN_PROVIDER [real*8, bielec_PQxx_no, (mo_num, mo_num,n_core_inact_act_orb,n_core_inact_act_orb)]
|
||||
BEGIN_DOC
|
||||
! integral (pq|xx) in the basis of natural MOs
|
||||
! indices are unshifted orbital numbers
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,l,t,u,p,q
|
||||
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||
|
||||
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j,k,l,p,d,f) &
|
||||
!$OMP SHARED(n_core_inact_act_orb,mo_num,n_act_orb,n_core_inact_orb, &
|
||||
!$OMP bielec_PQxx_no,bielec_PQxx,list_act,natorbsCI)
|
||||
|
||||
allocate (f(n_act_orb,mo_num,n_core_inact_act_orb), &
|
||||
d(n_act_orb,mo_num,n_core_inact_act_orb))
|
||||
|
||||
!$OMP DO
|
||||
do l=1,n_core_inact_act_orb
|
||||
bielec_PQxx_no(:,:,:,l) = bielec_PQxx(:,:,:,l)
|
||||
|
||||
do k=1,n_core_inact_act_orb
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
f(p,j,k)=bielec_PQxx_no(list_act(p),j,k,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',n_act_orb,mo_num*n_core_inact_act_orb,n_act_orb,1.d0, &
|
||||
natorbsCI, size(natorbsCI,1), &
|
||||
f, n_act_orb, &
|
||||
0.d0, &
|
||||
d, n_act_orb)
|
||||
do k=1,n_core_inact_act_orb
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
bielec_PQxx_no(list_act(p),j,k,l)=d(p,j,k)
|
||||
end do
|
||||
end do
|
||||
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
f(p,j,k)=bielec_PQxx_no(j,list_act(p),k,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',n_act_orb,mo_num*n_core_inact_act_orb,n_act_orb,1.d0, &
|
||||
natorbsCI, n_act_orb, &
|
||||
f, n_act_orb, &
|
||||
0.d0, &
|
||||
d, n_act_orb)
|
||||
do k=1,n_core_inact_act_orb
|
||||
do p=1,n_act_orb
|
||||
do j=1,mo_num
|
||||
bielec_PQxx_no(j,list_act(p),k,l)=d(p,j,k)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
deallocate (f,d)
|
||||
|
||||
allocate (f(mo_num,mo_num,n_act_orb),d(mo_num,mo_num,n_act_orb))
|
||||
|
||||
!$OMP DO
|
||||
do l=1,n_core_inact_act_orb
|
||||
|
||||
do p=1,n_act_orb
|
||||
do k=1,mo_num
|
||||
do j=1,mo_num
|
||||
f(j,k,p) = bielec_PQxx_no(j,k,n_core_inact_orb+p,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('N','N',mo_num*mo_num,n_act_orb,n_act_orb,1.d0, &
|
||||
f, mo_num*mo_num, &
|
||||
natorbsCI, n_act_orb, &
|
||||
0.d0, &
|
||||
d, mo_num*mo_num)
|
||||
do p=1,n_act_orb
|
||||
do k=1,mo_num
|
||||
do j=1,mo_num
|
||||
bielec_PQxx_no(j,k,n_core_inact_orb+p,l)=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP BARRIER
|
||||
|
||||
!$OMP DO
|
||||
do l=1,n_core_inact_act_orb
|
||||
do p=1,n_act_orb
|
||||
do k=1,mo_num
|
||||
do j=1,mo_num
|
||||
f(j,k,p) = bielec_PQxx_no(j,k,l,n_core_inact_orb+p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('N','N',mo_num*mo_num,n_act_orb,n_act_orb,1.d0, &
|
||||
f, mo_num*mo_num, &
|
||||
natorbsCI, n_act_orb, &
|
||||
0.d0, &
|
||||
d, mo_num*mo_num)
|
||||
do p=1,n_act_orb
|
||||
do k=1,mo_num
|
||||
do j=1,mo_num
|
||||
bielec_PQxx_no(j,k,l,n_core_inact_orb+p)=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
deallocate (f,d)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_inact_act_orb,n_core_inact_act_orb, mo_num)]
|
||||
BEGIN_DOC
|
||||
! integral (px|xq) in the basis of natural MOs
|
||||
! indices are unshifted orbital numbers
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,l,t,u,p,q
|
||||
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j,k,l,p,d,f) &
|
||||
!$OMP SHARED(n_core_inact_act_orb,mo_num,n_act_orb,n_core_inact_orb, &
|
||||
!$OMP bielec_PxxQ_no,bielec_PxxQ,list_act,natorbsCI)
|
||||
|
||||
|
||||
allocate (f(n_act_orb,n_core_inact_act_orb,n_core_inact_act_orb), &
|
||||
d(n_act_orb,n_core_inact_act_orb,n_core_inact_act_orb))
|
||||
|
||||
!$OMP DO
|
||||
do j=1,mo_num
|
||||
bielec_PxxQ_no(:,:,:,j) = bielec_PxxQ(:,:,:,j)
|
||||
do l=1,n_core_inact_act_orb
|
||||
do k=1,n_core_inact_act_orb
|
||||
do p=1,n_act_orb
|
||||
f(p,k,l) = bielec_PxxQ_no(list_act(p),k,l,j)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',n_act_orb,n_core_inact_act_orb**2,n_act_orb,1.d0, &
|
||||
natorbsCI, size(natorbsCI,1), &
|
||||
f, n_act_orb, &
|
||||
0.d0, &
|
||||
d, n_act_orb)
|
||||
do l=1,n_core_inact_act_orb
|
||||
do k=1,n_core_inact_act_orb
|
||||
do p=1,n_act_orb
|
||||
bielec_PxxQ_no(list_act(p),k,l,j)=d(p,k,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
deallocate (f,d)
|
||||
|
||||
allocate (f(n_act_orb,mo_num,n_core_inact_act_orb), &
|
||||
d(n_act_orb,mo_num,n_core_inact_act_orb))
|
||||
|
||||
!$OMP DO
|
||||
do k=1,mo_num
|
||||
do l=1,n_core_inact_act_orb
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
f(p,j,l) = bielec_PxxQ_no(j,n_core_inact_orb+p,l,k)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',n_act_orb,mo_num*n_core_inact_act_orb,n_act_orb,1.d0, &
|
||||
natorbsCI, size(natorbsCI,1), &
|
||||
f, n_act_orb, &
|
||||
0.d0, &
|
||||
d, n_act_orb)
|
||||
do l=1,n_core_inact_act_orb
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
bielec_PxxQ_no(j,n_core_inact_orb+p,l,k)=d(p,j,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
deallocate(f,d)
|
||||
|
||||
allocate(f(mo_num,n_core_inact_act_orb,n_act_orb), &
|
||||
d(mo_num,n_core_inact_act_orb,n_act_orb) )
|
||||
|
||||
!$OMP DO
|
||||
do k=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
do l=1,n_core_inact_act_orb
|
||||
do j=1,mo_num
|
||||
f(j,l,p) = bielec_PxxQ_no(j,l,n_core_inact_orb+p,k)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('N','N',mo_num*n_core_inact_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||
f, mo_num*n_core_inact_act_orb, &
|
||||
natorbsCI, size(natorbsCI,1), &
|
||||
0.d0, &
|
||||
d, mo_num*n_core_inact_act_orb)
|
||||
do p=1,n_act_orb
|
||||
do l=1,n_core_inact_act_orb
|
||||
do j=1,mo_num
|
||||
bielec_PxxQ_no(j,l,n_core_inact_orb+p,k)=d(j,l,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP BARRIER
|
||||
|
||||
!$OMP DO
|
||||
do l=1,n_core_inact_act_orb
|
||||
do p=1,n_act_orb
|
||||
do k=1,n_core_inact_act_orb
|
||||
do j=1,mo_num
|
||||
f(j,k,p) = bielec_PxxQ_no(j,k,l,n_core_inact_orb+p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('N','N',mo_num*n_core_inact_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||
f, mo_num*n_core_inact_act_orb, &
|
||||
natorbsCI, size(natorbsCI,1), &
|
||||
0.d0, &
|
||||
d, mo_num*n_core_inact_act_orb)
|
||||
do p=1,n_act_orb
|
||||
do k=1,n_core_inact_act_orb
|
||||
do j=1,mo_num
|
||||
bielec_PxxQ_no(j,k,l,n_core_inact_orb+p)=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
deallocate(f,d)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, bielecCI_no, (n_act_orb,n_act_orb,n_act_orb, mo_num)]
|
||||
BEGIN_DOC
|
||||
! integrals (tu|vp) in the basis of natural MOs
|
||||
! index p runs over the whole basis, t,u,v only over the active orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,l,t,u,p,q
|
||||
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j,k,l,p,d,f) &
|
||||
!$OMP SHARED(n_core_inact_act_orb,mo_num,n_act_orb,n_core_inact_orb, &
|
||||
!$OMP bielecCI_no,bielecCI,list_act,natorbsCI)
|
||||
|
||||
allocate (f(n_act_orb,n_act_orb,mo_num), &
|
||||
d(n_act_orb,n_act_orb,mo_num))
|
||||
|
||||
!$OMP DO
|
||||
do l=1,mo_num
|
||||
bielecCI_no(:,:,:,l) = bielecCI(:,:,:,l)
|
||||
do k=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
f(p,j,k)=bielecCI_no(p,j,k,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',n_act_orb,n_act_orb*n_act_orb,n_act_orb,1.d0, &
|
||||
natorbsCI, size(natorbsCI,1), &
|
||||
f, n_act_orb, &
|
||||
0.d0, &
|
||||
d, n_act_orb)
|
||||
do k=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
bielecCI_no(p,j,k,l)=d(p,j,k)
|
||||
end do
|
||||
end do
|
||||
|
||||
do j=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
f(p,j,k)=bielecCI_no(j,p,k,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',n_act_orb,n_act_orb*n_act_orb,n_act_orb,1.d0, &
|
||||
natorbsCI, n_act_orb, &
|
||||
f, n_act_orb, &
|
||||
0.d0, &
|
||||
d, n_act_orb)
|
||||
do k=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
bielecCI_no(j,p,k,l)=d(p,j,k)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do p=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
f(j,k,p)=bielecCI_no(j,k,p,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('N','N',n_act_orb*n_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||
f, n_act_orb*n_act_orb, &
|
||||
natorbsCI, n_act_orb, &
|
||||
0.d0, &
|
||||
d, n_act_orb*n_act_orb)
|
||||
|
||||
do p=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
bielecCI_no(j,k,p,l)=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP DO
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
f(j,k,p)=bielecCI_no(j,k,l,list_act(p))
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('N','N',n_act_orb*n_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||
f, n_act_orb*n_act_orb, &
|
||||
natorbsCI, n_act_orb, &
|
||||
0.d0, &
|
||||
d, n_act_orb*n_act_orb)
|
||||
|
||||
do p=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
bielecCI_no(j,k,l,list_act(p))=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
deallocate(d,f)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
57
src/casscf/casscf.irp.f
Normal file
57
src/casscf/casscf.irp.f
Normal file
@ -0,0 +1,57 @@
|
||||
program casscf
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
call reorder_orbitals_for_casscf
|
||||
no_vvvv_integrals = .True.
|
||||
pt2_max = 0.02
|
||||
SOFT_TOUCH no_vvvv_integrals pt2_max
|
||||
call run_stochastic_cipsi
|
||||
call run
|
||||
end
|
||||
|
||||
subroutine run
|
||||
implicit none
|
||||
double precision :: energy_old, energy
|
||||
logical :: converged,state_following_casscf_save
|
||||
integer :: iteration
|
||||
converged = .False.
|
||||
|
||||
energy = 0.d0
|
||||
mo_label = "MCSCF"
|
||||
iteration = 1
|
||||
state_following_casscf_save = state_following_casscf
|
||||
state_following_casscf = .True.
|
||||
touch state_following_casscf
|
||||
do while (.not.converged)
|
||||
call run_stochastic_cipsi
|
||||
energy_old = energy
|
||||
energy = eone+etwo+ecore
|
||||
|
||||
call write_time(6)
|
||||
call write_int(6,iteration,'CAS-SCF iteration')
|
||||
call write_double(6,energy,'CAS-SCF energy')
|
||||
call write_double(6,energy_improvement, 'Predicted energy improvement')
|
||||
|
||||
converged = dabs(energy_improvement) < thresh_scf
|
||||
pt2_max = dabs(energy_improvement / pt2_relative_error)
|
||||
|
||||
mo_coef = NewOrbs
|
||||
mo_occ = occnum
|
||||
call save_mos
|
||||
iteration += 1
|
||||
N_det = max(N_det/2 ,N_states)
|
||||
psi_det = psi_det_sorted
|
||||
psi_coef = psi_coef_sorted
|
||||
read_wf = .True.
|
||||
call clear_mo_map
|
||||
SOFT_TOUCH mo_coef N_det pt2_max psi_det psi_coef
|
||||
if(iteration .gt. 3)then
|
||||
state_following_casscf = state_following_casscf_save
|
||||
touch state_following_casscf
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
end
|
12
src/casscf/class.irp.f
Normal file
12
src/casscf/class.irp.f
Normal file
@ -0,0 +1,12 @@
|
||||
BEGIN_PROVIDER [ logical, do_only_1h1p ]
|
||||
&BEGIN_PROVIDER [ logical, do_only_cas ]
|
||||
&BEGIN_PROVIDER [ logical, do_ddci ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! In the CAS case, all those are always false except do_only_cas
|
||||
END_DOC
|
||||
do_only_cas = .True.
|
||||
do_only_1h1p = .False.
|
||||
do_ddci = .False.
|
||||
END_PROVIDER
|
||||
|
67
src/casscf/densities.irp.f
Normal file
67
src/casscf/densities.irp.f
Normal file
@ -0,0 +1,67 @@
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [real*8, D0tu, (n_act_orb,n_act_orb) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! the first-order density matrix in the basis of the starting MOs.
|
||||
! matrix is state averaged.
|
||||
END_DOC
|
||||
integer :: t,u
|
||||
|
||||
do u=1,n_act_orb
|
||||
do t=1,n_act_orb
|
||||
D0tu(t,u) = one_e_dm_mo_alpha_average( list_act(t), list_act(u) ) + &
|
||||
one_e_dm_mo_beta_average ( list_act(t), list_act(u) )
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [real*8, P0tuvx, (n_act_orb,n_act_orb,n_act_orb,n_act_orb) ]
|
||||
BEGIN_DOC
|
||||
! The second-order density matrix in the basis of the starting MOs ONLY IN THE RANGE OF ACTIVE MOS
|
||||
! The values are state averaged
|
||||
!
|
||||
! We use the spin-free generators of mono-excitations
|
||||
! E_pq destroys q and creates p
|
||||
! D_pq = <0|E_pq|0> = D_qp
|
||||
! P_pqrs = 1/2 <0|E_pq E_rs - delta_qr E_ps|0>
|
||||
!
|
||||
! P0tuvx(p,q,r,s) = chemist notation : 1/2 <0|E_pq E_rs - delta_qr E_ps|0>
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: t,u,v,x
|
||||
integer :: tt,uu,vv,xx
|
||||
integer :: mu,nu,istate,ispin,jspin,ihole,ipart,jhole,jpart
|
||||
integer :: ierr
|
||||
real*8 :: phase1,phase11,phase12,phase2,phase21,phase22
|
||||
integer :: nu1,nu2,nu11,nu12,nu21,nu22
|
||||
integer :: ierr1,ierr2,ierr11,ierr12,ierr21,ierr22
|
||||
real*8 :: cI_mu(N_states),term
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu, det_mu_ex
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu_ex1, det_mu_ex11, det_mu_ex12
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu_ex2, det_mu_ex21, det_mu_ex22
|
||||
|
||||
if (bavard) then
|
||||
write(6,*) ' providing the 2 body RDM on the active part'
|
||||
endif
|
||||
|
||||
P0tuvx= 0.d0
|
||||
do istate=1,N_states
|
||||
do x = 1, n_act_orb
|
||||
xx = list_act(x)
|
||||
do v = 1, n_act_orb
|
||||
vv = list_act(v)
|
||||
do u = 1, n_act_orb
|
||||
uu = list_act(u)
|
||||
do t = 1, n_act_orb
|
||||
tt = list_act(t)
|
||||
P0tuvx(t,u,v,x) = state_av_act_two_rdm_spin_trace_mo(t,v,u,x)
|
||||
! P0tuvx(t,u,v,x) = act_two_rdm_spin_trace_mo(t,v,u,x)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
125
src/casscf/det_manip.irp.f
Normal file
125
src/casscf/det_manip.irp.f
Normal file
@ -0,0 +1,125 @@
|
||||
use bitmasks
|
||||
|
||||
subroutine do_signed_mono_excitation(key1,key2,nu,ihole,ipart, &
|
||||
ispin,phase,ierr)
|
||||
BEGIN_DOC
|
||||
! we create the mono-excitation, and determine, if possible,
|
||||
! the phase and the number in the list of determinants
|
||||
END_DOC
|
||||
implicit none
|
||||
integer(bit_kind) :: key1(N_int,2),key2(N_int,2)
|
||||
integer(bit_kind), allocatable :: keytmp(:,:)
|
||||
integer :: exc(0:2,2,2),ihole,ipart,ierr,nu,ispin
|
||||
real*8 :: phase
|
||||
logical :: found
|
||||
allocate(keytmp(N_int,2))
|
||||
|
||||
nu=-1
|
||||
phase=1.D0
|
||||
ierr=0
|
||||
call det_copy(key1,key2,N_int)
|
||||
! write(6,*) ' key2 before excitation ',ihole,' -> ',ipart,' spin = ',ispin
|
||||
! call print_det(key2,N_int)
|
||||
call do_single_excitation(key2,ihole,ipart,ispin,ierr)
|
||||
! write(6,*) ' key2 after ',ihole,' -> ',ipart,' spin = ',ispin
|
||||
! call print_det(key2,N_int)
|
||||
! write(6,*) ' excitation ',ihole,' -> ',ipart,' gives ierr = ',ierr
|
||||
if (ierr.eq.1) then
|
||||
! excitation is possible
|
||||
! get the phase
|
||||
call get_single_excitation(key1,key2,exc,phase,N_int)
|
||||
! get the number in the list
|
||||
found=.false.
|
||||
nu=0
|
||||
|
||||
!TODO BOTTLENECK
|
||||
do while (.not.found)
|
||||
nu+=1
|
||||
if (nu.gt.N_det) then
|
||||
! the determinant is possible, but not in the list
|
||||
found=.true.
|
||||
nu=-1
|
||||
else
|
||||
call det_extract(keytmp,nu,N_int)
|
||||
integer :: i,ii
|
||||
found=.true.
|
||||
do ii=1,2
|
||||
do i=1,N_int
|
||||
if (keytmp(i,ii).ne.key2(i,ii)) then
|
||||
found=.false.
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
!
|
||||
! we found the new string, the phase, and possibly the number in the list
|
||||
!
|
||||
end subroutine do_signed_mono_excitation
|
||||
|
||||
subroutine det_extract(key,nu,Nint)
|
||||
BEGIN_DOC
|
||||
! extract a determinant from the list of determinants
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ispin,i,nu,Nint
|
||||
integer(bit_kind) :: key(Nint,2)
|
||||
do ispin=1,2
|
||||
do i=1,Nint
|
||||
key(i,ispin)=psi_det(i,ispin,nu)
|
||||
end do
|
||||
end do
|
||||
end subroutine det_extract
|
||||
|
||||
subroutine det_copy(key1,key2,Nint)
|
||||
use bitmasks ! you need to include the bitmasks_module.f90 features
|
||||
BEGIN_DOC
|
||||
! copy a determinant from key1 to key2
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ispin,i,Nint
|
||||
integer(bit_kind) :: key1(Nint,2),key2(Nint,2)
|
||||
do ispin=1,2
|
||||
do i=1,Nint
|
||||
key2(i,ispin)=key1(i,ispin)
|
||||
end do
|
||||
end do
|
||||
end subroutine det_copy
|
||||
|
||||
subroutine do_spinfree_mono_excitation(key_in,key_out1,key_out2 &
|
||||
,nu1,nu2,ihole,ipart,phase1,phase2,ierr,jerr)
|
||||
BEGIN_DOC
|
||||
! we create the spin-free mono-excitation E_pq=(a^+_p a_q + a^+_P a_Q)
|
||||
! we may create two determinants as result
|
||||
!
|
||||
END_DOC
|
||||
implicit none
|
||||
integer(bit_kind) :: key_in(N_int,2),key_out1(N_int,2)
|
||||
integer(bit_kind) :: key_out2(N_int,2)
|
||||
integer :: ihole,ipart,ierr,jerr,nu1,nu2
|
||||
integer :: ispin
|
||||
real*8 :: phase1,phase2
|
||||
|
||||
! write(6,*) ' applying E_',ipart,ihole,' on determinant '
|
||||
! call print_det(key_in,N_int)
|
||||
|
||||
! spin alpha
|
||||
ispin=1
|
||||
call do_signed_mono_excitation(key_in,key_out1,nu1,ihole &
|
||||
,ipart,ispin,phase1,ierr)
|
||||
! if (ierr.eq.1) then
|
||||
! write(6,*) ' 1 result is ',nu1,phase1
|
||||
! call print_det(key_out1,N_int)
|
||||
! end if
|
||||
! spin beta
|
||||
ispin=2
|
||||
call do_signed_mono_excitation(key_in,key_out2,nu2,ihole &
|
||||
,ipart,ispin,phase2,jerr)
|
||||
! if (jerr.eq.1) then
|
||||
! write(6,*) ' 2 result is ',nu2,phase2
|
||||
! call print_det(key_out2,N_int)
|
||||
! end if
|
||||
|
||||
end subroutine do_spinfree_mono_excitation
|
||||
|
3
src/casscf/driver_optorb.irp.f
Normal file
3
src/casscf/driver_optorb.irp.f
Normal file
@ -0,0 +1,3 @@
|
||||
subroutine driver_optorb
|
||||
implicit none
|
||||
end
|
104
src/casscf/get_energy.irp.f
Normal file
104
src/casscf/get_energy.irp.f
Normal file
@ -0,0 +1,104 @@
|
||||
program print_2rdm
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! get the active part of the bielectronic energy on a given wave function.
|
||||
!
|
||||
! useful to test the active part of the spin trace 2 rdms
|
||||
END_DOC
|
||||
!no_vvvv_integrals = .True.
|
||||
read_wf = .True.
|
||||
!touch read_wf no_vvvv_integrals
|
||||
!call routine
|
||||
!call routine_bis
|
||||
call print_grad
|
||||
end
|
||||
|
||||
subroutine print_grad
|
||||
implicit none
|
||||
integer :: i
|
||||
do i = 1, nMonoEx
|
||||
if(dabs(gradvec2(i)).gt.1.d-5)then
|
||||
print*,''
|
||||
print*,i,gradvec2(i),excit(:,i)
|
||||
endif
|
||||
enddo
|
||||
end
|
||||
|
||||
subroutine routine_bis
|
||||
implicit none
|
||||
integer :: i,j
|
||||
double precision :: accu_d,accu_od
|
||||
!accu_d = 0.d0
|
||||
!accu_od = 0.d0
|
||||
!print*,''
|
||||
!print*,''
|
||||
!print*,''
|
||||
!do i = 1, mo_num
|
||||
! write(*,'(100(F8.5,X))')super_ci_dm(i,:)
|
||||
! accu_d += super_ci_dm(i,i)
|
||||
! do j = i+1, mo_num
|
||||
! accu_od += dabs(super_ci_dm(i,j) - super_ci_dm(j,i))
|
||||
! enddo
|
||||
!enddo
|
||||
!print*,''
|
||||
!print*,''
|
||||
!print*,'accu_d = ',accu_d
|
||||
!print*,'n_elec = ',elec_num
|
||||
!print*,'accu_od= ',accu_od
|
||||
!print*,''
|
||||
!accu_d = 0.d0
|
||||
!do i = 1, N_det
|
||||
! accu_d += psi_coef(i,1)**2
|
||||
!enddo
|
||||
!print*,'accu_d = ',accu_d
|
||||
!provide superci_natorb
|
||||
|
||||
provide switch_mo_coef
|
||||
mo_coef = switch_mo_coef
|
||||
call save_mos
|
||||
end
|
||||
|
||||
subroutine routine
|
||||
integer :: i,j,k,l
|
||||
integer :: ii,jj,kk,ll
|
||||
double precision :: accu(4),twodm,thr,act_twodm2,integral,get_two_e_integral
|
||||
thr = 1.d-10
|
||||
|
||||
|
||||
accu = 0.d0
|
||||
do ll = 1, n_act_orb
|
||||
l = list_act(ll)
|
||||
do kk = 1, n_act_orb
|
||||
k = list_act(kk)
|
||||
do jj = 1, n_act_orb
|
||||
j = list_act(jj)
|
||||
do ii = 1, n_act_orb
|
||||
i = list_act(ii)
|
||||
integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
||||
accu(1) += state_av_act_two_rdm_spin_trace_mo(ii,jj,kk,ll) * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*,'accu = ',accu(1)
|
||||
|
||||
accu = 0.d0
|
||||
do ll = 1, n_act_orb
|
||||
l = list_act(ll)
|
||||
do kk = 1, n_act_orb
|
||||
k = list_act(kk)
|
||||
do jj = 1, n_act_orb
|
||||
j = list_act(jj)
|
||||
do ii = 1, n_act_orb
|
||||
i = list_act(ii)
|
||||
integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
||||
accu(1) += state_av_act_two_rdm_openmp_spin_trace_mo(ii,jj,kk,ll) * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*,'accu = ',accu(1)
|
||||
print*,'psi_energy_two_e = ',psi_energy_two_e
|
||||
|
||||
print *, psi_energy_with_nucl_rep
|
||||
end
|
74
src/casscf/grad_old.irp.f
Normal file
74
src/casscf/grad_old.irp.f
Normal file
@ -0,0 +1,74 @@
|
||||
|
||||
BEGIN_PROVIDER [real*8, gradvec_old, (nMonoEx)]
|
||||
BEGIN_DOC
|
||||
! calculate the orbital gradient <Psi| H E_pq |Psi> by hand, i.e. for
|
||||
! each determinant I we determine the string E_pq |I> (alpha and beta
|
||||
! separately) and generate <Psi|H E_pq |I>
|
||||
! sum_I c_I <Psi|H E_pq |I> is then the pq component of the orbital
|
||||
! gradient
|
||||
! E_pq = a^+_pa_q + a^+_Pa_Q
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ii,tt,aa,indx,ihole,ipart,istate
|
||||
real*8 :: res
|
||||
|
||||
do indx=1,nMonoEx
|
||||
ihole=excit(1,indx)
|
||||
ipart=excit(2,indx)
|
||||
call calc_grad_elem(ihole,ipart,res)
|
||||
gradvec_old(indx)=res
|
||||
end do
|
||||
|
||||
real*8 :: norm_grad
|
||||
norm_grad=0.d0
|
||||
do indx=1,nMonoEx
|
||||
norm_grad+=gradvec_old(indx)*gradvec_old(indx)
|
||||
end do
|
||||
norm_grad=sqrt(norm_grad)
|
||||
if (bavard) then
|
||||
write(6,*)
|
||||
write(6,*) ' Norm of the orbital gradient (via <0|EH|0>) : ', norm_grad
|
||||
write(6,*)
|
||||
endif
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
subroutine calc_grad_elem(ihole,ipart,res)
|
||||
BEGIN_DOC
|
||||
! eq 18 of Siegbahn et al, Physica Scripta 1980
|
||||
! we calculate 2 <Psi| H E_pq | Psi>, q=hole, p=particle
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ihole,ipart,mu,iii,ispin,ierr,nu,istate
|
||||
real*8 :: res
|
||||
integer(bit_kind), allocatable :: det_mu(:,:),det_mu_ex(:,:)
|
||||
real*8 :: i_H_psi_array(N_states),phase
|
||||
allocate(det_mu(N_int,2))
|
||||
allocate(det_mu_ex(N_int,2))
|
||||
|
||||
res=0.D0
|
||||
|
||||
do mu=1,n_det
|
||||
! get the string of the determinant
|
||||
call det_extract(det_mu,mu,N_int)
|
||||
do ispin=1,2
|
||||
! do the monoexcitation on it
|
||||
call det_copy(det_mu,det_mu_ex,N_int)
|
||||
call do_signed_mono_excitation(det_mu,det_mu_ex,nu &
|
||||
,ihole,ipart,ispin,phase,ierr)
|
||||
if (ierr.eq.1) then
|
||||
call i_H_psi(det_mu_ex,psi_det,psi_coef,N_int &
|
||||
,N_det,N_det,N_states,i_H_psi_array)
|
||||
do istate=1,N_states
|
||||
res+=i_H_psi_array(istate)*psi_coef(mu,istate)*phase
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
! state-averaged gradient
|
||||
res*=2.D0/dble(N_states)
|
||||
|
||||
end subroutine calc_grad_elem
|
||||
|
171
src/casscf/gradient.irp.f
Normal file
171
src/casscf/gradient.irp.f
Normal file
@ -0,0 +1,171 @@
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [ integer, nMonoEx ]
|
||||
BEGIN_DOC
|
||||
! Number of single excitations
|
||||
END_DOC
|
||||
implicit none
|
||||
nMonoEx=n_core_inact_orb*n_act_orb+n_core_inact_orb*n_virt_orb+n_act_orb*n_virt_orb
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, excit, (2,nMonoEx)]
|
||||
&BEGIN_PROVIDER [character*3, excit_class, (nMonoEx)]
|
||||
BEGIN_DOC
|
||||
! a list of the orbitals involved in the excitation
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,t,a,ii,tt,aa,indx
|
||||
indx=0
|
||||
do ii=1,n_core_inact_orb
|
||||
i=list_core_inact(ii)
|
||||
do tt=1,n_act_orb
|
||||
t=list_act(tt)
|
||||
indx+=1
|
||||
excit(1,indx)=i
|
||||
excit(2,indx)=t
|
||||
excit_class(indx)='c-a'
|
||||
end do
|
||||
end do
|
||||
|
||||
do ii=1,n_core_inact_orb
|
||||
i=list_core_inact(ii)
|
||||
do aa=1,n_virt_orb
|
||||
a=list_virt(aa)
|
||||
indx+=1
|
||||
excit(1,indx)=i
|
||||
excit(2,indx)=a
|
||||
excit_class(indx)='c-v'
|
||||
end do
|
||||
end do
|
||||
|
||||
do tt=1,n_act_orb
|
||||
t=list_act(tt)
|
||||
do aa=1,n_virt_orb
|
||||
a=list_virt(aa)
|
||||
indx+=1
|
||||
excit(1,indx)=t
|
||||
excit(2,indx)=a
|
||||
excit_class(indx)='a-v'
|
||||
end do
|
||||
end do
|
||||
|
||||
if (bavard) then
|
||||
write(6,*) ' Filled the table of the Monoexcitations '
|
||||
do indx=1,nMonoEx
|
||||
write(6,*) ' ex ',indx,' : ',excit(1,indx),' -> ' &
|
||||
,excit(2,indx),' ',excit_class(indx)
|
||||
end do
|
||||
end if
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [real*8, gradvec2, (nMonoEx)]
|
||||
BEGIN_DOC
|
||||
! calculate the orbital gradient <Psi| H E_pq |Psi> from density
|
||||
! matrices and integrals; Siegbahn et al, Phys Scr 1980
|
||||
! eqs 14 a,b,c
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,t,a,indx
|
||||
real*8 :: gradvec_it,gradvec_ia,gradvec_ta
|
||||
real*8 :: norm_grad
|
||||
|
||||
indx=0
|
||||
do i=1,n_core_inact_orb
|
||||
do t=1,n_act_orb
|
||||
indx+=1
|
||||
gradvec2(indx)=gradvec_it(i,t)
|
||||
end do
|
||||
end do
|
||||
|
||||
do i=1,n_core_inact_orb
|
||||
do a=1,n_virt_orb
|
||||
indx+=1
|
||||
gradvec2(indx)=gradvec_ia(i,a)
|
||||
end do
|
||||
end do
|
||||
|
||||
do t=1,n_act_orb
|
||||
do a=1,n_virt_orb
|
||||
indx+=1
|
||||
gradvec2(indx)=gradvec_ta(t,a)
|
||||
end do
|
||||
end do
|
||||
|
||||
norm_grad=0.d0
|
||||
do indx=1,nMonoEx
|
||||
norm_grad+=gradvec2(indx)*gradvec2(indx)
|
||||
end do
|
||||
norm_grad=sqrt(norm_grad)
|
||||
write(6,*)
|
||||
write(6,*) ' Norm of the orbital gradient (via D, P and integrals): ', norm_grad
|
||||
write(6,*)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
real*8 function gradvec_it(i,t)
|
||||
BEGIN_DOC
|
||||
! the orbital gradient core/inactive -> active
|
||||
! we assume natural orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,t
|
||||
|
||||
integer :: ii,tt,v,vv,x,y
|
||||
integer :: x3,y3
|
||||
|
||||
ii=list_core_inact(i)
|
||||
tt=list_act(t)
|
||||
gradvec_it=2.D0*(Fipq(tt,ii)+Fapq(tt,ii))
|
||||
gradvec_it-=occnum(tt)*Fipq(ii,tt)
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
do x=1,n_act_orb
|
||||
x3=x+n_core_inact_orb
|
||||
do y=1,n_act_orb
|
||||
y3=y+n_core_inact_orb
|
||||
gradvec_it-=2.D0*P0tuvx_no(t,v,x,y)*bielec_PQxx_no(ii,vv,x3,y3)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
gradvec_it*=2.D0
|
||||
end function gradvec_it
|
||||
|
||||
real*8 function gradvec_ia(i,a)
|
||||
BEGIN_DOC
|
||||
! the orbital gradient core/inactive -> virtual
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,a,ii,aa
|
||||
|
||||
ii=list_core_inact(i)
|
||||
aa=list_virt(a)
|
||||
gradvec_ia=2.D0*(Fipq(aa,ii)+Fapq(aa,ii))
|
||||
gradvec_ia*=2.D0
|
||||
|
||||
end function gradvec_ia
|
||||
|
||||
real*8 function gradvec_ta(t,a)
|
||||
BEGIN_DOC
|
||||
! the orbital gradient active -> virtual
|
||||
! we assume natural orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: t,a,tt,aa,v,vv,x,y
|
||||
|
||||
tt=list_act(t)
|
||||
aa=list_virt(a)
|
||||
gradvec_ta=0.D0
|
||||
gradvec_ta+=occnum(tt)*Fipq(aa,tt)
|
||||
do v=1,n_act_orb
|
||||
do x=1,n_act_orb
|
||||
do y=1,n_act_orb
|
||||
gradvec_ta+=2.D0*P0tuvx_no(t,v,x,y)*bielecCI_no(x,y,v,aa)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
gradvec_ta*=2.D0
|
||||
|
||||
end function gradvec_ta
|
||||
|
656
src/casscf/hessian.irp.f
Normal file
656
src/casscf/hessian.irp.f
Normal file
@ -0,0 +1,656 @@
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [real*8, hessmat, (nMonoEx,nMonoEx)]
|
||||
BEGIN_DOC
|
||||
! calculate the orbital hessian 2 <Psi| E_pq H E_rs |Psi>
|
||||
! + <Psi| E_pq E_rs H |Psi> + <Psi| E_rs E_pq H |Psi> by hand,
|
||||
! determinant per determinant, as for the gradient
|
||||
!
|
||||
! we assume that we have natural active orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: indx,ihole,ipart
|
||||
integer :: jndx,jhole,jpart
|
||||
character*3 :: iexc,jexc
|
||||
real*8 :: res
|
||||
|
||||
if (bavard) then
|
||||
write(6,*) ' providing Hessian matrix hessmat '
|
||||
write(6,*) ' nMonoEx = ',nMonoEx
|
||||
endif
|
||||
|
||||
do indx=1,nMonoEx
|
||||
do jndx=1,nMonoEx
|
||||
hessmat(indx,jndx)=0.D0
|
||||
end do
|
||||
end do
|
||||
|
||||
do indx=1,nMonoEx
|
||||
ihole=excit(1,indx)
|
||||
ipart=excit(2,indx)
|
||||
iexc=excit_class(indx)
|
||||
do jndx=indx,nMonoEx
|
||||
jhole=excit(1,jndx)
|
||||
jpart=excit(2,jndx)
|
||||
jexc=excit_class(jndx)
|
||||
call calc_hess_elem(ihole,ipart,jhole,jpart,res)
|
||||
hessmat(indx,jndx)=res
|
||||
hessmat(jndx,indx)=res
|
||||
end do
|
||||
end do
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
subroutine calc_hess_elem(ihole,ipart,jhole,jpart,res)
|
||||
BEGIN_DOC
|
||||
! eq 19 of Siegbahn et al, Physica Scripta 1980
|
||||
! we calculate 2 <Psi| E_pq H E_rs |Psi>
|
||||
! + <Psi| E_pq E_rs H |Psi> + <Psi| E_rs E_pq H |Psi>
|
||||
! average over all states is performed.
|
||||
! no transition between states.
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ihole,ipart,ispin,mu,istate
|
||||
integer :: jhole,jpart,jspin
|
||||
integer :: mu_pq, mu_pqrs, mu_rs, mu_rspq, nu_rs,nu
|
||||
real*8 :: res
|
||||
integer(bit_kind), allocatable :: det_mu(:,:)
|
||||
integer(bit_kind), allocatable :: det_nu(:,:)
|
||||
integer(bit_kind), allocatable :: det_mu_pq(:,:)
|
||||
integer(bit_kind), allocatable :: det_mu_rs(:,:)
|
||||
integer(bit_kind), allocatable :: det_nu_rs(:,:)
|
||||
integer(bit_kind), allocatable :: det_mu_pqrs(:,:)
|
||||
integer(bit_kind), allocatable :: det_mu_rspq(:,:)
|
||||
real*8 :: i_H_psi_array(N_states),phase,phase2,phase3
|
||||
real*8 :: i_H_j_element
|
||||
allocate(det_mu(N_int,2))
|
||||
allocate(det_nu(N_int,2))
|
||||
allocate(det_mu_pq(N_int,2))
|
||||
allocate(det_mu_rs(N_int,2))
|
||||
allocate(det_nu_rs(N_int,2))
|
||||
allocate(det_mu_pqrs(N_int,2))
|
||||
allocate(det_mu_rspq(N_int,2))
|
||||
integer :: mu_pq_possible
|
||||
integer :: mu_rs_possible
|
||||
integer :: nu_rs_possible
|
||||
integer :: mu_pqrs_possible
|
||||
integer :: mu_rspq_possible
|
||||
|
||||
res=0.D0
|
||||
|
||||
! the terms <0|E E H |0>
|
||||
do mu=1,n_det
|
||||
! get the string of the determinant
|
||||
call det_extract(det_mu,mu,N_int)
|
||||
do ispin=1,2
|
||||
! do the monoexcitation pq on it
|
||||
call det_copy(det_mu,det_mu_pq,N_int)
|
||||
call do_signed_mono_excitation(det_mu,det_mu_pq,mu_pq &
|
||||
,ihole,ipart,ispin,phase,mu_pq_possible)
|
||||
if (mu_pq_possible.eq.1) then
|
||||
! possible, but not necessarily in the list
|
||||
! do the second excitation
|
||||
do jspin=1,2
|
||||
call det_copy(det_mu_pq,det_mu_pqrs,N_int)
|
||||
call do_signed_mono_excitation(det_mu_pq,det_mu_pqrs,mu_pqrs&
|
||||
,jhole,jpart,jspin,phase2,mu_pqrs_possible)
|
||||
! excitation possible
|
||||
if (mu_pqrs_possible.eq.1) then
|
||||
call i_H_psi(det_mu_pqrs,psi_det,psi_coef,N_int &
|
||||
,N_det,N_det,N_states,i_H_psi_array)
|
||||
do istate=1,N_states
|
||||
res+=i_H_psi_array(istate)*psi_coef(mu,istate)*phase*phase2
|
||||
end do
|
||||
end if
|
||||
! try the de-excitation with opposite sign
|
||||
call det_copy(det_mu_pq,det_mu_pqrs,N_int)
|
||||
call do_signed_mono_excitation(det_mu_pq,det_mu_pqrs,mu_pqrs&
|
||||
,jpart,jhole,jspin,phase2,mu_pqrs_possible)
|
||||
phase2=-phase2
|
||||
! excitation possible
|
||||
if (mu_pqrs_possible.eq.1) then
|
||||
call i_H_psi(det_mu_pqrs,psi_det,psi_coef,N_int &
|
||||
,N_det,N_det,N_states,i_H_psi_array)
|
||||
do istate=1,N_states
|
||||
res+=i_H_psi_array(istate)*psi_coef(mu,istate)*phase*phase2
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
! exchange the notion of pq and rs
|
||||
! do the monoexcitation rs on the initial determinant
|
||||
call det_copy(det_mu,det_mu_rs,N_int)
|
||||
call do_signed_mono_excitation(det_mu,det_mu_rs,mu_rs &
|
||||
,jhole,jpart,ispin,phase2,mu_rs_possible)
|
||||
if (mu_rs_possible.eq.1) then
|
||||
! do the second excitation
|
||||
do jspin=1,2
|
||||
call det_copy(det_mu_rs,det_mu_rspq,N_int)
|
||||
call do_signed_mono_excitation(det_mu_rs,det_mu_rspq,mu_rspq&
|
||||
,ihole,ipart,jspin,phase3,mu_rspq_possible)
|
||||
! excitation possible (of course, the result is outside the CAS)
|
||||
if (mu_rspq_possible.eq.1) then
|
||||
call i_H_psi(det_mu_rspq,psi_det,psi_coef,N_int &
|
||||
,N_det,N_det,N_states,i_H_psi_array)
|
||||
do istate=1,N_states
|
||||
res+=i_H_psi_array(istate)*psi_coef(mu,istate)*phase2*phase3
|
||||
end do
|
||||
end if
|
||||
! we may try the de-excitation, with opposite sign
|
||||
call det_copy(det_mu_rs,det_mu_rspq,N_int)
|
||||
call do_signed_mono_excitation(det_mu_rs,det_mu_rspq,mu_rspq&
|
||||
,ipart,ihole,jspin,phase3,mu_rspq_possible)
|
||||
phase3=-phase3
|
||||
! excitation possible (of course, the result is outside the CAS)
|
||||
if (mu_rspq_possible.eq.1) then
|
||||
call i_H_psi(det_mu_rspq,psi_det,psi_coef,N_int &
|
||||
,N_det,N_det,N_states,i_H_psi_array)
|
||||
do istate=1,N_states
|
||||
res+=i_H_psi_array(istate)*psi_coef(mu,istate)*phase2*phase3
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
!
|
||||
! the operator E H E, we have to do a double loop over the determinants
|
||||
! we still have the determinant mu_pq and the phase in memory
|
||||
if (mu_pq_possible.eq.1) then
|
||||
do nu=1,N_det
|
||||
call det_extract(det_nu,nu,N_int)
|
||||
do jspin=1,2
|
||||
call det_copy(det_nu,det_nu_rs,N_int)
|
||||
call do_signed_mono_excitation(det_nu,det_nu_rs,nu_rs &
|
||||
,jhole,jpart,jspin,phase2,nu_rs_possible)
|
||||
! excitation possible ?
|
||||
if (nu_rs_possible.eq.1) then
|
||||
call i_H_j(det_mu_pq,det_nu_rs,N_int,i_H_j_element)
|
||||
do istate=1,N_states
|
||||
res+=2.D0*i_H_j_element*psi_coef(mu,istate) &
|
||||
*psi_coef(nu,istate)*phase*phase2
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
! state-averaged Hessian
|
||||
res*=1.D0/dble(N_states)
|
||||
|
||||
end subroutine calc_hess_elem
|
||||
|
||||
BEGIN_PROVIDER [real*8, hessmat2, (nMonoEx,nMonoEx)]
|
||||
BEGIN_DOC
|
||||
! explicit hessian matrix from density matrices and integrals
|
||||
! of course, this will be used for a direct Davidson procedure later
|
||||
! we will not store the matrix in real life
|
||||
! formulas are broken down as functions for the 6 classes of matrix elements
|
||||
!
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,t,u,a,b,indx,jndx,bstart,ustart,indx_shift
|
||||
|
||||
real*8 :: hessmat_itju
|
||||
real*8 :: hessmat_itja
|
||||
real*8 :: hessmat_itua
|
||||
real*8 :: hessmat_iajb
|
||||
real*8 :: hessmat_iatb
|
||||
real*8 :: hessmat_taub
|
||||
|
||||
if (bavard) then
|
||||
write(6,*) ' providing Hessian matrix hessmat2 '
|
||||
write(6,*) ' nMonoEx = ',nMonoEx
|
||||
endif
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP SHARED(hessmat2,n_core_inact_orb,n_act_orb,n_virt_orb,nMonoEx) &
|
||||
!$OMP PRIVATE(i,indx,jndx,j,ustart,t,u,a,bstart,indx_shift)
|
||||
|
||||
!$OMP DO
|
||||
do i=1,n_core_inact_orb
|
||||
do t=1,n_act_orb
|
||||
indx = t + (i-1)*n_act_orb
|
||||
jndx=indx
|
||||
do j=i,n_core_inact_orb
|
||||
if (i.eq.j) then
|
||||
ustart=t
|
||||
else
|
||||
ustart=1
|
||||
end if
|
||||
do u=ustart,n_act_orb
|
||||
hessmat2(jndx,indx)=hessmat_itju(i,t,j,u)
|
||||
jndx+=1
|
||||
end do
|
||||
end do
|
||||
do j=1,n_core_inact_orb
|
||||
do a=1,n_virt_orb
|
||||
hessmat2(jndx,indx)=hessmat_itja(i,t,j,a)
|
||||
jndx+=1
|
||||
end do
|
||||
end do
|
||||
do u=1,n_act_orb
|
||||
do a=1,n_virt_orb
|
||||
hessmat2(jndx,indx)=hessmat_itua(i,t,u,a)
|
||||
jndx+=1
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
indx_shift = n_core_inact_orb*n_act_orb
|
||||
!$OMP DO
|
||||
do a=1,n_virt_orb
|
||||
do i=1,n_core_inact_orb
|
||||
indx = a + (i-1)*n_virt_orb + indx_shift
|
||||
jndx=indx
|
||||
do j=i,n_core_inact_orb
|
||||
if (i.eq.j) then
|
||||
bstart=a
|
||||
else
|
||||
bstart=1
|
||||
end if
|
||||
do b=bstart,n_virt_orb
|
||||
hessmat2(jndx,indx)=hessmat_iajb(i,a,j,b)
|
||||
jndx+=1
|
||||
end do
|
||||
end do
|
||||
do t=1,n_act_orb
|
||||
do b=1,n_virt_orb
|
||||
hessmat2(jndx,indx)=hessmat_iatb(i,a,t,b)
|
||||
jndx+=1
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
indx_shift += n_core_inact_orb*n_virt_orb
|
||||
!$OMP DO
|
||||
do a=1,n_virt_orb
|
||||
do t=1,n_act_orb
|
||||
indx = a + (t-1)*n_virt_orb + indx_shift
|
||||
jndx=indx
|
||||
do u=t,n_act_orb
|
||||
if (t.eq.u) then
|
||||
bstart=a
|
||||
else
|
||||
bstart=1
|
||||
end if
|
||||
do b=bstart,n_virt_orb
|
||||
hessmat2(jndx,indx)=hessmat_taub(t,a,u,b)
|
||||
jndx+=1
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do jndx=1,nMonoEx
|
||||
do indx=1,jndx-1
|
||||
hessmat2(indx,jndx) = hessmat2(jndx,indx)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
real*8 function hessmat_itju(i,t,j,u)
|
||||
BEGIN_DOC
|
||||
! the orbital hessian for core/inactive -> active, core/inactive -> active
|
||||
! i, t, j, u are list indices, the corresponding orbitals are ii,tt,jj,uu
|
||||
!
|
||||
! we assume natural orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,t,j,u,ii,tt,uu,v,vv,x,xx,y,jj
|
||||
real*8 :: term,t2
|
||||
|
||||
ii=list_core_inact(i)
|
||||
tt=list_act(t)
|
||||
if (i.eq.j) then
|
||||
if (t.eq.u) then
|
||||
! diagonal element
|
||||
term=occnum(tt)*Fipq(ii,ii)+2.D0*(Fipq(tt,tt)+Fapq(tt,tt)) &
|
||||
-2.D0*(Fipq(ii,ii)+Fapq(ii,ii))
|
||||
term+=2.D0*(3.D0*bielec_pxxq_no(tt,i,i,tt)-bielec_pqxx_no(tt,tt,i,i))
|
||||
term-=2.D0*occnum(tt)*(3.D0*bielec_pxxq_no(tt,i,i,tt) &
|
||||
-bielec_pqxx_no(tt,tt,i,i))
|
||||
term-=occnum(tt)*Fipq(tt,tt)
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
term+=2.D0*(P0tuvx_no(t,t,v,x)*bielec_pqxx_no(vv,xx,i,i) &
|
||||
+(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v))* &
|
||||
bielec_pxxq_no(vv,i,i,xx))
|
||||
do y=1,n_act_orb
|
||||
term-=2.D0*P0tuvx_no(t,v,x,y)*bielecCI_no(t,v,y,xx)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
else
|
||||
! it/iu, t != u
|
||||
uu=list_act(u)
|
||||
term=2.D0*(Fipq(tt,uu)+Fapq(tt,uu))
|
||||
term+=2.D0*(4.D0*bielec_PxxQ_no(tt,i,j,uu)-bielec_PxxQ_no(uu,i,j,tt) &
|
||||
-bielec_PQxx_no(tt,uu,i,j))
|
||||
term-=occnum(tt)*Fipq(uu,tt)
|
||||
term-=(occnum(tt)+occnum(uu)) &
|
||||
*(3.D0*bielec_PxxQ_no(tt,i,i,uu)-bielec_PQxx_no(uu,tt,i,i))
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
! term-=D0tu(u,v)*Fipq(tt,vv) ! published, but inverting t and u seems more correct
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
term+=2.D0*(P0tuvx_no(u,t,v,x)*bielec_pqxx_no(vv,xx,i,i) &
|
||||
+(P0tuvx_no(u,x,v,t)+P0tuvx_no(u,x,t,v)) &
|
||||
*bielec_pxxq_no(vv,i,i,xx))
|
||||
do y=1,n_act_orb
|
||||
term-=2.D0*P0tuvx_no(t,v,x,y)*bielecCI_no(u,v,y,xx)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
else
|
||||
! it/ju
|
||||
jj=list_core_inact(j)
|
||||
uu=list_act(u)
|
||||
if (t.eq.u) then
|
||||
term=occnum(tt)*Fipq(ii,jj)
|
||||
term-=2.D0*(Fipq(ii,jj)+Fapq(ii,jj))
|
||||
else
|
||||
term=0.D0
|
||||
end if
|
||||
term+=2.D0*(4.D0*bielec_PxxQ_no(tt,i,j,uu)-bielec_PxxQ_no(uu,i,j,tt) &
|
||||
-bielec_PQxx_no(tt,uu,i,j))
|
||||
term-=(occnum(tt)+occnum(uu))* &
|
||||
(4.D0*bielec_PxxQ_no(tt,i,j,uu)-bielec_PxxQ_no(uu,i,j,tt) &
|
||||
-bielec_PQxx_no(uu,tt,i,j))
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
term+=2.D0*(P0tuvx_no(u,t,v,x)*bielec_pqxx_no(vv,xx,i,j) &
|
||||
+(P0tuvx_no(u,x,v,t)+P0tuvx_no(u,x,t,v)) &
|
||||
*bielec_pxxq_no(vv,i,j,xx))
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
|
||||
term*=2.D0
|
||||
hessmat_itju=term
|
||||
|
||||
end function hessmat_itju
|
||||
|
||||
real*8 function hessmat_itja(i,t,j,a)
|
||||
BEGIN_DOC
|
||||
! the orbital hessian for core/inactive -> active, core/inactive -> virtual
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,t,j,a,ii,tt,jj,aa,v,vv,x,y
|
||||
real*8 :: term
|
||||
|
||||
! it/ja
|
||||
ii=list_core_inact(i)
|
||||
tt=list_act(t)
|
||||
jj=list_core_inact(j)
|
||||
aa=list_virt(a)
|
||||
term=2.D0*(4.D0*bielec_pxxq_no(aa,j,i,tt) &
|
||||
-bielec_pqxx_no(aa,tt,i,j) -bielec_pxxq_no(aa,i,j,tt))
|
||||
term-=occnum(tt)*(4.D0*bielec_pxxq_no(aa,j,i,tt) &
|
||||
-bielec_pqxx_no(aa,tt,i,j) -bielec_pxxq_no(aa,i,j,tt))
|
||||
if (i.eq.j) then
|
||||
term+=2.D0*(Fipq(aa,tt)+Fapq(aa,tt))
|
||||
term-=0.5D0*occnum(tt)*Fipq(aa,tt)
|
||||
do v=1,n_act_orb
|
||||
do x=1,n_act_orb
|
||||
do y=1,n_act_orb
|
||||
term-=P0tuvx_no(t,v,x,y)*bielecCI_no(x,y,v,aa)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
term*=2.D0
|
||||
hessmat_itja=term
|
||||
|
||||
end function hessmat_itja
|
||||
|
||||
real*8 function hessmat_itua(i,t,u,a)
|
||||
BEGIN_DOC
|
||||
! the orbital hessian for core/inactive -> active, active -> virtual
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,t,u,a,ii,tt,uu,aa,v,vv,x,xx,u3,t3,v3
|
||||
real*8 :: term
|
||||
|
||||
ii=list_core_inact(i)
|
||||
tt=list_act(t)
|
||||
t3=t+n_core_inact_orb
|
||||
uu=list_act(u)
|
||||
u3=u+n_core_inact_orb
|
||||
aa=list_virt(a)
|
||||
if (t.eq.u) then
|
||||
term=-occnum(tt)*Fipq(aa,ii)
|
||||
else
|
||||
term=0.D0
|
||||
end if
|
||||
term-=occnum(uu)*(bielec_pqxx_no(aa,ii,t3,u3)-4.D0*bielec_pqxx_no(aa,uu,t3,i)&
|
||||
+bielec_pxxq_no(aa,t3,u3,ii))
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
v3=v+n_core_inact_orb
|
||||
do x=1,n_act_orb
|
||||
integer :: x3
|
||||
xx=list_act(x)
|
||||
x3=x+n_core_inact_orb
|
||||
term-=2.D0*(P0tuvx_no(t,u,v,x)*bielec_pqxx_no(aa,ii,v3,x3) &
|
||||
+(P0tuvx_no(t,v,u,x)+P0tuvx_no(t,v,x,u)) &
|
||||
*bielec_pqxx_no(aa,xx,v3,i))
|
||||
end do
|
||||
end do
|
||||
if (t.eq.u) then
|
||||
term+=Fipq(aa,ii)+Fapq(aa,ii)
|
||||
end if
|
||||
term*=2.D0
|
||||
hessmat_itua=term
|
||||
|
||||
end function hessmat_itua
|
||||
|
||||
real*8 function hessmat_iajb(i,a,j,b)
|
||||
BEGIN_DOC
|
||||
! the orbital hessian for core/inactive -> virtual, core/inactive -> virtual
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,a,j,b,ii,aa,jj,bb
|
||||
real*8 :: term
|
||||
|
||||
ii=list_core_inact(i)
|
||||
aa=list_virt(a)
|
||||
if (i.eq.j) then
|
||||
if (a.eq.b) then
|
||||
! ia/ia
|
||||
term=2.D0*(Fipq(aa,aa)+Fapq(aa,aa)-Fipq(ii,ii)-Fapq(ii,ii))
|
||||
term+=2.D0*(3.D0*bielec_pxxq_no(aa,i,i,aa)-bielec_pqxx_no(aa,aa,i,i))
|
||||
else
|
||||
bb=list_virt(b)
|
||||
! ia/ib
|
||||
term=2.D0*(Fipq(aa,bb)+Fapq(aa,bb))
|
||||
term+=2.D0*(3.D0*bielec_pxxq_no(aa,i,i,bb)-bielec_pqxx_no(aa,bb,i,i))
|
||||
end if
|
||||
else
|
||||
! ia/jb
|
||||
jj=list_core_inact(j)
|
||||
bb=list_virt(b)
|
||||
term=2.D0*(4.D0*bielec_pxxq_no(aa,i,j,bb)-bielec_pqxx_no(aa,bb,i,j) &
|
||||
-bielec_pxxq_no(aa,j,i,bb))
|
||||
if (a.eq.b) then
|
||||
term-=2.D0*(Fipq(ii,jj)+Fapq(ii,jj))
|
||||
end if
|
||||
end if
|
||||
term*=2.D0
|
||||
hessmat_iajb=term
|
||||
|
||||
end function hessmat_iajb
|
||||
|
||||
real*8 function hessmat_iatb(i,a,t,b)
|
||||
BEGIN_DOC
|
||||
! the orbital hessian for core/inactive -> virtual, active -> virtual
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,a,t,b,ii,aa,tt,bb,v,vv,x,y,v3,t3
|
||||
real*8 :: term
|
||||
|
||||
ii=list_core_inact(i)
|
||||
aa=list_virt(a)
|
||||
tt=list_act(t)
|
||||
bb=list_virt(b)
|
||||
t3=t+n_core_inact_orb
|
||||
term=occnum(tt)*(4.D0*bielec_pxxq_no(aa,i,t3,bb)-bielec_pxxq_no(aa,t3,i,bb)&
|
||||
-bielec_pqxx_no(aa,bb,i,t3))
|
||||
if (a.eq.b) then
|
||||
term-=Fipq(tt,ii)+Fapq(tt,ii)
|
||||
term-=0.5D0*occnum(tt)*Fipq(tt,ii)
|
||||
do v=1,n_act_orb
|
||||
do x=1,n_act_orb
|
||||
do y=1,n_act_orb
|
||||
term-=P0tuvx_no(t,v,x,y)*bielecCI_no(x,y,v,ii)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
term*=2.D0
|
||||
hessmat_iatb=term
|
||||
|
||||
end function hessmat_iatb
|
||||
|
||||
real*8 function hessmat_taub(t,a,u,b)
|
||||
BEGIN_DOC
|
||||
! the orbital hessian for act->virt,act->virt
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: t,a,u,b,tt,aa,uu,bb,v,vv,x,xx,y
|
||||
integer :: v3,x3
|
||||
real*8 :: term,t1,t2,t3
|
||||
|
||||
tt=list_act(t)
|
||||
aa=list_virt(a)
|
||||
if (t == u) then
|
||||
if (a == b) then
|
||||
! ta/ta
|
||||
t1=occnum(tt)*Fipq(aa,aa)
|
||||
t2=0.D0
|
||||
t3=0.D0
|
||||
t1-=occnum(tt)*Fipq(tt,tt)
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
v3=v+n_core_inact_orb
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
x3=x+n_core_inact_orb
|
||||
t2+=2.D0*(P0tuvx_no(t,t,v,x)*bielec_pqxx_no(aa,aa,v3,x3) &
|
||||
+(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v))* &
|
||||
bielec_pxxq_no(aa,x3,v3,aa))
|
||||
do y=1,n_act_orb
|
||||
t3-=2.D0*P0tuvx_no(t,v,x,y)*bielecCI_no(t,v,y,xx)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
term=t1+t2+t3
|
||||
else
|
||||
bb=list_virt(b)
|
||||
! ta/tb b/=a
|
||||
term=occnum(tt)*Fipq(aa,bb)
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
v3=v+n_core_inact_orb
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
x3=x+n_core_inact_orb
|
||||
term+=2.D0*(P0tuvx_no(t,t,v,x)*bielec_pqxx_no(aa,bb,v3,x3) &
|
||||
+(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v)) &
|
||||
*bielec_pxxq_no(aa,x3,v3,bb))
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
else
|
||||
! ta/ub t/=u
|
||||
uu=list_act(u)
|
||||
bb=list_virt(b)
|
||||
term=0.D0
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
v3=v+n_core_inact_orb
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
x3=x+n_core_inact_orb
|
||||
term+=2.D0*(P0tuvx_no(t,u,v,x)*bielec_pqxx_no(aa,bb,v3,x3) &
|
||||
+(P0tuvx_no(t,x,v,u)+P0tuvx_no(t,x,u,v)) &
|
||||
*bielec_pxxq_no(aa,x3,v3,bb))
|
||||
end do
|
||||
end do
|
||||
if (a.eq.b) then
|
||||
term-=0.5D0*(occnum(tt)*Fipq(uu,tt)+occnum(uu)*Fipq(tt,uu))
|
||||
do v=1,n_act_orb
|
||||
do y=1,n_act_orb
|
||||
do x=1,n_act_orb
|
||||
term-=P0tuvx_no(t,v,x,y)*bielecCI_no(x,y,v,uu)
|
||||
term-=P0tuvx_no(u,v,x,y)*bielecCI_no(x,y,v,tt)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
term*=2.D0
|
||||
hessmat_taub=term
|
||||
|
||||
end function hessmat_taub
|
||||
|
||||
BEGIN_PROVIDER [real*8, hessdiag, (nMonoEx)]
|
||||
BEGIN_DOC
|
||||
! the diagonal of the Hessian, needed for the Davidson procedure
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,t,a,indx,indx_shift
|
||||
real*8 :: hessmat_itju,hessmat_iajb,hessmat_taub
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP SHARED(hessdiag,n_core_inact_orb,n_act_orb,n_virt_orb,nMonoEx) &
|
||||
!$OMP PRIVATE(i,indx,t,a,indx_shift)
|
||||
|
||||
!$OMP DO
|
||||
do i=1,n_core_inact_orb
|
||||
do t=1,n_act_orb
|
||||
indx = t + (i-1)*n_act_orb
|
||||
hessdiag(indx)=hessmat_itju(i,t,i,t)
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
indx_shift = n_core_inact_orb*n_act_orb
|
||||
!$OMP DO
|
||||
do a=1,n_virt_orb
|
||||
do i=1,n_core_inact_orb
|
||||
indx = a + (i-1)*n_virt_orb + indx_shift
|
||||
hessdiag(indx)=hessmat_iajb(i,a,i,a)
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
indx_shift += n_core_inact_orb*n_virt_orb
|
||||
!$OMP DO
|
||||
do a=1,n_virt_orb
|
||||
do t=1,n_act_orb
|
||||
indx = a + (t-1)*n_virt_orb + indx_shift
|
||||
hessdiag(indx)=hessmat_taub(t,a,t,a)
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
80
src/casscf/mcscf_fock.irp.f
Normal file
80
src/casscf/mcscf_fock.irp.f
Normal file
@ -0,0 +1,80 @@
|
||||
BEGIN_PROVIDER [real*8, Fipq, (mo_num,mo_num) ]
|
||||
BEGIN_DOC
|
||||
! the inactive Fock matrix, in molecular orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: p,q,k,kk,t,tt,u,uu
|
||||
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
Fipq(p,q)=one_ints_no(p,q)
|
||||
end do
|
||||
end do
|
||||
|
||||
! the inactive Fock matrix
|
||||
do k=1,n_core_inact_orb
|
||||
kk=list_core_inact(k)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
Fipq(p,q)+=2.D0*bielec_pqxx_no(p,q,k,k) -bielec_pxxq_no(p,k,k,q)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
if (bavard) then
|
||||
integer :: i
|
||||
write(6,*)
|
||||
write(6,*) ' the diagonal of the inactive effective Fock matrix '
|
||||
write(6,'(5(i3,F12.5))') (i,Fipq(i,i),i=1,mo_num)
|
||||
write(6,*)
|
||||
end if
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, Fapq, (mo_num,mo_num) ]
|
||||
BEGIN_DOC
|
||||
! the active active Fock matrix, in molecular orbitals
|
||||
! we create them in MOs, quite expensive
|
||||
!
|
||||
! for an implementation in AOs we need first the natural orbitals
|
||||
! for forming an active density matrix in AOs
|
||||
!
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: p,q,k,kk,t,tt,u,uu
|
||||
|
||||
Fapq = 0.d0
|
||||
|
||||
! the active Fock matrix, D0tu is diagonal
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
Fapq(p,q)+=occnum(tt) &
|
||||
*(bielec_pqxx_no(p,q,tt,tt)-0.5D0*bielec_pxxq_no(p,tt,tt,q))
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
if (bavard) then
|
||||
integer :: i
|
||||
write(6,*)
|
||||
write(6,*) ' the effective Fock matrix over MOs'
|
||||
write(6,*)
|
||||
|
||||
write(6,*)
|
||||
write(6,*) ' the diagonal of the inactive effective Fock matrix '
|
||||
write(6,'(5(i3,F12.5))') (i,Fipq(i,i),i=1,mo_num)
|
||||
write(6,*)
|
||||
write(6,*)
|
||||
write(6,*) ' the diagonal of the active Fock matrix '
|
||||
write(6,'(5(i3,F12.5))') (i,Fapq(i,i),i=1,mo_num)
|
||||
write(6,*)
|
||||
end if
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
231
src/casscf/natorb.irp.f
Normal file
231
src/casscf/natorb.irp.f
Normal file
@ -0,0 +1,231 @@
|
||||
BEGIN_PROVIDER [real*8, occnum, (mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! MO occupation numbers
|
||||
END_DOC
|
||||
|
||||
integer :: i
|
||||
occnum=0.D0
|
||||
do i=1,n_core_inact_orb
|
||||
occnum(list_core_inact(i))=2.D0
|
||||
end do
|
||||
|
||||
do i=1,n_act_orb
|
||||
occnum(list_act(i))=occ_act(i)
|
||||
end do
|
||||
|
||||
if (bavard) then
|
||||
write(6,*) ' occupation numbers '
|
||||
do i=1,mo_num
|
||||
write(6,*) i,occnum(i)
|
||||
end do
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ real*8, natorbsCI, (n_act_orb,n_act_orb) ]
|
||||
&BEGIN_PROVIDER [ real*8, occ_act, (n_act_orb) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Natural orbitals of CI
|
||||
END_DOC
|
||||
integer :: i, j
|
||||
double precision :: Vt(n_act_orb,n_act_orb)
|
||||
|
||||
! call lapack_diag(occ_act,natorbsCI,D0tu,n_act_orb,n_act_orb)
|
||||
call svd(D0tu, size(D0tu,1), natorbsCI,size(natorbsCI,1), occ_act, Vt, size(Vt,1),n_act_orb,n_act_orb)
|
||||
|
||||
if (bavard) then
|
||||
write(6,*) ' found occupation numbers as '
|
||||
do i=1,n_act_orb
|
||||
write(6,*) i,occ_act(i)
|
||||
end do
|
||||
|
||||
integer :: nmx
|
||||
real*8 :: xmx
|
||||
do i=1,n_act_orb
|
||||
! largest element of the eigenvector should be positive
|
||||
xmx=0.D0
|
||||
nmx=0
|
||||
do j=1,n_act_orb
|
||||
if (abs(natOrbsCI(j,i)).gt.xmx) then
|
||||
nmx=j
|
||||
xmx=abs(natOrbsCI(j,i))
|
||||
end if
|
||||
end do
|
||||
xmx=sign(1.D0,natOrbsCI(nmx,i))
|
||||
do j=1,n_act_orb
|
||||
natOrbsCI(j,i)*=xmx
|
||||
end do
|
||||
|
||||
write(6,*) ' Eigenvector No ',i
|
||||
write(6,'(5(I3,F12.5))') (j,natOrbsCI(j,i),j=1,n_act_orb)
|
||||
end do
|
||||
end if
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, P0tuvx_no, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! 4-index transformation of 2part matrices
|
||||
END_DOC
|
||||
integer :: i,j,k,l,p,q
|
||||
real*8 :: d(n_act_orb)
|
||||
|
||||
! index per index
|
||||
! first quarter
|
||||
P0tuvx_no(:,:,:,:) = P0tuvx(:,:,:,:)
|
||||
|
||||
do j=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=P0tuvx_no(q,j,k,l)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
P0tuvx_no(p,j,k,l)=d(p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
! 2nd quarter
|
||||
do j=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=P0tuvx_no(j,q,k,l)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
P0tuvx_no(j,p,k,l)=d(p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
! 3rd quarter
|
||||
do j=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=P0tuvx_no(j,k,q,l)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
P0tuvx_no(j,k,p,l)=d(p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
! 4th quarter
|
||||
do j=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=P0tuvx_no(j,k,l,q)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
P0tuvx_no(j,k,l,p)=d(p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, one_ints_no, (mo_num,mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Transformed one-e integrals
|
||||
END_DOC
|
||||
integer :: i,j, p, q
|
||||
real*8 :: d(n_act_orb)
|
||||
one_ints_no(:,:)=mo_one_e_integrals(:,:)
|
||||
|
||||
! 1st half-trf
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=one_ints_no(list_act(q),j)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
one_ints_no(list_act(p),j)=d(p)
|
||||
end do
|
||||
end do
|
||||
|
||||
! 2nd half-trf
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=one_ints_no(j,list_act(q))*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
one_ints_no(j,list_act(p))=d(p)
|
||||
end do
|
||||
end do
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, NatOrbsCI_mos, (mo_num, mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Rotation matrix from current MOs to the CI natural MOs
|
||||
END_DOC
|
||||
integer :: p,q
|
||||
|
||||
NatOrbsCI_mos(:,:) = 0.d0
|
||||
|
||||
do q = 1,mo_num
|
||||
NatOrbsCI_mos(q,q) = 1.d0
|
||||
enddo
|
||||
|
||||
do q = 1,n_act_orb
|
||||
do p = 1,n_act_orb
|
||||
NatOrbsCI_mos(list_act(p),list_act(q)) = natorbsCI(p,q)
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, NatOrbsFCI, (ao_num,mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! FCI natural orbitals
|
||||
END_DOC
|
||||
|
||||
call dgemm('N','N', ao_num,mo_num,mo_num,1.d0, &
|
||||
mo_coef, size(mo_coef,1), &
|
||||
NatOrbsCI_mos, size(NatOrbsCI_mos,1), 0.d0, &
|
||||
NatOrbsFCI, size(NatOrbsFCI,1))
|
||||
END_PROVIDER
|
||||
|
221
src/casscf/neworbs.irp.f
Normal file
221
src/casscf/neworbs.irp.f
Normal file
@ -0,0 +1,221 @@
|
||||
BEGIN_PROVIDER [real*8, SXmatrix, (nMonoEx+1,nMonoEx+1)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Single-excitation matrix
|
||||
END_DOC
|
||||
|
||||
integer :: i,j
|
||||
|
||||
do i=1,nMonoEx+1
|
||||
do j=1,nMonoEx+1
|
||||
SXmatrix(i,j)=0.D0
|
||||
end do
|
||||
end do
|
||||
|
||||
do i=1,nMonoEx
|
||||
SXmatrix(1,i+1)=gradvec2(i)
|
||||
SXmatrix(1+i,1)=gradvec2(i)
|
||||
end do
|
||||
|
||||
do i=1,nMonoEx
|
||||
do j=1,nMonoEx
|
||||
SXmatrix(i+1,j+1)=hessmat2(i,j)
|
||||
SXmatrix(j+1,i+1)=hessmat2(i,j)
|
||||
end do
|
||||
end do
|
||||
|
||||
do i = 1, nMonoEx
|
||||
SXmatrix(i+1,i+1) += level_shift_casscf
|
||||
enddo
|
||||
if (bavard) then
|
||||
do i=2,nMonoEx
|
||||
write(6,*) ' diagonal of the Hessian : ',i,hessmat2(i,i)
|
||||
end do
|
||||
end if
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [real*8, SXeigenvec, (nMonoEx+1,nMonoEx+1)]
|
||||
&BEGIN_PROVIDER [real*8, SXeigenval, (nMonoEx+1)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Eigenvectors/eigenvalues of the single-excitation matrix
|
||||
END_DOC
|
||||
call lapack_diag(SXeigenval,SXeigenvec,SXmatrix,nMonoEx+1,nMonoEx+1)
|
||||
if (bavard) then
|
||||
write(6,*) ' SXdiag : lowest 5 eigenvalues '
|
||||
write(6,*) ' 1 - ',SXeigenval(1),SXeigenvec(1,1)
|
||||
if(nmonoex.gt.0)then
|
||||
write(6,*) ' 2 - ',SXeigenval(2),SXeigenvec(1,2)
|
||||
write(6,*) ' 3 - ',SXeigenval(3),SXeigenvec(1,3)
|
||||
write(6,*) ' 4 - ',SXeigenval(4),SXeigenvec(1,4)
|
||||
write(6,*) ' 5 - ',SXeigenval(5),SXeigenvec(1,5)
|
||||
endif
|
||||
write(6,*)
|
||||
write(6,*) ' SXdiag : lowest eigenvalue = ',SXeigenval(1)
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [real*8, energy_improvement]
|
||||
implicit none
|
||||
if(state_following_casscf)then
|
||||
energy_improvement = SXeigenval(best_vector_ovrlp_casscf)
|
||||
else
|
||||
energy_improvement = SXeigenval(1)
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, best_vector_ovrlp_casscf ]
|
||||
&BEGIN_PROVIDER [ double precision, best_overlap_casscf ]
|
||||
implicit none
|
||||
integer :: i
|
||||
double precision :: c0
|
||||
best_overlap_casscf = 0.D0
|
||||
best_vector_ovrlp_casscf = -1000
|
||||
do i=1,nMonoEx+1
|
||||
if (SXeigenval(i).lt.0.D0) then
|
||||
if (abs(SXeigenvec(1,i)).gt.best_overlap_casscf) then
|
||||
best_overlap_casscf=abs(SXeigenvec(1,i))
|
||||
best_vector_ovrlp_casscf = i
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
if(best_vector_ovrlp_casscf.lt.0)then
|
||||
best_vector_ovrlp_casscf = minloc(SXeigenval,nMonoEx+1)
|
||||
endif
|
||||
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
|
||||
if (bavard) then
|
||||
write(6,*) ' SXdiag : eigenvalue for best overlap with '
|
||||
write(6,*) ' previous orbitals = ',SXeigenval(best_vector_ovrlp_casscf)
|
||||
write(6,*) ' weight of the 1st element ',c0
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, SXvector, (nMonoEx+1)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Best eigenvector of the single-excitation matrix
|
||||
END_DOC
|
||||
integer :: i
|
||||
double precision :: c0
|
||||
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
|
||||
do i=1,nMonoEx+1
|
||||
SXvector(i)=SXeigenvec(i,best_vector_ovrlp_casscf)/c0
|
||||
end do
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, NewOrbs, (ao_num,mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Updated orbitals
|
||||
END_DOC
|
||||
integer :: i,j,ialph
|
||||
|
||||
if(state_following_casscf)then
|
||||
print*,'Using the state following casscf '
|
||||
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
||||
NatOrbsFCI, size(NatOrbsFCI,1), &
|
||||
Umat, size(Umat,1), 0.d0, &
|
||||
NewOrbs, size(NewOrbs,1))
|
||||
|
||||
level_shift_casscf *= 0.5D0
|
||||
level_shift_casscf = max(level_shift_casscf,0.002d0)
|
||||
!touch level_shift_casscf
|
||||
else
|
||||
if(best_vector_ovrlp_casscf.ne.1.and.n_orb_swap.ne.0)then
|
||||
print*,'Taking the lowest root for the CASSCF'
|
||||
print*,'!!! SWAPPING MOS !!!!!!'
|
||||
level_shift_casscf *= 2.D0
|
||||
level_shift_casscf = min(level_shift_casscf,0.5d0)
|
||||
print*,'level_shift_casscf = ',level_shift_casscf
|
||||
NewOrbs = switch_mo_coef
|
||||
!mo_coef = switch_mo_coef
|
||||
!soft_touch mo_coef
|
||||
!call save_mos_no_occ
|
||||
!stop
|
||||
else
|
||||
level_shift_casscf *= 0.5D0
|
||||
level_shift_casscf = max(level_shift_casscf,0.002d0)
|
||||
!touch level_shift_casscf
|
||||
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
||||
NatOrbsFCI, size(NatOrbsFCI,1), &
|
||||
Umat, size(Umat,1), 0.d0, &
|
||||
NewOrbs, size(NewOrbs,1))
|
||||
endif
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [real*8, Umat, (mo_num,mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Orbital rotation matrix
|
||||
END_DOC
|
||||
integer :: i,j,indx,k,iter,t,a,ii,tt,aa
|
||||
logical :: converged
|
||||
|
||||
real*8 :: Tpotmat (mo_num,mo_num), Tpotmat2 (mo_num,mo_num)
|
||||
real*8 :: Tmat(mo_num,mo_num)
|
||||
real*8 :: f
|
||||
|
||||
! the orbital rotation matrix T
|
||||
Tmat(:,:)=0.D0
|
||||
indx=1
|
||||
do i=1,n_core_inact_orb
|
||||
ii=list_core_inact(i)
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
indx+=1
|
||||
Tmat(ii,tt)= SXvector(indx)
|
||||
Tmat(tt,ii)=-SXvector(indx)
|
||||
end do
|
||||
end do
|
||||
do i=1,n_core_inact_orb
|
||||
ii=list_core_inact(i)
|
||||
do a=1,n_virt_orb
|
||||
aa=list_virt(a)
|
||||
indx+=1
|
||||
Tmat(ii,aa)= SXvector(indx)
|
||||
Tmat(aa,ii)=-SXvector(indx)
|
||||
end do
|
||||
end do
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
do a=1,n_virt_orb
|
||||
aa=list_virt(a)
|
||||
indx+=1
|
||||
Tmat(tt,aa)= SXvector(indx)
|
||||
Tmat(aa,tt)=-SXvector(indx)
|
||||
end do
|
||||
end do
|
||||
|
||||
! Form the exponential
|
||||
|
||||
Tpotmat(:,:)=0.D0
|
||||
Umat(:,:) =0.D0
|
||||
do i=1,mo_num
|
||||
Tpotmat(i,i)=1.D0
|
||||
Umat(i,i) =1.d0
|
||||
end do
|
||||
iter=0
|
||||
converged=.false.
|
||||
do while (.not.converged)
|
||||
iter+=1
|
||||
f = 1.d0 / dble(iter)
|
||||
Tpotmat2(:,:) = Tpotmat(:,:) * f
|
||||
call dgemm('N','N', mo_num,mo_num,mo_num,1.d0, &
|
||||
Tpotmat2, size(Tpotmat2,1), &
|
||||
Tmat, size(Tmat,1), 0.d0, &
|
||||
Tpotmat, size(Tpotmat,1))
|
||||
Umat(:,:) = Umat(:,:) + Tpotmat(:,:)
|
||||
|
||||
converged = ( sum(abs(Tpotmat(:,:))) < 1.d-6).or.(iter>30)
|
||||
end do
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
70
src/casscf/reorder_orb.irp.f
Normal file
70
src/casscf/reorder_orb.irp.f
Normal file
@ -0,0 +1,70 @@
|
||||
subroutine reorder_orbitals_for_casscf
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! routine that reorders the orbitals of the CASSCF in terms block of core, active and virtual
|
||||
END_DOC
|
||||
integer :: i,j,iorb
|
||||
integer, allocatable :: iorder(:),array(:)
|
||||
allocate(iorder(mo_num),array(mo_num))
|
||||
do i = 1, n_core_orb
|
||||
iorb = list_core(i)
|
||||
array(iorb) = i
|
||||
enddo
|
||||
|
||||
do i = 1, n_inact_orb
|
||||
iorb = list_inact(i)
|
||||
array(iorb) = mo_num + i
|
||||
enddo
|
||||
|
||||
do i = 1, n_act_orb
|
||||
iorb = list_act(i)
|
||||
array(iorb) = 2 * mo_num + i
|
||||
enddo
|
||||
|
||||
do i = 1, n_virt_orb
|
||||
iorb = list_virt(i)
|
||||
array(iorb) = 3 * mo_num + i
|
||||
enddo
|
||||
|
||||
do i = 1, mo_num
|
||||
iorder(i) = i
|
||||
enddo
|
||||
call isort(array,iorder,mo_num)
|
||||
double precision, allocatable :: mo_coef_new(:,:)
|
||||
allocate(mo_coef_new(ao_num,mo_num))
|
||||
do i = 1, mo_num
|
||||
mo_coef_new(:,i) = mo_coef(:,iorder(i))
|
||||
enddo
|
||||
mo_coef = mo_coef_new
|
||||
touch mo_coef
|
||||
|
||||
list_core_reverse = 0
|
||||
do i = 1, n_core_orb
|
||||
list_core(i) = i
|
||||
list_core_reverse(i) = i
|
||||
mo_class(i) = "Core"
|
||||
enddo
|
||||
|
||||
list_inact_reverse = 0
|
||||
do i = 1, n_inact_orb
|
||||
list_inact(i) = i + n_core_orb
|
||||
list_inact_reverse(i+n_core_orb) = i
|
||||
mo_class(i+n_core_orb) = "Inactive"
|
||||
enddo
|
||||
|
||||
list_act_reverse = 0
|
||||
do i = 1, n_act_orb
|
||||
list_act(i) = n_core_inact_orb + i
|
||||
list_act_reverse(n_core_inact_orb + i) = i
|
||||
mo_class(n_core_inact_orb + i) = "Active"
|
||||
enddo
|
||||
|
||||
list_virt_reverse = 0
|
||||
do i = 1, n_virt_orb
|
||||
list_virt(i) = n_core_inact_orb + n_act_orb + i
|
||||
list_virt_reverse(n_core_inact_orb + n_act_orb + i) = i
|
||||
mo_class(n_core_inact_orb + n_act_orb + i) = "Virtual"
|
||||
enddo
|
||||
touch list_core_reverse list_core list_inact list_inact_reverse list_act list_act_reverse list_virt list_virt_reverse
|
||||
|
||||
end
|
9
src/casscf/save_energy.irp.f
Normal file
9
src/casscf/save_energy.irp.f
Normal file
@ -0,0 +1,9 @@
|
||||
subroutine save_energy(E,pt2)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Saves the energy in |EZFIO|.
|
||||
END_DOC
|
||||
double precision, intent(in) :: E(N_states), pt2(N_states)
|
||||
call ezfio_set_casscf_energy(E(1:N_states))
|
||||
call ezfio_set_casscf_energy_pt2(E(1:N_states)+pt2(1:N_states))
|
||||
end
|
207
src/casscf/superci_dm.irp.f
Normal file
207
src/casscf/superci_dm.irp.f
Normal file
@ -0,0 +1,207 @@
|
||||
BEGIN_PROVIDER [double precision, super_ci_dm, (mo_num,mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! density matrix of the super CI matrix, in the basis of NATURAL ORBITALS OF THE CASCI WF
|
||||
!
|
||||
! This is obtained from annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
!
|
||||
! WARNING ::: in the equation B3.d there is a TYPO with a forgotten MINUS SIGN (see variable mat_tmp_dm_super_ci )
|
||||
END_DOC
|
||||
super_ci_dm = 0.d0
|
||||
integer :: i,j,iorb,jorb
|
||||
integer :: a,aorb,b,borb
|
||||
integer :: t,torb,v,vorb,u,uorb,x,xorb
|
||||
double precision :: c0,ci
|
||||
c0 = SXeigenvec(1,1)
|
||||
! equation B3.a of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
! loop over the core/inact
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
super_ci_dm(iorb,iorb) = 2.d0 ! first term of B3.a
|
||||
! loop over the core/inact
|
||||
do j = 1, n_core_inact_orb
|
||||
jorb = list_core_inact(j)
|
||||
! loop over the virtual
|
||||
do a = 1, n_virt_orb
|
||||
aorb = list_virt(a)
|
||||
super_ci_dm(jorb,iorb) += -2.d0 * lowest_super_ci_coef_mo(aorb,iorb) * lowest_super_ci_coef_mo(aorb,jorb) ! second term in B3.a
|
||||
enddo
|
||||
do t = 1, n_act_orb
|
||||
torb = list_act(t)
|
||||
! thrid term of the B3.a
|
||||
super_ci_dm(jorb,iorb) += - lowest_super_ci_coef_mo(iorb,torb) * lowest_super_ci_coef_mo(jorb,torb) * (2.d0 - occ_act(t))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! equation B3.b of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
do t = 1, n_act_orb
|
||||
torb = list_act(t)
|
||||
super_ci_dm(iorb,torb) = c0 * lowest_super_ci_coef_mo(torb,iorb) * (2.d0 - occ_act(t))
|
||||
super_ci_dm(torb,iorb) = c0 * lowest_super_ci_coef_mo(torb,iorb) * (2.d0 - occ_act(t))
|
||||
do a = 1, n_virt_orb
|
||||
aorb = list_virt(a)
|
||||
super_ci_dm(iorb,torb) += - lowest_super_ci_coef_mo(aorb,iorb) * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
|
||||
super_ci_dm(torb,iorb) += - lowest_super_ci_coef_mo(aorb,iorb) * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! equation B3.c of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
do a = 1, n_virt_orb
|
||||
aorb = list_virt(a)
|
||||
super_ci_dm(aorb,iorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
||||
super_ci_dm(iorb,aorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! equation B3.d of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
do t = 1, n_act_orb
|
||||
torb = list_act(t)
|
||||
super_ci_dm(torb,torb) = occ_act(t) ! first term of equation B3.d
|
||||
do x = 1, n_act_orb
|
||||
xorb = list_act(x)
|
||||
super_ci_dm(torb,torb) += - occ_act(x) * occ_act(t)* mat_tmp_dm_super_ci(x,x) ! second term involving the ONE-rdm
|
||||
enddo
|
||||
do u = 1, n_act_orb
|
||||
uorb = list_act(u)
|
||||
|
||||
! second term of equation B3.d
|
||||
do x = 1, n_act_orb
|
||||
xorb = list_act(x)
|
||||
do v = 1, n_act_orb
|
||||
vorb = list_act(v)
|
||||
super_ci_dm(torb,uorb) += 2.d0 * P0tuvx_no(v,x,t,u) * mat_tmp_dm_super_ci(v,x) ! second term involving the TWO-rdm
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! third term of equation B3.d
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
super_ci_dm(torb,uorb) += lowest_super_ci_coef_mo(iorb,torb) * lowest_super_ci_coef_mo(iorb,uorb) * (2.d0 - occ_act(t) - occ_act(u))
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! equation B3.e of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
do t = 1, n_act_orb
|
||||
torb = list_act(t)
|
||||
do a = 1, n_virt_orb
|
||||
aorb = list_virt(a)
|
||||
super_ci_dm(aorb,torb) += c0 * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
|
||||
super_ci_dm(torb,aorb) += c0 * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
super_ci_dm(aorb,torb) += lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,torb) * (2.d0 - occ_act(t))
|
||||
super_ci_dm(torb,aorb) += lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,torb) * (2.d0 - occ_act(t))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! equation B3.f of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
do a = 1, n_virt_orb
|
||||
aorb = list_virt(a)
|
||||
do b = 1, n_virt_orb
|
||||
borb= list_virt(b)
|
||||
|
||||
! First term of equation B3.f
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
super_ci_dm(borb,aorb) += 2.d0 * lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,borb)
|
||||
enddo
|
||||
|
||||
! Second term of equation B3.f
|
||||
do t = 1, n_act_orb
|
||||
torb = list_act(t)
|
||||
super_ci_dm(borb,aorb) += lowest_super_ci_coef_mo(torb,aorb) * lowest_super_ci_coef_mo(torb,borb) * occ_act(t)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, superci_natorb, (ao_num,mo_num)
|
||||
&BEGIN_PROVIDER [double precision, superci_nat_occ, (mo_num)
|
||||
implicit none
|
||||
call general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(super_ci_dm,mo_num,mo_num,mo_num,NatOrbsFCI,superci_nat_occ,superci_natorb)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, mat_tmp_dm_super_ci, (n_act_orb,n_act_orb)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! computation of the term in [ ] in the equation B3.d of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
!
|
||||
! !!!!! WARNING !!!!!! there is a TYPO: a MINUS SIGN SHOULD APPEAR in that term
|
||||
END_DOC
|
||||
integer :: a,aorb,i,iorb
|
||||
integer :: x,xorb,v,vorb
|
||||
mat_tmp_dm_super_ci = 0.d0
|
||||
do v = 1, n_act_orb
|
||||
vorb = list_act(v)
|
||||
do x = 1, n_act_orb
|
||||
xorb = list_act(x)
|
||||
do a = 1, n_virt_orb
|
||||
aorb = list_virt(a)
|
||||
mat_tmp_dm_super_ci(x,v) += lowest_super_ci_coef_mo(aorb,vorb) * lowest_super_ci_coef_mo(aorb,xorb)
|
||||
enddo
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
! MARK THE MINUS SIGN HERE !!!!!!!!!!! BECAUSE OF TYPO IN THE ORIGINAL PAPER
|
||||
mat_tmp_dm_super_ci(x,v) -= lowest_super_ci_coef_mo(iorb,vorb) * lowest_super_ci_coef_mo(iorb,xorb)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, lowest_super_ci_coef_mo, (mo_num,mo_num)]
|
||||
implicit none
|
||||
integer :: i,j,iorb,jorb
|
||||
integer :: a, aorb,t, torb
|
||||
double precision :: sqrt2
|
||||
|
||||
sqrt2 = 1.d0/dsqrt(2.d0)
|
||||
do i = 1, nMonoEx
|
||||
iorb = excit(1,i)
|
||||
jorb = excit(2,i)
|
||||
lowest_super_ci_coef_mo(iorb,jorb) = SXeigenvec(i+1,1)
|
||||
lowest_super_ci_coef_mo(jorb,iorb) = SXeigenvec(i+1,1)
|
||||
enddo
|
||||
|
||||
! a_{it} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
do t = 1, n_act_orb
|
||||
torb = list_act(t)
|
||||
lowest_super_ci_coef_mo(torb,iorb) *= (2.d0 - occ_act(t))**(-0.5d0)
|
||||
lowest_super_ci_coef_mo(iorb,torb) *= (2.d0 - occ_act(t))**(-0.5d0)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! a_{ia} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
do i = 1, n_core_inact_orb
|
||||
iorb = list_core_inact(i)
|
||||
do a = 1, n_virt_orb
|
||||
aorb = list_virt(a)
|
||||
lowest_super_ci_coef_mo(aorb,iorb) *= sqrt2
|
||||
lowest_super_ci_coef_mo(iorb,aorb) *= sqrt2
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! a_{ta} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||
do a = 1, n_virt_orb
|
||||
aorb = list_virt(a)
|
||||
do t = 1, n_act_orb
|
||||
torb = list_act(t)
|
||||
lowest_super_ci_coef_mo(torb,aorb) *= occ_act(t)**(-0.5d0)
|
||||
lowest_super_ci_coef_mo(aorb,torb) *= occ_act(t)**(-0.5d0)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
132
src/casscf/swap_orb.irp.f
Normal file
132
src/casscf/swap_orb.irp.f
Normal file
@ -0,0 +1,132 @@
|
||||
BEGIN_PROVIDER [double precision, SXvector_lowest, (nMonoEx)]
|
||||
implicit none
|
||||
integer :: i
|
||||
do i=2,nMonoEx+1
|
||||
SXvector_lowest(i-1)=SXeigenvec(i,1)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, thresh_overlap_switch]
|
||||
implicit none
|
||||
thresh_overlap_switch = 0.5d0
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, max_overlap, (nMonoEx)]
|
||||
&BEGIN_PROVIDER [integer, n_max_overlap]
|
||||
&BEGIN_PROVIDER [integer, dim_n_max_overlap]
|
||||
implicit none
|
||||
double precision, allocatable :: vec_tmp(:)
|
||||
integer, allocatable :: iorder(:)
|
||||
allocate(vec_tmp(nMonoEx),iorder(nMonoEx))
|
||||
integer :: i
|
||||
do i = 1, nMonoEx
|
||||
iorder(i) = i
|
||||
vec_tmp(i) = -dabs(SXvector_lowest(i))
|
||||
enddo
|
||||
call dsort(vec_tmp,iorder,nMonoEx)
|
||||
n_max_overlap = 0
|
||||
do i = 1, nMonoEx
|
||||
if(dabs(vec_tmp(i)).gt.thresh_overlap_switch)then
|
||||
n_max_overlap += 1
|
||||
max_overlap(n_max_overlap) = iorder(i)
|
||||
endif
|
||||
enddo
|
||||
dim_n_max_overlap = max(1,n_max_overlap)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, orb_swap, (2,dim_n_max_overlap)]
|
||||
&BEGIN_PROVIDER [integer, index_orb_swap, (dim_n_max_overlap)]
|
||||
&BEGIN_PROVIDER [integer, n_orb_swap ]
|
||||
implicit none
|
||||
use bitmasks ! you need to include the bitmasks_module.f90 features
|
||||
integer :: i,imono,iorb,jorb,j
|
||||
n_orb_swap = 0
|
||||
do i = 1, n_max_overlap
|
||||
imono = max_overlap(i)
|
||||
iorb = excit(1,imono)
|
||||
jorb = excit(2,imono)
|
||||
if (excit_class(imono) == "c-a" .and.hessmat2(imono,imono).gt.0.d0)then ! core --> active rotation
|
||||
n_orb_swap += 1
|
||||
orb_swap(1,n_orb_swap) = iorb ! core
|
||||
orb_swap(2,n_orb_swap) = jorb ! active
|
||||
index_orb_swap(n_orb_swap) = imono
|
||||
else if (excit_class(imono) == "a-v" .and.hessmat2(imono,imono).gt.0.d0)then ! active --> virtual rotation
|
||||
n_orb_swap += 1
|
||||
orb_swap(1,n_orb_swap) = jorb ! virtual
|
||||
orb_swap(2,n_orb_swap) = iorb ! active
|
||||
index_orb_swap(n_orb_swap) = imono
|
||||
endif
|
||||
enddo
|
||||
|
||||
integer,allocatable :: orb_swap_tmp(:,:)
|
||||
allocate(orb_swap_tmp(2,dim_n_max_overlap))
|
||||
do i = 1, n_orb_swap
|
||||
orb_swap_tmp(1,i) = orb_swap(1,i)
|
||||
orb_swap_tmp(2,i) = orb_swap(2,i)
|
||||
enddo
|
||||
|
||||
integer(bit_kind), allocatable :: det_i(:),det_j(:)
|
||||
allocate(det_i(N_int),det_j(N_int))
|
||||
logical, allocatable :: good_orb_rot(:)
|
||||
allocate(good_orb_rot(n_orb_swap))
|
||||
integer, allocatable :: index_orb_swap_tmp(:)
|
||||
allocate(index_orb_swap_tmp(dim_n_max_overlap))
|
||||
index_orb_swap_tmp = index_orb_swap
|
||||
good_orb_rot = .True.
|
||||
integer :: icount,k
|
||||
do i = 1, n_orb_swap
|
||||
if(.not.good_orb_rot(i))cycle
|
||||
det_i = 0_bit_kind
|
||||
call set_bit_to_integer(orb_swap(1,i),det_i,N_int)
|
||||
call set_bit_to_integer(orb_swap(2,i),det_i,N_int)
|
||||
do j = i+1, n_orb_swap
|
||||
det_j = 0_bit_kind
|
||||
call set_bit_to_integer(orb_swap(1,j),det_j,N_int)
|
||||
call set_bit_to_integer(orb_swap(2,j),det_j,N_int)
|
||||
icount = 0
|
||||
do k = 1, N_int
|
||||
icount += popcnt(ior(det_i(k),det_j(k)))
|
||||
enddo
|
||||
if (icount.ne.4)then
|
||||
good_orb_rot(i) = .False.
|
||||
good_orb_rot(j) = .False.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
icount = n_orb_swap
|
||||
n_orb_swap = 0
|
||||
do i = 1, icount
|
||||
if(good_orb_rot(i))then
|
||||
n_orb_swap += 1
|
||||
index_orb_swap(n_orb_swap) = index_orb_swap_tmp(i)
|
||||
orb_swap(1,n_orb_swap) = orb_swap_tmp(1,i)
|
||||
orb_swap(2,n_orb_swap) = orb_swap_tmp(2,i)
|
||||
endif
|
||||
enddo
|
||||
|
||||
if(n_orb_swap.gt.0)then
|
||||
print*,'n_orb_swap = ',n_orb_swap
|
||||
endif
|
||||
do i = 1, n_orb_swap
|
||||
print*,'imono = ',index_orb_swap(i)
|
||||
print*,orb_swap(1,i),'-->',orb_swap(2,i)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, switch_mo_coef, (ao_num,mo_num)]
|
||||
implicit none
|
||||
integer :: i,j,iorb,jorb
|
||||
switch_mo_coef = NatOrbsFCI
|
||||
do i = 1, n_orb_swap
|
||||
iorb = orb_swap(1,i)
|
||||
jorb = orb_swap(2,i)
|
||||
do j = 1, ao_num
|
||||
switch_mo_coef(j,jorb) = NatOrbsFCI(j,iorb)
|
||||
enddo
|
||||
do j = 1, ao_num
|
||||
switch_mo_coef(j,iorb) = NatOrbsFCI(j,jorb)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
29
src/casscf/test_pert_2rdm.irp.f
Normal file
29
src/casscf/test_pert_2rdm.irp.f
Normal file
@ -0,0 +1,29 @@
|
||||
program test_pert_2rdm
|
||||
implicit none
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
!call get_pert_2rdm
|
||||
integer :: i,j,k,l,ii,jj,kk,ll
|
||||
double precision :: accu , get_two_e_integral, integral
|
||||
accu = 0.d0
|
||||
print*,'n_orb_pert_rdm = ',n_orb_pert_rdm
|
||||
do ii = 1, n_orb_pert_rdm
|
||||
i = list_orb_pert_rdm(ii)
|
||||
do jj = 1, n_orb_pert_rdm
|
||||
j = list_orb_pert_rdm(jj)
|
||||
do kk = 1, n_orb_pert_rdm
|
||||
k= list_orb_pert_rdm(kk)
|
||||
do ll = 1, n_orb_pert_rdm
|
||||
l = list_orb_pert_rdm(ll)
|
||||
integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
||||
! if(dabs(pert_2rdm_provider(ii,jj,kk,ll) * integral).gt.1.d-12)then
|
||||
! print*,i,j,k,l
|
||||
! print*,pert_2rdm_provider(ii,jj,kk,ll) * integral,pert_2rdm_provider(ii,jj,kk,ll), pert_2rdm_provider(ii,jj,kk,ll), integral
|
||||
! endif
|
||||
accu += pert_2rdm_provider(ii,jj,kk,ll) * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*,'accu = ',accu
|
||||
end
|
101
src/casscf/tot_en.irp.f
Normal file
101
src/casscf/tot_en.irp.f
Normal file
@ -0,0 +1,101 @@
|
||||
BEGIN_PROVIDER [real*8, etwo]
|
||||
&BEGIN_PROVIDER [real*8, eone]
|
||||
&BEGIN_PROVIDER [real*8, eone_bis]
|
||||
&BEGIN_PROVIDER [real*8, etwo_bis]
|
||||
&BEGIN_PROVIDER [real*8, etwo_ter]
|
||||
&BEGIN_PROVIDER [real*8, ecore]
|
||||
&BEGIN_PROVIDER [real*8, ecore_bis]
|
||||
implicit none
|
||||
integer :: t,u,v,x,i,ii,tt,uu,vv,xx,j,jj,t3,u3,v3,x3
|
||||
real*8 :: e_one_all,e_two_all
|
||||
e_one_all=0.D0
|
||||
e_two_all=0.D0
|
||||
do i=1,n_core_inact_orb
|
||||
ii=list_core_inact(i)
|
||||
e_one_all+=2.D0*mo_one_e_integrals(ii,ii)
|
||||
do j=1,n_core_inact_orb
|
||||
jj=list_core_inact(j)
|
||||
e_two_all+=2.D0*bielec_PQxx(ii,ii,j,j)-bielec_PQxx(ii,jj,j,i)
|
||||
end do
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
t3=t+n_core_inact_orb
|
||||
do u=1,n_act_orb
|
||||
uu=list_act(u)
|
||||
u3=u+n_core_inact_orb
|
||||
e_two_all+=D0tu(t,u)*(2.D0*bielec_PQxx(tt,uu,i,i) &
|
||||
-bielec_PQxx(tt,ii,i,u3))
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
do u=1,n_act_orb
|
||||
uu=list_act(u)
|
||||
e_one_all+=D0tu(t,u)*mo_one_e_integrals(tt,uu)
|
||||
do v=1,n_act_orb
|
||||
v3=v+n_core_inact_orb
|
||||
do x=1,n_act_orb
|
||||
x3=x+n_core_inact_orb
|
||||
e_two_all +=P0tuvx(t,u,v,x)*bielec_PQxx(tt,uu,v3,x3)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
ecore =nuclear_repulsion
|
||||
ecore_bis=nuclear_repulsion
|
||||
do i=1,n_core_inact_orb
|
||||
ii=list_core_inact(i)
|
||||
ecore +=2.D0*mo_one_e_integrals(ii,ii)
|
||||
ecore_bis+=2.D0*mo_one_e_integrals(ii,ii)
|
||||
do j=1,n_core_inact_orb
|
||||
jj=list_core_inact(j)
|
||||
ecore +=2.D0*bielec_PQxx(ii,ii,j,j)-bielec_PQxx(ii,jj,j,i)
|
||||
ecore_bis+=2.D0*bielec_PxxQ(ii,i,j,jj)-bielec_PxxQ(ii,j,j,ii)
|
||||
end do
|
||||
end do
|
||||
eone =0.D0
|
||||
eone_bis=0.D0
|
||||
etwo =0.D0
|
||||
etwo_bis=0.D0
|
||||
etwo_ter=0.D0
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
t3=t+n_core_inact_orb
|
||||
do u=1,n_act_orb
|
||||
uu=list_act(u)
|
||||
u3=u+n_core_inact_orb
|
||||
eone +=D0tu(t,u)*mo_one_e_integrals(tt,uu)
|
||||
eone_bis+=D0tu(t,u)*mo_one_e_integrals(tt,uu)
|
||||
do i=1,n_core_inact_orb
|
||||
ii=list_core_inact(i)
|
||||
eone +=D0tu(t,u)*(2.D0*bielec_PQxx(tt,uu,i,i) &
|
||||
-bielec_PQxx(tt,ii,i,u3))
|
||||
eone_bis+=D0tu(t,u)*(2.D0*bielec_PxxQ(tt,u3,i,ii) &
|
||||
-bielec_PxxQ(tt,i,i,uu))
|
||||
end do
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
v3=v+n_core_inact_orb
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
x3=x+n_core_inact_orb
|
||||
real*8 :: h1,h2,h3
|
||||
h1=bielec_PQxx(tt,uu,v3,x3)
|
||||
h2=bielec_PxxQ(tt,u3,v3,xx)
|
||||
h3=bielecCI(t,u,v,xx)
|
||||
etwo +=P0tuvx(t,u,v,x)*h1
|
||||
etwo_bis+=P0tuvx(t,u,v,x)*h2
|
||||
etwo_ter+=P0tuvx(t,u,v,x)*h3
|
||||
if ((h1.ne.h2).or.(h1.ne.h3)) then
|
||||
write(6,9901) t,u,v,x,h1,h2,h3
|
||||
9901 format('aie: ',4I4,3E20.12)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
5
src/cipsi/EZFIO.cfg
Normal file
5
src/cipsi/EZFIO.cfg
Normal file
@ -0,0 +1,5 @@
|
||||
[pert_2rdm]
|
||||
type: logical
|
||||
doc: If true, computes the one- and two-body rdms with perturbation theory
|
||||
interface: ezfio,provider,ocaml
|
||||
default: False
|
@ -3,3 +3,4 @@ zmq
|
||||
mpi
|
||||
davidson_undressed
|
||||
iterations
|
||||
two_body_rdm
|
||||
|
@ -13,6 +13,7 @@ subroutine run_cipsi
|
||||
rss = memory_of_double(N_states)*4.d0
|
||||
call check_mem(rss,irp_here)
|
||||
|
||||
N_iter = 1
|
||||
allocate (pt2(N_states), zeros(N_states), rpt2(N_states), norm(N_states), variance(N_states))
|
||||
|
||||
double precision :: hf_energy_ref
|
||||
|
0
src/cipsi/lock_2rdm.irp.f
Normal file
0
src/cipsi/lock_2rdm.irp.f
Normal file
178
src/cipsi/pert_rdm_providers.irp.f
Normal file
178
src/cipsi/pert_rdm_providers.irp.f
Normal file
@ -0,0 +1,178 @@
|
||||
|
||||
use bitmasks
|
||||
use omp_lib
|
||||
|
||||
BEGIN_PROVIDER [ integer(omp_lock_kind), pert_2rdm_lock]
|
||||
use f77_zmq
|
||||
implicit none
|
||||
call omp_init_lock(pert_2rdm_lock)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, n_orb_pert_rdm]
|
||||
implicit none
|
||||
n_orb_pert_rdm = n_act_orb
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, list_orb_reverse_pert_rdm, (mo_num)]
|
||||
implicit none
|
||||
list_orb_reverse_pert_rdm = list_act_reverse
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, list_orb_pert_rdm, (n_orb_pert_rdm)]
|
||||
implicit none
|
||||
list_orb_pert_rdm = list_act
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, pert_2rdm_provider, (n_orb_pert_rdm,n_orb_pert_rdm,n_orb_pert_rdm,n_orb_pert_rdm)]
|
||||
implicit none
|
||||
pert_2rdm_provider = 0.d0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
subroutine fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf, psi_det_connection, psi_coef_connection_reverse, n_det_connection)
|
||||
use bitmasks
|
||||
use selection_types
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n_det_connection
|
||||
double precision, intent(in) :: psi_coef_connection_reverse(N_states,n_det_connection)
|
||||
integer(bit_kind), intent(in) :: psi_det_connection(N_int,2,n_det_connection)
|
||||
integer, intent(in) :: i_generator, sp, h1, h2
|
||||
double precision, intent(in) :: mat(N_states, mo_num, mo_num)
|
||||
logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num)
|
||||
double precision, intent(in) :: fock_diag_tmp(mo_num)
|
||||
double precision, intent(in) :: E0(N_states)
|
||||
double precision, intent(inout) :: pt2(N_states)
|
||||
double precision, intent(inout) :: variance(N_states)
|
||||
double precision, intent(inout) :: norm(N_states)
|
||||
type(selection_buffer), intent(inout) :: buf
|
||||
logical :: ok
|
||||
integer :: s1, s2, p1, p2, ib, j, istate
|
||||
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
||||
double precision :: e_pert, delta_E, val, Hii, sum_e_pert, tmp, alpha_h_psi, coef(N_states)
|
||||
double precision, external :: diag_H_mat_elem_fock
|
||||
double precision :: E_shift
|
||||
|
||||
logical, external :: detEq
|
||||
double precision, allocatable :: values(:)
|
||||
integer, allocatable :: keys(:,:)
|
||||
integer :: nkeys
|
||||
integer :: sze_buff
|
||||
sze_buff = 5 * mo_num ** 2
|
||||
allocate(keys(4,sze_buff),values(sze_buff))
|
||||
nkeys = 0
|
||||
if(sp == 3) then
|
||||
s1 = 1
|
||||
s2 = 2
|
||||
else
|
||||
s1 = sp
|
||||
s2 = sp
|
||||
end if
|
||||
call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int)
|
||||
E_shift = 0.d0
|
||||
|
||||
if (h0_type == 'SOP') then
|
||||
j = det_to_occ_pattern(i_generator)
|
||||
E_shift = psi_det_Hii(i_generator) - psi_occ_pattern_Hii(j)
|
||||
endif
|
||||
|
||||
do p1=1,mo_num
|
||||
if(bannedOrb(p1, s1)) cycle
|
||||
ib = 1
|
||||
if(sp /= 3) ib = p1+1
|
||||
|
||||
do p2=ib,mo_num
|
||||
|
||||
! -----
|
||||
! /!\ Generating only single excited determinants doesn't work because a
|
||||
! determinant generated by a single excitation may be doubly excited wrt
|
||||
! to a determinant of the future. In that case, the determinant will be
|
||||
! detected as already generated when generating in the future with a
|
||||
! double excitation.
|
||||
!
|
||||
! if (.not.do_singles) then
|
||||
! if ((h1 == p1) .or. (h2 == p2)) then
|
||||
! cycle
|
||||
! endif
|
||||
! endif
|
||||
!
|
||||
! if (.not.do_doubles) then
|
||||
! if ((h1 /= p1).and.(h2 /= p2)) then
|
||||
! cycle
|
||||
! endif
|
||||
! endif
|
||||
! -----
|
||||
|
||||
if(bannedOrb(p2, s2)) cycle
|
||||
if(banned(p1,p2)) cycle
|
||||
|
||||
|
||||
if( sum(abs(mat(1:N_states, p1, p2))) == 0d0) cycle
|
||||
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
||||
|
||||
if (do_only_cas) then
|
||||
integer, external :: number_of_holes, number_of_particles
|
||||
if (number_of_particles(det)>0) then
|
||||
cycle
|
||||
endif
|
||||
if (number_of_holes(det)>0) then
|
||||
cycle
|
||||
endif
|
||||
endif
|
||||
|
||||
if (do_ddci) then
|
||||
logical, external :: is_a_two_holes_two_particles
|
||||
if (is_a_two_holes_two_particles(det)) then
|
||||
cycle
|
||||
endif
|
||||
endif
|
||||
|
||||
if (do_only_1h1p) then
|
||||
logical, external :: is_a_1h1p
|
||||
if (.not.is_a_1h1p(det)) cycle
|
||||
endif
|
||||
|
||||
|
||||
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
||||
|
||||
sum_e_pert = 0d0
|
||||
integer :: degree
|
||||
call get_excitation_degree(det,HF_bitmask,degree,N_int)
|
||||
if(degree == 2)cycle
|
||||
do istate=1,N_states
|
||||
delta_E = E0(istate) - Hii + E_shift
|
||||
alpha_h_psi = mat(istate, p1, p2)
|
||||
val = alpha_h_psi + alpha_h_psi
|
||||
tmp = dsqrt(delta_E * delta_E + val * val)
|
||||
if (delta_E < 0.d0) then
|
||||
tmp = -tmp
|
||||
endif
|
||||
e_pert = 0.5d0 * (tmp - delta_E)
|
||||
coef(istate) = e_pert / alpha_h_psi
|
||||
print*,e_pert,coef,alpha_h_psi
|
||||
pt2(istate) = pt2(istate) + e_pert
|
||||
variance(istate) = variance(istate) + alpha_h_psi * alpha_h_psi
|
||||
norm(istate) = norm(istate) + coef(istate) * coef(istate)
|
||||
|
||||
if (weight_selection /= 5) then
|
||||
! Energy selection
|
||||
sum_e_pert = sum_e_pert + e_pert * selection_weight(istate)
|
||||
|
||||
else
|
||||
! Variance selection
|
||||
sum_e_pert = sum_e_pert - alpha_h_psi * alpha_h_psi * selection_weight(istate)
|
||||
endif
|
||||
end do
|
||||
call give_2rdm_pert_contrib(det,coef,psi_det_connection,psi_coef_connection_reverse,n_det_connection,nkeys,keys,values,sze_buff)
|
||||
|
||||
if(sum_e_pert <= buf%mini) then
|
||||
call add_to_selection_buffer(buf, det, sum_e_pert)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock)
|
||||
end
|
||||
|
||||
|
@ -77,6 +77,7 @@ logical function testTeethBuilding(minF, N)
|
||||
tilde_cW(i) = tilde_cW(i-1) + tilde_w(i)
|
||||
enddo
|
||||
tilde_cW(:) = tilde_cW(:) + 1.d0
|
||||
deallocate(tilde_w)
|
||||
|
||||
n0 = 0
|
||||
testTeethBuilding = .false.
|
||||
@ -89,19 +90,19 @@ logical function testTeethBuilding(minF, N)
|
||||
r = tilde_cW(n0 + minF)
|
||||
Wt = (1d0 - u0) * f
|
||||
if (dabs(Wt) <= 1.d-3) then
|
||||
return
|
||||
exit
|
||||
endif
|
||||
if(Wt >= r - u0) then
|
||||
testTeethBuilding = .true.
|
||||
return
|
||||
exit
|
||||
end if
|
||||
n0 += 1
|
||||
! if(N_det_generators - n0 < minF * N) then
|
||||
if(n0 > minFN) then
|
||||
return
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
stop "exited testTeethBuilding"
|
||||
deallocate(tilde_cW)
|
||||
|
||||
end function
|
||||
|
||||
|
||||
@ -129,13 +130,13 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
|
||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
||||
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
||||
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted
|
||||
PROVIDE psi_det_hii N_generators_bitmask selection_weight pseudo_sym
|
||||
PROVIDE psi_det_hii selection_weight pseudo_sym
|
||||
|
||||
if (h0_type == 'SOP') then
|
||||
PROVIDE psi_occ_pattern_hii det_to_occ_pattern
|
||||
endif
|
||||
|
||||
if (N_det < max(4,N_states)) then
|
||||
if (N_det <= max(4,N_states)) then
|
||||
pt2=0.d0
|
||||
variance=0.d0
|
||||
norm=0.d0
|
||||
@ -156,7 +157,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
|
||||
do pt2_stoch_istate=1,N_states
|
||||
state_average_weight(:) = 0.d0
|
||||
state_average_weight(pt2_stoch_istate) = 1.d0
|
||||
TOUCH state_average_weight pt2_stoch_istate
|
||||
TOUCH state_average_weight pt2_stoch_istate selection_weight
|
||||
|
||||
PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w
|
||||
PROVIDE psi_selectors pt2_u pt2_J pt2_R
|
||||
@ -523,10 +524,24 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
|
||||
exit
|
||||
else
|
||||
call pull_pt2_results(zmq_socket_pull, index, eI_task, vI_task, nI_task, task_id, n_tasks, b2)
|
||||
if(n_tasks > pt2_n_tasks_max)then
|
||||
print*,'PB !!!'
|
||||
print*,'If you see this, send an email to Anthony scemama with the following content'
|
||||
print*,irp_here
|
||||
print*,'n_tasks,pt2_n_tasks_max = ',n_tasks,pt2_n_tasks_max
|
||||
stop -1
|
||||
endif
|
||||
if (zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_tasks,sending) == -1) then
|
||||
stop 'PT2: Unable to delete tasks (send)'
|
||||
endif
|
||||
do i=1,n_tasks
|
||||
if(index(i).gt.size(eI,2).or.index(i).lt.1)then
|
||||
print*,'PB !!!'
|
||||
print*,'If you see this, send an email to Anthony scemama with the following content'
|
||||
print*,irp_here
|
||||
print*,'i,index(i),size(ei,2) = ',i,index(i),size(ei,2)
|
||||
stop -1
|
||||
endif
|
||||
eI(1:N_states, index(i)) += eI_task(1:N_states,i)
|
||||
vI(1:N_states, index(i)) += vI_task(1:N_states,i)
|
||||
nI(1:N_states, index(i)) += nI_task(1:N_states,i)
|
||||
@ -706,83 +721,95 @@ END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, pt2_w, (N_det_generators) ]
|
||||
&BEGIN_PROVIDER [ double precision, pt2_cW, (0:N_det_generators) ]
|
||||
&BEGIN_PROVIDER [ double precision, pt2_W_T ]
|
||||
&BEGIN_PROVIDER [ double precision, pt2_u_0 ]
|
||||
&BEGIN_PROVIDER [ integer, pt2_n_0, (pt2_N_teeth+1) ]
|
||||
implicit none
|
||||
integer :: i, t
|
||||
double precision, allocatable :: tilde_w(:), tilde_cW(:)
|
||||
double precision :: r, tooth_width
|
||||
integer, external :: pt2_find_sample
|
||||
BEGIN_PROVIDER [ double precision, pt2_w, (N_det_generators) ]
|
||||
&BEGIN_PROVIDER [ double precision, pt2_cW, (0:N_det_generators) ]
|
||||
&BEGIN_PROVIDER [ double precision, pt2_W_T ]
|
||||
&BEGIN_PROVIDER [ double precision, pt2_u_0 ]
|
||||
&BEGIN_PROVIDER [ integer, pt2_n_0, (pt2_N_teeth+1) ]
|
||||
implicit none
|
||||
integer :: i, t
|
||||
double precision, allocatable :: tilde_w(:), tilde_cW(:)
|
||||
double precision :: r, tooth_width
|
||||
integer, external :: pt2_find_sample
|
||||
|
||||
double precision :: rss
|
||||
double precision, external :: memory_of_double, memory_of_int
|
||||
rss = memory_of_double(2*N_det_generators+1)
|
||||
call check_mem(rss,irp_here)
|
||||
|
||||
if (N_det_generators == 1) then
|
||||
|
||||
pt2_w(1) = 1.d0
|
||||
pt2_cw(1) = 1.d0
|
||||
pt2_u_0 = 1.d0
|
||||
pt2_W_T = 0.d0
|
||||
pt2_n_0(1) = 0
|
||||
pt2_n_0(2) = 1
|
||||
|
||||
else
|
||||
|
||||
allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators))
|
||||
|
||||
tilde_cW(0) = 0d0
|
||||
|
||||
do i=1,N_det_generators
|
||||
tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20
|
||||
enddo
|
||||
|
||||
double precision :: norm
|
||||
norm = 0.d0
|
||||
do i=N_det_generators,1,-1
|
||||
norm += tilde_w(i)
|
||||
enddo
|
||||
|
||||
tilde_w(:) = tilde_w(:) / norm
|
||||
|
||||
tilde_cW(0) = -1.d0
|
||||
do i=1,N_det_generators
|
||||
tilde_cW(i) = tilde_cW(i-1) + tilde_w(i)
|
||||
enddo
|
||||
tilde_cW(:) = tilde_cW(:) + 1.d0
|
||||
|
||||
double precision :: rss
|
||||
double precision, external :: memory_of_double, memory_of_int
|
||||
rss = memory_of_double(2*N_det_generators+1)
|
||||
call check_mem(rss,irp_here)
|
||||
pt2_n_0(1) = 0
|
||||
do
|
||||
pt2_u_0 = tilde_cW(pt2_n_0(1))
|
||||
r = tilde_cW(pt2_n_0(1) + pt2_minDetInFirstTeeth)
|
||||
pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth)
|
||||
if(pt2_W_T >= r - pt2_u_0) then
|
||||
exit
|
||||
end if
|
||||
pt2_n_0(1) += 1
|
||||
if(N_det_generators - pt2_n_0(1) < pt2_minDetInFirstTeeth * pt2_N_teeth) then
|
||||
print *, "teeth building failed"
|
||||
stop -1
|
||||
end if
|
||||
end do
|
||||
|
||||
do t=2, pt2_N_teeth
|
||||
r = pt2_u_0 + pt2_W_T * dble(t-1)
|
||||
pt2_n_0(t) = pt2_find_sample(r, tilde_cW)
|
||||
end do
|
||||
pt2_n_0(pt2_N_teeth+1) = N_det_generators
|
||||
|
||||
pt2_w(:pt2_n_0(1)) = tilde_w(:pt2_n_0(1))
|
||||
do t=1, pt2_N_teeth
|
||||
tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t))
|
||||
if (tooth_width == 0.d0) then
|
||||
tooth_width = sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1)))
|
||||
endif
|
||||
ASSERT(tooth_width > 0.d0)
|
||||
do i=pt2_n_0(t)+1, pt2_n_0(t+1)
|
||||
pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width
|
||||
end do
|
||||
end do
|
||||
|
||||
pt2_cW(0) = 0d0
|
||||
do i=1,N_det_generators
|
||||
pt2_cW(i) = pt2_cW(i-1) + pt2_w(i)
|
||||
end do
|
||||
pt2_n_0(pt2_N_teeth+1) = N_det_generators
|
||||
|
||||
allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators))
|
||||
|
||||
tilde_cW(0) = 0d0
|
||||
|
||||
do i=1,N_det_generators
|
||||
tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20
|
||||
enddo
|
||||
|
||||
double precision :: norm
|
||||
norm = 0.d0
|
||||
do i=N_det_generators,1,-1
|
||||
norm += tilde_w(i)
|
||||
enddo
|
||||
|
||||
tilde_w(:) = tilde_w(:) / norm
|
||||
|
||||
tilde_cW(0) = -1.d0
|
||||
do i=1,N_det_generators
|
||||
tilde_cW(i) = tilde_cW(i-1) + tilde_w(i)
|
||||
enddo
|
||||
tilde_cW(:) = tilde_cW(:) + 1.d0
|
||||
|
||||
pt2_n_0(1) = 0
|
||||
do
|
||||
pt2_u_0 = tilde_cW(pt2_n_0(1))
|
||||
r = tilde_cW(pt2_n_0(1) + pt2_minDetInFirstTeeth)
|
||||
pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth)
|
||||
if(pt2_W_T >= r - pt2_u_0) then
|
||||
exit
|
||||
end if
|
||||
pt2_n_0(1) += 1
|
||||
if(N_det_generators - pt2_n_0(1) < pt2_minDetInFirstTeeth * pt2_N_teeth) then
|
||||
stop "teeth building failed"
|
||||
end if
|
||||
end do
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
do t=2, pt2_N_teeth
|
||||
r = pt2_u_0 + pt2_W_T * dble(t-1)
|
||||
pt2_n_0(t) = pt2_find_sample(r, tilde_cW)
|
||||
end do
|
||||
pt2_n_0(pt2_N_teeth+1) = N_det_generators
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
pt2_w(:pt2_n_0(1)) = tilde_w(:pt2_n_0(1))
|
||||
do t=1, pt2_N_teeth
|
||||
tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t))
|
||||
if (tooth_width == 0.d0) then
|
||||
tooth_width = sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1)))
|
||||
endif
|
||||
ASSERT(tooth_width > 0.d0)
|
||||
do i=pt2_n_0(t)+1, pt2_n_0(t+1)
|
||||
pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width
|
||||
end do
|
||||
end do
|
||||
|
||||
pt2_cW(0) = 0d0
|
||||
do i=1,N_det_generators
|
||||
pt2_cW(i) = pt2_cW(i-1) + pt2_w(i)
|
||||
end do
|
||||
pt2_n_0(pt2_N_teeth+1) = N_det_generators
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
@ -141,8 +141,8 @@ subroutine run_pt2_slave_small(thread,iproc,energy)
|
||||
b%cur=0
|
||||
|
||||
! ! Try to adjust n_tasks around nproc/2 seconds per job
|
||||
! n_tasks = min(2*n_tasks,int( dble(n_tasks * nproc/2) / (time1 - time0 + 1.d0)))
|
||||
n_tasks = 1
|
||||
n_tasks = min(2*n_tasks,int( dble(n_tasks * nproc/2) / (time1 - time0 + 1.d0)))
|
||||
! n_tasks = 1
|
||||
end do
|
||||
|
||||
integer, external :: disconnect_from_taskserver
|
||||
|
@ -61,7 +61,6 @@ subroutine run_selection_slave(thread,iproc,energy)
|
||||
! Only first time
|
||||
bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
|
||||
call create_selection_buffer(bsize, bsize*2, buf)
|
||||
! call create_selection_buffer(N, N*2, buf2)
|
||||
buffer_ready = .True.
|
||||
else
|
||||
ASSERT (N == buf%N)
|
||||
@ -85,7 +84,7 @@ subroutine run_selection_slave(thread,iproc,energy)
|
||||
if(ctask > 0) then
|
||||
call sort_selection_buffer(buf)
|
||||
! call merge_selection_buffers(buf,buf2)
|
||||
print *, task_id(1), pt2(1), buf%cur, ctask
|
||||
!print *, task_id(1), pt2(1), buf%cur, ctask
|
||||
call push_selection_results(zmq_socket_push, pt2, variance, norm, buf, task_id(1), ctask)
|
||||
! buf%mini = buf2%mini
|
||||
pt2(:) = 0d0
|
||||
|
@ -1,3 +1,4 @@
|
||||
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [ double precision, pt2_match_weight, (N_states) ]
|
||||
@ -69,8 +70,6 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st)
|
||||
variance_match_weight(k) = product(memo_variance(k,:))
|
||||
enddo
|
||||
|
||||
print *, '# PT2 weight ', real(pt2_match_weight(:),4)
|
||||
print *, '# var weight ', real(variance_match_weight(:),4)
|
||||
SOFT_TOUCH pt2_match_weight variance_match_weight
|
||||
end
|
||||
|
||||
@ -84,7 +83,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
|
||||
|
||||
case (0)
|
||||
print *, 'Using input weights in selection'
|
||||
selection_weight(1:N_states) = state_average_weight(1:N_states)
|
||||
selection_weight(1:N_states) = c0_weight(1:N_states) * state_average_weight(1:N_states)
|
||||
|
||||
case (1)
|
||||
print *, 'Using 1/c_max^2 weight in selection'
|
||||
@ -93,20 +92,30 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
|
||||
case (2)
|
||||
print *, 'Using pt2-matching weight in selection'
|
||||
selection_weight(1:N_states) = c0_weight(1:N_states) * pt2_match_weight(1:N_states)
|
||||
print *, '# PT2 weight ', real(pt2_match_weight(:),4)
|
||||
|
||||
case (3)
|
||||
print *, 'Using variance-matching weight in selection'
|
||||
selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states)
|
||||
print *, '# var weight ', real(variance_match_weight(:),4)
|
||||
|
||||
case (4)
|
||||
print *, 'Using variance- and pt2-matching weights in selection'
|
||||
selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states) * pt2_match_weight(1:N_states)
|
||||
selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states))
|
||||
print *, '# PT2 weight ', real(pt2_match_weight(:),4)
|
||||
print *, '# var weight ', real(variance_match_weight(:),4)
|
||||
|
||||
case (5)
|
||||
print *, 'Using variance-matching weight in selection'
|
||||
selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states)
|
||||
print *, '# var weight ', real(variance_match_weight(:),4)
|
||||
|
||||
case (6)
|
||||
print *, 'Using CI coefficient weight in selection'
|
||||
selection_weight(1:N_states) = c0_weight(1:N_states)
|
||||
|
||||
end select
|
||||
print *, '# Total weight ', real(selection_weight(:),4)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -164,15 +173,13 @@ subroutine select_connected(i_generator,E0,pt2,variance,norm,b,subset,csubset)
|
||||
|
||||
call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int)
|
||||
|
||||
do l=1,N_generators_bitmask
|
||||
do k=1,N_int
|
||||
hole_mask(k,1) = iand(generators_bitmask(k,1,s_hole,l), psi_det_generators(k,1,i_generator))
|
||||
hole_mask(k,2) = iand(generators_bitmask(k,2,s_hole,l), psi_det_generators(k,2,i_generator))
|
||||
particle_mask(k,1) = iand(generators_bitmask(k,1,s_part,l), not(psi_det_generators(k,1,i_generator)) )
|
||||
particle_mask(k,2) = iand(generators_bitmask(k,2,s_part,l), not(psi_det_generators(k,2,i_generator)) )
|
||||
enddo
|
||||
call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,variance,norm,b,subset,csubset)
|
||||
do k=1,N_int
|
||||
hole_mask(k,1) = iand(generators_bitmask(k,1,s_hole), psi_det_generators(k,1,i_generator))
|
||||
hole_mask(k,2) = iand(generators_bitmask(k,2,s_hole), psi_det_generators(k,2,i_generator))
|
||||
particle_mask(k,1) = iand(generators_bitmask(k,1,s_part), not(psi_det_generators(k,1,i_generator)) )
|
||||
particle_mask(k,2) = iand(generators_bitmask(k,2,s_part), not(psi_det_generators(k,2,i_generator)) )
|
||||
enddo
|
||||
call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,variance,norm,b,subset,csubset)
|
||||
deallocate(fock_diag_tmp)
|
||||
end subroutine
|
||||
|
||||
@ -248,6 +255,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
integer,allocatable :: tmp_array(:)
|
||||
integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :)
|
||||
logical, allocatable :: banned(:,:,:), bannedOrb(:,:)
|
||||
double precision, allocatable :: coef_fullminilist_rev(:,:)
|
||||
|
||||
|
||||
double precision, allocatable :: mat(:,:,:)
|
||||
@ -338,6 +346,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
call isort(indices,iorder,nmax)
|
||||
deallocate(iorder)
|
||||
|
||||
! Start with 32 elements. Size will double along with the filtering.
|
||||
allocate(preinteresting(0:32), prefullinteresting(0:32), &
|
||||
interesting(0:32), fullinteresting(0:32))
|
||||
preinteresting(:) = 0
|
||||
@ -469,7 +478,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
if (nt > 4) exit
|
||||
endif
|
||||
end do
|
||||
case default
|
||||
case default
|
||||
mobMask(1:N_int,1) = iand(negMask(1:N_int,1), psi_det_sorted(1:N_int,1,preinteresting(ii)))
|
||||
mobMask(1:N_int,2) = iand(negMask(1:N_int,2), psi_det_sorted(1:N_int,2,preinteresting(ii)))
|
||||
nt = 0
|
||||
@ -546,6 +555,14 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
|
||||
allocate (fullminilist (N_int, 2, fullinteresting(0)), &
|
||||
minilist (N_int, 2, interesting(0)) )
|
||||
if(pert_2rdm)then
|
||||
allocate(coef_fullminilist_rev(N_states,fullinteresting(0)))
|
||||
do i=1,fullinteresting(0)
|
||||
do j = 1, N_states
|
||||
coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j)
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
do i=1,fullinteresting(0)
|
||||
fullminilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,fullinteresting(i))
|
||||
enddo
|
||||
@ -597,12 +614,19 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
|
||||
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting)
|
||||
|
||||
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf)
|
||||
if(.not.pert_2rdm)then
|
||||
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf)
|
||||
else
|
||||
call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0))
|
||||
endif
|
||||
end if
|
||||
enddo
|
||||
if(s1 /= s2) monoBdo = .false.
|
||||
enddo
|
||||
deallocate(fullminilist,minilist)
|
||||
if(pert_2rdm)then
|
||||
deallocate(coef_fullminilist_rev)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
deallocate(preinteresting, prefullinteresting, interesting, fullinteresting)
|
||||
@ -628,11 +652,15 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
logical :: ok
|
||||
integer :: s1, s2, p1, p2, ib, j, istate
|
||||
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
||||
double precision :: e_pert, delta_E, val, Hii, sum_e_pert, tmp, alpha_h_psi, coef
|
||||
double precision :: e_pert, delta_E, val, Hii, w, tmp, alpha_h_psi, coef
|
||||
double precision, external :: diag_H_mat_elem_fock
|
||||
double precision :: E_shift
|
||||
|
||||
logical, external :: detEq
|
||||
double precision, allocatable :: values(:)
|
||||
integer, allocatable :: keys(:,:)
|
||||
integer :: nkeys
|
||||
|
||||
|
||||
if(sp == 3) then
|
||||
s1 = 1
|
||||
@ -683,6 +711,16 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
if( sum(abs(mat(1:N_states, p1, p2))) == 0d0) cycle
|
||||
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
||||
|
||||
if (do_only_cas) then
|
||||
integer, external :: number_of_holes, number_of_particles
|
||||
if (number_of_particles(det)>0) then
|
||||
cycle
|
||||
endif
|
||||
if (number_of_holes(det)>0) then
|
||||
cycle
|
||||
endif
|
||||
endif
|
||||
|
||||
if (do_ddci) then
|
||||
logical, external :: is_a_two_holes_two_particles
|
||||
if (is_a_two_holes_two_particles(det)) then
|
||||
@ -695,10 +733,14 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
if (.not.is_a_1h1p(det)) cycle
|
||||
endif
|
||||
|
||||
|
||||
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
||||
|
||||
sum_e_pert = 0d0
|
||||
w = 0d0
|
||||
|
||||
! integer(bit_kind) :: occ(N_int,2), n
|
||||
! call occ_pattern_of_det(det,occ,N_int)
|
||||
! call occ_pattern_to_dets_size(occ,n,elec_alpha_num,N_int)
|
||||
|
||||
|
||||
do istate=1,N_states
|
||||
delta_E = E0(istate) - Hii + E_shift
|
||||
@ -709,33 +751,63 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
tmp = -tmp
|
||||
endif
|
||||
e_pert = 0.5d0 * (tmp - delta_E)
|
||||
coef = e_pert / alpha_h_psi
|
||||
if (dabs(alpha_h_psi) > 1.d-4) then
|
||||
coef = e_pert / alpha_h_psi
|
||||
else
|
||||
coef = alpha_h_psi / delta_E
|
||||
endif
|
||||
pt2(istate) = pt2(istate) + e_pert
|
||||
variance(istate) = variance(istate) + alpha_h_psi * alpha_h_psi
|
||||
norm(istate) = norm(istate) + coef * coef
|
||||
|
||||
if (weight_selection /= 5) then
|
||||
! Energy selection
|
||||
sum_e_pert = sum_e_pert + e_pert * selection_weight(istate)
|
||||
else
|
||||
! Variance selection
|
||||
sum_e_pert = sum_e_pert - alpha_h_psi * alpha_h_psi * selection_weight(istate)
|
||||
endif
|
||||
!!!DEBUG
|
||||
! integer :: k
|
||||
! double precision :: alpha_h_psi_2,hij
|
||||
! alpha_h_psi_2 = 0.d0
|
||||
! do k = 1,N_det_selectors
|
||||
! call i_H_j(det,psi_selectors(1,1,k),N_int,hij)
|
||||
! alpha_h_psi_2 = alpha_h_psi_2 + psi_selectors_coef(k,istate) * hij
|
||||
! enddo
|
||||
! if(dabs(alpha_h_psi_2 - alpha_h_psi).gt.1.d-12)then
|
||||
! call debug_det(psi_det_generators(1,1,i_generator),N_int)
|
||||
! call debug_det(det,N_int)
|
||||
! print*,'alpha_h_psi,alpha_h_psi_2 = ',alpha_h_psi,alpha_h_psi_2
|
||||
! stop
|
||||
! endif
|
||||
!!!DEBUG
|
||||
|
||||
select case (weight_selection)
|
||||
|
||||
case(0:4)
|
||||
! Energy selection
|
||||
w = w + e_pert * selection_weight(istate)
|
||||
|
||||
case(5)
|
||||
! Variance selection
|
||||
w = w - alpha_h_psi * alpha_h_psi * selection_weight(istate)
|
||||
|
||||
case(6)
|
||||
w = w - coef * coef * selection_weight(istate)
|
||||
|
||||
end select
|
||||
end do
|
||||
|
||||
|
||||
if(pseudo_sym)then
|
||||
if(dabs(mat(1, p1, p2)).lt.thresh_sym)then
|
||||
sum_e_pert = 10.d0
|
||||
endif
|
||||
if(dabs(mat(1, p1, p2)).lt.thresh_sym)then
|
||||
w = 0.d0
|
||||
endif
|
||||
endif
|
||||
|
||||
if(sum_e_pert <= buf%mini) then
|
||||
call add_to_selection_buffer(buf, det, sum_e_pert)
|
||||
! w = dble(n) * w
|
||||
|
||||
if(w <= buf%mini) then
|
||||
call add_to_selection_buffer(buf, det, w)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end
|
||||
|
||||
|
||||
subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting)
|
||||
use bitmasks
|
||||
implicit none
|
||||
@ -814,10 +886,13 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
|
||||
|
||||
call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask,N_int)
|
||||
if(nt == 4) then
|
||||
! call get_d2_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||
call get_d2(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||
else if(nt == 3) then
|
||||
! call get_d1_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||
call get_d1(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||
else
|
||||
! call get_d0_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||
call get_d0(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||
end if
|
||||
else if(nt == 4) then
|
||||
@ -975,7 +1050,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
implicit none
|
||||
|
||||
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
|
||||
integer(bit_kind), intent(in) :: phasemask(N_int,2)
|
||||
integer(bit_kind), intent(in) :: phasemask(N_int,2)
|
||||
logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2)
|
||||
integer(bit_kind) :: det(N_int, 2)
|
||||
double precision, intent(in) :: coefs(N_states)
|
||||
@ -1058,8 +1133,10 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
call get_mo_two_e_integrals(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map)
|
||||
putj = p1
|
||||
do puti=1,mo_num
|
||||
if(lbanned(puti,mi)) cycle
|
||||
!p1 fixed
|
||||
if(.not.(banned(putj,puti,bant).or.lbanned(puti,mi))) then
|
||||
putj = p1
|
||||
if(.not. banned(putj,puti,bant)) then
|
||||
hij = hij_cache(puti,2)
|
||||
if (hij /= 0.d0) then
|
||||
hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int)
|
||||
@ -1068,11 +1145,9 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
enddo
|
||||
endif
|
||||
end if
|
||||
enddo
|
||||
|
||||
putj = p2
|
||||
do puti=1,mo_num
|
||||
if(.not.(banned(putj,puti,bant)).or.(lbanned(puti,mi))) then
|
||||
|
||||
putj = p2
|
||||
if(.not. banned(putj,puti,bant)) then
|
||||
hij = hij_cache(puti,1)
|
||||
if (hij /= 0.d0) then
|
||||
hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int)
|
||||
@ -1135,8 +1210,9 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
call get_mo_two_e_integrals(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map)
|
||||
putj = p2
|
||||
do puti=1,mo_num
|
||||
if(lbanned(puti,ma)) cycle
|
||||
putj = p2
|
||||
if(.not. banned(puti,putj,1)) then
|
||||
if(lbanned(puti,ma)) cycle
|
||||
hij = hij_cache(puti,1)
|
||||
if (hij /= 0.d0) then
|
||||
hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int)
|
||||
@ -1145,12 +1221,9 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
enddo
|
||||
endif
|
||||
end if
|
||||
enddo
|
||||
|
||||
putj = p1
|
||||
do puti=1,mo_num
|
||||
putj = p1
|
||||
if(.not. banned(puti,putj,1)) then
|
||||
if(lbanned(puti,ma)) cycle
|
||||
hij = hij_cache(puti,2)
|
||||
if (hij /= 0.d0) then
|
||||
hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int)
|
||||
@ -1179,12 +1252,11 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
|
||||
do i1=1,p(0,s1)
|
||||
ib = 1
|
||||
p1 = p(i1,s1)
|
||||
if(s1 == s2) ib = i1+1
|
||||
if(bannedOrb(p1, s1)) cycle
|
||||
do i2=ib,p(0,s2)
|
||||
p1 = p(i1,s1)
|
||||
p2 = p(i2,s2)
|
||||
if(bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle
|
||||
if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle
|
||||
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
||||
call i_h_j(gen, det, N_int, hij)
|
||||
mat(:, p1, p2) = mat(:, p1, p2) + coefs(:) * hij
|
||||
@ -1220,25 +1292,45 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
if(sp == 3) then ! AB
|
||||
h1 = p(1,1)
|
||||
h2 = p(1,2)
|
||||
do p2=1, mo_num
|
||||
if(bannedOrb(p2,2)) cycle
|
||||
call get_mo_two_e_integrals(p2,h1,h2,mo_num,hij_cache1,mo_integrals_map)
|
||||
do p1=1, mo_num
|
||||
if(bannedOrb(p1, 1) .or. banned(p1, p2, bant)) cycle
|
||||
if(p1 /= h1 .and. p2 /= h2) then
|
||||
if (hij_cache1(p1) == 0.d0) cycle
|
||||
phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
|
||||
hij = hij_cache1(p1) * phase
|
||||
else
|
||||
do p1=1, mo_num
|
||||
if(bannedOrb(p1, 1)) cycle
|
||||
call get_mo_two_e_integrals(p1,h2,h1,mo_num,hij_cache1,mo_integrals_map)
|
||||
do p2=1, mo_num
|
||||
if(bannedOrb(p2,2)) cycle
|
||||
if(banned(p1, p2, bant)) cycle ! rentable?
|
||||
if(p1 == h1 .or. p2 == h2) then
|
||||
call apply_particles(mask, 1,p1,2,p2, det, ok, N_int)
|
||||
call i_h_j(gen, det, N_int, hij)
|
||||
if (hij == 0.d0) cycle
|
||||
else
|
||||
phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
|
||||
! hij = mo_two_e_integral(p2, p1, h2, h1) * phase
|
||||
hij = hij_cache1(p2) * phase
|
||||
end if
|
||||
if (hij == 0.d0) cycle
|
||||
do k=1,N_states
|
||||
mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * hij ! HOTSPOT
|
||||
enddo
|
||||
end do
|
||||
end do
|
||||
! do p2=1, mo_num
|
||||
! if(bannedOrb(p2,2)) cycle
|
||||
! call get_mo_two_e_integrals(p2,h1,h2,mo_num,hij_cache1,mo_integrals_map)
|
||||
! do p1=1, mo_num
|
||||
! if(bannedOrb(p1, 1) .or. banned(p1, p2, bant)) cycle
|
||||
! if(p1 /= h1 .and. p2 /= h2) then
|
||||
! if (hij_cache1(p1) == 0.d0) cycle
|
||||
! phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
|
||||
! hij = hij_cache1(p1) * phase
|
||||
! else
|
||||
! call apply_particles(mask, 1,p1,2,p2, det, ok, N_int)
|
||||
! call i_h_j(gen, det, N_int, hij)
|
||||
! if (hij == 0.d0) cycle
|
||||
! end if
|
||||
! do k=1,N_states
|
||||
! mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * hij ! HOTSPOT
|
||||
! enddo
|
||||
! end do
|
||||
! end do
|
||||
|
||||
else ! AA BB
|
||||
p1 = p(1,sp)
|
||||
@ -1248,24 +1340,36 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
call get_mo_two_e_integrals(puti,p2,p1,mo_num,hij_cache1,mo_integrals_map)
|
||||
call get_mo_two_e_integrals(puti,p1,p2,mo_num,hij_cache2,mo_integrals_map)
|
||||
do putj=puti+1, mo_num
|
||||
if(bannedOrb(putj, sp) .or. banned(putj, sp, bant)) cycle
|
||||
if(puti /= p1 .and. putj /= p2 .and. puti /= p2 .and. putj /= p1) then
|
||||
hij = hij_cache1(putj) - hij_cache2(putj)
|
||||
if (hij /= 0.d0) then
|
||||
hij = hij * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
|
||||
do k=1,N_states
|
||||
mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij
|
||||
enddo
|
||||
endif
|
||||
else
|
||||
if(bannedOrb(putj, sp)) cycle
|
||||
if(banned(puti, putj, bant)) cycle ! rentable?
|
||||
if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then
|
||||
call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int)
|
||||
call i_h_j(gen, det, N_int, hij)
|
||||
if (hij /= 0.d0) then
|
||||
do k=1,N_states
|
||||
mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij
|
||||
enddo
|
||||
endif
|
||||
else
|
||||
hij = (mo_two_e_integral(p1, p2, puti, putj) - mo_two_e_integral(p2, p1, puti, putj))* get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
|
||||
end if
|
||||
if (hij == 0.d0) cycle
|
||||
do k=1,N_states
|
||||
mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij
|
||||
enddo
|
||||
! if(bannedOrb(putj, sp) .or. banned(putj, sp, bant)) cycle
|
||||
! if(puti /= p1 .and. putj /= p2 .and. puti /= p2 .and. putj /= p1) then
|
||||
! hij = hij_cache1(putj) - hij_cache2(putj)
|
||||
! if (hij /= 0.d0) then
|
||||
! hij = hij * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
|
||||
! do k=1,N_states
|
||||
! mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij
|
||||
! enddo
|
||||
! endif
|
||||
! else
|
||||
! call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int)
|
||||
! call i_h_j(gen, det, N_int, hij)
|
||||
! if (hij /= 0.d0) then
|
||||
! do k=1,N_states
|
||||
! mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij
|
||||
! enddo
|
||||
! endif
|
||||
! end if
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
@ -1395,3 +1499,356 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint)
|
||||
|
||||
end
|
||||
!
|
||||
|
||||
|
||||
|
||||
|
||||
! OLD unoptimized routines for debugging
|
||||
! ======================================
|
||||
|
||||
subroutine get_d0_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
||||
integer(bit_kind), intent(in) :: phasemask(N_int,2)
|
||||
logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2)
|
||||
integer(bit_kind) :: det(N_int, 2)
|
||||
double precision, intent(in) :: coefs(N_states)
|
||||
double precision, intent(inout) :: mat(N_states, mo_num, mo_num)
|
||||
integer, intent(in) :: h(0:2,2), p(0:4,2), sp
|
||||
|
||||
integer :: i, j, s, h1, h2, p1, p2, puti, putj
|
||||
double precision :: hij, phase
|
||||
double precision, external :: get_phase_bi, mo_two_e_integral
|
||||
logical :: ok
|
||||
|
||||
integer :: bant
|
||||
bant = 1
|
||||
|
||||
|
||||
if(sp == 3) then ! AB
|
||||
h1 = p(1,1)
|
||||
h2 = p(1,2)
|
||||
do p1=1, mo_num
|
||||
if(bannedOrb(p1, 1)) cycle
|
||||
do p2=1, mo_num
|
||||
if(bannedOrb(p2,2)) cycle
|
||||
if(banned(p1, p2, bant)) cycle ! rentable?
|
||||
if(p1 == h1 .or. p2 == h2) then
|
||||
call apply_particles(mask, 1,p1,2,p2, det, ok, N_int)
|
||||
call i_h_j(gen, det, N_int, hij)
|
||||
else
|
||||
phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
|
||||
hij = mo_two_e_integral(p1, p2, h1, h2) * phase
|
||||
end if
|
||||
mat(:, p1, p2) += coefs(:) * hij
|
||||
end do
|
||||
end do
|
||||
else ! AA BB
|
||||
p1 = p(1,sp)
|
||||
p2 = p(2,sp)
|
||||
do puti=1, mo_num
|
||||
if(bannedOrb(puti, sp)) cycle
|
||||
do putj=puti+1, mo_num
|
||||
if(bannedOrb(putj, sp)) cycle
|
||||
if(banned(puti, putj, bant)) cycle ! rentable?
|
||||
if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then
|
||||
call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int)
|
||||
call i_h_j(gen, det, N_int, hij)
|
||||
else
|
||||
hij = (mo_two_e_integral(p1, p2, puti, putj) - mo_two_e_integral(p2, p1, puti, putj))* get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
|
||||
end if
|
||||
mat(:, puti, putj) += coefs(:) * hij
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
end
|
||||
|
||||
subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
|
||||
integer(bit_kind), intent(in) :: phasemask(N_int,2)
|
||||
logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2)
|
||||
integer(bit_kind) :: det(N_int, 2)
|
||||
double precision, intent(in) :: coefs(N_states)
|
||||
double precision, intent(inout) :: mat(N_states, mo_num, mo_num)
|
||||
integer, intent(in) :: h(0:2,2), p(0:4,2), sp
|
||||
double precision :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num)
|
||||
double precision, external :: get_phase_bi, mo_two_e_integral
|
||||
logical :: ok
|
||||
|
||||
logical, allocatable :: lbanned(:,:)
|
||||
integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j
|
||||
integer :: hfix, pfix, h1, h2, p1, p2, ib
|
||||
|
||||
integer, parameter :: turn2(2) = (/2,1/)
|
||||
integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/))
|
||||
|
||||
integer :: bant
|
||||
|
||||
|
||||
allocate (lbanned(mo_num, 2))
|
||||
lbanned = bannedOrb
|
||||
|
||||
do i=1, p(0,1)
|
||||
lbanned(p(i,1), 1) = .true.
|
||||
end do
|
||||
do i=1, p(0,2)
|
||||
lbanned(p(i,2), 2) = .true.
|
||||
end do
|
||||
|
||||
ma = 1
|
||||
if(p(0,2) >= 2) ma = 2
|
||||
mi = turn2(ma)
|
||||
|
||||
bant = 1
|
||||
|
||||
if(sp == 3) then
|
||||
!move MA
|
||||
if(ma == 2) bant = 2
|
||||
puti = p(1,mi)
|
||||
hfix = h(1,ma)
|
||||
p1 = p(1,ma)
|
||||
p2 = p(2,ma)
|
||||
if(.not. bannedOrb(puti, mi)) then
|
||||
tmp_row = 0d0
|
||||
do putj=1, hfix-1
|
||||
if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle
|
||||
hij = (mo_two_e_integral(p1, p2, putj, hfix)-mo_two_e_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int)
|
||||
tmp_row(1:N_states,putj) += hij * coefs(1:N_states)
|
||||
end do
|
||||
do putj=hfix+1, mo_num
|
||||
if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle
|
||||
hij = (mo_two_e_integral(p1, p2, hfix, putj)-mo_two_e_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int)
|
||||
tmp_row(1:N_states,putj) += hij * coefs(1:N_states)
|
||||
end do
|
||||
|
||||
if(ma == 1) then
|
||||
mat(1:N_states,1:mo_num,puti) += tmp_row(1:N_states,1:mo_num)
|
||||
else
|
||||
mat(1:N_states,puti,1:mo_num) += tmp_row(1:N_states,1:mo_num)
|
||||
end if
|
||||
end if
|
||||
|
||||
!MOVE MI
|
||||
pfix = p(1,mi)
|
||||
tmp_row = 0d0
|
||||
tmp_row2 = 0d0
|
||||
do puti=1,mo_num
|
||||
if(lbanned(puti,mi)) cycle
|
||||
!p1 fixed
|
||||
putj = p1
|
||||
if(.not. banned(putj,puti,bant)) then
|
||||
hij = mo_two_e_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int)
|
||||
tmp_row(:,puti) += hij * coefs(:)
|
||||
end if
|
||||
|
||||
putj = p2
|
||||
if(.not. banned(putj,puti,bant)) then
|
||||
hij = mo_two_e_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int)
|
||||
tmp_row2(:,puti) += hij * coefs(:)
|
||||
end if
|
||||
end do
|
||||
|
||||
if(mi == 1) then
|
||||
mat(:,:,p1) += tmp_row(:,:)
|
||||
mat(:,:,p2) += tmp_row2(:,:)
|
||||
else
|
||||
mat(:,p1,:) += tmp_row(:,:)
|
||||
mat(:,p2,:) += tmp_row2(:,:)
|
||||
end if
|
||||
else
|
||||
if(p(0,ma) == 3) then
|
||||
do i=1,3
|
||||
hfix = h(1,ma)
|
||||
puti = p(i, ma)
|
||||
p1 = p(turn3(1,i), ma)
|
||||
p2 = p(turn3(2,i), ma)
|
||||
tmp_row = 0d0
|
||||
do putj=1,hfix-1
|
||||
if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle
|
||||
hij = (mo_two_e_integral(p1, p2, putj, hfix)-mo_two_e_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int)
|
||||
tmp_row(:,putj) += hij * coefs(:)
|
||||
end do
|
||||
do putj=hfix+1,mo_num
|
||||
if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle
|
||||
hij = (mo_two_e_integral(p1, p2, hfix, putj)-mo_two_e_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int)
|
||||
tmp_row(:,putj) += hij * coefs(:)
|
||||
end do
|
||||
|
||||
mat(:, :puti-1, puti) += tmp_row(:,:puti-1)
|
||||
mat(:, puti, puti:) += tmp_row(:,puti:)
|
||||
end do
|
||||
else
|
||||
hfix = h(1,mi)
|
||||
pfix = p(1,mi)
|
||||
p1 = p(1,ma)
|
||||
p2 = p(2,ma)
|
||||
tmp_row = 0d0
|
||||
tmp_row2 = 0d0
|
||||
do puti=1,mo_num
|
||||
if(lbanned(puti,ma)) cycle
|
||||
putj = p2
|
||||
if(.not. banned(puti,putj,1)) then
|
||||
hij = mo_two_e_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int)
|
||||
tmp_row(:,puti) += hij * coefs(:)
|
||||
end if
|
||||
|
||||
putj = p1
|
||||
if(.not. banned(puti,putj,1)) then
|
||||
hij = mo_two_e_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int)
|
||||
tmp_row2(:,puti) += hij * coefs(:)
|
||||
end if
|
||||
end do
|
||||
mat(:,:p2-1,p2) += tmp_row(:,:p2-1)
|
||||
mat(:,p2,p2:) += tmp_row(:,p2:)
|
||||
mat(:,:p1-1,p1) += tmp_row2(:,:p1-1)
|
||||
mat(:,p1,p1:) += tmp_row2(:,p1:)
|
||||
end if
|
||||
end if
|
||||
deallocate(lbanned)
|
||||
|
||||
!! MONO
|
||||
if(sp == 3) then
|
||||
s1 = 1
|
||||
s2 = 2
|
||||
else
|
||||
s1 = sp
|
||||
s2 = sp
|
||||
end if
|
||||
|
||||
do i1=1,p(0,s1)
|
||||
ib = 1
|
||||
if(s1 == s2) ib = i1+1
|
||||
do i2=ib,p(0,s2)
|
||||
p1 = p(i1,s1)
|
||||
p2 = p(i2,s2)
|
||||
if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle
|
||||
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
||||
call i_h_j(gen, det, N_int, hij)
|
||||
mat(:, p1, p2) += coefs(:) * hij
|
||||
end do
|
||||
end do
|
||||
end
|
||||
|
||||
subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
|
||||
integer(bit_kind), intent(in) :: phasemask(2,N_int)
|
||||
logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2)
|
||||
double precision, intent(in) :: coefs(N_states)
|
||||
double precision, intent(inout) :: mat(N_states, mo_num, mo_num)
|
||||
integer, intent(in) :: h(0:2,2), p(0:4,2), sp
|
||||
|
||||
double precision, external :: get_phase_bi, mo_two_e_integral
|
||||
|
||||
integer :: i, j, tip, ma, mi, puti, putj
|
||||
integer :: h1, h2, p1, p2, i1, i2
|
||||
double precision :: hij, phase
|
||||
|
||||
integer, parameter:: turn2d(2,3,4) = reshape((/0,0, 0,0, 0,0, 3,4, 0,0, 0,0, 2,4, 1,4, 0,0, 2,3, 1,3, 1,2 /), (/2,3,4/))
|
||||
integer, parameter :: turn2(2) = (/2, 1/)
|
||||
integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/))
|
||||
|
||||
integer :: bant
|
||||
bant = 1
|
||||
|
||||
tip = p(0,1) * p(0,2)
|
||||
|
||||
ma = sp
|
||||
if(p(0,1) > p(0,2)) ma = 1
|
||||
if(p(0,1) < p(0,2)) ma = 2
|
||||
mi = mod(ma, 2) + 1
|
||||
|
||||
if(sp == 3) then
|
||||
if(ma == 2) bant = 2
|
||||
|
||||
if(tip == 3) then
|
||||
puti = p(1, mi)
|
||||
do i = 1, 3
|
||||
putj = p(i, ma)
|
||||
if(banned(putj,puti,bant)) cycle
|
||||
i1 = turn3(1,i)
|
||||
i2 = turn3(2,i)
|
||||
p1 = p(i1, ma)
|
||||
p2 = p(i2, ma)
|
||||
h1 = h(1, ma)
|
||||
h2 = h(2, ma)
|
||||
|
||||
hij = (mo_two_e_integral(p1, p2, h1, h2) - mo_two_e_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int)
|
||||
if(ma == 1) then
|
||||
mat(:, putj, puti) += coefs(:) * hij
|
||||
else
|
||||
mat(:, puti, putj) += coefs(:) * hij
|
||||
end if
|
||||
end do
|
||||
else
|
||||
h1 = h(1,1)
|
||||
h2 = h(1,2)
|
||||
do j = 1,2
|
||||
putj = p(j, 2)
|
||||
p2 = p(turn2(j), 2)
|
||||
do i = 1,2
|
||||
puti = p(i, 1)
|
||||
|
||||
if(banned(puti,putj,bant)) cycle
|
||||
p1 = p(turn2(i), 1)
|
||||
|
||||
hij = mo_two_e_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2,N_int)
|
||||
mat(:, puti, putj) += coefs(:) * hij
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
|
||||
else
|
||||
if(tip == 0) then
|
||||
h1 = h(1, ma)
|
||||
h2 = h(2, ma)
|
||||
do i=1,3
|
||||
puti = p(i, ma)
|
||||
do j=i+1,4
|
||||
putj = p(j, ma)
|
||||
if(banned(puti,putj,1)) cycle
|
||||
|
||||
i1 = turn2d(1, i, j)
|
||||
i2 = turn2d(2, i, j)
|
||||
p1 = p(i1, ma)
|
||||
p2 = p(i2, ma)
|
||||
hij = (mo_two_e_integral(p1, p2, h1, h2) - mo_two_e_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2,N_int)
|
||||
mat(:, puti, putj) += coefs(:) * hij
|
||||
end do
|
||||
end do
|
||||
else if(tip == 3) then
|
||||
h1 = h(1, mi)
|
||||
h2 = h(1, ma)
|
||||
p1 = p(1, mi)
|
||||
do i=1,3
|
||||
puti = p(turn3(1,i), ma)
|
||||
putj = p(turn3(2,i), ma)
|
||||
if(banned(puti,putj,1)) cycle
|
||||
p2 = p(i, ma)
|
||||
|
||||
hij = mo_two_e_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2,N_int)
|
||||
mat(:, min(puti, putj), max(puti, putj)) += coefs(:) * hij
|
||||
end do
|
||||
else ! tip == 4
|
||||
puti = p(1, sp)
|
||||
putj = p(2, sp)
|
||||
if(.not. banned(puti,putj,1)) then
|
||||
p1 = p(1, mi)
|
||||
p2 = p(2, mi)
|
||||
h1 = h(1, mi)
|
||||
h2 = h(2, mi)
|
||||
hij = (mo_two_e_integral(p1, p2, h1, h2) - mo_two_e_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2,N_int)
|
||||
mat(:, puti, putj) += coefs(:) * hij
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
end
|
||||
|
||||
|
||||
|
@ -198,6 +198,7 @@ subroutine make_selection_buffer_s2(b)
|
||||
|
||||
deallocate(b%det)
|
||||
|
||||
print*,'n_d = ',n_d
|
||||
call i8sort(bit_tmp,iorder,n_d)
|
||||
|
||||
do i=1,n_d
|
||||
|
@ -117,8 +117,12 @@ subroutine run_slave_main
|
||||
call mpi_print('zmq_get_dvector state_average_weight')
|
||||
IRP_ENDIF
|
||||
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) cycle
|
||||
IRP_IF MPI_DEBUG
|
||||
call mpi_print('zmq_get_dvector selection_weight')
|
||||
IRP_ENDIF
|
||||
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) cycle
|
||||
pt2_e0_denominator(1:N_states) = energy(1:N_states)
|
||||
TOUCH pt2_e0_denominator state_average_weight threshold_generators
|
||||
TOUCH pt2_e0_denominator state_average_weight threshold_generators selection_weight
|
||||
|
||||
if (mpi_master) then
|
||||
print *, 'N_det', N_det
|
||||
@ -127,6 +131,7 @@ subroutine run_slave_main
|
||||
print *, 'pt2_e0_denominator', pt2_e0_denominator
|
||||
print *, 'pt2_stoch_istate', pt2_stoch_istate
|
||||
print *, 'state_average_weight', state_average_weight
|
||||
print *, 'selection_weight', selection_weight
|
||||
endif
|
||||
call wall_time(t1)
|
||||
call write_double(6,(t1-t0),'Broadcast time')
|
||||
|
@ -10,8 +10,9 @@ subroutine run_stochastic_cipsi
|
||||
|
||||
double precision :: rss
|
||||
double precision, external :: memory_of_double
|
||||
PROVIDE H_apply_buffer_allocated N_generators_bitmask
|
||||
PROVIDE H_apply_buffer_allocated
|
||||
|
||||
N_iter = 1
|
||||
threshold_generators = 1.d0
|
||||
SOFT_TOUCH threshold_generators
|
||||
|
||||
@ -101,7 +102,7 @@ subroutine run_stochastic_cipsi
|
||||
|
||||
! Add selected determinants
|
||||
call copy_H_apply_buffer_to_wf()
|
||||
call save_wavefunction
|
||||
! call save_wavefunction
|
||||
|
||||
PROVIDE psi_coef
|
||||
PROVIDE psi_det
|
||||
|
223
src/cipsi/update_2rdm.irp.f
Normal file
223
src/cipsi/update_2rdm.irp.f
Normal file
@ -0,0 +1,223 @@
|
||||
use bitmasks
|
||||
|
||||
subroutine give_2rdm_pert_contrib(det,coef,psi_det_connection,psi_coef_connection_reverse,n_det_connection,nkeys,keys,values,sze_buff)
|
||||
implicit none
|
||||
integer, intent(in) :: n_det_connection,sze_buff
|
||||
double precision, intent(in) :: coef(N_states)
|
||||
integer(bit_kind), intent(in) :: det(N_int,2)
|
||||
integer(bit_kind), intent(in) :: psi_det_connection(N_int,2,n_det_connection)
|
||||
double precision, intent(in) :: psi_coef_connection_reverse(N_states,n_det_connection)
|
||||
integer, intent(inout) :: keys(4,sze_buff),nkeys
|
||||
double precision, intent(inout) :: values(sze_buff)
|
||||
integer :: i,j
|
||||
integer :: exc(0:2,2,2)
|
||||
integer :: degree
|
||||
double precision :: phase, contrib
|
||||
do i = 1, n_det_connection
|
||||
call get_excitation(det,psi_det_connection(1,1,i),exc,degree,phase,N_int)
|
||||
if(degree.gt.2)cycle
|
||||
contrib = 0.d0
|
||||
do j = 1, N_states
|
||||
contrib += state_average_weight(j) * psi_coef_connection_reverse(j,i) * phase * coef(j)
|
||||
enddo
|
||||
! case of single excitations
|
||||
if(degree == 1)then
|
||||
if (nkeys + 6 * elec_alpha_num .ge. sze_buff)then
|
||||
call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock)
|
||||
nkeys = 0
|
||||
endif
|
||||
call update_buffer_single_exc_rdm(det,psi_det_connection(1,1,i),exc,phase,contrib,nkeys,keys,values,sze_buff)
|
||||
else
|
||||
!! case of double excitations
|
||||
! if (nkeys + 4 .ge. sze_buff)then
|
||||
! call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock)
|
||||
! nkeys = 0
|
||||
! endif
|
||||
! call update_buffer_double_exc_rdm(exc,phase,contrib,nkeys,keys,values,sze_buff)
|
||||
endif
|
||||
enddo
|
||||
!call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock)
|
||||
!nkeys = 0
|
||||
|
||||
end
|
||||
|
||||
subroutine update_buffer_single_exc_rdm(det1,det2,exc,phase,contrib,nkeys,keys,values,sze_buff)
|
||||
implicit none
|
||||
integer, intent(in) :: sze_buff
|
||||
integer(bit_kind), intent(in) :: det1(N_int,2)
|
||||
integer(bit_kind), intent(in) :: det2(N_int,2)
|
||||
integer,intent(in) :: exc(0:2,2,2)
|
||||
double precision,intent(in) :: phase, contrib
|
||||
integer, intent(inout) :: nkeys, keys(4,sze_buff)
|
||||
double precision, intent(inout):: values(sze_buff)
|
||||
|
||||
integer :: occ(N_int*bit_kind_size,2)
|
||||
integer :: n_occ_ab(2),ispin,other_spin
|
||||
integer :: h1,h2,p1,p2,i
|
||||
call bitstring_to_list_ab(det1, occ, n_occ_ab, N_int)
|
||||
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha
|
||||
h1 = exc(1,1,1)
|
||||
p1 = exc(1,2,1)
|
||||
ispin = 1
|
||||
other_spin = 2
|
||||
else
|
||||
! Mono beta
|
||||
h1 = exc(1,1,2)
|
||||
p1 = exc(1,2,2)
|
||||
ispin = 2
|
||||
other_spin = 1
|
||||
endif
|
||||
if(list_orb_reverse_pert_rdm(h1).lt.0)return
|
||||
h1 = list_orb_reverse_pert_rdm(h1)
|
||||
if(list_orb_reverse_pert_rdm(p1).lt.0)return
|
||||
p1 = list_orb_reverse_pert_rdm(p1)
|
||||
!update the alpha/beta part
|
||||
do i = 1, n_occ_ab(other_spin)
|
||||
h2 = occ(i,other_spin)
|
||||
if(list_orb_reverse_pert_rdm(h2).lt.0)return
|
||||
h2 = list_orb_reverse_pert_rdm(h2)
|
||||
|
||||
nkeys += 1
|
||||
values(nkeys) = 0.5d0 * contrib * phase
|
||||
keys(1,nkeys) = h1
|
||||
keys(2,nkeys) = h2
|
||||
keys(3,nkeys) = p1
|
||||
keys(4,nkeys) = h2
|
||||
nkeys += 1
|
||||
values(nkeys) = 0.5d0 * contrib * phase
|
||||
keys(1,nkeys) = h2
|
||||
keys(2,nkeys) = h1
|
||||
keys(3,nkeys) = h2
|
||||
keys(4,nkeys) = p1
|
||||
enddo
|
||||
!update the same spin part
|
||||
!do i = 1, n_occ_ab(ispin)
|
||||
! h2 = occ(i,ispin)
|
||||
! if(list_orb_reverse_pert_rdm(h2).lt.0)return
|
||||
! h2 = list_orb_reverse_pert_rdm(h2)
|
||||
|
||||
! nkeys += 1
|
||||
! values(nkeys) = 0.5d0 * contrib * phase
|
||||
! keys(1,nkeys) = h1
|
||||
! keys(2,nkeys) = h2
|
||||
! keys(3,nkeys) = p1
|
||||
! keys(4,nkeys) = h2
|
||||
|
||||
! nkeys += 1
|
||||
! values(nkeys) = - 0.5d0 * contrib * phase
|
||||
! keys(1,nkeys) = h1
|
||||
! keys(2,nkeys) = h2
|
||||
! keys(3,nkeys) = h2
|
||||
! keys(4,nkeys) = p1
|
||||
!
|
||||
! nkeys += 1
|
||||
! values(nkeys) = 0.5d0 * contrib * phase
|
||||
! keys(1,nkeys) = h2
|
||||
! keys(2,nkeys) = h1
|
||||
! keys(3,nkeys) = h2
|
||||
! keys(4,nkeys) = p1
|
||||
|
||||
! nkeys += 1
|
||||
! values(nkeys) = - 0.5d0 * contrib * phase
|
||||
! keys(1,nkeys) = h2
|
||||
! keys(2,nkeys) = h1
|
||||
! keys(3,nkeys) = p1
|
||||
! keys(4,nkeys) = h2
|
||||
!enddo
|
||||
|
||||
end
|
||||
|
||||
subroutine update_buffer_double_exc_rdm(exc,phase,contrib,nkeys,keys,values,sze_buff)
|
||||
implicit none
|
||||
integer, intent(in) :: sze_buff
|
||||
integer,intent(in) :: exc(0:2,2,2)
|
||||
double precision,intent(in) :: phase, contrib
|
||||
integer, intent(inout) :: nkeys, keys(4,sze_buff)
|
||||
double precision, intent(inout):: values(sze_buff)
|
||||
integer :: h1,h2,p1,p2
|
||||
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Double alpha/beta
|
||||
h1 = exc(1,1,1)
|
||||
h2 = exc(1,1,2)
|
||||
p1 = exc(1,2,1)
|
||||
p2 = exc(1,2,2)
|
||||
! check if the orbitals involved are within the orbital range
|
||||
if(list_orb_reverse_pert_rdm(h1).lt.0)return
|
||||
h1 = list_orb_reverse_pert_rdm(h1)
|
||||
if(list_orb_reverse_pert_rdm(h2).lt.0)return
|
||||
h2 = list_orb_reverse_pert_rdm(h2)
|
||||
if(list_orb_reverse_pert_rdm(p1).lt.0)return
|
||||
p1 = list_orb_reverse_pert_rdm(p1)
|
||||
if(list_orb_reverse_pert_rdm(p2).lt.0)return
|
||||
p2 = list_orb_reverse_pert_rdm(p2)
|
||||
nkeys += 1
|
||||
values(nkeys) = 0.5d0 * contrib * phase
|
||||
keys(1,nkeys) = h1
|
||||
keys(2,nkeys) = h2
|
||||
keys(3,nkeys) = p1
|
||||
keys(4,nkeys) = p2
|
||||
nkeys += 1
|
||||
values(nkeys) = 0.5d0 * contrib * phase
|
||||
keys(1,nkeys) = p1
|
||||
keys(2,nkeys) = p2
|
||||
keys(3,nkeys) = h1
|
||||
keys(4,nkeys) = h2
|
||||
|
||||
else
|
||||
if (exc(0,1,1) == 2) then
|
||||
! Double alpha/alpha
|
||||
h1 = exc(1,1,1)
|
||||
h2 = exc(2,1,1)
|
||||
p1 = exc(1,2,1)
|
||||
p2 = exc(2,2,1)
|
||||
else if (exc(0,1,2) == 2) then
|
||||
! Double beta
|
||||
h1 = exc(1,1,2)
|
||||
h2 = exc(2,1,2)
|
||||
p1 = exc(1,2,2)
|
||||
p2 = exc(2,2,2)
|
||||
endif
|
||||
! check if the orbitals involved are within the orbital range
|
||||
if(list_orb_reverse_pert_rdm(h1).lt.0)return
|
||||
h1 = list_orb_reverse_pert_rdm(h1)
|
||||
if(list_orb_reverse_pert_rdm(h2).lt.0)return
|
||||
h2 = list_orb_reverse_pert_rdm(h2)
|
||||
if(list_orb_reverse_pert_rdm(p1).lt.0)return
|
||||
p1 = list_orb_reverse_pert_rdm(p1)
|
||||
if(list_orb_reverse_pert_rdm(p2).lt.0)return
|
||||
p2 = list_orb_reverse_pert_rdm(p2)
|
||||
nkeys += 1
|
||||
values(nkeys) = 0.5d0 * contrib * phase
|
||||
keys(1,nkeys) = h1
|
||||
keys(2,nkeys) = h2
|
||||
keys(3,nkeys) = p1
|
||||
keys(4,nkeys) = p2
|
||||
|
||||
nkeys += 1
|
||||
values(nkeys) = - 0.5d0 * contrib * phase
|
||||
keys(1,nkeys) = h1
|
||||
keys(2,nkeys) = h2
|
||||
keys(3,nkeys) = p2
|
||||
keys(4,nkeys) = p1
|
||||
|
||||
nkeys += 1
|
||||
values(nkeys) = 0.5d0 * contrib * phase
|
||||
keys(1,nkeys) = h2
|
||||
keys(2,nkeys) = h1
|
||||
keys(3,nkeys) = p2
|
||||
keys(4,nkeys) = p1
|
||||
|
||||
nkeys += 1
|
||||
values(nkeys) = - 0.5d0 * contrib * phase
|
||||
keys(1,nkeys) = h2
|
||||
keys(2,nkeys) = h1
|
||||
keys(3,nkeys) = p1
|
||||
keys(4,nkeys) = p2
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
|
@ -21,6 +21,11 @@ function run() {
|
||||
eq $energy3 $4 $thresh
|
||||
}
|
||||
|
||||
@test "B-B" { # 2.0s
|
||||
run b2_stretched.ezfio -48.995058575280950 -48.974653655601145 -48.974653655601031
|
||||
|
||||
}
|
||||
|
||||
@test "SiH2_3B1" { # 1.23281s 1.24958s
|
||||
run sih2_3b1.ezfio -289.969297318489 -289.766898643192 -289.737521023380
|
||||
}
|
||||
|
@ -18,6 +18,11 @@ function run() {
|
||||
}
|
||||
|
||||
|
||||
@test "B-B" { #
|
||||
qp set_file b2_stretched.ezfio
|
||||
run -49.120607088648597 -49.055152453388231
|
||||
}
|
||||
|
||||
@test "SiH2_3B1" { # 1.53842s 3.53856s
|
||||
qp set_file sih2_3b1.ezfio
|
||||
run -290.015949171697 -289.805036176618
|
||||
|
@ -44,6 +44,7 @@ program cisd
|
||||
! * "del" orbitals which will be never occupied
|
||||
!
|
||||
END_DOC
|
||||
PROVIDE N_states
|
||||
read_wf = .False.
|
||||
SOFT_TOUCH read_wf
|
||||
call run
|
||||
@ -51,29 +52,52 @@ end
|
||||
|
||||
subroutine run
|
||||
implicit none
|
||||
integer :: i
|
||||
integer :: i,k
|
||||
double precision :: cisdq(N_states), delta_e
|
||||
double precision,external :: diag_h_mat_elem
|
||||
|
||||
if(pseudo_sym)then
|
||||
call H_apply_cisd_sym
|
||||
else
|
||||
call H_apply_cisd
|
||||
endif
|
||||
print *, 'N_det = ', N_det
|
||||
print*,'******************************'
|
||||
print *, 'Energies of the states:'
|
||||
do i = 1,N_states
|
||||
print *, i, CI_energy(i)
|
||||
enddo
|
||||
if (N_states > 1) then
|
||||
print*,'******************************'
|
||||
print*,'Excitation energies '
|
||||
do i = 2, N_states
|
||||
print*, i ,CI_energy(i) - CI_energy(1)
|
||||
enddo
|
||||
endif
|
||||
psi_coef = ci_eigenvectors
|
||||
SOFT_TOUCH psi_coef
|
||||
call save_wavefunction
|
||||
call ezfio_set_cisd_energy(CI_energy)
|
||||
|
||||
do i = 1,N_states
|
||||
k = maxloc(dabs(psi_coef_sorted(1:N_det,i)),dim=1)
|
||||
delta_E = CI_electronic_energy(i) - diag_h_mat_elem(psi_det_sorted(1,1,k),N_int)
|
||||
cisdq(i) = CI_energy(i) + delta_E * (1.d0 - psi_coef_sorted(k,i)**2)
|
||||
enddo
|
||||
print *, 'N_det = ', N_det
|
||||
print*,''
|
||||
print*,'******************************'
|
||||
print *, 'CISD Energies'
|
||||
do i = 1,N_states
|
||||
print *, i, CI_energy(i)
|
||||
enddo
|
||||
print*,''
|
||||
print*,'******************************'
|
||||
print *, 'CISD+Q Energies'
|
||||
do i = 1,N_states
|
||||
print *, i, cisdq(i)
|
||||
enddo
|
||||
if (N_states > 1) then
|
||||
print*,''
|
||||
print*,'******************************'
|
||||
print*,'Excitation energies (au) (CISD+Q)'
|
||||
do i = 2, N_states
|
||||
print*, i ,CI_energy(i) - CI_energy(1), cisdq(i) - cisdq(1)
|
||||
enddo
|
||||
print*,''
|
||||
print*,'******************************'
|
||||
print*,'Excitation energies (eV) (CISD+Q)'
|
||||
do i = 2, N_states
|
||||
print*, i ,(CI_energy(i) - CI_energy(1))/0.0367502d0, &
|
||||
(cisdq(i) - cisdq(1)) / 0.0367502d0
|
||||
enddo
|
||||
endif
|
||||
|
||||
end
|
||||
|
28
src/cisd/cisd_routine.irp.f
Normal file
28
src/cisd/cisd_routine.irp.f
Normal file
@ -0,0 +1,28 @@
|
||||
subroutine run_cisd
|
||||
implicit none
|
||||
integer :: i
|
||||
|
||||
if(pseudo_sym)then
|
||||
call H_apply_cisd_sym
|
||||
else
|
||||
call H_apply_cisd
|
||||
endif
|
||||
print *, 'N_det = ', N_det
|
||||
print*,'******************************'
|
||||
print *, 'Energies of the states:'
|
||||
do i = 1,N_states
|
||||
print *, i, CI_energy(i)
|
||||
enddo
|
||||
if (N_states > 1) then
|
||||
print*,'******************************'
|
||||
print*,'Excitation energies '
|
||||
do i = 2, N_states
|
||||
print*, i ,CI_energy(i) - CI_energy(1)
|
||||
enddo
|
||||
endif
|
||||
psi_coef = ci_eigenvectors
|
||||
SOFT_TOUCH psi_coef
|
||||
call save_wavefunction
|
||||
call ezfio_set_cisd_energy(CI_energy)
|
||||
|
||||
end
|
@ -6,7 +6,7 @@ BEGIN_PROVIDER [ double precision, psi_energy_two_e, (N_states) ]
|
||||
integer :: i,j
|
||||
call u_0_H_u_0_two_e(psi_energy_two_e,psi_coef,N_det,psi_det,N_int,N_states,psi_det_size)
|
||||
do i=N_det+1,N_states
|
||||
psi_energy(i) = 0.d0
|
||||
psi_energy_two_e(i) = 0.d0
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -106,12 +106,31 @@ END_PROVIDER
|
||||
BEGIN_PROVIDER [double precision, one_e_dm_average_mo_for_dft, (mo_num,mo_num)]
|
||||
implicit none
|
||||
integer :: i
|
||||
one_e_dm_average_mo_for_dft = 0.d0
|
||||
one_e_dm_average_mo_for_dft = one_e_dm_average_alpha_mo_for_dft + one_e_dm_average_beta_mo_for_dft
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, one_e_dm_average_alpha_mo_for_dft, (mo_num,mo_num)]
|
||||
implicit none
|
||||
integer :: i
|
||||
one_e_dm_average_alpha_mo_for_dft = 0.d0
|
||||
do i = 1, N_states
|
||||
one_e_dm_average_mo_for_dft(:,:) += one_e_dm_mo_for_dft(:,:,i) * state_average_weight(i)
|
||||
one_e_dm_average_alpha_mo_for_dft(:,:) += one_e_dm_mo_alpha_for_dft(:,:,i) * state_average_weight(i)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, one_e_dm_average_beta_mo_for_dft, (mo_num,mo_num)]
|
||||
implicit none
|
||||
integer :: i
|
||||
one_e_dm_average_beta_mo_for_dft = 0.d0
|
||||
do i = 1, N_states
|
||||
one_e_dm_average_beta_mo_for_dft(:,:) += one_e_dm_mo_beta_for_dft(:,:,i) * state_average_weight(i)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, one_e_dm_alpha_ao_for_dft, (ao_num,ao_num,N_states) ]
|
||||
&BEGIN_PROVIDER [ double precision, one_e_dm_beta_ao_for_dft, (ao_num,ao_num,N_states) ]
|
||||
BEGIN_DOC
|
||||
|
@ -22,6 +22,12 @@ doc: If |true|, read the wave function from the |EZFIO| file
|
||||
interface: ezfio,provider,ocaml
|
||||
default: False
|
||||
|
||||
[pruning]
|
||||
type: float
|
||||
doc: If p>0., remove p*Ndet determinants at every iteration
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 0.
|
||||
|
||||
[s2_eig]
|
||||
type: logical
|
||||
doc: Force the wave function to be an eigenfunction of |S^2|
|
||||
@ -32,11 +38,11 @@ default: True
|
||||
type: integer
|
||||
doc: Weight used in the calculation of the one-electron density matrix. 0: 1./(c_0^2), 1: 1/N_states, 2: input state-average weight, 3: 1/(Norm_L3(Psi))
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 1
|
||||
default: 2
|
||||
|
||||
[weight_selection]
|
||||
type: integer
|
||||
doc: Weight used in the selection. 0: input state-average weight, 1: 1./(c_0^2), 2: rPT2 matching, 3: variance matching, 4: variance and rPT2 matching, 5: variance minimization and matching
|
||||
doc: Weight used in the selection. 0: input state-average weight, 1: 1./(c_0^2), 2: rPT2 matching, 3: variance matching, 4: variance and rPT2 matching, 5: variance minimization and matching, 6: CI coefficients
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 2
|
||||
|
||||
@ -66,6 +72,12 @@ interface: ezfio
|
||||
doc: Number of determinants in the current wave function
|
||||
type: integer
|
||||
|
||||
[n_det_qp_edit]
|
||||
interface: ezfio
|
||||
doc: Number of determinants to print in qp_edit
|
||||
type: integer
|
||||
interface: ezfio
|
||||
|
||||
[psi_coef]
|
||||
interface: ezfio
|
||||
doc: Coefficients of the wave function
|
||||
@ -78,6 +90,18 @@ doc: Determinants of the variational space
|
||||
type: integer*8
|
||||
size: (determinants.n_int*determinants.bit_kind/8,2,determinants.n_det)
|
||||
|
||||
[psi_coef_qp_edit]
|
||||
interface: ezfio
|
||||
doc: Coefficients of the wave function
|
||||
type: double precision
|
||||
size: (determinants.n_det_qp_edit,determinants.n_states)
|
||||
|
||||
[psi_det_qp_edit]
|
||||
interface: ezfio
|
||||
doc: Determinants of the variational space
|
||||
type: integer*8
|
||||
size: (determinants.n_int*determinants.bit_kind/8,2,determinants.n_det_qp_edit)
|
||||
|
||||
[expected_s2]
|
||||
interface: ezfio
|
||||
doc: Expected value of |S^2|
|
||||
|
@ -12,6 +12,7 @@ subroutine do_single_excitation(key_in,i_hole,i_particle,ispin,i_ok)
|
||||
integer(bit_kind), intent(inout) :: key_in(N_int,2)
|
||||
integer, intent(out) :: i_ok
|
||||
integer :: k,j,i
|
||||
integer(bit_kind) :: mask
|
||||
use bitmasks
|
||||
ASSERT (i_hole > 0 )
|
||||
ASSERT (i_particle <= mo_num)
|
||||
@ -19,31 +20,66 @@ subroutine do_single_excitation(key_in,i_hole,i_particle,ispin,i_ok)
|
||||
! hole
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
mask = ibset(0_bit_kind,j)
|
||||
! check whether position j is occupied
|
||||
if (ibits(key_in(k,ispin),j,1).eq.1) then
|
||||
if (iand(key_in(k,ispin),mask) /= 0_bit_kind) then
|
||||
key_in(k,ispin) = ibclr(key_in(k,ispin),j)
|
||||
else
|
||||
i_ok= -1
|
||||
return
|
||||
end if
|
||||
|
||||
! particle
|
||||
k = shiftr(i_particle-1,bit_kind_shift)+1
|
||||
j = i_particle-shiftl(k-1,bit_kind_shift)-1
|
||||
key_in(k,ispin) = ibset(key_in(k,ispin),j)
|
||||
mask = ibset(0_bit_kind,j)
|
||||
if (iand(key_in(k,ispin),mask) == 0_bit_kind) then
|
||||
key_in(k,ispin) = ibset(key_in(k,ispin),j)
|
||||
else
|
||||
i_ok= -1
|
||||
return
|
||||
end if
|
||||
|
||||
integer :: n_elec_tmp
|
||||
n_elec_tmp = 0
|
||||
do i = 1, N_int
|
||||
n_elec_tmp += popcnt(key_in(i,1)) + popcnt(key_in(i,2))
|
||||
enddo
|
||||
if(n_elec_tmp .ne. elec_num)then
|
||||
!print*, n_elec_tmp,elec_num
|
||||
!call debug_det(key_in,N_int)
|
||||
i_ok = -1
|
||||
endif
|
||||
! integer :: n_elec_tmp
|
||||
! n_elec_tmp = 0
|
||||
! do i = 1, N_int
|
||||
! n_elec_tmp += popcnt(key_in(i,1)) + popcnt(key_in(i,2))
|
||||
! enddo
|
||||
! if(n_elec_tmp .ne. elec_num)then
|
||||
! print*, n_elec_tmp,elec_num
|
||||
! call debug_det(key_in,N_int)
|
||||
! stop -1
|
||||
! endif
|
||||
end
|
||||
|
||||
|
||||
subroutine build_singly_excited_wavefunction(i_hole,i_particle,ispin,det_out,coef_out)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Applies the single excitation operator : a^{dager}_(i_particle) a_(i_hole) of
|
||||
! spin = ispin to the current wave function (psi_det, psi_coef)
|
||||
END_DOC
|
||||
integer, intent(in) :: i_hole,i_particle,ispin
|
||||
integer(bit_kind), intent(out) :: det_out(N_int,2,N_det)
|
||||
double precision, intent(out) :: coef_out(N_det,N_states)
|
||||
|
||||
integer :: k
|
||||
integer :: i_ok
|
||||
double precision :: phase
|
||||
do k=1,N_det
|
||||
coef_out(k,:) = psi_coef(k,:)
|
||||
det_out(:,:,k) = psi_det(:,:,k)
|
||||
call do_single_excitation(det_out(1,1,k),i_hole,i_particle,ispin,i_ok)
|
||||
if (i_ok == 1) then
|
||||
call get_phase(psi_det(1,1,k), det_out(1,1,k),phase,N_int)
|
||||
coef_out(k,:) = phase * coef_out(k,:)
|
||||
else
|
||||
coef_out(k,:) = 0.d0
|
||||
det_out(:,:,k) = psi_det(:,:,k)
|
||||
endif
|
||||
enddo
|
||||
end
|
||||
|
||||
logical function is_spin_flip_possible(key_in,i_flip,ispin)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
|
@ -257,6 +257,18 @@ subroutine set_natural_mos
|
||||
double precision, allocatable :: tmp(:,:)
|
||||
|
||||
label = "Natural"
|
||||
integer :: i,j,iorb,jorb
|
||||
do i = 1, n_virt_orb
|
||||
iorb = list_virt(i)
|
||||
do j = 1, n_core_inact_act_orb
|
||||
jorb = list_core_inact_act(j)
|
||||
if(one_e_dm_mo(iorb,jorb).ne. 0.d0)then
|
||||
print*,'AHAHAH'
|
||||
print*,iorb,jorb,one_e_dm_mo(iorb,jorb)
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label)
|
||||
soft_touch mo_occ
|
||||
|
||||
@ -269,7 +281,6 @@ subroutine save_natural_mos
|
||||
END_DOC
|
||||
call set_natural_mos
|
||||
call save_mos
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
@ -44,6 +44,16 @@ BEGIN_PROVIDER [ integer, N_det ]
|
||||
ASSERT (N_det > 0)
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, N_det_qp_edit ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of determinants to print in qp_edit
|
||||
END_DOC
|
||||
|
||||
N_det_qp_edit = min(N_det,10000)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, max_degree_exc]
|
||||
implicit none
|
||||
integer :: i,degree
|
||||
@ -476,7 +486,7 @@ subroutine save_wavefunction
|
||||
endif
|
||||
if (mpi_master) then
|
||||
call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
|
||||
endif
|
||||
endif
|
||||
end
|
||||
|
||||
|
||||
@ -504,12 +514,16 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
||||
integer*8, allocatable :: psi_det_save(:,:,:)
|
||||
double precision, allocatable :: psi_coef_save(:,:)
|
||||
|
||||
integer :: i,j,k
|
||||
double precision :: accu_norm
|
||||
integer :: i,j,k, ndet_qp_edit
|
||||
|
||||
if (mpi_master) then
|
||||
ndet_qp_edit = min(ndet,N_det_qp_edit)
|
||||
|
||||
call ezfio_set_determinants_N_int(N_int)
|
||||
call ezfio_set_determinants_bit_kind(bit_kind)
|
||||
call ezfio_set_determinants_N_det(ndet)
|
||||
call ezfio_set_determinants_N_det_qp_edit(ndet_qp_edit)
|
||||
call ezfio_set_determinants_n_states(nstates)
|
||||
call ezfio_set_determinants_mo_label(mo_label)
|
||||
|
||||
@ -522,10 +536,10 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
||||
enddo
|
||||
enddo
|
||||
call ezfio_set_determinants_psi_det(psi_det_save)
|
||||
call ezfio_set_determinants_psi_det_qp_edit(psi_det_save)
|
||||
deallocate (psi_det_save)
|
||||
|
||||
allocate (psi_coef_save(ndet,nstates))
|
||||
double precision :: accu_norm
|
||||
do k=1,nstates
|
||||
do i=1,ndet
|
||||
psi_coef_save(i,k) = psicoef(i,k)
|
||||
@ -535,6 +549,18 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
||||
|
||||
call ezfio_set_determinants_psi_coef(psi_coef_save)
|
||||
deallocate (psi_coef_save)
|
||||
|
||||
allocate (psi_coef_save(ndet_qp_edit,nstates))
|
||||
do k=1,nstates
|
||||
do i=1,ndet_qp_edit
|
||||
psi_coef_save(i,k) = psicoef(i,k)
|
||||
enddo
|
||||
call normalize(psi_coef_save(1,k),ndet_qp_edit)
|
||||
enddo
|
||||
|
||||
call ezfio_set_determinants_psi_coef_qp_edit(psi_coef_save)
|
||||
deallocate (psi_coef_save)
|
||||
|
||||
call write_int(6,ndet,'Saved determinants')
|
||||
endif
|
||||
end
|
||||
@ -559,54 +585,80 @@ subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,inde
|
||||
integer :: N_int2
|
||||
equivalence (det_8, det_bk)
|
||||
|
||||
integer :: i,k
|
||||
integer :: i,j,k, ndet_qp_edit
|
||||
|
||||
call ezfio_set_determinants_N_int(N_int)
|
||||
call ezfio_set_determinants_bit_kind(bit_kind)
|
||||
call ezfio_set_determinants_N_det(ndetsave)
|
||||
call ezfio_set_determinants_n_states(nstates)
|
||||
call ezfio_set_determinants_mo_label(mo_label)
|
||||
if (mpi_master) then
|
||||
ndet_qp_edit = min(ndetsave,N_det_qp_edit)
|
||||
call ezfio_set_determinants_N_int(N_int)
|
||||
call ezfio_set_determinants_bit_kind(bit_kind)
|
||||
call ezfio_set_determinants_N_det(ndetsave)
|
||||
call ezfio_set_determinants_N_det_qp_edit(ndet_qp_edit)
|
||||
call ezfio_set_determinants_n_states(nstates)
|
||||
call ezfio_set_determinants_mo_label(mo_label)
|
||||
|
||||
N_int2 = (N_int*bit_kind)/8
|
||||
allocate (psi_det_save(N_int2,2,ndetsave))
|
||||
do i=1,ndetsave
|
||||
do k=1,N_int
|
||||
det_bk(k) = psidet(k,1,index_det_save(i))
|
||||
enddo
|
||||
do k=1,N_int2
|
||||
psi_det_save(k,1,i) = det_8(k)
|
||||
enddo
|
||||
do k=1,N_int
|
||||
det_bk(k) = psidet(k,2,index_det_save(i))
|
||||
enddo
|
||||
do k=1,N_int2
|
||||
psi_det_save(k,2,i) = det_8(k)
|
||||
enddo
|
||||
enddo
|
||||
call ezfio_set_determinants_psi_det(psi_det_save)
|
||||
deallocate (psi_det_save)
|
||||
|
||||
allocate (psi_coef_save(ndetsave,nstates))
|
||||
double precision :: accu_norm(nstates)
|
||||
accu_norm = 0.d0
|
||||
do k=1,nstates
|
||||
N_int2 = (N_int*bit_kind)/8
|
||||
allocate (psi_det_save(N_int2,2,ndetsave))
|
||||
do i=1,ndetsave
|
||||
accu_norm(k) = accu_norm(k) + psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k)
|
||||
psi_coef_save(i,k) = psicoef(index_det_save(i),k)
|
||||
do k=1,N_int
|
||||
det_bk(k) = psidet(k,1,index_det_save(i))
|
||||
enddo
|
||||
do k=1,N_int2
|
||||
psi_det_save(k,1,i) = det_8(k)
|
||||
enddo
|
||||
do k=1,N_int
|
||||
det_bk(k) = psidet(k,2,index_det_save(i))
|
||||
enddo
|
||||
do k=1,N_int2
|
||||
psi_det_save(k,2,i) = det_8(k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
do k = 1, nstates
|
||||
accu_norm(k) = 1.d0/dsqrt(accu_norm(k))
|
||||
enddo
|
||||
do k=1,nstates
|
||||
do i=1,ndetsave
|
||||
psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k)
|
||||
enddo
|
||||
enddo
|
||||
call ezfio_set_determinants_psi_det(psi_det_save)
|
||||
call ezfio_set_determinants_psi_det_qp_edit(psi_det_save)
|
||||
deallocate (psi_det_save)
|
||||
|
||||
call ezfio_set_determinants_psi_coef(psi_coef_save)
|
||||
call write_int(6,ndet,'Saved determinants')
|
||||
deallocate (psi_coef_save)
|
||||
allocate (psi_coef_save(ndetsave,nstates))
|
||||
double precision :: accu_norm(nstates)
|
||||
accu_norm = 0.d0
|
||||
do k=1,nstates
|
||||
do i=1,ndetsave
|
||||
accu_norm(k) = accu_norm(k) + psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k)
|
||||
psi_coef_save(i,k) = psicoef(index_det_save(i),k)
|
||||
enddo
|
||||
enddo
|
||||
do k = 1, nstates
|
||||
accu_norm(k) = 1.d0/dsqrt(accu_norm(k))
|
||||
enddo
|
||||
do k=1,nstates
|
||||
do i=1,ndetsave
|
||||
psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call ezfio_set_determinants_psi_coef(psi_coef_save)
|
||||
deallocate (psi_coef_save)
|
||||
|
||||
allocate (psi_coef_save(ndet_qp_edit,nstates))
|
||||
accu_norm = 0.d0
|
||||
do k=1,nstates
|
||||
do i=1,ndet_qp_edit
|
||||
accu_norm(k) = accu_norm(k) + psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k)
|
||||
psi_coef_save(i,k) = psicoef(index_det_save(i),k)
|
||||
enddo
|
||||
enddo
|
||||
do k = 1, nstates
|
||||
accu_norm(k) = 1.d0/dsqrt(accu_norm(k))
|
||||
enddo
|
||||
do k=1,nstates
|
||||
do i=1,ndet_qp_edit
|
||||
psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call ezfio_set_determinants_psi_coef(psi_coef_save)
|
||||
deallocate (psi_coef_save)
|
||||
|
||||
call write_int(6,ndet,'Saved determinants')
|
||||
endif
|
||||
end
|
||||
|
||||
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user