Changed symetric_fock_tc into symmetric_fock_tc

bugfix davidson recontraction + update

.readthedocs.yaml

@@ -0,0 +1,32 @@
+# .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

Makefile

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

README.md

@@ -1,3 +1,10 @@
+**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" --->

bin/qp_convert_output_to_ezfio

@@ -224,14 +224,18 @@ 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+1] * 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)
 
     # ~#~#~#~#~ #
     # W r i t e #
     # ~#~#~#~#~ #
 
     ezfio.set_basis_basis("Read from ResultsFile")
-    ezfio.set_basis_shell_num(len(ang_mom))
+    ezfio.set_basis_shell_num(shell_num)
     ezfio.set_basis_basis_nucleus_index(nucl_index)
     ezfio.set_basis_prim_num(len(coefficient))
 
@@ -256,6 +260,7 @@ 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]
 
@@ -308,10 +313,19 @@ 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]
@@ -328,6 +342,7 @@ 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")
 

bin/qp_plugins

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

bin/qp_set_frozen_core

@@ -83,6 +83,7 @@ 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

config/gfortran_mkl.cfg

@@ -0,0 +1,62 @@
+# Common flags
+##############
+#
+# -ffree-line-length-none : Needed for IRPF90 which produces long lines
+# -lblas -llapack         : Link with libblas and liblapack libraries provided by the system
+# -I .                    : Include the curent directory (Mandatory)
+#
+# --ninja                 : Allow the utilisation of ninja. (Mandatory)
+# --align=32              : Align all provided arrays on a 32-byte boundary
+#
+#
+[COMMON]
+FC           : gfortran -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
+

config/ifort_2021_avx.cfg

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

config/ifort_2021_avx_mpi.cfg

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

config/ifort_2021_avx_notz.cfg

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

config/ifort_2021_debug.cfg

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

config/ifort_2021_mpi_rome.cfg

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

config/ifort_2021_rome.cfg

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

config/ifort_2021_sse4.cfg

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

config/ifort_2021_sse4_mpi.cfg

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

config/ifort_2021_xHost.cfg

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

configure

@@ -9,7 +9,7 @@ echo "QP_ROOT="$QP_ROOT
 unset CC
 unset CCXX
 
-TREXIO_VERSION=2.3.2
+TREXIO_VERSION=2.4.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 -j 8 check && make -j 8 install
+              (make -j 8 || make) && make 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 -j 8 check && make -j 8 install
+              (make -j 8 || make) && make 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 && make -j 4 check && make install
+              (make -j 8 || make) && make 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 && make -j 4 check && make install
+              (make -j 8 || make) && make check && make install
 EOF
  
 

docs/ref

@@ -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/research.bib in bibtex
+* References of published results with QP should be added into docs/source/references.bib in bibtex
   format

docs/requirements.txt

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

docs/source/appendix/contributors.rst

@@ -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,9 +46,11 @@ 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 this file
+If you have contributed and don't appear in this list, please modify the file
+`$QP_ROOT/docs/source/appendix/contributors.rst`
 and submit a pull request.
 

docs/source/appendix/references.rst

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

docs/source/appendix/research.rst

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

docs/source/auto_generate.py

@@ -29,7 +29,8 @@ 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.readfp(f)
+        config_file.read_file(f)
         for section in config_file.sections():
             doc = config_file.get(section, "doc")
             doc = "    " + doc.replace("\n", "\n\n    ")+"\n"

docs/source/conf.py

@@ -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 = None
+language = "en"
 
 # List of patterns, relative to source directory, that match files and
 # directories to ignore when looking for source files.
@@ -208,3 +208,5 @@ epub_exclude_files = ['search.html']
 
 # -- Extension configuration -------------------------------------------------
 
+bibtex_bibfiles = [ "references.bib" ]
+

docs/source/index.rst

@@ -39,9 +39,10 @@
    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::
@@ -52,5 +53,6 @@
    appendix/benchmarks
    appendix/license
    appendix/contributors
+   appendix/references
 
 

docs/source/intro/intro.rst

@@ -11,25 +11,25 @@ The |qp|
 What it is
 ==========
 
-The |qp| is an open-source **programming environment** for quantum chemistry. 
+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 
+It has been built from the **developper** point of view in order to help
-the design of new quantum chemistry methods, 
+the design of new quantum chemistry methods,
-especially for `wave function theory <https://en.wikipedia.org/wiki/Ab_initio_quantum_chemistry_methods>`_ (|WFT|). 
+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 
+From the **user** point of view, the |qp| proposes a stand-alone path
-to use optimized selected configuration interaction |sCI| based on the 
+to use optimized selected configuration interaction |sCI| based on the
-|CIPSI| algorithm that can efficiently reach near-full configuration interaction 
+|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`). 
+|FCI| quality for relatively large systems.
-To have a simple example of how to use the |CIPSI| program, go to the `users_guide/quickstart`. 
+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 
+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 
+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>`_). 
+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|.
 

docs/source/intro/selected.bib

@@ -1,182 +0,0 @@
-@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}
-}
-

docs/source/modules/becke_numerical_grid.rst

@@ -99,6 +99,71 @@ 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 
 --------- 
@@ -122,6 +187,8 @@ 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`
 
  
@@ -156,6 +223,66 @@ 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
 
 
@@ -223,6 +350,11 @@ 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`
@@ -241,11 +373,60 @@ 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
 
 
@@ -272,12 +453,28 @@ Providers
        * :c:data:`nucl_num`
        * :c:data:`thresh_grid`
 
-    Needed by:
+
+ 
+.. 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:
 
     .. hlist::
        :columns: 3
 
-       * :c:data:`aos_in_r_array_per_atom`
+       * :c:data:`final_grid_points`
+       * :c:data:`n_points_final_grid`
+
 
  
 .. c:var:: final_weight_at_r
@@ -304,6 +501,8 @@ 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:
@@ -317,6 +516,43 @@ 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
 
 
@@ -355,6 +591,11 @@ 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,11 +614,60 @@ 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
 
 
@@ -404,12 +694,6 @@ 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
@@ -438,9 +722,77 @@ 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
 
 
@@ -466,6 +818,8 @@ 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:
 
@@ -544,6 +898,11 @@ 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`
@@ -562,11 +921,101 @@ 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
 
 
@@ -593,12 +1042,6 @@ 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
@@ -627,12 +1070,6 @@ 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
@@ -673,6 +1110,11 @@ 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`
@@ -691,8 +1133,16 @@ 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`
 
  
@@ -714,9 +1164,148 @@ 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
 
 
@@ -744,9 +1333,17 @@ 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`
@@ -759,6 +1356,14 @@ 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`
@@ -766,14 +1371,39 @@ 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`
@@ -789,6 +1419,8 @@ 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
@@ -928,7 +1560,6 @@ Providers
     .. hlist::
        :columns: 3
 
-       * :c:data:`aos_in_r_array_per_atom`
        * :c:data:`final_grid_points_per_atom`
 
  
@@ -960,10 +1591,31 @@ 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
 
 
@@ -1001,6 +1653,43 @@ 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
 
 
@@ -1032,6 +1721,37 @@ 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 
 ----------------------- 
@@ -1043,7 +1763,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))
@@ -1067,7 +1787,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
@@ -1118,7 +1838,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 :

docs/source/modules/cipsi.rst

