mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-31 21:23:40 +02:00
Merge pull request #307 from QuantumPackage/dev-stable
Some checks failed
continuous-integration/drone/push Build is failing
Some checks failed
continuous-integration/drone/push Build is failing
Dev stable
This commit is contained in:
commit
9ff4f2437c
2
.github/workflows/compilation.yml
vendored
2
.github/workflows/compilation.yml
vendored
@ -48,6 +48,8 @@ jobs:
|
||||
./configure -i docopt || :
|
||||
./configure -i resultsFile || :
|
||||
./configure -i bats || :
|
||||
./configure -i trexio-nohdf5 || :
|
||||
./configure -i qmckl || :
|
||||
./configure -c ./config/gfortran_debug.cfg
|
||||
- name: Compilation
|
||||
run: |
|
||||
|
11
.github/workflows/configuration.yml
vendored
11
.github/workflows/configuration.yml
vendored
@ -22,7 +22,7 @@ jobs:
|
||||
- uses: actions/checkout@v3
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config
|
||||
sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config libhdf5-dev
|
||||
- name: zlib
|
||||
run: |
|
||||
./configure -i zlib || echo OK
|
||||
@ -50,6 +50,15 @@ jobs:
|
||||
- name: bats
|
||||
run: |
|
||||
./configure -i bats || echo OK
|
||||
- name: trexio-nohdf5
|
||||
run: |
|
||||
./configure -i trexio-nohdf5 || echo OK
|
||||
- name: trexio
|
||||
run: |
|
||||
./configure -i trexio || echo OK
|
||||
- name: qmckl
|
||||
run: |
|
||||
./configure -i qmckl || echo OK
|
||||
- name: Final check
|
||||
run: |
|
||||
./configure -c config/gfortran_debug.cfg
|
||||
|
@ -10,7 +10,8 @@
|
||||
- Added many types of integrals
|
||||
- Accelerated four-index transformation
|
||||
- Added transcorrelated SCF
|
||||
- Added transcorrelated CIPSI
|
||||
- Added bi-orthonormal transcorrelated CIPSI
|
||||
- Added Cholesky decomposition of AO integrals
|
||||
- Added CCSD and CCSD(T)
|
||||
- Added MO localization
|
||||
- Changed coupling parameters for ROHF
|
||||
@ -20,7 +21,7 @@
|
||||
- Removed cryptokit dependency in OCaml
|
||||
- Using now standard convention in RDM
|
||||
- Added molecular properties
|
||||
- [ ] Added GTOs with complex exponent
|
||||
- Added GTOs with complex exponent
|
||||
|
||||
*** TODO: take from dev
|
||||
- Updated version of f77-zmq
|
||||
|
@ -97,6 +97,8 @@ if [[ $dets -eq 1 ]] ; then
|
||||
rm --force -- ${ezfio}/determinants/psi_{det,coef}.gz
|
||||
rm --force -- ${ezfio}/determinants/n_det_qp_edit
|
||||
rm --force -- ${ezfio}/determinants/psi_{det,coef}_qp_edit.gz
|
||||
rm --force -- ${ezfio}/tc_bi_ortho/psi_{l,r}_coef_bi_ortho.gz
|
||||
|
||||
fi
|
||||
|
||||
if [[ $mos -eq 1 ]] ; then
|
||||
|
@ -46,7 +46,7 @@ def main(arguments):
|
||||
append_bats(dirname, filenames)
|
||||
else:
|
||||
for (dirname, _, filenames) in os.walk(os.getcwd(), followlinks=False):
|
||||
if "IRPF90_temp" not in dirname:
|
||||
if "IRPF90_temp" not in dirname and "external" not in dirname:
|
||||
append_bats(dirname, filenames)
|
||||
l_bats = [y for _, y in sorted(l_bats)]
|
||||
|
||||
@ -67,6 +67,7 @@ def main(arguments):
|
||||
os.system(test+" python3 bats_to_sh.py "+bats_file+
|
||||
"| bash")
|
||||
else:
|
||||
# print(" ".join(["bats", "--verbose-run", "--trace", bats_file]))
|
||||
subprocess.check_call(["bats", "--verbose-run", "--trace", bats_file], env=os.environ)
|
||||
|
||||
|
||||
|
62
config/flang_avx.cfg
Normal file
62
config/flang_avx.cfg
Normal file
@ -0,0 +1,62 @@
|
||||
# Common flags
|
||||
##############
|
||||
#
|
||||
# -ffree-line-length-none : Needed for IRPF90 which produces long lines
|
||||
# -lblas -llapack : Link with libblas and liblapack libraries provided by the system
|
||||
# -I . : Include the curent directory (Mandatory)
|
||||
#
|
||||
# --ninja : Allow the utilisation of ninja. (Mandatory)
|
||||
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||
#
|
||||
#
|
||||
[COMMON]
|
||||
FC : flang -ffree-line-length-none -I . -mavx -g -fPIC
|
||||
LAPACK_LIB : -llapack -lblas
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 -DSET_NESTED
|
||||
|
||||
# Global options
|
||||
################
|
||||
#
|
||||
# 1 : Activate
|
||||
# 0 : Deactivate
|
||||
#
|
||||
[OPTION]
|
||||
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
CACHE : 0 ; Enable cache_compile.py
|
||||
OPENMP : 1 ; Append OpenMP flags
|
||||
|
||||
# Optimization flags
|
||||
####################
|
||||
#
|
||||
# -Ofast : Disregard strict standards compliance. Enables all -O3 optimizations.
|
||||
# It also enables optimizations that are not valid
|
||||
# for all standard-compliant programs. It turns on
|
||||
# -ffast-math and the Fortran-specific
|
||||
# -fno-protect-parens and -fstack-arrays.
|
||||
[OPT]
|
||||
FCFLAGS : -Ofast -mavx
|
||||
|
||||
# Profiling flags
|
||||
#################
|
||||
#
|
||||
[PROFILE]
|
||||
FC : -p -g
|
||||
FCFLAGS : -Ofast
|
||||
|
||||
# Debugging flags
|
||||
#################
|
||||
#
|
||||
# -fcheck=all : Checks uninitialized variables, array subscripts, etc...
|
||||
# -g : Extra debugging information
|
||||
#
|
||||
[DEBUG]
|
||||
FCFLAGS : -fcheck=all -g
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
#
|
||||
[OPENMP]
|
||||
FC : -fopenmp
|
||||
IRPF90_FLAGS : --openmp
|
||||
|
62
config/gfortran10.cfg
Normal file
62
config/gfortran10.cfg
Normal file
@ -0,0 +1,62 @@
|
||||
# Common flags
|
||||
##############
|
||||
#
|
||||
# -ffree-line-length-none : Needed for IRPF90 which produces long lines
|
||||
# -lblas -llapack : Link with libblas and liblapack libraries provided by the system
|
||||
# -I . : Include the curent directory (Mandatory)
|
||||
#
|
||||
# --ninja : Allow the utilisation of ninja. (Mandatory)
|
||||
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||
#
|
||||
#
|
||||
[COMMON]
|
||||
FC : gfortran-10 -g -ffree-line-length-none -I . -fPIC
|
||||
LAPACK_LIB : -lblas -llapack
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED
|
||||
|
||||
# Global options
|
||||
################
|
||||
#
|
||||
# 1 : Activate
|
||||
# 0 : Deactivate
|
||||
#
|
||||
[OPTION]
|
||||
MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
CACHE : 0 ; Enable cache_compile.py
|
||||
OPENMP : 1 ; Append OpenMP flags
|
||||
|
||||
# Optimization flags
|
||||
####################
|
||||
#
|
||||
# -Ofast : Disregard strict standards compliance. Enables all -O3 optimizations.
|
||||
# It also enables optimizations that are not valid
|
||||
# for all standard-compliant programs. It turns on
|
||||
# -ffast-math and the Fortran-specific
|
||||
# -fno-protect-parens and -fstack-arrays.
|
||||
[OPT]
|
||||
FCFLAGS : -Ofast
|
||||
|
||||
# Profiling flags
|
||||
#################
|
||||
#
|
||||
[PROFILE]
|
||||
FC : -p -g
|
||||
FCFLAGS : -Ofast
|
||||
|
||||
# Debugging flags
|
||||
#################
|
||||
#
|
||||
# -fcheck=all : Checks uninitialized variables, array subscripts, etc...
|
||||
# -g : Extra debugging information
|
||||
#
|
||||
[DEBUG]
|
||||
FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
#
|
||||
[OPENMP]
|
||||
FC : -fopenmp
|
||||
IRPF90_FLAGS : --openmp
|
||||
|
@ -14,7 +14,7 @@
|
||||
#
|
||||
[COMMON]
|
||||
FC : gfortran -g -ffree-line-length-none -I . -fPIC -march=native -std=legacy
|
||||
LAPACK_LIB : -larmpl_lp64
|
||||
LAPACK_LIB : -larmpl_lp64_mp
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED
|
||||
|
||||
|
62
config/gfortran_mpi_mkl.cfg
Normal file
62
config/gfortran_mpi_mkl.cfg
Normal file
@ -0,0 +1,62 @@
|
||||
# Common flags
|
||||
##############
|
||||
#
|
||||
# -ffree-line-length-none : Needed for IRPF90 which produces long lines
|
||||
# -lblas -llapack : Link with libblas and liblapack libraries provided by the system
|
||||
# -I . : Include the curent directory (Mandatory)
|
||||
#
|
||||
# --ninja : Allow the utilisation of ninja. (Mandatory)
|
||||
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||
#
|
||||
#
|
||||
[COMMON]
|
||||
FC : mpif90 -ffree-line-length-none -I . -g -fPIC -std=legacy
|
||||
LAPACK_LIB : -lblas -llapack
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 -DMPI -DSET_NESTED
|
||||
|
||||
# Global options
|
||||
################
|
||||
#
|
||||
# 1 : Activate
|
||||
# 0 : Deactivate
|
||||
#
|
||||
[OPTION]
|
||||
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
CACHE : 0 ; Enable cache_compile.py
|
||||
OPENMP : 1 ; Append OpenMP flags
|
||||
|
||||
# Optimization flags
|
||||
####################
|
||||
#
|
||||
# -Ofast : Disregard strict standards compliance. Enables all -O3 optimizations.
|
||||
# It also enables optimizations that are not valid
|
||||
# for all standard-compliant programs. It turns on
|
||||
# -ffast-math and the Fortran-specific
|
||||
# -fno-protect-parens and -fstack-arrays.
|
||||
[OPT]
|
||||
FCFLAGS : -Ofast -msse4.2
|
||||
|
||||
# Profiling flags
|
||||
#################
|
||||
#
|
||||
[PROFILE]
|
||||
FC : -p -g
|
||||
FCFLAGS : -Ofast -msse4.2
|
||||
|
||||
# Debugging flags
|
||||
#################
|
||||
#
|
||||
# -fcheck=all : Checks uninitialized variables, array subscripts, etc...
|
||||
# -g : Extra debugging information
|
||||
#
|
||||
[DEBUG]
|
||||
FCFLAGS : -fcheck=all -g
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
#
|
||||
[OPENMP]
|
||||
FC : -fopenmp
|
||||
IRPF90_FLAGS : --openmp
|
||||
|
63
config/ifort_2019_avx_notz.cfg
Normal file
63
config/ifort_2019_avx_notz.cfg
Normal file
@ -0,0 +1,63 @@
|
||||
# Common flags
|
||||
##############
|
||||
#
|
||||
# -mkl=[parallel|sequential] : Use the MKL library
|
||||
# --ninja : Allow the utilisation of ninja. It is mandatory !
|
||||
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||
#
|
||||
[COMMON]
|
||||
FC : ifort -fpic
|
||||
LAPACK_LIB : -mkl=parallel
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 --define=WITHOUT_TRAILZ --define=WITHOUT_SHIFTRL -DSET_NESTED
|
||||
|
||||
# Global options
|
||||
################
|
||||
#
|
||||
# 1 : Activate
|
||||
# 0 : Deactivate
|
||||
#
|
||||
[OPTION]
|
||||
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
CACHE : 0 ; Enable cache_compile.py
|
||||
OPENMP : 1 ; Append OpenMP flags
|
||||
|
||||
# Optimization flags
|
||||
####################
|
||||
#
|
||||
# -xHost : Compile a binary optimized for the current architecture
|
||||
# -O2 : O3 not better than O2.
|
||||
# -ip : Inter-procedural optimizations
|
||||
# -ftz : Flushes denormal results to zero
|
||||
#
|
||||
[OPT]
|
||||
FC : -traceback
|
||||
FCFLAGS : -xAVX -O2 -ip -ftz -g
|
||||
|
||||
# Profiling flags
|
||||
#################
|
||||
#
|
||||
[PROFILE]
|
||||
FC : -p -g
|
||||
FCFLAGS : -xSSE4.2 -O2 -ip -ftz
|
||||
|
||||
# Debugging flags
|
||||
#################
|
||||
#
|
||||
# -traceback : Activate backtrace on runtime
|
||||
# -fpe0 : All floating point exaceptions
|
||||
# -C : Checks uninitialized variables, array subscripts, etc...
|
||||
# -g : Extra debugging information
|
||||
# -xSSE2 : Valgrind needs a very simple x86 executable
|
||||
#
|
||||
[DEBUG]
|
||||
FC : -g -traceback
|
||||
FCFLAGS : -xSSE2 -C -fpe0 -implicitnone
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
#
|
||||
[OPENMP]
|
||||
FC : -qopenmp
|
||||
IRPF90_FLAGS : --openmp
|
||||
|
@ -7,7 +7,7 @@
|
||||
#
|
||||
[COMMON]
|
||||
FC : ifort -fpic
|
||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
||||
LAPACK_LIB : -mkl=parallel
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL -DSET_NESTED
|
||||
|
||||
|
63
config/ifort_2021_avx_notz.cfg
Normal file
63
config/ifort_2021_avx_notz.cfg
Normal file
@ -0,0 +1,63 @@
|
||||
# Common flags
|
||||
##############
|
||||
#
|
||||
# -mkl=[parallel|sequential] : Use the MKL library
|
||||
# --ninja : Allow the utilisation of ninja. It is mandatory !
|
||||
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||
#
|
||||
[COMMON]
|
||||
FC : ifort -fpic
|
||||
LAPACK_LIB : -mkl=parallel
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 --define=WITHOUT_TRAILZ --define=WITHOUT_SHIFTRL
|
||||
|
||||
# Global options
|
||||
################
|
||||
#
|
||||
# 1 : Activate
|
||||
# 0 : Deactivate
|
||||
#
|
||||
[OPTION]
|
||||
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
CACHE : 0 ; Enable cache_compile.py
|
||||
OPENMP : 1 ; Append OpenMP flags
|
||||
|
||||
# Optimization flags
|
||||
####################
|
||||
#
|
||||
# -xHost : Compile a binary optimized for the current architecture
|
||||
# -O2 : O3 not better than O2.
|
||||
# -ip : Inter-procedural optimizations
|
||||
# -ftz : Flushes denormal results to zero
|
||||
#
|
||||
[OPT]
|
||||
FC : -traceback
|
||||
FCFLAGS : -xAVX -O2 -ip -ftz -g
|
||||
|
||||
# Profiling flags
|
||||
#################
|
||||
#
|
||||
[PROFILE]
|
||||
FC : -p -g
|
||||
FCFLAGS : -xSSE4.2 -O2 -ip -ftz
|
||||
|
||||
# Debugging flags
|
||||
#################
|
||||
#
|
||||
# -traceback : Activate backtrace on runtime
|
||||
# -fpe0 : All floating point exaceptions
|
||||
# -C : Checks uninitialized variables, array subscripts, etc...
|
||||
# -g : Extra debugging information
|
||||
# -xSSE2 : Valgrind needs a very simple x86 executable
|
||||
#
|
||||
[DEBUG]
|
||||
FC : -g -traceback
|
||||
FCFLAGS : -xSSE2 -C -fpe0 -implicitnone
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
#
|
||||
[OPENMP]
|
||||
FC : -qopenmp
|
||||
IRPF90_FLAGS : --openmp
|
||||
|
66
config/ifort_2021_debug.cfg
Normal file
66
config/ifort_2021_debug.cfg
Normal file
@ -0,0 +1,66 @@
|
||||
# Common flags
|
||||
##############
|
||||
#
|
||||
# -mkl=[parallel|sequential] : Use the MKL library
|
||||
# --ninja : Allow the utilisation of ninja. It is mandatory !
|
||||
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||
#
|
||||
[COMMON]
|
||||
FC : ifort -fpic
|
||||
LAPACK_LIB : -mkl=parallel
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL
|
||||
|
||||
# Global options
|
||||
################
|
||||
#
|
||||
# 1 : Activate
|
||||
# 0 : Deactivate
|
||||
#
|
||||
[OPTION]
|
||||
MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
CACHE : 0 ; Enable cache_compile.py
|
||||
OPENMP : 1 ; Append OpenMP flags
|
||||
|
||||
# Optimization flags
|
||||
####################
|
||||
#
|
||||
# -xHost : Compile a binary optimized for the current architecture
|
||||
# -O2 : O3 not better than O2.
|
||||
# -ip : Inter-procedural optimizations
|
||||
# -ftz : Flushes denormal results to zero
|
||||
#
|
||||
[OPT]
|
||||
FC : -traceback
|
||||
FCFLAGS : -msse4.2 -O2 -ip -ftz -g
|
||||
|
||||
|
||||
# Profiling flags
|
||||
#################
|
||||
#
|
||||
[PROFILE]
|
||||
FC : -p -g
|
||||
FCFLAGS : -msse4.2 -O2 -ip -ftz
|
||||
|
||||
|
||||
# Debugging flags
|
||||
#################
|
||||
#
|
||||
# -traceback : Activate backtrace on runtime
|
||||
# -fpe0 : All floating point exaceptions
|
||||
# -C : Checks uninitialized variables, array subscripts, etc...
|
||||
# -g : Extra debugging information
|
||||
# -msse4.2 : Valgrind needs a very simple x86 executable
|
||||
#
|
||||
[DEBUG]
|
||||
FC : -g -traceback
|
||||
FCFLAGS : -msse4.2 -check all -debug all -fpe-all=0 -implicitnone
|
||||
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
#
|
||||
[OPENMP]
|
||||
FC : -qopenmp
|
||||
IRPF90_FLAGS : --openmp
|
||||
|
@ -6,7 +6,7 @@
|
||||
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||
#
|
||||
[COMMON]
|
||||
FC : ifort -fpic
|
||||
FC : ifort -fpic -diag-disable 5462
|
||||
LAPACK_LIB : -mkl=parallel
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=64 -DINTEL
|
||||
|
67
configure
vendored
67
configure
vendored
@ -9,6 +9,8 @@ echo "QP_ROOT="$QP_ROOT
|
||||
unset CC
|
||||
unset CCXX
|
||||
|
||||
TREXIO_VERSION=2.3.2
|
||||
|
||||
# Force GCC instead of ICC for dependencies
|
||||
export CC=gcc
|
||||
|
||||
@ -193,7 +195,7 @@ if [[ "${PACKAGES}.x" != ".x" ]] ; then
|
||||
fi
|
||||
|
||||
if [[ ${PACKAGES} = all ]] ; then
|
||||
PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats"
|
||||
PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats trexio qmckl"
|
||||
fi
|
||||
|
||||
|
||||
@ -207,6 +209,57 @@ for PACKAGE in ${PACKAGES} ; do
|
||||
mv ninja "\${QP_ROOT}"/bin/
|
||||
EOF
|
||||
|
||||
elif [[ ${PACKAGE} = trexio-nohdf5 ]] ; then
|
||||
|
||||
VERSION=$TREXIO_VERSION
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
|
||||
rm -rf trexio-${VERSION}
|
||||
tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz
|
||||
cd trexio-${VERSION}
|
||||
./configure --prefix=\${QP_ROOT} --without-hdf5 CFLAGS='-g'
|
||||
make -j 8 && make -j 8 check && make -j 8 install
|
||||
tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/${ARCHITECTURE}/ninja.tar.gz
|
||||
mv ninja "\${QP_ROOT}"/bin/
|
||||
EOF
|
||||
elif [[ ${PACKAGE} = trexio ]] ; then
|
||||
|
||||
VERSION=$TREXIO_VERSION
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
|
||||
rm -rf trexio-${VERSION}
|
||||
tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz
|
||||
cd trexio-${VERSION}
|
||||
./configure --prefix=\${QP_ROOT} CFLAGS="-g"
|
||||
make -j 8 && make -j 8 check && make -j 8 install
|
||||
EOF
|
||||
elif [[ ${PACKAGE} = qmckl ]] ; then
|
||||
|
||||
VERSION=0.5.4
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
wget https://github.com/TREX-CoE/qmckl/releases/download/v${VERSION}/qmckl-${VERSION}.tar.gz
|
||||
rm -rf qmckl-${VERSION}
|
||||
tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz
|
||||
cd qmckl-${VERSION}
|
||||
./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc CFLAGS='-g'
|
||||
make && make -j 4 check && make install
|
||||
EOF
|
||||
elif [[ ${PACKAGE} = qmckl-intel ]] ; then
|
||||
|
||||
VERSION=0.5.4
|
||||
execute << EOF
|
||||
cd "\${QP_ROOT}"/external
|
||||
wget https://github.com/TREX-CoE/qmckl/releases/download/v${VERSION}/qmckl-${VERSION}.tar.gz
|
||||
rm -rf qmckl-${VERSION}
|
||||
tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz
|
||||
cd qmckl-${VERSION}
|
||||
./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc --with-icc --with-ifort CFLAGS='-g'
|
||||
make && make -j 4 check && make install
|
||||
EOF
|
||||
|
||||
|
||||
elif [[ ${PACKAGE} = gmp ]] ; then
|
||||
|
||||
@ -343,6 +396,18 @@ if [[ ${ZEROMQ} = $(not_found) ]] ; then
|
||||
fail
|
||||
fi
|
||||
|
||||
TREXIO=$(find_lib -ltrexio)
|
||||
if [[ ${TREXIO} = $(not_found) ]] ; then
|
||||
error "TREXIO (trexio | trexio-nohdf5) is not installed. If you don't have HDF5, use trexio-nohdf5"
|
||||
fail
|
||||
fi
|
||||
|
||||
QMCKL=$(find_lib -lqmckl)
|
||||
if [[ ${QMCKL} = $(not_found) ]] ; then
|
||||
error "QMCkl (qmckl | qmckl-intel) is not installed."
|
||||
fail
|
||||
fi
|
||||
|
||||
F77ZMQ=$(find_lib -lzmq -lf77zmq -lpthread)
|
||||
if [[ ${F77ZMQ} = $(not_found) ]] ; then
|
||||
error "Fortran binding of ZeroMQ (f77zmq) is not installed."
|
||||
|
File diff suppressed because it is too large
Load Diff
5
data/basis/none
Normal file
5
data/basis/none
Normal file
@ -0,0 +1,5 @@
|
||||
$DATA
|
||||
|
||||
HYDROGEN
|
||||
|
||||
$END
|
920
data/pseudo/def2
Normal file
920
data/pseudo/def2
Normal file
@ -0,0 +1,920 @@
|
||||
$ECP
|
||||
RB-ECP GEN 28 3
|
||||
1 ----- f-ul potential -----
|
||||
-12.3169000 2 3.8431140
|
||||
3 ----- s-f potential -----
|
||||
89.5001980 2 5.0365510
|
||||
0.4937610 2 1.9708490
|
||||
12.3169000 2 3.8431140
|
||||
3 ----- p-f potential -----
|
||||
58.5689740 2 4.2583410
|
||||
0.4317910 2 1.4707090
|
||||
12.3169000 2 3.8431140
|
||||
3 ----- d-f potential -----
|
||||
26.2248980 2 3.0231270
|
||||
0.9628390 2 0.6503830
|
||||
12.3169000 2 3.8431140
|
||||
SR-ECP GEN 28 3
|
||||
1 ----- f-ul potential -----
|
||||
-15.8059920 2 4.6339750
|
||||
3 ----- s-f potential -----
|
||||
135.4794300 2 7.4000740
|
||||
17.5344630 2 3.6063790
|
||||
15.8059920 2 4.6339750
|
||||
3 ----- p-f potential -----
|
||||
88.3597090 2 6.4848680
|
||||
15.3943720 2 3.2880530
|
||||
15.8059920 2 4.6339750
|
||||
3 ----- d-f potential -----
|
||||
29.8889870 2 4.6228410
|
||||
6.6594140 2 2.2469040
|
||||
15.8059920 2 4.6339750
|
||||
Y-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-19.12219811 2 6.5842120
|
||||
-2.43637543 2 3.2921060
|
||||
4 ----- s-f potential -----
|
||||
135.15384412 2 7.4880494
|
||||
15.55244130 2 3.7440247
|
||||
19.12219811 2 6.5842120
|
||||
2.43637543 2 3.2921060
|
||||
4 ----- p-f potential -----
|
||||
87.78499167 2 6.4453772
|
||||
11.56406599 2 3.2226886
|
||||
19.12219811 2 6.5842120
|
||||
2.43637543 2 3.2921060
|
||||
4 ----- d-f potential -----
|
||||
29.70100072 2 4.6584472
|
||||
5.53996847 2 2.3292236
|
||||
19.12219811 2 6.5842120
|
||||
2.43637543 2 3.2921060
|
||||
ZR-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-21.09377605 2 7.5400000
|
||||
-3.08069427 2 3.7700000
|
||||
4 ----- s-f potential -----
|
||||
150.26759106 2 8.2000000
|
||||
18.97621650 2 4.0897278
|
||||
21.09377605 2 7.5400000
|
||||
3.08069427 2 3.7700000
|
||||
4 ----- p-f potential -----
|
||||
99.62212372 2 7.1100000
|
||||
14.16873329 2 3.5967980
|
||||
21.09377605 2 7.5400000
|
||||
3.08069427 2 3.7700000
|
||||
4 ----- d-f potential -----
|
||||
35.04512355 2 5.3500000
|
||||
6.11125948 2 2.4918215
|
||||
21.09377605 2 7.5400000
|
||||
3.08069427 2 3.7700000
|
||||
NB-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-22.92954996 2 8.4900000
|
||||
-3.66630986 2 4.2500000
|
||||
4 ----- s-f potential -----
|
||||
165.17914349 2 8.9000000
|
||||
21.99297437 2 4.4300000
|
||||
22.92954996 2 8.4900000
|
||||
3.66630986 2 4.2500000
|
||||
4 ----- p-f potential -----
|
||||
111.79441445 2 7.7700000
|
||||
16.63348326 2 3.9600000
|
||||
22.92954996 2 8.4900000
|
||||
3.66630986 2 4.2500000
|
||||
4 ----- d-f potential -----
|
||||
38.11224880 2 6.0500000
|
||||
8.03916727 2 2.8400000
|
||||
22.92954996 2 8.4900000
|
||||
3.66630986 2 4.2500000
|
||||
MO-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-24.80517707 2 9.4500000
|
||||
-4.15378155 2 4.7200000
|
||||
4 ----- s-f potential -----
|
||||
180.10310850 2 9.7145938
|
||||
24.99722791 2 4.6805004
|
||||
24.80517707 2 9.4500000
|
||||
4.15378155 2 4.7200000
|
||||
4 ----- p-f potential -----
|
||||
123.77275231 2 8.1421366
|
||||
19.53022800 2 4.6259863
|
||||
24.80517707 2 9.4500000
|
||||
4.15378155 2 4.7200000
|
||||
4 ----- d-f potential -----
|
||||
48.37502229 2 6.6184148
|
||||
8.89205274 2 3.2487516
|
||||
24.80517707 2 9.4500000
|
||||
4.15378155 2 4.7200000
|
||||
TC-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-26.56244747 2 10.4000000
|
||||
-4.58568054 2 5.2000000
|
||||
4 ----- s-f potential -----
|
||||
195.15916591 2 10.4223462
|
||||
28.09260333 2 5.0365160
|
||||
26.56244747 2 10.4000000
|
||||
4.58568054 2 5.2000000
|
||||
4 ----- p-f potential -----
|
||||
135.28456622 2 8.9504494
|
||||
21.80650430 2 4.8544394
|
||||
26.56244747 2 10.4000000
|
||||
4.58568054 2 5.2000000
|
||||
4 ----- d-f potential -----
|
||||
54.32972942 2 6.9456968
|
||||
11.15506795 2 3.9705849
|
||||
26.56244747 2 10.4000000
|
||||
4.58568054 2 5.2000000
|
||||
RU-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-28.34061627 2 11.3600000
|
||||
-4.94462923 2 5.6800000
|
||||
4 ----- s-f potential -----
|
||||
209.82297122 2 11.1052693
|
||||
30.65472642 2 5.4147454
|
||||
28.34061627 2 11.3600000
|
||||
4.94462923 2 5.6800000
|
||||
4 ----- p-f potential -----
|
||||
146.33618228 2 9.7712707
|
||||
24.12787723 2 5.0739908
|
||||
28.34061627 2 11.3600000
|
||||
4.94462923 2 5.6800000
|
||||
4 ----- d-f potential -----
|
||||
67.51589667 2 7.6714231
|
||||
9.87010415 2 4.1365647
|
||||
28.34061627 2 11.3600000
|
||||
4.94462923 2 5.6800000
|
||||
RH-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-30.09345572 2 12.3100000
|
||||
-5.21848192 2 6.1600000
|
||||
4 ----- s-f potential -----
|
||||
225.34775353 2 11.7200000
|
||||
32.82318898 2 5.8200000
|
||||
30.09345572 2 12.3100000
|
||||
5.21848192 2 6.1600000
|
||||
4 ----- p-f potential -----
|
||||
158.70941159 2 10.4200000
|
||||
26.44410049 2 5.4500000
|
||||
30.09345572 2 12.3100000
|
||||
5.21848192 2 6.1600000
|
||||
4 ----- d-f potential -----
|
||||
62.75862572 2 8.8200000
|
||||
10.97871947 2 3.8700000
|
||||
30.09345572 2 12.3100000
|
||||
5.21848192 2 6.1600000
|
||||
PD-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-31.92955431 2 13.2700000
|
||||
-5.39821694 2 6.6300000
|
||||
4 ----- s-f potential -----
|
||||
240.22904033 2 12.4300000
|
||||
35.17194347 2 6.1707594
|
||||
31.92955431 2 13.2700000
|
||||
5.39821694 2 6.6300000
|
||||
4 ----- p-f potential -----
|
||||
170.41727605 2 11.0800000
|
||||
28.47213287 2 5.8295541
|
||||
31.92955431 2 13.2700000
|
||||
5.39821694 2 6.6300000
|
||||
4 ----- d-f potential -----
|
||||
69.01384488 2 9.5100000
|
||||
11.75086158 2 4.1397811
|
||||
31.92955431 2 13.2700000
|
||||
5.39821694 2 6.6300000
|
||||
AG-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-33.68992012 2 14.2200000
|
||||
-5.53112021 2 7.1100000
|
||||
4 ----- s-f potential -----
|
||||
255.13936452 2 13.1300000
|
||||
36.86612154 2 6.5100000
|
||||
33.68992012 2 14.2200000
|
||||
5.53112021 2 7.1100000
|
||||
4 ----- p-f potential -----
|
||||
182.18186871 2 11.7400000
|
||||
30.35775148 2 6.2000000
|
||||
33.68992012 2 14.2200000
|
||||
5.53112021 2 7.1100000
|
||||
4 ----- d-f potential -----
|
||||
73.71926087 2 10.2100000
|
||||
12.50211712 2 4.3800000
|
||||
33.68992012 2 14.2200000
|
||||
5.53112021 2 7.1100000
|
||||
CD-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-35.47662555 2 15.1847957
|
||||
-5.61767685 2 7.5923978
|
||||
4 ----- s-f potential -----
|
||||
270.00948324 2 13.8358689
|
||||
38.76730798 2 6.8572704
|
||||
35.47662555 2 15.1847957
|
||||
5.61767685 2 7.5923978
|
||||
4 ----- p-f potential -----
|
||||
193.82962939 2 12.4049710
|
||||
31.89652523 2 6.5677995
|
||||
35.47662555 2 15.1847957
|
||||
5.61767685 2 7.5923978
|
||||
4 ----- d-f potential -----
|
||||
79.19364700 2 10.8969253
|
||||
13.23082674 2 4.6411649
|
||||
35.47662555 2 15.1847957
|
||||
5.61767685 2 7.5923978
|
||||
IN-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-13.72807800 2 12.53905600
|
||||
-18.20686600 2 12.55256100
|
||||
4 ----- s-f potential -----
|
||||
281.12235000 2 15.39282200
|
||||
61.90147000 2 8.05586400
|
||||
13.72807800 2 12.53905600
|
||||
18.20686600 2 12.55256100
|
||||
6 ----- p-f potential -----
|
||||
67.46215400 2 13.92867200
|
||||
134.94925000 2 13.34723400
|
||||
14.74614000 2 7.61413200
|
||||
29.63926200 2 7.31836500
|
||||
13.72807800 2 12.53905600
|
||||
18.20686600 2 12.55256100
|
||||
6 ----- d-f potential -----
|
||||
35.49325400 2 14.03471500
|
||||
53.17877300 2 14.51161600
|
||||
9.17728100 2 5.55055000
|
||||
12.39241000 2 5.05941500
|
||||
13.72807800 2 12.53905600
|
||||
18.20686600 2 12.55256100
|
||||
SN-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-12.57633300 2 12.28234800
|
||||
-16.59594400 2 12.27215000
|
||||
4 ----- s-f potential -----
|
||||
279.98868200 2 17.42041400
|
||||
62.37781000 2 7.63115500
|
||||
12.57633300 2 12.28234800
|
||||
16.59594400 2 12.27215000
|
||||
6 ----- p-f potential -----
|
||||
66.16252300 2 16.13102400
|
||||
132.17439600 2 15.62807700
|
||||
16.33941700 2 7.32560800
|
||||
32.48895900 2 6.94251900
|
||||
12.57633300 2 12.28234800
|
||||
16.59594400 2 12.27215000
|
||||
6 ----- d-f potential -----
|
||||
36.38744100 2 15.51497600
|
||||
54.50784100 2 15.18816000
|
||||
8.69682300 2 5.45602400
|
||||
12.84020800 2 5.36310500
|
||||
12.57633300 2 12.28234800
|
||||
16.59594400 2 12.27215000
|
||||
SB-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-15.36680100 2 14.44497800
|
||||
-20.29613800 2 14.44929500
|
||||
4 ----- s-f potential -----
|
||||
281.07158100 2 16.33086500
|
||||
61.71660400 2 8.55654200
|
||||
15.36680100 2 14.44497800
|
||||
20.29613800 2 14.44929500
|
||||
6 ----- p-f potential -----
|
||||
67.45738000 2 14.47033700
|
||||
134.93350300 2 13.81619400
|
||||
14.71634400 2 8.42492400
|
||||
29.51851200 2 8.09272800
|
||||
15.36680100 2 14.44497800
|
||||
20.29613800 2 14.44929500
|
||||
6 ----- d-f potential -----
|
||||
35.44781500 2 14.88633100
|
||||
53.14346600 2 15.14631900
|
||||
9.17922300 2 5.90826700
|
||||
13.24025300 2 5.59432200
|
||||
15.36680100 2 14.44497800
|
||||
20.29613800 2 14.44929500
|
||||
TE-ECP GEN 28 3
|
||||
2 ----- f-ul potential -----
|
||||
-15.74545000 2 15.20616800
|
||||
-20.74244800 2 15.20170200
|
||||
4 ----- s-f potential -----
|
||||
281.04584300 2 16.81447300
|
||||
61.62065600 2 8.79352600
|
||||
15.74545000 2 15.20616800
|
||||
20.74244800 2 15.20170200
|
||||
6 ----- p-f potential -----
|
||||
67.44946400 2 14.87780100
|
||||
134.90430400 2 14.26973100
|
||||
14.68954700 2 8.72443500
|
||||
29.41506300 2 8.29151500
|
||||
15.74545000 2 15.20616800
|
||||
20.74244800 2 15.20170200
|
||||
6 ----- d-f potential -----
|
||||
35.43205700 2 15.20500800
|
||||
53.13568700 2 15.22584800
|
||||
9.06980200 2 6.07176900
|
||||
13.12230400 2 5.80476000
|
||||
15.74545000 2 15.20616800
|
||||
20.74244800 2 15.20170200
|
||||
I-ECP GEN 28 3
|
||||
4 ----- f-ul potential -----
|
||||
-21.84204000 2 19.45860900
|
||||
-28.46819100 2 19.34926000
|
||||
-0.24371300 2 4.82376700
|
||||
-0.32080400 2 4.88431500
|
||||
7 ----- s-f potential -----
|
||||
49.99429300 2 40.01583500
|
||||
281.02531700 2 17.42974700
|
||||
61.57332600 2 9.00548400
|
||||
21.84204000 2 19.45860900
|
||||
28.46819100 2 19.34926000
|
||||
0.24371300 2 4.82376700
|
||||
0.32080400 2 4.88431500
|
||||
8 ----- p-f potential -----
|
||||
67.44284100 2 15.35546600
|
||||
134.88113700 2 14.97183300
|
||||
14.67505100 2 8.96016400
|
||||
29.37566600 2 8.25909600
|
||||
21.84204000 2 19.45860900
|
||||
28.46819100 2 19.34926000
|
||||
0.24371300 2 4.82376700
|
||||
0.32080400 2 4.88431500
|
||||
10 ----- d-f potential -----
|
||||
35.43952900 2 15.06890800
|
||||
53.17605700 2 14.55532200
|
||||
9.06719500 2 6.71864700
|
||||
13.20693700 2 6.45639300
|
||||
0.08933500 2 1.19177900
|
||||
0.05238000 2 1.29115700
|
||||
21.84204000 2 19.45860900
|
||||
28.46819100 2 19.34926000
|
||||
0.24371300 2 4.82376700
|
||||
0.32080400 2 4.88431500
|
||||
XE-ECP GEN 28 3
|
||||
4 ----- f-ul potential -----
|
||||
-23.08929500 2 20.88155700
|
||||
-30.07447500 2 20.78344300
|
||||
-0.28822700 2 5.25338900
|
||||
-0.38692400 2 5.36118800
|
||||
7 ----- s-f potential -----
|
||||
49.99796200 2 40.00518400
|
||||
281.01330300 2 17.81221400
|
||||
61.53825500 2 9.30415000
|
||||
23.08929500 2 20.88155700
|
||||
30.07447500 2 20.78344300
|
||||
0.28822700 2 5.25338900
|
||||
0.38692400 2 5.36118800
|
||||
8 ----- p-f potential -----
|
||||
67.43914200 2 15.70177200
|
||||
134.87471100 2 15.25860800
|
||||
14.66330000 2 9.29218400
|
||||
29.35473000 2 8.55900300
|
||||
23.08929500 2 20.88155700
|
||||
30.07447500 2 20.78344300
|
||||
0.28822700 2 5.25338900
|
||||
0.38692400 2 5.36118800
|
||||
10 ----- d-f potential -----
|
||||
35.43690800 2 15.18560000
|
||||
53.19577200 2 14.28450000
|
||||
9.04623200 2 7.12188900
|
||||
13.22368100 2 6.99196300
|
||||
0.08485300 2 0.62394600
|
||||
0.04415500 2 0.64728400
|
||||
23.08929500 2 20.88155700
|
||||
30.07447500 2 20.78344300
|
||||
0.28822700 2 5.25338900
|
||||
0.38692400 2 5.36118800
|
||||
CS-ECP GEN 46 3
|
||||
1 ----- f-ul potential -----
|
||||
-28.8843090 2 3.1232690
|
||||
3 ----- s-f potential -----
|
||||
84.5477300 2 4.0797500
|
||||
16.6541730 2 2.4174060
|
||||
28.8843090 2 3.1232690
|
||||
3 ----- p-f potential -----
|
||||
157.0490590 2 5.5140800
|
||||
26.4233070 2 2.1603160
|
||||
28.8843090 2 3.1232690
|
||||
3 ----- d-f potential -----
|
||||
13.1727530 2 1.8074100
|
||||
3.3428330 2 0.8581820
|
||||
28.8843090 2 3.1232690
|
||||
BA-ECP GEN 46 3
|
||||
1 ----- f-ul potential -----
|
||||
-33.4731740 2 3.5894650
|
||||
3 ----- s-f potential -----
|
||||
427.8458160 2 9.5269860
|
||||
204.4175300 2 4.4875100
|
||||
33.4731740 2 3.5894650
|
||||
3 ----- p-f potential -----
|
||||
293.6058640 2 8.3159300
|
||||
294.1933160 2 4.2922170
|
||||
33.4731740 2 3.5894650
|
||||
3 ----- d-f potential -----
|
||||
112.5504020 2 5.9161080
|
||||
181.7826210 2 2.8748420
|
||||
33.4731740 2 3.5894650
|
||||
LA-ECP GEN 46 3
|
||||
1 ----- f-ul potential -----
|
||||
-36.0100160 2 4.0286000
|
||||
3 ----- s-f potential -----
|
||||
91.9321770 2 3.3099000
|
||||
-3.7887640 2 1.6550000
|
||||
36.0100160 2 4.0286000
|
||||
3 ----- p-f potential -----
|
||||
63.7594860 2 2.8368000
|
||||
-0.6479580 2 1.4184000
|
||||
36.0100160 2 4.0286000
|
||||
3 ----- d-f potential -----
|
||||
36.1161730 2 2.0213000
|
||||
0.2191140 2 1.0107000
|
||||
36.0100160 2 4.0286000
|
||||
CE-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
580.08345700 2 20.13782900
|
||||
1 ----- p-h potential -----
|
||||
310.30283300 2 15.99848200
|
||||
1 ----- d-h potential -----
|
||||
167.81394400 2 14.97418700
|
||||
1 ----- f-h potential -----
|
||||
-49.39022900 2 23.40245500
|
||||
1 ----- g-h potential -----
|
||||
-21.33187900 2 16.57055300
|
||||
PR-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
577.57312200 2 20.76627800
|
||||
1 ----- p-h potential -----
|
||||
295.78584600 2 16.07844800
|
||||
1 ----- d-h potential -----
|
||||
150.86705500 2 14.70508900
|
||||
1 ----- f-h potential -----
|
||||
-48.73676600 2 23.37896900
|
||||
1 ----- g-h potential -----
|
||||
-22.32948800 2 17.44713800
|
||||
ND-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
574.37098000 2 21.35226700
|
||||
1 ----- p-h potential -----
|
||||
280.94644000 2 16.11926500
|
||||
1 ----- d-h potential -----
|
||||
138.67062700 2 14.49410300
|
||||
1 ----- f-h potential -----
|
||||
-47.52266800 2 23.18386000
|
||||
1 ----- g-h potential -----
|
||||
-23.34458700 2 18.34417400
|
||||
PM-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
575.39574900 2 21.94286500
|
||||
1 ----- p-h potential -----
|
||||
281.70451400 2 16.55516100
|
||||
1 ----- d-h potential -----
|
||||
123.52473700 2 13.96030800
|
||||
1 ----- f-h potential -----
|
||||
-50.74151100 2 24.03354600
|
||||
1 ----- g-h potential -----
|
||||
-24.37251000 2 19.26024500
|
||||
SM-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
572.98533200 2 22.34447100
|
||||
1 ----- p-h potential -----
|
||||
272.35914500 2 16.69459000
|
||||
1 ----- d-h potential -----
|
||||
115.29390000 2 13.72770500
|
||||
1 ----- f-h potential -----
|
||||
-51.10839200 2 24.05909200
|
||||
1 ----- g-h potential -----
|
||||
-25.42188500 2 20.19724900
|
||||
EU-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
607.65933100 2 23.47138400
|
||||
1 ----- p-h potential -----
|
||||
264.38547600 2 16.77247900
|
||||
1 ----- d-h potential -----
|
||||
115.38137500 2 13.98134300
|
||||
1 ----- f-h potential -----
|
||||
-49.40079400 2 23.96288800
|
||||
1 ----- g-h potential -----
|
||||
-26.74827300 2 21.23245800
|
||||
GD-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
637.20086900 2 24.60215100
|
||||
1 ----- p-h potential -----
|
||||
261.68960100 2 16.88925000
|
||||
1 ----- d-h potential -----
|
||||
106.85653300 2 13.64335800
|
||||
1 ----- f-h potential -----
|
||||
-50.68359000 2 24.12691700
|
||||
1 ----- g-h potential -----
|
||||
-27.57963000 2 22.13188700
|
||||
TB-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
668.59715500 2 24.95295600
|
||||
1 ----- p-h potential -----
|
||||
266.98047500 2 17.61089900
|
||||
1 ----- d-h potential -----
|
||||
97.50659600 2 12.97600900
|
||||
1 ----- f-h potential -----
|
||||
-52.17575700 2 24.24886900
|
||||
1 ----- g-h potential -----
|
||||
-28.69426800 2 23.13067200
|
||||
DY-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
705.67122100 2 26.42958600
|
||||
1 ----- p-h potential -----
|
||||
254.86698900 2 17.31703400
|
||||
1 ----- d-h potential -----
|
||||
95.04518700 2 12.91359900
|
||||
1 ----- f-h potential -----
|
||||
-54.57409300 2 24.90787800
|
||||
1 ----- g-h potential -----
|
||||
-29.82827700 2 24.14875300
|
||||
HO-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
755.70313600 2 28.39725700
|
||||
1 ----- p-h potential -----
|
||||
253.55199800 2 17.43863300
|
||||
1 ----- d-h potential -----
|
||||
89.63567700 2 12.43421200
|
||||
1 ----- f-h potential -----
|
||||
-55.48203600 2 25.38701000
|
||||
1 ----- g-h potential -----
|
||||
-30.99112500 2 25.18850100
|
||||
ER-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
800.95287600 2 29.79859200
|
||||
1 ----- p-h potential -----
|
||||
262.01986900 2 18.11423700
|
||||
1 ----- d-h potential -----
|
||||
80.17055200 2 11.36958700
|
||||
1 ----- f-h potential -----
|
||||
-42.33628500 2 21.82123300
|
||||
1 ----- g-h potential -----
|
||||
-32.18527800 2 26.25073500
|
||||
TM-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
845.51074300 2 31.14412200
|
||||
1 ----- p-h potential -----
|
||||
258.58523900 2 18.09235300
|
||||
1 ----- d-h potential -----
|
||||
80.72905900 2 11.46915900
|
||||
1 ----- f-h potential -----
|
||||
-48.70126600 2 23.60554400
|
||||
1 ----- g-h potential -----
|
||||
-33.39549600 2 27.32978100
|
||||
YB-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
891.01377700 2 32.42448400
|
||||
1 ----- p-h potential -----
|
||||
264.03695300 2 18.65623200
|
||||
1 ----- d-h potential -----
|
||||
73.92391900 2 10.49022200
|
||||
1 ----- f-h potential -----
|
||||
-39.59217300 2 20.77418300
|
||||
1 ----- g-h potential -----
|
||||
-34.63863800 2 28.43102800
|
||||
LU-ECP GEN 28 5
|
||||
1 ----- h-ul potential -----
|
||||
0.00000000 2 1.00000000
|
||||
1 ----- s-h potential -----
|
||||
989.99558400 2 35.16209700
|
||||
1 ----- p-h potential -----
|
||||
278.86565200 2 19.46440200
|
||||
1 ----- d-h potential -----
|
||||
71.00917800 2 10.00686500
|
||||
1 ----- f-h potential -----
|
||||
-47.40589000 2 23.51793200
|
||||
1 ----- g-h potential -----
|
||||
-35.55714600 2 29.41223800
|
||||
HF-ECP GEN 60 3
|
||||
1 ----- f-ul potential -----
|
||||
10.04672251 2 1.78576984
|
||||
3 ----- s-f potential -----
|
||||
1499.28471073 2 14.76995900
|
||||
40.28210136 2 7.38497940
|
||||
-10.04672251 2 1.78576984
|
||||
3 ----- p-f potential -----
|
||||
397.73300533 2 9.84948950
|
||||
19.31640586 2 4.92474450
|
||||
-10.04672251 2 1.78576984
|
||||
3 ----- d-f potential -----
|
||||
101.32980526 2 6.09675640
|
||||
5.87343821 2 3.04837820
|
||||
-10.04672251 2 1.78576984
|
||||
TA-ECP GEN 60 3
|
||||
1 ----- f-ul potential -----
|
||||
12.01796094 2 2.01788111
|
||||
3 ----- s-f potential -----
|
||||
1345.88064703 2 14.54640770
|
||||
36.76680620 2 7.27320380
|
||||
-12.01796094 2 2.01788111
|
||||
3 ----- p-f potential -----
|
||||
378.42530145 2 9.93556529
|
||||
22.29309086 2 4.96778243
|
||||
-12.01796094 2 2.01788111
|
||||
3 ----- d-f potential -----
|
||||
104.88395571 2 6.34737691
|
||||
8.75584805 2 3.17368846
|
||||
-12.01796094 2 2.01788111
|
||||
W-ECP GEN 60 3
|
||||
1 ----- f-ul potential -----
|
||||
14.15257947 2 2.25888846
|
||||
3 ----- s-f potential -----
|
||||
1192.39588226 2 14.32285640
|
||||
32.52293315 2 7.16142810
|
||||
-14.15257947 2 2.25888846
|
||||
3 ----- p-f potential -----
|
||||
359.03196711 2 10.02164110
|
||||
24.03038019 2 5.01082040
|
||||
-14.15257947 2 2.25888846
|
||||
3 ----- d-f potential -----
|
||||
108.30134897 2 6.59799743
|
||||
10.98252827 2 3.29899871
|
||||
-14.15257947 2 2.25888846
|
||||
RE-ECP GEN 60 3
|
||||
1 ----- f-ul potential -----
|
||||
16.44985227 2 2.50865059
|
||||
3 ----- s-f potential -----
|
||||
1038.95157226 2 14.09930510
|
||||
29.56173830 2 7.04965250
|
||||
-16.44985227 2 2.50865059
|
||||
3 ----- p-f potential -----
|
||||
339.54350965 2 10.10771690
|
||||
24.91369646 2 5.05385830
|
||||
-16.44985227 2 2.50865059
|
||||
3 ----- d-f potential -----
|
||||
111.69965275 2 6.84861794
|
||||
12.62432927 2 3.42430897
|
||||
-16.44985227 2 2.50865059
|
||||
OS-ECP GEN 60 3
|
||||
1 ----- f-ul potential -----
|
||||
18.90945701 2 2.76707510
|
||||
3 ----- s-f potential -----
|
||||
885.40571914 2 13.87575390
|
||||
25.96704014 2 6.93787690
|
||||
-18.90945701 2 2.76707510
|
||||
3 ----- p-f potential -----
|
||||
320.08390185 2 10.19379260
|
||||
26.14876493 2 5.09689620
|
||||
-18.90945701 2 2.76707510
|
||||
3 ----- d-f potential -----
|
||||
115.04484313 2 7.09923846
|
||||
13.62257457 2 3.54961923
|
||||
-18.90945701 2 2.76707510
|
||||
IR-ECP GEN 60 3
|
||||
1 ----- f-ul potential -----
|
||||
21.53103107 2 3.03407192
|
||||
3 ----- s-f potential -----
|
||||
732.26919978 2 13.65220260
|
||||
26.48472087 2 6.82610130
|
||||
-21.53103107 2 3.03407192
|
||||
3 ----- p-f potential -----
|
||||
299.48947357 2 10.27986840
|
||||
26.46623354 2 5.13993410
|
||||
-21.53103107 2 3.03407192
|
||||
3 ----- d-f potential -----
|
||||
124.45759451 2 7.34985897
|
||||
14.03599518 2 3.67492949
|
||||
-21.53103107 2 3.03407192
|
||||
PT-ECP GEN 60 3
|
||||
1 ----- f-ul potential -----
|
||||
24.31437573 2 3.30956857
|
||||
3 ----- s-f potential -----
|
||||
579.22386092 2 13.42865130
|
||||
29.66949062 2 6.71432560
|
||||
-24.31437573 2 3.30956857
|
||||
3 ----- p-f potential -----
|
||||
280.86077422 2 10.36594420
|
||||
26.74538204 2 5.18297210
|
||||
-24.31437573 2 3.30956857
|
||||
3 ----- d-f potential -----
|
||||
120.39644429 2 7.60047949
|
||||
15.81092058 2 3.80023974
|
||||
-24.31437573 2 3.30956857
|
||||
AU-ECP GEN 60 3
|
||||
2 ----- f-ul potential -----
|
||||
30.49008890 2 4.78982000
|
||||
5.17107381 2 2.39491000
|
||||
4 ----- s-f potential -----
|
||||
426.84667920 2 13.20510000
|
||||
37.00708285 2 6.60255000
|
||||
-30.49008890 2 4.78982000
|
||||
-5.17107381 2 2.39491000
|
||||
4 ----- p-f potential -----
|
||||
261.19958038 2 10.45202000
|
||||
26.96249604 2 5.22601000
|
||||
-30.49008890 2 4.78982000
|
||||
-5.17107381 2 2.39491000
|
||||
4 ----- d-f potential -----
|
||||
124.79066561 2 7.85110000
|
||||
16.30072573 2 3.92555000
|
||||
-30.49008890 2 4.78982000
|
||||
-5.17107381 2 2.39491000
|
||||
HG-ECP GEN 60 3
|
||||
1 ----- f-ul potential -----
|
||||
30.36499643 2 3.88579112
|
||||
3 ----- s-f potential -----
|
||||
275.73721174 2 12.98154870
|
||||
49.08921249 2 6.49077440
|
||||
-30.36499643 2 3.88579112
|
||||
3 ----- p-f potential -----
|
||||
241.54007398 2 10.53809580
|
||||
27.39659081 2 5.26904790
|
||||
-30.36499643 2 3.88579112
|
||||
3 ----- d-f potential -----
|
||||
127.86700761 2 8.10172051
|
||||
16.60831151 2 4.05086026
|
||||
-30.36499643 2 3.88579112
|
||||
TL-ECP GEN 60 3
|
||||
4 ----- f-ul potential -----
|
||||
15.82548800 2 5.62639900
|
||||
21.10402100 2 5.54895200
|
||||
2.91512700 2 2.87494600
|
||||
3.89690300 2 2.82145100
|
||||
6 ----- s-f potential -----
|
||||
281.28466300 2 12.16780500
|
||||
62.43425100 2 8.29490900
|
||||
-15.82548800 2 5.62639900
|
||||
-21.10402100 2 5.54895200
|
||||
-2.91512700 2 2.87494600
|
||||
-3.89690300 2 2.82145100
|
||||
8 ----- p-f potential -----
|
||||
4.63340800 2 7.15149200
|
||||
9.34175600 2 5.17286500
|
||||
72.29925300 2 9.89107200
|
||||
144.55803700 2 9.00339100
|
||||
-15.82548800 2 5.62639900
|
||||
-21.10402100 2 5.54895200
|
||||
-2.91512700 2 2.87494600
|
||||
-3.89690300 2 2.82145100
|
||||
8 ----- d-f potential -----
|
||||
35.94303900 2 7.13021800
|
||||
53.90959300 2 6.92690600
|
||||
10.38193900 2 5.41757000
|
||||
15.58382200 2 5.13868100
|
||||
-15.82548800 2 5.62639900
|
||||
-21.10402100 2 5.54895200
|
||||
-2.91512700 2 2.87494600
|
||||
-3.89690300 2 2.82145100
|
||||
PB-ECP GEN 60 3
|
||||
2 ----- f-ul potential -----
|
||||
12.20989200 2 3.88751200
|
||||
16.19029100 2 3.81196300
|
||||
4 ----- s-f potential -----
|
||||
281.28549900 2 12.29630300
|
||||
62.52021700 2 8.63263400
|
||||
-12.20989200 2 3.88751200
|
||||
-16.19029100 2 3.81196300
|
||||
6 ----- p-f potential -----
|
||||
72.27689700 2 10.24179000
|
||||
144.59108300 2 8.92417600
|
||||
4.75869300 2 6.58134200
|
||||
9.94062100 2 6.25540300
|
||||
-12.20989200 2 3.88751200
|
||||
-16.19029100 2 3.81196300
|
||||
6 ----- d-f potential -----
|
||||
35.84850700 2 7.75433600
|
||||
53.72434200 2 7.72028100
|
||||
10.11525600 2 4.97026400
|
||||
14.83373100 2 4.56378900
|
||||
-12.20989200 2 3.88751200
|
||||
-16.19029100 2 3.81196300
|
||||
BI-ECP GEN 60 3
|
||||
2 ----- f-ul potential -----
|
||||
13.71338300 2 4.21454600
|
||||
18.19430800 2 4.13340000
|
||||
4 ----- s-f potential -----
|
||||
283.26422700 2 13.04309000
|
||||
62.47195900 2 8.22168200
|
||||
-13.71338300 2 4.21454600
|
||||
-18.19430800 2 4.13340000
|
||||
6 ----- p-f potential -----
|
||||
72.00149900 2 10.46777700
|
||||
144.00227700 2 9.11890100
|
||||
5.00794500 2 6.75479100
|
||||
9.99155000 2 6.25259200
|
||||
-13.71338300 2 4.21454600
|
||||
-18.19430800 2 4.13340000
|
||||
6 ----- d-f potential -----
|
||||
36.39625900 2 8.08147400
|
||||
54.59766400 2 7.89059500
|
||||
9.98429400 2 4.95555600
|
||||
14.98148500 2 4.70455900
|
||||
-13.71338300 2 4.21454600
|
||||
-18.19430800 2 4.13340000
|
||||
PO-ECP GEN 60 3
|
||||
4 ----- f-ul potential -----
|
||||
17.42829500 2 5.01327000
|
||||
23.38035300 2 4.98464000
|
||||
0.16339200 2 1.32676000
|
||||
0.32456600 2 1.52875800
|
||||
6 ----- s-f potential -----
|
||||
283.24470600 2 13.27722700
|
||||
62.39646100 2 8.39951800
|
||||
-17.42829500 2 5.01327000
|
||||
-23.38035300 2 4.98464000
|
||||
-0.16339200 2 1.32676000
|
||||
-0.32456600 2 1.52875800
|
||||
8 ----- p-f potential -----
|
||||
71.99171600 2 10.66568200
|
||||
143.97187100 2 9.28375300
|
||||
4.94961500 2 6.87274900
|
||||
9.74049900 2 6.32615000
|
||||
-17.42829500 2 5.01327000
|
||||
-23.38035300 2 4.98464000
|
||||
-0.16339200 2 1.32676000
|
||||
-0.32456600 2 1.52875800
|
||||
8 ----- d-f potential -----
|
||||
36.37838300 2 8.21486600
|
||||
54.56271500 2 8.00869600
|
||||
9.88949900 2 5.05522700
|
||||
14.69387700 2 4.78255300
|
||||
-17.42829500 2 5.01327000
|
||||
-23.38035300 2 4.98464000
|
||||
-0.16339200 2 1.32676000
|
||||
-0.32456600 2 1.52875800
|
||||
AT-ECP GEN 60 3
|
||||
4 ----- f-ul potential -----
|
||||
19.87019800 2 5.81216300
|
||||
26.41645200 2 5.75371500
|
||||
0.99497000 2 2.51347200
|
||||
1.49070100 2 2.53626100
|
||||
7 ----- s-f potential -----
|
||||
49.95715800 2 30.20083200
|
||||
283.21037100 2 13.61230600
|
||||
62.28105200 2 8.52934000
|
||||
-19.87019800 2 5.81216300
|
||||
-26.41645200 2 5.75371500
|
||||
-0.99497000 2 2.51347200
|
||||
-1.49070100 2 2.53626100
|
||||
8 ----- p-f potential -----
|
||||
71.98237100 2 10.85406500
|
||||
143.90353200 2 9.46822900
|
||||
4.87175900 2 7.03111400
|
||||
8.98305900 2 6.14385800
|
||||
-19.87019800 2 5.81216300
|
||||
-26.41645200 2 5.75371500
|
||||
-0.99497000 2 2.51347200
|
||||
-1.49070100 2 2.53626100
|
||||
8 ----- d-f potential -----
|
||||
36.36323700 2 8.31351500
|
||||
54.54897000 2 7.99896500
|
||||
9.77628500 2 5.17996600
|
||||
14.26475500 2 4.94222600
|
||||
-19.87019800 2 5.81216300
|
||||
-26.41645200 2 5.75371500
|
||||
-0.99497000 2 2.51347200
|
||||
-1.49070100 2 2.53626100
|
||||
RN-ECP GEN 60 3
|
||||
4 ----- f-ul potential -----
|
||||
21.79729000 2 6.34857100
|
||||
28.94680500 2 6.29594900
|
||||
1.44736500 2 2.88211800
|
||||
2.17796400 2 2.90804800
|
||||
7 ----- s-f potential -----
|
||||
49.96555100 2 30.15124200
|
||||
283.07000000 2 14.52124100
|
||||
62.00287000 2 8.05203800
|
||||
-21.79729000 2 6.34857100
|
||||
-28.94680500 2 6.29594900
|
||||
-1.44736500 2 2.88211800
|
||||
-2.17796400 2 2.90804800
|
||||
8 ----- p-f potential -----
|
||||
71.96911900 2 11.00994200
|
||||
143.86055900 2 9.61762500
|
||||
4.71476100 2 7.33600800
|
||||
9.01306500 2 6.40625300
|
||||
-21.79729000 2 6.34857100
|
||||
-28.94680500 2 6.29594900
|
||||
-1.44736500 2 2.88211800
|
||||
-2.17796400 2 2.90804800
|
||||
8 ----- d-f potential -----
|
||||
36.36836500 2 8.36922000
|
||||
54.55176100 2 8.11697500
|
||||
9.63448700 2 5.35365600
|
||||
14.38790200 2 5.09721200
|
||||
-21.79729000 2 6.34857100
|
||||
-28.94680500 2 6.29594900
|
||||
-1.44736500 2 2.88211800
|
||||
-2.17796400 2 2.90804800
|
||||
$END
|
23
etc/qp.rc
23
etc/qp.rc
@ -110,6 +110,11 @@ function qp()
|
||||
unset COMMAND
|
||||
;;
|
||||
|
||||
"test")
|
||||
shift
|
||||
qp_test $@
|
||||
;;
|
||||
|
||||
*)
|
||||
which "qp_$1" &> /dev/null
|
||||
if [[ $? -eq 0 ]] ; then
|
||||
@ -183,7 +188,18 @@ _qp_Complete()
|
||||
;;
|
||||
esac;;
|
||||
set_file)
|
||||
COMPREPLY=( $(compgen -W "$(for i in * ; do [[ -f ${i}/ezfio/.version ]] && echo $i ; done)" -- ${cur} ) )
|
||||
# Array to store directory names
|
||||
dirs=""
|
||||
|
||||
# Find directories containing "ezfio/.version" file recursively
|
||||
for i in $(find . -name ezfio | sed 's/ezfio$/.version/')
|
||||
do
|
||||
dir_name=${i%/.version} # Remove the ".version" suffix
|
||||
dir_name=${dir_name#./} # Remove the leading "./"
|
||||
dirs+="./$dir_name "
|
||||
done
|
||||
|
||||
COMPREPLY=( $(compgen -W "$dirs" -- ${cur} ) )
|
||||
return 0
|
||||
;;
|
||||
plugins)
|
||||
@ -215,10 +231,15 @@ _qp_Complete()
|
||||
return 0
|
||||
;;
|
||||
esac;;
|
||||
test)
|
||||
COMPREPLY=( $(compgen -W "-v -a " -- $cur ) )
|
||||
return 0
|
||||
;;
|
||||
*)
|
||||
COMPREPLY=( $(compgen -W 'plugins set_file \
|
||||
unset_file man \
|
||||
create_ezfio \
|
||||
test \
|
||||
convert_output_to_ezfio \
|
||||
-h update' -- $cur ) )
|
||||
|
||||
|
2
external/ezfio
vendored
2
external/ezfio
vendored
@ -1 +1 @@
|
||||
Subproject commit d5805497fa0ef30e70e055cde1ecec2963303e93
|
||||
Subproject commit dba01c4fe0ff7b84c5ecfb1c7c77ec68781311b3
|
2
external/irpf90
vendored
2
external/irpf90
vendored
@ -1 +1 @@
|
||||
Subproject commit 0007f72f677fe7d61c5e1ed461882cb239517102
|
||||
Subproject commit 4ab1b175fc7ed0d96c1912f13dc53579b24157a6
|
@ -44,8 +44,12 @@ end = struct
|
||||
let get_default = Qpackage.get_ezfio_default "ao_basis";;
|
||||
|
||||
let read_ao_basis () =
|
||||
let result =
|
||||
Ezfio.get_ao_basis_ao_basis ()
|
||||
|> AO_basis_name.of_string
|
||||
in
|
||||
if result <> "None" then
|
||||
AO_basis_name.of_string result
|
||||
else failwith "No basis"
|
||||
;;
|
||||
|
||||
let read_ao_num () =
|
||||
@ -247,8 +251,7 @@ end = struct
|
||||
|
||||
|
||||
let read () =
|
||||
if (Ezfio.has_ao_basis_ao_basis ()) then
|
||||
begin
|
||||
try
|
||||
let result =
|
||||
{ ao_basis = read_ao_basis ();
|
||||
ao_num = read_ao_num () ;
|
||||
@ -267,9 +270,11 @@ end = struct
|
||||
|> MD5.to_string
|
||||
|> Ezfio.set_ao_basis_ao_md5 ;
|
||||
Some result
|
||||
end
|
||||
else
|
||||
None
|
||||
with
|
||||
| _ -> ( "None"
|
||||
|> Digest.string
|
||||
|> Digest.to_hex
|
||||
|> Ezfio.set_ao_basis_ao_md5 ; None)
|
||||
;;
|
||||
|
||||
|
||||
|
@ -56,7 +56,10 @@ end = struct
|
||||
let read_ao_md5 () =
|
||||
let ao_md5 =
|
||||
match (Input_ao_basis.Ao_basis.read ()) with
|
||||
| None -> failwith "Unable to read AO basis"
|
||||
| None -> ("None"
|
||||
|> Digest.string
|
||||
|> Digest.to_hex
|
||||
|> MD5.of_string)
|
||||
| Some result -> Input_ao_basis.Ao_basis.to_md5 result
|
||||
in
|
||||
let result =
|
||||
|
@ -478,6 +478,7 @@ let run ?o b au c d m p cart xyz_file =
|
||||
let nmax =
|
||||
Nucl_number.get_max ()
|
||||
in
|
||||
|
||||
let rec do_work (accu:(Atom.t*Nucl_number.t) list) (n:int) = function
|
||||
| [] -> accu
|
||||
| e::tail ->
|
||||
@ -520,6 +521,8 @@ let run ?o b au c d m p cart xyz_file =
|
||||
in
|
||||
let long_basis = Long_basis.of_basis basis in
|
||||
let ao_num = List.length long_basis in
|
||||
if ao_num > 0 then
|
||||
begin
|
||||
Ezfio.set_ao_basis_ao_num ao_num;
|
||||
Ezfio.set_ao_basis_ao_basis b;
|
||||
Ezfio.set_basis_basis b;
|
||||
@ -655,6 +658,7 @@ let run ?o b au c d m p cart xyz_file =
|
||||
match Input.Ao_basis.read () with
|
||||
| None -> failwith "Error in basis"
|
||||
| Some x -> Input.Ao_basis.write x
|
||||
end
|
||||
in
|
||||
let () =
|
||||
try write_file () with
|
||||
@ -781,7 +785,7 @@ If a file with the same name as the basis set exists, this file will be read. O
|
||||
run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
|
||||
)
|
||||
with
|
||||
| Failure txt -> Printf.eprintf "Fatal error: %s\n%!" txt
|
||||
(* | Failure txt -> Printf.eprintf "Fatal error: %s\n%!" txt *)
|
||||
| Command_line.Error txt -> Printf.eprintf "Command line error: %s\n%!" txt
|
||||
|
||||
|
||||
|
@ -38,7 +38,8 @@ let run slave ?prefix exe ezfio_file =
|
||||
| Unix.Unix_error _ -> try_new_port (port_number+100)
|
||||
in
|
||||
let result =
|
||||
try_new_port 41279
|
||||
let port = 10*(Unix.getpid () mod 2823) + 32_769 in
|
||||
try_new_port port
|
||||
in
|
||||
Zmq.Socket.close dummy_socket;
|
||||
Zmq.Context.terminate zmq_context;
|
||||
|
@ -1,4 +1,4 @@
|
||||
#!/usr/bin/python
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import zmq
|
||||
import sys, os
|
||||
|
@ -1,4 +1,4 @@
|
||||
#!/usr/bin/python
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import zmq
|
||||
import sys, os
|
||||
|
44
scripts/Hn.py
Normal file
44
scripts/Hn.py
Normal file
@ -0,0 +1,44 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import sys
|
||||
from math import *
|
||||
arg = sys.argv
|
||||
#f = open('data_dft','r')
|
||||
n = int(sys.argv[1])
|
||||
r = float(sys.argv[2])
|
||||
f = open('H'+str(n)+'_'+str(r)+'.xyz','w')
|
||||
string=str(n)+"\n"
|
||||
f.write(string)
|
||||
string="\n"
|
||||
f.write(string)
|
||||
for i in range(n):
|
||||
x = r * cos(2.* i* pi/n)
|
||||
y = r * sin(2.* i* pi/n)
|
||||
z = 0.
|
||||
string="H "+str(x)+" "+str(y)+" "+str(z)+"\n"
|
||||
f.write(string)
|
||||
|
||||
#lines = f.readlines()
|
||||
#cipsi_dft= []
|
||||
#
|
||||
#dissoc = []
|
||||
#dissoc.append(float(-76.0179223470363))
|
||||
#dissoc.append(float(-76.0592367866993))
|
||||
#dissoc.append(float(-76.0678739715659))
|
||||
#delta_e = []
|
||||
#
|
||||
#for line in lines:
|
||||
# data = line.split()
|
||||
# if(len(data)>0):
|
||||
# dft=float(data[1])
|
||||
# fci=float(data[2])
|
||||
# e=fci+dft
|
||||
# cipsi_dft.append(e)
|
||||
#
|
||||
#print(*cipsi_dft,sep=" & ")
|
||||
#
|
||||
#for i in 0,1,2:
|
||||
# delta_e.append(1000.*(dissoc[i] - cipsi_dft[i]))
|
||||
#
|
||||
#print(*delta_e,sep=" & ")
|
||||
#
|
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/env python3
|
||||
"""
|
||||
Save the .o from a .f90
|
||||
and is the .o is asked a second time, retur it
|
||||
and is the .o is asked a second time, return it
|
||||
Take in argv command like:
|
||||
ifort -g -openmp -I IRPF90_temp/Ezfio_files/ -c IRPF90_temp/Integrals_Monoelec/kin_ao_ints.irp.module.F90 -o IRPF90_temp/Integrals_Monoelec/kin_ao_ints.irp.module.o
|
||||
"""
|
||||
|
@ -25,7 +25,7 @@ except ImportError:
|
||||
"quantum_package.rc"))
|
||||
|
||||
print("\n".join(["", "Error:", "source %s" % f, ""]))
|
||||
sys.exit(1)
|
||||
raise
|
||||
|
||||
# Compress path
|
||||
def comp_path(path):
|
||||
@ -40,8 +40,6 @@ from qp_path import QP_ROOT, QP_SRC, QP_EZFIO
|
||||
|
||||
LIB = " -lz"
|
||||
EZFIO_LIB = join("$QP_ROOT", "lib", "libezfio_irp.a")
|
||||
ZMQ_LIB = "-lf77zmq -lzmq"
|
||||
#ZMQ_LIB = join("$QP_ROOT", "lib", "libf77zmq.a") + " " + join("$QP_ROOT", "lib", "libzmq.a") + " -lstdc++ -lrt -ldl"
|
||||
ROOT_BUILD_NINJA = join("$QP_ROOT", "config", "build.ninja")
|
||||
ROOT_BUILD_NINJA_EXP = join(QP_ROOT, "config", "build.ninja")
|
||||
ROOT_BUILD_NINJA_EXP_tmp = join(QP_ROOT, "config", "build.ninja.tmp")
|
||||
@ -119,7 +117,7 @@ def ninja_create_env_variable(pwd_config_file):
|
||||
lib_lapack = get_compilation_option(pwd_config_file, "LAPACK_LIB")
|
||||
lib_usr = get_compilation_option(pwd_config_file, "LIB")
|
||||
|
||||
str_lib = " ".join([lib_lapack, EZFIO_LIB, ZMQ_LIB, LIB, lib_usr])
|
||||
str_lib = " ".join([lib_lapack, EZFIO_LIB, LIB, lib_usr])
|
||||
|
||||
# Read all LIB files in modules
|
||||
for directory in [real_join(QP_SRC, m) for m in sorted(os.listdir(QP_SRC))]:
|
||||
|
@ -829,4 +829,8 @@ if __name__ == "__main__":
|
||||
# _|
|
||||
|
||||
for (m, dict_ezfio_cfg) in l_dict_ezfio_cfg:
|
||||
if dict_ezfio_cfg == {}:
|
||||
print("Error: Empty EZFIO.cfg in ", arguments["--path_module"])
|
||||
sys.exit(-1)
|
||||
code_generation(arguments, dict_ezfio_cfg, m)
|
||||
|
||||
|
@ -172,11 +172,8 @@ let run check_only ?ndet ?state ezfio_filename =
|
||||
|
||||
(* Reorder basis set *)
|
||||
begin
|
||||
let aos =
|
||||
match Input.Ao_basis.read() with
|
||||
| Some x -> x
|
||||
| _ -> assert false
|
||||
in
|
||||
| Some aos ->
|
||||
let ordering = Input.Ao_basis.ordering aos in
|
||||
let test = Array.copy ordering in
|
||||
Array.sort compare test ;
|
||||
@ -191,6 +188,7 @@ let run check_only ?ndet ?state ezfio_filename =
|
||||
let new_mos = Input.Mo_basis.reorder mos ordering in
|
||||
Input.Mo_basis.write new_mos
|
||||
end
|
||||
| _ -> ()
|
||||
end;
|
||||
|
||||
begin
|
||||
|
2
scripts/get_fci_tc_conv.sh
Executable file
2
scripts/get_fci_tc_conv.sh
Executable file
@ -0,0 +1,2 @@
|
||||
file=$1
|
||||
grep "Ndet,E,E+PT2,E+RPT2,|PT2|=" $file | cut -d "=" -f 2 > ${file}.conv_fci_tc
|
69
scripts/import_champ_jastrow.py
Executable file
69
scripts/import_champ_jastrow.py
Executable file
@ -0,0 +1,69 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
conv = [ 0, 0, 2 , 6 , 13 , 23 , 37 , 55 , 78 , 106 , 140 ]
|
||||
|
||||
|
||||
def import_jastrow(jastrow_filename):
|
||||
with open(jastrow_filename,'r') as jastrow_file:
|
||||
lines = [ line.strip() for line in jastrow_file.readlines() ]
|
||||
lines = [ line for line in lines if line != "" ]
|
||||
start = 0
|
||||
end = len(lines)
|
||||
for i,line in enumerate(lines):
|
||||
if line.startswith("jastrow_parameter"):
|
||||
start = i
|
||||
elif line.startswith("end"):
|
||||
end = i
|
||||
lines = lines[start:end]
|
||||
type_num = (len(lines)-4)//2
|
||||
nord_a,nord_b,nord_c = [ int(i) for i in lines[1].split()[:3] ]
|
||||
scale_k = float(lines[2].split()[0])
|
||||
vec_a = []
|
||||
for j in range(type_num):
|
||||
vec_a += [ float(i) for i in lines[3+j].split()[:nord_a+1] ]
|
||||
vec_b = [ float(i) for i in lines[3+type_num].split()[:nord_b+1] ]
|
||||
vec_c = []
|
||||
for j in range(type_num):
|
||||
vec_c += [ float(i) for i in lines[4+type_num+j].split()[:conv[nord_c]] ]
|
||||
|
||||
return {
|
||||
'type_num' : type_num,
|
||||
'scale_k' : scale_k,
|
||||
'nord_a' : nord_a,
|
||||
'nord_b' : nord_b,
|
||||
'nord_c' : nord_c,
|
||||
'vec_a' : vec_a,
|
||||
'vec_b' : vec_b,
|
||||
'vec_c' : vec_c,
|
||||
}
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
import sys
|
||||
from ezfio import ezfio
|
||||
ezfio.set_file(sys.argv[1])
|
||||
jastrow_file = sys.argv[2]
|
||||
jastrow = import_jastrow(jastrow_file)
|
||||
print (jastrow)
|
||||
ezfio.set_jastrow_jast_type("Qmckl")
|
||||
ezfio.set_jastrow_jast_qmckl_type_nucl_num(jastrow['type_num'])
|
||||
charges = ezfio.get_nuclei_nucl_charge()
|
||||
types = {}
|
||||
k = 1
|
||||
for c in charges:
|
||||
if c not in types:
|
||||
types[c] = k
|
||||
k += 1
|
||||
type_nucl_vector = [types[c] for c in charges]
|
||||
print(type_nucl_vector)
|
||||
ezfio.set_jastrow_jast_qmckl_type_nucl_vector(type_nucl_vector)
|
||||
ezfio.set_jastrow_jast_qmckl_rescale_ee(jastrow['scale_k'])
|
||||
ezfio.set_jastrow_jast_qmckl_rescale_en([jastrow['scale_k'] for i in type_nucl_vector])
|
||||
ezfio.set_jastrow_jast_qmckl_aord_num(jastrow['nord_a'])
|
||||
ezfio.set_jastrow_jast_qmckl_bord_num(jastrow['nord_b'])
|
||||
ezfio.set_jastrow_jast_qmckl_cord_num(jastrow['nord_c'])
|
||||
ezfio.set_jastrow_jast_qmckl_c_vector_size(len(jastrow['vec_c']))
|
||||
ezfio.set_jastrow_jast_qmckl_a_vector(jastrow['vec_a'])
|
||||
ezfio.set_jastrow_jast_qmckl_b_vector(jastrow['vec_b'])
|
||||
ezfio.set_jastrow_jast_qmckl_c_vector(jastrow['vec_c'])
|
||||
|
@ -115,9 +115,7 @@ def get_l_module_descendant(d_child, l_module):
|
||||
except KeyError:
|
||||
print("Error: ", file=sys.stderr)
|
||||
print("`{0}` is not a submodule".format(module), file=sys.stderr)
|
||||
print("Check the typo (spelling, case, '/', etc.) ", file=sys.stderr)
|
||||
# pass
|
||||
sys.exit(1)
|
||||
raise
|
||||
|
||||
return list(set(l))
|
||||
|
||||
|
189
scripts/qp_exc_energy.py
Executable file
189
scripts/qp_exc_energy.py
Executable file
@ -0,0 +1,189 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
# Computes the error on the excitation energy of a CIPSI run.
|
||||
|
||||
def student(p,df):
|
||||
import scipy
|
||||
from scipy.stats import t
|
||||
return t.ppf(p, df)
|
||||
|
||||
|
||||
def chi2cdf(x,k):
|
||||
import scipy
|
||||
import scipy.stats
|
||||
return scipy.stats.chi2.cdf(x,k)
|
||||
|
||||
|
||||
def jarque_bera(data):
|
||||
|
||||
n = max(len(data), 2)
|
||||
norm = 1./ sum( [ w for (_,w) in data ] )
|
||||
|
||||
mu = sum( [ w* x for (x,w) in data ] ) * norm
|
||||
sigma2 = sum( [ w*(x-mu)**2 for (x,w) in data ] ) * norm
|
||||
if sigma2 > 0.:
|
||||
S = ( sum( [ w*(x-mu)**3 for (x,w) in data ] ) * norm ) / sigma2**(3./2.)
|
||||
K = ( sum( [ w*(x-mu)**4 for (x,w) in data ] ) * norm ) / sigma2**2
|
||||
else:
|
||||
S = 0.
|
||||
K = 0.
|
||||
|
||||
# Value of the Jarque-Bera test
|
||||
JB = n/6. * (S**2 + 1./4. * (K-3.)**2)
|
||||
|
||||
# Probability that the data comes from a Gaussian distribution
|
||||
p = 1. - chi2cdf(JB,2)
|
||||
|
||||
return JB, mu, sqrt(sigma2/(n-1)), p
|
||||
|
||||
|
||||
|
||||
to_eV = 27.2107362681
|
||||
import sys, os
|
||||
import scipy
|
||||
import scipy.stats
|
||||
from math import sqrt, gamma, exp
|
||||
import qp_json
|
||||
|
||||
|
||||
def read_data(ezfio_filename,state):
|
||||
""" Read energies and PT2 from input file """
|
||||
data = qp_json.load_last(ezfio_filename)
|
||||
for method in data.keys():
|
||||
x = data[method]
|
||||
lines = x
|
||||
|
||||
print(f"State: {state}")
|
||||
|
||||
gs = []
|
||||
es = []
|
||||
|
||||
for l in lines:
|
||||
try:
|
||||
pt2_0 = l['states'][0]['pt2']
|
||||
e_0 = l['states'][0]['energy']
|
||||
pt2_1 = l['states'][state]['pt2']
|
||||
e_1 = l['states'][state]['energy']
|
||||
gs.append( (e_0, pt2_0) )
|
||||
es.append( (e_1, pt2_1) )
|
||||
except: pass
|
||||
|
||||
def f(p_1, p0, p1):
|
||||
e, pt2 = p0
|
||||
y0, x0 = p_1
|
||||
y1, x1 = p1
|
||||
try:
|
||||
alpha = (y1-y0)/(x0-x1)
|
||||
except ZeroDivisionError:
|
||||
alpha = 1.
|
||||
return [e, pt2, alpha]
|
||||
|
||||
for l in (gs, es):
|
||||
p_1, p0, p1 = l[0], l[0], l[1]
|
||||
l[0] = f(p_1, p0, p1)
|
||||
|
||||
for i in range(1,len(l)-1):
|
||||
p_1 = (l[i-1][0], l[i-1][1])
|
||||
p0 = l[i]
|
||||
p1 = l[i+1]
|
||||
l[i] = f(p_1, p0, p1)
|
||||
|
||||
i = len(l)-1
|
||||
p_1 = (l[i-1][0], l[i-1][1])
|
||||
p0 = l[i]
|
||||
p1 = l[-1]
|
||||
l[i] = f(p_1, p0, p1)
|
||||
|
||||
return [ x+y for x,y in zip(gs,es) ]
|
||||
|
||||
|
||||
def compute(data):
|
||||
|
||||
d = []
|
||||
for e0, p0, a0, e1, p1, a1 in data:
|
||||
x = (e1+p1)-(e0+p0)
|
||||
w = 1./sqrt(p0**2 + p1**2)
|
||||
bias = (a1-1.)*p1 - (a0-1.)*p0
|
||||
d.append( (x,w,bias) )
|
||||
|
||||
x = []
|
||||
target = (scipy.stats.norm.cdf(1.)-0.5)*2 # = 0.6827
|
||||
|
||||
print("| %2s | %8s | %8s | %8s | %8s | %8s |"%( "N", "DE", "+/-", "bias", "P(G)", "J"))
|
||||
print("|----+----------+----------+----------+----------+----------|")
|
||||
xmax = (0.,0.,0.,0.,0.,0,0.)
|
||||
for i in range(len(data)-1):
|
||||
jb, mu, sigma, p = jarque_bera( [ (x,w) for (x,w,bias) in d[i:] ] )
|
||||
bias = sum ( [ w * e for (_,w,e) in d[i:] ] ) / sum ( [ w for (_,w,_) in d[i:] ] )
|
||||
mu = (mu+0.5*bias) * to_eV
|
||||
sigma = sigma * to_eV
|
||||
bias = bias * to_eV
|
||||
n = len(data[i:])
|
||||
beta = student(0.5*(1.+target/p) ,n)
|
||||
err = sigma * beta + 0.5*abs(bias)
|
||||
print("| %2d | %8.3f | %8.3f | %8.3f | %8.3f | %8.3f |"%( n, mu, err, bias, p, jb))
|
||||
if n < 3 :
|
||||
continue
|
||||
y = (err, p, mu, err, jb,n,bias)
|
||||
if p > xmax[1]: xmax = y
|
||||
if p < 0.8:
|
||||
continue
|
||||
x.append(y)
|
||||
|
||||
x = sorted(x)
|
||||
|
||||
print("|----+----------+----------+----------+----------+----------|")
|
||||
if x != []:
|
||||
xmax = x[0]
|
||||
_, p, mu, err, jb, n, bias = xmax
|
||||
beta = student(0.5*(1.+target/p),n)
|
||||
print("| %2d | %8.3f | %8.3f | %8.3f | %8.3f | %8.3f |\n"%(n, mu, err, bias, p, jb))
|
||||
|
||||
return mu, err, bias, p
|
||||
|
||||
ezfio_filename = sys.argv[1]
|
||||
print(ezfio_filename)
|
||||
if len(sys.argv) > 2:
|
||||
state = int(sys.argv[2])
|
||||
else:
|
||||
state = 1
|
||||
data = read_data(ezfio_filename,state)
|
||||
mu, err, bias, _ = compute(data)
|
||||
print(" %s: %8.3f +/- %5.3f eV\n"%(ezfio_filename, mu, err))
|
||||
|
||||
import numpy as np
|
||||
A = np.array( [ [ data[-1][1], 1. ],
|
||||
[ data[-2][1], 1. ] ] )
|
||||
B = np.array( [ [ data[-1][0] ],
|
||||
[ data[-2][0] ] ] )
|
||||
E0 = np.linalg.solve(A,B)[1]
|
||||
A = np.array( [ [ data[-1][4], 1. ],
|
||||
[ data[-2][4], 1. ] ] )
|
||||
B = np.array( [ [ data[-1][3] ],
|
||||
[ data[-2][3] ] ] )
|
||||
E1 = np.linalg.solve(A,B)[1]
|
||||
average_2 = (E1-E0)*to_eV
|
||||
|
||||
A = np.array( [ [ data[-1][1], 1. ],
|
||||
[ data[-2][1], 1. ],
|
||||
[ data[-3][1], 1. ] ] )
|
||||
B = np.array( [ [ data[-1][0] ],
|
||||
[ data[-2][0] ],
|
||||
[ data[-3][0] ] ] )
|
||||
E0 = np.linalg.lstsq(A,B,rcond=None)[0][1]
|
||||
A = np.array( [ [ data[-1][4], 1. ],
|
||||
[ data[-2][4], 1. ],
|
||||
[ data[-3][4], 1. ] ] )
|
||||
B = np.array( [ [ data[-1][3] ],
|
||||
[ data[-2][3] ],
|
||||
[ data[-3][3] ] ] )
|
||||
E1 = np.linalg.lstsq(A,B,rcond=None)[0][1]
|
||||
average_3 = (E1-E0)*to_eV
|
||||
|
||||
exc = ((data[-1][3] + data[-1][4]) - (data[-1][0] + data[-1][1])) * to_eV
|
||||
error_2 = abs(average_2 - average_3)
|
||||
error_3 = abs(average_3 - exc)
|
||||
print(" 2-3 points: %.3f +/- %.3f "% (average_3, error_2))
|
||||
print(" largest wf: %.3f +/- %.3f "%(average_3, error_3))
|
||||
|
||||
|
@ -1,55 +1,37 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import re
|
||||
import qp_json
|
||||
import sys
|
||||
|
||||
# Read output file
|
||||
with open(sys.argv[1], 'r') as file:
|
||||
output = file.read()
|
||||
if len(sys.argv) == 1:
|
||||
print(f"syntax: {sys.argv[0]} EZFIO_FILE")
|
||||
|
||||
d = qp_json.load_all(sys.argv[1])
|
||||
|
||||
k = [ x for x in d.keys() ]
|
||||
k.sort()
|
||||
|
||||
print("# Energy PT2 PT2_err rPT2 rPT2_err exFCI\n")
|
||||
for f in k:
|
||||
try:
|
||||
j = d[f]["fci"]
|
||||
except:
|
||||
continue
|
||||
|
||||
print(f"# {f}")
|
||||
for e in j:
|
||||
|
||||
out = f" {e['n_det']:8d}"
|
||||
|
||||
nstates = len(e["states"])
|
||||
for ee in e["states"]:
|
||||
try:
|
||||
exc_energy = ee['ex_energy'][0]
|
||||
except:
|
||||
exc_energy = 0.
|
||||
out += f" {ee['energy']:16.8f} {ee['pt2']:e} {ee['pt2_err']:e} {ee['rpt2']:e} {ee['rpt2_err']:e} {exc_energy:16.8f}"
|
||||
print(out)
|
||||
|
||||
print("\n")
|
||||
|
||||
|
||||
def extract_data(output):
|
||||
lines = output.split("\n")
|
||||
data = []
|
||||
|
||||
n_det = None
|
||||
e = None
|
||||
pt2 = None
|
||||
err_pt2 = None
|
||||
rpt2 = None
|
||||
err_rpt2 = None
|
||||
e_ex = None
|
||||
|
||||
|
||||
reading = False
|
||||
for iline, line in enumerate(lines):
|
||||
if line.startswith("Summary at N_det"):
|
||||
reading = False
|
||||
|
||||
if not reading and line.startswith(" N_det "):
|
||||
n_det = int(re.search(r"N_det\s+=\s+(\d+)", line).group(1))
|
||||
reading = True
|
||||
|
||||
if reading:
|
||||
if line.startswith(" E "):
|
||||
e = float(re.search(r"E\s+=\s+(-?\d+\.\d+)", line).group(1))
|
||||
elif line.startswith(" PT2 "):
|
||||
pt2 = float(re.search(r"PT2\s+=\s+(-?\d+\.\d+E?.\d*)", line).group(1))
|
||||
err_pt2 = float(re.search(r"\+/-\s+(-?\d+\.\d+E?.\d*)", line).group(1))
|
||||
elif line.startswith(" rPT2 "):
|
||||
rpt2 = float(re.search(r"rPT2\s+=\s+(-?\d+\.\d+E?.\d*)", line).group(1))
|
||||
err_rpt2 = float(re.search(r"\+/-\s+(-?\d+\.\d+E?.\d*)", line).group(1))
|
||||
elif "minimum PT2 Extrapolated energy" in line:
|
||||
e_ex_line = lines[iline+2]
|
||||
e_ex = float(e_ex_line.split()[1])
|
||||
reading = False
|
||||
new_data = " {:8d} {:16.8f} {:e} {:e} {:e} {:e} {:16.8f}".format(n_det, e, pt2, err_pt2, rpt2, err_rpt2, e_ex)
|
||||
data.append(new_data)
|
||||
n_det = e = pt2 = err_pt2 = rpt2 = err_rpt2 = e_ex = None
|
||||
|
||||
return data
|
||||
|
||||
data = extract_data(output)
|
||||
|
||||
for item in data:
|
||||
print(item)
|
||||
|
524
scripts/qp_import_trexio.py
Executable file
524
scripts/qp_import_trexio.py
Executable file
@ -0,0 +1,524 @@
|
||||
#!/usr/bin/env python3
|
||||
"""
|
||||
convert TREXIO file to EZFIO
|
||||
|
||||
Usage:
|
||||
qp_import_trexio [-o EZFIO_DIR] FILE
|
||||
|
||||
Options:
|
||||
-o --output=EZFIO_DIR Produced directory
|
||||
by default is FILE.ezfio
|
||||
|
||||
"""
|
||||
|
||||
import sys
|
||||
import os
|
||||
import numpy as np
|
||||
from functools import reduce
|
||||
from ezfio import ezfio
|
||||
from docopt import docopt
|
||||
import qp_bitmasks
|
||||
|
||||
try:
|
||||
import trexio
|
||||
except ImportError:
|
||||
print("Error: trexio python module is not found. Try python3 -m pip install trexio")
|
||||
sys.exit(1)
|
||||
|
||||
|
||||
try:
|
||||
QP_ROOT = os.environ["QP_ROOT"]
|
||||
QP_EZFIO = os.environ["QP_EZFIO"]
|
||||
except KeyError:
|
||||
print("Error: QP_ROOT environment variable not found.")
|
||||
sys.exit(1)
|
||||
else:
|
||||
sys.path = [QP_EZFIO + "/Python",
|
||||
QP_ROOT + "/install/resultsFile",
|
||||
QP_ROOT + "/install",
|
||||
QP_ROOT + "/scripts"] + sys.path
|
||||
|
||||
def uint64_to_int64(u):
|
||||
# Check if the most significant bit is set
|
||||
if u & (1 << 63):
|
||||
# Calculate the two's complement
|
||||
result = -int(np.bitwise_not(np.uint64(u))+1)
|
||||
else:
|
||||
# The number is already positive
|
||||
result = u
|
||||
return result
|
||||
|
||||
def generate_xyz(l):
|
||||
|
||||
def create_z(x,y,z):
|
||||
return (x, y, l-(x+y))
|
||||
|
||||
def create_y(accu,x,y,z):
|
||||
if y == 0:
|
||||
result = [create_z(x,y,z)] + accu
|
||||
else:
|
||||
result = create_y([create_z(x,y,z)] + accu , x, y-1, z)
|
||||
return result
|
||||
|
||||
def create_x(accu,x,y,z):
|
||||
if x == 0:
|
||||
result = create_y([], x,y,z) + accu
|
||||
else:
|
||||
xnew = x-1
|
||||
ynew = l-xnew
|
||||
result = create_x(create_y([],x,y,z) + accu , xnew, ynew, z)
|
||||
return result
|
||||
|
||||
result = create_x([], l, 0, 0)
|
||||
result.reverse()
|
||||
return result
|
||||
|
||||
|
||||
|
||||
def write_ezfio(trexio_filename, filename):
|
||||
|
||||
try:
|
||||
trexio_file = trexio.File(trexio_filename,mode='r',back_end=trexio.TREXIO_TEXT)
|
||||
except:
|
||||
trexio_file = trexio.File(trexio_filename,mode='r',back_end=trexio.TREXIO_HDF5)
|
||||
|
||||
ezfio.set_file(filename)
|
||||
ezfio.set_trexio_trexio_file(trexio_filename)
|
||||
|
||||
print("Nuclei\t\t...\t", end=' ')
|
||||
|
||||
charge = [0.]
|
||||
if trexio.has_nucleus(trexio_file):
|
||||
charge = trexio.read_nucleus_charge(trexio_file)
|
||||
ezfio.set_nuclei_nucl_num(len(charge))
|
||||
ezfio.set_nuclei_nucl_charge(charge)
|
||||
|
||||
coord = trexio.read_nucleus_coord(trexio_file)
|
||||
coord = np.transpose(coord)
|
||||
ezfio.set_nuclei_nucl_coord(coord)
|
||||
|
||||
label = trexio.read_nucleus_label(trexio_file)
|
||||
nucl_num = trexio.read_nucleus_num(trexio_file)
|
||||
|
||||
# Transformt H1 into H
|
||||
import re
|
||||
p = re.compile(r'(\d*)$')
|
||||
label = [p.sub("", x).capitalize() for x in label]
|
||||
ezfio.set_nuclei_nucl_label(label)
|
||||
print("OK")
|
||||
|
||||
else:
|
||||
ezfio.set_nuclei_nucl_num(1)
|
||||
ezfio.set_nuclei_nucl_charge([0.])
|
||||
ezfio.set_nuclei_nucl_coord([0.,0.,0.])
|
||||
ezfio.set_nuclei_nucl_label(["X"])
|
||||
print("None")
|
||||
|
||||
|
||||
|
||||
print("Electrons\t...\t", end=' ')
|
||||
|
||||
try:
|
||||
num_beta = trexio.read_electron_dn_num(trexio_file)
|
||||
except:
|
||||
num_beta = int(sum(charge))//2
|
||||
|
||||
try:
|
||||
num_alpha = trexio.read_electron_up_num(trexio_file)
|
||||
except:
|
||||
num_alpha = int(sum(charge)) - num_beta
|
||||
|
||||
if num_alpha == 0:
|
||||
print("\n\nError: There are zero electrons in the TREXIO file.\n\n")
|
||||
sys.exit(1)
|
||||
ezfio.set_electrons_elec_alpha_num(num_alpha)
|
||||
ezfio.set_electrons_elec_beta_num(num_beta)
|
||||
|
||||
print(f"{num_alpha} {num_beta}")
|
||||
|
||||
print("Basis\t\t...\t", end=' ')
|
||||
|
||||
shell_num = 0
|
||||
try:
|
||||
basis_type = trexio.read_basis_type(trexio_file)
|
||||
|
||||
if basis_type.lower() in ["gaussian", "slater"]:
|
||||
shell_num = trexio.read_basis_shell_num(trexio_file)
|
||||
prim_num = trexio.read_basis_prim_num(trexio_file)
|
||||
ang_mom = trexio.read_basis_shell_ang_mom(trexio_file)
|
||||
nucl_index = trexio.read_basis_nucleus_index(trexio_file)
|
||||
exponent = trexio.read_basis_exponent(trexio_file)
|
||||
coefficient = trexio.read_basis_coefficient(trexio_file)
|
||||
shell_index = trexio.read_basis_shell_index(trexio_file)
|
||||
ao_shell = trexio.read_ao_shell(trexio_file)
|
||||
|
||||
ezfio.set_basis_basis("Read from TREXIO")
|
||||
ezfio.set_ao_basis_ao_basis("Read from TREXIO")
|
||||
ezfio.set_basis_shell_num(shell_num)
|
||||
ezfio.set_basis_prim_num(prim_num)
|
||||
ezfio.set_basis_shell_ang_mom(ang_mom)
|
||||
ezfio.set_basis_basis_nucleus_index([ x+1 for x in nucl_index ])
|
||||
ezfio.set_basis_prim_expo(exponent)
|
||||
ezfio.set_basis_prim_coef(coefficient)
|
||||
|
||||
nucl_shell_num = []
|
||||
prev = None
|
||||
m = 0
|
||||
for i in ao_shell:
|
||||
if i != prev:
|
||||
m += 1
|
||||
if prev is None or nucl_index[i] != nucl_index[prev]:
|
||||
nucl_shell_num.append(m)
|
||||
m = 0
|
||||
prev = i
|
||||
assert (len(nucl_shell_num) == nucl_num)
|
||||
|
||||
shell_prim_num = []
|
||||
prev = shell_index[0]
|
||||
count = 0
|
||||
for i in shell_index:
|
||||
if i != prev:
|
||||
shell_prim_num.append(count)
|
||||
count = 0
|
||||
count += 1
|
||||
prev = i
|
||||
shell_prim_num.append(count)
|
||||
|
||||
assert (len(shell_prim_num) == shell_num)
|
||||
|
||||
ezfio.set_basis_shell_prim_num(shell_prim_num)
|
||||
ezfio.set_basis_shell_index([x+1 for x in shell_index])
|
||||
ezfio.set_basis_nucleus_shell_num(nucl_shell_num)
|
||||
|
||||
|
||||
shell_factor = trexio.read_basis_shell_factor(trexio_file)
|
||||
prim_factor = trexio.read_basis_prim_factor(trexio_file)
|
||||
|
||||
elif basis_type.lower() == "numerical":
|
||||
|
||||
shell_num = trexio.read_basis_shell_num(trexio_file)
|
||||
prim_num = shell_num
|
||||
ang_mom = trexio.read_basis_shell_ang_mom(trexio_file)
|
||||
nucl_index = trexio.read_basis_nucleus_index(trexio_file)
|
||||
exponent = [1.]*prim_num
|
||||
coefficient = [1.]*prim_num
|
||||
shell_index = [i for i in range(shell_num)]
|
||||
ao_shell = trexio.read_ao_shell(trexio_file)
|
||||
|
||||
ezfio.set_basis_basis("None")
|
||||
ezfio.set_ao_basis_ao_basis("None")
|
||||
ezfio.set_basis_shell_num(shell_num)
|
||||
ezfio.set_basis_prim_num(prim_num)
|
||||
ezfio.set_basis_shell_ang_mom(ang_mom)
|
||||
ezfio.set_basis_basis_nucleus_index([ x+1 for x in nucl_index ])
|
||||
ezfio.set_basis_prim_expo(exponent)
|
||||
ezfio.set_basis_prim_coef(coefficient)
|
||||
|
||||
nucl_shell_num = []
|
||||
prev = None
|
||||
m = 0
|
||||
for i in ao_shell:
|
||||
if i != prev:
|
||||
m += 1
|
||||
if prev is None or nucl_index[i] != nucl_index[prev]:
|
||||
nucl_shell_num.append(m)
|
||||
m = 0
|
||||
prev = i
|
||||
assert (len(nucl_shell_num) == nucl_num)
|
||||
|
||||
shell_prim_num = []
|
||||
prev = shell_index[0]
|
||||
count = 0
|
||||
for i in shell_index:
|
||||
if i != prev:
|
||||
shell_prim_num.append(count)
|
||||
count = 0
|
||||
count += 1
|
||||
prev = i
|
||||
shell_prim_num.append(count)
|
||||
|
||||
assert (len(shell_prim_num) == shell_num)
|
||||
|
||||
ezfio.set_basis_shell_prim_num(shell_prim_num)
|
||||
ezfio.set_basis_shell_index([x+1 for x in shell_index])
|
||||
ezfio.set_basis_nucleus_shell_num(nucl_shell_num)
|
||||
|
||||
shell_factor = trexio.read_basis_shell_factor(trexio_file)
|
||||
prim_factor = [1.]*prim_num
|
||||
else:
|
||||
raise TypeError
|
||||
|
||||
print(basis_type)
|
||||
except:
|
||||
print("None")
|
||||
ezfio.set_ao_basis_ao_cartesian(True)
|
||||
|
||||
print("AOS\t\t...\t", end=' ')
|
||||
|
||||
try:
|
||||
cartesian = trexio.read_ao_cartesian(trexio_file)
|
||||
except:
|
||||
cartesian = True
|
||||
|
||||
if not cartesian:
|
||||
raise TypeError('Only cartesian TREXIO files can be converted')
|
||||
|
||||
ao_num = trexio.read_ao_num(trexio_file)
|
||||
ezfio.set_ao_basis_ao_num(ao_num)
|
||||
|
||||
if shell_num > 0:
|
||||
ao_shell = trexio.read_ao_shell(trexio_file)
|
||||
at = [ nucl_index[i]+1 for i in ao_shell ]
|
||||
ezfio.set_ao_basis_ao_nucl(at)
|
||||
|
||||
num_prim0 = [ 0 for i in range(shell_num) ]
|
||||
for i in shell_index:
|
||||
num_prim0[i] += 1
|
||||
|
||||
coef = {}
|
||||
expo = {}
|
||||
for i,c in enumerate(coefficient):
|
||||
idx = shell_index[i]
|
||||
if idx in coef:
|
||||
coef[idx].append(c)
|
||||
expo[idx].append(exponent[i])
|
||||
else:
|
||||
coef[idx] = [c]
|
||||
expo[idx] = [exponent[i]]
|
||||
|
||||
coefficient = []
|
||||
exponent = []
|
||||
power_x = []
|
||||
power_y = []
|
||||
power_z = []
|
||||
num_prim = []
|
||||
|
||||
for i in range(shell_num):
|
||||
for x,y,z in generate_xyz(ang_mom[i]):
|
||||
power_x.append(x)
|
||||
power_y.append(y)
|
||||
power_z.append(z)
|
||||
coefficient.append(coef[i])
|
||||
exponent.append(expo[i])
|
||||
num_prim.append(num_prim0[i])
|
||||
|
||||
assert (len(coefficient) == ao_num)
|
||||
ezfio.set_ao_basis_ao_power(power_x + power_y + power_z)
|
||||
ezfio.set_ao_basis_ao_prim_num(num_prim)
|
||||
|
||||
prim_num_max = max( [ len(x) for x in coefficient ] )
|
||||
|
||||
for i in range(ao_num):
|
||||
coefficient[i] += [0. for j in range(len(coefficient[i]), prim_num_max)]
|
||||
exponent [i] += [0. for j in range(len(exponent[i]), prim_num_max)]
|
||||
|
||||
coefficient = reduce(lambda x, y: x + y, coefficient, [])
|
||||
exponent = reduce(lambda x, y: x + y, exponent , [])
|
||||
|
||||
coef = []
|
||||
expo = []
|
||||
for i in range(prim_num_max):
|
||||
for j in range(i, len(coefficient), prim_num_max):
|
||||
coef.append(coefficient[j])
|
||||
expo.append(exponent[j])
|
||||
|
||||
# ezfio.set_ao_basis_ao_prim_num_max(prim_num_max)
|
||||
ezfio.set_ao_basis_ao_coef(coef)
|
||||
ezfio.set_ao_basis_ao_expo(expo)
|
||||
|
||||
print("OK")
|
||||
|
||||
else:
|
||||
print("None")
|
||||
|
||||
|
||||
# _
|
||||
# |\/| _ _ |_) _. _ o _
|
||||
# | | (_) _> |_) (_| _> | _>
|
||||
#
|
||||
|
||||
print("MOS\t\t...\t", end=' ')
|
||||
|
||||
labels = { "Canonical" : "Canonical",
|
||||
"RHF" : "Canonical",
|
||||
"BOYS" : "Localized",
|
||||
"ROHF" : "Canonical",
|
||||
"UHF" : "Canonical",
|
||||
"Natural": "Natural" }
|
||||
try:
|
||||
label = labels[trexio.read_mo_type(trexio_file)]
|
||||
except:
|
||||
label = "None"
|
||||
ezfio.set_mo_basis_mo_label(label)
|
||||
ezfio.set_determinants_mo_label(label)
|
||||
|
||||
try:
|
||||
clss = trexio.read_mo_class(trexio_file)
|
||||
core = [ i for i in clss if i.lower() == "core" ]
|
||||
inactive = [ i for i in clss if i.lower() == "inactive" ]
|
||||
active = [ i for i in clss if i.lower() == "active" ]
|
||||
virtual = [ i for i in clss if i.lower() == "virtual" ]
|
||||
deleted = [ i for i in clss if i.lower() == "deleted" ]
|
||||
except trexio.Error:
|
||||
pass
|
||||
|
||||
try:
|
||||
mo_num = trexio.read_mo_num(trexio_file)
|
||||
ezfio.set_mo_basis_mo_num(mo_num)
|
||||
|
||||
MoMatrix = trexio.read_mo_coefficient(trexio_file)
|
||||
ezfio.set_mo_basis_mo_coef(MoMatrix)
|
||||
|
||||
mo_occ = [ 0. for i in range(mo_num) ]
|
||||
for i in range(num_alpha):
|
||||
mo_occ[i] += 1.
|
||||
for i in range(num_beta):
|
||||
mo_occ[i] += 1.
|
||||
ezfio.set_mo_basis_mo_occ(mo_occ)
|
||||
print("OK")
|
||||
except:
|
||||
print("None")
|
||||
|
||||
|
||||
|
||||
print("Pseudos\t\t...\t", end=' ')
|
||||
|
||||
ezfio.set_pseudo_do_pseudo(False)
|
||||
|
||||
if trexio.has_ecp_ang_mom(trexio_file):
|
||||
ezfio.set_pseudo_do_pseudo(True)
|
||||
max_ang_mom_plus_1 = trexio.read_ecp_max_ang_mom_plus_1(trexio_file)
|
||||
z_core = trexio.read_ecp_z_core(trexio_file)
|
||||
ang_mom = trexio.read_ecp_ang_mom(trexio_file)
|
||||
nucleus_index = trexio.read_ecp_nucleus_index(trexio_file)
|
||||
exponent = trexio.read_ecp_exponent(trexio_file)
|
||||
coefficient = trexio.read_ecp_coefficient(trexio_file)
|
||||
power = trexio.read_ecp_power(trexio_file)
|
||||
|
||||
lmax = max( max_ang_mom_plus_1 ) - 1
|
||||
ezfio.set_pseudo_pseudo_lmax(lmax)
|
||||
ezfio.set_pseudo_nucl_charge_remove(z_core)
|
||||
|
||||
prev_center = None
|
||||
ecp = {}
|
||||
for i in range(len(ang_mom)):
|
||||
center = nucleus_index[i]
|
||||
if center != prev_center:
|
||||
ecp[center] = { "lmax": max_ang_mom_plus_1[center],
|
||||
"zcore": z_core[center],
|
||||
"contr": {} }
|
||||
for j in range(max_ang_mom_plus_1[center]+1):
|
||||
ecp[center]["contr"][j] = []
|
||||
|
||||
ecp[center]["contr"][ang_mom[i]].append( (coefficient[i], power[i], exponent[i]) )
|
||||
prev_center = center
|
||||
|
||||
ecp_loc = {}
|
||||
ecp_nl = {}
|
||||
kmax = 0
|
||||
klocmax = 0
|
||||
for center in ecp:
|
||||
ecp_nl [center] = {}
|
||||
for k in ecp[center]["contr"]:
|
||||
if k == ecp[center]["lmax"]:
|
||||
ecp_loc[center] = ecp[center]["contr"][k]
|
||||
klocmax = max(len(ecp_loc[center]), klocmax)
|
||||
else:
|
||||
ecp_nl [center][k] = ecp[center]["contr"][k]
|
||||
kmax = max(len(ecp_nl [center][k]), kmax)
|
||||
|
||||
ezfio.set_pseudo_pseudo_klocmax(klocmax)
|
||||
ezfio.set_pseudo_pseudo_kmax(kmax)
|
||||
|
||||
pseudo_n_k = [[0 for _ in range(nucl_num)] for _ in range(klocmax)]
|
||||
pseudo_v_k = [[0. for _ in range(nucl_num)] for _ in range(klocmax)]
|
||||
pseudo_dz_k = [[0. for _ in range(nucl_num)] for _ in range(klocmax)]
|
||||
pseudo_n_kl = [[[0 for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
|
||||
pseudo_v_kl = [[[0. for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
|
||||
pseudo_dz_kl = [[[0. for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
|
||||
for center in ecp_loc:
|
||||
for k in range( len(ecp_loc[center]) ):
|
||||
v, n, dz = ecp_loc[center][k]
|
||||
pseudo_n_k[k][center] = n
|
||||
pseudo_v_k[k][center] = v
|
||||
pseudo_dz_k[k][center] = dz
|
||||
|
||||
ezfio.set_pseudo_pseudo_n_k(pseudo_n_k)
|
||||
ezfio.set_pseudo_pseudo_v_k(pseudo_v_k)
|
||||
ezfio.set_pseudo_pseudo_dz_k(pseudo_dz_k)
|
||||
|
||||
for center in ecp_nl:
|
||||
for l in range( len(ecp_nl[center]) ):
|
||||
for k in range( len(ecp_nl[center][l]) ):
|
||||
v, n, dz = ecp_nl[center][l][k]
|
||||
pseudo_n_kl[l][k][center] = n
|
||||
pseudo_v_kl[l][k][center] = v
|
||||
pseudo_dz_kl[l][k][center] = dz
|
||||
|
||||
ezfio.set_pseudo_pseudo_n_kl(pseudo_n_kl)
|
||||
ezfio.set_pseudo_pseudo_v_kl(pseudo_v_kl)
|
||||
ezfio.set_pseudo_pseudo_dz_kl(pseudo_dz_kl)
|
||||
print("OK")
|
||||
|
||||
else:
|
||||
print("None")
|
||||
|
||||
print("Determinant\t...\t", end=' ')
|
||||
alpha = [ i for i in range(num_alpha) ]
|
||||
beta = [ i for i in range(num_beta) ]
|
||||
if trexio.has_mo_spin(trexio_file):
|
||||
spin = trexio.read_mo_spin(trexio_file)
|
||||
if max(spin) == 1:
|
||||
alpha = [ i for i in range(len(spin)) if spin[i] == 0 ]
|
||||
alpha = [ alpha[i] for i in range(num_alpha) ]
|
||||
beta = [ i for i in range(len(spin)) if spin[i] == 1 ]
|
||||
beta = [ beta[i] for i in range(num_beta) ]
|
||||
print("Warning -- UHF orbitals --", end=' ')
|
||||
alpha_s = ['0']*mo_num
|
||||
beta_s = ['0']*mo_num
|
||||
for i in alpha:
|
||||
alpha_s[i] = '1'
|
||||
for i in beta:
|
||||
beta_s[i] = '1'
|
||||
alpha_s = ''.join(alpha_s)[::-1]
|
||||
beta_s = ''.join(beta_s)[::-1]
|
||||
def conv(i):
|
||||
try:
|
||||
result = np.int64(i)
|
||||
except:
|
||||
result = np.int64(i-2**63-1)
|
||||
return result
|
||||
|
||||
alpha = [ uint64_to_int64(int(i,2)) for i in qp_bitmasks.string_to_bitmask(alpha_s) ][::-1]
|
||||
beta = [ uint64_to_int64(int(i,2)) for i in qp_bitmasks.string_to_bitmask(beta_s ) ][::-1]
|
||||
ezfio.set_determinants_bit_kind(8)
|
||||
ezfio.set_determinants_n_int(1+mo_num//64)
|
||||
ezfio.set_determinants_n_det(1)
|
||||
ezfio.set_determinants_n_states(1)
|
||||
ezfio.set_determinants_psi_det(alpha+beta)
|
||||
ezfio.set_determinants_psi_coef([[1.0]])
|
||||
print("OK")
|
||||
|
||||
|
||||
|
||||
|
||||
def get_full_path(file_path):
|
||||
file_path = os.path.expanduser(file_path)
|
||||
file_path = os.path.expandvars(file_path)
|
||||
return file_path
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
ARGUMENTS = docopt(__doc__)
|
||||
|
||||
FILE = get_full_path(ARGUMENTS['FILE'])
|
||||
trexio_filename = FILE
|
||||
|
||||
if ARGUMENTS["--output"]:
|
||||
EZFIO_FILE = get_full_path(ARGUMENTS["--output"])
|
||||
else:
|
||||
EZFIO_FILE = "{0}.ezfio".format(FILE)
|
||||
|
||||
write_ezfio(trexio_filename, EZFIO_FILE)
|
||||
sys.stdout.flush()
|
||||
|
@ -22,7 +22,7 @@ def int_to_string(s):
|
||||
assert s>=0
|
||||
AssertionError
|
||||
"""
|
||||
assert type(s) in (int, long)
|
||||
assert type(s) == int
|
||||
assert s>=0
|
||||
return '{s:0b}'.format(s=s)
|
||||
|
||||
@ -62,7 +62,7 @@ def int_to_bitmask(s,bit_kind_size=BIT_KIND_SIZE):
|
||||
['1111111111111111111111111111111111111111111111111111111111110110']
|
||||
>>>
|
||||
"""
|
||||
assert type(s) in (int, long)
|
||||
assert type(s) == int
|
||||
if s < 0:
|
||||
s = s + (1 << bit_kind_size)
|
||||
return ['{s:0{width}b}'.format(s=s,width=bit_kind_size)]
|
||||
@ -104,7 +104,7 @@ class BitMask(object):
|
||||
return self._data_int[i]
|
||||
|
||||
def __setitem__(self,i,value):
|
||||
if type(value) in (int,long):
|
||||
if type(value) == int :
|
||||
self._data_int[i] = value
|
||||
elif type(value) == str:
|
||||
s = string_to_bitmask(value,bit_kind_size=self.bit_kind_size)[0]
|
||||
|
67
scripts/utility/qp_json.py
Normal file
67
scripts/utility/qp_json.py
Normal file
@ -0,0 +1,67 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import os
|
||||
import json
|
||||
|
||||
def fix_json(s):
|
||||
"""Properly termitates an incomplete JSON file"""
|
||||
|
||||
s = s.replace(' ','')
|
||||
s = s.replace('\n','')
|
||||
s = s.replace('\t','')
|
||||
s = s.replace(",{}",'')
|
||||
tmp = [ c for c in s if c in "[]{}" ]
|
||||
tmp = "".join(tmp)
|
||||
tmp_old = ""
|
||||
while tmp != tmp_old:
|
||||
tmp_old = tmp
|
||||
tmp = tmp.replace("{}","")
|
||||
tmp = tmp.replace("[]","")
|
||||
while s[-1] in [ ',', '\n', ' ', '\t' ]:
|
||||
s = s[:-1]
|
||||
tmp = [ c for c in tmp ]
|
||||
tmp.reverse()
|
||||
for c in tmp:
|
||||
if c == '[': s += "]"
|
||||
elif c == '{': s += "}"
|
||||
return s
|
||||
|
||||
|
||||
def load(filename):
|
||||
"""Loads a JSON file after calling the fix_json function."""
|
||||
with open(filename,'r') as f:
|
||||
data = f.read()
|
||||
new_data = fix_json(data)
|
||||
return json.loads(new_data)
|
||||
|
||||
|
||||
def load_all(ezfio_filename):
|
||||
"""Loads all JSON files of an EZFIO."""
|
||||
d = {}
|
||||
prefix = ezfio_filename+'/json/'
|
||||
for filename in [ x for x in os.listdir(prefix) if x.endswith(".json")]:
|
||||
d[filename] = load(prefix+filename)
|
||||
return d
|
||||
|
||||
|
||||
def load_last(ezfio_filename):
|
||||
"""Loads last JSON file of an EZFIO."""
|
||||
d = {}
|
||||
prefix = ezfio_filename+'/json/'
|
||||
l = [ x for x in os.listdir(prefix) if x.endswith(".json")]
|
||||
l.sort()
|
||||
filename = l[-1]
|
||||
print(filename)
|
||||
return load(prefix+filename)
|
||||
|
||||
|
||||
def fix(ezfio_filename):
|
||||
"""Fixes all JSON files in an EZFIO."""
|
||||
d = load_all(ezfio_filename)
|
||||
prefix = ezfio_filename+'/json/'
|
||||
for filename in d.keys():
|
||||
with open(prefix+filename, 'w') as json_file:
|
||||
json.dump(d[filename], json_file)
|
||||
|
||||
|
||||
|
@ -67,3 +67,15 @@ doc: Use normalized primitive functions
|
||||
interface: ezfio, provider
|
||||
default: true
|
||||
|
||||
[ao_expoim_cosgtos]
|
||||
type: double precision
|
||||
doc: imag part for Exponents for each primitive of each cosGTOs |AO|
|
||||
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
|
||||
interface: ezfio, provider
|
||||
|
||||
[use_cosgtos]
|
||||
type: logical
|
||||
doc: If true, use cosgtos for AO integrals
|
||||
interface: ezfio
|
||||
default: False
|
||||
|
||||
|
@ -12,21 +12,21 @@ double precision function ao_value(i,r)
|
||||
integer :: power_ao(3)
|
||||
double precision :: accu,dx,dy,dz,r2
|
||||
num_ao = ao_nucl(i)
|
||||
! power_ao(1:3)= ao_power(i,1:3)
|
||||
! center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||
! dx = (r(1) - center_ao(1))
|
||||
! dy = (r(2) - center_ao(2))
|
||||
! dz = (r(3) - center_ao(3))
|
||||
! r2 = dx*dx + dy*dy + dz*dz
|
||||
! dx = dx**power_ao(1)
|
||||
! dy = dy**power_ao(2)
|
||||
! dz = dz**power_ao(3)
|
||||
power_ao(1:3)= ao_power(i,1:3)
|
||||
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||
dx = (r(1) - center_ao(1))
|
||||
dy = (r(2) - center_ao(2))
|
||||
dz = (r(3) - center_ao(3))
|
||||
r2 = dx*dx + dy*dy + dz*dz
|
||||
dx = dx**power_ao(1)
|
||||
dy = dy**power_ao(2)
|
||||
dz = dz**power_ao(3)
|
||||
|
||||
accu = 0.d0
|
||||
! do m=1,ao_prim_num(i)
|
||||
! beta = ao_expo_ordered_transp(m,i)
|
||||
! accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
|
||||
! enddo
|
||||
do m=1,ao_prim_num(i)
|
||||
beta = ao_expo_ordered_transp(m,i)
|
||||
accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
|
||||
enddo
|
||||
ao_value = accu * dx * dy * dz
|
||||
|
||||
end
|
||||
@ -65,46 +65,60 @@ double precision function primitive_value(i,j,r)
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine give_all_aos_at_r(r, tmp_array)
|
||||
|
||||
subroutine give_all_aos_at_r(r,aos_array)
|
||||
implicit none
|
||||
BEGIN_dOC
|
||||
! input : r == r(1) = x and so on
|
||||
!
|
||||
! output : aos_array(i) = aos(i) evaluated in $\textbf{r}$
|
||||
!
|
||||
! input : r == r(1) = x and so on
|
||||
!
|
||||
! output : tmp_array(i) = aos(i) evaluated in $\textbf{r}$
|
||||
!
|
||||
END_DOC
|
||||
double precision, intent(in) :: r(3)
|
||||
double precision, intent(out):: aos_array(ao_num)
|
||||
|
||||
integer :: power_ao(3)
|
||||
integer :: i,j,k,l,m
|
||||
double precision :: dx,dy,dz,r2
|
||||
double precision :: dx2,dy2,dz2
|
||||
double precision :: center_ao(3)
|
||||
implicit none
|
||||
double precision, intent(in) :: r(3)
|
||||
double precision, intent(out) :: tmp_array(ao_num)
|
||||
integer :: p_ao(3)
|
||||
integer :: i, j, k, l, m
|
||||
double precision :: dx, dy, dz, r2
|
||||
double precision :: dx2, dy2, dz2
|
||||
double precision :: c_ao(3)
|
||||
double precision :: beta
|
||||
|
||||
do i = 1, nucl_num
|
||||
center_ao(1:3) = nucl_coord(i,1:3)
|
||||
dx = (r(1) - center_ao(1))
|
||||
dy = (r(2) - center_ao(2))
|
||||
dz = (r(3) - center_ao(3))
|
||||
|
||||
c_ao(1:3) = nucl_coord(i,1:3)
|
||||
dx = r(1) - c_ao(1)
|
||||
dy = r(2) - c_ao(2)
|
||||
dz = r(3) - c_ao(3)
|
||||
r2 = dx*dx + dy*dy + dz*dz
|
||||
do j = 1,Nucl_N_Aos(i)
|
||||
|
||||
do j = 1, Nucl_N_Aos(i)
|
||||
|
||||
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
|
||||
aos_array(k) = 0.d0
|
||||
power_ao(1:3)= ao_power_ordered_transp_per_nucl(1:3,j,i)
|
||||
dx2 = dx**power_ao(1)
|
||||
dy2 = dy**power_ao(2)
|
||||
dz2 = dz**power_ao(3)
|
||||
p_ao(1:3) = ao_power_ordered_transp_per_nucl(1:3,j,i)
|
||||
dx2 = dx**p_ao(1)
|
||||
dy2 = dy**p_ao(2)
|
||||
dz2 = dz**p_ao(3)
|
||||
|
||||
tmp_array(k) = 0.d0
|
||||
do l = 1,ao_prim_num(k)
|
||||
beta = ao_expo_ordered_transp_per_nucl(l,j,i)
|
||||
if(dabs(beta*r2).gt.40.d0)cycle
|
||||
aos_array(k)+= ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
|
||||
if(dabs(beta*r2).gt.40.d0) cycle
|
||||
|
||||
tmp_array(k) += ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
|
||||
enddo
|
||||
aos_array(k) = aos_array(k) * dx2 * dy2 * dz2
|
||||
|
||||
tmp_array(k) = tmp_array(k) * dx2 * dy2 * dz2
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine give_all_aos_and_grad_at_r(r,aos_array,aos_grad_array)
|
||||
implicit none
|
||||
|
@ -1,20 +1,28 @@
|
||||
BEGIN_PROVIDER [ integer, Nucl_Aos_transposed, (N_AOs_max,nucl_num)]
|
||||
implicit none
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ integer, Nucl_Aos_transposed, (N_AOs_max,nucl_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! List of AOs attached on each atom
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i
|
||||
integer, allocatable :: nucl_tmp(:)
|
||||
|
||||
allocate(nucl_tmp(nucl_num))
|
||||
nucl_tmp = 0
|
||||
Nucl_Aos = 0
|
||||
do i = 1, ao_num
|
||||
nucl_tmp(ao_nucl(i))+=1
|
||||
nucl_tmp(ao_nucl(i)) += 1
|
||||
Nucl_Aos_transposed(nucl_tmp(ao_nucl(i)),ao_nucl(i)) = i
|
||||
enddo
|
||||
deallocate(nucl_tmp)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, ao_expo_ordered_transp_per_nucl, (ao_prim_num_max,N_AOs_max,nucl_num) ]
|
||||
implicit none
|
||||
integer :: i,j,k,l
|
||||
|
34
src/ao_basis/cosgtos.irp.f
Normal file
34
src/ao_basis/cosgtos.irp.f
Normal file
@ -0,0 +1,34 @@
|
||||
BEGIN_PROVIDER [ logical, use_cosgtos ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! If true, use cosgtos for AO integrals
|
||||
END_DOC
|
||||
|
||||
logical :: has
|
||||
PROVIDE ezfio_filename
|
||||
use_cosgtos = .False.
|
||||
if (mpi_master) then
|
||||
call ezfio_has_ao_basis_use_cosgtos(has)
|
||||
if (has) then
|
||||
! write(6,'(A)') '.. >>>>> [ IO READ: use_cosgtos ] <<<<< ..'
|
||||
call ezfio_get_ao_basis_use_cosgtos(use_cosgtos)
|
||||
else
|
||||
call ezfio_set_ao_basis_use_cosgtos(use_cosgtos)
|
||||
endif
|
||||
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( use_cosgtos, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
stop 'Unable to read use_cosgtos with MPI'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
! call write_time(6)
|
||||
|
||||
END_PROVIDER
|
@ -3,3 +3,4 @@ ao_two_e_ints
|
||||
becke_numerical_grid
|
||||
mo_one_e_ints
|
||||
dft_utils_in_r
|
||||
tc_keywords
|
||||
|
@ -212,9 +212,7 @@ subroutine NAI_pol_x_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
|
||||
! Computes the following integral :
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr x * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr y * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr z * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
@ -279,9 +277,7 @@ subroutine NAI_pol_x_mult_erf_ao_v0(i_ao, j_ao, mu_in, C_center, LD_C, ints, LD_
|
||||
! Computes the following integral :
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr x * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr y * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr z * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
@ -1111,3 +1107,295 @@ end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine NAI_pol_x2_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center, ints)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: beta, B_center(3), mu_in, C_center(3)
|
||||
double precision, intent(out) :: ints(3)
|
||||
|
||||
integer :: i, j, power_Ai(3), power_Aj(3), n_pt_in, m
|
||||
integer :: power_A1(3), power_A2(3)
|
||||
double precision :: Ai_center(3), Aj_center(3), alphai, alphaj, coef, coefi
|
||||
double precision :: integral0, integral1, integral2
|
||||
|
||||
double precision, external :: NAI_pol_mult_erf_with1s
|
||||
|
||||
ASSERT(beta .ge. 0.d0)
|
||||
if(beta .lt. 1d-10) then
|
||||
call NAI_pol_x2_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
|
||||
return
|
||||
endif
|
||||
|
||||
ints = 0.d0
|
||||
|
||||
power_Ai(1:3) = ao_power(i_ao,1:3)
|
||||
power_Aj(1:3) = ao_power(j_ao,1:3)
|
||||
|
||||
Ai_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
|
||||
Aj_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alphai = ao_expo_ordered_transp (i,i_ao)
|
||||
coefi = ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
|
||||
do m = 1, 3
|
||||
|
||||
power_A1 = power_Ai
|
||||
power_A1(m) += 1
|
||||
|
||||
power_A2 = power_Ai
|
||||
power_A2(m) += 2
|
||||
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
alphaj = ao_expo_ordered_transp (j,j_ao)
|
||||
coef = coefi * ao_coef_normalized_ordered_transp(j,j_ao)
|
||||
|
||||
integral0 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_Ai, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
integral1 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_A1, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
integral2 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_A2, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
|
||||
ints(m) += coef * (integral2 + Ai_center(m) * (2.d0*integral1 + Ai_center(m)*integral0))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine NAI_pol_x2_mult_erf_ao_with1s
|
||||
|
||||
! ---
|
||||
|
||||
subroutine NAI_pol_x2_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: mu_in, C_center(3)
|
||||
double precision, intent(out) :: ints(3)
|
||||
|
||||
integer :: i, j, num_A, num_B, power_A(3), power_B(3), n_pt_in, m
|
||||
integer :: power_A1(3), power_A2(3)
|
||||
double precision :: A_center(3), B_center(3), alpha, beta, coef
|
||||
double precision :: integral0, integral1, integral2
|
||||
|
||||
double precision :: NAI_pol_mult_erf
|
||||
|
||||
ints = 0.d0
|
||||
|
||||
num_A = ao_nucl(i_ao)
|
||||
power_A(1:3) = ao_power(i_ao,1:3)
|
||||
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||
num_B = ao_nucl(j_ao)
|
||||
power_B(1:3) = ao_power(j_ao,1:3)
|
||||
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alpha = ao_expo_ordered_transp(i,i_ao)
|
||||
|
||||
do m = 1, 3
|
||||
|
||||
power_A1 = power_A
|
||||
power_A1(m) += 1
|
||||
|
||||
power_A2 = power_A
|
||||
power_A2(m) += 2
|
||||
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
beta = ao_expo_ordered_transp(j,j_ao)
|
||||
coef = ao_coef_normalized_ordered_transp(j,j_ao) * ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
|
||||
integral0 = NAI_pol_mult_erf(A_center, B_center, power_A , power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
integral1 = NAI_pol_mult_erf(A_center, B_center, power_A1, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
integral2 = NAI_pol_mult_erf(A_center, B_center, power_A2, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
|
||||
ints(m) += coef * (integral2 + A_center(m) * (2.d0*integral1 + A_center(m)*integral0))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine NAI_pol_x2_mult_erf_ao
|
||||
|
||||
! ---
|
||||
|
||||
subroutine NAI_pol_012_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center, ints)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! ints(1) = $\int_{-\infty}^{infty} dr x^0 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! ints(2) = $\int_{-\infty}^{infty} dr x^1 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! ints(3) = $\int_{-\infty}^{infty} dr y^1 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! ints(4) = $\int_{-\infty}^{infty} dr z^1 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! ints(5) = $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! ints(6) = $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! ints(7) = $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: beta, B_center(3), mu_in, C_center(3)
|
||||
double precision, intent(out) :: ints(7)
|
||||
|
||||
integer :: i, j, power_Ai(3), power_Aj(3), n_pt_in, m
|
||||
integer :: power_A1(3), power_A2(3)
|
||||
double precision :: Ai_center(3), Aj_center(3), alphai, alphaj, coef, coefi
|
||||
double precision :: integral0, integral1, integral2
|
||||
|
||||
double precision, external :: NAI_pol_mult_erf_with1s
|
||||
|
||||
ASSERT(beta .ge. 0.d0)
|
||||
if(beta .lt. 1d-10) then
|
||||
call NAI_pol_012_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
|
||||
return
|
||||
endif
|
||||
|
||||
ints = 0.d0
|
||||
|
||||
power_Ai(1:3) = ao_power(i_ao,1:3)
|
||||
power_Aj(1:3) = ao_power(j_ao,1:3)
|
||||
|
||||
Ai_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
|
||||
Aj_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alphai = ao_expo_ordered_transp (i,i_ao)
|
||||
coefi = ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
alphaj = ao_expo_ordered_transp (j,j_ao)
|
||||
coef = coefi * ao_coef_normalized_ordered_transp(j,j_ao)
|
||||
|
||||
integral0 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_Ai, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
ints(1) += coef * integral0
|
||||
|
||||
do m = 1, 3
|
||||
|
||||
power_A1 = power_Ai
|
||||
power_A1(m) += 1
|
||||
integral1 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_A1, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
ints(1+m) += coef * (integral1 + Ai_center(m)*integral0)
|
||||
|
||||
power_A2 = power_Ai
|
||||
power_A2(m) += 2
|
||||
integral2 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_A2, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
ints(4+m) += coef * (integral2 + Ai_center(m) * (2.d0*integral1 + Ai_center(m)*integral0))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine NAI_pol_012_mult_erf_ao_with1s
|
||||
|
||||
! ---
|
||||
|
||||
subroutine NAI_pol_012_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! int(1) = $\int_{-\infty}^{infty} dr x^0 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! int(2) = $\int_{-\infty}^{infty} dr x^1 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! int(3) = $\int_{-\infty}^{infty} dr y^1 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! int(4) = $\int_{-\infty}^{infty} dr z^1 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! int(5) = $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! int(6) = $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! int(7) = $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: mu_in, C_center(3)
|
||||
double precision, intent(out) :: ints(7)
|
||||
|
||||
integer :: i, j, num_A, num_B, power_A(3), power_B(3), n_pt_in, m
|
||||
integer :: power_A1(3), power_A2(3)
|
||||
double precision :: A_center(3), B_center(3), alpha, beta, coef
|
||||
double precision :: integral0, integral1, integral2
|
||||
|
||||
double precision :: NAI_pol_mult_erf
|
||||
|
||||
ints = 0.d0
|
||||
|
||||
num_A = ao_nucl(i_ao)
|
||||
power_A(1:3) = ao_power(i_ao,1:3)
|
||||
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||
num_B = ao_nucl(j_ao)
|
||||
power_B(1:3) = ao_power(j_ao,1:3)
|
||||
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alpha = ao_expo_ordered_transp(i,i_ao)
|
||||
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
beta = ao_expo_ordered_transp(j,j_ao)
|
||||
coef = ao_coef_normalized_ordered_transp(j,j_ao) * ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
|
||||
integral0 = NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
ints(1) += coef * integral0
|
||||
|
||||
do m = 1, 3
|
||||
|
||||
power_A1 = power_A
|
||||
power_A1(m) += 1
|
||||
integral1 = NAI_pol_mult_erf(A_center, B_center, power_A1, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
|
||||
ints(1+m) += coef * (integral1 + A_center(m)*integral0)
|
||||
|
||||
power_A2 = power_A
|
||||
power_A2(m) += 2
|
||||
integral2 = NAI_pol_mult_erf(A_center, B_center, power_A2, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
|
||||
ints(4+m) += coef * (integral2 + A_center(m) * (2.d0*integral1 + A_center(m)*integral0))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine NAI_pol_012_mult_erf_ao
|
||||
|
||||
! ---
|
||||
|
||||
|
@ -38,7 +38,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n
|
||||
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
|
||||
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
|
||||
!$OMP List_comb_thr_b3_cent, int2_grad1u2_grad2u2_j1b2_test, ao_abs_comb_b3_j1b, &
|
||||
!$OMP ao_overlap_abs,sq_pi_3_2)
|
||||
!$OMP ao_overlap_abs,sq_pi_3_2,thrsh_cycle_tc)
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do ipoint = 1, n_points_final_grid
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
@ -46,7 +46,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n
|
||||
r(3) = final_grid_points(3,ipoint)
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
if(ao_overlap_abs(j,i) .lt. 1.d-12) then
|
||||
if(ao_overlap_abs(j,i) .lt. thrsh_cycle_tc) then
|
||||
cycle
|
||||
endif
|
||||
|
||||
@ -58,7 +58,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n
|
||||
do i_fit = 1, ng_fit_jast
|
||||
expo_fit = expo_gauss_1_erf_x_2(i_fit)
|
||||
coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit)
|
||||
if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.1.d-10)cycle
|
||||
! if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
|
||||
int_gauss = overlap_gauss_r12_ao(r, expo_fit, i, j)
|
||||
int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss
|
||||
enddo
|
||||
@ -81,8 +81,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n
|
||||
!DIR$ FORCEINLINE
|
||||
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
|
||||
coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) * coef
|
||||
! if(dabs(coef_fit*factor_ij_1s*int_j1b).lt.1.d-10)cycle ! old version
|
||||
if(dabs(coef_fit*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.1.d-10)cycle
|
||||
! if(dabs(coef_fit*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
|
||||
! call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, &
|
||||
! expo_fit, i, j, int_fit_v, n_points_final_grid)
|
||||
int_gauss = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
|
||||
@ -145,14 +144,14 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao
|
||||
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
|
||||
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
|
||||
!$OMP List_comb_thr_b3_cent, big_array,&
|
||||
!$OMP ao_abs_comb_b3_j1b,ao_overlap_abs)
|
||||
!$OMP ao_abs_comb_b3_j1b,ao_overlap_abs,thrsh_cycle_tc)
|
||||
!
|
||||
allocate(int_fit_v(n_points_final_grid))
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
|
||||
if(ao_overlap_abs(j,i) .lt. 1.d-12) then
|
||||
if(ao_overlap_abs(j,i) .lt. thrsh_cycle_tc) then
|
||||
cycle
|
||||
endif
|
||||
|
||||
@ -161,7 +160,6 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao
|
||||
coef = List_comb_thr_b3_coef (i_1s,j,i)
|
||||
beta = List_comb_thr_b3_expo (i_1s,j,i)
|
||||
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
|
||||
! if(dabs(coef)*dabs(int_j1b).lt.1.d-15)cycle
|
||||
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
|
||||
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
|
||||
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
|
||||
@ -243,7 +241,7 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_
|
||||
!$OMP final_grid_points, ng_fit_jast, &
|
||||
!$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, &
|
||||
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo,sq_pi_3_2, &
|
||||
!$OMP List_comb_thr_b3_cent, int2_u2_j1b2_test,ao_abs_comb_b3_j1b)
|
||||
!$OMP List_comb_thr_b3_cent, int2_u2_j1b2_test,ao_abs_comb_b3_j1b,thrsh_cycle_tc)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
@ -260,11 +258,11 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_
|
||||
! --- --- ---
|
||||
|
||||
int_j1b = ao_abs_comb_b3_j1b(1,j,i)
|
||||
if(dabs(int_j1b).lt.1.d-10) cycle
|
||||
if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
|
||||
do i_fit = 1, ng_fit_jast
|
||||
expo_fit = expo_gauss_j_mu_x_2(i_fit)
|
||||
coef_fit = coef_gauss_j_mu_x_2(i_fit)
|
||||
if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.1.d-10)cycle
|
||||
! if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
|
||||
int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
|
||||
tmp += coef_fit * int_fit
|
||||
enddo
|
||||
@ -278,7 +276,7 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_
|
||||
coef = List_comb_thr_b3_coef (i_1s,j,i)
|
||||
beta = List_comb_thr_b3_expo (i_1s,j,i)
|
||||
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
|
||||
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
|
||||
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
|
||||
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
|
||||
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
|
||||
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
|
||||
@ -288,8 +286,7 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_
|
||||
coef_fit = coef_gauss_j_mu_x_2(i_fit)
|
||||
!DIR$ FORCEINLINE
|
||||
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
|
||||
! if(dabs(coef_fit*coef*factor_ij_1s*int_j1b).lt.1.d-10)cycle ! old version
|
||||
if(dabs(coef_fit*coef*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.1.d-10)cycle
|
||||
! if(dabs(coef_fit*coef*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
|
||||
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
|
||||
tmp += coef * coef_fit * int_fit
|
||||
enddo
|
||||
@ -350,7 +347,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n
|
||||
!$OMP final_grid_points, ng_fit_jast, &
|
||||
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
|
||||
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
|
||||
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_j1b2_test,ao_abs_comb_b3_j1b,sq_pi_3_2)
|
||||
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_j1b2_test,ao_abs_comb_b3_j1b,sq_pi_3_2,thrsh_cycle_tc)
|
||||
!$OMP DO
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
@ -369,7 +366,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n
|
||||
coef = List_comb_thr_b3_coef (i_1s,j,i)
|
||||
beta = List_comb_thr_b3_expo (i_1s,j,i)
|
||||
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
|
||||
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
|
||||
if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
|
||||
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
|
||||
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
|
||||
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
|
||||
@ -392,8 +389,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n
|
||||
expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist
|
||||
coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
|
||||
sq_alpha = alpha_1s_inv * dsqrt(alpha_1s_inv)
|
||||
! if(dabs(coef_tmp*int_j1b) .lt. 1d-10) cycle ! old version
|
||||
if(dabs(coef_tmp*int_j1b*sq_pi_3_2*sq_alpha) .lt. 1d-10) cycle
|
||||
! if(dabs(coef_tmp*int_j1b*sq_pi_3_2*sq_alpha) .lt. thrsh_cycle_tc) cycle
|
||||
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r, int_fit)
|
||||
|
||||
@ -470,13 +466,13 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
|
||||
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
|
||||
!$OMP ao_prod_dist_grid, ao_prod_sigma, ao_overlap_abs_grid,ao_prod_center,dsqpi_3_2, &
|
||||
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, ao_abs_comb_b3_j1b, &
|
||||
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_j1b2_test)
|
||||
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_j1b2_test,thrsh_cycle_tc)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-10) cycle
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.thrsh_cycle_tc) cycle
|
||||
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
r(2) = final_grid_points(2,ipoint)
|
||||
@ -489,10 +485,10 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
|
||||
! --- --- ---
|
||||
|
||||
int_j1b = ao_abs_comb_b3_j1b(1,j,i)
|
||||
if(dabs(int_j1b).lt.1.d-10) cycle
|
||||
! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
|
||||
do i_fit = 1, ng_fit_jast
|
||||
expo_fit = expo_gauss_j_mu_1_erf(i_fit)
|
||||
if(dabs(int_j1b)*dsqpi_3_2*expo_fit**(-1.5d0).lt.1.d-15) cycle
|
||||
! if(dabs(int_j1b)*dsqpi_3_2*expo_fit**(-1.5d0).lt.thrsh_cycle_tc) cycle
|
||||
coef_fit = coef_gauss_j_mu_1_erf(i_fit)
|
||||
int_fit = NAI_pol_mult_erf_ao_with1s(i, j, expo_fit, r, 1.d+9, r)
|
||||
tmp += coef_fit * int_fit
|
||||
@ -507,7 +503,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
|
||||
coef = List_comb_thr_b3_coef (i_1s,j,i)
|
||||
beta = List_comb_thr_b3_expo (i_1s,j,i)
|
||||
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
|
||||
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
|
||||
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
|
||||
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
|
||||
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
|
||||
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
|
||||
@ -517,7 +513,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
|
||||
do i_fit = 1, ng_fit_jast
|
||||
expo_fit = expo_gauss_j_mu_1_erf(i_fit)
|
||||
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
|
||||
if(factor_ij_1s*dabs(coef*int_j1b)*dsqpi_3_2*beta_ij**(-1.5d0).lt.1.d-15)cycle
|
||||
! if(factor_ij_1s*dabs(coef*int_j1b)*dsqpi_3_2*beta_ij**(-1.5d0).lt.thrsh_cycle_tc)cycle
|
||||
coef_fit = coef_gauss_j_mu_1_erf(i_fit)
|
||||
|
||||
alpha_1s = beta + expo_fit
|
||||
@ -527,9 +523,9 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
|
||||
centr_1s(3) = alpha_1s_inv * (beta * B_center(3) + expo_fit * r(3))
|
||||
|
||||
expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist
|
||||
if(expo_coef_1s .gt. 20.d0) cycle
|
||||
! if(expo_coef_1s .gt. 20.d0) cycle
|
||||
coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
|
||||
if(dabs(coef_tmp) .lt. 1d-08) cycle
|
||||
! if(dabs(coef_tmp) .lt. 1d-08) cycle
|
||||
|
||||
int_fit = NAI_pol_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r)
|
||||
|
||||
|
@ -1,4 +1,72 @@
|
||||
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_points_final_grid)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) [1 - erf(mu r12)]^2
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, ipoint, i_fit
|
||||
double precision :: r(3), expo_fit, coef_fit
|
||||
double precision :: tmp
|
||||
double precision :: wall0, wall1
|
||||
|
||||
double precision, external :: overlap_gauss_r12_ao
|
||||
|
||||
print*, ' providing int2_grad1u2_grad2u2 ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mu_erf final_grid_points j1b_pen
|
||||
|
||||
int2_grad1u2_grad2u2 = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ipoint, i, j, i_fit, r, coef_fit, expo_fit, tmp) &
|
||||
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, ng_fit_jast, &
|
||||
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2,int2_grad1u2_grad2u2)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
r(2) = final_grid_points(2,ipoint)
|
||||
r(3) = final_grid_points(3,ipoint)
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
|
||||
tmp = 0.d0
|
||||
do i_fit = 1, ng_fit_jast
|
||||
|
||||
expo_fit = expo_gauss_1_erf_x_2(i_fit)
|
||||
coef_fit = coef_gauss_1_erf_x_2(i_fit)
|
||||
|
||||
tmp += -0.25d0 * coef_fit * overlap_gauss_r12_ao(r, expo_fit, i, j)
|
||||
enddo
|
||||
|
||||
int2_grad1u2_grad2u2(j,i,ipoint) = tmp
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 2, ao_num
|
||||
do j = 1, i-1
|
||||
int2_grad1u2_grad2u2(j,i,ipoint) = int2_grad1u2_grad2u2(i,j,ipoint)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call wall_time(wall1)
|
||||
print*, ' wall time for int2_grad1u2_grad2u2 =', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
|
||||
@ -60,6 +128,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n
|
||||
do i_1s = 2, List_all_comb_b3_size
|
||||
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b3_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b3_cent(2,i_1s)
|
||||
@ -96,7 +165,7 @@ END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
|
||||
BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
@ -154,6 +223,7 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final
|
||||
do i_1s = 2, List_all_comb_b3_size
|
||||
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b3_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b3_cent(2,i_1s)
|
||||
@ -254,6 +324,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin
|
||||
do i_1s = 2, List_all_comb_b3_size
|
||||
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b3_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b3_cent(2,i_1s)
|
||||
@ -368,6 +439,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points
|
||||
do i_1s = 2, List_all_comb_b3_size
|
||||
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b3_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b3_cent(2,i_1s)
|
||||
|
@ -31,7 +31,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num,
|
||||
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points, &
|
||||
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_j1b, &
|
||||
!$OMP v_ij_erf_rk_cst_mu_j1b_test, mu_erf, &
|
||||
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2)
|
||||
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc)
|
||||
!$OMP DO
|
||||
!do ipoint = 1, 10
|
||||
do ipoint = 1, n_points_final_grid
|
||||
@ -41,7 +41,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num,
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-20)cycle
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.thrsh_cycle_tc)cycle
|
||||
|
||||
tmp = 0.d0
|
||||
do i_1s = 1, List_comb_thr_b2_size(j,i)
|
||||
@ -49,7 +49,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num,
|
||||
coef = List_comb_thr_b2_coef (i_1s,j,i)
|
||||
beta = List_comb_thr_b2_expo (i_1s,j,i)
|
||||
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
|
||||
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
|
||||
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
|
||||
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
|
||||
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
|
||||
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
|
||||
@ -110,7 +110,7 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu
|
||||
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points,&
|
||||
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent, &
|
||||
!$OMP x_v_ij_erf_rk_cst_mu_j1b_test, mu_erf,ao_abs_comb_b2_j1b, &
|
||||
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma)
|
||||
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,thrsh_cycle_tc)
|
||||
! !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,expo_erfc_mu_gauss)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
@ -120,7 +120,7 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-10)cycle
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.thrsh_cycle_tc)cycle
|
||||
|
||||
tmp_x = 0.d0
|
||||
tmp_y = 0.d0
|
||||
@ -130,19 +130,11 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu
|
||||
coef = List_comb_thr_b2_coef (i_1s,j,i)
|
||||
beta = List_comb_thr_b2_expo (i_1s,j,i)
|
||||
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
|
||||
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
|
||||
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
|
||||
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
|
||||
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
|
||||
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
|
||||
|
||||
! if(ao_prod_center(1,j,i).ne.10000.d0)then
|
||||
! ! approximate 1 - erf(mu r12) by a gaussian * 10
|
||||
! !DIR$ FORCEINLINE
|
||||
! call gaussian_product(expo_erfc_mu_gauss,r, &
|
||||
! ao_prod_sigma(j,i),ao_prod_center(1,j,i), &
|
||||
! factor_ij_1s,beta_ij,center_ij_1s)
|
||||
! if(dabs(coef * factor_ij_1s*int_j1b*10.d0 * dsqpi_3_2 * beta_ij**(-1.5d0)).lt.1.d-10)cycle
|
||||
! endif
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints )
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, ints_coulomb)
|
||||
|
||||
@ -216,7 +208,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
|
||||
!$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, &
|
||||
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, &
|
||||
!$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_test,ao_abs_comb_b2_j1b, &
|
||||
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2)
|
||||
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
@ -225,7 +217,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-20)cycle
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.thrsh_cycle_tc)cycle
|
||||
|
||||
tmp = 0.d0
|
||||
|
||||
@ -234,11 +226,11 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
|
||||
! --- --- ---
|
||||
|
||||
int_j1b = ao_abs_comb_b2_j1b(1,j,i)
|
||||
if(dabs(int_j1b).lt.1.d-10) cycle
|
||||
! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
|
||||
do i_fit = 1, ng_fit_jast
|
||||
expo_fit = expo_gauss_j_mu_x(i_fit)
|
||||
coef_fit = coef_gauss_j_mu_x(i_fit)
|
||||
if(ao_overlap_abs_grid(j,i).lt.1.d-15) cycle
|
||||
! if(ao_overlap_abs_grid(j,i).lt.thrsh_cycle_tc) cycle
|
||||
int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
|
||||
tmp += coef_fit * int_fit
|
||||
enddo
|
||||
@ -251,7 +243,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
|
||||
coef = List_comb_thr_b2_coef (i_1s,j,i)
|
||||
beta = List_comb_thr_b2_expo (i_1s,j,i)
|
||||
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
|
||||
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
|
||||
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
|
||||
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
|
||||
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
|
||||
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
|
||||
@ -259,9 +251,9 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
|
||||
expo_fit = expo_gauss_j_mu_x(i_fit)
|
||||
coef_fit = coef_gauss_j_mu_x(i_fit)
|
||||
coeftot = coef * coef_fit
|
||||
if(dabs(coeftot).lt.1.d-15)cycle
|
||||
! if(dabs(coeftot).lt.thrsh_cycle_tc)cycle
|
||||
call gaussian_product(beta,B_center,expo_fit,r,factor_ij_1s_u,beta_ij_u,center_ij_1s_u)
|
||||
if(factor_ij_1s_u*ao_overlap_abs_grid(j,i).lt.1.d-15)cycle
|
||||
! if(factor_ij_1s_u*ao_overlap_abs_grid(j,i).lt.thrsh_cycle_tc)cycle
|
||||
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
|
||||
tmp += coef * coef_fit * int_fit
|
||||
enddo
|
||||
@ -325,7 +317,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num,
|
||||
!$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, &
|
||||
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, &
|
||||
!$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_ng_1_test,ao_abs_comb_b2_j1b, &
|
||||
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2)
|
||||
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
@ -334,7 +326,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num,
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-20)cycle
|
||||
if(dabs(ao_overlap_abs_grid(j,i)).lt.thrsh_cycle_tc)cycle
|
||||
|
||||
tmp = 0.d0
|
||||
|
||||
@ -343,7 +335,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num,
|
||||
! --- --- ---
|
||||
|
||||
int_j1b = ao_abs_comb_b2_j1b(1,j,i)
|
||||
if(dabs(int_j1b).lt.1.d-10) cycle
|
||||
! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
|
||||
expo_fit = expo_good_j_mu_1gauss
|
||||
int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
|
||||
tmp += int_fit
|
||||
@ -356,7 +348,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num,
|
||||
coef = List_comb_thr_b2_coef (i_1s,j,i)
|
||||
beta = List_comb_thr_b2_expo (i_1s,j,i)
|
||||
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
|
||||
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
|
||||
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
|
||||
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
|
||||
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
|
||||
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
|
||||
@ -364,9 +356,9 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num,
|
||||
expo_fit = expo_good_j_mu_1gauss
|
||||
coef_fit = 1.d0
|
||||
coeftot = coef * coef_fit
|
||||
if(dabs(coeftot).lt.1.d-15)cycle
|
||||
if(dabs(coeftot).lt.thrsh_cycle_tc)cycle
|
||||
call gaussian_product(beta,B_center,expo_fit,r,factor_ij_1s_u,beta_ij_u,center_ij_1s_u)
|
||||
if(factor_ij_1s_u*ao_overlap_abs_grid(j,i).lt.1.d-15)cycle
|
||||
if(factor_ij_1s_u*ao_overlap_abs_grid(j,i).lt.thrsh_cycle_tc)cycle
|
||||
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
|
||||
tmp += coef * coef_fit * int_fit
|
||||
! enddo
|
||||
|
@ -60,6 +60,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
@ -154,6 +155,7 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
@ -195,8 +197,7 @@ END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
! TODO analytically
|
||||
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid)]
|
||||
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_points_final_grid)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
@ -213,12 +214,14 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
|
||||
double precision, external :: overlap_gauss_r12_ao_with1s
|
||||
|
||||
print*, ' providing v_ij_u_cst_mu_j1b ...'
|
||||
print*, ' providing v_ij_u_cst_mu_j1b_fit ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mu_erf final_grid_points j1b_pen
|
||||
PROVIDE ng_fit_jast expo_gauss_j_mu_x coef_gauss_j_mu_x
|
||||
PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent
|
||||
|
||||
v_ij_u_cst_mu_j1b = 0.d0
|
||||
v_ij_u_cst_mu_j1b_fit = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
|
||||
@ -227,9 +230,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
!$OMP final_grid_points, ng_fit_jast, &
|
||||
!$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, &
|
||||
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, &
|
||||
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b)
|
||||
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_fit)
|
||||
!$OMP DO
|
||||
!do ipoint = 1, 10
|
||||
do ipoint = 1, n_points_final_grid
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
r(2) = final_grid_points(2,ipoint)
|
||||
@ -240,7 +242,6 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
|
||||
tmp = 0.d0
|
||||
do i_fit = 1, ng_fit_jast
|
||||
|
||||
expo_fit = expo_gauss_j_mu_x(i_fit)
|
||||
coef_fit = coef_gauss_j_mu_x(i_fit)
|
||||
|
||||
@ -253,7 +254,6 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
B_center(3) = List_all_comb_b2_cent(3,1)
|
||||
|
||||
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
|
||||
! if(dabs(int_fit*coef) .lt. 1d-12) cycle
|
||||
|
||||
tmp += coef * coef_fit * int_fit
|
||||
|
||||
@ -262,6 +262,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
@ -276,7 +277,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
|
||||
enddo
|
||||
|
||||
v_ij_u_cst_mu_j1b(j,i,ipoint) = tmp
|
||||
v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = tmp
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
@ -286,15 +287,266 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 2, ao_num
|
||||
do j = 1, i-1
|
||||
v_ij_u_cst_mu_j1b(j,i,ipoint) = v_ij_u_cst_mu_j1b(i,j,ipoint)
|
||||
v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = v_ij_u_cst_mu_j1b_fit(i,j,ipoint)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call wall_time(wall1)
|
||||
print*, ' wall time for v_ij_u_cst_mu_j1b', wall1 - wall0
|
||||
print*, ' wall time for v_ij_u_cst_mu_j1b_fit', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_points_final_grid)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'constants.include.F'
|
||||
|
||||
implicit none
|
||||
integer :: i, j, ipoint, i_1s
|
||||
double precision :: r(3), r1_2
|
||||
double precision :: int_c1, int_e1, int_o
|
||||
double precision :: int_c2(3), int_e2(3)
|
||||
double precision :: int_c3(3), int_e3(3)
|
||||
double precision :: coef, beta, B_center(3)
|
||||
double precision :: tmp, ct
|
||||
double precision :: wall0, wall1
|
||||
|
||||
double precision, external :: overlap_gauss_r12_ao_with1s
|
||||
double precision, external :: NAI_pol_mult_erf_ao_with1s
|
||||
|
||||
print*, ' providing v_ij_u_cst_mu_j1b_an_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mu_erf final_grid_points j1b_pen
|
||||
PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent
|
||||
|
||||
ct = inv_sq_pi_2 / mu_erf
|
||||
|
||||
v_ij_u_cst_mu_j1b_an_old = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, &
|
||||
!$OMP r1_2, tmp, int_c1, int_e1, int_o, int_c2, &
|
||||
!$OMP int_e2, int_c3, int_e3) &
|
||||
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, &
|
||||
!$OMP final_grid_points, mu_erf, ct, &
|
||||
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, &
|
||||
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an_old)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
r(2) = final_grid_points(2,ipoint)
|
||||
r(3) = final_grid_points(3,ipoint)
|
||||
r1_2 = 0.5d0 * (r(1)*r(1) + r(2)*r(2) + r(3)*r(3))
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
|
||||
! ---
|
||||
|
||||
coef = List_all_comb_b2_coef (1)
|
||||
beta = List_all_comb_b2_expo (1)
|
||||
B_center(1) = List_all_comb_b2_cent(1,1)
|
||||
B_center(2) = List_all_comb_b2_cent(2,1)
|
||||
B_center(3) = List_all_comb_b2_cent(3,1)
|
||||
|
||||
int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r)
|
||||
int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
|
||||
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c2)
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e2)
|
||||
|
||||
call NAI_pol_x2_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c3)
|
||||
call NAI_pol_x2_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e3)
|
||||
|
||||
int_o = overlap_gauss_r12_ao_with1s(B_center, beta, r, mu_erf*mu_erf, i, j)
|
||||
|
||||
tmp = coef &
|
||||
* ( r1_2 * (int_c1 - int_e1) &
|
||||
- r(1) * (int_c2(1) - int_e2(1)) - r(2) * (int_c2(2) - int_e2(2)) - r(3) * (int_c2(3) - int_e2(3)) &
|
||||
+ 0.5d0 * (int_c3(1) + int_c3(2) + int_c3(3) - int_e3(1) - int_e3(2) - int_e3(3)) &
|
||||
- ct * int_o &
|
||||
)
|
||||
|
||||
! ---
|
||||
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
B_center(3) = List_all_comb_b2_cent(3,i_1s)
|
||||
|
||||
int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r)
|
||||
int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
|
||||
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c2)
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e2)
|
||||
|
||||
call NAI_pol_x2_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c3)
|
||||
call NAI_pol_x2_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e3)
|
||||
|
||||
int_o = overlap_gauss_r12_ao_with1s(B_center, beta, r, mu_erf*mu_erf, i, j)
|
||||
|
||||
tmp = tmp + coef &
|
||||
* ( r1_2 * (int_c1 - int_e1) &
|
||||
- r(1) * (int_c2(1) - int_e2(1)) - r(2) * (int_c2(2) - int_e2(2)) - r(3) * (int_c2(3) - int_e2(3)) &
|
||||
+ 0.5d0 * (int_c3(1) + int_c3(2) + int_c3(3) - int_e3(1) - int_e3(2) - int_e3(3)) &
|
||||
- ct * int_o &
|
||||
)
|
||||
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) = tmp
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 2, ao_num
|
||||
do j = 1, i-1
|
||||
v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) = v_ij_u_cst_mu_j1b_an_old(i,j,ipoint)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call wall_time(wall1)
|
||||
print*, ' wall time for v_ij_u_cst_mu_j1b_an_old', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_points_final_grid)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'constants.include.F'
|
||||
|
||||
implicit none
|
||||
integer :: i, j, ipoint, i_1s
|
||||
double precision :: r(3), r1_2
|
||||
double precision :: int_o
|
||||
double precision :: int_c(7), int_e(7)
|
||||
double precision :: coef, beta, B_center(3)
|
||||
double precision :: tmp, ct
|
||||
double precision :: wall0, wall1
|
||||
|
||||
double precision, external :: overlap_gauss_r12_ao_with1s
|
||||
double precision, external :: NAI_pol_mult_erf_ao_with1s
|
||||
|
||||
print*, ' providing v_ij_u_cst_mu_j1b_an ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mu_erf final_grid_points j1b_pen
|
||||
PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent
|
||||
|
||||
ct = inv_sq_pi_2 / mu_erf
|
||||
|
||||
v_ij_u_cst_mu_j1b_an = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, &
|
||||
!$OMP r1_2, tmp, int_c, int_e, int_o) &
|
||||
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, &
|
||||
!$OMP final_grid_points, mu_erf, ct, &
|
||||
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, &
|
||||
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
r(2) = final_grid_points(2,ipoint)
|
||||
r(3) = final_grid_points(3,ipoint)
|
||||
r1_2 = 0.5d0 * (r(1)*r(1) + r(2)*r(2) + r(3)*r(3))
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
|
||||
! ---
|
||||
|
||||
coef = List_all_comb_b2_coef (1)
|
||||
beta = List_all_comb_b2_expo (1)
|
||||
B_center(1) = List_all_comb_b2_cent(1,1)
|
||||
B_center(2) = List_all_comb_b2_cent(2,1)
|
||||
B_center(3) = List_all_comb_b2_cent(3,1)
|
||||
|
||||
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c)
|
||||
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e)
|
||||
|
||||
int_o = overlap_gauss_r12_ao_with1s(B_center, beta, r, mu_erf*mu_erf, i, j)
|
||||
|
||||
tmp = coef &
|
||||
* ( r1_2 * (int_c(1) - int_e(1)) &
|
||||
- r(1) * (int_c(2) - int_e(2)) - r(2) * (int_c(3) - int_e(3)) - r(3) * (int_c(4) - int_e(4)) &
|
||||
+ 0.5d0 * (int_c(5) + int_c(6) + int_c(7) - int_e(5) - int_e(6) - int_e(7)) &
|
||||
- ct * int_o &
|
||||
)
|
||||
|
||||
! ---
|
||||
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
B_center(3) = List_all_comb_b2_cent(3,i_1s)
|
||||
|
||||
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c)
|
||||
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e)
|
||||
|
||||
int_o = overlap_gauss_r12_ao_with1s(B_center, beta, r, mu_erf*mu_erf, i, j)
|
||||
|
||||
tmp = tmp + coef &
|
||||
* ( r1_2 * (int_c(1) - int_e(1)) &
|
||||
- r(1) * (int_c(2) - int_e(2)) - r(2) * (int_c(3) - int_e(3)) - r(3) * (int_c(4) - int_e(4)) &
|
||||
+ 0.5d0 * (int_c(5) + int_c(6) + int_c(7) - int_e(5) - int_e(6) - int_e(7)) &
|
||||
- ct * int_o &
|
||||
)
|
||||
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
v_ij_u_cst_mu_j1b_an(j,i,ipoint) = tmp
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 2, ao_num
|
||||
do j = 1, i-1
|
||||
v_ij_u_cst_mu_j1b_an(j,i,ipoint) = v_ij_u_cst_mu_j1b_an(i,j,ipoint)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call wall_time(wall1)
|
||||
print*, ' wall time for v_ij_u_cst_mu_j1b_an', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
@ -1,17 +1,34 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ integer, List_all_comb_b2_size]
|
||||
BEGIN_PROVIDER [integer, List_all_comb_b2_size]
|
||||
|
||||
implicit none
|
||||
|
||||
PROVIDE j1b_type
|
||||
|
||||
if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
|
||||
|
||||
List_all_comb_b2_size = 2**nucl_num
|
||||
|
||||
elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
|
||||
|
||||
List_all_comb_b2_size = nucl_num + 1
|
||||
|
||||
else
|
||||
|
||||
print *, 'j1b_type = ', j1b_type, 'is not implemented'
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
print *, ' nb of linear terms in the envelope is ', List_all_comb_b2_size
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ integer, List_all_comb_b2, (nucl_num, List_all_comb_b2_size)]
|
||||
BEGIN_PROVIDER [integer, List_all_comb_b2, (nucl_num, List_all_comb_b2_size)]
|
||||
|
||||
implicit none
|
||||
integer :: i, j
|
||||
@ -45,11 +62,14 @@ END_PROVIDER
|
||||
double precision :: tmp_cent_x, tmp_cent_y, tmp_cent_z
|
||||
|
||||
provide j1b_pen
|
||||
provide j1b_pen_coef
|
||||
|
||||
List_all_comb_b2_coef = 0.d0
|
||||
List_all_comb_b2_expo = 0.d0
|
||||
List_all_comb_b2_cent = 0.d0
|
||||
|
||||
if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
|
||||
|
||||
do i = 1, List_all_comb_b2_size
|
||||
|
||||
tmp_cent_x = 0.d0
|
||||
@ -102,6 +122,26 @@ END_PROVIDER
|
||||
List_all_comb_b2_coef(i) = (-1.d0)**dble(phase) * dexp(-List_all_comb_b2_coef(i))
|
||||
enddo
|
||||
|
||||
elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
|
||||
|
||||
List_all_comb_b2_coef( 1) = 1.d0
|
||||
List_all_comb_b2_expo( 1) = 0.d0
|
||||
List_all_comb_b2_cent(1:3,1) = 0.d0
|
||||
do i = 1, nucl_num
|
||||
List_all_comb_b2_coef( i+1) = -1.d0 * j1b_pen_coef(i)
|
||||
List_all_comb_b2_expo( i+1) = j1b_pen(i)
|
||||
List_all_comb_b2_cent(1,i+1) = nucl_coord(i,1)
|
||||
List_all_comb_b2_cent(2,i+1) = nucl_coord(i,2)
|
||||
List_all_comb_b2_cent(3,i+1) = nucl_coord(i,3)
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
print *, 'j1b_type = ', j1b_type, 'is not implemented'
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
!print *, ' coeff, expo & cent of list b2'
|
||||
!do i = 1, List_all_comb_b2_size
|
||||
! print*, i, List_all_comb_b2_coef(i), List_all_comb_b2_expo(i)
|
||||
@ -115,14 +155,31 @@ END_PROVIDER
|
||||
BEGIN_PROVIDER [ integer, List_all_comb_b3_size]
|
||||
|
||||
implicit none
|
||||
double precision :: tmp
|
||||
|
||||
if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
|
||||
|
||||
List_all_comb_b3_size = 3**nucl_num
|
||||
|
||||
elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
|
||||
|
||||
tmp = 0.5d0 * dble(nucl_num) * (dble(nucl_num) + 3.d0)
|
||||
List_all_comb_b3_size = int(tmp) + 1
|
||||
|
||||
else
|
||||
|
||||
print *, 'j1b_type = ', j1b_type, 'is not implemented'
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
print *, ' nb of linear terms in the square of the envelope is ', List_all_comb_b3_size
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ integer, List_all_comb_b3, (nucl_num, List_all_comb_b3_size)]
|
||||
BEGIN_PROVIDER [integer, List_all_comb_b3, (nucl_num, List_all_comb_b3_size)]
|
||||
|
||||
implicit none
|
||||
integer :: i, j, ii, jj
|
||||
@ -162,14 +219,21 @@ END_PROVIDER
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, phase
|
||||
integer :: ii
|
||||
double precision :: tmp_alphaj, tmp_alphak, facto
|
||||
double precision :: tmp1, tmp2, tmp3, tmp4
|
||||
double precision :: xi, yi, zi, xj, yj, zj
|
||||
double precision :: dx, dy, dz, r2
|
||||
|
||||
provide j1b_pen
|
||||
provide j1b_pen_coef
|
||||
|
||||
List_all_comb_b3_coef = 0.d0
|
||||
List_all_comb_b3_expo = 0.d0
|
||||
List_all_comb_b3_cent = 0.d0
|
||||
|
||||
if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
|
||||
|
||||
do i = 1, List_all_comb_b3_size
|
||||
|
||||
do j = 1, nucl_num
|
||||
@ -225,6 +289,71 @@ END_PROVIDER
|
||||
List_all_comb_b3_coef(i) = (-1.d0)**dble(phase) * facto * dexp(-List_all_comb_b3_coef(i))
|
||||
enddo
|
||||
|
||||
elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
|
||||
|
||||
ii = 1
|
||||
List_all_comb_b3_coef( ii) = 1.d0
|
||||
List_all_comb_b3_expo( ii) = 0.d0
|
||||
List_all_comb_b3_cent(1:3,ii) = 0.d0
|
||||
|
||||
do i = 1, nucl_num
|
||||
ii = ii + 1
|
||||
List_all_comb_b3_coef( ii) = -2.d0 * j1b_pen_coef(i)
|
||||
List_all_comb_b3_expo( ii) = j1b_pen(i)
|
||||
List_all_comb_b3_cent(1,ii) = nucl_coord(i,1)
|
||||
List_all_comb_b3_cent(2,ii) = nucl_coord(i,2)
|
||||
List_all_comb_b3_cent(3,ii) = nucl_coord(i,3)
|
||||
enddo
|
||||
|
||||
do i = 1, nucl_num
|
||||
ii = ii + 1
|
||||
List_all_comb_b3_coef( ii) = 1.d0 * j1b_pen_coef(i) * j1b_pen_coef(i)
|
||||
List_all_comb_b3_expo( ii) = 2.d0 * j1b_pen(i)
|
||||
List_all_comb_b3_cent(1,ii) = nucl_coord(i,1)
|
||||
List_all_comb_b3_cent(2,ii) = nucl_coord(i,2)
|
||||
List_all_comb_b3_cent(3,ii) = nucl_coord(i,3)
|
||||
enddo
|
||||
|
||||
do i = 1, nucl_num-1
|
||||
|
||||
tmp1 = j1b_pen(i)
|
||||
|
||||
xi = nucl_coord(i,1)
|
||||
yi = nucl_coord(i,2)
|
||||
zi = nucl_coord(i,3)
|
||||
|
||||
do j = i+1, nucl_num
|
||||
|
||||
tmp2 = j1b_pen(j)
|
||||
tmp3 = tmp1 + tmp2
|
||||
tmp4 = 1.d0 / tmp3
|
||||
|
||||
xj = nucl_coord(j,1)
|
||||
yj = nucl_coord(j,2)
|
||||
zj = nucl_coord(j,3)
|
||||
|
||||
dx = xi - xj
|
||||
dy = yi - yj
|
||||
dz = zi - zj
|
||||
r2 = dx*dx + dy*dy + dz*dz
|
||||
|
||||
ii = ii + 1
|
||||
! x 2 to avoid doing integrals twice
|
||||
List_all_comb_b3_coef( ii) = 2.d0 * dexp(-tmp1*tmp2*tmp4*r2) * j1b_pen_coef(i) * j1b_pen_coef(j)
|
||||
List_all_comb_b3_expo( ii) = tmp3
|
||||
List_all_comb_b3_cent(1,ii) = tmp4 * (tmp1 * xi + tmp2 * xj)
|
||||
List_all_comb_b3_cent(2,ii) = tmp4 * (tmp1 * yi + tmp2 * yj)
|
||||
List_all_comb_b3_cent(3,ii) = tmp4 * (tmp1 * zi + tmp2 * zj)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
print *, 'j1b_type = ', j1b_type, 'is not implemented'
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
!print *, ' coeff, expo & cent of list b3'
|
||||
!do i = 1, List_all_comb_b3_size
|
||||
! print*, i, List_all_comb_b3_coef(i), List_all_comb_b3_expo(i)
|
||||
|
@ -3,15 +3,16 @@
|
||||
&BEGIN_PROVIDER [ integer, max_List_comb_thr_b2_size]
|
||||
implicit none
|
||||
integer :: i_1s,i,j,ipoint
|
||||
double precision :: coef,beta,center(3),int_j1b,thr
|
||||
double precision :: coef,beta,center(3),int_j1b
|
||||
double precision :: r(3),weight,dist
|
||||
thr = 1.d-15
|
||||
List_comb_thr_b2_size = 0
|
||||
print*,'List_all_comb_b2_size = ',List_all_comb_b2_size
|
||||
! pause
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
do i_1s = 1, List_all_comb_b2_size
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef).lt.1.d-15)cycle
|
||||
if(dabs(coef).lt.thrsh_cycle_tc)cycle
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
beta = max(beta,1.d-12)
|
||||
center(1:3) = List_all_comb_b2_cent(1:3,i_1s)
|
||||
@ -24,7 +25,7 @@
|
||||
dist += ( center(3) - r(3) )*( center(3) - r(3) )
|
||||
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
|
||||
enddo
|
||||
if(dabs(coef)*dabs(int_j1b).gt.thr)then
|
||||
if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then
|
||||
List_comb_thr_b2_size(j,i) += 1
|
||||
endif
|
||||
enddo
|
||||
@ -40,6 +41,7 @@
|
||||
list(i) = maxval(List_comb_thr_b2_size(:,i))
|
||||
enddo
|
||||
max_List_comb_thr_b2_size = maxval(list)
|
||||
print*,'max_List_comb_thr_b2_size = ',max_List_comb_thr_b2_size
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -49,16 +51,15 @@ END_PROVIDER
|
||||
&BEGIN_PROVIDER [ double precision, ao_abs_comb_b2_j1b, ( max_List_comb_thr_b2_size ,ao_num, ao_num)]
|
||||
implicit none
|
||||
integer :: i_1s,i,j,ipoint,icount
|
||||
double precision :: coef,beta,center(3),int_j1b,thr
|
||||
double precision :: coef,beta,center(3),int_j1b
|
||||
double precision :: r(3),weight,dist
|
||||
thr = 1.d-15
|
||||
ao_abs_comb_b2_j1b = 10000000.d0
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
icount = 0
|
||||
do i_1s = 1, List_all_comb_b2_size
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef).lt.1.d-12)cycle
|
||||
if(dabs(coef).lt.thrsh_cycle_tc)cycle
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
center(1:3) = List_all_comb_b2_cent(1:3,i_1s)
|
||||
int_j1b = 0.d0
|
||||
@ -70,7 +71,7 @@ END_PROVIDER
|
||||
dist += ( center(3) - r(3) )*( center(3) - r(3) )
|
||||
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
|
||||
enddo
|
||||
if(dabs(coef)*dabs(int_j1b).gt.thr)then
|
||||
if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then
|
||||
icount += 1
|
||||
List_comb_thr_b2_coef(icount,j,i) = coef
|
||||
List_comb_thr_b2_expo(icount,j,i) = beta
|
||||
@ -98,17 +99,17 @@ END_PROVIDER
|
||||
&BEGIN_PROVIDER [ integer, max_List_comb_thr_b3_size]
|
||||
implicit none
|
||||
integer :: i_1s,i,j,ipoint
|
||||
double precision :: coef,beta,center(3),int_j1b,thr
|
||||
double precision :: coef,beta,center(3),int_j1b
|
||||
double precision :: r(3),weight,dist
|
||||
thr = 1.d-15
|
||||
List_comb_thr_b3_size = 0
|
||||
print*,'List_all_comb_b3_size = ',List_all_comb_b3_size
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
do i_1s = 1, List_all_comb_b3_size
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
center(1:3) = List_all_comb_b3_cent(1:3,i_1s)
|
||||
if(dabs(coef).lt.thr)cycle
|
||||
if(dabs(coef).lt.thrsh_cycle_tc)cycle
|
||||
int_j1b = 0.d0
|
||||
do ipoint = 1, n_points_extra_final_grid
|
||||
r(1:3) = final_grid_points_extra(1:3,ipoint)
|
||||
@ -118,7 +119,7 @@ END_PROVIDER
|
||||
dist += ( center(3) - r(3) )*( center(3) - r(3) )
|
||||
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
|
||||
enddo
|
||||
if(dabs(coef)*dabs(int_j1b).gt.thr)then
|
||||
if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then
|
||||
List_comb_thr_b3_size(j,i) += 1
|
||||
endif
|
||||
enddo
|
||||
@ -144,9 +145,8 @@ END_PROVIDER
|
||||
&BEGIN_PROVIDER [ double precision, ao_abs_comb_b3_j1b, ( max_List_comb_thr_b3_size ,ao_num, ao_num)]
|
||||
implicit none
|
||||
integer :: i_1s,i,j,ipoint,icount
|
||||
double precision :: coef,beta,center(3),int_j1b,thr
|
||||
double precision :: coef,beta,center(3),int_j1b
|
||||
double precision :: r(3),weight,dist
|
||||
thr = 1.d-15
|
||||
ao_abs_comb_b3_j1b = 10000000.d0
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
@ -156,7 +156,7 @@ END_PROVIDER
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
beta = max(beta,1.d-12)
|
||||
center(1:3) = List_all_comb_b3_cent(1:3,i_1s)
|
||||
if(dabs(coef).lt.thr)cycle
|
||||
if(dabs(coef).lt.thrsh_cycle_tc)cycle
|
||||
int_j1b = 0.d0
|
||||
do ipoint = 1, n_points_extra_final_grid
|
||||
r(1:3) = final_grid_points_extra(1:3,ipoint)
|
||||
@ -166,7 +166,7 @@ END_PROVIDER
|
||||
dist += ( center(3) - r(3) )*( center(3) - r(3) )
|
||||
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
|
||||
enddo
|
||||
if(dabs(coef)*dabs(int_j1b).gt.thr)then
|
||||
if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then
|
||||
icount += 1
|
||||
List_comb_thr_b3_coef(icount,j,i) = coef
|
||||
List_comb_thr_b3_expo(icount,j,i) = beta
|
||||
@ -177,15 +177,5 @@ END_PROVIDER
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! do i = 1, ao_num
|
||||
! do j = 1, i-1
|
||||
! do icount = 1, List_comb_thr_b3_size(j,i)
|
||||
! List_comb_thr_b3_coef(icount,j,i) = List_comb_thr_b3_coef(icount,i,j)
|
||||
! List_comb_thr_b3_expo(icount,j,i) = List_comb_thr_b3_expo(icount,i,j)
|
||||
! List_comb_thr_b3_cent(1:3,icount,j,i) = List_comb_thr_b3_cent(1:3,icount,i,j)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -1,27 +1,47 @@
|
||||
BEGIN_PROVIDER [ double precision, ao_overlap,(ao_num,ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_x,(ao_num,ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_y,(ao_num,ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_z,(ao_num,ao_num) ]
|
||||
implicit none
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_overlap , (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_x, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_y, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_z, (ao_num, ao_num) ]
|
||||
|
||||
BEGIN_DOC
|
||||
! Overlap between atomic basis functions:
|
||||
!
|
||||
! :math:`\int \chi_i(r) \chi_j(r) dr`
|
||||
! Overlap between atomic basis functions:
|
||||
!
|
||||
! :math:`\int \chi_i(r) \chi_j(r) dr`
|
||||
END_DOC
|
||||
integer :: i,j,n,l
|
||||
double precision :: f
|
||||
integer :: dim1
|
||||
|
||||
implicit none
|
||||
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||
double precision :: overlap, overlap_x, overlap_y, overlap_z
|
||||
double precision :: alpha, beta, c
|
||||
double precision :: A_center(3), B_center(3)
|
||||
integer :: power_A(3), power_B(3)
|
||||
|
||||
ao_overlap = 0.d0
|
||||
ao_overlap_x = 0.d0
|
||||
ao_overlap_y = 0.d0
|
||||
ao_overlap_z = 0.d0
|
||||
if (read_ao_integrals_overlap) then
|
||||
|
||||
if(read_ao_integrals_overlap) then
|
||||
|
||||
call ezfio_get_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
|
||||
print *, 'AO overlap integrals read from disk'
|
||||
|
||||
else
|
||||
|
||||
if(use_cosgtos) then
|
||||
!print*, ' use_cosgtos for ao_overlap ?', use_cosgtos
|
||||
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
ao_overlap (i,j) = ao_overlap_cosgtos (i,j)
|
||||
ao_overlap_x(i,j) = ao_overlap_cosgtos_x(i,j)
|
||||
ao_overlap_y(i,j) = ao_overlap_cosgtos_y(i,j)
|
||||
ao_overlap_z(i,j) = ao_overlap_cosgtos_z(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
dim1=100
|
||||
@ -69,7 +89,11 @@
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
if (write_ao_integrals_overlap) then
|
||||
call ezfio_set_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
|
||||
print *, 'AO overlap integrals written to disk'
|
||||
@ -77,6 +101,8 @@
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -85,6 +111,8 @@ BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
||||
ao_overlap_imag = 0.d0
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -98,37 +126,39 @@ BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_overlap_abs, (ao_num, ao_num) ]
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Overlap between absolute values of atomic basis functions:
|
||||
!
|
||||
! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
|
||||
! Overlap between absolute values of atomic basis functions:
|
||||
!
|
||||
! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
|
||||
END_DOC
|
||||
integer :: i,j,n,l
|
||||
double precision :: f
|
||||
integer :: dim1
|
||||
double precision :: overlap, overlap_x, overlap_y, overlap_z
|
||||
|
||||
implicit none
|
||||
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||
double precision :: overlap_x, overlap_y, overlap_z
|
||||
double precision :: alpha, beta
|
||||
double precision :: A_center(3), B_center(3)
|
||||
integer :: power_A(3), power_B(3)
|
||||
double precision :: lower_exp_val, dx
|
||||
if (is_periodic) then
|
||||
do j=1,ao_num
|
||||
do i= 1,ao_num
|
||||
ao_overlap_abs(i,j)= cdabs(ao_overlap_complex(i,j))
|
||||
|
||||
if(is_periodic) then
|
||||
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
ao_overlap_abs(i,j) = cdabs(ao_overlap_complex(i,j))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
dim1=100
|
||||
lower_exp_val = 40.d0
|
||||
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(A_center,B_center,power_A,power_B, &
|
||||
!$OMP overlap_x,overlap_y, overlap_z, overlap, &
|
||||
!$OMP overlap_x,overlap_y, overlap_z, &
|
||||
!$OMP alpha, beta,i,j,dx) &
|
||||
!$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
|
||||
!$OMP ao_overlap_abs,ao_num,ao_coef_normalized_ordered_transp,ao_nucl,&
|
||||
@ -161,9 +191,13 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
|
210
src/ao_one_e_ints/aos_cosgtos.irp.f
Normal file
210
src/ao_one_e_ints/aos_cosgtos.irp.f
Normal file
@ -0,0 +1,210 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_coef_norm_ord_transp_cosgtos, (ao_prim_num_max, ao_num) ]
|
||||
|
||||
implicit none
|
||||
integer :: i, j
|
||||
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_prim_num_max
|
||||
ao_coef_norm_ord_transp_cosgtos(i,j) = ao_coef_norm_ord_cosgtos(j,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ complex*16, ao_expo_ord_transp_cosgtos, (ao_prim_num_max, ao_num) ]
|
||||
|
||||
implicit none
|
||||
integer :: i, j
|
||||
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_prim_num_max
|
||||
ao_expo_ord_transp_cosgtos(i,j) = ao_expo_ord_cosgtos(j,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_coef_norm_cosgtos, (ao_num, ao_prim_num_max) ]
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: i, j, powA(3), nz
|
||||
double precision :: norm
|
||||
complex*16 :: overlap_x, overlap_y, overlap_z, C_A(3)
|
||||
complex*16 :: integ1, integ2, expo
|
||||
|
||||
nz = 100
|
||||
|
||||
C_A(1) = (0.d0, 0.d0)
|
||||
C_A(2) = (0.d0, 0.d0)
|
||||
C_A(3) = (0.d0, 0.d0)
|
||||
|
||||
ao_coef_norm_cosgtos = 0.d0
|
||||
|
||||
do i = 1, ao_num
|
||||
|
||||
powA(1) = ao_power(i,1)
|
||||
powA(2) = ao_power(i,2)
|
||||
powA(3) = ao_power(i,3)
|
||||
|
||||
! Normalization of the primitives
|
||||
if(primitives_normalized) then
|
||||
|
||||
do j = 1, ao_prim_num(i)
|
||||
|
||||
expo = ao_expo(i,j) + (0.d0, 1.d0) * ao_expoim_cosgtos(i,j)
|
||||
|
||||
call overlap_cgaussian_xyz(C_A, C_A, expo, expo, powA, powA, overlap_x, overlap_y, overlap_z, integ1, nz)
|
||||
call overlap_cgaussian_xyz(C_A, C_A, conjg(expo), expo, powA, powA, overlap_x, overlap_y, overlap_z, integ2, nz)
|
||||
|
||||
norm = 2.d0 * real( integ1 + integ2 )
|
||||
|
||||
ao_coef_norm_cosgtos(i,j) = ao_coef(i,j) / dsqrt(norm)
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
do j = 1, ao_prim_num(i)
|
||||
ao_coef_norm_cosgtos(i,j) = ao_coef(i,j)
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_coef_norm_ord_cosgtos, (ao_num, ao_prim_num_max) ]
|
||||
&BEGIN_PROVIDER [ complex*16 , ao_expo_ord_cosgtos, (ao_num, ao_prim_num_max) ]
|
||||
|
||||
implicit none
|
||||
integer :: i, j
|
||||
integer :: iorder(ao_prim_num_max)
|
||||
double precision :: d(ao_prim_num_max,3)
|
||||
|
||||
d = 0.d0
|
||||
|
||||
do i = 1, ao_num
|
||||
|
||||
do j = 1, ao_prim_num(i)
|
||||
iorder(j) = j
|
||||
d(j,1) = ao_expo(i,j)
|
||||
d(j,2) = ao_coef_norm_cosgtos(i,j)
|
||||
d(j,3) = ao_expoim_cosgtos(i,j)
|
||||
enddo
|
||||
|
||||
call dsort (d(1,1), iorder, ao_prim_num(i))
|
||||
call dset_order(d(1,2), iorder, ao_prim_num(i))
|
||||
call dset_order(d(1,3), iorder, ao_prim_num(i))
|
||||
|
||||
do j = 1, ao_prim_num(i)
|
||||
ao_expo_ord_cosgtos (i,j) = d(j,1) + (0.d0, 1.d0) * d(j,3)
|
||||
ao_coef_norm_ord_cosgtos(i,j) = d(j,2)
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_x, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_y, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_z, (ao_num, ao_num) ]
|
||||
|
||||
implicit none
|
||||
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||
double precision :: c, overlap, overlap_x, overlap_y, overlap_z
|
||||
complex*16 :: alpha, beta, A_center(3), B_center(3)
|
||||
complex*16 :: overlap1, overlap_x1, overlap_y1, overlap_z1
|
||||
complex*16 :: overlap2, overlap_x2, overlap_y2, overlap_z2
|
||||
|
||||
ao_overlap_cosgtos = 0.d0
|
||||
ao_overlap_cosgtos_x = 0.d0
|
||||
ao_overlap_cosgtos_y = 0.d0
|
||||
ao_overlap_cosgtos_z = 0.d0
|
||||
|
||||
dim1 = 100
|
||||
|
||||
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE( A_center, B_center, power_A, power_B, alpha, beta, i, j, n, l, c &
|
||||
!$OMP , overlap_x , overlap_y , overlap_z , overlap &
|
||||
!$OMP , overlap_x1, overlap_y1, overlap_z1, overlap1 &
|
||||
!$OMP , overlap_x2, overlap_y2, overlap_z2, overlap2 ) &
|
||||
!$OMP SHARED( nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1 &
|
||||
!$OMP , ao_overlap_cosgtos_x, ao_overlap_cosgtos_y, ao_overlap_cosgtos_z, ao_overlap_cosgtos &
|
||||
!$OMP , ao_coef_norm_ord_transp_cosgtos, ao_expo_ord_transp_cosgtos )
|
||||
|
||||
do j = 1, ao_num
|
||||
|
||||
A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0)
|
||||
A_center(2) = nucl_coord(ao_nucl(j),2) * (1.d0, 0.d0)
|
||||
A_center(3) = nucl_coord(ao_nucl(j),3) * (1.d0, 0.d0)
|
||||
power_A(1) = ao_power(j,1)
|
||||
power_A(2) = ao_power(j,2)
|
||||
power_A(3) = ao_power(j,3)
|
||||
|
||||
do i = 1, ao_num
|
||||
|
||||
B_center(1) = nucl_coord(ao_nucl(i),1) * (1.d0, 0.d0)
|
||||
B_center(2) = nucl_coord(ao_nucl(i),2) * (1.d0, 0.d0)
|
||||
B_center(3) = nucl_coord(ao_nucl(i),3) * (1.d0, 0.d0)
|
||||
power_B(1) = ao_power(i,1)
|
||||
power_B(2) = ao_power(i,2)
|
||||
power_B(3) = ao_power(i,3)
|
||||
|
||||
do n = 1, ao_prim_num(j)
|
||||
alpha = ao_expo_ord_transp_cosgtos(n,j)
|
||||
|
||||
do l = 1, ao_prim_num(i)
|
||||
c = ao_coef_norm_ord_transp_cosgtos(n,j) * ao_coef_norm_ord_transp_cosgtos(l,i)
|
||||
beta = ao_expo_ord_transp_cosgtos(l,i)
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_x1, overlap_y1, overlap_z1, overlap1, dim1 )
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, conjg(alpha), beta, power_A, power_B &
|
||||
, overlap_x2, overlap_y2, overlap_z2, overlap2, dim1 )
|
||||
|
||||
overlap_x = 2.d0 * real( overlap_x1 + overlap_x2 )
|
||||
overlap_y = 2.d0 * real( overlap_y1 + overlap_y2 )
|
||||
overlap_z = 2.d0 * real( overlap_z1 + overlap_z2 )
|
||||
overlap = 2.d0 * real( overlap1 + overlap2 )
|
||||
|
||||
ao_overlap_cosgtos(i,j) = ao_overlap_cosgtos(i,j) + c * overlap
|
||||
|
||||
if( isnan(ao_overlap_cosgtos(i,j)) ) then
|
||||
print*,'i, j', i, j
|
||||
print*,'l, n', l, n
|
||||
print*,'c, overlap', c, overlap
|
||||
print*, overlap_x, overlap_y, overlap_z
|
||||
stop
|
||||
endif
|
||||
|
||||
ao_overlap_cosgtos_x(i,j) = ao_overlap_cosgtos_x(i,j) + c * overlap_x
|
||||
ao_overlap_cosgtos_y(i,j) = ao_overlap_cosgtos_y(i,j) + c * overlap_y
|
||||
ao_overlap_cosgtos_z(i,j) = ao_overlap_cosgtos_z(i,j) + c * overlap_z
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
|
@ -1,7 +1,10 @@
|
||||
BEGIN_PROVIDER [ double precision, ao_deriv2_x,(ao_num,ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_deriv2_y,(ao_num,ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_deriv2_z,(ao_num,ao_num) ]
|
||||
implicit none
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_deriv2_x, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_deriv2_y, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_deriv2_z, (ao_num, ao_num) ]
|
||||
|
||||
BEGIN_DOC
|
||||
! Second derivative matrix elements in the |AO| basis.
|
||||
!
|
||||
@ -11,15 +14,28 @@
|
||||
! \langle \chi_i(x,y,z) | \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
|
||||
!
|
||||
END_DOC
|
||||
integer :: i,j,n,l
|
||||
double precision :: f
|
||||
integer :: dim1
|
||||
|
||||
implicit none
|
||||
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||
double precision :: overlap, overlap_y, overlap_z
|
||||
double precision :: overlap_x0, overlap_y0, overlap_z0
|
||||
double precision :: alpha, beta, c
|
||||
double precision :: A_center(3), B_center(3)
|
||||
integer :: power_A(3), power_B(3)
|
||||
double precision :: d_a_2,d_2
|
||||
|
||||
if(use_cosgtos) then
|
||||
!print*, 'use_cosgtos for ao_kinetic_integrals ?', use_cosgtos
|
||||
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
ao_deriv2_x(i,j) = ao_deriv2_cosgtos_x(i,j)
|
||||
ao_deriv2_y(i,j) = ao_deriv2_cosgtos_y(i,j)
|
||||
ao_deriv2_z(i,j) = ao_deriv2_cosgtos_z(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
dim1=100
|
||||
|
||||
! -- Dummy call to provide everything
|
||||
@ -36,7 +52,7 @@
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(A_center,B_center,power_A,power_B,&
|
||||
!$OMP overlap_y, overlap_z, overlap, &
|
||||
!$OMP alpha, beta,i,j,c,d_a_2,d_2,deriv_tmp, &
|
||||
!$OMP alpha, beta, n, l, i,j,c,d_a_2,d_2,deriv_tmp, &
|
||||
!$OMP overlap_x0,overlap_y0,overlap_z0) &
|
||||
!$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
|
||||
!$OMP ao_deriv2_x,ao_deriv2_y,ao_deriv2_z,ao_num,ao_coef_normalized_ordered_transp,ao_nucl, &
|
||||
@ -117,8 +133,12 @@
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
|
535
src/ao_one_e_ints/one_e_Coul_integrals_cosgtos.irp.f
Normal file
535
src/ao_one_e_ints/one_e_Coul_integrals_cosgtos.irp.f
Normal file
@ -0,0 +1,535 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cosgtos, (ao_num, ao_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Nucleus-electron interaction, in the cosgtos |AO| basis set.
|
||||
!
|
||||
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: num_A, num_B, power_A(3), power_B(3)
|
||||
integer :: i, j, k, l, n_pt_in, m
|
||||
double precision :: c, Z, A_center(3), B_center(3), C_center(3)
|
||||
complex*16 :: alpha, beta, c1, c2
|
||||
|
||||
complex*16 :: NAI_pol_mult_cosgtos
|
||||
|
||||
ao_integrals_n_e_cosgtos = 0.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE ( i, j, k, l, m, alpha, beta, A_center, B_center, C_center &
|
||||
!$OMP , power_A, power_B, num_A, num_B, Z, c, c1, c2, n_pt_in ) &
|
||||
!$OMP SHARED ( ao_num, ao_prim_num, ao_nucl, nucl_coord, ao_power, nucl_num, nucl_charge &
|
||||
!$OMP , ao_expo_ord_transp_cosgtos, ao_coef_norm_ord_transp_cosgtos &
|
||||
!$OMP , n_pt_max_integrals, ao_integrals_n_e_cosgtos )
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
|
||||
do j = 1, ao_num
|
||||
num_A = ao_nucl(j)
|
||||
power_A(1:3) = ao_power(j,1:3)
|
||||
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||
|
||||
do i = 1, ao_num
|
||||
num_B = ao_nucl(i)
|
||||
power_B(1:3) = ao_power(i,1:3)
|
||||
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||
|
||||
do l = 1, ao_prim_num(j)
|
||||
alpha = ao_expo_ord_transp_cosgtos(l,j)
|
||||
|
||||
do m = 1, ao_prim_num(i)
|
||||
beta = ao_expo_ord_transp_cosgtos(m,i)
|
||||
|
||||
c = 0.d0
|
||||
do k = 1, nucl_num
|
||||
|
||||
Z = nucl_charge(k)
|
||||
|
||||
C_center(1:3) = nucl_coord(k,1:3)
|
||||
|
||||
!print *, ' '
|
||||
!print *, A_center, B_center, C_center, power_A, power_B
|
||||
!print *, real(alpha), real(beta)
|
||||
|
||||
c1 = NAI_pol_mult_cosgtos( A_center, B_center, power_A, power_B &
|
||||
, alpha, beta, C_center, n_pt_in )
|
||||
|
||||
!c2 = c1
|
||||
c2 = NAI_pol_mult_cosgtos( A_center, B_center, power_A, power_B &
|
||||
, conjg(alpha), beta, C_center, n_pt_in )
|
||||
|
||||
!print *, ' c1 = ', real(c1)
|
||||
!print *, ' c2 = ', real(c2)
|
||||
|
||||
c = c - Z * 2.d0 * real(c1 + c2)
|
||||
|
||||
enddo
|
||||
ao_integrals_n_e_cosgtos(i,j) = ao_integrals_n_e_cosgtos(i,j) &
|
||||
+ ao_coef_norm_ord_transp_cosgtos(l,j) &
|
||||
* ao_coef_norm_ord_transp_cosgtos(m,i) * c
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the electron-nucleus attraction with two primitves cosgtos.
|
||||
!
|
||||
! :math:`\langle g_i | \frac{1}{|r-R_c|} | g_j \rangle`
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer, intent(in) :: n_pt_in, power_A(3), power_B(3)
|
||||
double precision, intent(in) :: C_center(3), A_center(3), B_center(3)
|
||||
complex*16, intent(in) :: alpha, beta
|
||||
|
||||
integer :: i, n_pt, n_pt_out
|
||||
double precision :: dist, const_mod
|
||||
complex*16 :: p, p_inv, rho, dist_integral, const, const_factor, coeff, factor
|
||||
complex*16 :: accu, P_center(3)
|
||||
complex*16 :: d(0:n_pt_in)
|
||||
|
||||
complex*16 :: V_n_e_cosgtos
|
||||
complex*16 :: crint
|
||||
|
||||
if ( (A_center(1)/=B_center(1)) .or. (A_center(2)/=B_center(2)) .or. (A_center(3)/=B_center(3)) .or. &
|
||||
(A_center(1)/=C_center(1)) .or. (A_center(2)/=C_center(2)) .or. (A_center(3)/=C_center(3)) ) then
|
||||
|
||||
continue
|
||||
|
||||
else
|
||||
|
||||
NAI_pol_mult_cosgtos = V_n_e_cosgtos( power_A(1), power_A(2), power_A(3) &
|
||||
, power_B(1), power_B(2), power_B(3) &
|
||||
, alpha, beta )
|
||||
return
|
||||
|
||||
endif
|
||||
|
||||
p = alpha + beta
|
||||
p_inv = (1.d0, 0.d0) / p
|
||||
rho = alpha * beta * p_inv
|
||||
|
||||
dist = 0.d0
|
||||
dist_integral = (0.d0, 0.d0)
|
||||
do i = 1, 3
|
||||
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
||||
dist += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
|
||||
dist_integral += (P_center(i) - C_center(i)) * (P_center(i) - C_center(i))
|
||||
enddo
|
||||
|
||||
const_factor = dist * rho
|
||||
const = p * dist_integral
|
||||
|
||||
const_mod = dsqrt(real(const_factor)*real(const_factor) + aimag(const_factor)*aimag(const_factor))
|
||||
if(const_mod > 80.d0) then
|
||||
NAI_pol_mult_cosgtos = (0.d0, 0.d0)
|
||||
return
|
||||
endif
|
||||
|
||||
factor = zexp(-const_factor)
|
||||
coeff = dtwo_pi * factor * p_inv
|
||||
|
||||
do i = 0, n_pt_in
|
||||
d(i) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
n_pt = 2 * ( (power_A(1) + power_B(1)) + (power_A(2) + power_B(2)) + (power_A(3) + power_B(3)) )
|
||||
if(n_pt == 0) then
|
||||
NAI_pol_mult_cosgtos = coeff * crint(0, const)
|
||||
return
|
||||
endif
|
||||
|
||||
call give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
|
||||
, power_A, power_B, C_center, n_pt_in, d, n_pt_out)
|
||||
|
||||
if(n_pt_out < 0) then
|
||||
NAI_pol_mult_cosgtos = (0.d0, 0.d0)
|
||||
return
|
||||
endif
|
||||
|
||||
accu = (0.d0, 0.d0)
|
||||
do i = 0, n_pt_out, 2
|
||||
accu += crint(shiftr(i, 1), const) * d(i)
|
||||
|
||||
! print *, shiftr(i, 1), real(const), real(d(i)), real(crint(shiftr(i, 1), const))
|
||||
enddo
|
||||
NAI_pol_mult_cosgtos = accu * coeff
|
||||
|
||||
end function NAI_pol_mult_cosgtos
|
||||
|
||||
! ---
|
||||
|
||||
subroutine give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
|
||||
, power_A, power_B, C_center, n_pt_in, d, n_pt_out)
|
||||
|
||||
BEGIN_DOC
|
||||
! Returns the explicit polynomial in terms of the "t" variable of the following
|
||||
!
|
||||
! $I_{x1}(a_x, d_x,p,q) \times I_{x1}(a_y, d_y,p,q) \times I_{x1}(a_z, d_z,p,q)$.
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n_pt_in, power_A(3), power_B(3)
|
||||
double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
|
||||
complex*16, intent(in) :: alpha, beta
|
||||
integer, intent(out) :: n_pt_out
|
||||
complex*16, intent(out) :: d(0:n_pt_in)
|
||||
|
||||
integer :: a_x, b_x, a_y, b_y, a_z, b_z
|
||||
integer :: n_pt1, n_pt2, n_pt3, dim, i, n_pt_tmp
|
||||
complex*16 :: p, P_center(3), rho, p_inv, p_inv_2
|
||||
complex*16 :: R1x(0:2), B01(0:2), R1xp(0:2),R2x(0:2)
|
||||
complex*16 :: d1(0:n_pt_in), d2(0:n_pt_in), d3(0:n_pt_in)
|
||||
|
||||
ASSERT (n_pt_in > 1)
|
||||
|
||||
p = alpha + beta
|
||||
p_inv = (1.d0, 0.d0) / p
|
||||
p_inv_2 = 0.5d0 * p_inv
|
||||
|
||||
do i = 1, 3
|
||||
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
||||
enddo
|
||||
|
||||
do i = 0, n_pt_in
|
||||
d(i) = (0.d0, 0.d0)
|
||||
d1(i) = (0.d0, 0.d0)
|
||||
d2(i) = (0.d0, 0.d0)
|
||||
d3(i) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
n_pt1 = n_pt_in
|
||||
|
||||
R1x(0) = (P_center(1) - A_center(1))
|
||||
R1x(1) = (0.d0, 0.d0)
|
||||
R1x(2) = -(P_center(1) - C_center(1))
|
||||
|
||||
R1xp(0) = (P_center(1) - B_center(1))
|
||||
R1xp(1) = (0.d0, 0.d0)
|
||||
R1xp(2) = -(P_center(1) - C_center(1))
|
||||
|
||||
R2x(0) = p_inv_2
|
||||
R2x(1) = (0.d0, 0.d0)
|
||||
R2x(2) = -p_inv_2
|
||||
|
||||
a_x = power_A(1)
|
||||
b_x = power_B(1)
|
||||
call I_x1_pol_mult_one_e_cosgtos(a_x, b_x, R1x, R1xp, R2x, d1, n_pt1, n_pt_in)
|
||||
|
||||
if(n_pt1 < 0) then
|
||||
n_pt_out = -1
|
||||
do i = 0, n_pt_in
|
||||
d(i) = (0.d0, 0.d0)
|
||||
enddo
|
||||
return
|
||||
endif
|
||||
|
||||
! ---
|
||||
|
||||
n_pt2 = n_pt_in
|
||||
|
||||
R1x(0) = (P_center(2) - A_center(2))
|
||||
R1x(1) = (0.d0, 0.d0)
|
||||
R1x(2) = -(P_center(2) - C_center(2))
|
||||
|
||||
R1xp(0) = (P_center(2) - B_center(2))
|
||||
R1xp(1) = (0.d0, 0.d0)
|
||||
R1xp(2) = -(P_center(2) - C_center(2))
|
||||
|
||||
a_y = power_A(2)
|
||||
b_y = power_B(2)
|
||||
call I_x1_pol_mult_one_e_cosgtos(a_y, b_y, R1x, R1xp, R2x, d2, n_pt2, n_pt_in)
|
||||
|
||||
if(n_pt2 < 0) then
|
||||
n_pt_out = -1
|
||||
do i = 0, n_pt_in
|
||||
d(i) = (0.d0, 0.d0)
|
||||
enddo
|
||||
return
|
||||
endif
|
||||
|
||||
! ---
|
||||
|
||||
n_pt3 = n_pt_in
|
||||
|
||||
R1x(0) = (P_center(3) - A_center(3))
|
||||
R1x(1) = (0.d0, 0.d0)
|
||||
R1x(2) = -(P_center(3) - C_center(3))
|
||||
|
||||
R1xp(0) = (P_center(3) - B_center(3))
|
||||
R1xp(1) = (0.d0, 0.d0)
|
||||
R1xp(2) = -(P_center(3) - C_center(3))
|
||||
|
||||
a_z = power_A(3)
|
||||
b_z = power_B(3)
|
||||
call I_x1_pol_mult_one_e_cosgtos(a_z, b_z, R1x, R1xp, R2x, d3, n_pt3, n_pt_in)
|
||||
|
||||
if(n_pt3 < 0) then
|
||||
n_pt_out = -1
|
||||
do i = 0, n_pt_in
|
||||
d(i) = (0.d0, 0.d0)
|
||||
enddo
|
||||
return
|
||||
endif
|
||||
|
||||
! ---
|
||||
|
||||
n_pt_tmp = 0
|
||||
call multiply_cpoly(d1, n_pt1, d2, n_pt2, d, n_pt_tmp)
|
||||
do i = 0, n_pt_tmp
|
||||
d1(i) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
n_pt_out = 0
|
||||
call multiply_cpoly(d, n_pt_tmp, d3, n_pt3, d1, n_pt_out)
|
||||
do i = 0, n_pt_out
|
||||
d(i) = d1(i)
|
||||
enddo
|
||||
|
||||
end subroutine give_cpolynomial_mult_center_one_e
|
||||
|
||||
! ---
|
||||
|
||||
recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_pt_in)
|
||||
|
||||
BEGIN_DOC
|
||||
! Recursive routine involved in the electron-nucleus potential
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer, intent(in) :: a, c, n_pt_in
|
||||
complex*16, intent(in) :: R1x(0:2), R1xp(0:2), R2x(0:2)
|
||||
integer, intent(inout) :: nd
|
||||
complex*16, intent(inout) :: d(0:n_pt_in)
|
||||
|
||||
integer :: nx, ix, dim, iy, ny
|
||||
complex*16 :: X(0:max_dim)
|
||||
complex*16 :: Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
|
||||
|
||||
dim = n_pt_in
|
||||
|
||||
if( (a==0) .and. (c==0)) then
|
||||
|
||||
nd = 0
|
||||
d(0) = (1.d0, 0.d0)
|
||||
return
|
||||
|
||||
elseif( (c < 0) .or. (nd < 0) ) then
|
||||
|
||||
nd = -1
|
||||
return
|
||||
|
||||
elseif((a == 0) .and. (c .ne. 0)) then
|
||||
|
||||
call I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, n_pt_in)
|
||||
|
||||
elseif(a == 1) then
|
||||
|
||||
nx = nd
|
||||
do ix = 0, n_pt_in
|
||||
X(ix) = (0.d0, 0.d0)
|
||||
Y(ix) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
call I_x2_pol_mult_one_e_cosgtos(c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
|
||||
|
||||
do ix = 0, nx
|
||||
X(ix) *= dble(c)
|
||||
enddo
|
||||
|
||||
call multiply_cpoly(X, nx, R2x, 2, d, nd)
|
||||
|
||||
ny = 0
|
||||
call I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, Y, ny, n_pt_in)
|
||||
call multiply_cpoly(Y, ny, R1x, 2, d, nd)
|
||||
|
||||
else
|
||||
|
||||
nx = 0
|
||||
do ix = 0, n_pt_in
|
||||
X(ix) = (0.d0, 0.d0)
|
||||
Y(ix) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
call I_x1_pol_mult_one_e_cosgtos(a-2, c, R1x, R1xp, R2x, X, nx, n_pt_in)
|
||||
|
||||
do ix = 0, nx
|
||||
X(ix) *= dble(a-1)
|
||||
enddo
|
||||
call multiply_cpoly(X, nx, R2x, 2, d, nd)
|
||||
|
||||
nx = nd
|
||||
do ix = 0, n_pt_in
|
||||
X(ix) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
call I_x1_pol_mult_one_e_cosgtos(a-1, c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
|
||||
do ix = 0, nx
|
||||
X(ix) *= dble(c)
|
||||
enddo
|
||||
|
||||
call multiply_cpoly(X, nx, R2x, 2, d, nd)
|
||||
|
||||
ny = 0
|
||||
call I_x1_pol_mult_one_e_cosgtos(a-1, c, R1x, R1xp, R2x, Y, ny, n_pt_in)
|
||||
call multiply_cpoly(Y, ny, R1x, 2, d, nd)
|
||||
|
||||
endif
|
||||
|
||||
end subroutine I_x1_pol_mult_one_e_cosgtos
|
||||
|
||||
! ---
|
||||
|
||||
recursive subroutine I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, dim)
|
||||
|
||||
BEGIN_DOC
|
||||
! Recursive routine involved in the electron-nucleus potential
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer, intent(in) :: dim, c
|
||||
complex*16, intent(in) :: R1x(0:2), R1xp(0:2), R2x(0:2)
|
||||
integer, intent(inout) :: nd
|
||||
complex*16, intent(out) :: d(0:max_dim)
|
||||
|
||||
integer :: i, nx, ix, ny
|
||||
complex*16 :: X(0:max_dim), Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
|
||||
|
||||
if(c == 0) then
|
||||
|
||||
nd = 0
|
||||
d(0) = (1.d0, 0.d0)
|
||||
return
|
||||
|
||||
elseif((nd < 0) .or. (c < 0)) then
|
||||
|
||||
nd = -1
|
||||
return
|
||||
|
||||
else
|
||||
|
||||
nx = 0
|
||||
do ix = 0, dim
|
||||
X(ix) = (0.d0, 0.d0)
|
||||
Y(ix) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
call I_x1_pol_mult_one_e_cosgtos(0, c-2, R1x, R1xp, R2x, X, nx, dim)
|
||||
|
||||
do ix = 0, nx
|
||||
X(ix) *= dble(c-1)
|
||||
enddo
|
||||
|
||||
call multiply_cpoly(X, nx, R2x, 2, d, nd)
|
||||
|
||||
ny = 0
|
||||
do ix = 0, dim
|
||||
Y(ix) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
call I_x1_pol_mult_one_e_cosgtos(0, c-1, R1x, R1xp, R2x, Y, ny, dim)
|
||||
|
||||
if(ny .ge. 0) then
|
||||
call multiply_cpoly(Y, ny, R1xp, 2, d, nd)
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
end subroutine I_x2_pol_mult_one_e_cosgtos
|
||||
|
||||
! ---
|
||||
|
||||
complex*16 function V_n_e_cosgtos(a_x, a_y, a_z, b_x, b_y, b_z, alpha, beta)
|
||||
|
||||
BEGIN_DOC
|
||||
! Primitve nuclear attraction between the two primitves centered on the same atom.
|
||||
!
|
||||
! $p_1 = x^{a_x} y^{a_y} z^{a_z} \exp(-\alpha r^2)$
|
||||
!
|
||||
! $p_2 = x^{b_x} y^{b_y} z^{b_z} \exp(-\beta r^2)$
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: a_x, a_y, a_z, b_x, b_y, b_z
|
||||
complex*16, intent(in) :: alpha, beta
|
||||
|
||||
double precision :: V_phi, V_theta
|
||||
complex*16 :: V_r_cosgtos
|
||||
|
||||
if( (iand(a_x + b_x, 1) == 1) .or. &
|
||||
(iand(a_y + b_y, 1) == 1) .or. &
|
||||
(iand(a_z + b_z, 1) == 1) ) then
|
||||
|
||||
V_n_e_cosgtos = (0.d0, 0.d0)
|
||||
|
||||
else
|
||||
|
||||
V_n_e_cosgtos = V_r_cosgtos(a_x + b_x + a_y + b_y + a_z + b_z + 1, alpha + beta) &
|
||||
* V_phi(a_x + b_x, a_y + b_y) &
|
||||
* V_theta(a_z + b_z, a_x + b_x + a_y + b_y + 1)
|
||||
endif
|
||||
|
||||
end function V_n_e_cosgtos
|
||||
|
||||
! ---
|
||||
|
||||
complex*16 function V_r_cosgtos(n, alpha)
|
||||
|
||||
BEGIN_DOC
|
||||
! Computes the radial part of the nuclear attraction integral:
|
||||
!
|
||||
! $\int_{0}^{\infty} r^n \exp(-\alpha r^2) dr$
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer , intent(in) :: n
|
||||
complex*16, intent(in) :: alpha
|
||||
|
||||
double precision :: fact
|
||||
|
||||
if(iand(n, 1) .eq. 1) then
|
||||
V_r_cosgtos = 0.5d0 * fact(shiftr(n, 1)) / (alpha**(shiftr(n, 1) + 1))
|
||||
else
|
||||
V_r_cosgtos = sqpi * fact(n) / fact(shiftr(n, 1)) * (0.5d0/zsqrt(alpha))**(n+1)
|
||||
endif
|
||||
|
||||
end function V_r_cosgtos
|
||||
|
||||
! ---
|
||||
|
223
src/ao_one_e_ints/one_e_kin_integrals_cosgtos.irp.f
Normal file
223
src/ao_one_e_ints/one_e_kin_integrals_cosgtos.irp.f
Normal file
@ -0,0 +1,223 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_x, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_y, (ao_num, ao_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_z, (ao_num, ao_num) ]
|
||||
|
||||
implicit none
|
||||
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||
double precision :: c, deriv_tmp
|
||||
complex*16 :: alpha, beta, A_center(3), B_center(3)
|
||||
complex*16 :: overlap_x, overlap_y, overlap_z, overlap
|
||||
complex*16 :: overlap_x0_1, overlap_y0_1, overlap_z0_1
|
||||
complex*16 :: overlap_x0_2, overlap_y0_2, overlap_z0_2
|
||||
complex*16 :: overlap_m2_1, overlap_p2_1
|
||||
complex*16 :: overlap_m2_2, overlap_p2_2
|
||||
complex*16 :: deriv_tmp_1, deriv_tmp_2
|
||||
|
||||
|
||||
dim1 = 100
|
||||
|
||||
! -- Dummy call to provide everything
|
||||
|
||||
A_center(:) = (0.0d0, 0.d0)
|
||||
B_center(:) = (1.0d0, 0.d0)
|
||||
alpha = (1.0d0, 0.d0)
|
||||
beta = (0.1d0, 0.d0)
|
||||
power_A = 1
|
||||
power_B = 0
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap, dim1 )
|
||||
|
||||
! ---
|
||||
|
||||
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE( A_center, B_center, power_A, power_B, alpha, beta, i, j, l, n, c &
|
||||
!$OMP , deriv_tmp, deriv_tmp_1, deriv_tmp_2 &
|
||||
!$OMP , overlap_x, overlap_y, overlap_z, overlap &
|
||||
!$OMP , overlap_m2_1, overlap_p2_1, overlap_m2_2, overlap_p2_2 &
|
||||
!$OMP , overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap_x0_2, overlap_y0_2, overlap_z0_2 ) &
|
||||
!$OMP SHARED( nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1 &
|
||||
!$OMP , ao_coef_norm_ord_transp_cosgtos, ao_expo_ord_transp_cosgtos &
|
||||
!$OMP , ao_deriv2_cosgtos_x, ao_deriv2_cosgtos_y, ao_deriv2_cosgtos_z )
|
||||
|
||||
do j = 1, ao_num
|
||||
A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0)
|
||||
A_center(2) = nucl_coord(ao_nucl(j),2) * (1.d0, 0.d0)
|
||||
A_center(3) = nucl_coord(ao_nucl(j),3) * (1.d0, 0.d0)
|
||||
power_A(1) = ao_power(j,1)
|
||||
power_A(2) = ao_power(j,2)
|
||||
power_A(3) = ao_power(j,3)
|
||||
|
||||
do i = 1, ao_num
|
||||
B_center(1) = nucl_coord(ao_nucl(i),1) * (1.d0, 0.d0)
|
||||
B_center(2) = nucl_coord(ao_nucl(i),2) * (1.d0, 0.d0)
|
||||
B_center(3) = nucl_coord(ao_nucl(i),3) * (1.d0, 0.d0)
|
||||
power_B(1) = ao_power(i,1)
|
||||
power_B(2) = ao_power(i,2)
|
||||
power_B(3) = ao_power(i,3)
|
||||
|
||||
ao_deriv2_cosgtos_x(i,j) = 0.d0
|
||||
ao_deriv2_cosgtos_y(i,j) = 0.d0
|
||||
ao_deriv2_cosgtos_z(i,j) = 0.d0
|
||||
|
||||
do n = 1, ao_prim_num(j)
|
||||
alpha = ao_expo_ord_transp_cosgtos(n,j)
|
||||
|
||||
do l = 1, ao_prim_num(i)
|
||||
c = ao_coef_norm_ord_transp_cosgtos(n,j) * ao_coef_norm_ord_transp_cosgtos(l,i)
|
||||
beta = ao_expo_ord_transp_cosgtos(l,i)
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap, dim1 )
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||
, overlap_x0_2, overlap_y0_2, overlap_z0_2, overlap, dim1 )
|
||||
|
||||
! ---
|
||||
|
||||
power_A(1) = power_A(1) - 2
|
||||
if(power_A(1) > -1) then
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_m2_1, overlap_y, overlap_z, overlap, dim1 )
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||
, overlap_m2_2, overlap_y, overlap_z, overlap, dim1 )
|
||||
else
|
||||
overlap_m2_1 = (0.d0, 0.d0)
|
||||
overlap_m2_2 = (0.d0, 0.d0)
|
||||
endif
|
||||
|
||||
power_A(1) = power_A(1) + 4
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_p2_1, overlap_y, overlap_z, overlap, dim1 )
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||
, overlap_p2_2, overlap_y, overlap_z, overlap, dim1 )
|
||||
|
||||
power_A(1) = power_A(1) - 2
|
||||
|
||||
deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(1) + 1.d0) * overlap_x0_1 &
|
||||
+ power_A(1) * (power_A(1) - 1.d0) * overlap_m2_1 &
|
||||
+ 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_y0_1 * overlap_z0_1
|
||||
|
||||
deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(1) + 1.d0) * overlap_x0_2 &
|
||||
+ power_A(1) * (power_A(1) - 1.d0) * overlap_m2_2 &
|
||||
+ 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_y0_2 * overlap_z0_2
|
||||
|
||||
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
|
||||
|
||||
ao_deriv2_cosgtos_x(i,j) += c * deriv_tmp
|
||||
|
||||
! ---
|
||||
|
||||
power_A(2) = power_A(2) - 2
|
||||
if(power_A(2) > -1) then
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_x, overlap_m2_1, overlap_y, overlap, dim1 )
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||
, overlap_x, overlap_m2_2, overlap_y, overlap, dim1 )
|
||||
else
|
||||
overlap_m2_1 = (0.d0, 0.d0)
|
||||
overlap_m2_2 = (0.d0, 0.d0)
|
||||
endif
|
||||
|
||||
power_A(2) = power_A(2) + 4
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_x, overlap_p2_1, overlap_y, overlap, dim1 )
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||
, overlap_x, overlap_p2_2, overlap_y, overlap, dim1 )
|
||||
|
||||
power_A(2) = power_A(2) - 2
|
||||
|
||||
deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(2) + 1.d0) * overlap_y0_1 &
|
||||
+ power_A(2) * (power_A(2) - 1.d0) * overlap_m2_1 &
|
||||
+ 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_x0_1 * overlap_z0_1
|
||||
|
||||
deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(2) + 1.d0) * overlap_y0_2 &
|
||||
+ power_A(2) * (power_A(2) - 1.d0) * overlap_m2_2 &
|
||||
+ 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_x0_2 * overlap_z0_2
|
||||
|
||||
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
|
||||
|
||||
ao_deriv2_cosgtos_y(i,j) += c * deriv_tmp
|
||||
|
||||
! ---
|
||||
|
||||
power_A(3) = power_A(3) - 2
|
||||
if(power_A(3) > -1) then
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_x, overlap_y, overlap_m2_1, overlap, dim1 )
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||
, overlap_x, overlap_y, overlap_m2_2, overlap, dim1 )
|
||||
else
|
||||
overlap_m2_1 = (0.d0, 0.d0)
|
||||
overlap_m2_2 = (0.d0, 0.d0)
|
||||
endif
|
||||
|
||||
power_A(3) = power_A(3) + 4
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||
, overlap_x, overlap_y, overlap_p2_1, overlap, dim1 )
|
||||
|
||||
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||
, overlap_x, overlap_y, overlap_p2_2, overlap, dim1 )
|
||||
|
||||
power_A(3) = power_A(3) - 2
|
||||
|
||||
deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(3) + 1.d0) * overlap_z0_1 &
|
||||
+ power_A(3) * (power_A(3) - 1.d0) * overlap_m2_1 &
|
||||
+ 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_x0_1 * overlap_y0_1
|
||||
|
||||
deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(3) + 1.d0) * overlap_z0_2 &
|
||||
+ power_A(3) * (power_A(3) - 1.d0) * overlap_m2_2 &
|
||||
+ 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_x0_2 * overlap_y0_2
|
||||
|
||||
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
|
||||
|
||||
ao_deriv2_cosgtos_z(i,j) += c * deriv_tmp
|
||||
|
||||
! ---
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, ao_kinetic_integrals_cosgtos, (ao_num, ao_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Kinetic energy integrals in the cosgtos |AO| basis.
|
||||
!
|
||||
! $\langle \chi_i |\hat{T}| \chi_j \rangle$
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j
|
||||
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i, j) &
|
||||
!$OMP SHARED(ao_num, ao_kinetic_integrals_cosgtos, ao_deriv2_cosgtos_x, ao_deriv2_cosgtos_y, ao_deriv2_cosgtos_z)
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
ao_kinetic_integrals_cosgtos(i,j) = -0.5d0 * ( ao_deriv2_cosgtos_x(i,j) &
|
||||
+ ao_deriv2_cosgtos_y(i,j) &
|
||||
+ ao_deriv2_cosgtos_z(i,j) )
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
@ -1,3 +1,6 @@
|
||||
|
||||
! ---
|
||||
|
||||
subroutine give_all_erf_kl_ao(integrals_ao,mu_in,C_center)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -15,36 +18,104 @@ subroutine give_all_erf_kl_ao(integrals_ao,mu_in,C_center)
|
||||
enddo
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
double precision function NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
|
||||
|
||||
double precision function NAI_pol_mult_erf_ao(i_ao,j_ao,mu_in,C_center)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
||||
!
|
||||
END_DOC
|
||||
integer, intent(in) :: i_ao,j_ao
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: mu_in, C_center(3)
|
||||
integer :: i,j,num_A,num_B, power_A(3), power_B(3), n_pt_in
|
||||
double precision :: A_center(3), B_center(3),integral, alpha,beta
|
||||
|
||||
integer :: i, j, num_A, num_B, power_A(3), power_B(3), n_pt_in
|
||||
double precision :: A_center(3), B_center(3), integral, alpha, beta
|
||||
|
||||
double precision :: NAI_pol_mult_erf
|
||||
|
||||
num_A = ao_nucl(i_ao)
|
||||
power_A(1:3)= ao_power(i_ao,1:3)
|
||||
power_A(1:3) = ao_power(i_ao,1:3)
|
||||
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||
num_B = ao_nucl(j_ao)
|
||||
power_B(1:3)= ao_power(j_ao,1:3)
|
||||
power_B(1:3) = ao_power(j_ao,1:3)
|
||||
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
NAI_pol_mult_erf_ao = 0.d0
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alpha = ao_expo_ordered_transp(i,i_ao)
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
beta = ao_expo_ordered_transp(j,j_ao)
|
||||
integral = NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)
|
||||
NAI_pol_mult_erf_ao += integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
|
||||
integral = NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in,mu_in)
|
||||
|
||||
NAI_pol_mult_erf_ao += integral * ao_coef_normalized_ordered_transp(j,j_ao) * ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
end function NAI_pol_mult_erf_ao
|
||||
|
||||
! ---
|
||||
|
||||
double precision function NAI_pol_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: beta, B_center(3)
|
||||
double precision, intent(in) :: mu_in, C_center(3)
|
||||
|
||||
integer :: i, j, power_A1(3), power_A2(3), n_pt_in
|
||||
double precision :: A1_center(3), A2_center(3), alpha1, alpha2, coef12, coef1, integral
|
||||
|
||||
double precision, external :: NAI_pol_mult_erf_with1s, NAI_pol_mult_erf_ao
|
||||
|
||||
ASSERT(beta .ge. 0.d0)
|
||||
if(beta .lt. 1d-10) then
|
||||
NAI_pol_mult_erf_ao_with1s = NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
|
||||
return
|
||||
endif
|
||||
|
||||
power_A1(1:3) = ao_power(i_ao,1:3)
|
||||
power_A2(1:3) = ao_power(j_ao,1:3)
|
||||
|
||||
A1_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
|
||||
A2_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
NAI_pol_mult_erf_ao_with1s = 0.d0
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alpha1 = ao_expo_ordered_transp (i,i_ao)
|
||||
coef1 = ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
alpha2 = ao_expo_ordered_transp(j,j_ao)
|
||||
coef12 = coef1 * ao_coef_normalized_ordered_transp(j,j_ao)
|
||||
if(dabs(coef12) .lt. 1d-14) cycle
|
||||
|
||||
integral = NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
|
||||
, beta, B_center, C_center, n_pt_in, mu_in )
|
||||
|
||||
NAI_pol_mult_erf_ao_with1s += integral * coef12
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end function NAI_pol_mult_erf_ao_with1s
|
||||
|
||||
! ---
|
||||
|
||||
double precision function NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
|
||||
@ -127,58 +198,221 @@ end function NAI_pol_mult_erf
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
double precision function NAI_pol_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center)
|
||||
subroutine NAI_pol_mult_erf_v(A_center, B_center, power_A, power_B, alpha, beta, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
||||
!
|
||||
! .. math::
|
||||
!
|
||||
! \int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||
! \frac{\erf(\mu |r - R_C |)}{| r - R_C |}$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: beta, B_center(3)
|
||||
double precision, intent(in) :: mu_in, C_center(3)
|
||||
|
||||
integer :: i, j, power_A1(3), power_A2(3), n_pt_in
|
||||
double precision :: A1_center(3), A2_center(3), alpha1, alpha2, coef12, coef1, integral
|
||||
integer, intent(in) :: n_pt_in, n_points, LD_C, LD_resv
|
||||
integer, intent(in) :: power_A(3), power_B(3)
|
||||
double precision, intent(in) :: A_center(3), B_center(3), alpha, beta, mu_in
|
||||
double precision, intent(in) :: C_center(LD_C,3)
|
||||
double precision, intent(out) :: res_v(LD_resv)
|
||||
|
||||
double precision, external :: NAI_pol_mult_erf_with1s, NAI_pol_mult_erf_ao
|
||||
integer :: i, n_pt, n_pt_out, ipoint
|
||||
double precision :: P_center(3)
|
||||
double precision :: d(0:n_pt_in), coeff, dist, const, factor
|
||||
double precision :: const_factor, dist_integral
|
||||
double precision :: accu, p_inv, p, rho, p_inv_2
|
||||
double precision :: p_new, p_new2, coef_tmp
|
||||
|
||||
ASSERT(beta .ge. 0.d0)
|
||||
if(beta .lt. 1d-10) then
|
||||
NAI_pol_mult_erf_ao_with1s = NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
|
||||
double precision :: rint
|
||||
|
||||
res_V(1:LD_resv) = 0.d0
|
||||
|
||||
p = alpha + beta
|
||||
p_inv = 1.d0 / p
|
||||
p_inv_2 = 0.5d0 * p_inv
|
||||
rho = alpha * beta * p_inv
|
||||
p_new = mu_in / dsqrt(p + mu_in * mu_in)
|
||||
p_new2 = p_new * p_new
|
||||
coef_tmp = p * p_new2
|
||||
|
||||
dist = 0.d0
|
||||
do i = 1, 3
|
||||
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
||||
dist += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
|
||||
enddo
|
||||
|
||||
const_factor = dist * rho
|
||||
if(const_factor > 80.d0) then
|
||||
return
|
||||
endif
|
||||
factor = dexp(-const_factor)
|
||||
coeff = dtwo_pi * factor * p_inv * p_new
|
||||
|
||||
n_pt = 2 * ( power_A(1) + power_B(1) + power_A(2) + power_B(2) + power_A(3) + power_B(3) )
|
||||
|
||||
if(n_pt == 0) then
|
||||
|
||||
do ipoint = 1, n_points
|
||||
dist_integral = 0.d0
|
||||
do i = 1, 3
|
||||
dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
|
||||
enddo
|
||||
const = coef_tmp * dist_integral
|
||||
|
||||
res_v(ipoint) = coeff * rint(0, const)
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
do ipoint = 1, n_points
|
||||
dist_integral = 0.d0
|
||||
do i = 1, 3
|
||||
dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
|
||||
enddo
|
||||
const = coef_tmp * dist_integral
|
||||
|
||||
do i = 0, n_pt_in
|
||||
d(i) = 0.d0
|
||||
enddo
|
||||
call give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center(ipoint,1:3), n_pt_in, d, n_pt_out, p_inv_2, p_new2, P_center)
|
||||
|
||||
if(n_pt_out < 0) then
|
||||
res_v(ipoint) = 0.d0
|
||||
cycle
|
||||
endif
|
||||
|
||||
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
||||
accu = 0.d0
|
||||
do i = 0, n_pt_out, 2
|
||||
accu += d(i) * rint(i/2, const)
|
||||
enddo
|
||||
|
||||
res_v(ipoint) = accu * coeff
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end subroutine NAI_pol_mult_erf_v
|
||||
|
||||
! ---
|
||||
|
||||
double precision function NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
|
||||
, beta, B_center, C_center, n_pt_in, mu_in )
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! .. math::
|
||||
!
|
||||
! \int dx (x - A1_x)^a_1 (x - B1_x)^a_2 \exp(-\alpha_1 (x - A1_x)^2 - \alpha_2 (x - A2_x)^2)
|
||||
! \int dy (y - A1_y)^b_1 (y - B1_y)^b_2 \exp(-\alpha_1 (y - A1_y)^2 - \alpha_2 (y - A2_y)^2)
|
||||
! \int dz (x - A1_z)^c_1 (z - B1_z)^c_2 \exp(-\alpha_1 (z - A1_z)^2 - \alpha_2 (z - A2_z)^2)
|
||||
! \exp(-\beta (r - B)^2)
|
||||
! \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: n_pt_in
|
||||
integer, intent(in) :: power_A1(3), power_A2(3)
|
||||
double precision, intent(in) :: C_center(3), A1_center(3), A2_center(3), B_center(3)
|
||||
double precision, intent(in) :: alpha1, alpha2, beta, mu_in
|
||||
|
||||
integer :: i, n_pt, n_pt_out
|
||||
double precision :: alpha12, alpha12_inv, alpha12_inv_2, rho12, A12_center(3), dist12, const_factor12
|
||||
double precision :: p, p_inv, p_inv_2, rho, P_center(3), dist, const_factor
|
||||
double precision :: dist_integral
|
||||
double precision :: d(0:n_pt_in), coeff, const, factor
|
||||
double precision :: accu
|
||||
double precision :: p_new
|
||||
|
||||
double precision :: rint
|
||||
|
||||
|
||||
! e^{-alpha1 (r - A1)^2} e^{-alpha2 (r - A2)^2} = e^{-K12} e^{-alpha12 (r - A12)^2}
|
||||
alpha12 = alpha1 + alpha2
|
||||
alpha12_inv = 1.d0 / alpha12
|
||||
alpha12_inv_2 = 0.5d0 * alpha12_inv
|
||||
rho12 = alpha1 * alpha2 * alpha12_inv
|
||||
A12_center(1) = (alpha1 * A1_center(1) + alpha2 * A2_center(1)) * alpha12_inv
|
||||
A12_center(2) = (alpha1 * A1_center(2) + alpha2 * A2_center(2)) * alpha12_inv
|
||||
A12_center(3) = (alpha1 * A1_center(3) + alpha2 * A2_center(3)) * alpha12_inv
|
||||
dist12 = (A1_center(1) - A2_center(1)) * (A1_center(1) - A2_center(1)) &
|
||||
+ (A1_center(2) - A2_center(2)) * (A1_center(2) - A2_center(2)) &
|
||||
+ (A1_center(3) - A2_center(3)) * (A1_center(3) - A2_center(3))
|
||||
|
||||
const_factor12 = dist12 * rho12
|
||||
if(const_factor12 > 80.d0) then
|
||||
NAI_pol_mult_erf_with1s = 0.d0
|
||||
return
|
||||
endif
|
||||
|
||||
power_A1(1:3) = ao_power(i_ao,1:3)
|
||||
power_A2(1:3) = ao_power(j_ao,1:3)
|
||||
! ---
|
||||
|
||||
A1_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
|
||||
A2_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
|
||||
! e^{-K12} e^{-alpha12 (r - A12)^2} e^{-beta (r - B)^2} = e^{-K} e^{-p (r - P)^2}
|
||||
p = alpha12 + beta
|
||||
p_inv = 1.d0 / p
|
||||
p_inv_2 = 0.5d0 * p_inv
|
||||
rho = alpha12 * beta * p_inv
|
||||
P_center(1) = (alpha12 * A12_center(1) + beta * B_center(1)) * p_inv
|
||||
P_center(2) = (alpha12 * A12_center(2) + beta * B_center(2)) * p_inv
|
||||
P_center(3) = (alpha12 * A12_center(3) + beta * B_center(3)) * p_inv
|
||||
dist = (A12_center(1) - B_center(1)) * (A12_center(1) - B_center(1)) &
|
||||
+ (A12_center(2) - B_center(2)) * (A12_center(2) - B_center(2)) &
|
||||
+ (A12_center(3) - B_center(3)) * (A12_center(3) - B_center(3))
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
const_factor = const_factor12 + dist * rho
|
||||
if(const_factor > 80.d0) then
|
||||
NAI_pol_mult_erf_with1s = 0.d0
|
||||
return
|
||||
endif
|
||||
|
||||
NAI_pol_mult_erf_ao_with1s = 0.d0
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alpha1 = ao_expo_ordered_transp (i,i_ao)
|
||||
coef1 = ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
dist_integral = (P_center(1) - C_center(1)) * (P_center(1) - C_center(1)) &
|
||||
+ (P_center(2) - C_center(2)) * (P_center(2) - C_center(2)) &
|
||||
+ (P_center(3) - C_center(3)) * (P_center(3) - C_center(3))
|
||||
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
alpha2 = ao_expo_ordered_transp(j,j_ao)
|
||||
coef12 = coef1 * ao_coef_normalized_ordered_transp(j,j_ao)
|
||||
if(dabs(coef12) .lt. 1d-14) cycle
|
||||
! ---
|
||||
|
||||
integral = NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
|
||||
, beta, B_center, C_center, n_pt_in, mu_in )
|
||||
p_new = mu_in / dsqrt(p + mu_in * mu_in)
|
||||
factor = dexp(-const_factor)
|
||||
coeff = dtwo_pi * factor * p_inv * p_new
|
||||
|
||||
NAI_pol_mult_erf_ao_with1s += integral * coef12
|
||||
enddo
|
||||
n_pt = 2 * ( (power_A1(1) + power_A2(1)) + (power_A1(2) + power_A2(2)) + (power_A1(3) + power_A2(3)) )
|
||||
const = p * dist_integral * p_new * p_new
|
||||
if(n_pt == 0) then
|
||||
NAI_pol_mult_erf_with1s = coeff * rint(0, const)
|
||||
return
|
||||
endif
|
||||
|
||||
do i = 0, n_pt_in
|
||||
d(i) = 0.d0
|
||||
enddo
|
||||
p_new = p_new * p_new
|
||||
call give_polynomial_mult_center_one_e_erf_opt( A1_center, A2_center, power_A1, power_A2, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
|
||||
|
||||
end function NAI_pol_mult_erf_ao_with1s
|
||||
if(n_pt_out < 0) then
|
||||
NAI_pol_mult_erf_with1s = 0.d0
|
||||
return
|
||||
endif
|
||||
|
||||
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
||||
accu = 0.d0
|
||||
do i = 0, n_pt_out, 2
|
||||
accu += d(i) * rint(i/2, const)
|
||||
enddo
|
||||
NAI_pol_mult_erf_with1s = accu * coeff
|
||||
|
||||
end function NAI_pol_mult_erf_with1s
|
||||
|
||||
! ---
|
||||
|
||||
subroutine NAI_pol_mult_erf_with1s_v(A1_center, A2_center, power_A1, power_A2, alpha1, alpha2, beta, B_center, LD_B, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
|
||||
|
||||
@ -428,107 +662,6 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A
|
||||
end subroutine give_polynomial_mult_center_one_e_erf_opt
|
||||
|
||||
! ---
|
||||
subroutine NAI_pol_mult_erf_v(A_center, B_center, power_A, power_B, alpha, beta, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! .. math::
|
||||
!
|
||||
! \int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||
! \frac{\erf(\mu |r - R_C |)}{| r - R_C |}$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n_pt_in, n_points, LD_C, LD_resv
|
||||
integer, intent(in) :: power_A(3), power_B(3)
|
||||
double precision, intent(in) :: A_center(3), B_center(3), alpha, beta, mu_in
|
||||
double precision, intent(in) :: C_center(LD_C,3)
|
||||
double precision, intent(out) :: res_v(LD_resv)
|
||||
|
||||
integer :: i, n_pt, n_pt_out, ipoint
|
||||
double precision :: P_center(3)
|
||||
double precision :: d(0:n_pt_in), coeff, dist, const, factor
|
||||
double precision :: const_factor, dist_integral
|
||||
double precision :: accu, p_inv, p, rho, p_inv_2
|
||||
double precision :: p_new, p_new2, coef_tmp
|
||||
|
||||
double precision :: rint
|
||||
|
||||
res_V(1:LD_resv) = 0.d0
|
||||
|
||||
p = alpha + beta
|
||||
p_inv = 1.d0 / p
|
||||
p_inv_2 = 0.5d0 * p_inv
|
||||
rho = alpha * beta * p_inv
|
||||
p_new = mu_in / dsqrt(p + mu_in * mu_in)
|
||||
p_new2 = p_new * p_new
|
||||
coef_tmp = p * p_new2
|
||||
|
||||
dist = 0.d0
|
||||
do i = 1, 3
|
||||
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
||||
dist += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
|
||||
enddo
|
||||
|
||||
const_factor = dist * rho
|
||||
if(const_factor > 80.d0) then
|
||||
return
|
||||
endif
|
||||
factor = dexp(-const_factor)
|
||||
coeff = dtwo_pi * factor * p_inv * p_new
|
||||
|
||||
n_pt = 2 * ( power_A(1) + power_B(1) + power_A(2) + power_B(2) + power_A(3) + power_B(3) )
|
||||
|
||||
if(n_pt == 0) then
|
||||
|
||||
do ipoint = 1, n_points
|
||||
dist_integral = 0.d0
|
||||
do i = 1, 3
|
||||
dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
|
||||
enddo
|
||||
const = coef_tmp * dist_integral
|
||||
|
||||
res_v(ipoint) = coeff * rint(0, const)
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
do ipoint = 1, n_points
|
||||
dist_integral = 0.d0
|
||||
do i = 1, 3
|
||||
dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
|
||||
enddo
|
||||
const = coef_tmp * dist_integral
|
||||
|
||||
do i = 0, n_pt_in
|
||||
d(i) = 0.d0
|
||||
enddo
|
||||
call give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center(ipoint,1:3), n_pt_in, d, n_pt_out, p_inv_2, p_new2, P_center)
|
||||
|
||||
if(n_pt_out < 0) then
|
||||
res_v(ipoint) = 0.d0
|
||||
cycle
|
||||
endif
|
||||
|
||||
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
||||
accu = 0.d0
|
||||
do i = 0, n_pt_out, 2
|
||||
accu += d(i) * rint(i/2, const)
|
||||
enddo
|
||||
|
||||
res_v(ipoint) = accu * coeff
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end subroutine NAI_pol_mult_erf_v
|
||||
|
||||
|
||||
subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in)
|
||||
|
||||
@ -659,113 +792,3 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,po
|
||||
|
||||
end
|
||||
|
||||
double precision function NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
|
||||
, beta, B_center, C_center, n_pt_in, mu_in )
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! .. math::
|
||||
!
|
||||
! \int dx (x - A1_x)^a_1 (x - B1_x)^a_2 \exp(-\alpha_1 (x - A1_x)^2 - \alpha_2 (x - A2_x)^2)
|
||||
! \int dy (y - A1_y)^b_1 (y - B1_y)^b_2 \exp(-\alpha_1 (y - A1_y)^2 - \alpha_2 (y - A2_y)^2)
|
||||
! \int dz (x - A1_z)^c_1 (z - B1_z)^c_2 \exp(-\alpha_1 (z - A1_z)^2 - \alpha_2 (z - A2_z)^2)
|
||||
! \exp(-\beta (r - B)^2)
|
||||
! \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: n_pt_in
|
||||
integer, intent(in) :: power_A1(3), power_A2(3)
|
||||
double precision, intent(in) :: C_center(3), A1_center(3), A2_center(3), B_center(3)
|
||||
double precision, intent(in) :: alpha1, alpha2, beta, mu_in
|
||||
|
||||
integer :: i, n_pt, n_pt_out
|
||||
double precision :: alpha12, alpha12_inv, alpha12_inv_2, rho12, A12_center(3), dist12, const_factor12
|
||||
double precision :: p, p_inv, p_inv_2, rho, P_center(3), dist, const_factor
|
||||
double precision :: dist_integral
|
||||
double precision :: d(0:n_pt_in), coeff, const, factor
|
||||
double precision :: accu
|
||||
double precision :: p_new
|
||||
|
||||
double precision :: rint
|
||||
|
||||
|
||||
! e^{-alpha1 (r - A1)^2} e^{-alpha2 (r - A2)^2} = e^{-K12} e^{-alpha12 (r - A12)^2}
|
||||
alpha12 = alpha1 + alpha2
|
||||
alpha12_inv = 1.d0 / alpha12
|
||||
alpha12_inv_2 = 0.5d0 * alpha12_inv
|
||||
rho12 = alpha1 * alpha2 * alpha12_inv
|
||||
A12_center(1) = (alpha1 * A1_center(1) + alpha2 * A2_center(1)) * alpha12_inv
|
||||
A12_center(2) = (alpha1 * A1_center(2) + alpha2 * A2_center(2)) * alpha12_inv
|
||||
A12_center(3) = (alpha1 * A1_center(3) + alpha2 * A2_center(3)) * alpha12_inv
|
||||
dist12 = (A1_center(1) - A2_center(1)) * (A1_center(1) - A2_center(1)) &
|
||||
+ (A1_center(2) - A2_center(2)) * (A1_center(2) - A2_center(2)) &
|
||||
+ (A1_center(3) - A2_center(3)) * (A1_center(3) - A2_center(3))
|
||||
|
||||
const_factor12 = dist12 * rho12
|
||||
if(const_factor12 > 80.d0) then
|
||||
NAI_pol_mult_erf_with1s = 0.d0
|
||||
return
|
||||
endif
|
||||
|
||||
! ---
|
||||
|
||||
! e^{-K12} e^{-alpha12 (r - A12)^2} e^{-beta (r - B)^2} = e^{-K} e^{-p (r - P)^2}
|
||||
p = alpha12 + beta
|
||||
p_inv = 1.d0 / p
|
||||
p_inv_2 = 0.5d0 * p_inv
|
||||
rho = alpha12 * beta * p_inv
|
||||
P_center(1) = (alpha12 * A12_center(1) + beta * B_center(1)) * p_inv
|
||||
P_center(2) = (alpha12 * A12_center(2) + beta * B_center(2)) * p_inv
|
||||
P_center(3) = (alpha12 * A12_center(3) + beta * B_center(3)) * p_inv
|
||||
dist = (A12_center(1) - B_center(1)) * (A12_center(1) - B_center(1)) &
|
||||
+ (A12_center(2) - B_center(2)) * (A12_center(2) - B_center(2)) &
|
||||
+ (A12_center(3) - B_center(3)) * (A12_center(3) - B_center(3))
|
||||
|
||||
const_factor = const_factor12 + dist * rho
|
||||
if(const_factor > 80.d0) then
|
||||
NAI_pol_mult_erf_with1s = 0.d0
|
||||
return
|
||||
endif
|
||||
|
||||
dist_integral = (P_center(1) - C_center(1)) * (P_center(1) - C_center(1)) &
|
||||
+ (P_center(2) - C_center(2)) * (P_center(2) - C_center(2)) &
|
||||
+ (P_center(3) - C_center(3)) * (P_center(3) - C_center(3))
|
||||
|
||||
! ---
|
||||
|
||||
p_new = mu_in / dsqrt(p + mu_in * mu_in)
|
||||
factor = dexp(-const_factor)
|
||||
coeff = dtwo_pi * factor * p_inv * p_new
|
||||
|
||||
n_pt = 2 * ( (power_A1(1) + power_A2(1)) + (power_A1(2) + power_A2(2)) + (power_A1(3) + power_A2(3)) )
|
||||
const = p * dist_integral * p_new * p_new
|
||||
if(n_pt == 0) then
|
||||
NAI_pol_mult_erf_with1s = coeff * rint(0, const)
|
||||
return
|
||||
endif
|
||||
|
||||
do i = 0, n_pt_in
|
||||
d(i) = 0.d0
|
||||
enddo
|
||||
p_new = p_new * p_new
|
||||
call give_polynomial_mult_center_one_e_erf_opt( A1_center, A2_center, power_A1, power_A2, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
|
||||
|
||||
if(n_pt_out < 0) then
|
||||
NAI_pol_mult_erf_with1s = 0.d0
|
||||
return
|
||||
endif
|
||||
|
||||
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
||||
accu = 0.d0
|
||||
do i = 0, n_pt_out, 2
|
||||
accu += d(i) * rint(i/2, const)
|
||||
enddo
|
||||
NAI_pol_mult_erf_with1s = accu * coeff
|
||||
|
||||
end function NAI_pol_mult_erf_with1s
|
||||
|
@ -1,4 +1,8 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! Nucleus-electron interaction, in the |AO| basis set.
|
||||
!
|
||||
@ -6,30 +10,38 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
||||
!
|
||||
! These integrals also contain the pseudopotential integrals.
|
||||
END_DOC
|
||||
implicit none
|
||||
double precision :: alpha, beta, gama, delta
|
||||
integer :: num_A,num_B
|
||||
double precision :: A_center(3),B_center(3),C_center(3)
|
||||
integer :: power_A(3),power_B(3)
|
||||
integer :: i,j,k,l,n_pt_in,m
|
||||
double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
|
||||
|
||||
if (read_ao_integrals_n_e) then
|
||||
call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
|
||||
print *, 'AO N-e integrals read from disk'
|
||||
else
|
||||
implicit none
|
||||
integer :: num_A, num_B, power_A(3), power_B(3)
|
||||
integer :: i, j, k, l, n_pt_in, m
|
||||
double precision :: alpha, beta
|
||||
double precision :: A_center(3),B_center(3),C_center(3)
|
||||
double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
|
||||
|
||||
ao_integrals_n_e = 0.d0
|
||||
|
||||
! _
|
||||
! /| / |_)
|
||||
! | / | \
|
||||
!
|
||||
if (read_ao_integrals_n_e) then
|
||||
|
||||
call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
|
||||
print *, 'AO N-e integrals read from disk'
|
||||
|
||||
else
|
||||
|
||||
if(use_cosgtos) then
|
||||
!print *, " use_cosgtos for ao_integrals_n_e ?", use_cosgtos
|
||||
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
ao_integrals_n_e(i,j) = ao_integrals_n_e_cosgtos(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,&
|
||||
!$OMP num_A,num_B,Z,c,n_pt_in) &
|
||||
!$OMP num_A,num_B,Z,c,c1,n_pt_in) &
|
||||
!$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp,&
|
||||
!$OMP n_pt_max_integrals,ao_integrals_n_e,nucl_num,nucl_charge)
|
||||
|
||||
@ -54,7 +66,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
||||
do m=1,ao_prim_num(i)
|
||||
beta = ao_expo_ordered_transp(m,i)
|
||||
|
||||
double precision :: c
|
||||
double precision :: c, c1
|
||||
c = 0.d0
|
||||
|
||||
do k = 1, nucl_num
|
||||
@ -63,8 +75,16 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
||||
|
||||
C_center(1:3) = nucl_coord(k,1:3)
|
||||
|
||||
c = c - Z * NAI_pol_mult(A_center,B_center, &
|
||||
power_A,power_B,alpha,beta,C_center,n_pt_in)
|
||||
!print *, ' '
|
||||
!print *, A_center, B_center, C_center, power_A, power_B
|
||||
!print *, alpha, beta
|
||||
|
||||
c1 = NAI_pol_mult( A_center, B_center, power_A, power_B &
|
||||
, alpha, beta, C_center, n_pt_in )
|
||||
|
||||
!print *, ' c1 = ', c1
|
||||
|
||||
c = c - Z * c1
|
||||
|
||||
enddo
|
||||
ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j) &
|
||||
@ -77,14 +97,17 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
||||
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
IF (DO_PSEUDO) THEN
|
||||
|
||||
endif
|
||||
|
||||
|
||||
IF(do_pseudo) THEN
|
||||
ao_integrals_n_e += ao_pseudo_integrals
|
||||
ENDIF
|
||||
IF(point_charges) THEN
|
||||
ao_integrals_n_e += ao_integrals_pt_chrg
|
||||
ENDIF
|
||||
|
||||
|
||||
endif
|
||||
|
||||
|
||||
@ -102,7 +125,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_imag, (ao_num,ao_num)]
|
||||
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||
END_DOC
|
||||
implicit none
|
||||
double precision :: alpha, beta, gama, delta
|
||||
double precision :: alpha, beta
|
||||
integer :: num_A,num_B
|
||||
double precision :: A_center(3),B_center(3),C_center(3)
|
||||
integer :: power_A(3),power_B(3)
|
||||
@ -125,7 +148,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nuc
|
||||
! :math:`\langle \chi_i | -\frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||
END_DOC
|
||||
implicit none
|
||||
double precision :: alpha, beta, gama, delta
|
||||
double precision :: alpha, beta
|
||||
integer :: i_c,num_A,num_B
|
||||
double precision :: A_center(3),B_center(3),C_center(3)
|
||||
integer :: power_A(3),power_B(3)
|
||||
@ -268,6 +291,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out)
|
||||
implicit none
|
||||
@ -434,10 +458,12 @@ recursive subroutine I_x1_pol_mult_one_e(a,c,R1x,R1xp,R2x,d,nd,n_pt_in)
|
||||
do ix=0,nx
|
||||
X(ix) *= dble(c)
|
||||
enddo
|
||||
call multiply_poly(X,nx,R2x,2,d,nd)
|
||||
! call multiply_poly(X,nx,R2x,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,R2x,d,nd)
|
||||
ny=0
|
||||
call I_x2_pol_mult_one_e(c,R1x,R1xp,R2x,Y,ny,n_pt_in)
|
||||
call multiply_poly(Y,ny,R1x,2,d,nd)
|
||||
! call multiply_poly(Y,ny,R1x,2,d,nd)
|
||||
call multiply_poly_c2(Y,ny,R1x,d,nd)
|
||||
else
|
||||
do ix=0,n_pt_in
|
||||
X(ix) = 0.d0
|
||||
@ -448,7 +474,8 @@ recursive subroutine I_x1_pol_mult_one_e(a,c,R1x,R1xp,R2x,d,nd,n_pt_in)
|
||||
do ix=0,nx
|
||||
X(ix) *= dble(a-1)
|
||||
enddo
|
||||
call multiply_poly(X,nx,R2x,2,d,nd)
|
||||
! call multiply_poly(X,nx,R2x,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,R2x,d,nd)
|
||||
|
||||
nx = nd
|
||||
do ix=0,n_pt_in
|
||||
@ -458,10 +485,12 @@ recursive subroutine I_x1_pol_mult_one_e(a,c,R1x,R1xp,R2x,d,nd,n_pt_in)
|
||||
do ix=0,nx
|
||||
X(ix) *= dble(c)
|
||||
enddo
|
||||
call multiply_poly(X,nx,R2x,2,d,nd)
|
||||
! call multiply_poly(X,nx,R2x,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,R2x,d,nd)
|
||||
ny=0
|
||||
call I_x1_pol_mult_one_e(a-1,c,R1x,R1xp,R2x,Y,ny,n_pt_in)
|
||||
call multiply_poly(Y,ny,R1x,2,d,nd)
|
||||
! call multiply_poly(Y,ny,R1x,2,d,nd)
|
||||
call multiply_poly_c2(Y,ny,R1x,d,nd)
|
||||
endif
|
||||
end
|
||||
|
||||
@ -498,7 +527,8 @@ recursive subroutine I_x2_pol_mult_one_e(c,R1x,R1xp,R2x,d,nd,dim)
|
||||
do ix=0,nx
|
||||
X(ix) *= dble(c-1)
|
||||
enddo
|
||||
call multiply_poly(X,nx,R2x,2,d,nd)
|
||||
! call multiply_poly(X,nx,R2x,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,R2x,d,nd)
|
||||
ny = 0
|
||||
do ix=0,dim
|
||||
Y(ix) = 0.d0
|
||||
@ -506,7 +536,8 @@ recursive subroutine I_x2_pol_mult_one_e(c,R1x,R1xp,R2x,d,nd,dim)
|
||||
|
||||
call I_x1_pol_mult_one_e(0,c-1,R1x,R1xp,R2x,Y,ny,dim)
|
||||
if(ny.ge.0)then
|
||||
call multiply_poly(Y,ny,R1xp,2,d,nd)
|
||||
! call multiply_poly(Y,ny,R1xp,2,d,nd)
|
||||
call multiply_poly_c2(Y,ny,R1xp,d,nd)
|
||||
endif
|
||||
endif
|
||||
end
|
||||
@ -579,61 +610,3 @@ double precision function V_r(n,alpha)
|
||||
end
|
||||
|
||||
|
||||
double precision function V_phi(n,m)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Computes the angular $\phi$ part of the nuclear attraction integral:
|
||||
!
|
||||
! $\int_{0}^{2 \pi} \cos(\phi)^n \sin(\phi)^m d\phi$.
|
||||
END_DOC
|
||||
integer :: n,m, i
|
||||
double precision :: prod, Wallis
|
||||
prod = 1.d0
|
||||
do i = 0,shiftr(n,1)-1
|
||||
prod = prod/ (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
|
||||
enddo
|
||||
V_phi = 4.d0 * prod * Wallis(m)
|
||||
end
|
||||
|
||||
|
||||
double precision function V_theta(n,m)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Computes the angular $\theta$ part of the nuclear attraction integral:
|
||||
!
|
||||
! $\int_{0}^{\pi} \cos(\theta)^n \sin(\theta)^m d\theta$
|
||||
END_DOC
|
||||
integer :: n,m,i
|
||||
double precision :: Wallis, prod
|
||||
include 'utils/constants.include.F'
|
||||
V_theta = 0.d0
|
||||
prod = 1.d0
|
||||
do i = 0,shiftr(n,1)-1
|
||||
prod = prod / (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
|
||||
enddo
|
||||
V_theta = (prod+prod) * Wallis(m)
|
||||
end
|
||||
|
||||
|
||||
double precision function Wallis(n)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Wallis integral:
|
||||
!
|
||||
! $\int_{0}^{\pi} \cos(\theta)^n d\theta$.
|
||||
END_DOC
|
||||
double precision :: fact
|
||||
integer :: n,p
|
||||
include 'utils/constants.include.F'
|
||||
if(iand(n,1).eq.0)then
|
||||
Wallis = fact(shiftr(n,1))
|
||||
Wallis = pi * fact(n) / (dble(ibset(0_8,n)) * (Wallis+Wallis)*Wallis)
|
||||
else
|
||||
p = shiftr(n,1)
|
||||
Wallis = fact(p)
|
||||
Wallis = dble(ibset(0_8,p+p)) * Wallis*Wallis / fact(p+p+1)
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
ao_two_e_erf_ints
|
||||
ao_two_e_ints
|
||||
mo_one_e_ints
|
||||
ao_many_one_e_ints
|
||||
dft_utils_in_r
|
||||
|
@ -53,13 +53,13 @@ subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_va
|
||||
integral_erf = ao_two_e_integral_erf(i, k, j, l)
|
||||
integral = integral_erf + integral_pot
|
||||
|
||||
if( j1b_type .eq. 1 ) then
|
||||
!print *, ' j1b type 1 is added'
|
||||
integral = integral + j1b_gauss_2e_j1(i, k, j, l)
|
||||
elseif( j1b_type .eq. 2 ) then
|
||||
!print *, ' j1b type 2 is added'
|
||||
integral = integral + j1b_gauss_2e_j2(i, k, j, l)
|
||||
endif
|
||||
!if( j1b_type .eq. 1 ) then
|
||||
! !print *, ' j1b type 1 is added'
|
||||
! integral = integral + j1b_gauss_2e_j1(i, k, j, l)
|
||||
!elseif( j1b_type .eq. 2 ) then
|
||||
! !print *, ' j1b type 2 is added'
|
||||
! integral = integral + j1b_gauss_2e_j2(i, k, j, l)
|
||||
!endif
|
||||
|
||||
if(abs(integral) < thr) then
|
||||
cycle
|
||||
|
@ -36,7 +36,7 @@ END_PROVIDER
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, expo_j_xmu, (n_fit_1_erf_x) ]
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) is fitted with a gaussian and a Slater
|
||||
!
|
||||
@ -44,8 +44,17 @@ BEGIN_PROVIDER [ double precision, expo_j_xmu, (n_fit_1_erf_x) ]
|
||||
!
|
||||
! where alpha = expo_j_xmu(1) and beta = expo_j_xmu(2)
|
||||
END_DOC
|
||||
expo_j_xmu(1) = 1.7477d0
|
||||
expo_j_xmu(2) = 0.668662d0
|
||||
|
||||
implicit none
|
||||
|
||||
!expo_j_xmu(1) = 1.7477d0
|
||||
!expo_j_xmu(2) = 0.668662d0
|
||||
|
||||
!expo_j_xmu(1) = 1.74766377595541d0
|
||||
!expo_j_xmu(2) = 0.668719925486403d0
|
||||
|
||||
expo_j_xmu(1) = 1.74770446934522d0
|
||||
expo_j_xmu(2) = 0.668659706559979d0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -1,13 +0,0 @@
|
||||
[io_ao_two_e_integrals_erf]
|
||||
type: Disk_access
|
||||
doc: Read/Write |AO| integrals with the long range interaction from/to disk [ Write | Read | None ]
|
||||
interface: ezfio,provider,ocaml
|
||||
default: None
|
||||
|
||||
[mu_erf]
|
||||
type: double precision
|
||||
doc: cutting of the interaction in the range separated model
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 0.5
|
||||
ezfio_name: mu_erf
|
||||
|
@ -1 +0,0 @@
|
||||
ao_two_e_ints
|
@ -1,19 +0,0 @@
|
||||
======================
|
||||
ao_two_e_erf_ints
|
||||
======================
|
||||
|
||||
Here, all two-electron integrals (:math:`erf(\mu r_{12})/r_{12}`) are computed.
|
||||
As they have 4 indices and many are zero, they are stored in a map, as defined
|
||||
in :file:`utils/map_module.f90`.
|
||||
|
||||
The main parameter of this module is :option:`ao_two_e_erf_ints mu_erf` which is the range-separation parameter.
|
||||
|
||||
To fetch an |AO| integral, use the
|
||||
`get_ao_two_e_integral_erf(i,j,k,l,ao_integrals_erf_map)` function.
|
||||
|
||||
|
||||
The conventions are:
|
||||
* For |AO| integrals : (ij|kl) = (11|22) = <ik|jl> = <12|12>
|
||||
|
||||
|
||||
|
@ -4,6 +4,12 @@ doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
|
||||
interface: ezfio,provider,ocaml
|
||||
default: None
|
||||
|
||||
[io_ao_cholesky]
|
||||
type: Disk_access
|
||||
doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
|
||||
interface: ezfio,provider,ocaml
|
||||
default: None
|
||||
|
||||
[ao_integrals_threshold]
|
||||
type: Threshold
|
||||
doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero
|
||||
@ -11,6 +17,12 @@ interface: ezfio,provider,ocaml
|
||||
default: 1.e-15
|
||||
ezfio_name: threshold_ao
|
||||
|
||||
[ao_cholesky_threshold]
|
||||
type: Threshold
|
||||
doc: If | (ii|jj) | < `ao_cholesky_threshold` then (ii|jj) is zero
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 1.e-12
|
||||
|
||||
[do_direct_integrals]
|
||||
type: logical
|
||||
doc: Compute integrals on the fly (very slow, only for debugging)
|
||||
@ -18,3 +30,20 @@ interface: ezfio,provider,ocaml
|
||||
default: False
|
||||
ezfio_name: direct
|
||||
|
||||
[do_ao_cholesky]
|
||||
type: logical
|
||||
doc: Perform Cholesky decomposition of AO integrals
|
||||
interface: ezfio,provider,ocaml
|
||||
default: False
|
||||
|
||||
[io_ao_two_e_integrals_erf]
|
||||
type: Disk_access
|
||||
doc: Read/Write |AO| erf integrals from/to disk [ Write | Read | None ]
|
||||
interface: ezfio,provider,ocaml
|
||||
default: None
|
||||
|
||||
[use_only_lr]
|
||||
type: logical
|
||||
doc: If true, use only the long range part of the two-electron integrals instead of 1/r12
|
||||
interface: ezfio, provider, ocaml
|
||||
default: False
|
||||
|
@ -1,3 +1,4 @@
|
||||
hamiltonian
|
||||
ao_one_e_ints
|
||||
pseudo
|
||||
bitmask
|
||||
|
413
src/ao_two_e_ints/cholesky.irp.f
Normal file
413
src/ao_two_e_ints/cholesky.irp.f
Normal file
@ -0,0 +1,413 @@
|
||||
BEGIN_PROVIDER [ double precision, cholesky_ao_transp, (cholesky_ao_num, ao_num, ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Transposed of the Cholesky vectors in AO basis set
|
||||
END_DOC
|
||||
integer :: i,j,k
|
||||
do j=1,ao_num
|
||||
do i=1,ao_num
|
||||
do k=1,ao_num
|
||||
cholesky_ao_transp(k,i,j) = cholesky_ao(i,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, cholesky_ao_num ]
|
||||
&BEGIN_PROVIDER [ double precision, cholesky_ao, (ao_num, ao_num, 1) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Cholesky vectors in AO basis: (ik|a):
|
||||
! <ij|kl> = (ik|jl) = sum_a (ik|a).(a|jl)
|
||||
!
|
||||
! Last dimension of cholesky_ao is cholesky_ao_num
|
||||
END_DOC
|
||||
|
||||
integer :: rank, ndim
|
||||
double precision :: tau
|
||||
double precision, pointer :: L(:,:), L_old(:,:)
|
||||
|
||||
|
||||
double precision :: s
|
||||
double precision, parameter :: dscale = 1.d0
|
||||
|
||||
double precision, allocatable :: D(:), Delta(:,:), Ltmp_p(:,:), Ltmp_q(:,:)
|
||||
integer, allocatable :: Lset(:), Dset(:), addr(:,:)
|
||||
logical, allocatable :: computed(:)
|
||||
|
||||
integer :: i,j,k,m,p,q, qj, dj, p2, q2
|
||||
integer :: N, np, nq
|
||||
|
||||
double precision :: Dmax, Dmin, Qmax, f
|
||||
double precision, external :: get_ao_two_e_integral
|
||||
logical, external :: ao_two_e_integral_zero
|
||||
|
||||
double precision, external :: ao_two_e_integral
|
||||
integer :: block_size, iblock, ierr
|
||||
|
||||
double precision :: mem
|
||||
double precision, external :: memory_of_double, memory_of_int
|
||||
|
||||
integer, external :: getUnitAndOpen
|
||||
integer :: iunit
|
||||
|
||||
ndim = ao_num*ao_num
|
||||
deallocate(cholesky_ao)
|
||||
|
||||
if (read_ao_cholesky) then
|
||||
print *, 'Reading Cholesky vectors from disk...'
|
||||
iunit = getUnitAndOpen(trim(ezfio_work_dir)//'cholesky_ao', 'R')
|
||||
read(iunit) rank
|
||||
allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr)
|
||||
read(iunit) cholesky_ao
|
||||
close(iunit)
|
||||
cholesky_ao_num = rank
|
||||
|
||||
else
|
||||
|
||||
PROVIDE nucl_coord
|
||||
|
||||
if (do_direct_integrals) then
|
||||
if (ao_two_e_integral(1,1,1,1) < huge(1.d0)) then
|
||||
! Trigger providers inside ao_two_e_integral
|
||||
continue
|
||||
endif
|
||||
else
|
||||
PROVIDE ao_two_e_integrals_in_map
|
||||
endif
|
||||
|
||||
tau = ao_cholesky_threshold
|
||||
|
||||
mem = 6.d0 * memory_of_double(ndim) + 6.d0 * memory_of_int(ndim)
|
||||
call check_mem(mem, irp_here)
|
||||
|
||||
call print_memory_usage()
|
||||
|
||||
allocate(L(ndim,1))
|
||||
|
||||
print *, ''
|
||||
print *, 'Cholesky decomposition of AO integrals'
|
||||
print *, '======================================'
|
||||
print *, ''
|
||||
print *, '============ ============='
|
||||
print *, ' Rank Threshold'
|
||||
print *, '============ ============='
|
||||
|
||||
|
||||
rank = 0
|
||||
|
||||
allocate( D(ndim), Lset(ndim), Dset(ndim) )
|
||||
allocate( addr(3,ndim) )
|
||||
|
||||
! 1.
|
||||
k=0
|
||||
do j=1,ao_num
|
||||
do i=1,ao_num
|
||||
k = k+1
|
||||
addr(1,k) = i
|
||||
addr(2,k) = j
|
||||
addr(3,k) = (i-1)*ao_num + j
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if (do_direct_integrals) then
|
||||
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i) SCHEDULE(guided)
|
||||
do i=1,ndim
|
||||
D(i) = ao_two_e_integral(addr(1,i), addr(2,i), &
|
||||
addr(1,i), addr(2,i))
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
else
|
||||
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i) SCHEDULE(guided)
|
||||
do i=1,ndim
|
||||
D(i) = get_ao_two_e_integral(addr(1,i), addr(1,i), &
|
||||
addr(2,i), addr(2,i), &
|
||||
ao_integrals_map)
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
endif
|
||||
|
||||
Dmax = maxval(D)
|
||||
|
||||
! 2.
|
||||
np=0
|
||||
do p=1,ndim
|
||||
if ( dscale*dscale*Dmax*D(p) > tau*tau ) then
|
||||
np = np+1
|
||||
Lset(np) = p
|
||||
endif
|
||||
enddo
|
||||
|
||||
! 3.
|
||||
N = 0
|
||||
|
||||
! 4.
|
||||
i = 0
|
||||
|
||||
! 5.
|
||||
do while ( (Dmax > tau).and.(rank < ndim) )
|
||||
! a.
|
||||
i = i+1
|
||||
|
||||
s = 0.01d0
|
||||
|
||||
! Inrease s until the arrays fit in memory
|
||||
do while (.True.)
|
||||
|
||||
! b.
|
||||
Dmin = max(s*Dmax,tau)
|
||||
|
||||
! c.
|
||||
nq=0
|
||||
do p=1,np
|
||||
if ( D(Lset(p)) > Dmin ) then
|
||||
nq = nq+1
|
||||
Dset(nq) = Lset(p)
|
||||
endif
|
||||
enddo
|
||||
|
||||
call total_memory(mem)
|
||||
mem = mem &
|
||||
+ np*memory_of_double(nq) &! Delta(np,nq)
|
||||
+ (rank+nq)* memory_of_double(ndim) &! L(ndim,rank+nq)
|
||||
+ (np+nq)*memory_of_double(block_size) ! Ltmp_p(np,block_size) + Ltmp_q(nq,block_size)
|
||||
|
||||
if (mem > qp_max_mem) then
|
||||
s = s*2.d0
|
||||
else
|
||||
exit
|
||||
endif
|
||||
|
||||
if ((s > 1.d0).or.(nq == 0)) then
|
||||
call print_memory_usage()
|
||||
print *, 'Not enough memory. Reduce cholesky threshold'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
! d., e.
|
||||
block_size = max(N,24)
|
||||
|
||||
L_old => L
|
||||
allocate(L(ndim,rank+nq), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': allocation failed : (L(ndim,rank+nq))'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(k,j)
|
||||
do k=1,rank
|
||||
do j=1,ndim
|
||||
L(j,k) = L_old(j,k)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(L_old)
|
||||
|
||||
allocate(Delta(np,nq), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': allocation failed : (Delta(np,nq))'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
allocate(Ltmp_p(np,block_size), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': allocation failed : (Ltmp_p(np,block_size))'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
allocate(Ltmp_q(nq,block_size), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': allocation failed : (Ltmp_q(nq,block_size))'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
|
||||
allocate(computed(nq))
|
||||
|
||||
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(m,k,p,q,j)
|
||||
|
||||
!$OMP DO
|
||||
do q=1,nq
|
||||
do j=1,np
|
||||
Delta(j,q) = 0.d0
|
||||
enddo
|
||||
computed(q) = .False.
|
||||
enddo
|
||||
!$OMP ENDDO NOWAIT
|
||||
|
||||
!$OMP DO
|
||||
do k=1,N
|
||||
do p=1,np
|
||||
Ltmp_p(p,k) = L(Lset(p),k)
|
||||
enddo
|
||||
do q=1,nq
|
||||
Ltmp_q(q,k) = L(Dset(q),k)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP BARRIER
|
||||
!$OMP END PARALLEL
|
||||
|
||||
if (N>0) then
|
||||
call dgemm('N','T', np, nq, N, -1.d0, &
|
||||
Ltmp_p, np, Ltmp_q, nq, 1.d0, Delta, np)
|
||||
endif
|
||||
|
||||
! f.
|
||||
Qmax = D(Dset(1))
|
||||
do q=1,nq
|
||||
Qmax = max(Qmax, D(Dset(q)))
|
||||
enddo
|
||||
|
||||
! g.
|
||||
|
||||
iblock = 0
|
||||
do j=1,nq
|
||||
|
||||
if ( (Qmax <= Dmin).or.(N+j > ndim) ) exit
|
||||
! i.
|
||||
rank = N+j
|
||||
|
||||
if (iblock == block_size) then
|
||||
call dgemm('N','T',np,nq,block_size,-1.d0, &
|
||||
Ltmp_p, np, Ltmp_q, nq, 1.d0, Delta, np)
|
||||
iblock = 0
|
||||
endif
|
||||
|
||||
! ii.
|
||||
do dj=1,nq
|
||||
qj = Dset(dj)
|
||||
if (D(qj) == Qmax) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
|
||||
L(1:ndim, rank) = 0.d0
|
||||
|
||||
if (.not.computed(dj)) then
|
||||
m = dj
|
||||
!$OMP PARALLEL DO PRIVATE(k) SCHEDULE(guided)
|
||||
do k=np,1,-1
|
||||
if (.not.ao_two_e_integral_zero( addr(1,Lset(k)), addr(1,Dset(m)),&
|
||||
addr(2,Lset(k)), addr(2,Dset(m)) ) ) then
|
||||
if (do_direct_integrals) then
|
||||
Delta(k,m) = Delta(k,m) + &
|
||||
ao_two_e_integral(addr(1,Lset(k)), addr(2,Lset(k)),&
|
||||
addr(1,Dset(m)), addr(2,Dset(m)))
|
||||
else
|
||||
Delta(k,m) = Delta(k,m) + &
|
||||
get_ao_two_e_integral( addr(1,Lset(k)), addr(1,Dset(m)),&
|
||||
addr(2,Lset(k)), addr(2,Dset(m)), ao_integrals_map)
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
computed(dj) = .True.
|
||||
endif
|
||||
|
||||
iblock = iblock+1
|
||||
do p=1,np
|
||||
Ltmp_p(p,iblock) = Delta(p,dj)
|
||||
enddo
|
||||
|
||||
! iv.
|
||||
if (iblock > 1) then
|
||||
call dgemv('N', np, iblock-1, -1.d0, Ltmp_p, np, Ltmp_q(dj,1), nq, 1.d0,&
|
||||
Ltmp_p(1,iblock), 1)
|
||||
endif
|
||||
|
||||
! iii.
|
||||
f = 1.d0/dsqrt(Qmax)
|
||||
|
||||
!$OMP PARALLEL PRIVATE(m,p,q,k) DEFAULT(shared)
|
||||
!$OMP DO
|
||||
do p=1,np
|
||||
Ltmp_p(p,iblock) = Ltmp_p(p,iblock) * f
|
||||
L(Lset(p), rank) = Ltmp_p(p,iblock)
|
||||
D(Lset(p)) = D(Lset(p)) - Ltmp_p(p,iblock) * Ltmp_p(p,iblock)
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP DO
|
||||
do q=1,nq
|
||||
Ltmp_q(q,iblock) = L(Dset(q), rank)
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
Qmax = D(Dset(1))
|
||||
do q=1,nq
|
||||
Qmax = max(Qmax, D(Dset(q)))
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
print '(I10, 4X, ES12.3)', rank, Qmax
|
||||
|
||||
deallocate(computed)
|
||||
deallocate(Delta)
|
||||
deallocate(Ltmp_p)
|
||||
deallocate(Ltmp_q)
|
||||
|
||||
! i.
|
||||
N = rank
|
||||
|
||||
! j.
|
||||
Dmax = D(Lset(1))
|
||||
do p=1,np
|
||||
Dmax = max(Dmax, D(Lset(p)))
|
||||
enddo
|
||||
|
||||
np=0
|
||||
do p=1,ndim
|
||||
if ( dscale*dscale*Dmax*D(p) > tau*tau ) then
|
||||
np = np+1
|
||||
Lset(np) = p
|
||||
endif
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': Allocation failed'
|
||||
stop -1
|
||||
endif
|
||||
!$OMP PARALLEL DO PRIVATE(k)
|
||||
do k=1,rank
|
||||
call dcopy(ndim, L(1,k), 1, cholesky_ao(1,1,k), 1)
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
deallocate(L)
|
||||
cholesky_ao_num = rank
|
||||
|
||||
print *, '============ ============='
|
||||
print *, ''
|
||||
|
||||
if (write_ao_cholesky) then
|
||||
print *, 'Writing Cholesky vectors to disk...'
|
||||
iunit = getUnitAndOpen(trim(ezfio_work_dir)//'cholesky_ao', 'W')
|
||||
write(iunit) rank
|
||||
write(iunit) cholesky_ao
|
||||
close(iunit)
|
||||
call ezfio_set_ao_two_e_ints_io_ao_cholesky('Read')
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
print *, 'Rank : ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
|
||||
print *, ''
|
||||
|
||||
END_PROVIDER
|
||||
|
@ -486,7 +486,7 @@ subroutine get_ao_two_e_integrals(j,k,l,sze,out_val)
|
||||
PROVIDE ao_two_e_integrals_in_map ao_integrals_map
|
||||
|
||||
if (ao_one_e_integral_zero(j,l)) then
|
||||
out_val = 0.d0
|
||||
out_val(1:sze) = 0.d0
|
||||
return
|
||||
endif
|
||||
|
||||
|
@ -90,7 +90,7 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ]
|
||||
if (write_ao_two_e_integrals_erf) then
|
||||
call ezfio_set_work_empty(.False.)
|
||||
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_erf',ao_integrals_erf_map)
|
||||
call ezfio_set_ao_two_e_erf_ints_io_ao_two_e_integrals_erf("Read")
|
||||
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals_erf('Read')
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
@ -4,7 +4,7 @@ subroutine save_erf_two_e_integrals_ao
|
||||
PROVIDE ao_two_e_integrals_erf_in_map
|
||||
call ezfio_set_work_empty(.False.)
|
||||
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_erf',ao_integrals_erf_map)
|
||||
call ezfio_set_ao_two_e_erf_ints_io_ao_two_e_integrals_erf('Read')
|
||||
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals_erf('Read')
|
||||
end
|
||||
|
||||
subroutine save_erf_two_e_ints_ao_into_ints_ao
|
1582
src/ao_two_e_ints/two_e_Coul_integrals_cosgtos.irp.f
Normal file
1582
src/ao_two_e_ints/two_e_Coul_integrals_cosgtos.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
@ -1,23 +1,44 @@
|
||||
double precision function ao_two_e_integral(i,j,k,l)
|
||||
implicit none
|
||||
|
||||
! ---
|
||||
|
||||
double precision function ao_two_e_integral(i, j, k, l)
|
||||
|
||||
BEGIN_DOC
|
||||
! integral of the AO basis <ik|jl> or (ij|kl)
|
||||
! i(r1) j(r1) 1/r12 k(r2) l(r2)
|
||||
END_DOC
|
||||
|
||||
integer,intent(in) :: i,j,k,l
|
||||
integer :: p,q,r,s
|
||||
double precision :: I_center(3),J_center(3),K_center(3),L_center(3)
|
||||
integer :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
|
||||
double precision :: integral
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer, intent(in) :: i, j, k, l
|
||||
|
||||
integer :: p, q, r, s
|
||||
integer :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
|
||||
integer :: iorder_p(3), iorder_q(3)
|
||||
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||
double precision :: integral
|
||||
double precision :: P_new(0:max_dim,3),P_center(3),fact_p,pp
|
||||
double precision :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq
|
||||
integer :: iorder_p(3), iorder_q(3)
|
||||
double precision :: ao_two_e_integral_schwartz_accel
|
||||
|
||||
if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
|
||||
double precision, external :: ao_two_e_integral_erf
|
||||
double precision, external :: ao_two_e_integral_cosgtos
|
||||
double precision, external :: ao_two_e_integral_schwartz_accel
|
||||
|
||||
|
||||
if(use_cosgtos) then
|
||||
!print *, ' use_cosgtos for ao_two_e_integral ?', use_cosgtos
|
||||
|
||||
ao_two_e_integral = ao_two_e_integral_cosgtos(i, j, k, l)
|
||||
|
||||
else if (use_only_lr) then
|
||||
|
||||
ao_two_e_integral = ao_two_e_integral_erf(i, j, k, l)
|
||||
|
||||
else if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
|
||||
|
||||
ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l)
|
||||
|
||||
else
|
||||
|
||||
dim1 = n_pt_max_integrals
|
||||
@ -104,6 +125,8 @@ double precision function ao_two_e_integral(i,j,k,l)
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -421,20 +444,23 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ]
|
||||
implicit none
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz, (ao_num, ao_num) ]
|
||||
|
||||
BEGIN_DOC
|
||||
! Needed to compute Schwartz inequalities
|
||||
END_DOC
|
||||
|
||||
integer :: i,k
|
||||
implicit none
|
||||
integer :: i, k
|
||||
double precision :: ao_two_e_integral,cpu_1,cpu_2, wall_1, wall_2
|
||||
|
||||
ao_two_e_integral_schwartz(1,1) = ao_two_e_integral(1,1,1,1)
|
||||
!$OMP PARALLEL DO PRIVATE(i,k) &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP SHARED (ao_num,ao_two_e_integral_schwartz) &
|
||||
!$OMP SCHEDULE(dynamic)
|
||||
!$OMP SCHEDULE(guided)
|
||||
do i=1,ao_num
|
||||
do k=1,i
|
||||
ao_two_e_integral_schwartz(i,k) = dsqrt(ao_two_e_integral(i,i,k,k))
|
||||
@ -445,6 +471,7 @@ BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ]
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
double precision function general_primitive_integral(dim, &
|
||||
P_new,P_center,fact_p,p,p_inv,iorder_p, &
|
||||
@ -563,8 +590,20 @@ double precision function general_primitive_integral(dim, &
|
||||
d_poly(i)=0.d0
|
||||
enddo
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
|
||||
! call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
|
||||
integer :: ib, ic
|
||||
if (ior(n_Ix,n_Iy) >= 0) then
|
||||
do ib=0,n_Ix
|
||||
do ic = 0,n_Iy
|
||||
d_poly(ib+ic) = d_poly(ib+ic) + Iy_pol(ic) * Ix_pol(ib)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do n_pt_tmp = n_Ix+n_Iy, 0, -1
|
||||
if (d_poly(n_pt_tmp) /= 0.d0) exit
|
||||
enddo
|
||||
endif
|
||||
|
||||
if (n_pt_tmp == -1) then
|
||||
return
|
||||
endif
|
||||
@ -573,8 +612,21 @@ double precision function general_primitive_integral(dim, &
|
||||
d1(i)=0.d0
|
||||
enddo
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
|
||||
! call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
|
||||
if (ior(n_pt_tmp,n_Iz) >= 0) then
|
||||
! Bottleneck here
|
||||
do ib=0,n_pt_tmp
|
||||
do ic = 0,n_Iz
|
||||
d1(ib+ic) = d1(ib+ic) + Iz_pol(ic) * d_poly(ib)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do n_pt_out = n_pt_tmp+n_Iz, 0, -1
|
||||
if (d1(n_pt_out) /= 0.d0) exit
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
double precision :: rint_sum
|
||||
accu = accu + rint_sum(n_pt_out,const,d1)
|
||||
|
||||
@ -899,7 +951,7 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
double precision :: X(0:max_dim)
|
||||
double precision :: Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
|
||||
integer :: nx, ix,iy,ny
|
||||
integer :: nx, ix,iy,ny,ib
|
||||
|
||||
ASSERT (a>2)
|
||||
!DIR$ LOOP COUNT(8)
|
||||
@ -921,8 +973,44 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
X(ix) *= dble(a-1)
|
||||
enddo
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(X,nx,B_10,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_10,d,nd)
|
||||
if (nx >= 0) then
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(1) * X(1) + B_10(2) * X(0)
|
||||
d(3) = d(3) + B_10(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(0) * X(2) + B_10(1) * X(1) + B_10(2) * X(0)
|
||||
d(3) = d(3) + B_10(1) * X(2) + B_10(2) * X(1)
|
||||
d(4) = d(4) + B_10(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_10(0) * X(ib) + B_10(1) * X(ib-1) + B_10(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_10(1) * X(nx) + B_10(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_10(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
nx = nd
|
||||
!DIR$ LOOP COUNT(8)
|
||||
@ -943,8 +1031,47 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
X(ix) *= c
|
||||
enddo
|
||||
endif
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(X,nx,B_00,2,d,nd)
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
|
||||
d(4) = d(4) + B_00(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
ny=0
|
||||
@ -961,8 +1088,45 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
call I_x1_pol_mult_recurs(a-1,c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
||||
endif
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
|
||||
d(4) = d(4) + C_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
@ -980,7 +1144,7 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
double precision :: X(0:max_dim)
|
||||
double precision :: Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
|
||||
integer :: nx, ix,iy,ny
|
||||
integer :: nx, ix,iy,ny,ib
|
||||
|
||||
if( (c<0).or.(nd<0) )then
|
||||
nd = -1
|
||||
@ -1001,8 +1165,45 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
enddo
|
||||
endif
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(X,nx,B_00,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
|
||||
d(4) = d(4) + B_00(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
ny=0
|
||||
|
||||
@ -1012,8 +1213,45 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
enddo
|
||||
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
|
||||
d(4) = d(4) + C_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
@ -1031,7 +1269,7 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
double precision :: X(0:max_dim)
|
||||
double precision :: Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
|
||||
integer :: nx, ix,iy,ny
|
||||
integer :: nx, ix,iy,ny,ib
|
||||
|
||||
!DIR$ LOOP COUNT(8)
|
||||
do ix=0,n_pt_in
|
||||
@ -1040,8 +1278,45 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
nx = 0
|
||||
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,X,nx,n_pt_in)
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(X,nx,B_10,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_10,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(1) * X(1) + B_10(2) * X(0)
|
||||
d(3) = d(3) + B_10(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(0) * X(2) + B_10(1) * X(1) + B_10(2) * X(0)
|
||||
d(3) = d(3) + B_10(1) * X(2) + B_10(2) * X(1)
|
||||
d(4) = d(4) + B_10(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_10(0) * X(ib) + B_10(1) * X(ib-1) + B_10(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_10(1) * X(nx) + B_10(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_10(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
nx = nd
|
||||
!DIR$ LOOP COUNT(8)
|
||||
@ -1059,8 +1334,45 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
enddo
|
||||
endif
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(X,nx,B_00,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
|
||||
d(4) = d(4) + B_00(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
ny=0
|
||||
!DIR$ LOOP COUNT(8)
|
||||
@ -1070,8 +1382,45 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
!DIR$ FORCEINLINE
|
||||
call I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
|
||||
d(4) = d(4) + C_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
@ -1089,7 +1438,7 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
integer :: nx, ix,ny
|
||||
double precision :: X(0:max_dim),Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
|
||||
integer :: i
|
||||
integer :: i, ib
|
||||
|
||||
select case (c)
|
||||
case (0)
|
||||
@ -1119,8 +1468,47 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
Y(1) = D_00(1)
|
||||
Y(2) = D_00(2)
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(Y,ny,D_00,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,D_00,d,nd)
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
|
||||
d(3) = d(3) + D_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(0) * Y(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
|
||||
d(3) = d(3) + D_00(1) * Y(2) + D_00(2) * Y(1)
|
||||
d(4) = d(4) + D_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + D_00(0) * Y(ib) + D_00(1) * Y(ib-1) + D_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + D_00(1) * Y(ny) + D_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + D_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
|
||||
return
|
||||
|
||||
case default
|
||||
@ -1137,8 +1525,45 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
X(ix) *= dble(c-1)
|
||||
enddo
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(X,nx,B_01,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_01,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_01(0) * X(0)
|
||||
d(1) = d(1) + B_01(1) * X(0)
|
||||
d(2) = d(2) + B_01(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_01(0) * X(0)
|
||||
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
|
||||
d(2) = d(2) + B_01(1) * X(1) + B_01(2) * X(0)
|
||||
d(3) = d(3) + B_01(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_01(0) * X(0)
|
||||
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
|
||||
d(2) = d(2) + B_01(0) * X(2) + B_01(1) * X(1) + B_01(2) * X(0)
|
||||
d(3) = d(3) + B_01(1) * X(2) + B_01(2) * X(1)
|
||||
d(4) = d(4) + B_01(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_01(0) * X(0)
|
||||
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_01(0) * X(ib) + B_01(1) * X(ib-1) + B_01(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_01(1) * X(nx) + B_01(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_01(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
ny = 0
|
||||
!DIR$ LOOP COUNT(6)
|
||||
@ -1147,8 +1572,46 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
enddo
|
||||
call I_x2_pol_mult(c-1,B_10,B_01,B_00,C_00,D_00,Y,ny,dim)
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_poly(Y,ny,D_00,2,d,nd)
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,D_00,d,nd)
|
||||
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
|
||||
d(3) = d(3) + D_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(0) * Y(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
|
||||
d(3) = d(3) + D_00(1) * Y(2) + D_00(2) * Y(1)
|
||||
d(4) = d(4) + D_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + D_00(0) * Y(ib) + D_00(1) * Y(ib-1) + D_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + D_00(1) * Y(ny) + D_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + D_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end select
|
||||
end
|
||||
@ -1170,7 +1633,8 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
|
||||
logical, external :: ao_two_e_integral_zero
|
||||
|
||||
integer :: i,k
|
||||
double precision :: ao_two_e_integral,cpu_1,cpu_2, wall_1, wall_2
|
||||
double precision, external :: ao_two_e_integral
|
||||
double precision :: cpu_1,cpu_2, wall_1, wall_2
|
||||
double precision :: integral, wall_0
|
||||
double precision :: thr
|
||||
integer :: kk, m, j1, i1
|
||||
@ -1206,3 +1670,87 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
|
||||
subroutine multiply_poly_local(b,nb,c,nc,d,nd)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Multiply two polynomials
|
||||
! D(t) += B(t)*C(t)
|
||||
END_DOC
|
||||
|
||||
integer, intent(in) :: nb, nc
|
||||
integer, intent(out) :: nd
|
||||
double precision, intent(in) :: b(0:nb), c(0:nc)
|
||||
double precision, intent(inout) :: d(0:nb+nc)
|
||||
|
||||
integer :: ndtmp
|
||||
integer :: ib, ic, id, k
|
||||
if(ior(nc,nb) < 0) return !False if nc>=0 and nb>=0
|
||||
|
||||
do ib=0,nb
|
||||
do ic = 0,nc
|
||||
d(ib+ic) = d(ib+ic) + c(ic) * b(ib)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do nd = nb+nc,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
subroutine multiply_poly_c2_inline_2e(b,nb,c,d,nd)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Multiply two polynomials
|
||||
! D(t) += B(t)*C(t)
|
||||
END_DOC
|
||||
|
||||
integer, intent(in) :: nb
|
||||
integer, intent(out) :: nd
|
||||
double precision, intent(in) :: b(0:nb), c(0:2)
|
||||
double precision, intent(inout) :: d(0:nb+2)
|
||||
|
||||
integer :: ndtmp
|
||||
integer :: ib, ic, id, k
|
||||
if(nb < 0) return !False if nb>=0
|
||||
|
||||
select case (nb)
|
||||
case (0)
|
||||
d(0) = d(0) + c(0) * b(0)
|
||||
d(1) = d(1) + c(1) * b(0)
|
||||
d(2) = d(2) + c(2) * b(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + c(0) * b(0)
|
||||
d(1) = d(1) + c(0) * b(1) + c(1) * b(0)
|
||||
d(2) = d(2) + c(1) * b(1) + c(2) * b(0)
|
||||
d(3) = d(3) + c(2) * b(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + c(0) * b(0)
|
||||
d(1) = d(1) + c(0) * b(1) + c(1) * b(0)
|
||||
d(2) = d(2) + c(0) * b(2) + c(1) * b(1) + c(2) * b(0)
|
||||
d(3) = d(3) + c(1) * b(2) + c(2) * b(1)
|
||||
d(4) = d(4) + c(2) * b(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + c(0) * b(0)
|
||||
d(1) = d(1) + c(0) * b(1) + c(1) * b(0)
|
||||
do ib=2,nb
|
||||
d(ib) = d(ib) + c(0) * b(ib) + c(1) * b(ib-1) + c(2) * b(ib-2)
|
||||
enddo
|
||||
d(nb+1) = d(nb+1) + c(1) * b(nb) + c(2) * b(nb-1)
|
||||
d(nb+2) = d(nb+2) + c(2) * b(nb)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nb+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
|
@ -10,8 +10,8 @@ function run() {
|
||||
qp set perturbation do_pt2 False
|
||||
qp set determinants n_det_max 8000
|
||||
qp set determinants n_states 1
|
||||
qp set davidson threshold_davidson 1.e-10
|
||||
qp set davidson n_states_diag 8
|
||||
qp set davidson_keywords threshold_davidson 1.e-10
|
||||
qp set davidson_keywords n_states_diag 8
|
||||
qp run fci
|
||||
energy1="$(ezfio get fci energy | tr '[]' ' ' | cut -d ',' -f 1)"
|
||||
eq $energy1 $1 $thresh
|
||||
|
@ -33,6 +33,10 @@ doc: Number of angular grid points given from input. Warning, this number cannot
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 1202
|
||||
|
||||
[n_points_extra_final_grid]
|
||||
type: integer
|
||||
doc: Total number of extra_grid points
|
||||
interface: ezfio
|
||||
|
||||
[extra_grid_type_sgn]
|
||||
type: integer
|
||||
@ -64,3 +68,15 @@ doc: Number of angular extra_grid points given from input. Warning, this number
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 1202
|
||||
|
||||
[rad_grid_type]
|
||||
type: character*(32)
|
||||
doc: method used to sample the radial space. Possible choices are [KNOWLES | GILL]
|
||||
interface: ezfio,provider,ocaml
|
||||
default: KNOWLES
|
||||
|
||||
[extra_rad_grid_type]
|
||||
type: character*(32)
|
||||
doc: method used to sample the radial space. Possible choices are [KNOWLES | GILL]
|
||||
interface: ezfio,provider,ocaml
|
||||
default: KNOWLES
|
||||
|
||||
|
@ -1,7 +1,9 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [integer, n_points_extra_radial_grid]
|
||||
&BEGIN_PROVIDER [integer, n_points_extra_integration_angular]
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! n_points_extra_radial_grid = number of radial grid points_extra per atom
|
||||
!
|
||||
@ -9,7 +11,10 @@
|
||||
!
|
||||
! These numbers are automatically set by setting the grid_type_sgn parameter
|
||||
END_DOC
|
||||
if(.not.my_extra_grid_becke)then
|
||||
|
||||
implicit none
|
||||
|
||||
if(.not. my_extra_grid_becke) then
|
||||
select case (extra_grid_type_sgn)
|
||||
case(0)
|
||||
n_points_extra_radial_grid = 23
|
||||
@ -27,70 +32,118 @@ if(.not.my_extra_grid_becke)then
|
||||
write(*,*) '!!! Quadrature grid not available !!!'
|
||||
stop
|
||||
end select
|
||||
else
|
||||
else
|
||||
n_points_extra_radial_grid = my_n_pt_r_extra_grid
|
||||
n_points_extra_integration_angular = my_n_pt_a_extra_grid
|
||||
endif
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [integer, n_points_extra_grid_per_atom]
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! Number of grid points_extra per atom
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
n_points_extra_grid_per_atom = n_points_extra_integration_angular * n_points_extra_radial_grid
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, grid_points_extra_radial, (n_points_extra_radial_grid)]
|
||||
&BEGIN_PROVIDER [double precision, dr_radial_extra_integral]
|
||||
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! points_extra in [0,1] to map the radial integral [0,\infty]
|
||||
END_DOC
|
||||
dr_radial_extra_integral = 1.d0/dble(n_points_extra_radial_grid-1)
|
||||
|
||||
implicit none
|
||||
integer :: i
|
||||
|
||||
dr_radial_extra_integral = 1.d0/dble(n_points_extra_radial_grid-1)
|
||||
do i = 1, n_points_extra_radial_grid
|
||||
grid_points_extra_radial(i) = dble(i-1) * dr_radial_extra_integral
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, grid_points_extra_per_atom, (3,n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! x,y,z coordinates of grid points_extra used for integration in 3d space
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,j,k
|
||||
double precision :: dr,x_ref,y_ref,z_ref
|
||||
double precision :: knowles_function
|
||||
integer :: i, j, k
|
||||
double precision :: dr, x_ref, y_ref, z_ref
|
||||
double precision :: x, r, tmp
|
||||
double precision, external :: knowles_function
|
||||
|
||||
grid_points_extra_per_atom = 0.d0
|
||||
|
||||
PROVIDE extra_rad_grid_type
|
||||
if(extra_rad_grid_type .eq. "KNOWLES") then
|
||||
|
||||
do i = 1, nucl_num
|
||||
x_ref = nucl_coord(i,1)
|
||||
y_ref = nucl_coord(i,2)
|
||||
z_ref = nucl_coord(i,3)
|
||||
do j = 1, n_points_extra_radial_grid-1
|
||||
double precision :: x,r
|
||||
|
||||
! x value for the mapping of the [0, +\infty] to [0,1]
|
||||
x = grid_points_extra_radial(j)
|
||||
|
||||
! value of the radial coordinate for the integration
|
||||
r = knowles_function(alpha_knowles(grid_atomic_number(i)),m_knowles,x)
|
||||
r = knowles_function(alpha_knowles(grid_atomic_number(i)), m_knowles, x)
|
||||
|
||||
! explicit values of the grid points_extra centered around each atom
|
||||
do k = 1, n_points_extra_integration_angular
|
||||
grid_points_extra_per_atom(1,k,j,i) = &
|
||||
x_ref + angular_quadrature_points_extra(k,1) * r
|
||||
grid_points_extra_per_atom(2,k,j,i) = &
|
||||
y_ref + angular_quadrature_points_extra(k,2) * r
|
||||
grid_points_extra_per_atom(3,k,j,i) = &
|
||||
z_ref + angular_quadrature_points_extra(k,3) * r
|
||||
grid_points_extra_per_atom(1,k,j,i) = x_ref + angular_quadrature_points_extra(k,1) * r
|
||||
grid_points_extra_per_atom(2,k,j,i) = y_ref + angular_quadrature_points_extra(k,2) * r
|
||||
grid_points_extra_per_atom(3,k,j,i) = z_ref + angular_quadrature_points_extra(k,3) * r
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
elseif(extra_rad_grid_type .eq. "GILL") then
|
||||
! GILL & CHIEN, 2002
|
||||
|
||||
do i = 1, nucl_num
|
||||
x_ref = nucl_coord(i,1)
|
||||
y_ref = nucl_coord(i,2)
|
||||
z_ref = nucl_coord(i,3)
|
||||
do j = 1, n_points_extra_radial_grid-1
|
||||
|
||||
r = R_gill * dble(j-1)**2 / dble(n_points_extra_radial_grid-j+1)**2
|
||||
|
||||
! explicit values of the grid points_extra centered around each atom
|
||||
do k = 1, n_points_extra_integration_angular
|
||||
grid_points_extra_per_atom(1,k,j,i) = x_ref + angular_quadrature_points_extra(k,1) * r
|
||||
grid_points_extra_per_atom(2,k,j,i) = y_ref + angular_quadrature_points_extra(k,2) * r
|
||||
grid_points_extra_per_atom(3,k,j,i) = z_ref + angular_quadrature_points_extra(k,3) * r
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
print*, " extra_rad_grid_type = ", extra_rad_grid_type, ' is not implemented'
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) ]
|
||||
|
||||
BEGIN_DOC
|
||||
! Weight function at grid points_extra : w_n(r) according to the equation (22)
|
||||
! of Becke original paper (JCP, 88, 1988)
|
||||
@ -99,11 +152,14 @@ BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration
|
||||
! represented by the last dimension and the points_extra are labelled by the
|
||||
! other dimensions.
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,j,k,l,m
|
||||
integer :: i, j, k, l, m
|
||||
double precision :: r(3)
|
||||
double precision :: accu,cell_function_becke
|
||||
double precision :: accu
|
||||
double precision :: tmp_array(nucl_num)
|
||||
double precision, external :: cell_function_becke
|
||||
|
||||
! run over all points_extra in space
|
||||
! that are referred to each atom
|
||||
do j = 1, nucl_num
|
||||
@ -114,6 +170,7 @@ BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration
|
||||
r(1) = grid_points_extra_per_atom(1,l,k,j)
|
||||
r(2) = grid_points_extra_per_atom(2,l,k,j)
|
||||
r(3) = grid_points_extra_per_atom(3,l,k,j)
|
||||
|
||||
accu = 0.d0
|
||||
! For each of these points_extra in space, ou need to evaluate the P_n(r)
|
||||
do i = 1, nucl_num
|
||||
@ -124,6 +181,7 @@ BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration
|
||||
enddo
|
||||
accu = 1.d0/accu
|
||||
weight_at_r_extra(l,k,j) = tmp_array(j) * accu
|
||||
|
||||
if(isnan(weight_at_r_extra(l,k,j)))then
|
||||
print*,'isnan(weight_at_r_extra(l,k,j))'
|
||||
print*,l,k,j
|
||||
@ -144,25 +202,32 @@ BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, final_weight_at_r_extra, (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) ]
|
||||
|
||||
BEGIN_DOC
|
||||
! Total weight on each grid point which takes into account all Lebedev, Voronoi and radial weights.
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,j,k,l,m
|
||||
integer :: i, j, k, l, m
|
||||
double precision :: r(3)
|
||||
double precision :: accu,cell_function_becke
|
||||
double precision :: tmp_array(nucl_num)
|
||||
double precision :: contrib_integration,x
|
||||
double precision :: derivative_knowles_function,knowles_function
|
||||
double precision :: contrib_integration, x, tmp
|
||||
double precision, external :: derivative_knowles_function, knowles_function
|
||||
|
||||
PROVIDE extra_rad_grid_type
|
||||
if(extra_rad_grid_type .eq. "KNOWLES") then
|
||||
|
||||
! run over all points_extra in space
|
||||
do j = 1, nucl_num ! that are referred to each atom
|
||||
do i = 1, n_points_extra_radial_grid -1 !for each radial grid attached to the "jth" atom
|
||||
x = grid_points_extra_radial(i) ! x value for the mapping of the [0, +\infty] to [0,1]
|
||||
do k = 1, n_points_extra_integration_angular ! for each angular point attached to the "jth" atom
|
||||
contrib_integration = derivative_knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)&
|
||||
*knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)**2
|
||||
* knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)**2
|
||||
final_weight_at_r_extra(k,i,j) = weights_angular_points_extra(k) * weight_at_r_extra(k,i,j) * contrib_integration * dr_radial_extra_integral
|
||||
if(isnan(final_weight_at_r_extra(k,i,j)))then
|
||||
print*,'isnan(final_weight_at_r_extra(k,i,j))'
|
||||
@ -174,5 +239,36 @@ BEGIN_PROVIDER [double precision, final_weight_at_r_extra, (n_points_extra_integ
|
||||
enddo
|
||||
enddo
|
||||
|
||||
elseif(extra_rad_grid_type .eq. "GILL") then
|
||||
! GILL & CHIEN, 2002
|
||||
|
||||
PROVIDE R_gill
|
||||
tmp = 2.d0 * R_gill * R_gill * R_gill * dble(n_points_extra_radial_grid)
|
||||
|
||||
! run over all points_extra in space
|
||||
do j = 1, nucl_num ! that are referred to each atom
|
||||
do i = 1, n_points_extra_radial_grid -1 !for each radial grid attached to the "jth" atom
|
||||
contrib_integration = tmp * dble(i-1)**5 / dble(n_points_extra_radial_grid-i+1)**7
|
||||
|
||||
do k = 1, n_points_extra_integration_angular ! for each angular point attached to the "jth" atom
|
||||
final_weight_at_r_extra(k,i,j) = weights_angular_points_extra(k) * weight_at_r_extra(k,i,j) * contrib_integration
|
||||
if(isnan(final_weight_at_r_extra(k,i,j)))then
|
||||
print*,'isnan(final_weight_at_r_extra(k,i,j))'
|
||||
print*,k,i,j
|
||||
write(*,'(100(F16.10,X))') weights_angular_points_extra(k), weight_at_r_extra(k,i,j), contrib_integration
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
print*, " extra_rad_grid_type = ", extra_rad_grid_type, ' is not implemented'
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -1,42 +1,55 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [integer, n_points_extra_final_grid]
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! Number of points_extra which are non zero
|
||||
END_DOC
|
||||
integer :: i,j,k,l
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
|
||||
n_points_extra_final_grid = 0
|
||||
|
||||
do j = 1, nucl_num
|
||||
do i = 1, n_points_extra_radial_grid -1
|
||||
do k = 1, n_points_extra_integration_angular
|
||||
if(dabs(final_weight_at_r_extra(k,i,j)) < thresh_extra_grid)then
|
||||
if(dabs(final_weight_at_r_extra(k,i,j)) < thresh_extra_grid) then
|
||||
cycle
|
||||
endif
|
||||
n_points_extra_final_grid += 1
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*,'n_points_extra_final_grid = ',n_points_extra_final_grid
|
||||
print*,'n max point = ',n_points_extra_integration_angular*(n_points_extra_radial_grid*nucl_num - 1)
|
||||
! call ezfio_set_becke_numerical_grid_n_points_extra_final_grid(n_points_extra_final_grid)
|
||||
|
||||
print*, ' n_points_extra_final_grid = ', n_points_extra_final_grid
|
||||
print*, ' n max point = ', n_points_extra_integration_angular*(n_points_extra_radial_grid*nucl_num - 1)
|
||||
call ezfio_set_becke_numerical_grid_n_points_extra_final_grid(n_points_extra_final_grid)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, final_grid_points_extra, (3,n_points_extra_final_grid)]
|
||||
&BEGIN_PROVIDER [double precision, final_weight_at_r_vector_extra, (n_points_extra_final_grid) ]
|
||||
&BEGIN_PROVIDER [integer, index_final_points_extra, (3,n_points_extra_final_grid) ]
|
||||
&BEGIN_PROVIDER [integer, index_final_points_extra_reverse, (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) ]
|
||||
implicit none
|
||||
&BEGIN_PROVIDER [double precision, final_weight_at_r_vector_extra, (n_points_extra_final_grid)]
|
||||
&BEGIN_PROVIDER [integer, index_final_points_extra, (3,n_points_extra_final_grid)]
|
||||
&BEGIN_PROVIDER [integer, index_final_points_extra_reverse, (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point
|
||||
!
|
||||
! final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
|
||||
!
|
||||
! index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
|
||||
!
|
||||
! index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
|
||||
! final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point
|
||||
!
|
||||
! final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
|
||||
!
|
||||
! index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
|
||||
!
|
||||
! index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,j,k,l,i_count
|
||||
double precision :: r(3)
|
||||
|
||||
i_count = 0
|
||||
do j = 1, nucl_num
|
||||
do i = 1, n_points_extra_radial_grid -1
|
||||
@ -58,3 +71,5 @@ END_PROVIDER
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
@ -1,6 +1,9 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [integer, n_points_radial_grid]
|
||||
&BEGIN_PROVIDER [integer, n_points_integration_angular]
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! n_points_radial_grid = number of radial grid points per atom
|
||||
!
|
||||
@ -8,7 +11,10 @@
|
||||
!
|
||||
! These numbers are automatically set by setting the grid_type_sgn parameter
|
||||
END_DOC
|
||||
if(.not.my_grid_becke)then
|
||||
|
||||
implicit none
|
||||
|
||||
if(.not. my_grid_becke) then
|
||||
select case (grid_type_sgn)
|
||||
case(0)
|
||||
n_points_radial_grid = 23
|
||||
@ -26,78 +32,146 @@ if(.not.my_grid_becke)then
|
||||
write(*,*) '!!! Quadrature grid not available !!!'
|
||||
stop
|
||||
end select
|
||||
else
|
||||
else
|
||||
n_points_radial_grid = my_n_pt_r_grid
|
||||
n_points_integration_angular = my_n_pt_a_grid
|
||||
endif
|
||||
endif
|
||||
|
||||
print*, " n_points_radial_grid = ", n_points_radial_grid
|
||||
print*, " n_points_integration_angular = ", n_points_integration_angular
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [integer, n_points_grid_per_atom]
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! Number of grid points per atom
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
n_points_grid_per_atom = n_points_integration_angular * n_points_radial_grid
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer , m_knowles]
|
||||
implicit none
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [integer, m_knowles]
|
||||
|
||||
BEGIN_DOC
|
||||
! value of the "m" parameter in the equation (7) of the paper of Knowles (JCP, 104, 1996)
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
m_knowles = 3
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, R_gill]
|
||||
|
||||
implicit none
|
||||
|
||||
R_gill = 3.d0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, grid_points_radial, (n_points_radial_grid)]
|
||||
&BEGIN_PROVIDER [double precision, dr_radial_integral]
|
||||
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! points in [0,1] to map the radial integral [0,\infty]
|
||||
END_DOC
|
||||
dr_radial_integral = 1.d0/dble(n_points_radial_grid-1)
|
||||
|
||||
implicit none
|
||||
integer :: i
|
||||
|
||||
dr_radial_integral = 1.d0 / dble(n_points_radial_grid-1)
|
||||
|
||||
do i = 1, n_points_radial_grid
|
||||
grid_points_radial(i) = dble(i-1) * dr_radial_integral
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_integration_angular,n_points_radial_grid,nucl_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! x,y,z coordinates of grid points used for integration in 3d space
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,j,k
|
||||
double precision :: dr,x_ref,y_ref,z_ref
|
||||
double precision :: knowles_function
|
||||
integer :: i, j, k
|
||||
double precision :: dr, x_ref, y_ref, z_ref
|
||||
double precision :: x, r, tmp
|
||||
double precision, external :: knowles_function
|
||||
|
||||
grid_points_per_atom = 0.d0
|
||||
|
||||
PROVIDE rad_grid_type
|
||||
if(rad_grid_type .eq. "KNOWLES") then
|
||||
|
||||
do i = 1, nucl_num
|
||||
x_ref = nucl_coord(i,1)
|
||||
y_ref = nucl_coord(i,2)
|
||||
z_ref = nucl_coord(i,3)
|
||||
do j = 1, n_points_radial_grid-1
|
||||
double precision :: x,r
|
||||
|
||||
! x value for the mapping of the [0, +\infty] to [0,1]
|
||||
x = grid_points_radial(j)
|
||||
|
||||
! value of the radial coordinate for the integration
|
||||
r = knowles_function(alpha_knowles(grid_atomic_number(i)),m_knowles,x)
|
||||
r = knowles_function(alpha_knowles(grid_atomic_number(i)), m_knowles, x)
|
||||
|
||||
! explicit values of the grid points centered around each atom
|
||||
do k = 1, n_points_integration_angular
|
||||
grid_points_per_atom(1,k,j,i) = &
|
||||
x_ref + angular_quadrature_points(k,1) * r
|
||||
grid_points_per_atom(2,k,j,i) = &
|
||||
y_ref + angular_quadrature_points(k,2) * r
|
||||
grid_points_per_atom(3,k,j,i) = &
|
||||
z_ref + angular_quadrature_points(k,3) * r
|
||||
grid_points_per_atom(1,k,j,i) = x_ref + angular_quadrature_points(k,1) * r
|
||||
grid_points_per_atom(2,k,j,i) = y_ref + angular_quadrature_points(k,2) * r
|
||||
grid_points_per_atom(3,k,j,i) = z_ref + angular_quadrature_points(k,3) * r
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
elseif(rad_grid_type .eq. "GILL") then
|
||||
! GILL & CHIEN, 2002
|
||||
|
||||
do i = 1, nucl_num
|
||||
x_ref = nucl_coord(i,1)
|
||||
y_ref = nucl_coord(i,2)
|
||||
z_ref = nucl_coord(i,3)
|
||||
do j = 1, n_points_radial_grid-1
|
||||
|
||||
r = R_gill * dble(j-1)**2 / dble(n_points_radial_grid-j+1)**2
|
||||
|
||||
! explicit values of the grid points centered around each atom
|
||||
do k = 1, n_points_integration_angular
|
||||
grid_points_per_atom(1,k,j,i) = x_ref + angular_quadrature_points(k,1) * r
|
||||
grid_points_per_atom(2,k,j,i) = y_ref + angular_quadrature_points(k,2) * r
|
||||
grid_points_per_atom(3,k,j,i) = z_ref + angular_quadrature_points(k,3) * r
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
print*, " rad_grid_type = ", rad_grid_type, ' is not implemented'
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_points_radial_grid,nucl_num) ]
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_points_radial_grid,nucl_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! Weight function at grid points : w_n(r) according to the equation (22)
|
||||
! of Becke original paper (JCP, 88, 1988)
|
||||
@ -106,11 +180,13 @@ BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_p
|
||||
! represented by the last dimension and the points are labelled by the
|
||||
! other dimensions.
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,j,k,l,m
|
||||
double precision :: r(3)
|
||||
double precision :: accu,cell_function_becke
|
||||
integer :: i, j, k, l, m
|
||||
double precision :: r(3), accu
|
||||
double precision :: tmp_array(nucl_num)
|
||||
double precision, external :: cell_function_becke
|
||||
|
||||
! run over all points in space
|
||||
! that are referred to each atom
|
||||
do j = 1, nucl_num
|
||||
@ -121,17 +197,19 @@ BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_p
|
||||
r(1) = grid_points_per_atom(1,l,k,j)
|
||||
r(2) = grid_points_per_atom(2,l,k,j)
|
||||
r(3) = grid_points_per_atom(3,l,k,j)
|
||||
|
||||
accu = 0.d0
|
||||
! For each of these points in space, ou need to evaluate the P_n(r)
|
||||
do i = 1, nucl_num
|
||||
! function defined for each atom "i" by equation (13) and (21) with k == 3
|
||||
tmp_array(i) = cell_function_becke(r,i) ! P_n(r)
|
||||
tmp_array(i) = cell_function_becke(r, i) ! P_n(r)
|
||||
! Then you compute the summ the P_n(r) function for each of the "r" points
|
||||
accu += tmp_array(i)
|
||||
enddo
|
||||
accu = 1.d0/accu
|
||||
weight_at_r(l,k,j) = tmp_array(j) * accu
|
||||
if(isnan(weight_at_r(l,k,j)))then
|
||||
|
||||
if(isnan(weight_at_r(l,k,j))) then
|
||||
print*,'isnan(weight_at_r(l,k,j))'
|
||||
print*,l,k,j
|
||||
accu = 0.d0
|
||||
@ -151,35 +229,76 @@ BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_p
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, final_weight_at_r, (n_points_integration_angular,n_points_radial_grid,nucl_num)]
|
||||
|
||||
BEGIN_PROVIDER [double precision, final_weight_at_r, (n_points_integration_angular,n_points_radial_grid,nucl_num) ]
|
||||
BEGIN_DOC
|
||||
! Total weight on each grid point which takes into account all Lebedev, Voronoi and radial weights.
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,j,k,l,m
|
||||
integer :: i, j, k, l, m
|
||||
double precision :: r(3)
|
||||
double precision :: accu,cell_function_becke
|
||||
double precision :: tmp_array(nucl_num)
|
||||
double precision :: contrib_integration,x
|
||||
double precision :: derivative_knowles_function,knowles_function
|
||||
double precision :: contrib_integration, x, tmp
|
||||
double precision, external :: derivative_knowles_function, knowles_function
|
||||
|
||||
final_weight_at_r = 0.d0
|
||||
|
||||
PROVIDE rad_grid_type
|
||||
if(rad_grid_type .eq. "KNOWLES") then
|
||||
|
||||
! run over all points in space
|
||||
do j = 1, nucl_num ! that are referred to each atom
|
||||
do i = 1, n_points_radial_grid -1 !for each radial grid attached to the "jth" atom
|
||||
x = grid_points_radial(i) ! x value for the mapping of the [0, +\infty] to [0,1]
|
||||
|
||||
do k = 1, n_points_integration_angular ! for each angular point attached to the "jth" atom
|
||||
contrib_integration = derivative_knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)&
|
||||
*knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)**2
|
||||
contrib_integration = derivative_knowles_function(alpha_knowles(grid_atomic_number(j)), m_knowles, x) &
|
||||
* knowles_function(alpha_knowles(grid_atomic_number(j)), m_knowles, x)**2
|
||||
|
||||
final_weight_at_r(k,i,j) = weights_angular_points(k) * weight_at_r(k,i,j) * contrib_integration * dr_radial_integral
|
||||
if(isnan(final_weight_at_r(k,i,j)))then
|
||||
|
||||
if(isnan(final_weight_at_r(k,i,j))) then
|
||||
print*,'isnan(final_weight_at_r(k,i,j))'
|
||||
print*,k,i,j
|
||||
write(*,'(100(F16.10,X))')weights_angular_points(k) , weight_at_r(k,i,j) , contrib_integration , dr_radial_integral
|
||||
write(*,'(100(F16.10,X))') weights_angular_points(k), weight_at_r(k,i,j), contrib_integration
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
elseif(rad_grid_type .eq. "GILL") then
|
||||
! GILL & CHIEN, 2002
|
||||
|
||||
tmp = 2.d0 * R_gill * R_gill * R_gill * dble(n_points_radial_grid)
|
||||
|
||||
! run over all points in space
|
||||
do j = 1, nucl_num ! that are referred to each atom
|
||||
do i = 1, n_points_radial_grid - 1 !for each radial grid attached to the "jth" atom
|
||||
contrib_integration = tmp * dble(i-1)**5 / dble(n_points_radial_grid-i+1)**7
|
||||
do k = 1, n_points_integration_angular ! for each angular point attached to the "jth" atom
|
||||
final_weight_at_r(k,i,j) = weights_angular_points(k) * weight_at_r(k,i,j) * contrib_integration
|
||||
|
||||
if(isnan(final_weight_at_r(k,i,j))) then
|
||||
print*,'isnan(final_weight_at_r(k,i,j))'
|
||||
print*,k,i,j
|
||||
write(*,'(100(F16.10,X))') weights_angular_points(k), weight_at_r(k,i,j), contrib_integration, dr_radial_integral
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
print*, " rad_grid_type = ", rad_grid_type, ' is not implemented'
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
@ -1,10 +1,13 @@
|
||||
|
||||
BEGIN_PROVIDER [integer, n_points_final_grid]
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! Number of points which are non zero
|
||||
END_DOC
|
||||
integer :: i,j,k,l
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
|
||||
n_points_final_grid = 0
|
||||
do j = 1, nucl_num
|
||||
do i = 1, n_points_radial_grid -1
|
||||
@ -16,27 +19,38 @@ BEGIN_PROVIDER [integer, n_points_final_grid]
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*,'n_points_final_grid = ',n_points_final_grid
|
||||
print*,'n max point = ',n_points_integration_angular*(n_points_radial_grid*nucl_num - 1)
|
||||
|
||||
print*,' n_points_final_grid = ', n_points_final_grid
|
||||
print*,' n max point = ', n_points_integration_angular*(n_points_radial_grid*nucl_num - 1)
|
||||
call ezfio_set_becke_numerical_grid_n_points_final_grid(n_points_final_grid)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, final_grid_points, (3,n_points_final_grid)]
|
||||
&BEGIN_PROVIDER [double precision, final_weight_at_r_vector, (n_points_final_grid) ]
|
||||
&BEGIN_PROVIDER [integer, index_final_points, (3,n_points_final_grid) ]
|
||||
&BEGIN_PROVIDER [integer, index_final_points_reverse, (n_points_integration_angular,n_points_radial_grid,nucl_num) ]
|
||||
implicit none
|
||||
&BEGIN_PROVIDER [double precision, final_weight_at_r_vector, (n_points_final_grid)]
|
||||
&BEGIN_PROVIDER [integer, index_final_points, (3,n_points_final_grid)]
|
||||
&BEGIN_PROVIDER [integer, index_final_points_reverse, (n_points_integration_angular,n_points_radial_grid,nucl_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! final_grid_points(1:3,j) = (/ x, y, z /) of the jth grid point
|
||||
!
|
||||
! final_weight_at_r_vector(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
|
||||
!
|
||||
! index_final_points(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
|
||||
!
|
||||
! index_final_points_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
|
||||
! final_grid_points(1:3,j) = (/ x, y, z /) of the jth grid point
|
||||
!
|
||||
! final_weight_at_r_vector(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
|
||||
!
|
||||
! index_final_points(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
|
||||
!
|
||||
! index_final_points_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
|
||||
END_DOC
|
||||
integer :: i,j,k,l,i_count
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l, i_count
|
||||
double precision :: r(3)
|
||||
double precision :: wall0, wall1
|
||||
|
||||
call wall_time(wall0)
|
||||
print *, ' Providing final_grid_points ...'
|
||||
|
||||
i_count = 0
|
||||
do j = 1, nucl_num
|
||||
do i = 1, n_points_radial_grid -1
|
||||
@ -57,18 +71,34 @@ END_PROVIDER
|
||||
enddo
|
||||
enddo
|
||||
|
||||
FREE grid_points_per_atom
|
||||
FREE final_weight_at_r
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for final_grid_points,', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, final_grid_points_transp, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! Transposed final_grid_points
|
||||
! Transposed final_grid_points
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i,j
|
||||
do j=1,3
|
||||
do i=1,n_points_final_grid
|
||||
|
||||
do j = 1, 3
|
||||
do i = 1, n_points_final_grid
|
||||
final_grid_points_transp(i,j) = final_grid_points(j,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
|
@ -1,34 +1,53 @@
|
||||
double precision function knowles_function(alpha,m,x)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Function proposed by Knowles (JCP, 104, 1996) for distributing the radial points :
|
||||
! the Log "m" function ( equation (7) in the paper )
|
||||
END_DOC
|
||||
double precision, intent(in) :: alpha,x
|
||||
integer, intent(in) :: m
|
||||
!print*, x
|
||||
knowles_function = -alpha * dlog(1.d0-x**m)
|
||||
end
|
||||
|
||||
double precision function derivative_knowles_function(alpha,m,x)
|
||||
implicit none
|
||||
! ---
|
||||
|
||||
double precision function knowles_function(alpha, m, x)
|
||||
|
||||
BEGIN_DOC
|
||||
! Derivative of the function proposed by Knowles (JCP, 104, 1996) for distributing the radial points
|
||||
! Function proposed by Knowles (JCP, 104, 1996) for distributing the radial points :
|
||||
! the Log "m" function ( equation (7) in the paper )
|
||||
END_DOC
|
||||
double precision, intent(in) :: alpha,x
|
||||
|
||||
implicit none
|
||||
double precision, intent(in) :: alpha, x
|
||||
integer, intent(in) :: m
|
||||
|
||||
!print*, x
|
||||
knowles_function = -alpha * dlog(1.d0-x**m)
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
double precision function derivative_knowles_function(alpha, m, x)
|
||||
|
||||
BEGIN_DOC
|
||||
! Derivative of the function proposed by Knowles (JCP, 104, 1996) for distributing the radial points
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
double precision, intent(in) :: alpha, x
|
||||
integer, intent(in) :: m
|
||||
double precision :: f
|
||||
|
||||
f = x**(m-1)
|
||||
derivative_knowles_function = alpha * dble(m) * f / (1.d0 - x*f)
|
||||
end
|
||||
|
||||
BEGIN_PROVIDER [double precision, alpha_knowles, (100)]
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, alpha_knowles, (100)]
|
||||
|
||||
BEGIN_DOC
|
||||
! Recommended values for the alpha parameters according to the paper of Knowles (JCP, 104, 1996)
|
||||
! as a function of the nuclear charge
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i
|
||||
BEGIN_DOC
|
||||
! Recommended values for the alpha parameters according to the paper of Knowles (JCP, 104, 1996)
|
||||
! as a function of the nuclear charge
|
||||
END_DOC
|
||||
|
||||
! H-He
|
||||
alpha_knowles(1) = 5.d0
|
||||
@ -68,4 +87,7 @@
|
||||
alpha_knowles(i) = 7.d0
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
@ -20,31 +20,42 @@ double precision function f_function_becke(x)
|
||||
f_function_becke = 1.5d0 * x - 0.5d0 * x*x*x
|
||||
end
|
||||
|
||||
double precision function cell_function_becke(r,atom_number)
|
||||
! ---
|
||||
|
||||
double precision function cell_function_becke(r, atom_number)
|
||||
|
||||
BEGIN_DOC
|
||||
! atom_number :: atom on which the cell function of Becke (1988, JCP,88(4))
|
||||
! r(1:3) :: x,y,z coordinantes of the current point
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
double precision, intent(in) :: r(3)
|
||||
integer, intent(in) :: atom_number
|
||||
BEGIN_DOC
|
||||
! atom_number :: atom on which the cell function of Becke (1988, JCP,88(4))
|
||||
! r(1:3) :: x,y,z coordinantes of the current point
|
||||
END_DOC
|
||||
double precision :: mu_ij,nu_ij
|
||||
double precision :: distance_i,distance_j,step_function_becke
|
||||
integer :: j
|
||||
double precision :: mu_ij, nu_ij
|
||||
double precision :: distance_i, distance_j, step_function_becke
|
||||
|
||||
distance_i = (r(1) - nucl_coord_transp(1,atom_number) ) * (r(1) - nucl_coord_transp(1,atom_number))
|
||||
distance_i += (r(2) - nucl_coord_transp(2,atom_number) ) * (r(2) - nucl_coord_transp(2,atom_number))
|
||||
distance_i += (r(3) - nucl_coord_transp(3,atom_number) ) * (r(3) - nucl_coord_transp(3,atom_number))
|
||||
distance_i = dsqrt(distance_i)
|
||||
|
||||
cell_function_becke = 1.d0
|
||||
do j = 1, nucl_num
|
||||
if(j==atom_number)cycle
|
||||
if(j==atom_number) cycle
|
||||
|
||||
distance_j = (r(1) - nucl_coord_transp(1,j) ) * (r(1) - nucl_coord_transp(1,j))
|
||||
distance_j+= (r(2) - nucl_coord_transp(2,j) ) * (r(2) - nucl_coord_transp(2,j))
|
||||
distance_j+= (r(3) - nucl_coord_transp(3,j) ) * (r(3) - nucl_coord_transp(3,j))
|
||||
distance_j += (r(2) - nucl_coord_transp(2,j) ) * (r(2) - nucl_coord_transp(2,j))
|
||||
distance_j += (r(3) - nucl_coord_transp(3,j) ) * (r(3) - nucl_coord_transp(3,j))
|
||||
distance_j = dsqrt(distance_j)
|
||||
mu_ij = (distance_i - distance_j)*nucl_dist_inv(atom_number,j)
|
||||
|
||||
mu_ij = (distance_i - distance_j) * nucl_dist_inv(atom_number,j)
|
||||
nu_ij = mu_ij + slater_bragg_type_inter_distance_ua(atom_number,j) * (1.d0 - mu_ij*mu_ij)
|
||||
|
||||
cell_function_becke *= step_function_becke(nu_ij)
|
||||
enddo
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
|
@ -1,13 +1,37 @@
|
||||
! ---
|
||||
|
||||
program bi_ort_ints
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 10
|
||||
my_n_pt_a_grid = 14
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
call test_3e
|
||||
|
||||
! call test_3e
|
||||
! call test_5idx
|
||||
! call test_5idx2
|
||||
call test_4idx()
|
||||
!call test_4idx_n4()
|
||||
!call test_4idx2()
|
||||
!call test_5idx2
|
||||
!call test_5idx
|
||||
|
||||
end
|
||||
|
||||
subroutine test_5idx2
|
||||
PROVIDE three_e_5_idx_cycle_2_bi_ort
|
||||
end
|
||||
|
||||
subroutine test_4idx2()
|
||||
!PROVIDE three_e_4_idx_direct_bi_ort
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort
|
||||
end
|
||||
|
||||
subroutine test_3e
|
||||
@ -16,6 +40,7 @@ subroutine test_3e
|
||||
double precision :: accu, contrib,new,ref
|
||||
i = 1
|
||||
k = 1
|
||||
n = 0
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
@ -31,6 +56,7 @@ subroutine test_3e
|
||||
print*,'pb !!'
|
||||
print*,i,k,j,l,m,n
|
||||
print*,ref,new,contrib
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
@ -42,3 +68,408 @@ subroutine test_3e
|
||||
|
||||
|
||||
end
|
||||
|
||||
subroutine test_5idx
|
||||
implicit none
|
||||
integer :: i,k,j,l,m,n,ipoint
|
||||
double precision :: accu, contrib,new,ref
|
||||
double precision, external :: three_e_5_idx_exch12_bi_ort
|
||||
i = 1
|
||||
k = 1
|
||||
n = 0
|
||||
accu = 0.d0
|
||||
PROVIDE three_e_5_idx_direct_bi_ort_old
|
||||
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
! if (dabs(three_e_5_idx_direct_bi_ort(m,l,j,k,i) - three_e_5_idx_exch12_bi_ort(m,l,i,k,j)) > 1.d-10) then
|
||||
! stop
|
||||
! endif
|
||||
new = three_e_5_idx_direct_bi_ort(m,l,j,k,i)
|
||||
ref = three_e_5_idx_direct_bi_ort_old(m,l,j,k,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. 1.d-10)then
|
||||
print*,'direct'
|
||||
print*,i,k,j,l,m
|
||||
print*,ref,new,contrib
|
||||
stop
|
||||
endif
|
||||
!
|
||||
! new = three_e_5_idx_exch12_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_exch12_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'exch12'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
!
|
||||
! new = three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_cycle_1_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'cycle1'
|
||||
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! new = three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_cycle_2_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'cycle2'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! new = three_e_5_idx_exch23_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_exch23_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'exch23'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! new = three_e_5_idx_exch13_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_exch13_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'exch13'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! new = three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_cycle_1_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'cycle1'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! new = three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_cycle_2_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'cycle2'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! new = three_e_5_idx_exch23_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_exch23_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'exch23'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! new = three_e_5_idx_exch13_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_exch13_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'exch13'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*,'accu = ',accu/dble(mo_num)**5
|
||||
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine test_4idx_n4()
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
double precision :: accu, contrib, new, ref, thr
|
||||
|
||||
thr = 1d-10
|
||||
|
||||
PROVIDE three_e_4_idx_direct_bi_ort_old
|
||||
PROVIDE three_e_4_idx_direct_bi_ort_n4
|
||||
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_direct_bi_ort_n4 (l,k,j,i)
|
||||
ref = three_e_4_idx_direct_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_direct_bi_ort_n4'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on three_e_4_idx_direct_bi_ort_n4 = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_exch13_bi_ort_old
|
||||
PROVIDE three_e_4_idx_exch13_bi_ort_n4
|
||||
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_exch13_bi_ort_n4 (l,k,j,i)
|
||||
ref = three_e_4_idx_exch13_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_exch13_bi_ort_n4'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on three_e_4_idx_exch13_bi_ort_n4 = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_cycle_1_bi_ort_old
|
||||
PROVIDE three_e_4_idx_cycle_1_bi_ort_n4
|
||||
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_cycle_1_bi_ort_n4 (l,k,j,i)
|
||||
ref = three_e_4_idx_cycle_1_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_cycle_1_bi_ort_n4'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on three_e_4_idx_cycle_1_bi_ort_n4 = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort_old
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort_n4
|
||||
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_exch23_bi_ort_n4 (l,k,j,i)
|
||||
ref = three_e_4_idx_exch23_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_exch23_bi_ort_n4'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on three_e_4_idx_exch23_bi_ort_n4 = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine test_4idx()
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
double precision :: accu, contrib, new, ref, thr, norm
|
||||
|
||||
thr = 1d-10
|
||||
|
||||
PROVIDE three_e_4_idx_direct_bi_ort_old
|
||||
PROVIDE three_e_4_idx_direct_bi_ort
|
||||
|
||||
accu = 0.d0
|
||||
norm = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_direct_bi_ort (l,k,j,i)
|
||||
ref = three_e_4_idx_direct_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_direct_bi_ort'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
accu += contrib
|
||||
norm += dabs(ref)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
print*, ' accu on three_e_4_idx_direct_bi_ort (%) = ', 100.d0 * accu / norm
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_exch13_bi_ort_old
|
||||
PROVIDE three_e_4_idx_exch13_bi_ort
|
||||
|
||||
accu = 0.d0
|
||||
norm = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_exch13_bi_ort (l,k,j,i)
|
||||
ref = three_e_4_idx_exch13_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_exch13_bi_ort'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
accu += contrib
|
||||
norm += dabs(ref)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
print*, ' accu on three_e_4_idx_exch13_bi_ort (%) = ', 100.d0 * accu / norm
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_cycle_1_bi_ort_old
|
||||
PROVIDE three_e_4_idx_cycle_1_bi_ort
|
||||
|
||||
accu = 0.d0
|
||||
norm = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_cycle_1_bi_ort (l,k,j,i)
|
||||
ref = three_e_4_idx_cycle_1_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_cycle_1_bi_ort'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
accu += contrib
|
||||
norm += dabs(ref)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
print*, ' accu on three_e_4_idx_cycle_1_bi_ort (%) = ', 100.d0 * accu / norm
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort_old
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort
|
||||
|
||||
accu = 0.d0
|
||||
norm = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_exch23_bi_ort (l,k,j,i)
|
||||
ref = three_e_4_idx_exch23_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_exch23_bi_ort'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
accu += contrib
|
||||
norm += dabs(ref)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
print*, ' accu on three_e_4_idx_exch23_bi_ort (%) = ', 100.d0 * accu / norm
|
||||
|
||||
! ---
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
|
||||
|
1610
src/bi_ort_ints/no_dressing.irp.f
Normal file
1610
src/bi_ort_ints/no_dressing.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
66
src/bi_ort_ints/no_dressing_energy.irp.f
Normal file
66
src/bi_ort_ints/no_dressing_energy.irp.f
Normal file
@ -0,0 +1,66 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, energy_1e_noL_HF]
|
||||
|
||||
implicit none
|
||||
integer :: i
|
||||
|
||||
PROVIDE mo_bi_ortho_tc_one_e
|
||||
|
||||
energy_1e_noL_HF = 0.d0
|
||||
do i = 1, elec_beta_num
|
||||
energy_1e_noL_HF += mo_bi_ortho_tc_one_e(i,i)
|
||||
enddo
|
||||
do i = 1, elec_alpha_num
|
||||
energy_1e_noL_HF += mo_bi_ortho_tc_one_e(i,i)
|
||||
enddo
|
||||
|
||||
print*, "energy_1e_noL_HF = ", energy_1e_noL_HF
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, energy_2e_noL_HF]
|
||||
|
||||
implicit none
|
||||
integer :: i, j
|
||||
|
||||
PROVIDE mo_bi_ortho_tc_two_e
|
||||
|
||||
energy_2e_noL_HF = 0.d0
|
||||
! down-down & down-down
|
||||
do i = 1, elec_beta_num
|
||||
do j = 1, elec_beta_num
|
||||
energy_2e_noL_HF += (mo_bi_ortho_tc_two_e(i,j,i,j) - mo_bi_ortho_tc_two_e(j,i,i,j))
|
||||
enddo
|
||||
enddo
|
||||
! down-down & up-up
|
||||
do i = 1, elec_beta_num
|
||||
do j = 1, elec_alpha_num
|
||||
energy_2e_noL_HF += mo_bi_ortho_tc_two_e(i,j,i,j)
|
||||
enddo
|
||||
enddo
|
||||
! up-up & down-down
|
||||
do i = 1, elec_alpha_num
|
||||
do j = 1, elec_beta_num
|
||||
energy_2e_noL_HF += mo_bi_ortho_tc_two_e(i,j,i,j)
|
||||
enddo
|
||||
enddo
|
||||
! up-up & up-up
|
||||
do i = 1, elec_alpha_num
|
||||
do j = 1, elec_alpha_num
|
||||
energy_2e_noL_HF += (mo_bi_ortho_tc_two_e(i,j,i,j) - mo_bi_ortho_tc_two_e(j,i,i,j))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! 0.5 x is in the Slater-Condon rules and not in the integrals
|
||||
energy_2e_noL_HF = 0.5d0 * energy_2e_noL_HF
|
||||
|
||||
print*, "energy_2e_noL_HF = ", energy_2e_noL_HF
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
512
src/bi_ort_ints/no_dressing_naive.irp.f
Normal file
512
src/bi_ort_ints/no_dressing_naive.irp.f
Normal file
@ -0,0 +1,512 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, noL_0e_naive]
|
||||
|
||||
implicit none
|
||||
integer :: ii, jj, kk
|
||||
integer :: i, j, k
|
||||
double precision :: sigma_i, sigma_j, sigma_k
|
||||
double precision :: I_ijk_ijk, I_ijk_kij, I_ijk_jki, I_ijk_jik, I_ijk_kji, I_ijk_ikj
|
||||
double precision :: t0, t1
|
||||
double precision, allocatable :: tmp(:)
|
||||
|
||||
print*, " Providing noL_0e_naive ..."
|
||||
call wall_time(t0)
|
||||
|
||||
allocate(tmp(elec_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ii, i, sigma_i, jj, j, sigma_j, kk, k, sigma_k, &
|
||||
!$OMP I_ijk_ijk, I_ijk_kij, I_ijk_jki, I_ijk_jik, &
|
||||
!$OMP I_ijk_kji, I_ijk_ikj) &
|
||||
!$OMP SHARED (elec_beta_num, elec_num, tmp)
|
||||
!$OMP DO
|
||||
|
||||
do ii = 1, elec_num
|
||||
|
||||
if(ii .le. elec_beta_num) then
|
||||
i = ii
|
||||
sigma_i = -1.d0
|
||||
else
|
||||
i = ii - elec_beta_num
|
||||
sigma_i = +1.d0
|
||||
endif
|
||||
|
||||
tmp(ii) = 0.d0
|
||||
|
||||
do jj = 1, elec_num
|
||||
|
||||
if(jj .le. elec_beta_num) then
|
||||
j = jj
|
||||
sigma_j = -1.d0
|
||||
else
|
||||
j = jj - elec_beta_num
|
||||
sigma_j = +1.d0
|
||||
endif
|
||||
|
||||
do kk = 1, elec_num
|
||||
|
||||
if(kk .le. elec_beta_num) then
|
||||
k = kk
|
||||
sigma_k = -1.d0
|
||||
else
|
||||
k = kk - elec_beta_num
|
||||
sigma_k = +1.d0
|
||||
endif
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, j, sigma_j, k, sigma_k &
|
||||
, i, sigma_i, j, sigma_j, k, sigma_k &
|
||||
, I_ijk_ijk)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, j, sigma_j, k, sigma_k &
|
||||
, k, sigma_k, i, sigma_i, j, sigma_j &
|
||||
, I_ijk_kij)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, j, sigma_j, k, sigma_k &
|
||||
, j, sigma_j, k, sigma_k, i, sigma_i &
|
||||
, I_ijk_jki)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, j, sigma_j, k, sigma_k &
|
||||
, j, sigma_j, i, sigma_i, k, sigma_k &
|
||||
, I_ijk_jik)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, j, sigma_j, k, sigma_k &
|
||||
, k, sigma_k, j, sigma_j, i, sigma_i &
|
||||
, I_ijk_kji)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, j, sigma_j, k, sigma_k &
|
||||
, i, sigma_i, k, sigma_k, j, sigma_j &
|
||||
, I_ijk_ikj)
|
||||
|
||||
|
||||
tmp(ii) = tmp(ii) + I_ijk_ijk + I_ijk_kij + I_ijk_jki - I_ijk_jik - I_ijk_kji - I_ijk_ikj
|
||||
! = tmp(ii) + I_ijk_ijk + 2.d0 * I_ijk_kij - 3.d0 * I_ijk_jik
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
noL_0e_naive = -1.d0 * (sum(tmp)) / 6.d0
|
||||
|
||||
deallocate(tmp)
|
||||
|
||||
call wall_time(t1)
|
||||
print*, " Wall time for noL_0e_naive (min) = ", (t1 - t0)/60.d0
|
||||
|
||||
print*, " noL_0e_naive = ", noL_0e_naive
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, noL_1e_naive, (mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! < p | H(1) | s > is dressed with noL_1e_naive(p,s)
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: ii, jj
|
||||
integer :: i, j, p, s
|
||||
double precision :: sigma_i, sigma_j, sigma_p, sigma_s
|
||||
double precision :: I_pij_sji, I_pij_sij, I_pij_jis, I_pij_ijs, I_pij_isj, I_pij_jsi
|
||||
double precision :: t0, t1
|
||||
|
||||
print*, " Providing noL_1e_naive ..."
|
||||
call wall_time(t0)
|
||||
|
||||
! ----
|
||||
! up-up part
|
||||
|
||||
sigma_p = +1.d0
|
||||
sigma_s = +1.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ii, i, sigma_i, jj, j, sigma_j, &
|
||||
!$OMP I_pij_sji, I_pij_sij, I_pij_jis, &
|
||||
!$OMP I_pij_ijs, I_pij_isj, I_pij_jsi ) &
|
||||
!$OMP SHARED (mo_num, elec_beta_num, elec_num, &
|
||||
!$OMP sigma_p, sigma_s, noL_1e_naive)
|
||||
|
||||
!$OMP DO COLLAPSE (2)
|
||||
|
||||
do s = 1, mo_num
|
||||
do p = 1, mo_num
|
||||
|
||||
noL_1e_naive(p,s) = 0.d0
|
||||
do ii = 1, elec_num
|
||||
if(ii .le. elec_beta_num) then
|
||||
i = ii
|
||||
sigma_i = -1.d0
|
||||
else
|
||||
i = ii - elec_beta_num
|
||||
sigma_i = +1.d0
|
||||
endif
|
||||
|
||||
do jj = 1, elec_num
|
||||
if(jj .le. elec_beta_num) then
|
||||
j = jj
|
||||
sigma_j = -1.d0
|
||||
else
|
||||
j = jj - elec_beta_num
|
||||
sigma_j = +1d0
|
||||
endif
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, s, sigma_s, j, sigma_j, i, sigma_i &
|
||||
, I_pij_sji)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, s, sigma_s, i, sigma_i, j, sigma_j &
|
||||
, I_pij_sij)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, j, sigma_j, i, sigma_i, s, sigma_s &
|
||||
, I_pij_jis)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, i, sigma_i, j, sigma_j, s, sigma_s &
|
||||
, I_pij_ijs)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, i, sigma_i, s, sigma_s, j, sigma_j &
|
||||
, I_pij_isj)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, j, sigma_j, s, sigma_s, i, sigma_i &
|
||||
, I_pij_jsi)
|
||||
|
||||
! x 0.5 because we consider 0.5 (up + down)
|
||||
noL_1e_naive(p,s) = noL_1e_naive(p,s) - 0.25d0 * (I_pij_sji - I_pij_sij + I_pij_jis - I_pij_ijs + I_pij_isj - I_pij_jsi)
|
||||
enddo ! j
|
||||
enddo ! i
|
||||
enddo ! s
|
||||
enddo ! p
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
! ----
|
||||
! down-down part
|
||||
|
||||
sigma_p = -1.d0
|
||||
sigma_s = -1.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ii, i, sigma_i, jj, j, sigma_j, &
|
||||
!$OMP I_pij_sji, I_pij_sij, I_pij_jis, &
|
||||
!$OMP I_pij_ijs, I_pij_isj, I_pij_jsi ) &
|
||||
!$OMP SHARED (mo_num, elec_beta_num, elec_num, &
|
||||
!$OMP sigma_p, sigma_s, noL_1e_naive)
|
||||
|
||||
!$OMP DO COLLAPSE (2)
|
||||
|
||||
do s = 1, mo_num
|
||||
do p = 1, mo_num
|
||||
|
||||
do ii = 1, elec_num
|
||||
if(ii .le. elec_beta_num) then
|
||||
i = ii
|
||||
sigma_i = -1.d0
|
||||
else
|
||||
i = ii - elec_beta_num
|
||||
sigma_i = +1.d0
|
||||
endif
|
||||
|
||||
do jj = 1, elec_num
|
||||
if(jj .le. elec_beta_num) then
|
||||
j = jj
|
||||
sigma_j = -1.d0
|
||||
else
|
||||
j = jj - elec_beta_num
|
||||
sigma_j = +1d0
|
||||
endif
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, s, sigma_s, j, sigma_j, i, sigma_i &
|
||||
, I_pij_sji)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, s, sigma_s, i, sigma_i, j, sigma_j &
|
||||
, I_pij_sij)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, j, sigma_j, i, sigma_i, s, sigma_s &
|
||||
, I_pij_jis)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, i, sigma_i, j, sigma_j, s, sigma_s &
|
||||
, I_pij_ijs)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, i, sigma_i, s, sigma_s, j, sigma_j &
|
||||
, I_pij_isj)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( p, sigma_p, i, sigma_i, j, sigma_j &
|
||||
, j, sigma_j, s, sigma_s, i, sigma_i &
|
||||
, I_pij_jsi)
|
||||
|
||||
! x 0.5 because we consider 0.5 (up + down)
|
||||
noL_1e_naive(p,s) = noL_1e_naive(p,s) - 0.25d0 * (I_pij_sji - I_pij_sij + I_pij_jis - I_pij_ijs + I_pij_isj - I_pij_jsi)
|
||||
enddo ! j
|
||||
enddo ! i
|
||||
enddo ! s
|
||||
enddo ! p
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! ---
|
||||
|
||||
call wall_time(t1)
|
||||
print*, " Wall time for noL_1e_naive (min) = ", (t1 - t0)/60.d0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, noL_2e_naive, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! < p q | H(2) | s t > is dressed with noL_2e_naive(p,q,s,t)
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: ii
|
||||
integer :: i, p, q, s, t
|
||||
double precision :: sigma_i, sigma_p, sigma_q, sigma_s, sigma_t
|
||||
double precision :: I_ipq_ist, I_ipq_sit, I_ipq_tsi
|
||||
double precision :: t0, t1
|
||||
|
||||
print*, " Providing noL_2e_naive ..."
|
||||
call wall_time(t0)
|
||||
|
||||
! ----
|
||||
! up-up & up-up part
|
||||
|
||||
sigma_p = +1.d0
|
||||
sigma_s = +1.d0
|
||||
sigma_q = +1.d0
|
||||
sigma_t = +1.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ii, i, sigma_i, p, q, s, t, &
|
||||
!$OMP I_ipq_ist, I_ipq_sit, I_ipq_tsi) &
|
||||
!$OMP SHARED (mo_num, elec_beta_num, elec_num, &
|
||||
!$OMP sigma_p, sigma_q, sigma_s, sigma_t, &
|
||||
!$OMP noL_2e_naive)
|
||||
|
||||
!$OMP DO COLLAPSE (4)
|
||||
do t = 1, mo_num
|
||||
do s = 1, mo_num
|
||||
do q = 1, mo_num
|
||||
do p = 1, mo_num
|
||||
|
||||
noL_2e_naive(p,q,s,t) = 0.d0
|
||||
do ii = 1, elec_num
|
||||
if(ii .le. elec_beta_num) then
|
||||
i = ii
|
||||
sigma_i = -1.d0
|
||||
else
|
||||
i = ii - elec_beta_num
|
||||
sigma_i = +1.d0
|
||||
endif
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, i, sigma_i, s, sigma_s, t, sigma_t &
|
||||
, I_ipq_ist)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, s, sigma_s, i, sigma_i, t, sigma_t &
|
||||
, I_ipq_sit)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, t, sigma_t, s, sigma_s, i, sigma_i &
|
||||
, I_ipq_tsi)
|
||||
|
||||
! x 0.25 because we consider 0.25 (up-up + up-down + down-up + down-down)
|
||||
noL_2e_naive(p,q,s,t) = noL_2e_naive(p,q,s,t) - 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi)
|
||||
enddo ! i
|
||||
enddo ! p
|
||||
enddo ! q
|
||||
enddo ! s
|
||||
enddo ! t
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! ----
|
||||
! up-up & down-down part
|
||||
|
||||
sigma_p = +1.d0
|
||||
sigma_s = +1.d0
|
||||
sigma_q = -1.d0
|
||||
sigma_t = -1.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ii, i, sigma_i, p, q, s, t, &
|
||||
!$OMP I_ipq_ist, I_ipq_sit, I_ipq_tsi) &
|
||||
!$OMP SHARED (mo_num, elec_beta_num, elec_num, &
|
||||
!$OMP sigma_p, sigma_q, sigma_s, sigma_t, &
|
||||
!$OMP noL_2e_naive)
|
||||
|
||||
!$OMP DO COLLAPSE (4)
|
||||
do t = 1, mo_num
|
||||
do s = 1, mo_num
|
||||
do q = 1, mo_num
|
||||
do p = 1, mo_num
|
||||
|
||||
do ii = 1, elec_num
|
||||
if(ii .le. elec_beta_num) then
|
||||
i = ii
|
||||
sigma_i = -1.d0
|
||||
else
|
||||
i = ii - elec_beta_num
|
||||
sigma_i = +1.d0
|
||||
endif
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, i, sigma_i, s, sigma_s, t, sigma_t &
|
||||
, I_ipq_ist)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, s, sigma_s, i, sigma_i, t, sigma_t &
|
||||
, I_ipq_sit)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, t, sigma_t, s, sigma_s, i, sigma_i &
|
||||
, I_ipq_tsi)
|
||||
|
||||
! x 0.25 because we consider 0.25 (up-up + up-down + down-up + down-down)
|
||||
noL_2e_naive(p,q,s,t) = noL_2e_naive(p,q,s,t) - 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi)
|
||||
enddo ! i
|
||||
enddo ! p
|
||||
enddo ! q
|
||||
enddo ! s
|
||||
enddo ! t
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! ----
|
||||
! down-down & up-up part
|
||||
|
||||
sigma_p = -1.d0
|
||||
sigma_s = -1.d0
|
||||
sigma_q = +1.d0
|
||||
sigma_t = +1.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ii, i, sigma_i, p, q, s, t, &
|
||||
!$OMP I_ipq_ist, I_ipq_sit, I_ipq_tsi) &
|
||||
!$OMP SHARED (mo_num, elec_beta_num, elec_num, &
|
||||
!$OMP sigma_p, sigma_q, sigma_s, sigma_t, &
|
||||
!$OMP noL_2e_naive)
|
||||
|
||||
!$OMP DO COLLAPSE (4)
|
||||
do t = 1, mo_num
|
||||
do s = 1, mo_num
|
||||
do q = 1, mo_num
|
||||
do p = 1, mo_num
|
||||
|
||||
do ii = 1, elec_num
|
||||
if(ii .le. elec_beta_num) then
|
||||
i = ii
|
||||
sigma_i = -1.d0
|
||||
else
|
||||
i = ii - elec_beta_num
|
||||
sigma_i = +1.d0
|
||||
endif
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, i, sigma_i, s, sigma_s, t, sigma_t &
|
||||
, I_ipq_ist)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, s, sigma_s, i, sigma_i, t, sigma_t &
|
||||
, I_ipq_sit)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, t, sigma_t, s, sigma_s, i, sigma_i &
|
||||
, I_ipq_tsi)
|
||||
|
||||
! x 0.25 because we consider 0.25 (up-up + up-down + down-up + down-down)
|
||||
noL_2e_naive(p,q,s,t) = noL_2e_naive(p,q,s,t) - 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi)
|
||||
enddo ! i
|
||||
enddo ! p
|
||||
enddo ! q
|
||||
enddo ! s
|
||||
enddo ! t
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! ----
|
||||
! down-down & down-down part
|
||||
|
||||
sigma_p = -1.d0
|
||||
sigma_s = -1.d0
|
||||
sigma_q = -1.d0
|
||||
sigma_t = -1.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ii, i, sigma_i, p, q, s, t, &
|
||||
!$OMP I_ipq_ist, I_ipq_sit, I_ipq_tsi) &
|
||||
!$OMP SHARED (mo_num, elec_beta_num, elec_num, &
|
||||
!$OMP sigma_p, sigma_q, sigma_s, sigma_t, &
|
||||
!$OMP noL_2e_naive)
|
||||
|
||||
!$OMP DO COLLAPSE (4)
|
||||
do t = 1, mo_num
|
||||
do s = 1, mo_num
|
||||
do q = 1, mo_num
|
||||
do p = 1, mo_num
|
||||
|
||||
do ii = 1, elec_num
|
||||
if(ii .le. elec_beta_num) then
|
||||
i = ii
|
||||
sigma_i = -1.d0
|
||||
else
|
||||
i = ii - elec_beta_num
|
||||
sigma_i = +1.d0
|
||||
endif
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, i, sigma_i, s, sigma_s, t, sigma_t &
|
||||
, I_ipq_ist)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, s, sigma_s, i, sigma_i, t, sigma_t &
|
||||
, I_ipq_sit)
|
||||
|
||||
call give_integrals_3_body_bi_ort_spin( i, sigma_i, p, sigma_p, q, sigma_q &
|
||||
, t, sigma_t, s, sigma_s, i, sigma_i &
|
||||
, I_ipq_tsi)
|
||||
|
||||
! x 0.25 because we consider 0.25 (up-up + up-down + down-up + down-down)
|
||||
noL_2e_naive(p,q,s,t) = noL_2e_naive(p,q,s,t) - 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi)
|
||||
enddo ! i
|
||||
enddo ! p
|
||||
enddo ! q
|
||||
enddo ! s
|
||||
enddo ! t
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(t1)
|
||||
print*, " Wall time for noL_2e_naive (min) = ", (t1 - t0)/60.d0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
@ -8,25 +8,28 @@ BEGIN_PROVIDER [double precision, ao_one_e_integrals_tc_tot, (ao_num,ao_num)]
|
||||
|
||||
ao_one_e_integrals_tc_tot = ao_one_e_integrals
|
||||
|
||||
provide j1b_type
|
||||
!provide j1b_type
|
||||
|
||||
if( (j1b_type .eq. 1) .or. (j1b_type .eq. 2) ) then
|
||||
!if( (j1b_type .eq. 1) .or. (j1b_type .eq. 2) ) then
|
||||
!
|
||||
! print *, ' do things properly !'
|
||||
! stop
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
ao_one_e_integrals_tc_tot(j,i) += ( j1b_gauss_hermI (j,i) &
|
||||
+ j1b_gauss_hermII (j,i) &
|
||||
+ j1b_gauss_nonherm(j,i) )
|
||||
enddo
|
||||
enddo
|
||||
! !do i = 1, ao_num
|
||||
! ! do j = 1, ao_num
|
||||
! ! ao_one_e_integrals_tc_tot(j,i) += ( j1b_gauss_hermI (j,i) &
|
||||
! ! + j1b_gauss_hermII (j,i) &
|
||||
! ! + j1b_gauss_nonherm(j,i) )
|
||||
! ! enddo
|
||||
! !enddo
|
||||
|
||||
endif
|
||||
!endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)]
|
||||
BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
@ -38,6 +41,11 @@ BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)]
|
||||
|
||||
call ao_to_mo_bi_ortho(ao_one_e_integrals_tc_tot, ao_num, mo_bi_ortho_tc_one_e, mo_num)
|
||||
|
||||
if(noL_standard) then
|
||||
PROVIDE noL_1e
|
||||
mo_bi_ortho_tc_one_e = mo_bi_ortho_tc_one_e + noL_1e
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
@ -45,11 +53,13 @@ END_PROVIDER
|
||||
BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_x , (mo_num,mo_num)]
|
||||
&BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_y , (mo_num,mo_num)]
|
||||
&BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_z , (mo_num,mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! array of the integrals of Left MO_i * x Right MO_j
|
||||
! array of the integrals of Left MO_i * y Right MO_j
|
||||
! array of the integrals of Left MO_i * z Right MO_j
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
call ao_to_mo_bi_ortho( &
|
||||
|
@ -54,7 +54,7 @@ BEGIN_PROVIDER [ double precision, mo_v_ki_bi_ortho_erf_rk_cst_mu_transp, (n_poi
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! FREE mo_v_ki_bi_ortho_erf_rk_cst_mu
|
||||
!FREE mo_v_ki_bi_ortho_erf_rk_cst_mu
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -110,7 +110,10 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_transp, (ao_num, ao_num, 3,
|
||||
print *, ' providing int2_grad1_u12_ao_transp ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
if(test_cycle_tc)then
|
||||
if(test_cycle_tc) then
|
||||
|
||||
PROVIDE int2_grad1_u12_ao_test
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
@ -120,7 +123,13 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_transp, (ao_num, ao_num, 3,
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
FREE int2_grad1_u12_ao_test
|
||||
|
||||
else
|
||||
|
||||
PROVIDE int2_grad1_u12_ao
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
@ -130,9 +139,12 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_transp, (ao_num, ao_num, 3,
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for int2_grad1_u12_ao_transp ', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -144,9 +156,12 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_bimo_transp, (mo_num, mo_num,
|
||||
integer :: ipoint
|
||||
double precision :: wall0, wall1
|
||||
|
||||
!print *, ' providing int2_grad1_u12_bimo_transp'
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
PROVIDE int2_grad1_u12_ao_transp
|
||||
|
||||
!print *, ' providing int2_grad1_u12_bimo_transp'
|
||||
!call wall_time(wall0)
|
||||
|
||||
call wall_time(wall0)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ipoint) &
|
||||
@ -163,16 +178,26 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_bimo_transp, (mo_num, mo_num,
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
!call wall_time(wall1)
|
||||
!print *, ' Wall time for providing int2_grad1_u12_bimo_transp',wall1 - wall0
|
||||
!call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, int2_grad1_u12_bimo_t, (n_points_final_grid,3, mo_num, mo_num )]
|
||||
BEGIN_PROVIDER [ double precision, int2_grad1_u12_bimo_t, (n_points_final_grid, 3, mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, j, ipoint
|
||||
double precision :: wall0, wall1
|
||||
|
||||
!call wall_time(wall0)
|
||||
!print *, ' Providing int2_grad1_u12_bimo_t ...'
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
PROVIDE int2_grad1_u12_bimo_transp
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
@ -182,6 +207,13 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_bimo_t, (n_points_final_grid,3
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
FREE int2_grad1_u12_bimo_transp
|
||||
|
||||
!call wall_time(wall1)
|
||||
!print *, ' wall time for int2_grad1_u12_bimo_t,', wall1 - wall0
|
||||
!call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
@ -191,6 +223,8 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_t, (n_points_final_grid, 3,
|
||||
implicit none
|
||||
integer :: i, j, ipoint
|
||||
|
||||
PROVIDE int2_grad1_u12_ao
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
|
@ -17,11 +17,14 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num,
|
||||
integer :: i, j, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
three_e_3_idx_direct_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_3_idx_direct_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
@ -49,6 +52,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num,
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_3_idx_direct_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -76,6 +80,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_1_bi_ort, (mo_num, mo_num
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,m,integral) &
|
||||
@ -102,6 +107,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_1_bi_ort, (mo_num, mo_num
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_3_idx_cycle_1_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -123,12 +129,15 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_2_bi_ort, (mo_num, mo_num
|
||||
integer :: i, j, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_cycle_2_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_3_idx_cycle_2_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,m,integral) &
|
||||
@ -155,6 +164,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_2_bi_ort, (mo_num, mo_num
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_3_idx_cycle_2_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -176,12 +186,15 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch23_bi_ort, (mo_num, mo_num,
|
||||
integer :: i, j, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_exch23_bi_ort = 0.d0
|
||||
print*,'Providing the three_e_3_idx_exch23_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,m,integral) &
|
||||
@ -208,6 +221,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch23_bi_ort, (mo_num, mo_num,
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_3_idx_exch23_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -229,12 +243,15 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch13_bi_ort, (mo_num, mo_num,
|
||||
integer :: i,j,m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_exch13_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_3_idx_exch13_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,m,integral) &
|
||||
@ -261,6 +278,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch13_bi_ort, (mo_num, mo_num,
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_3_idx_exch13_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -282,12 +300,15 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort, (mo_num, mo_num,
|
||||
integer :: i, j, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_exch12_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_3_idx_exch12_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,m,integral) &
|
||||
@ -306,6 +327,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort, (mo_num, mo_num,
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_3_idx_exch12_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -333,6 +355,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort_new, (mo_num, mo_
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,m,integral) &
|
||||
@ -359,6 +382,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort_new, (mo_num, mo_
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_3_idx_exch12_bi_ort_new', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -1,282 +1,229 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort , (mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort , (mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort , (mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_direct_bi_ort(m,j,k,i) = <mjk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_direct_bi_ort (m,j,k,i) = < m j k | -L | m j i > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_exch13_bi_ort (m,j,k,i) = < m j k | -L | i j m > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_exch23_bi_ort (m,j,k,i) = < m j k | -L | j m i > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = < m j k | -L | j i m > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
! notice the -1 sign: in this way three_e_4_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
! three_e_4_idx_direct_bi_ort (m,j,k,i) : Lk Ri Imm Ijj + Lj Rj Imm Iki + Lm Rm Ijj Iki
|
||||
! three_e_4_idx_exch13_bi_ort (m,j,k,i) : Lk Rm Imi Ijj + Lj Rj Imi Ikm + Lm Ri Ijj Ikm
|
||||
! three_e_4_idx_exch23_bi_ort (m,j,k,i) : Lk Ri Imj Ijm + Lj Rm Imj Iki + Lm Rj Ijm Iki
|
||||
! three_e_4_idx_cycle_1_bi_ort(m,j,k,i) : Lk Rm Imj Iji + Lj Ri Imj Ikm + Lm Rj Iji Ikm
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
integer :: ipoint, i, j, k, m, n
|
||||
double precision :: wall1, wall0
|
||||
double precision :: tmp_loc_1, tmp_loc_2
|
||||
double precision, allocatable :: tmp1(:,:,:), tmp2(:,:,:)
|
||||
double precision, allocatable :: tmp_2d(:,:)
|
||||
double precision, allocatable :: tmp_aux_1(:,:,:), tmp_aux_2(:,:)
|
||||
|
||||
three_e_4_idx_direct_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_direct_bi_ort ...'
|
||||
print *, ' Providing the three_e_4_idx_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
|
||||
! to reduce the number of operations
|
||||
allocate(tmp_aux_1(n_points_final_grid,4,mo_num))
|
||||
allocate(tmp_aux_2(n_points_final_grid,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_direct_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, m, j, i, integral)
|
||||
three_e_4_idx_direct_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
!$OMP PRIVATE (n, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp_aux_1, tmp_aux_2)
|
||||
!$OMP DO
|
||||
do n = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_aux_1(ipoint,1,n) = int2_grad1_u12_bimo_t(ipoint,1,n,n) * final_weight_at_r_vector(ipoint)
|
||||
tmp_aux_1(ipoint,2,n) = int2_grad1_u12_bimo_t(ipoint,2,n,n) * final_weight_at_r_vector(ipoint)
|
||||
tmp_aux_1(ipoint,3,n) = int2_grad1_u12_bimo_t(ipoint,3,n,n) * final_weight_at_r_vector(ipoint)
|
||||
tmp_aux_1(ipoint,4,n) = mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,n) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
tmp_aux_2(ipoint,n) = mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,n)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
! loops approach to break the O(N^4) scaling in memory
|
||||
|
||||
call set_multiple_levels_omp(.false.)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (k, i, j, m, n, ipoint, tmp_loc_1, tmp_loc_2, tmp_2d, tmp1, tmp2) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp_aux_1, tmp_aux_2, &
|
||||
!$OMP three_e_4_idx_direct_bi_ort, three_e_4_idx_exch13_bi_ort, &
|
||||
!$OMP three_e_4_idx_exch23_bi_ort, three_e_4_idx_cycle_1_bi_ort)
|
||||
|
||||
allocate(tmp_2d(mo_num,mo_num))
|
||||
allocate(tmp1(n_points_final_grid,4,mo_num))
|
||||
allocate(tmp2(n_points_final_grid,4,mo_num))
|
||||
|
||||
!$OMP DO
|
||||
do k = 1, mo_num
|
||||
|
||||
! ---
|
||||
|
||||
do i = 1, mo_num
|
||||
|
||||
! ---
|
||||
|
||||
do n = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_loc_1 = mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_loc_2 = tmp_aux_2(ipoint,n)
|
||||
|
||||
tmp1(ipoint,1,n) = int2_grad1_u12_bimo_t(ipoint,1,n,n) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,1,k,i) * tmp_loc_2
|
||||
tmp1(ipoint,2,n) = int2_grad1_u12_bimo_t(ipoint,2,n,n) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,2,k,i) * tmp_loc_2
|
||||
tmp1(ipoint,3,n) = int2_grad1_u12_bimo_t(ipoint,3,n,n) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,3,k,i) * tmp_loc_2
|
||||
tmp1(ipoint,4,n) = int2_grad1_u12_bimo_t(ipoint,1,n,n) * int2_grad1_u12_bimo_t(ipoint,1,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,n,n) * int2_grad1_u12_bimo_t(ipoint,2,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,n,n) * int2_grad1_u12_bimo_t(ipoint,3,k,i)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call dgemm( 'T', 'N', mo_num, mo_num, 4*n_points_final_grid, 1.d0 &
|
||||
, tmp_aux_1(1,1,1), 4*n_points_final_grid, tmp1(1,1,1), 4*n_points_final_grid &
|
||||
, 0.d0, tmp_2d(1,1), mo_num)
|
||||
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_direct_bi_ort(m,j,k,i) = -tmp_2d(m,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
do n = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_loc_1 = mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,n)
|
||||
tmp_loc_2 = mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,i)
|
||||
|
||||
tmp1(ipoint,1,n) = int2_grad1_u12_bimo_t(ipoint,1,n,i) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,1,k,n) * tmp_loc_2
|
||||
tmp1(ipoint,2,n) = int2_grad1_u12_bimo_t(ipoint,2,n,i) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,2,k,n) * tmp_loc_2
|
||||
tmp1(ipoint,3,n) = int2_grad1_u12_bimo_t(ipoint,3,n,i) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,3,k,n) * tmp_loc_2
|
||||
tmp1(ipoint,4,n) = int2_grad1_u12_bimo_t(ipoint,1,n,i) * int2_grad1_u12_bimo_t(ipoint,1,k,n) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,n,i) * int2_grad1_u12_bimo_t(ipoint,2,k,n) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,n,i) * int2_grad1_u12_bimo_t(ipoint,3,k,n)
|
||||
|
||||
tmp2(ipoint,1,n) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,1,i,n)
|
||||
tmp2(ipoint,2,n) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,2,i,n)
|
||||
tmp2(ipoint,3,n) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,3,i,n)
|
||||
tmp2(ipoint,4,n) = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,n)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
call dgemm( 'T', 'N', mo_num, mo_num, 4*n_points_final_grid, 1.d0 &
|
||||
, tmp1(1,1,1), 4*n_points_final_grid, tmp_aux_1(1,1,1), 4*n_points_final_grid &
|
||||
, 0.d0, tmp_2d(1,1), mo_num)
|
||||
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_exch13_bi_ort(m,j,k,i) = -tmp_2d(m,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
call dgemm( 'T', 'N', mo_num, mo_num, 4*n_points_final_grid, 1.d0 &
|
||||
, tmp1(1,1,1), 4*n_points_final_grid, tmp2(1,1,1), 4*n_points_final_grid &
|
||||
, 0.d0, tmp_2d(1,1), mo_num)
|
||||
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_cycle_1_bi_ort(m,i,k,j) = -tmp_2d(m,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
enddo ! i
|
||||
|
||||
! ---
|
||||
|
||||
do j = 1, mo_num
|
||||
|
||||
do n = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_loc_1 = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,j) * mos_r_in_r_array_transp(ipoint,n)
|
||||
tmp_loc_2 = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,j)
|
||||
|
||||
tmp1(ipoint,1,n) = int2_grad1_u12_bimo_t(ipoint,1,n,j) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,1,j,n) * tmp_loc_2
|
||||
tmp1(ipoint,2,n) = int2_grad1_u12_bimo_t(ipoint,2,n,j) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,2,j,n) * tmp_loc_2
|
||||
tmp1(ipoint,3,n) = int2_grad1_u12_bimo_t(ipoint,3,n,j) * tmp_loc_1 + int2_grad1_u12_bimo_t(ipoint,3,j,n) * tmp_loc_2
|
||||
tmp1(ipoint,4,n) = int2_grad1_u12_bimo_t(ipoint,1,n,j) * int2_grad1_u12_bimo_t(ipoint,1,j,n) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,n,j) * int2_grad1_u12_bimo_t(ipoint,2,j,n) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,n,j) * int2_grad1_u12_bimo_t(ipoint,3,j,n)
|
||||
|
||||
tmp2(ipoint,1,n) = int2_grad1_u12_bimo_t(ipoint,1,k,n)
|
||||
tmp2(ipoint,2,n) = int2_grad1_u12_bimo_t(ipoint,2,k,n)
|
||||
tmp2(ipoint,3,n) = int2_grad1_u12_bimo_t(ipoint,3,k,n)
|
||||
tmp2(ipoint,4,n) = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,n)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call dgemm( 'T', 'N', mo_num, mo_num, 4*n_points_final_grid, 1.d0 &
|
||||
, tmp1(1,1,1), 4*n_points_final_grid, tmp2(1,1,1), 4*n_points_final_grid &
|
||||
, 0.d0, tmp_2d(1,1), mo_num)
|
||||
|
||||
do i = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_exch23_bi_ort(m,j,k,i) = -tmp_2d(m,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo ! j
|
||||
|
||||
! ---
|
||||
|
||||
enddo !k
|
||||
!$OMP END DO
|
||||
|
||||
deallocate(tmp_2d)
|
||||
deallocate(tmp1)
|
||||
deallocate(tmp2)
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
deallocate(tmp_aux_1)
|
||||
deallocate(tmp_aux_2)
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_direct_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = <mjk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_cycle_1_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_cycle_1_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_cycle_1_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, j, i, m, integral)
|
||||
three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_cycle_1_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! --
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = <mjk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_cycle_2_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_cycle_2_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_cycle_2_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, i, m, j, integral)
|
||||
three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_cycle_2_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch23_bi_ort(m,j,k,i) = <mjk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch23_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch23_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch23_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, j, m, i, integral)
|
||||
three_e_4_idx_exch23_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch23_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch13_bi_ort(m,j,k,i) = <mjk|-L|ijm> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch13_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch13_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch13_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, i, j, m, integral)
|
||||
three_e_4_idx_exch13_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch13_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch12_bi_ort(m,j,k,i) = <mjk|-L|mij> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch12_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch12_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch12_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, m, i, j, integral)
|
||||
three_e_4_idx_exch12_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch12_bi_ort', wall1 - wall0
|
||||
print *, ' wall time for three_e_4_idx_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
486
src/bi_ort_ints/three_body_ijmk_n4.irp.f
Normal file
486
src/bi_ort_ints/three_body_ijmk_n4.irp.f
Normal file
@ -0,0 +1,486 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort_n4 , (mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort_n4 , (mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort_n4, (mo_num, mo_num, mo_num, mo_num)]
|
||||
!&BEGIN_PROVIDER [ double precision, three_e_4_idx_exch12_bi_ort_n4, (mo_num, mo_num, mo_num, mo_num)]
|
||||
!&BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_2_bi_ort_n4, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_direct_bi_ort_n4 (m,j,k,i) = < m j k | -L | m j i > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_exch13_bi_ort_n4 (m,j,k,i) = < m j k | -L | i j m > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_exch12_bi_ort_n4 (m,j,k,i) = < m j k | -L | m i j > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! = three_e_4_idx_exch13_bi_ort_n4 (j,m,k,i)
|
||||
! three_e_4_idx_cycle_1_bi_ort_n4(m,j,k,i) = < m j k | -L | j i m > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_cycle_2_bi_ort_n4(m,j,k,i) = < m j k | -L | i m j > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! = three_e_4_idx_cycle_1_bi_ort_n4(j,m,k,i)
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_4_idx_direct_bi_ort_n4 can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
! three_e_4_idx_direct_bi_ort_n4 (m,j,k,i) : Lk Ri Imm Ijj + Lj Rj Imm Iki + Lm Rm Ijj Iki
|
||||
! three_e_4_idx_exch13_bi_ort_n4 (m,j,k,i) : Lk Rm Imi Ijj + Lj Rj Imi Ikm + Lm Ri Ijj Ikm
|
||||
! three_e_4_idx_cycle_1_bi_ort_n4(m,j,k,i) : Lk Rm Imj Iji + Lj Ri Imj Ikm + Lm Rj Iji Ikm
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: ipoint, i, j, k, l, m
|
||||
double precision :: wall1, wall0
|
||||
double precision, allocatable :: tmp1(:,:,:,:), tmp2(:,:,:,:), tmp3(:,:,:,:)
|
||||
double precision, allocatable :: tmp_4d(:,:,:,:)
|
||||
double precision, allocatable :: tmp4(:,:,:)
|
||||
double precision, allocatable :: tmp5(:,:)
|
||||
double precision, allocatable :: tmp_3d(:,:,:)
|
||||
|
||||
print *, ' Providing the O(N^4) three_e_4_idx_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
|
||||
allocate(tmp_4d(mo_num,mo_num,mo_num,mo_num))
|
||||
|
||||
allocate(tmp1(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp2(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp3(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp1, tmp2, tmp3)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp1(ipoint,1,l,i) = int2_grad1_u12_bimo_t(ipoint,1,l,l) * mos_l_in_r_array_transp(ipoint,i) * final_weight_at_r_vector(ipoint)
|
||||
tmp1(ipoint,2,l,i) = int2_grad1_u12_bimo_t(ipoint,2,l,l) * mos_l_in_r_array_transp(ipoint,i) * final_weight_at_r_vector(ipoint)
|
||||
tmp1(ipoint,3,l,i) = int2_grad1_u12_bimo_t(ipoint,3,l,l) * mos_l_in_r_array_transp(ipoint,i) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
tmp2(ipoint,1,l,i) = int2_grad1_u12_bimo_t(ipoint,1,l,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp2(ipoint,2,l,i) = int2_grad1_u12_bimo_t(ipoint,2,l,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp2(ipoint,3,l,i) = int2_grad1_u12_bimo_t(ipoint,3,l,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
|
||||
tmp3(ipoint,1,l,i) = int2_grad1_u12_bimo_t(ipoint,1,l,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
tmp3(ipoint,2,l,i) = int2_grad1_u12_bimo_t(ipoint,2,l,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
tmp3(ipoint,3,l,i) = int2_grad1_u12_bimo_t(ipoint,3,l,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp1(1,1,1,1), 3*n_points_final_grid, tmp2(1,1,1,1), 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d(1,1,1,1), mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_direct_bi_ort_n4(m,j,k,i) = -tmp_4d(m,k,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp3(1,1,1,1), 3*n_points_final_grid, tmp1(1,1,1,1), 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d(1,1,1,1), mo_num*mo_num)
|
||||
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_exch13_bi_ort_n4(m,j,k,i) = -tmp_4d(m,i,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp1)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp1(ipoint,1,l,i) = int2_grad1_u12_bimo_t(ipoint,1,i,l) * mos_l_in_r_array_transp(ipoint,l) * final_weight_at_r_vector(ipoint)
|
||||
tmp1(ipoint,2,l,i) = int2_grad1_u12_bimo_t(ipoint,2,i,l) * mos_l_in_r_array_transp(ipoint,l) * final_weight_at_r_vector(ipoint)
|
||||
tmp1(ipoint,3,l,i) = int2_grad1_u12_bimo_t(ipoint,3,i,l) * mos_l_in_r_array_transp(ipoint,l) * final_weight_at_r_vector(ipoint)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp1(1,1,1,1), 3*n_points_final_grid, tmp2(1,1,1,1), 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d(1,1,1,1), mo_num*mo_num)
|
||||
|
||||
|
||||
deallocate(tmp2)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_exch13_bi_ort_n4(m,j,k,i) = three_e_4_idx_exch13_bi_ort_n4(m,j,k,i) - tmp_4d(m,k,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp1(1,1,1,1), 3*n_points_final_grid, tmp3(1,1,1,1), 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d(1,1,1,1), mo_num*mo_num)
|
||||
|
||||
deallocate(tmp3)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_cycle_1_bi_ort_n4(m,j,k,i) = -tmp_4d(m,k,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp1)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp1(ipoint,1,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,1,l,l) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp1(ipoint,2,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,2,l,l) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp1(ipoint,3,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,3,l,l) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp1(1,1,1,1), 3*n_points_final_grid, int2_grad1_u12_bimo_t(1,1,1,1), 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d(1,1,1,1), mo_num*mo_num)
|
||||
|
||||
deallocate(tmp1)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_direct_bi_ort_n4(m,j,k,i) = three_e_4_idx_direct_bi_ort_n4(m,j,k,i) - tmp_4d(m,j,k,i) - tmp_4d(j,m,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(tmp_4d)
|
||||
|
||||
|
||||
allocate(tmp_3d(mo_num,mo_num,mo_num))
|
||||
allocate(tmp5(n_points_final_grid,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP final_weight_at_r_vector, &
|
||||
!$OMP tmp5)
|
||||
!$OMP DO
|
||||
do i = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp5(ipoint,i) = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
allocate(tmp4(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
do m = 1, mo_num
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, k, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, m, &
|
||||
!$OMP int2_grad1_u12_bimo_t, &
|
||||
!$OMP tmp4)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp4(ipoint,k,i) = int2_grad1_u12_bimo_t(ipoint,1,k,m) * int2_grad1_u12_bimo_t(ipoint,1,m,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,k,m) * int2_grad1_u12_bimo_t(ipoint,2,m,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,k,m) * int2_grad1_u12_bimo_t(ipoint,3,m,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num, mo_num*mo_num, n_points_final_grid, 1.d0 &
|
||||
, tmp5(1,1), n_points_final_grid, tmp4(1,1,1), n_points_final_grid &
|
||||
, 0.d0, tmp_3d(1,1,1), mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
three_e_4_idx_exch13_bi_ort_n4(m,j,k,i) = three_e_4_idx_exch13_bi_ort_n4(m,j,k,i) - tmp_3d(j,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (j, k, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, m, &
|
||||
!$OMP mos_l_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp4)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp4(ipoint,j,k) = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,j) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,m,j) * int2_grad1_u12_bimo_t(ipoint,1,k,m) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,m,j) * int2_grad1_u12_bimo_t(ipoint,2,k,m) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,m,j) * int2_grad1_u12_bimo_t(ipoint,3,k,m) )
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num, n_points_final_grid, 1.d0 &
|
||||
, tmp4(1,1,1), n_points_final_grid, mos_r_in_r_array_transp(1,1), n_points_final_grid &
|
||||
, 0.d0, tmp_3d(1,1,1), mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
three_e_4_idx_cycle_1_bi_ort_n4(m,j,k,i) = three_e_4_idx_cycle_1_bi_ort_n4(m,j,k,i) - tmp_3d(j,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
enddo
|
||||
|
||||
deallocate(tmp5)
|
||||
deallocate(tmp_3d)
|
||||
|
||||
|
||||
|
||||
do i = 1, mo_num
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (m, j, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, i, &
|
||||
!$OMP mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp4)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp4(ipoint,m,j) = final_weight_at_r_vector(ipoint) * mos_r_in_r_array_transp(ipoint,m) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,m,j) * int2_grad1_u12_bimo_t(ipoint,1,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,m,j) * int2_grad1_u12_bimo_t(ipoint,2,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,m,j) * int2_grad1_u12_bimo_t(ipoint,3,j,i) )
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num, n_points_final_grid, -1.d0 &
|
||||
, tmp4(1,1,1), n_points_final_grid, mos_l_in_r_array_transp(1,1), n_points_final_grid &
|
||||
, 1.d0, three_e_4_idx_cycle_1_bi_ort_n4(1,1,1,i), mo_num*mo_num)
|
||||
|
||||
enddo
|
||||
|
||||
deallocate(tmp4)
|
||||
|
||||
|
||||
! !$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
! do i = 1, mo_num
|
||||
! do k = 1, mo_num
|
||||
! do j = 1, mo_num
|
||||
! do m = 1, mo_num
|
||||
! three_e_4_idx_exch12_bi_ort_n4 (m,j,k,i) = three_e_4_idx_exch13_bi_ort_n4 (j,m,k,i)
|
||||
! three_e_4_idx_cycle_2_bi_ort_n4(m,j,k,i) = three_e_4_idx_cycle_1_bi_ort_n4(j,m,k,i)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! !$OMP END PARALLEL DO
|
||||
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for O(N^4) three_e_4_idx_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort_n4 , (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch23_bi_ort_n4 (m,j,k,i) = < m j k | -L | j m i > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_4_idx_direct_bi_ort_n4 can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
! three_e_4_idx_exch23_bi_ort_n4 (m,j,k,i) : Lk Ri Imj Ijm + Lj Rm Imj Iki + Lm Rj Ijm Iki
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l, m, ipoint
|
||||
double precision :: wall1, wall0
|
||||
double precision, allocatable :: tmp1(:,:,:,:), tmp_4d(:,:,:,:)
|
||||
double precision, allocatable :: tmp5(:,:,:), tmp6(:,:,:)
|
||||
|
||||
print *, ' Providing the O(N^4) three_e_4_idx_exch23_bi_ort_n4 ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
|
||||
allocate(tmp5(n_points_final_grid,mo_num,mo_num))
|
||||
allocate(tmp6(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp5, tmp6)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp5(ipoint,l,i) = int2_grad1_u12_bimo_t(ipoint,1,l,i) * int2_grad1_u12_bimo_t(ipoint,1,i,l) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,l,i) * int2_grad1_u12_bimo_t(ipoint,2,i,l) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,l,i) * int2_grad1_u12_bimo_t(ipoint,3,i,l)
|
||||
|
||||
tmp6(ipoint,l,i) = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, n_points_final_grid, -1.d0 &
|
||||
, tmp5(1,1,1), n_points_final_grid, tmp6(1,1,1), n_points_final_grid &
|
||||
, 0.d0, three_e_4_idx_exch23_bi_ort_n4(1,1,1,1), mo_num*mo_num)
|
||||
|
||||
deallocate(tmp5)
|
||||
deallocate(tmp6)
|
||||
|
||||
|
||||
allocate(tmp_4d(mo_num,mo_num,mo_num,mo_num))
|
||||
allocate(tmp1(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp1)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp1(ipoint,1,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,1,l,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
tmp1(ipoint,2,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,2,l,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
tmp1(ipoint,3,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,3,l,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp1(1,1,1,1), 3*n_points_final_grid, int2_grad1_u12_bimo_t(1,1,1,1), 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d(1,1,1,1), mo_num*mo_num)
|
||||
|
||||
deallocate(tmp1)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_exch23_bi_ort_n4(m,j,k,i) = three_e_4_idx_exch23_bi_ort_n4(m,j,k,i) - tmp_4d(m,j,k,i) - tmp_4d(j,m,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(tmp_4d)
|
||||
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for O(N^4) three_e_4_idx_exch23_bi_ort_n4', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
290
src/bi_ort_ints/three_body_ijmk_old.irp.f
Normal file
290
src/bi_ort_ints/three_body_ijmk_old.irp.f
Normal file
@ -0,0 +1,290 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_direct_bi_ort_old(m,j,k,i) = <mjk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_direct_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_direct_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_direct_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, m, j, i, integral)
|
||||
three_e_4_idx_direct_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_direct_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_cycle_1_bi_ort_old(m,j,k,i) = <mjk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_cycle_1_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_cycle_1_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_cycle_1_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, j, i, m, integral)
|
||||
three_e_4_idx_cycle_1_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_cycle_1_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! --
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_2_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_cycle_2_bi_ort_old(m,j,k,i) = <mjk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_cycle_2_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_cycle_2_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_cycle_2_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, i, m, j, integral)
|
||||
three_e_4_idx_cycle_2_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_cycle_2_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch23_bi_ort_old(m,j,k,i) = <mjk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch23_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch23_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch23_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, j, m, i, integral)
|
||||
three_e_4_idx_exch23_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch23_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch13_bi_ort_old(m,j,k,i) = <mjk|-L|ijm> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch13_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch13_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch13_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, i, j, m, integral)
|
||||
three_e_4_idx_exch13_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch13_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch12_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch12_bi_ort_old(m,j,k,i) = <mjk|-L|mij> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch12_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch12_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch12_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, m, i, j, integral)
|
||||
three_e_4_idx_exch12_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch12_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
@ -1,296 +1,245 @@
|
||||
|
||||
! ---
|
||||
double precision function three_e_5_idx_exch12_bi_ort(m,l,i,k,j) result(integral)
|
||||
implicit none
|
||||
integer, intent(in) :: m,l,j,k,i
|
||||
integral = three_e_5_idx_direct_bi_ort(m,l,j,k,i)
|
||||
end
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_direct_bi_ort , (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_5_idx_exch23_bi_ort , (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_5_idx_exch13_bi_ort , (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_direct_bi_ort(m,l,j,k,i) = <mlk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_direct_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_direct_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_direct_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, m, j, i, integral)
|
||||
three_e_5_idx_direct_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_direct_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = <mlk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_5_idx_direct_bi_ort(m,l,j,k,i) = <mlk|-L|mji> :: : notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_cycle_1_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_cycle_1_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: wall1, wall0
|
||||
integer :: ipoint
|
||||
double precision, allocatable :: grad_mli(:,:), orb_mat(:,:,:)
|
||||
double precision, allocatable :: lk_grad_mi(:,:,:,:), rk_grad_im(:,:,:)
|
||||
double precision, allocatable :: lm_grad_ik(:,:,:,:), rm_grad_ik(:,:,:)
|
||||
double precision, allocatable :: tmp_mat(:,:,:)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
PROVIDE mo_l_coef mo_r_coef int2_grad1_u12_bimo_t
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_cycle_1_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
call print_memory_usage
|
||||
print *, ' Providing the three_e_5_idx_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
three_e_5_idx_direct_bi_ort (:,:,:,:,:) = 0.d0
|
||||
three_e_5_idx_cycle_1_bi_ort(:,:,:,:,:) = 0.d0
|
||||
three_e_5_idx_cycle_2_bi_ort(:,:,:,:,:) = 0.d0
|
||||
three_e_5_idx_exch23_bi_ort (:,:,:,:,:) = 0.d0
|
||||
three_e_5_idx_exch13_bi_ort (:,:,:,:,:) = 0.d0
|
||||
|
||||
call print_memory_usage
|
||||
|
||||
allocate(tmp_mat(mo_num,mo_num,mo_num))
|
||||
allocate(orb_mat(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE (i,l,ipoint)
|
||||
do i=1,mo_num
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
|
||||
orb_mat(ipoint,l,i) = final_weight_at_r_vector(ipoint) &
|
||||
* mos_l_in_r_array_transp(ipoint,l) &
|
||||
* mos_r_in_r_array_transp(ipoint,i)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
tmp_mat = 0.d0
|
||||
call print_memory_usage
|
||||
|
||||
do m = 1, mo_num
|
||||
|
||||
allocate(grad_mli(n_points_final_grid,mo_num))
|
||||
|
||||
do i=1,mo_num
|
||||
!$OMP PARALLEL DO PRIVATE (l,ipoint)
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
|
||||
grad_mli(ipoint,l) = &
|
||||
int2_grad1_u12_bimo_t(ipoint,1,m,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i) +&
|
||||
int2_grad1_u12_bimo_t(ipoint,2,m,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i) +&
|
||||
int2_grad1_u12_bimo_t(ipoint,3,m,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num, n_points_final_grid, 1.d0,&
|
||||
orb_mat, n_points_final_grid, &
|
||||
grad_mli, n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL PRIVATE(j,k,l)
|
||||
!$OMP DO
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, j, i, m, integral)
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
three_e_5_idx_direct_bi_ort(m,l,j,k,i) = three_e_5_idx_direct_bi_ort(m,l,j,k,i) - tmp_mat(l,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP DO
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
three_e_5_idx_direct_bi_ort(m,k,i,l,j) = three_e_5_idx_direct_bi_ort(m,k,i,l,j) - tmp_mat(l,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
enddo
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_cycle_1_bi_ort', wall1 - wall0
|
||||
deallocate(grad_mli)
|
||||
|
||||
END_PROVIDER
|
||||
allocate(lm_grad_ik(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(lk_grad_mi(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
! ---
|
||||
!$OMP PARALLEL DO PRIVATE (i,l,ipoint)
|
||||
do i=1,mo_num
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
lm_grad_ik(ipoint,1,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i) * final_weight_at_r_vector(ipoint)
|
||||
lm_grad_ik(ipoint,2,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i) * final_weight_at_r_vector(ipoint)
|
||||
lm_grad_ik(ipoint,3,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = <mlk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
lk_grad_mi(ipoint,1,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,1,m,i) * final_weight_at_r_vector(ipoint)
|
||||
lk_grad_mi(ipoint,2,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,2,m,i) * final_weight_at_r_vector(ipoint)
|
||||
lk_grad_mi(ipoint,3,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,3,m,i) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_cycle_2_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_cycle_2_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_cycle_2_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, i, m, j, integral)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
allocate(rm_grad_ik(n_points_final_grid,3,mo_num))
|
||||
allocate(rk_grad_im(n_points_final_grid,3,mo_num))
|
||||
|
||||
do i=1,mo_num
|
||||
!$OMP PARALLEL DO PRIVATE (l,ipoint)
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
|
||||
rm_grad_ik(ipoint,1,l) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i)
|
||||
rm_grad_ik(ipoint,2,l) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i)
|
||||
rm_grad_ik(ipoint,3,l) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i)
|
||||
|
||||
rk_grad_im(ipoint,1,l) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,1,i,m)
|
||||
rk_grad_im(ipoint,2,l) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,2,i,m)
|
||||
rk_grad_im(ipoint,3,l) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,3,i,m)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_cycle_2_bi_ort', wall1 - wall0
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num, 3*n_points_final_grid, 1.d0,&
|
||||
lm_grad_ik, 3*n_points_final_grid, &
|
||||
rm_grad_ik, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = <mlk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_exch23_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_exch23_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch23_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
!$OMP PARALLEL DO PRIVATE(j,k,l)
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, j, m, i, integral)
|
||||
three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
three_e_5_idx_direct_bi_ort(m,l,j,k,i) = three_e_5_idx_direct_bi_ort(m,l,j,k,i) - tmp_mat(l,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch23_bi_ort', wall1 - wall0
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num, 3*n_points_final_grid, 1.d0,&
|
||||
lm_grad_ik, 3*n_points_final_grid, &
|
||||
rk_grad_im, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = <mlk|-L|ijm> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_exch13_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_exch13_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch13_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
!$OMP PARALLEL DO PRIVATE(j,k,l)
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, i, j, m, integral)
|
||||
three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,i,k) = three_e_5_idx_cycle_1_bi_ort(m,l,j,i,k) - tmp_mat(l,k,j)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,i,j,k,l) = three_e_5_idx_cycle_2_bi_ort(m,i,j,k,l) - tmp_mat(k,j,l)
|
||||
three_e_5_idx_exch23_bi_ort (m,i,j,k,l) = three_e_5_idx_exch23_bi_ort (m,i,j,k,l) - tmp_mat(k,l,j)
|
||||
three_e_5_idx_exch13_bi_ort (m,l,j,i,k) = three_e_5_idx_exch13_bi_ort (m,l,j,i,k) - tmp_mat(l,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch13_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num, 3*n_points_final_grid, 1.d0,&
|
||||
lk_grad_mi, 3*n_points_final_grid, &
|
||||
rm_grad_ik, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = <mlk|-L|mij> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_exch12_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_exch12_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch12_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
!$OMP PARALLEL DO PRIVATE(j,k,l)
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, m, i, j, integral)
|
||||
three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) - tmp_mat(k,j,l)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,l,i,k,j) = three_e_5_idx_cycle_2_bi_ort(m,l,i,k,j) - tmp_mat(l,j,k)
|
||||
three_e_5_idx_exch23_bi_ort (m,l,j,k,i) = three_e_5_idx_exch23_bi_ort (m,l,j,k,i) - tmp_mat(l,j,k)
|
||||
three_e_5_idx_exch13_bi_ort (m,l,i,k,j) = three_e_5_idx_exch13_bi_ort (m,l,i,k,j) - tmp_mat(k,j,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num, 3*n_points_final_grid, 1.d0,&
|
||||
lk_grad_mi, 3*n_points_final_grid, &
|
||||
rk_grad_im, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(j,k,l)
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,i,k) = three_e_5_idx_cycle_1_bi_ort(m,l,j,i,k) - tmp_mat(l,j,k)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,i,j,k,l) = three_e_5_idx_cycle_2_bi_ort(m,i,j,k,l) - tmp_mat(k,l,j)
|
||||
three_e_5_idx_exch23_bi_ort (m,i,j,k,l) = three_e_5_idx_exch23_bi_ort (m,i,j,k,l) - tmp_mat(k,j,l)
|
||||
three_e_5_idx_exch13_bi_ort (m,l,j,i,k) = three_e_5_idx_exch13_bi_ort (m,l,j,i,k) - tmp_mat(l,k,j)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
enddo
|
||||
|
||||
deallocate(rm_grad_ik)
|
||||
deallocate(rk_grad_im)
|
||||
deallocate(lk_grad_mi)
|
||||
deallocate(lm_grad_ik)
|
||||
|
||||
enddo
|
||||
|
||||
deallocate(tmp_mat)
|
||||
|
||||
deallocate(orb_mat)
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch12_bi_ort', wall1 - wall0
|
||||
print *, ' wall time for three_e_5_idx_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
295
src/bi_ort_ints/three_body_ijmkl_old.irp.f
Normal file
295
src/bi_ort_ints/three_body_ijmkl_old.irp.f
Normal file
@ -0,0 +1,295 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_direct_bi_ort_old, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_direct_bi_ort_old(m,l,j,k,i) = <mlk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_direct_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_direct_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_direct_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, m, j, i, integral)
|
||||
three_e_5_idx_direct_bi_ort_old(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_direct_bi_ort_old', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_1_bi_ort_old, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_cycle_1_bi_ort_old(m,l,j,k,i) = <mlk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_cycle_1_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_cycle_1_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_cycle_1_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, j, i, m, integral)
|
||||
three_e_5_idx_cycle_1_bi_ort_old(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_cycle_1_bi_ort_old', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_2_bi_ort_old, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_cycle_2_bi_ort_old(m,l,j,k,i) = <mlk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_cycle_2_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_cycle_2_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_cycle_2_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, i, m, j, integral)
|
||||
three_e_5_idx_cycle_2_bi_ort_old(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_cycle_2_bi_ort_old', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch23_bi_ort_old, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch23_bi_ort_old(m,l,j,k,i) = <mlk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_exch23_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_exch23_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch23_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, j, m, i, integral)
|
||||
three_e_5_idx_exch23_bi_ort_old(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch23_bi_ort_old', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch13_bi_ort_old, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch13_bi_ort_old(m,l,j,k,i) = <mlk|-L|ijm> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_exch13_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_exch13_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch13_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, i, j, m, integral)
|
||||
three_e_5_idx_exch13_bi_ort_old(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch13_bi_ort_old', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort_old, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch12_bi_ort_old(m,l,j,k,i) = <mlk|-L|mij> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
PROVIDE mo_l_coef mo_r_coef int2_grad1_u12_bimo_t
|
||||
|
||||
three_e_5_idx_exch12_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_exch12_bi_ort_old ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch12_bi_ort_old)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, m, i, j, integral)
|
||||
three_e_5_idx_exch12_bi_ort_old(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch12_bi_ort_old', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
@ -29,6 +29,9 @@ BEGIN_PROVIDER [ double precision, three_body_ints_bi_ort, (mo_num, mo_num, mo_n
|
||||
|
||||
!provide x_W_ki_bi_ortho_erf_rk
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
provide int2_grad1_u12_ao_transp final_grid_points int2_grad1_u12_bimo_t
|
||||
provide mo_l_coef mo_r_coef mos_l_in_r_array_transp mos_r_in_r_array_transp n_points_final_grid
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
@ -57,6 +60,7 @@ BEGIN_PROVIDER [ double precision, three_body_ints_bi_ort, (mo_num, mo_num, mo_n
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_body_ints_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
! if(write_three_body_ints_bi_ort)then
|
||||
! print*,'Writing three_body_ints_bi_ort on disk ...'
|
||||
! call write_array_6_index_tensor(mo_num,three_body_ints_bi_ort,name_file)
|
||||
@ -67,11 +71,69 @@ END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
subroutine give_integrals_3_body_bi_ort_spin( n, sigma_n, l, sigma_l, k, sigma_k &
|
||||
, m, sigma_m, j, sigma_j, i, sigma_i &
|
||||
, integral)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! < n l k | L | m j i > with a BI-ORTHONORMAL SPIN-ORBITALS
|
||||
!
|
||||
! /!\ L is defined without the 1/6 factor
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: n, l, k, m, j, i
|
||||
double precision, intent(in) :: sigma_n, sigma_l, sigma_k, sigma_m, sigma_j, sigma_i
|
||||
double precision, intent(out) :: integral
|
||||
integer :: ipoint
|
||||
double precision :: weight, tmp
|
||||
logical, external :: is_same_spin
|
||||
|
||||
integral = 0.d0
|
||||
|
||||
if( is_same_spin(sigma_n, sigma_m) .and. &
|
||||
is_same_spin(sigma_l, sigma_j) .and. &
|
||||
is_same_spin(sigma_k, sigma_i) ) then
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
PROVIDE int2_grad1_u12_bimo_t
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp = mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,n,m) * int2_grad1_u12_bimo_t(ipoint,1,l,j) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,n,m) * int2_grad1_u12_bimo_t(ipoint,2,l,j) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,n,m) * int2_grad1_u12_bimo_t(ipoint,3,l,j) )
|
||||
|
||||
tmp = tmp + mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,n,m) * int2_grad1_u12_bimo_t(ipoint,1,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,n,m) * int2_grad1_u12_bimo_t(ipoint,2,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,n,m) * int2_grad1_u12_bimo_t(ipoint,3,k,i) )
|
||||
|
||||
tmp = tmp + mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,l,j) * int2_grad1_u12_bimo_t(ipoint,1,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,l,j) * int2_grad1_u12_bimo_t(ipoint,2,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,l,j) * int2_grad1_u12_bimo_t(ipoint,3,k,i) )
|
||||
|
||||
integral = integral + tmp * final_weight_at_r_vector(ipoint)
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine give_integrals_3_body_bi_ort_spin
|
||||
|
||||
! ---
|
||||
|
||||
subroutine give_integrals_3_body_bi_ort(n, l, k, m, j, i, integral)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! < n l k | -L | m j i > with a BI-ORTHONORMAL MOLECULAR ORBITALS
|
||||
! < n l k | L | m j i > with a BI-ORTHONORMAL MOLECULAR ORBITALS
|
||||
!
|
||||
! /!\ L is defined without the 1/6 factor
|
||||
!
|
||||
END_DOC
|
||||
|
||||
@ -79,25 +141,31 @@ subroutine give_integrals_3_body_bi_ort(n, l, k, m, j, i, integral)
|
||||
integer, intent(in) :: n, l, k, m, j, i
|
||||
double precision, intent(out) :: integral
|
||||
integer :: ipoint
|
||||
double precision :: weight
|
||||
double precision :: weight, tmp
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
PROVIDE int2_grad1_u12_bimo_t
|
||||
|
||||
integral = 0.d0
|
||||
! (n, l, k, m, j, i)
|
||||
do ipoint = 1, n_points_final_grid
|
||||
weight = final_weight_at_r_vector(ipoint)
|
||||
|
||||
integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) &
|
||||
tmp = mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,n,m) * int2_grad1_u12_bimo_t(ipoint,1,l,j) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,n,m) * int2_grad1_u12_bimo_t(ipoint,2,l,j) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,n,m) * int2_grad1_u12_bimo_t(ipoint,3,l,j) )
|
||||
integral += weight * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j) &
|
||||
|
||||
tmp = tmp + mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,n,m) * int2_grad1_u12_bimo_t(ipoint,1,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,n,m) * int2_grad1_u12_bimo_t(ipoint,2,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,n,m) * int2_grad1_u12_bimo_t(ipoint,3,k,i) )
|
||||
integral += weight * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m) &
|
||||
|
||||
tmp = tmp + mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,l,j) * int2_grad1_u12_bimo_t(ipoint,1,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,l,j) * int2_grad1_u12_bimo_t(ipoint,2,k,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,l,j) * int2_grad1_u12_bimo_t(ipoint,3,k,i) )
|
||||
|
||||
integral = integral + tmp * final_weight_at_r_vector(ipoint)
|
||||
enddo
|
||||
|
||||
end subroutine give_integrals_3_body_bi_ort
|
||||
@ -108,7 +176,9 @@ subroutine give_integrals_3_body_bi_ort_old(n, l, k, m, j, i, integral)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! < n l k | -L | m j i > with a BI-ORTHONORMAL MOLECULAR ORBITALS
|
||||
! < n l k | L | m j i > with a BI-ORTHONORMAL MOLECULAR ORBITALS
|
||||
!
|
||||
! /!\ L is defined without the 1/6 factor
|
||||
!
|
||||
END_DOC
|
||||
|
||||
@ -121,35 +191,6 @@ subroutine give_integrals_3_body_bi_ort_old(n, l, k, m, j, i, integral)
|
||||
integral = 0.d0
|
||||
do ipoint = 1, n_points_final_grid
|
||||
weight = final_weight_at_r_vector(ipoint)
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) &
|
||||
! * ( x_W_ki_bi_ortho_erf_rk(ipoint,1,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,1,l,j) &
|
||||
! + x_W_ki_bi_ortho_erf_rk(ipoint,2,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,2,l,j) &
|
||||
! + x_W_ki_bi_ortho_erf_rk(ipoint,3,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,3,l,j) )
|
||||
! integral += weight * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j) &
|
||||
! * ( x_W_ki_bi_ortho_erf_rk(ipoint,1,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,1,k,i) &
|
||||
! + x_W_ki_bi_ortho_erf_rk(ipoint,2,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,2,k,i) &
|
||||
! + x_W_ki_bi_ortho_erf_rk(ipoint,3,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,3,k,i) )
|
||||
! integral += weight * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m) &
|
||||
! * ( x_W_ki_bi_ortho_erf_rk(ipoint,1,l,j) * x_W_ki_bi_ortho_erf_rk(ipoint,1,k,i) &
|
||||
! + x_W_ki_bi_ortho_erf_rk(ipoint,2,l,j) * x_W_ki_bi_ortho_erf_rk(ipoint,2,k,i) &
|
||||
! + x_W_ki_bi_ortho_erf_rk(ipoint,3,l,j) * x_W_ki_bi_ortho_erf_rk(ipoint,3,k,i) )
|
||||
|
||||
! integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) &
|
||||
! * ( int2_grad1_u12_bimo(1,n,m,ipoint) * int2_grad1_u12_bimo(1,l,j,ipoint) &
|
||||
! + int2_grad1_u12_bimo(2,n,m,ipoint) * int2_grad1_u12_bimo(2,l,j,ipoint) &
|
||||
! + int2_grad1_u12_bimo(3,n,m,ipoint) * int2_grad1_u12_bimo(3,l,j,ipoint) )
|
||||
! integral += weight * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j) &
|
||||
! * ( int2_grad1_u12_bimo(1,n,m,ipoint) * int2_grad1_u12_bimo(1,k,i,ipoint) &
|
||||
! + int2_grad1_u12_bimo(2,n,m,ipoint) * int2_grad1_u12_bimo(2,k,i,ipoint) &
|
||||
! + int2_grad1_u12_bimo(3,n,m,ipoint) * int2_grad1_u12_bimo(3,k,i,ipoint) )
|
||||
! integral += weight * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m) &
|
||||
! * ( int2_grad1_u12_bimo(1,l,j,ipoint) * int2_grad1_u12_bimo(1,k,i,ipoint) &
|
||||
! + int2_grad1_u12_bimo(2,l,j,ipoint) * int2_grad1_u12_bimo(2,k,i,ipoint) &
|
||||
! + int2_grad1_u12_bimo(3,l,j,ipoint) * int2_grad1_u12_bimo(3,k,i,ipoint) )
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) &
|
||||
* ( int2_grad1_u12_bimo_transp(n,m,1,ipoint) * int2_grad1_u12_bimo_transp(l,j,1,ipoint) &
|
||||
+ int2_grad1_u12_bimo_transp(n,m,2,ipoint) * int2_grad1_u12_bimo_transp(l,j,2,ipoint) &
|
||||
@ -173,7 +214,9 @@ subroutine give_integrals_3_body_bi_ort_ao(n, l, k, m, j, i, integral)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! < n l k | -L | m j i > with a BI-ORTHONORMAL ATOMIC ORBITALS
|
||||
! < n l k | L | m j i > with a BI-ORTHONORMAL ATOMIC ORBITALS
|
||||
!
|
||||
! /!\ L is defined without the 1/6 factor
|
||||
!
|
||||
END_DOC
|
||||
|
||||
|
@ -20,6 +20,7 @@ BEGIN_PROVIDER [double precision, ao_two_e_vartc_tot, (ao_num, ao_num, ao_num, a
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num) ]
|
||||
@ -40,23 +41,11 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n
|
||||
|
||||
provide j1b_type
|
||||
|
||||
if(j1b_type .eq. 3) then
|
||||
|
||||
do j = 1, ao_num
|
||||
do l = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
do k = 1, ao_num
|
||||
ao_two_e_tc_tot(k,i,l,j) = ao_tc_int_chemist(k,i,l,j)
|
||||
!write(222,*) ao_two_e_tc_tot(k,i,l,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
if(j1b_type .eq. 0) then
|
||||
|
||||
PROVIDE ao_tc_sym_two_e_pot_in_map
|
||||
|
||||
!!! TODO :: OPENMP
|
||||
do j = 1, ao_num
|
||||
do l = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
@ -76,6 +65,23 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
PROVIDE ao_tc_int_chemist
|
||||
|
||||
do j = 1, ao_num
|
||||
do l = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
do k = 1, ao_num
|
||||
ao_two_e_tc_tot(k,i,l,j) = ao_tc_int_chemist(k,i,l,j)
|
||||
!write(222,*) ao_two_e_tc_tot(k,i,l,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
FREE ao_tc_int_chemist
|
||||
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
@ -124,69 +130,99 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num,
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l, m, n, p, q
|
||||
double precision, allocatable :: mo_tmp_1(:,:,:,:), mo_tmp_2(:,:,:,:)
|
||||
double precision, allocatable :: a1(:,:,:,:), a2(:,:,:,:)
|
||||
|
||||
allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
|
||||
mo_tmp_1 = 0.d0
|
||||
PROVIDE mo_r_coef mo_l_coef
|
||||
|
||||
do m = 1, ao_num
|
||||
do p = 1, ao_num
|
||||
do n = 1, ao_num
|
||||
do q = 1, ao_num
|
||||
do k = 1, mo_num
|
||||
! (k n|p m) = sum_q c_qk * (q n|p m)
|
||||
mo_tmp_1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_tc_tot(q,n,p,m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
allocate(a2(ao_num,ao_num,ao_num,mo_num))
|
||||
|
||||
allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
|
||||
mo_tmp_2 = 0.d0
|
||||
call dgemm( 'T', 'N', ao_num*ao_num*ao_num, mo_num, ao_num, 1.d0 &
|
||||
, ao_two_e_tc_tot(1,1,1,1), ao_num, mo_l_coef(1,1), ao_num &
|
||||
, 0.d0 , a2(1,1,1,1), ao_num*ao_num*ao_num)
|
||||
|
||||
do m = 1, ao_num
|
||||
do p = 1, ao_num
|
||||
do n = 1, ao_num
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
! (k i|p m) = sum_n c_ni * (k n|p m)
|
||||
mo_tmp_2(k,i,p,m) += mo_r_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
deallocate(mo_tmp_1)
|
||||
allocate(a1(ao_num,ao_num,mo_num,mo_num))
|
||||
|
||||
allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
|
||||
mo_tmp_1 = 0.d0
|
||||
do m = 1, ao_num
|
||||
do p = 1, ao_num
|
||||
do l = 1, mo_num
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
mo_tmp_1(k,i,l,m) += mo_l_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
deallocate(mo_tmp_2)
|
||||
call dgemm( 'T', 'N', ao_num*ao_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||
, a2(1,1,1,1), ao_num, mo_r_coef(1,1), ao_num &
|
||||
, 0.d0, a1(1,1,1,1), ao_num*ao_num*mo_num)
|
||||
|
||||
mo_bi_ortho_tc_two_e_chemist = 0.d0
|
||||
do m = 1, ao_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
mo_bi_ortho_tc_two_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * mo_tmp_1(k,i,l,m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
deallocate(mo_tmp_1)
|
||||
deallocate(a2)
|
||||
allocate(a2(ao_num,mo_num,mo_num,mo_num))
|
||||
|
||||
call dgemm( 'T', 'N', ao_num*mo_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||
, a1(1,1,1,1), ao_num, mo_l_coef(1,1), ao_num &
|
||||
, 0.d0, a2(1,1,1,1), ao_num*mo_num*mo_num)
|
||||
|
||||
deallocate(a1)
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||
, a2(1,1,1,1), ao_num, mo_r_coef(1,1), ao_num &
|
||||
, 0.d0, mo_bi_ortho_tc_two_e_chemist(1,1,1,1), mo_num*mo_num*mo_num)
|
||||
|
||||
deallocate(a2)
|
||||
|
||||
|
||||
!allocate(a1(mo_num,ao_num,ao_num,ao_num))
|
||||
!a1 = 0.d0
|
||||
|
||||
!do m = 1, ao_num
|
||||
! do p = 1, ao_num
|
||||
! do n = 1, ao_num
|
||||
! do q = 1, ao_num
|
||||
! do k = 1, mo_num
|
||||
! ! (k n|p m) = sum_q c_qk * (q n|p m)
|
||||
! a1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_tc_tot(q,n,p,m)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
!enddo
|
||||
|
||||
!allocate(a2(mo_num,mo_num,ao_num,ao_num))
|
||||
!a2 = 0.d0
|
||||
|
||||
!do m = 1, ao_num
|
||||
! do p = 1, ao_num
|
||||
! do n = 1, ao_num
|
||||
! do i = 1, mo_num
|
||||
! do k = 1, mo_num
|
||||
! ! (k i|p m) = sum_n c_ni * (k n|p m)
|
||||
! a2(k,i,p,m) += mo_r_coef_transp(i,n) * a1(k,n,p,m)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
!enddo
|
||||
!deallocate(a1)
|
||||
|
||||
!allocate(a1(mo_num,mo_num,mo_num,ao_num))
|
||||
!a1 = 0.d0
|
||||
!do m = 1, ao_num
|
||||
! do p = 1, ao_num
|
||||
! do l = 1, mo_num
|
||||
! do i = 1, mo_num
|
||||
! do k = 1, mo_num
|
||||
! a1(k,i,l,m) += mo_l_coef_transp(l,p) * a2(k,i,p,m)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
!enddo
|
||||
!deallocate(a2)
|
||||
|
||||
!mo_bi_ortho_tc_two_e_chemist = 0.d0
|
||||
!do m = 1, ao_num
|
||||
! do j = 1, mo_num
|
||||
! do l = 1, mo_num
|
||||
! do i = 1, mo_num
|
||||
! do k = 1, mo_num
|
||||
! mo_bi_ortho_tc_two_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * a1(k,i,l,m)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
!enddo
|
||||
!deallocate(a1)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -205,6 +241,8 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num,
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
|
||||
PROVIDE mo_bi_ortho_tc_two_e_chemist
|
||||
|
||||
do j = 1, mo_num
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
@ -216,48 +254,60 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num,
|
||||
enddo
|
||||
enddo
|
||||
|
||||
FREE mo_bi_ortho_tc_two_e_chemist
|
||||
|
||||
if(noL_standard) then
|
||||
PROVIDE noL_2e
|
||||
! x 2 because of the Slater-Condon rules convention
|
||||
mo_bi_ortho_tc_two_e = mo_bi_ortho_tc_two_e + 2.d0 * noL_2e
|
||||
FREE noL_2e
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_exchange, (mo_num,mo_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_anti, (mo_num,mo_num) ]
|
||||
implicit none
|
||||
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_exchange, (mo_num,mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_anti, (mo_num,mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! mo_bi_ortho_tc_two_e_jj(i,j) = J_ij = <ji|W-K|ji>
|
||||
!
|
||||
! mo_bi_ortho_tc_two_e_jj (i,j) = J_ij = <ji|W-K|ji>
|
||||
! mo_bi_ortho_tc_two_e_jj_exchange(i,j) = K_ij = <ij|W-K|ji>
|
||||
! mo_bi_ortho_tc_two_e_jj_anti(i,j) = J_ij - K_ij
|
||||
! mo_bi_ortho_tc_two_e_jj_anti (i,j) = J_ij - K_ij
|
||||
!
|
||||
END_DOC
|
||||
|
||||
integer :: i,j
|
||||
double precision :: get_two_e_integral
|
||||
implicit none
|
||||
integer :: i, j
|
||||
|
||||
mo_bi_ortho_tc_two_e_jj = 0.d0
|
||||
mo_bi_ortho_tc_two_e_jj_exchange = 0.d0
|
||||
|
||||
do i=1,mo_num
|
||||
do j=1,mo_num
|
||||
mo_bi_ortho_tc_two_e_jj(i,j) = mo_bi_ortho_tc_two_e(j,i,j,i)
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
mo_bi_ortho_tc_two_e_jj (i,j) = mo_bi_ortho_tc_two_e(j,i,j,i)
|
||||
mo_bi_ortho_tc_two_e_jj_exchange(i,j) = mo_bi_ortho_tc_two_e(i,j,j,i)
|
||||
mo_bi_ortho_tc_two_e_jj_anti(i,j) = mo_bi_ortho_tc_two_e_jj(i,j) - mo_bi_ortho_tc_two_e_jj_exchange(i,j)
|
||||
mo_bi_ortho_tc_two_e_jj_anti (i,j) = mo_bi_ortho_tc_two_e_jj(i,j) - mo_bi_ortho_tc_two_e_jj_exchange(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, tc_2e_3idx_coulomb_integrals, (mo_num,mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [double precision, tc_2e_3idx_exchange_integrals,(mo_num,mo_num, mo_num)]
|
||||
implicit none
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, tc_2e_3idx_coulomb_integrals , (mo_num,mo_num,mo_num)]
|
||||
&BEGIN_PROVIDER [double precision, tc_2e_3idx_exchange_integrals, (mo_num,mo_num,mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! tc_2e_3idx_coulomb_integrals(j,k,i) = <jk|ji>
|
||||
!
|
||||
! tc_2e_3idx_coulomb_integrals (j,k,i) = <jk|ji>
|
||||
! tc_2e_3idx_exchange_integrals(j,k,i) = <kj|ji>
|
||||
END_DOC
|
||||
integer :: i,j,k,l
|
||||
double precision :: get_two_e_integral
|
||||
double precision :: integral
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k
|
||||
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
@ -269,3 +319,6 @@ END_PROVIDER
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
@ -15,7 +15,6 @@ BEGIN_PROVIDER [double precision, TCSCF_bi_ort_dm_ao_alpha, (ao_num, ao_num) ]
|
||||
|
||||
call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 &
|
||||
, mo_l_coef, size(mo_l_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
|
||||
!, mo_r_coef, size(mo_r_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
|
||||
, 0.d0, TCSCF_bi_ort_dm_ao_alpha, size(TCSCF_bi_ort_dm_ao_alpha, 1) )
|
||||
|
||||
END_PROVIDER
|
||||
@ -36,7 +35,6 @@ BEGIN_PROVIDER [ double precision, TCSCF_bi_ort_dm_ao_beta, (ao_num, ao_num) ]
|
||||
|
||||
call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 &
|
||||
, mo_l_coef, size(mo_l_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
|
||||
!, mo_r_coef, size(mo_r_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
|
||||
, 0.d0, TCSCF_bi_ort_dm_ao_beta, size(TCSCF_bi_ort_dm_ao_beta, 1) )
|
||||
|
||||
END_PROVIDER
|
||||
|
@ -116,7 +116,7 @@ end subroutine give_all_mos_l_at_r
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER[double precision, mos_l_in_r_array_transp,(n_points_final_grid,mo_num)]
|
||||
BEGIN_PROVIDER[double precision, mos_l_in_r_array_transp, (n_points_final_grid,mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! mos_l_in_r_array_transp(i,j) = value of the jth mo on the ith grid point
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user