LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-25 05:52:05 +02:00
Code Releases Activity

Compare commits

base: LCPQ:master
Branches Tags
LCPQ:master
LCPQ:dev-stable
LCPQ:dev-spher_harm
LCPQ:macos
LCPQ:dev-stable-tc-scf
LCPQ:dev-stable-rdm
LCPQ:bugfix
LCPQ:dev-stable-pt-charges
LCPQ:dev-broken
LCPQ:good-dev-tc
LCPQ:guix
LCPQ:dev-tc
LCPQ:cleaning_dft
LCPQ:trexio
LCPQ:dev-pbc
LCPQ:csf
LCPQ:v1j4y-patch-2
LCPQ:TApplencourt-patch-1
LCPQ:kpts-patch-1
LCPQ:cleaning_kpts
LCPQ:features_kpts
LCPQ:kgasperich-patch-2
LCPQ:kgasperich-patch-1
LCPQ:features_periodic
LCPQ:features_spack
LCPQ:daily-test
LCPQ:biblio
LCPQ:features_casscf
LCPQ:gh-pages
LCPQ:v2.2.2
LCPQ:v2.1.1
LCPQ:v0.10-kpts
LCPQ:v0.9-kpts
LCPQ:v0.8-kpts
LCPQ:v0.7-kpts
LCPQ:v0.6-kpts
LCPQ:v0.5-kpts
LCPQ:v0.4-kpts
LCPQ:v0.3-kpts
LCPQ:v0.2-kpts
LCPQ:v0.1-kpts
LCPQ:v0.0-kpts
LCPQ:2.1.2
LCPQ:2.1.1
LCPQ:2.1.0
LCPQ:2.0.0
LCPQ:v2.0.0-beta
..
compare: LCPQ:v2.2.2
Branches Tags
LCPQ:dev-stable
LCPQ:master
LCPQ:dev-spher_harm
LCPQ:macos
LCPQ:dev-stable-tc-scf
LCPQ:dev-stable-rdm
LCPQ:bugfix
LCPQ:dev-stable-pt-charges
LCPQ:dev-broken
LCPQ:good-dev-tc
LCPQ:guix
LCPQ:dev-tc
LCPQ:cleaning_dft
LCPQ:trexio
LCPQ:dev-pbc
LCPQ:csf
LCPQ:v1j4y-patch-2
LCPQ:TApplencourt-patch-1
LCPQ:kpts-patch-1
LCPQ:cleaning_kpts
LCPQ:features_kpts
LCPQ:kgasperich-patch-2
LCPQ:kgasperich-patch-1
LCPQ:features_periodic
LCPQ:features_spack
LCPQ:daily-test
LCPQ:biblio
LCPQ:features_casscf
LCPQ:gh-pages
LCPQ:v2.2.2
LCPQ:v2.1.1
LCPQ:v0.10-kpts
LCPQ:v0.9-kpts
LCPQ:v0.8-kpts
LCPQ:v0.7-kpts
LCPQ:v0.6-kpts
LCPQ:v0.5-kpts
LCPQ:v0.4-kpts
LCPQ:v0.3-kpts
LCPQ:v0.2-kpts
LCPQ:v0.1-kpts
LCPQ:v0.0-kpts
LCPQ:2.1.2
LCPQ:2.1.1
LCPQ:2.1.0
LCPQ:2.0.0
LCPQ:v2.0.0-beta

No commits in common. "master" and "v2.2.2" have entirely different histories.
master ... v2.2.2

257 changed files with 10699 additions and 15844 deletions
Show Stats Expand all files Collapse all files

32
.readthedocs.yaml
View File

@ -1,32 +0,0 @@
# .readthedocs.yaml
# Read the Docs configuration file
# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details
# Required
version: 2
# Set the OS, Python version and other tools you might need
build:
os: ubuntu-22.04
tools:
python: "3.12"
# You can also specify other tool versions:
# nodejs: "19"
# rust: "1.64"
# golang: "1.19"
# Build documentation in the "docs/" directory with Sphinx
sphinx:
configuration: docs/source/conf.py
# Optionally build your docs in additional formats such as PDF and ePub
# formats:
# - pdf
# - epub
# Optional but recommended, declare the Python requirements required
# to build your documentation
# See https://docs.readthedocs.io/en/stable/guides/reproducible-builds.html
python:
install:
- requirements: docs/requirements.txt

2
Makefile
View File

@ -2,4 +2,4 @@ default: build.ninja
bash -c "source quantum_package.rc ; ninja"
build.ninja:
@bash -c ' echo '' ; echo xxxxxxxxxxxxxxxxxx ; echo "QP is not configured yet. Please run the ./configure command" ; echo xxxxxxxxxxxxxxxxxx ; echo '' ; ./configure --help' | more
@bash -c ' echo '' ; echo xxxxxxxxxxxxxxxxxx ; echo "The QP is not configured yet. Please run the ./configure command" ; echo xxxxxxxxxxxxxxxxxx ; echo '' ; ./configure --help' | more

7
README.md
View File

@ -1,10 +1,3 @@
**Important**: The Intel ifx compiler is not able to produce correct
executables for Quantum Package. Please use ifort as long as you can, and
consider switching to gfortran in the long term.
---
# Quantum Package 2.2
<!--- img src="https://raw.githubusercontent.com/QuantumPackage/qp2/master/data/qp2.png" width="250" --->

21
bin/qp_convert_output_to_ezfio
View File

@ -224,18 +224,14 @@ def write_ezfio(res, filename):
exponent += [p.expo for p in b.prim]
ang_mom.append(str.count(s, "z"))
shell_prim_num.append(len(b.prim))
shell_index += [nshell_tot] * len(b.prim)
shell_num = len(ang_mom)
assert(shell_index[0] == 1)
assert(shell_index[-1] == shell_num)
shell_index += [nshell_tot+1] * len(b.prim)
# ~#~#~#~#~ #
# W r i t e #
# ~#~#~#~#~ #
ezfio.set_basis_basis("Read from ResultsFile")
ezfio.set_basis_shell_num(shell_num)
ezfio.set_basis_shell_num(len(ang_mom))
ezfio.set_basis_basis_nucleus_index(nucl_index)
ezfio.set_basis_prim_num(len(coefficient))
@ -260,7 +256,6 @@ def write_ezfio(res, filename):
MoTag = res.determinants_mo_type
ezfio.set_mo_basis_mo_label('Orthonormalized')
ezfio.set_determinants_mo_label('Orthonormalized')
MO_type = MoTag
allMOs = res.mo_sets[MO_type]
@ -313,19 +308,10 @@ def write_ezfio(res, filename):
MoMatrix = []
sym0 = [i.sym for i in res.mo_sets[MO_type]]
sym = [i.sym for i in res.mo_sets[MO_type]]
sym = [i.sym for i in res.mo_sets[MO_type]]
for i in range(len(sym)):
sym[MOmap[i]] = sym0[i]
irrep = {}
for i in sym:
irrep[i] = 0
for i, j in enumerate(irrep.keys()):
irrep[j] = i+1
sym = [ irrep[k] for k in sym ]
MoMatrix = []
for i in range(len(MOs)):
m = MOs[i]
@ -342,7 +328,6 @@ def write_ezfio(res, filename):
ezfio.set_mo_basis_mo_num(mo_num)
ezfio.set_mo_basis_mo_coef(MoMatrix)
ezfio.set_mo_basis_mo_occ(OccNum)
ezfio.set_mo_basis_mo_symmetry(sym)
print("OK")

2
bin/qp_plugins
View File

@ -97,7 +97,7 @@ end
def get_repositories():
l_result = [f for f in os.listdir(QP_PLUGINS) \
if f not in [".gitignore", "local", "README.rst"] ]
if f not in [".gitignore", "local"] ]
return sorted(l_result)

1
bin/qp_set_frozen_core
View File

@ -83,7 +83,6 @@ def main(arguments):
elif charge <= 118: n_frozen += 43
elif arguments["--small"]:
for charge in ezfio.nuclei_nucl_charge:
if charge <= 4: pass
elif charge <= 18: n_frozen += 1
elif charge <= 36: n_frozen += 5

62
config/gfortran_mkl.cfg
View File

@ -1,62 +0,0 @@
# Common flags
##############
#
# -ffree-line-length-none : Needed for IRPF90 which produces long lines
# -lblas -llapack : Link with libblas and liblapack libraries provided by the system
# -I . : Include the curent directory (Mandatory)
#
# --ninja : Allow the utilisation of ninja. (Mandatory)
# --align=32 : Align all provided arrays on a 32-byte boundary
#
#
[COMMON]
FC : gfortran -ffree-line-length-none -I . -mavx -g -fPIC -std=legacy
LAPACK_LIB : -I${MKLROOT}/include -L${MKLROOT}/lib/intel64 -Wl,--no-as-needed -lmkl_gf_lp64 -lmkl_core -lpthread -lm -ldl -lmkl_gnu_thread -lgomp -fopenmp
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DSET_NESTED
# Global options
################
#
# 1 : Activate
# 0 : Deactivate
#
[OPTION]
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
CACHE : 0 ; Enable cache_compile.py
OPENMP : 1 ; Append OpenMP flags
# Optimization flags
####################
#
# -Ofast : Disregard strict standards compliance. Enables all -O3 optimizations.
# It also enables optimizations that are not valid
# for all standard-compliant programs. It turns on
# -ffast-math and the Fortran-specific
# -fno-protect-parens and -fstack-arrays.
[OPT]
FCFLAGS : -Ofast -mavx
# Profiling flags
#################
#
[PROFILE]
FC : -p -g
FCFLAGS : -Ofast
# Debugging flags
#################
#
# -fcheck=all : Checks uninitialized variables, array subscripts, etc...
# -g : Extra debugging information
#
[DEBUG]
FCFLAGS : -fcheck=all -g
# OpenMP flags
#################
#
[OPENMP]
FC : -fopenmp
IRPF90_FLAGS : --openmp

2
config/ifort_2021_avx.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : ifort -fpic -diag-disable=10448
FC : ifort -fpic
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DINTEL

2
config/ifort_2021_avx_mpi.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : mpiifort -fpic -diag-disable=10448
FC : mpiifort -fpic
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL

2
config/ifort_2021_avx_notz.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : ifort -fpic -diag-disable=10448
FC : ifort -fpic
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 --define=WITHOUT_TRAILZ --define=WITHOUT_SHIFTRL

2
config/ifort_2021_debug.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : ifort -fpic -diag-disable=10448
FC : ifort -fpic
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL

2
config/ifort_2021_mpi_rome.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : mpiifort -fpic -diag-disable=10448
FC : mpiifort -fpic
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DINTEL

2
config/ifort_2021_rome.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : ifort -fpic -diag-disable=10448
FC : ifort -fpic
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DINTEL

2
config/ifort_2021_sse4.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : ifort -fpic -diag-disable=10448
FC : ifort -fpic
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DINTEL

2
config/ifort_2021_sse4_mpi.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : mpiifort -fpic -diag-disable=10448
FC : mpiifort -fpic
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL

2
config/ifort_2021_xHost.cfg
View File

@ -6,7 +6,7 @@
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : ifort -fpic -diag-disable=5462 -diag-disable=10448
FC : ifort -fpic -diag-disable 5462
LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=64 -DINTEL

10
configure vendored
View File

@ -9,7 +9,7 @@ echo "QP_ROOT="$QP_ROOT
unset CC
unset CCXX
TREXIO_VERSION=2.4.2
TREXIO_VERSION=2.3.2
# Force GCC instead of ICC for dependencies
export CC=gcc
@ -219,7 +219,7 @@ EOF
tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz
cd trexio-${VERSION}
./configure --prefix=\${QP_ROOT} --without-hdf5 CFLAGS='-g'
(make -j 8 || make) && make check && make -j 8 install
make -j 8 && make -j 8 check && make -j 8 install
tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/${ARCHITECTURE}/ninja.tar.gz
mv ninja "\${QP_ROOT}"/bin/
EOF
@ -233,7 +233,7 @@ EOF
tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz
cd trexio-${VERSION}
./configure --prefix=\${QP_ROOT} CFLAGS="-g"
(make -j 8 || make) && make check && make -j 8 install
make -j 8 && make -j 8 check && make -j 8 install
EOF
elif [[ ${PACKAGE} = qmckl ]] ; then
@ -245,7 +245,7 @@ EOF
tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz
cd qmckl-${VERSION}
./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc CFLAGS='-g'
(make -j 8 || make) && make check && make install
make && make -j 4 check && make install
EOF
elif [[ ${PACKAGE} = qmckl-intel ]] ; then
@ -257,7 +257,7 @@ EOF
tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz
cd qmckl-${VERSION}
./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc --with-icc --with-ifort CFLAGS='-g'
(make -j 8 || make) && make check && make install
make && make -j 4 check && make install
EOF

2
docs/ref
View File

@ -20,5 +20,5 @@ Then, to reference for "myref" just type :ref:`myref`
or use `IRPF90`_ and define
_IRPF90: http://irpf90.ups-tlse.fr
somewhere
* References of published results with QP should be added into docs/source/references.bib in bibtex
* References of published results with QP should be added into docs/source/research.bib in bibtex
format

4
docs/requirements.txt
View File

@ -1,2 +1,2 @@
sphinxcontrib-bibtex
sphinx-rtd-theme
sphinxcontrib-bibtex==0.4.0
sphinx-rtd-theme==0.4.2

26
docs/source/appendix/contributors.rst
View File

@ -2,13 +2,13 @@
Contributors
============
The |qp| is maintained by
The |qp| is maintained by
Anthony Scemama
Anthony Scemama
| `Laboratoire de Chimie et Physique Quantiques <http://www.lcpq.ups-tlse.fr/>`_,
| CNRS - Université Paul Sabatier
| Toulouse, France
| scemama@irsamc.ups-tlse.fr
| scemama@irsamc.ups-tlse.fr
Emmanuel Giner
@ -18,27 +18,27 @@ Emmanuel Giner
| emmanuel.giner@lct.jussieu.fr
Thomas Applencourt
| `Argonne Leadership Computing Facility <http://www.alcf.anl.gov/>`_
| Argonne, USA
| tapplencourt@anl.gov
The following people have contributed to this project (by alphabetical order):
* Abdallah Ammar
* Thomas Applencourt
* Roland Assaraf
* Pierrette Barbaresco
* Anouar Benali
* Chandler Bennet
* Michel Caffarel
* Vijay Gopal Chilkuri
* Yann Damour
* Grégoire David
* Amanda Dumi
* Anthony Ferté
* Madeline Galbraith
* Madeline Galbraith
* Yann Garniron
* Kevin Gasperich
* Fabris Kossoski
* Pierre-François Loos
* Jean-Paul Malrieu
* Antoine Marie
* Barry Moore
* Julien Paquier
* Barthélémy Pradines
@ -46,11 +46,9 @@ The following people have contributed to this project (by alphabetical order):
* Nicolas Renon
* Lorenzo Tenti
* Julien Toulouse
* Diata Traoré
* Mikaël Véril
If you have contributed and don't appear in this list, please modify the file
`$QP_ROOT/docs/source/appendix/contributors.rst`
If you have contributed and don't appear in this list, please modify this file
and submit a pull request.

8
docs/source/appendix/references.rst
View File

@ -1,8 +0,0 @@
References
==========
.. bibliography:: /references.bib
:style: unsrt
:all:

8
docs/source/appendix/research.rst Normal file
View File

@ -0,0 +1,8 @@
Some research made with the |qp|
================================
.. bibliography:: /research.bib
:style: unsrt
:all:

3
docs/source/auto_generate.py
View File

@ -29,8 +29,7 @@ def generate_modules(abs_module, entities):
rst += ["", "EZFIO parameters", "----------------", ""]
config_file = configparser.ConfigParser()
with open(EZFIO, 'r') as f:
# config_file.readfp(f)
config_file.read_file(f)
config_file.readfp(f)
for section in config_file.sections():
doc = config_file.get(section, "doc")
doc = " " + doc.replace("\n", "\n\n ")+"\n"

4
docs/source/conf.py
View File

@ -70,7 +70,7 @@ master_doc = 'index'
#
# This is also used if you do content translation via gettext catalogs.
# Usually you set "language" from the command line for these cases.
language = "en"
language = None
# List of patterns, relative to source directory, that match files and
# directories to ignore when looking for source files.
@ -208,5 +208,3 @@ epub_exclude_files = ['search.html']
# -- Extension configuration -------------------------------------------------
bibtex_bibfiles = [ "references.bib" ]

4
docs/source/index.rst
View File

@ -39,10 +39,9 @@
programmers_guide/programming
programmers_guide/ezfio
programmers_guide/plugins
programmers_guide/plugins_tuto_intro
programmers_guide/plugins_tuto_I
programmers_guide/new_ks
programmers_guide/index
programmers_guide/plugins
.. toctree::
@ -53,6 +52,5 @@
appendix/benchmarks
appendix/license
appendix/contributors
appendix/references

32
docs/source/intro/intro.rst
View File

@ -11,25 +11,25 @@ The |qp|
What it is
==========
The |qp| is an open-source **programming environment** for quantum chemistry.
It has been built from the **developper** point of view in order to help
the design of new quantum chemistry methods,
especially for `wave function theory <https://en.wikipedia.org/wiki/Ab_initio_quantum_chemistry_methods>`_ (|WFT|).
The |qp| is an open-source **programming environment** for quantum chemistry.
It has been built from the **developper** point of view in order to help
the design of new quantum chemistry methods,
especially for `wave function theory <https://en.wikipedia.org/wiki/Ab_initio_quantum_chemistry_methods>`_ (|WFT|).
From the **user** point of view, the |qp| proposes a stand-alone path
to use optimized selected configuration interaction |sCI| based on the
|CIPSI| algorithm that can efficiently reach near-full configuration interaction
|FCI| quality for relatively large systems.
To have a simple example of how to use the |CIPSI| program, go to the `users_guide/quickstart`.
From the **user** point of view, the |qp| proposes a stand-alone path
to use optimized selected configuration interaction |sCI| based on the
|CIPSI| algorithm that can efficiently reach near-full configuration interaction
|FCI| quality for relatively large systems (see for instance :cite:`Caffarel_2016,Caffarel_2016.2,Loos_2018,Scemama_2018,Dash_2018,Garniron_2017.2,Loos_2018,Garniron_2018,Giner2018Oct`).
To have a simple example of how to use the |CIPSI| program, go to the `users_guide/quickstart`.
The main goal is the development of selected configuration interaction |sCI|
methods and multi-reference perturbation theory |MRPT| in the
determinant-driven paradigm. It also contains the very basics of Kohn-Sham `density functional theory <https://en.wikipedia.org/wiki/Density_functional_theory>`_ |KS-DFT| and `range-separated hybrids <https://aip.scitation.org/doi/10.1063/1.1383587>`_ |RSH|.
determinant-driven paradigm. It also contains the very basics of Kohn-Sham `density functional theory <https://en.wikipedia.org/wiki/Density_functional_theory>`_ |KS-DFT| and `range-separated hybrids <https://aip.scitation.org/doi/10.1063/1.1383587>`_ |RSH|.
The determinant-driven framework allows the programmer to include any arbitrary set of
determinants in the variational space, and thus gives a complete freedom in the methodological
development. The basic ingredients of |RSH| together with those of the |WFT| framework available in the |qp| library allows one to easily develop range-separated DFT (|RSDFT|) approaches (see for instance the plugins at `<https://gitlab.com/eginer/qp_plugins_eginer>`_).
The determinant-driven framework allows the programmer to include any arbitrary set of
determinants in the variational space, and thus gives a complete freedom in the methodological
development. The basic ingredients of |RSH| together with those of the |WFT| framework available in the |qp| library allows one to easily develop range-separated DFT (|RSDFT|) approaches (see for instance the plugins at `<https://gitlab.com/eginer/qp_plugins_eginer>`_).
All the programs are developed with the `IRPF90`_ code generator, which considerably simplifies
the collaborative development, and the development of new features.
@ -40,20 +40,20 @@ What it is not
==============
The |qp| is *not* a general purpose quantum chemistry program.
First of all, it is a *library* to develop new theories and algorithms in quantum chemistry.
First of all, it is a *library* to develop new theories and algorithms in quantum chemistry.
Therefore, beside the use of the programs of the core modules, the users of the |qp| should develop their own programs.
The |qp| has been designed specifically for |sCI|, so all the
algorithms which are programmed are not adapted to run SCF or DFT calculations
on thousands of atoms. Currently, the systems targeted have less than 600
molecular orbitals. This limit is due to the memory bottleneck induced by the storring of the two-electron integrals (see ``mo_two_e_integrals`` and ``ao_two_e_integrals``).
molecular orbitals. This limit is due to the memory bottleneck induced by the storring of the two-electron integrals (see ``mo_two_e_integrals`` and ``ao_two_e_integrals``).
The |qp| is *not* a massive production code. For conventional
methods such as Hartree-Fock, CISD or MP2, the users are recommended to use the
existing standard production codes which are designed to make these methods run
fast. Again, the role of the |qp| is to make life simple for the
developer. Once a new method is developed and tested, the developer is encouraged
to consider re-expressing it with an integral-driven formulation, and to
to consider re-expressing it with an integral-driven formulation, and to
implement the new method in open-source production codes, such as `NWChem`_
or |GAMESS|.

182
docs/source/intro/selected.bib Normal file
View File

@ -0,0 +1,182 @@
@article{Bytautas_2009,
doi = {10.1016/j.chemphys.2008.11.021},
url = {https://doi.org/10.1016%2Fj.chemphys.2008.11.021},
year = 2009,
month = {feb},
publisher = {Elsevier {BV}},
volume = {356},
number = {1-3},
pages = {64--75},
author = {Laimutis Bytautas and Klaus Ruedenberg},
title = {A priori identification of configurational deadwood},
journal = {Chemical Physics}
}
@article{Anderson_2018,
doi = {10.1016/j.comptc.2018.08.017},
url = {https://doi.org/10.1016%2Fj.comptc.2018.08.017},
year = 2018,
month = {oct},
publisher = {Elsevier {BV}},
volume = {1142},
pages = {66--77},
author = {James S.M. Anderson and Farnaz Heidar-Zadeh and Paul W. Ayers},
title = {Breaking the curse of dimension for the electronic Schrodinger equation with functional analysis},
journal = {Computational and Theoretical Chemistry}
}
@article{Bender_1969,
doi = {10.1103/physrev.183.23},
url = {http://dx.doi.org/10.1103/PhysRev.183.23},
year = 1969,
month = {jul},
publisher = {American Physical Society ({APS})},
volume = {183},
number = {1},
pages = {23--30},
author = {Charles F. Bender and Ernest R. Davidson},
title = {Studies in Configuration Interaction: The First-Row Diatomic Hydrides},
journal = {Phys. Rev.}
}
@article{Whitten_1969,
doi = {10.1063/1.1671985},
url = {https://doi.org/10.1063%2F1.1671985},
year = 1969,
month = {dec},
publisher = {{AIP} Publishing},
volume = {51},
number = {12},
pages = {5584--5596},
author = {J. L. Whitten and Melvyn Hackmeyer},
title = {Configuration Interaction Studies of Ground and Excited States of Polyatomic Molecules. I. The {CI} Formulation and Studies of Formaldehyde},
journal = {The Journal of Chemical Physics}
}
@article{Huron_1973,
doi = {10.1063/1.1679199},
url = {https://doi.org/10.1063%2F1.1679199},
year = 1973,
month = {jun},
publisher = {{AIP} Publishing},
volume = {58},
number = {12},
pages = {5745--5759},
author = {B. Huron and J. P. Malrieu and P. Rancurel},
title = {Iterative perturbation calculations of ground and excited state energies from multiconfigurational zeroth-order wavefunctions},
journal = {The Journal of Chemical Physics}
}
@article{Knowles_1984,
author="Peter J. Knowles and Nicholas C Handy",
year=1984,
journal={Chem. Phys. Letters},
volume=111,
pages="315--321",
title="A New Determinant-based Full Configuration Interaction Method"
}
@article{Scemama_2013,
author = {{Scemama}, A. and {Giner}, E.},
title = "{An efficient implementation of Slater-Condon rules}",
journal = {ArXiv [physics.comp-ph]},
pages = {1311.6244},
year = 2013,
month = nov,
url = {https://arxiv.org/abs/1311.6244}
}
@article{Sharma_2017,
doi = {10.1021/acs.jctc.6b01028},
url = {https://doi.org/10.1021%2Facs.jctc.6b01028},
year = 2017,
month = {mar},
publisher = {American Chemical Society ({ACS})},
volume = {13},
number = {4},
pages = {1595--1604},
author = {Sandeep Sharma and Adam A. Holmes and Guillaume Jeanmairet and Ali Alavi and C. J. Umrigar},
title = {Semistochastic Heat-Bath Configuration Interaction Method: Selected Configuration Interaction with Semistochastic Perturbation Theory},
journal = {Journal of Chemical Theory and Computation}
}
@article{Holmes_2016,
doi = {10.1021/acs.jctc.6b00407},
url = {https://doi.org/10.1021%2Facs.jctc.6b00407},
year = 2016,
month = {aug},
publisher = {American Chemical Society ({ACS})},
volume = {12},
number = {8},
pages = {3674--3680},
author = {Adam A. Holmes and Norm M. Tubman and C. J. Umrigar},
title = {Heat-Bath Configuration Interaction: An Efficient Selected Configuration Interaction Algorithm Inspired by Heat-Bath Sampling},
journal = {Journal of Chemical Theory and Computation}
}
@article{Evangelisti_1983,
doi = {10.1016/0301-0104(83)85011-3},
url = {https://doi.org/10.1016%2F0301-0104%2883%2985011-3},
year = 1983,
month = {feb},
publisher = {Elsevier {BV}},
volume = {75},
number = {1},
pages = {91--102},
author = {Stefano Evangelisti and Jean-Pierre Daudey and Jean-Paul Malrieu},
title = {Convergence of an improved {CIPSI} algorithm},
journal = {Chemical Physics}
}
@article{Booth_2009,
doi = {10.1063/1.3193710},
url = {https://doi.org/10.1063%2F1.3193710},
year = 2009,
publisher = {{AIP} Publishing},
volume = {131},
number = {5},
pages = {054106},
author = {George H. Booth and Alex J. W. Thom and Ali Alavi},
title = {Fermion Monte Carlo without fixed nodes: A game of life, death, and annihilation in Slater determinant space},
journal = {The Journal of Chemical Physics}
}
@article{Booth_2010,
doi = {10.1063/1.3407895},
url = {https://doi.org/10.1063%2F1.3407895},
year = 2010,
month = {may},
publisher = {{AIP} Publishing},
volume = {132},
number = {17},
pages = {174104},
author = {George H. Booth and Ali Alavi},
title = {Approaching chemical accuracy using full configuration-interaction quantum Monte Carlo: A study of ionization potentials},
journal = {The Journal of Chemical Physics}
}
@article{Cleland_2010,
doi = {10.1063/1.3302277},
url = {https://doi.org/10.1063%2F1.3302277},
year = 2010,
month = {jan},
publisher = {{AIP} Publishing},
volume = {132},
number = {4},
pages = {041103},
author = {Deidre Cleland and George H. Booth and Ali Alavi},
title = {Communications: Survival of the fittest: Accelerating convergence in full configuration-interaction quantum Monte Carlo},
journal = {The Journal of Chemical Physics}
}
@article{Garniron_2017b,
doi = {10.1063/1.4992127},
url = {https://doi.org/10.1063%2F1.4992127},
year = 2017,
month = {jul},
publisher = {{AIP} Publishing},
volume = {147},
number = {3},
pages = {034101},
author = {Yann Garniron and Anthony Scemama and Pierre-Fran{\c{c}}ois Loos and Michel Caffarel},
title = {Hybrid stochastic-deterministic calculation of the second-order perturbative contribution of multireference perturbation theory},
journal = {The Journal of Chemical Physics}
}

770
docs/source/modules/becke_numerical_grid.rst
View File

@ -99,71 +99,6 @@ EZFIO parameters
Default: 1.e-20
.. option:: my_grid_becke
if True, the number of angular and radial grid points are read from EZFIO
Default: False
.. option:: my_n_pt_r_grid
Number of radial grid points given from input
Default: 300
.. option:: my_n_pt_a_grid
Number of angular grid points given from input. Warning, this number cannot be any integer. See file list_angular_grid
Default: 1202
.. option:: n_points_extra_final_grid
Total number of extra_grid points
.. option:: extra_grid_type_sgn
Type of extra_grid used for the Becke's numerical extra_grid. Can be, by increasing accuracy: [ 0 | 1 | 2 | 3 ]
Default: 0
.. option:: thresh_extra_grid
threshold on the weight of a given extra_grid point
Default: 1.e-20
.. option:: my_extra_grid_becke
if True, the number of angular and radial extra_grid points are read from EZFIO
Default: False
.. option:: my_n_pt_r_extra_grid
Number of radial extra_grid points given from input
Default: 300
.. option:: my_n_pt_a_extra_grid
Number of angular extra_grid points given from input. Warning, this number cannot be any integer. See file list_angular_extra_grid
Default: 1202
.. option:: rad_grid_type
method used to sample the radial space. Possible choices are [KNOWLES | GILL]
Default: KNOWLES
.. option:: extra_rad_grid_type
method used to sample the radial space. Possible choices are [KNOWLES | GILL]
Default: KNOWLES
Providers
---------
@ -187,8 +122,6 @@ Providers
:columns: 3
* :c:data:`final_weight_at_r`
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`grid_points_per_atom`
@ -223,66 +156,6 @@ Providers
* :c:data:`grid_points_per_atom`
.. c:var:: angular_quadrature_points_extra
File : :file:`becke_numerical_grid/angular_extra_grid.irp.f`
.. code:: fortran
double precision, allocatable :: angular_quadrature_points_extra (n_points_extra_integration_angular,3)
double precision, allocatable :: weights_angular_points_extra (n_points_extra_integration_angular)
weights and grid points_extra for the integration on the angular variables on
the unit sphere centered on (0,0,0)
According to the LEBEDEV scheme
Needs:
.. hlist::
:columns: 3
* :c:data:`n_points_extra_radial_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
.. c:var:: dr_radial_extra_integral
File : :file:`becke_numerical_grid/extra_grid.irp.f`
.. code:: fortran
double precision, allocatable :: grid_points_extra_radial (n_points_extra_radial_grid)
double precision :: dr_radial_extra_integral
points_extra in [0,1] to map the radial integral [0,\infty]
Needs:
.. hlist::
:columns: 3
* :c:data:`n_points_extra_radial_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
.. c:var:: dr_radial_integral
@ -350,11 +223,6 @@ Providers
.. hlist::
:columns: 3
* :c:data:`ao_abs_int_grid`
* :c:data:`ao_overlap_abs_grid`
* :c:data:`ao_prod_abs_r`
* :c:data:`ao_prod_center`
* :c:data:`ao_prod_dist_grid`
* :c:data:`aos_grad_in_r_array`
* :c:data:`aos_in_r_array`
* :c:data:`aos_lapl_in_r_array`
@ -373,60 +241,11 @@ Providers
* :c:data:`energy_x_pbe`
* :c:data:`energy_x_sr_lda`
* :c:data:`energy_x_sr_pbe`
* :c:data:`f_psi_cas_ab`
* :c:data:`f_psi_hf_ab`
* :c:data:`final_grid_points_transp`
* :c:data:`mo_grad_ints`
* :c:data:`mos_in_r_array`
* :c:data:`mos_in_r_array_omp`
* :c:data:`mu_average_prov`
* :c:data:`mu_grad_rho`
* :c:data:`mu_of_r_dft_average`
* :c:data:`mu_rsc_of_r`
* :c:data:`one_e_dm_and_grad_alpha_in_r`
.. c:var:: final_grid_points_extra
File : :file:`becke_numerical_grid/extra_grid_vector.irp.f`
.. code:: fortran
double precision, allocatable :: final_grid_points_extra (3,n_points_extra_final_grid)
double precision, allocatable :: final_weight_at_r_vector_extra (n_points_extra_final_grid)
integer, allocatable :: index_final_points_extra (3,n_points_extra_final_grid)
integer, allocatable :: index_final_points_extra_reverse (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)
final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point
final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
Needs:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`n_points_extra_final_grid`
* :c:data:`n_points_extra_radial_grid`
* :c:data:`nucl_num`
* :c:data:`thresh_extra_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_extra`
.. c:var:: final_grid_points_per_atom
@ -453,28 +272,12 @@ Providers
* :c:data:`nucl_num`
* :c:data:`thresh_grid`
.. c:var:: final_grid_points_transp
File : :file:`becke_numerical_grid/grid_becke_vector.irp.f`
.. code:: fortran
double precision, allocatable :: final_grid_points_transp (n_points_final_grid,3)
Transposed final_grid_points
Needs:
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_grid_points`
* :c:data:`n_points_final_grid`
* :c:data:`aos_in_r_array_per_atom`
.. c:var:: final_weight_at_r
@ -501,8 +304,6 @@ Providers
* :c:data:`m_knowles`
* :c:data:`n_points_radial_grid`
* :c:data:`nucl_num`
* :c:data:`r_gill`
* :c:data:`rad_grid_type`
* :c:data:`weight_at_r`
Needed by:
@ -516,43 +317,6 @@ Providers
* :c:data:`n_pts_per_atom`
.. c:var:: final_weight_at_r_extra
File : :file:`becke_numerical_grid/extra_grid.irp.f`
.. code:: fortran
double precision, allocatable :: final_weight_at_r_extra (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)
Total weight on each grid point which takes into account all Lebedev, Voronoi and radial weights.
Needs:
.. hlist::
:columns: 3
* :c:data:`alpha_knowles`
* :c:data:`angular_quadrature_points_extra`
* :c:data:`extra_rad_grid_type`
* :c:data:`grid_atomic_number`
* :c:data:`grid_points_extra_radial`
* :c:data:`m_knowles`
* :c:data:`n_points_extra_radial_grid`
* :c:data:`nucl_num`
* :c:data:`r_gill`
* :c:data:`weight_at_r_extra`
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_grid_points_extra`
* :c:data:`n_points_extra_final_grid`
.. c:var:: final_weight_at_r_vector
@ -591,11 +355,6 @@ Providers
.. hlist::
:columns: 3
* :c:data:`ao_abs_int_grid`
* :c:data:`ao_overlap_abs_grid`
* :c:data:`ao_prod_abs_r`
* :c:data:`ao_prod_center`
* :c:data:`ao_prod_dist_grid`
* :c:data:`aos_grad_in_r_array`
* :c:data:`aos_in_r_array`
* :c:data:`aos_lapl_in_r_array`
@ -614,60 +373,11 @@ Providers
* :c:data:`energy_x_pbe`
* :c:data:`energy_x_sr_lda`
* :c:data:`energy_x_sr_pbe`
* :c:data:`f_psi_cas_ab`
* :c:data:`f_psi_hf_ab`
* :c:data:`final_grid_points_transp`
* :c:data:`mo_grad_ints`
* :c:data:`mos_in_r_array`
* :c:data:`mos_in_r_array_omp`
* :c:data:`mu_average_prov`
* :c:data:`mu_grad_rho`
* :c:data:`mu_of_r_dft_average`
* :c:data:`mu_rsc_of_r`
* :c:data:`one_e_dm_and_grad_alpha_in_r`
.. c:var:: final_weight_at_r_vector_extra
File : :file:`becke_numerical_grid/extra_grid_vector.irp.f`
.. code:: fortran
double precision, allocatable :: final_grid_points_extra (3,n_points_extra_final_grid)
double precision, allocatable :: final_weight_at_r_vector_extra (n_points_extra_final_grid)
integer, allocatable :: index_final_points_extra (3,n_points_extra_final_grid)
integer, allocatable :: index_final_points_extra_reverse (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)
final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point
final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
Needs:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`n_points_extra_final_grid`
* :c:data:`n_points_extra_radial_grid`
* :c:data:`nucl_num`
* :c:data:`thresh_extra_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_extra`
.. c:var:: final_weight_at_r_vector_per_atom
@ -694,6 +404,12 @@ Providers
* :c:data:`nucl_num`
* :c:data:`thresh_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_per_atom`
.. c:var:: grid_atomic_number
@ -722,77 +438,9 @@ Providers
:columns: 3
* :c:data:`final_weight_at_r`
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`grid_points_per_atom`
.. c:var:: grid_points_extra_per_atom
File : :file:`becke_numerical_grid/extra_grid.irp.f`
.. code:: fortran
double precision, allocatable :: grid_points_extra_per_atom (3,n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)
x,y,z coordinates of grid points_extra used for integration in 3d space
Needs:
.. hlist::
:columns: 3
* :c:data:`alpha_knowles`
* :c:data:`angular_quadrature_points_extra`
* :c:data:`extra_rad_grid_type`
* :c:data:`grid_atomic_number`
* :c:data:`grid_points_extra_radial`
* :c:data:`m_knowles`
* :c:data:`n_points_extra_radial_grid`
* :c:data:`nucl_coord`
* :c:data:`nucl_num`
* :c:data:`r_gill`
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_grid_points_extra`
* :c:data:`weight_at_r_extra`
.. c:var:: grid_points_extra_radial
File : :file:`becke_numerical_grid/extra_grid.irp.f`
.. code:: fortran
double precision, allocatable :: grid_points_extra_radial (n_points_extra_radial_grid)
double precision :: dr_radial_extra_integral
points_extra in [0,1] to map the radial integral [0,\infty]
Needs:
.. hlist::
:columns: 3
* :c:data:`n_points_extra_radial_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
.. c:var:: grid_points_per_atom
@ -818,8 +466,6 @@ Providers
* :c:data:`n_points_radial_grid`
* :c:data:`nucl_coord`
* :c:data:`nucl_num`
* :c:data:`r_gill`
* :c:data:`rad_grid_type`
Needed by:
@ -898,11 +544,6 @@ Providers
.. hlist::
:columns: 3
* :c:data:`ao_abs_int_grid`
* :c:data:`ao_overlap_abs_grid`
* :c:data:`ao_prod_abs_r`
* :c:data:`ao_prod_center`
* :c:data:`ao_prod_dist_grid`
* :c:data:`aos_grad_in_r_array`
* :c:data:`aos_in_r_array`
* :c:data:`aos_lapl_in_r_array`
@ -921,101 +562,11 @@ Providers
* :c:data:`energy_x_pbe`
* :c:data:`energy_x_sr_lda`
* :c:data:`energy_x_sr_pbe`
* :c:data:`f_psi_cas_ab`
* :c:data:`f_psi_hf_ab`
* :c:data:`final_grid_points_transp`
* :c:data:`mo_grad_ints`
* :c:data:`mos_in_r_array`
* :c:data:`mos_in_r_array_omp`
* :c:data:`mu_average_prov`
* :c:data:`mu_grad_rho`
* :c:data:`mu_of_r_dft_average`
* :c:data:`mu_rsc_of_r`
* :c:data:`one_e_dm_and_grad_alpha_in_r`
.. c:var:: index_final_points_extra
File : :file:`becke_numerical_grid/extra_grid_vector.irp.f`
.. code:: fortran
double precision, allocatable :: final_grid_points_extra (3,n_points_extra_final_grid)
double precision, allocatable :: final_weight_at_r_vector_extra (n_points_extra_final_grid)
integer, allocatable :: index_final_points_extra (3,n_points_extra_final_grid)
integer, allocatable :: index_final_points_extra_reverse (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)
final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point
final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
Needs:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`n_points_extra_final_grid`
* :c:data:`n_points_extra_radial_grid`
* :c:data:`nucl_num`
* :c:data:`thresh_extra_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_extra`
.. c:var:: index_final_points_extra_reverse
File : :file:`becke_numerical_grid/extra_grid_vector.irp.f`
.. code:: fortran
double precision, allocatable :: final_grid_points_extra (3,n_points_extra_final_grid)
double precision, allocatable :: final_weight_at_r_vector_extra (n_points_extra_final_grid)
integer, allocatable :: index_final_points_extra (3,n_points_extra_final_grid)
integer, allocatable :: index_final_points_extra_reverse (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)
final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point
final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
Needs:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`n_points_extra_final_grid`
* :c:data:`n_points_extra_radial_grid`
* :c:data:`nucl_num`
* :c:data:`thresh_extra_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_extra`
.. c:var:: index_final_points_per_atom
@ -1042,6 +593,12 @@ Providers
* :c:data:`nucl_num`
* :c:data:`thresh_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_per_atom`
.. c:var:: index_final_points_per_atom_reverse
@ -1070,6 +627,12 @@ Providers
* :c:data:`nucl_num`
* :c:data:`thresh_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_per_atom`
.. c:var:: index_final_points_reverse
@ -1110,11 +673,6 @@ Providers
.. hlist::
:columns: 3
* :c:data:`ao_abs_int_grid`
* :c:data:`ao_overlap_abs_grid`
* :c:data:`ao_prod_abs_r`
* :c:data:`ao_prod_center`
* :c:data:`ao_prod_dist_grid`
* :c:data:`aos_grad_in_r_array`
* :c:data:`aos_in_r_array`
* :c:data:`aos_lapl_in_r_array`
@ -1133,16 +691,8 @@ Providers
* :c:data:`energy_x_pbe`
* :c:data:`energy_x_sr_lda`
* :c:data:`energy_x_sr_pbe`
* :c:data:`f_psi_cas_ab`
* :c:data:`f_psi_hf_ab`
* :c:data:`final_grid_points_transp`
* :c:data:`mo_grad_ints`
* :c:data:`mos_in_r_array`
* :c:data:`mos_in_r_array_omp`
* :c:data:`mu_average_prov`
* :c:data:`mu_grad_rho`
* :c:data:`mu_of_r_dft_average`
* :c:data:`mu_rsc_of_r`
* :c:data:`one_e_dm_and_grad_alpha_in_r`
@ -1164,148 +714,9 @@ Providers
:columns: 3
* :c:data:`final_weight_at_r`
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`grid_points_per_atom`
.. c:var:: n_points_extra_final_grid
File : :file:`becke_numerical_grid/extra_grid_vector.irp.f`
.. code:: fortran
integer :: n_points_extra_final_grid
Number of points_extra which are non zero
Needs:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`n_points_extra_radial_grid`
* :c:data:`nucl_num`
* :c:data:`thresh_extra_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_extra`
* :c:data:`aos_in_r_array_extra_transp`
* :c:data:`final_grid_points_extra`
.. c:var:: n_points_extra_grid_per_atom
File : :file:`becke_numerical_grid/extra_grid.irp.f`
.. code:: fortran
integer :: n_points_extra_grid_per_atom
Number of grid points_extra per atom
Needs:
.. hlist::
:columns: 3
* :c:data:`n_points_extra_radial_grid`
.. c:var:: n_points_extra_integration_angular
File : :file:`becke_numerical_grid/extra_grid.irp.f`
.. code:: fortran
integer :: n_points_extra_radial_grid
integer :: n_points_extra_integration_angular
n_points_extra_radial_grid = number of radial grid points_extra per atom
n_points_extra_integration_angular = number of angular grid points_extra per atom
These numbers are automatically set by setting the grid_type_sgn parameter
Needs:
.. hlist::
:columns: 3
* :c:data:`extra_grid_type_sgn`
* :c:data:`my_extra_grid_becke`
* :c:data:`my_n_pt_a_extra_grid`
* :c:data:`my_n_pt_r_extra_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`angular_quadrature_points_extra`
* :c:data:`final_grid_points_extra`
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`grid_points_extra_radial`
* :c:data:`n_points_extra_final_grid`
* :c:data:`n_points_extra_grid_per_atom`
* :c:data:`weight_at_r_extra`
.. c:var:: n_points_extra_radial_grid
File : :file:`becke_numerical_grid/extra_grid.irp.f`
.. code:: fortran
integer :: n_points_extra_radial_grid
integer :: n_points_extra_integration_angular
n_points_extra_radial_grid = number of radial grid points_extra per atom
n_points_extra_integration_angular = number of angular grid points_extra per atom
These numbers are automatically set by setting the grid_type_sgn parameter
Needs:
.. hlist::
:columns: 3
* :c:data:`extra_grid_type_sgn`
* :c:data:`my_extra_grid_becke`
* :c:data:`my_n_pt_a_extra_grid`
* :c:data:`my_n_pt_r_extra_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`angular_quadrature_points_extra`
* :c:data:`final_grid_points_extra`
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`grid_points_extra_radial`
* :c:data:`n_points_extra_final_grid`
* :c:data:`n_points_extra_grid_per_atom`
* :c:data:`weight_at_r_extra`
.. c:var:: n_points_final_grid
@ -1333,17 +744,9 @@ Providers
.. hlist::
:columns: 3
* :c:data:`act_mos_in_r_array`
* :c:data:`alpha_dens_kin_in_r`
* :c:data:`ao_abs_int_grid`
* :c:data:`ao_overlap_abs_grid`
* :c:data:`ao_prod_abs_r`
* :c:data:`ao_prod_center`
* :c:data:`ao_prod_dist_grid`
* :c:data:`aos_grad_in_r_array`
* :c:data:`aos_grad_in_r_array_transp`
* :c:data:`aos_grad_in_r_array_transp_3`
* :c:data:`aos_grad_in_r_array_transp_bis`
* :c:data:`aos_in_r_array`
* :c:data:`aos_in_r_array_transp`
* :c:data:`aos_lapl_in_r_array`
@ -1356,14 +759,6 @@ Providers
* :c:data:`aos_vxc_alpha_lda_w`
* :c:data:`aos_vxc_alpha_pbe_w`
* :c:data:`aos_vxc_alpha_sr_pbe_w`
* :c:data:`basis_mos_in_r_array`
* :c:data:`core_density`
* :c:data:`core_inact_act_mos_grad_in_r_array`
* :c:data:`core_inact_act_mos_in_r_array`
* :c:data:`core_inact_act_v_kl_contracted`
* :c:data:`core_mos_in_r_array`
* :c:data:`effective_alpha_dm`
* :c:data:`effective_spin_dm`
* :c:data:`elec_beta_num_grid_becke`
* :c:data:`energy_c_lda`
* :c:data:`energy_c_sr_lda`
@ -1371,39 +766,14 @@ Providers
* :c:data:`energy_x_pbe`
* :c:data:`energy_x_sr_lda`
* :c:data:`energy_x_sr_pbe`
* :c:data:`f_psi_cas_ab`
* :c:data:`f_psi_cas_ab_old`
* :c:data:`f_psi_hf_ab`
* :c:data:`final_grid_points`
* :c:data:`final_grid_points_transp`
* :c:data:`full_occ_2_rdm_cntrctd`
* :c:data:`full_occ_2_rdm_cntrctd_trans`
* :c:data:`full_occ_v_kl_cntrctd`
* :c:data:`grad_total_cas_on_top_density`
* :c:data:`inact_density`
* :c:data:`inact_mos_in_r_array`
* :c:data:`kinetic_density_generalized`
* :c:data:`mo_grad_ints`
* :c:data:`mos_grad_in_r_array`
* :c:data:`mos_grad_in_r_array_tranp`
* :c:data:`mos_grad_in_r_array_transp_3`
* :c:data:`mos_grad_in_r_array_transp_bis`
* :c:data:`mos_in_r_array`
* :c:data:`mos_in_r_array_omp`
* :c:data:`mos_in_r_array_transp`
* :c:data:`mos_lapl_in_r_array`
* :c:data:`mos_lapl_in_r_array_tranp`
* :c:data:`mu_average_prov`
* :c:data:`mu_grad_rho`
* :c:data:`mu_of_r_dft`
* :c:data:`mu_of_r_dft_average`
* :c:data:`mu_of_r_hf`
* :c:data:`mu_of_r_prov`
* :c:data:`mu_of_r_psi_cas`
* :c:data:`mu_rsc_of_r`
* :c:data:`one_e_act_density_alpha`
* :c:data:`one_e_act_density_beta`
* :c:data:`one_e_cas_total_density`
* :c:data:`one_e_dm_and_grad_alpha_in_r`
* :c:data:`pot_grad_x_alpha_ao_pbe`
* :c:data:`pot_grad_x_alpha_ao_sr_pbe`
@ -1419,8 +789,6 @@ Providers
* :c:data:`potential_x_alpha_ao_sr_lda`
* :c:data:`potential_xc_alpha_ao_lda`
* :c:data:`potential_xc_alpha_ao_sr_lda`
* :c:data:`total_cas_on_top_density`
* :c:data:`virt_mos_in_r_array`
.. c:var:: n_points_grid_per_atom
@ -1560,6 +928,7 @@ Providers
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_per_atom`
* :c:data:`final_grid_points_per_atom`
@ -1591,31 +960,10 @@ Providers
.. hlist::
:columns: 3
* :c:data:`aos_in_r_array_per_atom`
* :c:data:`final_grid_points_per_atom`
.. c:var:: r_gill
File : :file:`becke_numerical_grid/grid_becke.irp.f`
.. code:: fortran
double precision :: r_gill
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r`
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
* :c:data:`grid_points_per_atom`
.. c:var:: weight_at_r
@ -1653,43 +1001,6 @@ Providers
* :c:data:`final_weight_at_r`
.. c:var:: weight_at_r_extra
File : :file:`becke_numerical_grid/extra_grid.irp.f`
.. code:: fortran
double precision, allocatable :: weight_at_r_extra (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)
Weight function at grid points_extra : w_n(r) according to the equation (22)
of Becke original paper (JCP, 88, 1988)
The "n" discrete variable represents the nucleis which in this array is
represented by the last dimension and the points_extra are labelled by the
other dimensions.
Needs:
.. hlist::
:columns: 3
* :c:data:`grid_points_extra_per_atom`
* :c:data:`n_points_extra_radial_grid`
* :c:data:`nucl_coord_transp`
* :c:data:`nucl_dist_inv`
* :c:data:`nucl_num`
* :c:data:`slater_bragg_type_inter_distance_ua`
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
.. c:var:: weights_angular_points
@ -1721,37 +1032,6 @@ Providers
* :c:data:`grid_points_per_atom`
.. c:var:: weights_angular_points_extra
File : :file:`becke_numerical_grid/angular_extra_grid.irp.f`
.. code:: fortran
double precision, allocatable :: angular_quadrature_points_extra (n_points_extra_integration_angular,3)
double precision, allocatable :: weights_angular_points_extra (n_points_extra_integration_angular)
weights and grid points_extra for the integration on the angular variables on
the unit sphere centered on (0,0,0)
According to the LEBEDEV scheme
Needs:
.. hlist::
:columns: 3
* :c:data:`n_points_extra_radial_grid`
Needed by:
.. hlist::
:columns: 3
* :c:data:`final_weight_at_r_extra`
* :c:data:`grid_points_extra_per_atom`
Subroutines / functions
-----------------------
@ -1763,7 +1043,7 @@ Subroutines / functions
.. code:: fortran
double precision function cell_function_becke(r, atom_number)
double precision function cell_function_becke(r,atom_number)
atom_number :: atom on which the cell function of Becke (1988, JCP,88(4))
@ -1787,7 +1067,7 @@ Subroutines / functions
.. code:: fortran
double precision function derivative_knowles_function(alpha, m, x)
double precision function derivative_knowles_function(alpha,m,x)
Derivative of the function proposed by Knowles (JCP, 104, 1996) for distributing the radial points
@ -1838,7 +1118,7 @@ Subroutines / functions
.. code:: fortran
double precision function knowles_function(alpha, m, x)
double precision function knowles_function(alpha,m,x)
Function proposed by Knowles (JCP, 104, 1996) for distributing the radial points :

2
docs/source/modules/cipsi.rst
View File

@ -21,7 +21,7 @@ The :c:func:`run_cipsi` subroutine iteratively:
* If :option:`determinants s2_eig` is |true|, it adds all the necessary
determinants to allow the eigenstates of |H| to be eigenstates of |S^2|
* Diagonalizes |H| in the enlarged internal space
* Computes the |PT2| contribution to the energy stochastically :cite:`Garniron_2017b`
* Computes the |PT2| contribution to the energy stochastically :cite:`Garniron_2017.2`
or deterministically, depending on :option:`perturbation do_pt2`
* Extrapolates the variational energy by fitting
:math:`E=E_\text{FCI} - \alpha\, E_\text{PT2}`

1
docs/source/programmers_guide/plugins_tuto_I.rst
View File

@ -1 +0,0 @@
.. include:: ../../../plugins/local/tuto_plugins/tuto_I/tuto_I.rst

1
docs/source/programmers_guide/plugins_tuto_intro.rst
View File

@ -1 +0,0 @@
.. include:: ../../../plugins/README.rst

847
docs/source/references.bib
View File

@ -1,847 +0,0 @@
@article{Ammar_2023,
author = {Ammar, Abdallah and Scemama, Anthony and Giner, Emmanuel},
title = {{Transcorrelated selected configuration interaction in a bi-orthonormal basis and with a cheap three-body correlation factor}},
journal = {J. Chem. Phys.},
volume = {159},
number = {11},
year = {2023},
month = sep,
issn = {0021-9606},
publisher = {AIP Publishing},
doi = {10.1063/5.0163831}
}
@article{Ammar_2023.2,
author = {Ammar, Abdallah and Scemama, Anthony and Giner, Emmanuel},
title = {{Biorthonormal Orbital Optimization with a Cheap Core-Electron-Free Three-Body Correlation Factor for Quantum Monte Carlo and Transcorrelation}},
journal = {J. Chem. Theory Comput.},
volume = {19},
number = {15},
pages = {4883--4896},
year = {2023},
month = aug,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.3c00257}
}
@article{Damour_2023,
author = {Damour, Yann and Quintero-Monsebaiz, Ra{\'{u}}l and Caffarel, Michel and Jacquemin, Denis and Kossoski, F{\'{a}}bris and Scemama, Anthony and Loos, Pierre-Fran{\c{c}}ois},
title = {{Ground- and Excited-State Dipole Moments and Oscillator Strengths of Full Configuration Interaction Quality}},
journal = {J. Chem. Theory Comput.},
volume = {19},
number = {1},
pages = {221--234},
year = {2023},
month = jan,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.2c01111}
}
@article{Ammar_2022,
author = {Ammar, Abdallah and Scemama, Anthony and Giner, Emmanuel},
title = {{Extension of selected configuration interaction for transcorrelated methods}},
journal = {J. Chem. Phys.},
volume = {157},
number = {13},
year = {2022},
month = oct,
issn = {0021-9606},
publisher = {AIP Publishing},
doi = {10.1063/5.0115524}
}
@article{Ammar_2022.2,
author = {Ammar, Abdallah and Giner, Emmanuel and Scemama, Anthony},
title = {{Optimization of Large Determinant Expansions in Quantum Monte Carlo}},
journal = {J. Chem. Theory Comput.},
volume = {18},
number = {9},
pages = {5325--5336},
year = {2022},
month = sep,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.2c00556}
}
@article{Monino_2022,
author = {Monino, Enzo and Boggio-Pasqua, Martial and Scemama, Anthony and Jacquemin, Denis and Loos, Pierre-Fran{\c{c}}ois},
title = {{Reference Energies for Cyclobutadiene: Automerization and Excited States}},
journal = {J. Phys. Chem. A},
volume = {126},
number = {28},
pages = {4664--4679},
year = {2022},
month = jul,
issn = {1089-5639},
publisher = {American Chemical Society},
doi = {10.1021/acs.jpca.2c02480}
}
@article{Cuzzocrea_2022,
author = {Cuzzocrea, Alice and Moroni, Saverio and Scemama, Anthony and Filippi, Claudia},
title = {{Reference Excitation Energies of Increasingly Large Molecules: A QMC Study of Cyanine Dyes}},
journal = {J. Chem. Theory Comput.},
volume = {18},
number = {2},
pages = {1089--1095},
year = {2022},
month = feb,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.1c01162}
}
@article{Damour_2021,
author = {Damour, Yann and V{\'{e}}ril, Micka{\"{e}}l and Kossoski, F{\'{a}}bris and Caffarel, Michel and Jacquemin, Denis and Scemama, Anthony and Loos, Pierre-Fran{\c{c}}ois},
title = {{Accurate full configuration interaction correlation energy estimates for five- and six-membered rings}},
journal = {J. Chem. Phys.},
volume = {155},
number = {13},
year = {2021},
month = oct,
issn = {0021-9606},
publisher = {AIP Publishing},
doi = {10.1063/5.0065314}
}
@article{Veril_2021,
author = {V{\'{e}}ril, Micka{\"{e}}l and Scemama, Anthony and Caffarel, Michel and Lipparini, Filippo and Boggio-Pasqua, Martial and Jacquemin, Denis and Loos, Pierre-Fran{\c{c}}ois},
title = {{QUESTDB: A database of highly accurate excitation energies for the electronic structure community}},
journal = {WIREs Comput. Mol. Sci.},
volume = {11},
number = {5},
pages = {e1517},
year = {2021},
month = sep,
issn = {1759-0876},
publisher = {John Wiley {\&} Sons, Ltd},
doi = {10.1002/wcms.1517}
}
@article{Kossoski_2021,
author = {Kossoski, F{\'{a}}bris and Marie, Antoine and Scemama, Anthony and Caffarel, Michel and Loos, Pierre-Fran{\c{c}}ois},
title = {{Excited States from State-Specific Orbital-Optimized Pair Coupled Cluster}},
journal = {J. Chem. Theory Comput.},
volume = {17},
number = {8},
pages = {4756--4768},
year = {2021},
month = aug,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.1c00348}
}
@article{Dash_2021,
author = {Dash, Monika and Moroni, Saverio and Filippi, Claudia and Scemama, Anthony},
title = {{Tailoring CIPSI Expansions for QMC Calculations of Electronic Excitations: The Case Study of Thiophene}},
journal = {J. Chem. Theory Comput.},
volume = {17},
number = {6},
pages = {3426--3434},
year = {2021},
month = jun,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.1c00212}
}
@article{Loos_2020,
author = {Loos, Pierre-Fran{\c{c}}ois and Lipparini, Filippo and Boggio-Pasqua, Martial and Scemama, Anthony and Jacquemin, Denis},
title = {{A Mountaineering Strategy to Excited States: Highly Accurate Energies and Benchmarks for Medium Sized Molecules}},
journal = {J. Chem. Theory Comput.},
volume = {16},
number = {3},
pages = {1711--1741},
year = {2020},
month = mar,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.9b01216}
}
@article{Loos_2020.2,
author = {Loos, Pierre-Fran{\c{c}}ois and Pradines, Barth{\'{e}}l{\'{e}}my and Scemama, Anthony and Giner, Emmanuel and Toulouse, Julien},
title = {{Density-Based Basis-Set Incompleteness Correction for GW Methods}},
journal = {J. Chem. Theory Comput.},
volume = {16},
number = {2},
pages = {1018--1028},
year = {2020},
month = feb,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.9b01067}
}
@article{Loos_2020.3,
author = {Loos, Pierre-Fran{\c{c}}ois and Scemama, Anthony and Jacquemin, Denis},
title = {{The Quest for Highly Accurate Excitation Energies: A Computational Perspective}},
journal = {J. Phys. Chem. Lett.},
volume = {11},
number = {6},
pages = {2374--2383},
year = {2020},
month = mar,
publisher = {American Chemical Society},
doi = {10.1021/acs.jpclett.0c00014}
}
@article{Giner_2020,
author = {Giner, Emmanuel and Scemama, Anthony and Loos, Pierre-Fran{\c{c}}ois and Toulouse, Julien},
title = {{A basis-set error correction based on density-functional theory for strongly correlated molecular systems}},
journal = {J. Chem. Phys.},
volume = {152},
number = {17},
year = {2020},
month = may,
issn = {0021-9606},
publisher = {AIP Publishing},
doi = {10.1063/5.0002892}
}
@article{Loos_2020.4,
author = {Loos, Pierre-Fran{\c{c}}ois and Scemama, Anthony and Boggio-Pasqua, Martial and Jacquemin, Denis},
title = {{Mountaineering Strategy to Excited States: Highly Accurate Energies and Benchmarks for Exotic Molecules and Radicals}},
journal = {J. Chem. Theory Comput.},
volume = {16},
number = {6},
pages = {3720--3736},
year = {2020},
month = jun,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.0c00227}
}
@article{Benali_2020,
author = {Benali, Anouar and Gasperich, Kevin and Jordan, Kenneth D. and Applencourt, Thomas and Luo, Ye and Bennett, M. Chandler and Krogel, Jaron T. and Shulenburger, Luke and Kent, Paul R. C. and Loos, Pierre-Fran{\c{c}}ois and Scemama, Anthony and Caffarel, Michel},
title = {{Toward a systematic improvement of the fixed-node approximation in diffusion Monte Carlo for solids{\textemdash}A case study in diamond}},
journal = {J. Chem. Phys.},
volume = {153},
number = {18},
year = {2020},
month = nov,
issn = {0021-9606},
publisher = {AIP Publishing},
doi = {10.1063/5.0021036}
}
@article{Scemama_2020,
author = {Scemama, Anthony and Giner, Emmanuel and Benali, Anouar and Loos, Pierre-Fran{\c{c}}ois},
title = {{Taming the fixed-node error in diffusion Monte Carlo via range separation}},
journal = {J. Chem. Phys.},
volume = {153},
number = {17},
year = {2020},
month = nov,
issn = {0021-9606},
publisher = {AIP Publishing},
doi = {10.1063/5.0026324}
}
@article{Loos_2020.5,
author = {Loos, Pierre-Fran{\c{c}}ois and Damour, Yann and Scemama, Anthony},
title = {{The performance of CIPSI on the ground state electronic energy of benzene}},
journal = {J. Chem. Phys.},
volume = {153},
number = {17},
year = {2020},
month = nov,
issn = {0021-9606},
publisher = {AIP Publishing},
doi = {10.1063/5.0027617}
}
@article{Loos_2019,
author = {Loos, Pierre-Fran{\c{c}}ois and Pradines, Barth{\'{e}}l{\'{e}}my and Scemama, Anthony and Toulouse, Julien and Giner, Emmanuel},
title = {{A Density-Based Basis-Set Correction for Wave Function Theory}},
journal = {J. Phys. Chem. Lett.},
volume = {10},
number = {11},
pages = {2931--2937},
year = {2019},
month = jun,
publisher = {American Chemical Society},
doi = {10.1021/acs.jpclett.9b01176}
}
@article{Dash_2019,
author = {Dash, Monika and Feldt, Jonas and Moroni, Saverio and Scemama, Anthony and Filippi, Claudia},
title = {{Excited States with Selected Configuration Interaction-Quantum Monte Carlo: Chemically Accurate Excitation Energies and Geometries}},
journal = {J. Chem. Theory Comput.},
volume = {15},
number = {9},
pages = {4896--4906},
year = {2019},
month = sep,
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.9b00476}
}
@article{Burton2019May,
author = {Burton, Hugh G. A. and Thom, Alex J. W.},
title = {{A General Approach for Multireference Ground and Excited States using Non-Orthogonal Configuration Interaction}},
journal = {arXiv},
year = {2019},
month = {May},
eprint = {1905.02626},
url = {https://arxiv.org/abs/1905.02626}
}
@article{Giner_2019,
author = {Giner, Emmanuel and Scemama, Anthony and Toulouse, Julien and Loos, Pierre-Fran{\c{c}}ois},
title = {{Chemically accurate excitation energies with small basis sets}},
journal = {J. Chem. Phys.},
volume = {151},
number = {14},
year = {2019},
month = oct,
issn = {0021-9606},
publisher = {AIP Publishing},
doi = {10.1063/1.5122976}
}
@article{Garniron_2019,
doi = {10.1021/acs.jctc.9b00176},
url = {https://doi.org/10.1021%2Facs.jctc.9b00176},
year = 2019,
month = {may},
publisher = {American Chemical Society ({ACS})},
author = {Yann Garniron and Thomas Applencourt and Kevin Gasperich and Anouar Benali and Anthony Ferte and Julien Paquier and Bartélémy Pradines and Roland Assaraf and Peter Reinhardt and Julien Toulouse and Pierrette Barbaresco and Nicolas Renon and Gregoire David and Jean-Paul Malrieu and Mickael Veril and Michel Caffarel and Pierre-Francois Loos and Emmanuel Giner and Anthony Scemama},
title = {Quantum Package 2.0: An Open-Source Determinant-Driven Suite of Programs},
journal = {Journal of Chemical Theory and Computation}
}
@article{Scemama_2019,
doi = {10.1016/j.rechem.2019.100002},
url = {https://doi.org/10.1016%2Fj.rechem.2019.100002},
year = 2019,
month = {may},
publisher = {Elsevier {BV}},
pages = {100002},
author = {Anthony Scemama and Michel Caffarel and Anouar Benali and Denis Jacquemin and Pierre-Fran{\c{c}}ois Loos},
title = {Influence of pseudopotentials on excitation energies from selected configuration interaction and diffusion Monte Carlo},
journal = {Results in Chemistry}
}
@article{Applencourt2018Dec,
author = {Applencourt, Thomas and Gasperich, Kevin and Scemama, Anthony},
title = {{Spin adaptation with determinant-based selected configuration interaction}},
journal = {arXiv},
year = {2018},
month = {Dec},
eprint = {1812.06902},
url = {https://arxiv.org/abs/1812.06902}
}
@article{Loos2019Mar,
author = {Loos, Pierre-Fran\c{c}ois and Boggio-Pasqua, Martial and Scemama, Anthony and Caffarel, Michel and Jacquemin, Denis},
title = {{Reference Energies for Double Excitations}},
journal = {J. Chem. Theory Comput.},
volume = {15},
number = {3},
pages = {1939--1956},
year = {2019},
month = {Mar},
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.8b01205}
}
@article{PinedaFlores2019Feb,
author = {Pineda Flores, Sergio and Neuscamman, Eric},
title = {{Excited State Specific Multi-Slater Jastrow Wave Functions}},
journal = {J. Phys. Chem. A},
volume = {123},
number = {8},
pages = {1487--1497},
year = {2019},
month = {Feb},
issn = {1089-5639},
publisher = {American Chemical Society},
doi = {10.1021/acs.jpca.8b10671}
}
@phdthesis{yann_garniron_2019_2558127,
author = {Yann Garniron},
title = {{Development and parallel implementation of
selected configuration interaction methods}},
school = {Université de Toulouse},
year = 2019,
month = feb,
doi = {10.5281/zenodo.2558127},
url = {https://doi.org/10.5281/zenodo.2558127}
}
@article{Giner_2018,
doi = {10.1063/1.5052714},
url = {https://doi.org/10.1063%2F1.5052714},
year = 2018,
month = {nov},
publisher = {{AIP} Publishing},
volume = {149},
number = {19},
pages = {194301},
author = {Emmanuel Giner and Barth{\'{e}}lemy Pradines and Anthony Fert{\'{e}} and Roland Assaraf and Andreas Savin and Julien Toulouse},
title = {Curing basis-set convergence of wave-function theory using density-functional theory: A systematically improvable approach},
journal = {The Journal of Chemical Physics}
}
@article{Giner2018Oct,
author = {Giner, Emmanuel and Tew, David and Garniron, Yann and Alavi, Ali},
title = {{Interplay between electronic correlation and metal-ligand delocalization in the spectroscopy of transition metal compounds: case study on a series of planar Cu2+complexes.}},
journal = {J. Chem. Theory Comput.},
year = {2018},
month = {Oct},
issn = {1549-9618},
publisher = {American Chemical Society},
doi = {10.1021/acs.jctc.8b00591}
}
@article{Loos_2018,
doi = {10.1021/acs.jctc.8b00406},
url = {https://doi.org/10.1021%2Facs.jctc.8b00406},
year = 2018,
month = {jul},
publisher = {American Chemical Society ({ACS})},
volume = {14},
number = {8},
pages = {4360--4379},
author = {Pierre-Fran{\c{c}}ois Loos and Anthony Scemama and Aymeric Blondel and Yann Garniron and Michel Caffarel and Denis Jacquemin},
title = {A Mountaineering Strategy to Excited States: Highly Accurate Reference Energies and Benchmarks},
journal = {Journal of Chemical Theory and Computation}
}
@article{Scemama_2018,
doi = {10.1021/acs.jctc.7b01250},
url = {https://doi.org/10.1021%2Facs.jctc.7b01250},
year = 2018,
month = {jan},
publisher = {American Chemical Society ({ACS})},
volume = {14},
number = {3},
pages = {1395--1402},
author = {Anthony Scemama and Yann Garniron and Michel Caffarel and Pierre-Fran{\c{c}}ois Loos},
title = {Deterministic Construction of Nodal Surfaces within Quantum Monte Carlo: The Case of {FeS}},
journal = {Journal of Chemical Theory and Computation}
}
@article{Scemama_2018.2,
doi = {10.1063/1.5041327},
url = {https://doi.org/10.1063%2F1.5041327},
year = 2018,
month = {jul},
publisher = {{AIP} Publishing},
volume = {149},
number = {3},
pages = {034108},
author = {Anthony Scemama and Anouar Benali and Denis Jacquemin and Michel Caffarel and Pierre-Fran{\c{c}}ois Loos},
title = {Excitation energies from diffusion Monte Carlo using selected configuration interaction nodes},
journal = {The Journal of Chemical Physics}
}
@article{Dash_2018,
doi = {10.1021/acs.jctc.8b00393},
url = {https://doi.org/10.1021%2Facs.jctc.8b00393},
year = 2018,
month = {jun},
publisher = {American Chemical Society ({ACS})},
volume = {14},
number = {8},
pages = {4176--4182},
author = {Monika Dash and Saverio Moroni and Anthony Scemama and Claudia Filippi},
title = {Perturbatively Selected Configuration-Interaction Wave Functions for Efficient Geometry Optimization in Quantum Monte Carlo},
journal = {Journal of Chemical Theory and Computation}
}
@article{Garniron_2018,
doi = {10.1063/1.5044503},
url = {https://doi.org/10.1063%2F1.5044503},
year = 2018,
month = {aug},
publisher = {{AIP} Publishing},
volume = {149},
number = {6},
pages = {064103},
author = {Yann Garniron and Anthony Scemama and Emmanuel Giner and Michel Caffarel and Pierre-Fran{\c{c}}ois Loos},
title = {Selected configuration interaction dressed by perturbation},
journal = {The Journal of Chemical Physics}
}
@article{Giner_2017,
doi = {10.1063/1.4984616},
url = {https://doi.org/10.1063%2F1.4984616},
year = 2017,
month = {jun},
publisher = {{AIP} Publishing},
volume = {146},
number = {22},
pages = {224108},
author = {Emmanuel Giner and Celestino Angeli and Yann Garniron and Anthony Scemama and Jean-Paul Malrieu},
title = {A Jeziorski-Monkhorst fully uncontracted multi-reference perturbative treatment. I. Principles, second-order versions, and tests on ground state potential energy curves},
journal = {The Journal of Chemical Physics}
}
@article{Garniron_2017,
doi = {10.1063/1.4980034},
url = {https://doi.org/10.1063%2F1.4980034},
year = 2017,
month = {apr},
publisher = {{AIP} Publishing},
volume = {146},
number = {15},
pages = {154107},
author = {Yann Garniron and Emmanuel Giner and Jean-Paul Malrieu and Anthony Scemama},
title = {Alternative definition of excitation amplitudes in multi-reference state-specific coupled cluster},
journal = {The Journal of Chemical Physics}
}
@article{Garniron_2017.2,
doi = {10.1063/1.4992127},
url = {https://doi.org/10.1063%2F1.4992127},
year = 2017,
month = {jul},
publisher = {{AIP} Publishing},
volume = {147},
number = {3},
pages = {034101},
author = {Yann Garniron and Anthony Scemama and Pierre-Fran{\c{c}}ois Loos and Michel Caffarel},
title = {Hybrid stochastic-deterministic calculation of the second-order perturbative contribution of multireference perturbation theory},
journal = {The Journal of Chemical Physics}
}
@article{Giner_2017.2,
doi = {10.1016/j.comptc.2017.03.001},
url = {https://doi.org/10.1016%2Fj.comptc.2017.03.001},
year = 2017,
month = {sep},
publisher = {Elsevier {BV}},
volume = {1116},
pages = {134--140},
author = {E. Giner and C. Angeli and A. Scemama and J.-P. Malrieu},
title = {Orthogonal Valence Bond Hamiltonians incorporating dynamical correlation effects},
journal = {Computational and Theoretical Chemistry}
}
@article{Giner_2017.3,
author = {Giner, Emmanuel and Tenti, Lorenzo and Angeli, Celestino and Ferré, Nicolas},
title = {Computation of the Isotropic Hyperfine Coupling Constant: Efficiency and Insights from a New Approach Based on Wave Function Theory},
journal = {Journal of Chemical Theory and Computation},
volume = {13},
number = {2},
pages = {475-487},
year = {2017},
doi = {10.1021/acs.jctc.6b00827},
note ={PMID: 28094936},
URL = {https://doi.org/10.1021/acs.jctc.6b00827},
eprint = {https://doi.org/10.1021/acs.jctc.6b00827}
}
@article{Giner2016Mar,
author = {Giner, Emmanuel and Angeli, Celestino},
title = {{Spin density and orbital optimization in open shell systems: A rational and computationally efficient proposal}},
journal = {J. Chem. Phys.},
volume = {144},
number = {10},
pages = {104104},
year = {2016},
month = {Mar},
issn = {0021-9606},
publisher = {American Institute of Physics},
doi = {10.1063/1.4943187}
}
@article{Giner_2016,
doi = {10.1063/1.4940781},
url = {https://doi.org/10.1063%2F1.4940781},
year = 2016,
month = {feb},
publisher = {{AIP} Publishing},
volume = {144},
number = {6},
pages = {064101},
author = {E. Giner and G. David and A. Scemama and J. P. Malrieu},
title = {A simple approach to the state-specific {MR}-{CC} using the intermediate Hamiltonian formalism},
journal = {The Journal of Chemical Physics}
}
@article{Caffarel_2016,
doi = {10.1063/1.4947093},
url = {https://doi.org/10.1063%2F1.4947093},
year = 2016,
month = {apr},
publisher = {{AIP} Publishing},
volume = {144},
number = {15},
pages = {151103},
author = {Michel Caffarel and Thomas Applencourt and Emmanuel Giner and Anthony Scemama},
title = {Communication: Toward an improved control of the fixed-node error in quantum Monte Carlo: The case of the water molecule},
journal = {The Journal of Chemical Physics}
}
@incollection{Caffarel_2016.2,
doi = {10.1021/bk-2016-1234.ch002},
url = {https://doi.org/10.1021%2Fbk-2016-1234.ch002},
year = 2016,
month = {jan},
publisher = {American Chemical Society},
pages = {15--46},
author = {Michel Caffarel and Thomas Applencourt and Emmanuel Giner and Anthony Scemama},
title = {Using CIPSI Nodes in Diffusion Monte Carlo},
booktitle = {{ACS} Symposium Series}
}
@article{Giner_2015,
doi = {10.1063/1.4905528},
url = {https://doi.org/10.1063%2F1.4905528},
year = 2015,
month = {jan},
publisher = {{AIP} Publishing},
volume = {142},
number = {4},
pages = {044115},
author = {Emmanuel Giner and Anthony Scemama and Michel Caffarel},
title = {Fixed-node diffusion Monte Carlo potential energy curve of the fluorine molecule F2 using selected configuration interaction trial wavefunctions},
journal = {The Journal of Chemical Physics}
}
@article{Giner2015Sep,
author = {Giner, Emmanuel and Angeli, Celestino},
title = {{Metal-ligand delocalization and spin density in the CuCl2 and [CuCl4]2{-} molecules: Some insights from wave function theory}},
journal = {J. Chem. Phys.},
volume = {143},
number = {12},
pages = {124305},
year = {2015},
month = {Sep},
issn = {0021-9606},
publisher = {American Institute of Physics},
doi = {10.1063/1.4931639}
}
@article{Scemama_2014,
doi = {10.1063/1.4903985},
url = {https://doi.org/10.1063%2F1.4903985},
year = 2014,
month = {dec},
publisher = {{AIP} Publishing},
volume = {141},
number = {24},
pages = {244110},
author = {A. Scemama and T. Applencourt and E. Giner and M. Caffarel},
title = {Accurate nonrelativistic ground-state energies of 3d transition metal atoms},
journal = {The Journal of Chemical Physics}
}
@article{Caffarel_2014,
doi = {10.1021/ct5004252},
url = {https://doi.org/10.1021%2Fct5004252},
year = 2014,
month = {nov},
publisher = {American Chemical Society ({ACS})},
volume = {10},
number = {12},
pages = {5286--5296},
author = {Michel Caffarel and Emmanuel Giner and Anthony Scemama and Alejandro Ram{\'{\i}}rez-Sol{\'{\i}}s},
title = {Spin Density Distribution in Open-Shell Transition Metal Systems: A Comparative Post-Hartree-Fock, Density Functional Theory, and Quantum Monte Carlo Study of the CuCl2 Molecule},
journal = {Journal of Chemical Theory and Computation}
}
@article{Giner_2013,
doi = {10.1139/cjc-2013-0017},
url = {https://doi.org/10.1139%2Fcjc-2013-0017},
year = 2013,
month = {sep},
publisher = {Canadian Science Publishing},
volume = {91},
number = {9},
pages = {879--885},
author = {Emmanuel Giner and Anthony Scemama and Michel Caffarel},
title = {Using perturbatively selected configuration interaction in quantum Monte Carlo calculations},
journal = {Canadian Journal of Chemistry}
}
@article{Scemama2013Nov,
author = {Scemama, Anthony and Giner, Emmanuel},
title = {{An efficient implementation of Slater-Condon rules}},
journal = {arXiv},
year = {2013},
month = {Nov},
eprint = {1311.6244},
url = {https://arxiv.org/abs/1311.6244}
}
@article{Bytautas_2009,
doi = {10.1016/j.chemphys.2008.11.021},
url = {https://doi.org/10.1016%2Fj.chemphys.2008.11.021},
year = 2009,
month = {feb},
publisher = {Elsevier {BV}},
volume = {356},
number = {1-3},
pages = {64--75},
author = {Laimutis Bytautas and Klaus Ruedenberg},
title = {A priori identification of configurational deadwood},
journal = {Chemical Physics}
}
@article{Anderson_2018,
doi = {10.1016/j.comptc.2018.08.017},
url = {https://doi.org/10.1016%2Fj.comptc.2018.08.017},
year = 2018,
month = {oct},
publisher = {Elsevier {BV}},
volume = {1142},
pages = {66--77},
author = {James S.M. Anderson and Farnaz Heidar-Zadeh and Paul W. Ayers},
title = {Breaking the curse of dimension for the electronic Schrodinger equation with functional analysis},
journal = {Computational and Theoretical Chemistry}
}
@article{Bender_1969,
doi = {10.1103/physrev.183.23},
url = {http://dx.doi.org/10.1103/PhysRev.183.23},
year = 1969,
month = {jul},
publisher = {American Physical Society ({APS})},
volume = {183},
number = {1},
pages = {23--30},
author = {Charles F. Bender and Ernest R. Davidson},
title = {Studies in Configuration Interaction: The First-Row Diatomic Hydrides},
journal = {Phys. Rev.}
}
@article{Whitten_1969,
doi = {10.1063/1.1671985},
url = {https://doi.org/10.1063%2F1.1671985},
year = 1969,
month = {dec},
publisher = {{AIP} Publishing},
volume = {51},
number = {12},
pages = {5584--5596},
author = {J. L. Whitten and Melvyn Hackmeyer},
title = {Configuration Interaction Studies of Ground and Excited States of Polyatomic Molecules. I. The {CI} Formulation and Studies of Formaldehyde},
journal = {The Journal of Chemical Physics}
}
@article{Huron_1973,
doi = {10.1063/1.1679199},
url = {https://doi.org/10.1063%2F1.1679199},
year = 1973,
month = {jun},
publisher = {{AIP} Publishing},
volume = {58},
number = {12},
pages = {5745--5759},
author = {B. Huron and J. P. Malrieu and P. Rancurel},
title = {Iterative perturbation calculations of ground and excited state energies from multiconfigurational zeroth-order wavefunctions},
journal = {The Journal of Chemical Physics}
}
@article{Knowles_1984,
author="Peter J. Knowles and Nicholas C Handy",
year=1984,
journal={Chem. Phys. Letters},
volume=111,
pages="315--321",
title="A New Determinant-based Full Configuration Interaction Method"
}
@article{Sharma_2017,
doi = {10.1021/acs.jctc.6b01028},
url = {https://doi.org/10.1021%2Facs.jctc.6b01028},
year = 2017,
month = {mar},
publisher = {American Chemical Society ({ACS})},
volume = {13},
number = {4},
pages = {1595--1604},
author = {Sandeep Sharma and Adam A. Holmes and Guillaume Jeanmairet and Ali Alavi and C. J. Umrigar},
title = {Semistochastic Heat-Bath Configuration Interaction Method: Selected Configuration Interaction with Semistochastic Perturbation Theory},
journal = {Journal of Chemical Theory and Computation}
}
@article{Holmes_2016,
doi = {10.1021/acs.jctc.6b00407},
url = {https://doi.org/10.1021%2Facs.jctc.6b00407},
year = 2016,
month = {aug},
publisher = {American Chemical Society ({ACS})},
volume = {12},
number = {8},
pages = {3674--3680},
author = {Adam A. Holmes and Norm M. Tubman and C. J. Umrigar},
title = {Heat-Bath Configuration Interaction: An Efficient Selected Configuration Interaction Algorithm Inspired by Heat-Bath Sampling},
journal = {Journal of Chemical Theory and Computation}
}
@article{Evangelisti_1983,
doi = {10.1016/0301-0104(83)85011-3},
url = {https://doi.org/10.1016%2F0301-0104%2883%2985011-3},
year = 1983,
month = {feb},
publisher = {Elsevier {BV}},
volume = {75},
number = {1},
pages = {91--102},
author = {Stefano Evangelisti and Jean-Pierre Daudey and Jean-Paul Malrieu},
title = {Convergence of an improved {CIPSI} algorithm},
journal = {Chemical Physics}
}
@article{Booth_2009,
doi = {10.1063/1.3193710},
url = {https://doi.org/10.1063%2F1.3193710},
year = 2009,
publisher = {{AIP} Publishing},
volume = {131},
number = {5},
pages = {054106},
author = {George H. Booth and Alex J. W. Thom and Ali Alavi},
title = {Fermion Monte Carlo without fixed nodes: A game of life, death, and annihilation in Slater determinant space},
journal = {The Journal of Chemical Physics}
}
@article{Booth_2010,
doi = {10.1063/1.3407895},
url = {https://doi.org/10.1063%2F1.3407895},
year = 2010,
month = {may},
publisher = {{AIP} Publishing},
volume = {132},
number = {17},
pages = {174104},
author = {George H. Booth and Ali Alavi},
title = {Approaching chemical accuracy using full configuration-interaction quantum Monte Carlo: A study of ionization potentials},
journal = {The Journal of Chemical Physics}
}
@article{Cleland_2010,
doi = {10.1063/1.3302277},
url = {https://doi.org/10.1063%2F1.3302277},
year = 2010,
month = {jan},
publisher = {{AIP} Publishing},
volume = {132},
number = {4},
pages = {041103},
author = {Deidre Cleland and George H. Booth and Ali Alavi},
title = {Communications: Survival of the fittest: Accelerating convergence in full configuration-interaction quantum Monte Carlo},
journal = {The Journal of Chemical Physics}
}
@article{Garniron_2017b,
doi = {10.1063/1.4992127},
url = {https://doi.org/10.1063%2F1.4992127},
year = 2017,
month = {jul},
publisher = {{AIP} Publishing},
volume = {147},
number = {3},
pages = {034101},
author = {Yann Garniron and Anthony Scemama and Pierre-Fran{\c{c}}ois Loos and Michel Caffarel},
title = {Hybrid stochastic-deterministic calculation of the second-order perturbative contribution of multireference perturbation theory},
journal = {The Journal of Chemical Physics}
}

2
etc/qp.rc
View File

@ -120,9 +120,7 @@ function qp()
if [[ $? -eq 0 ]] ; then
COMMAND='qp_$@'
eval "$COMMAND" "${EZFIO_FILE}"
result=$?
unset COMMAND
return $result
else
_qp_usage
fi

2
external/irpf90 vendored

@ -1 +1 @@
Subproject commit beac615343f421bd6c0571a408ba389a6d5a32ac
Subproject commit 4ab1b175fc7ed0d96c1912f13dc53579b24157a6

3
ocaml/Angmom.ml
View File

@ -26,7 +26,8 @@ let of_string = function
| "J" | "j" -> J
| "K" | "k" -> K
| "L" | "l" -> L
| x -> raise (Failure ("Angmom should be S|P|D|F|G|H|I|J|K|L, not "^x^"."))
| x -> raise (Failure ("Angmom should be S|P|D|F|G|H|I|J|K|L,
not "^x^"."))
let of_char = function
| 'S' | 's' -> S

13
ocaml/Atom.ml
View File

@ -22,15 +22,10 @@ let of_string ~units s =
}
| [ name; x; y; z ] ->
let e = Element.of_string name in
begin
try
{ element = e ;
charge = Element.to_charge e;
coord = Point3d.of_string ~units (String.concat " " [x; y; z])
}
with
| err -> (Printf.eprintf "name = \"%s\"\nxyz = (%s,%s,%s)\n%!" name x y z ; raise err)
end
{ element = e ;
charge = Element.to_charge e;
coord = Point3d.of_string ~units (String.concat " " [x; y; z])
}
| _ -> raise (AtomError s)

2
ocaml/Basis.ml
View File

@ -17,7 +17,7 @@ let read in_channel at_number =
(** Find an element in the basis set file *)
let find in_channel element =
seek_in in_channel 0;
let element_read = ref Element.Og in
let element_read = ref Element.X in
while !element_read <> element
do
let buffer = input_line in_channel in

38
ocaml/Element.ml
View File

@ -4,7 +4,7 @@ open Qptypes
exception ElementError of string
type t = X
|H |He
|Li|Be |B |C |N |O |F |Ne
|Na|Mg |Al|Si|P |S |Cl|Ar
@ -20,7 +20,7 @@ type t = X
let of_string x =
match (String.capitalize_ascii (String.lowercase_ascii x)) with
| "X" | "Ghost" -> X
| "X" | "Dummy" -> X
| "H" | "Hydrogen" -> H
| "He" | "Helium" -> He
| "Li" | "Lithium" -> Li
@ -265,7 +265,7 @@ let to_string = function
let to_long_string = function
| X -> "Ghost"
| X -> "Dummy"
| H -> "Hydrogen"
| He -> "Helium"
| Li -> "Lithium"
@ -492,20 +492,20 @@ let to_charge c =
| No -> 102
| Lr -> 103
| Rf -> 104
| Db -> 105
| Sg -> 106
| Bh -> 107
| Hs -> 108
| Mt -> 109
| Ds -> 110
| Rg -> 111
| Cn -> 112
| Nh -> 113
| Fl -> 114
| Mc -> 115
| Lv -> 116
| Ts -> 117
| Og -> 118
| Db -> 105
| Sg -> 106
| Bh -> 107
| Hs -> 108
| Mt -> 109
| Ds -> 110
| Rg -> 111
| Cn -> 112
| Nh -> 113
| Fl -> 114
| Mc -> 115
| Lv -> 116
| Ts -> 117
| Og -> 118
in Charge.of_int result
@ -565,7 +565,7 @@ let of_charge c = match (Charge.to_int c) with
| 52 -> Te
| 53 -> I
| 54 -> Xe
| 55 -> Cs
| 55 -> Cs
| 56 -> Ba
| 57 -> La
| 58 -> Ce
@ -880,7 +880,7 @@ let vdw_radius x =
| Ts -> None
| Og -> None
in
match result x with
match result x with
| Some y -> Some (Positive_float.of_float @@ Units.angstrom_to_bohr *. y )
| None -> None

33
ocaml/Input_determinants_by_hand.ml
View File

@ -13,7 +13,6 @@ module Determinants_by_hand : sig
psi_coef : Det_coef.t array;
psi_det : Determinant.t array;
state_average_weight : Positive_float.t array;
mo_label : MO_label.t;
} [@@deriving sexp]
val read : ?full:bool -> unit -> t option
val write : ?force:bool -> t -> unit
@ -35,21 +34,11 @@ end = struct
psi_coef : Det_coef.t array;
psi_det : Determinant.t array;
state_average_weight : Positive_float.t array;
mo_label : MO_label.t;
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "determinants";;
let read_mo_label () =
if not (Ezfio.has_determinants_mo_label ()) then
if Ezfio.has_mo_basis_mo_label () then (
let label = Ezfio.get_mo_basis_mo_label () in
Ezfio.set_determinants_mo_label label) ;
Ezfio.get_determinants_mo_label ()
|> MO_label.of_string
;;
let read_n_int () =
if not (Ezfio.has_determinants_n_int()) then
Ezfio.get_mo_basis_mo_num ()
@ -233,7 +222,7 @@ end = struct
and n_states =
States_number.to_int n_states
in
let r =
let r =
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c
in
Ezfio.set_determinants_psi_coef r;
@ -294,23 +283,19 @@ end = struct
|> Array.concat
|> Array.to_list
in
let r =
let r =
Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; Det_number.to_int n_det |] ~data:data
in
Ezfio.set_determinants_psi_det r;
Ezfio.set_determinants_psi_det_qp_edit r
;;
let write_mo_label a =
MO_label.to_string a
|> Ezfio.set_determinants_mo_label
let read ?(full=true) () =
let n_det_qp_edit = read_n_det_qp_edit () in
let n_det = read_n_det () in
let read_only =
let read_only =
if full then false else n_det_qp_edit <> n_det
in
@ -326,7 +311,6 @@ end = struct
psi_det = read_psi_det ~read_only () ;
n_states = read_n_states () ;
state_average_weight = read_state_average_weight () ;
mo_label = read_mo_label () ;
}
with _ -> None
else
@ -344,7 +328,6 @@ end = struct
psi_det ;
n_states ;
state_average_weight ;
mo_label ;
} =
write_n_int n_int ;
write_bit_kind bit_kind;
@ -357,9 +340,7 @@ end = struct
write_psi_coef ~n_det:n_det ~n_states:n_states psi_coef ;
write_psi_det ~n_int:n_int ~n_det:n_det psi_det
end;
write_state_average_weight state_average_weight ;
write_mo_label mo_label ;
()
write_state_average_weight state_average_weight
;;
@ -458,7 +439,7 @@ psi_det = %s
in
(* Split into header and determinants data *)
let idx =
let idx =
match String_ext.substr_index r ~pos:0 ~pattern:"\nDeterminants" with
| Some x -> x
| None -> assert false
@ -564,8 +545,6 @@ psi_det = %s
let bitkind =
Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind
|> Bit_kind.to_int)
and mo_label =
Printf.sprintf "(mo_label %s)" (MO_label.to_string @@ read_mo_label ())
and n_int =
Printf.sprintf "(n_int %d)" (N_int_number.get_max ())
and n_states =
@ -574,7 +553,7 @@ psi_det = %s
Printf.sprintf "(n_det_qp_edit %d)" (Det_number.to_int @@ read_n_det_qp_edit ())
in
let s =
String.concat "" [ header ; mo_label ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ]
String.concat "" [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ]
in

12
ocaml/Molecule.ml
View File

@ -142,21 +142,13 @@ let of_xyz_string
result
let regexp_r = Str.regexp {| |}
let regexp_t = Str.regexp {| |}
let of_xyz_file
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
?(units=Units.Angstrom)
filename =
let lines =
Io_ext.input_lines filename
|> List.map (fun s -> Str.global_replace regexp_r "" s)
|> List.map (fun s -> Str.global_replace regexp_t " " s)
in
let lines =
match lines with
match Io_ext.input_lines filename with
| natoms :: title :: rest ->
let natoms =
try
@ -181,8 +173,6 @@ let of_zmt_file
?(units=Units.Angstrom)
filename =
Io_ext.read_all filename
|> Str.global_replace regexp_r ""
|> Str.global_replace regexp_t " "
|> Zmatrix.of_string
|> Zmatrix.to_xyz_string
|> of_xyz_string ~charge ~multiplicity ~units

4
ocaml/Point3d.ml
View File

@ -24,9 +24,7 @@ let of_string ~units s =
let l = s
|> String_ext.split ~on:' '
|> List.filter (fun x -> x <> "")
|> list_map (fun x ->
try float_of_string x with
| Failure msg -> (Printf.eprintf "Bad string: \"%s\"\n%!" x ; failwith msg) )
|> list_map float_of_string
|> Array.of_list
in
{ x = l.(0) *. f ;

21
ocaml/Zmatrix.ml
View File

@ -58,32 +58,17 @@ let int_of_atom_id : atom_id -> int = fun x -> x
let float_of_distance : float StringMap.t -> distance -> float =
fun map -> function
| Value x -> x
| Label s -> begin
try StringMap.find s map with
| Not_found ->
Printf.sprintf "Zmatrix error: distance %s undefined" s
|> failwith
end
| Label s -> StringMap.find s map
let float_of_angle : float StringMap.t -> angle -> float =
fun map -> function
| Value x -> x
| Label s -> begin
try StringMap.find s map with
| Not_found ->
Printf.sprintf "Zmatrix error: angle %s undefined" s
|> failwith
end
| Label s -> StringMap.find s map
let float_of_dihedral : float StringMap.t -> dihedral -> float =
fun map -> function
| Value x -> x
| Label s -> begin
try StringMap.find s map with
| Not_found ->
Printf.sprintf "Zmatrix error: dihedral %s undefined" s
|> failwith
end
| Label s -> StringMap.find s map
type line =

42
ocaml/qp_create_ezfio.ml
View File

@ -6,8 +6,8 @@ type element =
| Element of Element.t
| Int_elem of (Nucl_number.t * Element.t)
(** Handle ghost atoms placed on bonds *)
let ghost_centers ~threshold ~molecule ~nuclei =
(** Handle dummy atoms placed on bonds *)
let dummy_centers ~threshold ~molecule ~nuclei =
let d =
Molecule.distance_matrix molecule
in
@ -68,11 +68,11 @@ let run ?o b au c d m p cart xyz_file =
(Molecule.of_file xyz_file ~charge:(Charge.of_int c)
~multiplicity:(Multiplicity.of_int m) )
in
let ghost =
ghost_centers ~threshold:d ~molecule ~nuclei:molecule.Molecule.nuclei
let dummy =
dummy_centers ~threshold:d ~molecule ~nuclei:molecule.Molecule.nuclei
in
let nuclei =
molecule.Molecule.nuclei @ ghost
molecule.Molecule.nuclei @ dummy
in
@ -145,6 +145,8 @@ let run ?o b au c d m p cart xyz_file =
| i :: k :: [] -> (Nucl_number.of_int @@ int_of_string i, Element.of_string k)
| _ -> failwith "Expected format is int,Element:basis"
in Int_elem result
and basis =
String.lowercase_ascii basis
in
let key =
match elem with
@ -311,7 +313,7 @@ let run ?o b au c d m p cart xyz_file =
}
in
let nuclei =
molecule.Molecule.nuclei @ ghost
molecule.Molecule.nuclei @ dummy
in
@ -489,7 +491,11 @@ let run ?o b au c d m p cart xyz_file =
|> List.rev
|> list_map (fun (x,i) ->
try
let e = x.Atom.element in
let e =
match x.Atom.element with
| Element.X -> Element.H
| e -> e
in
let key =
Int_elem (i,x.Atom.element)
in
@ -501,15 +507,9 @@ let run ?o b au c d m p cart xyz_file =
in
try
Basis.read_element (basis_channel key) i e
with _ ->
try
if e = Element.X then
Basis.read_element (basis_channel key) i (Element.H)
else
raise Not_found
with Not_found ->
failwith (Printf.sprintf "Basis not found for atom %d (%s)" (Nucl_number.to_int i)
(Element.to_string x.Atom.element) )
with Not_found ->
failwith (Printf.sprintf "Basis not found for atom %d (%s)" (Nucl_number.to_int i)
(Element.to_string x.Atom.element) )
with
| End_of_file -> failwith
("Element "^(Element.to_string x.Atom.element)^" not found in basis set.")
@ -710,9 +710,9 @@ If a file with the same name as the basis set exists, this file will be read. O
arg=With_arg "<int>";
doc="Total charge of the molecule. Default is 0. For negative values, use m instead of -, for ex m1"} ;
{ opt=Optional ; short='g'; long="ghost";
{ opt=Optional ; short='d'; long="dummy";
arg=With_arg "<float>";
doc="Add ghost atoms. x * (covalent radii of the atoms)."} ;
doc="Add dummy atoms. x * (covalent radii of the atoms)."} ;
{ opt=Optional ; short='m'; long="multiplicity";
arg=With_arg "<int>";
@ -756,8 +756,8 @@ If a file with the same name as the basis set exists, this file will be read. O
int_of_string x )
in
let ghost =
match Command_line.get "ghost" with
let dummy =
match Command_line.get "dummy" with
| None -> 0.
| Some x -> float_of_string x
in
@ -782,7 +782,7 @@ If a file with the same name as the basis set exists, this file will be read. O
| x::_ -> x
in
run ?o:output basis au charge ghost multiplicity pseudo cart xyz_filename
run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
)
with
(* | Failure txt -> Printf.eprintf "Fatal error: %s\n%!" txt *)

4
ocaml/qptypes_generator.ml
View File

@ -154,8 +154,8 @@ let input_ezfio = "
* N_int_number : int
determinants_n_int
1 : 128
N_int > 128
1 : 30
N_int > 30
* Det_number : int
determinants_n_det

131
plugins/README.rst
View File

@ -1,131 +0,0 @@
==============================
Tutorial for creating a plugin
==============================
Introduction: what is a plugin, and what tutorial will be about ?
=================================================================
The |QP| is split into two kinds of routines/global variables (i.e. *providers*):
1) the **core modules** locatedin qp2/src/, which contains all the bulk of a quantum chemistry software (integrals, matrix elements between Slater determinants, linear algebra routines, DFT stuffs etc..)
2) the **plugins** which are external routines/*providers* connected to the qp2/src/ routines/*providers*.
More precisely, a **plugin** of the |QP| is a directory where you can create routines,
providers and executables that use all the global variables/functions/routines already created
in the modules of qp2/src or in other plugins.
Instead of giving a theoretical lecture on what is a plugin,
we will go through a series of examples that allow you to do the following thing:
1) print out **one- and two-electron integrals** on the AO/MO basis, creates two providers which manipulate these objects, print out these providers,
2) browse the **Slater determinants stored** in the |EZFIO| wave function and compute their matrix elements,
3) build the **Hamiltonian matrix** and **diagonalize** it either with **Lapack or Davidson**,
4) print out the **one- and two-electron rdms**,
5) obtain the **AOs** and **MOs** on the **DFT grid**, together with the **density**,
How the tutorial will be done
-----------------------------
This tuto is as follows:
1) you **READ THIS FILE UNTIL THE END** in order to get the big picture and vocabulary,
2) you go to the directory :file:`qp2/plugins/tuto_plugins/` and you will find detailed tutorials for each of the 5 examples.
Creating a plugin: the basic
----------------------------
The first thing to do is to be in the QPSH mode: you execute the qp2/bin/qpsh script that essentially loads all
the environement variables and allows for the completion of command lines in bash (that is an AMAZING feature :)
Then, you need to known **where** you want to create your plugin, and what is the **name** of the plugin.
.. important::
The plugins are **NECESSARILY** located in qp2/plugins/, and from there you can create any structures of directories.
Ex: If you want to create a plugin named "my_fancy_plugin" in the directory plugins/plugins_test/,
this goes with the command
.. code:: bash
qp plugins create -n my_fancy_plugin -r plugins_test/
Then, to create the plugin of your dreams, the two questions you need to answer are the following:
1) What do I **need** to compute what I want, which means what are the **objects** that I need ?
There are two kind of objects:
+ the *routines/functions*:
Ex: Linear algebra routines, integration routines etc ...
+ the global variables which are called the *providers*:
Ex: one-electron integrals, Slater determinants, density matrices etc ...
2) **Where do I find** these objects ?
The objects (routines/functions/providers) are necessarily created in other *modules/plugins*.
.. seealso::
The routine :c:func:`lapack_diagd` (which diagonalises a real hermitian matrix) is located in the file
:file:`qp2/src/utils/linear_algebra.irp.f`
therefore it "belongs" to the module :ref:`module_utils`
The routine :c:func:`ao_to_mo` (which converts a given matrix A from the AO basis to the MO basis) is located in the file
:file:`qp2/src/mo_one_e_ints/ao_to_mo.irp.f`
therefore it "belongs" to the module :ref:`module_mo_one_e_ints`
The provider :c:data:`ao_one_e_integrals` (which is the integrals of one-body part of H on the AO basis) is located in the file
:file:`qp2/src/ao_one_e_ints/ao_one_e_ints.irp.f`
therefore it belongs to the module :ref:`module_ao_one_e_ints`
The provider :c:data:`one_e_dm_mo_beta_average` (which is the state average beta density matrix on the MO basis) is located in the file
:file:`qp2/src/determinants/density_matrix.irp.f`
therefore it belongs to the module :ref:`module_determinants`
To import all the variables that you need, you just need to write the name of the plugins in the :file:`NEED` file .
To import all the variables/routines of the module :ref:`module_utils`, :ref:`module_determinants` and :ref:`module_mo_one_e_ints`, the :file:`NEED` file you will need is simply the following:
.. code:: bash
cat NEED
utils
determinants
mo_one_e_ints
.. important::
There are **many** routines/providers in the core modules of QP.
Nevertheless, as everything is coded with the |IRPF90|, you can use the following amazing tools: :command:`irpman`
:command:`irpman` can be used in command line in bash to obtain all the info on a routine or variable !
Example: execute the following command line :
.. code:: bash
irpman ao_one_e_integrals
Then all the information you need on :c:data:`ao_one_e_integrals` will appear on the screen.
This includes
- **where** the provider is created, (*i.e.* the actual file where the provider is designed)
- the **type** of the provider (*i.e.* a logical, integer etc ...)
- the **dimension** if it is an array,
- what other *providers* are **needed** to build this provider,
- what other *providers* **need** this provider.

1
plugins/local/ao_many_one_e_ints/NEED
View File

@ -4,4 +4,3 @@ becke_numerical_grid
mo_one_e_ints
dft_utils_in_r
tc_keywords
hamiltonian

38
plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f
View File

@ -98,7 +98,7 @@ double precision function phi_j_erf_mu_r_phi(i, j, mu_in, C_center)
enddo
enddo
end
end function phi_j_erf_mu_r_phi
! ---
@ -201,7 +201,7 @@ subroutine erf_mu_gauss_ij_ao(i, j, mu, C_center, delta, gauss_ints)
enddo
enddo
end
end subroutine erf_mu_gauss_ij_ao
! ---
@ -266,7 +266,7 @@ subroutine NAI_pol_x_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
enddo
enddo
end
end subroutine NAI_pol_x_mult_erf_ao
! ---
@ -340,7 +340,7 @@ subroutine NAI_pol_x_mult_erf_ao_v0(i_ao, j_ao, mu_in, C_center, LD_C, ints, LD_
deallocate(integral)
end
end subroutine NAI_pol_x_mult_erf_ao_v0
! ---
@ -420,7 +420,7 @@ subroutine NAI_pol_x_mult_erf_ao_v(i_ao, j_ao, mu_in, C_center, LD_C, ints, LD_i
deallocate(integral)
end
end subroutine NAI_pol_x_mult_erf_ao_v
! ---
@ -479,7 +479,7 @@ double precision function NAI_pol_x_mult_erf_ao_x(i_ao, j_ao, mu_in, C_center)
enddo
enddo
end
end function NAI_pol_x_mult_erf_ao_x
! ---
@ -538,7 +538,7 @@ double precision function NAI_pol_x_mult_erf_ao_y(i_ao, j_ao, mu_in, C_center)
enddo
enddo
end
end function NAI_pol_x_mult_erf_ao_y
! ---
@ -597,7 +597,7 @@ double precision function NAI_pol_x_mult_erf_ao_z(i_ao, j_ao, mu_in, C_center)
enddo
enddo
end
end function NAI_pol_x_mult_erf_ao_z
! ---
@ -667,7 +667,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_x(i_ao, j_ao, beta, B_cen
enddo
enddo
end
end function NAI_pol_x_mult_erf_ao_with1s_x
! ---
@ -737,7 +737,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_y(i_ao, j_ao, beta, B_cen
enddo
enddo
end
end function NAI_pol_x_mult_erf_ao_with1s_y
! ---
@ -807,7 +807,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_z(i_ao, j_ao, beta, B_cen
enddo
enddo
end
end function NAI_pol_x_mult_erf_ao_with1s_z
! ---
@ -880,7 +880,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_cen
enddo
enddo
end
end subroutine NAI_pol_x_mult_erf_ao_with1s
! ---
@ -967,7 +967,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s_v0(i_ao, j_ao, beta, B_center, LD_B, mu_
deallocate(integral)
end
end subroutine NAI_pol_x_mult_erf_ao_with1s_v0
! ---
@ -1057,7 +1057,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s_v(i_ao, j_ao, beta, B_center, LD_B, mu_i
deallocate(integral)
end
end subroutine NAI_pol_x_mult_erf_ao_with1s_v
! ---
@ -1175,7 +1175,7 @@ subroutine NAI_pol_x2_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_ce
enddo
enddo
end
end subroutine NAI_pol_x2_mult_erf_ao_with1s
! ---
@ -1241,7 +1241,7 @@ subroutine NAI_pol_x2_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
enddo
enddo
end
end subroutine NAI_pol_x2_mult_erf_ao
! ---
@ -1320,7 +1320,7 @@ subroutine NAI_pol_012_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_c
enddo
enddo
end
end subroutine NAI_pol_012_mult_erf_ao_with1s
! ---
@ -1328,7 +1328,7 @@ subroutine NAI_pol_012_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
BEGIN_DOC
!
! Computes the following integrals :
! Computes the following integral :
!
! int(1) = $\int_{-\infty}^{infty} dr x^0 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
!
@ -1395,7 +1395,7 @@ subroutine NAI_pol_012_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
enddo
enddo
end
end subroutine NAI_pol_012_mult_erf_ao
! ---

89
plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f
View File

@ -152,7 +152,7 @@ double precision function overlap_gauss_r12_ao(D_center, delta, i, j)
enddo
enddo
end
end function overlap_gauss_r12_ao
! --
@ -199,7 +199,7 @@ double precision function overlap_abs_gauss_r12_ao(D_center, delta, i, j)
enddo
enddo
end
end function overlap_gauss_r12_ao
! --
@ -257,7 +257,7 @@ subroutine overlap_gauss_r12_ao_v(D_center, LD_D, delta, i, j, resv, LD_resv, n_
deallocate(analytical_j)
end
end subroutine overlap_gauss_r12_ao_v
! ---
@ -327,7 +327,7 @@ double precision function overlap_gauss_r12_ao_with1s(B_center, beta, D_center,
enddo
enddo
end
end function overlap_gauss_r12_ao_with1s
! ---
@ -420,86 +420,7 @@ subroutine overlap_gauss_r12_ao_with1s_v(B_center, beta, D_center, LD_D, delta,
deallocate(fact_g, G_center, analytical_j)
end
! ---
subroutine overlap_gauss_r12_ao_012(D_center, delta, i, j, ints)
BEGIN_DOC
!
! Computes the following integrals :
!
! ints(1) = $\int_{-\infty}^{infty} dr x^0 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2}
!
! ints(2) = $\int_{-\infty}^{infty} dr x^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2}
! ints(3) = $\int_{-\infty}^{infty} dr y^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2}
! ints(4) = $\int_{-\infty}^{infty} dr z^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2}
!
! ints(5) = $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2}
! ints(6) = $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2}
! ints(7) = $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2}
!
END_DOC
include 'utils/constants.include.F'
implicit none
integer, intent(in) :: i, j
double precision, intent(in) :: delta, D_center(3)
double precision, intent(out) :: ints(7)
integer :: k, l, m
integer :: power_A(3), power_B(3), power_A1(3), power_A2(3)
double precision :: A_center(3), B_center(3), alpha, beta, coef1, coef
double precision :: integral0, integral1, integral2
double precision, external :: overlap_gauss_r12
ints = 0.d0
if(ao_overlap_abs(j,i).lt.1.d-12) then
return
endif
power_A(1:3) = ao_power(i,1:3)
power_B(1:3) = ao_power(j,1:3)
A_center(1:3) = nucl_coord(ao_nucl(i),1:3)
B_center(1:3) = nucl_coord(ao_nucl(j),1:3)
do l = 1, ao_prim_num(i)
alpha = ao_expo_ordered_transp (l,i)
coef1 = ao_coef_normalized_ordered_transp(l,i)
do k = 1, ao_prim_num(j)
beta = ao_expo_ordered_transp(k,j)
coef = coef1 * ao_coef_normalized_ordered_transp(k,j)
if(dabs(coef) .lt. 1d-12) cycle
integral0 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta)
ints(1) += coef * integral0
do m = 1, 3
power_A1 = power_A
power_A1(m) += 1
integral1 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A1, power_B, alpha, beta)
ints(1+m) += coef * (integral1 + A_center(m)*integral0)
power_A2 = power_A
power_A2(m) += 2
integral2 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A2, power_B, alpha, beta)
ints(4+m) += coef * (integral2 + A_center(m) * (2.d0*integral1 + A_center(m)*integral0))
enddo
enddo ! k
enddo ! l
return
end
end subroutine overlap_gauss_r12_ao_with1s_v
! ---

0
plugins/local/jastrow/fit_slat_gauss.irp.f → plugins/local/ao_many_one_e_ints/fit_slat_gauss.irp.f
View File

198
plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f
View File

@ -1,11 +1,11 @@
! ---
BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
!
END_DOC
@ -15,30 +15,30 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (ao_num, ao_nu
double precision :: coef, beta, B_center(3)
double precision :: tmp
double precision :: wall0, wall1
double precision :: int_gauss, dsqpi_3_2, int_env
double precision :: int_gauss, dsqpi_3_2, int_j1b
double precision :: factor_ij_1s, beta_ij, center_ij_1s(3), sq_pi_3_2
double precision, allocatable :: int_fit_v(:)
double precision, external :: overlap_gauss_r12_ao
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing int2_grad1u2_grad2u2_env2_test ...'
print*, ' providing int2_grad1u2_grad2u2_j1b2_test ...'
sq_pi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points_transp List_comb_thr_b3_coef
provide mu_erf final_grid_points_transp j1b_pen List_comb_thr_b3_coef
call wall_time(wall0)
int2_grad1u2_grad2u2_env2_test(:,:,:) = 0.d0
int2_grad1u2_grad2u2_j1b2_test(:,:,:) = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit_v, tmp,int_gauss,int_env,factor_ij_1s,beta_ij,center_ij_1s) &
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size, &
!$OMP final_grid_points_transp, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
!$OMP List_comb_thr_b3_cent, int2_grad1u2_grad2u2_env2_test, ao_abs_comb_b3_env, &
!$OMP ao_overlap_abs,sq_pi_3_2,thrsh_cycle_tc)
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit_v, tmp,int_gauss,int_j1b,factor_ij_1s,beta_ij,center_ij_1s) &
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size, &
!$OMP final_grid_points_transp, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
!$OMP List_comb_thr_b3_cent, int2_grad1u2_grad2u2_j1b2_test, ao_abs_comb_b3_j1b, &
!$OMP ao_overlap_abs,sq_pi_3_2,thrsh_cycle_tc)
!$OMP DO SCHEDULE(dynamic)
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
@ -54,13 +54,13 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (ao_num, ao_nu
! i_1s = 1
! --- --- ---
int_env = ao_abs_comb_b3_env(1,j,i)
int_j1b = ao_abs_comb_b3_j1b(1,j,i)
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_1_erf_x_2(i_fit)
coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit)
! if(dabs(coef_fit*int_env*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
! if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
int_gauss = overlap_gauss_r12_ao(r, expo_fit, i, j)
int2_grad1u2_grad2u2_env2_test(j,i,ipoint) += coef_fit * int_gauss
int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss
enddo
! --- --- ---
@ -71,7 +71,7 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (ao_num, ao_nu
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_env = ao_abs_comb_b3_env(i_1s,j,i)
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
@ -81,11 +81,11 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (ao_num, ao_nu
!DIR$ FORCEINLINE
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) * coef
! if(dabs(coef_fit*factor_ij_1s*int_env*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
! if(dabs(coef_fit*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
! call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, &
! expo_fit, i, j, int_fit_v, n_points_final_grid)
int_gauss = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
int2_grad1u2_grad2u2_env2_test(j,i,ipoint) += coef_fit * int_gauss
int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss
enddo
enddo
@ -98,26 +98,26 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (ao_num, ao_nu
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = 1, i-1
int2_grad1u2_grad2u2_env2_test(j,i,ipoint) = int2_grad1u2_grad2u2_env2_test(i,j,ipoint)
int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_grad1u2_grad2u2_env2_test (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test_v, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2
!
END_DOC
BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao_num, n_points_final_grid)]
!
! BEGIN_DOC
! !
! ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
! !
! END_DOC
!
implicit none
integer :: i, j, ipoint, i_1s, i_fit
double precision :: r(3), expo_fit, coef_fit
@ -128,24 +128,24 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test_v, (ao_num, ao_
double precision, allocatable :: int_fit_v(:),big_array(:,:,:)
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing int2_grad1u2_grad2u2_env2_test_v ...'
print*, ' providing int2_grad1u2_grad2u2_j1b2_test_v ...'
provide mu_erf final_grid_points_transp
provide mu_erf final_grid_points_transp j1b_pen
call wall_time(wall0)
double precision :: int_env
double precision :: int_j1b
big_array(:,:,:) = 0.d0
allocate(big_array(n_points_final_grid,ao_num, ao_num))
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,&
!$OMP coef_fit, expo_fit, int_fit_v, tmp,int_env) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size,&
!$OMP final_grid_points_transp, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
!$OMP List_comb_thr_b3_cent, big_array,&
!$OMP ao_abs_comb_b3_env,ao_overlap_abs,thrsh_cycle_tc)
!
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,&
!$OMP coef_fit, expo_fit, int_fit_v, tmp,int_j1b) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size,&
!$OMP final_grid_points_transp, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
!$OMP List_comb_thr_b3_cent, big_array,&
!$OMP ao_abs_comb_b3_j1b,ao_overlap_abs,thrsh_cycle_tc)
!
allocate(int_fit_v(n_points_final_grid))
!$OMP DO SCHEDULE(dynamic)
do i = 1, ao_num
@ -159,7 +159,7 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test_v, (ao_num, ao_
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_env = ao_abs_comb_b3_env(i_1s,j,i)
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
@ -187,7 +187,7 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test_v, (ao_num, ao_
do i = 1, ao_num
do j = i, ao_num
do ipoint = 1, n_points_final_grid
int2_grad1u2_grad2u2_env2_test_v(j,i,ipoint) = big_array(ipoint,j,i)
int2_grad1u2_grad2u2_j1b2_test_v(j,i,ipoint) = big_array(ipoint,j,i)
enddo
enddo
enddo
@ -195,23 +195,23 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test_v, (ao_num, ao_
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_grad1u2_grad2u2_env2_test_v(j,i,ipoint) = big_array(ipoint,i,j)
int2_grad1u2_grad2u2_j1b2_test_v(j,i,ipoint) = big_array(ipoint,i,j)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_grad1u2_grad2u2_env2_test_v (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test_v', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, int2_u2_env2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [u_12^mu]^2
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2
!
END_DOC
@ -219,29 +219,29 @@ BEGIN_PROVIDER [double precision, int2_u2_env2_test, (ao_num, ao_num, n_points_f
integer :: i, j, ipoint, i_1s, i_fit
double precision :: r(3), int_fit, expo_fit, coef_fit
double precision :: coef, beta, B_center(3), tmp
double precision :: wall0, wall1,int_env
double precision :: wall0, wall1,int_j1b
double precision, external :: overlap_gauss_r12_ao
double precision, external :: overlap_gauss_r12_ao_with1s
double precision :: factor_ij_1s,beta_ij,center_ij_1s(3),sq_pi_3_2
print*, ' providing int2_u2_env2_test ...'
print*, ' providing int2_u2_j1b2_test ...'
sq_pi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
int2_u2_env2_test = 0.d0
int2_u2_j1b2_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp, int_env,factor_ij_1s,beta_ij,center_ij_1s) &
!$OMP coef_fit, expo_fit, int_fit, tmp, int_j1b,factor_ij_1s,beta_ij,center_ij_1s) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo,sq_pi_3_2, &
!$OMP List_comb_thr_b3_cent, int2_u2_env2_test,ao_abs_comb_b3_env,thrsh_cycle_tc)
!$OMP List_comb_thr_b3_cent, int2_u2_j1b2_test,ao_abs_comb_b3_j1b,thrsh_cycle_tc)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
@ -257,12 +257,12 @@ BEGIN_PROVIDER [double precision, int2_u2_env2_test, (ao_num, ao_num, n_points_f
! i_1s = 1
! --- --- ---
int_env = ao_abs_comb_b3_env(1,j,i)
if(dabs(int_env).lt.thrsh_cycle_tc) cycle
int_j1b = ao_abs_comb_b3_j1b(1,j,i)
if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_j_mu_x_2(i_fit)
coef_fit = coef_gauss_j_mu_x_2(i_fit)
! if(dabs(coef_fit*int_env*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
! if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
tmp += coef_fit * int_fit
enddo
@ -275,8 +275,8 @@ BEGIN_PROVIDER [double precision, int2_u2_env2_test, (ao_num, ao_num, n_points_f
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_env = ao_abs_comb_b3_env(i_1s,j,i)
! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
@ -286,13 +286,13 @@ BEGIN_PROVIDER [double precision, int2_u2_env2_test, (ao_num, ao_num, n_points_f
coef_fit = coef_gauss_j_mu_x_2(i_fit)
!DIR$ FORCEINLINE
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
! if(dabs(coef_fit*coef*factor_ij_1s*int_env*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
! if(dabs(coef_fit*coef*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
tmp += coef * coef_fit * int_fit
enddo
enddo
int2_u2_env2_test(j,i,ipoint) = tmp
int2_u2_j1b2_test(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -302,23 +302,23 @@ BEGIN_PROVIDER [double precision, int2_u2_env2_test, (ao_num, ao_num, n_points_f
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_u2_env2_test(j,i,ipoint) = int2_u2_env2_test(i,j,ipoint)
int2_u2_j1b2_test(j,i,ipoint) = int2_u2_j1b2_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u2_env2_test (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_u2_j1b2_test', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (ao_num,ao_num,n_points_final_grid,3)]
BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n_points_final_grid, 3)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] r2
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2
!
END_DOC
@ -327,27 +327,27 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (ao_num,ao_num,n_po
double precision :: r(3), int_fit(3), expo_fit, coef_fit
double precision :: coef, beta, B_center(3), dist
double precision :: alpha_1s, alpha_1s_inv, centr_1s(3), expo_coef_1s, coef_tmp
double precision :: tmp_x, tmp_y, tmp_z, int_env
double precision :: tmp_x, tmp_y, tmp_z, int_j1b
double precision :: wall0, wall1, sq_pi_3_2,sq_alpha
print*, ' providing int2_u_grad1u_x_env2_test ...'
print*, ' providing int2_u_grad1u_x_j1b2_test ...'
sq_pi_3_2 = dacos(-1.D0)**(1.d0)
provide mu_erf final_grid_points
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
int2_u_grad1u_x_env2_test = 0.d0
int2_u_grad1u_x_j1b2_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, alpha_1s, dist, &
!$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, &
!$OMP tmp_x, tmp_y, tmp_z,int_env,sq_alpha) &
!$OMP tmp_x, tmp_y, tmp_z,int_j1b,sq_alpha) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_env2_test,ao_abs_comb_b3_env,sq_pi_3_2,thrsh_cycle_tc)
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_j1b2_test,ao_abs_comb_b3_j1b,sq_pi_3_2,thrsh_cycle_tc)
!$OMP DO
do ipoint = 1, n_points_final_grid
@ -365,8 +365,8 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (ao_num,ao_num,n_po
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_env = ao_abs_comb_b3_env(i_1s,j,i)
if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
@ -389,7 +389,7 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (ao_num,ao_num,n_po
expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist
coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
sq_alpha = alpha_1s_inv * dsqrt(alpha_1s_inv)
! if(dabs(coef_tmp*int_env*sq_pi_3_2*sq_alpha) .lt. thrsh_cycle_tc) cycle
! if(dabs(coef_tmp*int_j1b*sq_pi_3_2*sq_alpha) .lt. thrsh_cycle_tc) cycle
call NAI_pol_x_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r, int_fit)
@ -402,9 +402,9 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (ao_num,ao_num,n_po
enddo
int2_u_grad1u_x_env2_test(j,i,ipoint,1) = tmp_x
int2_u_grad1u_x_env2_test(j,i,ipoint,2) = tmp_y
int2_u_grad1u_x_env2_test(j,i,ipoint,3) = tmp_z
int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = tmp_x
int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = tmp_y
int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = tmp_z
enddo
enddo
enddo
@ -414,25 +414,24 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (ao_num,ao_num,n_po
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_u_grad1u_x_env2_test(j,i,ipoint,1) = int2_u_grad1u_x_env2_test(i,j,ipoint,1)
int2_u_grad1u_x_env2_test(j,i,ipoint,2) = int2_u_grad1u_x_env2_test(i,j,ipoint,2)
int2_u_grad1u_x_env2_test(j,i,ipoint,3) = int2_u_grad1u_x_env2_test(i,j,ipoint,3)
int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,1)
int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,2)
int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,3)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u_grad1u_x_env2_test (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_u_grad1u_x_j1b2_test', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu]
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu]
!
END_DOC
@ -443,31 +442,31 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_po
double precision :: alpha_1s, alpha_1s_inv, centr_1s(3), expo_coef_1s, tmp
double precision :: wall0, wall1
double precision, external :: NAI_pol_mult_erf_ao_with1s
double precision :: j12_mu_r12,int_env
double precision :: j12_mu_r12,int_j1b
double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2
double precision :: beta_ij,center_ij_1s(3),factor_ij_1s
print*, ' providing int2_u_grad1u_env2_test ...'
print*, ' providing int2_u_grad1u_j1b2_test ...'
dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points ao_overlap_abs List_comb_thr_b3_cent
provide mu_erf final_grid_points j1b_pen ao_overlap_abs List_comb_thr_b3_cent
call wall_time(wall0)
int2_u_grad1u_env2_test = 0.d0
int2_u_grad1u_j1b2_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist, &
!$OMP beta_ij,center_ij_1s,factor_ij_1s, &
!$OMP int_env,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) &
!$OMP int_j1b,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP ao_prod_dist_grid, ao_prod_sigma, ao_overlap_abs_grid,ao_prod_center,dsqpi_3_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, ao_abs_comb_b3_env, &
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_env2_test,thrsh_cycle_tc)
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, ao_abs_comb_b3_j1b, &
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_j1b2_test,thrsh_cycle_tc)
!$OMP DO
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
@ -485,9 +484,11 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_po
! i_1s = 1
! --- --- ---
int_env = ao_abs_comb_b3_env(1,j,i)
int_j1b = ao_abs_comb_b3_j1b(1,j,i)
! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_j_mu_1_erf(i_fit)
! if(dabs(int_j1b)*dsqpi_3_2*expo_fit**(-1.5d0).lt.thrsh_cycle_tc) cycle
coef_fit = coef_gauss_j_mu_1_erf(i_fit)
int_fit = NAI_pol_mult_erf_ao_with1s(i, j, expo_fit, r, 1.d+9, r)
tmp += coef_fit * int_fit
@ -501,7 +502,8 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_po
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_env = ao_abs_comb_b3_env(i_1s,j,i)
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
@ -511,6 +513,7 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_po
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_j_mu_1_erf(i_fit)
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
! if(factor_ij_1s*dabs(coef*int_j1b)*dsqpi_3_2*beta_ij**(-1.5d0).lt.thrsh_cycle_tc)cycle
coef_fit = coef_gauss_j_mu_1_erf(i_fit)
alpha_1s = beta + expo_fit
@ -530,7 +533,7 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_po
enddo
enddo
int2_u_grad1u_env2_test(j,i,ipoint) = tmp
int2_u_grad1u_j1b2_test(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -540,15 +543,14 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_po
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_u_grad1u_env2_test(j,i,ipoint) = int2_u_grad1u_env2_test(i,j,ipoint)
int2_u_grad1u_j1b2_test(j,i,ipoint) = int2_u_grad1u_j1b2_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u_grad1u_env2_test (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_u_grad1u_j1b2_test', wall1 - wall0
END_PROVIDER
! ---

203
plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f
View File

@ -6,7 +6,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin
BEGIN_DOC
!
! \frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) [1 - erf(mu r12)]^2
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) [1 - erf(mu r12)]^2
!
END_DOC
@ -21,8 +21,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin
print*, ' providing int2_grad1u2_grad2u2 ...'
call wall_time(wall0)
provide mu_erf
provide final_grid_points
provide mu_erf final_grid_points j1b_pen
int2_grad1u2_grad2u2 = 0.d0
@ -45,7 +44,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin
expo_fit = expo_gauss_1_erf_x_2(i_fit)
coef_fit = coef_gauss_1_erf_x_2(i_fit)
tmp += 0.25d0 * coef_fit * overlap_gauss_r12_ao(r, expo_fit, i, j)
tmp += -0.25d0 * coef_fit * overlap_gauss_r12_ao(r, expo_fit, i, j)
enddo
int2_grad1u2_grad2u2(j,i,ipoint) = tmp
@ -64,17 +63,17 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin
enddo
call wall_time(wall1)
print*, ' wall time for int2_grad1u2_grad2u2 (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_grad1u2_grad2u2 =', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
!
END_DOC
@ -88,22 +87,21 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2, (ao_num, ao_num, n_
double precision, external :: overlap_gauss_r12_ao
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing int2_grad1u2_grad2u2_env2 ...'
print*, ' providing int2_grad1u2_grad2u2_j1b2 ...'
call wall_time(wall0)
provide mu_erf
provide final_grid_points
provide mu_erf final_grid_points j1b_pen
int2_grad1u2_grad2u2_env2 = 0.d0
int2_grad1u2_grad2u2_j1b2 = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_env1s_square_coef, List_env1s_square_expo, &
!$OMP List_env1s_square_cent, int2_grad1u2_grad2u2_env2)
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
!$OMP List_all_comb_b3_cent, int2_grad1u2_grad2u2_j1b2)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
@ -127,14 +125,14 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2, (ao_num, ao_num, n_
! ---
do i_1s = 2, List_env1s_square_size
do i_1s = 2, List_all_comb_b3_size
coef = List_env1s_square_coef (i_1s)
coef = List_all_comb_b3_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_square_expo (i_1s)
B_center(1) = List_env1s_square_cent(1,i_1s)
B_center(2) = List_env1s_square_cent(2,i_1s)
B_center(3) = List_env1s_square_cent(3,i_1s)
beta = List_all_comb_b3_expo (i_1s)
B_center(1) = List_all_comb_b3_cent(1,i_1s)
B_center(2) = List_all_comb_b3_cent(2,i_1s)
B_center(3) = List_all_comb_b3_cent(3,i_1s)
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
@ -145,7 +143,7 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2, (ao_num, ao_num, n_
enddo
int2_grad1u2_grad2u2_env2(j,i,ipoint) = tmp
int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -155,23 +153,23 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2, (ao_num, ao_num, n_
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_grad1u2_grad2u2_env2(j,i,ipoint) = int2_grad1u2_grad2u2_env2(i,j,ipoint)
int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_grad1u2_grad2u2_env2 (min) =', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_grad1u2_grad2u2_j1b2 =', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, int2_u2_env2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [u_12^mu]^2
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2
!
END_DOC
@ -184,22 +182,21 @@ BEGIN_PROVIDER [double precision, int2_u2_env2, (ao_num, ao_num, n_points_final_
double precision, external :: overlap_gauss_r12_ao
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing int2_u2_env2 ...'
print*, ' providing int2_u2_j1b2 ...'
call wall_time(wall0)
provide mu_erf
provide final_grid_points
provide mu_erf final_grid_points j1b_pen
int2_u2_env2 = 0.d0
int2_u2_j1b2 = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, &
!$OMP List_env1s_square_coef, List_env1s_square_expo, &
!$OMP List_env1s_square_cent, int2_u2_env2)
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, &
!$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
!$OMP List_all_comb_b3_cent, int2_u2_j1b2)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
@ -223,14 +220,14 @@ BEGIN_PROVIDER [double precision, int2_u2_env2, (ao_num, ao_num, n_points_final_
! ---
do i_1s = 2, List_env1s_square_size
do i_1s = 2, List_all_comb_b3_size
coef = List_env1s_square_coef (i_1s)
coef = List_all_comb_b3_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_square_expo (i_1s)
B_center(1) = List_env1s_square_cent(1,i_1s)
B_center(2) = List_env1s_square_cent(2,i_1s)
B_center(3) = List_env1s_square_cent(3,i_1s)
beta = List_all_comb_b3_expo (i_1s)
B_center(1) = List_all_comb_b3_cent(1,i_1s)
B_center(2) = List_all_comb_b3_cent(2,i_1s)
B_center(3) = List_all_comb_b3_cent(3,i_1s)
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
@ -241,7 +238,7 @@ BEGIN_PROVIDER [double precision, int2_u2_env2, (ao_num, ao_num, n_points_final_
enddo
int2_u2_env2(j,i,ipoint) = tmp
int2_u2_j1b2(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -251,23 +248,23 @@ BEGIN_PROVIDER [double precision, int2_u2_env2, (ao_num, ao_num, n_points_final_
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_u2_env2(j,i,ipoint) = int2_u2_env2(i,j,ipoint)
int2_u2_j1b2(j,i,ipoint) = int2_u2_j1b2(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u2_env2 (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_u2_j1b2', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2, (ao_num, ao_num, n_points_final_grid, 3)]
BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_points_final_grid, 3)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] r2
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2
!
END_DOC
@ -279,24 +276,23 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2, (ao_num, ao_num, n_point
double precision :: tmp_x, tmp_y, tmp_z
double precision :: wall0, wall1
print*, ' providing int2_u_grad1u_x_env2 ...'
print*, ' providing int2_u_grad1u_x_j1b2 ...'
call wall_time(wall0)
provide mu_erf
provide final_grid_points
provide mu_erf final_grid_points j1b_pen
int2_u_grad1u_x_env2 = 0.d0
int2_u_grad1u_x_j1b2 = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, alpha_1s, dist, &
!$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, &
!$OMP tmp_x, tmp_y, tmp_z) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP List_env1s_square_coef, List_env1s_square_expo, &
!$OMP List_env1s_square_cent, int2_u_grad1u_x_env2)
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, alpha_1s, dist, &
!$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, &
!$OMP tmp_x, tmp_y, tmp_z) &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
!$OMP List_all_comb_b3_cent, int2_u_grad1u_x_j1b2)
!$OMP DO
do ipoint = 1, n_points_final_grid
@ -325,14 +321,14 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2, (ao_num, ao_num, n_point
! ---
do i_1s = 2, List_env1s_square_size
do i_1s = 2, List_all_comb_b3_size
coef = List_env1s_square_coef (i_1s)
coef = List_all_comb_b3_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_square_expo (i_1s)
B_center(1) = List_env1s_square_cent(1,i_1s)
B_center(2) = List_env1s_square_cent(2,i_1s)
B_center(3) = List_env1s_square_cent(3,i_1s)
beta = List_all_comb_b3_expo (i_1s)
B_center(1) = List_all_comb_b3_cent(1,i_1s)
B_center(2) = List_all_comb_b3_cent(2,i_1s)
B_center(3) = List_all_comb_b3_cent(3,i_1s)
dist = (B_center(1) - r(1)) * (B_center(1) - r(1)) &
+ (B_center(2) - r(2)) * (B_center(2) - r(2)) &
+ (B_center(3) - r(3)) * (B_center(3) - r(3))
@ -359,9 +355,9 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2, (ao_num, ao_num, n_point
enddo
int2_u_grad1u_x_env2(j,i,ipoint,1) = tmp_x
int2_u_grad1u_x_env2(j,i,ipoint,2) = tmp_y
int2_u_grad1u_x_env2(j,i,ipoint,3) = tmp_z
int2_u_grad1u_x_j1b2(j,i,ipoint,1) = tmp_x
int2_u_grad1u_x_j1b2(j,i,ipoint,2) = tmp_y
int2_u_grad1u_x_j1b2(j,i,ipoint,3) = tmp_z
enddo
enddo
enddo
@ -371,25 +367,25 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2, (ao_num, ao_num, n_point
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_u_grad1u_x_env2(j,i,ipoint,1) = int2_u_grad1u_x_env2(i,j,ipoint,1)
int2_u_grad1u_x_env2(j,i,ipoint,2) = int2_u_grad1u_x_env2(i,j,ipoint,2)
int2_u_grad1u_x_env2(j,i,ipoint,3) = int2_u_grad1u_x_env2(i,j,ipoint,3)
int2_u_grad1u_x_j1b2(j,i,ipoint,1) = int2_u_grad1u_x_j1b2(i,j,ipoint,1)
int2_u_grad1u_x_j1b2(j,i,ipoint,2) = int2_u_grad1u_x_j1b2(i,j,ipoint,2)
int2_u_grad1u_x_j1b2(j,i,ipoint,3) = int2_u_grad1u_x_j1b2(i,j,ipoint,3)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u_grad1u_x_env2 (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_u_grad1u_x_j1b2 = ', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, int2_u_grad1u_env2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu]
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu]
!
END_DOC
@ -401,23 +397,22 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_env2, (ao_num, ao_num, n_points
double precision :: wall0, wall1
double precision, external :: NAI_pol_mult_erf_ao_with1s
print*, ' providing int2_u_grad1u_env2 ...'
print*, ' providing int2_u_grad1u_j1b2 ...'
call wall_time(wall0)
provide mu_erf
provide final_grid_points
provide mu_erf final_grid_points j1b_pen
int2_u_grad1u_env2 = 0.d0
int2_u_grad1u_j1b2 = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist, &
!$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP List_env1s_square_coef, List_env1s_square_expo, &
!$OMP List_env1s_square_cent, int2_u_grad1u_env2)
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist, &
!$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
!$OMP List_all_comb_b3_cent, int2_u_grad1u_j1b2)
!$OMP DO
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
@ -441,14 +436,14 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_env2, (ao_num, ao_num, n_points
! ---
do i_1s = 2, List_env1s_square_size
do i_1s = 2, List_all_comb_b3_size
coef = List_env1s_square_coef (i_1s)
coef = List_all_comb_b3_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_square_expo (i_1s)
B_center(1) = List_env1s_square_cent(1,i_1s)
B_center(2) = List_env1s_square_cent(2,i_1s)
B_center(3) = List_env1s_square_cent(3,i_1s)
beta = List_all_comb_b3_expo (i_1s)
B_center(1) = List_all_comb_b3_cent(1,i_1s)
B_center(2) = List_all_comb_b3_cent(2,i_1s)
B_center(3) = List_all_comb_b3_cent(3,i_1s)
dist = (B_center(1) - r(1)) * (B_center(1) - r(1)) &
+ (B_center(2) - r(2)) * (B_center(2) - r(2)) &
+ (B_center(3) - r(3)) * (B_center(3) - r(3))
@ -473,7 +468,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_env2, (ao_num, ao_num, n_points
enddo
int2_u_grad1u_env2(j,i,ipoint) = tmp
int2_u_grad1u_j1b2(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -483,13 +478,13 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_env2, (ao_num, ao_num, n_points
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_u_grad1u_env2(j,i,ipoint) = int2_u_grad1u_env2(i,j,ipoint)
int2_u_grad1u_j1b2(j,i,ipoint) = int2_u_grad1u_j1b2(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u_grad1u_env2 (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for int2_u_grad1u_j1b2', wall1 - wall0
END_PROVIDER

453
plugins/local/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f Normal file
View File

@ -0,0 +1,453 @@
!
!! ---
!
!BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
!
! BEGIN_DOC
! !
! ! -\frac{1}{4} int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
! !
! END_DOC
!
! implicit none
! integer :: i, j, ipoint, i_1s, i_fit
! integer :: i_mask_grid
! double precision :: r(3), expo_fit, coef_fit
! double precision :: coef, beta, B_center(3)
! double precision :: wall0, wall1
!
! integer, allocatable :: n_mask_grid(:)
! double precision, allocatable :: r_mask_grid(:,:)
! double precision, allocatable :: int_fit_v(:)
!
! print*, ' providing int2_grad1u2_grad2u2_j1b2'
!
! provide mu_erf final_grid_points_transp j1b_pen
! call wall_time(wall0)
!
! int2_grad1u2_grad2u2_j1b2(:,:,:) = 0.d0
!
! !$OMP PARALLEL DEFAULT (NONE) &
! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,&
! !$OMP coef_fit, expo_fit, int_fit_v, n_mask_grid, &
! !$OMP i_mask_grid, r_mask_grid) &
! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size,&
! !$OMP final_grid_points_transp, n_max_fit_slat, &
! !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
! !$OMP List_all_comb_b3_cent, int2_grad1u2_grad2u2_j1b2, &
! !$OMP ao_overlap_abs)
!
! allocate(int_fit_v(n_points_final_grid))
! allocate(n_mask_grid(n_points_final_grid))
! allocate(r_mask_grid(n_points_final_grid,3))
!
! !$OMP DO SCHEDULE(dynamic)
! do i = 1, ao_num
! do j = i, ao_num
!
! if(ao_overlap_abs(j,i) .lt. 1.d-12) then
! cycle
! endif
!
! do i_fit = 1, n_max_fit_slat
!
! expo_fit = expo_gauss_1_erf_x_2(i_fit)
! coef_fit = coef_gauss_1_erf_x_2(i_fit) * (-0.25d0)
!
! ! ---
!
! call overlap_gauss_r12_ao_v(final_grid_points_transp, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, n_points_final_grid)
!
! i_mask_grid = 0 ! dim
! n_mask_grid = 0 ! ind
! r_mask_grid = 0.d0 ! val
! do ipoint = 1, n_points_final_grid
!
! int2_grad1u2_grad2u2_j1b2(j,i,ipoint) += coef_fit * int_fit_v(ipoint)
!
! if(dabs(int_fit_v(ipoint)) .gt. 1d-10) then
! i_mask_grid += 1
! n_mask_grid(i_mask_grid ) = ipoint
! r_mask_grid(i_mask_grid,1) = final_grid_points_transp(ipoint,1)
! r_mask_grid(i_mask_grid,2) = final_grid_points_transp(ipoint,2)
! r_mask_grid(i_mask_grid,3) = final_grid_points_transp(ipoint,3)
! endif
!
! enddo
!
! if(i_mask_grid .eq. 0) cycle
!
! ! ---
!
! do i_1s = 2, List_all_comb_b3_size
!
! coef = List_all_comb_b3_coef (i_1s) * coef_fit
! beta = List_all_comb_b3_expo (i_1s)
! B_center(1) = List_all_comb_b3_cent(1,i_1s)
! B_center(2) = List_all_comb_b3_cent(2,i_1s)
! B_center(3) = List_all_comb_b3_cent(3,i_1s)
!
! call overlap_gauss_r12_ao_with1s_v(B_center, beta, r_mask_grid, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, i_mask_grid)
!
! do ipoint = 1, i_mask_grid
! int2_grad1u2_grad2u2_j1b2(j,i,n_mask_grid(ipoint)) += coef * int_fit_v(ipoint)
! enddo
!
! enddo
!
! ! ---
!
! enddo
! enddo
! enddo
! !$OMP END DO
!
! deallocate(n_mask_grid)
! deallocate(r_mask_grid)
! deallocate(int_fit_v)
!
! !$OMP END PARALLEL
!
! do ipoint = 1, n_points_final_grid
! do i = 2, ao_num
! do j = 1, i-1
! int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2(i,j,ipoint)
! enddo
! enddo
! enddo
!
! call wall_time(wall1)
! print*, ' wall time for int2_grad1u2_grad2u2_j1b2', wall1 - wall0
!
!END_PROVIDER
!
!! ---
!
!BEGIN_PROVIDER [ double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
!
! BEGIN_DOC
! !
! ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2
! !
! END_DOC
!
! implicit none
! integer :: i, j, ipoint, i_1s, i_fit
! integer :: i_mask_grid
! double precision :: r(3), expo_fit, coef_fit
! double precision :: coef, beta, B_center(3), tmp
! double precision :: wall0, wall1
!
! integer, allocatable :: n_mask_grid(:)
! double precision, allocatable :: r_mask_grid(:,:)
! double precision, allocatable :: int_fit_v(:)
!
! print*, ' providing int2_u2_j1b2'
!
! provide mu_erf final_grid_points_transp j1b_pen
! call wall_time(wall0)
!
! int2_u2_j1b2(:,:,:) = 0.d0
!
! !$OMP PARALLEL DEFAULT (NONE) &
! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
! !$OMP coef_fit, expo_fit, int_fit_v, &
! !$OMP i_mask_grid, n_mask_grid, r_mask_grid ) &
! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, &
! !$OMP final_grid_points_transp, n_max_fit_slat, &
! !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, &
! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
! !$OMP List_all_comb_b3_cent, int2_u2_j1b2)
!
! allocate(n_mask_grid(n_points_final_grid))
! allocate(r_mask_grid(n_points_final_grid,3))
! allocate(int_fit_v(n_points_final_grid))
!
! !$OMP DO SCHEDULE(dynamic)
! do i = 1, ao_num
! do j = i, ao_num
!
! do i_fit = 1, n_max_fit_slat
!
! expo_fit = expo_gauss_j_mu_x_2(i_fit)
! coef_fit = coef_gauss_j_mu_x_2(i_fit)
!
! ! ---
!
! call overlap_gauss_r12_ao_v(final_grid_points_transp, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, n_points_final_grid)
!
! i_mask_grid = 0 ! dim
! n_mask_grid = 0 ! ind
! r_mask_grid = 0.d0 ! val
!
! do ipoint = 1, n_points_final_grid
! int2_u2_j1b2(j,i,ipoint) += coef_fit * int_fit_v(ipoint)
!
! if(dabs(int_fit_v(ipoint)) .gt. 1d-10) then
! i_mask_grid += 1
! n_mask_grid(i_mask_grid ) = ipoint
! r_mask_grid(i_mask_grid,1) = final_grid_points_transp(ipoint,1)
! r_mask_grid(i_mask_grid,2) = final_grid_points_transp(ipoint,2)
! r_mask_grid(i_mask_grid,3) = final_grid_points_transp(ipoint,3)
! endif
! enddo
!
! if(i_mask_grid .eq. 0) cycle
!
! ! ---
!
! do i_1s = 2, List_all_comb_b3_size
!
! coef = List_all_comb_b3_coef (i_1s) * coef_fit
! beta = List_all_comb_b3_expo (i_1s)
! B_center(1) = List_all_comb_b3_cent(1,i_1s)
! B_center(2) = List_all_comb_b3_cent(2,i_1s)
! B_center(3) = List_all_comb_b3_cent(3,i_1s)
!
! call overlap_gauss_r12_ao_with1s_v(B_center, beta, r_mask_grid, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, i_mask_grid)
!
! do ipoint = 1, i_mask_grid
! int2_u2_j1b2(j,i,n_mask_grid(ipoint)) += coef * int_fit_v(ipoint)
! enddo
!
! enddo
!
! ! ---
!
! enddo
! enddo
! enddo
! !$OMP END DO
!
! deallocate(n_mask_grid)
! deallocate(r_mask_grid)
! deallocate(int_fit_v)
!
! !$OMP END PARALLEL
!
! do ipoint = 1, n_points_final_grid
! do i = 2, ao_num
! do j = 1, i-1
! int2_u2_j1b2(j,i,ipoint) = int2_u2_j1b2(i,j,ipoint)
! enddo
! enddo
! enddo
!
! call wall_time(wall1)
! print*, ' wall time for int2_u2_j1b2', wall1 - wall0
!
!END_PROVIDER
!
!! ---
!
!BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_points_final_grid, 3)]
!
! BEGIN_DOC
! !
! ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2
! !
! END_DOC
!
! implicit none
!
! integer :: i, j, ipoint, i_1s, i_fit
! integer :: i_mask_grid1, i_mask_grid2, i_mask_grid3, i_mask_grid(3)
! double precision :: x, y, z, expo_fit, coef_fit
! double precision :: coef, beta, B_center(3)
! double precision :: alpha_1s, alpha_1s_inv, expo_coef_1s
! double precision :: wall0, wall1
!
! integer, allocatable :: n_mask_grid(:,:)
! double precision, allocatable :: r_mask_grid(:,:,:)
! double precision, allocatable :: int_fit_v(:,:), dist(:,:), centr_1s(:,:,:)
!
! print*, ' providing int2_u_grad1u_x_j1b2'
!
! provide mu_erf final_grid_points_transp j1b_pen
! call wall_time(wall0)
!
! int2_u_grad1u_x_j1b2(:,:,:,:) = 0.d0
!
! !$OMP PARALLEL DEFAULT (NONE) &
! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, x, y, z, coef, beta, &
! !$OMP coef_fit, expo_fit, int_fit_v, alpha_1s, dist, B_center,&
! !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, &
! !$OMP i_mask_grid1, i_mask_grid2, i_mask_grid3, i_mask_grid, &
! !$OMP n_mask_grid, r_mask_grid) &
! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, &
! !$OMP final_grid_points_transp, n_max_fit_slat, &
! !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
! !$OMP List_all_comb_b3_cent, int2_u_grad1u_x_j1b2)
!
! allocate(dist(n_points_final_grid,3))
! allocate(centr_1s(n_points_final_grid,3,3))
! allocate(n_mask_grid(n_points_final_grid,3))
! allocate(r_mask_grid(n_points_final_grid,3,3))
! allocate(int_fit_v(n_points_final_grid,3))
!
! !$OMP DO SCHEDULE(dynamic)
! do i = 1, ao_num
! do j = i, ao_num
! do i_fit = 1, n_max_fit_slat
!
! expo_fit = expo_gauss_j_mu_1_erf(i_fit)
! coef_fit = coef_gauss_j_mu_1_erf(i_fit)
!
! ! ---
!
! call NAI_pol_x_mult_erf_ao_with1s_v0(i, j, expo_fit, final_grid_points_transp, n_points_final_grid, 1.d+9, final_grid_points_transp, n_points_final_grid, int_fit_v, n_points_final_grid, n_points_final_grid)
!
! i_mask_grid1 = 0 ! dim
! i_mask_grid2 = 0 ! dim
! i_mask_grid3 = 0 ! dim
! n_mask_grid = 0 ! ind
! r_mask_grid = 0.d0 ! val
! do ipoint = 1, n_points_final_grid
!
! ! ---
!
! int2_u_grad1u_x_j1b2(j,i,ipoint,1) += coef_fit * int_fit_v(ipoint,1)
!
! if(dabs(int_fit_v(ipoint,1)) .gt. 1d-10) then
! i_mask_grid1 += 1
! n_mask_grid(i_mask_grid1, 1) = ipoint
! r_mask_grid(i_mask_grid1,1,1) = final_grid_points_transp(ipoint,1)
! r_mask_grid(i_mask_grid1,2,1) = final_grid_points_transp(ipoint,2)
! r_mask_grid(i_mask_grid1,3,1) = final_grid_points_transp(ipoint,3)
! endif
!
! ! ---
!
! int2_u_grad1u_x_j1b2(j,i,ipoint,2) += coef_fit * int_fit_v(ipoint,2)
!
! if(dabs(int_fit_v(ipoint,2)) .gt. 1d-10) then
! i_mask_grid2 += 1
! n_mask_grid(i_mask_grid2, 2) = ipoint
! r_mask_grid(i_mask_grid2,1,2) = final_grid_points_transp(ipoint,1)
! r_mask_grid(i_mask_grid2,2,2) = final_grid_points_transp(ipoint,2)
! r_mask_grid(i_mask_grid2,3,2) = final_grid_points_transp(ipoint,3)
! endif
!
! ! ---
!
! int2_u_grad1u_x_j1b2(j,i,ipoint,3) += coef_fit * int_fit_v(ipoint,3)
!
! if(dabs(int_fit_v(ipoint,3)) .gt. 1d-10) then
! i_mask_grid3 += 1
! n_mask_grid(i_mask_grid3, 3) = ipoint
! r_mask_grid(i_mask_grid3,1,3) = final_grid_points_transp(ipoint,1)
! r_mask_grid(i_mask_grid3,2,3) = final_grid_points_transp(ipoint,2)
! r_mask_grid(i_mask_grid3,3,3) = final_grid_points_transp(ipoint,3)
! endif
!
! ! ---
!
! enddo
!
! if((i_mask_grid1+i_mask_grid2+i_mask_grid3) .eq. 0) cycle
!
! i_mask_grid(1) = i_mask_grid1
! i_mask_grid(2) = i_mask_grid2
! i_mask_grid(3) = i_mask_grid3
!
! ! ---
!
! do i_1s = 2, List_all_comb_b3_size
!
! coef = List_all_comb_b3_coef (i_1s) * coef_fit
! beta = List_all_comb_b3_expo (i_1s)
! B_center(1) = List_all_comb_b3_cent(1,i_1s)
! B_center(2) = List_all_comb_b3_cent(2,i_1s)
! B_center(3) = List_all_comb_b3_cent(3,i_1s)
!
! alpha_1s = beta + expo_fit
! alpha_1s_inv = 1.d0 / alpha_1s
! expo_coef_1s = beta * expo_fit * alpha_1s_inv
!
! do ipoint = 1, i_mask_grid1
!
! x = r_mask_grid(ipoint,1,1)
! y = r_mask_grid(ipoint,2,1)
! z = r_mask_grid(ipoint,3,1)
!
! centr_1s(ipoint,1,1) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x)
! centr_1s(ipoint,2,1) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y)
! centr_1s(ipoint,3,1) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z)
!
! dist(ipoint,1) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z)
! enddo
!
! do ipoint = 1, i_mask_grid2
!
! x = r_mask_grid(ipoint,1,2)
! y = r_mask_grid(ipoint,2,2)
! z = r_mask_grid(ipoint,3,2)
!
! centr_1s(ipoint,1,2) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x)
! centr_1s(ipoint,2,2) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y)
! centr_1s(ipoint,3,2) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z)
!
! dist(ipoint,2) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z)
! enddo
!
! do ipoint = 1, i_mask_grid3
!
! x = r_mask_grid(ipoint,1,3)
! y = r_mask_grid(ipoint,2,3)
! z = r_mask_grid(ipoint,3,3)
!
! centr_1s(ipoint,1,3) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x)
! centr_1s(ipoint,2,3) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y)
! centr_1s(ipoint,3,3) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z)
!
! dist(ipoint,3) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z)
! enddo
!
! call NAI_pol_x_mult_erf_ao_with1s_v(i, j, alpha_1s, centr_1s, n_points_final_grid, 1.d+9, r_mask_grid, n_points_final_grid, int_fit_v, n_points_final_grid, i_mask_grid)
!
! do ipoint = 1, i_mask_grid1
! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,1),1) += coef * dexp(-expo_coef_1s * dist(ipoint,1)) * int_fit_v(ipoint,1)
! enddo
!
! do ipoint = 1, i_mask_grid2
! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,2),2) += coef * dexp(-expo_coef_1s * dist(ipoint,2)) * int_fit_v(ipoint,2)
! enddo
!
! do ipoint = 1, i_mask_grid3
! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,3),3) += coef * dexp(-expo_coef_1s * dist(ipoint,3)) * int_fit_v(ipoint,3)
! enddo
!
! enddo
!
! ! ---
!
! enddo
! enddo
! enddo
! !$OMP END DO
!
! deallocate(dist)
! deallocate(centr_1s)
! deallocate(n_mask_grid)
! deallocate(r_mask_grid)
! deallocate(int_fit_v)
!
! !$OMP END PARALLEL
!
! do ipoint = 1, n_points_final_grid
! do i = 2, ao_num
! do j = 1, i-1
! int2_u_grad1u_x_j1b2(j,i,ipoint,1) = int2_u_grad1u_x_j1b2(i,j,ipoint,1)
! int2_u_grad1u_x_j1b2(j,i,ipoint,2) = int2_u_grad1u_x_j1b2(i,j,ipoint,2)
! int2_u_grad1u_x_j1b2(j,i,ipoint,3) = int2_u_grad1u_x_j1b2(i,j,ipoint,3)
! enddo
! enddo
! enddo
!
! call wall_time(wall1)
! print*, ' wall time for int2_u_grad1u_x_j1b2 =', wall1 - wall0
!
!END_PROVIDER
!

115
plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f
View File

@ -1,11 +1,11 @@
! ---
BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R| - 1) / |r - R|
! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R|
!
END_DOC
@ -13,23 +13,24 @@ BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num,
integer :: i, j, ipoint, i_1s
double precision :: r(3), int_mu, int_coulomb
double precision :: coef, beta, B_center(3)
double precision :: tmp,int_env
double precision :: tmp,int_j1b
double precision :: wall0, wall1
double precision, external :: NAI_pol_mult_erf_ao_with1s
double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2
print*, ' providing v_ij_erf_rk_cst_mu_env_test ...'
print*, ' providing v_ij_erf_rk_cst_mu_j1b_test ...'
dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
v_ij_erf_rk_cst_mu_env_test = 0.d0
v_ij_erf_rk_cst_mu_j1b_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp, int_env)&
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp, int_j1b)&
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points, &
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_env, &
!$OMP v_ij_erf_rk_cst_mu_env_test, mu_erf, &
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_j1b, &
!$OMP v_ij_erf_rk_cst_mu_j1b_test, mu_erf, &
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc)
!$OMP DO
!do ipoint = 1, 10
@ -47,8 +48,8 @@ BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num,
coef = List_comb_thr_b2_coef (i_1s,j,i)
beta = List_comb_thr_b2_expo (i_1s,j,i)
int_env = ao_abs_comb_b2_env(i_1s,j,i)
! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
@ -59,7 +60,7 @@ BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num,
tmp += coef * (int_mu - int_coulomb)
enddo
v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) = tmp
v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -69,22 +70,22 @@ BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num,
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_env_test(i,j,ipoint)
v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for v_ij_erf_rk_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid, 3)]
BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid, 3)]
BEGIN_DOC
! int dr x phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R|) - 1)/|r - R|
! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R|
END_DOC
implicit none
@ -92,23 +93,23 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num
double precision :: coef, beta, B_center(3), r(3), ints(3), ints_coulomb(3)
double precision :: tmp_x, tmp_y, tmp_z
double precision :: wall0, wall1
double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2,int_env,factor_ij_1s,beta_ij,center_ij_1s
double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2,int_j1b,factor_ij_1s,beta_ij,center_ij_1s
print*, ' providing x_v_ij_erf_rk_cst_mu_env_test ...'
print*, ' providing x_v_ij_erf_rk_cst_mu_j1b_test ...'
dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
provide expo_erfc_mu_gauss ao_prod_sigma ao_prod_center
call wall_time(wall0)
x_v_ij_erf_rk_cst_mu_env_test = 0.d0
x_v_ij_erf_rk_cst_mu_j1b_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb, &
!$OMP int_env, tmp_x, tmp_y, tmp_z,factor_ij_1s,beta_ij,center_ij_1s) &
!$OMP int_j1b, tmp_x, tmp_y, tmp_z,factor_ij_1s,beta_ij,center_ij_1s) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points,&
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent, &
!$OMP x_v_ij_erf_rk_cst_mu_env_test, mu_erf,ao_abs_comb_b2_env, &
!$OMP x_v_ij_erf_rk_cst_mu_j1b_test, mu_erf,ao_abs_comb_b2_j1b, &
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,thrsh_cycle_tc)
! !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,expo_erfc_mu_gauss)
!$OMP DO
@ -128,8 +129,8 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num
coef = List_comb_thr_b2_coef (i_1s,j,i)
beta = List_comb_thr_b2_expo (i_1s,j,i)
int_env = ao_abs_comb_b2_env(i_1s,j,i)
! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
@ -142,9 +143,9 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num
tmp_z += coef * (ints(3) - ints_coulomb(3))
enddo
x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,1) = tmp_x
x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,2) = tmp_y
x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,3) = tmp_z
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = tmp_x
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,2) = tmp_y
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = tmp_z
enddo
enddo
enddo
@ -154,26 +155,26 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,1)
x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,2)
x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,3)
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,1)
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,2)
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,3)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for x_v_ij_erf_rk_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0
END_PROVIDER
! ---
! TODO analytically
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12)
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
!
END_DOC
@ -184,28 +185,29 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_poi
double precision :: tmp
double precision :: wall0, wall1
double precision :: beta_ij_u, factor_ij_1s_u, center_ij_1s_u(3), coeftot
double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_env
double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_j1b
double precision, external :: overlap_gauss_r12_ao
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing v_ij_u_cst_mu_env_test ...'
print*, ' providing v_ij_u_cst_mu_j1b_test ...'
dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
v_ij_u_cst_mu_env_test = 0.d0
v_ij_u_cst_mu_j1b_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP beta_ij_u, factor_ij_1s_u, center_ij_1s_u, &
!$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_env) &
!$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_j1b) &
!$OMP SHARED (n_points_final_grid, ao_num, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, &
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, &
!$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_env_test,ao_abs_comb_b2_env, &
!$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_test,ao_abs_comb_b2_j1b, &
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc)
!$OMP DO
do ipoint = 1, n_points_final_grid
@ -223,8 +225,8 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_poi
! i_1s = 1
! --- --- ---
int_env = ao_abs_comb_b2_env(1,j,i)
! if(dabs(int_env).lt.thrsh_cycle_tc) cycle
int_j1b = ao_abs_comb_b2_j1b(1,j,i)
! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_j_mu_x(i_fit)
coef_fit = coef_gauss_j_mu_x(i_fit)
@ -240,8 +242,8 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_poi
do i_1s = 2, List_comb_thr_b2_size(j,i)
coef = List_comb_thr_b2_coef (i_1s,j,i)
beta = List_comb_thr_b2_expo (i_1s,j,i)
int_env = ao_abs_comb_b2_env(i_1s,j,i)
! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
@ -257,7 +259,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_poi
enddo
enddo
v_ij_u_cst_mu_env_test(j,i,ipoint) = tmp
v_ij_u_cst_mu_j1b_test(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -267,23 +269,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_poi
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
v_ij_u_cst_mu_env_test(j,i,ipoint) = v_ij_u_cst_mu_env_test(i,j,ipoint)
v_ij_u_cst_mu_j1b_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for v_ij_u_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for v_ij_u_cst_mu_j1b_test', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) with u(mu,r12) \approx 1/2 mu e^{-2.5 * mu (r12)^2}
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) with u(mu,r12) \approx 1/2 mu e^{-2.5 * mu (r12)^2}
!
END_DOC
@ -294,26 +296,27 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num,
double precision :: tmp
double precision :: wall0, wall1
double precision :: beta_ij_u, factor_ij_1s_u, center_ij_1s_u(3), coeftot
double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_env
double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_j1b
double precision, external :: overlap_gauss_r12_ao
double precision, external :: overlap_gauss_r12_ao_with1s
dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
v_ij_u_cst_mu_env_ng_1_test = 0.d0
v_ij_u_cst_mu_j1b_ng_1_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, &
!$OMP beta_ij_u, factor_ij_1s_u, center_ij_1s_u, &
!$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_env) &
!$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_j1b) &
!$OMP SHARED (n_points_final_grid, ao_num, &
!$OMP final_grid_points, expo_good_j_mu_1gauss,coef_good_j_mu_1gauss, &
!$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, &
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, &
!$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_env_ng_1_test,ao_abs_comb_b2_env, &
!$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_ng_1_test,ao_abs_comb_b2_j1b, &
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc)
!$OMP DO
do ipoint = 1, n_points_final_grid
@ -331,8 +334,8 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num,
! i_1s = 1
! --- --- ---
int_env = ao_abs_comb_b2_env(1,j,i)
! if(dabs(int_env).lt.thrsh_cycle_tc) cycle
int_j1b = ao_abs_comb_b2_j1b(1,j,i)
! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
expo_fit = expo_good_j_mu_1gauss
int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
tmp += int_fit
@ -344,8 +347,8 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num,
do i_1s = 2, List_comb_thr_b2_size(j,i)
coef = List_comb_thr_b2_coef (i_1s,j,i)
beta = List_comb_thr_b2_expo (i_1s,j,i)
int_env = ao_abs_comb_b2_env(i_1s,j,i)
! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
@ -361,7 +364,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num,
! enddo
enddo
v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint) = tmp
v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -371,13 +374,13 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num,
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_env_ng_1_test(i,j,ipoint)
v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_ng_1_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for v_ij_u_cst_mu_env_ng_1_test (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for v_ij_u_cst_mu_j1b_ng_1_test', wall1 - wall0
END_PROVIDER

237
plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f
View File

@ -1,11 +1,11 @@
! ---
BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R| - 1) / |r - R|
! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R|
!
END_DOC
@ -17,20 +17,18 @@ BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_poi
double precision :: wall0, wall1
double precision, external :: NAI_pol_mult_erf_ao_with1s
PROVIDE mu_erf
PROVIDE final_grid_points
PROVIDE env_expo
print *, ' providing v_ij_erf_rk_cst_mu_env ...'
print *, ' providing v_ij_erf_rk_cst_mu_j1b ...'
call wall_time(wall0)
v_ij_erf_rk_cst_mu_env = 0.d0
provide mu_erf final_grid_points j1b_pen
v_ij_erf_rk_cst_mu_j1b = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, final_grid_points, &
!$OMP List_env1s_coef, List_env1s_expo, List_env1s_cent, &
!$OMP v_ij_erf_rk_cst_mu_env, mu_erf)
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, final_grid_points, &
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, List_all_comb_b2_cent, &
!$OMP v_ij_erf_rk_cst_mu_j1b, mu_erf)
!$OMP DO
!do ipoint = 1, 10
do ipoint = 1, n_points_final_grid
@ -45,27 +43,28 @@ BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_poi
! ---
coef = List_env1s_coef (1)
beta = List_env1s_expo (1)
B_center(1) = List_env1s_cent(1,1)
B_center(2) = List_env1s_cent(2,1)
B_center(3) = List_env1s_cent(3,1)
coef = List_all_comb_b2_coef (1)
beta = List_all_comb_b2_expo (1)
B_center(1) = List_all_comb_b2_cent(1,1)
B_center(2) = List_all_comb_b2_cent(2,1)
B_center(3) = List_all_comb_b2_cent(3,1)
int_mu = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
int_coulomb = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r)
! if(dabs(coef)*dabs(int_mu - int_coulomb) .lt. 1d-12) cycle
tmp += coef * (int_mu - int_coulomb)
! ---
do i_1s = 2, List_env1s_size
do i_1s = 2, List_all_comb_b2_size
coef = List_env1s_coef (i_1s)
coef = List_all_comb_b2_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_expo (i_1s)
B_center(1) = List_env1s_cent(1,i_1s)
B_center(2) = List_env1s_cent(2,i_1s)
B_center(3) = List_env1s_cent(3,i_1s)
beta = List_all_comb_b2_expo (i_1s)
B_center(1) = List_all_comb_b2_cent(1,i_1s)
B_center(2) = List_all_comb_b2_cent(2,i_1s)
B_center(3) = List_all_comb_b2_cent(3,i_1s)
int_mu = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
int_coulomb = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r)
@ -75,7 +74,7 @@ BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_poi
! ---
v_ij_erf_rk_cst_mu_env(j,i,ipoint) = tmp
v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -85,22 +84,22 @@ BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_poi
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
v_ij_erf_rk_cst_mu_env(j,i,ipoint) = v_ij_erf_rk_cst_mu_env(i,j,ipoint)
v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for v_ij_erf_rk_cst_mu_env (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for v_ij_erf_rk_cst_mu_j1b', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_points_final_grid, 3)]
BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid, 3)]
BEGIN_DOC
! int dr x phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R|) - 1)/|r - R|
! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R|
END_DOC
implicit none
@ -109,17 +108,17 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_p
double precision :: tmp_x, tmp_y, tmp_z
double precision :: wall0, wall1
print*, ' providing x_v_ij_erf_rk_cst_mu_env ...'
print*, ' providing x_v_ij_erf_rk_cst_mu_j1b ...'
call wall_time(wall0)
x_v_ij_erf_rk_cst_mu_env = 0.d0
x_v_ij_erf_rk_cst_mu_j1b = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb, &
!$OMP tmp_x, tmp_y, tmp_z) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, final_grid_points,&
!$OMP List_env1s_coef, List_env1s_expo, List_env1s_cent, &
!$OMP x_v_ij_erf_rk_cst_mu_env, mu_erf)
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, final_grid_points,&
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, List_all_comb_b2_cent, &
!$OMP x_v_ij_erf_rk_cst_mu_j1b, mu_erf)
!$OMP DO
!do ipoint = 1, 10
do ipoint = 1, n_points_final_grid
@ -136,11 +135,11 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_p
! ---
coef = List_env1s_coef (1)
beta = List_env1s_expo (1)
B_center(1) = List_env1s_cent(1,1)
B_center(2) = List_env1s_cent(2,1)
B_center(3) = List_env1s_cent(3,1)
coef = List_all_comb_b2_coef (1)
beta = List_all_comb_b2_expo (1)
B_center(1) = List_all_comb_b2_cent(1,1)
B_center(2) = List_all_comb_b2_cent(2,1)
B_center(3) = List_all_comb_b2_cent(3,1)
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints )
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, ints_coulomb)
@ -153,14 +152,14 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_p
! ---
do i_1s = 2, List_env1s_size
do i_1s = 2, List_all_comb_b2_size
coef = List_env1s_coef (i_1s)
coef = List_all_comb_b2_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_expo (i_1s)
B_center(1) = List_env1s_cent(1,i_1s)
B_center(2) = List_env1s_cent(2,i_1s)
B_center(3) = List_env1s_cent(3,i_1s)
beta = List_all_comb_b2_expo (i_1s)
B_center(1) = List_all_comb_b2_cent(1,i_1s)
B_center(2) = List_all_comb_b2_cent(2,i_1s)
B_center(3) = List_all_comb_b2_cent(3,i_1s)
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints )
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, ints_coulomb)
@ -172,9 +171,9 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_p
! ---
x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,1) = tmp_x
x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,2) = tmp_y
x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,3) = tmp_z
x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,1) = tmp_x
x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,2) = tmp_y
x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,3) = tmp_z
enddo
enddo
enddo
@ -184,25 +183,25 @@ BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_p
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1)
x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2)
x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3)
x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1)
x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2)
x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for x_v_ij_erf_rk_cst_mu_env (min) =', (wall1 - wall0) / 60.d0
print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b =', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_fit, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12)
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
!
END_DOC
@ -215,23 +214,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_fit, (ao_num, ao_num, n_poin
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing v_ij_u_cst_mu_env_fit ...'
print*, ' providing v_ij_u_cst_mu_j1b_fit ...'
call wall_time(wall0)
provide mu_erf final_grid_points env_expo
provide mu_erf final_grid_points j1b_pen
PROVIDE ng_fit_jast expo_gauss_j_mu_x coef_gauss_j_mu_x
PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent
PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent
v_ij_u_cst_mu_env_fit = 0.d0
v_ij_u_cst_mu_j1b_fit = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, &
!$OMP List_env1s_coef, List_env1s_expo, &
!$OMP List_env1s_cent, v_ij_u_cst_mu_env_fit)
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, &
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_fit)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
@ -248,11 +247,11 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_fit, (ao_num, ao_num, n_poin
! ---
coef = List_env1s_coef (1)
beta = List_env1s_expo (1)
B_center(1) = List_env1s_cent(1,1)
B_center(2) = List_env1s_cent(2,1)
B_center(3) = List_env1s_cent(3,1)
coef = List_all_comb_b2_coef (1)
beta = List_all_comb_b2_expo (1)
B_center(1) = List_all_comb_b2_cent(1,1)
B_center(2) = List_all_comb_b2_cent(2,1)
B_center(3) = List_all_comb_b2_cent(3,1)
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
@ -260,14 +259,14 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_fit, (ao_num, ao_num, n_poin
! ---
do i_1s = 2, List_env1s_size
do i_1s = 2, List_all_comb_b2_size
coef = List_env1s_coef (i_1s)
coef = List_all_comb_b2_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_expo (i_1s)
B_center(1) = List_env1s_cent(1,i_1s)
B_center(2) = List_env1s_cent(2,i_1s)
B_center(3) = List_env1s_cent(3,i_1s)
beta = List_all_comb_b2_expo (i_1s)
B_center(1) = List_all_comb_b2_cent(1,i_1s)
B_center(2) = List_all_comb_b2_cent(2,i_1s)
B_center(3) = List_all_comb_b2_cent(3,i_1s)
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
@ -278,7 +277,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_fit, (ao_num, ao_num, n_poin
enddo
v_ij_u_cst_mu_env_fit(j,i,ipoint) = tmp
v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -288,23 +287,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_fit, (ao_num, ao_num, n_poin
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
v_ij_u_cst_mu_env_fit(j,i,ipoint) = v_ij_u_cst_mu_env_fit(i,j,ipoint)
v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = v_ij_u_cst_mu_j1b_fit(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for v_ij_u_cst_mu_env_fit (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for v_ij_u_cst_mu_j1b_fit', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an_old, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12)
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
!
END_DOC
@ -323,24 +322,24 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an_old, (ao_num, ao_num, n_p
double precision, external :: overlap_gauss_r12_ao_with1s
double precision, external :: NAI_pol_mult_erf_ao_with1s
print*, ' providing v_ij_u_cst_mu_env_an_old ...'
print*, ' providing v_ij_u_cst_mu_j1b_an_old ...'
call wall_time(wall0)
provide mu_erf final_grid_points env_expo
PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent
provide mu_erf final_grid_points j1b_pen
PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent
ct = inv_sq_pi_2 / mu_erf
v_ij_u_cst_mu_env_an_old = 0.d0
v_ij_u_cst_mu_j1b_an_old = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, &
!$OMP r1_2, tmp, int_c1, int_e1, int_o, int_c2, &
!$OMP int_e2, int_c3, int_e3) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, &
!$OMP final_grid_points, mu_erf, ct, &
!$OMP List_env1s_coef, List_env1s_expo, &
!$OMP List_env1s_cent, v_ij_u_cst_mu_env_an_old)
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, &
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an_old)
!$OMP DO
do ipoint = 1, n_points_final_grid
@ -354,11 +353,11 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an_old, (ao_num, ao_num, n_p
! ---
coef = List_env1s_coef (1)
beta = List_env1s_expo (1)
B_center(1) = List_env1s_cent(1,1)
B_center(2) = List_env1s_cent(2,1)
B_center(3) = List_env1s_cent(3,1)
coef = List_all_comb_b2_coef (1)
beta = List_all_comb_b2_expo (1)
B_center(1) = List_all_comb_b2_cent(1,1)
B_center(2) = List_all_comb_b2_cent(2,1)
B_center(3) = List_all_comb_b2_cent(3,1)
int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r)
int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
@ -380,14 +379,14 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an_old, (ao_num, ao_num, n_p
! ---
do i_1s = 2, List_env1s_size
do i_1s = 2, List_all_comb_b2_size
coef = List_env1s_coef (i_1s)
coef = List_all_comb_b2_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_expo (i_1s)
B_center(1) = List_env1s_cent(1,i_1s)
B_center(2) = List_env1s_cent(2,i_1s)
B_center(3) = List_env1s_cent(3,i_1s)
beta = List_all_comb_b2_expo (i_1s)
B_center(1) = List_all_comb_b2_cent(1,i_1s)
B_center(2) = List_all_comb_b2_cent(2,i_1s)
B_center(3) = List_all_comb_b2_cent(3,i_1s)
int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r)
int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
@ -411,7 +410,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an_old, (ao_num, ao_num, n_p
! ---
v_ij_u_cst_mu_env_an_old(j,i,ipoint) = tmp
v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -421,23 +420,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an_old, (ao_num, ao_num, n_p
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
v_ij_u_cst_mu_env_an_old(j,i,ipoint) = v_ij_u_cst_mu_env_an_old(i,j,ipoint)
v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) = v_ij_u_cst_mu_j1b_an_old(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for v_ij_u_cst_mu_env_an_old (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for v_ij_u_cst_mu_j1b_an_old', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an, (ao_num, ao_num, n_points_final_grid)]
BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12)
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
!
END_DOC
@ -455,23 +454,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an, (ao_num, ao_num, n_point
double precision, external :: overlap_gauss_r12_ao_with1s
double precision, external :: NAI_pol_mult_erf_ao_with1s
print*, ' providing v_ij_u_cst_mu_env_an ...'
print*, ' providing v_ij_u_cst_mu_j1b_an ...'
call wall_time(wall0)
provide mu_erf final_grid_points env_expo
PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent
provide mu_erf final_grid_points j1b_pen
PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent
ct = inv_sq_pi_2 / mu_erf
v_ij_u_cst_mu_env_an = 0.d0
v_ij_u_cst_mu_j1b_an = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, &
!$OMP r1_2, tmp, int_c, int_e, int_o) &
!$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, &
!$OMP final_grid_points, mu_erf, ct, &
!$OMP List_env1s_coef, List_env1s_expo, &
!$OMP List_env1s_cent, v_ij_u_cst_mu_env_an)
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, &
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an)
!$OMP DO
do ipoint = 1, n_points_final_grid
@ -485,11 +484,11 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an, (ao_num, ao_num, n_point
! ---
coef = List_env1s_coef (1)
beta = List_env1s_expo (1)
B_center(1) = List_env1s_cent(1,1)
B_center(2) = List_env1s_cent(2,1)
B_center(3) = List_env1s_cent(3,1)
coef = List_all_comb_b2_coef (1)
beta = List_all_comb_b2_expo (1)
B_center(1) = List_all_comb_b2_cent(1,1)
B_center(2) = List_all_comb_b2_cent(2,1)
B_center(3) = List_all_comb_b2_cent(3,1)
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c)
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e)
@ -505,14 +504,14 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an, (ao_num, ao_num, n_point
! ---
do i_1s = 2, List_env1s_size
do i_1s = 2, List_all_comb_b2_size
coef = List_env1s_coef (i_1s)
coef = List_all_comb_b2_coef (i_1s)
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
beta = List_env1s_expo (i_1s)
B_center(1) = List_env1s_cent(1,i_1s)
B_center(2) = List_env1s_cent(2,i_1s)
B_center(3) = List_env1s_cent(3,i_1s)
beta = List_all_comb_b2_expo (i_1s)
B_center(1) = List_all_comb_b2_cent(1,i_1s)
B_center(2) = List_all_comb_b2_cent(2,i_1s)
B_center(3) = List_all_comb_b2_cent(3,i_1s)
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c)
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e)
@ -530,7 +529,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an, (ao_num, ao_num, n_point
! ---
v_ij_u_cst_mu_env_an(j,i,ipoint) = tmp
v_ij_u_cst_mu_j1b_an(j,i,ipoint) = tmp
enddo
enddo
enddo
@ -540,13 +539,13 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an, (ao_num, ao_num, n_point
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
v_ij_u_cst_mu_env_an(j,i,ipoint) = v_ij_u_cst_mu_env_an(i,j,ipoint)
v_ij_u_cst_mu_j1b_an(j,i,ipoint) = v_ij_u_cst_mu_j1b_an(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for v_ij_u_cst_mu_env_an (min) = ', (wall1 - wall0) / 60.d0
print*, ' wall time for v_ij_u_cst_mu_j1b_an', wall1 - wall0
END_PROVIDER

574
plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f
View File

@ -1,574 +0,0 @@
! ---
BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_0, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_x, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_y, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_z, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! Ir2_Mu_long_Du_0 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12]
!
! Ir2_Mu_long_Du_x = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * x2
! Ir2_Mu_long_Du_y = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * y2
! Ir2_Mu_long_Du_z = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * z2
!
! Ir2_Mu_long_Du_2 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * r2^2
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s
double precision :: r(3), int_clb(7), int_erf(7)
double precision :: c_1s, e_1s, R_1s(3)
double precision :: tmp_Du_0, tmp_Du_x, tmp_Du_y, tmp_Du_z, tmp_Du_2
double precision :: wall0, wall1
PROVIDE mu_erf
PROVIDE final_grid_points
PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent
print *, ' providing Ir2_Mu_long_Du ...'
call wall_time(wall0)
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, c_1s, e_1s, R_1s, int_erf, int_clb, &
!$OMP tmp_Du_0, tmp_Du_x, tmp_Du_y, tmp_Du_z, tmp_Du_2) &
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_erf, &
!$OMP List_env1s_size, List_env1s_expo, &
!$OMP List_env1s_coef, List_env1s_cent, &
!$OMP Ir2_Mu_long_Du_0, Ir2_Mu_long_Du_x, &
!$OMP Ir2_Mu_long_Du_y, Ir2_Mu_long_Du_z, &
!$OMP Ir2_Mu_long_Du_2)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
do i = 1, ao_num
do j = i, ao_num
call NAI_pol_012_mult_erf_ao(i, j, 1.d+9, r, int_clb)
call NAI_pol_012_mult_erf_ao(i, j, mu_erf, r, int_erf)
tmp_Du_0 = int_clb(1) - int_erf(1)
tmp_Du_x = int_clb(2) - int_erf(2)
tmp_Du_y = int_clb(3) - int_erf(3)
tmp_Du_z = int_clb(4) - int_erf(4)
tmp_Du_2 = int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)
do i_1s = 2, List_env1s_size
e_1s = List_env1s_expo(i_1s)
c_1s = List_env1s_coef(i_1s)
R_1s(1) = List_env1s_cent(1,i_1s)
R_1s(2) = List_env1s_cent(2,i_1s)
R_1s(3) = List_env1s_cent(3,i_1s)
call NAI_pol_012_mult_erf_ao_with1s(i, j, e_1s, R_1s, 1.d+9, r, int_clb)
call NAI_pol_012_mult_erf_ao_with1s(i, j, e_1s, R_1s, mu_erf, r, int_erf)
tmp_Du_0 = tmp_Du_0 + c_1s * (int_clb(1) - int_erf(1))
tmp_Du_x = tmp_Du_x + c_1s * (int_clb(2) - int_erf(2))
tmp_Du_y = tmp_Du_y + c_1s * (int_clb(3) - int_erf(3))
tmp_Du_z = tmp_Du_z + c_1s * (int_clb(4) - int_erf(4))
tmp_Du_2 = tmp_Du_2 + c_1s * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7))
enddo
Ir2_Mu_long_Du_0(j,i,ipoint) = tmp_Du_0
Ir2_Mu_long_Du_x(j,i,ipoint) = tmp_Du_x
Ir2_Mu_long_Du_y(j,i,ipoint) = tmp_Du_y
Ir2_Mu_long_Du_z(j,i,ipoint) = tmp_Du_z
Ir2_Mu_long_Du_2(j,i,ipoint) = tmp_Du_2
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
Ir2_Mu_long_Du_0(j,i,ipoint) = Ir2_Mu_long_Du_0(i,j,ipoint)
Ir2_Mu_long_Du_x(j,i,ipoint) = Ir2_Mu_long_Du_x(i,j,ipoint)
Ir2_Mu_long_Du_y(j,i,ipoint) = Ir2_Mu_long_Du_y(i,j,ipoint)
Ir2_Mu_long_Du_z(j,i,ipoint) = Ir2_Mu_long_Du_z(i,j,ipoint)
Ir2_Mu_long_Du_2(j,i,ipoint) = Ir2_Mu_long_Du_2(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for Ir2_Mu_long_Du (min) = ', (wall1 - wall0) / 60.d0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, Ir2_Mu_gauss_Du, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! Ir2_Mu_gauss_Du = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) e^{-(mu r_12)^2}
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s
double precision :: r(3)
double precision :: coef, beta, B_center(3)
double precision :: tmp_Du
double precision :: mu_sq, dx, dy, dz, tmp_arg, rmu_sq(3)
double precision :: e_1s, c_1s, R_1s(3)
double precision :: wall0, wall1
double precision, external :: overlap_gauss_r12_ao
PROVIDE mu_erf
PROVIDE final_grid_points
PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent
print *, ' providing Ir2_Mu_gauss_Du ...'
call wall_time(wall0)
mu_sq = mu_erf * mu_erf
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, dx, dy, dz, r, tmp_arg, coef, &
!$OMP rmu_sq, e_1s, c_1s, R_1s, beta, B_center, tmp_Du) &
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, &
!$OMP List_env1s_size, List_env1s_expo, &
!$OMP List_env1s_coef, List_env1s_cent, &
!$OMP Ir2_Mu_gauss_Du)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
rmu_sq(1) = mu_sq * r(1)
rmu_sq(2) = mu_sq * r(2)
rmu_sq(3) = mu_sq * r(3)
do i = 1, ao_num
do j = i, ao_num
tmp_Du = overlap_gauss_r12_ao(r, mu_sq, j, i)
do i_1s = 2, List_env1s_size
e_1s = List_env1s_expo(i_1s)
c_1s = List_env1s_coef(i_1s)
R_1s(1) = List_env1s_cent(1,i_1s)
R_1s(2) = List_env1s_cent(2,i_1s)
R_1s(3) = List_env1s_cent(3,i_1s)
dx = r(1) - R_1s(1)
dy = r(2) - R_1s(2)
dz = r(3) - R_1s(3)
beta = mu_sq + e_1s
tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta
coef = c_1s * dexp(-tmp_arg)
B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta
B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta
B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta
tmp_Du += coef * overlap_gauss_r12_ao(B_center, beta, j, i)
enddo
Ir2_Mu_gauss_Du(j,i,ipoint) = tmp_Du
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
Ir2_Mu_gauss_Du(j,i,ipoint) = Ir2_Mu_gauss_Du(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for Ir2_Mu_gauss_Du (min) = ', (wall1 - wall0) / 60.d0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_0, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_x, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_y, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_z, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! Ir2_Mu_long_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12]
!
! Ir2_Mu_long_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * x2
! Ir2_Mu_long_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * y2
! Ir2_Mu_long_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * z2
!
! Ir2_Mu_long_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * r2^2
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s
double precision :: r(3), int_clb(7), int_erf(7)
double precision :: coef, beta, B_center(3)
double precision :: tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2
double precision :: mu_sq, tmp_arg, dx, dy, dz, rmu_sq(3)
double precision :: e_1s, c_1s, R_1s(3)
double precision :: wall0, wall1
PROVIDE mu_erf
PROVIDE final_grid_points
PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent
print *, ' providing Ir2_Mu_long_Du2 ...'
call wall_time(wall0)
mu_sq = mu_erf * mu_erf
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, rmu_sq, dx, dy, dz, &
!$OMP e_1s, c_1s, R_1s, tmp_arg, coef, beta, B_center, &
!$OMP int_erf, int_clb, &
!$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) &
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, &
!$OMP mu_erf, List_env1s_square_size, List_env1s_square_expo, &
!$OMP List_env1s_square_coef, List_env1s_square_cent, &
!$OMP Ir2_Mu_long_Du2_0, Ir2_Mu_long_Du2_x, &
!$OMP Ir2_Mu_long_Du2_y, Ir2_Mu_long_Du2_z, &
!$OMP Ir2_Mu_long_Du2_2)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
rmu_sq(1) = mu_sq * r(1)
rmu_sq(2) = mu_sq * r(2)
rmu_sq(3) = mu_sq * r(3)
do i = 1, ao_num
do j = i, ao_num
call NAI_pol_012_mult_erf_ao_with1s(i, j, mu_sq, r, 1.d+9, r, int_clb)
call NAI_pol_012_mult_erf_ao_with1s(i, j, mu_sq, r, mu_erf, r, int_erf)
tmp_Du2_0 = int_clb(1) - int_erf(1)
tmp_Du2_x = int_clb(2) - int_erf(2)
tmp_Du2_y = int_clb(3) - int_erf(3)
tmp_Du2_z = int_clb(4) - int_erf(4)
tmp_Du2_2 = int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)
do i_1s = 2, List_env1s_square_size
e_1s = List_env1s_square_expo(i_1s)
c_1s = List_env1s_square_coef(i_1s)
R_1s(1) = List_env1s_square_cent(1,i_1s)
R_1s(2) = List_env1s_square_cent(2,i_1s)
R_1s(3) = List_env1s_square_cent(3,i_1s)
dx = r(1) - R_1s(1)
dy = r(2) - R_1s(2)
dz = r(3) - R_1s(3)
beta = mu_sq + e_1s
tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta
coef = c_1s * dexp(-tmp_arg)
B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta
B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta
B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_clb)
call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_erf)
tmp_Du2_0 = tmp_Du2_0 + coef * (int_clb(1) - int_erf(1))
tmp_Du2_x = tmp_Du2_x + coef * (int_clb(2) - int_erf(2))
tmp_Du2_y = tmp_Du2_y + coef * (int_clb(3) - int_erf(3))
tmp_Du2_z = tmp_Du2_z + coef * (int_clb(4) - int_erf(4))
tmp_Du2_2 = tmp_Du2_2 + coef * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7))
enddo
Ir2_Mu_long_Du2_0(j,i,ipoint) = tmp_Du2_0
Ir2_Mu_long_Du2_x(j,i,ipoint) = tmp_Du2_x
Ir2_Mu_long_Du2_y(j,i,ipoint) = tmp_Du2_y
Ir2_Mu_long_Du2_z(j,i,ipoint) = tmp_Du2_z
Ir2_Mu_long_Du2_2(j,i,ipoint) = tmp_Du2_2
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
Ir2_Mu_long_Du2_0(j,i,ipoint) = Ir2_Mu_long_Du2_0(i,j,ipoint)
Ir2_Mu_long_Du2_x(j,i,ipoint) = Ir2_Mu_long_Du2_x(i,j,ipoint)
Ir2_Mu_long_Du2_y(j,i,ipoint) = Ir2_Mu_long_Du2_y(i,j,ipoint)
Ir2_Mu_long_Du2_z(j,i,ipoint) = Ir2_Mu_long_Du2_z(i,j,ipoint)
Ir2_Mu_long_Du2_2(j,i,ipoint) = Ir2_Mu_long_Du2_2(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for Ir2_Mu_long_Du2 (min) = ', (wall1 - wall0) / 60.d0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, Ir2_Mu_gauss_Du2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! Ir2_Mu_gauss_Du2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 e^{-(mu r_12)^2}
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s
double precision :: r(3)
double precision :: coef, beta, B_center(3)
double precision :: tmp_Du2
double precision :: mu_sq, dx, dy, dz, tmp_arg, rmu_sq(3)
double precision :: e_1s, c_1s, R_1s(3)
double precision :: wall0, wall1
double precision, external :: overlap_gauss_r12_ao
PROVIDE mu_erf
PROVIDE final_grid_points
PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent
print *, ' providing Ir2_Mu_gauss_Du2 ...'
call wall_time(wall0)
mu_sq = 2.d0 * mu_erf * mu_erf
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, dx, dy, dz, r, tmp_arg, coef, &
!$OMP rmu_sq, e_1s, c_1s, R_1s, beta, B_center, tmp_Du2) &
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, &
!$OMP List_env1s_square_size, List_env1s_square_expo, &
!$OMP List_env1s_square_coef, List_env1s_square_cent, &
!$OMP Ir2_Mu_gauss_Du2)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
rmu_sq(1) = mu_sq * r(1)
rmu_sq(2) = mu_sq * r(2)
rmu_sq(3) = mu_sq * r(3)
do i = 1, ao_num
do j = i, ao_num
tmp_Du2 = overlap_gauss_r12_ao(r, mu_sq, j, i)
do i_1s = 2, List_env1s_square_size
e_1s = List_env1s_square_expo(i_1s)
c_1s = List_env1s_square_coef(i_1s)
R_1s(1) = List_env1s_square_cent(1,i_1s)
R_1s(2) = List_env1s_square_cent(2,i_1s)
R_1s(3) = List_env1s_square_cent(3,i_1s)
dx = r(1) - R_1s(1)
dy = r(2) - R_1s(2)
dz = r(3) - R_1s(3)
beta = mu_sq + e_1s
tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta
coef = c_1s * dexp(-tmp_arg)
B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta
B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta
B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta
tmp_Du2 += coef * overlap_gauss_r12_ao(B_center, beta, j, i)
enddo
Ir2_Mu_gauss_Du2(j,i,ipoint) = tmp_Du2
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
Ir2_Mu_gauss_Du2(j,i,ipoint) = Ir2_Mu_gauss_Du2(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for Ir2_Mu_gauss_Du2 (min) = ', (wall1 - wall0) / 60.d0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_0, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_x, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_y, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_z, (ao_num, ao_num, n_points_final_grid)]
&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! Ir2_Mu_short_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2
!
! Ir2_Mu_short_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * x2
! Ir2_Mu_short_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * y2
! Ir2_Mu_short_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * z2
!
! Ir2_Mu_short_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * r2^2
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s, i_fit
double precision :: r(3), ints(7)
double precision :: coef, beta, B_center(3)
double precision :: tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2
double precision :: tmp_arg, dx, dy, dz
double precision :: expo_fit, coef_fit, e_1s, c_1s, R_1s(3)
double precision :: wall0, wall1
PROVIDE final_grid_points
PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent
PROVIDE ng_fit_jast expo_gauss_1_erf_x_2 coef_gauss_1_erf_x_2
print *, ' providing Ir2_Mu_short_Du2 ...'
call wall_time(wall0)
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, dx, dy, dz, &
!$OMP expo_fit, coef_fit, e_1s, c_1s, R_1s, &
!$OMP tmp_arg, coef, beta, B_center, ints, &
!$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) &
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, &
!$OMP ng_fit_jast, expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_env1s_square_size, List_env1s_square_expo, &
!$OMP List_env1s_square_coef, List_env1s_square_cent, &
!$OMP Ir2_Mu_short_Du2_0, Ir2_Mu_short_Du2_x, &
!$OMP Ir2_Mu_short_Du2_y, Ir2_Mu_short_Du2_z, &
!$OMP Ir2_Mu_short_Du2_2)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
do i = 1, ao_num
do j = i, ao_num
tmp_Du2_0 = 0.d0
tmp_Du2_x = 0.d0
tmp_Du2_y = 0.d0
tmp_Du2_z = 0.d0
tmp_Du2_2 = 0.d0
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_1_erf_x_2(i_fit)
coef_fit = coef_gauss_1_erf_x_2(i_fit)
call overlap_gauss_r12_ao_012(r, expo_fit, i, j, ints)
tmp_Du2_0 += coef_fit * ints(1)
tmp_Du2_x += coef_fit * ints(2)
tmp_Du2_y += coef_fit * ints(3)
tmp_Du2_z += coef_fit * ints(4)
tmp_Du2_2 += coef_fit * (ints(5) + ints(6) + ints(7))
do i_1s = 2, List_env1s_square_size
e_1s = List_env1s_square_expo(i_1s)
c_1s = List_env1s_square_coef(i_1s)
R_1s(1) = List_env1s_square_cent(1,i_1s)
R_1s(2) = List_env1s_square_cent(2,i_1s)
R_1s(3) = List_env1s_square_cent(3,i_1s)
dx = r(1) - R_1s(1)
dy = r(2) - R_1s(2)
dz = r(3) - R_1s(3)
beta = expo_fit + e_1s
tmp_arg = expo_fit * e_1s * (dx*dx + dy*dy + dz*dz) / beta
coef = coef_fit * c_1s * dexp(-tmp_arg)
B_center(1) = (expo_fit * r(1) + e_1s * R_1s(1)) / beta
B_center(2) = (expo_fit * r(2) + e_1s * R_1s(2)) / beta
B_center(3) = (expo_fit * r(3) + e_1s * R_1s(3)) / beta
call overlap_gauss_r12_ao_012(B_center, beta, i, j, ints)
tmp_Du2_0 += coef * ints(1)
tmp_Du2_x += coef * ints(2)
tmp_Du2_y += coef * ints(3)
tmp_Du2_z += coef * ints(4)
tmp_Du2_2 += coef * (ints(5) + ints(6) + ints(7))
enddo ! i_1s
enddo ! i_fit
Ir2_Mu_short_Du2_0(j,i,ipoint) = tmp_Du2_0
Ir2_Mu_short_Du2_x(j,i,ipoint) = tmp_Du2_x
Ir2_Mu_short_Du2_y(j,i,ipoint) = tmp_Du2_y
Ir2_Mu_short_Du2_z(j,i,ipoint) = tmp_Du2_z
Ir2_Mu_short_Du2_2(j,i,ipoint) = tmp_Du2_2
enddo ! j
enddo ! i
enddo ! ipoint
!$OMP END DO
!$OMP END PARALLEL
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
Ir2_Mu_short_Du2_0(j,i,ipoint) = Ir2_Mu_short_Du2_0(i,j,ipoint)
Ir2_Mu_short_Du2_x(j,i,ipoint) = Ir2_Mu_short_Du2_x(i,j,ipoint)
Ir2_Mu_short_Du2_y(j,i,ipoint) = Ir2_Mu_short_Du2_y(i,j,ipoint)
Ir2_Mu_short_Du2_z(j,i,ipoint) = Ir2_Mu_short_Du2_z(i,j,ipoint)
Ir2_Mu_short_Du2_2(j,i,ipoint) = Ir2_Mu_short_Du2_2(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for Ir2_Mu_short_Du2 (min) = ', (wall1 - wall0) / 60.d0
END_PROVIDER
! ---

366
plugins/local/ao_many_one_e_ints/listj1b.irp.f Normal file
View File

@ -0,0 +1,366 @@
! ---
BEGIN_PROVIDER [integer, List_all_comb_b2_size]
implicit none
PROVIDE j1b_type
if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
List_all_comb_b2_size = 2**nucl_num
elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
List_all_comb_b2_size = nucl_num + 1
else
print *, 'j1b_type = ', j1b_type, 'is not implemented'
stop
endif
print *, ' nb of linear terms in the envelope is ', List_all_comb_b2_size
END_PROVIDER
! ---
BEGIN_PROVIDER [integer, List_all_comb_b2, (nucl_num, List_all_comb_b2_size)]
implicit none
integer :: i, j
if(nucl_num .gt. 32) then
print *, ' nucl_num = ', nucl_num, '> 32'
stop
endif
List_all_comb_b2 = 0
do i = 0, List_all_comb_b2_size-1
do j = 0, nucl_num-1
if (btest(i,j)) then
List_all_comb_b2(j+1,i+1) = 1
endif
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, List_all_comb_b2_coef, ( List_all_comb_b2_size)]
&BEGIN_PROVIDER [ double precision, List_all_comb_b2_expo, ( List_all_comb_b2_size)]
&BEGIN_PROVIDER [ double precision, List_all_comb_b2_cent, (3, List_all_comb_b2_size)]
implicit none
integer :: i, j, k, phase
double precision :: tmp_alphaj, tmp_alphak
double precision :: tmp_cent_x, tmp_cent_y, tmp_cent_z
provide j1b_pen
provide j1b_pen_coef
List_all_comb_b2_coef = 0.d0
List_all_comb_b2_expo = 0.d0
List_all_comb_b2_cent = 0.d0
if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
do i = 1, List_all_comb_b2_size
tmp_cent_x = 0.d0
tmp_cent_y = 0.d0
tmp_cent_z = 0.d0
do j = 1, nucl_num
tmp_alphaj = dble(List_all_comb_b2(j,i)) * j1b_pen(j)
List_all_comb_b2_expo(i) += tmp_alphaj
tmp_cent_x += tmp_alphaj * nucl_coord(j,1)
tmp_cent_y += tmp_alphaj * nucl_coord(j,2)
tmp_cent_z += tmp_alphaj * nucl_coord(j,3)
enddo
if(List_all_comb_b2_expo(i) .lt. 1d-10) cycle
List_all_comb_b2_cent(1,i) = tmp_cent_x / List_all_comb_b2_expo(i)
List_all_comb_b2_cent(2,i) = tmp_cent_y / List_all_comb_b2_expo(i)
List_all_comb_b2_cent(3,i) = tmp_cent_z / List_all_comb_b2_expo(i)
enddo
! ---
do i = 1, List_all_comb_b2_size
do j = 2, nucl_num, 1
tmp_alphaj = dble(List_all_comb_b2(j,i)) * j1b_pen(j)
do k = 1, j-1, 1
tmp_alphak = dble(List_all_comb_b2(k,i)) * j1b_pen(k)
List_all_comb_b2_coef(i) += tmp_alphaj * tmp_alphak * ( (nucl_coord(j,1) - nucl_coord(k,1)) * (nucl_coord(j,1) - nucl_coord(k,1)) &
+ (nucl_coord(j,2) - nucl_coord(k,2)) * (nucl_coord(j,2) - nucl_coord(k,2)) &
+ (nucl_coord(j,3) - nucl_coord(k,3)) * (nucl_coord(j,3) - nucl_coord(k,3)) )
enddo
enddo
if(List_all_comb_b2_expo(i) .lt. 1d-10) cycle
List_all_comb_b2_coef(i) = List_all_comb_b2_coef(i) / List_all_comb_b2_expo(i)
enddo
! ---
do i = 1, List_all_comb_b2_size
phase = 0
do j = 1, nucl_num
phase += List_all_comb_b2(j,i)
enddo
List_all_comb_b2_coef(i) = (-1.d0)**dble(phase) * dexp(-List_all_comb_b2_coef(i))
enddo
elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
List_all_comb_b2_coef( 1) = 1.d0
List_all_comb_b2_expo( 1) = 0.d0
List_all_comb_b2_cent(1:3,1) = 0.d0
do i = 1, nucl_num
List_all_comb_b2_coef( i+1) = -1.d0 * j1b_pen_coef(i)
List_all_comb_b2_expo( i+1) = j1b_pen(i)
List_all_comb_b2_cent(1,i+1) = nucl_coord(i,1)
List_all_comb_b2_cent(2,i+1) = nucl_coord(i,2)
List_all_comb_b2_cent(3,i+1) = nucl_coord(i,3)
enddo
else
print *, 'j1b_type = ', j1b_type, 'is not implemented'
stop
endif
!print *, ' coeff, expo & cent of list b2'
!do i = 1, List_all_comb_b2_size
! print*, i, List_all_comb_b2_coef(i), List_all_comb_b2_expo(i)
! print*, List_all_comb_b2_cent(1,i), List_all_comb_b2_cent(2,i), List_all_comb_b2_cent(3,i)
!enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [ integer, List_all_comb_b3_size]
implicit none
double precision :: tmp
if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
List_all_comb_b3_size = 3**nucl_num
elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
tmp = 0.5d0 * dble(nucl_num) * (dble(nucl_num) + 3.d0)
List_all_comb_b3_size = int(tmp) + 1
else
print *, 'j1b_type = ', j1b_type, 'is not implemented'
stop
endif
print *, ' nb of linear terms in the square of the envelope is ', List_all_comb_b3_size
END_PROVIDER
! ---
BEGIN_PROVIDER [integer, List_all_comb_b3, (nucl_num, List_all_comb_b3_size)]
implicit none
integer :: i, j, ii, jj
integer, allocatable :: M(:,:), p(:)
if(nucl_num .gt. 32) then
print *, ' nucl_num = ', nucl_num, '> 32'
stop
endif
List_all_comb_b3(:,:) = 0
List_all_comb_b3(:,List_all_comb_b3_size) = 2
allocate(p(nucl_num))
p = 0
do i = 2, List_all_comb_b3_size-1
do j = 1, nucl_num
ii = 0
do jj = 1, j-1, 1
ii = ii + p(jj) * 3**(jj-1)
enddo
p(j) = modulo(i-1-ii, 3**j) / 3**(j-1)
List_all_comb_b3(j,i) = p(j)
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, List_all_comb_b3_coef, ( List_all_comb_b3_size)]
&BEGIN_PROVIDER [ double precision, List_all_comb_b3_expo, ( List_all_comb_b3_size)]
&BEGIN_PROVIDER [ double precision, List_all_comb_b3_cent, (3, List_all_comb_b3_size)]
implicit none
integer :: i, j, k, phase
integer :: ii
double precision :: tmp_alphaj, tmp_alphak, facto
double precision :: tmp1, tmp2, tmp3, tmp4
double precision :: xi, yi, zi, xj, yj, zj
double precision :: dx, dy, dz, r2
provide j1b_pen
provide j1b_pen_coef
List_all_comb_b3_coef = 0.d0
List_all_comb_b3_expo = 0.d0
List_all_comb_b3_cent = 0.d0
if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
do i = 1, List_all_comb_b3_size
do j = 1, nucl_num
tmp_alphaj = dble(List_all_comb_b3(j,i)) * j1b_pen(j)
List_all_comb_b3_expo(i) += tmp_alphaj
List_all_comb_b3_cent(1,i) += tmp_alphaj * nucl_coord(j,1)
List_all_comb_b3_cent(2,i) += tmp_alphaj * nucl_coord(j,2)
List_all_comb_b3_cent(3,i) += tmp_alphaj * nucl_coord(j,3)
enddo
if(List_all_comb_b3_expo(i) .lt. 1d-10) cycle
ASSERT(List_all_comb_b3_expo(i) .gt. 0d0)
List_all_comb_b3_cent(1,i) = List_all_comb_b3_cent(1,i) / List_all_comb_b3_expo(i)
List_all_comb_b3_cent(2,i) = List_all_comb_b3_cent(2,i) / List_all_comb_b3_expo(i)
List_all_comb_b3_cent(3,i) = List_all_comb_b3_cent(3,i) / List_all_comb_b3_expo(i)
enddo
! ---
do i = 1, List_all_comb_b3_size
do j = 2, nucl_num, 1
tmp_alphaj = dble(List_all_comb_b3(j,i)) * j1b_pen(j)
do k = 1, j-1, 1
tmp_alphak = dble(List_all_comb_b3(k,i)) * j1b_pen(k)
List_all_comb_b3_coef(i) += tmp_alphaj * tmp_alphak * ( (nucl_coord(j,1) - nucl_coord(k,1)) * (nucl_coord(j,1) - nucl_coord(k,1)) &
+ (nucl_coord(j,2) - nucl_coord(k,2)) * (nucl_coord(j,2) - nucl_coord(k,2)) &
+ (nucl_coord(j,3) - nucl_coord(k,3)) * (nucl_coord(j,3) - nucl_coord(k,3)) )
enddo
enddo
if(List_all_comb_b3_expo(i) .lt. 1d-10) cycle
List_all_comb_b3_coef(i) = List_all_comb_b3_coef(i) / List_all_comb_b3_expo(i)
enddo
! ---
do i = 1, List_all_comb_b3_size
facto = 1.d0
phase = 0
do j = 1, nucl_num
tmp_alphaj = dble(List_all_comb_b3(j,i))
facto *= 2.d0 / (gamma(tmp_alphaj+1.d0) * gamma(3.d0-tmp_alphaj))
phase += List_all_comb_b3(j,i)
enddo
List_all_comb_b3_coef(i) = (-1.d0)**dble(phase) * facto * dexp(-List_all_comb_b3_coef(i))
enddo
elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
ii = 1
List_all_comb_b3_coef( ii) = 1.d0
List_all_comb_b3_expo( ii) = 0.d0
List_all_comb_b3_cent(1:3,ii) = 0.d0
do i = 1, nucl_num
ii = ii + 1
List_all_comb_b3_coef( ii) = -2.d0 * j1b_pen_coef(i)
List_all_comb_b3_expo( ii) = j1b_pen(i)
List_all_comb_b3_cent(1,ii) = nucl_coord(i,1)
List_all_comb_b3_cent(2,ii) = nucl_coord(i,2)
List_all_comb_b3_cent(3,ii) = nucl_coord(i,3)
enddo
do i = 1, nucl_num
ii = ii + 1
List_all_comb_b3_coef( ii) = 1.d0 * j1b_pen_coef(i) * j1b_pen_coef(i)
List_all_comb_b3_expo( ii) = 2.d0 * j1b_pen(i)
List_all_comb_b3_cent(1,ii) = nucl_coord(i,1)
List_all_comb_b3_cent(2,ii) = nucl_coord(i,2)
List_all_comb_b3_cent(3,ii) = nucl_coord(i,3)
enddo
do i = 1, nucl_num-1
tmp1 = j1b_pen(i)
xi = nucl_coord(i,1)
yi = nucl_coord(i,2)
zi = nucl_coord(i,3)
do j = i+1, nucl_num
tmp2 = j1b_pen(j)
tmp3 = tmp1 + tmp2
tmp4 = 1.d0 / tmp3
xj = nucl_coord(j,1)
yj = nucl_coord(j,2)
zj = nucl_coord(j,3)
dx = xi - xj
dy = yi - yj
dz = zi - zj
r2 = dx*dx + dy*dy + dz*dz
ii = ii + 1
! x 2 to avoid doing integrals twice
List_all_comb_b3_coef( ii) = 2.d0 * dexp(-tmp1*tmp2*tmp4*r2) * j1b_pen_coef(i) * j1b_pen_coef(j)
List_all_comb_b3_expo( ii) = tmp3
List_all_comb_b3_cent(1,ii) = tmp4 * (tmp1 * xi + tmp2 * xj)
List_all_comb_b3_cent(2,ii) = tmp4 * (tmp1 * yi + tmp2 * yj)
List_all_comb_b3_cent(3,ii) = tmp4 * (tmp1 * zi + tmp2 * zj)
enddo
enddo
else
print *, 'j1b_type = ', j1b_type, 'is not implemented'
stop
endif
!print *, ' coeff, expo & cent of list b3'
!do i = 1, List_all_comb_b3_size
! print*, i, List_all_comb_b3_coef(i), List_all_comb_b3_expo(i)
! print*, List_all_comb_b3_cent(1,i), List_all_comb_b3_cent(2,i), List_all_comb_b3_cent(3,i)
!enddo
END_PROVIDER
! ---

356
plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f
View File

@ -1,197 +1,181 @@
! ---
BEGIN_PROVIDER [integer, List_comb_thr_b2_size, (ao_num, ao_num)]
&BEGIN_PROVIDER [integer, max_List_comb_thr_b2_size]
implicit none
integer :: i_1s, i, j, ipoint
integer :: list(ao_num)
double precision :: coef,beta,center(3),int_env
double precision :: r(3),weight,dist
List_comb_thr_b2_size = 0
print*,'List_env1s_size = ',List_env1s_size
do i = 1, ao_num
do j = i, ao_num
do i_1s = 1, List_env1s_size
coef = List_env1s_coef(i_1s)
if(dabs(coef).lt.thrsh_cycle_tc) cycle
beta = List_env1s_expo(i_1s)
beta = max(beta,1.d-12)
center(1:3) = List_env1s_cent(1:3,i_1s)
int_env = 0.d0
do ipoint = 1, n_points_extra_final_grid
r(1:3) = final_grid_points_extra(1:3,ipoint)
weight = final_weight_at_r_vector_extra(ipoint)
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then
List_comb_thr_b2_size(j,i) += 1
endif
enddo
enddo
BEGIN_PROVIDER [ integer, List_comb_thr_b2_size, (ao_num, ao_num)]
&BEGIN_PROVIDER [ integer, max_List_comb_thr_b2_size]
implicit none
integer :: i_1s,i,j,ipoint
double precision :: coef,beta,center(3),int_j1b
double precision :: r(3),weight,dist
List_comb_thr_b2_size = 0
print*,'List_all_comb_b2_size = ',List_all_comb_b2_size
! pause
do i = 1, ao_num
do j = i, ao_num
do i_1s = 1, List_all_comb_b2_size
coef = List_all_comb_b2_coef (i_1s)
if(dabs(coef).lt.thrsh_cycle_tc)cycle
beta = List_all_comb_b2_expo (i_1s)
beta = max(beta,1.d-12)
center(1:3) = List_all_comb_b2_cent(1:3,i_1s)
int_j1b = 0.d0
do ipoint = 1, n_points_extra_final_grid
r(1:3) = final_grid_points_extra(1:3,ipoint)
weight = final_weight_at_r_vector_extra(ipoint)
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then
List_comb_thr_b2_size(j,i) += 1
endif
enddo
enddo
enddo
do i = 1, ao_num
do j = 1, i-1
List_comb_thr_b2_size(j,i) = List_comb_thr_b2_size(i,j)
enddo
do i = 1, ao_num
do j = 1, i-1
List_comb_thr_b2_size(j,i) = List_comb_thr_b2_size(i,j)
enddo
enddo
do i = 1, ao_num
list(i) = maxval(List_comb_thr_b2_size(:,i))
enddo
max_List_comb_thr_b2_size = maxval(list)
print*, ' max_List_comb_thr_b2_size = ',max_List_comb_thr_b2_size
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, List_comb_thr_b2_coef, ( max_List_comb_thr_b2_size,ao_num,ao_num)]
&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_expo, ( max_List_comb_thr_b2_size,ao_num,ao_num)]
&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_cent, (3,max_List_comb_thr_b2_size,ao_num,ao_num)]
&BEGIN_PROVIDER [ double precision, ao_abs_comb_b2_env , ( max_List_comb_thr_b2_size,ao_num,ao_num)]
implicit none
integer :: i_1s,i,j,ipoint,icount
double precision :: coef,beta,center(3),int_env
double precision :: r(3),weight,dist
ao_abs_comb_b2_env = 10000000.d0
do i = 1, ao_num
do j = i, ao_num
icount = 0
do i_1s = 1, List_env1s_size
coef = List_env1s_coef (i_1s)
if(dabs(coef).lt.thrsh_cycle_tc)cycle
beta = List_env1s_expo (i_1s)
center(1:3) = List_env1s_cent(1:3,i_1s)
int_env = 0.d0
do ipoint = 1, n_points_extra_final_grid
r(1:3) = final_grid_points_extra(1:3,ipoint)
weight = final_weight_at_r_vector_extra(ipoint)
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then
icount += 1
List_comb_thr_b2_coef(icount,j,i) = coef
List_comb_thr_b2_expo(icount,j,i) = beta
List_comb_thr_b2_cent(1:3,icount,j,i) = center(1:3)
ao_abs_comb_b2_env(icount,j,i) = int_env
endif
enddo
enddo
enddo
do i = 1, ao_num
do j = 1, i-1
do icount = 1, List_comb_thr_b2_size(j,i)
List_comb_thr_b2_coef(icount,j,i) = List_comb_thr_b2_coef(icount,i,j)
List_comb_thr_b2_expo(icount,j,i) = List_comb_thr_b2_expo(icount,i,j)
List_comb_thr_b2_cent(1:3,icount,j,i) = List_comb_thr_b2_cent(1:3,icount,i,j)
enddo
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [integer, List_comb_thr_b3_size, (ao_num,ao_num)]
&BEGIN_PROVIDER [integer, max_List_comb_thr_b3_size]
implicit none
integer :: i_1s,i,j,ipoint
enddo
integer :: list(ao_num)
double precision :: coef,beta,center(3),int_env
double precision :: r(3),weight,dist
List_comb_thr_b3_size = 0
print*,'List_env1s_square_size = ',List_env1s_square_size
do i = 1, ao_num
do j = 1, ao_num
do i_1s = 1, List_env1s_square_size
coef = List_env1s_square_coef (i_1s)
beta = List_env1s_square_expo (i_1s)
center(1:3) = List_env1s_square_cent(1:3,i_1s)
if(dabs(coef).lt.thrsh_cycle_tc)cycle
int_env = 0.d0
do ipoint = 1, n_points_extra_final_grid
r(1:3) = final_grid_points_extra(1:3,ipoint)
weight = final_weight_at_r_vector_extra(ipoint)
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc) then
List_comb_thr_b3_size(j,i) += 1
endif
enddo
enddo
enddo
do i = 1, ao_num
list(i) = maxval(List_comb_thr_b3_size(:,i))
enddo
max_List_comb_thr_b3_size = maxval(list)
print*, ' max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size
do i = 1, ao_num
list(i) = maxval(List_comb_thr_b2_size(:,i))
enddo
max_List_comb_thr_b2_size = maxval(list)
print*,'max_List_comb_thr_b2_size = ',max_List_comb_thr_b2_size
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, List_comb_thr_b2_coef, ( max_List_comb_thr_b2_size,ao_num, ao_num )]
&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_expo, ( max_List_comb_thr_b2_size,ao_num, ao_num )]
&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_cent, (3, max_List_comb_thr_b2_size,ao_num, ao_num )]
&BEGIN_PROVIDER [ double precision, ao_abs_comb_b2_j1b, ( max_List_comb_thr_b2_size ,ao_num, ao_num)]
implicit none
integer :: i_1s,i,j,ipoint,icount
double precision :: coef,beta,center(3),int_j1b
double precision :: r(3),weight,dist
ao_abs_comb_b2_j1b = 10000000.d0
do i = 1, ao_num
do j = i, ao_num
icount = 0
do i_1s = 1, List_all_comb_b2_size
coef = List_all_comb_b2_coef (i_1s)
if(dabs(coef).lt.thrsh_cycle_tc)cycle
beta = List_all_comb_b2_expo (i_1s)
center(1:3) = List_all_comb_b2_cent(1:3,i_1s)
int_j1b = 0.d0
do ipoint = 1, n_points_extra_final_grid
r(1:3) = final_grid_points_extra(1:3,ipoint)
weight = final_weight_at_r_vector_extra(ipoint)
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then
icount += 1
List_comb_thr_b2_coef(icount,j,i) = coef
List_comb_thr_b2_expo(icount,j,i) = beta
List_comb_thr_b2_cent(1:3,icount,j,i) = center(1:3)
ao_abs_comb_b2_j1b(icount,j,i) = int_j1b
endif
enddo
enddo
enddo
BEGIN_PROVIDER [double precision, List_comb_thr_b3_coef, ( max_List_comb_thr_b3_size,ao_num,ao_num)]
&BEGIN_PROVIDER [double precision, List_comb_thr_b3_expo, ( max_List_comb_thr_b3_size,ao_num,ao_num)]
&BEGIN_PROVIDER [double precision, List_comb_thr_b3_cent, (3, max_List_comb_thr_b3_size,ao_num,ao_num)]
&BEGIN_PROVIDER [double precision, ao_abs_comb_b3_env , ( max_List_comb_thr_b3_size,ao_num,ao_num)]
implicit none
integer :: i_1s,i,j,ipoint,icount
double precision :: coef,beta,center(3),int_env
double precision :: r(3),weight,dist
ao_abs_comb_b3_env = 10000000.d0
do i = 1, ao_num
do j = 1, ao_num
icount = 0
do i_1s = 1, List_env1s_square_size
coef = List_env1s_square_coef (i_1s)
beta = List_env1s_square_expo (i_1s)
beta = max(beta,1.d-12)
center(1:3) = List_env1s_square_cent(1:3,i_1s)
if(dabs(coef).lt.thrsh_cycle_tc)cycle
int_env = 0.d0
do ipoint = 1, n_points_extra_final_grid
r(1:3) = final_grid_points_extra(1:3,ipoint)
weight = final_weight_at_r_vector_extra(ipoint)
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then
icount += 1
List_comb_thr_b3_coef(icount,j,i) = coef
List_comb_thr_b3_expo(icount,j,i) = beta
List_comb_thr_b3_cent(1:3,icount,j,i) = center(1:3)
ao_abs_comb_b3_env(icount,j,i) = int_env
endif
enddo
enddo
do i = 1, ao_num
do j = 1, i-1
do icount = 1, List_comb_thr_b2_size(j,i)
List_comb_thr_b2_coef(icount,j,i) = List_comb_thr_b2_coef(icount,i,j)
List_comb_thr_b2_expo(icount,j,i) = List_comb_thr_b2_expo(icount,i,j)
List_comb_thr_b2_cent(1:3,icount,j,i) = List_comb_thr_b2_cent(1:3,icount,i,j)
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, List_comb_thr_b3_size, (ao_num, ao_num)]
&BEGIN_PROVIDER [ integer, max_List_comb_thr_b3_size]
implicit none
integer :: i_1s,i,j,ipoint
double precision :: coef,beta,center(3),int_j1b
double precision :: r(3),weight,dist
List_comb_thr_b3_size = 0
print*,'List_all_comb_b3_size = ',List_all_comb_b3_size
do i = 1, ao_num
do j = 1, ao_num
do i_1s = 1, List_all_comb_b3_size
coef = List_all_comb_b3_coef (i_1s)
beta = List_all_comb_b3_expo (i_1s)
center(1:3) = List_all_comb_b3_cent(1:3,i_1s)
if(dabs(coef).lt.thrsh_cycle_tc)cycle
int_j1b = 0.d0
do ipoint = 1, n_points_extra_final_grid
r(1:3) = final_grid_points_extra(1:3,ipoint)
weight = final_weight_at_r_vector_extra(ipoint)
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then
List_comb_thr_b3_size(j,i) += 1
endif
enddo
enddo
enddo
! do i = 1, ao_num
! do j = 1, i-1
! List_comb_thr_b3_size(j,i) = List_comb_thr_b3_size(i,j)
! enddo
! enddo
integer :: list(ao_num)
do i = 1, ao_num
list(i) = maxval(List_comb_thr_b3_size(:,i))
enddo
max_List_comb_thr_b3_size = maxval(list)
print*,'max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size
END_PROVIDER
BEGIN_PROVIDER [ double precision, List_comb_thr_b3_coef, ( max_List_comb_thr_b3_size,ao_num, ao_num )]
&BEGIN_PROVIDER [ double precision, List_comb_thr_b3_expo, ( max_List_comb_thr_b3_size,ao_num, ao_num )]
&BEGIN_PROVIDER [ double precision, List_comb_thr_b3_cent, (3, max_List_comb_thr_b3_size,ao_num, ao_num )]
&BEGIN_PROVIDER [ double precision, ao_abs_comb_b3_j1b, ( max_List_comb_thr_b3_size ,ao_num, ao_num)]
implicit none
integer :: i_1s,i,j,ipoint,icount
double precision :: coef,beta,center(3),int_j1b
double precision :: r(3),weight,dist
ao_abs_comb_b3_j1b = 10000000.d0
do i = 1, ao_num
do j = 1, ao_num
icount = 0
do i_1s = 1, List_all_comb_b3_size
coef = List_all_comb_b3_coef (i_1s)
beta = List_all_comb_b3_expo (i_1s)
beta = max(beta,1.d-12)
center(1:3) = List_all_comb_b3_cent(1:3,i_1s)
if(dabs(coef).lt.thrsh_cycle_tc)cycle
int_j1b = 0.d0
do ipoint = 1, n_points_extra_final_grid
r(1:3) = final_grid_points_extra(1:3,ipoint)
weight = final_weight_at_r_vector_extra(ipoint)
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then
icount += 1
List_comb_thr_b3_coef(icount,j,i) = coef
List_comb_thr_b3_expo(icount,j,i) = beta
List_comb_thr_b3_cent(1:3,icount,j,i) = center(1:3)
ao_abs_comb_b3_j1b(icount,j,i) = int_j1b
endif
enddo
enddo
enddo
END_PROVIDER
! ---

2
plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f
View File

@ -200,7 +200,7 @@ subroutine overlap_gauss_r12_v(D_center, LD_D, delta, A_center, B_center, power_
deallocate(A_new, A_center_new, fact_a_new, iorder_a_new, overlap)
end
end subroutine overlap_gauss_r12_v
!---

2
plugins/local/ao_tc_eff_map/NEED
View File

@ -3,5 +3,3 @@ mo_one_e_ints
ao_many_one_e_ints
dft_utils_in_r
tc_keywords
hamiltonian
jastrow

11
plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f
View File

@ -23,9 +23,10 @@ subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_va
logical, external :: ao_two_e_integral_zero
double precision :: ao_tc_sym_two_e_pot, ao_two_e_integral_erf
double precision :: env_gauss_2e_j1, env_gauss_2e_j2
double precision :: j1b_gauss_2e_j1, j1b_gauss_2e_j2
PROVIDE j1b_type
thr = ao_integrals_threshold
@ -52,6 +53,14 @@ subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_va
integral_erf = ao_two_e_integral_erf(i, k, j, l)
integral = integral_erf + integral_pot
!if( j1b_type .eq. 1 ) then
! !print *, ' j1b type 1 is added'
! integral = integral + j1b_gauss_2e_j1(i, k, j, l)
!elseif( j1b_type .eq. 2 ) then
! !print *, ' j1b type 2 is added'
! integral = integral + j1b_gauss_2e_j2(i, k, j, l)
!endif
if(abs(integral) < thr) then
cycle
endif

193
plugins/local/jastrow/fit_j.irp.f → plugins/local/ao_tc_eff_map/fit_j.irp.f
View File

@ -1,67 +1,41 @@
BEGIN_PROVIDER [ double precision, expo_j_xmu_1gauss ]
&BEGIN_PROVIDER [ double precision, coef_j_xmu_1gauss ]
implicit none
BEGIN_DOC
! Upper bound long range fit of F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2)
!
! with a single gaussian.
!
! Such a function can be used to screen integrals with F(x).
END_DOC
expo_j_xmu_1gauss = 0.5d0
coef_j_xmu_1gauss = 1.d0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, expo_j_xmu_1gauss]
&BEGIN_PROVIDER [double precision, coef_j_xmu_1gauss]
implicit none
BEGIN_DOC
! Upper bound long range fit of F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2)
!
! with a single gaussian.
!
! Such a function can be used to screen integrals with F(x).
END_DOC
expo_j_xmu_1gauss = 0.5d0
coef_j_xmu_1gauss = 1.d0
BEGIN_PROVIDER [ double precision, expo_erfc_gauss ]
implicit none
expo_erfc_gauss = 1.41211d0
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, expo_erfc_gauss]
implicit none
expo_erfc_gauss = 1.41211d0
BEGIN_PROVIDER [ double precision, expo_erfc_mu_gauss ]
implicit none
expo_erfc_mu_gauss = expo_erfc_gauss * mu_erf * mu_erf
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, expo_good_j_mu_1gauss ]
&BEGIN_PROVIDER [ double precision, coef_good_j_mu_1gauss ]
implicit none
BEGIN_DOC
! exponent of Gaussian in order to obtain an upper bound of J(r12,mu)
!
! Can be used to scree integrals with J(r12,mu)
END_DOC
expo_good_j_mu_1gauss = 2.D0 * mu_erf * expo_j_xmu_1gauss
coef_good_j_mu_1gauss = 0.5d0/mu_erf * coef_j_xmu_1gauss
END_PROVIDER
BEGIN_PROVIDER [double precision, expo_erfc_mu_gauss]
implicit none
expo_erfc_mu_gauss = expo_erfc_gauss * mu_erf * mu_erf
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, expo_good_j_mu_1gauss]
&BEGIN_PROVIDER [double precision, coef_good_j_mu_1gauss]
BEGIN_DOC
!
! exponent of Gaussian in order to obtain an upper bound of J(r12,mu)
!
! Can be used to scree integrals with J(r12,mu)
!
END_DOC
implicit none
expo_good_j_mu_1gauss = 2.d0 * mu_erf * expo_j_xmu_1gauss
coef_good_j_mu_1gauss = 0.5d0/mu_erf * coef_j_xmu_1gauss
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, expo_j_xmu, (n_fit_1_erf_x)]
BEGIN_PROVIDER [ double precision, expo_j_xmu, (n_fit_1_erf_x) ]
BEGIN_DOC
! F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) is fitted with a gaussian and a Slater
@ -491,86 +465,53 @@ END_PROVIDER
! ---
double precision function F_x_j(x)
BEGIN_DOC
!
! dimension-less correlation factor:
!
! F_x_j(x) = x (1 - erf(x)) - 1/sqrt(pi) exp(-x^2)
!
END_DOC
implicit none
double precision, intent(in) :: x
F_x_j = x * (1.d0 - derf(x)) - 1/dsqrt(dacos(-1.d0)) * dexp(-x**2)
implicit none
BEGIN_DOC
! F_x_j(x) = dimension-less correlation factor = x (1 - erf(x)) - 1/sqrt(pi) exp(-x^2)
END_DOC
double precision, intent(in) :: x
F_x_j = x * (1.d0 - derf(x)) - 1/dsqrt(dacos(-1.d0)) * dexp(-x**2)
end
! ---
double precision function j_mu_F_x_j(x)
BEGIN_DOC
!
! correlation factor:
!
! j_mu_F_x_j(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
! = 1/(2*mu) * F_x_j(mu*x)
!
END_DOC
implicit none
double precision, intent(in) :: x
double precision :: F_x_j
j_mu_F_x_j = 0.5d0/mu_erf * F_x_j(x*mu_erf)
implicit none
BEGIN_DOC
! j_mu_F_x_j(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
!
! = 1/(2*mu) * F_x_j(mu*x)
END_DOC
double precision :: F_x_j
double precision, intent(in) :: x
j_mu_F_x_j = 0.5d0/mu_erf * F_x_j(x*mu_erf)
end
! ---
double precision function j_mu(x)
BEGIN_DOC
!
! correlation factor:
!
! j_mu(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
!
END_DOC
implicit none
double precision, intent(in) :: x
j_mu = 0.5d0* x * (1.d0 - derf(mu_erf*x)) - 0.5d0/( dsqrt(dacos(-1.d0))*mu_erf) * dexp(-(mu_erf*x)*(mu_erf*x))
implicit none
double precision, intent(in) :: x
BEGIN_DOC
! j_mu(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
END_DOC
j_mu = 0.5d0* x * (1.d0 - derf(mu_erf*x)) - 0.5d0/( dsqrt(dacos(-1.d0))*mu_erf) * dexp(-(mu_erf*x)*(mu_erf*x))
end
! ---
double precision function j_mu_fit_gauss(x)
BEGIN_DOC
!
! correlation factor fitted with gaussians:
!
! j_mu_fit_gauss(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
!
!
END_DOC
implicit none
double precision, intent(in) :: x
integer :: i
double precision :: alpha, coef
j_mu_fit_gauss = 0.d0
do i = 1, n_max_fit_slat
alpha = expo_gauss_j_mu_x(i)
coef = coef_gauss_j_mu_x(i)
j_mu_fit_gauss += coef * dexp(-alpha*x*x)
enddo
implicit none
BEGIN_DOC
! j_mu_fit_gauss(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
!
! but fitted with gaussians
END_DOC
double precision, intent(in) :: x
integer :: i
double precision :: alpha,coef
j_mu_fit_gauss = 0.d0
do i = 1, n_max_fit_slat
alpha = expo_gauss_j_mu_x(i)
coef = coef_gauss_j_mu_x(i)
j_mu_fit_gauss += coef * dexp(-alpha*x*x)
enddo
end

145
plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f
View File

@ -1,10 +1,10 @@
! ---
BEGIN_PROVIDER [double precision, env_gauss_hermII, (ao_num,ao_num)]
BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)]
BEGIN_DOC
!
! :math:`\langle \chi_A | -0.5 \grad \tau_{env} \cdot \grad \tau_{env} | \chi_B \rangle`
! :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle`
!
END_DOC
@ -22,6 +22,8 @@ BEGIN_PROVIDER [double precision, env_gauss_hermII, (ao_num,ao_num)]
double precision :: int_gauss_4G
PROVIDE j1b_type j1b_pen j1b_coeff
! --------------------------------------------------------------------------------
! -- Dummy call to provide everything
dim1 = 100
@ -36,7 +38,10 @@ BEGIN_PROVIDER [double precision, env_gauss_hermII, (ao_num,ao_num)]
! --------------------------------------------------------------------------------
env_gauss_hermII(1:ao_num,1:ao_num) = 0.d0
j1b_gauss_hermII(1:ao_num,1:ao_num) = 0.d0
if(j1b_type .eq. 1) then
! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)]
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
@ -46,51 +51,113 @@ BEGIN_PROVIDER [double precision, env_gauss_hermII, (ao_num,ao_num)]
!$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, env_expo, env_gauss_hermII)
!$OMP nucl_num, j1b_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 = env_expo(k1)
C_center1(1:3) = nucl_coord(k1,1:3)
do k2 = 1, nucl_num
gama2 = env_expo(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
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_pen(k1)
C_center1(1:3) = nucl_coord(k1,1:3)
do k2 = 1, nucl_num
gama2 = j1b_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
env_gauss_hermII(i,j) = env_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
elseif(j1b_type .eq. 2) then
! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)]
!$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 coef1, coef2) &
!$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_pen, j1b_gauss_hermII, &
!$OMP j1b_coeff)
!$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_pen (k1)
coef1 = j1b_coeff(k1)
C_center1(1:3) = nucl_coord(k1,1:3)
do k2 = 1, nucl_num
gama2 = j1b_pen (k2)
coef2 = j1b_coeff(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 * coef1 * coef2 * 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
endif
END_PROVIDER

142
plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f
View File

@ -1,10 +1,10 @@
! ---
BEGIN_PROVIDER [double precision, env_gauss_hermI, (ao_num,ao_num)]
BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)]
BEGIN_DOC
!
! :math:`\langle \chi_A | -0.5 \Delta \tau_{env} | \chi_B \rangle`
! :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \rangle`
!
END_DOC
@ -22,6 +22,8 @@ BEGIN_PROVIDER [double precision, env_gauss_hermI, (ao_num,ao_num)]
double precision :: int_gauss_r0, int_gauss_r2
PROVIDE j1b_type j1b_pen j1b_coeff
! --------------------------------------------------------------------------------
! -- Dummy call to provide everything
dim1 = 100
@ -35,7 +37,10 @@ BEGIN_PROVIDER [double precision, env_gauss_hermI, (ao_num,ao_num)]
, overlap_y, d_a_2, overlap_z, overlap, dim1 )
! --------------------------------------------------------------------------------
env_gauss_hermI(1:ao_num,1:ao_num) = 0.d0
j1b_gauss_hermI(1:ao_num,1:ao_num) = 0.d0
if(j1b_type .eq. 1) then
! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)]
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
@ -45,50 +50,109 @@ BEGIN_PROVIDER [double precision, env_gauss_hermI, (ao_num,ao_num)]
!$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, env_expo, env_gauss_hermI)
!$OMP nucl_num, j1b_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 = env_expo(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
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_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
env_gauss_hermI(i,j) = env_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
elseif(j1b_type .eq. 2) then
! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)]
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, coef, &
!$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_pen, j1b_gauss_hermI, &
!$OMP j1b_coeff)
!$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_pen (k)
coef = j1b_coeff(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 * coef * c1 - 2.d0 * gama * gama * coef * 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
endif
END_PROVIDER

130
plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f
View File

@ -1,11 +1,10 @@
! ---
BEGIN_PROVIDER [double precision, env_gauss_nonherm, (ao_num,ao_num)]
BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)]
BEGIN_DOC
!
! env_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{env} \cdot grad | \chi_i \rangle
! j1b_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{1b} \cdot grad | \chi_i \rangle
!
END_DOC
@ -23,6 +22,8 @@ BEGIN_PROVIDER [double precision, env_gauss_nonherm, (ao_num,ao_num)]
double precision :: int_gauss_deriv
PROVIDE j1b_type j1b_pen j1b_coeff
! --------------------------------------------------------------------------------
! -- Dummy call to provide everything
dim1 = 100
@ -37,8 +38,10 @@ BEGIN_PROVIDER [double precision, env_gauss_nonherm, (ao_num,ao_num)]
! --------------------------------------------------------------------------------
env_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0
j1b_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0
if(j1b_type .eq. 1) then
! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)]
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
@ -48,46 +51,101 @@ BEGIN_PROVIDER [double precision, env_gauss_nonherm, (ao_num,ao_num)]
!$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, env_expo, env_gauss_nonherm)
!$OMP nucl_num, j1b_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 = env_expo(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
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_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
env_gauss_nonherm(i,j) = env_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
elseif(j1b_type .eq. 2) then
! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)]
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, coef, &
!$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_pen, j1b_gauss_nonherm, &
!$OMP j1b_coeff)
!$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_pen (k)
coef = j1b_coeff(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 * coef * 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
endif
END_PROVIDER

146
plugins/local/jastrow/fit_potential.irp.f → plugins/local/ao_tc_eff_map/potential.irp.f
View File

@ -1,16 +1,13 @@
! ---
BEGIN_PROVIDER [integer, n_gauss_eff_pot]
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
implicit none
@ -24,13 +21,10 @@ END_PROVIDER
BEGIN_PROVIDER [integer, n_gauss_eff_pot_deriv]
BEGIN_DOC
!
! V(r12) = -(1 - erf(mu*r12))^2 is expanded in Gaussians as Eqs A11-A20 in JCP 154, 084119 (2021)
!
END_DOC
implicit none
n_gauss_eff_pot_deriv = ng_fit_jast
END_PROVIDER
@ -41,13 +35,11 @@ END_PROVIDER
&BEGIN_PROVIDER [double precision, coef_gauss_eff_pot, (n_gauss_eff_pot)]
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'
@ -72,9 +64,7 @@ END_PROVIDER
double precision function eff_pot_gauss(x, mu)
BEGIN_DOC
!
! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2)
!
END_DOC
implicit none
@ -84,58 +74,44 @@ double precision function eff_pot_gauss(x, mu)
end
! -------------------------------------------------------------------------------------------------
! ---
double precision function eff_pot_fit_gauss(x)
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
implicit none
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
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
n_fit_1_erf_x = 2
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)]
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
implicit none
expos_slat_gauss_1_erf_x(1) = 1.09529d0
expos_slat_gauss_1_erf_x(2) = 0.756023d0
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
! ---
@ -175,14 +151,12 @@ END_PROVIDER
double precision function fit_1_erf_x(x)
BEGIN_DOC
!
! fit_1_erf_x(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))
!
END_DOC
implicit none
integer :: i
double precision, intent(in) :: x
integer :: i
fit_1_erf_x = 0.d0
do i = 1, n_max_fit_slat
@ -197,13 +171,11 @@ end
&BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x_2, (ng_fit_jast)]
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
implicit none
@ -314,22 +286,50 @@ END_PROVIDER
! ---
double precision function fit_1_erf_x_2(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
implicit none
double precision, intent(in) :: x
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
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

3
plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f
View File

@ -22,6 +22,9 @@ BEGIN_PROVIDER [ logical, ao_tc_sym_two_e_pot_in_map ]
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

27
plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f
View File

@ -1,6 +1,6 @@
! ---
double precision function env_gauss_2e_j1(i, j, k, l)
double precision function j1b_gauss_2e_j1(i, j, k, l)
BEGIN_DOC
!
@ -36,10 +36,10 @@ double precision function env_gauss_2e_j1(i, j, k, l)
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
double precision :: ff, gg, cx, cy, cz
double precision :: env_gauss_2e_j1_schwartz
double precision :: j1b_gauss_2e_j1_schwartz
if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
env_gauss_2e_j1 = env_gauss_2e_j1_schwartz(i, j, k, l)
j1b_gauss_2e_j1 = j1b_gauss_2e_j1_schwartz(i, j, k, l)
return
endif
@ -59,7 +59,7 @@ double precision function env_gauss_2e_j1(i, j, k, l)
L_center(p) = nucl_coord(num_l,p)
enddo
env_gauss_2e_j1 = 0.d0
j1b_gauss_2e_j1 = 0.d0
do p = 1, ao_prim_num(i)
coef1 = ao_coef_normalized_ordered_transp(p, i)
@ -89,18 +89,18 @@ double precision function env_gauss_2e_j1(i, j, k, l)
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
env_gauss_2e_j1 = env_gauss_2e_j1 + coef4 * ( cx + cy + cz )
j1b_gauss_2e_j1 = j1b_gauss_2e_j1 + coef4 * ( cx + cy + cz )
enddo ! s
enddo ! r
enddo ! q
enddo ! p
return
end
end function j1b_gauss_2e_j1
! ---
double precision function env_gauss_2e_j1_schwartz(i, j, k, l)
double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l)
BEGIN_DOC
!
@ -137,6 +137,8 @@ double precision function env_gauss_2e_j1_schwartz(i, j, k, l)
double precision :: schwartz_ij, thr
double precision, allocatable :: schwartz_kl(:,:)
PROVIDE j1b_pen
dim1 = n_pt_max_integrals
thr = ao_integrals_threshold * ao_integrals_threshold
@ -184,7 +186,8 @@ double precision function env_gauss_2e_j1_schwartz(i, j, k, l)
schwartz_kl(0,0) = max( schwartz_kl(0,r) , schwartz_kl(0,0) )
enddo
env_gauss_2e_j1_schwartz = 0.d0
j1b_gauss_2e_j1_schwartz = 0.d0
do p = 1, ao_prim_num(i)
expo1 = ao_expo_ordered_transp(p, i)
@ -223,7 +226,7 @@ double precision function env_gauss_2e_j1_schwartz(i, j, k, l)
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
env_gauss_2e_j1_schwartz = env_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz )
j1b_gauss_2e_j1_schwartz = j1b_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz )
enddo ! s
enddo ! r
enddo ! q
@ -232,7 +235,7 @@ double precision function env_gauss_2e_j1_schwartz(i, j, k, l)
deallocate( schwartz_kl )
return
end
end function j1b_gauss_2e_j1_schwartz
! ---
@ -260,12 +263,14 @@ subroutine get_cxcycz_j1( dim1, cx, cy, cz &
double precision :: general_primitive_integral_erf_shifted
double precision :: general_primitive_integral_coul_shifted
PROVIDE j1b_pen
cx = 0.d0
cy = 0.d0
cz = 0.d0
do ii = 1, nucl_num
expoii = env_expo(ii)
expoii = j1b_pen(ii)
Centerii(1:3) = nucl_coord(ii, 1:3)
call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)

26
plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f
View File

@ -1,6 +1,6 @@
! ---
double precision function env_gauss_2e_j2(i, j, k, l)
double precision function j1b_gauss_2e_j2(i, j, k, l)
BEGIN_DOC
!
@ -36,12 +36,12 @@ double precision function env_gauss_2e_j2(i, j, k, l)
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
double precision :: ff, gg, cx, cy, cz
double precision :: env_gauss_2e_j2_schwartz
double precision :: j1b_gauss_2e_j2_schwartz
dim1 = n_pt_max_integrals
if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
env_gauss_2e_j2 = env_gauss_2e_j2_schwartz(i, j, k, l)
j1b_gauss_2e_j2 = j1b_gauss_2e_j2_schwartz(i, j, k, l)
return
endif
@ -61,7 +61,7 @@ double precision function env_gauss_2e_j2(i, j, k, l)
L_center(p) = nucl_coord(num_l,p)
enddo
env_gauss_2e_j2 = 0.d0
j1b_gauss_2e_j2 = 0.d0
do p = 1, ao_prim_num(i)
coef1 = ao_coef_normalized_ordered_transp(p, i)
@ -91,18 +91,18 @@ double precision function env_gauss_2e_j2(i, j, k, l)
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
env_gauss_2e_j2 = env_gauss_2e_j2 + coef4 * ( cx + cy + cz )
j1b_gauss_2e_j2 = j1b_gauss_2e_j2 + coef4 * ( cx + cy + cz )
enddo ! s
enddo ! r
enddo ! q
enddo ! p
return
end
end function j1b_gauss_2e_j2
! ---
double precision function env_gauss_2e_j2_schwartz(i, j, k, l)
double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l)
BEGIN_DOC
!
@ -187,7 +187,7 @@ double precision function env_gauss_2e_j2_schwartz(i, j, k, l)
enddo
env_gauss_2e_j2_schwartz = 0.d0
j1b_gauss_2e_j2_schwartz = 0.d0
do p = 1, ao_prim_num(i)
expo1 = ao_expo_ordered_transp(p, i)
@ -226,7 +226,7 @@ double precision function env_gauss_2e_j2_schwartz(i, j, k, l)
, P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
, Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
env_gauss_2e_j2_schwartz = env_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz )
j1b_gauss_2e_j2_schwartz = j1b_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz )
enddo ! s
enddo ! r
enddo ! q
@ -235,7 +235,7 @@ double precision function env_gauss_2e_j2_schwartz(i, j, k, l)
deallocate( schwartz_kl )
return
end
end function j1b_gauss_2e_j2_schwartz
! ---
@ -263,13 +263,15 @@ subroutine get_cxcycz_j2( dim1, cx, cy, cz &
double precision :: general_primitive_integral_erf_shifted
double precision :: general_primitive_integral_coul_shifted
PROVIDE j1b_pen j1b_coeff
cx = 0.d0
cy = 0.d0
cz = 0.d0
do ii = 1, nucl_num
expoii = env_expo(ii)
coefii = env_coef(ii)
expoii = j1b_pen (ii)
coefii = j1b_coeff(ii)
Centerii(1:3) = nucl_coord(ii, 1:3)
call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)

49
plugins/local/ao_tc_eff_map/useful_sub.irp.f
View File

@ -174,7 +174,7 @@ double precision function general_primitive_integral_coul_shifted( dim
general_primitive_integral_coul_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q)
return
end
end function general_primitive_integral_coul_shifted
!______________________________________________________________________________________________________________________
!______________________________________________________________________________________________________________________
@ -354,7 +354,7 @@ double precision function general_primitive_integral_erf_shifted( dim
general_primitive_integral_erf_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q)
return
end
end function general_primitive_integral_erf_shifted
!______________________________________________________________________________________________________________________
!______________________________________________________________________________________________________________________
@ -362,48 +362,3 @@ end
! ---
subroutine inv_r_times_poly(r, dist_r, dist_vec, poly)
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
implicit none
double precision, intent(in) :: r(3), dist_r, dist_vec(3)
double precision, intent(out) :: poly(3)
integer :: i
double precision :: inv_dist
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
poly(i) = 1.d0
endif
enddo
endif
end
! ---

2
plugins/local/basis_correction/README.rst
View File

@ -12,7 +12,7 @@ This basis set correction relies mainy on :
When HF is a qualitative representation of the electron pairs (i.e. weakly correlated systems), such an approach for \mu(r) is OK.
See for instance JPCL, 10, 2931-2937 (2019) for typical flavours of the results.
Thanks to the trivial nature of such a two-body rdm, the equation (22) of J. Chem. Phys. 149, 194301 (2018) can be rewritten in a very efficient way, and therefore the limiting factor of such an approach is the AO->MO four-index transformation of the two-electron integrals.
b) "mu_of_r_potential = cas_full" uses the two-body rdm of CAS-like wave function (i.e. linear combination of Slater determinants developped in an active space with the MOs stored in the EZFIO folder).
b) "mu_of_r_potential = cas_ful" uses the two-body rdm of CAS-like wave function (i.e. linear combination of Slater determinants developped in an active space with the MOs stored in the EZFIO folder).
If the CAS is properly chosen (i.e. the CAS-like wave function qualitatively represents the wave function of the systems), then such an approach is OK for \mu(r) even in the case of strong correlation.
+) The use of DFT correlation functionals with multi-determinant reference (Ecmd). These functionals are originally defined in the RS-DFT framework (see for instance Theor. Chem. Acc.114, 305(2005)) and design to capture short-range correlation effects. A important quantity arising in the Ecmd is the exact on-top pair density of the system, and the main differences of approximated Ecmd relies on different approximations for the exact on-top pair density.

6
plugins/local/basis_correction/pbe_on_top.irp.f
View File

@ -39,7 +39,7 @@
grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate)
grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate)
if(mu_of_r_potential == "cas_full")then
if(mu_of_r_potential == "cas_ful")then
! You take the on-top of the CAS wave function which is computed with mu(r)
on_top = on_top_cas_mu_r(ipoint,istate)
else
@ -101,7 +101,7 @@
grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate)
grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate)
if(mu_of_r_potential == "cas_full")then
if(mu_of_r_potential == "cas_ful")then
! You take the on-top of the CAS wave function which is computed with mu(r)
on_top = on_top_cas_mu_r(ipoint,istate)
else
@ -163,7 +163,7 @@
grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate)
grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate)
if(mu_of_r_potential == "cas_full")then
if(mu_of_r_potential == "cas_ful")then
! You take the on-top of the CAS wave function which is computed with mu(r)
on_top = on_top_cas_mu_r(ipoint,istate)
else

14
plugins/local/basis_correction/print_routine.irp.f
View File

@ -4,8 +4,8 @@ subroutine print_basis_correction
provide mu_average_prov
if(mu_of_r_potential.EQ."hf")then
provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r
else if(mu_of_r_potential.EQ."cas_full".or.mu_of_r_potential.EQ."cas_truncated")then
provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r
else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated")then
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
endif
@ -25,7 +25,7 @@ subroutine print_basis_correction
if(mu_of_r_potential.EQ."hf")then
print*, ''
print*,'Using a HF-like two-body density to define mu(r)'
print*,'This assumes that HF is a qualitative representation of the wave function '
print*,'This assumes that HF is a qualitative representation of the wave function '
print*,'********************************************'
print*,'Functionals more suited for weak correlation'
print*,'********************************************'
@ -38,10 +38,10 @@ 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)
enddo
else if(mu_of_r_potential.EQ."cas_full".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".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then
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*,'This assumes that the CAS is a qualitative representation of the wave function '
print*,'********************************************'
print*,'Functionals more suited for weak correlation'
print*,'********************************************'
@ -56,14 +56,14 @@ subroutine print_basis_correction
print*,''
print*,'********************************************'
print*,'********************************************'
print*,'+) PBE-on-top Ecmd functional : JCP, 152, 174104 (2020) '
print*,'+) PBE-on-top Ecmd functional : JCP, 152, 174104 (2020) '
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 : JCP, 152, 174104 (2020)'
print*,'+) PBE-on-top no spin polarization Ecmd functional : JCP, 152, 174104 (2020)'
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)

37
plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f
View File

@ -1,39 +1,4 @@
! ---
BEGIN_PROVIDER [double precision, ao_two_e_coul, (ao_num, ao_num, ao_num, ao_num) ]
BEGIN_DOC
!
! ao_two_e_coul(k,i,l,j) = ( k i | 1/r12 | l j ) = < l k | 1/r12 | j i >
!
END_DOC
integer :: i, j, k, l
double precision, external :: get_ao_two_e_integral
PROVIDE ao_integrals_map
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP SHARED(ao_num, ao_two_e_coul, ao_integrals_map) &
!$OMP PRIVATE(i, j, k, l)
!$OMP DO
do j = 1, ao_num
do l = 1, ao_num
do i = 1, ao_num
do k = 1, ao_num
! < 1:k, 2:l | 1:i, 2:j >
ao_two_e_coul(k,i,l,j) = get_ao_two_e_integral(i, j, k, l, ao_integrals_map)
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
END_PROVIDER
! ---
double precision function bi_ortho_mo_coul_ints(l, k, j, i)
@ -60,7 +25,7 @@ double precision function bi_ortho_mo_coul_ints(l, k, j, i)
enddo
enddo
end
end function bi_ortho_mo_coul_ints
! ---

17
plugins/local/bi_ort_ints/one_e_bi_ort.irp.f
View File

@ -8,6 +8,23 @@ BEGIN_PROVIDER [double precision, ao_one_e_integrals_tc_tot, (ao_num,ao_num)]
ao_one_e_integrals_tc_tot = ao_one_e_integrals
!provide j1b_type
!if( (j1b_type .eq. 1) .or. (j1b_type .eq. 2) ) then
!
! print *, ' do things properly !'
! stop
! !do i = 1, ao_num
! ! do j = 1, ao_num
! ! ao_one_e_integrals_tc_tot(j,i) += ( j1b_gauss_hermI (j,i) &
! ! + j1b_gauss_hermII (j,i) &
! ! + j1b_gauss_nonherm(j,i) )
! ! enddo
! !enddo
!endif
END_PROVIDER
! ---

90
plugins/local/bi_ort_ints/total_twoe_pot.irp.f
View File

@ -1,4 +1,91 @@
! ---
BEGIN_PROVIDER [double precision, ao_two_e_vartc_tot, (ao_num, ao_num, ao_num, ao_num) ]
integer :: i, j, k, l
provide j1b_type
provide mo_r_coef mo_l_coef
do j = 1, ao_num
do l = 1, ao_num
do i = 1, ao_num
do k = 1, ao_num
ao_two_e_vartc_tot(k,i,l,j) = ao_vartc_int_chemist(k,i,l,j)
enddo
enddo
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num) ]
BEGIN_DOC
!
! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) = <lk| V^TC(r_12) |ji> where V^TC(r_12) is the total TC operator
!
! including both hermitian and non hermitian parts. THIS IS IN CHEMIST NOTATION.
!
! WARNING :: non hermitian ! acts on "the right functions" (i,j)
!
END_DOC
integer :: i, j, k, l
double precision :: integral_sym, integral_nsym
double precision, external :: get_ao_tc_sym_two_e_pot
provide j1b_type
if(j1b_type .eq. 0) then
PROVIDE ao_tc_sym_two_e_pot_in_map
!!! TODO :: OPENMP
do j = 1, ao_num
do l = 1, ao_num
do i = 1, ao_num
do k = 1, ao_num
integral_sym = get_ao_tc_sym_two_e_pot(i, j, k, l, ao_tc_sym_two_e_pot_map)
! ao_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the AO basis
integral_nsym = ao_non_hermit_term_chemist(k,i,l,j)
!print *, ' sym integ = ', integral_sym
!print *, ' non-sym integ = ', integral_nsym
ao_two_e_tc_tot(k,i,l,j) = integral_sym + integral_nsym
!write(111,*) ao_two_e_tc_tot(k,i,l,j)
enddo
enddo
enddo
enddo
else
PROVIDE ao_tc_int_chemist
do j = 1, ao_num
do l = 1, ao_num
do i = 1, ao_num
do k = 1, ao_num
ao_two_e_tc_tot(k,i,l,j) = ao_tc_int_chemist(k,i,l,j)
!write(222,*) ao_two_e_tc_tot(k,i,l,j)
enddo
enddo
enddo
enddo
FREE ao_tc_int_chemist
endif
END_PROVIDER
! ---
double precision function bi_ortho_mo_ints(l, k, j, i)
@ -31,6 +118,8 @@ end function bi_ortho_mo_ints
! ---
! TODO :: transform into DEGEMM
BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num, mo_num, mo_num)]
BEGIN_DOC
@ -178,6 +267,7 @@ END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num)]
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_exchange, (mo_num,mo_num)]
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_anti, (mo_num,mo_num)]

1
plugins/local/cipsi_tc_bi_ortho/NEED
View File

@ -1,4 +1,3 @@
cipsi_utils
json
mpi
perturbation

2
plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f
View File

@ -65,7 +65,7 @@ subroutine run_cipsi
if (N_det > N_det_max) then
psi_det(1:N_int,1:2,1:N_det) = psi_det_generators(1:N_int,1:2,1:N_det)
psi_coef(1:N_det,1:N_states) = psi_coef_sorted_gen(1:N_det,1:N_states)
psi_coef(1:N_det,1:N_states) = psi_coef_sorted_tc_gen(1:N_det,1:N_states)
N_det = N_det_max
soft_touch N_det psi_det psi_coef
if (s2_eig) then

32
plugins/local/cipsi_tc_bi_ortho/energy.irp.f
View File

@ -15,5 +15,37 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ]
pt2_E0_denominator = eigval_right_tc_bi_orth
! if (initialize_pt2_E0_denominator) then
! if (h0_type == "EN") then
! pt2_E0_denominator(1:N_states) = psi_energy(1:N_states)
! else if (h0_type == "HF") then
! do i=1,N_states
! j = maxloc(abs(psi_coef(:,i)),1)
! pt2_E0_denominator(i) = psi_det_hii(j)
! enddo
! else if (h0_type == "Barycentric") then
! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states)
! else if (h0_type == "CFG") then
! pt2_E0_denominator(1:N_states) = psi_energy(1:N_states)
! else
! print *, h0_type, ' not implemented'
! stop
! endif
! do i=1,N_states
! call write_double(6,pt2_E0_denominator(i)+nuclear_repulsion, 'PT2 Energy denominator')
! enddo
! else
! pt2_E0_denominator = -huge(1.d0)
! endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, pt2_overlap, (N_states, N_states) ]
implicit none
BEGIN_DOC
! Overlap between the perturbed wave functions
END_DOC
pt2_overlap(1:N_states,1:N_states) = 0.d0
END_PROVIDER

14
plugins/local/cipsi_tc_bi_ortho/environment.irp.f Normal file
View File

@ -0,0 +1,14 @@
BEGIN_PROVIDER [ integer, nthreads_pt2 ]
implicit none
BEGIN_DOC
! Number of threads for Davidson
END_DOC
nthreads_pt2 = nproc
character*(32) :: env
call getenv('QP_NTHREADS_PT2',env)
if (trim(env) /= '') then
read(env,*) nthreads_pt2
call write_int(6,nthreads_pt2,'Target number of threads for PT2')
endif
END_PROVIDER

0
plugins/local/cipsi_tc_bi_ortho/lock_2rdm.irp.f Normal file
View File

869
plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f
View File

@ -1,3 +1,868 @@
subroutine provide_for_zmq_pt2
PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc psi_det_sorted_tc_order
BEGIN_PROVIDER [ integer, pt2_stoch_istate ]
implicit none
BEGIN_DOC
! State for stochatsic PT2
END_DOC
pt2_stoch_istate = 1
END_PROVIDER
BEGIN_PROVIDER [ integer, pt2_F, (N_det_generators) ]
&BEGIN_PROVIDER [ integer, pt2_n_tasks_max ]
implicit none
logical, external :: testTeethBuilding
integer :: i,j
pt2_n_tasks_max = elec_alpha_num*elec_alpha_num + elec_alpha_num*elec_beta_num - n_core_orb*2
pt2_n_tasks_max = min(pt2_n_tasks_max,1+N_det_generators/10000)
call write_int(6,pt2_n_tasks_max,'pt2_n_tasks_max')
pt2_F(:) = max(int(sqrt(float(pt2_n_tasks_max))),1)
do i=1,pt2_n_0(1+pt2_N_teeth/4)
pt2_F(i) = pt2_n_tasks_max*pt2_min_parallel_tasks
enddo
do i=1+pt2_n_0(pt2_N_teeth-pt2_N_teeth/4), pt2_n_0(pt2_N_teeth-pt2_N_teeth/10)
pt2_F(i) = pt2_min_parallel_tasks
enddo
do i=1+pt2_n_0(pt2_N_teeth-pt2_N_teeth/10), N_det_generators
pt2_F(i) = 1
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, pt2_N_teeth ]
&BEGIN_PROVIDER [ integer, pt2_minDetInFirstTeeth ]
implicit none
logical, external :: testTeethBuilding
if(N_det_generators < 500) then
pt2_minDetInFirstTeeth = 1
pt2_N_teeth = 1
else
pt2_minDetInFirstTeeth = min(5, N_det_generators)
do pt2_N_teeth=100,2,-1
if(testTeethBuilding(pt2_minDetInFirstTeeth, pt2_N_teeth)) exit
end do
end if
call write_int(6,pt2_N_teeth,'Number of comb teeth')
END_PROVIDER
logical function testTeethBuilding(minF, N)
implicit none
integer, intent(in) :: minF, N
integer :: n0, i
double precision :: u0, Wt, r
double precision, allocatable :: tilde_w(:), tilde_cW(:)
integer, external :: dress_find_sample
double precision :: rss
double precision, external :: memory_of_double, memory_of_int
rss = memory_of_double(2*N_det_generators+1)
call check_mem(rss,irp_here)
allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators))
double precision :: norm2
norm2 = 0.d0
do i=N_det_generators,1,-1
tilde_w(i) = psi_coef_sorted_tc_gen(i,pt2_stoch_istate) * &
psi_coef_sorted_tc_gen(i,pt2_stoch_istate)
norm2 = norm2 + tilde_w(i)
enddo
f = 1.d0/norm2
tilde_w(:) = tilde_w(:) * f
tilde_cW(0) = -1.d0
do i=1,N_det_generators
tilde_cW(i) = tilde_cW(i-1) + tilde_w(i)
enddo
tilde_cW(:) = tilde_cW(:) + 1.d0
deallocate(tilde_w)
n0 = 0
testTeethBuilding = .false.
double precision :: f
integer :: minFN
minFN = N_det_generators - minF * N
f = 1.d0/dble(N)
do
u0 = tilde_cW(n0)
r = tilde_cW(n0 + minF)
Wt = (1d0 - u0) * f
if (dabs(Wt) <= 1.d-3) then
exit
endif
if(Wt >= r - u0) then
testTeethBuilding = .true.
exit
end if
n0 += 1
if(n0 > minFN) then
exit
end if
end do
deallocate(tilde_cW)
end function
subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
use f77_zmq
use selection_types
implicit none
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
integer, intent(in) :: N_in
! integer, intent(inout) :: N_in
double precision, intent(in) :: relative_error, E(N_states)
type(pt2_type), intent(inout) :: pt2_data, pt2_data_err
!
integer :: i, N
double precision :: state_average_weight_save(N_states), w(N_states,4)
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
type(selection_buffer) :: b
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_tc psi_det_sorted_tc
PROVIDE psi_det_hii selection_weight pseudo_sym
PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max
PROVIDE excitation_beta_max excitation_alpha_max excitation_max
if (h0_type == 'CFG') then
PROVIDE psi_configuration_hii det_to_configuration
endif
if (N_det <= max(4,N_states) .or. pt2_N_teeth < 2) then
print*,'ZMQ_selection'
call ZMQ_selection(N_in, pt2_data)
else
print*,'else ZMQ_selection'
N = max(N_in,1) * N_states
state_average_weight_save(:) = state_average_weight(:)
if (int(N,8)*2_8 > huge(1)) then
print *, irp_here, ': integer too large'
stop -1
endif
call create_selection_buffer(N, N*2, b)
ASSERT (associated(b%det))
ASSERT (associated(b%val))
do pt2_stoch_istate=1,N_states
state_average_weight(:) = 0.d0
state_average_weight(pt2_stoch_istate) = 1.d0
TOUCH state_average_weight pt2_stoch_istate selection_weight
PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w
PROVIDE pt2_u pt2_J pt2_R
call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
integer, external :: zmq_put_psi
integer, external :: zmq_put_N_det_generators
integer, external :: zmq_put_N_det_selectors
integer, external :: zmq_put_dvector
integer, external :: zmq_put_ivector
if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
stop 'Unable to put psi on ZMQ server'
endif
if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then
stop 'Unable to put N_det_generators on ZMQ server'
endif
if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then
stop 'Unable to put N_det_selectors on ZMQ server'
endif
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then
stop 'Unable to put energy on ZMQ server'
endif
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then
stop 'Unable to put state_average_weight on ZMQ server'
endif
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then
stop 'Unable to put selection_weight on ZMQ server'
endif
if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then
stop 'Unable to put pt2_stoch_istate on ZMQ server'
endif
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) then
stop 'Unable to put threshold_generators on ZMQ server'
endif
integer, external :: add_task_to_taskserver
character(300000) :: task
integer :: j,k,ipos,ifirst
ifirst=0
ipos=0
do i=1,N_det_generators
if (pt2_F(i) > 1) then
ipos += 1
endif
enddo
call write_int(6,sum(pt2_F),'Number of tasks')
call write_int(6,ipos,'Number of fragmented tasks')
ipos=1
do i= 1, N_det_generators
do j=1,pt2_F(pt2_J(i))
write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in
ipos += 30
if (ipos > 300000-30) then
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
stop 'Unable to add task to task server'
endif
ipos=1
if (ifirst == 0) then
ifirst=1
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
endif
endif
end do
enddo
if (ipos > 1) then
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
stop 'Unable to add task to task server'
endif
endif
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
double precision :: mem_collector, mem, rss
call resident_memory(rss)
mem_collector = 8.d0 * & ! bytes
( 1.d0*pt2_n_tasks_max & ! task_id, index
+ 0.635d0*N_det_generators & ! f,d
+ pt2_n_tasks_max*pt2_type_size(N_states) & ! pt2_data_task
+ N_det_generators*pt2_type_size(N_states) & ! pt2_data_I
+ 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3
+ 1.d0*(N_int*2.d0*N + N) & ! selection buffer
+ 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer
) / 1024.d0**3
integer :: nproc_target, ii
nproc_target = nthreads_pt2
ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2)
do
mem = mem_collector + & !
nproc_target * 8.d0 * & ! bytes
( 0.5d0*pt2_n_tasks_max & ! task_id
+ 64.d0*pt2_n_tasks_max & ! task
+ pt2_type_size(N_states)*pt2_n_tasks_max*N_states & ! pt2, variance, overlap
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset
+ 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer
+ 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer
+ 2.0d0*(ii) & ! preinteresting, interesting,
! prefullinteresting, fullinteresting
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
) / 1024.d0**3
if (nproc_target == 0) then
call check_mem(mem,irp_here)
nproc_target = 1
exit
endif
if (mem+rss < qp_max_mem) then
exit
endif
nproc_target = nproc_target - 1
enddo
call write_int(6,nproc_target,'Number of threads for PT2')
call write_double(6,mem,'Memory (Gb)')
call omp_set_max_active_levels(1)
print '(A)', '========== ======================= ===================== ===================== ==========='
print '(A)', ' Samples Energy Variance Norm^2 Seconds'
print '(A)', '========== ======================= ===================== ===================== ==========='
PROVIDE global_selection_buffer
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) &
!$OMP PRIVATE(i)
i = omp_get_thread_num()
if (i==0) then
call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, pt2_data, pt2_data_err, b, N)
pt2_data % rpt2(pt2_stoch_istate) = &
pt2_data % pt2(pt2_stoch_istate)/(1.d0+pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate))
!TODO : We should use here the correct formula for the error of X/Y
pt2_data_err % rpt2(pt2_stoch_istate) = &
pt2_data_err % pt2(pt2_stoch_istate)/(1.d0 + pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate))
else
call pt2_slave_inproc(i)
endif
!$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
call omp_set_max_active_levels(8)
print '(A)', '========== ======================= ===================== ===================== ==========='
do k=1,N_states
pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate)
enddo
SOFT_TOUCH pt2_overlap
enddo
FREE pt2_stoch_istate
! Symmetrize overlap
do j=2,N_states
do i=1,j-1
pt2_overlap(i,j) = 0.5d0 * (pt2_overlap(i,j) + pt2_overlap(j,i))
pt2_overlap(j,i) = pt2_overlap(i,j)
enddo
enddo
print *, 'Overlap of perturbed states:'
do k=1,N_states
print *, pt2_overlap(k,:)
enddo
print *, '-------'
if (N_in > 0) then
b%cur = min(N_in,b%cur)
if (s2_eig) then
call make_selection_buffer_s2(b)
else
call remove_duplicates_in_selection_buffer(b)
endif
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0)
endif
call delete_selection_buffer(b)
state_average_weight(:) = state_average_weight_save(:)
TOUCH state_average_weight
call update_pt2_and_variance_weights(pt2_data, N_states)
endif
end subroutine
subroutine pt2_slave_inproc(i)
implicit none
integer, intent(in) :: i
PROVIDE global_selection_buffer
call run_pt2_slave(1,i,pt2_e0_denominator)
end
subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_err, b, N_)
use f77_zmq
use selection_types
use bitmasks
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
double precision, intent(in) :: relative_error, E
type(pt2_type), intent(inout) :: pt2_data, pt2_data_err
type(selection_buffer), intent(inout) :: b
integer, intent(in) :: N_
type(pt2_type), allocatable :: pt2_data_task(:)
type(pt2_type), allocatable :: pt2_data_I(:)
type(pt2_type), allocatable :: pt2_data_S(:)
type(pt2_type), allocatable :: pt2_data_S2(:)
type(pt2_type) :: pt2_data_teeth
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer, external :: zmq_delete_tasks_async_send
integer, external :: zmq_delete_tasks_async_recv
integer, external :: zmq_abort
integer, external :: pt2_find_sample_lr
PROVIDE pt2_stoch_istate
integer :: more, n, i, p, c, t, n_tasks, U
integer, allocatable :: task_id(:)
integer, allocatable :: index(:)
double precision :: v, x, x2, x3, avg, avg2, avg3(N_states), eqt, E0, v0, n0(N_states)
double precision :: eqta(N_states)
double precision :: time, time1, time0
integer, allocatable :: f(:)
logical, allocatable :: d(:)
logical :: do_exit, stop_now, sending
logical, external :: qp_stop
type(selection_buffer) :: b2
double precision :: rss
double precision, external :: memory_of_double, memory_of_int
sending =.False.
rss = memory_of_int(pt2_n_tasks_max*2+N_det_generators*2)
rss += memory_of_double(N_states*N_det_generators)*3.d0
rss += memory_of_double(N_states*pt2_n_tasks_max)*3.d0
rss += memory_of_double(pt2_N_teeth+1)*4.d0
call check_mem(rss,irp_here)
! If an allocation is added here, the estimate of the memory should also be
! updated in ZMQ_pt2
allocate(task_id(pt2_n_tasks_max), index(pt2_n_tasks_max), f(N_det_generators))
allocate(d(N_det_generators+1))
allocate(pt2_data_task(pt2_n_tasks_max))
allocate(pt2_data_I(N_det_generators))
allocate(pt2_data_S(pt2_N_teeth+1))
allocate(pt2_data_S2(pt2_N_teeth+1))
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
call create_selection_buffer(N_, N_*2, b2)
pt2_data % pt2(pt2_stoch_istate) = -huge(1.)
pt2_data_err % pt2(pt2_stoch_istate) = huge(1.)
pt2_data % variance(pt2_stoch_istate) = huge(1.)
pt2_data_err % variance(pt2_stoch_istate) = huge(1.)
pt2_data % overlap(:,pt2_stoch_istate) = 0.d0
pt2_data_err % overlap(:,pt2_stoch_istate) = huge(1.)
n = 1
t = 0
U = 0
do i=1,pt2_n_tasks_max
call pt2_alloc(pt2_data_task(i),N_states)
enddo
do i=1,pt2_N_teeth+1
call pt2_alloc(pt2_data_S(i),N_states)
call pt2_alloc(pt2_data_S2(i),N_states)
enddo
do i=1,N_det_generators
call pt2_alloc(pt2_data_I(i),N_states)
enddo
f(:) = pt2_F(:)
d(:) = .false.
n_tasks = 0
E0 = E
v0 = 0.d0
n0(:) = 0.d0
more = 1
call wall_time(time0)
time1 = time0
do_exit = .false.
stop_now = .false.
do while (n <= N_det_generators)
if(f(pt2_J(n)) == 0) then
d(pt2_J(n)) = .true.
do while(d(U+1))
U += 1
end do
! Deterministic part
do while(t <= pt2_N_teeth)
if(U >= pt2_n_0(t+1)) then
t=t+1
E0 = 0.d0
v0 = 0.d0
n0(:) = 0.d0
do i=pt2_n_0(t),1,-1
E0 += pt2_data_I(i) % pt2(pt2_stoch_istate)
v0 += pt2_data_I(i) % variance(pt2_stoch_istate)
n0(:) += pt2_data_I(i) % overlap(:,pt2_stoch_istate)
end do
else
exit
end if
end do
! Add Stochastic part
c = pt2_R(n)
if(c > 0) then
call pt2_alloc(pt2_data_teeth,N_states)
do p=pt2_N_teeth, 1, -1
v = pt2_u_0 + pt2_W_T * (pt2_u(c) + dble(p-1))
i = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(p),pt2_n_0(p+1))
v = pt2_W_T / pt2_w(i)
call pt2_add ( pt2_data_teeth, v, pt2_data_I(i) )
call pt2_add ( pt2_data_S(p), 1.d0, pt2_data_teeth )
call pt2_add2( pt2_data_S2(p), 1.d0, pt2_data_teeth )
enddo
call pt2_dealloc(pt2_data_teeth)
avg = E0 + pt2_data_S(t) % pt2(pt2_stoch_istate) / dble(c)
avg2 = v0 + pt2_data_S(t) % variance(pt2_stoch_istate) / dble(c)
avg3(:) = n0(:) + pt2_data_S(t) % overlap(:,pt2_stoch_istate) / dble(c)
if ((avg /= 0.d0) .or. (n == N_det_generators) ) then
do_exit = .true.
endif
if (qp_stop()) then
stop_now = .True.
endif
pt2_data % pt2(pt2_stoch_istate) = avg
pt2_data % variance(pt2_stoch_istate) = avg2
pt2_data % overlap(:,pt2_stoch_istate) = avg3(:)
call wall_time(time)
! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969)
if(c > 2) then
eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
eqt = sqrt(eqt / (dble(c) - 1.5d0))
pt2_data_err % pt2(pt2_stoch_istate) = eqt
eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
eqt = sqrt(eqt / (dble(c) - 1.5d0))
pt2_data_err % variance(pt2_stoch_istate) = eqt
eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability
eqta(:) = sqrt(eqta(:) / (dble(c) - 1.5d0))
pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:)
if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then
time1 = time
print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.4)', c, &
pt2_data % pt2(pt2_stoch_istate) +E, &
pt2_data_err % pt2(pt2_stoch_istate), &
pt2_data % variance(pt2_stoch_istate), &
pt2_data_err % variance(pt2_stoch_istate), &
pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate), &
pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate), &
time-time0
if (stop_now .or. ( &
(do_exit .and. (dabs(pt2_data_err % pt2(pt2_stoch_istate)) / &
(1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) <= relative_error))) ) then
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
call sleep(10)
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Error in sending abort signal (2)'
endif
endif
endif
endif
endif
end if
n += 1
else if(more == 0) then
exit
else
call pull_pt2_results(zmq_socket_pull, index, pt2_data_task, task_id, n_tasks, b2)
if(n_tasks > pt2_n_tasks_max)then
print*,'PB !!!'
print*,'If you see this, send a bug report with the following content'
print*,irp_here
print*,'n_tasks,pt2_n_tasks_max = ',n_tasks,pt2_n_tasks_max
stop -1
endif
if (zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_tasks,sending) == -1) then
stop 'PT2: Unable to delete tasks (send)'
endif
do i=1,n_tasks
if(index(i).gt.size(pt2_data_I,1).or.index(i).lt.1)then
print*,'PB !!!'
print*,'If you see this, send a bug report with the following content'
print*,irp_here
print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1)
stop -1
endif
call pt2_add(pt2_data_I(index(i)),1.d0,pt2_data_task(i))
f(index(i)) -= 1
end do
do i=1, b2%cur
! We assume the pulled buffer is sorted
if (b2%val(i) > b%mini) exit
call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i))
end do
if (zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,more,sending) == -1) then
stop 'PT2: Unable to delete tasks (recv)'
endif
end if
end do
do i=1,N_det_generators
call pt2_dealloc(pt2_data_I(i))
enddo
do i=1,pt2_N_teeth+1
call pt2_dealloc(pt2_data_S(i))
call pt2_dealloc(pt2_data_S2(i))
enddo
do i=1,pt2_n_tasks_max
call pt2_dealloc(pt2_data_task(i))
enddo
!print *, 'deleting b2'
call delete_selection_buffer(b2)
!print *, 'sorting b'
call sort_selection_buffer(b)
!print *, 'done'
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end subroutine
integer function pt2_find_sample(v, w)
implicit none
double precision, intent(in) :: v, w(0:N_det_generators)
integer, external :: pt2_find_sample_lr
pt2_find_sample = pt2_find_sample_lr(v, w, 0, N_det_generators)
end function
integer function pt2_find_sample_lr(v, w, l_in, r_in)
implicit none
double precision, intent(in) :: v, w(0:N_det_generators)
integer, intent(in) :: l_in,r_in
integer :: i,l,r
l=l_in
r=r_in
do while(r-l > 1)
i = shiftr(r+l,1)
if(w(i) < v) then
l = i
else
r = i
end if
end do
i = r
do r=i+1,N_det_generators
if (w(r) /= w(i)) then
exit
endif
enddo
pt2_find_sample_lr = r-1
end function
BEGIN_PROVIDER [ integer, pt2_n_tasks ]
implicit none
BEGIN_DOC
! Number of parallel tasks for the Monte Carlo
END_DOC
pt2_n_tasks = N_det_generators
END_PROVIDER
BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)]
implicit none
integer, allocatable :: seed(:)
integer :: m,i
call random_seed(size=m)
allocate(seed(m))
do i=1,m
seed(i) = i
enddo
call random_seed(put=seed)
deallocate(seed)
call RANDOM_NUMBER(pt2_u)
END_PROVIDER
BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)]
&BEGIN_PROVIDER[ integer, pt2_R, (N_det_generators)]
implicit none
BEGIN_DOC
! pt2_J contains the list of generators after ordering them according to the
! Monte Carlo sampling.
!
! pt2_R(i) is the number of combs drawn when determinant i is computed.
END_DOC
integer :: N_c, N_j
integer :: U, t, i
double precision :: v
integer, external :: pt2_find_sample_lr
logical, allocatable :: pt2_d(:)
integer :: m,l,r,k
integer :: ncache
integer, allocatable :: ii(:,:)
double precision :: dt
ncache = min(N_det_generators,10000)
double precision :: rss
double precision, external :: memory_of_double, memory_of_int
rss = memory_of_int(ncache)*dble(pt2_N_teeth) + memory_of_int(N_det_generators)
call check_mem(rss,irp_here)
allocate(ii(pt2_N_teeth,ncache),pt2_d(N_det_generators))
pt2_R(:) = 0
pt2_d(:) = .false.
N_c = 0
N_j = pt2_n_0(1)
do i=1,N_j
pt2_d(i) = .true.
pt2_J(i) = i
end do
U = 0
do while(N_j < pt2_n_tasks)
if (N_c+ncache > N_det_generators) then
ncache = N_det_generators - N_c
endif
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(dt,v,t,k)
do k=1, ncache
dt = pt2_u_0
do t=1, pt2_N_teeth
v = dt + pt2_W_T *pt2_u(N_c+k)
dt = dt + pt2_W_T
ii(t,k) = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(t),pt2_n_0(t+1))
end do
enddo
!$OMP END PARALLEL DO
do k=1,ncache
!ADD_COMB
N_c = N_c+1
do t=1, pt2_N_teeth
i = ii(t,k)
if(.not. pt2_d(i)) then
N_j += 1
pt2_J(N_j) = i
pt2_d(i) = .true.
end if
end do
pt2_R(N_j) = N_c
!FILL_TOOTH
do while(U < N_det_generators)
U += 1
if(.not. pt2_d(U)) then
N_j += 1
pt2_J(N_j) = U
pt2_d(U) = .true.
exit
end if
end do
if (N_j >= pt2_n_tasks) exit
end do
enddo
if(N_det_generators > 1) then
pt2_R(N_det_generators-1) = 0
pt2_R(N_det_generators) = N_c
end if
deallocate(ii,pt2_d)
END_PROVIDER
BEGIN_PROVIDER [ double precision, pt2_w, (N_det_generators) ]
&BEGIN_PROVIDER [ double precision, pt2_cW, (0:N_det_generators) ]
&BEGIN_PROVIDER [ double precision, pt2_W_T ]
&BEGIN_PROVIDER [ double precision, pt2_u_0 ]
&BEGIN_PROVIDER [ integer, pt2_n_0, (pt2_N_teeth+1) ]
implicit none
integer :: i, t
double precision, allocatable :: tilde_w(:), tilde_cW(:)
double precision :: r, tooth_width
integer, external :: pt2_find_sample
double precision :: rss
double precision, external :: memory_of_double, memory_of_int
rss = memory_of_double(2*N_det_generators+1)
call check_mem(rss,irp_here)
if (N_det_generators == 1) then
pt2_w(1) = 1.d0
pt2_cw(1) = 1.d0
pt2_u_0 = 1.d0
pt2_W_T = 0.d0
pt2_n_0(1) = 0
pt2_n_0(2) = 1
else
allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators))
tilde_cW(0) = 0d0
do i=1,N_det_generators
tilde_w(i) = psi_coef_sorted_tc_gen(i,pt2_stoch_istate)**2 !+ 1.d-20
enddo
double precision :: norm2
norm2 = 0.d0
do i=N_det_generators,1,-1
norm2 += tilde_w(i)
enddo
tilde_w(:) = tilde_w(:) / norm2
tilde_cW(0) = -1.d0
do i=1,N_det_generators
tilde_cW(i) = tilde_cW(i-1) + tilde_w(i)
enddo
tilde_cW(:) = tilde_cW(:) + 1.d0
pt2_n_0(1) = 0
do
pt2_u_0 = tilde_cW(pt2_n_0(1))
r = tilde_cW(pt2_n_0(1) + pt2_minDetInFirstTeeth)
pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth)
if(pt2_W_T >= r - pt2_u_0) then
exit
end if
pt2_n_0(1) += 1
if(N_det_generators - pt2_n_0(1) < pt2_minDetInFirstTeeth * pt2_N_teeth) then
print *, "teeth building failed"
stop -1
end if
end do
do t=2, pt2_N_teeth
r = pt2_u_0 + pt2_W_T * dble(t-1)
pt2_n_0(t) = pt2_find_sample(r, tilde_cW)
end do
pt2_n_0(pt2_N_teeth+1) = N_det_generators
pt2_w(:pt2_n_0(1)) = tilde_w(:pt2_n_0(1))
do t=1, pt2_N_teeth
tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t))
if (tooth_width == 0.d0) then
tooth_width = sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1)))
endif
ASSERT(tooth_width > 0.d0)
do i=pt2_n_0(t)+1, pt2_n_0(t+1)
pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width
end do
end do
pt2_cW(0) = 0d0
do i=1,N_det_generators
pt2_cW(i) = pt2_cW(i-1) + pt2_w(i)
end do
pt2_n_0(pt2_N_teeth+1) = N_det_generators
endif
END_PROVIDER

0
src/cipsi_utils/pt2_type.irp.f → plugins/local/cipsi_tc_bi_ortho/pt2_type.irp.f
View File

549
plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f Normal file
View File

@ -0,0 +1,549 @@
use omp_lib
use selection_types
use f77_zmq
BEGIN_PROVIDER [ integer(omp_lock_kind), global_selection_buffer_lock ]
use omp_lib
implicit none
BEGIN_DOC
! Global buffer for the OpenMP selection
END_DOC
call omp_init_lock(global_selection_buffer_lock)
END_PROVIDER
BEGIN_PROVIDER [ type(selection_buffer), global_selection_buffer ]
use omp_lib
implicit none
BEGIN_DOC
! Global buffer for the OpenMP selection
END_DOC
call omp_set_lock(global_selection_buffer_lock)
call delete_selection_buffer(global_selection_buffer)
call create_selection_buffer(N_det_generators, 2*N_det_generators, &
global_selection_buffer)
call omp_unset_lock(global_selection_buffer_lock)
END_PROVIDER
subroutine run_pt2_slave(thread,iproc,energy)
use selection_types
use f77_zmq
implicit none
double precision, intent(in) :: energy(N_states_diag)
integer, intent(in) :: thread, iproc
if (N_det > 100000 ) then
call run_pt2_slave_large(thread,iproc,energy)
else
call run_pt2_slave_small(thread,iproc,energy)
endif
end
subroutine run_pt2_slave_small(thread,iproc,energy)
use selection_types
use f77_zmq
implicit none
double precision, intent(in) :: energy(N_states_diag)
integer, intent(in) :: thread, iproc
integer :: rc, i
integer :: worker_id, ctask, ltask
character*(512), allocatable :: task(:)
integer, allocatable :: task_id(:)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_push_socket
integer(ZMQ_PTR) :: zmq_socket_push
type(selection_buffer) :: b
logical :: done, buffer_ready
type(pt2_type), allocatable :: pt2_data(:)
integer :: n_tasks, k, N
integer, allocatable :: i_generator(:), subset(:)
double precision, external :: memory_of_double, memory_of_int
integer :: bsize ! Size of selection buffers
allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max))
allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max))
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)
b%N = 0
buffer_ready = .False.
n_tasks = 1
done = .False.
do while (.not.done)
n_tasks = max(1,n_tasks)
n_tasks = min(pt2_n_tasks_max,n_tasks)
integer, external :: get_tasks_from_taskserver
if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then
exit
endif
done = task_id(n_tasks) == 0
if (done) then
n_tasks = n_tasks-1
endif
if (n_tasks == 0) exit
do k=1,n_tasks
call sscanf_ddd(task(k), subset(k), i_generator(k), N)
enddo
if (b%N == 0) then
! Only first time
bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
call create_selection_buffer(bsize, bsize*2, b)
buffer_ready = .True.
else
ASSERT (b%N == bsize)
endif
double precision :: time0, time1
call wall_time(time0)
do k=1,n_tasks
call pt2_alloc(pt2_data(k),N_states)
b%cur = 0
call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k)))
enddo
call wall_time(time1)
integer, external :: tasks_done_to_taskserver
if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then
done = .true.
endif
call sort_selection_buffer(b)
call push_pt2_results(zmq_socket_push, i_generator, pt2_data, b, task_id, n_tasks)
do k=1,n_tasks
call pt2_dealloc(pt2_data(k))
enddo
b%cur=0
! ! Try to adjust n_tasks around nproc/2 seconds per job
n_tasks = min(2*n_tasks,int( dble(n_tasks * nproc/2) / (time1 - time0 + 1.d0)))
n_tasks = min(n_tasks, pt2_n_tasks_max)
! n_tasks = 1
end do
integer, external :: disconnect_from_taskserver
do i=1,300
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) /= -2) exit
call usleep(500)
print *, 'Retry disconnect...'
end do
call end_zmq_push_socket(zmq_socket_push,thread)
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
if (buffer_ready) then
call delete_selection_buffer(b)
endif
deallocate(pt2_data)
end subroutine
subroutine run_pt2_slave_large(thread,iproc,energy)
use selection_types
use f77_zmq
implicit none
double precision, intent(in) :: energy(N_states_diag)
integer, intent(in) :: thread, iproc
integer :: rc, i
integer :: worker_id, ctask, ltask
character*(512) :: task
integer :: task_id(1)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_push_socket
integer(ZMQ_PTR) :: zmq_socket_push
type(selection_buffer) :: b
logical :: done, buffer_ready
type(pt2_type) :: pt2_data
integer :: n_tasks, k, N
integer :: i_generator, subset
integer :: bsize ! Size of selection buffers
logical :: sending
double precision :: time_shift
PROVIDE global_selection_buffer global_selection_buffer_lock
call random_number(time_shift)
time_shift = time_shift*15.d0
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)
b%N = 0
buffer_ready = .False.
n_tasks = 1
sending = .False.
done = .False.
double precision :: time0, time1
call wall_time(time0)
time0 = time0+time_shift
do while (.not.done)
integer, external :: get_tasks_from_taskserver
if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then
exit
endif
done = task_id(1) == 0
if (done) then
n_tasks = n_tasks-1
endif
if (n_tasks == 0) exit
call sscanf_ddd(task, subset, i_generator, N)
if( pt2_F(i_generator) <= 0 .or. pt2_F(i_generator) > N_det ) then
print *, irp_here
stop 'bug in selection'
endif
if (b%N == 0) then
! Only first time
bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
call create_selection_buffer(bsize, bsize*2, b)
buffer_ready = .True.
else
ASSERT (b%N == bsize)
endif
call pt2_alloc(pt2_data,N_states)
b%cur = 0
call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator))
integer, external :: tasks_done_to_taskserver
if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then
done = .true.
endif
call sort_selection_buffer(b)
call wall_time(time1)
! if (time1-time0 > 15.d0) then
call omp_set_lock(global_selection_buffer_lock)
global_selection_buffer%mini = b%mini
call merge_selection_buffers(b,global_selection_buffer)
b%cur=0
call omp_unset_lock(global_selection_buffer_lock)
call wall_time(time0)
! endif
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
if ( iproc == 1 .or. i_generator < 100 .or. done) then
call omp_set_lock(global_selection_buffer_lock)
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending)
global_selection_buffer%cur = 0
call omp_unset_lock(global_selection_buffer_lock)
else
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending)
endif
call pt2_dealloc(pt2_data)
end do
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
integer, external :: disconnect_from_taskserver
do i=1,300
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) /= -2) exit
call sleep(1)
print *, 'Retry disconnect...'
end do
call end_zmq_push_socket(zmq_socket_push,thread)
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
if (buffer_ready) then
call delete_selection_buffer(b)
endif
FREE global_selection_buffer
end subroutine
subroutine push_pt2_results(zmq_socket_push, index, pt2_data, b, task_id, n_tasks)
use selection_types
use f77_zmq
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
type(pt2_type), intent(in) :: pt2_data(n_tasks)
integer, intent(in) :: n_tasks, index(n_tasks), task_id(n_tasks)
type(selection_buffer), intent(inout) :: b
logical :: sending
sending = .False.
call push_pt2_results_async_send(zmq_socket_push, index, pt2_data, b, task_id, n_tasks, sending)
call push_pt2_results_async_recv(zmq_socket_push, b%mini, sending)
end subroutine
subroutine push_pt2_results_async_send(zmq_socket_push, index, pt2_data, b, task_id, n_tasks, sending)
use selection_types
use f77_zmq
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
type(pt2_type), intent(in) :: pt2_data(n_tasks)
integer, intent(in) :: n_tasks, index(n_tasks), task_id(n_tasks)
type(selection_buffer), intent(inout) :: b
logical, intent(inout) :: sending
integer :: rc, i
integer*8 :: rc8
double precision, allocatable :: pt2_serialized(:,:)
if (sending) then
print *, irp_here, ': sending is true'
stop -1
endif
sending = .True.
rc = f77_zmq_send( zmq_socket_push, n_tasks, 4, ZMQ_SNDMORE)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 1
return
else if(rc /= 4) then
stop 'push'
endif
rc = f77_zmq_send( zmq_socket_push, index, 4*n_tasks, ZMQ_SNDMORE)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 2
return
else if(rc /= 4*n_tasks) then
stop 'push'
endif
allocate(pt2_serialized (pt2_type_size(N_states),n_tasks) )
do i=1,n_tasks
call pt2_serialize(pt2_data(i),N_states,pt2_serialized(1,i))
enddo
rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE)
deallocate(pt2_serialized)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 3
return
else if(rc /= size(pt2_serialized)*8) then
stop 'push'
endif
rc = f77_zmq_send( zmq_socket_push, task_id, n_tasks*4, ZMQ_SNDMORE)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 6
return
else if(rc /= 4*n_tasks) then
stop 'push'
endif
if (b%cur == 0) then
rc = f77_zmq_send( zmq_socket_push, b%cur, 4, 0)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 7
return
else if(rc /= 4) then
stop 'push'
endif
else
rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 7
return
else if(rc /= 4) then
stop 'push'
endif
rc8 = f77_zmq_send8( zmq_socket_push, b%val, 8_8*int(b%cur,8), ZMQ_SNDMORE)
if (rc8 == -1_8) then
print *, irp_here, ': error sending result'
stop 8
return
else if(rc8 /= 8_8*int(b%cur,8)) then
stop 'push'
endif
rc8 = f77_zmq_send8( zmq_socket_push, b%det, int(bit_kind*N_int*2,8)*int(b%cur,8), 0)
if (rc8 == -1_8) then
print *, irp_here, ': error sending result'
stop 9
return
else if(rc8 /= int(N_int*2*8,8)*int(b%cur,8)) then
stop 'push'
endif
endif
end subroutine
subroutine push_pt2_results_async_recv(zmq_socket_push,mini,sending)
use selection_types
use f77_zmq
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
double precision, intent(out) :: mini
logical, intent(inout) :: sending
integer :: rc
if (.not.sending) return
! Activate is zmq_socket_push is a REQ
IRP_IF ZMQ_PUSH
IRP_ELSE
character*(2) :: ok
rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 10
return
else if ((rc /= 2).and.(ok(1:2) /= 'ok')) then
print *, irp_here//': error in receiving ok'
stop -1
endif
rc = f77_zmq_recv( zmq_socket_push, mini, 8, 0)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 11
return
else if (rc /= 8) then
print *, irp_here//': error in receiving mini'
stop 12
endif
IRP_ENDIF
sending = .False.
end subroutine
subroutine pull_pt2_results(zmq_socket_pull, index, pt2_data, task_id, n_tasks, b)
use selection_types
use f77_zmq
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
type(pt2_type), intent(inout) :: pt2_data(*)
type(selection_buffer), intent(inout) :: b
integer, intent(out) :: index(*)
integer, intent(out) :: n_tasks, task_id(*)
integer :: rc, rn, i
integer*8 :: rc8
double precision, allocatable :: pt2_serialized(:,:)
rc = f77_zmq_recv( zmq_socket_pull, n_tasks, 4, 0)
if (rc == -1) then
n_tasks = 1
task_id(1) = 0
else if(rc /= 4) then
stop 'pull'
endif
rc = f77_zmq_recv( zmq_socket_pull, index, 4*n_tasks, 0)
if (rc == -1) then
n_tasks = 1
task_id(1) = 0
else if(rc /= 4*n_tasks) then
stop 'pull'
endif
allocate(pt2_serialized (pt2_type_size(N_states),n_tasks) )
rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized)*n_tasks, 0)
if (rc == -1) then
n_tasks = 1
task_id(1) = 0
else if(rc /= 8*size(pt2_serialized)) then
stop 'pull'
endif
do i=1,n_tasks
call pt2_deserialize(pt2_data(i),N_states,pt2_serialized(1,i))
enddo
deallocate(pt2_serialized)
rc = f77_zmq_recv( zmq_socket_pull, task_id, n_tasks*4, 0)
if (rc == -1) then
n_tasks = 1
task_id(1) = 0
else if(rc /= 4*n_tasks) then
stop 'pull'
endif
rc = f77_zmq_recv( zmq_socket_pull, b%cur, 4, 0)
if (rc == -1) then
n_tasks = 1
task_id(1) = 0
else if(rc /= 4) then
stop 'pull'
endif
if (b%cur > 0) then
rc8 = f77_zmq_recv8( zmq_socket_pull, b%val, 8_8*int(b%cur,8), 0)
if (rc8 == -1_8) then
n_tasks = 1
task_id(1) = 0
else if(rc8 /= 8_8*int(b%cur,8)) then
stop 'pull'
endif
rc8 = f77_zmq_recv8( zmq_socket_pull, b%det, int(bit_kind*N_int*2,8)*int(b%cur,8), 0)
if (rc8 == -1_8) then
n_tasks = 1
task_id(1) = 0
else if(rc8 /= int(N_int*2*8,8)*int(b%cur,8)) then
stop 'pull'
endif
endif
! Activate is zmq_socket_pull is a REP
IRP_IF ZMQ_PUSH
IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, ZMQ_SNDMORE)
if (rc == -1) then
n_tasks = 1
task_id(1) = 0
else if (rc /= 2) then
print *, irp_here//': error in sending ok'
stop -1
endif
rc = f77_zmq_send( zmq_socket_pull, b%mini, 8, 0)
IRP_ENDIF
end subroutine

258
plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f
View File

@ -1,5 +1,255 @@
subroutine provide_for_selection_slave
PROVIDE psi_det_sorted_tc_order
PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc
end
subroutine run_selection_slave(thread, iproc, energy)
use f77_zmq
use selection_types
implicit none
double precision, intent(in) :: energy(N_states)
integer, intent(in) :: thread, iproc
integer :: rc, i
integer :: worker_id, task_id(1), ctask, ltask
character*(512) :: task
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_socket_push
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_push_socket
type(selection_buffer) :: buf, buf2
type(pt2_type) :: pt2_data
logical :: done, buffer_ready
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order N_int pt2_F pseudo_sym
PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc weight_selection
call pt2_alloc(pt2_data,N_states)
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)
buf%N = 0
buffer_ready = .False.
ctask = 1
do
integer, external :: get_task_from_taskserver
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id(ctask), task) == -1) then
exit
endif
done = task_id(ctask) == 0
if (done) then
ctask = ctask - 1
else
integer :: i_generator, N, subset, bsize
call sscanf_ddd(task, subset, i_generator, N)
if(buf%N == 0) then
! Only first time
call create_selection_buffer(N, N*2, buf)
buffer_ready = .True.
else
if (N /= buf%N) then
print *, 'N=', N
print *, 'buf%N=', buf%N
print *, 'bug in ', irp_here
stop '-1'
end if
end if
call select_connected(i_generator, energy, pt2_data, buf,subset, pt2_F(i_generator))
endif
integer, external :: task_done_to_taskserver
if(done .or. ctask == size(task_id)) then
do i=1, ctask
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) == -1) then
call usleep(100)
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) == -1) then
ctask = 0
done = .true.
exit
endif
endif
end do
if(ctask > 0) then
call sort_selection_buffer(buf)
! call merge_selection_buffers(buf,buf2)
call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask)
call pt2_dealloc(pt2_data)
call pt2_alloc(pt2_data,N_states)
! buf%mini = buf2%mini
buf%cur = 0
end if
ctask = 0
end if
if(done) exit
ctask = ctask + 1
end do
if(ctask > 0) then
call sort_selection_buffer(buf)
! call merge_selection_buffers(buf,buf2)
call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask)
! buf%mini = buf2%mini
buf%cur = 0
end if
ctask = 0
call pt2_dealloc(pt2_data)
integer, external :: disconnect_from_taskserver
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
continue
endif
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread)
if (buffer_ready) then
call delete_selection_buffer(buf)
! call delete_selection_buffer(buf2)
endif
end subroutine
subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntasks)
use f77_zmq
use selection_types
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
type(pt2_type), intent(in) :: pt2_data
type(selection_buffer), intent(inout) :: b
integer, intent(in) :: ntasks, task_id(*)
integer :: rc
double precision, allocatable :: pt2_serialized(:)
rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)
if(rc /= 4) then
print *, 'f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)'
endif
allocate(pt2_serialized (pt2_type_size(N_states)) )
call pt2_serialize(pt2_data,N_states,pt2_serialized)
rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 3
return
else if(rc /= size(pt2_serialized)*8) then
stop 'push'
endif
deallocate(pt2_serialized)
if (b%cur > 0) then
rc = f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE)
if(rc /= 8*b%cur) then
print *, 'f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE)'
endif
rc = f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE)
if(rc /= bit_kind*N_int*2*b%cur) then
print *, 'f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE)'
endif
endif
rc = f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE)
if(rc /= 4) then
print *, 'f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE)'
endif
rc = f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0)
if(rc /= 4*ntasks) then
print *, 'f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0)'
endif
! Activate is zmq_socket_push is a REQ
IRP_IF ZMQ_PUSH
IRP_ELSE
character*(2) :: ok
rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
if ((rc /= 2).and.(ok(1:2) /= 'ok')) then
print *, irp_here//': error in receiving ok'
stop -1
endif
IRP_ENDIF
end subroutine
subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_id, ntasks)
use f77_zmq
use selection_types
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
type(pt2_type), intent(inout) :: pt2_data
double precision, intent(out) :: val(*)
integer(bit_kind), intent(out) :: det(N_int, 2, *)
integer, intent(out) :: N, ntasks, task_id(*)
integer :: rc, rn, i
double precision, allocatable :: pt2_serialized(:)
rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0)
if(rc /= 4) then
print *, 'f77_zmq_recv( zmq_socket_pull, N, 4, 0)'
endif
allocate(pt2_serialized (pt2_type_size(N_states)) )
rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized), 0)
if (rc == -1) then
ntasks = 1
task_id(1) = 0
else if(rc /= 8*size(pt2_serialized)) then
stop 'pull'
endif
call pt2_deserialize(pt2_data,N_states,pt2_serialized)
deallocate(pt2_serialized)
if (N>0) then
rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0)
if(rc /= 8*N) then
print *, 'f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0)'
endif
rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0)
if(rc /= bit_kind*N_int*2*N) then
print *, 'f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0)'
endif
endif
rc = f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0)
if(rc /= 4) then
print *, 'f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0)'
endif
rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0)
if(rc /= 4*ntasks) then
print *, 'f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0)'
endif
! Activate is zmq_socket_pull is a REP
IRP_IF ZMQ_PUSH
IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
if (rc /= 2) then
print *, irp_here//': error in sending ok'
stop -1
endif
IRP_ENDIF
end subroutine

164
plugins/local/cipsi_tc_bi_ortho/selection.irp.f
View File

@ -76,8 +76,6 @@ subroutine select_connected(i_generator,E0,pt2_data,b,subset,csubset)
double precision, allocatable :: fock_diag_tmp(:,:)
if (csubset == 0) return
allocate(fock_diag_tmp(2,mo_num+1))
call build_fock_tmp_tc(fock_diag_tmp, psi_det_generators(1,1,i_generator), N_int)
@ -88,13 +86,10 @@ subroutine select_connected(i_generator,E0,pt2_data,b,subset,csubset)
particle_mask(k,1) = iand(generators_bitmask(k,1,s_part), not(psi_det_generators(k,1,i_generator)) )
particle_mask(k,2) = iand(generators_bitmask(k,2,s_part), not(psi_det_generators(k,2,i_generator)) )
enddo
! if ((subset == 1).and.(sum(hole_mask(:,2)) == 0_bit_kind)) then
! ! No beta electron to excite
! call select_singles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,b)
! endif
call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,b,subset,csubset)
deallocate(fock_diag_tmp)
end subroutine
end subroutine select_connected
double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
@ -141,7 +136,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
end
subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, fock_diag_tmp, E0, pt2_data, buf, subset, csubset)
subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock_diag_tmp, E0, pt2_data, buf, subset, csubset)
use bitmasks
use selection_types
implicit none
@ -156,6 +151,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
type(pt2_type), intent(inout) :: pt2_data
type(selection_buffer), intent(inout) :: buf
double precision, parameter :: norm_thr = 1.d-16
integer :: h1, h2, s1, s2, s3, i1, i2, ib, sp, k, i, j, nt, ii, sze
integer :: maskInd
integer :: N_holes(2), N_particles(2)
@ -173,7 +170,6 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
integer, allocatable :: preinteresting(:), prefullinteresting(:)
integer, allocatable :: interesting(:), fullinteresting(:)
integer, allocatable :: tmp_array(:)
integer, allocatable :: indices(:), exc_degree(:), iorder(:)
integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :)
logical, allocatable :: banned(:,:,:), bannedOrb(:,:)
@ -182,16 +178,15 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_bilinear_matrix_order psi_bilinear_matrix_transp_order
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc_order
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_tc
PROVIDE banned_excitation
monoAdo = .true.
monoBdo = .true.
if (csubset == 0) return
do k=1,N_int
hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1))
@ -203,11 +198,7 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
call bitstring_to_list_ab(hole , hole_list , N_holes , N_int)
call bitstring_to_list_ab(particle, particle_list, N_particles, N_int)
! Removed to avoid introducing determinants already presents in the wf
!double precision, parameter :: norm_thr = 1.d-16
allocate (indices(N_det), &
exc_degree(max(N_det_alpha_unique,N_det_beta_unique)))
allocate( indices(N_det), exc_degree( max(N_det_alpha_unique, N_det_beta_unique) ) )
! Pre-compute excitation degrees wrt alpha determinants
k=1
@ -223,76 +214,73 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
if (nt > 2) cycle
do l_a=psi_bilinear_matrix_columns_loc(j), psi_bilinear_matrix_columns_loc(j+1)-1
i = psi_bilinear_matrix_rows(l_a)
if (nt + exc_degree(i) <= 4) then
if(nt + exc_degree(i) <= 4) then
idx = psi_det_sorted_tc_order(psi_bilinear_matrix_order(l_a))
! Removed to avoid introducing determinants already presents in the wf
!if (psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then
! if (psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then
indices(k) = idx
k=k+1
!endif
k = k + 1
! endif
endif
enddo
enddo
! Pre-compute excitation degrees wrt beta determinants
do i=1,N_det_beta_unique
call get_excitation_degree_spin(psi_det_beta_unique(1,i), &
psi_det_generators(1,2,i_generator), exc_degree(i), N_int)
call get_excitation_degree_spin(psi_det_beta_unique(1,i), psi_det_generators(1,2,i_generator), exc_degree(i), N_int)
enddo
! Iterate on 0S alpha, and find betas TQ such that exc_degree <= 4
! Remove also contributions < 1.d-20)
do j=1,N_det_alpha_unique
call get_excitation_degree_spin(psi_det_alpha_unique(1,j), &
psi_det_generators(1,1,i_generator), nt, N_int)
call get_excitation_degree_spin(psi_det_alpha_unique(1,j), psi_det_generators(1,1,i_generator), nt, N_int)
if (nt > 1) cycle
do l_a=psi_bilinear_matrix_transp_rows_loc(j), psi_bilinear_matrix_transp_rows_loc(j+1)-1
do l_a = psi_bilinear_matrix_transp_rows_loc(j), psi_bilinear_matrix_transp_rows_loc(j+1)-1
i = psi_bilinear_matrix_transp_columns(l_a)
if (exc_degree(i) < 3) cycle
if (nt + exc_degree(i) <= 4) then
if(exc_degree(i) < 3) cycle
if(nt + exc_degree(i) <= 4) then
idx = psi_det_sorted_tc_order( &
psi_bilinear_matrix_order( &
psi_bilinear_matrix_transp_order(l_a)))
! Removed to avoid introducing determinants already presents in the wf
!if(psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then
! if(psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then
indices(k) = idx
k=k+1
!endif
k = k + 1
! endif
endif
enddo
enddo
deallocate(exc_degree)
nmax=k-1
nmax = k - 1
call isort_noidx(indices,nmax)
! Start with 32 elements. Size will double along with the filtering.
allocate(preinteresting(0:32), prefullinteresting(0:32), &
interesting(0:32), fullinteresting(0:32))
allocate(preinteresting(0:32), prefullinteresting(0:32), interesting(0:32), fullinteresting(0:32))
preinteresting(:) = 0
prefullinteresting(:) = 0
do i=1,N_int
do i = 1, N_int
negMask(i,1) = not(psi_det_generators(i,1,i_generator))
negMask(i,2) = not(psi_det_generators(i,2,i_generator))
end do
enddo
do k = 1, nmax
do k=1,nmax
i = indices(k)
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted_tc(1,1,i))
mobMask(1,2) = iand(negMask(1,2), psi_det_sorted_tc(1,2,i))
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
do j=2,N_int
do j = 2, N_int
mobMask(j,1) = iand(negMask(j,1), psi_det_sorted_tc(j,1,i))
mobMask(j,2) = iand(negMask(j,2), psi_det_sorted_tc(j,2,i))
nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
end do
enddo
if(nt <= 4) then
if(i <= N_det_selectors) then
sze = preinteresting(0)
if (sze+1 == size(preinteresting)) then
allocate (tmp_array(0:sze))
if(sze+1 == size(preinteresting)) then
allocate(tmp_array(0:sze))
tmp_array(0:sze) = preinteresting(0:sze)
deallocate(preinteresting)
allocate(preinteresting(0:2*sze))
@ -301,9 +289,9 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
endif
preinteresting(0) = sze+1
preinteresting(sze+1) = i
else if(nt <= 2) then
elseif(nt <= 2) then
sze = prefullinteresting(0)
if (sze+1 == size(prefullinteresting)) then
if(sze+1 == size(prefullinteresting)) then
allocate (tmp_array(0:sze))
tmp_array(0:sze) = prefullinteresting(0:sze)
deallocate(prefullinteresting)
@ -313,16 +301,20 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
endif
prefullinteresting(0) = sze+1
prefullinteresting(sze+1) = i
end if
end if
end do
endif
endif
enddo
deallocate(indices)
allocate(banned(mo_num, mo_num,2), bannedOrb(mo_num, 2))
allocate(mat(N_states, mo_num, mo_num))
allocate(mat_l(N_states, mo_num, mo_num), mat_r(N_states, mo_num, mo_num))
allocate( banned(mo_num, mo_num,2), bannedOrb(mo_num, 2) )
allocate( mat(N_states, mo_num, mo_num) )
allocate( mat_l(N_states, mo_num, mo_num), mat_r(N_states, mo_num, mo_num) )
maskInd = -1
do s1 = 1, 2
do i1 = N_holes(s1), 1, -1 ! Generate low excitations first
@ -355,17 +347,17 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
do ii = 1, preinteresting(0)
i = preinteresting(ii)
select case (N_int)
case (1)
select case(N_int)
case(1)
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted_tc(1,1,i))
mobMask(1,2) = iand(negMask(1,2), psi_det_sorted_tc(1,2,i))
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
case (2)
case(2)
mobMask(1:2,1) = iand(negMask(1:2,1), psi_det_sorted_tc(1:2,1,i))
mobMask(1:2,2) = iand(negMask(1:2,2), psi_det_sorted_tc(1:2,2,i))
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + &
popcnt(mobMask(2, 1)) + popcnt(mobMask(2, 2))
case (3)
case(3)
mobMask(1:3,1) = iand(negMask(1:3,1), psi_det_sorted_tc(1:3,1,i))
mobMask(1:3,2) = iand(negMask(1:3,2), psi_det_sorted_tc(1:3,2,i))
nt = 0
@ -378,8 +370,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
nt = nt+ popcnt(mobMask(j, 2))
if (nt > 4) exit
endif
end do
case (4)
enddo
case(4)
mobMask(1:4,1) = iand(negMask(1:4,1), psi_det_sorted_tc(1:4,1,i))
mobMask(1:4,2) = iand(negMask(1:4,2), psi_det_sorted_tc(1:4,2,i))
nt = 0
@ -392,7 +384,7 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
nt = nt+ popcnt(mobMask(j, 2))
if (nt > 4) exit
endif
end do
enddo
case default
mobMask(1:N_int,1) = iand(negMask(1:N_int,1), psi_det_sorted_tc(1:N_int,1,i))
mobMask(1:N_int,2) = iand(negMask(1:N_int,2), psi_det_sorted_tc(1:N_int,2,i))
@ -406,12 +398,12 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
nt = nt+ popcnt(mobMask(j, 2))
if (nt > 4) exit
endif
end do
enddo
end select
if(nt <= 4) then
sze = interesting(0)
if (sze+1 == size(interesting)) then
if(sze+1 == size(interesting)) then
allocate (tmp_array(0:sze))
tmp_array(0:sze) = interesting(0:sze)
deallocate(interesting)
@ -433,8 +425,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
endif
fullinteresting(0) = sze+1
fullinteresting(sze+1) = i
end if
end if
endif
endif
enddo
@ -464,10 +456,10 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
endif
fullinteresting(0) = sze+1
fullinteresting(sze+1) = i
end if
end do
allocate (fullminilist (N_int, 2, fullinteresting(0)), &
minilist (N_int, 2, interesting(0)) )
endif
enddo
allocate( fullminilist (N_int, 2, fullinteresting(0)), &
minilist (N_int, 2, interesting(0)) )
do i = 1, fullinteresting(0)
do k = 1, N_int
@ -525,8 +517,7 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting, mat_l, mat_r)
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf, mat_l, mat_r)
end if
endif
enddo
@ -542,8 +533,7 @@ subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, foc
deallocate(banned, bannedOrb,mat)
deallocate(mat_l, mat_r)
end subroutine
end subroutine select_singles_and_doubles
! ---
@ -795,11 +785,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
if (do_ormas) then
logical, external :: det_allowed_ormas
if (.not.det_allowed_ormas(det)) cycle
endif
if(do_only_cas) then
if( number_of_particles(det) > 0 ) cycle
if( number_of_holes(det) > 0 ) cycle
@ -939,13 +924,13 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
call htilde_mu_mat_opt_bi_ortho_no_3e(psi_selectors(1,1,iii), det, N_int, i_h_alpha)
call htilde_mu_mat_opt_bi_ortho_no_3e(det, psi_selectors(1,1,iii), N_int, alpha_h_i)
print*,i_h_alpha,alpha_h_i
call debug_det(psi_selectors(1,1,iii),N_int)
enddo
call debug_det(psi_selectors(1,1,iii),N_int)
enddo
! print*,'psi_det '
! do iii = 1, N_det! old version
! print*,'iii',iii,psi_l_coef_bi_ortho(iii,1),psi_r_coef_bi_ortho(iii,1)
! call debug_det(psi_det(1,1,iii),N_int)
! enddo
! call debug_det(psi_det(1,1,iii),N_int)
! enddo
stop
endif
endif
@ -953,29 +938,29 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
psi_h_alpha = mat_l(istate, p1, p2)
alpha_h_psi = mat_r(istate, p1, p2)
endif
val = 4.d0 * psi_h_alpha * alpha_h_psi
val = 4.d0 * psi_h_alpha * alpha_h_psi
tmp = dsqrt(delta_E * delta_E + val)
! if (delta_E < 0.d0) then
! tmp = -tmp
! endif
e_pert(istate) = 0.25 * val / delta_E
! e_pert(istate) = 0.5d0 * (tmp - delta_E)
if(dsqrt(tmp).gt.1.d-4.and.dabs(psi_h_alpha).gt.1.d-4)then
coef(istate) = e_pert(istate) / psi_h_alpha
if(dsqrt(dabs(tmp)).gt.1.d-4.and.dabs(alpha_h_psi).gt.1.d-4)then
coef(istate) = e_pert(istate) / psi_h_alpha
else
coef(istate) = alpha_h_psi / delta_E
coef(istate) = alpha_h_psi / delta_E
endif
if(selection_tc == 1)then
if(e_pert(istate).lt.0.d0)then
if(e_pert(istate).lt.0.d0)then
e_pert(istate)=0.d0
else
else
e_pert(istate)=-e_pert(istate)
endif
else if(selection_tc == -1)then
if(e_pert(istate).gt.0.d0)e_pert(istate)=0.d0
endif
! if(selection_tc == 1 )then
! if(e_pert(istate).lt.0.d0)then
! e_pert(istate) = 0.d0
@ -995,11 +980,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
psi_h_alpha = mat_l(istate, p1, p2)
pt2_data % overlap(:,istate) = pt2_data % overlap(:,istate) + coef(:) * coef(istate)
if(e_pert(istate).gt.0.d0)then! accumulate the positive part of the pt2
pt2_data % variance(istate) = pt2_data % variance(istate) + e_pert(istate)
else ! accumulate the negative part of the pt2
pt2_data % pt2(istate) = pt2_data % pt2(istate) + e_pert(istate)
endif
pt2_data % variance(istate) = pt2_data % variance(istate) + dabs(e_pert(istate))
pt2_data % pt2(istate) = pt2_data % pt2(istate) + e_pert(istate)
select case (weight_selection)
case(5)

424
plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f Normal file
View File

@ -0,0 +1,424 @@
subroutine create_selection_buffer(N, size_in, res)
use selection_types
implicit none
BEGIN_DOC
! Allocates the memory for a selection buffer.
! The arrays have dimension size_in and the maximum number of elements is N
END_DOC
integer, intent(in) :: N, size_in
type(selection_buffer), intent(out) :: res
integer :: siz
siz = max(size_in,1)
double precision :: rss
double precision, external :: memory_of_double
rss = memory_of_double(siz)*(N_int*2+1)
call check_mem(rss,irp_here)
allocate(res%det(N_int, 2, siz), res%val(siz))
res%val(:) = 0d0
res%det(:,:,:) = 0_8
res%N = N
res%mini = 0d0
res%cur = 0
end subroutine
subroutine delete_selection_buffer(b)
use selection_types
implicit none
type(selection_buffer), intent(inout) :: b
if (associated(b%det)) then
deallocate(b%det)
endif
if (associated(b%val)) then
deallocate(b%val)
endif
NULLIFY(b%det)
NULLIFY(b%val)
b%cur = 0
b%mini = 0.d0
b%N = 0
end
subroutine add_to_selection_buffer(b, det, val)
use selection_types
implicit none
type(selection_buffer), intent(inout) :: b
integer(bit_kind), intent(in) :: det(N_int, 2)
double precision, intent(in) :: val
integer :: i
if(b%N > 0 .and. val <= b%mini) then
b%cur += 1
b%det(1:N_int,1:2,b%cur) = det(1:N_int,1:2)
b%val(b%cur) = val
if(b%cur == size(b%val)) then
call sort_selection_buffer(b)
end if
end if
end subroutine
subroutine merge_selection_buffers(b1, b2)
use selection_types
implicit none
BEGIN_DOC
! Merges the selection buffers b1 and b2 into b2
END_DOC
type(selection_buffer), intent(inout) :: b1
type(selection_buffer), intent(inout) :: b2
integer(bit_kind), pointer :: detmp(:,:,:)
double precision, pointer :: val(:)
integer :: i, i1, i2, k, nmwen, sze
if (b1%cur == 0) return
do while (b1%val(b1%cur) > b2%mini)
b1%cur = b1%cur-1
if (b1%cur == 0) then
return
endif
enddo
nmwen = min(b1%N, b1%cur+b2%cur)
double precision :: rss
double precision, external :: memory_of_double
sze = max(size(b1%val), size(b2%val))
rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze)
call check_mem(rss,irp_here)
allocate(val(sze), detmp(N_int, 2, sze))
i1=1
i2=1
do i=1,nmwen
if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then
exit
else if (i1 > b1%cur) then
val(i) = b2%val(i2)
detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2)
detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2)
i2=i2+1
else if (i2 > b2%cur) then
val(i) = b1%val(i1)
detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1)
detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1)
i1=i1+1
else
if (b1%val(i1) <= b2%val(i2)) then
val(i) = b1%val(i1)
detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1)
detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1)
i1=i1+1
else
val(i) = b2%val(i2)
detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2)
detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2)
i2=i2+1
endif
endif
enddo
deallocate(b2%det, b2%val)
do i=nmwen+1,b2%N
val(i) = 0.d0
detmp(1:N_int,1:2,i) = 0_bit_kind
enddo
b2%det => detmp
b2%val => val
! if(selection_tc == 1)then
! b2%mini = max(b2%mini,b2%val(b2%N))
! else
b2%mini = min(b2%mini,b2%val(b2%N))
! endif
b2%cur = nmwen
end
subroutine sort_selection_buffer(b)
use selection_types
implicit none
type(selection_buffer), intent(inout) :: b
integer, allocatable :: iorder(:)
integer(bit_kind), pointer :: detmp(:,:,:)
integer :: i, nmwen
logical, external :: detEq
if (b%N == 0 .or. b%cur == 0) return
nmwen = min(b%N, b%cur)
double precision :: rss
double precision, external :: memory_of_double, memory_of_int
rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3))
call check_mem(rss,irp_here)
allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3)))
do i=1,b%cur
iorder(i) = i
end do
call dsort(b%val, iorder, b%cur)
do i=1, nmwen
detmp(1:N_int,1,i) = b%det(1:N_int,1,iorder(i))
detmp(1:N_int,2,i) = b%det(1:N_int,2,iorder(i))
end do
deallocate(b%det,iorder)
b%det => detmp
! if(selection_tc == 1)then
! b%mini = max(b%mini,b%val(b%N))
! else
b%mini = min(b%mini,b%val(b%N))
! endif
b%cur = nmwen
end subroutine
subroutine make_selection_buffer_s2(b)
use selection_types
type(selection_buffer), intent(inout) :: b
integer(bit_kind), allocatable :: o(:,:,:)
double precision, allocatable :: val(:)
integer :: n_d
integer :: i,k,sze,n_alpha,j,n
logical :: dup
! Sort
integer, allocatable :: iorder(:)
integer*8, allocatable :: bit_tmp(:)
integer*8, external :: configuration_search_key
integer(bit_kind), allocatable :: tmp_array(:,:,:)
logical, allocatable :: duplicate(:)
n_d = b%cur
double precision :: rss
double precision, external :: memory_of_double
rss = (4*N_int+4)*memory_of_double(n_d)
call check_mem(rss,irp_here)
allocate(o(N_int,2,n_d), iorder(n_d), duplicate(n_d), bit_tmp(n_d), &
tmp_array(N_int,2,n_d), val(n_d) )
do i=1,n_d
do k=1,N_int
o(k,1,i) = ieor(b%det(k,1,i), b%det(k,2,i))
o(k,2,i) = iand(b%det(k,1,i), b%det(k,2,i))
enddo
iorder(i) = i
bit_tmp(i) = configuration_search_key(o(1,1,i),N_int)
enddo
deallocate(b%det)
call i8sort(bit_tmp,iorder,n_d)
do i=1,n_d
do k=1,N_int
tmp_array(k,1,i) = o(k,1,iorder(i))
tmp_array(k,2,i) = o(k,2,iorder(i))
enddo
val(i) = b%val(iorder(i))
duplicate(i) = .False.
enddo
! Find duplicates
do i=1,n_d-1
if (duplicate(i)) then
cycle
endif
j = i+1
do while (bit_tmp(j)==bit_tmp(i))
if (duplicate(j)) then
j+=1
if (j>n_d) then
exit
endif
cycle
endif
dup = .True.
do k=1,N_int
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) &
.or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
dup = .False.
exit
endif
enddo
if (dup) then
val(i) = max(val(i), val(j))
duplicate(j) = .True.
endif
j+=1
if (j>n_d) then
exit
endif
enddo
enddo
deallocate (b%val)
! Copy filtered result
integer :: n_p
n_p=0
do i=1,n_d
if (duplicate(i)) then
cycle
endif
n_p = n_p + 1
do k=1,N_int
o(k,1,n_p) = tmp_array(k,1,i)
o(k,2,n_p) = tmp_array(k,2,i)
enddo
val(n_p) = val(i)
enddo
! Sort by importance
do i=1,n_p
iorder(i) = i
end do
call dsort(val,iorder,n_p)
do i=1,n_p
do k=1,N_int
tmp_array(k,1,i) = o(k,1,iorder(i))
tmp_array(k,2,i) = o(k,2,iorder(i))
enddo
enddo
do i=1,n_p
do k=1,N_int
o(k,1,i) = tmp_array(k,1,i)
o(k,2,i) = tmp_array(k,2,i)
enddo
enddo
! Create determinants
n_d = 0
do i=1,n_p
call configuration_to_dets_size(o(1,1,i),sze,elec_alpha_num,N_int)
n_d = n_d + sze
if (n_d > b%cur) then
! if (n_d - b%cur > b%cur - n_d + sze) then
! n_d = n_d - sze
! endif
exit
endif
enddo
rss = (4*N_int+2)*memory_of_double(n_d)
call check_mem(rss,irp_here)
allocate(b%det(N_int,2,2*n_d), b%val(2*n_d))
k=1
do i=1,n_p
n=n_d
call configuration_to_dets_size(o(1,1,i),n,elec_alpha_num,N_int)
call configuration_to_dets(o(1,1,i),b%det(1,1,k),n,elec_alpha_num,N_int)
do j=k,k+n-1
b%val(j) = val(i)
enddo
k = k+n
if (k > n_d) exit
enddo
deallocate(o)
b%cur = n_d
b%N = n_d
end
subroutine remove_duplicates_in_selection_buffer(b)
use selection_types
type(selection_buffer), intent(inout) :: b
integer(bit_kind), allocatable :: o(:,:,:)
double precision, allocatable :: val(:)
integer :: n_d
integer :: i,k,sze,n_alpha,j,n
logical :: dup
! Sort
integer, allocatable :: iorder(:)
integer*8, allocatable :: bit_tmp(:)
integer*8, external :: det_search_key
integer(bit_kind), allocatable :: tmp_array(:,:,:)
logical, allocatable :: duplicate(:)
n_d = b%cur
logical :: found_duplicates
double precision :: rss
double precision, external :: memory_of_double
rss = (4*N_int+4)*memory_of_double(n_d)
call check_mem(rss,irp_here)
found_duplicates = .False.
allocate(iorder(n_d), duplicate(n_d), bit_tmp(n_d), &
tmp_array(N_int,2,n_d), val(n_d) )
do i=1,n_d
iorder(i) = i
bit_tmp(i) = det_search_key(b%det(1,1,i),N_int)
enddo
call i8sort(bit_tmp,iorder,n_d)
do i=1,n_d
do k=1,N_int
tmp_array(k,1,i) = b%det(k,1,iorder(i))
tmp_array(k,2,i) = b%det(k,2,iorder(i))
enddo
val(i) = b%val(iorder(i))
duplicate(i) = .False.
enddo
! Find duplicates
do i=1,n_d-1
if (duplicate(i)) then
cycle
endif
j = i+1
do while (bit_tmp(j)==bit_tmp(i))
if (duplicate(j)) then
j+=1
if (j>n_d) then
exit
endif
cycle
endif
dup = .True.
do k=1,N_int
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) &
.or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
dup = .False.
exit
endif
enddo
if (dup) then
duplicate(j) = .True.
found_duplicates = .True.
endif
j+=1
if (j>n_d) then
exit
endif
enddo
enddo
if (found_duplicates) then
! Copy filtered result
integer :: n_p
n_p=0
do i=1,n_d
if (duplicate(i)) then
cycle
endif
n_p = n_p + 1
do k=1,N_int
b%det(k,1,n_p) = tmp_array(k,1,i)
b%det(k,2,n_p) = tmp_array(k,2,i)
enddo
val(n_p) = val(i)
enddo
b%cur=n_p
b%N=n_p
endif
end

0
src/cipsi_utils/selection_types.f90 → plugins/local/cipsi_tc_bi_ortho/selection_types.f90
View File

134
plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f Normal file
View File

@ -0,0 +1,134 @@
BEGIN_PROVIDER [ double precision, pt2_match_weight, (N_states) ]
implicit none
BEGIN_DOC
! Weights adjusted along the selection to make the PT2 contributions
! of each state coincide.
END_DOC
pt2_match_weight(:) = 1.d0
END_PROVIDER
BEGIN_PROVIDER [ double precision, variance_match_weight, (N_states) ]
implicit none
BEGIN_DOC
! Weights adjusted along the selection to make the variances
! of each state coincide.
END_DOC
variance_match_weight(:) = 1.d0
END_PROVIDER
subroutine update_pt2_and_variance_weights(pt2_data, N_st)
implicit none
use selection_types
BEGIN_DOC
! Updates the PT2- and Variance- matching weights.
END_DOC
integer, intent(in) :: N_st
type(pt2_type), intent(in) :: pt2_data
double precision :: pt2(N_st)
double precision :: variance(N_st)
double precision :: avg, element, dt, x
integer :: k
pt2(:) = pt2_data % pt2(:)
variance(:) = pt2_data % variance(:)
avg = sum(pt2(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero
dt = 8.d0 !* selection_factor
do k=1,N_st
element = exp(dt*(pt2(k)/avg - 1.d0))
element = min(2.0d0 , element)
element = max(0.5d0 , element)
pt2_match_weight(k) *= element
enddo
avg = sum(variance(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero
do k=1,N_st
element = exp(dt*(variance(k)/avg -1.d0))
element = min(2.0d0 , element)
element = max(0.5d0 , element)
variance_match_weight(k) *= element
enddo
if (N_det < 100) then
! For tiny wave functions, weights are 1.d0
pt2_match_weight(:) = 1.d0
variance_match_weight(:) = 1.d0
endif
threshold_davidson_pt2 = min(1.d-6, &
max(threshold_davidson, 1.e-1 * PT2_relative_error * minval(abs(pt2(1:N_states)))) )
SOFT_TOUCH pt2_match_weight variance_match_weight threshold_davidson_pt2
end
BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
implicit none
BEGIN_DOC
! Weights used in the selection criterion
END_DOC
select case (weight_selection)
case (0)
print *, 'Using input weights in selection'
selection_weight(1:N_states) = c0_weight(1:N_states) * state_average_weight(1:N_states)
case (1)
print *, 'Using 1/c_max^2 weight in selection'
selection_weight(1:N_states) = c0_weight(1:N_states)
case (2)
print *, 'Using pt2-matching weight in selection'
selection_weight(1:N_states) = c0_weight(1:N_states) * pt2_match_weight(1:N_states)
print *, '# PT2 weight ', real(pt2_match_weight(:),4)
case (3)
print *, 'Using variance-matching weight in selection'
selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states)
print *, '# var weight ', real(variance_match_weight(:),4)
case (4)
print *, 'Using variance- and pt2-matching weights in selection'
selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states))
print *, '# PT2 weight ', real(pt2_match_weight(:),4)
print *, '# var weight ', real(variance_match_weight(:),4)
case (5)
print *, 'Using variance-matching weight in selection'
selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states)
print *, '# var weight ', real(variance_match_weight(:),4)
case (6)
print *, 'Using CI coefficient-based selection'
selection_weight(1:N_states) = c0_weight(1:N_states)
case (7)
print *, 'Input weights multiplied by variance- and pt2-matching'
selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states)) * state_average_weight(1:N_states)
print *, '# PT2 weight ', real(pt2_match_weight(:),4)
print *, '# var weight ', real(variance_match_weight(:),4)
case (8)
print *, 'Input weights multiplied by pt2-matching'
selection_weight(1:N_states) = c0_weight(1:N_states) * pt2_match_weight(1:N_states) * state_average_weight(1:N_states)
print *, '# PT2 weight ', real(pt2_match_weight(:),4)
case (9)
print *, 'Input weights multiplied by variance-matching'
selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states) * state_average_weight(1:N_states)
print *, '# var weight ', real(variance_match_weight(:),4)
end select
print *, '# Total weight ', real(selection_weight(:),4)
END_PROVIDER

348
plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f Normal file
View File

@ -0,0 +1,348 @@
subroutine run_slave_cipsi
BEGIN_DOC
! Helper program for distributed parallelism
END_DOC
implicit none
call omp_set_max_active_levels(1)
distributed_davidson = .False.
read_wf = .False.
SOFT_TOUCH read_wf distributed_davidson
call provide_everything
call switch_qp_run_to_master
call run_slave_main
end
subroutine provide_everything
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag
PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context
PROVIDE psi_det psi_coef threshold_generators state_average_weight
PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym
end
subroutine run_slave_main
use f77_zmq
implicit none
IRP_IF MPI
include 'mpif.h'
IRP_ENDIF
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
double precision :: energy(N_states)
character*(64) :: states(10)
character*(64) :: old_state
integer :: rc, i, ierr
double precision :: t0, t1
integer, external :: zmq_get_dvector, zmq_get_N_det_generators
integer, external :: zmq_get8_dvector
integer, external :: zmq_get_ivector
integer, external :: zmq_get_psi, zmq_get_N_det_selectors, zmq_get_psi_bilinear
integer, external :: zmq_get_psi_notouch
integer, external :: zmq_get_N_states_diag
zmq_context = f77_zmq_ctx_new ()
states(1) = 'selection'
states(2) = 'davidson'
states(3) = 'pt2'
old_state = 'Waiting'
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
PROVIDE psi_det psi_coef threshold_generators state_average_weight mpi_master
PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator
PROVIDE N_det_generators N_states N_states_diag pt2_e0_denominator mpi_rank
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
do
if (mpi_master) then
call wait_for_states(states,zmq_state,size(states))
if (zmq_state(1:64) == old_state(1:64)) then
call usleep(200)
cycle
else
old_state(1:64) = zmq_state(1:64)
endif
print *, trim(zmq_state)
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
call MPI_BCAST (zmq_state, 128, MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here, 'error in broadcast of zmq_state'
endif
IRP_ENDIF
if(zmq_state(1:7) == 'Stopped') then
exit
endif
if (zmq_state(1:9) == 'selection') then
! Selection
! ---------
call wall_time(t0)
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_psi')
IRP_ENDIF
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_dvector threshold_generators')
IRP_ENDIF
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_dvector energy')
IRP_ENDIF
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_N_det_generators')
IRP_ENDIF
if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_N_det_selectors')
IRP_ENDIF
if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_dvector state_average_weight')
IRP_ENDIF
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_dvector selection_weight')
IRP_ENDIF
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) cycle
pt2_e0_denominator(1:N_states) = energy(1:N_states)
TOUCH pt2_e0_denominator state_average_weight threshold_generators selection_weight psi_det psi_coef
if (mpi_master) then
print *, 'N_det', N_det
print *, 'N_det_generators', N_det_generators
print *, 'N_det_selectors', N_det_selectors
print *, 'pt2_e0_denominator', pt2_e0_denominator
print *, 'pt2_stoch_istate', pt2_stoch_istate
print *, 'state_average_weight', state_average_weight
print *, 'selection_weight', selection_weight
endif
call wall_time(t1)
call write_double(6,(t1-t0),'Broadcast time')
IRP_IF MPI_DEBUG
call mpi_print('Entering OpenMP section')
IRP_ENDIF
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call run_selection_slave(0,i,energy)
!$OMP END PARALLEL
print *, mpi_rank, ': Selection done'
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here, 'error in barrier'
endif
IRP_ENDIF
call mpi_print('----------')
else if (zmq_state(1:8) == 'davidson') then
! Davidson
! --------
call wall_time(t0)
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_N_states_diag')
IRP_ENDIF
if (zmq_get_N_states_diag(zmq_to_qp_run_socket,1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_psi')
IRP_ENDIF
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
call wall_time(t1)
call write_double(6,(t1-t0),'Broadcast time')
!---
call omp_set_max_active_levels(8)
call davidson_slave_tcp(0)
call omp_set_max_active_levels(1)
print *, mpi_rank, ': Davidson done'
!---
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here, 'error in barrier'
endif
IRP_ENDIF
call mpi_print('----------')
else if (zmq_state(1:3) == 'pt2') then
! PT2
! ---
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here, 'error in barrier'
endif
IRP_ENDIF
call wall_time(t0)
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_psi')
IRP_ENDIF
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_N_det_generators')
IRP_ENDIF
if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_N_det_selectors')
IRP_ENDIF
if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_dvector threshold_generators')
IRP_ENDIF
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_dvector energy')
IRP_ENDIF
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_ivector pt2_stoch_istate')
IRP_ENDIF
if (zmq_get_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_dvector state_average_weight')
IRP_ENDIF
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) cycle
IRP_IF MPI_DEBUG
call mpi_print('zmq_get_dvector selection_weight')
IRP_ENDIF
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) cycle
pt2_e0_denominator(1:N_states) = energy(1:N_states)
SOFT_TOUCH pt2_e0_denominator state_average_weight pt2_stoch_istate threshold_generators selection_weight psi_det psi_coef N_det_generators N_det_selectors
call wall_time(t1)
call write_double(6,(t1-t0),'Broadcast time')
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here, 'error in barrier'
endif
IRP_ENDIF
IRP_IF MPI_DEBUG
call mpi_print('Entering OpenMP section')
IRP_ENDIF
if (.true.) then
integer :: nproc_target, ii
double precision :: mem_collector, mem, rss
call resident_memory(rss)
nproc_target = nthreads_pt2
ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2)
do
mem = rss + & !
nproc_target * 8.d0 * & ! bytes
( 0.5d0*pt2_n_tasks_max & ! task_id
+ 64.d0*pt2_n_tasks_max & ! task
+ 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset
+ 3.d0*(N_int*2.d0*ii+ ii) & ! selection buffer
+ 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer
+ 2.0d0*(ii) & ! preinteresting, interesting,
! prefullinteresting, fullinteresting
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
) / 1024.d0**3
if (nproc_target == 0) then
call check_mem(mem,irp_here)
nproc_target = 1
exit
endif
if (mem+rss < qp_max_mem) then
exit
endif
nproc_target = nproc_target - 1
enddo
if (N_det > 100000) then
if (mpi_master) then
print *, 'N_det', N_det
print *, 'N_det_generators', N_det_generators
print *, 'N_det_selectors', N_det_selectors
print *, 'pt2_e0_denominator', pt2_e0_denominator
print *, 'pt2_stoch_istate', pt2_stoch_istate
print *, 'state_average_weight', state_average_weight
print *, 'selection_weight', selection_weight
print *, 'Number of threads', nproc_target
endif
if (h0_type == 'CFG') then
PROVIDE det_to_configuration
endif
PROVIDE global_selection_buffer pt2_N_teeth pt2_F N_det_generators
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted_tc
PROVIDE psi_det_hii selection_weight pseudo_sym pt2_min_parallel_tasks
if (mpi_master) then
print *, 'Running PT2'
endif
!$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target+1)
i = omp_get_thread_num()
call run_pt2_slave(0,i,pt2_e0_denominator)
!$OMP END PARALLEL
FREE state_average_weight
print *, mpi_rank, ': PT2 done'
print *, '-------'
endif
endif
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here, 'error in barrier'
endif
IRP_ENDIF
call mpi_print('----------')
endif
end do
IRP_IF MPI
call MPI_finalize(ierr)
IRP_ENDIF
end

63
plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f
View File

@ -11,13 +11,15 @@ subroutine run_stochastic_cipsi
implicit none
integer :: i, j, k, ndet
integer :: to_select
logical :: print_pt2
logical :: has
type(pt2_type) :: pt2_data, pt2_data_err
double precision :: rss
double precision :: correlation_energy_ratio
double precision :: correlation_energy_ratio, E_denom, E_tc, norm
double precision :: hf_energy_ref
double precision :: relative_error
double precision, allocatable :: zeros(:),E_tc(:), norm(:)
double precision, allocatable :: ept2(:), pt1(:), extrap_energy(:)
double precision, allocatable :: zeros(:)
logical, external :: qp_stop
double precision, external :: memory_of_double
@ -30,13 +32,14 @@ subroutine run_stochastic_cipsi
write(*,*) i, Fock_matrix_tc_mo_tot(i,i)
enddo
N_iter = 1
threshold_generators = 1.d0
SOFT_TOUCH threshold_generators
rss = memory_of_double(N_states)*4.d0
call check_mem(rss, irp_here)
allocate(zeros(N_states),E_tc(N_states), norm(N_states))
allocate(zeros(N_states))
call pt2_alloc(pt2_data, N_states)
call pt2_alloc(pt2_data_err, N_states)
@ -52,27 +55,32 @@ subroutine run_stochastic_cipsi
! if (s2_eig) then
! call make_s2_eigenfunction
! endif
call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm)
print_pt2 = .False.
call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2)
! call routine_save_right
! if (N_det > N_det_max) then
! psi_det(1:N_int,1:2,1:N_det) = psi_det_generators(1:N_int,1:2,1:N_det)
! psi_coef(1:N_det,1:N_states) = psi_coef_sorted_gen(1:N_det,1:N_states)
! psi_coef(1:N_det,1:N_states) = psi_coef_sorted_tc_gen(1:N_det,1:N_states)
! N_det = N_det_max
! soft_touch N_det psi_det psi_coef
! if (s2_eig) then
! call make_s2_eigenfunction
! endif
! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm)
! print_pt2 = .False.
! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
! call routine_save_right
! endif
allocate(ept2(1000),pt1(1000),extrap_energy(100))
correlation_energy_ratio = 0.d0
! thresh_it_dav = 5.d-5
! soft_touch thresh_it_dav
print_pt2 = .True.
do while( (N_det < N_det_max) .and. &
(maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max))
@ -83,15 +91,15 @@ subroutine run_stochastic_cipsi
to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor)
to_select = max(N_states_diag, to_select)
print*,'E_tc = ',E_tc
E_denom = E_tc ! TC Energy of the current wave function
call pt2_dealloc(pt2_data)
call pt2_dealloc(pt2_data_err)
call pt2_alloc(pt2_data, N_states)
call pt2_alloc(pt2_data_err, N_states)
call ZMQ_pt2(E_tc, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection
call ZMQ_pt2(E_denom, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection
! stop
call print_summary_tc(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, N_det, N_configuration, N_states, psi_s2)
call print_summary(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, N_det, N_configuration, N_states, psi_s2)
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
@ -109,19 +117,48 @@ subroutine run_stochastic_cipsi
PROVIDE psi_det
PROVIDE psi_det_sorted_tc
call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm)
ept2(N_iter-1) = E_tc + nuclear_repulsion + (pt2_data % pt2(1))/norm
pt1(N_iter-1) = dsqrt(pt2_data % overlap(1,1))
call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2)
! stop
if (qp_stop()) exit
enddo
! print*,'data to extrapolate '
! do i = 2, N_iter
! print*,'iteration ',i
! print*,'pt1,Ept2',pt1(i),ept2(i)
! call get_extrapolated_energy(i-1,ept2(i),pt1(i),extrap_energy(i))
! do j = 2, i
! print*,'j,e,energy',j,extrap_energy(j)
! enddo
! enddo
! thresh_it_dav = 5.d-6
! soft_touch thresh_it_dav
call pt2_dealloc(pt2_data)
call pt2_dealloc(pt2_data_err)
call pt2_alloc(pt2_data, N_states)
call pt2_alloc(pt2_data_err, N_states)
call ZMQ_pt2(E_tc, pt2_data, pt2_data_err, relative_error,0) ! Stochastic PT2 and selection
call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm)
call pt2_dealloc(pt2_data)
call pt2_dealloc(pt2_data_err)
call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
! if (.not.qp_stop()) then
! if (N_det < N_det_max) then
! thresh_it_dav = 5.d-7
! soft_touch thresh_it_dav
! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
! endif
!
! call pt2_dealloc(pt2_data)
! call pt2_dealloc(pt2_data_err)
! call pt2_alloc(pt2_data, N_states)
! call pt2_alloc(pt2_data_err, N_states)
! call ZMQ_pt2(E_denom, pt2_data, pt2_data_err, relative_error, 0) ! Stochastic PT2
! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
! endif
! call pt2_dealloc(pt2_data)
! call pt2_dealloc(pt2_data_err)
! call routine_save_right
end

29
plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f
View File

@ -9,8 +9,6 @@ subroutine write_cipsi_json(pt2_data, pt2_data_err)
call lock_io
character*(64), allocatable :: fmtk(:)
double precision:: pt2_minus,pt2_plus,pt2_tot, pt2_abs
double precision :: error_pt2_minus, error_pt2_plus, error_pt2_tot, error_pt2_abs
integer :: N_states_p, N_iter_p
N_states_p = min(N_states,N_det)
N_iter_p = min(N_iter,8)
@ -28,34 +26,15 @@ subroutine write_cipsi_json(pt2_data, pt2_data_err)
endif
write(json_unit, json_array_open_fmt) 'states'
do k=1,N_states_p
pt2_plus = pt2_data % variance(k)
pt2_minus = pt2_data % pt2(k)
pt2_abs = pt2_plus - pt2_minus
pt2_tot = pt2_plus + pt2_minus
error_pt2_minus = pt2_data_err % pt2(k)
error_pt2_plus = pt2_data_err % variance(k)
error_pt2_tot = dsqrt(error_pt2_minus**2+error_pt2_plus**2)
error_pt2_abs = error_pt2_tot ! same variance because independent variables
write(json_unit, json_dict_uopen_fmt)
write(json_unit, json_real_fmt) 'energy', psi_energy_with_nucl_rep(k)
write(json_unit, json_real_fmt) 's2', psi_s2(k)
write(json_unit, json_real_fmt) 'pt2', pt2_tot
write(json_unit, json_real_fmt) 'pt2_err', error_pt2_tot
write(json_unit, json_real_fmt) 'pt2_minus', pt2_minus
write(json_unit, json_real_fmt) 'pt2_minus_err', error_pt2_minus
write(json_unit, json_real_fmt) 'pt2_abs', pt2_abs
write(json_unit, json_real_fmt) 'pt2_abs_err', error_pt2_abs
write(json_unit, json_real_fmt) 'pt2_plus', pt2_plus
write(json_unit, json_real_fmt) 'pt2_plus_err', error_pt2_plus
write(json_unit, json_real_fmt) 'pt2', pt2_data % pt2(k)
write(json_unit, json_real_fmt) 'pt2_err', pt2_data_err % pt2(k)
write(json_unit, json_real_fmt) 'rpt2', pt2_data % rpt2(k)
write(json_unit, json_real_fmt) 'rpt2_err', pt2_data_err % rpt2(k)
! write(json_unit, json_real_fmt) 'variance', pt2_data % variance(k)
! write(json_unit, json_real_fmt) 'variance_err', pt2_data_err % variance(k)
write(json_unit, json_real_fmt) 'variance', pt2_data % variance(k)
write(json_unit, json_real_fmt) 'variance_err', pt2_data_err % variance(k)
write(json_unit, json_array_open_fmt) 'ex_energy'
do i=2,N_iter_p
write(json_unit, fmtk(i)) extrapolated_energy(i,k)

235
plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f Normal file
View File

@ -0,0 +1,235 @@
subroutine ZMQ_selection(N_in, pt2_data)
use f77_zmq
use selection_types
implicit none
integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull
integer, intent(in) :: N_in
type(selection_buffer) :: b
integer :: i, l, N
integer, external :: omp_get_thread_num
type(pt2_type), intent(inout) :: pt2_data
PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators
N = max(N_in,1)
N = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
if (.True.) then
PROVIDE pt2_e0_denominator nproc
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym
PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max
PROVIDE excitation_beta_max excitation_alpha_max excitation_max
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
integer, external :: zmq_put_psi
integer, external :: zmq_put_N_det_generators
integer, external :: zmq_put_N_det_selectors
integer, external :: zmq_put_dvector
if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
stop 'Unable to put psi on ZMQ server'
endif
if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then
stop 'Unable to put N_det_generators on ZMQ server'
endif
if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then
stop 'Unable to put N_det_selectors on ZMQ server'
endif
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then
stop 'Unable to put energy on ZMQ server'
endif
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then
stop 'Unable to put state_average_weight on ZMQ server'
endif
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then
stop 'Unable to put selection_weight on ZMQ server'
endif
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) then
stop 'Unable to put threshold_generators on ZMQ server'
endif
call create_selection_buffer(N, N*2, b)
endif
integer, external :: add_task_to_taskserver
character(len=100000) :: task
integer :: j,k,ipos
ipos=1
task = ' '
do i= 1, N_det_generators
do j=1,pt2_F(i)
write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N
ipos += 30
if (ipos > 100000-30) then
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
stop 'Unable to add task to task server'
endif
ipos=1
endif
end do
enddo
if (ipos > 1) then
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
stop 'Unable to add task to task server'
endif
endif
N = max(N_in,1)
ASSERT (associated(b%det))
ASSERT (associated(b%val))
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
integer :: nproc_target
if (N_det < 3*nproc) then
nproc_target = N_det/4
else
nproc_target = nproc
endif
double precision :: mem
mem = 8.d0 * N_det * (N_int * 2.d0 * 3.d0 + 3.d0 + 5.d0) / (1024.d0**3)
call write_double(6,mem,'Estimated memory/thread (Gb)')
if (qp_max_mem > 0) then
nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem)))
nproc_target = min(nproc_target,nproc)
endif
f(:) = 1.d0
if (.not.do_pt2) then
double precision :: f(N_states), u_dot_u
do k=1,min(N_det,N_states)
f(k) = 1.d0 / u_dot_u(psi_selectors_coef(1,k), N_det_selectors)
enddo
endif
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2_data) PRIVATE(i) NUM_THREADS(nproc_target+1)
i = omp_get_thread_num()
if (i==0) then
call selection_collector(zmq_socket_pull, b, N, pt2_data)
else
call selection_slave_inproc(i)
endif
!$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection')
if (N_in > 0) then
if (s2_eig) then
call make_selection_buffer_s2(b)
endif
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0)
endif
call delete_selection_buffer(b)
do k=1,N_states
pt2_data % pt2(k) = pt2_data % pt2(k) * f(k)
pt2_data % variance(k) = pt2_data % variance(k) * f(k)
do l=1,N_states
pt2_data % overlap(k,l) = pt2_data % overlap(k,l) * dsqrt(f(k)*f(l))
pt2_data % overlap(l,k) = pt2_data % overlap(l,k) * dsqrt(f(k)*f(l))
enddo
pt2_data % rpt2(k) = &
pt2_data % pt2(k)/(1.d0 + pt2_data % overlap(k,k))
enddo
pt2_overlap(:,:) = pt2_data % overlap(:,:)
print *, 'Overlap of perturbed states:'
do l=1,N_states
print *, pt2_overlap(l,:)
enddo
print *, '-------'
SOFT_TOUCH pt2_overlap
call update_pt2_and_variance_weights(pt2_data, N_states)
end subroutine
subroutine selection_slave_inproc(i)
implicit none
integer, intent(in) :: i
call run_selection_slave(1,i,pt2_e0_denominator)
end
subroutine selection_collector(zmq_socket_pull, b, N, pt2_data)
use f77_zmq
use selection_types
use bitmasks
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
type(selection_buffer), intent(inout) :: b
integer, intent(in) :: N
type(pt2_type), intent(inout) :: pt2_data
type(pt2_type) :: pt2_data_tmp
double precision :: pt2_mwen(N_states)
double precision :: variance_mwen(N_states)
double precision :: norm2_mwen(N_states)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer :: msg_size, rc, more
integer :: acc, i, j, robin, ntask
double precision, pointer :: val(:)
integer(bit_kind), pointer :: det(:,:,:)
integer, allocatable :: task_id(:)
type(selection_buffer) :: b2
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
call create_selection_buffer(N, N*2, b2)
integer :: k
double precision :: rss
double precision, external :: memory_of_int
rss = memory_of_int(N_det_generators)
call check_mem(rss,irp_here)
allocate(task_id(N_det_generators))
more = 1
pt2_data % pt2(:) = 0d0
pt2_data % variance(:) = 0.d0
pt2_data % overlap(:,:) = 0.d0
call pt2_alloc(pt2_data_tmp,N_states)
do while (more == 1)
call pull_selection_results(zmq_socket_pull, pt2_data_tmp, b2%val(1), b2%det(1,1,1), b2%cur, task_id, ntask)
call pt2_add(pt2_data, 1.d0, pt2_data_tmp)
do i=1, b2%cur
call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i))
if (b2%val(i) > b%mini) exit
end do
do i=1, ntask
if(task_id(i) == 0) then
print *, "Error in collector"
endif
integer, external :: zmq_delete_task
if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more) == -1) then
stop 'Unable to delete task'
endif
end do
end do
call pt2_dealloc(pt2_data_tmp)
call delete_selection_buffer(b2)
call sort_selection_buffer(b)
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end subroutine

1
plugins/local/fci_tc_bi/NEED
View File

@ -1,4 +1,3 @@
generators_full_tc
json
tc_bi_ortho
davidson_undressed

94
plugins/local/fci_tc_bi/diagonalize_ci.irp.f
View File

@ -1,7 +1,7 @@
! ---
subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm )
subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2)
BEGIN_DOC
! Replace the coefficients of the CI states by the coefficients of the
@ -11,19 +11,49 @@ subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm )
use selection_types
implicit none
integer, intent(inout) :: ndet ! number of determinants from before
double precision, intent(inout) :: E_tc(N_states), norm(N_states) ! E and norm from previous wave function
integer :: i, j,k
double precision, intent(inout) :: E_tc, norm ! E and norm from previous wave function
type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function
logical, intent(in) :: print_pt2
integer :: i, j
double precision :: pt2_tmp, pt1_norm, rpt2_tmp, abs_pt2
PROVIDE mo_l_coef mo_r_coef
do k = 1, N_states
E_tc(k) = eigval_right_tc_bi_orth(k)
norm(k) = norm_ground_left_right_bi_orth(k)
enddo
pt2_tmp = pt2_data % pt2(1)
abs_pt2 = pt2_data % variance(1)
pt1_norm = pt2_data % overlap(1,1)
rpt2_tmp = pt2_tmp/(1.d0 + pt1_norm)
print*,'*****'
print*,'New wave function information'
print*,'N_det tc = ',N_det
print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth
print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(1)
print*,'Ndet, E_tc = ',N_det,eigval_right_tc_bi_orth(1)
print*,'*****'
if(print_pt2) then
print*,'*****'
print*,'previous wave function info'
print*,'norm(before) = ',norm
print*,'E(before) = ',E_tc
print*,'PT1 norm = ',dsqrt(pt1_norm)
print*,'PT2 = ',pt2_tmp
print*,'rPT2 = ',rpt2_tmp
print*,'|PT2| = ',abs_pt2
print*,'Positive PT2 = ',(pt2_tmp + abs_pt2)*0.5d0
print*,'Negative PT2 = ',(pt2_tmp - abs_pt2)*0.5d0
print*,'E(before) + PT2 = ',E_tc + pt2_tmp/norm
print*,'E(before) +rPT2 = ',E_tc + rpt2_tmp/norm
write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tmp/norm,E_tc + rpt2_tmp/norm,abs_pt2
print*,'*****'
endif
psi_energy(1:N_states) = eigval_right_tc_bi_orth(1:N_states) - nuclear_repulsion
psi_s2(1:N_states) = s2_eigvec_tc_bi_orth(1:N_states)
E_tc = eigval_right_tc_bi_orth(1)
norm = norm_ground_left_right_bi_orth
ndet = N_det
do j = 1, N_states
do i = 1, N_det
@ -41,3 +71,53 @@ end
! ---
subroutine print_CI_dressed(ndet, E_tc, norm, pt2_data, print_pt2)
BEGIN_DOC
! Replace the coefficients of the CI states by the coefficients of the
! eigenstates of the CI matrix
END_DOC
use selection_types
implicit none
integer, intent(inout) :: ndet ! number of determinants from before
double precision, intent(inout) :: E_tc,norm ! E and norm from previous wave function
type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function
logical, intent(in) :: print_pt2
integer :: i, j
print*,'*****'
print*,'New wave function information'
print*,'N_det tc = ',N_det
print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth
print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(1)
print*,'Ndet, E_tc = ',N_det,eigval_right_tc_bi_orth(1)
print*,'*****'
if(print_pt2) then
print*,'*****'
print*,'previous wave function info'
print*,'norm(before) = ',norm
print*,'E(before) = ',E_tc
print*,'PT1 norm = ',dsqrt(pt2_data % overlap(1,1))
print*,'E(before) + PT2 = ',E_tc + (pt2_data % pt2(1))/norm
print*,'PT2 = ',pt2_data % pt2(1)
print*,'Ndet, E_tc, E+PT2 = ',ndet,E_tc,E_tc + (pt2_data % pt2(1))/norm,dsqrt(pt2_data % overlap(1,1))
print*,'*****'
endif
E_tc = eigval_right_tc_bi_orth(1)
norm = norm_ground_left_right_bi_orth
ndet = N_det
do j = 1, N_states
do i = 1, N_det
psi_coef(i,j) = reigvec_tc_bi_orth(i,j)
enddo
enddo
SOFT_TOUCH eigval_left_tc_bi_orth eigval_right_tc_bi_orth leigvec_tc_bi_orth norm_ground_left_right_bi_orth psi_coef reigvec_tc_bi_orth
end
! ---

48
src/generators_full_tc/generators.irp.f → plugins/local/fci_tc_bi/generators.irp.f
View File

@ -34,49 +34,23 @@ END_PROVIDER
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_gen, (N_int,2,psi_det_size) ]
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_gen, (psi_det_size,N_states) ]
&BEGIN_PROVIDER [ integer, psi_det_sorted_gen_order, (psi_det_size) ]
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc_gen, (N_int,2,psi_det_size) ]
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc_gen, (psi_det_size,N_states) ]
&BEGIN_PROVIDER [ integer, psi_det_sorted_tc_gen_order, (psi_det_size) ]
implicit none
BEGIN_DOC
! For Single reference wave functions, the generator is the
! Hartree-Fock determinant
END_DOC
psi_det_sorted_gen = psi_det_sorted_tc
psi_coef_sorted_gen = psi_coef_sorted_tc
psi_det_sorted_gen_order = psi_det_sorted_tc_order
psi_det_sorted_tc_gen = psi_det_sorted_tc
psi_coef_sorted_tc_gen = psi_coef_sorted_tc
psi_det_sorted_tc_gen_order = psi_det_sorted_tc_order
integer :: i
! do i = 1,N_det
! print*,'i = ',i
! call debug_det(psi_det_sorted_tc(1,1,i),N_int)
! enddo
END_PROVIDER
BEGIN_PROVIDER [integer, degree_max_generators]
implicit none
BEGIN_DOC
! Max degree of excitation (respect to HF) of the generators
END_DOC
integer :: i,degree
degree_max_generators = 0
do i = 1, N_det_generators
call get_excitation_degree(HF_bitmask,psi_det_generators(1,1,i),degree,N_int)
if(degree .gt. degree_max_generators)then
degree_max_generators = degree
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, size_select_max]
implicit none
BEGIN_DOC
! Size of the select_max array
END_DOC
size_select_max = 10000
END_PROVIDER
BEGIN_PROVIDER [ double precision, select_max, (size_select_max) ]
implicit none
BEGIN_DOC
! Memo to skip useless selectors
END_DOC
select_max = huge(1.d0)
END_PROVIDER

85
plugins/local/fci_tc_bi/script_tc_bh_h2o_gd_exc.sh
View File

@ -1,85 +0,0 @@
#!/bin/bash
source ~/qp2/quantum_package.rc
## Define the system/basis/charge/mult and genric keywords
system=H2O
xyz=${system}.xyz
basis=6-31g
mult=1
charge=0
j2e_type="Boys_Handy"
thresh_tcscf=1e-10
io_tc_integ="Write"
nstates=4
##################### Function to create the EZFIO
function create_ezfio (){
qp create_ezfio -b $basis -m $mult -c $charge $xyz -o $ezfio
qp run scf | tee ${EZFIO_FILE}.scf.out
}
##################### Function to set parameters for BH9 jastrow
function BH_9 (){
j2e_type="Boys_Handy" # type of correlation factor: Boys Handy type
env_type="None" # Boys Handy J does not use our envelopes
j1e_type="None" # Boys Handy J does not use our J1body
tc_integ_type="numeric" # Boys Handy requires numerical integrals
jBH_size=9 # Number of parameters for the BH
######## All parameters for the H2O and Boys Handy Jastrow
jBH_c=[[0.50000,-0.57070,0.49861,-0.78663,0.01990,0.13386,-0.60446,-1.67160,1.36590],[0.0,0.0,0.0,0.0,0.12063,-0.18527,0.12324,-0.11187,-0.06558],[0.0,0.0,0.0,0.0,0.12063,-0.18527,0.12324,-0.11187,-0.06558]]
jBH_m=[[0,0,0,0,2,3,4,2,2],[0,0,0,0,2,3,4,2,2],[0,0,0,0,2,3,4,2,2]]
jBH_n=[[0,0,0,0,0,0,0,2,0],[0,0,0,0,0,0,0,2,0],[0,0,0,0,0,0,0,2,0]]
jBH_o=[[1,2,3,4,0,0,0,0,2],[1,2,3,4,0,0,0,0,2],[1,2,3,4,0,0,0,0,2]]
jBH_ee=[1.0,1.0,1.0]
jBH_en=[1.0,1.0,1.0]
set_BH_J_keywords
}
function set_BH_J_keywords (){
qp set jastrow j2e_type $j2e_type # set the jastrow two-e type
qp set jastrow env_type $env_type
qp set jastrow j1e_type $j1e_type
qp set jastrow jBH_size $jBH_size # set the number of parameters in Boys-Handy jastrow
qp set jastrow jBH_c "$jBH_c" # set the parameters which are lists for Boys-Handy
qp set jastrow jBH_m "$jBH_m" #
qp set jastrow jBH_n "$jBH_n" #
qp set jastrow jBH_o "$jBH_o" #
qp set jastrow jBH_ee $jBH_ee #
qp set jastrow jBH_en $jBH_en #
qp set tc_keywords tc_integ_type $tc_integ_type # set the analytical or numerical integrals
qp set tc_keywords thresh_tcscf $thresh_tcscf
qp set tc_keywords io_tc_integ $io_tc_integ # set the io
rm ${EZFIO_FILE}/tc_bi_ortho/psi_*
}
function run_ground_state (){
qp set tc_keywords minimize_lr_angles True
qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out
qp set_frozen_core
qp set determinants n_det_max 1e6
qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi.out
}
function run_excited_state (){
qp set determinants n_states $nstates
qp run cis | tee ${EZFIO_FILE}.cis.out
rm ${EZFIO_FILE}/tc_bi_ortho/psi_*
qp run tc_bi_ortho | tee ${EZFIO_FILE}.tc_cis_nst_${nstates}.out
qp set determinants read_wf True
qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi_nst_${nstates}.out
}
## BH9 calculations
ezfio=${system}_${charge}_${basis}_${j2e_type}
create_ezfio
BH_9
run_ground_state
run_excited_state

84
plugins/local/fci_tc_bi/script_tc_jmu_h2o_gd_exc.sh
View File

@ -1,84 +0,0 @@
#!/bin/bash
source ~/qp2/quantum_package.rc
## Define the system/basis/charge/mult and genric keywords
system=H2O
xyz=${system}.xyz
basis=6-31g
mult=1
charge=0
j2e_type=Mu
thresh_tcscf=1e-10
io_tc_integ="Write"
nstates=4
nol_standard=False
tc_integ_type=numeric # can be changed for semi-analytic
if (( $nol_standard == "False" ))
then
three_body_h_tc=True
else
three_body_h_tc=False
fi
##################### Function to create the EZFIO
function create_ezfio (){
qp create_ezfio -b $basis -m $mult -c $charge $xyz -o $ezfio
qp run scf | tee ${EZFIO_FILE}.scf.out
}
function set_env_j_keywords (){
qp set hamiltonian mu_erf 0.87
qp set jastrow env_type Sum_Gauss
qp set jastrow env_coef "${coef}"
qp set tc_keywords tc_integ_type $tc_integ_type
qp set jastrow j1e_type $j1e_type
qp set jastrow j2e_type $j2e_type
qp set jastrow env_expo "${alpha}"
}
function run_ground_state (){
qp set tc_keywords minimize_lr_angles True
qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out
qp set_frozen_core
qp set determinants n_det_max 1e6
qp set perturbation pt2_max 0.001
qp set tc_keywords nol_standard $nol_standard
qp set tc_keywords three_body_h_tc $three_body_h_tc
qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi.out
}
function run_excited_state (){
qp set determinants n_states $nstates
qp run cis | tee ${EZFIO_FILE}.cis.out
rm ${EZFIO_FILE}/tc_bi_ortho/psi_*
qp run tc_bi_ortho | tee ${EZFIO_FILE}.tc_cis_nst_${nstates}.out
qp set determinants read_wf True
qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi_nst_${nstates}.out
}
# Define J(mu) with envelope and without j1e
j2e_type=Mu
j1e_type=None
ezfio=${system}_${charge}_${basis}_${j2e_type}_${j1e_type}
create_ezfio
alpha=[2.0,1000.,1000.] # parameters for H2O
coef=[1.,1.,1.] # parameters for H2O
set_env_j_keywords
run_ground_state
run_excited_state
# Define J(mu) with envelope and with a charge Harmonizer for J1e
j2e_type=Mu
j1e_type=Charge_Harmonizer
ezfio=${system}_${charge}_${basis}_${j2e_type}_${j1e_type}
create_ezfio
alpha=[2.5,1000.,1000.] # parameters for H2O
coef=[1.,1.,1.] # parameters for H2O
set_env_j_keywords
run_ground_state
run_excited_state

2
plugins/local/fci_tc_bi/selectors.irp.f
View File

@ -40,7 +40,7 @@ END_PROVIDER
enddo
do k=1,N_states
do i=1,N_det_selectors
psi_selectors_coef(i,k) = psi_coef_sorted_gen(i,k)
psi_selectors_coef(i,k) = psi_coef_sorted_tc_gen(i,k)
psi_selectors_coef_tc(i,1,k) = psi_l_coef_sorted_bi_ortho(i,k)
psi_selectors_coef_tc(i,2,k) = psi_r_coef_sorted_bi_ortho(i,k)
enddo

132
plugins/local/jastrow/EZFIO.cfg
View File

@ -1,21 +1,8 @@
[j2e_type]
[jast_type]
doc: Type of Jastrow [None| Mu | Qmckl]
type: character*(32)
doc: type of the 2e-Jastrow: [ None | Mu | Mu_Nu | Mur | Boys | Boys_Handy | Qmckl ]
interface: ezfio,provider,ocaml
default: Mu
[j1e_type]
type: character*(32)
doc: type of the 1e-Jastrow: [ None | Gauss | Charge_Harmonizer | Charge_Harmonizer_AO ]
interface: ezfio,provider,ocaml
default: None
[env_type]
type: character*(32)
doc: type of envelop for Jastrow: [ None | Prod_Gauss | Sum_Gauss | Sum_Slat | Sum_Quartic ]
interface: ezfio, provider, ocaml
default: Sum_Gauss
default: None
[jast_qmckl_type_nucl_num]
doc: Number of different nuclei types in QMCkl jastrow
@ -77,119 +64,6 @@ type: double precision
size: (jastrow.jast_qmckl_c_vector_size)
interface: ezfio, provider
[j1e_size]
type: integer
doc: number of functions per atom in 1e-Jastrow
interface: ezfio,provider,ocaml
default: 1
[j1e_coef]
type: double precision
doc: linear coef of functions in 1e-Jastrow
interface: ezfio
size: (jastrow.j1e_size,nuclei.nucl_num)
[j1e_coef_ao]
type: double precision
doc: coefficients of the 1-electrob Jastrow in AOs
interface: ezfio
size: (ao_basis.ao_num)
[j1e_coef_ao2]
type: double precision
doc: coefficients of the 1-electron Jastrow in AOsxAOs
interface: ezfio
size: (ao_basis.ao_num,ao_basis.ao_num)
[j1e_coef_ao3]
type: double precision
doc: coefficients of the 1-electron Jastrow in AOsxAOs
interface: ezfio
size: (ao_basis.ao_num,3)
[j1e_expo]
type: double precision
doc: exponenets of functions in 1e-Jastrow
interface: ezfio
size: (jastrow.j1e_size,nuclei.nucl_num)
[env_expo]
type: double precision
doc: exponents of the envelop for Jastrow
interface: ezfio
size: (nuclei.nucl_num)
[env_coef]
type: double precision
doc: coefficients of the envelop for Jastrow
interface: ezfio
size: (nuclei.nucl_num)
[murho_type]
type: integer
doc: type of mu(rho) Jastrow
interface: ezfio, provider, ocaml
default: 0
[ng_fit_jast]
type: integer
doc: nb of Gaussians used to fit Jastrow fcts
interface: ezfio,provider,ocaml
default: 20
[a_boys]
type: double precision
doc: cutting of the interaction in the range separated model
interface: ezfio,provider,ocaml
default: 1.0
ezfio_name: a_boys
[nu_erf]
type: double precision
doc: e-e correlation in the core
interface: ezfio,provider,ocaml
default: 1.0
ezfio_name: nu_erf
[jBH_size]
type: integer
doc: number of terms per atom in Boys-Handy-Jastrow
interface: ezfio,provider,ocaml
default: 1
[jBH_c]
type: double precision
doc: coefficients of terms in Boys-Handy-Jastrow
interface: ezfio
size: (jastrow.jBH_size,nuclei.nucl_num)
[jBH_m]
type: integer
doc: powers of terms in Boys-Handy-Jastrow
interface: ezfio
size: (jastrow.jBH_size,nuclei.nucl_num)
[jBH_n]
type: integer
doc: powers of terms in Boys-Handy-Jastrow
interface: ezfio
size: (jastrow.jBH_size,nuclei.nucl_num)
[jBH_o]
type: integer
doc: powers of terms in Boys-Handy-Jastrow
interface: ezfio
size: (jastrow.jBH_size,nuclei.nucl_num)
[jBH_ee]
type: double precision
doc: parameters of e-e terms in Boys-Handy-Jastrow
interface: ezfio
size: (nuclei.nucl_num)
[jBH_en]
type: double precision
doc: parameters of e-n terms in Boys-Handy-Jastrow
interface: ezfio
size: (nuclei.nucl_num)

1
plugins/local/jastrow/NEED
View File

@ -1,3 +1,2 @@
nuclei
electrons
ao_basis

Some files were not shown because too many files have changed in this diff Show More