@@ -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_2017.2`
+* Computes the |PT2| contribution to the energy stochastically :cite:`Garniron_2017b`
   or deterministically, depending on :option:`perturbation do_pt2`
 * Extrapolates the variational energy by fitting
   :math:`E=E_\text{FCI} - \alpha\, E_\text{PT2}`

docs/source/programmers_guide/plugins_tuto_I.rst

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

docs/source/programmers_guide/plugins_tuto_intro.rst

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

docs/source/references.bib

@@ -0,0 +1,847 @@
+
+@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}
+}
+
+
+

etc/qp.rc

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

external/irpf90

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

ocaml/Angmom.ml

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

ocaml/Atom.ml

@@ -22,10 +22,15 @@ let of_string ~units s =
     }
   | [ name; x; y; z ] ->
     let e = Element.of_string name in
-    { element = e ;
+    begin
-      charge  = Element.to_charge e;
+      try
-      coord   = Point3d.of_string ~units (String.concat " " [x; y; z])
+      { 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
   | _ -> raise (AtomError s)
 
 

ocaml/Basis.ml

@@ -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.X in
+  let element_read = ref Element.Og in
   while !element_read <> element
   do
     let buffer = input_line in_channel in

ocaml/Element.ml

@@ -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"   |   "Dummy"        ->  X
+|  "X"   |   "Ghost"        ->  X
 |  "H"   |   "Hydrogen"     ->  H
 |  "He"  |   "Helium"       ->  He
 |  "Li"  |   "Lithium"      ->  Li
@@ -265,7 +265,7 @@ let to_string = function
 
 
 let to_long_string = function
-| X   -> "Dummy"
+| X   -> "Ghost"
 | H   -> "Hydrogen"
 | He  -> "Helium"
 | Li  -> "Lithium"
@@ -492,20 +492,20 @@ let to_charge c =
   | No  -> 102
   | Lr  -> 103
   | Rf  -> 104
-  | Db  -> 105 
+  | Db  -> 105
-  | Sg  -> 106 
+  | Sg  -> 106
-  | Bh  -> 107 
+  | Bh  -> 107
-  | Hs  -> 108 
+  | Hs  -> 108
-  | Mt  -> 109 
+  | Mt  -> 109
-  | Ds  -> 110 
+  | Ds  -> 110
-  | Rg  -> 111 
+  | Rg  -> 111
-  | Cn  -> 112 
+  | Cn  -> 112
-  | Nh  -> 113 
+  | Nh  -> 113
-  | Fl  -> 114 
+  | Fl  -> 114
-  | Mc  -> 115 
+  | Mc  -> 115
-  | Lv  -> 116 
+  | Lv  -> 116
-  | Ts  -> 117 
+  | Ts  -> 117
-  | Og  -> 118 
+  | 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
 

ocaml/Input_determinants_by_hand.ml

@@ -13,6 +13,7 @@ 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
@@ -34,11 +35,21 @@ 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 ()
@@ -222,7 +233,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;
@@ -283,19 +294,23 @@ 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
 
@@ -311,6 +326,7 @@ 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
@@ -328,6 +344,7 @@ end = struct
       psi_det              ;
       n_states             ;
       state_average_weight ;
+      mo_label             ;
     } =
      write_n_int n_int ;
      write_bit_kind bit_kind;
@@ -340,7 +357,9 @@ 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_state_average_weight state_average_weight ;
+     write_mo_label mo_label ;
+     ()
   ;;
 
 
@@ -439,7 +458,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
@@ -545,6 +564,8 @@ 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 =
@@ -553,7 +574,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 ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ]
+       String.concat "" [ header ; mo_label ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ]
     in
 
 

ocaml/Molecule.ml

@@ -142,13 +142,21 @@ 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 =
-    match Io_ext.input_lines filename with
+    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
     | natoms :: title :: rest ->
           let natoms = 
             try
@@ -173,6 +181,8 @@ 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

ocaml/Point3d.ml

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

ocaml/Zmatrix.ml

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

ocaml/qp_create_ezfio.ml

@@ -6,8 +6,8 @@ type element =
 | Element of Element.t
 | Int_elem of (Nucl_number.t * Element.t)
 
-(** Handle dummy atoms placed on bonds *)
+(** Handle ghost atoms placed on bonds *)
-let dummy_centers ~threshold ~molecule ~nuclei =
+let ghost_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 dummy =
+  let ghost =
-    dummy_centers ~threshold:d ~molecule ~nuclei:molecule.Molecule.nuclei
+    ghost_centers ~threshold:d ~molecule ~nuclei:molecule.Molecule.nuclei
   in
   let nuclei =
-    molecule.Molecule.nuclei @ dummy
+    molecule.Molecule.nuclei @ ghost
   in
 
 
@@ -145,8 +145,6 @@ 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
@@ -313,7 +311,7 @@ let run ?o b au c d m p cart xyz_file =
         }
       in
       let nuclei =
-        molecule.Molecule.nuclei @ dummy
+        molecule.Molecule.nuclei @ ghost
       in
 
 
@@ -491,11 +489,7 @@ let run ?o b au c d m p cart xyz_file =
         |> List.rev
         |> list_map (fun (x,i) ->
           try
-            let e =
+            let e = x.Atom.element in
-              match x.Atom.element with
-              | Element.X -> Element.H
-              | e -> e
-            in
             let key =
               Int_elem (i,x.Atom.element)
             in
@@ -507,9 +501,15 @@ let run ?o b au c d m p cart xyz_file =
               in
               try
                 Basis.read_element (basis_channel key) i e
-              with Not_found ->
+              with _ ->
-                failwith (Printf.sprintf "Basis not found for atom %d (%s)" (Nucl_number.to_int i)
+                try
-                 (Element.to_string x.Atom.element) )
+                  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
           | 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='d'; long="dummy";
+      { opt=Optional ; short='g'; long="ghost";
         arg=With_arg "<float>";
-        doc="Add dummy atoms. x * (covalent radii of the atoms)."} ;
+        doc="Add ghost 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 dummy =
+  let ghost =
-    match Command_line.get "dummy" with
+    match Command_line.get "ghost" 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 dummy multiplicity pseudo cart xyz_filename
+  run ?o:output basis au charge ghost multiplicity pseudo cart xyz_filename
   )
   with
 (*  | Failure txt  -> Printf.eprintf "Fatal error: %s\n%!" txt *)

ocaml/qptypes_generator.ml

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

plugins/README.rst

@@ -0,0 +1,131 @@
+==============================
+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. 
+
+

plugins/local/ao_many_one_e_ints/NEED

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

plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f

@@ -98,7 +98,7 @@ double precision function phi_j_erf_mu_r_phi(i, j, mu_in, C_center)
    enddo
   enddo
 
-end function phi_j_erf_mu_r_phi
+end
 
 ! ---
 
@@ -201,7 +201,7 @@ subroutine erf_mu_gauss_ij_ao(i, j, mu, C_center, delta, gauss_ints)
    enddo
   enddo
 
-end subroutine erf_mu_gauss_ij_ao
+end
 
 ! ---
 
@@ -266,7 +266,7 @@ subroutine NAI_pol_x_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
     enddo
   enddo
 
-end subroutine NAI_pol_x_mult_erf_ao
+end
 
 ! ---
 
@@ -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 subroutine NAI_pol_x_mult_erf_ao_v0
+end
 
 ! ---
 
@@ -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 subroutine NAI_pol_x_mult_erf_ao_v
+end
 
 ! ---
 
@@ -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 function NAI_pol_x_mult_erf_ao_x
+end
 
 ! ---
 
@@ -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 function NAI_pol_x_mult_erf_ao_y
+end
 
 ! ---
 
@@ -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 function NAI_pol_x_mult_erf_ao_z
+end
 
 ! ---
 
@@ -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 function NAI_pol_x_mult_erf_ao_with1s_x
+end
 
 ! ---
 
@@ -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 function NAI_pol_x_mult_erf_ao_with1s_y
+end
 
 ! ---
 
@@ -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 function NAI_pol_x_mult_erf_ao_with1s_z
+end
 
 ! ---
 
@@ -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 subroutine NAI_pol_x_mult_erf_ao_with1s
+end
 
 ! ---
 
@@ -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 subroutine NAI_pol_x_mult_erf_ao_with1s_v0
+end
 
 ! ---
 
@@ -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 subroutine NAI_pol_x_mult_erf_ao_with1s_v
+end
 
 ! ---
 
@@ -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 subroutine NAI_pol_x2_mult_erf_ao_with1s
+end
 
 ! ---
 
@@ -1241,7 +1241,7 @@ subroutine NAI_pol_x2_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
     enddo
   enddo
 
-end subroutine NAI_pol_x2_mult_erf_ao
+end
 
 ! ---
 
@@ -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 subroutine NAI_pol_012_mult_erf_ao_with1s
+end
 
 ! ---
 
@@ -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 integral :
+  ! Computes the following integrals :
   !
   ! 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 subroutine NAI_pol_012_mult_erf_ao
+end
 
 ! ---
 

plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f

@@ -152,7 +152,7 @@ double precision function overlap_gauss_r12_ao(D_center, delta, i, j)
     enddo
   enddo
 
-end function overlap_gauss_r12_ao
+end
 
 ! --
 
@@ -199,7 +199,7 @@ double precision function overlap_abs_gauss_r12_ao(D_center, delta, i, j)
     enddo
   enddo
 
-end function overlap_gauss_r12_ao
+end
 
 ! --
 
@@ -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 subroutine overlap_gauss_r12_ao_v
+end
 
 ! ---
 
@@ -327,7 +327,7 @@ double precision function overlap_gauss_r12_ao_with1s(B_center, beta, D_center,
     enddo
   enddo
 
-end function overlap_gauss_r12_ao_with1s
+end
 
 ! ---
 
@@ -420,7 +420,86 @@ 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_with1s_v
+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
 
 ! ---
 

plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f

@@ -1,11 +1,11 @@
 
 ! ---
 
-BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
+BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (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
+  ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2
   !
   END_DOC
 
@@ -15,30 +15,30 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n
   double precision              :: coef, beta, B_center(3)
   double precision              :: tmp
   double precision              :: wall0, wall1
-  double precision              :: int_gauss, dsqpi_3_2, int_j1b
+  double precision              :: int_gauss, dsqpi_3_2, int_env
   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_j1b2_test ...'
+  print*, ' providing int2_grad1u2_grad2u2_env2_test ...'
 
   sq_pi_3_2 = (dacos(-1.d0))**(1.5d0)
 
-  provide mu_erf final_grid_points_transp j1b_pen List_comb_thr_b3_coef
+  provide mu_erf final_grid_points_transp List_comb_thr_b3_coef
   call wall_time(wall0)
 
-  int2_grad1u2_grad2u2_j1b2_test(:,:,:) = 0.d0
+  int2_grad1u2_grad2u2_env2_test(:,:,:) = 0.d0
 
- !$OMP PARALLEL DEFAULT (NONE)                                                                              &
+ !$OMP PARALLEL DEFAULT (NONE)                                                                          &
-     !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,                                     &
+ !$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          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 SHARED  (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size,                   &
-     !$OMP          final_grid_points_transp, ng_fit_jast,                                                  &
+ !$OMP          final_grid_points_transp, ng_fit_jast,                                                  &
-     !$OMP          expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2,                                             &
+ !$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_coef, List_comb_thr_b3_expo,                                           &
-     !$OMP          List_comb_thr_b3_cent, int2_grad1u2_grad2u2_j1b2_test, ao_abs_comb_b3_j1b,              &
+ !$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          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_j1b2_test, (ao_num, ao_n
         ! i_1s = 1
         ! --- --- ---
 
-        int_j1b = ao_abs_comb_b3_j1b(1,j,i)
+        int_env = ao_abs_comb_b3_env(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_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
+!          if(dabs(coef_fit*int_env*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
           int_gauss = overlap_gauss_r12_ao(r, expo_fit, i, j)
-          int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss 
+          int2_grad1u2_grad2u2_env2_test(j,i,ipoint) += coef_fit * int_gauss 
         enddo
 
         ! --- --- ---
@@ -71,7 +71,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n
 
           coef        = List_comb_thr_b3_coef  (i_1s,j,i)
           beta        = List_comb_thr_b3_expo  (i_1s,j,i)
-          int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+          int_env = ao_abs_comb_b3_env(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_j1b2_test, (ao_num, ao_n
             !DIR$ FORCEINLINE
             call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
             coef_fit = -0.25d0 *  coef_gauss_1_erf_x_2(i_fit) * coef
-!            if(dabs(coef_fit*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
+!            if(dabs(coef_fit*factor_ij_1s*int_env*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_j1b2_test(j,i,ipoint) += coef_fit * int_gauss 
+            int2_grad1u2_grad2u2_env2_test(j,i,ipoint) += coef_fit * int_gauss 
           enddo
         enddo
 
@@ -98,26 +98,26 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n
   do ipoint = 1, n_points_final_grid
     do i = 1, ao_num
       do j = 1, i-1
-        int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint)
+        int2_grad1u2_grad2u2_env2_test(j,i,ipoint) = int2_grad1u2_grad2u2_env2_test(i,j,ipoint)
       enddo
     enddo
   enddo
 
   call wall_time(wall1)
-  print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test', wall1 - wall0
+  print*, ' wall time for int2_grad1u2_grad2u2_env2_test (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER
 
 ! ---
 
-BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao_num, n_points_final_grid)]
+BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test_v, (ao_num, ao_num, n_points_final_grid)]
-!
+
-!  BEGIN_DOC
+  BEGIN_DOC
-!  !
+  !
-!  ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
+  ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2
-!  !
+  !
-!  END_DOC
+  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_j1b2_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_j1b2_test_v ...'
+  print*, ' providing int2_grad1u2_grad2u2_env2_test_v ...'
 
-  provide mu_erf final_grid_points_transp j1b_pen
+  provide mu_erf final_grid_points_transp
   call wall_time(wall0)
 
- double precision :: int_j1b
+ double precision :: int_env
  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 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          coef_fit, expo_fit, int_fit_v, tmp,int_env)                &
-     !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b3_size,&
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b3_size,&
-     !$OMP          final_grid_points_transp, ng_fit_jast,               &
+ !$OMP          final_grid_points_transp, ng_fit_jast,               &
-     !$OMP          expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2,      &
+ !$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_coef, List_comb_thr_b3_expo,    &
-     !$OMP          List_comb_thr_b3_cent, big_array,&
+ !$OMP          List_comb_thr_b3_cent, big_array,&
-     !$OMP          ao_abs_comb_b3_j1b,ao_overlap_abs,thrsh_cycle_tc)
+ !$OMP          ao_abs_comb_b3_env,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_j1b2_test_v, (ao_num, ao
 
          coef        = List_comb_thr_b3_coef  (i_1s,j,i)
          beta        = List_comb_thr_b3_expo  (i_1s,j,i)
-         int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+         int_env = ao_abs_comb_b3_env(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_j1b2_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_j1b2_test_v(j,i,ipoint) = big_array(ipoint,j,i)
+     int2_grad1u2_grad2u2_env2_test_v(j,i,ipoint) = big_array(ipoint,j,i)
     enddo
    enddo
   enddo
@@ -195,23 +195,23 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_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_j1b2_test_v(j,i,ipoint) = big_array(ipoint,i,j)
+        int2_grad1u2_grad2u2_env2_test_v(j,i,ipoint) = big_array(ipoint,i,j)
       enddo
     enddo
   enddo
 
   call wall_time(wall1)
-  print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test_v', wall1 - wall0
+  print*, ' wall time for int2_grad1u2_grad2u2_env2_test_v (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER
 
 ! ---
 
-BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
+BEGIN_PROVIDER [double precision, int2_u2_env2_test, (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
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [u_12^mu]^2
   !
   END_DOC
 
@@ -219,29 +219,29 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_
   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_j1b
+  double precision              :: wall0, wall1,int_env
 
   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_j1b2_test ...'
+  print*, ' providing int2_u2_env2_test ...'
 
   sq_pi_3_2 = (dacos(-1.d0))**(1.5d0)
 
-  provide mu_erf final_grid_points j1b_pen
+  provide mu_erf final_grid_points
   call wall_time(wall0)
 
-  int2_u2_j1b2_test = 0.d0
+  int2_u2_env2_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_j1b,factor_ij_1s,beta_ij,center_ij_1s)          & 
+ !$OMP          coef_fit, expo_fit, int_fit, tmp, int_env,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_j1b2_test,ao_abs_comb_b3_j1b,thrsh_cycle_tc)
+ !$OMP          List_comb_thr_b3_cent, int2_u2_env2_test,ao_abs_comb_b3_env,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_j1b2_test, (ao_num, ao_num, n_points_
         ! i_1s = 1
         ! --- --- ---
 
-        int_j1b = ao_abs_comb_b3_j1b(1,j,i)
+        int_env = ao_abs_comb_b3_env(1,j,i)
-        if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
+        if(dabs(int_env).lt.thrsh_cycle_tc) cycle
         do i_fit = 1, ng_fit_jast
           expo_fit = expo_gauss_j_mu_x_2(i_fit)
           coef_fit = coef_gauss_j_mu_x_2(i_fit)
-!          if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
+!          if(dabs(coef_fit*int_env*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_j1b2_test, (ao_num, ao_num, n_points_
 
           coef        = List_comb_thr_b3_coef  (i_1s,j,i)
           beta        = List_comb_thr_b3_expo  (i_1s,j,i)
-          int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+          int_env = ao_abs_comb_b3_env(i_1s,j,i)
-!         if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
+!         if(dabs(coef)*dabs(int_env).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_j1b2_test, (ao_num, ao_num, n_points_
             coef_fit = coef_gauss_j_mu_x_2(i_fit)
             !DIR$ FORCEINLINE
             call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
-!            if(dabs(coef_fit*coef*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle
+!            if(dabs(coef_fit*coef*factor_ij_1s*int_env*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_j1b2_test(j,i,ipoint) = tmp
+        int2_u2_env2_test(j,i,ipoint) = tmp
       enddo
     enddo
   enddo
@@ -302,23 +302,23 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_
   do ipoint = 1, n_points_final_grid
     do i = 2, ao_num
       do j = 1, i-1
-        int2_u2_j1b2_test(j,i,ipoint) = int2_u2_j1b2_test(i,j,ipoint)
+        int2_u2_env2_test(j,i,ipoint) = int2_u2_env2_test(i,j,ipoint)
       enddo
     enddo
   enddo
 
   call wall_time(wall1)
-  print*, ' wall time for int2_u2_j1b2_test', wall1 - wall0
+  print*, ' wall time for int2_u2_env2_test (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER 
 
 ! ---
 
-BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n_points_final_grid, 3)]
+BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (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
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_env(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_j1b2_test, (ao_num, ao_num, n
   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_j1b
+  double precision :: tmp_x, tmp_y, tmp_z, int_env
   double precision :: wall0, wall1, sq_pi_3_2,sq_alpha
 
-  print*, ' providing int2_u_grad1u_x_j1b2_test ...'
+  print*, ' providing int2_u_grad1u_x_env2_test ...'
 
   sq_pi_3_2 = dacos(-1.D0)**(1.d0)
-  provide mu_erf final_grid_points j1b_pen
+  provide mu_erf final_grid_points
   call wall_time(wall0)
 
-  int2_u_grad1u_x_j1b2_test = 0.d0
+  int2_u_grad1u_x_env2_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_j1b,sq_alpha)                        & 
+ !$OMP          tmp_x, tmp_y, tmp_z,int_env,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_j1b2_test,ao_abs_comb_b3_j1b,sq_pi_3_2,thrsh_cycle_tc)
+ !$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 DO
 
   do ipoint = 1, n_points_final_grid
@@ -365,8 +365,8 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n
 
           coef        = List_comb_thr_b3_coef  (i_1s,j,i)
           beta        = List_comb_thr_b3_expo  (i_1s,j,i)
-          int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+          int_env = ao_abs_comb_b3_env(i_1s,j,i)
-          if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
+          if(dabs(coef)*dabs(int_env).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_j1b2_test, (ao_num, ao_num, n
             expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist 
             coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
             sq_alpha = alpha_1s_inv * dsqrt(alpha_1s_inv)
-!            if(dabs(coef_tmp*int_j1b*sq_pi_3_2*sq_alpha) .lt. thrsh_cycle_tc) cycle
+!            if(dabs(coef_tmp*int_env*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_j1b2_test, (ao_num, ao_num, n
 
         enddo
 
-        int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = tmp_x
+        int2_u_grad1u_x_env2_test(j,i,ipoint,1) = tmp_x
-        int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = tmp_y
+        int2_u_grad1u_x_env2_test(j,i,ipoint,2) = tmp_y
-        int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = tmp_z
+        int2_u_grad1u_x_env2_test(j,i,ipoint,3) = tmp_z
       enddo
     enddo
   enddo
@@ -414,24 +414,25 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n
   do ipoint = 1, n_points_final_grid
     do i = 2, ao_num
       do j = 1, i-1
-        int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,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_j1b2_test(j,i,ipoint,2) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,2)
+        int2_u_grad1u_x_env2_test(j,i,ipoint,2) = int2_u_grad1u_x_env2_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)
+        int2_u_grad1u_x_env2_test(j,i,ipoint,3) = int2_u_grad1u_x_env2_test(i,j,ipoint,3)
       enddo
     enddo
   enddo
 
   call wall_time(wall1)
-  print*, ' wall time for int2_u_grad1u_x_j1b2_test', wall1 - wall0
+  print*, ' wall time for int2_u_grad1u_x_env2_test (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER 
 
+! ---
 
-BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
+BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (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 [\grad_1 u_12^mu]
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu]
   !
   END_DOC
 
@@ -442,31 +443,31 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
   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_j1b
+  double precision :: j12_mu_r12,int_env
   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_j1b2_test ...'
+  print*, ' providing int2_u_grad1u_env2_test ...'
 
   dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
 
-  provide mu_erf final_grid_points j1b_pen ao_overlap_abs List_comb_thr_b3_cent
+  provide mu_erf final_grid_points ao_overlap_abs List_comb_thr_b3_cent
   call wall_time(wall0)
 
 
-  int2_u_grad1u_j1b2_test = 0.d0
+  int2_u_grad1u_env2_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_j1b,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp)     &
+ !$OMP          int_env,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_j1b,     &
+ !$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_j1b2_test,thrsh_cycle_tc)
+ !$OMP          List_comb_thr_b3_cent, int2_u_grad1u_env2_test,thrsh_cycle_tc)
  !$OMP DO
   do ipoint = 1, n_points_final_grid
     do i = 1, ao_num
@@ -484,11 +485,9 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
         ! i_1s = 1
         ! --- --- ---
 
-        int_j1b = ao_abs_comb_b3_j1b(1,j,i)
+        int_env = ao_abs_comb_b3_env(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
@@ -502,8 +501,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
 
           coef        = List_comb_thr_b3_coef  (i_1s,j,i)
           beta        = List_comb_thr_b3_expo  (i_1s,j,i)
-          int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+          int_env = ao_abs_comb_b3_env(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)
@@ -513,7 +511,6 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
           do i_fit = 1, ng_fit_jast
             expo_fit = expo_gauss_j_mu_1_erf(i_fit)
             call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
-!            if(factor_ij_1s*dabs(coef*int_j1b)*dsqpi_3_2*beta_ij**(-1.5d0).lt.thrsh_cycle_tc)cycle
             coef_fit = coef_gauss_j_mu_1_erf(i_fit)
 
             alpha_1s     = beta + expo_fit
@@ -533,7 +530,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
           enddo
         enddo
 
-        int2_u_grad1u_j1b2_test(j,i,ipoint) = tmp
+        int2_u_grad1u_env2_test(j,i,ipoint) = tmp
       enddo
     enddo
   enddo
@@ -543,14 +540,15 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p
   do ipoint = 1, n_points_final_grid
     do i = 2, ao_num
       do j = 1, i-1
-        int2_u_grad1u_j1b2_test(j,i,ipoint) = int2_u_grad1u_j1b2_test(i,j,ipoint)
+        int2_u_grad1u_env2_test(j,i,ipoint) = int2_u_grad1u_env2_test(i,j,ipoint)
       enddo
     enddo
   enddo
 
   call wall_time(wall1)
-  print*, ' wall time for int2_u_grad1u_j1b2_test', wall1 - wall0
+  print*, ' wall time for int2_u_grad1u_env2_test (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER
 
 ! ---
+

plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f

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

plugins/local/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f

@@ -1,453 +0,0 @@
-!
-!! ---
-!
-!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
-!

plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f

@@ -1,11 +1,11 @@
 
 ! ---
 
-BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)]
+BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid)]
 
   BEGIN_DOC
   !
-  ! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R|
+  ! int dr phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R| - 1) / |r - R|
   !
   END_DOC
 
@@ -13,24 +13,23 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_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_j1b
+  double precision           :: tmp,int_env
   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_j1b_test ...'
+  print*, ' providing v_ij_erf_rk_cst_mu_env_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_j1b_test = 0.d0
+  v_ij_erf_rk_cst_mu_env_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_j1b)& 
+ !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp, int_env)& 
  !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points, &
- !$OMP          List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_j1b,  &
+ !$OMP          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_j1b_test, mu_erf,                                   &
+ !$OMP          v_ij_erf_rk_cst_mu_env_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
@@ -48,8 +47,8 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num,
 
           coef        = List_comb_thr_b2_coef  (i_1s,j,i)
           beta        = List_comb_thr_b2_expo  (i_1s,j,i)
-          int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
+          int_env = ao_abs_comb_b2_env(i_1s,j,i)
-!         if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
+!         if(dabs(coef)*dabs(int_env).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)
@@ -60,7 +59,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num,
           tmp += coef * (int_mu - int_coulomb)
         enddo
 
-        v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = tmp
+        v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) = tmp
       enddo
     enddo
   enddo
@@ -70,22 +69,22 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_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_j1b_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint)
+        v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_env_test(i,j,ipoint)
       enddo
     enddo
   enddo
  
   call wall_time(wall1)
-  print*, ' wall time for v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0
+  print*, ' wall time for v_ij_erf_rk_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER 
 
 ! ---
 
-BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid, 3)]
+BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid, 3)]
 
   BEGIN_DOC
-  ! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+  ! int dr x phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R|) - 1)/|r - R|
   END_DOC
 
   implicit none
@@ -93,23 +92,23 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu
   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_j1b,factor_ij_1s,beta_ij,center_ij_1s
+  double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2,int_env,factor_ij_1s,beta_ij,center_ij_1s
 
-  print*, ' providing x_v_ij_erf_rk_cst_mu_j1b_test ...'
+  print*, ' providing x_v_ij_erf_rk_cst_mu_env_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_j1b_test = 0.d0
+  x_v_ij_erf_rk_cst_mu_env_test = 0.d0
 
  !$OMP PARALLEL DEFAULT (NONE)                                                        &
  !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb,      & 
- !$OMP          int_j1b, tmp_x, tmp_y, tmp_z,factor_ij_1s,beta_ij,center_ij_1s)       & 
+ !$OMP          int_env, 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_j1b_test, mu_erf,ao_abs_comb_b2_j1b,         &
+ !$OMP          x_v_ij_erf_rk_cst_mu_env_test, mu_erf,ao_abs_comb_b2_env,         &
  !$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
@@ -129,8 +128,8 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu
 
           coef        = List_comb_thr_b2_coef  (i_1s,j,i)
           beta        = List_comb_thr_b2_expo  (i_1s,j,i)
-          int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
+          int_env = ao_abs_comb_b2_env(i_1s,j,i)
- !        if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
+ !        if(dabs(coef)*dabs(int_env).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)
@@ -143,9 +142,9 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu
           tmp_z += coef * (ints(3) - ints_coulomb(3))
         enddo
 
-        x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = tmp_x
+        x_v_ij_erf_rk_cst_mu_env_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_env_test(j,i,ipoint,2) = tmp_y
-        x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = tmp_z
+        x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,3) = tmp_z
       enddo
     enddo
   enddo
@@ -155,26 +154,26 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu
   do ipoint = 1, n_points_final_grid
     do i = 2, ao_num
       do j = 1, i-1
-        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_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_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_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_j1b_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,3)
+        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)
       enddo
     enddo
   enddo
 
   call wall_time(wall1)
-  print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0
+  print*, ' wall time for x_v_ij_erf_rk_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER 
 
 ! ---
 
 ! TODO analytically
-BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)]
+BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid)]
 
   BEGIN_DOC
   !
-  ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12)
   !
   END_DOC
 
@@ -185,29 +184,28 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
   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_j1b
+  double precision           :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_env
 
   double precision, external :: overlap_gauss_r12_ao
   double precision, external :: overlap_gauss_r12_ao_with1s
 
-  print*, ' providing v_ij_u_cst_mu_j1b_test ...'
+  print*, ' providing v_ij_u_cst_mu_env_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_j1b_test = 0.d0
+  v_ij_u_cst_mu_env_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_j1b)   & 
+ !$OMP          coef_fit, expo_fit, int_fit, tmp,coeftot,int_env)   & 
  !$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_j1b_test,ao_abs_comb_b2_j1b,   &
+ !$OMP          List_comb_thr_b2_cent, v_ij_u_cst_mu_env_test,ao_abs_comb_b2_env,   &
  !$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
@@ -225,8 +223,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
         ! i_1s = 1
         ! --- --- ---
 
-        int_j1b = ao_abs_comb_b2_j1b(1,j,i)
+        int_env = ao_abs_comb_b2_env(1,j,i)
- !      if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
+ !      if(dabs(int_env).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)
@@ -242,8 +240,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
         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_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
+          int_env = ao_abs_comb_b2_env(i_1s,j,i)
-!          if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
+!          if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle
           B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
           B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
           B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
@@ -259,7 +257,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
           enddo
         enddo
 
-        v_ij_u_cst_mu_j1b_test(j,i,ipoint) = tmp
+        v_ij_u_cst_mu_env_test(j,i,ipoint) = tmp
       enddo
     enddo
   enddo
@@ -269,23 +267,23 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po
   do ipoint = 1, n_points_final_grid
     do i = 2, ao_num
       do j = 1, i-1
-        v_ij_u_cst_mu_j1b_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_test(i,j,ipoint)
+        v_ij_u_cst_mu_env_test(j,i,ipoint) = v_ij_u_cst_mu_env_test(i,j,ipoint)
       enddo
     enddo
   enddo
  
   call wall_time(wall1)
-  print*, ' wall time for v_ij_u_cst_mu_j1b_test', wall1 - wall0
+  print*, ' wall time for v_ij_u_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER 
 
 ! ---
 
-BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, n_points_final_grid)]
+BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num, n_points_final_grid)]
 
   BEGIN_DOC
   !
-  ! 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}
+  ! 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}
   !
   END_DOC
 
@@ -296,27 +294,26 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_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_j1b
+  double precision           :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_env
 
   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_j1b_ng_1_test = 0.d0
+  v_ij_u_cst_mu_env_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_j1b)   & 
+ !$OMP          coef_fit, expo_fit, int_fit, tmp,coeftot,int_env)   & 
  !$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_j1b_ng_1_test,ao_abs_comb_b2_j1b, &
+ !$OMP          List_comb_thr_b2_cent, v_ij_u_cst_mu_env_ng_1_test,ao_abs_comb_b2_env, &
  !$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
@@ -334,8 +331,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num,
         ! i_1s = 1
         ! --- --- ---
 
-        int_j1b = ao_abs_comb_b2_j1b(1,j,i)
+        int_env = ao_abs_comb_b2_env(1,j,i)
-!        if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle
+!        if(dabs(int_env).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
@@ -347,8 +344,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_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_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
+          int_env = ao_abs_comb_b2_env(i_1s,j,i)
-!          if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle
+!          if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle
           B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
           B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
           B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
@@ -364,7 +361,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num,
 !          enddo
         enddo
 
-        v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = tmp
+        v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint) = tmp
       enddo
     enddo
   enddo
@@ -374,13 +371,13 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_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_j1b_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_ng_1_test(i,j,ipoint)
+        v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_env_ng_1_test(i,j,ipoint)
       enddo
     enddo
   enddo
  
   call wall_time(wall1)
-  print*, ' wall time for v_ij_u_cst_mu_j1b_ng_1_test', wall1 - wall0
+  print*, ' wall time for v_ij_u_cst_mu_env_ng_1_test (min) = ', (wall1 - wall0) / 60.d0
 
 END_PROVIDER 
 

plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f

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

plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f

@@ -0,0 +1,574 @@
+
+! ---
+
+ 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 
+
+! ---
+

plugins/local/ao_many_one_e_ints/listj1b.irp.f

@@ -1,366 +0,0 @@
-
-! ---
-
-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
-
-! ---
-

plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f

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

plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f

@@ -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 subroutine overlap_gauss_r12_v
+end
 
 !---
 

plugins/local/ao_tc_eff_map/NEED

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

plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f

@@ -23,10 +23,9 @@ 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                :: j1b_gauss_2e_j1, j1b_gauss_2e_j2
+  double precision                :: env_gauss_2e_j1, env_gauss_2e_j2
 
 
-  PROVIDE j1b_type
 
   thr = ao_integrals_threshold
 
@@ -53,14 +52,6 @@ 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

plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f

@@ -1,10 +1,10 @@
 ! ---
 
-BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)]
+BEGIN_PROVIDER [double precision, env_gauss_hermII, (ao_num,ao_num)]
 
   BEGIN_DOC
   !
-  !  :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle` 
+  !  :math:`\langle \chi_A | -0.5 \grad \tau_{env} \cdot \grad \tau_{env} | \chi_B \rangle` 
   !
   END_DOC
 
