mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-07 14:03:37 +01:00
commit
2989703835
36
.drone.yml
36
.drone.yml
@ -7,46 +7,46 @@ clone:
|
|||||||
depth: 10
|
depth: 10
|
||||||
|
|
||||||
steps:
|
steps:
|
||||||
|
- name: configure debug
|
||||||
- name: configure
|
|
||||||
image: scemama666/qp2_env
|
image: scemama666/qp2_env
|
||||||
commands:
|
commands:
|
||||||
- ./configure -i all -c ./config/gfortran_debug.cfg
|
- ./configure -i all -c ./config/gfortran_debug.cfg
|
||||||
- bash -c "source quantum_package.rc ; exec qp_plugins download https://gitlab.com/scemama/qp_plugins_scemama"
|
- bash -c "source quantum_package.rc ; exec qp_plugins download https://gitlab.com/scemama/qp_plugins_scemama"
|
||||||
- bash -c "source quantum_package.rc ; exec qp_plugins install champ"
|
- bash -c "source quantum_package.rc ; exec qp_plugins install champ"
|
||||||
|
|
||||||
- name: compile
|
- name: compile debug
|
||||||
image: scemama666/qp2_env
|
image: scemama666/qp2_env
|
||||||
commands:
|
commands:
|
||||||
- bash -c "source quantum_package.rc ; exec ninja"
|
- bash -c "source quantum_package.rc ; exec ninja"
|
||||||
|
|
||||||
- name: testing
|
- name: testing debug
|
||||||
image: scemama666/qp2_env
|
image: scemama666/qp2_env
|
||||||
commands:
|
commands:
|
||||||
- bash -c "source quantum_package.rc ; TRAVIS=1 exec qp_test -a"
|
- bash -c "source quantum_package.rc ; TRAVIS=1 exec qp_test -a"
|
||||||
|
|
||||||
---
|
- name: configure fast
|
||||||
kind: pipeline
|
|
||||||
type: docker
|
|
||||||
name: gfortran-avx
|
|
||||||
|
|
||||||
clone:
|
|
||||||
depth: 10
|
|
||||||
|
|
||||||
steps:
|
|
||||||
|
|
||||||
- name: configure
|
|
||||||
image: scemama666/qp2_env
|
image: scemama666/qp2_env
|
||||||
commands:
|
commands:
|
||||||
- ./configure -i all -c ./config/gfortran_avx.cfg
|
- ./configure -c ./config/gfortran_avx.cfg
|
||||||
|
|
||||||
- name: compile
|
- name: compile fast
|
||||||
image: scemama666/qp2_env
|
image: scemama666/qp2_env
|
||||||
commands:
|
commands:
|
||||||
- bash -c "source quantum_package.rc ; exec ninja"
|
- bash -c "source quantum_package.rc ; exec ninja"
|
||||||
|
|
||||||
- name: testing
|
- name: testing fast
|
||||||
image: scemama666/qp2_env
|
image: scemama666/qp2_env
|
||||||
commands:
|
commands:
|
||||||
- bash -c "source quantum_package.rc ; exec qp_test -a"
|
- bash -c "source quantum_package.rc ; exec qp_test -a"
|
||||||
|
|
||||||
|
- name: notify
|
||||||
|
image: drillster/drone-email
|
||||||
|
settings:
|
||||||
|
host:
|
||||||
|
from_secret: hostname # irsamc.ups-tlse.fr
|
||||||
|
from:
|
||||||
|
from_secret: from # drone@irssv7.ups-tlse.fr
|
||||||
|
recipients:
|
||||||
|
from_secret: recipients # scemama@irsamc.ups-tlse.fr
|
||||||
|
when:
|
||||||
|
status: [changed, failure]
|
||||||
|
@ -35,6 +35,12 @@ https://arxiv.org/abs/1902.08154
|
|||||||
* [Download the latest release](http://github.com/QuantumPackage/qp2/releases)
|
* [Download the latest release](http://github.com/QuantumPackage/qp2/releases)
|
||||||
* [Read the documentation](https://quantum-package.readthedocs.io)
|
* [Read the documentation](https://quantum-package.readthedocs.io)
|
||||||
|
|
||||||
|
# Discussion list
|
||||||
|
|
||||||
|
For any questions or announcements regarding QuantumPackage, you can join our discussion list by registering [here](https://groupes.renater.fr/sympa/subscribe/quantum_package) or by sending an email to `quantum_package-request@groupes.renater.fr` .
|
||||||
|
You can also look over its [archives](https://groupes.renater.fr/sympa/arc/quantum_package).
|
||||||
|
|
||||||
|
|
||||||
# Build status
|
# Build status
|
||||||
|
|
||||||
* Master [![master build status](https://travis-ci.com/QuantumPackage/qp2.svg?branch=master)](https://travis-ci.org/QuantumPackage/qp2)
|
* Master [![master build status](https://travis-ci.com/QuantumPackage/qp2.svg?branch=master)](https://travis-ci.org/QuantumPackage/qp2)
|
||||||
|
@ -146,6 +146,17 @@ def write_ezfio(res, filename):
|
|||||||
ezfio.set_ao_basis_ao_nucl(at)
|
ezfio.set_ao_basis_ao_nucl(at)
|
||||||
ezfio.set_ao_basis_ao_prim_num(num_prim)
|
ezfio.set_ao_basis_ao_prim_num(num_prim)
|
||||||
ezfio.set_ao_basis_ao_power(power_x + power_y + power_z)
|
ezfio.set_ao_basis_ao_power(power_x + power_y + power_z)
|
||||||
|
try:
|
||||||
|
normf = res.normf
|
||||||
|
if normf == 0:
|
||||||
|
ezfio.set_ao_basis_ao_normalized(True)
|
||||||
|
elif normf == 1:
|
||||||
|
ezfio.set_ao_basis_ao_normalized(False)
|
||||||
|
else:
|
||||||
|
print("BUG in NORMF")
|
||||||
|
sys.exit(0)
|
||||||
|
except AttributeError:
|
||||||
|
ezfio.set_ao_basis_ao_normalized(True)
|
||||||
|
|
||||||
# ~#~#~#~#~#~#~ #
|
# ~#~#~#~#~#~#~ #
|
||||||
# P a r s i n g #
|
# P a r s i n g #
|
||||||
@ -224,7 +235,7 @@ def write_ezfio(res, filename):
|
|||||||
exponent += [p.expo for p in b.prim]
|
exponent += [p.expo for p in b.prim]
|
||||||
ang_mom.append(str.count(s, "z"))
|
ang_mom.append(str.count(s, "z"))
|
||||||
shell_prim_num.append(len(b.prim))
|
shell_prim_num.append(len(b.prim))
|
||||||
shell_index += [nshell_tot+1] * len(b.prim)
|
shell_index += [nshell_tot] * len(b.prim)
|
||||||
|
|
||||||
# ~#~#~#~#~ #
|
# ~#~#~#~#~ #
|
||||||
# W r i t e #
|
# W r i t e #
|
||||||
|
@ -11,8 +11,8 @@ Usage:
|
|||||||
|
|
||||||
Options:
|
Options:
|
||||||
-q --query Prints in the standard output the number of frozen MOs
|
-q --query Prints in the standard output the number of frozen MOs
|
||||||
-l --large Use a small core
|
-l --large Use a large core
|
||||||
-s --small Use a large core
|
-s --small Use a small core
|
||||||
-u --unset Unset frozen core
|
-u --unset Unset frozen core
|
||||||
|
|
||||||
|
|
||||||
|
@ -60,19 +60,14 @@ def main(arguments):
|
|||||||
print("Running tests for %s"%(bats_file))
|
print("Running tests for %s"%(bats_file))
|
||||||
print("")
|
print("")
|
||||||
if arguments["-v"]:
|
if arguments["-v"]:
|
||||||
p = None
|
|
||||||
if arguments["TEST"]:
|
if arguments["TEST"]:
|
||||||
test = "export TEST=%s ; "%arguments["TEST"]
|
test = "export TEST=%s ; "%arguments["TEST"]
|
||||||
else:
|
else:
|
||||||
test = ""
|
test = ""
|
||||||
try:
|
|
||||||
os.system(test+" python3 bats_to_sh.py "+bats_file+
|
os.system(test+" python3 bats_to_sh.py "+bats_file+
|
||||||
"| bash")
|
"| bash")
|
||||||
except:
|
|
||||||
if p:
|
|
||||||
p.terminate()
|
|
||||||
else:
|
else:
|
||||||
subprocess.check_call(["bats", bats_file], env=os.environ)
|
subprocess.check_call(["bats", "--verbose-run", "--trace", bats_file], env=os.environ)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : ifort -fpic
|
FC : ifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
|
IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : mpiifort -fpic
|
FC : mpiifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_NESTED
|
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_NESTED
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : mpiifort -fpic
|
FC : mpiifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
|
IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : ifort -fpic
|
FC : ifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
|
IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : ifort -fpic
|
FC : ifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
|
IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : mpiifort -fpic
|
FC : mpiifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_NESTED
|
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_NESTED
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : ifort -fpic
|
FC : ifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=64 -DINTEL -DSET_NESTED
|
IRPF90_FLAGS : --ninja --align=64 -DINTEL -DSET_NESTED
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : ifort -fpic
|
FC : ifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DINTEL
|
IRPF90_FLAGS : --ninja --align=32 -DINTEL
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : mpiifort -fpic
|
FC : mpiifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL
|
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : mpiifort -fpic
|
FC : mpiifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DINTEL
|
IRPF90_FLAGS : --ninja --align=32 -DINTEL
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : ifort -fpic
|
FC : ifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DINTEL
|
IRPF90_FLAGS : --ninja --align=32 -DINTEL
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : ifort -fpic
|
FC : ifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DINTEL
|
IRPF90_FLAGS : --ninja --align=32 -DINTEL
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : mpiifort -fpic
|
FC : mpiifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL
|
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
#
|
#
|
||||||
[COMMON]
|
[COMMON]
|
||||||
FC : ifort -fpic
|
FC : ifort -fpic
|
||||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
LAPACK_LIB : -mkl=parallel
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=64 -DINTEL
|
IRPF90_FLAGS : --ninja --align=64 -DINTEL
|
||||||
|
|
||||||
|
12
configure
vendored
12
configure
vendored
@ -180,7 +180,7 @@ if [[ "${PACKAGES}.x" != ".x" ]] ; then
|
|||||||
fi
|
fi
|
||||||
|
|
||||||
if [[ ${PACKAGES} = all ]] ; then
|
if [[ ${PACKAGES} = all ]] ; then
|
||||||
PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats"
|
PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats bse"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
||||||
@ -281,8 +281,8 @@ EOF
|
|||||||
|
|
||||||
execute << EOF
|
execute << EOF
|
||||||
cd "\${QP_ROOT}"/external
|
cd "\${QP_ROOT}"/external
|
||||||
tar -zxf qp2-dependencies/bats-v1.1.0.tar.gz
|
tar -zxf qp2-dependencies/bats-v1.7.0.tar.gz
|
||||||
( cd bats-core-1.1.0/ ; ./install.sh \${QP_ROOT})
|
( cd bats-core-1.7.0/ ; ./install.sh \${QP_ROOT})
|
||||||
EOF
|
EOF
|
||||||
|
|
||||||
else
|
else
|
||||||
@ -354,12 +354,6 @@ echo " ||----w | "
|
|||||||
echo " || || "
|
echo " || || "
|
||||||
echo "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
|
echo "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
|
||||||
echo ""
|
echo ""
|
||||||
echo "If you have PIP, you can install the Basis Set Exchange command-line tool:"
|
|
||||||
echo ""
|
|
||||||
echo " ./configure -i bse"
|
|
||||||
echo ""
|
|
||||||
echo "This will enable the usage of qp_basis to install extra basis sets."
|
|
||||||
echo ""
|
|
||||||
echo ""
|
echo ""
|
||||||
printf "\e[m\n"
|
printf "\e[m\n"
|
||||||
|
|
||||||
|
@ -1,8 +0,0 @@
|
|||||||
Docker files to build the containers used with DroneCI.
|
|
||||||
|
|
||||||
Example:
|
|
||||||
```
|
|
||||||
docker build -t ubuntu/qp2_env .
|
|
||||||
|
|
||||||
```
|
|
||||||
|
|
@ -1,27 +0,0 @@
|
|||||||
ARG UBUNTU_VERSION=20.04
|
|
||||||
FROM ubuntu:${UBUNTU_VERSION} AS builder
|
|
||||||
|
|
||||||
# Timezone for tzdata
|
|
||||||
ARG tz=Etc/UTC
|
|
||||||
RUN echo $tz > /etc/timezone && rm -rf /etc/localtime
|
|
||||||
|
|
||||||
# Install
|
|
||||||
RUN apt-get update && DEBIAN_FRONTEND=noninteractive apt-get install -y \
|
|
||||||
git \
|
|
||||||
curl \
|
|
||||||
wget \
|
|
||||||
python3 \
|
|
||||||
gfortran \
|
|
||||||
gcc \
|
|
||||||
g++ \
|
|
||||||
make \
|
|
||||||
build-essential \
|
|
||||||
rsync \
|
|
||||||
unzip \
|
|
||||||
libopenblas-dev \
|
|
||||||
pkg-config \
|
|
||||||
m4
|
|
||||||
|
|
||||||
RUN ln -s /usr/bin/python3 /usr/bin/python
|
|
||||||
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
|||||||
#!/bin/bash
|
|
||||||
# Stage 2
|
|
||||||
|
|
||||||
# Extract cache from config stage
|
|
||||||
cd ../
|
|
||||||
tar -zxf $HOME/cache/config.tgz
|
|
||||||
|
|
||||||
# Configure QP2
|
|
||||||
cd qp2
|
|
||||||
source ./quantum_package.rc
|
|
||||||
ninja -j 1 -v || exit -1
|
|
||||||
|
|
||||||
# Create cache
|
|
||||||
cd ..
|
|
||||||
tar -zcf $HOME/cache/compil.tgz qp2 && rm $HOME/cache/config.tgz
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
|||||||
#!/bin/bash
|
|
||||||
# Stage 1
|
|
||||||
|
|
||||||
# Configure QP2
|
|
||||||
./configure --download all --install all --config ./config/travis.cfg || exit -1
|
|
||||||
|
|
||||||
# Create cache
|
|
||||||
cd ../
|
|
||||||
tar -zcf $HOME/cache/config.tgz qp2
|
|
||||||
|
|
@ -1,30 +0,0 @@
|
|||||||
---
|
|
||||||
kind: pipeline
|
|
||||||
type: docker
|
|
||||||
name: default
|
|
||||||
|
|
||||||
clone:
|
|
||||||
depth: 10
|
|
||||||
|
|
||||||
steps:
|
|
||||||
- name: configure
|
|
||||||
pull: never
|
|
||||||
image: ubuntu/qp2_env
|
|
||||||
commands:
|
|
||||||
- ./configure -i all -c ./config/gfortran_debug.cfg
|
|
||||||
- source quantum_package.rc ; qp plugins download https://gitlab.com/scemama/qp_plugins_scemama
|
|
||||||
- source quantum_package.rc ; qp plugins install champ
|
|
||||||
|
|
||||||
- name: compile
|
|
||||||
pull: never
|
|
||||||
image: ubuntu/qp2_env
|
|
||||||
commands:
|
|
||||||
- ninja
|
|
||||||
|
|
||||||
- name: testing
|
|
||||||
pull: never
|
|
||||||
image: ubuntu/qp2_env
|
|
||||||
commands:
|
|
||||||
- qp test
|
|
||||||
|
|
||||||
|
|
@ -1,29 +0,0 @@
|
|||||||
kind: pipeline
|
|
||||||
type: ssh
|
|
||||||
name: default
|
|
||||||
|
|
||||||
clone:
|
|
||||||
depth: 10
|
|
||||||
|
|
||||||
server:
|
|
||||||
host: 130.120.229.139
|
|
||||||
user: test
|
|
||||||
password:
|
|
||||||
from_secret: ssh_pass
|
|
||||||
|
|
||||||
steps:
|
|
||||||
- name: configure
|
|
||||||
commands:
|
|
||||||
- ./configure -i all -c ./config/gfortran_debug.cfg
|
|
||||||
- source quantum_package.rc ; qp plugins download https://gitlab.com/scemama/qp_plugins_scemama
|
|
||||||
- source quantum_package.rc ; qp plugins install champ
|
|
||||||
|
|
||||||
- name: compile
|
|
||||||
commands:
|
|
||||||
- ninja
|
|
||||||
|
|
||||||
- name: testing
|
|
||||||
commands:
|
|
||||||
- qp test
|
|
||||||
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
|||||||
#!/bin/bash
|
|
||||||
# Stage 3
|
|
||||||
|
|
||||||
# Extract cache from compile stage
|
|
||||||
cd ../
|
|
||||||
tar -zxf $HOME/cache/compil.tgz
|
|
||||||
|
|
||||||
# Configure QP2
|
|
||||||
cd qp2
|
|
||||||
source ./quantum_package.rc
|
|
||||||
exec qp_test -a && rm $HOME/cache/compil.tgz
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -80,8 +80,6 @@ function qp()
|
|||||||
if [[ -d $NAME ]] ; then
|
if [[ -d $NAME ]] ; then
|
||||||
[[ -d $EZFIO_FILE ]] && ezfio unset_file
|
[[ -d $EZFIO_FILE ]] && ezfio unset_file
|
||||||
ezfio set_file $NAME
|
ezfio set_file $NAME
|
||||||
else
|
|
||||||
qp_create_ezfio -h | more
|
|
||||||
fi
|
fi
|
||||||
unset _ARGS
|
unset _ARGS
|
||||||
;;
|
;;
|
||||||
|
579
external/Python/docopt.py
vendored
Normal file
579
external/Python/docopt.py
vendored
Normal file
@ -0,0 +1,579 @@
|
|||||||
|
"""Pythonic command-line interface parser that will make you smile.
|
||||||
|
|
||||||
|
* http://docopt.org
|
||||||
|
* Repository and issue-tracker: https://github.com/docopt/docopt
|
||||||
|
* Licensed under terms of MIT license (see LICENSE-MIT)
|
||||||
|
* Copyright (c) 2013 Vladimir Keleshev, vladimir@keleshev.com
|
||||||
|
|
||||||
|
"""
|
||||||
|
import sys
|
||||||
|
import re
|
||||||
|
|
||||||
|
|
||||||
|
__all__ = ['docopt']
|
||||||
|
__version__ = '0.6.2'
|
||||||
|
|
||||||
|
|
||||||
|
class DocoptLanguageError(Exception):
|
||||||
|
|
||||||
|
"""Error in construction of usage-message by developer."""
|
||||||
|
|
||||||
|
|
||||||
|
class DocoptExit(SystemExit):
|
||||||
|
|
||||||
|
"""Exit in case user invoked program with incorrect arguments."""
|
||||||
|
|
||||||
|
usage = ''
|
||||||
|
|
||||||
|
def __init__(self, message=''):
|
||||||
|
SystemExit.__init__(self, (message + '\n' + self.usage).strip())
|
||||||
|
|
||||||
|
|
||||||
|
class Pattern(object):
|
||||||
|
|
||||||
|
def __eq__(self, other):
|
||||||
|
return repr(self) == repr(other)
|
||||||
|
|
||||||
|
def __hash__(self):
|
||||||
|
return hash(repr(self))
|
||||||
|
|
||||||
|
def fix(self):
|
||||||
|
self.fix_identities()
|
||||||
|
self.fix_repeating_arguments()
|
||||||
|
return self
|
||||||
|
|
||||||
|
def fix_identities(self, uniq=None):
|
||||||
|
"""Make pattern-tree tips point to same object if they are equal."""
|
||||||
|
if not hasattr(self, 'children'):
|
||||||
|
return self
|
||||||
|
uniq = list(set(self.flat())) if uniq is None else uniq
|
||||||
|
for i, c in enumerate(self.children):
|
||||||
|
if not hasattr(c, 'children'):
|
||||||
|
assert c in uniq
|
||||||
|
self.children[i] = uniq[uniq.index(c)]
|
||||||
|
else:
|
||||||
|
c.fix_identities(uniq)
|
||||||
|
|
||||||
|
def fix_repeating_arguments(self):
|
||||||
|
"""Fix elements that should accumulate/increment values."""
|
||||||
|
either = [list(c.children) for c in self.either.children]
|
||||||
|
for case in either:
|
||||||
|
for e in [c for c in case if case.count(c) > 1]:
|
||||||
|
if type(e) is Argument or type(e) is Option and e.argcount:
|
||||||
|
if e.value is None:
|
||||||
|
e.value = []
|
||||||
|
elif type(e.value) is not list:
|
||||||
|
e.value = e.value.split()
|
||||||
|
if type(e) is Command or type(e) is Option and e.argcount == 0:
|
||||||
|
e.value = 0
|
||||||
|
return self
|
||||||
|
|
||||||
|
@property
|
||||||
|
def either(self):
|
||||||
|
"""Transform pattern into an equivalent, with only top-level Either."""
|
||||||
|
# Currently the pattern will not be equivalent, but more "narrow",
|
||||||
|
# although good enough to reason about list arguments.
|
||||||
|
ret = []
|
||||||
|
groups = [[self]]
|
||||||
|
while groups:
|
||||||
|
children = groups.pop(0)
|
||||||
|
types = [type(c) for c in children]
|
||||||
|
if Either in types:
|
||||||
|
either = [c for c in children if type(c) is Either][0]
|
||||||
|
children.pop(children.index(either))
|
||||||
|
for c in either.children:
|
||||||
|
groups.append([c] + children)
|
||||||
|
elif Required in types:
|
||||||
|
required = [c for c in children if type(c) is Required][0]
|
||||||
|
children.pop(children.index(required))
|
||||||
|
groups.append(list(required.children) + children)
|
||||||
|
elif Optional in types:
|
||||||
|
optional = [c for c in children if type(c) is Optional][0]
|
||||||
|
children.pop(children.index(optional))
|
||||||
|
groups.append(list(optional.children) + children)
|
||||||
|
elif AnyOptions in types:
|
||||||
|
optional = [c for c in children if type(c) is AnyOptions][0]
|
||||||
|
children.pop(children.index(optional))
|
||||||
|
groups.append(list(optional.children) + children)
|
||||||
|
elif OneOrMore in types:
|
||||||
|
oneormore = [c for c in children if type(c) is OneOrMore][0]
|
||||||
|
children.pop(children.index(oneormore))
|
||||||
|
groups.append(list(oneormore.children) * 2 + children)
|
||||||
|
else:
|
||||||
|
ret.append(children)
|
||||||
|
return Either(*[Required(*e) for e in ret])
|
||||||
|
|
||||||
|
|
||||||
|
class ChildPattern(Pattern):
|
||||||
|
|
||||||
|
def __init__(self, name, value=None):
|
||||||
|
self.name = name
|
||||||
|
self.value = value
|
||||||
|
|
||||||
|
def __repr__(self):
|
||||||
|
return '%s(%r, %r)' % (self.__class__.__name__, self.name, self.value)
|
||||||
|
|
||||||
|
def flat(self, *types):
|
||||||
|
return [self] if not types or type(self) in types else []
|
||||||
|
|
||||||
|
def match(self, left, collected=None):
|
||||||
|
collected = [] if collected is None else collected
|
||||||
|
pos, match = self.single_match(left)
|
||||||
|
if match is None:
|
||||||
|
return False, left, collected
|
||||||
|
left_ = left[:pos] + left[pos + 1:]
|
||||||
|
same_name = [a for a in collected if a.name == self.name]
|
||||||
|
if type(self.value) in (int, list):
|
||||||
|
if type(self.value) is int:
|
||||||
|
increment = 1
|
||||||
|
else:
|
||||||
|
increment = ([match.value] if type(match.value) is str
|
||||||
|
else match.value)
|
||||||
|
if not same_name:
|
||||||
|
match.value = increment
|
||||||
|
return True, left_, collected + [match]
|
||||||
|
same_name[0].value += increment
|
||||||
|
return True, left_, collected
|
||||||
|
return True, left_, collected + [match]
|
||||||
|
|
||||||
|
|
||||||
|
class ParentPattern(Pattern):
|
||||||
|
|
||||||
|
def __init__(self, *children):
|
||||||
|
self.children = list(children)
|
||||||
|
|
||||||
|
def __repr__(self):
|
||||||
|
return '%s(%s)' % (self.__class__.__name__,
|
||||||
|
', '.join(repr(a) for a in self.children))
|
||||||
|
|
||||||
|
def flat(self, *types):
|
||||||
|
if type(self) in types:
|
||||||
|
return [self]
|
||||||
|
return sum([c.flat(*types) for c in self.children], [])
|
||||||
|
|
||||||
|
|
||||||
|
class Argument(ChildPattern):
|
||||||
|
|
||||||
|
def single_match(self, left):
|
||||||
|
for n, p in enumerate(left):
|
||||||
|
if type(p) is Argument:
|
||||||
|
return n, Argument(self.name, p.value)
|
||||||
|
return None, None
|
||||||
|
|
||||||
|
@classmethod
|
||||||
|
def parse(class_, source):
|
||||||
|
name = re.findall('(<\S*?>)', source)[0]
|
||||||
|
value = re.findall('\[default: (.*)\]', source, flags=re.I)
|
||||||
|
return class_(name, value[0] if value else None)
|
||||||
|
|
||||||
|
|
||||||
|
class Command(Argument):
|
||||||
|
|
||||||
|
def __init__(self, name, value=False):
|
||||||
|
self.name = name
|
||||||
|
self.value = value
|
||||||
|
|
||||||
|
def single_match(self, left):
|
||||||
|
for n, p in enumerate(left):
|
||||||
|
if type(p) is Argument:
|
||||||
|
if p.value == self.name:
|
||||||
|
return n, Command(self.name, True)
|
||||||
|
else:
|
||||||
|
break
|
||||||
|
return None, None
|
||||||
|
|
||||||
|
|
||||||
|
class Option(ChildPattern):
|
||||||
|
|
||||||
|
def __init__(self, short=None, long=None, argcount=0, value=False):
|
||||||
|
assert argcount in (0, 1)
|
||||||
|
self.short, self.long = short, long
|
||||||
|
self.argcount, self.value = argcount, value
|
||||||
|
self.value = None if value is False and argcount else value
|
||||||
|
|
||||||
|
@classmethod
|
||||||
|
def parse(class_, option_description):
|
||||||
|
short, long, argcount, value = None, None, 0, False
|
||||||
|
options, _, description = option_description.strip().partition(' ')
|
||||||
|
options = options.replace(',', ' ').replace('=', ' ')
|
||||||
|
for s in options.split():
|
||||||
|
if s.startswith('--'):
|
||||||
|
long = s
|
||||||
|
elif s.startswith('-'):
|
||||||
|
short = s
|
||||||
|
else:
|
||||||
|
argcount = 1
|
||||||
|
if argcount:
|
||||||
|
matched = re.findall('\[default: (.*)\]', description, flags=re.I)
|
||||||
|
value = matched[0] if matched else None
|
||||||
|
return class_(short, long, argcount, value)
|
||||||
|
|
||||||
|
def single_match(self, left):
|
||||||
|
for n, p in enumerate(left):
|
||||||
|
if self.name == p.name:
|
||||||
|
return n, p
|
||||||
|
return None, None
|
||||||
|
|
||||||
|
@property
|
||||||
|
def name(self):
|
||||||
|
return self.long or self.short
|
||||||
|
|
||||||
|
def __repr__(self):
|
||||||
|
return 'Option(%r, %r, %r, %r)' % (self.short, self.long,
|
||||||
|
self.argcount, self.value)
|
||||||
|
|
||||||
|
|
||||||
|
class Required(ParentPattern):
|
||||||
|
|
||||||
|
def match(self, left, collected=None):
|
||||||
|
collected = [] if collected is None else collected
|
||||||
|
l = left
|
||||||
|
c = collected
|
||||||
|
for p in self.children:
|
||||||
|
matched, l, c = p.match(l, c)
|
||||||
|
if not matched:
|
||||||
|
return False, left, collected
|
||||||
|
return True, l, c
|
||||||
|
|
||||||
|
|
||||||
|
class Optional(ParentPattern):
|
||||||
|
|
||||||
|
def match(self, left, collected=None):
|
||||||
|
collected = [] if collected is None else collected
|
||||||
|
for p in self.children:
|
||||||
|
m, left, collected = p.match(left, collected)
|
||||||
|
return True, left, collected
|
||||||
|
|
||||||
|
|
||||||
|
class AnyOptions(Optional):
|
||||||
|
|
||||||
|
"""Marker/placeholder for [options] shortcut."""
|
||||||
|
|
||||||
|
|
||||||
|
class OneOrMore(ParentPattern):
|
||||||
|
|
||||||
|
def match(self, left, collected=None):
|
||||||
|
assert len(self.children) == 1
|
||||||
|
collected = [] if collected is None else collected
|
||||||
|
l = left
|
||||||
|
c = collected
|
||||||
|
l_ = None
|
||||||
|
matched = True
|
||||||
|
times = 0
|
||||||
|
while matched:
|
||||||
|
# could it be that something didn't match but changed l or c?
|
||||||
|
matched, l, c = self.children[0].match(l, c)
|
||||||
|
times += 1 if matched else 0
|
||||||
|
if l_ == l:
|
||||||
|
break
|
||||||
|
l_ = l
|
||||||
|
if times >= 1:
|
||||||
|
return True, l, c
|
||||||
|
return False, left, collected
|
||||||
|
|
||||||
|
|
||||||
|
class Either(ParentPattern):
|
||||||
|
|
||||||
|
def match(self, left, collected=None):
|
||||||
|
collected = [] if collected is None else collected
|
||||||
|
outcomes = []
|
||||||
|
for p in self.children:
|
||||||
|
matched, _, _ = outcome = p.match(left, collected)
|
||||||
|
if matched:
|
||||||
|
outcomes.append(outcome)
|
||||||
|
if outcomes:
|
||||||
|
return min(outcomes, key=lambda outcome: len(outcome[1]))
|
||||||
|
return False, left, collected
|
||||||
|
|
||||||
|
|
||||||
|
class TokenStream(list):
|
||||||
|
|
||||||
|
def __init__(self, source, error):
|
||||||
|
self += source.split() if hasattr(source, 'split') else source
|
||||||
|
self.error = error
|
||||||
|
|
||||||
|
def move(self):
|
||||||
|
return self.pop(0) if len(self) else None
|
||||||
|
|
||||||
|
def current(self):
|
||||||
|
return self[0] if len(self) else None
|
||||||
|
|
||||||
|
|
||||||
|
def parse_long(tokens, options):
|
||||||
|
"""long ::= '--' chars [ ( ' ' | '=' ) chars ] ;"""
|
||||||
|
long, eq, value = tokens.move().partition('=')
|
||||||
|
assert long.startswith('--')
|
||||||
|
value = None if eq == value == '' else value
|
||||||
|
similar = [o for o in options if o.long == long]
|
||||||
|
if tokens.error is DocoptExit and similar == []: # if no exact match
|
||||||
|
similar = [o for o in options if o.long and o.long.startswith(long)]
|
||||||
|
if len(similar) > 1: # might be simply specified ambiguously 2+ times?
|
||||||
|
raise tokens.error('%s is not a unique prefix: %s?' %
|
||||||
|
(long, ', '.join(o.long for o in similar)))
|
||||||
|
elif len(similar) < 1:
|
||||||
|
argcount = 1 if eq == '=' else 0
|
||||||
|
o = Option(None, long, argcount)
|
||||||
|
options.append(o)
|
||||||
|
if tokens.error is DocoptExit:
|
||||||
|
o = Option(None, long, argcount, value if argcount else True)
|
||||||
|
else:
|
||||||
|
o = Option(similar[0].short, similar[0].long,
|
||||||
|
similar[0].argcount, similar[0].value)
|
||||||
|
if o.argcount == 0:
|
||||||
|
if value is not None:
|
||||||
|
raise tokens.error('%s must not have an argument' % o.long)
|
||||||
|
else:
|
||||||
|
if value is None:
|
||||||
|
if tokens.current() is None:
|
||||||
|
raise tokens.error('%s requires argument' % o.long)
|
||||||
|
value = tokens.move()
|
||||||
|
if tokens.error is DocoptExit:
|
||||||
|
o.value = value if value is not None else True
|
||||||
|
return [o]
|
||||||
|
|
||||||
|
|
||||||
|
def parse_shorts(tokens, options):
|
||||||
|
"""shorts ::= '-' ( chars )* [ [ ' ' ] chars ] ;"""
|
||||||
|
token = tokens.move()
|
||||||
|
assert token.startswith('-') and not token.startswith('--')
|
||||||
|
left = token.lstrip('-')
|
||||||
|
parsed = []
|
||||||
|
while left != '':
|
||||||
|
short, left = '-' + left[0], left[1:]
|
||||||
|
similar = [o for o in options if o.short == short]
|
||||||
|
if len(similar) > 1:
|
||||||
|
raise tokens.error('%s is specified ambiguously %d times' %
|
||||||
|
(short, len(similar)))
|
||||||
|
elif len(similar) < 1:
|
||||||
|
o = Option(short, None, 0)
|
||||||
|
options.append(o)
|
||||||
|
if tokens.error is DocoptExit:
|
||||||
|
o = Option(short, None, 0, True)
|
||||||
|
else: # why copying is necessary here?
|
||||||
|
o = Option(short, similar[0].long,
|
||||||
|
similar[0].argcount, similar[0].value)
|
||||||
|
value = None
|
||||||
|
if o.argcount != 0:
|
||||||
|
if left == '':
|
||||||
|
if tokens.current() is None:
|
||||||
|
raise tokens.error('%s requires argument' % short)
|
||||||
|
value = tokens.move()
|
||||||
|
else:
|
||||||
|
value = left
|
||||||
|
left = ''
|
||||||
|
if tokens.error is DocoptExit:
|
||||||
|
o.value = value if value is not None else True
|
||||||
|
parsed.append(o)
|
||||||
|
return parsed
|
||||||
|
|
||||||
|
|
||||||
|
def parse_pattern(source, options):
|
||||||
|
tokens = TokenStream(re.sub(r'([\[\]\(\)\|]|\.\.\.)', r' \1 ', source),
|
||||||
|
DocoptLanguageError)
|
||||||
|
result = parse_expr(tokens, options)
|
||||||
|
if tokens.current() is not None:
|
||||||
|
raise tokens.error('unexpected ending: %r' % ' '.join(tokens))
|
||||||
|
return Required(*result)
|
||||||
|
|
||||||
|
|
||||||
|
def parse_expr(tokens, options):
|
||||||
|
"""expr ::= seq ( '|' seq )* ;"""
|
||||||
|
seq = parse_seq(tokens, options)
|
||||||
|
if tokens.current() != '|':
|
||||||
|
return seq
|
||||||
|
result = [Required(*seq)] if len(seq) > 1 else seq
|
||||||
|
while tokens.current() == '|':
|
||||||
|
tokens.move()
|
||||||
|
seq = parse_seq(tokens, options)
|
||||||
|
result += [Required(*seq)] if len(seq) > 1 else seq
|
||||||
|
return [Either(*result)] if len(result) > 1 else result
|
||||||
|
|
||||||
|
|
||||||
|
def parse_seq(tokens, options):
|
||||||
|
"""seq ::= ( atom [ '...' ] )* ;"""
|
||||||
|
result = []
|
||||||
|
while tokens.current() not in [None, ']', ')', '|']:
|
||||||
|
atom = parse_atom(tokens, options)
|
||||||
|
if tokens.current() == '...':
|
||||||
|
atom = [OneOrMore(*atom)]
|
||||||
|
tokens.move()
|
||||||
|
result += atom
|
||||||
|
return result
|
||||||
|
|
||||||
|
|
||||||
|
def parse_atom(tokens, options):
|
||||||
|
"""atom ::= '(' expr ')' | '[' expr ']' | 'options'
|
||||||
|
| long | shorts | argument | command ;
|
||||||
|
"""
|
||||||
|
token = tokens.current()
|
||||||
|
result = []
|
||||||
|
if token in '([':
|
||||||
|
tokens.move()
|
||||||
|
matching, pattern = {'(': [')', Required], '[': [']', Optional]}[token]
|
||||||
|
result = pattern(*parse_expr(tokens, options))
|
||||||
|
if tokens.move() != matching:
|
||||||
|
raise tokens.error("unmatched '%s'" % token)
|
||||||
|
return [result]
|
||||||
|
elif token == 'options':
|
||||||
|
tokens.move()
|
||||||
|
return [AnyOptions()]
|
||||||
|
elif token.startswith('--') and token != '--':
|
||||||
|
return parse_long(tokens, options)
|
||||||
|
elif token.startswith('-') and token not in ('-', '--'):
|
||||||
|
return parse_shorts(tokens, options)
|
||||||
|
elif token.startswith('<') and token.endswith('>') or token.isupper():
|
||||||
|
return [Argument(tokens.move())]
|
||||||
|
else:
|
||||||
|
return [Command(tokens.move())]
|
||||||
|
|
||||||
|
|
||||||
|
def parse_argv(tokens, options, options_first=False):
|
||||||
|
"""Parse command-line argument vector.
|
||||||
|
|
||||||
|
If options_first:
|
||||||
|
argv ::= [ long | shorts ]* [ argument ]* [ '--' [ argument ]* ] ;
|
||||||
|
else:
|
||||||
|
argv ::= [ long | shorts | argument ]* [ '--' [ argument ]* ] ;
|
||||||
|
|
||||||
|
"""
|
||||||
|
parsed = []
|
||||||
|
while tokens.current() is not None:
|
||||||
|
if tokens.current() == '--':
|
||||||
|
return parsed + [Argument(None, v) for v in tokens]
|
||||||
|
elif tokens.current().startswith('--'):
|
||||||
|
parsed += parse_long(tokens, options)
|
||||||
|
elif tokens.current().startswith('-') and tokens.current() != '-':
|
||||||
|
parsed += parse_shorts(tokens, options)
|
||||||
|
elif options_first:
|
||||||
|
return parsed + [Argument(None, v) for v in tokens]
|
||||||
|
else:
|
||||||
|
parsed.append(Argument(None, tokens.move()))
|
||||||
|
return parsed
|
||||||
|
|
||||||
|
|
||||||
|
def parse_defaults(doc):
|
||||||
|
# in python < 2.7 you can't pass flags=re.MULTILINE
|
||||||
|
split = re.split('\n *(<\S+?>|-\S+?)', doc)[1:]
|
||||||
|
split = [s1 + s2 for s1, s2 in zip(split[::2], split[1::2])]
|
||||||
|
options = [Option.parse(s) for s in split if s.startswith('-')]
|
||||||
|
#arguments = [Argument.parse(s) for s in split if s.startswith('<')]
|
||||||
|
#return options, arguments
|
||||||
|
return options
|
||||||
|
|
||||||
|
|
||||||
|
def printable_usage(doc):
|
||||||
|
# in python < 2.7 you can't pass flags=re.IGNORECASE
|
||||||
|
usage_split = re.split(r'([Uu][Ss][Aa][Gg][Ee]:)', doc)
|
||||||
|
if len(usage_split) < 3:
|
||||||
|
raise DocoptLanguageError('"usage:" (case-insensitive) not found.')
|
||||||
|
if len(usage_split) > 3:
|
||||||
|
raise DocoptLanguageError('More than one "usage:" (case-insensitive).')
|
||||||
|
return re.split(r'\n\s*\n', ''.join(usage_split[1:]))[0].strip()
|
||||||
|
|
||||||
|
|
||||||
|
def formal_usage(printable_usage):
|
||||||
|
pu = printable_usage.split()[1:] # split and drop "usage:"
|
||||||
|
return '( ' + ' '.join(') | (' if s == pu[0] else s for s in pu[1:]) + ' )'
|
||||||
|
|
||||||
|
|
||||||
|
def extras(help, version, options, doc):
|
||||||
|
if help and any((o.name in ('-h', '--help')) and o.value for o in options):
|
||||||
|
print(doc.strip("\n"))
|
||||||
|
sys.exit()
|
||||||
|
if version and any(o.name == '--version' and o.value for o in options):
|
||||||
|
print(version)
|
||||||
|
sys.exit()
|
||||||
|
|
||||||
|
|
||||||
|
class Dict(dict):
|
||||||
|
def __repr__(self):
|
||||||
|
return '{%s}' % ',\n '.join('%r: %r' % i for i in sorted(self.items()))
|
||||||
|
|
||||||
|
|
||||||
|
def docopt(doc, argv=None, help=True, version=None, options_first=False):
|
||||||
|
"""Parse `argv` based on command-line interface described in `doc`.
|
||||||
|
|
||||||
|
`docopt` creates your command-line interface based on its
|
||||||
|
description that you pass as `doc`. Such description can contain
|
||||||
|
--options, <positional-argument>, commands, which could be
|
||||||
|
[optional], (required), (mutually | exclusive) or repeated...
|
||||||
|
|
||||||
|
Parameters
|
||||||
|
----------
|
||||||
|
doc : str
|
||||||
|
Description of your command-line interface.
|
||||||
|
argv : list of str, optional
|
||||||
|
Argument vector to be parsed. sys.argv[1:] is used if not
|
||||||
|
provided.
|
||||||
|
help : bool (default: True)
|
||||||
|
Set to False to disable automatic help on -h or --help
|
||||||
|
options.
|
||||||
|
version : any object
|
||||||
|
If passed, the object will be printed if --version is in
|
||||||
|
`argv`.
|
||||||
|
options_first : bool (default: False)
|
||||||
|
Set to True to require options preceed positional arguments,
|
||||||
|
i.e. to forbid options and positional arguments intermix.
|
||||||
|
|
||||||
|
Returns
|
||||||
|
-------
|
||||||
|
args : dict
|
||||||
|
A dictionary, where keys are names of command-line elements
|
||||||
|
such as e.g. "--verbose" and "<path>", and values are the
|
||||||
|
parsed values of those elements.
|
||||||
|
|
||||||
|
Example
|
||||||
|
-------
|
||||||
|
>>> from docopt import docopt
|
||||||
|
>>> doc = '''
|
||||||
|
Usage:
|
||||||
|
my_program tcp <host> <port> [--timeout=<seconds>]
|
||||||
|
my_program serial <port> [--baud=<n>] [--timeout=<seconds>]
|
||||||
|
my_program (-h | --help | --version)
|
||||||
|
|
||||||
|
Options:
|
||||||
|
-h, --help Show this screen and exit.
|
||||||
|
--baud=<n> Baudrate [default: 9600]
|
||||||
|
'''
|
||||||
|
>>> argv = ['tcp', '127.0.0.1', '80', '--timeout', '30']
|
||||||
|
>>> docopt(doc, argv)
|
||||||
|
{'--baud': '9600',
|
||||||
|
'--help': False,
|
||||||
|
'--timeout': '30',
|
||||||
|
'--version': False,
|
||||||
|
'<host>': '127.0.0.1',
|
||||||
|
'<port>': '80',
|
||||||
|
'serial': False,
|
||||||
|
'tcp': True}
|
||||||
|
|
||||||
|
See also
|
||||||
|
--------
|
||||||
|
* For video introduction see http://docopt.org
|
||||||
|
* Full documentation is available in README.rst as well as online
|
||||||
|
at https://github.com/docopt/docopt#readme
|
||||||
|
|
||||||
|
"""
|
||||||
|
if argv is None:
|
||||||
|
argv = sys.argv[1:]
|
||||||
|
DocoptExit.usage = printable_usage(doc)
|
||||||
|
options = parse_defaults(doc)
|
||||||
|
pattern = parse_pattern(formal_usage(DocoptExit.usage), options)
|
||||||
|
# [default] syntax for argument is disabled
|
||||||
|
#for a in pattern.flat(Argument):
|
||||||
|
# same_name = [d for d in arguments if d.name == a.name]
|
||||||
|
# if same_name:
|
||||||
|
# a.value = same_name[0].value
|
||||||
|
argv = parse_argv(TokenStream(argv, DocoptExit), list(options),
|
||||||
|
options_first)
|
||||||
|
pattern_options = set(pattern.flat(Option))
|
||||||
|
for ao in pattern.flat(AnyOptions):
|
||||||
|
doc_options = parse_defaults(doc)
|
||||||
|
ao.children = list(set(doc_options) - pattern_options)
|
||||||
|
#if any_options:
|
||||||
|
# ao.children += [Option(o.short, o.long, o.argcount)
|
||||||
|
# for o in argv if type(o) is Option]
|
||||||
|
extras(help, version, argv, doc)
|
||||||
|
matched, left, collected = pattern.fix().match(argv)
|
||||||
|
if matched and left == []: # better error message if left?
|
||||||
|
return Dict((a.name, a.value) for a in (pattern.flat() + collected))
|
||||||
|
raise DocoptExit()
|
2
external/qp2-dependencies
vendored
2
external/qp2-dependencies
vendored
@ -1 +1 @@
|
|||||||
Subproject commit 90ee61f5041c7c94a0c605625a264860292813a0
|
Subproject commit 242151e03d1d6bf042387226431d82d35845686a
|
617
include/f77_zmq.h
Normal file
617
include/f77_zmq.h
Normal file
@ -0,0 +1,617 @@
|
|||||||
|
integer EADDRINUSE
|
||||||
|
integer EADDRNOTAVAIL
|
||||||
|
integer EAFNOSUPPORT
|
||||||
|
integer ECONNABORTED
|
||||||
|
integer ECONNREFUSED
|
||||||
|
integer ECONNRESET
|
||||||
|
integer EFSM
|
||||||
|
integer EHOSTUNREACH
|
||||||
|
integer EINPROGRESS
|
||||||
|
integer EMSGSIZE
|
||||||
|
integer EMTHREAD
|
||||||
|
integer ENETDOWN
|
||||||
|
integer ENETRESET
|
||||||
|
integer ENETUNREACH
|
||||||
|
integer ENOBUFS
|
||||||
|
integer ENOCOMPATPROTO
|
||||||
|
integer ENOTCONN
|
||||||
|
integer ENOTSOCK
|
||||||
|
integer ENOTSUP
|
||||||
|
integer EPROTONOSUPPORT
|
||||||
|
integer ETERM
|
||||||
|
integer ETIMEDOUT
|
||||||
|
integer ZMQ_AFFINITY
|
||||||
|
integer ZMQ_BACKLOG
|
||||||
|
integer ZMQ_BINDTODEVICE
|
||||||
|
integer ZMQ_BLOCKY
|
||||||
|
integer ZMQ_CHANNEL
|
||||||
|
integer ZMQ_CLIENT
|
||||||
|
integer ZMQ_CONFLATE
|
||||||
|
integer ZMQ_CONNECT_RID
|
||||||
|
integer ZMQ_CONNECT_ROUTING_ID
|
||||||
|
integer ZMQ_CONNECT_TIMEOUT
|
||||||
|
integer ZMQ_CURRENT_EVENT_VERSION
|
||||||
|
integer ZMQ_CURRENT_EVENT_VERSION_DRAFT
|
||||||
|
integer ZMQ_CURVE
|
||||||
|
integer ZMQ_CURVE_PUBLICKEY
|
||||||
|
integer ZMQ_CURVE_SECRETKEY
|
||||||
|
integer ZMQ_CURVE_SERVER
|
||||||
|
integer ZMQ_CURVE_SERVERKEY
|
||||||
|
integer ZMQ_DEALER
|
||||||
|
integer ZMQ_DEFINED_STDINT
|
||||||
|
integer ZMQ_DELAY_ATTACH_ON_CONNECT
|
||||||
|
integer ZMQ_DGRAM
|
||||||
|
integer ZMQ_DISCONNECT_MSG
|
||||||
|
integer ZMQ_DISH
|
||||||
|
integer ZMQ_DONTWAIT
|
||||||
|
integer ZMQ_EVENTS
|
||||||
|
integer ZMQ_EVENT_ACCEPTED
|
||||||
|
integer ZMQ_EVENT_ACCEPT_FAILED
|
||||||
|
integer ZMQ_EVENT_ALL
|
||||||
|
integer ZMQ_EVENT_ALL_V1
|
||||||
|
integer ZMQ_EVENT_ALL_V2
|
||||||
|
integer ZMQ_EVENT_BIND_FAILED
|
||||||
|
integer ZMQ_EVENT_CLOSED
|
||||||
|
integer ZMQ_EVENT_CLOSE_FAILED
|
||||||
|
integer ZMQ_EVENT_CONNECTED
|
||||||
|
integer ZMQ_EVENT_CONNECT_DELAYED
|
||||||
|
integer ZMQ_EVENT_CONNECT_RETRIED
|
||||||
|
integer ZMQ_EVENT_DISCONNECTED
|
||||||
|
integer ZMQ_EVENT_HANDSHAKE_FAILED_AUTH
|
||||||
|
integer ZMQ_EVENT_HANDSHAKE_FAILED_NO_DETAIL
|
||||||
|
integer ZMQ_EVENT_HANDSHAKE_FAILED_PROTOCOL
|
||||||
|
integer ZMQ_EVENT_HANDSHAKE_SUCCEEDED
|
||||||
|
integer ZMQ_EVENT_LISTENING
|
||||||
|
integer ZMQ_EVENT_MONITOR_STOPPED
|
||||||
|
integer ZMQ_EVENT_PIPES_STATS
|
||||||
|
integer ZMQ_FAIL_UNROUTABLE
|
||||||
|
integer ZMQ_FD
|
||||||
|
integer ZMQ_FORWARDER
|
||||||
|
integer ZMQ_GATHER
|
||||||
|
integer ZMQ_GROUP_MAX_LENGTH
|
||||||
|
integer ZMQ_GSSAPI
|
||||||
|
integer ZMQ_GSSAPI_NT_HOSTBASED
|
||||||
|
integer ZMQ_GSSAPI_NT_KRB5_PRINCIPAL
|
||||||
|
integer ZMQ_GSSAPI_NT_USER_NAME
|
||||||
|
integer ZMQ_GSSAPI_PLAINTEXT
|
||||||
|
integer ZMQ_GSSAPI_PRINCIPAL
|
||||||
|
integer ZMQ_GSSAPI_PRINCIPAL_NAMETYPE
|
||||||
|
integer ZMQ_GSSAPI_SERVER
|
||||||
|
integer ZMQ_GSSAPI_SERVICE_PRINCIPAL
|
||||||
|
integer ZMQ_GSSAPI_SERVICE_PRINCIPAL_NAMETYPE
|
||||||
|
integer ZMQ_HANDSHAKE_IVL
|
||||||
|
integer ZMQ_HAS_CAPABILITIES
|
||||||
|
integer ZMQ_HAUSNUMERO
|
||||||
|
integer ZMQ_HEARTBEAT_IVL
|
||||||
|
integer ZMQ_HEARTBEAT_TIMEOUT
|
||||||
|
integer ZMQ_HEARTBEAT_TTL
|
||||||
|
integer ZMQ_HELLO_MSG
|
||||||
|
integer ZMQ_IDENTITY
|
||||||
|
integer ZMQ_IMMEDIATE
|
||||||
|
integer ZMQ_INVERT_MATCHING
|
||||||
|
integer ZMQ_IN_BATCH_SIZE
|
||||||
|
integer ZMQ_IO_THREADS
|
||||||
|
integer ZMQ_IO_THREADS_DFLT
|
||||||
|
integer ZMQ_IPC_FILTER_GID
|
||||||
|
integer ZMQ_IPC_FILTER_PID
|
||||||
|
integer ZMQ_IPC_FILTER_UID
|
||||||
|
integer ZMQ_IPV4ONLY
|
||||||
|
integer ZMQ_IPV6
|
||||||
|
integer ZMQ_LAST_ENDPOINT
|
||||||
|
integer ZMQ_LINGER
|
||||||
|
integer ZMQ_LOOPBACK_FASTPATH
|
||||||
|
integer ZMQ_MAXMSGSIZE
|
||||||
|
integer ZMQ_MAX_MSGSZ
|
||||||
|
integer ZMQ_MAX_SOCKETS
|
||||||
|
integer ZMQ_MAX_SOCKETS_DFLT
|
||||||
|
integer ZMQ_MECHANISM
|
||||||
|
integer ZMQ_METADATA
|
||||||
|
integer ZMQ_MORE
|
||||||
|
integer ZMQ_MSG_T_SIZE
|
||||||
|
integer ZMQ_MULTICAST_HOPS
|
||||||
|
integer ZMQ_MULTICAST_LOOP
|
||||||
|
integer ZMQ_MULTICAST_MAXTPDU
|
||||||
|
integer ZMQ_NOBLOCK
|
||||||
|
integer ZMQ_NOTIFY_CONNECT
|
||||||
|
integer ZMQ_NOTIFY_DISCONNECT
|
||||||
|
integer ZMQ_NULL
|
||||||
|
integer ZMQ_ONLY_FIRST_SUBSCRIBE
|
||||||
|
integer ZMQ_OUT_BATCH_SIZE
|
||||||
|
integer ZMQ_PAIR
|
||||||
|
integer ZMQ_PEER
|
||||||
|
integer ZMQ_PLAIN
|
||||||
|
integer ZMQ_PLAIN_PASSWORD
|
||||||
|
integer ZMQ_PLAIN_SERVER
|
||||||
|
integer ZMQ_PLAIN_USERNAME
|
||||||
|
integer ZMQ_POLLERR
|
||||||
|
integer ZMQ_POLLIN
|
||||||
|
integer ZMQ_POLLITEMS_DFLT
|
||||||
|
integer ZMQ_POLLOUT
|
||||||
|
integer ZMQ_POLLPRI
|
||||||
|
integer ZMQ_PRIORITY
|
||||||
|
integer ZMQ_PROBE_ROUTER
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_WS_UNSPECIFIED
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZAP_BAD_REQUEST_ID
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZAP_BAD_VERSION
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZAP_INVALID_METADATA
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZAP_INVALID_STATUS_CODE
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZAP_MALFORMED_REPLY
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZAP_UNSPECIFIED
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_CRYPTOGRAPHIC
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_METADATA
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_SEQUENCE
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_KEY_EXCHANGE
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_ERROR
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_HELLO
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_INITIATE
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_MESSAGE
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_READY
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_UNSPECIFIED
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_WELCOME
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_MECHANISM_MISMATCH
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_UNEXPECTED_COMMAND
|
||||||
|
integer ZMQ_PROTOCOL_ERROR_ZMTP_UNSPECIFIED
|
||||||
|
integer ZMQ_PTR
|
||||||
|
integer ZMQ_PUB
|
||||||
|
integer ZMQ_PULL
|
||||||
|
integer ZMQ_PUSH
|
||||||
|
integer ZMQ_QUEUE
|
||||||
|
integer ZMQ_RADIO
|
||||||
|
integer ZMQ_RATE
|
||||||
|
integer ZMQ_RCVBUF
|
||||||
|
integer ZMQ_RCVHWM
|
||||||
|
integer ZMQ_RCVMORE
|
||||||
|
integer ZMQ_RCVTIMEO
|
||||||
|
integer ZMQ_RECONNECT_IVL
|
||||||
|
integer ZMQ_RECONNECT_IVL_MAX
|
||||||
|
integer ZMQ_RECONNECT_STOP
|
||||||
|
integer ZMQ_RECONNECT_STOP_AFTER_DISCONNECT
|
||||||
|
integer ZMQ_RECONNECT_STOP_CONN_REFUSED
|
||||||
|
integer ZMQ_RECONNECT_STOP_HANDSHAKE_FAILED
|
||||||
|
integer ZMQ_RECOVERY_IVL
|
||||||
|
integer ZMQ_REP
|
||||||
|
integer ZMQ_REQ
|
||||||
|
integer ZMQ_REQ_CORRELATE
|
||||||
|
integer ZMQ_REQ_RELAXED
|
||||||
|
integer ZMQ_ROUTER
|
||||||
|
integer ZMQ_ROUTER_BEHAVIOR
|
||||||
|
integer ZMQ_ROUTER_HANDOVER
|
||||||
|
integer ZMQ_ROUTER_MANDATORY
|
||||||
|
integer ZMQ_ROUTER_NOTIFY
|
||||||
|
integer ZMQ_ROUTER_RAW
|
||||||
|
integer ZMQ_ROUTING_ID
|
||||||
|
integer ZMQ_SCATTER
|
||||||
|
integer ZMQ_SERVER
|
||||||
|
integer ZMQ_SHARED
|
||||||
|
integer ZMQ_SNDBUF
|
||||||
|
integer ZMQ_SNDHWM
|
||||||
|
integer ZMQ_SNDMORE
|
||||||
|
integer ZMQ_SNDTIMEO
|
||||||
|
integer ZMQ_SOCKET_LIMIT
|
||||||
|
integer ZMQ_SOCKS_PASSWORD
|
||||||
|
integer ZMQ_SOCKS_PROXY
|
||||||
|
integer ZMQ_SOCKS_USERNAME
|
||||||
|
integer ZMQ_SRCFD
|
||||||
|
integer ZMQ_STREAM
|
||||||
|
integer ZMQ_STREAMER
|
||||||
|
integer ZMQ_STREAM_NOTIFY
|
||||||
|
integer ZMQ_SUB
|
||||||
|
integer ZMQ_SUBSCRIBE
|
||||||
|
integer ZMQ_TCP_ACCEPT_FILTER
|
||||||
|
integer ZMQ_TCP_KEEPALIVE
|
||||||
|
integer ZMQ_TCP_KEEPALIVE_CNT
|
||||||
|
integer ZMQ_TCP_KEEPALIVE_IDLE
|
||||||
|
integer ZMQ_TCP_KEEPALIVE_INTVL
|
||||||
|
integer ZMQ_TCP_MAXRT
|
||||||
|
integer ZMQ_THREAD_AFFINITY_CPU_ADD
|
||||||
|
integer ZMQ_THREAD_AFFINITY_CPU_REMOVE
|
||||||
|
integer ZMQ_THREAD_NAME_PREFIX
|
||||||
|
integer ZMQ_THREAD_PRIORITY
|
||||||
|
integer ZMQ_THREAD_PRIORITY_DFLT
|
||||||
|
integer ZMQ_THREAD_SAFE
|
||||||
|
integer ZMQ_THREAD_SCHED_POLICY
|
||||||
|
integer ZMQ_THREAD_SCHED_POLICY_DFLT
|
||||||
|
integer ZMQ_TOS
|
||||||
|
integer ZMQ_TYPE
|
||||||
|
integer ZMQ_UNSUBSCRIBE
|
||||||
|
integer ZMQ_USE_FD
|
||||||
|
integer ZMQ_VERSION
|
||||||
|
integer ZMQ_VERSION_MAJOR
|
||||||
|
integer ZMQ_VERSION_MINOR
|
||||||
|
integer ZMQ_VERSION_PATCH
|
||||||
|
integer ZMQ_VMCI_BUFFER_MAX_SIZE
|
||||||
|
integer ZMQ_VMCI_BUFFER_MIN_SIZE
|
||||||
|
integer ZMQ_VMCI_BUFFER_SIZE
|
||||||
|
integer ZMQ_VMCI_CONNECT_TIMEOUT
|
||||||
|
integer ZMQ_WSS_CERT_PEM
|
||||||
|
integer ZMQ_WSS_HOSTNAME
|
||||||
|
integer ZMQ_WSS_KEY_PEM
|
||||||
|
integer ZMQ_WSS_TRUST_PEM
|
||||||
|
integer ZMQ_WSS_TRUST_SYSTEM
|
||||||
|
integer ZMQ_XPUB
|
||||||
|
integer ZMQ_XPUB_MANUAL
|
||||||
|
integer ZMQ_XPUB_MANUAL_LAST_VALUE
|
||||||
|
integer ZMQ_XPUB_NODROP
|
||||||
|
integer ZMQ_XPUB_VERBOSE
|
||||||
|
integer ZMQ_XPUB_VERBOSER
|
||||||
|
integer ZMQ_XPUB_WELCOME_MSG
|
||||||
|
integer ZMQ_XREP
|
||||||
|
integer ZMQ_XREQ
|
||||||
|
integer ZMQ_XSUB
|
||||||
|
integer ZMQ_ZAP_DOMAIN
|
||||||
|
integer ZMQ_ZAP_ENFORCE_DOMAIN
|
||||||
|
integer ZMQ_ZERO_COPY_RECV
|
||||||
|
parameter(EADDRINUSE=156384717)
|
||||||
|
parameter(EADDRNOTAVAIL=156384718)
|
||||||
|
parameter(EAFNOSUPPORT=156384723)
|
||||||
|
parameter(ECONNABORTED=156384725)
|
||||||
|
parameter(ECONNREFUSED=156384719)
|
||||||
|
parameter(ECONNRESET=156384726)
|
||||||
|
parameter(EFSM=156384763)
|
||||||
|
parameter(EHOSTUNREACH=156384729)
|
||||||
|
parameter(EINPROGRESS=156384720)
|
||||||
|
parameter(EMSGSIZE=156384722)
|
||||||
|
parameter(EMTHREAD=156384766)
|
||||||
|
parameter(ENETDOWN=156384716)
|
||||||
|
parameter(ENETRESET=156384730)
|
||||||
|
parameter(ENETUNREACH=156384724)
|
||||||
|
parameter(ENOBUFS=156384715)
|
||||||
|
parameter(ENOCOMPATPROTO=156384764)
|
||||||
|
parameter(ENOTCONN=156384727)
|
||||||
|
parameter(ENOTSOCK=156384721)
|
||||||
|
parameter(ENOTSUP=156384713)
|
||||||
|
parameter(EPROTONOSUPPORT=156384714)
|
||||||
|
parameter(ETERM=156384765)
|
||||||
|
parameter(ETIMEDOUT=156384728)
|
||||||
|
parameter(ZMQ_AFFINITY=4)
|
||||||
|
parameter(ZMQ_BACKLOG=19)
|
||||||
|
parameter(ZMQ_BINDTODEVICE=92)
|
||||||
|
parameter(ZMQ_BLOCKY=70)
|
||||||
|
parameter(ZMQ_CHANNEL=20)
|
||||||
|
parameter(ZMQ_CLIENT=13)
|
||||||
|
parameter(ZMQ_CONFLATE=54)
|
||||||
|
parameter(ZMQ_CONNECT_RID=61)
|
||||||
|
parameter(ZMQ_CONNECT_ROUTING_ID=61)
|
||||||
|
parameter(ZMQ_CONNECT_TIMEOUT=79)
|
||||||
|
parameter(ZMQ_CURRENT_EVENT_VERSION=1)
|
||||||
|
parameter(ZMQ_CURRENT_EVENT_VERSION_DRAFT=2)
|
||||||
|
parameter(ZMQ_CURVE=2)
|
||||||
|
parameter(ZMQ_CURVE_PUBLICKEY=48)
|
||||||
|
parameter(ZMQ_CURVE_SECRETKEY=49)
|
||||||
|
parameter(ZMQ_CURVE_SERVER=47)
|
||||||
|
parameter(ZMQ_CURVE_SERVERKEY=50)
|
||||||
|
parameter(ZMQ_DEALER=5)
|
||||||
|
parameter(ZMQ_DEFINED_STDINT=1)
|
||||||
|
parameter(ZMQ_DELAY_ATTACH_ON_CONNECT=39)
|
||||||
|
parameter(ZMQ_DGRAM=18)
|
||||||
|
parameter(ZMQ_DISCONNECT_MSG=111)
|
||||||
|
parameter(ZMQ_DISH=15)
|
||||||
|
parameter(ZMQ_DONTWAIT=1)
|
||||||
|
parameter(ZMQ_EVENTS=15)
|
||||||
|
parameter(ZMQ_EVENT_ACCEPTED=32)
|
||||||
|
parameter(ZMQ_EVENT_ACCEPT_FAILED=64)
|
||||||
|
parameter(ZMQ_EVENT_ALL=65535)
|
||||||
|
parameter(ZMQ_EVENT_ALL_V1=65535)
|
||||||
|
parameter(ZMQ_EVENT_ALL_V2=131071)
|
||||||
|
parameter(ZMQ_EVENT_BIND_FAILED=16)
|
||||||
|
parameter(ZMQ_EVENT_CLOSED=128)
|
||||||
|
parameter(ZMQ_EVENT_CLOSE_FAILED=256)
|
||||||
|
parameter(ZMQ_EVENT_CONNECTED=1)
|
||||||
|
parameter(ZMQ_EVENT_CONNECT_DELAYED=2)
|
||||||
|
parameter(ZMQ_EVENT_CONNECT_RETRIED=4)
|
||||||
|
parameter(ZMQ_EVENT_DISCONNECTED=512)
|
||||||
|
parameter(ZMQ_EVENT_HANDSHAKE_FAILED_AUTH=16384)
|
||||||
|
parameter(ZMQ_EVENT_HANDSHAKE_FAILED_NO_DETAIL=2048)
|
||||||
|
parameter(ZMQ_EVENT_HANDSHAKE_FAILED_PROTOCOL=8192)
|
||||||
|
parameter(ZMQ_EVENT_HANDSHAKE_SUCCEEDED=4096)
|
||||||
|
parameter(ZMQ_EVENT_LISTENING=8)
|
||||||
|
parameter(ZMQ_EVENT_MONITOR_STOPPED=1024)
|
||||||
|
parameter(ZMQ_EVENT_PIPES_STATS=65536)
|
||||||
|
parameter(ZMQ_FAIL_UNROUTABLE=33)
|
||||||
|
parameter(ZMQ_FD=14)
|
||||||
|
parameter(ZMQ_FORWARDER=2)
|
||||||
|
parameter(ZMQ_GATHER=16)
|
||||||
|
parameter(ZMQ_GROUP_MAX_LENGTH=255)
|
||||||
|
parameter(ZMQ_GSSAPI=3)
|
||||||
|
parameter(ZMQ_GSSAPI_NT_HOSTBASED=0)
|
||||||
|
parameter(ZMQ_GSSAPI_NT_KRB5_PRINCIPAL=2)
|
||||||
|
parameter(ZMQ_GSSAPI_NT_USER_NAME=1)
|
||||||
|
parameter(ZMQ_GSSAPI_PLAINTEXT=65)
|
||||||
|
parameter(ZMQ_GSSAPI_PRINCIPAL=63)
|
||||||
|
parameter(ZMQ_GSSAPI_PRINCIPAL_NAMETYPE=90)
|
||||||
|
parameter(ZMQ_GSSAPI_SERVER=62)
|
||||||
|
parameter(ZMQ_GSSAPI_SERVICE_PRINCIPAL=64)
|
||||||
|
parameter(ZMQ_GSSAPI_SERVICE_PRINCIPAL_NAMETYPE=91)
|
||||||
|
parameter(ZMQ_HANDSHAKE_IVL=66)
|
||||||
|
parameter(ZMQ_HAS_CAPABILITIES=1)
|
||||||
|
parameter(ZMQ_HAUSNUMERO=156384712)
|
||||||
|
parameter(ZMQ_HEARTBEAT_IVL=75)
|
||||||
|
parameter(ZMQ_HEARTBEAT_TIMEOUT=77)
|
||||||
|
parameter(ZMQ_HEARTBEAT_TTL=76)
|
||||||
|
parameter(ZMQ_HELLO_MSG=110)
|
||||||
|
parameter(ZMQ_IDENTITY=5)
|
||||||
|
parameter(ZMQ_IMMEDIATE=39)
|
||||||
|
parameter(ZMQ_INVERT_MATCHING=74)
|
||||||
|
parameter(ZMQ_IN_BATCH_SIZE=101)
|
||||||
|
parameter(ZMQ_IO_THREADS=1)
|
||||||
|
parameter(ZMQ_IO_THREADS_DFLT=1)
|
||||||
|
parameter(ZMQ_IPC_FILTER_GID=60)
|
||||||
|
parameter(ZMQ_IPC_FILTER_PID=58)
|
||||||
|
parameter(ZMQ_IPC_FILTER_UID=59)
|
||||||
|
parameter(ZMQ_IPV4ONLY=31)
|
||||||
|
parameter(ZMQ_IPV6=42)
|
||||||
|
parameter(ZMQ_LAST_ENDPOINT=32)
|
||||||
|
parameter(ZMQ_LINGER=17)
|
||||||
|
parameter(ZMQ_LOOPBACK_FASTPATH=94)
|
||||||
|
parameter(ZMQ_MAXMSGSIZE=22)
|
||||||
|
parameter(ZMQ_MAX_MSGSZ=5)
|
||||||
|
parameter(ZMQ_MAX_SOCKETS=2)
|
||||||
|
parameter(ZMQ_MAX_SOCKETS_DFLT=1023)
|
||||||
|
parameter(ZMQ_MECHANISM=43)
|
||||||
|
parameter(ZMQ_METADATA=95)
|
||||||
|
parameter(ZMQ_MORE=1)
|
||||||
|
parameter(ZMQ_MSG_T_SIZE=6)
|
||||||
|
parameter(ZMQ_MULTICAST_HOPS=25)
|
||||||
|
parameter(ZMQ_MULTICAST_LOOP=96)
|
||||||
|
parameter(ZMQ_MULTICAST_MAXTPDU=84)
|
||||||
|
parameter(ZMQ_NOBLOCK=1)
|
||||||
|
parameter(ZMQ_NOTIFY_CONNECT=1)
|
||||||
|
parameter(ZMQ_NOTIFY_DISCONNECT=2)
|
||||||
|
parameter(ZMQ_NULL=0)
|
||||||
|
parameter(ZMQ_ONLY_FIRST_SUBSCRIBE=108)
|
||||||
|
parameter(ZMQ_OUT_BATCH_SIZE=102)
|
||||||
|
parameter(ZMQ_PAIR=0)
|
||||||
|
parameter(ZMQ_PEER=19)
|
||||||
|
parameter(ZMQ_PLAIN=1)
|
||||||
|
parameter(ZMQ_PLAIN_PASSWORD=46)
|
||||||
|
parameter(ZMQ_PLAIN_SERVER=44)
|
||||||
|
parameter(ZMQ_PLAIN_USERNAME=45)
|
||||||
|
parameter(ZMQ_POLLERR=4)
|
||||||
|
parameter(ZMQ_POLLIN=1)
|
||||||
|
parameter(ZMQ_POLLITEMS_DFLT=16)
|
||||||
|
parameter(ZMQ_POLLOUT=2)
|
||||||
|
parameter(ZMQ_POLLPRI=8)
|
||||||
|
parameter(ZMQ_PRIORITY=112)
|
||||||
|
parameter(ZMQ_PROBE_ROUTER=51)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_WS_UNSPECIFIED=805306368)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZAP_BAD_REQUEST_ID=536870914)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZAP_BAD_VERSION=536870915)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZAP_INVALID_METADATA=536870917)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZAP_INVALID_STATUS_CODE=536870916)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZAP_MALFORMED_REPLY=536870913)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZAP_UNSPECIFIED=536870912)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZMTP_CRYPTOGRAPHIC=285212673)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_METADATA=268435480)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_SEQUENCE=268435458)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZMTP_KEY_EXCHANGE=268435459)
|
||||||
|
parameter(
|
||||||
|
& ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_ERROR=268435477)
|
||||||
|
parameter(
|
||||||
|
& ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_HELLO=268435475)
|
||||||
|
parameter(
|
||||||
|
& ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_INITIATE=268435476)
|
||||||
|
parameter(
|
||||||
|
& ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_MESSAGE=268435474)
|
||||||
|
parameter(
|
||||||
|
& ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_READY=268435478)
|
||||||
|
parameter(
|
||||||
|
& ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_UNSPECIFIED=268435473)
|
||||||
|
parameter(
|
||||||
|
& ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_WELCOME=268435479)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZMTP_MECHANISM_MISMATCH=285212674)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZMTP_UNEXPECTED_COMMAND=268435457)
|
||||||
|
parameter(ZMQ_PROTOCOL_ERROR_ZMTP_UNSPECIFIED=268435456)
|
||||||
|
parameter(ZMQ_PTR=8)
|
||||||
|
parameter(ZMQ_PUB=1)
|
||||||
|
parameter(ZMQ_PULL=7)
|
||||||
|
parameter(ZMQ_PUSH=8)
|
||||||
|
parameter(ZMQ_QUEUE=3)
|
||||||
|
parameter(ZMQ_RADIO=14)
|
||||||
|
parameter(ZMQ_RATE=8)
|
||||||
|
parameter(ZMQ_RCVBUF=12)
|
||||||
|
parameter(ZMQ_RCVHWM=24)
|
||||||
|
parameter(ZMQ_RCVMORE=13)
|
||||||
|
parameter(ZMQ_RCVTIMEO=27)
|
||||||
|
parameter(ZMQ_RECONNECT_IVL=18)
|
||||||
|
parameter(ZMQ_RECONNECT_IVL_MAX=21)
|
||||||
|
parameter(ZMQ_RECONNECT_STOP=109)
|
||||||
|
parameter(ZMQ_RECONNECT_STOP_AFTER_DISCONNECT=3)
|
||||||
|
parameter(ZMQ_RECONNECT_STOP_CONN_REFUSED=1)
|
||||||
|
parameter(ZMQ_RECONNECT_STOP_HANDSHAKE_FAILED=2)
|
||||||
|
parameter(ZMQ_RECOVERY_IVL=9)
|
||||||
|
parameter(ZMQ_REP=4)
|
||||||
|
parameter(ZMQ_REQ=3)
|
||||||
|
parameter(ZMQ_REQ_CORRELATE=52)
|
||||||
|
parameter(ZMQ_REQ_RELAXED=53)
|
||||||
|
parameter(ZMQ_ROUTER=6)
|
||||||
|
parameter(ZMQ_ROUTER_BEHAVIOR=33)
|
||||||
|
parameter(ZMQ_ROUTER_HANDOVER=56)
|
||||||
|
parameter(ZMQ_ROUTER_MANDATORY=33)
|
||||||
|
parameter(ZMQ_ROUTER_NOTIFY=97)
|
||||||
|
parameter(ZMQ_ROUTER_RAW=41)
|
||||||
|
parameter(ZMQ_ROUTING_ID=5)
|
||||||
|
parameter(ZMQ_SCATTER=17)
|
||||||
|
parameter(ZMQ_SERVER=12)
|
||||||
|
parameter(ZMQ_SHARED=3)
|
||||||
|
parameter(ZMQ_SNDBUF=11)
|
||||||
|
parameter(ZMQ_SNDHWM=23)
|
||||||
|
parameter(ZMQ_SNDMORE=2)
|
||||||
|
parameter(ZMQ_SNDTIMEO=28)
|
||||||
|
parameter(ZMQ_SOCKET_LIMIT=3)
|
||||||
|
parameter(ZMQ_SOCKS_PASSWORD=100)
|
||||||
|
parameter(ZMQ_SOCKS_PROXY=68)
|
||||||
|
parameter(ZMQ_SOCKS_USERNAME=99)
|
||||||
|
parameter(ZMQ_SRCFD=2)
|
||||||
|
parameter(ZMQ_STREAM=11)
|
||||||
|
parameter(ZMQ_STREAMER=1)
|
||||||
|
parameter(ZMQ_STREAM_NOTIFY=73)
|
||||||
|
parameter(ZMQ_SUB=2)
|
||||||
|
parameter(ZMQ_SUBSCRIBE=6)
|
||||||
|
parameter(ZMQ_TCP_ACCEPT_FILTER=38)
|
||||||
|
parameter(ZMQ_TCP_KEEPALIVE=34)
|
||||||
|
parameter(ZMQ_TCP_KEEPALIVE_CNT=35)
|
||||||
|
parameter(ZMQ_TCP_KEEPALIVE_IDLE=36)
|
||||||
|
parameter(ZMQ_TCP_KEEPALIVE_INTVL=37)
|
||||||
|
parameter(ZMQ_TCP_MAXRT=80)
|
||||||
|
parameter(ZMQ_THREAD_AFFINITY_CPU_ADD=7)
|
||||||
|
parameter(ZMQ_THREAD_AFFINITY_CPU_REMOVE=8)
|
||||||
|
parameter(ZMQ_THREAD_NAME_PREFIX=9)
|
||||||
|
parameter(ZMQ_THREAD_PRIORITY=3)
|
||||||
|
parameter(ZMQ_THREAD_PRIORITY_DFLT=-1)
|
||||||
|
parameter(ZMQ_THREAD_SAFE=81)
|
||||||
|
parameter(ZMQ_THREAD_SCHED_POLICY=4)
|
||||||
|
parameter(ZMQ_THREAD_SCHED_POLICY_DFLT=-1)
|
||||||
|
parameter(ZMQ_TOS=57)
|
||||||
|
parameter(ZMQ_TYPE=16)
|
||||||
|
parameter(ZMQ_UNSUBSCRIBE=7)
|
||||||
|
parameter(ZMQ_USE_FD=89)
|
||||||
|
parameter(ZMQ_VERSION=40304)
|
||||||
|
parameter(ZMQ_VERSION_MAJOR=4)
|
||||||
|
parameter(ZMQ_VERSION_MINOR=3)
|
||||||
|
parameter(ZMQ_VERSION_PATCH=4)
|
||||||
|
parameter(ZMQ_VMCI_BUFFER_MAX_SIZE=87)
|
||||||
|
parameter(ZMQ_VMCI_BUFFER_MIN_SIZE=86)
|
||||||
|
parameter(ZMQ_VMCI_BUFFER_SIZE=85)
|
||||||
|
parameter(ZMQ_VMCI_CONNECT_TIMEOUT=88)
|
||||||
|
parameter(ZMQ_WSS_CERT_PEM=104)
|
||||||
|
parameter(ZMQ_WSS_HOSTNAME=106)
|
||||||
|
parameter(ZMQ_WSS_KEY_PEM=103)
|
||||||
|
parameter(ZMQ_WSS_TRUST_PEM=105)
|
||||||
|
parameter(ZMQ_WSS_TRUST_SYSTEM=107)
|
||||||
|
parameter(ZMQ_XPUB=9)
|
||||||
|
parameter(ZMQ_XPUB_MANUAL=71)
|
||||||
|
parameter(ZMQ_XPUB_MANUAL_LAST_VALUE=98)
|
||||||
|
parameter(ZMQ_XPUB_NODROP=69)
|
||||||
|
parameter(ZMQ_XPUB_VERBOSE=40)
|
||||||
|
parameter(ZMQ_XPUB_VERBOSER=78)
|
||||||
|
parameter(ZMQ_XPUB_WELCOME_MSG=72)
|
||||||
|
parameter(ZMQ_XREP=6)
|
||||||
|
parameter(ZMQ_XREQ=5)
|
||||||
|
parameter(ZMQ_XSUB=10)
|
||||||
|
parameter(ZMQ_ZAP_DOMAIN=55)
|
||||||
|
parameter(ZMQ_ZAP_ENFORCE_DOMAIN=93)
|
||||||
|
parameter(ZMQ_ZERO_COPY_RECV=10)
|
||||||
|
integer f77_zmq_bind
|
||||||
|
external f77_zmq_bind
|
||||||
|
integer f77_zmq_close
|
||||||
|
external f77_zmq_close
|
||||||
|
integer f77_zmq_connect
|
||||||
|
external f77_zmq_connect
|
||||||
|
integer f77_zmq_ctx_destroy
|
||||||
|
external f77_zmq_ctx_destroy
|
||||||
|
integer f77_zmq_ctx_get
|
||||||
|
external f77_zmq_ctx_get
|
||||||
|
integer*8 f77_zmq_ctx_new
|
||||||
|
external f77_zmq_ctx_new
|
||||||
|
integer f77_zmq_ctx_set
|
||||||
|
external f77_zmq_ctx_set
|
||||||
|
integer f77_zmq_ctx_shutdown
|
||||||
|
external f77_zmq_ctx_shutdown
|
||||||
|
integer f77_zmq_ctx_term
|
||||||
|
external f77_zmq_ctx_term
|
||||||
|
integer f77_zmq_disconnect
|
||||||
|
external f77_zmq_disconnect
|
||||||
|
integer f77_zmq_errno
|
||||||
|
external f77_zmq_errno
|
||||||
|
integer f77_zmq_getsockopt
|
||||||
|
external f77_zmq_getsockopt
|
||||||
|
integer f77_zmq_microsleep
|
||||||
|
external f77_zmq_microsleep
|
||||||
|
integer f77_zmq_msg_close
|
||||||
|
external f77_zmq_msg_close
|
||||||
|
integer f77_zmq_msg_copy
|
||||||
|
external f77_zmq_msg_copy
|
||||||
|
integer f77_zmq_msg_copy_from_data
|
||||||
|
external f77_zmq_msg_copy_from_data
|
||||||
|
integer f77_zmq_msg_copy_to_data
|
||||||
|
external f77_zmq_msg_copy_to_data
|
||||||
|
integer f77_zmq_msg_copy_to_data8
|
||||||
|
external f77_zmq_msg_copy_to_data8
|
||||||
|
integer*8 f77_zmq_msg_data
|
||||||
|
external f77_zmq_msg_data
|
||||||
|
integer*8 f77_zmq_msg_data_new
|
||||||
|
external f77_zmq_msg_data_new
|
||||||
|
integer f77_zmq_msg_destroy
|
||||||
|
external f77_zmq_msg_destroy
|
||||||
|
integer f77_zmq_msg_destroy_data
|
||||||
|
external f77_zmq_msg_destroy_data
|
||||||
|
integer f77_zmq_msg_get
|
||||||
|
external f77_zmq_msg_get
|
||||||
|
character*(64) f77_zmq_msg_gets
|
||||||
|
external f77_zmq_msg_gets
|
||||||
|
integer f77_zmq_msg_init
|
||||||
|
external f77_zmq_msg_init
|
||||||
|
integer f77_zmq_msg_init_data
|
||||||
|
external f77_zmq_msg_init_data
|
||||||
|
integer f77_zmq_msg_init_size
|
||||||
|
external f77_zmq_msg_init_size
|
||||||
|
integer f77_zmq_msg_more
|
||||||
|
external f77_zmq_msg_more
|
||||||
|
integer f77_zmq_msg_move
|
||||||
|
external f77_zmq_msg_move
|
||||||
|
integer*8 f77_zmq_msg_new
|
||||||
|
external f77_zmq_msg_new
|
||||||
|
integer f77_zmq_msg_recv
|
||||||
|
external f77_zmq_msg_recv
|
||||||
|
integer*8 f77_zmq_msg_recv8
|
||||||
|
external f77_zmq_msg_recv8
|
||||||
|
integer f77_zmq_msg_send
|
||||||
|
external f77_zmq_msg_send
|
||||||
|
integer*8 f77_zmq_msg_send8
|
||||||
|
external f77_zmq_msg_send8
|
||||||
|
integer f77_zmq_msg_set
|
||||||
|
external f77_zmq_msg_set
|
||||||
|
integer f77_zmq_msg_size
|
||||||
|
external f77_zmq_msg_size
|
||||||
|
integer*8 f77_zmq_msg_size8
|
||||||
|
external f77_zmq_msg_size8
|
||||||
|
integer f77_zmq_poll
|
||||||
|
external f77_zmq_poll
|
||||||
|
integer f77_zmq_pollitem_destroy
|
||||||
|
external f77_zmq_pollitem_destroy
|
||||||
|
integer*8 f77_zmq_pollitem_new
|
||||||
|
external f77_zmq_pollitem_new
|
||||||
|
integer f77_zmq_pollitem_revents
|
||||||
|
external f77_zmq_pollitem_revents
|
||||||
|
integer f77_zmq_pollitem_set_events
|
||||||
|
external f77_zmq_pollitem_set_events
|
||||||
|
integer f77_zmq_pollitem_set_socket
|
||||||
|
external f77_zmq_pollitem_set_socket
|
||||||
|
integer f77_zmq_proxy
|
||||||
|
external f77_zmq_proxy
|
||||||
|
integer f77_zmq_proxy_steerable
|
||||||
|
external f77_zmq_proxy_steerable
|
||||||
|
integer f77_zmq_recv
|
||||||
|
external f77_zmq_recv
|
||||||
|
integer*8 f77_zmq_recv8
|
||||||
|
external f77_zmq_recv8
|
||||||
|
integer f77_zmq_send
|
||||||
|
external f77_zmq_send
|
||||||
|
integer*8 f77_zmq_send8
|
||||||
|
external f77_zmq_send8
|
||||||
|
integer f77_zmq_send_const
|
||||||
|
external f77_zmq_send_const
|
||||||
|
integer*8 f77_zmq_send_const8
|
||||||
|
external f77_zmq_send_const8
|
||||||
|
integer f77_zmq_setsockopt
|
||||||
|
external f77_zmq_setsockopt
|
||||||
|
integer*8 f77_zmq_socket
|
||||||
|
external f77_zmq_socket
|
||||||
|
integer f77_zmq_socket_monitor
|
||||||
|
external f77_zmq_socket_monitor
|
||||||
|
character*(64) f77_zmq_strerror
|
||||||
|
external f77_zmq_strerror
|
||||||
|
integer f77_zmq_term
|
||||||
|
external f77_zmq_term
|
||||||
|
integer f77_zmq_unbind
|
||||||
|
external f77_zmq_unbind
|
||||||
|
integer f77_zmq_version
|
||||||
|
external f77_zmq_version
|
||||||
|
integer pthread_create
|
||||||
|
external pthread_create
|
||||||
|
integer pthread_create_arg
|
||||||
|
external pthread_create_arg
|
||||||
|
integer pthread_detach
|
||||||
|
external pthread_detach
|
||||||
|
integer pthread_join
|
||||||
|
external pthread_join
|
113
ocaml/Input_ao_two_e_eff_pot.ml
Normal file
113
ocaml/Input_ao_two_e_eff_pot.ml
Normal file
@ -0,0 +1,113 @@
|
|||||||
|
(* =~=~ *)
|
||||||
|
(* Init *)
|
||||||
|
(* =~=~ *)
|
||||||
|
|
||||||
|
open Qptypes;;
|
||||||
|
open Qputils;;
|
||||||
|
open Sexplib.Std;;
|
||||||
|
|
||||||
|
module Ao_two_e_eff_pot : sig
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
adjoint_tc_h : bool;
|
||||||
|
grad_squared : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
val read : unit -> t option
|
||||||
|
val write : t-> unit
|
||||||
|
val to_string : t -> string
|
||||||
|
val to_rst : t -> Rst_string.t
|
||||||
|
val of_rst : Rst_string.t -> t option
|
||||||
|
end = struct
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
adjoint_tc_h : bool;
|
||||||
|
grad_squared : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let get_default = Qpackage.get_ezfio_default "ao_two_e_eff_pot";;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
|
||||||
|
(* Generate Special Function *)
|
||||||
|
(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read snippet for adjoint_tc_h *)
|
||||||
|
let read_adjoint_tc_h () =
|
||||||
|
if not (Ezfio.has_ao_two_e_eff_pot_adjoint_tc_h ()) then
|
||||||
|
get_default "adjoint_tc_h"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_ao_two_e_eff_pot_adjoint_tc_h
|
||||||
|
;
|
||||||
|
Ezfio.get_ao_two_e_eff_pot_adjoint_tc_h ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for adjoint_tc_h *)
|
||||||
|
let write_adjoint_tc_h =
|
||||||
|
Ezfio.set_ao_two_e_eff_pot_adjoint_tc_h
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for grad_squared *)
|
||||||
|
let read_grad_squared () =
|
||||||
|
if not (Ezfio.has_ao_two_e_eff_pot_grad_squared ()) then
|
||||||
|
get_default "grad_squared"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_ao_two_e_eff_pot_grad_squared
|
||||||
|
;
|
||||||
|
Ezfio.get_ao_two_e_eff_pot_grad_squared ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for grad_squared *)
|
||||||
|
let write_grad_squared =
|
||||||
|
Ezfio.set_ao_two_e_eff_pot_grad_squared
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
(* Generate Global Function *)
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read all *)
|
||||||
|
let read() =
|
||||||
|
Some
|
||||||
|
{
|
||||||
|
adjoint_tc_h = read_adjoint_tc_h ();
|
||||||
|
grad_squared = read_grad_squared ();
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
(* Write all *)
|
||||||
|
let write{
|
||||||
|
adjoint_tc_h;
|
||||||
|
grad_squared;
|
||||||
|
} =
|
||||||
|
write_adjoint_tc_h adjoint_tc_h;
|
||||||
|
write_grad_squared grad_squared;
|
||||||
|
;;
|
||||||
|
(* to_string*)
|
||||||
|
let to_string b =
|
||||||
|
Printf.sprintf "
|
||||||
|
adjoint_tc_h = %s
|
||||||
|
grad_squared = %s
|
||||||
|
"
|
||||||
|
(string_of_bool b.adjoint_tc_h)
|
||||||
|
(string_of_bool b.grad_squared)
|
||||||
|
;;
|
||||||
|
(* to_rst*)
|
||||||
|
let to_rst b =
|
||||||
|
Printf.sprintf "
|
||||||
|
If |true|, you compute the adjoint of the transcorrelated Hamiltonian ::
|
||||||
|
|
||||||
|
adjoint_tc_h = %s
|
||||||
|
|
||||||
|
If |true|, you compute also the square of the gradient of the correlation factor ::
|
||||||
|
|
||||||
|
grad_squared = %s
|
||||||
|
|
||||||
|
"
|
||||||
|
(string_of_bool b.adjoint_tc_h)
|
||||||
|
(string_of_bool b.grad_squared)
|
||||||
|
|> Rst_string.of_string
|
||||||
|
;;
|
||||||
|
include Generic_input_of_rst;;
|
||||||
|
let of_rst = of_rst t_of_sexp;;
|
||||||
|
|
||||||
|
end
|
87
ocaml/Input_bi_ortho_mos.ml
Normal file
87
ocaml/Input_bi_ortho_mos.ml
Normal file
@ -0,0 +1,87 @@
|
|||||||
|
(* =~=~ *)
|
||||||
|
(* Init *)
|
||||||
|
(* =~=~ *)
|
||||||
|
|
||||||
|
open Qptypes;;
|
||||||
|
open Qputils;;
|
||||||
|
open Sexplib.Std;;
|
||||||
|
|
||||||
|
module Bi_ortho_mos : sig
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
bi_ortho : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
val read : unit -> t option
|
||||||
|
val write : t-> unit
|
||||||
|
val to_string : t -> string
|
||||||
|
val to_rst : t -> Rst_string.t
|
||||||
|
val of_rst : Rst_string.t -> t option
|
||||||
|
end = struct
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
bi_ortho : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let get_default = Qpackage.get_ezfio_default "bi_ortho_mos";;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
|
||||||
|
(* Generate Special Function *)
|
||||||
|
(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read snippet for bi_ortho *)
|
||||||
|
let read_bi_ortho () =
|
||||||
|
if not (Ezfio.has_bi_ortho_mos_bi_ortho ()) then
|
||||||
|
get_default "bi_ortho"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_bi_ortho_mos_bi_ortho
|
||||||
|
;
|
||||||
|
Ezfio.get_bi_ortho_mos_bi_ortho ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for bi_ortho *)
|
||||||
|
let write_bi_ortho =
|
||||||
|
Ezfio.set_bi_ortho_mos_bi_ortho
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
(* Generate Global Function *)
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read all *)
|
||||||
|
let read() =
|
||||||
|
Some
|
||||||
|
{
|
||||||
|
bi_ortho = read_bi_ortho ();
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
(* Write all *)
|
||||||
|
let write{
|
||||||
|
bi_ortho;
|
||||||
|
} =
|
||||||
|
write_bi_ortho bi_ortho;
|
||||||
|
;;
|
||||||
|
(* to_string*)
|
||||||
|
let to_string b =
|
||||||
|
Printf.sprintf "
|
||||||
|
bi_ortho = %s
|
||||||
|
"
|
||||||
|
(string_of_bool b.bi_ortho)
|
||||||
|
;;
|
||||||
|
(* to_rst*)
|
||||||
|
let to_rst b =
|
||||||
|
Printf.sprintf "
|
||||||
|
If |true|, the MO basis is assumed to be bi-orthonormal ::
|
||||||
|
|
||||||
|
bi_ortho = %s
|
||||||
|
|
||||||
|
"
|
||||||
|
(string_of_bool b.bi_ortho)
|
||||||
|
|> Rst_string.of_string
|
||||||
|
;;
|
||||||
|
include Generic_input_of_rst;;
|
||||||
|
let of_rst = of_rst t_of_sexp;;
|
||||||
|
|
||||||
|
end
|
113
ocaml/Input_cassd.ml
Normal file
113
ocaml/Input_cassd.ml
Normal file
@ -0,0 +1,113 @@
|
|||||||
|
(* =~=~ *)
|
||||||
|
(* Init *)
|
||||||
|
(* =~=~ *)
|
||||||
|
|
||||||
|
open Qptypes;;
|
||||||
|
open Qputils;;
|
||||||
|
open Sexplib.Std;;
|
||||||
|
|
||||||
|
module Cassd : sig
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
do_ddci : bool;
|
||||||
|
do_only_1h1p : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
val read : unit -> t option
|
||||||
|
val write : t-> unit
|
||||||
|
val to_string : t -> string
|
||||||
|
val to_rst : t -> Rst_string.t
|
||||||
|
val of_rst : Rst_string.t -> t option
|
||||||
|
end = struct
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
do_ddci : bool;
|
||||||
|
do_only_1h1p : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let get_default = Qpackage.get_ezfio_default "cassd";;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
|
||||||
|
(* Generate Special Function *)
|
||||||
|
(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read snippet for do_ddci *)
|
||||||
|
let read_do_ddci () =
|
||||||
|
if not (Ezfio.has_cassd_do_ddci ()) then
|
||||||
|
get_default "do_ddci"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_cassd_do_ddci
|
||||||
|
;
|
||||||
|
Ezfio.get_cassd_do_ddci ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for do_ddci *)
|
||||||
|
let write_do_ddci =
|
||||||
|
Ezfio.set_cassd_do_ddci
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for do_only_1h1p *)
|
||||||
|
let read_do_only_1h1p () =
|
||||||
|
if not (Ezfio.has_cassd_do_only_1h1p ()) then
|
||||||
|
get_default "do_only_1h1p"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_cassd_do_only_1h1p
|
||||||
|
;
|
||||||
|
Ezfio.get_cassd_do_only_1h1p ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for do_only_1h1p *)
|
||||||
|
let write_do_only_1h1p =
|
||||||
|
Ezfio.set_cassd_do_only_1h1p
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
(* Generate Global Function *)
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read all *)
|
||||||
|
let read() =
|
||||||
|
Some
|
||||||
|
{
|
||||||
|
do_ddci = read_do_ddci ();
|
||||||
|
do_only_1h1p = read_do_only_1h1p ();
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
(* Write all *)
|
||||||
|
let write{
|
||||||
|
do_ddci;
|
||||||
|
do_only_1h1p;
|
||||||
|
} =
|
||||||
|
write_do_ddci do_ddci;
|
||||||
|
write_do_only_1h1p do_only_1h1p;
|
||||||
|
;;
|
||||||
|
(* to_string*)
|
||||||
|
let to_string b =
|
||||||
|
Printf.sprintf "
|
||||||
|
do_ddci = %s
|
||||||
|
do_only_1h1p = %s
|
||||||
|
"
|
||||||
|
(string_of_bool b.do_ddci)
|
||||||
|
(string_of_bool b.do_only_1h1p)
|
||||||
|
;;
|
||||||
|
(* to_rst*)
|
||||||
|
let to_rst b =
|
||||||
|
Printf.sprintf "
|
||||||
|
If true, remove purely inactive double excitations ::
|
||||||
|
|
||||||
|
do_ddci = %s
|
||||||
|
|
||||||
|
If true, do only one hole/one particle excitations ::
|
||||||
|
|
||||||
|
do_only_1h1p = %s
|
||||||
|
|
||||||
|
"
|
||||||
|
(string_of_bool b.do_ddci)
|
||||||
|
(string_of_bool b.do_only_1h1p)
|
||||||
|
|> Rst_string.of_string
|
||||||
|
;;
|
||||||
|
include Generic_input_of_rst;;
|
||||||
|
let of_rst = of_rst t_of_sexp;;
|
||||||
|
|
||||||
|
end
|
243
ocaml/Input_cipsi_deb.ml
Normal file
243
ocaml/Input_cipsi_deb.ml
Normal file
@ -0,0 +1,243 @@
|
|||||||
|
(* =~=~ *)
|
||||||
|
(* Init *)
|
||||||
|
(* =~=~ *)
|
||||||
|
|
||||||
|
open Qptypes;;
|
||||||
|
open Qputils;;
|
||||||
|
open Sexplib.Std;;
|
||||||
|
|
||||||
|
module Cipsi_deb : sig
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
pert_2rdm : bool;
|
||||||
|
save_wf_after_selection : bool;
|
||||||
|
seniority_max : int;
|
||||||
|
excitation_ref : int;
|
||||||
|
excitation_max : int;
|
||||||
|
excitation_alpha_max : int;
|
||||||
|
excitation_beta_max : int;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
val read : unit -> t option
|
||||||
|
val write : t-> unit
|
||||||
|
val to_string : t -> string
|
||||||
|
val to_rst : t -> Rst_string.t
|
||||||
|
val of_rst : Rst_string.t -> t option
|
||||||
|
end = struct
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
pert_2rdm : bool;
|
||||||
|
save_wf_after_selection : bool;
|
||||||
|
seniority_max : int;
|
||||||
|
excitation_ref : int;
|
||||||
|
excitation_max : int;
|
||||||
|
excitation_alpha_max : int;
|
||||||
|
excitation_beta_max : int;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let get_default = Qpackage.get_ezfio_default "cipsi_deb";;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
|
||||||
|
(* Generate Special Function *)
|
||||||
|
(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read snippet for excitation_alpha_max *)
|
||||||
|
let read_excitation_alpha_max () =
|
||||||
|
if not (Ezfio.has_cipsi_deb_excitation_alpha_max ()) then
|
||||||
|
get_default "excitation_alpha_max"
|
||||||
|
|> int_of_string
|
||||||
|
|> Ezfio.set_cipsi_deb_excitation_alpha_max
|
||||||
|
;
|
||||||
|
Ezfio.get_cipsi_deb_excitation_alpha_max ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for excitation_alpha_max *)
|
||||||
|
let write_excitation_alpha_max =
|
||||||
|
Ezfio.set_cipsi_deb_excitation_alpha_max
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for excitation_beta_max *)
|
||||||
|
let read_excitation_beta_max () =
|
||||||
|
if not (Ezfio.has_cipsi_deb_excitation_beta_max ()) then
|
||||||
|
get_default "excitation_beta_max"
|
||||||
|
|> int_of_string
|
||||||
|
|> Ezfio.set_cipsi_deb_excitation_beta_max
|
||||||
|
;
|
||||||
|
Ezfio.get_cipsi_deb_excitation_beta_max ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for excitation_beta_max *)
|
||||||
|
let write_excitation_beta_max =
|
||||||
|
Ezfio.set_cipsi_deb_excitation_beta_max
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for excitation_max *)
|
||||||
|
let read_excitation_max () =
|
||||||
|
if not (Ezfio.has_cipsi_deb_excitation_max ()) then
|
||||||
|
get_default "excitation_max"
|
||||||
|
|> int_of_string
|
||||||
|
|> Ezfio.set_cipsi_deb_excitation_max
|
||||||
|
;
|
||||||
|
Ezfio.get_cipsi_deb_excitation_max ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for excitation_max *)
|
||||||
|
let write_excitation_max =
|
||||||
|
Ezfio.set_cipsi_deb_excitation_max
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for excitation_ref *)
|
||||||
|
let read_excitation_ref () =
|
||||||
|
if not (Ezfio.has_cipsi_deb_excitation_ref ()) then
|
||||||
|
get_default "excitation_ref"
|
||||||
|
|> int_of_string
|
||||||
|
|> Ezfio.set_cipsi_deb_excitation_ref
|
||||||
|
;
|
||||||
|
Ezfio.get_cipsi_deb_excitation_ref ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for excitation_ref *)
|
||||||
|
let write_excitation_ref =
|
||||||
|
Ezfio.set_cipsi_deb_excitation_ref
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for pert_2rdm *)
|
||||||
|
let read_pert_2rdm () =
|
||||||
|
if not (Ezfio.has_cipsi_deb_pert_2rdm ()) then
|
||||||
|
get_default "pert_2rdm"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_cipsi_deb_pert_2rdm
|
||||||
|
;
|
||||||
|
Ezfio.get_cipsi_deb_pert_2rdm ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for pert_2rdm *)
|
||||||
|
let write_pert_2rdm =
|
||||||
|
Ezfio.set_cipsi_deb_pert_2rdm
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for save_wf_after_selection *)
|
||||||
|
let read_save_wf_after_selection () =
|
||||||
|
if not (Ezfio.has_cipsi_deb_save_wf_after_selection ()) then
|
||||||
|
get_default "save_wf_after_selection"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_cipsi_deb_save_wf_after_selection
|
||||||
|
;
|
||||||
|
Ezfio.get_cipsi_deb_save_wf_after_selection ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for save_wf_after_selection *)
|
||||||
|
let write_save_wf_after_selection =
|
||||||
|
Ezfio.set_cipsi_deb_save_wf_after_selection
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for seniority_max *)
|
||||||
|
let read_seniority_max () =
|
||||||
|
if not (Ezfio.has_cipsi_deb_seniority_max ()) then
|
||||||
|
get_default "seniority_max"
|
||||||
|
|> int_of_string
|
||||||
|
|> Ezfio.set_cipsi_deb_seniority_max
|
||||||
|
;
|
||||||
|
Ezfio.get_cipsi_deb_seniority_max ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for seniority_max *)
|
||||||
|
let write_seniority_max =
|
||||||
|
Ezfio.set_cipsi_deb_seniority_max
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
(* Generate Global Function *)
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read all *)
|
||||||
|
let read() =
|
||||||
|
Some
|
||||||
|
{
|
||||||
|
pert_2rdm = read_pert_2rdm ();
|
||||||
|
save_wf_after_selection = read_save_wf_after_selection ();
|
||||||
|
seniority_max = read_seniority_max ();
|
||||||
|
excitation_ref = read_excitation_ref ();
|
||||||
|
excitation_max = read_excitation_max ();
|
||||||
|
excitation_alpha_max = read_excitation_alpha_max ();
|
||||||
|
excitation_beta_max = read_excitation_beta_max ();
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
(* Write all *)
|
||||||
|
let write{
|
||||||
|
pert_2rdm;
|
||||||
|
save_wf_after_selection;
|
||||||
|
seniority_max;
|
||||||
|
excitation_ref;
|
||||||
|
excitation_max;
|
||||||
|
excitation_alpha_max;
|
||||||
|
excitation_beta_max;
|
||||||
|
} =
|
||||||
|
write_pert_2rdm pert_2rdm;
|
||||||
|
write_save_wf_after_selection save_wf_after_selection;
|
||||||
|
write_seniority_max seniority_max;
|
||||||
|
write_excitation_ref excitation_ref;
|
||||||
|
write_excitation_max excitation_max;
|
||||||
|
write_excitation_alpha_max excitation_alpha_max;
|
||||||
|
write_excitation_beta_max excitation_beta_max;
|
||||||
|
;;
|
||||||
|
(* to_string*)
|
||||||
|
let to_string b =
|
||||||
|
Printf.sprintf "
|
||||||
|
pert_2rdm = %s
|
||||||
|
save_wf_after_selection = %s
|
||||||
|
seniority_max = %s
|
||||||
|
excitation_ref = %s
|
||||||
|
excitation_max = %s
|
||||||
|
excitation_alpha_max = %s
|
||||||
|
excitation_beta_max = %s
|
||||||
|
"
|
||||||
|
(string_of_bool b.pert_2rdm)
|
||||||
|
(string_of_bool b.save_wf_after_selection)
|
||||||
|
(string_of_int b.seniority_max)
|
||||||
|
(string_of_int b.excitation_ref)
|
||||||
|
(string_of_int b.excitation_max)
|
||||||
|
(string_of_int b.excitation_alpha_max)
|
||||||
|
(string_of_int b.excitation_beta_max)
|
||||||
|
;;
|
||||||
|
(* to_rst*)
|
||||||
|
let to_rst b =
|
||||||
|
Printf.sprintf "
|
||||||
|
If true, computes the one- and two-body rdms with perturbation theory ::
|
||||||
|
|
||||||
|
pert_2rdm = %s
|
||||||
|
|
||||||
|
If true, saves the wave function after the selection, before the diagonalization ::
|
||||||
|
|
||||||
|
save_wf_after_selection = %s
|
||||||
|
|
||||||
|
Maximum number of allowed open shells. Using -1 selects all determinants ::
|
||||||
|
|
||||||
|
seniority_max = %s
|
||||||
|
|
||||||
|
1: Hartree-Fock determinant, 2:All determinants of the dominant configuration ::
|
||||||
|
|
||||||
|
excitation_ref = %s
|
||||||
|
|
||||||
|
Maximum number of excitation with respect to the Hartree-Fock determinant. Using -1 selects all determinants ::
|
||||||
|
|
||||||
|
excitation_max = %s
|
||||||
|
|
||||||
|
Maximum number of excitation for alpha determinants with respect to the Hartree-Fock determinant. Using -1 selects all determinants ::
|
||||||
|
|
||||||
|
excitation_alpha_max = %s
|
||||||
|
|
||||||
|
Maximum number of excitation for beta determinants with respect to the Hartree-Fock determinant. Using -1 selects all determinants ::
|
||||||
|
|
||||||
|
excitation_beta_max = %s
|
||||||
|
|
||||||
|
"
|
||||||
|
(string_of_bool b.pert_2rdm)
|
||||||
|
(string_of_bool b.save_wf_after_selection)
|
||||||
|
(string_of_int b.seniority_max)
|
||||||
|
(string_of_int b.excitation_ref)
|
||||||
|
(string_of_int b.excitation_max)
|
||||||
|
(string_of_int b.excitation_alpha_max)
|
||||||
|
(string_of_int b.excitation_beta_max)
|
||||||
|
|> Rst_string.of_string
|
||||||
|
;;
|
||||||
|
include Generic_input_of_rst;;
|
||||||
|
let of_rst = of_rst t_of_sexp;;
|
||||||
|
|
||||||
|
end
|
351
ocaml/Input_tc_h_clean.ml
Normal file
351
ocaml/Input_tc_h_clean.ml
Normal file
@ -0,0 +1,351 @@
|
|||||||
|
(* =~=~ *)
|
||||||
|
(* Init *)
|
||||||
|
(* =~=~ *)
|
||||||
|
|
||||||
|
open Qptypes;;
|
||||||
|
open Qputils;;
|
||||||
|
open Sexplib.Std;;
|
||||||
|
|
||||||
|
module Tc_h_clean : sig
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
read_rl_eigv : bool;
|
||||||
|
comp_left_eigv : bool;
|
||||||
|
three_body_h_tc : bool;
|
||||||
|
pure_three_body_h_tc : bool;
|
||||||
|
double_normal_ord : bool;
|
||||||
|
core_tc_op : bool;
|
||||||
|
full_tc_h_solver : bool;
|
||||||
|
thresh_it_dav : Threshold.t;
|
||||||
|
max_it_dav : int;
|
||||||
|
thresh_psi_r : Threshold.t;
|
||||||
|
thresh_psi_r_norm : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
val read : unit -> t option
|
||||||
|
val write : t-> unit
|
||||||
|
val to_string : t -> string
|
||||||
|
val to_rst : t -> Rst_string.t
|
||||||
|
val of_rst : Rst_string.t -> t option
|
||||||
|
end = struct
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
read_rl_eigv : bool;
|
||||||
|
comp_left_eigv : bool;
|
||||||
|
three_body_h_tc : bool;
|
||||||
|
pure_three_body_h_tc : bool;
|
||||||
|
double_normal_ord : bool;
|
||||||
|
core_tc_op : bool;
|
||||||
|
full_tc_h_solver : bool;
|
||||||
|
thresh_it_dav : Threshold.t;
|
||||||
|
max_it_dav : int;
|
||||||
|
thresh_psi_r : Threshold.t;
|
||||||
|
thresh_psi_r_norm : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let get_default = Qpackage.get_ezfio_default "tc_h_clean";;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
|
||||||
|
(* Generate Special Function *)
|
||||||
|
(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read snippet for comp_left_eigv *)
|
||||||
|
let read_comp_left_eigv () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_comp_left_eigv ()) then
|
||||||
|
get_default "comp_left_eigv"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_comp_left_eigv
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_comp_left_eigv ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for comp_left_eigv *)
|
||||||
|
let write_comp_left_eigv =
|
||||||
|
Ezfio.set_tc_h_clean_comp_left_eigv
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for core_tc_op *)
|
||||||
|
let read_core_tc_op () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_core_tc_op ()) then
|
||||||
|
get_default "core_tc_op"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_core_tc_op
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_core_tc_op ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for core_tc_op *)
|
||||||
|
let write_core_tc_op =
|
||||||
|
Ezfio.set_tc_h_clean_core_tc_op
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for double_normal_ord *)
|
||||||
|
let read_double_normal_ord () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_double_normal_ord ()) then
|
||||||
|
get_default "double_normal_ord"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_double_normal_ord
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_double_normal_ord ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for double_normal_ord *)
|
||||||
|
let write_double_normal_ord =
|
||||||
|
Ezfio.set_tc_h_clean_double_normal_ord
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for full_tc_h_solver *)
|
||||||
|
let read_full_tc_h_solver () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_full_tc_h_solver ()) then
|
||||||
|
get_default "full_tc_h_solver"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_full_tc_h_solver
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_full_tc_h_solver ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for full_tc_h_solver *)
|
||||||
|
let write_full_tc_h_solver =
|
||||||
|
Ezfio.set_tc_h_clean_full_tc_h_solver
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for max_it_dav *)
|
||||||
|
let read_max_it_dav () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_max_it_dav ()) then
|
||||||
|
get_default "max_it_dav"
|
||||||
|
|> int_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_max_it_dav
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_max_it_dav ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for max_it_dav *)
|
||||||
|
let write_max_it_dav =
|
||||||
|
Ezfio.set_tc_h_clean_max_it_dav
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for pure_three_body_h_tc *)
|
||||||
|
let read_pure_three_body_h_tc () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_pure_three_body_h_tc ()) then
|
||||||
|
get_default "pure_three_body_h_tc"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_pure_three_body_h_tc
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_pure_three_body_h_tc ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for pure_three_body_h_tc *)
|
||||||
|
let write_pure_three_body_h_tc =
|
||||||
|
Ezfio.set_tc_h_clean_pure_three_body_h_tc
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for read_rl_eigv *)
|
||||||
|
let read_read_rl_eigv () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_read_rl_eigv ()) then
|
||||||
|
get_default "read_rl_eigv"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_read_rl_eigv
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_read_rl_eigv ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for read_rl_eigv *)
|
||||||
|
let write_read_rl_eigv =
|
||||||
|
Ezfio.set_tc_h_clean_read_rl_eigv
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for three_body_h_tc *)
|
||||||
|
let read_three_body_h_tc () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_three_body_h_tc ()) then
|
||||||
|
get_default "three_body_h_tc"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_three_body_h_tc
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_three_body_h_tc ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for three_body_h_tc *)
|
||||||
|
let write_three_body_h_tc =
|
||||||
|
Ezfio.set_tc_h_clean_three_body_h_tc
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for thresh_it_dav *)
|
||||||
|
let read_thresh_it_dav () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_thresh_it_dav ()) then
|
||||||
|
get_default "thresh_it_dav"
|
||||||
|
|> float_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_thresh_it_dav
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_thresh_it_dav ()
|
||||||
|
|> Threshold.of_float
|
||||||
|
;;
|
||||||
|
(* Write snippet for thresh_it_dav *)
|
||||||
|
let write_thresh_it_dav var =
|
||||||
|
Threshold.to_float var
|
||||||
|
|> Ezfio.set_tc_h_clean_thresh_it_dav
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for thresh_psi_r *)
|
||||||
|
let read_thresh_psi_r () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_thresh_psi_r ()) then
|
||||||
|
get_default "thresh_psi_r"
|
||||||
|
|> float_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_thresh_psi_r
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_thresh_psi_r ()
|
||||||
|
|> Threshold.of_float
|
||||||
|
;;
|
||||||
|
(* Write snippet for thresh_psi_r *)
|
||||||
|
let write_thresh_psi_r var =
|
||||||
|
Threshold.to_float var
|
||||||
|
|> Ezfio.set_tc_h_clean_thresh_psi_r
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for thresh_psi_r_norm *)
|
||||||
|
let read_thresh_psi_r_norm () =
|
||||||
|
if not (Ezfio.has_tc_h_clean_thresh_psi_r_norm ()) then
|
||||||
|
get_default "thresh_psi_r_norm"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_h_clean_thresh_psi_r_norm
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_h_clean_thresh_psi_r_norm ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for thresh_psi_r_norm *)
|
||||||
|
let write_thresh_psi_r_norm =
|
||||||
|
Ezfio.set_tc_h_clean_thresh_psi_r_norm
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
(* Generate Global Function *)
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read all *)
|
||||||
|
let read() =
|
||||||
|
Some
|
||||||
|
{
|
||||||
|
read_rl_eigv = read_read_rl_eigv ();
|
||||||
|
comp_left_eigv = read_comp_left_eigv ();
|
||||||
|
three_body_h_tc = read_three_body_h_tc ();
|
||||||
|
pure_three_body_h_tc = read_pure_three_body_h_tc ();
|
||||||
|
double_normal_ord = read_double_normal_ord ();
|
||||||
|
core_tc_op = read_core_tc_op ();
|
||||||
|
full_tc_h_solver = read_full_tc_h_solver ();
|
||||||
|
thresh_it_dav = read_thresh_it_dav ();
|
||||||
|
max_it_dav = read_max_it_dav ();
|
||||||
|
thresh_psi_r = read_thresh_psi_r ();
|
||||||
|
thresh_psi_r_norm = read_thresh_psi_r_norm ();
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
(* Write all *)
|
||||||
|
let write{
|
||||||
|
read_rl_eigv;
|
||||||
|
comp_left_eigv;
|
||||||
|
three_body_h_tc;
|
||||||
|
pure_three_body_h_tc;
|
||||||
|
double_normal_ord;
|
||||||
|
core_tc_op;
|
||||||
|
full_tc_h_solver;
|
||||||
|
thresh_it_dav;
|
||||||
|
max_it_dav;
|
||||||
|
thresh_psi_r;
|
||||||
|
thresh_psi_r_norm;
|
||||||
|
} =
|
||||||
|
write_read_rl_eigv read_rl_eigv;
|
||||||
|
write_comp_left_eigv comp_left_eigv;
|
||||||
|
write_three_body_h_tc three_body_h_tc;
|
||||||
|
write_pure_three_body_h_tc pure_three_body_h_tc;
|
||||||
|
write_double_normal_ord double_normal_ord;
|
||||||
|
write_core_tc_op core_tc_op;
|
||||||
|
write_full_tc_h_solver full_tc_h_solver;
|
||||||
|
write_thresh_it_dav thresh_it_dav;
|
||||||
|
write_max_it_dav max_it_dav;
|
||||||
|
write_thresh_psi_r thresh_psi_r;
|
||||||
|
write_thresh_psi_r_norm thresh_psi_r_norm;
|
||||||
|
;;
|
||||||
|
(* to_string*)
|
||||||
|
let to_string b =
|
||||||
|
Printf.sprintf "
|
||||||
|
read_rl_eigv = %s
|
||||||
|
comp_left_eigv = %s
|
||||||
|
three_body_h_tc = %s
|
||||||
|
pure_three_body_h_tc = %s
|
||||||
|
double_normal_ord = %s
|
||||||
|
core_tc_op = %s
|
||||||
|
full_tc_h_solver = %s
|
||||||
|
thresh_it_dav = %s
|
||||||
|
max_it_dav = %s
|
||||||
|
thresh_psi_r = %s
|
||||||
|
thresh_psi_r_norm = %s
|
||||||
|
"
|
||||||
|
(string_of_bool b.read_rl_eigv)
|
||||||
|
(string_of_bool b.comp_left_eigv)
|
||||||
|
(string_of_bool b.three_body_h_tc)
|
||||||
|
(string_of_bool b.pure_three_body_h_tc)
|
||||||
|
(string_of_bool b.double_normal_ord)
|
||||||
|
(string_of_bool b.core_tc_op)
|
||||||
|
(string_of_bool b.full_tc_h_solver)
|
||||||
|
(Threshold.to_string b.thresh_it_dav)
|
||||||
|
(string_of_int b.max_it_dav)
|
||||||
|
(Threshold.to_string b.thresh_psi_r)
|
||||||
|
(string_of_bool b.thresh_psi_r_norm)
|
||||||
|
;;
|
||||||
|
(* to_rst*)
|
||||||
|
let to_rst b =
|
||||||
|
Printf.sprintf "
|
||||||
|
If |true|, read the right/left eigenvectors from ezfio ::
|
||||||
|
|
||||||
|
read_rl_eigv = %s
|
||||||
|
|
||||||
|
If |true|, computes also the left-eigenvector ::
|
||||||
|
|
||||||
|
comp_left_eigv = %s
|
||||||
|
|
||||||
|
If |true|, three-body terms are included ::
|
||||||
|
|
||||||
|
three_body_h_tc = %s
|
||||||
|
|
||||||
|
If |true|, pure triple excitation three-body terms are included ::
|
||||||
|
|
||||||
|
pure_three_body_h_tc = %s
|
||||||
|
|
||||||
|
If |true|, contracted double excitation three-body terms are included ::
|
||||||
|
|
||||||
|
double_normal_ord = %s
|
||||||
|
|
||||||
|
If |true|, takes the usual Hamiltonian for core orbitals (assumed to be doubly occupied) ::
|
||||||
|
|
||||||
|
core_tc_op = %s
|
||||||
|
|
||||||
|
If |true|, you diagonalize the full TC H matrix ::
|
||||||
|
|
||||||
|
full_tc_h_solver = %s
|
||||||
|
|
||||||
|
Thresholds on the energy for iterative Davidson used in TC ::
|
||||||
|
|
||||||
|
thresh_it_dav = %s
|
||||||
|
|
||||||
|
nb max of iteration in Davidson used in TC ::
|
||||||
|
|
||||||
|
max_it_dav = %s
|
||||||
|
|
||||||
|
Thresholds on the coefficients of the right-eigenvector. Used for PT2 computation. ::
|
||||||
|
|
||||||
|
thresh_psi_r = %s
|
||||||
|
|
||||||
|
If |true|, you prune the WF to compute the PT1 coef based on the norm. If False, the pruning is done through the amplitude on the right-coefficient. ::
|
||||||
|
|
||||||
|
thresh_psi_r_norm = %s
|
||||||
|
|
||||||
|
"
|
||||||
|
(string_of_bool b.read_rl_eigv)
|
||||||
|
(string_of_bool b.comp_left_eigv)
|
||||||
|
(string_of_bool b.three_body_h_tc)
|
||||||
|
(string_of_bool b.pure_three_body_h_tc)
|
||||||
|
(string_of_bool b.double_normal_ord)
|
||||||
|
(string_of_bool b.core_tc_op)
|
||||||
|
(string_of_bool b.full_tc_h_solver)
|
||||||
|
(Threshold.to_string b.thresh_it_dav)
|
||||||
|
(string_of_int b.max_it_dav)
|
||||||
|
(Threshold.to_string b.thresh_psi_r)
|
||||||
|
(string_of_bool b.thresh_psi_r_norm)
|
||||||
|
|> Rst_string.of_string
|
||||||
|
;;
|
||||||
|
include Generic_input_of_rst;;
|
||||||
|
let of_rst = of_rst t_of_sexp;;
|
||||||
|
|
||||||
|
end
|
143
ocaml/Input_tc_scf.ml
Normal file
143
ocaml/Input_tc_scf.ml
Normal file
@ -0,0 +1,143 @@
|
|||||||
|
(* =~=~ *)
|
||||||
|
(* Init *)
|
||||||
|
(* =~=~ *)
|
||||||
|
|
||||||
|
open Qptypes;;
|
||||||
|
open Qputils;;
|
||||||
|
open Sexplib.Std;;
|
||||||
|
|
||||||
|
module Tc_scf : sig
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
bi_ortho : bool;
|
||||||
|
thresh_tcscf : Threshold.t;
|
||||||
|
n_it_tcscf_max : Strictly_positive_int.t;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
val read : unit -> t option
|
||||||
|
val write : t-> unit
|
||||||
|
val to_string : t -> string
|
||||||
|
val to_rst : t -> Rst_string.t
|
||||||
|
val of_rst : Rst_string.t -> t option
|
||||||
|
end = struct
|
||||||
|
(* Generate type *)
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
bi_ortho : bool;
|
||||||
|
thresh_tcscf : Threshold.t;
|
||||||
|
n_it_tcscf_max : Strictly_positive_int.t;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let get_default = Qpackage.get_ezfio_default "tc_scf";;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
|
||||||
|
(* Generate Special Function *)
|
||||||
|
(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read snippet for bi_ortho *)
|
||||||
|
let read_bi_ortho () =
|
||||||
|
if not (Ezfio.has_tc_scf_bi_ortho ()) then
|
||||||
|
get_default "bi_ortho"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_tc_scf_bi_ortho
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_scf_bi_ortho ()
|
||||||
|
;;
|
||||||
|
(* Write snippet for bi_ortho *)
|
||||||
|
let write_bi_ortho =
|
||||||
|
Ezfio.set_tc_scf_bi_ortho
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for n_it_tcscf_max *)
|
||||||
|
let read_n_it_tcscf_max () =
|
||||||
|
if not (Ezfio.has_tc_scf_n_it_tcscf_max ()) then
|
||||||
|
get_default "n_it_tcscf_max"
|
||||||
|
|> int_of_string
|
||||||
|
|> Ezfio.set_tc_scf_n_it_tcscf_max
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_scf_n_it_tcscf_max ()
|
||||||
|
|> Strictly_positive_int.of_int
|
||||||
|
;;
|
||||||
|
(* Write snippet for n_it_tcscf_max *)
|
||||||
|
let write_n_it_tcscf_max var =
|
||||||
|
Strictly_positive_int.to_int var
|
||||||
|
|> Ezfio.set_tc_scf_n_it_tcscf_max
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* Read snippet for thresh_tcscf *)
|
||||||
|
let read_thresh_tcscf () =
|
||||||
|
if not (Ezfio.has_tc_scf_thresh_tcscf ()) then
|
||||||
|
get_default "thresh_tcscf"
|
||||||
|
|> float_of_string
|
||||||
|
|> Ezfio.set_tc_scf_thresh_tcscf
|
||||||
|
;
|
||||||
|
Ezfio.get_tc_scf_thresh_tcscf ()
|
||||||
|
|> Threshold.of_float
|
||||||
|
;;
|
||||||
|
(* Write snippet for thresh_tcscf *)
|
||||||
|
let write_thresh_tcscf var =
|
||||||
|
Threshold.to_float var
|
||||||
|
|> Ezfio.set_tc_scf_thresh_tcscf
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
(* Generate Global Function *)
|
||||||
|
(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
|
||||||
|
|
||||||
|
(* Read all *)
|
||||||
|
let read() =
|
||||||
|
Some
|
||||||
|
{
|
||||||
|
bi_ortho = read_bi_ortho ();
|
||||||
|
thresh_tcscf = read_thresh_tcscf ();
|
||||||
|
n_it_tcscf_max = read_n_it_tcscf_max ();
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
(* Write all *)
|
||||||
|
let write{
|
||||||
|
bi_ortho;
|
||||||
|
thresh_tcscf;
|
||||||
|
n_it_tcscf_max;
|
||||||
|
} =
|
||||||
|
write_bi_ortho bi_ortho;
|
||||||
|
write_thresh_tcscf thresh_tcscf;
|
||||||
|
write_n_it_tcscf_max n_it_tcscf_max;
|
||||||
|
;;
|
||||||
|
(* to_string*)
|
||||||
|
let to_string b =
|
||||||
|
Printf.sprintf "
|
||||||
|
bi_ortho = %s
|
||||||
|
thresh_tcscf = %s
|
||||||
|
n_it_tcscf_max = %s
|
||||||
|
"
|
||||||
|
(string_of_bool b.bi_ortho)
|
||||||
|
(Threshold.to_string b.thresh_tcscf)
|
||||||
|
(Strictly_positive_int.to_string b.n_it_tcscf_max)
|
||||||
|
;;
|
||||||
|
(* to_rst*)
|
||||||
|
let to_rst b =
|
||||||
|
Printf.sprintf "
|
||||||
|
If |true|, the MO basis is assumed to be bi-orthonormal ::
|
||||||
|
|
||||||
|
bi_ortho = %s
|
||||||
|
|
||||||
|
Threshold on the convergence of the Hartree Fock energy. ::
|
||||||
|
|
||||||
|
thresh_tcscf = %s
|
||||||
|
|
||||||
|
Maximum number of SCF iterations ::
|
||||||
|
|
||||||
|
n_it_tcscf_max = %s
|
||||||
|
|
||||||
|
"
|
||||||
|
(string_of_bool b.bi_ortho)
|
||||||
|
(Threshold.to_string b.thresh_tcscf)
|
||||||
|
(Strictly_positive_int.to_string b.n_it_tcscf_max)
|
||||||
|
|> Rst_string.of_string
|
||||||
|
;;
|
||||||
|
include Generic_input_of_rst;;
|
||||||
|
let of_rst = of_rst t_of_sexp;;
|
||||||
|
|
||||||
|
end
|
@ -681,10 +681,8 @@ let () =
|
|||||||
let open Command_line in
|
let open Command_line in
|
||||||
begin
|
begin
|
||||||
"Creates an EZFIO directory from a standard xyz file or from a z-matrix file in Gaussian format. The basis set is defined as a single string if all the atoms are taken from the same basis set, otherwise specific elements can be defined as follows:
|
"Creates an EZFIO directory from a standard xyz file or from a z-matrix file in Gaussian format. The basis set is defined as a single string if all the atoms are taken from the same basis set, otherwise specific elements can be defined as follows:
|
||||||
|
|
||||||
-b \"cc-pcvdz | H:cc-pvdz | C:6-31g\"
|
-b \"cc-pcvdz | H:cc-pvdz | C:6-31g\"
|
||||||
-b \"cc-pvtz | 1,H:sto-3g | 3,H:6-31g\"
|
-b \"cc-pvtz | 1,H:sto-3g | 3,H:6-31g\"
|
||||||
|
|
||||||
If a file with the same name as the basis set exists, this file will be read. Otherwise, the basis set is obtained from the database.
|
If a file with the same name as the basis set exists, this file will be read. Otherwise, the basis set is obtained from the database.
|
||||||
" |> set_description_doc ;
|
" |> set_description_doc ;
|
||||||
set_header_doc (Sys.argv.(0) ^ " - Quantum Package command");
|
set_header_doc (Sys.argv.(0) ^ " - Quantum Package command");
|
||||||
|
@ -17,7 +17,7 @@ interface: ezfio, provider
|
|||||||
[ao_prim_num_max]
|
[ao_prim_num_max]
|
||||||
type: integer
|
type: integer
|
||||||
doc: Maximum number of primitives
|
doc: Maximum number of primitives
|
||||||
default: =maxval(ao_basis.ao_prim_num)
|
#default: =maxval(ao_basis.ao_prim_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
[ao_nucl]
|
[ao_nucl]
|
||||||
@ -36,13 +36,13 @@ interface: ezfio, provider
|
|||||||
type: double precision
|
type: double precision
|
||||||
doc: Primitive coefficients, read from input. Those should not be used directly, as the MOs are expressed on the basis of **normalized** AOs.
|
doc: Primitive coefficients, read from input. Those should not be used directly, as the MOs are expressed on the basis of **normalized** AOs.
|
||||||
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
|
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
|
||||||
interface: ezfio, provider
|
interface: ezfio
|
||||||
|
|
||||||
[ao_expo]
|
[ao_expo]
|
||||||
type: double precision
|
type: double precision
|
||||||
doc: Exponents for each primitive of each |AO|
|
doc: Exponents for each primitive of each |AO|
|
||||||
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
|
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
|
||||||
interface: ezfio, provider
|
interface: ezfio
|
||||||
|
|
||||||
[ao_md5]
|
[ao_md5]
|
||||||
type: character*(32)
|
type: character*(32)
|
||||||
@ -67,3 +67,4 @@ doc: Use normalized primitive functions
|
|||||||
interface: ezfio, provider
|
interface: ezfio, provider
|
||||||
default: true
|
default: true
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,11 +1,3 @@
|
|||||||
BEGIN_PROVIDER [ integer, ao_prim_num_max ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Max number of primitives.
|
|
||||||
END_DOC
|
|
||||||
ao_prim_num_max = maxval(ao_prim_num)
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, ao_shell, (ao_num) ]
|
BEGIN_PROVIDER [ integer, ao_shell, (ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -23,6 +15,32 @@ BEGIN_PROVIDER [ integer, ao_shell, (ao_num) ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_coef , (ao_num,ao_prim_num_max) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ao_expo , (ao_num,ao_prim_num_max) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Primitive coefficients and exponents for each atomic orbital. Copied from shell info.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i, l
|
||||||
|
do i=1,ao_num
|
||||||
|
l = ao_shell(i)
|
||||||
|
ao_coef(i,:) = shell_coef(l,:)
|
||||||
|
ao_expo(i,:) = shell_expo(l,:)
|
||||||
|
end do
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, ao_prim_num_max ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Max number of primitives.
|
||||||
|
END_DOC
|
||||||
|
ao_prim_num_max = shell_prim_num_max
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, ao_first_of_shell, (shell_num) ]
|
BEGIN_PROVIDER [ integer, ao_first_of_shell, (shell_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -44,20 +62,20 @@ END_PROVIDER
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Coefficients including the |AO| normalization
|
! Coefficients including the |AO| normalization
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
|
do i=1,ao_num
|
||||||
|
l = ao_shell(i)
|
||||||
|
ao_coef_normalized(i,:) = shell_coef(l,:) * shell_normalization_factor(l)
|
||||||
|
end do
|
||||||
|
|
||||||
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
|
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
|
||||||
integer :: l, powA(3), nz
|
integer :: l, powA(3), nz
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
nz=100
|
nz=100
|
||||||
C_A(1) = 0.d0
|
C_A = 0.d0
|
||||||
C_A(2) = 0.d0
|
|
||||||
C_A(3) = 0.d0
|
|
||||||
ao_coef_normalized = 0.d0
|
|
||||||
|
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
|
|
||||||
! powA(1) = ao_power(i,1) + ao_power(i,2) + ao_power(i,3)
|
|
||||||
! powA(2) = 0
|
|
||||||
! powA(3) = 0
|
|
||||||
powA(1) = ao_power(i,1)
|
powA(1) = ao_power(i,1)
|
||||||
powA(2) = ao_power(i,2)
|
powA(2) = ao_power(i,2)
|
||||||
powA(3) = ao_power(i,3)
|
powA(3) = ao_power(i,3)
|
||||||
@ -67,18 +85,9 @@ END_PROVIDER
|
|||||||
do j=1,ao_prim_num(i)
|
do j=1,ao_prim_num(i)
|
||||||
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j), &
|
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j), &
|
||||||
powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
|
powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
|
||||||
ao_coef_normalized(i,j) = ao_coef(i,j)/dsqrt(norm)
|
ao_coef_normalized(i,j) = ao_coef_normalized(i,j)/dsqrt(norm)
|
||||||
enddo
|
|
||||||
else
|
|
||||||
do j=1,ao_prim_num(i)
|
|
||||||
ao_coef_normalized(i,j) = ao_coef(i,j)
|
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
|
|
||||||
powA(1) = ao_power(i,1)
|
|
||||||
powA(2) = ao_power(i,2)
|
|
||||||
powA(3) = ao_power(i,3)
|
|
||||||
|
|
||||||
! Normalization of the contracted basis functions
|
! Normalization of the contracted basis functions
|
||||||
if (ao_normalized) then
|
if (ao_normalized) then
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
|
@ -12,21 +12,21 @@ double precision function ao_value(i,r)
|
|||||||
integer :: power_ao(3)
|
integer :: power_ao(3)
|
||||||
double precision :: accu,dx,dy,dz,r2
|
double precision :: accu,dx,dy,dz,r2
|
||||||
num_ao = ao_nucl(i)
|
num_ao = ao_nucl(i)
|
||||||
! power_ao(1:3)= ao_power(i,1:3)
|
power_ao(1:3)= ao_power(i,1:3)
|
||||||
! center_ao(1:3) = nucl_coord(num_ao,1:3)
|
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||||
! dx = (r(1) - center_ao(1))
|
dx = (r(1) - center_ao(1))
|
||||||
! dy = (r(2) - center_ao(2))
|
dy = (r(2) - center_ao(2))
|
||||||
! dz = (r(3) - center_ao(3))
|
dz = (r(3) - center_ao(3))
|
||||||
! r2 = dx*dx + dy*dy + dz*dz
|
r2 = dx*dx + dy*dy + dz*dz
|
||||||
! dx = dx**power_ao(1)
|
dx = dx**power_ao(1)
|
||||||
! dy = dy**power_ao(2)
|
dy = dy**power_ao(2)
|
||||||
! dz = dz**power_ao(3)
|
dz = dz**power_ao(3)
|
||||||
|
|
||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
! do m=1,ao_prim_num(i)
|
do m=1,ao_prim_num(i)
|
||||||
! beta = ao_expo_ordered_transp(m,i)
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
! accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
|
accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
|
||||||
! enddo
|
enddo
|
||||||
ao_value = accu * dx * dy * dz
|
ao_value = accu * dx * dy * dz
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
! Spherical to cartesian transformation matrix obtained with
|
! Spherical to cartesian transformation matrix obtained with
|
||||||
! Horton (http://theochem.github.com/horton/, 2015)
|
! Horton (http://theochem.github.com/horton/, 2015)
|
||||||
|
|
||||||
! First index is the index of the cartesian AO, obtained by ao_power_index
|
! First index is the index of the carteisan AO, obtained by ao_power_index
|
||||||
! Second index is the index of the spherical AO
|
! Second index is the index of the spherical AO
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, cart_to_sphe_0, (1,1) ]
|
BEGIN_PROVIDER [ double precision, cart_to_sphe_0, (1,1) ]
|
||||||
|
5
src/ao_many_one_e_ints/NEED
Normal file
5
src/ao_many_one_e_ints/NEED
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
ao_one_e_ints
|
||||||
|
ao_two_e_ints
|
||||||
|
becke_numerical_grid
|
||||||
|
mo_one_e_ints
|
||||||
|
dft_utils_in_r
|
25
src/ao_many_one_e_ints/README.rst
Normal file
25
src/ao_many_one_e_ints/README.rst
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
==================
|
||||||
|
ao_many_one_e_ints
|
||||||
|
==================
|
||||||
|
|
||||||
|
This module contains A LOT of one-electron integrals of the type
|
||||||
|
A_ij( r ) = \int dr' phi_i(r') w(r,r') phi_j(r')
|
||||||
|
where r is a point in real space.
|
||||||
|
|
||||||
|
+) ao_gaus_gauss.irp.f: w(r,r') is a exp(-(r-r')^2) , and can be multiplied by x/y/z
|
||||||
|
+) ao_erf_gauss.irp.f : w(r,r') is a exp(-(r-r')^2) erf(mu * |r-r'|)/|r-r'| , and can be multiplied by x/y/z
|
||||||
|
+) ao_erf_gauss_grad.irp.f: w(r,r') is a exp(-(r-r')^2) erf(mu * |r-r'|)/|r-r'| , and can be multiplied by x/y/z, but evaluated with also one gradient of an AO function.
|
||||||
|
|
||||||
|
Fit of a Slater function and corresponding integrals
|
||||||
|
----------------------------------------------------
|
||||||
|
The file fit_slat_gauss.irp.f contains many useful providers/routines to fit a Slater function with 20 gaussian.
|
||||||
|
+) coef_fit_slat_gauss : coefficients of the gaussians to fit e^(-x)
|
||||||
|
+) expo_fit_slat_gauss : exponents of the gaussians to fit e^(-x)
|
||||||
|
|
||||||
|
Integrals involving Slater functions : stg_gauss_int.irp.f
|
||||||
|
|
||||||
|
Taylor expansion of full correlation factor
|
||||||
|
-------------------------------------------
|
||||||
|
In taylor_exp.irp.f you might find interesting integrals of the type
|
||||||
|
\int dr' exp( e^{-alpha |r-r|' - beta |r-r'|^2}) phi_i(r') phi_j(r')
|
||||||
|
evaluated as a Taylor expansion of the exponential.
|
269
src/ao_many_one_e_ints/ao_erf_gauss.irp.f
Normal file
269
src/ao_many_one_e_ints/ao_erf_gauss.irp.f
Normal file
@ -0,0 +1,269 @@
|
|||||||
|
|
||||||
|
subroutine phi_j_erf_mu_r_xyz_phi(i,j,mu_in, C_center, xyz_ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! xyz_ints(1/2/3) = int dr phi_j(r) [erf(mu |r - C|)/|r-C|] x/y/z phi_i(r)
|
||||||
|
!
|
||||||
|
! where phi_i and phi_j are AOs
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
double precision, intent(out):: xyz_ints(3)
|
||||||
|
integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
|
||||||
|
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
|
||||||
|
integer :: n_pt_in,l,m,mm
|
||||||
|
xyz_ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
! j
|
||||||
|
num_A = ao_nucl(j)
|
||||||
|
power_A(1:3)= ao_power(j,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
! i
|
||||||
|
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_ordered_transp(l,j)
|
||||||
|
do m=1,ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
do mm = 1, 3
|
||||||
|
! (x phi_i ) * phi_j
|
||||||
|
! x * (x - B_x)^b_x = b_x (x - B_x)^b_x + 1 * (x - B_x)^{b_x+1}
|
||||||
|
!
|
||||||
|
! first contribution :: B_x (x - B_x)^b_x :: usual integral multiplied by B_x
|
||||||
|
power_B_tmp = power_B
|
||||||
|
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
xyz_ints(mm) += contrib * B_center(mm) * ao_coef_normalized_ordered_transp(l,j) &
|
||||||
|
* ao_coef_normalized_ordered_transp(m,i)
|
||||||
|
! second contribution :: 1 * (x - B_x)^(b_x+1) :: integral with b_x=>b_x+1
|
||||||
|
power_B_tmp(mm) += 1
|
||||||
|
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
xyz_ints(mm) += contrib * 1.d0 * ao_coef_normalized_ordered_transp(l,j) &
|
||||||
|
* ao_coef_normalized_ordered_transp(m,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
double precision function phi_j_erf_mu_r_phi(i,j,mu_in, C_center)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! phi_j_erf_mu_r_phi = int dr phi_j(r) [erf(mu |r - C|)/|r-C|] phi_i(r)
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
integer :: num_A,power_A(3), num_b, power_B(3)
|
||||||
|
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
|
||||||
|
integer :: n_pt_in,l,m
|
||||||
|
phi_j_erf_mu_r_phi = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
! j
|
||||||
|
num_A = ao_nucl(j)
|
||||||
|
power_A(1:3)= ao_power(j,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
! i
|
||||||
|
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_ordered_transp(l,j)
|
||||||
|
do m=1,ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
phi_j_erf_mu_r_phi += contrib * ao_coef_normalized_ordered_transp(l,j) &
|
||||||
|
* ao_coef_normalized_ordered_transp(m,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine erfc_mu_gauss_xyz_ij_ao(i,j,mu, C_center, delta,gauss_ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! gauss_ints(m) = \int dr exp(-delta (r - C)^2 ) x/y/z * ( 1 - erf(mu |r-r'|))/ |r-r'| * AO_i(r') * AO_j(r')
|
||||||
|
!
|
||||||
|
! with m = 1 ==> x, m = 2, m = 3 ==> z
|
||||||
|
!
|
||||||
|
! m = 4 ==> no x/y/z
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: mu, C_center(3),delta
|
||||||
|
double precision, intent(out):: gauss_ints(4)
|
||||||
|
|
||||||
|
integer :: num_A,power_A(3), num_b, power_B(3)
|
||||||
|
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
|
||||||
|
double precision :: xyz_ints(4)
|
||||||
|
integer :: n_pt_in,l,m,mm
|
||||||
|
gauss_ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
! j
|
||||||
|
num_A = ao_nucl(j)
|
||||||
|
power_A(1:3)= ao_power(j,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
! i
|
||||||
|
num_B = ao_nucl(i)
|
||||||
|
power_B(1:3)= ao_power(i,1:3)
|
||||||
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
|
||||||
|
gauss_ints = 0.d0
|
||||||
|
do l=1,ao_prim_num(j)
|
||||||
|
alpha = ao_expo_ordered_transp(l,j)
|
||||||
|
do m=1,ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
call erfc_mu_gauss_xyz(C_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in,xyz_ints)
|
||||||
|
do mm = 1, 4
|
||||||
|
gauss_ints(mm) += xyz_ints(mm) * ao_coef_normalized_ordered_transp(l,j) &
|
||||||
|
* ao_coef_normalized_ordered_transp(m,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine erf_mu_gauss_ij_ao(i,j,mu, C_center, delta,gauss_ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! gauss_ints(m) = \int dr exp(-delta (r - C)^2 ) * erf(mu |r-r'|)/ |r-r'| * AO_i(r') * AO_j(r')
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: mu, C_center(3),delta
|
||||||
|
double precision, intent(out):: gauss_ints
|
||||||
|
|
||||||
|
integer :: num_A,power_A(3), num_b, power_B(3)
|
||||||
|
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
|
||||||
|
double precision :: integral , erf_mu_gauss
|
||||||
|
integer :: n_pt_in,l,m,mm
|
||||||
|
gauss_ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
! j
|
||||||
|
num_A = ao_nucl(j)
|
||||||
|
power_A(1:3)= ao_power(j,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
! i
|
||||||
|
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_ordered_transp(l,j)
|
||||||
|
do m=1,ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
if(dabs(ao_coef_normalized_ordered_transp(l,j) * ao_coef_normalized_ordered_transp(m,i)).lt.1.d-12)cycle
|
||||||
|
integral = erf_mu_gauss(C_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in)
|
||||||
|
gauss_ints += integral * ao_coef_normalized_ordered_transp(l,j) &
|
||||||
|
* ao_coef_normalized_ordered_transp(m,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine NAI_pol_x_mult_erf_ao(i_ao,j_ao,mu_in,C_center,ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! 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
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
integer, intent(in) :: i_ao,j_ao
|
||||||
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
double precision, intent(out):: ints(3)
|
||||||
|
double precision :: A_center(3), B_center(3),integral, alpha,beta
|
||||||
|
double precision :: NAI_pol_mult_erf
|
||||||
|
integer :: i,j,num_A,num_B, power_A(3), power_B(3), n_pt_in, power_xA(3),m
|
||||||
|
ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j_ao,i_ao).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
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_xA = power_A
|
||||||
|
! x * phi_i(r) = x * (x-Ax)**ax = (x-Ax)**(ax+1) + Ax * (x-Ax)**ax
|
||||||
|
power_xA(m) += 1
|
||||||
|
do j = 1, ao_prim_num(j_ao)
|
||||||
|
beta = ao_expo_ordered_transp(j,j_ao)
|
||||||
|
! First term = (x-Ax)**(ax+1)
|
||||||
|
integral = NAI_pol_mult_erf(A_center,B_center,power_xA,power_B,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
ints(m) += integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
|
||||||
|
! Second term = Ax * (x-Ax)**(ax)
|
||||||
|
integral = NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
ints(m) += A_center(m) * integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine NAI_pol_x_specify_mult_erf_ao(i_ao,j_ao,mu_in,C_center,m,ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
! $\int_{-\infty}^{infty} dr X(m) * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||||
|
!
|
||||||
|
! if m == 1 X(m) = x, m == 1 X(m) = y, m == 1 X(m) = z
|
||||||
|
END_DOC
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
integer, intent(in) :: i_ao,j_ao,m
|
||||||
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
double precision, intent(out):: ints
|
||||||
|
double precision :: A_center(3), B_center(3),integral, alpha,beta
|
||||||
|
double precision :: NAI_pol_mult_erf
|
||||||
|
integer :: i,j,num_A,num_B, power_A(3), power_B(3), n_pt_in, power_xA(3)
|
||||||
|
ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j_ao,i_ao).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
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)
|
||||||
|
power_xA = power_A
|
||||||
|
! x * phi_i(r) = x * (x-Ax)**ax = (x-Ax)**(ax+1) + Ax * (x-Ax)**ax
|
||||||
|
power_xA(m) += 1
|
||||||
|
do j = 1, ao_prim_num(j_ao)
|
||||||
|
beta = ao_expo_ordered_transp(j,j_ao)
|
||||||
|
! First term = (x-Ax)**(ax+1)
|
||||||
|
integral = NAI_pol_mult_erf(A_center,B_center,power_xA,power_B,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
ints += integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
|
||||||
|
! Second term = Ax * (x-Ax)**(ax)
|
||||||
|
integral = NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
ints += A_center(m) * integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
150
src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f
Normal file
150
src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f
Normal file
@ -0,0 +1,150 @@
|
|||||||
|
subroutine phi_j_erf_mu_r_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dxyz_ints(1/2/3) = int dr phi_i(r) [erf(mu |r - C|)/|r-C|] d/d(x/y/z) phi_i(r)
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
double precision, intent(out):: dxyz_ints(3)
|
||||||
|
integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
|
||||||
|
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf,coef,thr
|
||||||
|
integer :: n_pt_in,l,m,mm
|
||||||
|
thr = 1.d-12
|
||||||
|
dxyz_ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.thr)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
! j
|
||||||
|
num_A = ao_nucl(j)
|
||||||
|
power_A(1:3)= ao_power(j,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
! i
|
||||||
|
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_ordered_transp(l,j)
|
||||||
|
do m=1,ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_normalized_ordered_transp(m,i)
|
||||||
|
if(dabs(coef).lt.thr)cycle
|
||||||
|
do mm = 1, 3
|
||||||
|
! (d/dx phi_i ) * phi_j
|
||||||
|
! d/dx * (x - B_x)^b_x exp(-beta * (x -B_x)^2)= [b_x * (x - B_x)^(b_x - 1) - 2 beta * (x - B_x)^(b_x + 1)] exp(-beta * (x -B_x)^2)
|
||||||
|
!
|
||||||
|
! first contribution :: b_x (x - B_x)^(b_x-1) :: integral with b_x=>b_x-1 multiplied by b_x
|
||||||
|
power_B_tmp = power_B
|
||||||
|
power_B_tmp(mm) += -1
|
||||||
|
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
dxyz_ints(mm) += contrib * dble(power_B(mm)) * coef
|
||||||
|
|
||||||
|
! second contribution :: - 2 beta * (x - B_x)^(b_x + 1) :: integral with b_x=> b_x+1 multiplied by -2 * beta
|
||||||
|
power_B_tmp = power_B
|
||||||
|
power_B_tmp(mm) += 1
|
||||||
|
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
dxyz_ints(mm) += contrib * (-2.d0 * beta ) * coef
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine phi_j_erf_mu_r_dxyz_phi_bis(i,j,mu_in, C_center, dxyz_ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dxyz_ints(1/2/3) = int dr phi_j(r) [erf(mu |r - C|)/|r-C|] d/d(x/y/z) phi_i(r)
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
double precision, intent(out):: dxyz_ints(3)
|
||||||
|
integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
|
||||||
|
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
|
||||||
|
double precision :: thr, coef
|
||||||
|
integer :: n_pt_in,l,m,mm,kk
|
||||||
|
thr = 1.d-12
|
||||||
|
dxyz_ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.thr)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
! j == A
|
||||||
|
num_A = ao_nucl(j)
|
||||||
|
power_A(1:3)= ao_power(j,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
! i == B
|
||||||
|
num_B = ao_nucl(i)
|
||||||
|
power_B(1:3)= ao_power(i,1:3)
|
||||||
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
|
||||||
|
dxyz_ints = 0.d0
|
||||||
|
do l=1,ao_prim_num(j)
|
||||||
|
alpha = ao_expo_ordered_transp(l,j)
|
||||||
|
do m=1,ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
do kk = 1, 2 ! loop over the extra terms induced by the d/dx/y/z * AO(i)
|
||||||
|
do mm = 1, 3
|
||||||
|
power_B_tmp = power_B
|
||||||
|
power_B_tmp(mm) = power_ord_grad_transp(kk,mm,i)
|
||||||
|
coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_ord_grad_transp(kk,mm,m,i)
|
||||||
|
if(dabs(coef).lt.thr)cycle
|
||||||
|
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
dxyz_ints(mm) += contrib * coef
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine phi_j_erf_mu_r_xyz_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dxyz_ints(1/2/3) = int dr phi_j(r) x/y/z [erf(mu |r - C|)/|r-C|] d/d(x/y/z) phi_i(r)
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
double precision, intent(out):: dxyz_ints(3)
|
||||||
|
integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
|
||||||
|
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
|
||||||
|
double precision :: thr, coef
|
||||||
|
integer :: n_pt_in,l,m,mm,kk
|
||||||
|
thr = 1.d-12
|
||||||
|
dxyz_ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.thr)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
! j == A
|
||||||
|
num_A = ao_nucl(j)
|
||||||
|
power_A(1:3)= ao_power(j,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
! i == B
|
||||||
|
num_B = ao_nucl(i)
|
||||||
|
power_B(1:3)= ao_power(i,1:3)
|
||||||
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
|
||||||
|
dxyz_ints = 0.d0
|
||||||
|
do l=1,ao_prim_num(j)
|
||||||
|
alpha = ao_expo_ordered_transp(l,j)
|
||||||
|
do m=1,ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
do kk = 1, 4 ! loop over the extra terms induced by the x/y/z * d dx/y/z AO(i)
|
||||||
|
do mm = 1, 3
|
||||||
|
power_B_tmp = power_B
|
||||||
|
power_B_tmp(mm) = power_ord_xyz_grad_transp(kk,mm,i)
|
||||||
|
coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_ord_xyz_grad_transp(kk,mm,m,i)
|
||||||
|
if(dabs(coef).lt.thr)cycle
|
||||||
|
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
|
||||||
|
dxyz_ints(mm) += contrib * coef
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
137
src/ao_many_one_e_ints/ao_gaus_gauss.irp.f
Normal file
137
src/ao_many_one_e_ints/ao_gaus_gauss.irp.f
Normal file
@ -0,0 +1,137 @@
|
|||||||
|
subroutine overlap_gauss_xyz_r12_ao(D_center,delta,i,j,gauss_ints)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! gauss_ints(m) = \int dr AO_i(r) AO_j(r) x/y/z e^{-delta |r-D_center|^2}
|
||||||
|
!
|
||||||
|
! with m == 1 ==> x, m == 2 ==> y, m == 3 ==> z
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: D_center(3), delta
|
||||||
|
double precision, intent(out) :: gauss_ints(3)
|
||||||
|
|
||||||
|
integer :: num_a,num_b,power_A(3), power_B(3),l,k,m
|
||||||
|
double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,gauss_ints_tmp(3)
|
||||||
|
gauss_ints = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
num_A = ao_nucl(i)
|
||||||
|
power_A(1:3)= ao_power(i,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
num_B = ao_nucl(j)
|
||||||
|
power_B(1:3)= ao_power(j,1:3)
|
||||||
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
do l=1,ao_prim_num(i)
|
||||||
|
alpha = ao_expo_ordered_transp(l,i)
|
||||||
|
do k=1,ao_prim_num(j)
|
||||||
|
beta = ao_expo_ordered_transp(k,j)
|
||||||
|
call overlap_gauss_xyz_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,gauss_ints_tmp)
|
||||||
|
do m = 1, 3
|
||||||
|
gauss_ints(m) += gauss_ints_tmp(m) * ao_coef_normalized_ordered_transp(l,i) &
|
||||||
|
* ao_coef_normalized_ordered_transp(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
double precision function overlap_gauss_xyz_r12_ao_specific(D_center,delta,i,j,mx)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! \int dr AO_i(r) AO_j(r) x/y/z e^{-delta |r-D_center|^2}
|
||||||
|
!
|
||||||
|
! with mx == 1 ==> x, mx == 2 ==> y, mx == 3 ==> z
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j,mx
|
||||||
|
double precision, intent(in) :: D_center(3), delta
|
||||||
|
|
||||||
|
integer :: num_a,num_b,power_A(3), power_B(3),l,k
|
||||||
|
double precision :: gauss_int
|
||||||
|
double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta
|
||||||
|
double precision :: overlap_gauss_xyz_r12_specific
|
||||||
|
overlap_gauss_xyz_r12_ao_specific = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
num_A = ao_nucl(i)
|
||||||
|
power_A(1:3)= ao_power(i,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
num_B = ao_nucl(j)
|
||||||
|
power_B(1:3)= ao_power(j,1:3)
|
||||||
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
do l=1,ao_prim_num(i)
|
||||||
|
alpha = ao_expo_ordered_transp(l,i)
|
||||||
|
do k=1,ao_prim_num(j)
|
||||||
|
beta = ao_expo_ordered_transp(k,j)
|
||||||
|
gauss_int = overlap_gauss_xyz_r12_specific(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,mx)
|
||||||
|
overlap_gauss_xyz_r12_ao_specific = gauss_int * ao_coef_normalized_ordered_transp(l,i) &
|
||||||
|
* ao_coef_normalized_ordered_transp(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine overlap_gauss_r12_all_ao(D_center,delta,aos_ints)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: D_center(3), delta
|
||||||
|
double precision, intent(out):: aos_ints(ao_num,ao_num)
|
||||||
|
|
||||||
|
integer :: num_a,num_b,power_A(3), power_B(3),l,k,i,j
|
||||||
|
double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,analytical_j
|
||||||
|
aos_ints = 0.d0
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
if(ao_overlap_abs(j,i).lt.1.d-12)cycle
|
||||||
|
num_A = ao_nucl(i)
|
||||||
|
power_A(1:3)= ao_power(i,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
num_B = ao_nucl(j)
|
||||||
|
power_B(1:3)= ao_power(j,1:3)
|
||||||
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
do l=1,ao_prim_num(i)
|
||||||
|
alpha = ao_expo_ordered_transp(l,i)
|
||||||
|
do k=1,ao_prim_num(j)
|
||||||
|
beta = ao_expo_ordered_transp(k,j)
|
||||||
|
analytical_j = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
|
||||||
|
aos_ints(j,i) += analytical_j * ao_coef_normalized_ordered_transp(l,i) &
|
||||||
|
* ao_coef_normalized_ordered_transp(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function overlap_gauss_r12_ao(D_center,delta,i,j)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! \int dr AO_i(r) AO_j(r) e^{-delta |r-D_center|^2}
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
double precision, intent(in) :: D_center(3), delta
|
||||||
|
|
||||||
|
integer :: num_a,num_b,power_A(3), power_B(3),l,k
|
||||||
|
double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,analytical_j
|
||||||
|
overlap_gauss_r12_ao = 0.d0
|
||||||
|
if(ao_overlap_abs(j,i).lt.1.d-12)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
! TODO :: PUT CYCLES IN LOOPS
|
||||||
|
num_A = ao_nucl(i)
|
||||||
|
power_A(1:3)= ao_power(i,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
num_B = ao_nucl(j)
|
||||||
|
power_B(1:3)= ao_power(j,1:3)
|
||||||
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
do l=1,ao_prim_num(i)
|
||||||
|
alpha = ao_expo_ordered_transp(l,i)
|
||||||
|
do k=1,ao_prim_num(j)
|
||||||
|
beta = ao_expo_ordered_transp(k,j)
|
||||||
|
analytical_j = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
|
||||||
|
overlap_gauss_r12_ao += analytical_j * ao_coef_normalized_ordered_transp(l,i) &
|
||||||
|
* ao_coef_normalized_ordered_transp(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
94
src/ao_many_one_e_ints/fit_slat_gauss.irp.f
Normal file
94
src/ao_many_one_e_ints/fit_slat_gauss.irp.f
Normal file
@ -0,0 +1,94 @@
|
|||||||
|
BEGIN_PROVIDER [integer, n_max_fit_slat]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! number of gaussian to fit exp(-x)
|
||||||
|
!
|
||||||
|
! I took 20 gaussians from the program bassto.f
|
||||||
|
END_DOC
|
||||||
|
n_max_fit_slat = 20
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, coef_fit_slat_gauss, (n_max_fit_slat)]
|
||||||
|
&BEGIN_PROVIDER [double precision, expo_fit_slat_gauss, (n_max_fit_slat)]
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
BEGIN_DOC
|
||||||
|
! fit the exp(-x) as
|
||||||
|
!
|
||||||
|
! \sum_{i = 1, n_max_fit_slat} coef_fit_slat_gauss(i) * exp(-expo_fit_slat_gauss(i) * x**2)
|
||||||
|
!
|
||||||
|
! The coefficient are taken from the program bassto.f
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
|
||||||
|
expo_fit_slat_gauss(01)=30573.77073000000
|
||||||
|
coef_fit_slat_gauss(01)=0.00338925525
|
||||||
|
expo_fit_slat_gauss(02)=5608.45238100000
|
||||||
|
coef_fit_slat_gauss(02)=0.00536433869
|
||||||
|
expo_fit_slat_gauss(03)=1570.95673400000
|
||||||
|
coef_fit_slat_gauss(03)=0.00818702846
|
||||||
|
expo_fit_slat_gauss(04)=541.39785110000
|
||||||
|
coef_fit_slat_gauss(04)=0.01202047655
|
||||||
|
expo_fit_slat_gauss(05)=212.43469630000
|
||||||
|
coef_fit_slat_gauss(05)=0.01711289568
|
||||||
|
expo_fit_slat_gauss(06)=91.31444574000
|
||||||
|
coef_fit_slat_gauss(06)=0.02376001022
|
||||||
|
expo_fit_slat_gauss(07)=42.04087246000
|
||||||
|
coef_fit_slat_gauss(07)=0.03229121736
|
||||||
|
expo_fit_slat_gauss(08)=20.43200443000
|
||||||
|
coef_fit_slat_gauss(08)=0.04303646818
|
||||||
|
expo_fit_slat_gauss(09)=10.37775161000
|
||||||
|
coef_fit_slat_gauss(09)=0.05624657578
|
||||||
|
expo_fit_slat_gauss(10)=5.46880754500
|
||||||
|
coef_fit_slat_gauss(10)=0.07192311571
|
||||||
|
expo_fit_slat_gauss(11)=2.97373529200
|
||||||
|
coef_fit_slat_gauss(11)=0.08949389001
|
||||||
|
expo_fit_slat_gauss(12)=1.66144190200
|
||||||
|
coef_fit_slat_gauss(12)=0.10727599240
|
||||||
|
expo_fit_slat_gauss(13)=0.95052560820
|
||||||
|
coef_fit_slat_gauss(13)=0.12178961750
|
||||||
|
expo_fit_slat_gauss(14)=0.55528683970
|
||||||
|
coef_fit_slat_gauss(14)=0.12740141870
|
||||||
|
expo_fit_slat_gauss(15)=0.33043360020
|
||||||
|
coef_fit_slat_gauss(15)=0.11759168160
|
||||||
|
expo_fit_slat_gauss(16)=0.19982303230
|
||||||
|
coef_fit_slat_gauss(16)=0.08953504394
|
||||||
|
expo_fit_slat_gauss(17)=0.12246840760
|
||||||
|
coef_fit_slat_gauss(17)=0.05066721317
|
||||||
|
expo_fit_slat_gauss(18)=0.07575825322
|
||||||
|
coef_fit_slat_gauss(18)=0.01806363869
|
||||||
|
expo_fit_slat_gauss(19)=0.04690146243
|
||||||
|
coef_fit_slat_gauss(19)=0.00305632563
|
||||||
|
expo_fit_slat_gauss(20)=0.02834749861
|
||||||
|
coef_fit_slat_gauss(20)=0.00013317513
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
double precision function slater_fit_gam(x,gam)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: x,gam
|
||||||
|
BEGIN_DOC
|
||||||
|
! fit of the function exp(-gam * x) with gaussian functions
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
slater_fit_gam = 0.d0
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
slater_fit_gam += coef_fit_slat_gauss(i) * dexp(-expo_fit_slat_gauss(i) * gam * gam * x * x)
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine expo_fit_slater_gam(gam,expos)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! returns the array of the exponents of the gaussians to fit exp(-gam*x)
|
||||||
|
END_DOC
|
||||||
|
double precision, intent(in) :: gam
|
||||||
|
double precision, intent(out) :: expos(n_max_fit_slat)
|
||||||
|
integer :: i
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
expos(i) = expo_fit_slat_gauss(i) * gam * gam
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
342
src/ao_many_one_e_ints/grad_related_ints.irp.f
Normal file
342
src/ao_many_one_e_ints/grad_related_ints.irp.f
Normal file
@ -0,0 +1,342 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu, ( ao_num, ao_num,n_points_final_grid)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R| - 1)/|r - R|
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint
|
||||||
|
double precision :: mu,r(3),NAI_pol_mult_erf_ao
|
||||||
|
double precision :: int_mu, int_coulomb
|
||||||
|
provide mu_erf final_grid_points
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (i,j,ipoint,mu,r,int_mu,int_coulomb) &
|
||||||
|
!$OMP SHARED (ao_num,n_points_final_grid,v_ij_erf_rk_cst_mu,final_grid_points,mu_erf)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = i, ao_num
|
||||||
|
mu = mu_erf
|
||||||
|
r(1) = final_grid_points(1,ipoint)
|
||||||
|
r(2) = final_grid_points(2,ipoint)
|
||||||
|
r(3) = final_grid_points(3,ipoint)
|
||||||
|
int_mu = NAI_pol_mult_erf_ao(i,j,mu,r)
|
||||||
|
int_coulomb = NAI_pol_mult_erf_ao(i,j,1.d+9,r)
|
||||||
|
v_ij_erf_rk_cst_mu(j,i,ipoint)= (int_mu - int_coulomb )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, i-1
|
||||||
|
v_ij_erf_rk_cst_mu(j,i,ipoint)= v_ij_erf_rk_cst_mu(i,j,ipoint)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for v_ij_erf_rk_cst_mu ',wall1 - wall0
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_transp, (n_points_final_grid, ao_num, ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R| - 1)/|r - R|
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint
|
||||||
|
double precision :: mu,r(3),NAI_pol_mult_erf_ao
|
||||||
|
double precision :: int_mu, int_coulomb
|
||||||
|
provide mu_erf final_grid_points
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (i,j,ipoint,mu,r,int_mu,int_coulomb) &
|
||||||
|
!$OMP SHARED (ao_num,n_points_final_grid,v_ij_erf_rk_cst_mu_transp,final_grid_points,mu_erf)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = i, ao_num
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
mu = mu_erf
|
||||||
|
r(1) = final_grid_points(1,ipoint)
|
||||||
|
r(2) = final_grid_points(2,ipoint)
|
||||||
|
r(3) = final_grid_points(3,ipoint)
|
||||||
|
int_mu = NAI_pol_mult_erf_ao(i,j,mu,r)
|
||||||
|
int_coulomb = NAI_pol_mult_erf_ao(i,j,1.d+9,r)
|
||||||
|
v_ij_erf_rk_cst_mu_transp(ipoint,j,i)= (int_mu - int_coulomb )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, i-1
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
v_ij_erf_rk_cst_mu_transp(ipoint,j,i)= v_ij_erf_rk_cst_mu_transp(ipoint,i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for v_ij_erf_rk_cst_mu_transp ',wall1 - wall0
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_tmp, (3,ao_num, ao_num,n_points_final_grid)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint,m
|
||||||
|
double precision :: mu,r(3),ints(3),ints_coulomb(3)
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (i,j,ipoint,mu,r,ints,m,ints_coulomb) &
|
||||||
|
!$OMP SHARED (ao_num,n_points_final_grid,x_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = i, ao_num
|
||||||
|
mu = mu_erf
|
||||||
|
r(1) = final_grid_points(1,ipoint)
|
||||||
|
r(2) = final_grid_points(2,ipoint)
|
||||||
|
r(3) = final_grid_points(3,ipoint)
|
||||||
|
call NAI_pol_x_mult_erf_ao(i,j,mu,r,ints)
|
||||||
|
call NAI_pol_x_mult_erf_ao(i,j,1.d+9,r,ints_coulomb)
|
||||||
|
do m = 1, 3
|
||||||
|
x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint) = ( ints(m) - ints_coulomb(m))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, i-1
|
||||||
|
do m = 1, 3
|
||||||
|
x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint)= x_v_ij_erf_rk_cst_mu_tmp(m,i,j,ipoint)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for x_v_ij_erf_rk_cst_mu_tmp',wall1 - wall0
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu, (ao_num, ao_num,n_points_final_grid,3)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint,m
|
||||||
|
double precision :: mu,r(3),ints,ints_coulomb
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
do m = 1, 3
|
||||||
|
x_v_ij_erf_rk_cst_mu(j,i,ipoint,m)= x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for x_v_ij_erf_rk_cst_mu',wall1 - wall0
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_transp, (ao_num, ao_num,3,n_points_final_grid)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint,m
|
||||||
|
double precision :: mu,r(3),ints,ints_coulomb
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
do m = 1, 3
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
x_v_ij_erf_rk_cst_mu_transp(j,i,m,ipoint)= x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for x_v_ij_erf_rk_cst_mu_transp',wall1 - wall0
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_transp_bis, (n_points_final_grid,ao_num, ao_num,3)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint,m
|
||||||
|
double precision :: mu,r(3),ints,ints_coulomb
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
do m = 1, 3
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
x_v_ij_erf_rk_cst_mu_transp_bis(ipoint,j,i,m)= x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for x_v_ij_erf_rk_cst_mu_transp',wall1 - wall0
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, d_dx_v_ij_erf_rk_cst_mu_tmp, (3,n_points_final_grid,ao_num, ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! d_dx_v_ij_erf_rk_cst_mu_tmp(m,R,j,i) = int dr phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r)
|
||||||
|
!
|
||||||
|
! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint,m
|
||||||
|
double precision :: mu,r(3),ints(3),ints_coulomb(3)
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (i,j,ipoint,mu,r,ints,m,ints_coulomb) &
|
||||||
|
!$OMP SHARED (ao_num,n_points_final_grid,d_dx_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
mu = mu_erf
|
||||||
|
r(1) = final_grid_points(1,ipoint)
|
||||||
|
r(2) = final_grid_points(2,ipoint)
|
||||||
|
r(3) = final_grid_points(3,ipoint)
|
||||||
|
call phi_j_erf_mu_r_dxyz_phi(j,i,mu, r, ints)
|
||||||
|
call phi_j_erf_mu_r_dxyz_phi(j,i,1.d+9, r, ints_coulomb)
|
||||||
|
do m = 1, 3
|
||||||
|
d_dx_v_ij_erf_rk_cst_mu_tmp(m,ipoint,j,i) = ( ints(m) - ints_coulomb(m))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for d_dx_v_ij_erf_rk_cst_mu_tmp',wall1 - wall0
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, d_dx_v_ij_erf_rk_cst_mu, (n_points_final_grid,ao_num, ao_num,3)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! d_dx_v_ij_erf_rk_cst_mu_tmp(j,i,R,m) = int dr phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r)
|
||||||
|
!
|
||||||
|
! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint,m
|
||||||
|
double precision :: mu,r(3),ints,ints_coulomb
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
do m = 1, 3
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,m)= d_dx_v_ij_erf_rk_cst_mu_tmp(m,ipoint,j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for d_dx_v_ij_erf_rk_cst_mu',wall1 - wall0
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, x_d_dx_v_ij_erf_rk_cst_mu_tmp, (3,n_points_final_grid,ao_num, ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! x_d_dx_v_ij_erf_rk_cst_mu_tmp(m,j,i,R) = int dr x phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r)
|
||||||
|
!
|
||||||
|
! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint,m
|
||||||
|
double precision :: mu,r(3),ints(3),ints_coulomb(3)
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (i,j,ipoint,mu,r,ints,m,ints_coulomb) &
|
||||||
|
!$OMP SHARED (ao_num,n_points_final_grid,x_d_dx_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
mu = mu_erf
|
||||||
|
r(1) = final_grid_points(1,ipoint)
|
||||||
|
r(2) = final_grid_points(2,ipoint)
|
||||||
|
r(3) = final_grid_points(3,ipoint)
|
||||||
|
call phi_j_erf_mu_r_xyz_dxyz_phi(j,i,mu, r, ints)
|
||||||
|
call phi_j_erf_mu_r_xyz_dxyz_phi(j,i,1.d+9, r, ints_coulomb)
|
||||||
|
do m = 1, 3
|
||||||
|
x_d_dx_v_ij_erf_rk_cst_mu_tmp(m,ipoint,j,i) = ( ints(m) - ints_coulomb(m))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for x_d_dx_v_ij_erf_rk_cst_mu_tmp',wall1 - wall0
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, x_d_dx_v_ij_erf_rk_cst_mu, (n_points_final_grid,ao_num, ao_num,3)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! x_d_dx_v_ij_erf_rk_cst_mu_tmp(j,i,R,m) = int dr x phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r)
|
||||||
|
!
|
||||||
|
! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,ipoint,m
|
||||||
|
double precision :: mu,r(3),ints,ints_coulomb
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
call wall_time(wall0)
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
do m = 1, 3
|
||||||
|
x_d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,m)= x_d_dx_v_ij_erf_rk_cst_mu_tmp(m,ipoint,j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'wall time for x_d_dx_v_ij_erf_rk_cst_mu',wall1 - wall0
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
195
src/ao_many_one_e_ints/prim_int_erf_gauss.irp.f
Normal file
195
src/ao_many_one_e_ints/prim_int_erf_gauss.irp.f
Normal file
@ -0,0 +1,195 @@
|
|||||||
|
double precision function NAI_pol_mult_erf_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral R^3 :
|
||||||
|
!
|
||||||
|
! .. 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 | }$ exp(-delta (r - D)^2 ).
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
double precision, intent(in) :: D_center(3), delta ! pure gaussian "D"
|
||||||
|
double precision, intent(in) :: C_center(3),mu ! coulomb center "C" and "mu" in the erf(mu*x)/x function
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
|
||||||
|
double precision :: NAI_pol_mult_erf
|
||||||
|
! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
|
||||||
|
double precision :: A_new(0:max_dim,3)! new polynom
|
||||||
|
double precision :: A_center_new(3) ! new center
|
||||||
|
integer :: iorder_a_new(3) ! i_order(i) = order of the new polynom ==> should be equal to power_A
|
||||||
|
double precision :: alpha_new ! new exponent
|
||||||
|
double precision :: fact_a_new ! constant factor
|
||||||
|
double precision :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr
|
||||||
|
integer :: d(3),i,lx,ly,lz,iorder_tmp(3)
|
||||||
|
thr = 1.d-10
|
||||||
|
d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 ) == 0
|
||||||
|
|
||||||
|
! New gaussian/polynom defined by :: new pol new center new expo cst fact new order
|
||||||
|
call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , &
|
||||||
|
delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
|
||||||
|
! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
|
||||||
|
accu = 0.d0
|
||||||
|
do lx = 0, iorder_a_new(1)
|
||||||
|
coefx = A_new(lx,1)
|
||||||
|
if(dabs(coefx).lt.thr)cycle
|
||||||
|
iorder_tmp(1) = lx
|
||||||
|
do ly = 0, iorder_a_new(2)
|
||||||
|
coefy = A_new(ly,2)
|
||||||
|
coefxy = coefx * coefy
|
||||||
|
if(dabs(coefxy).lt.thr)cycle
|
||||||
|
iorder_tmp(2) = ly
|
||||||
|
do lz = 0, iorder_a_new(3)
|
||||||
|
coefz = A_new(lz,3)
|
||||||
|
coefxyz = coefxy * coefz
|
||||||
|
if(dabs(coefxyz).lt.thr)cycle
|
||||||
|
iorder_tmp(3) = lz
|
||||||
|
accu += coefxyz * NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B,alpha_new,beta,C_center,n_pt_max_integrals,mu)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
NAI_pol_mult_erf_gauss_r12 = fact_a_new * accu
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine erfc_mu_gauss_xyz(D_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in,xyz_ints)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr exp(-delta (r - D)^2 ) x/y/z * (1 - erf(mu |r-r'|))/ |r-r'| * (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
!
|
||||||
|
! xyz_ints(1) = x , xyz_ints(2) = y, xyz_ints(3) = z, xyz_ints(4) = x^0
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
double precision, intent(in) :: D_center(3), delta,mu ! pure gaussian "D" and mu parameter
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3),n_pt_in
|
||||||
|
double precision, intent(out) :: xyz_ints(4)
|
||||||
|
|
||||||
|
double precision :: NAI_pol_mult_erf
|
||||||
|
! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
|
||||||
|
double precision :: A_new(0:max_dim,3)! new polynom
|
||||||
|
double precision :: A_center_new(3) ! new center
|
||||||
|
integer :: iorder_a_new(3) ! i_order(i) = order of the new polynom ==> should be equal to power_A
|
||||||
|
double precision :: alpha_new ! new exponent
|
||||||
|
double precision :: fact_a_new ! constant factor
|
||||||
|
double precision :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr,contrib,contrib_inf,mu_inf
|
||||||
|
integer :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,mm
|
||||||
|
integer :: power_B_tmp(3)
|
||||||
|
dim1=100
|
||||||
|
mu_inf = 1.d+10
|
||||||
|
thr = 1.d-10
|
||||||
|
d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 ) == 0
|
||||||
|
|
||||||
|
! New gaussian/polynom defined by :: new pol new center new expo cst fact new order
|
||||||
|
call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , &
|
||||||
|
delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
|
||||||
|
! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
|
||||||
|
xyz_ints = 0.d0
|
||||||
|
do lx = 0, iorder_a_new(1)
|
||||||
|
coefx = A_new(lx,1)
|
||||||
|
if(dabs(coefx).lt.thr)cycle
|
||||||
|
iorder_tmp(1) = lx
|
||||||
|
do ly = 0, iorder_a_new(2)
|
||||||
|
coefy = A_new(ly,2)
|
||||||
|
coefxy = coefx * coefy
|
||||||
|
if(dabs(coefxy).lt.thr)cycle
|
||||||
|
iorder_tmp(2) = ly
|
||||||
|
do lz = 0, iorder_a_new(3)
|
||||||
|
coefz = A_new(lz,3)
|
||||||
|
coefxyz = coefxy * coefz
|
||||||
|
if(dabs(coefxyz).lt.thr)cycle
|
||||||
|
iorder_tmp(3) = lz
|
||||||
|
power_B_tmp = power_B
|
||||||
|
contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)
|
||||||
|
contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)
|
||||||
|
xyz_ints(4) += (contrib_inf - contrib) * coefxyz ! usual term with no x/y/z
|
||||||
|
|
||||||
|
do mm = 1, 3
|
||||||
|
! (x phi_i ) * phi_j
|
||||||
|
! x * (x - B_x)^b_x = B_x (x - B_x)^b_x + 1 * (x - B_x)^{b_x+1}
|
||||||
|
|
||||||
|
!
|
||||||
|
! first contribution :: B_x (x - B_x)^b_x :: usual integral multiplied by B_x
|
||||||
|
power_B_tmp = power_B
|
||||||
|
contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)
|
||||||
|
contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)
|
||||||
|
xyz_ints(mm) += (contrib_inf - contrib) * B_center(mm) * coefxyz
|
||||||
|
|
||||||
|
!
|
||||||
|
! second contribution :: (x - B_x)^(b_x+1) :: integral with b_x=>b_x+1
|
||||||
|
power_B_tmp(mm) += 1
|
||||||
|
contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)
|
||||||
|
contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)
|
||||||
|
xyz_ints(mm) += (contrib_inf - contrib) * coefxyz
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
xyz_ints *= fact_a_new
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
double precision function erf_mu_gauss(D_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr exp(-delta (r - D)^2 ) erf(mu*|r-r'|)/ |r-r'| * (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
double precision, intent(in) :: D_center(3), delta,mu ! pure gaussian "D" and mu parameter
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3),n_pt_in
|
||||||
|
|
||||||
|
double precision :: NAI_pol_mult_erf
|
||||||
|
! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
|
||||||
|
double precision :: A_new(0:max_dim,3)! new polynom
|
||||||
|
double precision :: A_center_new(3) ! new center
|
||||||
|
integer :: iorder_a_new(3) ! i_order(i) = order of the new polynom ==> should be equal to power_A
|
||||||
|
double precision :: alpha_new ! new exponent
|
||||||
|
double precision :: fact_a_new ! constant factor
|
||||||
|
double precision :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr,contrib,contrib_inf,mu_inf
|
||||||
|
integer :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,mm
|
||||||
|
dim1=100
|
||||||
|
mu_inf = 1.d+10
|
||||||
|
thr = 1.d-10
|
||||||
|
d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 ) == 0
|
||||||
|
|
||||||
|
! New gaussian/polynom defined by :: new pol new center new expo cst fact new order
|
||||||
|
call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , &
|
||||||
|
delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
|
||||||
|
! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
|
||||||
|
erf_mu_gauss = 0.d0
|
||||||
|
do lx = 0, iorder_a_new(1)
|
||||||
|
coefx = A_new(lx,1)
|
||||||
|
if(dabs(coefx).lt.thr)cycle
|
||||||
|
iorder_tmp(1) = lx
|
||||||
|
do ly = 0, iorder_a_new(2)
|
||||||
|
coefy = A_new(ly,2)
|
||||||
|
coefxy = coefx * coefy
|
||||||
|
if(dabs(coefxy).lt.thr)cycle
|
||||||
|
iorder_tmp(2) = ly
|
||||||
|
do lz = 0, iorder_a_new(3)
|
||||||
|
coefz = A_new(lz,3)
|
||||||
|
coefxyz = coefxy * coefz
|
||||||
|
if(dabs(coefxyz).lt.thr)cycle
|
||||||
|
iorder_tmp(3) = lz
|
||||||
|
contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B,alpha_new,beta,D_center,n_pt_in,mu)
|
||||||
|
erf_mu_gauss += contrib * coefxyz
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
erf_mu_gauss *= fact_a_new
|
||||||
|
end
|
||||||
|
|
191
src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f
Normal file
191
src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f
Normal file
@ -0,0 +1,191 @@
|
|||||||
|
|
||||||
|
double precision function overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr exp(-delta (r - D)^2 ) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
double precision, intent(in) :: D_center(3), delta ! pure gaussian "D"
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
|
||||||
|
double precision :: overlap_x,overlap_y,overlap_z,overlap
|
||||||
|
! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
|
||||||
|
double precision :: A_new(0:max_dim,3)! new polynom
|
||||||
|
double precision :: A_center_new(3) ! new center
|
||||||
|
integer :: iorder_a_new(3) ! i_order(i) = order of the new polynom ==> should be equal to power_A
|
||||||
|
double precision :: alpha_new ! new exponent
|
||||||
|
double precision :: fact_a_new ! constant factor
|
||||||
|
double precision :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr
|
||||||
|
integer :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1
|
||||||
|
dim1=100
|
||||||
|
thr = 1.d-10
|
||||||
|
d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 ) == 0
|
||||||
|
|
||||||
|
! New gaussian/polynom defined by :: new pol new center new expo cst fact new order
|
||||||
|
call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , &
|
||||||
|
delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
|
||||||
|
! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
|
||||||
|
accu = 0.d0
|
||||||
|
do lx = 0, iorder_a_new(1)
|
||||||
|
coefx = A_new(lx,1)
|
||||||
|
if(dabs(coefx).lt.thr)cycle
|
||||||
|
iorder_tmp(1) = lx
|
||||||
|
do ly = 0, iorder_a_new(2)
|
||||||
|
coefy = A_new(ly,2)
|
||||||
|
coefxy = coefx * coefy
|
||||||
|
if(dabs(coefxy).lt.thr)cycle
|
||||||
|
iorder_tmp(2) = ly
|
||||||
|
do lz = 0, iorder_a_new(3)
|
||||||
|
coefz = A_new(lz,3)
|
||||||
|
coefxyz = coefxy * coefz
|
||||||
|
if(dabs(coefxyz).lt.thr)cycle
|
||||||
|
iorder_tmp(3) = lz
|
||||||
|
call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1)
|
||||||
|
accu += coefxyz * overlap
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
overlap_gauss_r12 = fact_a_new * accu
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine overlap_gauss_xyz_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,gauss_ints)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! gauss_ints(m) = \int dr exp(-delta (r - D)^2 ) * x/y/z (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
!
|
||||||
|
! with m == 1 ==> x, m == 2 ==> y, m == 3 ==> z
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
double precision, intent(in) :: D_center(3), delta ! pure gaussian "D"
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
double precision, intent(out) :: gauss_ints(3)
|
||||||
|
|
||||||
|
double precision :: overlap_x,overlap_y,overlap_z,overlap
|
||||||
|
! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
|
||||||
|
double precision :: A_new(0:max_dim,3)! new polynom
|
||||||
|
double precision :: A_center_new(3) ! new center
|
||||||
|
integer :: iorder_a_new(3) ! i_order(i) = order of the new polynom ==> should be equal to power_A
|
||||||
|
integer :: power_B_new(3)
|
||||||
|
double precision :: alpha_new ! new exponent
|
||||||
|
double precision :: fact_a_new ! constant factor
|
||||||
|
double precision :: coefx,coefy,coefz,coefxy,coefxyz,thr
|
||||||
|
integer :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,m
|
||||||
|
dim1=100
|
||||||
|
thr = 1.d-10
|
||||||
|
d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 ) == 0
|
||||||
|
|
||||||
|
! New gaussian/polynom defined by :: new pol new center new expo cst fact new order
|
||||||
|
call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , &
|
||||||
|
delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
|
||||||
|
! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
|
||||||
|
gauss_ints = 0.d0
|
||||||
|
do lx = 0, iorder_a_new(1)
|
||||||
|
coefx = A_new(lx,1)
|
||||||
|
if(dabs(coefx).lt.thr)cycle
|
||||||
|
iorder_tmp(1) = lx
|
||||||
|
do ly = 0, iorder_a_new(2)
|
||||||
|
coefy = A_new(ly,2)
|
||||||
|
coefxy = coefx * coefy
|
||||||
|
if(dabs(coefxy).lt.thr)cycle
|
||||||
|
iorder_tmp(2) = ly
|
||||||
|
do lz = 0, iorder_a_new(3)
|
||||||
|
coefz = A_new(lz,3)
|
||||||
|
coefxyz = coefxy * coefz
|
||||||
|
if(dabs(coefxyz).lt.thr)cycle
|
||||||
|
iorder_tmp(3) = lz
|
||||||
|
do m = 1, 3
|
||||||
|
! change (x-Bx)^bx --> (x-Bx)^(bx+1) + Bx(x-Bx)^bx
|
||||||
|
power_B_new = power_B
|
||||||
|
power_B_new(m) += 1 ! (x-Bx)^(bx+1)
|
||||||
|
call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
|
||||||
|
gauss_ints(m) += coefxyz * overlap
|
||||||
|
|
||||||
|
power_B_new = power_B
|
||||||
|
call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
|
||||||
|
gauss_ints(m) += coefxyz * overlap * B_center(m) ! Bx (x-Bx)^(bx)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
gauss_ints *= fact_a_new
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function overlap_gauss_xyz_r12_specific(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,mx)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr exp(-delta (r - D)^2 ) * x/y/z (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
!
|
||||||
|
! with mx == 1 ==> x, mx == 2 ==> y, mx == 3 ==> z
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
double precision, intent(in) :: D_center(3), delta ! pure gaussian "D"
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3),mx
|
||||||
|
|
||||||
|
double precision :: overlap_x,overlap_y,overlap_z,overlap
|
||||||
|
! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
|
||||||
|
double precision :: A_new(0:max_dim,3)! new polynom
|
||||||
|
double precision :: A_center_new(3) ! new center
|
||||||
|
integer :: iorder_a_new(3) ! i_order(i) = order of the new polynom ==> should be equal to power_A
|
||||||
|
integer :: power_B_new(3)
|
||||||
|
double precision :: alpha_new ! new exponent
|
||||||
|
double precision :: fact_a_new ! constant factor
|
||||||
|
double precision :: coefx,coefy,coefz,coefxy,coefxyz,thr
|
||||||
|
integer :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,m
|
||||||
|
dim1=100
|
||||||
|
thr = 1.d-10
|
||||||
|
d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 ) == 0
|
||||||
|
|
||||||
|
! New gaussian/polynom defined by :: new pol new center new expo cst fact new order
|
||||||
|
call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , &
|
||||||
|
delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
|
||||||
|
! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
|
||||||
|
overlap_gauss_xyz_r12_specific = 0.d0
|
||||||
|
do lx = 0, iorder_a_new(1)
|
||||||
|
coefx = A_new(lx,1)
|
||||||
|
if(dabs(coefx).lt.thr)cycle
|
||||||
|
iorder_tmp(1) = lx
|
||||||
|
do ly = 0, iorder_a_new(2)
|
||||||
|
coefy = A_new(ly,2)
|
||||||
|
coefxy = coefx * coefy
|
||||||
|
if(dabs(coefxy).lt.thr)cycle
|
||||||
|
iorder_tmp(2) = ly
|
||||||
|
do lz = 0, iorder_a_new(3)
|
||||||
|
coefz = A_new(lz,3)
|
||||||
|
coefxyz = coefxy * coefz
|
||||||
|
if(dabs(coefxyz).lt.thr)cycle
|
||||||
|
iorder_tmp(3) = lz
|
||||||
|
m = mx
|
||||||
|
! change (x-Bx)^bx --> (x-Bx)^(bx+1) + Bx(x-Bx)^bx
|
||||||
|
power_B_new = power_B
|
||||||
|
power_B_new(m) += 1 ! (x-Bx)^(bx+1)
|
||||||
|
call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
|
||||||
|
overlap_gauss_xyz_r12_specific += coefxyz * overlap
|
||||||
|
|
||||||
|
power_B_new = power_B
|
||||||
|
call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
|
||||||
|
overlap_gauss_xyz_r12_specific += coefxyz * overlap * B_center(m) ! Bx (x-Bx)^(bx)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
overlap_gauss_xyz_r12_specific *= fact_a_new
|
||||||
|
end
|
121
src/ao_many_one_e_ints/stg_gauss_int.irp.f
Normal file
121
src/ao_many_one_e_ints/stg_gauss_int.irp.f
Normal file
@ -0,0 +1,121 @@
|
|||||||
|
double precision function ovlp_stg_gauss_int_phi_ij(D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr exp(-gam (r - D)) exp(-delta * (r -D)^2) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: D_center(3), gam ! pure Slater "D" in r-r_D
|
||||||
|
double precision, intent(in) :: delta ! gaussian in r-r_D
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
double precision :: integral,gama_gauss
|
||||||
|
double precision, allocatable :: expos_slat(:)
|
||||||
|
allocate(expos_slat(n_max_fit_slat))
|
||||||
|
double precision :: overlap_gauss_r12
|
||||||
|
ovlp_stg_gauss_int_phi_ij = 0.d0
|
||||||
|
call expo_fit_slater_gam(gam,expos_slat)
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
gama_gauss = expos_slat(i)+delta
|
||||||
|
integral = overlap_gauss_r12(D_center,gama_gauss,A_center,B_center,power_A,power_B,alpha,beta)
|
||||||
|
ovlp_stg_gauss_int_phi_ij += coef_fit_slat_gauss(i) * integral
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
double precision function erf_mu_stg_gauss_int_phi_ij(D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr exp(-gam(r - D)-delta(r - D)^2) (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
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
double precision, intent(in) :: D_center(3), gam ! pure Slater "D" in r-r_D
|
||||||
|
double precision, intent(in) :: delta ! gaussian in r-r_D
|
||||||
|
double precision, intent(in) :: C_center(3),mu ! coulomb center "C" and "mu" in the erf(mu*x)/x function
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
double precision :: NAI_pol_mult_erf_gauss_r12
|
||||||
|
double precision :: integral,gama_gauss
|
||||||
|
double precision, allocatable :: expos_slat(:)
|
||||||
|
allocate(expos_slat(n_max_fit_slat))
|
||||||
|
erf_mu_stg_gauss_int_phi_ij = 0.d0
|
||||||
|
call expo_fit_slater_gam(gam,expos_slat)
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
gama_gauss = expos_slat(i) + delta
|
||||||
|
integral = NAI_pol_mult_erf_gauss_r12(D_center,gama_gauss,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
|
||||||
|
erf_mu_stg_gauss_int_phi_ij += coef_fit_slat_gauss(i) * integral
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function overlap_stg_gauss(D_center,gam,A_center,B_center,power_A,power_B,alpha,beta)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr exp(-gam (r - D)) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: D_center(3), gam ! pure Slater "D"
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
double precision :: expos_slat(n_max_fit_slat),integral,delta
|
||||||
|
double precision :: overlap_gauss_r12
|
||||||
|
overlap_stg_gauss = 0.d0
|
||||||
|
call expo_fit_slater_gam(gam,expos_slat)
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
delta = expos_slat(i)
|
||||||
|
integral = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
|
||||||
|
overlap_stg_gauss += coef_fit_slat_gauss(i) * integral
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function erf_mu_stg_gauss(D_center,gam,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr exp(-gam(r - D)) (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
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
double precision, intent(in) :: D_center(3), gam ! pure Slater "D"
|
||||||
|
double precision, intent(in) :: C_center(3),mu ! coulomb center "C" and "mu" in the erf(mu*x)/x function
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
double precision :: expos_slat(n_max_fit_slat),integral,delta
|
||||||
|
double precision :: NAI_pol_mult_erf_gauss_r12
|
||||||
|
erf_mu_stg_gauss = 0.d0
|
||||||
|
call expo_fit_slater_gam(gam,expos_slat)
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
delta = expos_slat(i)
|
||||||
|
integral = NAI_pol_mult_erf_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
|
||||||
|
erf_mu_stg_gauss += coef_fit_slat_gauss(i) * integral
|
||||||
|
enddo
|
||||||
|
end
|
101
src/ao_many_one_e_ints/taylor_exp.irp.f
Normal file
101
src/ao_many_one_e_ints/taylor_exp.irp.f
Normal file
@ -0,0 +1,101 @@
|
|||||||
|
double precision function exp_dl(x,n)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: x
|
||||||
|
integer , intent(in) :: n
|
||||||
|
integer :: i
|
||||||
|
exp_dl = 1.d0
|
||||||
|
do i = 1, n
|
||||||
|
exp_dl += fact_inv(i) * x**dble(i)
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine exp_dl_rout(x,n, array)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: x
|
||||||
|
integer , intent(in) :: n
|
||||||
|
double precision, intent(out):: array(0:n)
|
||||||
|
integer :: i
|
||||||
|
double precision :: accu
|
||||||
|
accu = 1.d0
|
||||||
|
array(0) = 1.d0
|
||||||
|
do i = 1, n
|
||||||
|
accu += fact_inv(i) * x**dble(i)
|
||||||
|
array(i) = accu
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine exp_dl_ovlp_stg_phi_ij(zeta,D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,n_taylor,array_ints,integral_taylor,exponent_exp)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integrals :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! array(i) = \int dr EXP{exponent_exp * [exp(-gam*i (r - D)) exp(-delta*i * (r -D)^2)] (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! and gives back the Taylor expansion of the exponential in integral_taylor
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: zeta ! prefactor of the argument of the exp(-zeta*x)
|
||||||
|
integer, intent(in) :: n_taylor ! order of the Taylor expansion of the exponential
|
||||||
|
double precision, intent(in) :: D_center(3), gam ! pure Slater "D" in r-r_D
|
||||||
|
double precision, intent(in) :: delta ! gaussian in r-r_D
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
double precision, intent(in) :: exponent_exp
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
double precision, intent(out) :: array_ints(0:n_taylor),integral_taylor
|
||||||
|
|
||||||
|
integer :: i,dim1
|
||||||
|
double precision :: delta_exp,gam_exp,ovlp_stg_gauss_int_phi_ij
|
||||||
|
double precision :: overlap_x,overlap_y,overlap_z,overlap
|
||||||
|
dim1=100
|
||||||
|
call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1)
|
||||||
|
array_ints(0) = overlap
|
||||||
|
integral_taylor = array_ints(0)
|
||||||
|
do i = 1, n_taylor
|
||||||
|
delta_exp = dble(i) * delta
|
||||||
|
gam_exp = dble(i) * gam
|
||||||
|
array_ints(i) = ovlp_stg_gauss_int_phi_ij(D_center,gam_exp,delta_exp,A_center,B_center,power_A,power_B,alpha,beta)
|
||||||
|
integral_taylor += (-zeta*exponent_exp)**dble(i) * fact_inv(i) * array_ints(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine exp_dl_erf_stg_phi_ij(zeta,D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu,n_taylor,array_ints,integral_taylor)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the following integrals :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! array(i) = \int dr exp(-gam*i (r - D)) exp(-delta*i * (r -D)^2) (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 | }$.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! and gives back the Taylor expansion of the exponential in integral_taylor
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: n_taylor ! order of the Taylor expansion of the exponential
|
||||||
|
double precision, intent(in) :: zeta ! prefactor of the argument of the exp(-zeta*x)
|
||||||
|
double precision, intent(in) :: D_center(3), gam ! pure Slater "D" in r-r_D
|
||||||
|
double precision, intent(in) :: delta ! gaussian in r-r_D
|
||||||
|
double precision, intent(in) :: C_center(3),mu ! coulomb center "C" and "mu" in the erf(mu*x)/x function
|
||||||
|
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
|
||||||
|
integer, intent(in) :: power_A(3),power_B(3)
|
||||||
|
double precision, intent(out) :: array_ints(0:n_taylor),integral_taylor
|
||||||
|
|
||||||
|
integer :: i,dim1
|
||||||
|
double precision :: delta_exp,gam_exp,NAI_pol_mult_erf,erf_mu_stg_gauss_int_phi_ij
|
||||||
|
dim1=100
|
||||||
|
|
||||||
|
array_ints(0) = NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_max_integrals,mu)
|
||||||
|
integral_taylor = array_ints(0)
|
||||||
|
do i = 1, n_taylor
|
||||||
|
delta_exp = dble(i) * delta
|
||||||
|
gam_exp = dble(i) * gam
|
||||||
|
array_ints(i) = erf_mu_stg_gauss_int_phi_ij(D_center,gam_exp,delta_exp,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
|
||||||
|
integral_taylor += (-zeta)**dble(i) * fact_inv(i) * array_ints(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
343
src/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f
Normal file
343
src/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f
Normal file
@ -0,0 +1,343 @@
|
|||||||
|
BEGIN_PROVIDER [double precision, coef_xyz_ao, (2,3,ao_num)]
|
||||||
|
&BEGIN_PROVIDER [integer, power_xyz_ao, (2,3,ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! coefficient for the basis function :: (x * phi_i(r), y * phi_i(r), * z_phi(r))
|
||||||
|
!
|
||||||
|
! x * (x - A_x)^a_x = A_x (x - A_x)^a_x + 1 * (x - A_x)^{a_x+1}
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,num_ao,power_ao(1:3)
|
||||||
|
double precision :: center_ao(1:3)
|
||||||
|
do i = 1, ao_num
|
||||||
|
power_ao(1:3)= ao_power(i,1:3)
|
||||||
|
num_ao = ao_nucl(i)
|
||||||
|
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||||
|
do j = 1, 3
|
||||||
|
coef_xyz_ao(1,j,i) = center_ao(j) ! A_x (x - A_x)^a_x
|
||||||
|
power_xyz_ao(1,j,i)= power_ao(j)
|
||||||
|
coef_xyz_ao(2,j,i) = 1.d0 ! 1 * (x - A_x)^a_{x+1}
|
||||||
|
power_xyz_ao(2,j,i)= power_ao(j) + 1
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_coef_ord_grad_transp, (2,3,ao_prim_num_max,ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, power_ord_grad_transp, (2,3,ao_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! grad AO in terms of polynoms and coefficients
|
||||||
|
!
|
||||||
|
! WARNING !!!! SOME polynoms might be negative !!!!!
|
||||||
|
!
|
||||||
|
! WHEN IT IS THE CASE, coefficients are ZERO
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,power_ao(3), m,kk
|
||||||
|
do j=1, ao_num
|
||||||
|
power_ao(1:3)= ao_power(j,1:3)
|
||||||
|
do m = 1, 3
|
||||||
|
power_ord_grad_transp(1,m,j) = power_ao(m) - 1
|
||||||
|
power_ord_grad_transp(2,m,j) = power_ao(m) + 1
|
||||||
|
enddo
|
||||||
|
do i=1, ao_prim_num_max
|
||||||
|
do m = 1, 3
|
||||||
|
ao_coef_ord_grad_transp(1,m,i,j) = ao_coef_normalized_ordered(j,i) * dble(power_ao(m)) ! a_x * c_i
|
||||||
|
ao_coef_ord_grad_transp(2,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j) ! -2 * c_i * alpha_i
|
||||||
|
do kk = 1, 2
|
||||||
|
if(power_ord_grad_transp(kk,m,j).lt.0)then
|
||||||
|
ao_coef_ord_grad_transp(kk,m,i,j) = 0.d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_coef_ord_xyz_grad_transp, (4,3,ao_prim_num_max,ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, power_ord_xyz_grad_transp, (4,3,ao_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! x * d/dx of an AO in terms of polynoms and coefficients
|
||||||
|
!
|
||||||
|
! WARNING !!!! SOME polynoms might be negative !!!!!
|
||||||
|
!
|
||||||
|
! WHEN IT IS THE CASE, coefficients are ZERO
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,power_ao(3), m,num_ao,kk
|
||||||
|
double precision :: center_ao(1:3)
|
||||||
|
do j=1, ao_num
|
||||||
|
power_ao(1:3)= ao_power(j,1:3)
|
||||||
|
num_ao = ao_nucl(j)
|
||||||
|
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||||
|
do m = 1, 3
|
||||||
|
power_ord_xyz_grad_transp(1,m,j) = power_ao(m) - 1
|
||||||
|
power_ord_xyz_grad_transp(2,m,j) = power_ao(m)
|
||||||
|
power_ord_xyz_grad_transp(3,m,j) = power_ao(m) + 1
|
||||||
|
power_ord_xyz_grad_transp(4,m,j) = power_ao(m) + 2
|
||||||
|
do kk = 1, 4
|
||||||
|
if(power_ord_xyz_grad_transp(kk,m,j).lt.0)then
|
||||||
|
power_ord_xyz_grad_transp(kk,m,j) = -1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do i=1, ao_prim_num_max
|
||||||
|
do m = 1, 3
|
||||||
|
ao_coef_ord_xyz_grad_transp(1,m,i,j) = dble(power_ao(m)) * ao_coef_normalized_ordered(j,i) * center_ao(m)
|
||||||
|
ao_coef_ord_xyz_grad_transp(2,m,i,j) = dble(power_ao(m)) * ao_coef_normalized_ordered(j,i)
|
||||||
|
ao_coef_ord_xyz_grad_transp(3,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j) * center_ao(m)
|
||||||
|
ao_coef_ord_xyz_grad_transp(4,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j)
|
||||||
|
do kk = 1, 4
|
||||||
|
if(power_ord_xyz_grad_transp(kk,m,j).lt.0)then
|
||||||
|
ao_coef_ord_xyz_grad_transp(kk,m,i,j) = 0.d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine xyz_grad_phi_ao(r,i_ao,xyz_grad_phi)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i_ao
|
||||||
|
double precision, intent(in) :: r(3)
|
||||||
|
double precision, intent(out):: xyz_grad_phi(3) ! x * d/dx phi i, y * d/dy phi_i, z * d/dz phi_
|
||||||
|
double precision :: center_ao(3),beta
|
||||||
|
double precision :: accu(3,4),dr(3),r2,pol_usual(3)
|
||||||
|
integer :: m,power_ao(3),num_ao,j_prim
|
||||||
|
power_ao(1:3)= ao_power(i_ao,1:3)
|
||||||
|
num_ao = ao_nucl(i_ao)
|
||||||
|
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||||
|
dr(1) = (r(1) - center_ao(1))
|
||||||
|
dr(2) = (r(2) - center_ao(2))
|
||||||
|
dr(3) = (r(3) - center_ao(3))
|
||||||
|
r2 = 0.d0
|
||||||
|
do m = 1, 3
|
||||||
|
r2 += dr(m)*dr(m)
|
||||||
|
enddo
|
||||||
|
! computes the gaussian part
|
||||||
|
accu = 0.d0
|
||||||
|
do j_prim =1,ao_prim_num(i_ao)
|
||||||
|
beta = ao_expo_ordered_transp(j_prim,i_ao)
|
||||||
|
if(dabs(beta*r2).gt.50.d0)cycle
|
||||||
|
do m = 1, 3
|
||||||
|
accu(m,1) += ao_coef_ord_xyz_grad_transp(1,m,j_prim,i_ao) * dexp(-beta*r2)
|
||||||
|
accu(m,2) += ao_coef_ord_xyz_grad_transp(2,m,j_prim,i_ao) * dexp(-beta*r2)
|
||||||
|
accu(m,3) += ao_coef_ord_xyz_grad_transp(3,m,j_prim,i_ao) * dexp(-beta*r2)
|
||||||
|
accu(m,4) += ao_coef_ord_xyz_grad_transp(4,m,j_prim,i_ao) * dexp(-beta*r2)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
! computes the polynom part
|
||||||
|
pol_usual = 0.d0
|
||||||
|
pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3))
|
||||||
|
pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3))
|
||||||
|
pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2))
|
||||||
|
|
||||||
|
xyz_grad_phi = 0.d0
|
||||||
|
do m = 1, 3
|
||||||
|
xyz_grad_phi(m) += accu(m,2) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(2,m,i_ao))
|
||||||
|
xyz_grad_phi(m) += accu(m,3) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(3,m,i_ao))
|
||||||
|
xyz_grad_phi(m) += accu(m,4) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(4,m,i_ao))
|
||||||
|
if(power_ord_xyz_grad_transp(1,m,i_ao).lt.0)cycle
|
||||||
|
xyz_grad_phi(m) += accu(m,1) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(1,m,i_ao))
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine grad_phi_ao(r,i_ao,grad_xyz_phi)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i_ao
|
||||||
|
double precision, intent(in) :: r(3)
|
||||||
|
double precision, intent(out):: grad_xyz_phi(3) ! x * phi i, y * phi_i, z * phi_
|
||||||
|
double precision :: center_ao(3),beta
|
||||||
|
double precision :: accu(3,2),dr(3),r2,pol_usual(3)
|
||||||
|
integer :: m,power_ao(3),num_ao,j_prim
|
||||||
|
power_ao(1:3)= ao_power(i_ao,1:3)
|
||||||
|
num_ao = ao_nucl(i_ao)
|
||||||
|
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||||
|
dr(1) = (r(1) - center_ao(1))
|
||||||
|
dr(2) = (r(2) - center_ao(2))
|
||||||
|
dr(3) = (r(3) - center_ao(3))
|
||||||
|
r2 = 0.d0
|
||||||
|
do m = 1, 3
|
||||||
|
r2 += dr(m)*dr(m)
|
||||||
|
enddo
|
||||||
|
! computes the gaussian part
|
||||||
|
accu = 0.d0
|
||||||
|
do j_prim =1,ao_prim_num(i_ao)
|
||||||
|
beta = ao_expo_ordered_transp(j_prim,i_ao)
|
||||||
|
if(dabs(beta*r2).gt.50.d0)cycle
|
||||||
|
do m = 1, 3
|
||||||
|
accu(m,1) += ao_coef_ord_grad_transp(1,m,j_prim,i_ao) * dexp(-beta*r2)
|
||||||
|
accu(m,2) += ao_coef_ord_grad_transp(2,m,j_prim,i_ao) * dexp(-beta*r2)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
! computes the polynom part
|
||||||
|
pol_usual = 0.d0
|
||||||
|
pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3))
|
||||||
|
pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3))
|
||||||
|
pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2))
|
||||||
|
do m = 1, 3
|
||||||
|
grad_xyz_phi(m) = accu(m,2) * pol_usual(m) * dr(m)**dble(power_ord_grad_transp(2,m,i_ao))
|
||||||
|
if(power_ao(m)==0)cycle
|
||||||
|
grad_xyz_phi(m) += accu(m,1) * pol_usual(m) * dr(m)**dble(power_ord_grad_transp(1,m,i_ao))
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine xyz_phi_ao(r,i_ao,xyz_phi)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i_ao
|
||||||
|
double precision, intent(in) :: r(3)
|
||||||
|
double precision, intent(out):: xyz_phi(3) ! x * phi i, y * phi_i, z * phi_i
|
||||||
|
double precision :: center_ao(3),beta
|
||||||
|
double precision :: accu,dr(3),r2,pol_usual(3)
|
||||||
|
integer :: m,power_ao(3),num_ao
|
||||||
|
power_ao(1:3)= ao_power(i_ao,1:3)
|
||||||
|
num_ao = ao_nucl(i_ao)
|
||||||
|
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||||
|
dr(1) = (r(1) - center_ao(1))
|
||||||
|
dr(2) = (r(2) - center_ao(2))
|
||||||
|
dr(3) = (r(3) - center_ao(3))
|
||||||
|
r2 = 0.d0
|
||||||
|
do m = 1, 3
|
||||||
|
r2 += dr(m)*dr(m)
|
||||||
|
enddo
|
||||||
|
! computes the gaussian part
|
||||||
|
accu = 0.d0
|
||||||
|
do m=1,ao_prim_num(i_ao)
|
||||||
|
beta = ao_expo_ordered_transp(m,i_ao)
|
||||||
|
if(dabs(beta*r2).gt.50.d0)cycle
|
||||||
|
accu += ao_coef_normalized_ordered_transp(m,i_ao) * dexp(-beta*r2)
|
||||||
|
enddo
|
||||||
|
! computes the polynom part
|
||||||
|
pol_usual = 0.d0
|
||||||
|
pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3))
|
||||||
|
pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3))
|
||||||
|
pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2))
|
||||||
|
do m = 1, 3
|
||||||
|
xyz_phi(m) = accu * pol_usual(m) * dr(m)**(dble(power_ao(m))) * ( coef_xyz_ao(1,m,i_ao) + coef_xyz_ao(2,m,i_ao) * dr(m) )
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine test_pol_xyz
|
||||||
|
implicit none
|
||||||
|
integer :: ipoint,i,j,m,jpoint
|
||||||
|
double precision :: r1(3),derf_mu_x
|
||||||
|
double precision :: weight1,r12,xyz_phi(3),grad_phi(3),xyz_grad_phi(3)
|
||||||
|
double precision, allocatable :: aos_array(:),aos_grad_array(:,:)
|
||||||
|
double precision :: num_xyz_phi(3),num_grad_phi(3),num_xyz_grad_phi(3)
|
||||||
|
double precision :: accu_xyz_phi(3),accu_grad_phi(3),accu_xyz_grad_phi(3)
|
||||||
|
double precision :: meta_accu_xyz_phi(3),meta_accu_grad_phi(3),meta_accu_xyz_grad_phi(3)
|
||||||
|
allocate(aos_array(ao_num),aos_grad_array(3,ao_num))
|
||||||
|
meta_accu_xyz_phi = 0.d0
|
||||||
|
meta_accu_grad_phi = 0.d0
|
||||||
|
meta_accu_xyz_grad_phi= 0.d0
|
||||||
|
do i = 1, ao_num
|
||||||
|
accu_xyz_phi = 0.d0
|
||||||
|
accu_grad_phi = 0.d0
|
||||||
|
accu_xyz_grad_phi= 0.d0
|
||||||
|
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
r1(:) = final_grid_points(:,ipoint)
|
||||||
|
weight1 = final_weight_at_r_vector(ipoint)
|
||||||
|
call give_all_aos_and_grad_at_r(r1,aos_array,aos_grad_array)
|
||||||
|
do m = 1, 3
|
||||||
|
num_xyz_phi(m) = r1(m) * aos_array(i)
|
||||||
|
num_grad_phi(m) = aos_grad_array(m,i)
|
||||||
|
num_xyz_grad_phi(m) = r1(m) * aos_grad_array(m,i)
|
||||||
|
enddo
|
||||||
|
call xyz_phi_ao(r1,i,xyz_phi)
|
||||||
|
call grad_phi_ao(r1,i,grad_phi)
|
||||||
|
call xyz_grad_phi_ao(r1,i,xyz_grad_phi)
|
||||||
|
do m = 1, 3
|
||||||
|
accu_xyz_phi(m) += weight1 * dabs(num_xyz_phi(m) - xyz_phi(m) )
|
||||||
|
accu_grad_phi(m) += weight1 * dabs(num_grad_phi(m) - grad_phi(m) )
|
||||||
|
accu_xyz_grad_phi(m) += weight1 * dabs(num_xyz_grad_phi(m) - xyz_grad_phi(m))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,''
|
||||||
|
print*,''
|
||||||
|
print*,'i,',i
|
||||||
|
print*,''
|
||||||
|
do m = 1, 3
|
||||||
|
! print*, 'm, accu_xyz_phi(m) ' ,m, accu_xyz_phi(m)
|
||||||
|
! print*, 'm, accu_grad_phi(m) ' ,m, accu_grad_phi(m)
|
||||||
|
print*, 'm, accu_xyz_grad_phi' ,m, accu_xyz_grad_phi(m)
|
||||||
|
enddo
|
||||||
|
do m = 1, 3
|
||||||
|
meta_accu_xyz_phi(m) += dabs(accu_xyz_phi(m))
|
||||||
|
meta_accu_grad_phi(m) += dabs(accu_grad_phi(m))
|
||||||
|
meta_accu_xyz_grad_phi(m) += dabs(accu_xyz_grad_phi(m))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do m = 1, 3
|
||||||
|
! print*, 'm, meta_accu_xyz_phi(m) ' ,m, meta_accu_xyz_phi(m)
|
||||||
|
! print*, 'm, meta_accu_grad_phi(m) ' ,m, meta_accu_grad_phi(m)
|
||||||
|
print*, 'm, meta_accu_xyz_grad_phi' ,m, meta_accu_xyz_grad_phi(m)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine test_ints_semi_bis
|
||||||
|
implicit none
|
||||||
|
integer :: ipoint,i,j,m
|
||||||
|
double precision :: r1(3), aos_grad_array_r1(3, ao_num), aos_array_r1(ao_num)
|
||||||
|
double precision :: C_center(3), weight1,mu_in,r12,derf_mu_x,dxyz_ints(3),NAI_pol_mult_erf_ao
|
||||||
|
double precision :: ao_mat(ao_num,ao_num),ao_xmat(3,ao_num,ao_num),accu1, accu2(3)
|
||||||
|
mu_in = 0.5d0
|
||||||
|
C_center = 0.d0
|
||||||
|
C_center(1) = 0.25d0
|
||||||
|
C_center(3) = 1.12d0
|
||||||
|
C_center(2) = -1.d0
|
||||||
|
ao_mat = 0.d0
|
||||||
|
ao_xmat = 0.d0
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
r1(1) = final_grid_points(1,ipoint)
|
||||||
|
r1(2) = final_grid_points(2,ipoint)
|
||||||
|
r1(3) = final_grid_points(3,ipoint)
|
||||||
|
call give_all_aos_and_grad_at_r(r1,aos_array_r1,aos_grad_array_r1)
|
||||||
|
weight1 = final_weight_at_r_vector(ipoint)
|
||||||
|
r12 = (r1(1) - C_center(1))**2.d0 + (r1(2) - C_center(2))**2.d0 + (r1(3) - C_center(3))**2.d0
|
||||||
|
r12 = dsqrt(r12)
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
ao_mat(j,i) += aos_array_r1(i) * aos_array_r1(j) * weight1 * derf_mu_x(mu_in,r12)
|
||||||
|
do m = 1, 3
|
||||||
|
ao_xmat(m,j,i) += r1(m) * aos_array_r1(j) * aos_grad_array_r1(m,i) * weight1 * derf_mu_x(mu_in,r12)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
accu1 = 0.d0
|
||||||
|
accu2 = 0.d0
|
||||||
|
accu1relat = 0.d0
|
||||||
|
accu2relat = 0.d0
|
||||||
|
double precision :: accu1relat, accu2relat(3)
|
||||||
|
double precision :: contrib(3)
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
call phi_j_erf_mu_r_xyz_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
|
||||||
|
print*,''
|
||||||
|
print*,'i,j',i,j
|
||||||
|
print*,dxyz_ints(:)
|
||||||
|
print*,ao_xmat(:,j,i)
|
||||||
|
do m = 1, 3
|
||||||
|
contrib(m) = dabs(ao_xmat(m,j,i) - dxyz_ints(m))
|
||||||
|
accu2(m) += contrib(m)
|
||||||
|
if(dabs(ao_xmat(m,j,i)).gt.1.d-10)then
|
||||||
|
accu2relat(m) += dabs(ao_xmat(m,j,i) - dxyz_ints(m))/dabs(ao_xmat(m,j,i))
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,contrib
|
||||||
|
enddo
|
||||||
|
print*,''
|
||||||
|
enddo
|
||||||
|
print*,'accu2relat = '
|
||||||
|
print*, accu2relat /dble(ao_num * ao_num)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
@ -1,2 +1,3 @@
|
|||||||
ao_basis
|
ao_basis
|
||||||
pseudo
|
pseudo
|
||||||
|
cosgtos_ao_int
|
||||||
|
@ -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) ]
|
BEGIN_PROVIDER [ double precision, ao_overlap , (ao_num, ao_num) ]
|
||||||
implicit none
|
&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
|
BEGIN_DOC
|
||||||
! Overlap between atomic basis functions:
|
! Overlap between atomic basis functions:
|
||||||
!
|
!
|
||||||
! :math:`\int \chi_i(r) \chi_j(r) dr`
|
! :math:`\int \chi_i(r) \chi_j(r) dr`
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,n,l
|
|
||||||
double precision :: f
|
implicit none
|
||||||
integer :: dim1
|
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||||
double precision :: overlap, overlap_x, overlap_y, overlap_z
|
double precision :: overlap, overlap_x, overlap_y, overlap_z
|
||||||
double precision :: alpha, beta, c
|
double precision :: alpha, beta, c
|
||||||
double precision :: A_center(3), B_center(3)
|
double precision :: A_center(3), B_center(3)
|
||||||
integer :: power_A(3), power_B(3)
|
|
||||||
ao_overlap = 0.d0
|
ao_overlap = 0.d0
|
||||||
ao_overlap_x = 0.d0
|
ao_overlap_x = 0.d0
|
||||||
ao_overlap_y = 0.d0
|
ao_overlap_y = 0.d0
|
||||||
ao_overlap_z = 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))
|
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'
|
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
|
else
|
||||||
|
|
||||||
dim1=100
|
dim1=100
|
||||||
@ -69,7 +89,11 @@
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
if (write_ao_integrals_overlap) then
|
if (write_ao_integrals_overlap) then
|
||||||
call ezfio_set_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
|
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'
|
print *, 'AO overlap integrals written to disk'
|
||||||
@ -77,6 +101,8 @@
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -85,6 +111,8 @@ BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
|||||||
ao_overlap_imag = 0.d0
|
ao_overlap_imag = 0.d0
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -98,37 +126,39 @@ BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
|||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
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
|
BEGIN_DOC
|
||||||
! Overlap between absolute values of atomic basis functions:
|
! Overlap between absolute values of atomic basis functions:
|
||||||
!
|
!
|
||||||
! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
|
! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,n,l
|
|
||||||
double precision :: f
|
implicit none
|
||||||
integer :: dim1
|
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||||
double precision :: overlap, overlap_x, overlap_y, overlap_z
|
double precision :: overlap_x, overlap_y, overlap_z
|
||||||
double precision :: alpha, beta
|
double precision :: alpha, beta
|
||||||
double precision :: A_center(3), B_center(3)
|
double precision :: A_center(3), B_center(3)
|
||||||
integer :: power_A(3), power_B(3)
|
|
||||||
double precision :: lower_exp_val, dx
|
double precision :: lower_exp_val, dx
|
||||||
if (is_periodic) then
|
|
||||||
do j=1,ao_num
|
if(is_periodic) then
|
||||||
do i= 1,ao_num
|
|
||||||
ao_overlap_abs(i,j)= cdabs(ao_overlap_complex(i,j))
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
ao_overlap_abs(i,j) = cdabs(ao_overlap_complex(i,j))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
dim1=100
|
dim1=100
|
||||||
lower_exp_val = 40.d0
|
lower_exp_val = 40.d0
|
||||||
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
||||||
!$OMP DEFAULT(NONE) &
|
!$OMP DEFAULT(NONE) &
|
||||||
!$OMP PRIVATE(A_center,B_center,power_A,power_B, &
|
!$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 alpha, beta,i,j,dx) &
|
||||||
!$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
|
!$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
|
||||||
!$OMP ao_overlap_abs,ao_num,ao_coef_normalized_ordered_transp,ao_nucl,&
|
!$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
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
|
BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -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
|
BEGIN_DOC
|
||||||
! Second derivative matrix elements in the |AO| basis.
|
! 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
|
! \langle \chi_i(x,y,z) | \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
|
||||||
!
|
!
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,n,l
|
|
||||||
double precision :: f
|
implicit none
|
||||||
integer :: dim1
|
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||||
double precision :: overlap, overlap_y, overlap_z
|
double precision :: overlap, overlap_y, overlap_z
|
||||||
double precision :: overlap_x0, overlap_y0, overlap_z0
|
double precision :: overlap_x0, overlap_y0, overlap_z0
|
||||||
double precision :: alpha, beta, c
|
double precision :: alpha, beta, c
|
||||||
double precision :: A_center(3), B_center(3)
|
double precision :: A_center(3), B_center(3)
|
||||||
integer :: power_A(3), power_B(3)
|
|
||||||
double precision :: d_a_2,d_2
|
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
|
dim1=100
|
||||||
|
|
||||||
! -- Dummy call to provide everything
|
! -- Dummy call to provide everything
|
||||||
@ -117,8 +133,12 @@
|
|||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
|
BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -1,4 +1,8 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Nucleus-electron interaction, in the |AO| basis set.
|
! Nucleus-electron interaction, in the |AO| basis set.
|
||||||
!
|
!
|
||||||
@ -6,17 +10,30 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
!
|
!
|
||||||
! These integrals also contain the pseudopotential integrals.
|
! These integrals also contain the pseudopotential integrals.
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
double precision :: alpha, beta, gama, delta
|
integer :: num_A, num_B, power_A(3), power_B(3)
|
||||||
integer :: num_A,num_B
|
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 :: 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
|
double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
|
||||||
|
|
||||||
if (read_ao_integrals_n_e) then
|
if (read_ao_integrals_n_e) then
|
||||||
|
|
||||||
call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
|
call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
|
||||||
print *, 'AO N-e integrals read from disk'
|
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
|
else
|
||||||
|
|
||||||
ao_integrals_n_e = 0.d0
|
ao_integrals_n_e = 0.d0
|
||||||
@ -29,7 +46,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
!$OMP PARALLEL &
|
!$OMP PARALLEL &
|
||||||
!$OMP DEFAULT (NONE) &
|
!$OMP DEFAULT (NONE) &
|
||||||
!$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,&
|
!$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 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)
|
!$OMP n_pt_max_integrals,ao_integrals_n_e,nucl_num,nucl_charge)
|
||||||
|
|
||||||
@ -54,7 +71,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
do m=1,ao_prim_num(i)
|
do m=1,ao_prim_num(i)
|
||||||
beta = ao_expo_ordered_transp(m,i)
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
|
||||||
double precision :: c
|
double precision :: c, c1
|
||||||
c = 0.d0
|
c = 0.d0
|
||||||
|
|
||||||
do k = 1, nucl_num
|
do k = 1, nucl_num
|
||||||
@ -63,8 +80,16 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
|
|
||||||
C_center(1:3) = nucl_coord(k,1:3)
|
C_center(1:3) = nucl_coord(k,1:3)
|
||||||
|
|
||||||
c = c - Z * NAI_pol_mult(A_center,B_center, &
|
!print *, ' '
|
||||||
power_A,power_B,alpha,beta,C_center,n_pt_in)
|
!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
|
enddo
|
||||||
ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j) &
|
ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j) &
|
||||||
@ -77,7 +102,11 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
|
|
||||||
!$OMP END DO
|
!$OMP END DO
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
IF (DO_PSEUDO) THEN
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
IF(DO_PSEUDO) THEN
|
||||||
ao_integrals_n_e += ao_pseudo_integrals
|
ao_integrals_n_e += ao_pseudo_integrals
|
||||||
ENDIF
|
ENDIF
|
||||||
|
|
||||||
@ -98,7 +127,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`
|
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
double precision :: alpha, beta, gama, delta
|
double precision :: alpha, beta
|
||||||
integer :: num_A,num_B
|
integer :: num_A,num_B
|
||||||
double precision :: A_center(3),B_center(3),C_center(3)
|
double precision :: A_center(3),B_center(3),C_center(3)
|
||||||
integer :: power_A(3),power_B(3)
|
integer :: power_A(3),power_B(3)
|
||||||
@ -121,7 +150,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`
|
! :math:`\langle \chi_i | -\frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
double precision :: alpha, beta, gama, delta
|
double precision :: alpha, beta
|
||||||
integer :: i_c,num_A,num_B
|
integer :: i_c,num_A,num_B
|
||||||
double precision :: A_center(3),B_center(3),C_center(3)
|
double precision :: A_center(3),B_center(3),C_center(3)
|
||||||
integer :: power_A(3),power_B(3)
|
integer :: power_A(3),power_B(3)
|
||||||
@ -259,11 +288,14 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
|
|||||||
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
||||||
do i =0 ,n_pt_out,2
|
do i =0 ,n_pt_out,2
|
||||||
accu += d(i) * rint(i/2,const)
|
accu += d(i) * rint(i/2,const)
|
||||||
|
|
||||||
|
! print *, i/2, const, d(i), rint(shiftr(i, 1), const)
|
||||||
enddo
|
enddo
|
||||||
NAI_pol_mult = accu * coeff
|
NAI_pol_mult = accu * coeff
|
||||||
|
|
||||||
end
|
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)
|
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
|
implicit none
|
||||||
@ -575,61 +607,3 @@ double precision function V_r(n,alpha)
|
|||||||
end
|
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
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -28,7 +28,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals, (ao_num,ao_num)]
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
|
BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
|
||||||
use omp_lib
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Local pseudo-potential
|
! Local pseudo-potential
|
||||||
@ -43,6 +42,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
|
|||||||
|
|
||||||
double precision :: wall_1, wall_2, wall_0
|
double precision :: wall_1, wall_2, wall_0
|
||||||
integer :: thread_num
|
integer :: thread_num
|
||||||
|
integer :: omp_get_thread_num
|
||||||
double precision :: c
|
double precision :: c
|
||||||
double precision :: Z
|
double precision :: Z
|
||||||
|
|
||||||
@ -158,7 +158,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
|
|||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_non_local, (ao_num,ao_num)]
|
BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_non_local, (ao_num,ao_num)]
|
||||||
use omp_lib
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Non-local pseudo-potential
|
! Non-local pseudo-potential
|
||||||
@ -170,6 +169,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
|
|||||||
integer :: power_A(3),power_B(3)
|
integer :: power_A(3),power_B(3)
|
||||||
integer :: i,j,k,l,m
|
integer :: i,j,k,l,m
|
||||||
double precision :: Vloc, Vpseudo
|
double precision :: Vloc, Vpseudo
|
||||||
|
integer :: omp_get_thread_num
|
||||||
|
|
||||||
double precision :: wall_1, wall_2, wall_0
|
double precision :: wall_1, wall_2, wall_0
|
||||||
integer :: thread_num
|
integer :: thread_num
|
||||||
|
12
src/ao_tc_eff_map/EZFIO.cfg
Normal file
12
src/ao_tc_eff_map/EZFIO.cfg
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
|
||||||
|
[j1b_gauss_pen]
|
||||||
|
type: double precision
|
||||||
|
doc: exponents of the 1-body Jastrow
|
||||||
|
interface: ezfio
|
||||||
|
size: (nuclei.nucl_num)
|
||||||
|
|
||||||
|
[j1b_gauss]
|
||||||
|
type: integer
|
||||||
|
doc: Use 1-body Gaussian Jastrow
|
||||||
|
interface: ezfio, provider, ocaml
|
||||||
|
default: 0
|
4
src/ao_tc_eff_map/NEED
Normal file
4
src/ao_tc_eff_map/NEED
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
ao_two_e_erf_ints
|
||||||
|
mo_one_e_ints
|
||||||
|
ao_many_one_e_ints
|
||||||
|
dft_utils_in_r
|
12
src/ao_tc_eff_map/README.rst
Normal file
12
src/ao_tc_eff_map/README.rst
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
ao_tc_eff_map
|
||||||
|
=============
|
||||||
|
|
||||||
|
This is a module to obtain the integrals on the AO basis of the SCALAR HERMITIAN
|
||||||
|
effective potential defined in Eq. 32 of JCP 154, 084119 (2021)
|
||||||
|
It also contains the modification by a one-body Jastrow factor.
|
||||||
|
|
||||||
|
The main routine/providers are
|
||||||
|
|
||||||
|
+) ao_tc_sym_two_e_pot_map : map of the SCALAR PART of total effective two-electron on the AO basis in PHYSICIST notations. It might contain the two-electron term coming from the one-e correlation factor.
|
||||||
|
+) get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map) : routine to get the integrals from ao_tc_sym_two_e_pot_map.
|
||||||
|
+) ao_tc_sym_two_e_pot(i,j,k,l) : FUNCTION that returns the scalar part of TC-potential EXCLUDING the erf(mu r12)/r12. See two_e_ints_gauss.irp.f for more details.
|
75
src/ao_tc_eff_map/compute_ints_eff_pot.irp.f
Normal file
75
src/ao_tc_eff_map/compute_ints_eff_pot.irp.f
Normal file
@ -0,0 +1,75 @@
|
|||||||
|
subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_value)
|
||||||
|
|
||||||
|
use map_module
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Parallel client for AO integrals of the TC integrals involving purely hermitian operators
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: j, l
|
||||||
|
integer,intent(out) :: n_integrals
|
||||||
|
integer(key_kind),intent(out) :: buffer_i(ao_num*ao_num)
|
||||||
|
real(integral_kind),intent(out) :: buffer_value(ao_num*ao_num)
|
||||||
|
|
||||||
|
integer :: i, k
|
||||||
|
integer :: kk, m, j1, i1
|
||||||
|
double precision :: cpu_1, cpu_2, wall_1, wall_2
|
||||||
|
double precision :: integral, wall_0, integral_pot, integral_erf
|
||||||
|
double precision :: thr
|
||||||
|
|
||||||
|
logical, external :: ao_two_e_integral_zero
|
||||||
|
double precision :: ao_tc_sym_two_e_pot, ao_two_e_integral_erf
|
||||||
|
double precision :: j1b_gauss_erf, j1b_gauss_coul
|
||||||
|
double precision :: j1b_gauss_coul_debug
|
||||||
|
double precision :: j1b_gauss_coul_modifdebug
|
||||||
|
double precision :: j1b_gauss_coulerf
|
||||||
|
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss
|
||||||
|
|
||||||
|
thr = ao_integrals_threshold
|
||||||
|
|
||||||
|
n_integrals = 0
|
||||||
|
|
||||||
|
j1 = j+ishft(l*l-l,-1)
|
||||||
|
do k = 1, ao_num ! r1
|
||||||
|
i1 = ishft(k*k-k,-1)
|
||||||
|
if (i1 > j1) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
do i = 1, k
|
||||||
|
i1 += 1
|
||||||
|
if (i1 > j1) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr ) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
integral_pot = ao_tc_sym_two_e_pot (i, k, j, l) ! i,k : r1 j,l : r2
|
||||||
|
integral_erf = ao_two_e_integral_erf(i, k, j, l)
|
||||||
|
integral = integral_erf + integral_pot
|
||||||
|
|
||||||
|
if( j1b_gauss .eq. 1 ) then
|
||||||
|
integral = integral &
|
||||||
|
+ j1b_gauss_coulerf(i, k, j, l)
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
if(abs(integral) < thr) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
n_integrals += 1
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call two_e_integrals_index(i, j, k, l, buffer_i(n_integrals))
|
||||||
|
buffer_value(n_integrals) = integral
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end subroutine compute_ao_tc_sym_two_e_pot_jl
|
||||||
|
|
194
src/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f
Normal file
194
src/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f
Normal file
@ -0,0 +1,194 @@
|
|||||||
|
subroutine ao_tc_sym_two_e_pot_in_map_slave_tcp(i)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes a buffer of integrals. i is the ID of the current thread.
|
||||||
|
END_DOC
|
||||||
|
call ao_tc_sym_two_e_pot_in_map_slave(0,i)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ao_tc_sym_two_e_pot_in_map_slave_inproc(i)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes a buffer of integrals. i is the ID of the current thread.
|
||||||
|
END_DOC
|
||||||
|
call ao_tc_sym_two_e_pot_in_map_slave(1,i)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ao_tc_sym_two_e_pot_in_map_slave(thread,iproc)
|
||||||
|
use map_module
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes a buffer of integrals
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: thread, iproc
|
||||||
|
|
||||||
|
integer :: j,l,n_integrals
|
||||||
|
integer :: rc
|
||||||
|
real(integral_kind), allocatable :: buffer_value(:)
|
||||||
|
integer(key_kind), allocatable :: buffer_i(:)
|
||||||
|
|
||||||
|
integer :: worker_id, task_id
|
||||||
|
character*(512) :: task
|
||||||
|
|
||||||
|
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_push_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_socket_push
|
||||||
|
|
||||||
|
character*(64) :: state
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
|
integer, external :: connect_to_taskserver
|
||||||
|
if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
zmq_socket_push = new_zmq_push_socket(thread)
|
||||||
|
|
||||||
|
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
|
||||||
|
|
||||||
|
|
||||||
|
do
|
||||||
|
integer, external :: get_task_from_taskserver
|
||||||
|
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) == -1) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
if (task_id == 0) exit
|
||||||
|
read(task,*) j, l
|
||||||
|
integer, external :: task_done_to_taskserver
|
||||||
|
call compute_ao_tc_sym_two_e_pot_jl(j,l,n_integrals,buffer_i,buffer_value)
|
||||||
|
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
|
||||||
|
stop 'Unable to send task_done'
|
||||||
|
endif
|
||||||
|
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
integer, external :: disconnect_from_taskserver
|
||||||
|
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||||
|
continue
|
||||||
|
endif
|
||||||
|
deallocate( buffer_i, buffer_value )
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ao_tc_sym_two_e_pot_in_map_collector(zmq_socket_pull)
|
||||||
|
use map_module
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Collects results from the AO integral calculation
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
||||||
|
integer :: j,l,n_integrals
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
real(integral_kind), allocatable :: buffer_value(:)
|
||||||
|
integer(key_kind), allocatable :: buffer_i(:)
|
||||||
|
|
||||||
|
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_pull_socket
|
||||||
|
|
||||||
|
integer*8 :: control, accu, sze
|
||||||
|
integer :: task_id, more
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
|
sze = ao_num*ao_num
|
||||||
|
allocate ( buffer_i(sze), buffer_value(sze) )
|
||||||
|
|
||||||
|
accu = 0_8
|
||||||
|
more = 1
|
||||||
|
do while (more == 1)
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
|
||||||
|
if (rc == -1) then
|
||||||
|
n_integrals = 0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (n_integrals >= 0) then
|
||||||
|
|
||||||
|
if (n_integrals > sze) then
|
||||||
|
deallocate (buffer_value, buffer_i)
|
||||||
|
sze = n_integrals
|
||||||
|
allocate (buffer_value(sze), buffer_i(sze))
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
|
||||||
|
if (rc /= key_kind*n_integrals) then
|
||||||
|
print *, rc, key_kind, n_integrals
|
||||||
|
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
|
||||||
|
if (rc /= integral_kind*n_integrals) then
|
||||||
|
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
|
||||||
|
|
||||||
|
IRP_IF ZMQ_PUSH
|
||||||
|
IRP_ELSE
|
||||||
|
rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
|
||||||
|
call insert_into_ao_tc_sym_two_e_pot_map(n_integrals,buffer_i,buffer_value)
|
||||||
|
accu += n_integrals
|
||||||
|
if (task_id /= 0) then
|
||||||
|
integer, external :: zmq_delete_task
|
||||||
|
if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
|
||||||
|
stop 'Unable to delete task'
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate( buffer_i, buffer_value )
|
||||||
|
|
||||||
|
integer (map_size_kind) :: get_ao_tc_sym_two_e_pot_map_size
|
||||||
|
control = get_ao_tc_sym_two_e_pot_map_size(ao_tc_sym_two_e_pot_map)
|
||||||
|
|
||||||
|
if (control /= accu) then
|
||||||
|
print *, ''
|
||||||
|
print *, irp_here
|
||||||
|
print *, 'Control : ', control
|
||||||
|
print *, 'Accu : ', accu
|
||||||
|
print *, 'Some integrals were lost during the parallel computation.'
|
||||||
|
print *, 'Try to reduce the number of threads.'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
299
src/ao_tc_eff_map/j1b_1eInteg.py
Normal file
299
src/ao_tc_eff_map/j1b_1eInteg.py
Normal file
@ -0,0 +1,299 @@
|
|||||||
|
import sys, os
|
||||||
|
QP_PATH=os.environ["QP_EZFIO"]
|
||||||
|
sys.path.insert(0,QP_PATH+"/Python/")
|
||||||
|
from ezfio import ezfio
|
||||||
|
from datetime import datetime
|
||||||
|
import time
|
||||||
|
from math import exp, sqrt, pi
|
||||||
|
import numpy as np
|
||||||
|
import subprocess
|
||||||
|
from scipy.integrate import tplquad
|
||||||
|
import multiprocessing
|
||||||
|
from multiprocessing import Pool
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
def read_ao():
|
||||||
|
|
||||||
|
with open('ao_data') as f:
|
||||||
|
lines = f.readlines()
|
||||||
|
|
||||||
|
ao_prim_num = np.zeros((ao_num), dtype=int)
|
||||||
|
ao_nucl = np.zeros((ao_num), dtype=int)
|
||||||
|
ao_power = np.zeros((ao_num, 3))
|
||||||
|
nucl_coord = np.zeros((ao_num, 3))
|
||||||
|
ao_expo = np.zeros((ao_num, ao_num))
|
||||||
|
ao_coef = np.zeros((ao_num, ao_num))
|
||||||
|
|
||||||
|
iline = 0
|
||||||
|
for j in range(ao_num):
|
||||||
|
|
||||||
|
line = lines[iline]
|
||||||
|
iline += 1
|
||||||
|
ao_nucl[j] = int(line) - 1
|
||||||
|
|
||||||
|
line = lines[iline].split()
|
||||||
|
iline += 1
|
||||||
|
ao_power[j, 0] = float(line[0])
|
||||||
|
ao_power[j, 1] = float(line[1])
|
||||||
|
ao_power[j, 2] = float(line[2])
|
||||||
|
|
||||||
|
line = lines[iline].split()
|
||||||
|
iline += 1
|
||||||
|
nucl_coord[ao_nucl[j], 0] = float(line[0])
|
||||||
|
nucl_coord[ao_nucl[j], 1] = float(line[1])
|
||||||
|
nucl_coord[ao_nucl[j], 2] = float(line[2])
|
||||||
|
|
||||||
|
line = lines[iline]
|
||||||
|
iline += 1
|
||||||
|
ao_prim_num[j] = int(line)
|
||||||
|
|
||||||
|
for l in range(ao_prim_num[j]):
|
||||||
|
|
||||||
|
line = lines[iline].split()
|
||||||
|
iline += 1
|
||||||
|
ao_expo[l, j] = float(line[0])
|
||||||
|
ao_coef[l, j] = float(line[1])
|
||||||
|
|
||||||
|
return( ao_prim_num
|
||||||
|
, ao_nucl
|
||||||
|
, ao_power
|
||||||
|
, nucl_coord
|
||||||
|
, ao_expo
|
||||||
|
, ao_coef )
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
def Gao(X, i_ao):
|
||||||
|
|
||||||
|
ii = ao_nucl[i_ao]
|
||||||
|
C = np.array([nucl_coord[ii,0], nucl_coord[ii,1], nucl_coord[ii,2]])
|
||||||
|
Y = X - C
|
||||||
|
dis = np.dot(Y,Y)
|
||||||
|
|
||||||
|
ip = np.array([ao_power[i_ao,0], ao_power[i_ao,1], ao_power[i_ao,2]])
|
||||||
|
pol = np.prod(Y**ip)
|
||||||
|
|
||||||
|
xi = np.sum( ao_coef[:,i_ao] * np.exp(-dis*ao_expo[:,i_ao]) )
|
||||||
|
|
||||||
|
return(xi*pol)
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
def grad_Gao(X, i_ao):
|
||||||
|
|
||||||
|
ii = ao_nucl[i_ao]
|
||||||
|
C = np.array([nucl_coord[ii,0], nucl_coord[ii,1], nucl_coord[ii,2]])
|
||||||
|
|
||||||
|
ix = ao_power[i_ao,0]
|
||||||
|
iy = ao_power[i_ao,1]
|
||||||
|
iz = ao_power[i_ao,2]
|
||||||
|
|
||||||
|
Y = X - C
|
||||||
|
dis = np.dot(Y,Y)
|
||||||
|
|
||||||
|
xm = np.sum( ao_coef[:,i_ao]*np.exp(-dis*ao_expo[:,i_ao]))
|
||||||
|
xp = np.sum(ao_expo[:,i_ao]*ao_coef[:,i_ao]*np.exp(-dis*ao_expo[:,i_ao]))
|
||||||
|
|
||||||
|
ip = np.array([ix+1, iy, iz])
|
||||||
|
dx = -2. * np.prod(Y**ip) * xp
|
||||||
|
if(ix > 0):
|
||||||
|
ip = np.array([ix-1, iy, iz])
|
||||||
|
dx += ix * np.prod(Y**ip) * xm
|
||||||
|
|
||||||
|
ip = np.array([ix, iy+1, iz])
|
||||||
|
dy = -2. * np.prod(Y**ip) * xp
|
||||||
|
if(iy > 0):
|
||||||
|
ip = np.array([ix, iy-1, iz])
|
||||||
|
dy += iy * np.prod(Y**ip) * xm
|
||||||
|
|
||||||
|
ip = np.array([ix, iy, iz+1])
|
||||||
|
dz = -2. * np.prod(Y**ip) * xp
|
||||||
|
if(iz > 0):
|
||||||
|
ip = np.array([ix, iy, iz-1])
|
||||||
|
dz += iz * np.prod(Y**ip) * xm
|
||||||
|
|
||||||
|
return(np.array([dx, dy, dz]))
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
# 3 x < XA | exp[-gama r_C^2] | XB >
|
||||||
|
# - 2 x < XA | r_A^2 exp[-gama r_C^2] | XB >
|
||||||
|
#
|
||||||
|
def integ_lap(z, y, x, i_ao, j_ao):
|
||||||
|
|
||||||
|
X = np.array([x, y, z])
|
||||||
|
|
||||||
|
Gi = Gao(X, i_ao)
|
||||||
|
Gj = Gao(X, j_ao)
|
||||||
|
|
||||||
|
c = 0.
|
||||||
|
for k in range(nucl_num):
|
||||||
|
gama = j1b_gauss_pen[k]
|
||||||
|
C = nucl_coord[k,:]
|
||||||
|
Y = X - C
|
||||||
|
dis = np.dot(Y, Y)
|
||||||
|
arg = exp(-gama*dis)
|
||||||
|
arg = exp(-gama*dis)
|
||||||
|
c += ( 3. - 2. * dis * gama ) * arg * gama * Gi * Gj
|
||||||
|
|
||||||
|
return(c)
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
#
|
||||||
|
def integ_grad2(z, y, x, i_ao, j_ao):
|
||||||
|
|
||||||
|
X = np.array([x, y, z])
|
||||||
|
|
||||||
|
Gi = Gao(X, i_ao)
|
||||||
|
Gj = Gao(X, j_ao)
|
||||||
|
|
||||||
|
c = np.zeros((3))
|
||||||
|
for k in range(nucl_num):
|
||||||
|
gama = j1b_gauss_pen[k]
|
||||||
|
C = nucl_coord[k,:]
|
||||||
|
Y = X - C
|
||||||
|
c += gama * exp(-gama*np.dot(Y, Y)) * Y
|
||||||
|
|
||||||
|
return(-2*np.dot(c,c)*Gi*Gj)
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
#
|
||||||
|
def integ_nonh(z, y, x, i_ao, j_ao):
|
||||||
|
|
||||||
|
X = np.array([x, y, z])
|
||||||
|
|
||||||
|
Gi = Gao(X, i_ao)
|
||||||
|
|
||||||
|
c = 0.
|
||||||
|
for k in range(nucl_num):
|
||||||
|
gama = j1b_gauss_pen[k]
|
||||||
|
C = nucl_coord[k,:]
|
||||||
|
Y = X - C
|
||||||
|
grad = grad_Gao(X, j_ao)
|
||||||
|
c += gama * exp(-gama*np.dot(Y,Y)) * np.dot(Y,grad)
|
||||||
|
|
||||||
|
return(2*c*Gi)
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
def perform_integ( ind_ao ):
|
||||||
|
|
||||||
|
i_ao = ind_ao[0]
|
||||||
|
j_ao = ind_ao[1]
|
||||||
|
|
||||||
|
a = -15. #-np.Inf
|
||||||
|
b = +15. #+np.Inf
|
||||||
|
epsrel = 1e-5
|
||||||
|
|
||||||
|
res_lap, err_lap = tplquad( integ_lap
|
||||||
|
, a, b
|
||||||
|
, lambda x : a, lambda x : b
|
||||||
|
, lambda x,y: a, lambda x,y: b
|
||||||
|
, (i_ao, j_ao)
|
||||||
|
, epsrel=epsrel )
|
||||||
|
|
||||||
|
res_grd, err_grd = tplquad( integ_grad2
|
||||||
|
, a, b
|
||||||
|
, lambda x : a, lambda x : b
|
||||||
|
, lambda x,y: a, lambda x,y: b
|
||||||
|
, (i_ao, j_ao)
|
||||||
|
, epsrel=epsrel )
|
||||||
|
|
||||||
|
res_nnh, err_nnh = tplquad( integ_nonh
|
||||||
|
, a, b
|
||||||
|
, lambda x : a, lambda x : b
|
||||||
|
, lambda x,y: a, lambda x,y: b
|
||||||
|
, (i_ao, j_ao)
|
||||||
|
, epsrel=epsrel )
|
||||||
|
|
||||||
|
return( [ res_lap, err_lap
|
||||||
|
, res_grd, err_grd
|
||||||
|
, res_nnh, err_nnh ])
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
def integ_eval():
|
||||||
|
|
||||||
|
list_ind = []
|
||||||
|
for i_ao in range(ao_num):
|
||||||
|
for j_ao in range(ao_num):
|
||||||
|
list_ind.append( [i_ao, j_ao] )
|
||||||
|
|
||||||
|
nb_proc = multiprocessing.cpu_count()
|
||||||
|
print(" --- Excexution with {} processors ---\n".format(nb_proc))
|
||||||
|
|
||||||
|
p = Pool(nb_proc)
|
||||||
|
res = np.array( p.map( perform_integ, list_ind ) )
|
||||||
|
|
||||||
|
ii = 0
|
||||||
|
for i_ao in range(ao_num):
|
||||||
|
for j_ao in range(ao_num):
|
||||||
|
print(" {} {} {:+e} {:+e} {:+e} {:+e}".format( i_ao, j_ao
|
||||||
|
, res[ii][0], res[ii][1], res[ii][2], res[ii][3]) )
|
||||||
|
ii += 1
|
||||||
|
|
||||||
|
p.close()
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
#
|
||||||
|
if __name__=="__main__":
|
||||||
|
|
||||||
|
t0 = time.time()
|
||||||
|
|
||||||
|
EZFIO_file = sys.argv[1]
|
||||||
|
ezfio.set_file(EZFIO_file)
|
||||||
|
|
||||||
|
print(" Today's date:", datetime.now() )
|
||||||
|
print(" EZFIO file = {}".format(EZFIO_file))
|
||||||
|
|
||||||
|
nucl_num = ezfio.get_nuclei_nucl_num()
|
||||||
|
ao_num = ezfio.get_ao_basis_ao_num()
|
||||||
|
j1b_gauss_pen = ezfio.get_ao_tc_eff_map_j1b_gauss_pen()
|
||||||
|
|
||||||
|
ao_prim_num, ao_nucl, ao_power, nucl_coord, ao_expo, ao_coef = read_ao()
|
||||||
|
|
||||||
|
#integ_eval()
|
||||||
|
|
||||||
|
i_ao = 0
|
||||||
|
j_ao = 0
|
||||||
|
|
||||||
|
a = -5.
|
||||||
|
b = +5.
|
||||||
|
epsrel = 1e-1
|
||||||
|
res_grd, err_grd = tplquad( integ_nonh
|
||||||
|
, a, b
|
||||||
|
, lambda x : a, lambda x : b
|
||||||
|
, lambda x,y: a, lambda x,y: b
|
||||||
|
, (i_ao, j_ao)
|
||||||
|
, epsrel=epsrel )
|
||||||
|
|
||||||
|
print(res_grd, err_grd)
|
||||||
|
|
||||||
|
|
||||||
|
tf = time.time() - t0
|
||||||
|
print(' end after {} min'.format(tf/60.))
|
||||||
|
# _____________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
|
59
src/ao_tc_eff_map/j1b_pen.irp.f
Normal file
59
src/ao_tc_eff_map/j1b_pen.irp.f
Normal file
@ -0,0 +1,59 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, j1b_gauss_pen, (nucl_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! exponents of the 1-body Jastrow
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
logical :: exists
|
||||||
|
|
||||||
|
PROVIDE ezfio_filename
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
call ezfio_has_ao_tc_eff_map_j1b_gauss_pen(exists)
|
||||||
|
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(j1b_gauss_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read j1b_gauss_pen with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
if (exists) then
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
write(6,'(A)') '.. >>>>> [ IO READ: j1b_gauss_pen ] <<<<< ..'
|
||||||
|
call ezfio_get_ao_tc_eff_map_j1b_gauss_pen(j1b_gauss_pen)
|
||||||
|
IRP_IF MPI
|
||||||
|
call MPI_BCAST(j1b_gauss_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read j1b_gauss_pen with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
endif
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
do i = 1, nucl_num
|
||||||
|
j1b_gauss_pen(i) = 1d5
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
|
291
src/ao_tc_eff_map/map_integrals_eff_pot.irp.f
Normal file
291
src/ao_tc_eff_map/map_integrals_eff_pot.irp.f
Normal file
@ -0,0 +1,291 @@
|
|||||||
|
use map_module
|
||||||
|
|
||||||
|
!! AO Map
|
||||||
|
!! ======
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ type(map_type), ao_tc_sym_two_e_pot_map ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |AO| integrals
|
||||||
|
END_DOC
|
||||||
|
integer(key_kind) :: key_max
|
||||||
|
integer(map_size_kind) :: sze
|
||||||
|
call two_e_integrals_index(ao_num,ao_num,ao_num,ao_num,key_max)
|
||||||
|
sze = key_max
|
||||||
|
call map_init(ao_tc_sym_two_e_pot_map,sze)
|
||||||
|
print*, 'ao_tc_sym_two_e_pot_map map initialized : ', sze
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, ao_tc_sym_two_e_pot_cache_min ]
|
||||||
|
&BEGIN_PROVIDER [ integer, ao_tc_sym_two_e_pot_cache_max ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Min and max values of the AOs for which the integrals are in the cache
|
||||||
|
END_DOC
|
||||||
|
ao_tc_sym_two_e_pot_cache_min = max(1,ao_num - 63)
|
||||||
|
ao_tc_sym_two_e_pot_cache_max = ao_num
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_tc_sym_two_e_pot_cache, (0:64*64*64*64) ]
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Cache of |AO| integrals for fast access
|
||||||
|
END_DOC
|
||||||
|
PROVIDE ao_tc_sym_two_e_pot_in_map
|
||||||
|
integer :: i,j,k,l,ii
|
||||||
|
integer(key_kind) :: idx
|
||||||
|
real(integral_kind) :: integral
|
||||||
|
!$OMP PARALLEL DO PRIVATE (i,j,k,l,idx,ii,integral)
|
||||||
|
do l=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max
|
||||||
|
do k=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max
|
||||||
|
do j=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max
|
||||||
|
do i=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call two_e_integrals_index(i,j,k,l,idx)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call map_get(ao_tc_sym_two_e_pot_map,idx,integral)
|
||||||
|
ii = l-ao_tc_sym_two_e_pot_cache_min
|
||||||
|
ii = ior( ishft(ii,6), k-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
ii = ior( ishft(ii,6), j-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
ii = ior( ishft(ii,6), i-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
ao_tc_sym_two_e_pot_cache(ii) = integral
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
subroutine insert_into_ao_tc_sym_two_e_pot_map(n_integrals,buffer_i, buffer_values)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Create new entry into |AO| map
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: n_integrals
|
||||||
|
integer(key_kind), intent(inout) :: buffer_i(n_integrals)
|
||||||
|
real(integral_kind), intent(inout) :: buffer_values(n_integrals)
|
||||||
|
|
||||||
|
call map_append(ao_tc_sym_two_e_pot_map, buffer_i, buffer_values, n_integrals)
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function get_ao_tc_sym_two_e_pot(i,j,k,l,map) result(result)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gets one |AO| two-electron integral from the |AO| map in PHYSICIST NOTATION
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j,k,l
|
||||||
|
integer(key_kind) :: idx
|
||||||
|
type(map_type), intent(inout) :: map
|
||||||
|
integer :: ii
|
||||||
|
real(integral_kind) :: tmp
|
||||||
|
logical, external :: ao_two_e_integral_zero
|
||||||
|
PROVIDE ao_tc_sym_two_e_pot_in_map ao_tc_sym_two_e_pot_cache ao_tc_sym_two_e_pot_cache_min
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
! if (ao_two_e_integral_zero(i,j,k,l)) then
|
||||||
|
if (.False.) then
|
||||||
|
tmp = 0.d0
|
||||||
|
!else if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < ao_integrals_threshold) then
|
||||||
|
! tmp = 0.d0
|
||||||
|
else
|
||||||
|
ii = l-ao_tc_sym_two_e_pot_cache_min
|
||||||
|
ii = ior(ii, k-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
ii = ior(ii, j-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
ii = ior(ii, i-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
if (iand(ii, -64) /= 0) then
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call two_e_integrals_index(i,j,k,l,idx)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call map_get(map,idx,tmp)
|
||||||
|
tmp = tmp
|
||||||
|
else
|
||||||
|
ii = l-ao_tc_sym_two_e_pot_cache_min
|
||||||
|
ii = ior( ishft(ii,6), k-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
ii = ior( ishft(ii,6), j-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
ii = ior( ishft(ii,6), i-ao_tc_sym_two_e_pot_cache_min)
|
||||||
|
tmp = ao_tc_sym_two_e_pot_cache(ii)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
result = tmp
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_many_ao_tc_sym_two_e_pot(j,k,l,sze,out_val)
|
||||||
|
use map_module
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gets multiple |AO| two-electron integral from the |AO| map .
|
||||||
|
! All i are retrieved for j,k,l fixed.
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: j,k,l, sze
|
||||||
|
real(integral_kind), intent(out) :: out_val(sze)
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
integer(key_kind) :: hash
|
||||||
|
double precision :: thresh
|
||||||
|
! logical, external :: ao_one_e_integral_zero
|
||||||
|
PROVIDE ao_tc_sym_two_e_pot_in_map ao_tc_sym_two_e_pot_map
|
||||||
|
thresh = ao_integrals_threshold
|
||||||
|
|
||||||
|
! if (ao_one_e_integral_zero(j,l)) then
|
||||||
|
if (.False.) then
|
||||||
|
out_val = 0.d0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
double precision :: get_ao_tc_sym_two_e_pot
|
||||||
|
do i=1,sze
|
||||||
|
out_val(i) = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine get_many_ao_tc_sym_two_e_pot_non_zero(j,k,l,sze,out_val,out_val_index,non_zero_int)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gets multiple |AO| two-electron integrals from the |AO| map .
|
||||||
|
! All non-zero i are retrieved for j,k,l fixed.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: j,k,l, sze
|
||||||
|
real(integral_kind), intent(out) :: out_val(sze)
|
||||||
|
integer, intent(out) :: out_val_index(sze),non_zero_int
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
integer(key_kind) :: hash
|
||||||
|
double precision :: thresh,tmp
|
||||||
|
! logical, external :: ao_one_e_integral_zero
|
||||||
|
PROVIDE ao_tc_sym_two_e_pot_in_map
|
||||||
|
thresh = ao_integrals_threshold
|
||||||
|
|
||||||
|
non_zero_int = 0
|
||||||
|
! if (ao_one_e_integral_zero(j,l)) then
|
||||||
|
if (.False.) then
|
||||||
|
out_val = 0.d0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
non_zero_int = 0
|
||||||
|
do i=1,sze
|
||||||
|
integer, external :: ao_l4
|
||||||
|
double precision, external :: ao_two_e_integral_eff_pot
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
!if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thresh) then
|
||||||
|
! cycle
|
||||||
|
!endif
|
||||||
|
call two_e_integrals_index(i,j,k,l,hash)
|
||||||
|
call map_get(ao_tc_sym_two_e_pot_map, hash,tmp)
|
||||||
|
if (dabs(tmp) < thresh ) cycle
|
||||||
|
non_zero_int = non_zero_int+1
|
||||||
|
out_val_index(non_zero_int) = i
|
||||||
|
out_val(non_zero_int) = tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
function get_ao_tc_sym_two_e_pot_map_size()
|
||||||
|
implicit none
|
||||||
|
integer (map_size_kind) :: get_ao_tc_sym_two_e_pot_map_size
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns the number of elements in the |AO| map
|
||||||
|
END_DOC
|
||||||
|
get_ao_tc_sym_two_e_pot_map_size = ao_tc_sym_two_e_pot_map % n_elements
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine clear_ao_tc_sym_two_e_pot_map
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Frees the memory of the |AO| map
|
||||||
|
END_DOC
|
||||||
|
call map_deinit(ao_tc_sym_two_e_pot_map)
|
||||||
|
FREE ao_tc_sym_two_e_pot_map
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine dump_ao_tc_sym_two_e_pot(filename)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Save to disk the |AO| eff_pot integrals
|
||||||
|
END_DOC
|
||||||
|
character*(*), intent(in) :: filename
|
||||||
|
integer(cache_key_kind), pointer :: key(:)
|
||||||
|
real(integral_kind), pointer :: val(:)
|
||||||
|
integer*8 :: i,j, n
|
||||||
|
call ezfio_set_work_empty(.False.)
|
||||||
|
open(unit=66,file=filename,FORM='unformatted')
|
||||||
|
write(66) integral_kind, key_kind
|
||||||
|
write(66) ao_tc_sym_two_e_pot_map%sorted, ao_tc_sym_two_e_pot_map%map_size, &
|
||||||
|
ao_tc_sym_two_e_pot_map%n_elements
|
||||||
|
do i=0_8,ao_tc_sym_two_e_pot_map%map_size
|
||||||
|
write(66) ao_tc_sym_two_e_pot_map%map(i)%sorted, ao_tc_sym_two_e_pot_map%map(i)%map_size,&
|
||||||
|
ao_tc_sym_two_e_pot_map%map(i)%n_elements
|
||||||
|
enddo
|
||||||
|
do i=0_8,ao_tc_sym_two_e_pot_map%map_size
|
||||||
|
key => ao_tc_sym_two_e_pot_map%map(i)%key
|
||||||
|
val => ao_tc_sym_two_e_pot_map%map(i)%value
|
||||||
|
n = ao_tc_sym_two_e_pot_map%map(i)%n_elements
|
||||||
|
write(66) (key(j), j=1,n), (val(j), j=1,n)
|
||||||
|
enddo
|
||||||
|
close(66)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
integer function load_ao_tc_sym_two_e_pot(filename)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Read from disk the |AO| eff_pot integrals
|
||||||
|
END_DOC
|
||||||
|
character*(*), intent(in) :: filename
|
||||||
|
integer*8 :: i
|
||||||
|
integer(cache_key_kind), pointer :: key(:)
|
||||||
|
real(integral_kind), pointer :: val(:)
|
||||||
|
integer :: iknd, kknd
|
||||||
|
integer*8 :: n, j
|
||||||
|
load_ao_tc_sym_two_e_pot = 1
|
||||||
|
open(unit=66,file=filename,FORM='unformatted',STATUS='UNKNOWN')
|
||||||
|
read(66,err=98,end=98) iknd, kknd
|
||||||
|
if (iknd /= integral_kind) then
|
||||||
|
print *, 'Wrong integrals kind in file :', iknd
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
if (kknd /= key_kind) then
|
||||||
|
print *, 'Wrong key kind in file :', kknd
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
read(66,err=98,end=98) ao_tc_sym_two_e_pot_map%sorted, ao_tc_sym_two_e_pot_map%map_size,&
|
||||||
|
ao_tc_sym_two_e_pot_map%n_elements
|
||||||
|
do i=0_8, ao_tc_sym_two_e_pot_map%map_size
|
||||||
|
read(66,err=99,end=99) ao_tc_sym_two_e_pot_map%map(i)%sorted, &
|
||||||
|
ao_tc_sym_two_e_pot_map%map(i)%map_size, ao_tc_sym_two_e_pot_map%map(i)%n_elements
|
||||||
|
call cache_map_reallocate(ao_tc_sym_two_e_pot_map%map(i),ao_tc_sym_two_e_pot_map%map(i)%map_size)
|
||||||
|
enddo
|
||||||
|
do i=0_8, ao_tc_sym_two_e_pot_map%map_size
|
||||||
|
key => ao_tc_sym_two_e_pot_map%map(i)%key
|
||||||
|
val => ao_tc_sym_two_e_pot_map%map(i)%value
|
||||||
|
n = ao_tc_sym_two_e_pot_map%map(i)%n_elements
|
||||||
|
read(66,err=99,end=99) (key(j), j=1,n), (val(j), j=1,n)
|
||||||
|
enddo
|
||||||
|
call map_sort(ao_tc_sym_two_e_pot_map)
|
||||||
|
load_ao_tc_sym_two_e_pot = 0
|
||||||
|
return
|
||||||
|
99 continue
|
||||||
|
call map_deinit(ao_tc_sym_two_e_pot_map)
|
||||||
|
98 continue
|
||||||
|
stop 'Problem reading ao_tc_sym_two_e_pot_map file in work/'
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
519
src/ao_tc_eff_map/one_e_1bgauss_hermit.irp.f
Normal file
519
src/ao_tc_eff_map/one_e_1bgauss_hermit.irp.f
Normal file
@ -0,0 +1,519 @@
|
|||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Hermitian part of 1-body Jastrow factow in the |AO| basis set.
|
||||||
|
!
|
||||||
|
! :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle`
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: num_A, num_B
|
||||||
|
integer :: power_A(3), power_B(3)
|
||||||
|
integer :: i, j, k1, k2, l, m
|
||||||
|
double precision :: alpha, beta, gama1, gama2
|
||||||
|
double precision :: A_center(3), B_center(3), C_center1(3), C_center2(3)
|
||||||
|
double precision :: c1, c
|
||||||
|
|
||||||
|
integer :: dim1
|
||||||
|
double precision :: overlap_y, d_a_2, overlap_z, overlap
|
||||||
|
|
||||||
|
double precision :: int_gauss_4G
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
! --------------------------------------------------------------------------------
|
||||||
|
! -- Dummy call to provide everything
|
||||||
|
dim1 = 100
|
||||||
|
A_center(:) = 0.d0
|
||||||
|
B_center(:) = 1.d0
|
||||||
|
alpha = 1.d0
|
||||||
|
beta = 0.1d0
|
||||||
|
power_A(:) = 1
|
||||||
|
power_B(:) = 0
|
||||||
|
call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_y, d_a_2, overlap_z, overlap, dim1 )
|
||||||
|
! --------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
j1b_gauss_hermII(1:ao_num,1:ao_num) = 0.d0
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (i, j, k1, k2, l, m, alpha, beta, gama1, gama2, &
|
||||||
|
!$OMP A_center, B_center, C_center1, C_center2, &
|
||||||
|
!$OMP power_A, power_B, num_A, num_B, c1, c) &
|
||||||
|
!$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, &
|
||||||
|
!$OMP ao_power, ao_nucl, nucl_coord, &
|
||||||
|
!$OMP ao_coef_normalized_ordered_transp, &
|
||||||
|
!$OMP nucl_num, j1b_gauss_pen, j1b_gauss_hermII)
|
||||||
|
|
||||||
|
!$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_ordered_transp(l,j)
|
||||||
|
|
||||||
|
do m = 1, ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
|
||||||
|
c = 0.d0
|
||||||
|
do k1 = 1, nucl_num
|
||||||
|
gama1 = j1b_gauss_pen(k1)
|
||||||
|
C_center1(1:3) = nucl_coord(k1,1:3)
|
||||||
|
|
||||||
|
do k2 = 1, nucl_num
|
||||||
|
gama2 = j1b_gauss_pen(k2)
|
||||||
|
C_center2(1:3) = nucl_coord(k2,1:3)
|
||||||
|
|
||||||
|
! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB >
|
||||||
|
c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2 &
|
||||||
|
, power_A, power_B, alpha, beta, gama1, gama2 )
|
||||||
|
|
||||||
|
c = c - 2.d0 * gama1 * gama2 * c1
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_hermII(i,j) = j1b_gauss_hermII(i,j) &
|
||||||
|
+ ao_coef_normalized_ordered_transp(l,j) &
|
||||||
|
* ao_coef_normalized_ordered_transp(m,i) * c
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
!
|
||||||
|
! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB >
|
||||||
|
!
|
||||||
|
double precision function int_gauss_4G( A_center, B_center, C_center1, C_center2, power_A, power_B &
|
||||||
|
, alpha, beta, gama1, gama2 )
|
||||||
|
|
||||||
|
! for max_dim
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer , intent(in) :: power_A(3), power_B(3)
|
||||||
|
double precision, intent(in) :: A_center(3), B_center(3), C_center1(3), C_center2(3)
|
||||||
|
double precision, intent(in) :: alpha, beta, gama1, gama2
|
||||||
|
|
||||||
|
integer :: i, dim1, power_C
|
||||||
|
integer :: iorder(3)
|
||||||
|
double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
|
||||||
|
double precision :: gama, fact_C, C_center(3)
|
||||||
|
double precision :: cx0, cy0, cz0, c_tmp1, c_tmp2, cx, cy, cz
|
||||||
|
double precision :: int_tmp
|
||||||
|
|
||||||
|
double precision :: overlap_gaussian_x
|
||||||
|
|
||||||
|
dim1 = 100
|
||||||
|
|
||||||
|
! P_AB(0:max_dim,3) polynomial
|
||||||
|
! AB_center(3) new center
|
||||||
|
! AB_expo new exponent
|
||||||
|
! fact_AB constant factor
|
||||||
|
! iorder(3) i_order(i) = order of the polynomials
|
||||||
|
call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
|
||||||
|
|
||||||
|
call gaussian_product(gama1, C_center1, gama2, C_center2, fact_C, gama, C_center)
|
||||||
|
|
||||||
|
! <<<
|
||||||
|
! to avoid multi-evaluation
|
||||||
|
power_C = 0
|
||||||
|
|
||||||
|
cx0 = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
cy0 = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
cz0 = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
! >>>
|
||||||
|
|
||||||
|
int_tmp = 0.d0
|
||||||
|
|
||||||
|
! -----------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! x term:
|
||||||
|
! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (x - x_C1) (x - x_C2) | XB >
|
||||||
|
!
|
||||||
|
|
||||||
|
c_tmp1 = 2.d0 * C_center(1) - C_center1(1) - C_center2(1)
|
||||||
|
c_tmp2 = ( C_center(1) - C_center1(1) ) * ( C_center(1) - C_center2(1) )
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] (x - x_C)^2 | XB >
|
||||||
|
power_C = 2
|
||||||
|
cx = cx + P_AB(i,1) &
|
||||||
|
* overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] (x - x_C) | XB >
|
||||||
|
power_C = 1
|
||||||
|
cx = cx + P_AB(i,1) * c_tmp1 &
|
||||||
|
* overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] | XB >
|
||||||
|
power_C = 0
|
||||||
|
cx = cx + P_AB(i,1) * c_tmp2 &
|
||||||
|
* overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_tmp += cx * cy0 * cz0
|
||||||
|
|
||||||
|
! -----------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! -----------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! y term:
|
||||||
|
! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (y - y_C1) (y - y_C2) | XB >
|
||||||
|
!
|
||||||
|
|
||||||
|
c_tmp1 = 2.d0 * C_center(2) - C_center1(2) - C_center2(2)
|
||||||
|
c_tmp2 = ( C_center(2) - C_center1(2) ) * ( C_center(2) - C_center2(2) )
|
||||||
|
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] (y - y_C)^2 | XB >
|
||||||
|
power_C = 2
|
||||||
|
cy = cy + P_AB(i,2) &
|
||||||
|
* overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] (y - y_C) | XB >
|
||||||
|
power_C = 1
|
||||||
|
cy = cy + P_AB(i,2) * c_tmp1 &
|
||||||
|
* overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] | XB >
|
||||||
|
power_C = 0
|
||||||
|
cy = cy + P_AB(i,2) * c_tmp2 &
|
||||||
|
* overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_tmp += cx0 * cy * cz0
|
||||||
|
|
||||||
|
! -----------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! -----------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! z term:
|
||||||
|
! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (z - z_C1) (z - z_C2) | XB >
|
||||||
|
!
|
||||||
|
|
||||||
|
c_tmp1 = 2.d0 * C_center(3) - C_center1(3) - C_center2(3)
|
||||||
|
c_tmp2 = ( C_center(3) - C_center1(3) ) * ( C_center(3) - C_center2(3) )
|
||||||
|
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] (z - z_C)^2 | XB >
|
||||||
|
power_C = 2
|
||||||
|
cz = cz + P_AB(i,3) &
|
||||||
|
* overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] (z - z_C) | XB >
|
||||||
|
power_C = 1
|
||||||
|
cz = cz + P_AB(i,3) * c_tmp1 &
|
||||||
|
* overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] | XB >
|
||||||
|
power_C = 0
|
||||||
|
cz = cz + P_AB(i,3) * c_tmp2 &
|
||||||
|
* overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_tmp += cx0 * cy0 * cz
|
||||||
|
|
||||||
|
! -----------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
int_gauss_4G = fact_AB * fact_C * int_tmp
|
||||||
|
|
||||||
|
return
|
||||||
|
end function int_gauss_4G
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Hermitian part of 1-body Jastrow factow in the |AO| basis set.
|
||||||
|
!
|
||||||
|
! :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \rangle`
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: num_A, num_B
|
||||||
|
integer :: power_A(3), power_B(3)
|
||||||
|
integer :: i, j, k, l, m
|
||||||
|
double precision :: alpha, beta, gama
|
||||||
|
double precision :: A_center(3), B_center(3), C_center(3)
|
||||||
|
double precision :: c1, c2, c
|
||||||
|
|
||||||
|
integer :: dim1
|
||||||
|
double precision :: overlap_y, d_a_2, overlap_z, overlap
|
||||||
|
|
||||||
|
double precision :: int_gauss_r0, int_gauss_r2
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
! --------------------------------------------------------------------------------
|
||||||
|
! -- Dummy call to provide everything
|
||||||
|
dim1 = 100
|
||||||
|
A_center(:) = 0.d0
|
||||||
|
B_center(:) = 1.d0
|
||||||
|
alpha = 1.d0
|
||||||
|
beta = 0.1d0
|
||||||
|
power_A(:) = 1
|
||||||
|
power_B(:) = 0
|
||||||
|
call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_y, d_a_2, overlap_z, overlap, dim1 )
|
||||||
|
! --------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
j1b_gauss_hermI(1:ao_num,1:ao_num) = 0.d0
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, &
|
||||||
|
!$OMP A_center, B_center, C_center, power_A, power_B, &
|
||||||
|
!$OMP num_A, num_B, c1, c2, c) &
|
||||||
|
!$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, &
|
||||||
|
!$OMP ao_power, ao_nucl, nucl_coord, &
|
||||||
|
!$OMP ao_coef_normalized_ordered_transp, &
|
||||||
|
!$OMP nucl_num, j1b_gauss_pen, j1b_gauss_hermI)
|
||||||
|
|
||||||
|
!$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_ordered_transp(l,j)
|
||||||
|
|
||||||
|
do m = 1, ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
|
||||||
|
c = 0.d0
|
||||||
|
do k = 1, nucl_num
|
||||||
|
|
||||||
|
gama = j1b_gauss_pen(k)
|
||||||
|
C_center(1:3) = nucl_coord(k,1:3)
|
||||||
|
|
||||||
|
! < XA | exp[-gama r_C^2] | XB >
|
||||||
|
c1 = int_gauss_r0( A_center, B_center, C_center &
|
||||||
|
, power_A, power_B, alpha, beta, gama )
|
||||||
|
|
||||||
|
! < XA | r_A^2 exp[-gama r_C^2] | XB >
|
||||||
|
c2 = int_gauss_r2( A_center, B_center, C_center &
|
||||||
|
, power_A, power_B, alpha, beta, gama )
|
||||||
|
|
||||||
|
c = c + 3.d0 * gama * c1 - 2.d0 * gama * gama * c2
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_hermI(i,j) = j1b_gauss_hermI(i,j) &
|
||||||
|
+ ao_coef_normalized_ordered_transp(l,j) &
|
||||||
|
* ao_coef_normalized_ordered_transp(m,i) * c
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
!
|
||||||
|
! < XA | exp[-gama r_C^2] | XB >
|
||||||
|
!
|
||||||
|
double precision function int_gauss_r0(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
|
||||||
|
|
||||||
|
! for max_dim
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer , intent(in) :: power_A(3), power_B(3)
|
||||||
|
double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
|
||||||
|
double precision, intent(in) :: alpha, beta, gama
|
||||||
|
|
||||||
|
integer :: i, power_C, dim1
|
||||||
|
integer :: iorder(3)
|
||||||
|
integer :: nmax
|
||||||
|
double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
|
||||||
|
double precision :: cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: overlap_gaussian_x
|
||||||
|
|
||||||
|
dim1 = 100
|
||||||
|
|
||||||
|
! P_AB(0:max_dim,3) polynomial
|
||||||
|
! AB_center(3) new center
|
||||||
|
! AB_expo new exponent
|
||||||
|
! fact_AB constant factor
|
||||||
|
! iorder(3) i_order(i) = order of the polynomials
|
||||||
|
call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
|
||||||
|
|
||||||
|
if( fact_AB .lt. 1d-20 ) then
|
||||||
|
int_gauss_r0 = 0.d0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
power_C = 0
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_gauss_r0 = fact_AB * cx * cy * cz
|
||||||
|
|
||||||
|
return
|
||||||
|
end function int_gauss_r0
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
!
|
||||||
|
! < XA | r_C^2 exp[-gama r_C^2] | XB >
|
||||||
|
!
|
||||||
|
double precision function int_gauss_r2(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
|
||||||
|
|
||||||
|
! for max_dim
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: power_A(3), power_B(3)
|
||||||
|
double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
|
||||||
|
double precision, intent(in) :: alpha, beta, gama
|
||||||
|
|
||||||
|
integer :: i, power_C, dim1
|
||||||
|
integer :: iorder(3)
|
||||||
|
double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
|
||||||
|
double precision :: cx0, cy0, cz0, cx, cy, cz
|
||||||
|
double precision :: int_tmp
|
||||||
|
|
||||||
|
double precision :: overlap_gaussian_x
|
||||||
|
|
||||||
|
dim1 = 100
|
||||||
|
|
||||||
|
! P_AB(0:max_dim,3) polynomial centered on AB_center
|
||||||
|
! AB_center(3) new center
|
||||||
|
! AB_expo new exponent
|
||||||
|
! fact_AB constant factor
|
||||||
|
! iorder(3) i_order(i) = order of the polynomials
|
||||||
|
call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
|
||||||
|
|
||||||
|
! <<<
|
||||||
|
! to avoid multi-evaluation
|
||||||
|
power_C = 0
|
||||||
|
|
||||||
|
cx0 = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
cy0 = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
cz0 = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
! >>>
|
||||||
|
|
||||||
|
int_tmp = 0.d0
|
||||||
|
|
||||||
|
power_C = 2
|
||||||
|
|
||||||
|
! ( x - XC)^2
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
int_tmp += cx * cy0 * cz0
|
||||||
|
|
||||||
|
! ( y - YC)^2
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
int_tmp += cx0 * cy * cz0
|
||||||
|
|
||||||
|
! ( z - ZC)^2
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
int_tmp += cx0 * cy0 * cz
|
||||||
|
|
||||||
|
int_gauss_r2 = fact_AB * int_tmp
|
||||||
|
|
||||||
|
return
|
||||||
|
end function int_gauss_r2
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
!_____________________________________________________________________________________________________________
|
319
src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f
Normal file
319
src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f
Normal file
@ -0,0 +1,319 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Hermitian part of 1-body Jastrow factow in the |AO| basis set.
|
||||||
|
!
|
||||||
|
! \langle \chi_i | - grad \tau_{1b} \cdot grad | \chi_j \rangle =
|
||||||
|
! 2 \sum_A aA \langle \chi_i | exp[-aA riA^2] (ri-rA) \cdot grad | \chi_j \rangle
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: num_A, num_B
|
||||||
|
integer :: power_A(3), power_B(3)
|
||||||
|
integer :: i, j, k, l, m
|
||||||
|
double precision :: alpha, beta, gama
|
||||||
|
double precision :: A_center(3), B_center(3), C_center(3)
|
||||||
|
double precision :: c1, c
|
||||||
|
|
||||||
|
integer :: dim1
|
||||||
|
double precision :: overlap_y, d_a_2, overlap_z, overlap
|
||||||
|
|
||||||
|
double precision :: int_gauss_deriv
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
! --------------------------------------------------------------------------------
|
||||||
|
! -- Dummy call to provide everything
|
||||||
|
dim1 = 100
|
||||||
|
A_center(:) = 0.d0
|
||||||
|
B_center(:) = 1.d0
|
||||||
|
alpha = 1.d0
|
||||||
|
beta = 0.1d0
|
||||||
|
power_A(:) = 1
|
||||||
|
power_B(:) = 0
|
||||||
|
call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_y, d_a_2, overlap_z, overlap, dim1 )
|
||||||
|
! --------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
j1b_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, &
|
||||||
|
!$OMP A_center, B_center, C_center, power_A, power_B, &
|
||||||
|
!$OMP num_A, num_B, c1, c) &
|
||||||
|
!$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, &
|
||||||
|
!$OMP ao_power, ao_nucl, nucl_coord, &
|
||||||
|
!$OMP ao_coef_normalized_ordered_transp, &
|
||||||
|
!$OMP nucl_num, j1b_gauss_pen, j1b_gauss_nonherm)
|
||||||
|
|
||||||
|
!$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_ordered_transp(l,j)
|
||||||
|
|
||||||
|
do m = 1, ao_prim_num(i)
|
||||||
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
|
||||||
|
c = 0.d0
|
||||||
|
do k = 1, nucl_num
|
||||||
|
|
||||||
|
gama = j1b_gauss_pen(k)
|
||||||
|
C_center(1:3) = nucl_coord(k,1:3)
|
||||||
|
|
||||||
|
! \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle
|
||||||
|
c1 = int_gauss_deriv( A_center, B_center, C_center &
|
||||||
|
, power_A, power_B, alpha, beta, gama )
|
||||||
|
|
||||||
|
c = c + 2.d0 * gama * c1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_nonherm(i,j) = j1b_gauss_nonherm(i,j) &
|
||||||
|
+ ao_coef_normalized_ordered_transp(l,j) &
|
||||||
|
* ao_coef_normalized_ordered_transp(m,i) * c
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
!
|
||||||
|
! < XA | exp[-gama r_C^2] r_C \cdot grad | XB >
|
||||||
|
!
|
||||||
|
double precision function int_gauss_deriv(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
|
||||||
|
|
||||||
|
! for max_dim
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
|
||||||
|
integer , intent(in) :: power_A(3), power_B(3)
|
||||||
|
double precision, intent(in) :: alpha, beta, gama
|
||||||
|
|
||||||
|
integer :: i, power_C, dim1
|
||||||
|
integer :: iorder(3), power_D(3)
|
||||||
|
double precision :: AB_expo
|
||||||
|
double precision :: fact_AB, center_AB(3), pol_AB(0:max_dim,3)
|
||||||
|
double precision :: cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: overlap_gaussian_x
|
||||||
|
|
||||||
|
dim1 = 100
|
||||||
|
|
||||||
|
int_gauss_deriv = 0.d0
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
! term I:
|
||||||
|
! \partial_x
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
if( power_B(1) .ge. 1 ) then
|
||||||
|
|
||||||
|
power_D(1) = power_B(1) - 1
|
||||||
|
power_D(2) = power_B(2)
|
||||||
|
power_D(3) = power_B(3)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
|
||||||
|
power_C = 1
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 0
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 0
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(1)) * cx * cy * cz
|
||||||
|
endif
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
power_D(1) = power_B(1) + 1
|
||||||
|
power_D(2) = power_B(2)
|
||||||
|
power_D(3) = power_B(3)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
|
||||||
|
power_C = 1
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 0
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 0
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
! term II:
|
||||||
|
! \partial_y
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
if( power_B(2) .ge. 1 ) then
|
||||||
|
|
||||||
|
power_D(1) = power_B(1)
|
||||||
|
power_D(2) = power_B(2) - 1
|
||||||
|
power_D(3) = power_B(3)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
|
||||||
|
power_C = 0
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 1
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 0
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(2)) * cx * cy * cz
|
||||||
|
endif
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
power_D(1) = power_B(1)
|
||||||
|
power_D(2) = power_B(2) + 1
|
||||||
|
power_D(3) = power_B(3)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
|
||||||
|
power_C = 0
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 1
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 0
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
! term III:
|
||||||
|
! \partial_z
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
if( power_B(3) .ge. 1 ) then
|
||||||
|
|
||||||
|
power_D(1) = power_B(1)
|
||||||
|
power_D(2) = power_B(2)
|
||||||
|
power_D(3) = power_B(3) - 1
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
|
||||||
|
power_C = 0
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 0
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 1
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(3)) * cx * cy * cz
|
||||||
|
endif
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
power_D(1) = power_B(1)
|
||||||
|
power_D(2) = power_B(2)
|
||||||
|
power_D(3) = power_B(3) + 1
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
|
||||||
|
, iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
|
||||||
|
power_C = 0
|
||||||
|
cx = 0.d0
|
||||||
|
do i = 0, iorder(1)
|
||||||
|
cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 0
|
||||||
|
cy = 0.d0
|
||||||
|
do i = 0, iorder(2)
|
||||||
|
cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
power_C = 1
|
||||||
|
cz = 0.d0
|
||||||
|
do i = 0, iorder(3)
|
||||||
|
cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
|
||||||
|
|
||||||
|
! ===============
|
||||||
|
! ===============
|
||||||
|
|
||||||
|
return
|
||||||
|
end function int_gauss_deriv
|
||||||
|
!_____________________________________________________________________________________________________________
|
||||||
|
!_____________________________________________________________________________________________________________
|
203
src/ao_tc_eff_map/potential.irp.f
Normal file
203
src/ao_tc_eff_map/potential.irp.f
Normal file
@ -0,0 +1,203 @@
|
|||||||
|
BEGIN_PROVIDER [integer, n_gauss_eff_pot]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! number of gaussians to represent the effective potential :
|
||||||
|
!
|
||||||
|
! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2)
|
||||||
|
!
|
||||||
|
! Here (1 - erf(mu*r12))^2 is expanded in Gaussians as Eqs A11-A20 in JCP 154, 084119 (2021)
|
||||||
|
END_DOC
|
||||||
|
n_gauss_eff_pot = n_max_fit_slat + 1
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, n_gauss_eff_pot_deriv]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! V(r12) = -(1 - erf(mu*r12))^2 is expanded in Gaussians as Eqs A11-A20 in JCP 154, 084119 (2021)
|
||||||
|
END_DOC
|
||||||
|
n_gauss_eff_pot_deriv = n_max_fit_slat
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, expo_gauss_eff_pot, (n_gauss_eff_pot)]
|
||||||
|
&BEGIN_PROVIDER [double precision, coef_gauss_eff_pot, (n_gauss_eff_pot)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Coefficients and exponents of the Fit on Gaussians of V(X) = -(1 - erf(mu*X))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*X)^2)
|
||||||
|
!
|
||||||
|
! V(X) = \sum_{i=1,n_gauss_eff_pot} coef_gauss_eff_pot(i) * exp(-expo_gauss_eff_pot(i) * X^2)
|
||||||
|
!
|
||||||
|
! Relies on the fit proposed in Eqs A11-A20 in JCP 154, 084119 (2021)
|
||||||
|
END_DOC
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
! fit of the -0.25 * (1 - erf(mu*x))^2 with n_max_fit_slat gaussians
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
expo_gauss_eff_pot(i) = expo_gauss_1_erf_x_2(i)
|
||||||
|
coef_gauss_eff_pot(i) = -0.25d0 * coef_gauss_1_erf_x_2(i) ! -1/4 * (1 - erf(mu*x))^2
|
||||||
|
enddo
|
||||||
|
! Analytical Gaussian part of the potential: + 1/(\sqrt(pi)mu) * exp(-(mu*x)^2)
|
||||||
|
expo_gauss_eff_pot(n_max_fit_slat+1) = mu_erf * mu_erf
|
||||||
|
coef_gauss_eff_pot(n_max_fit_slat+1) = 1.d0 * mu_erf * inv_sq_pi
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
double precision function eff_pot_gauss(x,mu)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2)
|
||||||
|
END_DOC
|
||||||
|
double precision, intent(in) :: x,mu
|
||||||
|
eff_pot_gauss = mu/dsqrt(dacos(-1.d0)) * dexp(-mu*mu*x*x) - 0.25d0 * (1.d0 - derf(mu*x))**2.d0
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------
|
||||||
|
! ---
|
||||||
|
|
||||||
|
double precision function eff_pot_fit_gauss(x)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2)
|
||||||
|
!
|
||||||
|
! but fitted with gaussians
|
||||||
|
END_DOC
|
||||||
|
double precision, intent(in) :: x
|
||||||
|
integer :: i
|
||||||
|
double precision :: alpha
|
||||||
|
eff_pot_fit_gauss = derf(mu_erf*x)/x
|
||||||
|
do i = 1, n_gauss_eff_pot
|
||||||
|
alpha = expo_gauss_eff_pot(i)
|
||||||
|
eff_pot_fit_gauss += coef_gauss_eff_pot(i) * dexp(-alpha*x*x)
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, n_fit_1_erf_x]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
n_fit_1_erf_x = 2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, expos_slat_gauss_1_erf_x, (n_fit_1_erf_x)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! 1 - erf(mu*x) is fitted with a Slater and gaussian as in Eq.A15 of JCP 154, 084119 (2021)
|
||||||
|
!
|
||||||
|
! 1 - erf(mu*x) = e^{-expos_slat_gauss_1_erf_x(1) * mu *x} * e^{-expos_slat_gauss_1_erf_x(2) * mu^2 * x^2}
|
||||||
|
END_DOC
|
||||||
|
expos_slat_gauss_1_erf_x(1) = 1.09529d0
|
||||||
|
expos_slat_gauss_1_erf_x(2) = 0.756023d0
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x, (n_max_fit_slat)]
|
||||||
|
&BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x, (n_max_fit_slat)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! (1 - erf(mu*x)) = \sum_i coef_gauss_1_erf_x(i) * exp(-expo_gauss_1_erf_x(i) * x^2)
|
||||||
|
!
|
||||||
|
! This is based on a fit of (1 - erf(mu*x)) by exp(-alpha * x) exp(-beta*mu^2x^2)
|
||||||
|
!
|
||||||
|
! and the slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians
|
||||||
|
!
|
||||||
|
! See Appendix 2 of JCP 154, 084119 (2021)
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
double precision :: expos(n_max_fit_slat),alpha,beta
|
||||||
|
alpha = expos_slat_gauss_1_erf_x(1) * mu_erf
|
||||||
|
call expo_fit_slater_gam(alpha,expos)
|
||||||
|
beta = expos_slat_gauss_1_erf_x(2) * mu_erf**2.d0
|
||||||
|
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
expo_gauss_1_erf_x(i) = expos(i) + beta
|
||||||
|
coef_gauss_1_erf_x(i) = coef_fit_slat_gauss(i)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
double precision function fit_1_erf_x(x)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: x
|
||||||
|
BEGIN_DOC
|
||||||
|
! fit_1_erf_x(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
fit_1_erf_x = 0.d0
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
fit_1_erf_x += dexp(-expo_gauss_1_erf_x(i) *x*x) * coef_gauss_1_erf_x(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x_2, (n_max_fit_slat)]
|
||||||
|
&BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x_2, (n_max_fit_slat)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! (1 - erf(mu*x))^2 = \sum_i coef_gauss_1_erf_x_2(i) * exp(-expo_gauss_1_erf_x_2(i) * x^2)
|
||||||
|
!
|
||||||
|
! This is based on a fit of (1 - erf(mu*x)) by exp(-alpha * x) exp(-beta*mu^2x^2)
|
||||||
|
!
|
||||||
|
! and the slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
double precision :: expos(n_max_fit_slat),alpha,beta
|
||||||
|
alpha = 2.d0 * expos_slat_gauss_1_erf_x(1) * mu_erf
|
||||||
|
call expo_fit_slater_gam(alpha,expos)
|
||||||
|
beta = 2.d0 * expos_slat_gauss_1_erf_x(2) * mu_erf**2.d0
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
expo_gauss_1_erf_x_2(i) = expos(i) + beta
|
||||||
|
coef_gauss_1_erf_x_2(i) = coef_fit_slat_gauss(i)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
double precision function fit_1_erf_x_2(x)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: x
|
||||||
|
BEGIN_DOC
|
||||||
|
! fit_1_erf_x_2(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))^2
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
fit_1_erf_x_2 = 0.d0
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
fit_1_erf_x_2 += dexp(-expo_gauss_1_erf_x_2(i) *x*x) * coef_gauss_1_erf_x_2(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine inv_r_times_poly(r, dist_r, dist_vec, poly)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! returns
|
||||||
|
!
|
||||||
|
! poly(1) = x / sqrt(x^2+y^2+z^2), poly(2) = y / sqrt(x^2+y^2+z^2), poly(3) = z / sqrt(x^2+y^2+z^2)
|
||||||
|
!
|
||||||
|
! with the arguments
|
||||||
|
!
|
||||||
|
! r(1) = x, r(2) = y, r(3) = z, dist_r = sqrt(x^2+y^2+z^2)
|
||||||
|
!
|
||||||
|
! dist_vec(1) = sqrt(y^2+z^2), dist_vec(2) = sqrt(x^2+z^2), dist_vec(3) = sqrt(x^2+y^2)
|
||||||
|
END_DOC
|
||||||
|
double precision, intent(in) :: r(3), dist_r, dist_vec(3)
|
||||||
|
double precision, intent(out):: poly(3)
|
||||||
|
double precision :: inv_dist
|
||||||
|
integer :: i
|
||||||
|
if (dist_r.gt. 1.d-8)then
|
||||||
|
inv_dist = 1.d0/dist_r
|
||||||
|
do i = 1, 3
|
||||||
|
poly(i) = r(i) * inv_dist
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
do i = 1, 3
|
||||||
|
if(dabs(r(i)).lt.dist_vec(i))then
|
||||||
|
inv_dist = 1.d0/dist_r
|
||||||
|
poly(i) = r(i) * inv_dist
|
||||||
|
else !if(dabs(r(i)))then
|
||||||
|
poly(i) = 1.d0
|
||||||
|
! poly(i) = 0.d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
end
|
86
src/ao_tc_eff_map/providers_ao_eff_pot.irp.f
Normal file
86
src/ao_tc_eff_map/providers_ao_eff_pot.irp.f
Normal file
@ -0,0 +1,86 @@
|
|||||||
|
|
||||||
|
BEGIN_PROVIDER [ logical, ao_tc_sym_two_e_pot_in_map ]
|
||||||
|
implicit none
|
||||||
|
use f77_zmq
|
||||||
|
use map_module
|
||||||
|
BEGIN_DOC
|
||||||
|
! Map of Atomic integrals
|
||||||
|
! i(r1) j(r2) 1/r12 k(r1) l(r2)
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i,j,k,l
|
||||||
|
double precision :: ao_tc_sym_two_e_pot,cpu_1,cpu_2, wall_1, wall_2
|
||||||
|
double precision :: integral, wall_0
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
! For integrals file
|
||||||
|
integer(key_kind),allocatable :: buffer_i(:)
|
||||||
|
integer,parameter :: size_buffer = 1024*64
|
||||||
|
real(integral_kind),allocatable :: buffer_value(:)
|
||||||
|
|
||||||
|
integer :: n_integrals, rc
|
||||||
|
integer :: kk, m, j1, i1, lmax
|
||||||
|
character*(64) :: fmt
|
||||||
|
|
||||||
|
!double precision :: j1b_gauss_coul_debug
|
||||||
|
!integral = j1b_gauss_coul_debug(1,1,1,1)
|
||||||
|
|
||||||
|
integral = ao_tc_sym_two_e_pot(1,1,1,1)
|
||||||
|
|
||||||
|
double precision :: map_mb
|
||||||
|
|
||||||
|
print*, 'Providing the ao_tc_sym_two_e_pot_map integrals'
|
||||||
|
call wall_time(wall_0)
|
||||||
|
call wall_time(wall_1)
|
||||||
|
call cpu_time(cpu_1)
|
||||||
|
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
|
||||||
|
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_tc_sym_two_e_pot')
|
||||||
|
|
||||||
|
character(len=:), allocatable :: task
|
||||||
|
allocate(character(len=ao_num*12) :: task)
|
||||||
|
write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
|
||||||
|
do l=1,ao_num
|
||||||
|
write(task,fmt) (i,l, i=1,l)
|
||||||
|
integer, external :: add_task_to_taskserver
|
||||||
|
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
|
||||||
|
stop 'Unable to add task to server'
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
deallocate(task)
|
||||||
|
|
||||||
|
integer, external :: zmq_set_running
|
||||||
|
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||||
|
print *, irp_here, ': Failed in zmq_set_running'
|
||||||
|
endif
|
||||||
|
|
||||||
|
PROVIDE nproc
|
||||||
|
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
if (i==0) then
|
||||||
|
call ao_tc_sym_two_e_pot_in_map_collector(zmq_socket_pull)
|
||||||
|
else
|
||||||
|
call ao_tc_sym_two_e_pot_in_map_slave_inproc(i)
|
||||||
|
endif
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_tc_sym_two_e_pot')
|
||||||
|
|
||||||
|
|
||||||
|
print*, 'Sorting the map'
|
||||||
|
call map_sort(ao_tc_sym_two_e_pot_map)
|
||||||
|
call cpu_time(cpu_2)
|
||||||
|
call wall_time(wall_2)
|
||||||
|
integer(map_size_kind) :: get_ao_tc_sym_two_e_pot_map_size, ao_eff_pot_map_size
|
||||||
|
ao_eff_pot_map_size = get_ao_tc_sym_two_e_pot_map_size()
|
||||||
|
|
||||||
|
print*, 'AO eff_pot integrals provided:'
|
||||||
|
print*, ' Size of AO eff_pot map : ', map_mb(ao_tc_sym_two_e_pot_map) ,'MB'
|
||||||
|
print*, ' Number of AO eff_pot integrals :', ao_eff_pot_map_size
|
||||||
|
print*, ' cpu time :',cpu_2 - cpu_1, 's'
|
||||||
|
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
|
||||||
|
|
||||||
|
ao_tc_sym_two_e_pot_in_map = .True.
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
800
src/ao_tc_eff_map/two_e_1bgauss_coul.irp.f
Normal file
800
src/ao_tc_eff_map/two_e_1bgauss_coul.irp.f
Normal file
@ -0,0 +1,800 @@
|
|||||||
|
double precision function j1b_gauss_coul(i, j, k, l)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! integral in the AO basis:
|
||||||
|
! i(r1) j(r1) f(r12) k(r2) l(r2)
|
||||||
|
!
|
||||||
|
! with:
|
||||||
|
! f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
|
||||||
|
! = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! + (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s, ii
|
||||||
|
integer :: num_i, num_j, num_k, num_l, num_ii
|
||||||
|
integer :: I_power(3), J_power(3), K_power(3), L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
integer :: shift_P(3), shift_Q(3)
|
||||||
|
integer :: dim1
|
||||||
|
|
||||||
|
double precision :: coef1, coef2, coef3, coef4
|
||||||
|
double precision :: expo1, expo2, expo3, expo4
|
||||||
|
double precision :: p_inv, q_inv
|
||||||
|
double precision :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp
|
||||||
|
double precision :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp
|
||||||
|
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
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: expoii, factii, Centerii(3)
|
||||||
|
double precision :: ff, gg, cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: general_primitive_integral_coul_shifted
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul = 0.d0
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
|
||||||
|
|
||||||
|
fact_p = fact_p_tmp * factii
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
! pol centerd on P_center_tmp ==> centerd on P_center
|
||||||
|
call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
ff = P_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! y term:
|
||||||
|
|
||||||
|
ff = P_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_P = (/ 0, 2, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! z term:
|
||||||
|
|
||||||
|
ff = P_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 2 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul = j1b_gauss_coul + coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
|
||||||
|
|
||||||
|
fact_q = fact_q_tmp * factii
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
! pol centerd on Q_center_tmp ==> centerd on Q_center
|
||||||
|
call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
ff = Q_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_Q = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! y term:
|
||||||
|
|
||||||
|
ff = Q_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 2, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! z term:
|
||||||
|
|
||||||
|
ff = Q_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 2 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul = j1b_gauss_coul + coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
|
||||||
|
|
||||||
|
fact_p = fact_p_tmp * factii
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
! pol centerd on P_center_tmp ==> centerd on P_center
|
||||||
|
call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
ff = P_center(1) - Centerii(1)
|
||||||
|
gg = Q_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! y term:
|
||||||
|
|
||||||
|
ff = P_center(2) - Centerii(2)
|
||||||
|
gg = Q_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! z term:
|
||||||
|
|
||||||
|
ff = P_center(3) - Centerii(3)
|
||||||
|
gg = Q_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul = j1b_gauss_coul - coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
|
||||||
|
|
||||||
|
fact_q = fact_q_tmp * factii
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
! pol centerd on Q_center_tmp ==> centerd on Q_center
|
||||||
|
call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
ff = P_center(1) - Centerii(1)
|
||||||
|
gg = Q_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! y term:
|
||||||
|
|
||||||
|
ff = P_center(2) - Centerii(2)
|
||||||
|
gg = Q_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! z term:
|
||||||
|
|
||||||
|
ff = P_center(3) - Centerii(3)
|
||||||
|
gg = Q_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul = j1b_gauss_coul - coef4 * ( cx + cy + cz )
|
||||||
|
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
return
|
||||||
|
end function j1b_gauss_coul
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
!______________________________________________________________________________________________________________________
|
||||||
|
!______________________________________________________________________________________________________________________
|
||||||
|
|
||||||
|
double precision function general_primitive_integral_coul_shifted( dim &
|
||||||
|
, P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: dim
|
||||||
|
integer, intent(in) :: iorder_p(3), shift_P(3)
|
||||||
|
integer, intent(in) :: iorder_q(3), shift_Q(3)
|
||||||
|
double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv
|
||||||
|
double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv
|
||||||
|
|
||||||
|
integer :: n_Ix, n_Iy, n_Iz, nx, ny, nz
|
||||||
|
integer :: ix, iy, iz, jx, jy, jz, i
|
||||||
|
integer :: n_pt_tmp, n_pt_out, iorder
|
||||||
|
integer :: ii, jj
|
||||||
|
double precision :: rho, dist
|
||||||
|
double precision :: dx(0:max_dim), Ix_pol(0:max_dim)
|
||||||
|
double precision :: dy(0:max_dim), Iy_pol(0:max_dim)
|
||||||
|
double precision :: dz(0:max_dim), Iz_pol(0:max_dim)
|
||||||
|
double precision :: a, b, c, d, e, f, accu, pq, const
|
||||||
|
double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2
|
||||||
|
double precision :: d1(0:max_dim), d_poly(0:max_dim)
|
||||||
|
double precision :: p_plus_q
|
||||||
|
|
||||||
|
double precision :: rint_sum
|
||||||
|
|
||||||
|
general_primitive_integral_coul_shifted = 0.d0
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
|
||||||
|
|
||||||
|
! Gaussian Product
|
||||||
|
! ----------------
|
||||||
|
p_plus_q = (p+q)
|
||||||
|
pq = p_inv * 0.5d0 * q_inv
|
||||||
|
pq_inv = 0.5d0 / p_plus_q
|
||||||
|
p10_1 = q * pq ! 1/(2p)
|
||||||
|
p01_1 = p * pq ! 1/(2q)
|
||||||
|
pq_inv_2 = pq_inv + pq_inv
|
||||||
|
p10_2 = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p)
|
||||||
|
p01_2 = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq)
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
|
||||||
|
iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1)
|
||||||
|
iorder = iorder + shift_P(1) + shift_Q(1)
|
||||||
|
iorder = iorder + shift_P(1) + shift_Q(1)
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do ix = 0, iorder
|
||||||
|
Ix_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Ix = 0
|
||||||
|
do ix = 0, iorder_p(1)
|
||||||
|
|
||||||
|
ii = ix + shift_P(1)
|
||||||
|
a = P_new(ix,1)
|
||||||
|
if(abs(a) < thresh) cycle
|
||||||
|
|
||||||
|
do jx = 0, iorder_q(1)
|
||||||
|
|
||||||
|
jj = jx + shift_Q(1)
|
||||||
|
d = a * Q_new(jx,1)
|
||||||
|
if(abs(d) < thresh) cycle
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj &
|
||||||
|
, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx )
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
if(n_Ix == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2)
|
||||||
|
iorder = iorder + shift_P(2) + shift_Q(2)
|
||||||
|
iorder = iorder + shift_P(2) + shift_Q(2)
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do ix = 0, iorder
|
||||||
|
Iy_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Iy = 0
|
||||||
|
do iy = 0, iorder_p(2)
|
||||||
|
|
||||||
|
if(abs(P_new(iy,2)) > thresh) then
|
||||||
|
|
||||||
|
ii = iy + shift_P(2)
|
||||||
|
b = P_new(iy,2)
|
||||||
|
|
||||||
|
do jy = 0, iorder_q(2)
|
||||||
|
|
||||||
|
jj = jy + shift_Q(2)
|
||||||
|
e = b * Q_new(jy,2)
|
||||||
|
if(abs(e) < thresh) cycle
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj &
|
||||||
|
, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny )
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if(n_Iy == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3)
|
||||||
|
iorder = iorder + shift_P(3) + shift_Q(3)
|
||||||
|
iorder = iorder + shift_P(3) + shift_Q(3)
|
||||||
|
do ix = 0, iorder
|
||||||
|
Iz_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Iz = 0
|
||||||
|
do iz = 0, iorder_p(3)
|
||||||
|
|
||||||
|
if( abs(P_new(iz,3)) > thresh ) then
|
||||||
|
|
||||||
|
ii = iz + shift_P(3)
|
||||||
|
c = P_new(iz,3)
|
||||||
|
|
||||||
|
do jz = 0, iorder_q(3)
|
||||||
|
|
||||||
|
jj = jz + shift_Q(3)
|
||||||
|
f = c * Q_new(jz,3)
|
||||||
|
if(abs(f) < thresh) cycle
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj &
|
||||||
|
, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz )
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if(n_Iz == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
rho = p * q * pq_inv_2
|
||||||
|
dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
|
||||||
|
+ (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
|
||||||
|
+ (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
|
||||||
|
const = dist*rho
|
||||||
|
|
||||||
|
n_pt_tmp = n_Ix + n_Iy
|
||||||
|
do i = 0, n_pt_tmp
|
||||||
|
d_poly(i) = 0.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp)
|
||||||
|
if(n_pt_tmp == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
n_pt_out = n_pt_tmp + n_Iz
|
||||||
|
do i = 0, n_pt_out
|
||||||
|
d1(i) = 0.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out)
|
||||||
|
accu = accu + rint_sum(n_pt_out, const, d1)
|
||||||
|
|
||||||
|
general_primitive_integral_coul_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q)
|
||||||
|
|
||||||
|
return
|
||||||
|
end function general_primitive_integral_coul_shifted
|
||||||
|
!______________________________________________________________________________________________________________________
|
||||||
|
!______________________________________________________________________________________________________________________
|
433
src/ao_tc_eff_map/two_e_1bgauss_coul_acc.irp.f
Normal file
433
src/ao_tc_eff_map/two_e_1bgauss_coul_acc.irp.f
Normal file
@ -0,0 +1,433 @@
|
|||||||
|
double precision function j1b_gauss_coul_acc(i, j, k, l)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! integral in the AO basis:
|
||||||
|
! i(r1) j(r1) f(r12) k(r2) l(r2)
|
||||||
|
!
|
||||||
|
! with:
|
||||||
|
! f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
|
||||||
|
! = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! + (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s, ii
|
||||||
|
integer :: num_i, num_j, num_k, num_l, num_ii
|
||||||
|
integer :: I_power(3), J_power(3), K_power(3), L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
integer :: shift_P(3), shift_Q(3)
|
||||||
|
integer :: dim1
|
||||||
|
|
||||||
|
double precision :: coef1, coef2, coef3, coef4
|
||||||
|
double precision :: expo1, expo2, expo3, expo4
|
||||||
|
double precision :: p1_inv, q1_inv, p2_inv, q2_inv
|
||||||
|
double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1
|
||||||
|
double precision :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2
|
||||||
|
double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1
|
||||||
|
double precision :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: expoii, factii, Centerii(3)
|
||||||
|
double precision :: ff, gg, cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: general_primitive_integral_coul_shifted
|
||||||
|
!double precision :: j1b_gauss_coul_schwartz_accel
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
|
||||||
|
! TODO
|
||||||
|
!if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
|
||||||
|
! j1b_gauss_coul_schwartz_accel = j1b_gauss_coul_schwartz_accel(i, j, k, l)
|
||||||
|
! return
|
||||||
|
!endif
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul_acc = 0.d0
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p1_inv = 1.d0 / pp1
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q1_inv = 1.d0 / qq1
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)
|
||||||
|
fact_p2 = fact_p1 * factii
|
||||||
|
p2_inv = 1.d0 / pp2
|
||||||
|
call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new)
|
||||||
|
|
||||||
|
call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center)
|
||||||
|
fact_q2 = fact_q1 * factii
|
||||||
|
q2_inv = 1.d0 / qq2
|
||||||
|
call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new)
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_P = (/ 0, 2, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 2 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = Q2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_Q = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = Q2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 2, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = Q2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 2 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P2_center(1) - Centerii(1)
|
||||||
|
gg = Q1_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P2_center(2) - Centerii(2)
|
||||||
|
gg = Q1_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P2_center(3) - Centerii(3)
|
||||||
|
gg = Q1_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P1_center(1) - Centerii(1)
|
||||||
|
gg = Q2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P1_center(2) - Centerii(2)
|
||||||
|
gg = Q2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P1_center(3) - Centerii(3)
|
||||||
|
gg = Q2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul_acc = j1b_gauss_coul_acc + coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
return
|
||||||
|
end function j1b_gauss_coul_acc
|
397
src/ao_tc_eff_map/two_e_1bgauss_coul_debug.irp.f
Normal file
397
src/ao_tc_eff_map/two_e_1bgauss_coul_debug.irp.f
Normal file
@ -0,0 +1,397 @@
|
|||||||
|
double precision function j1b_gauss_coul_debug(i, j, k, l)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! integral in the AO basis:
|
||||||
|
! i(r1) j(r1) f(r12) k(r2) l(r2)
|
||||||
|
!
|
||||||
|
! with:
|
||||||
|
! f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
|
||||||
|
! = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! + (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s, ii
|
||||||
|
integer :: num_i, num_j, num_k, num_l, num_ii
|
||||||
|
integer :: I_power(3), J_power(3), K_power(3), L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
integer :: shift_P(3), shift_Q(3)
|
||||||
|
integer :: dim1
|
||||||
|
|
||||||
|
double precision :: coef1, coef2, coef3, coef4
|
||||||
|
double precision :: expo1, expo2, expo3, expo4
|
||||||
|
double precision :: p_inv, q_inv
|
||||||
|
double precision :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp
|
||||||
|
double precision :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp
|
||||||
|
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
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: expoii, factii, Centerii(3)
|
||||||
|
double precision :: ff, gg, cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: general_primitive_integral_coul_shifted
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul_debug = 0.d0
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
|
||||||
|
|
||||||
|
fact_p = fact_p_tmp * factii
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
! pol centerd on P_center_tmp ==> centerd on P_center
|
||||||
|
call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
ff = P_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul_debug = j1b_gauss_coul_debug + coef4 * cx
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! ! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! !
|
||||||
|
! ! [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! !
|
||||||
|
! ! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! shift_P = (/ 0, 0, 0 /)
|
||||||
|
!
|
||||||
|
! do p = 1, ao_prim_num(i)
|
||||||
|
! coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
! expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
!
|
||||||
|
! do q = 1, ao_prim_num(j)
|
||||||
|
! coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
! expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
!
|
||||||
|
! call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
|
||||||
|
! , I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
! p_inv = 1.d0 / pp
|
||||||
|
!
|
||||||
|
! do r = 1, ao_prim_num(k)
|
||||||
|
! coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
! expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
!
|
||||||
|
! do s = 1, ao_prim_num(l)
|
||||||
|
! coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
! expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
!
|
||||||
|
! call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
|
||||||
|
! , K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
!
|
||||||
|
! cx = 0.d0
|
||||||
|
! do ii = 1, nucl_num
|
||||||
|
! expoii = j1b_gauss_pen(ii)
|
||||||
|
! Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
!
|
||||||
|
! call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
|
||||||
|
!
|
||||||
|
! fact_q = fact_q_tmp * factii
|
||||||
|
! q_inv = 1.d0 / qq
|
||||||
|
!
|
||||||
|
! ! pol centerd on Q_center_tmp ==> centerd on Q_center
|
||||||
|
! call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
|
||||||
|
!
|
||||||
|
! ! ----------------------------------------------------------------------------------------------------
|
||||||
|
! ! x term:
|
||||||
|
!
|
||||||
|
! ff = Q_center(1) - Centerii(1)
|
||||||
|
!
|
||||||
|
! shift_Q = (/ 2, 0, 0 /)
|
||||||
|
! cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
!
|
||||||
|
! shift_Q = (/ 1, 0, 0 /)
|
||||||
|
! cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
!
|
||||||
|
! shift_Q = (/ 0, 0, 0 /)
|
||||||
|
! cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
!
|
||||||
|
! ! ----------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! j1b_gauss_coul_debug = j1b_gauss_coul_debug + coef4 * cx
|
||||||
|
! enddo ! s
|
||||||
|
! enddo ! r
|
||||||
|
! enddo ! q
|
||||||
|
! enddo ! p
|
||||||
|
!
|
||||||
|
! ! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! ! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
|
||||||
|
|
||||||
|
fact_p = fact_p_tmp * factii
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
! pol centerd on P_center_tmp ==> centerd on P_center
|
||||||
|
call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
ff = P_center(1) - Centerii(1)
|
||||||
|
gg = Q_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul_debug = j1b_gauss_coul_debug - coef4 * cx
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! !
|
||||||
|
! ! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
! !
|
||||||
|
! ! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! do p = 1, ao_prim_num(i)
|
||||||
|
! coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
! expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
!
|
||||||
|
! do q = 1, ao_prim_num(j)
|
||||||
|
! coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
! expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
!
|
||||||
|
! call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
|
||||||
|
! , I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
! p_inv = 1.d0 / pp
|
||||||
|
!
|
||||||
|
! do r = 1, ao_prim_num(k)
|
||||||
|
! coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
! expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
!
|
||||||
|
! do s = 1, ao_prim_num(l)
|
||||||
|
! coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
! expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
!
|
||||||
|
! call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
|
||||||
|
! , K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
!
|
||||||
|
! cx = 0.d0
|
||||||
|
! do ii = 1, nucl_num
|
||||||
|
! expoii = j1b_gauss_pen(ii)
|
||||||
|
! Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
!
|
||||||
|
! call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
|
||||||
|
!
|
||||||
|
! fact_q = fact_q_tmp * factii
|
||||||
|
! q_inv = 1.d0 / qq
|
||||||
|
!
|
||||||
|
! ! pol centerd on Q_center_tmp ==> centerd on Q_center
|
||||||
|
! call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
|
||||||
|
!
|
||||||
|
! ! ----------------------------------------------------------------------------------------------------
|
||||||
|
! ! x term:
|
||||||
|
!
|
||||||
|
! ff = P_center(1) - Centerii(1)
|
||||||
|
! gg = Q_center(1) - Centerii(1)
|
||||||
|
!
|
||||||
|
! shift_P = (/ 1, 0, 0 /)
|
||||||
|
! shift_Q = (/ 1, 0, 0 /)
|
||||||
|
! cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
!
|
||||||
|
! shift_P = (/ 1, 0, 0 /)
|
||||||
|
! shift_Q = (/ 0, 0, 0 /)
|
||||||
|
! cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
!
|
||||||
|
! shift_P = (/ 0, 0, 0 /)
|
||||||
|
! shift_Q = (/ 1, 0, 0 /)
|
||||||
|
! cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
!
|
||||||
|
! shift_P = (/ 0, 0, 0 /)
|
||||||
|
! shift_Q = (/ 0, 0, 0 /)
|
||||||
|
! cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
!
|
||||||
|
! ! ----------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! j1b_gauss_coul_debug = j1b_gauss_coul_debug - coef4 * cx
|
||||||
|
!
|
||||||
|
! enddo ! s
|
||||||
|
! enddo ! r
|
||||||
|
! enddo ! q
|
||||||
|
! enddo ! p
|
||||||
|
!
|
||||||
|
! ! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! ! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
return
|
||||||
|
end function j1b_gauss_coul_debug
|
||||||
|
|
324
src/ao_tc_eff_map/two_e_1bgauss_coul_modifdebug.irp.f
Normal file
324
src/ao_tc_eff_map/two_e_1bgauss_coul_modifdebug.irp.f
Normal file
@ -0,0 +1,324 @@
|
|||||||
|
double precision function j1b_gauss_coul_modifdebug(i, j, k, l)
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s, ii
|
||||||
|
integer :: num_i, num_j, num_k, num_l, num_ii
|
||||||
|
integer :: I_power(3), J_power(3), K_power(3), L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
integer :: shift_P(3), shift_Q(3)
|
||||||
|
integer :: dim1
|
||||||
|
|
||||||
|
double precision :: coef1, coef2, coef3, coef4
|
||||||
|
double precision :: expo1, expo2, expo3, expo4
|
||||||
|
double precision :: p_inv, q_inv
|
||||||
|
double precision :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp
|
||||||
|
double precision :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp
|
||||||
|
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
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: expoii, factii, Centerii(3)
|
||||||
|
double precision :: ff, gg, cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: general_primitive_integral_coul
|
||||||
|
double precision :: general_primitive_integral_coul_shifted
|
||||||
|
double precision :: ao_two_e_integral
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul_modifdebug = 0.d0
|
||||||
|
|
||||||
|
! do ii = 1, nucl_num
|
||||||
|
! expoii = j1b_gauss_pen(ii)
|
||||||
|
! j1b_gauss_coul_modifdebug += expoii * ao_two_e_integral(i, j, k, l)
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! [ 1 / r12 ] \sum_A a_A exp(-aA r1A^2)
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
|
||||||
|
fact_p = fact_p_tmp * factii
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
P_new(:,:) = 0.d0
|
||||||
|
call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul_modifdebug = j1b_gauss_coul_modifdebug + coef4 * cx
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! [ 1 / r12 ] \sum_A a_A exp(-aA r2A^2)
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
|
||||||
|
fact_q = fact_q_tmp * factii
|
||||||
|
Q_inv = 1.d0 / qq
|
||||||
|
call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coul_modifdebug = j1b_gauss_coul_modifdebug + coef4 * cx
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
return
|
||||||
|
end function j1b_gauss_coul_modifdebug
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
double precision function general_primitive_integral_coul(dim, &
|
||||||
|
P_new,P_center,fact_p,p,p_inv,iorder_p, &
|
||||||
|
Q_new,Q_center,fact_q,q,q_inv,iorder_q)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the integral <pq|rs> where p,q,r,s are Gaussian primitives
|
||||||
|
END_DOC
|
||||||
|
integer,intent(in) :: dim
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
double precision, intent(in) :: P_new(0:max_dim,3),P_center(3),fact_p,p,p_inv
|
||||||
|
double precision, intent(in) :: Q_new(0:max_dim,3),Q_center(3),fact_q,q,q_inv
|
||||||
|
integer, intent(in) :: iorder_p(3)
|
||||||
|
integer, intent(in) :: iorder_q(3)
|
||||||
|
|
||||||
|
double precision :: r_cut,gama_r_cut,rho,dist
|
||||||
|
double precision :: dx(0:max_dim),Ix_pol(0:max_dim),dy(0:max_dim),Iy_pol(0:max_dim),dz(0:max_dim),Iz_pol(0:max_dim)
|
||||||
|
integer :: n_Ix,n_Iy,n_Iz,nx,ny,nz
|
||||||
|
double precision :: bla
|
||||||
|
integer :: ix,iy,iz,jx,jy,jz,i
|
||||||
|
double precision :: a,b,c,d,e,f,accu,pq,const
|
||||||
|
double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2,pq_inv_2
|
||||||
|
integer :: n_pt_tmp,n_pt_out, iorder
|
||||||
|
double precision :: d1(0:max_dim),d_poly(0:max_dim),rint,d1_screened(0:max_dim)
|
||||||
|
|
||||||
|
general_primitive_integral_coul = 0.d0
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx,Ix_pol,dy,Iy_pol,dz,Iz_pol
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
|
||||||
|
|
||||||
|
! Gaussian Product
|
||||||
|
! ----------------
|
||||||
|
|
||||||
|
pq = p_inv*0.5d0*q_inv
|
||||||
|
pq_inv = 0.5d0/(p+q)
|
||||||
|
p10_1 = q*pq ! 1/(2p)
|
||||||
|
p01_1 = p*pq ! 1/(2q)
|
||||||
|
pq_inv_2 = pq_inv+pq_inv
|
||||||
|
p10_2 = pq_inv_2 * p10_1*q !0.5d0*q/(pq + p*p)
|
||||||
|
p01_2 = pq_inv_2 * p01_1*p !0.5d0*p/(q*q + pq)
|
||||||
|
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
iorder = iorder_p(1)+iorder_q(1)+iorder_p(1)+iorder_q(1)
|
||||||
|
do ix=0,iorder
|
||||||
|
Ix_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Ix = 0
|
||||||
|
do ix = 0, iorder_p(1)
|
||||||
|
if (abs(P_new(ix,1)) < thresh) cycle
|
||||||
|
a = P_new(ix,1)
|
||||||
|
do jx = 0, iorder_q(1)
|
||||||
|
d = a*Q_new(jx,1)
|
||||||
|
if (abs(d) < thresh) cycle
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x(P_center(1),Q_center(1),ix,jx,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dx,nx)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dx,nx,d,Ix_pol,n_Ix)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
if (n_Ix == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
iorder = iorder_p(2)+iorder_q(2)+iorder_p(2)+iorder_q(2)
|
||||||
|
do ix=0, iorder
|
||||||
|
Iy_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Iy = 0
|
||||||
|
do iy = 0, iorder_p(2)
|
||||||
|
if (abs(P_new(iy,2)) > thresh) then
|
||||||
|
b = P_new(iy,2)
|
||||||
|
do jy = 0, iorder_q(2)
|
||||||
|
e = b*Q_new(jy,2)
|
||||||
|
if (abs(e) < thresh) cycle
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x(P_center(2),Q_center(2),iy,jy,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dy,ny)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dy,ny,e,Iy_pol,n_Iy)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (n_Iy == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
iorder = iorder_p(3)+iorder_q(3)+iorder_p(3)+iorder_q(3)
|
||||||
|
do ix=0,iorder
|
||||||
|
Iz_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Iz = 0
|
||||||
|
do iz = 0, iorder_p(3)
|
||||||
|
if (abs(P_new(iz,3)) > thresh) then
|
||||||
|
c = P_new(iz,3)
|
||||||
|
do jz = 0, iorder_q(3)
|
||||||
|
f = c*Q_new(jz,3)
|
||||||
|
if (abs(f) < thresh) cycle
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x(P_center(3),Q_center(3),iz,jz,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dz,nz)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dz,nz,f,Iz_pol,n_Iz)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (n_Iz == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
rho = p*q *pq_inv_2
|
||||||
|
dist = (P_center(1) - Q_center(1))*(P_center(1) - Q_center(1)) + &
|
||||||
|
(P_center(2) - Q_center(2))*(P_center(2) - Q_center(2)) + &
|
||||||
|
(P_center(3) - Q_center(3))*(P_center(3) - Q_center(3))
|
||||||
|
const = dist*rho
|
||||||
|
|
||||||
|
n_pt_tmp = n_Ix+n_Iy
|
||||||
|
do i=0,n_pt_tmp
|
||||||
|
d_poly(i)=0.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
|
||||||
|
if (n_pt_tmp == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
n_pt_out = n_pt_tmp+n_Iz
|
||||||
|
do i=0,n_pt_out
|
||||||
|
d1(i)=0.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
|
||||||
|
double precision :: rint_sum
|
||||||
|
accu = accu + rint_sum(n_pt_out,const,d1)
|
||||||
|
|
||||||
|
general_primitive_integral_coul = fact_p * fact_q * accu *pi_5_2*p_inv*q_inv/dsqrt(p+q)
|
||||||
|
end function general_primitive_integral_coul
|
102
src/ao_tc_eff_map/two_e_1bgauss_coulerf.irp.f
Normal file
102
src/ao_tc_eff_map/two_e_1bgauss_coulerf.irp.f
Normal file
@ -0,0 +1,102 @@
|
|||||||
|
double precision function j1b_gauss_coulerf(i, j, k, l)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! integral in the AO basis:
|
||||||
|
! i(r1) j(r1) f(r12) k(r2) l(r2)
|
||||||
|
!
|
||||||
|
! with:
|
||||||
|
! f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
|
||||||
|
! = [ (1 - erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! + (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s
|
||||||
|
integer :: num_i, num_j, num_k, num_l, num_ii
|
||||||
|
integer :: I_power(3), J_power(3), K_power(3), L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
integer :: shift_P(3), shift_Q(3)
|
||||||
|
integer :: dim1
|
||||||
|
|
||||||
|
double precision :: coef1, coef2, coef3, coef4
|
||||||
|
double precision :: expo1, expo2, expo3, expo4
|
||||||
|
double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
|
||||||
|
double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: ff, gg, cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: j1b_gauss_coulerf_schwartz
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
|
||||||
|
if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
|
||||||
|
j1b_gauss_coulerf = j1b_gauss_coulerf_schwartz(i, j, k, l)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_coulerf = 0.d0
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p1_inv = 1.d0 / pp1
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q1_inv = 1.d0 / qq1
|
||||||
|
|
||||||
|
call get_cxcycz( dim1, cx, cy, cz &
|
||||||
|
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
|
||||||
|
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
|
||||||
|
|
||||||
|
j1b_gauss_coulerf = j1b_gauss_coulerf + coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
return
|
||||||
|
end function j1b_gauss_coulerf
|
||||||
|
|
624
src/ao_tc_eff_map/two_e_1bgauss_coulerf_schwartz.irp.f
Normal file
624
src/ao_tc_eff_map/two_e_1bgauss_coulerf_schwartz.irp.f
Normal file
@ -0,0 +1,624 @@
|
|||||||
|
double precision function j1b_gauss_coulerf_schwartz(i, j, k, l)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! integral in the AO basis:
|
||||||
|
! i(r1) j(r1) f(r12) k(r2) l(r2)
|
||||||
|
!
|
||||||
|
! with:
|
||||||
|
! f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
|
||||||
|
! = [ (1 - erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! + (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s
|
||||||
|
integer :: num_i, num_j, num_k, num_l, num_ii
|
||||||
|
integer :: I_power(3), J_power(3), K_power(3), L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
integer :: dim1
|
||||||
|
|
||||||
|
double precision :: coef1, coef2, coef3, coef4
|
||||||
|
double precision :: expo1, expo2, expo3, expo4
|
||||||
|
double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
|
||||||
|
double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: cx, cy, cz
|
||||||
|
double precision :: schwartz_ij, thr
|
||||||
|
double precision, allocatable :: schwartz_kl(:,:)
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
thr = ao_integrals_threshold * ao_integrals_threshold
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
allocate( schwartz_kl(0:ao_prim_num(l) , 0:ao_prim_num(k)) )
|
||||||
|
|
||||||
|
schwartz_kl(0,0) = 0.d0
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r,k)
|
||||||
|
coef3 = ao_coef_normalized_ordered_transp(r,k) * ao_coef_normalized_ordered_transp(r,k)
|
||||||
|
|
||||||
|
schwartz_kl(0,r) = 0.d0
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s,l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s,l) * ao_coef_normalized_ordered_transp(s,l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q1_inv = 1.d0 / qq1
|
||||||
|
|
||||||
|
call get_cxcycz( dim1, cx, cy, cz &
|
||||||
|
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q &
|
||||||
|
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
|
||||||
|
|
||||||
|
schwartz_kl(s,r) = coef4 * dabs( cx + cy + cz )
|
||||||
|
schwartz_kl(0,r) = max( schwartz_kl(0,r) , schwartz_kl(s,r) )
|
||||||
|
enddo
|
||||||
|
|
||||||
|
schwartz_kl(0,0) = max( schwartz_kl(0,r) , schwartz_kl(0,0) )
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
j1b_gauss_coulerf_schwartz = 0.d0
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p1_inv = 1.d0 / pp1
|
||||||
|
|
||||||
|
call get_cxcycz( dim1, cx, cy, cz &
|
||||||
|
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
|
||||||
|
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p )
|
||||||
|
|
||||||
|
schwartz_ij = coef2 * coef2 * dabs( cx + cy + cz )
|
||||||
|
if( schwartz_kl(0,0) * schwartz_ij < thr ) cycle
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
if( schwartz_kl(0,r) * schwartz_ij < thr ) cycle
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
if( schwartz_kl(s,r) * schwartz_ij < thr ) cycle
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q1_inv = 1.d0 / qq1
|
||||||
|
|
||||||
|
call get_cxcycz( dim1, cx, cy, cz &
|
||||||
|
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
|
||||||
|
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
|
||||||
|
|
||||||
|
j1b_gauss_coulerf_schwartz = j1b_gauss_coulerf_schwartz + coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
deallocate( schwartz_kl )
|
||||||
|
|
||||||
|
return
|
||||||
|
end function j1b_gauss_coulerf_schwartz
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_cxcycz( dim1, cx, cy, cz &
|
||||||
|
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
|
||||||
|
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: dim1
|
||||||
|
integer, intent(in) :: iorder_p(3), iorder_q(3)
|
||||||
|
double precision, intent(in) :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
|
||||||
|
double precision, intent(in) :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
|
||||||
|
double precision, intent(out) :: cx, cy, cz
|
||||||
|
|
||||||
|
integer :: ii
|
||||||
|
integer :: shift_P(3), shift_Q(3)
|
||||||
|
double precision :: expoii, factii, Centerii(3)
|
||||||
|
double precision :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2, p2_inv
|
||||||
|
double precision :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2, q2_inv
|
||||||
|
double precision :: ff, gg
|
||||||
|
|
||||||
|
double precision :: general_primitive_integral_erf_shifted
|
||||||
|
double precision :: general_primitive_integral_coul_shifted
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)
|
||||||
|
fact_p2 = fact_p1 * factii
|
||||||
|
p2_inv = 1.d0 / pp2
|
||||||
|
call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new )
|
||||||
|
|
||||||
|
call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center)
|
||||||
|
fact_q2 = fact_q1 * factii
|
||||||
|
q2_inv = 1.d0 / qq2
|
||||||
|
call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new )
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_P = (/ 0, 2, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 2 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = Q2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_Q = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = Q2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 2, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = Q2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 2 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! - [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P2_center(1) - Centerii(1)
|
||||||
|
gg = Q1_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P2_center(2) - Centerii(2)
|
||||||
|
gg = Q1_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P2_center(3) - Centerii(3)
|
||||||
|
gg = Q1_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! - [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P1_center(1) - Centerii(1)
|
||||||
|
gg = Q2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P1_center(2) - Centerii(2)
|
||||||
|
gg = Q2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P1_center(3) - Centerii(3)
|
||||||
|
gg = Q2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine get_cxcycz
|
||||||
|
|
854
src/ao_tc_eff_map/two_e_1bgauss_erf.irp.f
Normal file
854
src/ao_tc_eff_map/two_e_1bgauss_erf.irp.f
Normal file
@ -0,0 +1,854 @@
|
|||||||
|
double precision function j1b_gauss_erf(i, j, k, l)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! integral in the AO basis:
|
||||||
|
! i(r1) j(r1) f(r12) k(r2) l(r2)
|
||||||
|
!
|
||||||
|
! with:
|
||||||
|
! f(r12) = - [ -0.5 erf(mu r12) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
|
||||||
|
! = - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! + (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s, ii
|
||||||
|
integer :: num_i, num_j, num_k, num_l, num_ii
|
||||||
|
integer :: I_power(3), J_power(3), K_power(3), L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
integer :: shift_P(3), shift_Q(3)
|
||||||
|
integer :: dim1
|
||||||
|
|
||||||
|
double precision :: coef1, coef2, coef3, coef4
|
||||||
|
double precision :: expo1, expo2, expo3, expo4
|
||||||
|
double precision :: p_inv, q_inv
|
||||||
|
double precision :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp
|
||||||
|
double precision :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp
|
||||||
|
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
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: expoii, factii, Centerii(3)
|
||||||
|
double precision :: ff, gg, cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: general_primitive_integral_erf_shifted
|
||||||
|
|
||||||
|
PROVIDE mu_erf
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_erf = 0.d0
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_Q(1) = 0
|
||||||
|
shift_Q(2) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
|
||||||
|
|
||||||
|
fact_p = fact_p_tmp * factii
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
! pol centerd on P_center_tmp ==> centerd on P_center
|
||||||
|
call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_P(3) = 0
|
||||||
|
|
||||||
|
ff = P_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P(1) = 2
|
||||||
|
cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(1) = 1
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! y term:
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_P(3) = 0
|
||||||
|
|
||||||
|
ff = P_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_P(2) = 2
|
||||||
|
cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(2) = 1
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(2) = 0
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! z term:
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_P(2) = 0
|
||||||
|
|
||||||
|
ff = P_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_P(3) = 2
|
||||||
|
cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(3) = 1
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(3) = 0
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_erf = j1b_gauss_erf - coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! - [ erf(mu r12) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_P(3) = 0
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
|
||||||
|
|
||||||
|
fact_q = fact_q_tmp * factii
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
! pol centerd on Q_center_tmp ==> centerd on Q_center
|
||||||
|
call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
shift_Q(2) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
|
||||||
|
ff = Q_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_Q(1) = 2
|
||||||
|
cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q(1) = 1
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q(1) = 0
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! y term:
|
||||||
|
|
||||||
|
shift_Q(1) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
|
||||||
|
ff = Q_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_Q(2) = 2
|
||||||
|
cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q(2) = 1
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q(2) = 0
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! z term:
|
||||||
|
|
||||||
|
shift_Q(1) = 0
|
||||||
|
shift_Q(2) = 0
|
||||||
|
|
||||||
|
ff = Q_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_Q(3) = 2
|
||||||
|
cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q(3) = 1
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q(3) = 0
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_erf = j1b_gauss_erf - coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
|
||||||
|
|
||||||
|
fact_p = fact_p_tmp * factii
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
! pol centerd on P_center_tmp ==> centerd on P_center
|
||||||
|
call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_P(3) = 0
|
||||||
|
shift_Q(2) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
|
||||||
|
ff = P_center(1) - Centerii(1)
|
||||||
|
gg = Q_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P(1) = 1
|
||||||
|
shift_Q(1) = 1
|
||||||
|
cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(1) = 1
|
||||||
|
shift_Q(1) = 0
|
||||||
|
cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_Q(1) = 1
|
||||||
|
cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_Q(1) = 0
|
||||||
|
cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! y term:
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_P(3) = 0
|
||||||
|
shift_Q(1) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
|
||||||
|
ff = P_center(2) - Centerii(2)
|
||||||
|
gg = Q_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_P(2) = 1
|
||||||
|
shift_Q(2) = 1
|
||||||
|
cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(2) = 1
|
||||||
|
shift_Q(2) = 0
|
||||||
|
cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_Q(2) = 1
|
||||||
|
cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_Q(2) = 0
|
||||||
|
cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! z term:
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_Q(1) = 0
|
||||||
|
shift_Q(2) = 0
|
||||||
|
|
||||||
|
ff = P_center(3) - Centerii(3)
|
||||||
|
gg = Q_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_P(3) = 1
|
||||||
|
shift_Q(3) = 1
|
||||||
|
cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(3) = 1
|
||||||
|
shift_Q(3) = 0
|
||||||
|
cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(3) = 0
|
||||||
|
shift_Q(3) = 1
|
||||||
|
cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(3) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_erf = j1b_gauss_erf + coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
! [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p_inv = 1.d0 / pp
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
|
||||||
|
|
||||||
|
fact_q = fact_q_tmp * factii
|
||||||
|
q_inv = 1.d0 / qq
|
||||||
|
|
||||||
|
! pol centerd on Q_center_tmp ==> centerd on Q_center
|
||||||
|
call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! x term:
|
||||||
|
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_P(3) = 0
|
||||||
|
shift_Q(2) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
|
||||||
|
ff = P_center(1) - Centerii(1)
|
||||||
|
gg = Q_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P(1) = 1
|
||||||
|
shift_Q(1) = 1
|
||||||
|
cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(1) = 1
|
||||||
|
shift_Q(1) = 0
|
||||||
|
cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_Q(1) = 1
|
||||||
|
cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_Q(1) = 0
|
||||||
|
cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! y term:
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_P(3) = 0
|
||||||
|
shift_Q(1) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
|
||||||
|
ff = P_center(2) - Centerii(2)
|
||||||
|
gg = Q_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_P(2) = 1
|
||||||
|
shift_Q(2) = 1
|
||||||
|
cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(2) = 1
|
||||||
|
shift_Q(2) = 0
|
||||||
|
cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_Q(2) = 1
|
||||||
|
cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_Q(2) = 0
|
||||||
|
cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! z term:
|
||||||
|
|
||||||
|
shift_P(1) = 0
|
||||||
|
shift_P(2) = 0
|
||||||
|
shift_Q(1) = 0
|
||||||
|
shift_Q(2) = 0
|
||||||
|
|
||||||
|
ff = P_center(3) - Centerii(3)
|
||||||
|
gg = Q_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_P(3) = 1
|
||||||
|
shift_Q(3) = 1
|
||||||
|
cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(3) = 1
|
||||||
|
shift_Q(3) = 0
|
||||||
|
cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(3) = 0
|
||||||
|
shift_Q(3) = 1
|
||||||
|
cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P(3) = 0
|
||||||
|
shift_Q(3) = 0
|
||||||
|
cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_erf = j1b_gauss_erf + coef4 * ( cx + cy + cz )
|
||||||
|
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
! -------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
return
|
||||||
|
end function j1b_gauss_erf
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
!______________________________________________________________________________________________________________________
|
||||||
|
!______________________________________________________________________________________________________________________
|
||||||
|
|
||||||
|
double precision function general_primitive_integral_erf_shifted( dim &
|
||||||
|
, P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P &
|
||||||
|
, Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: dim
|
||||||
|
integer, intent(in) :: iorder_p(3), shift_P(3)
|
||||||
|
integer, intent(in) :: iorder_q(3), shift_Q(3)
|
||||||
|
double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv
|
||||||
|
double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv
|
||||||
|
|
||||||
|
integer :: n_Ix, n_Iy, n_Iz, nx, ny, nz
|
||||||
|
integer :: ix, iy, iz, jx, jy, jz, i
|
||||||
|
integer :: n_pt_tmp, n_pt_out, iorder
|
||||||
|
integer :: ii, jj
|
||||||
|
double precision :: rho, dist
|
||||||
|
double precision :: dx(0:max_dim), Ix_pol(0:max_dim)
|
||||||
|
double precision :: dy(0:max_dim), Iy_pol(0:max_dim)
|
||||||
|
double precision :: dz(0:max_dim), Iz_pol(0:max_dim)
|
||||||
|
double precision :: a, b, c, d, e, f, accu, pq, const
|
||||||
|
double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2
|
||||||
|
double precision :: d1(0:max_dim), d_poly(0:max_dim)
|
||||||
|
double precision :: p_plus_q
|
||||||
|
|
||||||
|
double precision :: rint_sum
|
||||||
|
|
||||||
|
general_primitive_integral_erf_shifted = 0.d0
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
|
||||||
|
|
||||||
|
! Gaussian Product
|
||||||
|
! ----------------
|
||||||
|
p_plus_q = (p+q) * ( (p*q)/(p+q) + mu_erf*mu_erf ) / (mu_erf*mu_erf)
|
||||||
|
pq = p_inv * 0.5d0 * q_inv
|
||||||
|
pq_inv = 0.5d0 / p_plus_q
|
||||||
|
p10_1 = q * pq ! 1/(2p)
|
||||||
|
p01_1 = p * pq ! 1/(2q)
|
||||||
|
pq_inv_2 = pq_inv + pq_inv
|
||||||
|
p10_2 = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p)
|
||||||
|
p01_2 = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq)
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
|
||||||
|
iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1)
|
||||||
|
iorder = iorder + shift_P(1) + shift_Q(1)
|
||||||
|
iorder = iorder + shift_P(1) + shift_Q(1)
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do ix = 0, iorder
|
||||||
|
Ix_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Ix = 0
|
||||||
|
do ix = 0, iorder_p(1)
|
||||||
|
|
||||||
|
ii = ix + shift_P(1)
|
||||||
|
a = P_new(ix,1)
|
||||||
|
if(abs(a) < thresh) cycle
|
||||||
|
|
||||||
|
do jx = 0, iorder_q(1)
|
||||||
|
|
||||||
|
jj = jx + shift_Q(1)
|
||||||
|
d = a * Q_new(jx,1)
|
||||||
|
if(abs(d) < thresh) cycle
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj &
|
||||||
|
, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx )
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
if(n_Ix == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2)
|
||||||
|
iorder = iorder + shift_P(2) + shift_Q(2)
|
||||||
|
iorder = iorder + shift_P(2) + shift_Q(2)
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do ix = 0, iorder
|
||||||
|
Iy_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Iy = 0
|
||||||
|
do iy = 0, iorder_p(2)
|
||||||
|
|
||||||
|
if(abs(P_new(iy,2)) > thresh) then
|
||||||
|
|
||||||
|
ii = iy + shift_P(2)
|
||||||
|
b = P_new(iy,2)
|
||||||
|
|
||||||
|
do jy = 0, iorder_q(2)
|
||||||
|
|
||||||
|
jj = jy + shift_Q(2)
|
||||||
|
e = b * Q_new(jy,2)
|
||||||
|
if(abs(e) < thresh) cycle
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj &
|
||||||
|
, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny )
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if(n_Iy == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3)
|
||||||
|
iorder = iorder + shift_P(3) + shift_Q(3)
|
||||||
|
iorder = iorder + shift_P(3) + shift_Q(3)
|
||||||
|
do ix = 0, iorder
|
||||||
|
Iz_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Iz = 0
|
||||||
|
do iz = 0, iorder_p(3)
|
||||||
|
|
||||||
|
if( abs(P_new(iz,3)) > thresh ) then
|
||||||
|
|
||||||
|
ii = iz + shift_P(3)
|
||||||
|
c = P_new(iz,3)
|
||||||
|
|
||||||
|
do jz = 0, iorder_q(3)
|
||||||
|
|
||||||
|
jj = jz + shift_Q(3)
|
||||||
|
f = c * Q_new(jz,3)
|
||||||
|
if(abs(f) < thresh) cycle
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj &
|
||||||
|
, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz )
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if(n_Iz == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
rho = p * q * pq_inv_2
|
||||||
|
dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
|
||||||
|
+ (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
|
||||||
|
+ (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
|
||||||
|
const = dist*rho
|
||||||
|
|
||||||
|
n_pt_tmp = n_Ix + n_Iy
|
||||||
|
do i = 0, n_pt_tmp
|
||||||
|
d_poly(i) = 0.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp)
|
||||||
|
if(n_pt_tmp == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
n_pt_out = n_pt_tmp + n_Iz
|
||||||
|
do i = 0, n_pt_out
|
||||||
|
d1(i) = 0.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!DEC$ FORCEINLINE
|
||||||
|
call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out)
|
||||||
|
accu = accu + rint_sum(n_pt_out, const, d1)
|
||||||
|
|
||||||
|
general_primitive_integral_erf_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q)
|
||||||
|
|
||||||
|
return
|
||||||
|
end function general_primitive_integral_erf_shifted
|
||||||
|
!______________________________________________________________________________________________________________________
|
||||||
|
!______________________________________________________________________________________________________________________
|
433
src/ao_tc_eff_map/two_e_1bgauss_erf_acc.irp.f
Normal file
433
src/ao_tc_eff_map/two_e_1bgauss_erf_acc.irp.f
Normal file
@ -0,0 +1,433 @@
|
|||||||
|
double precision function j1b_gauss_erf_acc(i, j, k, l)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! integral in the AO basis:
|
||||||
|
! i(r1) j(r1) f(r12) k(r2) l(r2)
|
||||||
|
!
|
||||||
|
! with:
|
||||||
|
! f(r12) = - [ -0.5 erf(mu r12) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
|
||||||
|
! = - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! + (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
|
||||||
|
! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s, ii
|
||||||
|
integer :: num_i, num_j, num_k, num_l, num_ii
|
||||||
|
integer :: I_power(3), J_power(3), K_power(3), L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
integer :: shift_P(3), shift_Q(3)
|
||||||
|
integer :: dim1
|
||||||
|
|
||||||
|
double precision :: coef1, coef2, coef3, coef4
|
||||||
|
double precision :: expo1, expo2, expo3, expo4
|
||||||
|
double precision :: p1_inv, q1_inv, p2_inv, q2_inv
|
||||||
|
double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1
|
||||||
|
double precision :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2
|
||||||
|
double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1
|
||||||
|
double precision :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: expoii, factii, Centerii(3)
|
||||||
|
double precision :: ff, gg, cx, cy, cz
|
||||||
|
|
||||||
|
double precision :: general_primitive_integral_erf_shifted
|
||||||
|
!double precision :: j1b_gauss_erf_schwartz_accel
|
||||||
|
|
||||||
|
PROVIDE j1b_gauss_pen
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
|
||||||
|
! TODO
|
||||||
|
!if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
|
||||||
|
! j1b_gauss_erf_schwartz_accel = j1b_gauss_erf_schwartz_accel(i, j, k, l)
|
||||||
|
! return
|
||||||
|
!endif
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_erf_acc = 0.d0
|
||||||
|
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p, i)
|
||||||
|
expo1 = ao_expo_ordered_transp(p, i)
|
||||||
|
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
|
||||||
|
expo2 = ao_expo_ordered_transp(q, j)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
|
||||||
|
, I_power, J_power, I_center, J_center, dim1 )
|
||||||
|
p1_inv = 1.d0 / pp1
|
||||||
|
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
|
||||||
|
expo3 = ao_expo_ordered_transp(r, k)
|
||||||
|
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
|
||||||
|
expo4 = ao_expo_ordered_transp(s, l)
|
||||||
|
|
||||||
|
call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
|
||||||
|
, K_power, L_power, K_center, L_center, dim1 )
|
||||||
|
q1_inv = 1.d0 / qq1
|
||||||
|
|
||||||
|
cx = 0.d0
|
||||||
|
cy = 0.d0
|
||||||
|
cz = 0.d0
|
||||||
|
do ii = 1, nucl_num
|
||||||
|
expoii = j1b_gauss_pen(ii)
|
||||||
|
Centerii(1:3) = nucl_coord(ii, 1:3)
|
||||||
|
|
||||||
|
call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)
|
||||||
|
fact_p2 = fact_p1 * factii
|
||||||
|
p2_inv = 1.d0 / pp2
|
||||||
|
call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new)
|
||||||
|
|
||||||
|
call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center)
|
||||||
|
fact_q2 = fact_q1 * factii
|
||||||
|
q2_inv = 1.d0 / qq2
|
||||||
|
call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new)
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_P = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_P = (/ 0, 2, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 2 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! [ erf(mu r12) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
shift_P = (/ 0, 0, 0 /)
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = Q2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_Q = (/ 2, 0, 0 /)
|
||||||
|
cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = Q2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 2, 0 /)
|
||||||
|
cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = Q2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 2 /)
|
||||||
|
cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P2_center(1) - Centerii(1)
|
||||||
|
gg = Q1_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P2_center(2) - Centerii(2)
|
||||||
|
gg = Q1_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P2_center(3) - Centerii(3)
|
||||||
|
gg = Q1_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
|
||||||
|
, Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
! - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
! x term:
|
||||||
|
ff = P1_center(1) - Centerii(1)
|
||||||
|
gg = Q2_center(1) - Centerii(1)
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 1, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 1, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cx = cx - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! y term:
|
||||||
|
ff = P1_center(2) - Centerii(2)
|
||||||
|
gg = Q2_center(2) - Centerii(2)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 1, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 1, 0 /)
|
||||||
|
cy = cy - expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cy = cy - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! z term:
|
||||||
|
ff = P1_center(3) - Centerii(3)
|
||||||
|
gg = Q2_center(3) - Centerii(3)
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 1 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 1 /)
|
||||||
|
cz = cz - expoii * ff * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
shift_p = (/ 0, 0, 0 /)
|
||||||
|
shift_Q = (/ 0, 0, 0 /)
|
||||||
|
cz = cz - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
|
||||||
|
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
|
||||||
|
, Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
|
||||||
|
|
||||||
|
! ----------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
j1b_gauss_erf_acc = j1b_gauss_erf_acc - coef4 * ( cx + cy + cz )
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
return
|
||||||
|
end function j1b_gauss_erf_acc
|
326
src/ao_tc_eff_map/two_e_ints_gauss.irp.f
Normal file
326
src/ao_tc_eff_map/two_e_ints_gauss.irp.f
Normal file
@ -0,0 +1,326 @@
|
|||||||
|
double precision function ao_tc_sym_two_e_pot(i,j,k,l)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! integral of the AO basis <ik|jl> or (ij|kl)
|
||||||
|
! i(r1) j(r1) (tc_pot(r12,mu)) k(r2) l(r2)
|
||||||
|
!
|
||||||
|
! where (tc_pot(r12,mu)) is the scalar part of the potential EXCLUDING the term erf(mu r12)/r12.
|
||||||
|
!
|
||||||
|
! See Eq. (32) of JCP 154, 084119 (2021).
|
||||||
|
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
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
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, allocatable :: schwartz_kl(:,:)
|
||||||
|
double precision :: schwartz_ij
|
||||||
|
double precision :: scw_gauss_int,general_primitive_integral_gauss
|
||||||
|
|
||||||
|
dim1 = n_pt_max_integrals
|
||||||
|
|
||||||
|
num_i = ao_nucl(i)
|
||||||
|
num_j = ao_nucl(j)
|
||||||
|
num_k = ao_nucl(k)
|
||||||
|
num_l = ao_nucl(l)
|
||||||
|
ao_tc_sym_two_e_pot = 0.d0
|
||||||
|
double precision :: thr
|
||||||
|
thr = ao_integrals_threshold*ao_integrals_threshold
|
||||||
|
|
||||||
|
allocate(schwartz_kl(0:ao_prim_num(l),0:ao_prim_num(k)))
|
||||||
|
|
||||||
|
double precision :: coef3
|
||||||
|
double precision :: coef2
|
||||||
|
double precision :: p_inv,q_inv
|
||||||
|
double precision :: coef1
|
||||||
|
double precision :: coef4
|
||||||
|
|
||||||
|
do p = 1, 3
|
||||||
|
I_power(p) = ao_power(i,p)
|
||||||
|
J_power(p) = ao_power(j,p)
|
||||||
|
K_power(p) = ao_power(k,p)
|
||||||
|
L_power(p) = ao_power(l,p)
|
||||||
|
I_center(p) = nucl_coord(num_i,p)
|
||||||
|
J_center(p) = nucl_coord(num_j,p)
|
||||||
|
K_center(p) = nucl_coord(num_k,p)
|
||||||
|
L_center(p) = nucl_coord(num_l,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
schwartz_kl(0,0) = 0.d0
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(r,k)*ao_coef_normalized_ordered_transp(r,k)
|
||||||
|
schwartz_kl(0,r) = 0.d0
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
coef2 = coef1 * ao_coef_normalized_ordered_transp(s,l) * ao_coef_normalized_ordered_transp(s,l)
|
||||||
|
call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q,&
|
||||||
|
ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l), &
|
||||||
|
K_power,L_power,K_center,L_center,dim1)
|
||||||
|
q_inv = 1.d0/qq
|
||||||
|
scw_gauss_int = general_primitive_integral_gauss(dim1, &
|
||||||
|
Q_new,Q_center,fact_q,qq,q_inv,iorder_q, &
|
||||||
|
Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
|
||||||
|
|
||||||
|
schwartz_kl(s,r) = dabs(scw_gauss_int * coef2)
|
||||||
|
schwartz_kl(0,r) = max(schwartz_kl(0,r),schwartz_kl(s,r))
|
||||||
|
enddo
|
||||||
|
schwartz_kl(0,0) = max(schwartz_kl(0,r),schwartz_kl(0,0))
|
||||||
|
enddo
|
||||||
|
do p = 1, ao_prim_num(i)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(p,i)
|
||||||
|
do q = 1, ao_prim_num(j)
|
||||||
|
coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
|
||||||
|
call give_explicit_poly_and_gaussian(P_new,P_center,pp,fact_p,iorder_p,&
|
||||||
|
ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j), &
|
||||||
|
I_power,J_power,I_center,J_center,dim1)
|
||||||
|
p_inv = 1.d0/pp
|
||||||
|
scw_gauss_int = general_primitive_integral_gauss(dim1, &
|
||||||
|
P_new,P_center,fact_p,pp,p_inv,iorder_p, &
|
||||||
|
P_new,P_center,fact_p,pp,p_inv,iorder_p)
|
||||||
|
schwartz_ij = dabs(scw_gauss_int * coef2*coef2)
|
||||||
|
if (schwartz_kl(0,0)*schwartz_ij < thr) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
do r = 1, ao_prim_num(k)
|
||||||
|
if (schwartz_kl(0,r)*schwartz_ij < thr) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
|
||||||
|
do s = 1, ao_prim_num(l)
|
||||||
|
if (schwartz_kl(s,r)*schwartz_ij < thr) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
|
||||||
|
call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q, &
|
||||||
|
ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l), &
|
||||||
|
K_power,L_power,K_center,L_center,dim1)
|
||||||
|
q_inv = 1.d0/qq
|
||||||
|
integral = general_primitive_integral_gauss(dim1, &
|
||||||
|
P_new,P_center,fact_p,pp,p_inv,iorder_p, &
|
||||||
|
Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
|
||||||
|
ao_tc_sym_two_e_pot = ao_tc_sym_two_e_pot + coef4 * integral
|
||||||
|
enddo ! s
|
||||||
|
enddo ! r
|
||||||
|
enddo ! q
|
||||||
|
enddo ! p
|
||||||
|
|
||||||
|
deallocate (schwartz_kl)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
double precision function general_primitive_integral_gauss(dim, &
|
||||||
|
P_new,P_center,fact_p,p,p_inv,iorder_p, &
|
||||||
|
Q_new,Q_center,fact_q,q,q_inv,iorder_q)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the integral <pq|rs> where p,q,r,s are Gaussian primitives
|
||||||
|
END_DOC
|
||||||
|
integer,intent(in) :: dim
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
double precision, intent(in) :: P_new(0:max_dim,3),P_center(3),fact_p,p,p_inv
|
||||||
|
double precision, intent(in) :: Q_new(0:max_dim,3),Q_center(3),fact_q,q,q_inv
|
||||||
|
integer, intent(in) :: iorder_p(3)
|
||||||
|
integer, intent(in) :: iorder_q(3)
|
||||||
|
|
||||||
|
double precision :: r_cut,gama_r_cut,rho,dist
|
||||||
|
double precision :: dx(0:max_dim),Ix_pol(0:max_dim),dy(0:max_dim),Iy_pol(0:max_dim),dz(0:max_dim),Iz_pol(0:max_dim)
|
||||||
|
integer :: n_Ix,n_Iy,n_Iz,nx,ny,nz
|
||||||
|
double precision :: bla
|
||||||
|
integer :: ix,iy,iz,jx,jy,jz,i
|
||||||
|
double precision :: a,b,c,d,e,f,accu,pq,const
|
||||||
|
double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2,pq_inv_2
|
||||||
|
integer :: n_pt_tmp,n_pt_out, iorder
|
||||||
|
double precision :: d1(0:max_dim),d_poly(0:max_dim),rint,d1_screened(0:max_dim)
|
||||||
|
double precision :: thr
|
||||||
|
|
||||||
|
thr = ao_integrals_threshold
|
||||||
|
|
||||||
|
general_primitive_integral_gauss = 0.d0
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx,Ix_pol,dy,Iy_pol,dz,Iz_pol
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
|
||||||
|
|
||||||
|
! Gaussian Product
|
||||||
|
! ----------------
|
||||||
|
|
||||||
|
pq = p_inv*0.5d0*q_inv
|
||||||
|
pq_inv = 0.5d0/(p+q)
|
||||||
|
p10_1 = q*pq ! 1/(2p)
|
||||||
|
p01_1 = p*pq ! 1/(2q)
|
||||||
|
pq_inv_2 = pq_inv+pq_inv
|
||||||
|
p10_2 = pq_inv_2 * p10_1*q !0.5d0*q/(pq + p*p)
|
||||||
|
p01_2 = pq_inv_2 * p01_1*p !0.5d0*p/(q*q + pq)
|
||||||
|
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
iorder = iorder_p(1)+iorder_q(1)+iorder_p(1)+iorder_q(1)
|
||||||
|
do ix=0,iorder
|
||||||
|
Ix_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Ix = 0
|
||||||
|
do ix = 0, iorder_p(1)
|
||||||
|
if (abs(P_new(ix,1)) < thr) cycle
|
||||||
|
a = P_new(ix,1)
|
||||||
|
do jx = 0, iorder_q(1)
|
||||||
|
d = a*Q_new(jx,1)
|
||||||
|
if (abs(d) < thr) cycle
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x(P_center(1),Q_center(1),ix,jx,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dx,nx)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dx,nx,d,Ix_pol,n_Ix)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
if (n_Ix == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
iorder = iorder_p(2)+iorder_q(2)+iorder_p(2)+iorder_q(2)
|
||||||
|
do ix=0, iorder
|
||||||
|
Iy_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Iy = 0
|
||||||
|
do iy = 0, iorder_p(2)
|
||||||
|
if (abs(P_new(iy,2)) > thr) then
|
||||||
|
b = P_new(iy,2)
|
||||||
|
do jy = 0, iorder_q(2)
|
||||||
|
e = b*Q_new(jy,2)
|
||||||
|
if (abs(e) < thr) cycle
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x(P_center(2),Q_center(2),iy,jy,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dy,ny)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dy,ny,e,Iy_pol,n_Iy)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (n_Iy == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
iorder = iorder_p(3)+iorder_q(3)+iorder_p(3)+iorder_q(3)
|
||||||
|
do ix=0,iorder
|
||||||
|
Iz_pol(ix) = 0.d0
|
||||||
|
enddo
|
||||||
|
n_Iz = 0
|
||||||
|
do iz = 0, iorder_p(3)
|
||||||
|
if (abs(P_new(iz,3)) > thr) then
|
||||||
|
c = P_new(iz,3)
|
||||||
|
do jz = 0, iorder_q(3)
|
||||||
|
f = c*Q_new(jz,3)
|
||||||
|
if (abs(f) < thr) cycle
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call give_polynom_mult_center_x(P_center(3),Q_center(3),iz,jz,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dz,nz)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call add_poly_multiply(dz,nz,f,Iz_pol,n_Iz)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (n_Iz == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
rho = p*q *pq_inv_2
|
||||||
|
dist = (P_center(1) - Q_center(1))*(P_center(1) - Q_center(1)) + &
|
||||||
|
(P_center(2) - Q_center(2))*(P_center(2) - Q_center(2)) + &
|
||||||
|
(P_center(3) - Q_center(3))*(P_center(3) - Q_center(3))
|
||||||
|
const = dist*rho
|
||||||
|
|
||||||
|
n_pt_tmp = n_Ix+n_Iy
|
||||||
|
do i=0,n_pt_tmp
|
||||||
|
d_poly(i)=0.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
|
||||||
|
if (n_pt_tmp == -1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
n_pt_out = n_pt_tmp+n_Iz
|
||||||
|
do i=0,n_pt_out
|
||||||
|
d1(i)=0.d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
|
||||||
|
|
||||||
|
double precision :: aa,c_a,t_a,rho_old,w_a,pi_3,prefactor,inv_pq_3_2
|
||||||
|
double precision :: gauss_int
|
||||||
|
integer :: m
|
||||||
|
gauss_int = 0.d0
|
||||||
|
pi_3 = pi*pi*pi
|
||||||
|
inv_pq_3_2 = (p_inv * q_inv)**(1.5d0)
|
||||||
|
rho_old = (p*q)/(p+q)
|
||||||
|
prefactor = pi_3 * inv_pq_3_2 * fact_p * fact_q
|
||||||
|
do i = 1, n_gauss_eff_pot ! browse the gaussians with different expo/coef
|
||||||
|
aa = expo_gauss_eff_pot(i)
|
||||||
|
c_a = coef_gauss_eff_pot(i)
|
||||||
|
t_a = dsqrt( aa /(rho_old + aa) )
|
||||||
|
w_a = dexp(-t_a*t_a*rho_old*dist)
|
||||||
|
accu = 0.d0
|
||||||
|
! evaluation of the polynom Ix(t_a) * Iy(t_a) * Iz(t_a)
|
||||||
|
do m = 0, n_pt_out,2
|
||||||
|
accu += d1(m) * (t_a)**(dble(m))
|
||||||
|
enddo
|
||||||
|
! equation A8 of PRA-70-062505 (2004) of Toul. Col. Sav.
|
||||||
|
gauss_int = gauss_int + c_a * prefactor * (1.d0 - t_a*t_a)**(1.5d0) * w_a * accu
|
||||||
|
enddo
|
||||||
|
|
||||||
|
general_primitive_integral_gauss = gauss_int
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine compute_ao_integrals_gauss_jl(j,l,n_integrals,buffer_i,buffer_value)
|
||||||
|
implicit none
|
||||||
|
use map_module
|
||||||
|
BEGIN_DOC
|
||||||
|
! Parallel client for AO integrals
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: j,l
|
||||||
|
integer,intent(out) :: n_integrals
|
||||||
|
integer(key_kind),intent(out) :: buffer_i(ao_num*ao_num)
|
||||||
|
real(integral_kind),intent(out) :: buffer_value(ao_num*ao_num)
|
||||||
|
|
||||||
|
integer :: i,k
|
||||||
|
double precision :: cpu_1,cpu_2, wall_1, wall_2
|
||||||
|
double precision :: integral, wall_0
|
||||||
|
double precision :: thr,ao_tc_sym_two_e_pot
|
||||||
|
integer :: kk, m, j1, i1
|
||||||
|
logical, external :: ao_two_e_integral_zero
|
||||||
|
|
||||||
|
thr = ao_integrals_threshold
|
||||||
|
|
||||||
|
n_integrals = 0
|
||||||
|
|
||||||
|
j1 = j+ishft(l*l-l,-1)
|
||||||
|
do k = 1, ao_num ! r1
|
||||||
|
i1 = ishft(k*k-k,-1)
|
||||||
|
if (i1 > j1) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
do i = 1, k
|
||||||
|
i1 += 1
|
||||||
|
if (i1 > j1) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
! if (ao_two_e_integral_zero(i,j,k,l)) then
|
||||||
|
if (.False.) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr ) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
integral = ao_tc_sym_two_e_pot(i,k,j,l) ! i,k : r1 j,l : r2
|
||||||
|
if (abs(integral) < thr) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
n_integrals += 1
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call two_e_integrals_index(i,j,k,l,buffer_i(n_integrals))
|
||||||
|
buffer_value(n_integrals) = integral
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
@ -4,13 +4,6 @@ doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
|
|||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: None
|
default: None
|
||||||
|
|
||||||
[ao_integrals_threshold]
|
|
||||||
type: Threshold
|
|
||||||
doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero
|
|
||||||
interface: ezfio,provider,ocaml
|
|
||||||
default: 1.e-15
|
|
||||||
ezfio_name: threshold_ao
|
|
||||||
|
|
||||||
[do_direct_integrals]
|
[do_direct_integrals]
|
||||||
type: logical
|
type: logical
|
||||||
doc: Compute integrals on the fly (very slow, only for debugging)
|
doc: Compute integrals on the fly (very slow, only for debugging)
|
||||||
|
@ -1,57 +0,0 @@
|
|||||||
BEGIN_PROVIDER [ double precision, gauleg_t2, (n_pt_max_integrals,n_pt_max_integrals/2) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, gauleg_w, (n_pt_max_integrals,n_pt_max_integrals/2) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! t_w(i,1,k) = w(i)
|
|
||||||
! t_w(i,2,k) = t(i)
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,l
|
|
||||||
l=0
|
|
||||||
do i = 2,n_pt_max_integrals,2
|
|
||||||
l = l+1
|
|
||||||
call gauleg(0.d0,1.d0,gauleg_t2(1,l),gauleg_w(1,l),i)
|
|
||||||
do j=1,i
|
|
||||||
gauleg_t2(j,l) *= gauleg_t2(j,l)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
subroutine gauleg(x1,x2,x,w,n)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Gauss-Legendre
|
|
||||||
END_DOC
|
|
||||||
integer, intent(in) :: n
|
|
||||||
double precision, intent(in) :: x1, x2
|
|
||||||
double precision, intent (out) :: x(n),w(n)
|
|
||||||
double precision, parameter :: eps=3.d-14
|
|
||||||
|
|
||||||
integer :: m,i,j
|
|
||||||
double precision :: xm, xl, z, z1, p1, p2, p3, pp, dn
|
|
||||||
m=(n+1)/2
|
|
||||||
xm=0.5d0*(x2+x1)
|
|
||||||
xl=0.5d0*(x2-x1)
|
|
||||||
dn = dble(n)
|
|
||||||
do i=1,m
|
|
||||||
z=dcos(3.141592654d0*(dble(i)-.25d0)/(dble(n)+.5d0))
|
|
||||||
z1 = z+1.d0
|
|
||||||
do while (dabs(z-z1) > eps)
|
|
||||||
p1=1.d0
|
|
||||||
p2=0.d0
|
|
||||||
do j=1,n
|
|
||||||
p3=p2
|
|
||||||
p2=p1
|
|
||||||
p1=(dble(j+j-1)*z*p2-dble(j-1)*p3)/j
|
|
||||||
enddo
|
|
||||||
pp=dn*(z*p1-p2)/(z*z-1.d0)
|
|
||||||
z1=z
|
|
||||||
z=z1-p1/pp
|
|
||||||
end do
|
|
||||||
x(i)=xm-xl*z
|
|
||||||
x(n+1-i)=xm+xl*z
|
|
||||||
w(i)=(xl+xl)/((1.d0-z*z)*pp*pp)
|
|
||||||
w(n+1-i)=w(i)
|
|
||||||
enddo
|
|
||||||
end
|
|
||||||
|
|
@ -326,9 +326,9 @@ double precision function get_ao_two_e_integral(i,j,k,l,map) result(result)
|
|||||||
use map_module
|
use map_module
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Gets one AO bi-electronic integral from the AO map
|
! Gets one AO bi-electronic integral from the AO map in PHYSICIST NOTATION
|
||||||
!
|
!
|
||||||
! i,j,k,l in physicist notation <ij|kl>
|
! <1:k, 2:l |1:i, 2:j>
|
||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: i,j,k,l
|
integer, intent(in) :: i,j,k,l
|
||||||
integer(key_kind) :: idx
|
integer(key_kind) :: idx
|
||||||
|
191
src/ao_two_e_ints/test_cosgtos_1e.irp.f
Normal file
191
src/ao_two_e_ints/test_cosgtos_1e.irp.f
Normal file
@ -0,0 +1,191 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
program test_cosgtos
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
|
||||||
|
call init_expo()
|
||||||
|
|
||||||
|
! call test_coef()
|
||||||
|
call test_1e_kin()
|
||||||
|
call test_1e_coul()
|
||||||
|
|
||||||
|
i = 1
|
||||||
|
j = 1
|
||||||
|
! call test_1e_coul_real(i, j)
|
||||||
|
! call test_1e_coul_cpx (i, j)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine init_expo()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
double precision, allocatable :: expo_im(:,:)
|
||||||
|
|
||||||
|
allocate(expo_im(ao_num, ao_prim_num_max))
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num_max
|
||||||
|
do i = 1, ao_num
|
||||||
|
ao_expoim_cosgtos(i,j) = 0.d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call ezfio_set_cosgtos_ao_int_ao_expoim_cosgtos(expo_im)
|
||||||
|
|
||||||
|
deallocate(expo_im)
|
||||||
|
|
||||||
|
end subroutine init_expo
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_coef()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: coef, coef_gtos, coef_cosgtos
|
||||||
|
double precision :: delta, accu_abs
|
||||||
|
|
||||||
|
print*, ' check coefs'
|
||||||
|
|
||||||
|
accu_abs = 0.d0
|
||||||
|
accu_abs = 0.d0
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
|
||||||
|
coef = ao_coef(i,j)
|
||||||
|
coef_gtos = 1.d0 * ao_coef_normalized_ordered_transp(j,i)
|
||||||
|
coef_cosgtos = 2.d0 * ao_coef_norm_ord_transp_cosgtos (j,i)
|
||||||
|
|
||||||
|
delta = dabs(coef_gtos - coef_cosgtos)
|
||||||
|
accu_abs += delta
|
||||||
|
|
||||||
|
if(delta .gt. 1.d-10) then
|
||||||
|
print*, ' problem on: '
|
||||||
|
print*, i, j
|
||||||
|
print*, coef_gtos, coef_cosgtos, delta
|
||||||
|
print*, coef
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*, 'accu_abs = ', accu_abs
|
||||||
|
|
||||||
|
end subroutine test_coef
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_1e_kin()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: integral_gtos, integral_cosgtos
|
||||||
|
double precision :: delta, accu_abs
|
||||||
|
|
||||||
|
print*, ' check kin 1e integrals'
|
||||||
|
|
||||||
|
accu_abs = 0.d0
|
||||||
|
accu_abs = 0.d0
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
|
||||||
|
integral_gtos = ao_kinetic_integrals (i,j)
|
||||||
|
integral_cosgtos = ao_kinetic_integrals_cosgtos(i,j)
|
||||||
|
|
||||||
|
|
||||||
|
delta = dabs(integral_gtos - integral_cosgtos)
|
||||||
|
accu_abs += delta
|
||||||
|
|
||||||
|
if(delta .gt. 1.d-7) then
|
||||||
|
print*, ' problem on: '
|
||||||
|
print*, i, j
|
||||||
|
print*, integral_gtos, integral_cosgtos, delta
|
||||||
|
!stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'accu_abs = ', accu_abs
|
||||||
|
|
||||||
|
end subroutine test_1e_kin
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_1e_coul()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: integral_gtos, integral_cosgtos
|
||||||
|
double precision :: delta, accu_abs
|
||||||
|
|
||||||
|
print*, ' check Coulomb 1e integrals'
|
||||||
|
|
||||||
|
accu_abs = 0.d0
|
||||||
|
accu_abs = 0.d0
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
|
||||||
|
integral_gtos = ao_integrals_n_e (i,j)
|
||||||
|
integral_cosgtos = ao_integrals_n_e_cosgtos(i,j)
|
||||||
|
|
||||||
|
delta = dabs(integral_gtos - integral_cosgtos)
|
||||||
|
accu_abs += delta
|
||||||
|
|
||||||
|
if(delta .gt. 1.d-7) then
|
||||||
|
print*, ' problem on: '
|
||||||
|
print*, i, j
|
||||||
|
print*, integral_gtos, integral_cosgtos, delta
|
||||||
|
!stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'accu_abs = ', accu_abs
|
||||||
|
|
||||||
|
end subroutine test_1e_coul
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_1e_coul_cpx(i, j)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j
|
||||||
|
double precision :: integral
|
||||||
|
|
||||||
|
integral = ao_integrals_n_e_cosgtos(i,j)
|
||||||
|
|
||||||
|
print*, ' cpx Coulomb 1e integrals', integral
|
||||||
|
|
||||||
|
end subroutine test_1e_coul_cpx
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_1e_coul_real(i, j)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j
|
||||||
|
double precision :: integral
|
||||||
|
|
||||||
|
integral = ao_integrals_n_e(i,j)
|
||||||
|
|
||||||
|
print*, ' real Coulomb 1e integrals', integral
|
||||||
|
|
||||||
|
end subroutine test_1e_coul_real
|
||||||
|
|
||||||
|
! ---
|
165
src/ao_two_e_ints/test_cosgtos_2e.irp.f
Normal file
165
src/ao_two_e_ints/test_cosgtos_2e.irp.f
Normal file
@ -0,0 +1,165 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
program test_cosgtos
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: iao, jao, kao, lao
|
||||||
|
|
||||||
|
call init_expo()
|
||||||
|
|
||||||
|
! call test_coef()
|
||||||
|
call test_2e()
|
||||||
|
|
||||||
|
iao = 1
|
||||||
|
jao = 1
|
||||||
|
kao = 1
|
||||||
|
lao = 21
|
||||||
|
! call test_2e_cpx (iao, jao, kao, lao)
|
||||||
|
! call test_2e_real(iao, jao, kao, lao)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine init_expo()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
double precision, allocatable :: expo_im(:,:)
|
||||||
|
|
||||||
|
allocate(expo_im(ao_num, ao_prim_num_max))
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num_max
|
||||||
|
do i = 1, ao_num
|
||||||
|
ao_expoim_cosgtos(i,j) = 0.d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call ezfio_set_cosgtos_ao_int_ao_expoim_cosgtos(expo_im)
|
||||||
|
|
||||||
|
deallocate(expo_im)
|
||||||
|
|
||||||
|
end subroutine init_expo
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_coef()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: coef, coef_gtos, coef_cosgtos
|
||||||
|
double precision :: delta, accu_abs
|
||||||
|
|
||||||
|
print*, ' check coefs'
|
||||||
|
|
||||||
|
accu_abs = 0.d0
|
||||||
|
accu_abs = 0.d0
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
|
||||||
|
coef = ao_coef(i,j)
|
||||||
|
coef_gtos = 1.d0 * ao_coef_normalized_ordered_transp(j,i)
|
||||||
|
coef_cosgtos = 2.d0 * ao_coef_norm_ord_transp_cosgtos (j,i)
|
||||||
|
|
||||||
|
delta = dabs(coef_gtos - coef_cosgtos)
|
||||||
|
accu_abs += delta
|
||||||
|
|
||||||
|
if(delta .gt. 1.d-10) then
|
||||||
|
print*, ' problem on: '
|
||||||
|
print*, i, j
|
||||||
|
print*, coef_gtos, coef_cosgtos, delta
|
||||||
|
print*, coef
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*, 'accu_abs = ', accu_abs
|
||||||
|
|
||||||
|
end subroutine test_coef
|
||||||
|
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_2e()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: iao, jao, kao, lao
|
||||||
|
double precision :: integral_gtos, integral_cosgtos
|
||||||
|
double precision :: delta, accu_abs
|
||||||
|
|
||||||
|
double precision :: ao_two_e_integral, ao_two_e_integral_cosgtos
|
||||||
|
|
||||||
|
print*, ' check integrals'
|
||||||
|
|
||||||
|
accu_abs = 0.d0
|
||||||
|
accu_abs = 0.d0
|
||||||
|
|
||||||
|
! iao = 1
|
||||||
|
! jao = 1
|
||||||
|
! kao = 1
|
||||||
|
! lao = 24
|
||||||
|
|
||||||
|
do iao = 1, ao_num ! r1
|
||||||
|
do jao = 1, ao_num ! r2
|
||||||
|
do kao = 1, ao_num ! r1
|
||||||
|
do lao = 1, ao_num ! r2
|
||||||
|
|
||||||
|
integral_gtos = ao_two_e_integral (iao, kao, jao, lao)
|
||||||
|
integral_cosgtos = ao_two_e_integral_cosgtos(iao, kao, jao, lao)
|
||||||
|
|
||||||
|
delta = dabs(integral_gtos - integral_cosgtos)
|
||||||
|
accu_abs += delta
|
||||||
|
|
||||||
|
if(delta .gt. 1.d-7) then
|
||||||
|
print*, ' problem on: '
|
||||||
|
print*, iao, jao, kao, lao
|
||||||
|
print*, integral_gtos, integral_cosgtos, delta
|
||||||
|
!stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'accu_abs = ', accu_abs
|
||||||
|
|
||||||
|
end subroutine test_2e
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_2e_cpx(iao, jao, kao, lao)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: iao, jao, kao, lao
|
||||||
|
double precision :: integral
|
||||||
|
double precision :: ao_two_e_integral_cosgtos
|
||||||
|
|
||||||
|
integral = ao_two_e_integral_cosgtos(iao, kao, jao, lao)
|
||||||
|
print *, ' cosgtos: ', integral
|
||||||
|
|
||||||
|
end subroutine test_2e_cpx
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine test_2e_real(iao, jao, kao, lao)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: iao, jao, kao, lao
|
||||||
|
double precision :: integral
|
||||||
|
double precision :: ao_two_e_integral
|
||||||
|
|
||||||
|
integral = ao_two_e_integral(iao, kao, jao, lao)
|
||||||
|
print *, ' gtos: ', integral
|
||||||
|
|
||||||
|
end subroutine test_2e_real
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
|
@ -1,23 +1,42 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function ao_two_e_integral(i,j,k,l)
|
double precision function ao_two_e_integral(i,j,k,l)
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! integral of the AO basis <ik|jl> or (ij|kl)
|
! integral of the AO basis <ik|jl> or (ij|kl)
|
||||||
! i(r1) j(r1) 1/r12 k(r2) l(r2)
|
! i(r1) j(r1) 1/r12 k(r2) l(r2)
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
integer,intent(in) :: i,j,k,l
|
implicit none
|
||||||
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
|
|
||||||
include 'utils/constants.include.F'
|
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 :: 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
|
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
|
double precision :: ao_two_e_integral_schwartz_accel
|
||||||
|
|
||||||
|
double precision :: ao_two_e_integral_cosgtos
|
||||||
|
|
||||||
|
|
||||||
|
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 (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
|
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)
|
ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l)
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
dim1 = n_pt_max_integrals
|
dim1 = n_pt_max_integrals
|
||||||
@ -101,8 +120,13 @@ double precision function ao_two_e_integral(i,j,k,l)
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)
|
double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -420,13 +444,16 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
|
|||||||
|
|
||||||
END_PROVIDER
|
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
|
BEGIN_DOC
|
||||||
! Needed to compute Schwartz inequalities
|
! Needed to compute Schwartz inequalities
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
integer :: i,k
|
implicit none
|
||||||
|
integer :: i, k
|
||||||
double precision :: ao_two_e_integral,cpu_1,cpu_2, wall_1, wall_2
|
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)
|
ao_two_e_integral_schwartz(1,1) = ao_two_e_integral(1,1,1,1)
|
||||||
@ -444,6 +471,7 @@ BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function general_primitive_integral(dim, &
|
double precision function general_primitive_integral(dim, &
|
||||||
P_new,P_center,fact_p,p,p_inv,iorder_p, &
|
P_new,P_center,fact_p,p,p_inv,iorder_p, &
|
||||||
@ -575,7 +603,10 @@ double precision function general_primitive_integral(dim, &
|
|||||||
!DIR$ FORCEINLINE
|
!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)
|
||||||
double precision :: rint_sum
|
double precision :: rint_sum
|
||||||
|
|
||||||
accu = accu + rint_sum(n_pt_out,const,d1)
|
accu = accu + rint_sum(n_pt_out,const,d1)
|
||||||
|
! print *, n_pt_out, d1(0:n_pt_out)
|
||||||
|
! print *, accu
|
||||||
|
|
||||||
general_primitive_integral = fact_p * fact_q * accu *pi_5_2*p_inv*q_inv/dsqrt(p+q)
|
general_primitive_integral = fact_p * fact_q * accu *pi_5_2*p_inv*q_inv/dsqrt(p+q)
|
||||||
end
|
end
|
||||||
@ -840,6 +871,15 @@ subroutine give_polynom_mult_center_x(P_center,Q_center,a_x,d_x,p,q,n_pt_in,pq_i
|
|||||||
!DIR$ FORCEINLINE
|
!DIR$ FORCEINLINE
|
||||||
call I_x1_pol_mult(a_x,d_x,B10,B01,B00,C00,D00,d,n_pt1,n_pt_in)
|
call I_x1_pol_mult(a_x,d_x,B10,B01,B00,C00,D00,d,n_pt1,n_pt_in)
|
||||||
n_pt_out = n_pt1
|
n_pt_out = n_pt1
|
||||||
|
|
||||||
|
! print *, ' '
|
||||||
|
! print *, a_x, d_x
|
||||||
|
! print *, B10, B01, B00, C00, D00
|
||||||
|
! print *, n_pt1, d(0:n_pt1)
|
||||||
|
! print *, ' '
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
if(n_pt1<0)then
|
if(n_pt1<0)then
|
||||||
n_pt_out = -1
|
n_pt_out = -1
|
||||||
do i = 0,n_pt_in
|
do i = 0,n_pt_in
|
||||||
|
@ -72,4 +72,3 @@ doc: Exponents in the shell
|
|||||||
size: (basis.prim_num)
|
size: (basis.prim_num)
|
||||||
interface: ezfio, provider
|
interface: ezfio, provider
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,67 +1,11 @@
|
|||||||
BEGIN_PROVIDER [ double precision, shell_normalization_factor , (shell_num) ]
|
BEGIN_PROVIDER [ integer, shell_prim_num_max ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Number of primitives per |AO|
|
! Max number of primitives.
|
||||||
END_DOC
|
END_DOC
|
||||||
|
shell_prim_num_max = maxval(shell_prim_num)
|
||||||
logical :: has
|
|
||||||
PROVIDE ezfio_filename
|
|
||||||
if (mpi_master) then
|
|
||||||
if (size(shell_normalization_factor) == 0) return
|
|
||||||
|
|
||||||
call ezfio_has_basis_shell_normalization_factor(has)
|
|
||||||
if (has) then
|
|
||||||
write(6,'(A)') '.. >>>>> [ IO READ: shell_normalization_factor ] <<<<< ..'
|
|
||||||
call ezfio_get_basis_shell_normalization_factor(shell_normalization_factor)
|
|
||||||
else
|
|
||||||
|
|
||||||
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
|
|
||||||
integer :: l, powA(3), nz
|
|
||||||
integer :: i,j,k
|
|
||||||
nz=100
|
|
||||||
C_A(1) = 0.d0
|
|
||||||
C_A(2) = 0.d0
|
|
||||||
C_A(3) = 0.d0
|
|
||||||
|
|
||||||
do i=1,shell_num
|
|
||||||
|
|
||||||
powA(1) = shell_ang_mom(i)
|
|
||||||
powA(2) = 0
|
|
||||||
powA(3) = 0
|
|
||||||
|
|
||||||
norm = 0.d0
|
|
||||||
do k=1, prim_num
|
|
||||||
if (shell_index(k) /= i) cycle
|
|
||||||
do j=1, prim_num
|
|
||||||
if (shell_index(j) /= i) cycle
|
|
||||||
call overlap_gaussian_xyz(C_A,C_A,prim_expo(j),prim_expo(k), &
|
|
||||||
powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
|
|
||||||
norm = norm+c*prim_coef(j)*prim_coef(k) * prim_normalization_factor(j) * prim_normalization_factor(k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
shell_normalization_factor(i) = 1.d0/dsqrt(norm)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
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( shell_normalization_factor, (shell_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
|
|
||||||
if (ierr /= MPI_SUCCESS) then
|
|
||||||
stop 'Unable to read shell_normalization_factor with MPI'
|
|
||||||
endif
|
|
||||||
IRP_ENDIF
|
|
||||||
|
|
||||||
call write_time(6)
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, prim_normalization_factor , (prim_num) ]
|
BEGIN_PROVIDER [ double precision, prim_normalization_factor , (prim_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -120,3 +64,94 @@ BEGIN_PROVIDER [ double precision, prim_normalization_factor , (prim_num) ]
|
|||||||
call write_time(6)
|
call write_time(6)
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, shell_coef , (shell_num, shell_prim_num_max) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, shell_expo , (shell_num, shell_prim_num_max) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Primitive coefficients and exponents for each shell.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i, idx
|
||||||
|
integer :: count(shell_num)
|
||||||
|
|
||||||
|
count(:) = 0
|
||||||
|
do i=1, prim_num
|
||||||
|
idx = shell_index(i)
|
||||||
|
count(idx) += 1
|
||||||
|
shell_coef(idx, count(idx)) = prim_coef(i)
|
||||||
|
shell_expo(idx, count(idx)) = prim_expo(i)
|
||||||
|
end do
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, shell_coef_normalized, (shell_num,shell_prim_num_max) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, shell_normalization_factor, (shell_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Coefficients including the |shell| normalization
|
||||||
|
END_DOC
|
||||||
|
logical :: has
|
||||||
|
PROVIDE ezfio_filename
|
||||||
|
|
||||||
|
shell_normalization_factor(:) = 1.d0
|
||||||
|
if (mpi_master) then
|
||||||
|
if (size(shell_normalization_factor) == 0) return
|
||||||
|
|
||||||
|
call ezfio_has_basis_shell_normalization_factor(has)
|
||||||
|
if (has) then
|
||||||
|
write(6,'(A)') '.. >>>>> [ IO READ: shell_normalization_factor ] <<<<< ..'
|
||||||
|
call ezfio_get_basis_shell_normalization_factor(shell_normalization_factor)
|
||||||
|
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( shell_normalization_factor, (shell_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read shell_normalization_factor with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
|
||||||
|
integer :: l, powA(3), nz
|
||||||
|
integer :: i,j,k
|
||||||
|
nz=100
|
||||||
|
C_A = 0.d0
|
||||||
|
powA = 0
|
||||||
|
shell_coef_normalized = 0.d0
|
||||||
|
|
||||||
|
do i=1,shell_num
|
||||||
|
|
||||||
|
powA(1) = shell_ang_mom(i)
|
||||||
|
|
||||||
|
! Normalization of the primitives
|
||||||
|
if (primitives_normalized) then
|
||||||
|
do j=1,shell_prim_num(i)
|
||||||
|
call overlap_gaussian_xyz(C_A,C_A,shell_expo(i,j),shell_expo(i,j), &
|
||||||
|
powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
|
||||||
|
shell_coef_normalized(i,j) = shell_coef(i,j)/dsqrt(norm)
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
do j=1,shell_prim_num(i)
|
||||||
|
shell_coef_normalized(i,j) = shell_coef(i,j)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Normalization of the contracted basis functions
|
||||||
|
norm = 0.d0
|
||||||
|
do j=1,shell_prim_num(i)
|
||||||
|
do k=1,shell_prim_num(i)
|
||||||
|
call overlap_gaussian_xyz(C_A,C_A,shell_expo(i,j),shell_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
|
||||||
|
norm = norm+c*shell_coef_normalized(i,j)*shell_coef_normalized(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
shell_normalization_factor(i) *= 1.d0/dsqrt(norm)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
57
src/basis_correction/pbe_ueg_self_contained.irp.f
Normal file
57
src/basis_correction/pbe_ueg_self_contained.irp.f
Normal file
@ -0,0 +1,57 @@
|
|||||||
|
double precision function ecmd_pbe_ueg_self_cont(dens,spin_pol,mu,e_PBE)
|
||||||
|
implicit none
|
||||||
|
! dens = total density
|
||||||
|
! spin_pol = spin_polarization (n_a - n_b)/dens
|
||||||
|
! e_PBE = PBE correlation (mu=0) energy evaluated at dens,spin_pol (and grad_rho)
|
||||||
|
! e_PBE = epsilon_PBE * dens which means that it is not the energy density but the energy density X the density
|
||||||
|
double precision, intent(in) :: dens,spin_pol,mu,e_PBE
|
||||||
|
double precision :: rho_a,rho_b,pi,g0_UEG_func,denom,beta
|
||||||
|
pi = dacos(-1.d0)
|
||||||
|
rho_a = (dens * spin_pol + dens)*0.5d0
|
||||||
|
rho_b = (dens - dens * spin_pol)*0.5d0
|
||||||
|
if(mu == 0.d0) then
|
||||||
|
ecmd_pbe_ueg_self_cont = e_PBE
|
||||||
|
else
|
||||||
|
! note: the on-top pair density is (1-zeta^2) rhoc^2 g0 = 4 rhoa * rhob * g0
|
||||||
|
denom = (-2.d0+sqrt(2d0))*sqrt(2.d0*pi) * 4.d0*rho_a*rho_b*g0_UEG_func(rho_a,rho_b)
|
||||||
|
if (dabs(denom) > 1.d-12) then
|
||||||
|
beta = (3.d0*e_PBE)/denom
|
||||||
|
ecmd_pbe_ueg_self_cont=e_PBE/(1.d0+beta*mu**3)
|
||||||
|
else
|
||||||
|
ecmd_pbe_ueg_self_cont=0.d0
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
double precision function g0_UEG_func(rho_a,rho_b)
|
||||||
|
! Pair distribution function g0(n_alpha,n_beta) of the Colombic UEG
|
||||||
|
!
|
||||||
|
! Taken from Eq. (46) P. Gori-Giorgi and A. Savin, Phys. Rev. A 73, 032506 (2006).
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: rho_a,rho_b
|
||||||
|
double precision :: rho,pi,x
|
||||||
|
double precision :: B, C, D, E, d2, rs, ahd
|
||||||
|
rho = rho_a+rho_b
|
||||||
|
pi = 4d0 * datan(1d0)
|
||||||
|
ahd = -0.36583d0
|
||||||
|
d2 = 0.7524d0
|
||||||
|
B = -2d0 * ahd - d2
|
||||||
|
C = 0.08193d0
|
||||||
|
D = -0.01277d0
|
||||||
|
E = 0.001859d0
|
||||||
|
x = -d2*rs
|
||||||
|
if (dabs(rho) > 1.d-20) then
|
||||||
|
rs = (3d0 / (4d0*pi*rho))**(1d0/3d0)
|
||||||
|
x = -d2*rs
|
||||||
|
if(dabs(x).lt.50.d0)then
|
||||||
|
g0_UEG_func= 0.5d0 * (1d0+ rs* (-B + rs*(C + rs*(D + rs*E))))*dexp(x)
|
||||||
|
else
|
||||||
|
g0_UEG_func= 0.d0
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
g0_UEG_func= 0.d0
|
||||||
|
endif
|
||||||
|
g0_UEG_func = max(g0_UEG_func,1.d-14)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
@ -38,7 +38,7 @@ subroutine print_basis_correction
|
|||||||
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-UEG , state ',istate,' = ',ecmd_pbe_ueg_mu_of_r(istate)
|
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-UEG , state ',istate,' = ',ecmd_pbe_ueg_mu_of_r(istate)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then
|
else if(mu_of_r_potential.EQ."cas_ful")then
|
||||||
print*, ''
|
print*, ''
|
||||||
print*,'Using a CAS-like two-body density to define mu(r)'
|
print*,'Using a CAS-like two-body density to define mu(r)'
|
||||||
print*,'This assumes that the CAS is a qualitative representation of the wave function '
|
print*,'This assumes that the CAS is a qualitative representation of the wave function '
|
||||||
@ -80,3 +80,64 @@ subroutine print_basis_correction
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine print_all_basis_correction
|
||||||
|
implicit none
|
||||||
|
integer :: istate
|
||||||
|
provide mu_average_prov
|
||||||
|
provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r
|
||||||
|
provide ecmd_pbe_on_top_mu_of_r ecmd_pbe_on_top_su_mu_of_r
|
||||||
|
|
||||||
|
print*, ''
|
||||||
|
print*, ''
|
||||||
|
print*, '****************************************'
|
||||||
|
print*, '****************************************'
|
||||||
|
print*, 'Basis set correction for WFT using DFT Ecmd functionals'
|
||||||
|
print*, 'These functionals are accurate for short-range correlation'
|
||||||
|
print*, ''
|
||||||
|
print*, 'For more details look at Journal of Chemical Physics 149, 194301 1-15 (2018) '
|
||||||
|
print*, ' Journal of Physical Chemistry Letters 10, 2931-2937 (2019) '
|
||||||
|
print*, ' ???REF SC?'
|
||||||
|
print*, '****************************************'
|
||||||
|
print*, '****************************************'
|
||||||
|
print*, 'mu_of_r_potential = ',mu_of_r_potential
|
||||||
|
print*, ''
|
||||||
|
print*,'Using a CAS-like two-body density to define mu(r)'
|
||||||
|
print*,'This assumes that the CAS is a qualitative representation of the wave function '
|
||||||
|
print*,'********************************************'
|
||||||
|
print*,'Functionals more suited for weak correlation'
|
||||||
|
print*,'********************************************'
|
||||||
|
print*,'+) LDA Ecmd functional : purely based on the UEG (JCP,149,194301,1-15 (2018)) '
|
||||||
|
do istate = 1, N_states
|
||||||
|
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD LDA , state ',istate,' = ',ecmd_lda_mu_of_r(istate)
|
||||||
|
enddo
|
||||||
|
print*,'+) PBE-UEG Ecmd functional : PBE at mu=0, UEG ontop pair density at large mu (JPCL, 10, 2931-2937 (2019))'
|
||||||
|
do istate = 1, N_states
|
||||||
|
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-UEG , state ',istate,' = ',ecmd_pbe_ueg_mu_of_r(istate)
|
||||||
|
enddo
|
||||||
|
print*,''
|
||||||
|
print*,'********************************************'
|
||||||
|
print*,'********************************************'
|
||||||
|
print*,'+) PBE-on-top Ecmd functional : (??????? REF-SCF ??????????)'
|
||||||
|
print*,'PBE at mu=0, extrapolated ontop pair density at large mu, usual spin-polarization'
|
||||||
|
do istate = 1, N_states
|
||||||
|
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-OT , state ',istate,' = ',ecmd_pbe_on_top_mu_of_r(istate)
|
||||||
|
enddo
|
||||||
|
print*,''
|
||||||
|
print*,'********************************************'
|
||||||
|
print*,'+) PBE-on-top no spin polarization Ecmd functional : (??????? REF-SCF ??????????)'
|
||||||
|
print*,'PBE at mu=0, extrapolated ontop pair density at large mu, and ZERO SPIN POLARIZATION'
|
||||||
|
do istate = 1, N_states
|
||||||
|
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD SU-PBE-OT , state ',istate,' = ',ecmd_pbe_on_top_su_mu_of_r(istate)
|
||||||
|
enddo
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'**************'
|
||||||
|
do istate = 1, N_states
|
||||||
|
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' Average mu(r) , state ',istate,' = ',mu_average_prov(istate)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -20,9 +20,10 @@ subroutine print_su_pbe_ot
|
|||||||
integer :: istate
|
integer :: istate
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-UEG , state ',istate,' = ',ecmd_pbe_ueg_mu_of_r(istate)
|
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-UEG , state ',istate,' = ',ecmd_pbe_ueg_mu_of_r(istate)
|
||||||
|
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ecmd_pbe_ueg_test , state ',istate,' = ',ecmd_pbe_ueg_test(istate)
|
||||||
enddo
|
enddo
|
||||||
do istate = 1, N_states
|
! do istate = 1, N_states
|
||||||
write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD SU-PBE-OT , state ',istate,' = ',ecmd_pbe_on_top_su_mu_of_r(istate)
|
! write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD SU-PBE-OT , state ',istate,' = ',ecmd_pbe_on_top_su_mu_of_r(istate)
|
||||||
enddo
|
! enddo
|
||||||
|
|
||||||
end
|
end
|
||||||
|
84
src/basis_correction/test_ueg_self_contained.irp.f
Normal file
84
src/basis_correction/test_ueg_self_contained.irp.f
Normal file
@ -0,0 +1,84 @@
|
|||||||
|
program test_sc
|
||||||
|
implicit none
|
||||||
|
integer :: m
|
||||||
|
double precision :: r(3),f_hf,on_top,mu,sqpi
|
||||||
|
double precision :: rho_a,rho_b,w_hf,dens,delta_rho,e_pbe
|
||||||
|
double precision :: grad_rho_a(3),grad_rho_b(3),grad_rho_a_2(3),grad_rho_b_2(3),grad_rho_a_b(3)
|
||||||
|
double precision :: sigmacc,sigmaco,sigmaoo,spin_pol
|
||||||
|
double precision :: eps_c_md_PBE , ecmd_pbe_ueg_self_cont
|
||||||
|
r = 0.D0
|
||||||
|
r(3) = 1.D0
|
||||||
|
call f_HF_valence_ab(r,r,f_hf,on_top)
|
||||||
|
sqpi = dsqrt(dacos(-1.d0))
|
||||||
|
if(on_top.le.1.d-12.or.f_hf.le.0.d0.or.f_hf * on_top.lt.0.d0)then
|
||||||
|
w_hf = 1.d+10
|
||||||
|
else
|
||||||
|
w_hf = f_hf / on_top
|
||||||
|
endif
|
||||||
|
mu = sqpi * 0.5d0 * w_hf
|
||||||
|
call density_and_grad_alpha_beta(r,rho_a,rho_b, grad_rho_a, grad_rho_b)
|
||||||
|
dens = rho_a + rho_b
|
||||||
|
delta_rho = rho_a - rho_b
|
||||||
|
spin_pol = delta_rho/(max(1.d-10,dens))
|
||||||
|
grad_rho_a_2 = 0.d0
|
||||||
|
grad_rho_b_2 = 0.d0
|
||||||
|
grad_rho_a_b = 0.d0
|
||||||
|
do m = 1, 3
|
||||||
|
grad_rho_a_2 += grad_rho_a(m)*grad_rho_a(m)
|
||||||
|
grad_rho_b_2 += grad_rho_b(m)*grad_rho_b(m)
|
||||||
|
grad_rho_a_b += grad_rho_a(m)*grad_rho_b(m)
|
||||||
|
enddo
|
||||||
|
call grad_rho_ab_to_grad_rho_oc(grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,sigmaoo,sigmacc,sigmaco)
|
||||||
|
|
||||||
|
! call the PBE energy
|
||||||
|
print*,'f_hf,on_top = ',f_hf,on_top
|
||||||
|
print*,'mu = ',mu
|
||||||
|
print*,'dens,spin_pol',dens,spin_pol
|
||||||
|
call ec_pbe_only(0.d0,dens,delta_rho,sigmacc,sigmaco,sigmaoo,e_PBE)
|
||||||
|
print*,'e_PBE = ',e_PBE
|
||||||
|
eps_c_md_PBE = ecmd_pbe_ueg_self_cont(dens,spin_pol,mu,e_PBE)
|
||||||
|
print*,'eps_c_md_PBE = ',eps_c_md_PBE
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,''
|
||||||
|
print*,''
|
||||||
|
print*,'energy_c' ,energy_c
|
||||||
|
|
||||||
|
integer::ipoint
|
||||||
|
double precision :: weight , accu
|
||||||
|
accu = 0.d0
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
r = final_grid_points(:,ipoint)
|
||||||
|
weight = final_weight_at_r_vector(ipoint)
|
||||||
|
call f_HF_valence_ab(r,r,f_hf,on_top)
|
||||||
|
sqpi = dsqrt(dacos(-1.d0))
|
||||||
|
if(on_top.le.1.d-12.or.f_hf.le.0.d0.or.f_hf * on_top.lt.0.d0)then
|
||||||
|
w_hf = 1.d+10
|
||||||
|
else
|
||||||
|
w_hf = f_hf / on_top
|
||||||
|
endif
|
||||||
|
mu = sqpi * 0.5d0 * w_hf
|
||||||
|
call density_and_grad_alpha_beta(r,rho_a,rho_b, grad_rho_a, grad_rho_b)
|
||||||
|
dens = rho_a + rho_b
|
||||||
|
delta_rho = rho_a - rho_b
|
||||||
|
spin_pol = delta_rho/(max(1.d-10,dens))
|
||||||
|
grad_rho_a_2 = 0.d0
|
||||||
|
grad_rho_b_2 = 0.d0
|
||||||
|
grad_rho_a_b = 0.d0
|
||||||
|
do m = 1, 3
|
||||||
|
grad_rho_a_2 += grad_rho_a(m)*grad_rho_a(m)
|
||||||
|
grad_rho_b_2 += grad_rho_b(m)*grad_rho_b(m)
|
||||||
|
grad_rho_a_b += grad_rho_a(m)*grad_rho_b(m)
|
||||||
|
enddo
|
||||||
|
call grad_rho_ab_to_grad_rho_oc(grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,sigmaoo,sigmacc,sigmaco)
|
||||||
|
! call the PBE energy
|
||||||
|
call ec_pbe_only(0.d0,dens,delta_rho,sigmacc,sigmaco,sigmaoo,e_PBE)
|
||||||
|
eps_c_md_PBE = ecmd_pbe_ueg_self_cont(dens,spin_pol,mu,e_PBE)
|
||||||
|
write(33,'(100(F16.10,X))')r(:), weight, w_hf, on_top, mu, dens, spin_pol, e_PBE, eps_c_md_PBE
|
||||||
|
accu += weight * eps_c_md_PBE
|
||||||
|
enddo
|
||||||
|
print*,'accu = ',accu
|
||||||
|
write(*, *) ' ECMD PBE-UEG ',ecmd_pbe_ueg_mu_of_r(1)
|
||||||
|
write(*, *) ' ecmd_pbe_ueg_test ',ecmd_pbe_ueg_test(1)
|
||||||
|
|
||||||
|
end
|
@ -81,3 +81,54 @@ BEGIN_PROVIDER [double precision, ecmd_pbe_ueg_mu_of_r, (N_states)]
|
|||||||
print*,'Time for the ecmd_pbe_ueg_mu_of_r:',wall1-wall0
|
print*,'Time for the ecmd_pbe_ueg_mu_of_r:',wall1-wall0
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, ecmd_pbe_ueg_test, (N_states)]
|
||||||
|
BEGIN_DOC
|
||||||
|
! test of the routines contained in pbe_ueg_self_contained.irp.f
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
double precision :: weight
|
||||||
|
integer :: ipoint,istate,m
|
||||||
|
double precision :: mu,rho_a,rho_b
|
||||||
|
double precision :: dens,spin_pol,grad_rho,e_PBE,delta_rho
|
||||||
|
double precision :: ecmd_pbe_ueg_self_cont,eps_c_md_PBE
|
||||||
|
ecmd_pbe_ueg_test = 0.d0
|
||||||
|
|
||||||
|
do istate = 1, N_states
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
weight=final_weight_at_r_vector(ipoint)
|
||||||
|
|
||||||
|
! mu(r) defined by Eq. (37) of J. Chem. Phys. 149, 194301 (2018)
|
||||||
|
mu = mu_of_r_prov(ipoint,istate)
|
||||||
|
|
||||||
|
! conversion from rho_a,rho_b --> dens,spin_pol
|
||||||
|
rho_a = one_e_dm_and_grad_alpha_in_r(4,ipoint,istate)
|
||||||
|
rho_b = one_e_dm_and_grad_beta_in_r(4,ipoint,istate)
|
||||||
|
dens = rho_a + rho_b
|
||||||
|
spin_pol = (rho_a - rho_b)/(max(dens,1.d-12))
|
||||||
|
delta_rho = rho_a - rho_b
|
||||||
|
|
||||||
|
! conversion from grad_rho_a ... to sigma
|
||||||
|
double precision :: grad_rho_a(3),grad_rho_b(3),grad_rho_a_2(3),grad_rho_b_2(3),grad_rho_a_b(3)
|
||||||
|
double precision :: sigmacc,sigmaco,sigmaoo
|
||||||
|
grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate)
|
||||||
|
grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate)
|
||||||
|
grad_rho_a_2 = 0.d0
|
||||||
|
grad_rho_b_2 = 0.d0
|
||||||
|
grad_rho_a_b = 0.d0
|
||||||
|
do m = 1, 3
|
||||||
|
grad_rho_a_2 += grad_rho_a(m)*grad_rho_a(m)
|
||||||
|
grad_rho_b_2 += grad_rho_b(m)*grad_rho_b(m)
|
||||||
|
grad_rho_a_b += grad_rho_a(m)*grad_rho_b(m)
|
||||||
|
enddo
|
||||||
|
call grad_rho_ab_to_grad_rho_oc(grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,sigmaoo,sigmacc,sigmaco)
|
||||||
|
|
||||||
|
! call the PBE energy
|
||||||
|
call ec_pbe_only(0.d0,dens,delta_rho,sigmacc,sigmaco,sigmaoo,e_PBE)
|
||||||
|
eps_c_md_PBE = ecmd_pbe_ueg_self_cont(dens,spin_pol,mu,e_PBE)
|
||||||
|
|
||||||
|
ecmd_pbe_ueg_test(istate) += eps_c_md_PBE * weight
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!
|
||||||
|
END_PROVIDER
|
||||||
|
@ -64,7 +64,8 @@ END_PROVIDER
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_integration_angular,n_points_radial_grid,nucl_num)]
|
BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_integration_angular,n_points_radial_grid,nucl_num)]
|
||||||
|
&BEGIN_PROVIDER [double precision, radial_points_per_atom, (n_points_radial_grid,nucl_num)]
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! x,y,z coordinates of grid points used for integration in 3d space
|
! x,y,z coordinates of grid points used for integration in 3d space
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -72,6 +73,7 @@ BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_integration_
|
|||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
double precision :: dr,x_ref,y_ref,z_ref
|
double precision :: dr,x_ref,y_ref,z_ref
|
||||||
double precision :: knowles_function
|
double precision :: knowles_function
|
||||||
|
radial_points_per_atom = 0.D0
|
||||||
do i = 1, nucl_num
|
do i = 1, nucl_num
|
||||||
x_ref = nucl_coord(i,1)
|
x_ref = nucl_coord(i,1)
|
||||||
y_ref = nucl_coord(i,2)
|
y_ref = nucl_coord(i,2)
|
||||||
@ -83,7 +85,7 @@ BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_integration_
|
|||||||
|
|
||||||
! value of the radial coordinate for the integration
|
! 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)
|
||||||
|
radial_points_per_atom(j,i) = r
|
||||||
! explicit values of the grid points centered around each atom
|
! explicit values of the grid points centered around each atom
|
||||||
do k = 1, n_points_integration_angular
|
do k = 1, n_points_integration_angular
|
||||||
grid_points_per_atom(1,k,j,i) = &
|
grid_points_per_atom(1,k,j,i) = &
|
||||||
|
@ -58,17 +58,3 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, final_grid_points_transp, (n_points_final_grid,3)]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Transposed final_grid_points
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
integer :: i,j
|
|
||||||
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
|
|
||||||
|
3
src/bi_ort_ints/NEED
Normal file
3
src/bi_ort_ints/NEED
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
non_h_ints_mu
|
||||||
|
ao_tc_eff_map
|
||||||
|
bi_ortho_mos
|
25
src/bi_ort_ints/README.rst
Normal file
25
src/bi_ort_ints/README.rst
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
===========
|
||||||
|
bi_ort_ints
|
||||||
|
===========
|
||||||
|
|
||||||
|
This module contains all necessary integrals for the TC Hamiltonian in a bi-orthonormal (BO) MO Basis.
|
||||||
|
See in bi_ortho_basis for more information.
|
||||||
|
The main providers are :
|
||||||
|
|
||||||
|
One-electron integrals
|
||||||
|
----------------------
|
||||||
|
+) ao_one_e_integrals_tc_tot : total one-electron Hamiltonian which might include non hermitian part coming from one-e correlation factor.
|
||||||
|
+) mo_bi_ortho_tc_one_e : one-electron Hamiltonian (h_core+one-J terms) on the BO-MO basis.
|
||||||
|
+) mo_bi_orth_bipole_x : x-component of the dipole operator on the BO-MO basis. (Same for y,z)
|
||||||
|
|
||||||
|
Two-electron integrals
|
||||||
|
----------------------
|
||||||
|
+) ao_two_e_tc_tot : Total two-electron operator (including the non-hermitian term of the TC Hamiltonian) on the AO basis
|
||||||
|
+) mo_bi_ortho_tc_two_e : Total two-electron operator on the BO-MO basis
|
||||||
|
|
||||||
|
Three-electron integrals
|
||||||
|
------------------------
|
||||||
|
+) three_body_ints_bi_ort : 6-indices three-electron tensor (-L) on the BO-MO basis. WARNING :: N^6 storage !
|
||||||
|
+) three_e_3_idx_direct_bi_ort : DIRECT term with 3 different indices of the -L operator. These terms appear in the DIAGONAL matrix element of the -L operator. The 5 other permutations needed to compute matrix elements can be found in three_body_ijm.irp.f
|
||||||
|
+) three_e_4_idx_direct_bi_ort : DIRECT term with 4 different indices of the -L operator. These terms appear in the OFF-DIAGONAL matrix element of the -L operator including SINGLE EXCITATIONS. The 5 other permutations needed to compute matrix elements can be found in three_body_ijmk.irp.f
|
||||||
|
+) three_e_5_idx_direct_bi_ort : DIRECT term with 5 different indices of the -L operator. These terms appear in the OFF-DIAGONAL matrix element of the -L operator including DOUBLE EXCITATIONS. The 5 other permutations needed to compute matrix elements can be found in three_body_ijmkl.irp.f
|
21
src/bi_ort_ints/bi_ort_ints.irp.f
Normal file
21
src/bi_ort_ints/bi_ort_ints.irp.f
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
program bi_ort_ints
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! TODO : Put the documentation of the program here
|
||||||
|
END_DOC
|
||||||
|
my_grid_becke = .True.
|
||||||
|
my_n_pt_r_grid = 30
|
||||||
|
my_n_pt_a_grid = 50
|
||||||
|
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||||
|
! call test_overlap
|
||||||
|
! call routine_twoe
|
||||||
|
! call routine_onee
|
||||||
|
! call test_v_ki_bi_ortho
|
||||||
|
! call test_x_v_ki_bi_ortho
|
||||||
|
! call test_3_body_bi_ort
|
||||||
|
! call test_3_e_diag
|
||||||
|
! call test_3_e_diag_cycle1
|
||||||
|
! call test_3_e
|
||||||
|
! call routine_test_one_int
|
||||||
|
end
|
||||||
|
|
70
src/bi_ort_ints/one_e_bi_ort.irp.f
Normal file
70
src/bi_ort_ints/one_e_bi_ort.irp.f
Normal file
@ -0,0 +1,70 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, ao_one_e_integrals_tc_tot, (ao_num,ao_num)]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
|
||||||
|
ao_one_e_integrals_tc_tot = ao_one_e_integrals
|
||||||
|
|
||||||
|
provide j1b_gauss
|
||||||
|
|
||||||
|
if(j1b_gauss .eq. 1) then
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! mo_bi_ortho_tc_one_e(k,i) = <MO^L_k | h_c | MO^R_i>
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k,p,q
|
||||||
|
|
||||||
|
call ao_to_mo_bi_ortho(ao_one_e_integrals_tc_tot, ao_num, mo_bi_ortho_tc_one_e, mo_num)
|
||||||
|
|
||||||
|
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 MO_i * x MO_j
|
||||||
|
! array of the integrals of MO_i * y MO_j
|
||||||
|
! array of the integrals of MO_i * z MO_j
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call ao_to_mo_bi_ortho( &
|
||||||
|
ao_dipole_x, &
|
||||||
|
size(ao_dipole_x,1), &
|
||||||
|
mo_bi_orth_bipole_x, &
|
||||||
|
size(mo_bi_orth_bipole_x,1) &
|
||||||
|
)
|
||||||
|
call ao_to_mo_bi_ortho( &
|
||||||
|
ao_dipole_y, &
|
||||||
|
size(ao_dipole_y,1), &
|
||||||
|
mo_bi_orth_bipole_y, &
|
||||||
|
size(mo_bi_orth_bipole_y,1) &
|
||||||
|
)
|
||||||
|
call ao_to_mo_bi_ortho( &
|
||||||
|
ao_dipole_z, &
|
||||||
|
size(ao_dipole_z,1), &
|
||||||
|
mo_bi_orth_bipole_z, &
|
||||||
|
size(mo_bi_orth_bipole_z,1) &
|
||||||
|
)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
177
src/bi_ort_ints/semi_num_ints_mo.irp.f
Normal file
177
src/bi_ort_ints/semi_num_ints_mo.irp.f
Normal file
@ -0,0 +1,177 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, mo_v_ki_bi_ortho_erf_rk_cst_mu, ( mo_num, mo_num,n_points_final_grid)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! mo_v_ki_bi_ortho_erf_rk_cst_mu(k,i,ip) = int dr chi_k(r) phi_i(r) (erf(mu |r - R_ip|) - 1 )/(2|r - R_ip|) on the BI-ORTHO MO basis
|
||||||
|
!
|
||||||
|
! where phi_k(r) is a LEFT MOs and phi_i(r) is a RIGHT MO
|
||||||
|
!
|
||||||
|
! R_ip = the "ip"-th point of the DFT Grid
|
||||||
|
END_DOC
|
||||||
|
integer :: ipoint
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (ipoint) &
|
||||||
|
!$OMP SHARED (n_points_final_grid,v_ij_erf_rk_cst_mu,mo_v_ki_bi_ortho_erf_rk_cst_mu)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
! TODO :: optimization : transform into a DGEMM
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
call ao_to_mo_bi_ortho(v_ij_erf_rk_cst_mu(1,1,ipoint),size(v_ij_erf_rk_cst_mu,1),mo_v_ki_bi_ortho_erf_rk_cst_mu(1,1,ipoint),size(mo_v_ki_bi_ortho_erf_rk_cst_mu,1))
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
mo_v_ki_bi_ortho_erf_rk_cst_mu = mo_v_ki_bi_ortho_erf_rk_cst_mu * 0.5d0
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_v_ki_bi_ortho_erf_rk_cst_mu_transp, ( n_points_final_grid,mo_num, mo_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/(2|r - R|) on the BI-ORTHO MO basis
|
||||||
|
END_DOC
|
||||||
|
integer :: ipoint,i,j
|
||||||
|
do i = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,j,i) = mo_v_ki_bi_ortho_erf_rk_cst_mu(j,i,ipoint)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
! FREE mo_v_ki_bi_ortho_erf_rk_cst_mu
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_x_v_ki_bi_ortho_erf_rk_cst_mu, ( mo_num, mo_num,3,n_points_final_grid)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! mo_x_v_ki_bi_ortho_erf_rk_cst_mu(k,i,m,ip) = int dr x(m) * chi_k(r) phi_i(r) (erf(mu |r - R_ip|) - 1)/2|r - R_ip| on the BI-ORTHO MO basis
|
||||||
|
!
|
||||||
|
! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => x(m) = x, m=2 => x(m) = y, m=3 => x(m) = z,
|
||||||
|
!
|
||||||
|
! R_ip = the "ip"-th point of the DFT Grid
|
||||||
|
END_DOC
|
||||||
|
integer :: ipoint,m
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (ipoint,m) &
|
||||||
|
!$OMP SHARED (n_points_final_grid,x_v_ij_erf_rk_cst_mu_transp,mo_x_v_ki_bi_ortho_erf_rk_cst_mu)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
! TODO :: optimization : transform into a DGEMM
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
do m = 1, 3
|
||||||
|
call ao_to_mo_bi_ortho(x_v_ij_erf_rk_cst_mu_transp(1,1,m,ipoint),size(x_v_ij_erf_rk_cst_mu_transp,1),mo_x_v_ki_bi_ortho_erf_rk_cst_mu(1,1,m,ipoint),size(mo_x_v_ki_bi_ortho_erf_rk_cst_mu,1))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
mo_x_v_ki_bi_ortho_erf_rk_cst_mu = 0.5d0 * mo_x_v_ki_bi_ortho_erf_rk_cst_mu
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp, (n_points_final_grid, 3, mo_num, mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, m, ipoint
|
||||||
|
do i = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do m = 1, 3
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,m,j,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu(j,i,m,ipoint)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, x_W_ki_bi_ortho_erf_rk, (n_points_final_grid, 3, mo_num, mo_num)]
|
||||||
|
BEGIN_DOC
|
||||||
|
! x_W_ki_bi_ortho_erf_rk(ip,m,k,i) = \int dr chi_k(r) (1 - erf(mu |r-R_ip|)) (x(m)-X(m)_ip) phi_i(r) ON THE BI-ORTHO MO BASIS
|
||||||
|
!
|
||||||
|
! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => X(m) = x, m=2 => X(m) = y, m=3 => X(m) = z,
|
||||||
|
!
|
||||||
|
! R_ip = the "ip"-th point of the DFT Grid
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
integer :: ipoint, m, i, k
|
||||||
|
double precision :: xyz
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
|
||||||
|
print*,'providing x_W_ki_bi_ortho_erf_rk ...'
|
||||||
|
call wall_time(wall0)
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (ipoint,m,i,k,xyz) &
|
||||||
|
!$OMP SHARED (x_W_ki_bi_ortho_erf_rk,n_points_final_grid,mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_num,final_grid_points)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
do i = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
do m = 1, 3
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
xyz = final_grid_points(m,ipoint)
|
||||||
|
x_W_ki_bi_ortho_erf_rk(ipoint,m,k,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,m,k,i) - xyz * mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,k,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
! FREE mo_v_ki_bi_ortho_erf_rk_cst_mu_transp
|
||||||
|
! FREE mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'time to provide x_W_ki_bi_ortho_erf_rk = ',wall1 - wall0
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, x_W_ki_bi_ortho_erf_rk_diag, (n_points_final_grid, 3, mo_num)]
|
||||||
|
BEGIN_DOC
|
||||||
|
! x_W_ki_bi_ortho_erf_rk_diag(ip,m,i) = \int dr chi_i(r) (1 - erf(mu |r-R_ip|)) (x(m)-X(m)_ip) phi_i(r) ON THE BI-ORTHO MO BASIS
|
||||||
|
!
|
||||||
|
! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => X(m) = x, m=2 => X(m) = y, m=3 => X(m) = z,
|
||||||
|
!
|
||||||
|
! R_ip = the "ip"-th point of the DFT Grid
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
integer :: ipoint, m, i
|
||||||
|
double precision :: xyz
|
||||||
|
double precision :: wall0, wall1
|
||||||
|
|
||||||
|
print*,'providing x_W_ki_bi_ortho_erf_rk_diag ...'
|
||||||
|
call wall_time(wall0)
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (ipoint,m,i,xyz) &
|
||||||
|
!$OMP SHARED (x_W_ki_bi_ortho_erf_rk_diag,n_points_final_grid,mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_num,final_grid_points)
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
do i = 1, mo_num
|
||||||
|
do m = 1, 3
|
||||||
|
do ipoint = 1, n_points_final_grid
|
||||||
|
xyz = final_grid_points(m,ipoint)
|
||||||
|
x_W_ki_bi_ortho_erf_rk_diag(ipoint,m,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,m,i,i) - xyz * mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,i,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call wall_time(wall1)
|
||||||
|
print*,'time to provide x_W_ki_bi_ortho_erf_rk_diag = ',wall1 - wall0
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user