@@ -22,8 +22,6 @@ BEGIN_PROVIDER [ double precision, j1b_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
@@ -38,10 +36,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)]
   ! --------------------------------------------------------------------------------
   
 
-  j1b_gauss_hermII(1:ao_num,1:ao_num) = 0.d0
+  env_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)                                           &
@@ -51,113 +46,51 @@ BEGIN_PROVIDER [ double precision, j1b_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, j1b_pen, j1b_gauss_hermII)
+ !$OMP         nucl_num, env_expo, env_gauss_hermII)
  !$OMP DO SCHEDULE (dynamic)
-    do j = 1, ao_num
+  do j = 1, ao_num
-      num_A         = ao_nucl(j)
+    num_A         = ao_nucl(j)
-      power_A(1:3)  = ao_power(j,1:3)
+    power_A(1:3)  = ao_power(j,1:3)
-      A_center(1:3) = nucl_coord(num_A,1:3)
+    A_center(1:3) = nucl_coord(num_A,1:3)
-  
+
-      do i = 1, ao_num
+    do i = 1, ao_num
-        num_B         = ao_nucl(i)
+      num_B         = ao_nucl(i)
-        power_B(1:3)  = ao_power(i,1:3)
+      power_B(1:3)  = ao_power(i,1:3)
-        B_center(1:3) = nucl_coord(num_B,1:3)
+      B_center(1:3) = nucl_coord(num_B,1:3)
-  
+
-        do l = 1, ao_prim_num(j)
+      do l = 1, ao_prim_num(j)
-          alpha = ao_expo_ordered_transp(l,j)
+        alpha = ao_expo_ordered_transp(l,j)
-  
+
-          do m = 1, ao_prim_num(i)
+        do m = 1, ao_prim_num(i)
-            beta = ao_expo_ordered_transp(m,i)
+          beta = ao_expo_ordered_transp(m,i)
-  
+
-            c = 0.d0
+          c = 0.d0
-            do k1 = 1, nucl_num
+          do k1 = 1, nucl_num
-              gama1          = j1b_pen(k1)
+            gama1          = env_expo(k1)
-              C_center1(1:3) = nucl_coord(k1,1:3)
+            C_center1(1:3) = nucl_coord(k1,1:3)
-  
+
-              do k2 = 1, nucl_num
+            do k2 = 1, nucl_num
-                gama2          = j1b_pen(k2)
+              gama2          = env_expo(k2)
-                C_center2(1:3) = nucl_coord(k2,1:3)
+              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 >
+              ! < 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     &
+              c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2     &
-                                 , power_A, power_B, alpha, beta, gama1, gama2  )
+                               , power_A, power_B, alpha, beta, gama1, gama2  )
-  
+
-                c = c - 2.d0 * gama1 * gama2 * c1
+              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
 
 

plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f

@@ -1,10 +1,10 @@
 ! ---
 
-BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)]
+BEGIN_PROVIDER [double precision, env_gauss_hermI, (ao_num,ao_num)]
 
   BEGIN_DOC
   !
-  !  :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \rangle` 
+  !  :math:`\langle \chi_A | -0.5 \Delta \tau_{env} | \chi_B \rangle` 
   !
   END_DOC
 
@@ -22,8 +22,6 @@ BEGIN_PROVIDER [ double precision, j1b_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
@@ -37,10 +35,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)]
                            , overlap_y, d_a_2, overlap_z, overlap, dim1 )
   ! --------------------------------------------------------------------------------
   
-  j1b_gauss_hermI(1:ao_num,1:ao_num) = 0.d0
+  env_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)                                           &
@@ -50,109 +45,50 @@ BEGIN_PROVIDER [ double precision, j1b_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, j1b_pen, j1b_gauss_hermI)
+ !$OMP         nucl_num, env_expo, env_gauss_hermI)
  !$OMP DO SCHEDULE (dynamic)
-    do j = 1, ao_num
+  do j = 1, ao_num
-      num_A         = ao_nucl(j)
+    num_A         = ao_nucl(j)
-      power_A(1:3)  = ao_power(j,1:3)
+    power_A(1:3)  = ao_power(j,1:3)
-      A_center(1:3) = nucl_coord(num_A,1:3)
+    A_center(1:3) = nucl_coord(num_A,1:3)
-  
+ 
-      do i = 1, ao_num
+    do i = 1, ao_num
-        num_B         = ao_nucl(i)
+      num_B         = ao_nucl(i)
-        power_B(1:3)  = ao_power(i,1:3)
+      power_B(1:3)  = ao_power(i,1:3)
-        B_center(1:3) = nucl_coord(num_B,1:3)
+      B_center(1:3) = nucl_coord(num_B,1:3)
-  
+ 
-        do l = 1, ao_prim_num(j)
+      do l = 1, ao_prim_num(j)
-          alpha = ao_expo_ordered_transp(l,j)
+        alpha = ao_expo_ordered_transp(l,j)
-  
+ 
-          do m = 1, ao_prim_num(i)
+        do m = 1, ao_prim_num(i)
-            beta = ao_expo_ordered_transp(m,i)
+          beta = ao_expo_ordered_transp(m,i)
-  
+ 
-            c = 0.d0
+          c = 0.d0
-            do k = 1, nucl_num
+          do k = 1, nucl_num
-              gama          = j1b_pen(k)
+            gama          = env_expo(k)
-              C_center(1:3) = nucl_coord(k,1:3)
+            C_center(1:3) = nucl_coord(k,1:3)
-  
+ 
-              ! < XA | exp[-gama r_C^2] | XB >
+            ! < XA | exp[-gama r_C^2] | XB >
-              c1 = int_gauss_r0( A_center, B_center, C_center        &
+            c1 = int_gauss_r0( A_center, B_center, C_center        &
-                               , power_A, power_B, alpha, beta, gama )
+                             , power_A, power_B, alpha, beta, gama )
-  
+ 
-              ! < XA | r_A^2 exp[-gama r_C^2] | XB >
+            ! < XA | r_A^2 exp[-gama r_C^2] | XB >
-              c2 = int_gauss_r2( A_center, B_center, C_center        &
+            c2 = int_gauss_r2( A_center, B_center, C_center        &
-                               , power_A, power_B, alpha, beta, gama )
+                             , power_A, power_B, alpha, beta, gama )
-  
+ 
-              c = c + 3.d0 * gama * c1 - 2.d0 * gama * gama * c2
+            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
 
 

plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f

@@ -1,10 +1,11 @@
+
 ! ---
 
-BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)]
+BEGIN_PROVIDER [double precision, env_gauss_nonherm, (ao_num,ao_num)]
 
   BEGIN_DOC
   !
-  !  j1b_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{1b} \cdot grad | \chi_i \rangle  
+  !  env_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{env} \cdot grad | \chi_i \rangle  
   !
   END_DOC
 
@@ -22,8 +23,6 @@ BEGIN_PROVIDER [ double precision, j1b_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
@@ -38,10 +37,8 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)]
   ! --------------------------------------------------------------------------------
   
 
-  j1b_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0
+  env_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)                                           &
@@ -51,101 +48,46 @@ BEGIN_PROVIDER [ double precision, j1b_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, j1b_pen, j1b_gauss_nonherm)
+ !$OMP         nucl_num, env_expo, env_gauss_nonherm)
  !$OMP DO SCHEDULE (dynamic)
-    do j = 1, ao_num
+  do j = 1, ao_num
-      num_A         = ao_nucl(j)
+    num_A         = ao_nucl(j)
-      power_A(1:3)  = ao_power(j,1:3)
+    power_A(1:3)  = ao_power(j,1:3)
-      A_center(1:3) = nucl_coord(num_A,1:3)
+    A_center(1:3) = nucl_coord(num_A,1:3)
-  
+
-      do i = 1, ao_num
+    do i = 1, ao_num
-        num_B         = ao_nucl(i)
+      num_B         = ao_nucl(i)
-        power_B(1:3)  = ao_power(i,1:3)
+      power_B(1:3)  = ao_power(i,1:3)
-        B_center(1:3) = nucl_coord(num_B,1:3)
+      B_center(1:3) = nucl_coord(num_B,1:3)
-  
+
-        do l = 1, ao_prim_num(j)
+      do l = 1, ao_prim_num(j)
-          alpha = ao_expo_ordered_transp(l,j)
+        alpha = ao_expo_ordered_transp(l,j)
-  
+
-          do m = 1, ao_prim_num(i)
+        do m = 1, ao_prim_num(i)
-            beta = ao_expo_ordered_transp(m,i)
+          beta = ao_expo_ordered_transp(m,i)
-  
+
-            c = 0.d0
+          c = 0.d0
-            do k = 1, nucl_num
+          do k = 1, nucl_num
-              gama          = j1b_pen(k)
+            gama          = env_expo(k)
-              C_center(1:3) = nucl_coord(k,1:3)
+            C_center(1:3) = nucl_coord(k,1:3)
-  
+
-              !  \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle
+            !  \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        &
+            c1 = int_gauss_deriv( A_center, B_center, C_center        &
-                                  , power_A, power_B, alpha, beta, gama )
+                                , power_A, power_B, alpha, beta, gama )
-  
+
-              c = c + 2.d0 * gama * c1 
+            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
 
 

plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f

@@ -22,9 +22,6 @@ 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

plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f

@@ -1,6 +1,6 @@
 ! ---
 
-double precision function j1b_gauss_2e_j1(i, j, k, l)
+double precision function env_gauss_2e_j1(i, j, k, l)
 
   BEGIN_DOC
   ! 
@@ -36,10 +36,10 @@ double precision function j1b_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    :: j1b_gauss_2e_j1_schwartz
+  double precision    :: env_gauss_2e_j1_schwartz
   
   if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
-    j1b_gauss_2e_j1 = j1b_gauss_2e_j1_schwartz(i, j, k, l)
+    env_gauss_2e_j1 = env_gauss_2e_j1_schwartz(i, j, k, l)
     return
   endif
 
@@ -59,7 +59,7 @@ double precision function j1b_gauss_2e_j1(i, j, k, l)
     L_center(p) = nucl_coord(num_l,p)
   enddo
 
-  j1b_gauss_2e_j1 = 0.d0
+  env_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 j1b_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 )
 
-          j1b_gauss_2e_j1 = j1b_gauss_2e_j1 + coef4 * ( cx + cy + cz )
+          env_gauss_2e_j1 = env_gauss_2e_j1 + coef4 * ( cx + cy + cz )
         enddo ! s
       enddo  ! r
     enddo   ! q
   enddo    ! p
 
   return
-end function j1b_gauss_2e_j1
+end
 
 ! ---
 
-double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l)
+double precision function env_gauss_2e_j1_schwartz(i, j, k, l)
 
   BEGIN_DOC
   ! 
@@ -137,8 +137,6 @@ double precision function j1b_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
 
@@ -186,8 +184,7 @@ double precision function j1b_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)
@@ -226,7 +223,7 @@ double precision function j1b_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 )
 
-          j1b_gauss_2e_j1_schwartz = j1b_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz )
+          env_gauss_2e_j1_schwartz = env_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz )
         enddo ! s
       enddo  ! r
     enddo   ! q
@@ -235,7 +232,7 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l)
   deallocate( schwartz_kl )
 
   return
-end function j1b_gauss_2e_j1_schwartz
+end
 
 ! ---
 
@@ -263,14 +260,12 @@ 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        = j1b_pen(ii)
+    expoii        = env_expo(ii)
     Centerii(1:3) = nucl_coord(ii, 1:3)
 
     call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)

plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f

@@ -1,6 +1,6 @@
 ! ---
 
-double precision function j1b_gauss_2e_j2(i, j, k, l)
+double precision function env_gauss_2e_j2(i, j, k, l)
 
   BEGIN_DOC
   ! 
@@ -36,12 +36,12 @@ double precision function j1b_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    :: j1b_gauss_2e_j2_schwartz
+  double precision    :: env_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
-    j1b_gauss_2e_j2 = j1b_gauss_2e_j2_schwartz(i, j, k, l)
+    env_gauss_2e_j2 = env_gauss_2e_j2_schwartz(i, j, k, l)
     return
   endif
 
@@ -61,7 +61,7 @@ double precision function j1b_gauss_2e_j2(i, j, k, l)
     L_center(p) = nucl_coord(num_l,p)
   enddo
 
-  j1b_gauss_2e_j2 = 0.d0
+  env_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 j1b_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 )
 
-          j1b_gauss_2e_j2 = j1b_gauss_2e_j2 + coef4 * ( cx + cy + cz )
+          env_gauss_2e_j2 = env_gauss_2e_j2 + coef4 * ( cx + cy + cz )
         enddo ! s
       enddo  ! r
     enddo   ! q
   enddo    ! p
 
   return
-end function j1b_gauss_2e_j2
+end
 
 ! ---
 
-double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l)
+double precision function env_gauss_2e_j2_schwartz(i, j, k, l)
 
   BEGIN_DOC
   ! 
@@ -187,7 +187,7 @@ double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l)
   enddo
 
 
-  j1b_gauss_2e_j2_schwartz = 0.d0
+  env_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 j1b_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 )
 
-          j1b_gauss_2e_j2_schwartz = j1b_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz )
+          env_gauss_2e_j2_schwartz = env_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz )
         enddo ! s
       enddo  ! r
     enddo   ! q
@@ -235,7 +235,7 @@ double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l)
   deallocate( schwartz_kl )
 
   return
-end function j1b_gauss_2e_j2_schwartz
+end
 
 ! ---
 
@@ -263,15 +263,13 @@ 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        = j1b_pen  (ii)
+    expoii        = env_expo(ii)
-    coefii        = j1b_coeff(ii)
+    coefii        = env_coef(ii)
     Centerii(1:3) = nucl_coord(ii, 1:3)
 
     call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)

plugins/local/ao_tc_eff_map/useful_sub.irp.f

@@ -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 function general_primitive_integral_coul_shifted
+end
 !______________________________________________________________________________________________________________________
 !______________________________________________________________________________________________________________________
 
@@ -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 function general_primitive_integral_erf_shifted
+end
 !______________________________________________________________________________________________________________________
 !______________________________________________________________________________________________________________________
 
@@ -362,3 +362,48 @@ end function general_primitive_integral_erf_shifted
 
 
 
+
+! ---
+
+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
+
+! ---
+

plugins/local/basis_correction/README.rst

@@ -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_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). 
+    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). 
       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.  

plugins/local/basis_correction/pbe_on_top.irp.f

@@ -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_ful")then
+   if(mu_of_r_potential == "cas_full")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_ful")then
+   if(mu_of_r_potential == "cas_full")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_ful")then
+   if(mu_of_r_potential == "cas_full")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

plugins/local/basis_correction/print_routine.irp.f

@@ -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_ful".or.mu_of_r_potential.EQ."cas_truncated")then
+ 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 
+  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_ful".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then
+  else if(mu_of_r_potential.EQ."cas_full".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)

plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f

@@ -1,4 +1,39 @@
 
+
+! ---
+
+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)
@@ -25,7 +60,7 @@ double precision function bi_ortho_mo_coul_ints(l, k, j, i)
     enddo
   enddo
 
-end function bi_ortho_mo_coul_ints
+end
 
 ! ---
 

plugins/local/bi_ort_ints/one_e_bi_ort.irp.f

@@ -8,23 +8,6 @@ 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
 
 ! ---

plugins/local/bi_ort_ints/total_twoe_pot.irp.f

@@ -1,91 +1,4 @@
 
-
-! ---
-
-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)
@@ -118,8 +31,6 @@ 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
@@ -267,7 +178,6 @@ 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)]

plugins/local/cipsi_tc_bi_ortho/NEED

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

plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f

@@ -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_tc_gen(1:N_det,1:N_states)
+    psi_coef(1:N_det,1:N_states) = psi_coef_sorted_gen(1:N_det,1:N_states)
     N_det = N_det_max
     soft_touch N_det psi_det psi_coef
     if (s2_eig) then

plugins/local/cipsi_tc_bi_ortho/energy.irp.f

@@ -15,37 +15,5 @@ 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
 

plugins/local/cipsi_tc_bi_ortho/environment.irp.f

@@ -1,14 +0,0 @@
-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
-

plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f

@@ -1,868 +1,3 @@
-BEGIN_PROVIDER [ integer, pt2_stoch_istate ]
+subroutine provide_for_zmq_pt2
- implicit none
+  PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc psi_det_sorted_tc_order
- 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
-
-
-
-
-

plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f

@@ -1,549 +0,0 @@
- 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
-

plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f

@@ -1,255 +1,5 @@
-subroutine run_selection_slave(thread, iproc, energy)
+subroutine provide_for_selection_slave
-
+  PROVIDE psi_det_sorted_tc_order
-  use f77_zmq
+  PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc 
-  use selection_types
+end
-
-  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
-
-
 

plugins/local/cipsi_tc_bi_ortho/selection.irp.f

@@ -76,6 +76,8 @@ 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)
@@ -86,10 +88,13 @@ 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 select_connected
+end subroutine
-
 
 
 double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
@@ -136,7 +141,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
@@ -151,8 +156,6 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
   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)
@@ -170,6 +173,7 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
   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(:,:)
@@ -178,15 +182,16 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
 
 
   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_rows psi_bilinear_matrix_order psi_bilinear_matrix_transp_order
   PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
-  PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_tc
+  PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc_order
 
   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))
@@ -198,7 +203,11 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
   call bitstring_to_list_ab(hole    , hole_list    , N_holes    , N_int)
   call bitstring_to_list_ab(particle, particle_list, N_particles, N_int)
 
-  allocate( indices(N_det), exc_degree( max(N_det_alpha_unique, N_det_beta_unique) ) )
+  ! 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)))
 
   ! Pre-compute excitation degrees wrt alpha determinants
   k=1
@@ -214,73 +223,76 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
     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))
-!       if (psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then
+        ! Removed to avoid introducing determinants already presents in the wf
+        !if (psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then
           indices(k) = idx
-          k = k + 1
+          k=k+1
-!       endif
+        !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 (exc_degree(i) < 3) cycle
-      if(nt + exc_degree(i) <= 4) then
+      if (nt + exc_degree(i) <= 4) then
         idx = psi_det_sorted_tc_order(                                  &
             psi_bilinear_matrix_order(                               &
             psi_bilinear_matrix_transp_order(l_a)))
-!       if(psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then
+        ! Removed to avoid introducing determinants already presents in the wf
+        !if(psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then
           indices(k) = idx
-          k = k + 1
+          k=k+1
-!       endif
+        !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))
-  enddo
+  end do
-
-  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))
-    enddo
+    end do
 
     if(nt <= 4) then
       if(i <= N_det_selectors) then
         sze = preinteresting(0)
-        if(sze+1 == size(preinteresting)) then
+        if (sze+1 == size(preinteresting)) then
-          allocate(tmp_array(0:sze))
+          allocate (tmp_array(0:sze))
           tmp_array(0:sze) = preinteresting(0:sze)
           deallocate(preinteresting)
           allocate(preinteresting(0:2*sze))
@@ -289,9 +301,9 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
         endif
         preinteresting(0) = sze+1
         preinteresting(sze+1) = i
-      elseif(nt <= 2) then
+      else if(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)
@@ -301,20 +313,16 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
         endif
         prefullinteresting(0) = sze+1
         prefullinteresting(sze+1) = i
-      endif
+      end if
-    endif
+    end if
-
+  end do
-  enddo
   deallocate(indices)
 
-  allocate( banned(mo_num, mo_num,2), bannedOrb(mo_num, 2) )
+  allocate(banned(mo_num, mo_num,2), bannedOrb(mo_num, 2))
-  allocate( mat(N_states, mo_num, mo_num) )
+  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(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
 
@@ -347,17 +355,17 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
 
       do ii = 1, preinteresting(0)
         i = preinteresting(ii)
-        select case(N_int)
+        select case (N_int)
-          case(1)
+          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
@@ -370,8 +378,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
                 nt = nt+ popcnt(mobMask(j, 2))
                 if (nt > 4) exit
               endif
-            enddo
+            end do
-          case(4)
+          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
@@ -384,7 +392,7 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
                 nt = nt+ popcnt(mobMask(j, 2))
                 if (nt > 4) exit
               endif
-            enddo
+            end do
           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))
@@ -398,12 +406,12 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
                 nt = nt+ popcnt(mobMask(j, 2))
                 if (nt > 4) exit
               endif
-            enddo
+            end do
         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)
@@ -425,8 +433,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
             endif
             fullinteresting(0) = sze+1
             fullinteresting(sze+1) = i
-          endif
+          end if
-        endif
+        end if
 
       enddo
 
@@ -456,10 +464,10 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
           endif
           fullinteresting(0) = sze+1
           fullinteresting(sze+1) = i
-        endif
+        end if
-      enddo
+      end do
-      allocate( fullminilist (N_int, 2, fullinteresting(0)), &
+      allocate (fullminilist (N_int, 2, fullinteresting(0)), &
-                    minilist (N_int, 2,     interesting(0))  )
+                   minilist (N_int, 2,     interesting(0))  )
 
       do i = 1, fullinteresting(0)
         do k = 1, N_int
@@ -517,7 +525,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
             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)
-          endif
+          end if
+
 
         enddo
 
@@ -533,7 +542,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
   deallocate(banned, bannedOrb,mat)
   deallocate(mat_l, mat_r)
 
-end subroutine select_singles_and_doubles
+
+end subroutine
 
 ! ---
 
@@ -785,6 +795,11 @@ 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
@@ -924,13 +939,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) 
+                 call debug_det(psi_selectors(1,1,iii),N_int)
-                enddo 
+                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) 
+!                 call debug_det(psi_det(1,1,iii),N_int)
-!                enddo 
+!                enddo
                 stop
               endif
             endif
@@ -938,29 +953,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(dabs(tmp)).gt.1.d-4.and.dabs(alpha_h_psi).gt.1.d-4)then
+          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 
+           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
@@ -980,8 +995,11 @@ 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)
-        pt2_data % variance(istate)  = pt2_data % variance(istate) + dabs(e_pert(istate))
+        if(e_pert(istate).gt.0.d0)then! accumulate the positive part of the pt2
-        pt2_data % pt2(istate)       = pt2_data % pt2(istate)      + e_pert(istate)
+         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
 
         select case (weight_selection)
           case(5)

plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f

@@ -1,424 +0,0 @@
-
-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
-
-
-

plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f

@@ -1,134 +0,0 @@
-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
-

plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f

@@ -1,348 +0,0 @@
-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
-
-
-

plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f

@@ -11,15 +11,13 @@ 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, E_denom, E_tc, norm
+  double precision              :: correlation_energy_ratio
   double precision              :: hf_energy_ref
   double precision              :: relative_error
-  double precision, allocatable :: ept2(:), pt1(:), extrap_energy(:)
+  double precision, allocatable :: zeros(:),E_tc(:), norm(:)
-  double precision, allocatable :: zeros(:)
 
   logical,          external    :: qp_stop
   double precision, external    :: memory_of_double
@@ -32,14 +30,13 @@ 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))
+  allocate(zeros(N_states),E_tc(N_states), norm(N_states))
   call pt2_alloc(pt2_data, N_states)
   call pt2_alloc(pt2_data_err, N_states)
 
@@ -55,32 +52,27 @@ subroutine run_stochastic_cipsi
 !  if (s2_eig) then
 !    call make_s2_eigenfunction
 !  endif
-  print_pt2 = .False.
+  call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm)
-  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_tc_gen(1:N_det,1:N_states)
+!    psi_coef(1:N_det,1:N_states) = psi_coef_sorted_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
-!    print_pt2 = .False.
+!    call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm)
-!    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))
 
@@ -91,15 +83,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)
 
-    E_denom = E_tc ! TC Energy of the current wave function 
+    print*,'E_tc = ',E_tc
     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,to_select) ! Stochastic PT2 and selection
+    call ZMQ_pt2(E_tc, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection
 !    stop
 
-    call print_summary(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, N_det, N_configuration, N_states, psi_s2)
+    call print_summary_tc(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)
 
@@ -117,48 +109,19 @@ subroutine run_stochastic_cipsi
     PROVIDE psi_det
     PROVIDE psi_det_sorted_tc
 
-    ept2(N_iter-1) = E_tc + nuclear_repulsion + (pt2_data % pt2(1))/norm
+    call diagonalize_CI_tc_bi_ortho(ndet, E_tc, 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,pt2_data,print_pt2)
+  call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm)
-!  if (.not.qp_stop()) then
+  call pt2_dealloc(pt2_data)
-!    if (N_det < N_det_max) then
+  call pt2_dealloc(pt2_data_err)
-!     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
 

plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f

@@ -9,6 +9,8 @@ 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)
@@ -26,15 +28,34 @@ 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_data % pt2(k)
+      
-      write(json_unit, json_real_fmt) 'pt2_err', pt2_data_err % pt2(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) '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', pt2_data % variance(k)
-      write(json_unit, json_real_fmt) 'variance_err', pt2_data_err % 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)

plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f

@@ -1,235 +0,0 @@
-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
-

plugins/local/fci_tc_bi/NEED

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

plugins/local/fci_tc_bi/diagonalize_ci.irp.f

@@ -1,7 +1,7 @@
 
 ! ---
 
-subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2)
+subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm )
 
   BEGIN_DOC
   !  Replace the coefficients of the CI states by the coefficients of the
@@ -11,49 +11,19 @@ subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2)
   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 
+  double precision, intent(inout) :: E_tc(N_states), norm(N_states) ! E and norm from previous wave function 
-  type(pt2_type)  , intent(in)    :: pt2_data   ! PT2 from previous wave function 
+  integer                         :: i, j,k
-  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
 
-  pt2_tmp  = pt2_data % pt2(1)
+  do k = 1, N_states
-  abs_pt2  = pt2_data % variance(1)
+   E_tc(k) = eigval_right_tc_bi_orth(k)
-  pt1_norm = pt2_data % overlap(1,1)
+   norm(k) = norm_ground_left_right_bi_orth(k)
-  rpt2_tmp = pt2_tmp/(1.d0 + pt1_norm)
+  enddo
-
-  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
@@ -71,53 +41,3 @@ 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
-
-! ---
-

plugins/local/fci_tc_bi/script_tc_bh_h2o_gd_exc.sh

@@ -0,0 +1,85 @@
+#!/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

plugins/local/fci_tc_bi/script_tc_jmu_h2o_gd_exc.sh

@@ -0,0 +1,84 @@
+#!/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 

plugins/local/fci_tc_bi/selectors.irp.f

@@ -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_tc_gen(i,k)
+      psi_selectors_coef(i,k)      = psi_coef_sorted_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

plugins/local/jastrow/EZFIO.cfg

@@ -1,9 +1,22 @@
-[jast_type]
+
-doc: Type of Jastrow [None| Mu | Qmckl]
+[j2e_type]
 type: character*(32)
-interface: ezfio, provider, ocaml
+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
+
 [jast_qmckl_type_nucl_num]
 doc: Number of different nuclei types in QMCkl jastrow
 type: integer
@@ -64,6 +77,119 @@ 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)
 

plugins/local/jastrow/NEED

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

plugins/local/jastrow/README.md

@@ -1,3 +1,78 @@
 # Jastrow
 
-Information relative to the Jastrow factor in trans-correlated calculations.
+Information related to the Jastrow factor in trans-correlated calculations.
+
+The main keywords are:
+- `j2e_type`
+- `j1e_type`
+- `env_type`
+
+## j2e_type Options
+
+1. **None:** No 2e-Jastrow is used.
+
+2. **Mu:** 2e-Jastrow inspired by Range Separated Density Functional Theory. It has the following shape:
+   <p align="center">
+      <img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7D%5Ctau=%5Cfrac%7B1%7D%7B2%7D%5Csum_%7Bi,j%5Cneq%20i%7Du(%5Cmathbf%7Br%7D_i,%5Cmathbf%7Br%7D_j)">
+   </p>
+   with,
+   <p align="center">
+   <img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7D%20u(%5Cmathbf%7Br%7D_1,%5Cmathbf%7Br%7D_2)=u(r_%7B12%7D)=%5Cfrac%7Br_%7B12%7D%7D%7B2%7D%5Cleft%5B1-%5Ctext%7Berf%7D(%5Cmu%20r_%7B12%7D)%5Cright%5D-%5Cfrac%7B%5Cexp%5B-(%5Cmu%20r_%7B12%7D)%5E2%5D%7D%7B2%5Csqrt%7B%5Cpi%7D%5Cmu%7D">
+   </p>
+
+3. **Mu_Nu:** A valence and a core correlation terms are used
+   <p align="center">
+      <img src="https://latex.codecogs.com/png.image?\inline&space;\large&space;\dpi{110}\bg{white}&space;u(\mathbf{r}_1,\mathbf{r}_2)=u(\mu;r_{12})\,v(\mathbf{r}_1)\,v(\mathbf{r}_2)&plus;u(\nu;r_{12})[1-v(\mathbf{r}_1)\,v(\mathbf{r}_2)]">
+   </p>
+   with envelop \(v\).
+
+
+## env_type Options
+
+The 2-electron Jastrow is multiplied by an envelope \(v\):
+<p align="center">
+      <img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7D%5Ctau=%5Cfrac%7B1%7D%7B2%7D%5Csum_%7Bi,j%5Cneq%20i%7Du(%5Cmathbf%7Br%7D_i,%5Cmathbf%7Br%7D_j)%5C,v(%5Cmathbf%7Br%7D_i)%5C,v(%5Cmathbf%7Br%7D_j)">
+</p>
+
+- if `env_type` is **None**: No envelope is used.
+
+- if `env_type` is **Prod_Gauss**:
+  <p align="center">
+     <img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7D%20v(%5Cmathbf%7Br%7D)=%5Cprod_%7BA%7D%5Cleft(1-e%5E%7B-%5Calpha_A(%5Cmathbf%7Br%7D-%5Cmathbf%7BR%7D_A)%5E2%7D%5Cright)">
+   </p>
+
+- if `env_type` is **Sum_Gauss**:
+  <p align="center">
+     <img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7D%20v(%5Cmathbf%7Br%7D)=1-%5Csum_%7BA%7Dc_A%20e%5E%7B-%5Calpha_A(%5Cmathbf%7Br%7D-%5Cmathbf%7BR%7D_A)%5E2%7D">
+  </p>
+
+Here, \(A\) designates the nuclei, and the coefficients and exponents are defined in the tables `env_coef` and `env_expo` respectively.
+
+
+## j1e_type Options
+
+The 1-electron Jastrow used is:
+<p align="center">
+   <img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7D%5Ctau=%5Csum_i%20u_%7B1e%7D(%5Cmathbf%7Br%7D_i)">
+</p>
+
+- if `j1e_type` is **None**: No one-electron Jastrow is used.
+
+- if `j1e_type` is **Gauss**: We use
+<p align="center">
+   <img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7Du_%7B1e%7D(%5Cmathbf%7Br%7D)=%5Csum_A%5Csum_%7Bp_A%7Dc_%7Bp_A%7De%5E%7B-%5Calpha_%7Bp_A%7D(%5Cmathbf%7Br%7D-%5Cmathbf%7BR%7D_A)%5E2%7D">
+</p>
+<img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7D%20c_%7Bp_A%7D%5C,%5Ctext%7Band%7D%5C,%5Calpha_%7Bp_A%7D"> 
+
+are defined by the tables `j1e_coef` and `j1e_expo`, respectively.
+
+- if `j1e_type` is **Charge_Harmonizer**: The one-electron Jastrow factor aims to offset the adverse impact of modifying the charge density induced by the two-electron factor
+  <p align="center">
+     <img src="https://latex.codecogs.com/png.image?%5Cinline%20%5Clarge%20%5Cdpi%7B200%7D%5Cbg%7Bwhite%7Du_%7B1e%7D(%5Cmathbf%7Br%7D_1)=-%5Cfrac%7BN-1%7D%7B2N%7D%5C,%5Csum_%7B%5Csigma%7D%5C,%5Cint%20d%5Cmathbf%7Br%7D_2%5C,%5Crho%5E%7B%5Csigma%7D(%5Cmathbf%7Br%7D_2)%5C,u_%7B2e%7D(%5Cmathbf%7Br%7D_1,%5Cmathbf%7Br%7D_2)">
+  </p>
+
+- if `j1e_type` is **Charge_Harmonizer_AO**: The one-electron Jastrow factor **Charge_Harmonizer** is fitted by the product of atomic orbitals:
+  <p align="center">
+     <img src="https://latex.codecogs.com/png.image?\inline&space;\large&space;\dpi{300}\bg{white}&space;u_{1e}(\mathbf{r})=\sum_{\alpha,\beta}C_{\alpha,\beta}\chi_{\alpha}(\mathbf{r})\chi_{\beta}(\mathbf{r})">
+  </p>
+

plugins/local/jastrow/bh_param.irp.f

@@ -0,0 +1,252 @@
+
+ BEGIN_PROVIDER [double precision, jBH_ee,           (nucl_num)]
+&BEGIN_PROVIDER [double precision, jBH_en,           (nucl_num)]
+&BEGIN_PROVIDER [double precision, jBH_c , (jBH_size, nucl_num)]
+&BEGIN_PROVIDER [integer         , jBH_m , (jBH_size, nucl_num)]
+&BEGIN_PROVIDER [integer         , jBH_n , (jBH_size, nucl_num)]
+&BEGIN_PROVIDER [integer         , jBH_o , (jBH_size, nucl_num)]
+
+  BEGIN_DOC
+  !
+  ! parameters of Boys-Handy-Jastrow
+  !
+  END_DOC
+
+  implicit none
+  logical :: exists
+  integer :: i_nucl, p
+  integer :: ierr
+
+  PROVIDE ezfio_filename
+
+  ! ---
+
+  if(mpi_master) then
+    call ezfio_has_jastrow_jBH_ee(exists)
+  endif
+
+  IRP_IF MPI_DEBUG
+    print *,  irp_here, mpi_rank
+    call MPI_BARRIER(MPI_COMM_WORLD, ierr)
+  IRP_ENDIF
+
+  IRP_IF MPI
+    include 'mpif.h'
+    call MPI_BCAST(jBH_ee, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+    if(ierr /= MPI_SUCCESS) then
+      stop 'Unable to read Boys-Handy e-e param with MPI'
+    endif
+  IRP_ENDIF
+
+  if(exists) then
+    if(mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: jBH_ee ] <<<<< ..'
+      call ezfio_get_jastrow_jBH_ee(jBH_ee)
+      IRP_IF MPI
+        call MPI_BCAST(jBH_ee, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+        if(ierr /= MPI_SUCCESS) then
+          stop 'Unable to read jBH_ee with MPI'
+        endif
+      IRP_ENDIF
+    endif
+  else
+
+    jBH_ee = 1.d0
+    call ezfio_set_jastrow_jBH_ee(jBH_ee)
+  endif
+
+  ! ---
+
+  if(mpi_master) then
+    call ezfio_has_jastrow_jBH_en(exists)
+  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(jBH_en, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+    if(ierr /= MPI_SUCCESS) then
+      stop 'Unable to read Boys-Handy e-n param with MPI'
+    endif
+  IRP_ENDIF
+
+  if(exists) then
+    if(mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: jBH_en ] <<<<< ..'
+      call ezfio_get_jastrow_jBH_en(jBH_en)
+      IRP_IF MPI
+        call MPI_BCAST(jBH_en, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+        if (ierr /= MPI_SUCCESS) then
+          stop 'Unable to read jBH_en with MPI'
+        endif
+      IRP_ENDIF
+    endif
+  else
+
+    jBH_en = 1.d0
+    call ezfio_set_jastrow_jBH_en(jBH_en)
+  endif
+
+  ! ---
+
+  if(mpi_master) then
+    call ezfio_has_jastrow_jBH_c(exists)
+  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(jBH_c, (jBH_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+    if(ierr /= MPI_SUCCESS) then
+      stop 'Unable to read Boys-Handy coeff with MPI'
+    endif
+  IRP_ENDIF
+
+  if(exists) then
+    if(mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: jBH_c ] <<<<< ..'
+      call ezfio_get_jastrow_jBH_c(jBH_c)
+      IRP_IF MPI
+        call MPI_BCAST(jBH_c, (jBH_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+        if(ierr /= MPI_SUCCESS) then
+          stop 'Unable to read jBH_c with MPI'
+        endif
+      IRP_ENDIF
+    endif
+  else
+
+    jBH_c = 0.d0
+    call ezfio_set_jastrow_jBH_c(jBH_c)
+  endif
+
+  ! ---
+
+  if(mpi_master) then
+    call ezfio_has_jastrow_jBH_m(exists)
+  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(jBH_m, (jBH_size*nucl_num), MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if(ierr /= MPI_SUCCESS) then
+      stop 'Unable to read Boys-Handy m powers with MPI'
+    endif
+  IRP_ENDIF
+
+  if(exists) then
+    if(mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: jBH_m ] <<<<< ..'
+      call ezfio_get_jastrow_jBH_m(jBH_m)
+      IRP_IF MPI
+        call MPI_BCAST(jBH_m, (jBH_size*nucl_num), MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+        if(ierr /= MPI_SUCCESS) then
+          stop 'Unable to read jBH_m with MPI'
+        endif
+      IRP_ENDIF
+    endif
+  else
+
+    jBH_m = 0
+    call ezfio_set_jastrow_jBH_m(jBH_m)
+  endif
+
+  ! ---
+
+  if(mpi_master) then
+    call ezfio_has_jastrow_jBH_n(exists)
+  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(jBH_n, (jBH_size*nucl_num), MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if(ierr /= MPI_SUCCESS) then
+      stop 'Unable to read Boys-Handy n powers with MPI'
+    endif
+  IRP_ENDIF
+
+  if(exists) then
+    if(mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: jBH_n ] <<<<< ..'
+      call ezfio_get_jastrow_jBH_n(jBH_n)
+      IRP_IF MPI
+        call MPI_BCAST(jBH_n, (jBH_size*nucl_num), MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+        if(ierr /= MPI_SUCCESS) then
+          stop 'Unable to read jBH_n with MPI'
+        endif
+      IRP_ENDIF
+    endif
+  else
+
+    jBH_n = 0
+    call ezfio_set_jastrow_jBH_n(jBH_n)
+  endif
+
+  ! ---
+
+  if(mpi_master) then
+    call ezfio_has_jastrow_jBH_o(exists)
+  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(jBH_o, (jBH_size*nucl_num), MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if(ierr /= MPI_SUCCESS) then
+      stop 'Unable to read Boys-Handy o powers with MPI'
+    endif
+  IRP_ENDIF
+
+  if(exists) then
+    if(mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: jBH_o ] <<<<< ..'
+      call ezfio_get_jastrow_jBH_o(jBH_o)
+      IRP_IF MPI
+        call MPI_BCAST(jBH_o, (jBH_size*nucl_num), MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+        if(ierr /= MPI_SUCCESS) then
+          stop 'Unable to read jBH_o with MPI'
+        endif
+      IRP_ENDIF
+    endif
+  else
+
+    jBH_o = 0
+    call ezfio_set_jastrow_jBH_o(jBH_o)
+  endif
+
+  ! ---
+
+  print *, ' parameters for Boys-Handy Jastrow'
+  print *, ' nb of terms per nucleus = ', jBH_size
+
+  do i_nucl = 1, nucl_num
+    print *, ' nucl    = ', nucl_label(i_nucl)
+    print *, ' ee-term = ', jBH_ee(i_nucl)
+    print *, ' en-term = ', jBH_en(i_nucl)
+    print *, '  m     n     o          c'
+    do p = 1, jBH_size
+      write(*,'(3(I4,2x), E15.7)') jBH_m(p,i_nucl), jBH_n(p,i_nucl), jBH_o(p,i_nucl), jBH_c(p,i_nucl)
+    enddo
+  enddo
+
+
+END_PROVIDER
+
+! ---
+

plugins/local/jastrow/env_param.irp.f

@@ -0,0 +1,102 @@
+
+! ---
+
+ BEGIN_PROVIDER [double precision, env_expo, (nucl_num)]
+&BEGIN_PROVIDER [double precision, env_coef, (nucl_num)]
+
+  BEGIN_DOC
+  !
+  ! parameters of the env of the 2e-Jastrow
+  !
+  END_DOC
+
+  implicit none
+  logical :: exists
+  integer :: i
+  integer :: ierr
+
+  PROVIDE ezfio_filename
+
+  ! ---
+
+  if (mpi_master) then
+    call ezfio_has_jastrow_env_expo(exists)
+  endif
+
+  IRP_IF MPI_DEBUG
+    print *,  irp_here, mpi_rank
+    call MPI_BARRIER(MPI_COMM_WORLD, ierr)
+  IRP_ENDIF
+
+  IRP_IF MPI
+    include 'mpif.h'
+    call MPI_BCAST(env_expo, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      stop 'Unable to read env_expo with MPI'
+    endif
+  IRP_ENDIF
+
+  if (exists) then
+    if (mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: env_expo ] <<<<< ..'
+      call ezfio_get_jastrow_env_expo(env_expo)
+      IRP_IF MPI
+        call MPI_BCAST(env_expo, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+        if (ierr /= MPI_SUCCESS) then
+          stop 'Unable to read env_expo with MPI'
+        endif
+      IRP_ENDIF
+    endif
+  else
+
+    env_expo = 1d5
+    call ezfio_set_jastrow_env_expo(env_expo)
+  endif
+
+  ! ---
+
+  if (mpi_master) then
+    call ezfio_has_jastrow_env_coef(exists)
+  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(env_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      stop 'Unable to read env_coef with MPI'
+    endif
+  IRP_ENDIF
+
+  if (exists) then
+    if (mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: env_coef ] <<<<< ..'
+      call ezfio_get_jastrow_env_coef(env_coef)
+      IRP_IF MPI
+        call MPI_BCAST(env_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+        if (ierr /= MPI_SUCCESS) then
+          stop 'Unable to read env_coef with MPI'
+        endif
+      IRP_ENDIF
+    endif
+  else
+
+    env_coef = 1d0
+    call ezfio_set_jastrow_env_coef(env_coef)
+  endif
+
+  ! ---
+
+  print *, ' parameters for nuclei jastrow'
+  print *, ' i, Z, env_expo, env_coef'
+  do i = 1, nucl_num
+    write(*,'(I4, 2x, 3(E15.7, 2X))') i, nucl_charge(i), env_expo(i), env_coef(i)
+  enddo
+
+END_PROVIDER
+
+! ---
+

plugins/local/jastrow/fit_j.irp.f

@@ -1,41 +1,67 @@
- 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_erfc_gauss ]
+ BEGIN_PROVIDER [double precision, expo_j_xmu_1gauss]
- implicit none 
+&BEGIN_PROVIDER [double precision, coef_j_xmu_1gauss]
- expo_erfc_gauss = 1.41211d0
+
+  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_erfc_mu_gauss ]
+! ---
- implicit none 
+
- expo_erfc_mu_gauss = expo_erfc_gauss * mu_erf * mu_erf
+BEGIN_PROVIDER [double precision, expo_erfc_gauss]
+
+  implicit none 
+
+  expo_erfc_gauss = 1.41211d0
+
 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_j_xmu, (n_fit_1_erf_x) ]
+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_DOC
   ! F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) is fitted with a gaussian and a Slater
@@ -465,53 +491,86 @@ END_PROVIDER
 ! ---
 
 double precision  function F_x_j(x)
- implicit none
+
- BEGIN_DOC 
+  BEGIN_DOC 
- ! F_x_j(x) = dimension-less correlation factor = x (1 - erf(x)) - 1/sqrt(pi) exp(-x^2)
+  !
- END_DOC
+  ! dimension-less correlation factor:
- double precision, intent(in) :: x
+  !
- F_x_j = x * (1.d0 - derf(x)) - 1/dsqrt(dacos(-1.d0)) * dexp(-x**2)
+  ! 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)
 
 end
 
+! ---
+
 double precision function j_mu_F_x_j(x)
- implicit none
+
- BEGIN_DOC 
+  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)
+  !
- !
+  ! correlation factor:
- !         = 1/(2*mu) * F_x_j(mu*x)
+  !
- END_DOC
+  ! j_mu_F_x_j(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
- double precision :: F_x_j
+  !               = 1/(2*mu) * F_x_j(mu*x)
- double precision, intent(in) :: x
+  !
- j_mu_F_x_j = 0.5d0/mu_erf * F_x_j(x*mu_erf)
+  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)
+
 end
 
+! ---
+
 double precision function j_mu(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 
- implicit none
+  !
- BEGIN_DOC 
+  ! correlation factor:
- ! j_mu_fit_gauss(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
+  !
- !
+  ! j_mu(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
- ! but fitted with gaussians 
+  !
- END_DOC
+  END_DOC
- double precision, intent(in) :: x
+ 
- integer :: i
+  implicit none
- double precision :: alpha,coef
+  double precision, intent(in) :: x
- j_mu_fit_gauss = 0.d0
+ 
- do i = 1, n_max_fit_slat
+  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))
-  alpha = expo_gauss_j_mu_x(i) 
+ 
-  coef  = coef_gauss_j_mu_x(i) 
+end
-  j_mu_fit_gauss +=  coef * dexp(-alpha*x*x)
+
- enddo
+! ---
+
+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
  
 end
 

plugins/local/jastrow/fit_potential.irp.f

@@ -1,13 +1,16 @@
+
 ! ---
 
 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
@@ -21,10 +24,13 @@ 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 
@@ -35,11 +41,13 @@ 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'
@@ -64,7 +72,9 @@ 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
@@ -74,44 +84,58 @@ double precision function eff_pot_gauss(x, mu)
 
 end
 
-! -------------------------------------------------------------------------------------------------
 ! ---
 
 double precision function eff_pot_fit_gauss(x)
- implicit none
+
- BEGIN_DOC
+  BEGIN_DOC
- ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) 
+  !
- ! 
+  ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) 
- ! but fitted with gaussians 
+  ! 
- END_DOC
+  ! but fitted with gaussians 
- double precision, intent(in) :: x
+  !
- integer :: i
+  END_DOC
- double precision :: alpha
+
- eff_pot_fit_gauss = derf(mu_erf*x)/x
+  implicit none
- do i = 1, n_gauss_eff_pot
+  double precision, intent(in) :: x
-  alpha = expo_gauss_eff_pot(i)
+  integer                      :: i
-  eff_pot_fit_gauss += coef_gauss_eff_pot(i) * dexp(-alpha*x*x)
+  double precision             :: alpha
- enddo
+
+  eff_pot_fit_gauss = derf(mu_erf*x)/x
+  do i = 1, n_gauss_eff_pot
+    alpha = expo_gauss_eff_pot(i)
+    eff_pot_fit_gauss += coef_gauss_eff_pot(i) * dexp(-alpha*x*x)
+  enddo
+
 end
 
+! ---
+
 BEGIN_PROVIDER [integer, n_fit_1_erf_x]
- implicit none
+
- BEGIN_DOC
+  implicit none
-! 
+
- END_DOC
+  n_fit_1_erf_x = 2
- n_fit_1_erf_x = 2
 
 END_PROVIDER 
 
+! ---
+
 BEGIN_PROVIDER [double precision, expos_slat_gauss_1_erf_x, (n_fit_1_erf_x)]
- implicit none
+
- BEGIN_DOC
+  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) 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
+  ! 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}
- expos_slat_gauss_1_erf_x(1) = 1.09529d0
+  !
- expos_slat_gauss_1_erf_x(2) = 0.756023d0
+  END_DOC
+
+  implicit none
+
+  expos_slat_gauss_1_erf_x(1) = 1.09529d0
+  expos_slat_gauss_1_erf_x(2) = 0.756023d0
+
 END_PROVIDER 
 
 ! ---
@@ -151,12 +175,14 @@ 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
@@ -171,11 +197,13 @@ 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
@@ -286,50 +314,22 @@ END_PROVIDER
 ! ---
 
 double precision function fit_1_erf_x_2(x)
- implicit none
+
- double precision, intent(in) :: x
+  BEGIN_DOC
- BEGIN_DOC
+  !
-! fit_1_erf_x_2(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))^2
+  ! 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
+  END_DOC
- fit_1_erf_x_2 = 0.d0
+
- do i = 1, n_max_fit_slat
+  implicit none
-  fit_1_erf_x_2 += dexp(-expo_gauss_1_erf_x_2(i) *x*x) * coef_gauss_1_erf_x_2(i)
+  double precision, intent(in) :: x
- enddo
+  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