Merge pull request #267 from QuantumPackage/dev-stable

Dev stable

.gitignore

@@ -5,7 +5,10 @@ build.ninja
 .ninja_deps
 bin/
 lib/
+lib64/
+libexec/
 config/qp_create_ninja.pickle
 src/*/.gitignore
 ezfio_interface.irp.f
 share
+*.swp

.travis.yml

@@ -1,52 +0,0 @@
-#sudo: true
-#before_script:
-#  - sudo apt-get update -q
-#  - sudo apt-get remove curl
-#  - sudo apt-get remove zlib1g-dev
-#  - sudo apt-get install autoconf
-#  - sudo rm /usr/local/bin/bats
-
-os: linux
-
-dist: bionic
-
-sudo: false
-
-compiler: gfortran
-
-addons:
-  apt:
-    packages:
-    - gfortran
-    - gcc
-    - libatlas-base-dev
-#    - liblapack-dev
-#    - libblas-dev
-    - wget
-
-env:
-  - OPAMROOT=$HOME/.opam
-
-cache:
-  directories:
-  - $HOME/.opam/
-  - $HOME/cache
-
-language: python
-python:
-    - "3.7"
-
-stages:
-  - configuration
-  - compilation
-  - testing
-
-jobs:
-  include:
-    - stage: configuration
-      script: travis/configuration.sh
-    - stage: compilation
-      script: travis/compilation.sh
-    - stage: testing
-      script: travis/testing.sh
-

INSTALL.rst

@@ -316,7 +316,7 @@ OCaml
 
   .. code:: bash
 
-      opam install ocamlbuild cryptokit zmq sexplib ppx_sexp_conv ppx_deriving getopt
+      opam install ocamlbuild zmq sexplib ppx_sexp_conv ppx_deriving getopt
 
 
 Docopt

RELEASE_NOTES.org

@@ -1,5 +1,32 @@
 #+TITLE: Quantum Package Release notes
 
+* Version 2.3
+
+** Changes
+
+  - Introduced DFT-based basis set correction
+  - Use OpamPack for OCaml
+  - Configure adapted for ARM
+  - Added many types of integrals
+  - Accelerated four-index transformation
+  - Added transcorrelated SCF
+  - Added transcorrelated CIPSI
+  - Added CCSD and CCSD(T)
+  - Added MO localization
+  - Changed coupling parameters for ROHF
+  - General Davidson algorithm
+  - Accelerated restore_symmetry
+  - Point charges in the Hamiltonian
+  - Removed cryptokit dependency in OCaml
+  - Using now standard convention in RDM
+  - Added molecular properties
+  - [ ] Added GTOs with complex exponent
+
+*** TODO: take from dev
+  - Updated version of f77-zmq
+  - Started to introduce shells in AOs
+  - Added ECMD UEG functional
+
 * Version 2.2
 
 ** Changes
@@ -32,9 +59,8 @@
   - Fixed bug with non-contiguous MOs in active space and deleter MOs
   - Complete network-free installation
   - Fixed bug in selection when computing full PT2
-  - Updated version of f77-zmq
 
-*** User interface
+** User interface
 
   - Added ~qp_basis~ script to install a basis set from the ~bse~
     command-line tool
@@ -62,7 +88,7 @@
   - Added a basis module containing basis set information
   - Added qp_run truncate_wf
 
-*** Code
+** Code
 
   - Many bug fixes
   - Changed electron-nucleus from ~e_n~ to ~n_e~ in names of variables

bin/qp_reset

@@ -105,6 +105,7 @@ if [[ $mos -eq 1 ]] ; then
       echo "Warning: You will need to re-define the MO classes"
   fi
   rm --recursive --force -- ${ezfio}/mo_basis
+  rm --recursive --force -- ${ezfio}/bi_ortho_mos
   rm --recursive --force -- ${ezfio}/work/mo_ints_*
 fi
 

bin/qp_test

@@ -60,19 +60,14 @@ def main(arguments):
         print("Running tests for %s"%(bats_file))
         print("")
         if arguments["-v"]:
-            p = None
             if arguments["TEST"]:
                 test = "export TEST=%s ; "%arguments["TEST"]
             else:
                 test = ""
-            try:
             os.system(test+" python3 bats_to_sh.py "+bats_file+
                                     "| bash")
-            except:
-                if p:
-                    p.terminate()
         else:
-            subprocess.check_call(["bats", bats_file], env=os.environ)
+            subprocess.check_call(["bats", "--verbose-run", "--trace", bats_file], env=os.environ)
 
 
 

codemeta.json

@@ -0,0 +1,66 @@
+{
+    "@context": "https://doi.org/10.5063/schema/codemeta-2.0",
+    "@type": "SoftwareSourceCode",
+    "license": "https://spdx.org/licenses/AGPL-3.0",
+    "codeRepository": "https://github.com/QuantumPackage/qp2",
+    "dateCreated": "2014-04-01",
+    "datePublished": "2019-06-11",
+    "dateModified": "2020-02-21",
+    "downloadUrl": "https://github.com/QuantumPackage/qp2/releases/tag/2.1.2",
+    "issueTracker": "https://github.com/QuantumPackage/qp2/issues",
+    "name": "Quantum Package",
+    "version": "2.1.2",
+    "identifier": "https://doi.org/10.5281/zenodo.3677565",
+    "description": "Programming environment for wave function methods",
+    "applicationCategory": "Quantum Chemistry",
+    "funding": "ERC_863481, CoE_952165",
+    "developmentStatus": "active",
+    "referencePublication": "https://doi.org/10.1021/acs.jctc.9b00176",
+    "funder": {
+        "@type": "Organization",
+        "name": "CNRS"
+    },
+    "keywords": [
+        "selected configuration interaction",
+        "CIPSI"
+    ],
+    "programmingLanguage": [
+        "Fortran",
+        "IRPF90",
+        "OCaml",
+        "Python",
+        "C"
+    ],
+    "operatingSystem": [
+        "Linux"
+    ],
+    "softwareRequirements": [
+        "ZeroMQ"
+    ],
+    "author": [
+        {
+            "@type": "Person",
+            "@id": "https://orcid.org/0000-0003-4955-7136",
+            "givenName": "Scemama",
+            "familyName": "Anthony",
+            "email": "scemama@irsamc.ups-tlse.fr",
+            "affiliation": {
+                "@type": "Organization",
+                "name": "Laboratoire de chimie et physique quantiques, Toulouse, CNRS"
+            }
+        }
+    ],
+    "contributor": [
+        {
+            "@type": "Person",
+            "givenName": "Emmanuel",
+            "familyName": "Giner",
+            "email": "eginer@lct.jussieu.fr",
+            "affiliation": {
+                "@type": "Organization",
+                "name": "Laboratoire de Chimie Theorique, Paris, CNRS"
+            }
+        }
+    ]
+}
+

config/bull.cfg

@@ -6,7 +6,7 @@
 # --align=32                 : Align all provided arrays on a 32-byte boundary
 #
 [COMMON]
-FC           : mpiifort -shared-libgcc -shared-intel -fpic
+FC           : mpiifort -fpic -xCORE-AVX2 
 LAPACK_LIB   : -mkl=parallel 
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DMPI  
@@ -31,7 +31,7 @@ OPENMP  : 1          ; Append OpenMP flags
 # -ftz                       : Flushes denormal results to zero
 #
 [OPT]
-FCFLAGS  : -xCORE-AVX2 -O2 -ip -ftz -g -traceback -qopt-prefetch=5 -qopt-prefetch-issue-excl-hint -unroll-aggressive 
+FCFLAGS  : -O2 -ip -ftz -g -traceback -qopt-prefetch=5 -qopt-prefetch-issue-excl-hint -unroll-aggressive 
 # Profiling flags
 #################
 #

config/cray_gfortran.cfg

@@ -0,0 +1,68 @@
+# On LUMI
+# 
+# export SPACK_USER_PREFIX=$HOME/spack
+# module swap PrgEnv-cray/8.3.3 PrgEnv-gnu/8.3.3
+# module load spack/22.08
+# module load openblas/0.3.17-gcc-omp-xi
+# 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
+LAPACK_LIB   : -L/appl/lumi/spack/22.08/0.18.1/opt/spack/openblas-0.3.17-xinceno/lib -lopenblas
+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 -march=native
+
+# 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/gfortran.cfg

@@ -10,7 +10,7 @@
 #
 #
 [COMMON]
-FC           : gfortran -g -ffree-line-length-none -I . -fPIC
+FC           : gfortran -g -ffree-line-length-none -I . -fPIC -march=native
 LAPACK_LIB   : -lblas -llapack
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED
@@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED
 # 0 : Deactivate
 #
 [OPTION]
-MODE    : DEBUG      ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
+MODE    : OPT        ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
 CACHE   : 0          ; Enable cache_compile.py
 OPENMP  : 1          ; Append OpenMP flags
 

config/gfortran_armpl.cfg

@@ -0,0 +1,65 @@
+# Common flags
+##############
+# module load arm
+# module load gnu
+# module load acfl
+#
+# -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 -g -ffree-line-length-none -I . -fPIC -march=native
+LAPACK_LIB   : -larmpl_lp64
+IRPF90       : irpf90
+IRPF90_FLAGS : --ninja --align=32 --assert -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
+
+# Profiling flags
+#################
+#
+[PROFILE]
+FC      : -p -g
+FCFLAGS : -Ofast
+
+# Debugging flags
+#################
+#
+# -fcheck=all  : Checks uninitialized variables,  array subscripts, etc...
+# -g           : Extra debugging information
+#
+[DEBUG]
+FCFLAGS : -g -march=native  -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized  -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
+
+# OpenMP flags
+#################
+#
+[OPENMP]
+FC           : -fopenmp
+IRPF90_FLAGS : --openmp
+

config/gfortran_openblas.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 -g -ffree-line-length-none -I . -fPIC -march=native
+LAPACK_LIB   : -lopenblas
+IRPF90       : irpf90
+IRPF90_FLAGS : --ninja --align=32 --assert -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
+
+# Profiling flags
+#################
+#
+[PROFILE]
+FC      : -p -g
+FCFLAGS : -Ofast
+
+# Debugging flags
+#################
+#
+# -fcheck=all  : Checks uninitialized variables,  array subscripts, etc...
+# -g           : Extra debugging information
+#
+[DEBUG]
+FCFLAGS : -g -march=native  -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized  -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
+
+# OpenMP flags
+#################
+#
+[OPENMP]
+FC           : -fopenmp
+IRPF90_FLAGS : --openmp
+

config/ifort_2019_avx.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : ifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel 
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
 

config/ifort_2019_avx_mpi.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : mpiifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_NESTED
 

config/ifort_2019_debug.cfg

@@ -0,0 +1,66 @@
+# Common flags
+##############
+#
+# -mkl=[parallel|sequential] : Use the MKL library
+# --ninja                 : Allow the utilisation of ninja. It is mandatory !
+# --align=32                 : Align all provided arrays on a 32-byte boundary
+#
+[COMMON]
+FC           : ifort -fpic
+LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+IRPF90       : irpf90
+IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL -DSET_NESTED
+
+# Global options
+################
+#
+# 1 : Activate
+# 0 : Deactivate
+# 
+[OPTION]
+MODE    : DEBUG      ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
+CACHE   : 0          ; Enable cache_compile.py
+OPENMP  : 1          ; Append OpenMP flags
+
+# Optimization flags
+####################
+#
+# -xHost                     : Compile a binary optimized for the current architecture
+# -O2                        : O3 not better than O2.
+# -ip                        : Inter-procedural optimizations
+# -ftz                       : Flushes denormal results to zero
+#
+[OPT]
+FC       : -traceback
+FCFLAGS  : -msse4.2 -O2 -ip -ftz -g 
+
+
+# Profiling flags
+#################
+#
+[PROFILE]
+FC       : -p -g
+FCFLAGS  : -msse4.2 -O2 -ip -ftz 
+
+
+# Debugging flags
+#################
+#
+# -traceback   : Activate backtrace on runtime
+# -fpe0        : All floating point exaceptions
+# -C           : Checks uninitialized variables,  array subscripts, etc...
+# -g           : Extra debugging information
+# -msse4.2     : Valgrind needs a very simple x86 executable
+#
+[DEBUG]
+FC      : -g -traceback
+FCFLAGS : -msse4.2 -check all -debug all -fpe-all=0  -implicitnone
+
+
+# OpenMP flags
+#################
+#
+[OPENMP]
+FC           : -qopenmp
+IRPF90_FLAGS : --openmp
+

config/ifort_2019_mpi_rome.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : mpiifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
 

config/ifort_2019_rome.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : ifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
 

config/ifort_2019_sse4.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : ifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED
 

config/ifort_2019_sse4_mpi.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : mpiifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_NESTED
 

config/ifort_2019_xHost.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : ifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=64 -DINTEL -DSET_NESTED
 

config/ifort_2021_avx.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : ifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DINTEL 
 

config/ifort_2021_avx_mpi.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : mpiifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL 
 

config/ifort_2021_mpi_rome.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : mpiifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DINTEL 
 

config/ifort_2021_rome.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : ifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DINTEL 
 

config/ifort_2021_sse4.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : ifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DINTEL 
 

config/ifort_2021_sse4_mpi.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : mpiifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL 
 

config/ifort_2021_xHost.cfg

@@ -7,7 +7,7 @@
 #
 [COMMON]
 FC           : ifort -fpic
-LAPACK_LIB   : -mkl=parallel -lirc -lsvml -limf -lipps
+LAPACK_LIB   : -mkl=parallel
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=64 -DINTEL 
 

configure

@@ -19,19 +19,9 @@ git submodule update
 # Update ARM or x86 dependencies
 ARCHITECTURE=$(uname -m)
 cd ${QP_ROOT}/external/qp2-dependencies
+git checkout master
+git pull
 echo "Architecture: $ARCHITECTURE"
-case $ARCHITECTURE in
-  aarch64)
-    git checkout arm64
-    ;;
-  x86_64) 
-    git checkout x86
-    ;;
-  *)
-    echo "Unknown architecture. Using x86_64."
-    git checkout x86
-    ;;
-esac
 cd ${QP_ROOT}
 
 
@@ -118,7 +108,7 @@ PACKAGES=$(echo $PACKAGES | xargs)
 
 echo "export QP_ROOT=\"$QP_ROOT\"" > ${QP_ROOT}/etc/00.qp_root.rc
 
-source quantum_package.rc
+source ${QP_ROOT}/quantum_package.rc
 
 
 
@@ -209,7 +199,7 @@ for PACKAGE in ${PACKAGES} ; do
 
             execute << EOF
               rm -f "\${QP_ROOT}"/bin/ninja
-              tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/ninja.tar.gz 
+              tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/${ARCHITECTURE}/ninja.tar.gz 
               mv ninja "\${QP_ROOT}"/bin/
 EOF
 
@@ -256,7 +246,7 @@ EOF
             source "${QP_ROOT}"/quantum_package.rc
             rm -rf "${QP_ROOT}"/external/opampack
             cd "${QP_ROOT}"/external/
-            tar --gunzip --extract --file qp2-dependencies/opampack.tar.gz
+            tar --gunzip --extract --file qp2-dependencies/${ARCHITECTURE}/opampack.tar.gz
             cd "${QP_ROOT}"/external/opampack
             ./install.sh
             export OPAMROOT="${QP_ROOT}"/external/opampack/opamroot
@@ -268,7 +258,7 @@ EOF
             execute << EOF
               cd "\${QP_ROOT}"/external
               tar --gunzip --extract --file qp2-dependencies/bse-v0.8.11.tar.gz
-              pip install -e basis_set_exchange-*
+              python3 -m pip install -e basis_set_exchange-*
 EOF
 
     elif [[ ${PACKAGE} = zlib ]] ; then
@@ -303,8 +293,8 @@ EOF
 
             execute << EOF
               cd "\${QP_ROOT}"/external
-              tar -zxf qp2-dependencies/bats-v1.1.0.tar.gz
+              tar -zxf qp2-dependencies/bats-v1.7.0.tar.gz
-              ( cd bats-core-1.1.0/ ; ./install.sh \${QP_ROOT})
+              ( cd bats-core-1.7.0/ ; ./install.sh \${QP_ROOT})
 EOF
 
     else
@@ -315,7 +305,7 @@ EOF
 
 done
 
-source quantum_package.rc
+source ${QP_ROOT}/quantum_package.rc
 
 NINJA=$(find_exe ninja)
 if [[ ${NINJA} = $(not_found) ]] ; then
@@ -416,7 +406,7 @@ else
       echo ""
       echo "${QP_ROOT}/build.ninja does not exist,"
       echo "you need to specify the COMPILATION configuration file."
-      echo "See  ./configure --help  for more details."
+      echo "See  ./configure -h  for more details."
       echo ""
 fi
 

data/basis/cc-pcvdz

@@ -991,4 +991,266 @@ D   1
 1         1.3743000              1.0000000
 D   1
 1         0.0537000              1.00000000
+
+COPPER
+S   20
+1         5.430321E+06           7.801026E-06
+2         8.131665E+05           6.065666E-05
+3         1.850544E+05           3.188964E-04
+4         5.241466E+04           1.344687E-03
+5         1.709868E+04           4.869050E-03
+6         6.171994E+03           1.561013E-02
+7         2.406481E+03           4.452077E-02
+8         9.972584E+02           1.103111E-01
+9         4.339289E+02           2.220342E-01
+10        1.962869E+02           3.133739E-01
+11        9.104280E+01           2.315121E-01
+12        4.138425E+01           7.640920E-02
+13        1.993278E+01           1.103818E-01
+14        9.581891E+00           1.094372E-01
+15        4.234516E+00           1.836311E-02
+16        1.985814E+00          -6.043084E-04
+17        8.670830E-01           5.092245E-05
+18        1.813390E-01          -5.540730E-05
+19        8.365700E-02           3.969482E-05
+20        3.626700E-02          -1.269538E-05
+S   20
+1         5.430321E+06          -4.404706E-06
+2         8.131665E+05          -3.424801E-05
+3         1.850544E+05          -1.801238E-04
+4         5.241466E+04          -7.600455E-04
+5         1.709868E+04          -2.759348E-03
+6         6.171994E+03          -8.900970E-03
+7         2.406481E+03          -2.579378E-02
+8         9.972584E+02          -6.623861E-02
+9         4.339289E+02          -1.445927E-01
+10        1.962869E+02          -2.440110E-01
+11        9.104280E+01          -2.504837E-01
+12        4.138425E+01           2.852577E-02
+13        1.993278E+01           5.115874E-01
+14        9.581891E+00           4.928061E-01
+15        4.234516E+00           8.788437E-02
+16        1.985814E+00          -5.820281E-03
+17        8.670830E-01           2.013508E-04
+18        1.813390E-01          -5.182553E-04
+19        8.365700E-02           3.731503E-04
+20        3.626700E-02          -1.193171E-04
+S   20
+1         5.430321E+06           9.704682E-07
+2         8.131665E+05           7.549245E-06
+3         1.850544E+05           3.968892E-05
+4         5.241466E+04           1.677200E-04
+5         1.709868E+04           6.095101E-04
+6         6.171994E+03           1.978846E-03
+7         2.406481E+03           5.798049E-03
+8         9.972584E+02           1.534158E-02
+9         4.339289E+02           3.540484E-02
+10        1.962869E+02           6.702098E-02
+11        9.104280E+01           8.026945E-02
+12        4.138425E+01          -1.927231E-02
+13        1.993278E+01          -3.160129E-01
+14        9.581891E+00          -4.573162E-01
+15        4.234516E+00           1.550841E-01
+16        1.985814E+00           7.202872E-01
+17        8.670830E-01           3.885122E-01
+18        1.813390E-01           1.924326E-02
+19        8.365700E-02          -7.103807E-03
+20        3.626700E-02           3.272906E-03
+S   20
+1         5.430321E+06          -1.959354E-07
+2         8.131665E+05          -1.523472E-06
+3         1.850544E+05          -8.014808E-06
+4         5.241466E+04          -3.383992E-05
+5         1.709868E+04          -1.231191E-04
+6         6.171994E+03          -3.992085E-04
+7         2.406481E+03          -1.171900E-03
+8         9.972584E+02          -3.096141E-03
+9         4.339289E+02          -7.171993E-03
+10        1.962869E+02          -1.356621E-02
+11        9.104280E+01          -1.643989E-02
+12        4.138425E+01           4.107628E-03
+13        1.993278E+01           6.693964E-02
+14        9.581891E+00           1.028221E-01
+15        4.234516E+00          -4.422945E-02
+16        1.985814E+00          -2.031191E-01
+17        8.670830E-01          -2.230022E-01
+18        1.813390E-01           2.517975E-01
+19        8.365700E-02           5.650091E-01
+20        3.626700E-02           3.247243E-01
+S   20
+1         5.430321E+06          -7.508267E-07
+2         8.131665E+05          -5.972018E-06
+3         1.850544E+05          -3.039682E-05
+4         5.241466E+04          -1.340405E-04
+5         1.709868E+04          -4.615778E-04
+6         6.171994E+03          -1.601064E-03
+7         2.406481E+03          -4.330942E-03
+8         9.972584E+02          -1.265434E-02
+9         4.339289E+02          -2.586864E-02
+10        1.962869E+02          -5.835428E-02
+11        9.104280E+01          -5.132322E-02
+12        4.138425E+01          -1.908953E-02
+13        1.993278E+01           3.586116E-01
+14        9.581891E+00           3.885818E-01
+15        4.234516E+00          -3.057106E-01
+16        1.985814E+00          -2.069896E+00
+17        8.670830E-01           2.431774E+00
+18        1.813390E-01          -2.121974E-02
+19        8.365700E-02          -1.820251E+00
+20        3.626700E-02           1.434585E+00
+S   20
+1         5.430321E+06          -3.532229E-07
+2         8.131665E+05          -2.798812E-06
+3         1.850544E+05          -1.432517E-05
+4         5.241466E+04          -6.270946E-05
+5         1.709868E+04          -2.179490E-04
+6         6.171994E+03          -7.474316E-04
+7         2.406481E+03          -2.049271E-03
+8         9.972584E+02          -5.885203E-03
+9         4.339289E+02          -1.226885E-02
+10        1.962869E+02          -2.683147E-02
+11        9.104280E+01          -2.479261E-02
+12        4.138425E+01          -5.984746E-03
+13        1.993278E+01           1.557124E-01
+14        9.581891E+00           1.436683E-01
+15        4.234516E+00           8.374103E-03
+16        1.985814E+00          -7.460711E-01
+17        8.670830E-01           1.244367E-01
+18        1.813390E-01           1.510110E+00
+19        8.365700E-02          -3.477122E-01
+20        3.626700E-02          -9.774169E-01
+S   1
+1         3.626700E-02           1.000000E+00
+S   1
+1         0.0157200              1.0000000
+P   16
+1         2.276057E+04           4.000000E-05
+2         5.387679E+03           3.610000E-04
+3         1.749945E+03           2.083000E-03
+4         6.696653E+02           9.197000E-03
+5         2.841948E+02           3.266000E-02
+6         1.296077E+02           9.379500E-02
+7         6.225415E+01           2.082740E-01
+8         3.092964E+01           3.339930E-01
+9         1.575827E+01           3.324930E-01
+10        8.094211E+00           1.547280E-01
+11        4.046921E+00           2.127100E-02
+12        1.967869E+00          -1.690000E-03
+13        9.252950E-01          -1.516000E-03
+14        3.529920E-01          -2.420000E-04
+15        1.273070E-01           2.300000E-05
+16        4.435600E-02          -9.000000E-06
+P   16
+1         2.276057E+04          -1.500000E-05
+2         5.387679E+03          -1.310000E-04
+3         1.749945E+03          -7.550000E-04
+4         6.696653E+02          -3.359000E-03
+5         2.841948E+02          -1.208100E-02
+6         1.296077E+02          -3.570300E-02
+7         6.225415E+01          -8.250200E-02
+8         3.092964E+01          -1.398900E-01
+9         1.575827E+01          -1.407290E-01
+10        8.094211E+00           3.876600E-02
+11        4.046921E+00           3.426950E-01
+12        1.967869E+00           4.523100E-01
+13        9.252950E-01           2.770540E-01
+14        3.529920E-01           4.388500E-02
+15        1.273070E-01          -2.802000E-03
+16        4.435600E-02           1.152000E-03
+P   16
+1         2.276057E+04           5.000000E-06
+2         5.387679E+03           4.900000E-05
+3         1.749945E+03           2.780000E-04
+4         6.696653E+02           1.253000E-03
+5         2.841948E+02           4.447000E-03
+6         1.296077E+02           1.337000E-02
+7         6.225415E+01           3.046900E-02
+8         3.092964E+01           5.344700E-02
+9         1.575827E+01           5.263900E-02
+10        8.094211E+00          -1.688100E-02
+11        4.046921E+00          -1.794480E-01
+12        1.967869E+00          -2.095880E-01
+13        9.252950E-01          -3.963300E-02
+14        3.529920E-01           5.021300E-01
+15        1.273070E-01           5.811110E-01
+16        4.435600E-02           4.566600E-02
+P   16
+1         2.276057E+04           1.100000E-05
+2         5.387679E+03           9.600000E-05
+3         1.749945E+03           5.900000E-04
+4         6.696653E+02           2.484000E-03
+5         2.841948E+02           9.463000E-03
+6         1.296077E+02           2.645300E-02
+7         6.225415E+01           6.568900E-02
+8         3.092964E+01           1.027320E-01
+9         1.575827E+01           1.370410E-01
+10        8.094211E+00          -7.096100E-02
+11        4.046921E+00          -5.047080E-01
+12        1.967869E+00          -4.780560E-01
+13        9.252950E-01           9.428920E-01
+14        3.529920E-01           5.446990E-01
+15        1.273070E-01          -8.327660E-01
+16        4.435600E-02          -1.084160E-01
+P   16
+1         2.276057E+04           3.000000E-06
+2         5.387679E+03           2.500000E-05
+3         1.749945E+03           1.470000E-04
+4         6.696653E+02           6.560000E-04
+5         2.841948E+02           2.351000E-03
+6         1.296077E+02           7.004000E-03
+7         6.225415E+01           1.613100E-02
+8         3.092964E+01           2.777000E-02
+9         1.575827E+01           2.756700E-02
+10        8.094211E+00          -1.011500E-02
+11        4.046921E+00          -8.100900E-02
+12        1.967869E+00          -1.104090E-01
+13        9.252950E-01          -7.173200E-02
+14        3.529920E-01           1.879300E-01
+15        1.273070E-01           5.646290E-01
+16        4.435600E-02           4.070000E-01
+P   1
+1         4.435600E-02           1.000000E+00
+P   1
+1         0.0154500              1.0000000
+D   8
+1         1.738970E+02           2.700000E-03
+2         5.188690E+01           2.090900E-02
+3         1.934190E+01           8.440800E-02
+4         7.975720E+00           2.139990E-01
+5         3.398230E+00           3.359800E-01
+6         1.409320E+00           3.573010E-01
+7         5.488580E-01           2.645780E-01
+8         1.901990E-01           1.039720E-01
+D   8
+1         1.738970E+02          -3.363000E-03
+2         5.188690E+01          -2.607900E-02
+3         1.934190E+01          -1.082310E-01
+4         7.975720E+00          -2.822170E-01
+5         3.398230E+00          -3.471900E-01
+6         1.409320E+00           2.671100E-02
+7         5.488580E-01           4.920470E-01
+8         1.901990E-01           4.384220E-01
+D   8
+1         1.738970E+02           4.133000E-03
+2         5.188690E+01           3.308500E-02
+3         1.934190E+01           1.383360E-01
+4         7.975720E+00           3.901660E-01
+5         3.398230E+00           1.698420E-01
+6         1.409320E+00          -6.830180E-01
+7         5.488580E-01          -2.657970E-01
+8         1.901990E-01           8.380630E-01
+D   1
+1         1.901990E-01           1.000000E+00
+D   1
+1         0.0659100              1.0000000
+F   1
+1         5.082100E+00           1.000000E+00
+F   1
+1         1.279700E+00           1.000000E+00
+F   1
+1         0.4617200              1.0000000
+G   1
+1         3.483500E+00           1.0000000
+G   1
+1         1.4597900              1.0000000
 $END

external/.gitignore

@@ -1,2 +1,2 @@
-#*
+*
 

external/qp2-dependencies

@@ -1 +1 @@
-Subproject commit b8cd5815bce14c9b880e3c5ea3d5fc2652f5955c
+Subproject commit ce14f57b50511825a9fedb096749200779d3f4d4

include/.gitignore

@@ -1,7 +1 @@
-zmq.h
+*
-gmp.h
-zconf.h
-zconf.h
-zlib.h
-zmq_utils.h
-f77_zmq_free.h

ocaml/Makefile

@@ -43,7 +43,7 @@ $(QP_ROOT)/data/executables: remake_executables element_create_db.byte Qptypes.m
 	$(QP_ROOT)/ocaml/element_create_db.byte
 
 external_libs:
-	opam install cryptokit sexplib
+	opam install sexplib
 
 qpackage.odocl: $(MLIFILES)
 	ls $(MLIFILES) | sed "s/\.mli//" > qpackage.odocl

ocaml/To_md5.ml

@@ -4,8 +4,8 @@ open Sexplib
 let to_md5 sexp_of_t t =
   sexp_of_t t
   |> Sexp.to_string
-  |> Cryptokit.hash_string (Cryptokit.Hash.md5 ())
+  |> Digest.string 
-  |> Cryptokit.transform_string (Cryptokit.Hexa.encode ())
+  |> Digest.to_hex
   |> MD5.of_string
 ;;
 

ocaml/_tags

@@ -1,4 +1,4 @@
-true: package(cryptokit,zarith,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt)
+true: package(zarith,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt)
 true: thread
 false: profile
 <*byte>   : linkdep(c_bindings.o), custom

scripts/.gitignore

@@ -2,3 +2,6 @@
 *.pyo
 docopt.py
 resultsFile/
+verif_omp/a.out
+src/*/Makefile
+src/*/*/

scripts/compilation/qp_create_ninja

@@ -99,9 +99,20 @@ def ninja_create_env_variable(pwd_config_file):
     l_string = ["builddir = {0}".format(os.path.dirname(ROOT_BUILD_NINJA)),
                 ""]
 
+
     for flag in ["FC", "FCFLAGS", "IRPF90", "IRPF90_FLAGS"]:
         str_ = "{0} = {1}".format(flag, get_compilation_option(pwd_config_file,
                                                                flag))
+        for directory in [real_join(QP_SRC, m) for m in sorted(os.listdir(QP_SRC))]:
+            includefile = real_join(directory, flag)
+            try:
+                content = ""
+                with open(includefile,'r') as f:
+                    content = f.read()
+                    str_ += " "+content
+            except IOError:
+                pass
+
         l_string.append(str_)
 
     lib_lapack = get_compilation_option(pwd_config_file, "LAPACK_LIB")
@@ -110,17 +121,20 @@ def ninja_create_env_variable(pwd_config_file):
     str_lib = " ".join([lib_lapack, EZFIO_LIB, ZMQ_LIB, LIB, lib_usr])
 
     # Read all LIB files in modules
-    libfile = "LIB"
+    for directory in [real_join(QP_SRC, m) for m in sorted(os.listdir(QP_SRC))]:
+        libfile = real_join(directory, "LIB")
         try:
             content = ""
             with open(libfile,'r') as f:
-            content = f.read()
+                content = f.read().replace('\n','')
                 str_lib += " "+content
         except IOError:
             pass
 
     l_string.append("LIB = {0} ".format(str_lib))
 
+
+    l_string.append("CONFIG_FILE = {0}".format(pwd_config_file))
     l_string.append("")
 
     return l_string

scripts/ezfio_interface/ezfio_generate_provider.py

@@ -52,7 +52,7 @@ BEGIN_PROVIDER [ %(type)s, %(name)s %(size)s ]
     %(test_null_size)s
     call ezfio_has_%(ezfio_dir)s_%(ezfio_name)s(has)
     if (has) then
-      write(6,'(A)') '.. >>>>> [ IO READ: %(name)s ] <<<<< ..'
+!      write(6,'(A)') '.. >>>>> [ IO READ: %(name)s ] <<<<< ..'
       call ezfio_get_%(ezfio_dir)s_%(ezfio_name)s(%(name)s)
     else
       print *, '%(ezfio_dir)s/%(ezfio_name)s not found in EZFIO file'
@@ -117,7 +117,7 @@ END_PROVIDER
         output = self.output
         name = self.name
         l_write = ["",
-                   "  call write_time(%(output)s)",
+                   "!  call write_time(%(output)s)",
                    ""]
 
         self.write = "\n".join(l_write) % locals()
@@ -129,7 +129,7 @@ END_PROVIDER
                 write = self.write_correspondance[self.type]
 
                 l_write = ["",
-                          "  call write_time(%(output)s)",
+                          "!  call write_time(%(output)s)",
                           "  call %(write)s(%(output)s, %(name)s, &",
                           "     '%(name)s')",
                           ""]

scripts/get_fci_conv.sh

@@ -0,0 +1,7 @@
+file=$1
+grep "N_det             =" $1 | cut -d "=" -f 2 > N_det_tmp
+grep "E               =" $file | cut -d "=" -f 2 > E_tmp
+grep "E+PT2           =" $file | cut -d "=" -f 2 | cut -d "+" -f 1 > E+PT2_tmp
+grep "E+rPT2          =" $file | cut -d "=" -f 2 | cut -d "+" -f 1 > E+rPT2_tmp
+paste N_det_tmp E_tmp E+PT2_tmp E+rPT2_tmp | column -s ' ' -t > $file.conv_fci
+rm N_det_tmp E_tmp E+PT2_tmp E+rPT2_tmp

scripts/qp_extract_cipsi_data.py

@@ -0,0 +1,54 @@
+#!/usr/bin/env python3
+
+import re
+import sys
+
+# Read output file
+with open(sys.argv[1], 'r') as file:
+  output = file.read()
+
+
+def extract_data(output):
+    lines = output.split("\n")
+    data = []
+
+    n_det = None
+    e = None
+    pt2 = None
+    err_pt2 = None
+    rpt2 = None
+    err_rpt2 = None
+    e_ex = None
+
+
+    reading = False
+    for iline, line in enumerate(lines):
+        if not reading and line.startswith(" N_det "):
+            n_det = int(re.search(r"N_det\s+=\s+(\d+)", line).group(1))
+            reading = True
+
+        if reading:
+            if line.startswith(" E "):
+                e = float(re.search(r"E\s+=\s+(-?\d+\.\d+)", line).group(1))
+            elif line.startswith(" PT2 "):
+                pt2 = float(re.search(r"PT2\s+=\s+(-?\d+\.\d+E?.\d*)", line).group(1))
+                err_pt2 = float(re.search(r"\+/-\s+(-?\d+\.\d+E?.\d*)", line).group(1))
+            elif line.startswith(" rPT2 "):
+                rpt2 = float(re.search(r"rPT2\s+=\s+(-?\d+\.\d+E?.\d*)", line).group(1))
+                err_rpt2 = float(re.search(r"\+/-\s+(-?\d+\.\d+E?.\d*)", line).group(1))
+            elif "minimum PT2 Extrapolated energy" in line:
+                e_ex_line = lines[iline+2]
+                e_ex = float(e_ex_line.split()[1])
+                reading = False
+
+                data.append((n_det, e, pt2, err_pt2, rpt2, err_rpt2, e_ex))
+                n_det = e = pt2 = err_pt2 = rpt2 = err_rpt2 = e_ex = None
+
+    return data
+
+data = extract_data(output)
+
+for item in data:
+    print(" ".join(str(x) for x in item))
+
+

scripts/script_fci_tc.sh

@@ -0,0 +1,33 @@
+ source ~/qp2/quantum_package.rc  
+ alpha=1.8
+ input=O
+ basis=cc-pvdz
+ mult=3
+ output=${input}_${basis}_al_${alpha}
+ qp create_ezfio -b ${basis} ${input}.xyz -m $mult
+ qp run scf 
+ qp set perturbation pt2_max 0.0001
+ qp set_frozen_core 
+
+########## FCI CALCULATION FOR REFERENCE 
+ qp run fci | tee ${EZFIO_FILE}.fci.out
+ qp run sort_wf 
+ mv ${EZFIO_FILE}.wf_sorted ${EZFIO_FILE}_fci.wf_sorted
+########### TC SCF CALCULATION
+ qp reset -d 
+ qp set ao_two_e_erf_ints mu_erf 0.87 
+ qp set tc_keywords j1b_type 3
+ qp set tc_keywords j1b_pen "[${alpha}]"
+ qp set tc_keywords bi_ortho True 
+ qp set tc_keywords test_cycle_tc True
+ qp set tc_keywords write_tc_integ True
+ qp set tc_keywords read_tc_integ False
+ qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out
+ qp set tc_keywords write_tc_integ False
+ qp set tc_keywords read_tc_integ True
+############ TC-FCI CALCULATION
+ qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi_ortho.out
+ grep "Ndet,E,E+PT2,E+RPT2,|PT2|=" ${EZFIO_FILE}.fci_tc_bi_ortho.out | cut -d "=" -f 2 > data_al_$alpha
+ qp run sort_wf 
+ mv ${EZFIO_FILE}.wf_sorted ${EZFIO_FILE}_tc_fci.wf_sorted
+ 

src/.gitignore

@@ -0,0 +1,11 @@
+*
+!README.rst
+!*/
+*/*
+!*/*.*
+*/*.o
+*/build.ninja
+*/ezfio_interface.irp.f
+*/.gitignore
+*/*.swp
+

src/ao_many_one_e_ints/NEED

@@ -0,0 +1,5 @@
+ao_one_e_ints
+ao_two_e_ints
+becke_numerical_grid
+mo_one_e_ints
+dft_utils_in_r

src/ao_many_one_e_ints/README.rst

@@ -0,0 +1,25 @@
+==================
+ao_many_one_e_ints
+==================
+
+This module contains A LOT of one-electron integrals of the type 
+A_ij( r ) = \int dr' phi_i(r') w(r,r') phi_j(r') 
+where r is a point in real space. 
+
++) ao_gaus_gauss.irp.f: w(r,r') is a exp(-(r-r')^2)  , and can be multiplied by x/y/z
++) ao_erf_gauss.irp.f : w(r,r') is a exp(-(r-r')^2) erf(mu * |r-r'|)/|r-r'| , and can be multiplied by x/y/z
++) ao_erf_gauss_grad.irp.f: w(r,r') is a exp(-(r-r')^2) erf(mu * |r-r'|)/|r-r'| , and can be multiplied by x/y/z, but evaluated with also one gradient of an AO function. 
+
+Fit of a Slater function and corresponding integrals
+----------------------------------------------------
+The file fit_slat_gauss.irp.f contains many useful providers/routines to fit a Slater function with 20 gaussian. 
++) coef_fit_slat_gauss : coefficients of the gaussians to fit e^(-x)
++) expo_fit_slat_gauss : exponents of the gaussians to fit e^(-x)
+
+Integrals involving Slater functions : stg_gauss_int.irp.f
+
+Taylor expansion of full correlation factor
+-------------------------------------------
+In taylor_exp.irp.f you might find interesting integrals of the type 
+\int dr' exp( e^{-alpha |r-r|' - beta |r-r'|^2}) phi_i(r') phi_j(r') 
+evaluated as a Taylor expansion of the exponential. 

src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f

@@ -0,0 +1,150 @@
+subroutine phi_j_erf_mu_r_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
+ implicit none
+ BEGIN_DOC
+! dxyz_ints(1/2/3) = int dr phi_i(r) [erf(mu  |r - C|)/|r-C|]  d/d(x/y/z) phi_i(r)
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: dxyz_ints(3)
+ integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf,coef,thr
+ integer :: n_pt_in,l,m,mm
+ thr = 1.d-12
+ dxyz_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.thr)then
+  return
+ endif
+
+ n_pt_in = n_pt_max_integrals
+ ! j 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i 
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_normalized_ordered_transp(m,i) 
+    if(dabs(coef).lt.thr)cycle
+    do mm = 1, 3
+     ! (d/dx phi_i ) * phi_j 
+     ! d/dx * (x - B_x)^b_x exp(-beta * (x -B_x)^2)= [b_x * (x - B_x)^(b_x - 1) - 2 beta * (x - B_x)^(b_x + 1)] exp(-beta * (x -B_x)^2)
+     !
+     ! first contribution :: b_x (x - B_x)^(b_x-1) :: integral with b_x=>b_x-1 multiplied by b_x
+     power_B_tmp = power_B
+     power_B_tmp(mm) += -1
+     contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+     dxyz_ints(mm) += contrib * dble(power_B(mm)) * coef 
+                                                  
+     ! second contribution ::  - 2 beta * (x - B_x)^(b_x + 1) :: integral with b_x=> b_x+1 multiplied by -2 * beta
+     power_B_tmp = power_B
+     power_B_tmp(mm) += 1
+     contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+     dxyz_ints(mm) += contrib * (-2.d0 * beta )  * coef 
+                                                 
+    enddo
+  enddo
+ enddo
+end
+
+
+
+
+subroutine phi_j_erf_mu_r_dxyz_phi_bis(i,j,mu_in, C_center, dxyz_ints)
+ implicit none
+ BEGIN_DOC
+! dxyz_ints(1/2/3) = int dr phi_j(r) [erf(mu  |r - C|)/|r-C|]  d/d(x/y/z) phi_i(r)
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: dxyz_ints(3)
+ integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
+ double precision :: thr, coef
+ integer :: n_pt_in,l,m,mm,kk
+ thr = 1.d-12
+ dxyz_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.thr)then
+  return
+ endif
+
+ n_pt_in = n_pt_max_integrals
+ ! j == A 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i == B
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ dxyz_ints = 0.d0
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    do kk = 1, 2 ! loop over the extra terms induced by the d/dx/y/z * AO(i)
+     do mm = 1, 3
+      power_B_tmp = power_B
+      power_B_tmp(mm) = power_ord_grad_transp(kk,mm,i)
+      coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_ord_grad_transp(kk,mm,m,i) 
+      if(dabs(coef).lt.thr)cycle
+      contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+      dxyz_ints(mm) += contrib * coef 
+     enddo
+    enddo
+  enddo
+ enddo
+end
+
+subroutine phi_j_erf_mu_r_xyz_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
+ implicit none
+ BEGIN_DOC
+! dxyz_ints(1/2/3) = int dr phi_j(r) x/y/z [erf(mu  |r - C|)/|r-C|]  d/d(x/y/z) phi_i(r)
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: dxyz_ints(3)
+ integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
+ double precision :: thr, coef
+ integer :: n_pt_in,l,m,mm,kk
+ thr = 1.d-12
+ dxyz_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.thr)then
+  return
+ endif
+
+ n_pt_in = n_pt_max_integrals
+ ! j == A 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i == B
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ dxyz_ints = 0.d0
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    do kk = 1, 4 ! loop over the extra terms induced by the x/y/z * d dx/y/z AO(i)
+     do mm = 1, 3
+      power_B_tmp = power_B
+      power_B_tmp(mm) = power_ord_xyz_grad_transp(kk,mm,i)
+      coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_ord_xyz_grad_transp(kk,mm,m,i) 
+      if(dabs(coef).lt.thr)cycle
+      contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+      dxyz_ints(mm) += contrib * coef 
+     enddo
+    enddo
+  enddo
+ enddo
+end

src/ao_many_one_e_ints/ao_gaus_gauss.irp.f

@@ -0,0 +1,426 @@
+! ---
+
+subroutine overlap_gauss_xyz_r12_ao(D_center,delta,i,j,gauss_ints)
+
+ implicit none
+ BEGIN_DOC
+! gauss_ints(m) = \int dr AO_i(r) AO_j(r) x/y/z e^{-delta |r-D_center|^2}
+!
+! with m == 1 ==> x, m == 2 ==> y, m == 3 ==> z
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in)  :: D_center(3), delta
+ double precision, intent(out) :: gauss_ints(3)
+
+ integer :: num_a,num_b,power_A(3), power_B(3),l,k,m
+ double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,gauss_ints_tmp(3)
+ gauss_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ num_A = ao_nucl(i)
+ power_A(1:3)= ao_power(i,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ num_B = ao_nucl(j)
+ power_B(1:3)= ao_power(j,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+ do l=1,ao_prim_num(i)
+  alpha = ao_expo_ordered_transp(l,i)
+  do k=1,ao_prim_num(j)
+   beta = ao_expo_ordered_transp(k,j)
+   call overlap_gauss_xyz_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,gauss_ints_tmp)
+   do m = 1, 3
+    gauss_ints(m) += gauss_ints_tmp(m) *  ao_coef_normalized_ordered_transp(l,i)             &
+                                       *  ao_coef_normalized_ordered_transp(k,j)
+   enddo
+  enddo
+ enddo
+
+end
+
+
+
+double precision function overlap_gauss_xyz_r12_ao_specific(D_center,delta,i,j,mx)
+ implicit none
+ BEGIN_DOC
+! \int dr AO_i(r) AO_j(r) x/y/z e^{-delta |r-D_center|^2}
+!
+! with mx == 1 ==> x, mx == 2 ==> y, mx == 3 ==> z
+ END_DOC
+ integer, intent(in) :: i,j,mx
+ double precision, intent(in)  :: D_center(3), delta
+
+ integer :: num_a,num_b,power_A(3), power_B(3),l,k
+ double precision :: gauss_int
+ double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta
+ double precision :: overlap_gauss_xyz_r12_specific
+ overlap_gauss_xyz_r12_ao_specific = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ num_A = ao_nucl(i)
+ power_A(1:3)= ao_power(i,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ num_B = ao_nucl(j)
+ power_B(1:3)= ao_power(j,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+ do l=1,ao_prim_num(i)
+  alpha = ao_expo_ordered_transp(l,i)
+  do k=1,ao_prim_num(j)
+   beta = ao_expo_ordered_transp(k,j)
+   gauss_int = overlap_gauss_xyz_r12_specific(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,mx)
+   overlap_gauss_xyz_r12_ao_specific = gauss_int *  ao_coef_normalized_ordered_transp(l,i)             &
+                                                 *  ao_coef_normalized_ordered_transp(k,j)
+  enddo
+ enddo
+end
+
+
+subroutine overlap_gauss_r12_all_ao(D_center,delta,aos_ints)
+ implicit none
+ double precision, intent(in) :: D_center(3), delta
+ double precision, intent(out):: aos_ints(ao_num,ao_num)
+
+ integer :: num_a,num_b,power_A(3), power_B(3),l,k,i,j
+ double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,analytical_j
+ aos_ints = 0.d0
+ do i = 1, ao_num
+  do j = 1, ao_num
+   if(ao_overlap_abs(j,i).lt.1.d-12)cycle
+   num_A = ao_nucl(i)
+   power_A(1:3)= ao_power(i,1:3)
+   A_center(1:3) = nucl_coord(num_A,1:3)
+   num_B = ao_nucl(j)
+   power_B(1:3)= ao_power(j,1:3)
+   B_center(1:3) = nucl_coord(num_B,1:3)
+   do l=1,ao_prim_num(i)
+    alpha = ao_expo_ordered_transp(l,i)
+    do k=1,ao_prim_num(j)
+     beta = ao_expo_ordered_transp(k,j)
+     analytical_j = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
+     aos_ints(j,i) += analytical_j *  ao_coef_normalized_ordered_transp(l,i)             &
+                                   *  ao_coef_normalized_ordered_transp(k,j)
+    enddo
+   enddo
+  enddo
+ enddo
+end
+
+! ---
+
+! TODO :: PUT CYCLES IN LOOPS
+double precision function overlap_gauss_r12_ao(D_center, delta, i, j)
+
+  BEGIN_DOC
+  ! \int dr AO_i(r) AO_j(r) e^{-delta |r-D_center|^2}
+  END_DOC
+
+  implicit none
+  integer,          intent(in) :: i, j
+  double precision, intent(in) :: D_center(3), delta
+
+  integer                      :: power_A(3), power_B(3), l, k
+  double precision             :: A_center(3), B_center(3), alpha, beta, coef, coef1, analytical_j
+
+  double precision, external   :: overlap_gauss_r12
+
+  overlap_gauss_r12_ao = 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
+
+      analytical_j = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta)
+
+      overlap_gauss_r12_ao += coef * analytical_j
+    enddo
+  enddo
+
+end function overlap_gauss_r12_ao
+
+! --
+
+double precision function overlap_abs_gauss_r12_ao(D_center, delta, i, j)
+
+  BEGIN_DOC
+  ! \int dr AO_i(r) AO_j(r) e^{-delta |r-D_center|^2}
+  END_DOC
+
+  implicit none
+  integer,          intent(in) :: i, j
+  double precision, intent(in) :: D_center(3), delta
+
+  integer                      :: power_A(3), power_B(3), l, k
+  double precision             :: A_center(3), B_center(3), alpha, beta, coef, coef1, analytical_j
+
+  double precision, external   :: overlap_abs_gauss_r12
+
+  overlap_abs_gauss_r12_ao = 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
+
+      analytical_j = overlap_abs_gauss_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta)
+
+      overlap_abs_gauss_r12_ao += dabs(coef * analytical_j)
+    enddo
+  enddo
+
+end function overlap_gauss_r12_ao
+
+! --
+
+subroutine overlap_gauss_r12_ao_v(D_center, LD_D, delta, i, j, resv, LD_resv, n_points)
+
+  BEGIN_DOC
+  !
+  ! \int dr AO_i(r) AO_j(r) e^{-delta |r-D_center|^2}
+  !
+  ! n_points: nb of integrals <= min(LD_D, LD_resv)
+  !
+  END_DOC
+
+  implicit none
+  integer,          intent(in)  :: i, j, LD_D, LD_resv, n_points
+  double precision, intent(in)  :: D_center(LD_D,3), delta
+  double precision, intent(out) :: resv(LD_resv)
+
+  integer                       :: ipoint
+  integer                       :: power_A(3), power_B(3), l, k
+  double precision              :: A_center(3), B_center(3), alpha, beta, coef, coef1 
+  double precision, allocatable :: analytical_j(:)
+
+  resv(:) = 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)
+
+  allocate(analytical_j(n_points))
+
+  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
+
+      call overlap_gauss_r12_v(D_center, LD_D, delta, A_center, B_center, power_A, power_B, alpha, beta, analytical_j, n_points, n_points)
+
+      do ipoint = 1, n_points
+        resv(ipoint) = resv(ipoint) + coef * analytical_j(ipoint)
+      enddo
+
+    enddo
+  enddo
+
+  deallocate(analytical_j)
+
+end subroutine overlap_gauss_r12_ao_v
+
+! ---
+
+double precision function overlap_gauss_r12_ao_with1s(B_center, beta, D_center, delta, i, j)
+
+  BEGIN_DOC
+  !
+  ! \int dr AO_i(r) AO_j(r) e^{-beta |r-B_center^2|} e^{-delta |r-D_center|^2}
+  !
+  END_DOC
+
+  implicit none
+  integer,          intent(in) :: i, j
+  double precision, intent(in) :: B_center(3), beta, D_center(3), delta
+
+  integer                      :: power_A1(3), power_A2(3), l, k
+  double precision             :: A1_center(3), A2_center(3), alpha1, alpha2, coef1, coef12, analytical_j
+  double precision             :: G_center(3), gama, fact_g, gama_inv
+
+  double precision, external   :: overlap_gauss_r12, overlap_gauss_r12_ao
+
+  if(beta .lt. 1d-10) then
+    overlap_gauss_r12_ao_with1s = overlap_gauss_r12_ao(D_center, delta, i, j)
+    return
+  endif
+
+  overlap_gauss_r12_ao_with1s = 0.d0
+
+  if(ao_overlap_abs(j,i) .lt. 1.d-12) then
+    return
+  endif
+
+  ! e^{-beta |r-B_center^2|} e^{-delta |r-D_center|^2} = fact_g e^{-gama |r - G|^2}
+
+  gama        = beta + delta
+  gama_inv    = 1.d0 / gama
+  G_center(1) = (beta * B_center(1) + delta * D_center(1)) * gama_inv
+  G_center(2) = (beta * B_center(2) + delta * D_center(2)) * gama_inv
+  G_center(3) = (beta * B_center(3) + delta * D_center(3)) * gama_inv
+  fact_g      = beta * delta * gama_inv * ( (B_center(1) - D_center(1)) * (B_center(1) - D_center(1)) &
+                                          + (B_center(2) - D_center(2)) * (B_center(2) - D_center(2)) &
+                                          + (B_center(3) - D_center(3)) * (B_center(3) - D_center(3)) )
+  if(fact_g .gt. 10d0) return
+  fact_g = dexp(-fact_g)
+
+  ! ---
+
+  power_A1(1:3) = ao_power(i,1:3)
+  power_A2(1:3) = ao_power(j,1:3)
+
+  A1_center(1:3) = nucl_coord(ao_nucl(i),1:3)
+  A2_center(1:3) = nucl_coord(ao_nucl(j),1:3)
+
+  do l = 1, ao_prim_num(i)
+    alpha1 = ao_expo_ordered_transp                    (l,i)
+    coef1  = fact_g * ao_coef_normalized_ordered_transp(l,i)
+    if(dabs(coef1) .lt. 1d-12) cycle
+
+    do k = 1, ao_prim_num(j)
+      alpha2 = ao_expo_ordered_transp                   (k,j)
+      coef12 = coef1 * ao_coef_normalized_ordered_transp(k,j)
+      if(dabs(coef12) .lt. 1d-12) cycle
+
+      analytical_j = overlap_gauss_r12(G_center, gama, A1_center, A2_center, power_A1, power_A2, alpha1, alpha2)
+
+      overlap_gauss_r12_ao_with1s += coef12 * analytical_j
+    enddo
+  enddo
+
+end function overlap_gauss_r12_ao_with1s
+
+! ---
+
+subroutine overlap_gauss_r12_ao_with1s_v(B_center, beta, D_center, LD_D, delta, i, j, resv, LD_resv, n_points)
+
+  BEGIN_DOC
+  !
+  ! \int dr AO_i(r) AO_j(r) e^{-beta |r-B_center^2|} e^{-delta |r-D_center|^2}
+  ! using an array of D_centers.
+  !
+  END_DOC
+
+  implicit none
+  integer,          intent(in)  :: i, j, n_points, LD_D, LD_resv
+  double precision, intent(in)  :: B_center(3), beta, D_center(LD_D,3), delta
+  double precision, intent(out) :: resv(LD_resv)
+
+  integer                       :: ipoint
+  integer                       :: power_A1(3), power_A2(3), l, k
+  double precision              :: A1_center(3), A2_center(3), alpha1, alpha2, coef1
+  double precision              :: coef12, coef12f
+  double precision              :: gama, gama_inv
+  double precision              :: bg, dg, bdg
+  double precision, allocatable :: fact_g(:), G_center(:,:), analytical_j(:)
+
+  if(ao_overlap_abs(j,i) .lt. 1.d-12) then
+    return
+  endif
+
+  ASSERT(beta .gt. 0.d0)
+
+  if(beta .lt. 1d-10) then
+    call overlap_gauss_r12_ao_v(D_center, LD_D, delta, i, j, resv, LD_resv, n_points)
+    return
+  endif
+
+  resv(:) = 0.d0
+
+  ! e^{-beta |r-B_center^2|} e^{-delta |r-D_center|^2} = fact_g e^{-gama |r - G|^2}
+
+  gama     = beta + delta
+  gama_inv = 1.d0 / gama
+
+  power_A1(1:3) = ao_power(i,1:3)
+  power_A2(1:3) = ao_power(j,1:3)
+
+  A1_center(1:3) = nucl_coord(ao_nucl(i),1:3)
+  A2_center(1:3) = nucl_coord(ao_nucl(j),1:3)
+
+  allocate(fact_g(n_points), G_center(n_points,3), analytical_j(n_points))
+
+  bg  = beta  * gama_inv
+  dg  = delta * gama_inv
+  bdg = bg * delta 
+
+  do ipoint = 1, n_points
+
+    G_center(ipoint,1) = bg * B_center(1) + dg * D_center(ipoint,1)
+    G_center(ipoint,2) = bg * B_center(2) + dg * D_center(ipoint,2)
+    G_center(ipoint,3) = bg * B_center(3) + dg * D_center(ipoint,3)
+    fact_g(ipoint) = bdg * ( (B_center(1) - D_center(ipoint,1)) * (B_center(1) - D_center(ipoint,1)) &
+                           + (B_center(2) - D_center(ipoint,2)) * (B_center(2) - D_center(ipoint,2)) &
+                           + (B_center(3) - D_center(ipoint,3)) * (B_center(3) - D_center(ipoint,3)) )
+
+    if(fact_g(ipoint) < 10d0) then
+      fact_g(ipoint) = dexp(-fact_g(ipoint))
+    else
+      fact_g(ipoint) = 0.d0
+    endif
+
+  enddo
+
+  do l = 1, ao_prim_num(i)
+    alpha1 = ao_expo_ordered_transp           (l,i)
+    coef1  = ao_coef_normalized_ordered_transp(l,i)
+
+    do k = 1, ao_prim_num(j)
+      alpha2 = ao_expo_ordered_transp                   (k,j)
+      coef12 = coef1 * ao_coef_normalized_ordered_transp(k,j)
+      if(dabs(coef12) .lt. 1d-12) cycle
+
+      call overlap_gauss_r12_v(G_center, n_points, gama, A1_center, A2_center, power_A1, power_A2, alpha1, alpha2, analytical_j, n_points, n_points)
+
+      do ipoint = 1, n_points
+        coef12f = coef12 * fact_g(ipoint)
+        resv(ipoint) += coef12f * analytical_j(ipoint)
+      enddo
+    enddo
+  enddo
+
+  deallocate(fact_g, G_center, analytical_j)
+
+end subroutine overlap_gauss_r12_ao_with1s_v
+
+! ---
+

src/ao_many_one_e_ints/fit_slat_gauss.irp.f

@@ -0,0 +1,94 @@
+ BEGIN_PROVIDER [integer, n_max_fit_slat]
+ implicit none
+ BEGIN_DOC
+! number of gaussian to fit exp(-x)
+!
+! I took 20 gaussians from the program bassto.f
+ END_DOC
+ n_max_fit_slat = 20
+ END_PROVIDER
+
+ BEGIN_PROVIDER [double precision, coef_fit_slat_gauss, (n_max_fit_slat)]
+&BEGIN_PROVIDER [double precision, expo_fit_slat_gauss, (n_max_fit_slat)]
+ implicit none
+  include 'constants.include.F'
+ BEGIN_DOC
+ ! fit the exp(-x) as 
+ !
+ ! \sum_{i = 1, n_max_fit_slat} coef_fit_slat_gauss(i) * exp(-expo_fit_slat_gauss(i) * x**2)
+ !
+ ! The coefficient are taken from the program bassto.f
+ END_DOC
+
+
+      expo_fit_slat_gauss(01)=30573.77073000000
+      coef_fit_slat_gauss(01)=0.00338925525
+      expo_fit_slat_gauss(02)=5608.45238100000
+      coef_fit_slat_gauss(02)=0.00536433869
+      expo_fit_slat_gauss(03)=1570.95673400000
+      coef_fit_slat_gauss(03)=0.00818702846
+      expo_fit_slat_gauss(04)=541.39785110000
+      coef_fit_slat_gauss(04)=0.01202047655
+      expo_fit_slat_gauss(05)=212.43469630000
+      coef_fit_slat_gauss(05)=0.01711289568
+      expo_fit_slat_gauss(06)=91.31444574000
+      coef_fit_slat_gauss(06)=0.02376001022
+      expo_fit_slat_gauss(07)=42.04087246000
+      coef_fit_slat_gauss(07)=0.03229121736
+      expo_fit_slat_gauss(08)=20.43200443000
+      coef_fit_slat_gauss(08)=0.04303646818
+      expo_fit_slat_gauss(09)=10.37775161000
+      coef_fit_slat_gauss(09)=0.05624657578
+      expo_fit_slat_gauss(10)=5.46880754500
+      coef_fit_slat_gauss(10)=0.07192311571
+      expo_fit_slat_gauss(11)=2.97373529200
+      coef_fit_slat_gauss(11)=0.08949389001
+      expo_fit_slat_gauss(12)=1.66144190200
+      coef_fit_slat_gauss(12)=0.10727599240
+      expo_fit_slat_gauss(13)=0.95052560820
+      coef_fit_slat_gauss(13)=0.12178961750
+      expo_fit_slat_gauss(14)=0.55528683970
+      coef_fit_slat_gauss(14)=0.12740141870
+      expo_fit_slat_gauss(15)=0.33043360020
+      coef_fit_slat_gauss(15)=0.11759168160
+      expo_fit_slat_gauss(16)=0.19982303230
+      coef_fit_slat_gauss(16)=0.08953504394
+      expo_fit_slat_gauss(17)=0.12246840760
+      coef_fit_slat_gauss(17)=0.05066721317
+      expo_fit_slat_gauss(18)=0.07575825322
+      coef_fit_slat_gauss(18)=0.01806363869
+      expo_fit_slat_gauss(19)=0.04690146243
+      coef_fit_slat_gauss(19)=0.00305632563
+      expo_fit_slat_gauss(20)=0.02834749861
+      coef_fit_slat_gauss(20)=0.00013317513
+
+
+
+END_PROVIDER 
+
+double precision function slater_fit_gam(x,gam)
+ implicit none
+ double precision, intent(in) :: x,gam
+ BEGIN_DOC
+! fit of the function exp(-gam * x) with gaussian functions 
+ END_DOC
+ integer :: i
+ slater_fit_gam = 0.d0
+ do i = 1, n_max_fit_slat
+  slater_fit_gam += coef_fit_slat_gauss(i) * dexp(-expo_fit_slat_gauss(i) * gam * gam * x * x)
+ enddo
+end
+
+subroutine expo_fit_slater_gam(gam,expos)
+ implicit none
+ BEGIN_DOC
+! returns the array of the exponents of the gaussians to fit exp(-gam*x)
+ END_DOC
+ double precision, intent(in)  :: gam
+ double precision, intent(out) :: expos(n_max_fit_slat)
+ integer :: i
+ do i = 1, n_max_fit_slat
+  expos(i) = expo_fit_slat_gauss(i) * gam * gam
+ enddo
+end
+

src/ao_many_one_e_ints/grad2_jmu_manu.irp.f

@@ -0,0 +1,560 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
+  !
+  END_DOC
+
+  implicit none
+  integer                       :: i, j, ipoint, i_1s, i_fit
+  double precision              :: r(3), expo_fit, coef_fit
+  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              :: 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 ...'
+
+  sq_pi_3_2 = (dacos(-1.d0))**(1.5d0)
+
+  provide mu_erf final_grid_points_transp j1b_pen List_comb_thr_b3_coef
+  call wall_time(wall0)
+
+  int2_grad1u2_grad2u2_j1b2_test(:,:,:) = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                                                              &
+     !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,                                     &
+     !$OMP          coef_fit, expo_fit, int_fit_v, tmp,int_gauss,int_j1b,factor_ij_1s,beta_ij,center_ij_1s) &
+     !$OMP SHARED  (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size,                   &
+     !$OMP          final_grid_points_transp, ng_fit_jast,                                                  &
+     !$OMP          expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2,                                             &
+     !$OMP          List_comb_thr_b3_coef, List_comb_thr_b3_expo,                                           &
+     !$OMP          List_comb_thr_b3_cent, int2_grad1u2_grad2u2_j1b2_test, ao_abs_comb_b3_j1b,              &
+     !$OMP          ao_overlap_abs,sq_pi_3_2)
+ !$OMP DO SCHEDULE(dynamic)
+  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
+        if(ao_overlap_abs(j,i) .lt. 1.d-12) then
+          cycle
+        endif
+
+        ! --- --- ---
+        ! i_1s = 1
+        ! --- --- ---
+
+        int_j1b = ao_abs_comb_b3_j1b(1,j,i)
+        do i_fit = 1, ng_fit_jast
+          expo_fit = expo_gauss_1_erf_x_2(i_fit)
+          coef_fit = -0.25d0 *  coef_gauss_1_erf_x_2(i_fit)
+          if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.1.d-10)cycle
+          int_gauss = overlap_gauss_r12_ao(r, expo_fit, i, j)
+          int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss 
+        enddo
+
+        ! --- --- ---
+        ! i_1s > 1
+        ! --- --- ---
+  
+        do i_1s = 2, List_comb_thr_b3_size(j,i)
+
+          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)
+          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)
+  
+          do i_fit = 1, ng_fit_jast
+            expo_fit = expo_gauss_1_erf_x_2(i_fit)
+            !DIR$ FORCEINLINE
+            call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
+            coef_fit = -0.25d0 *  coef_gauss_1_erf_x_2(i_fit) * coef
+!           if(dabs(coef_fit*factor_ij_1s*int_j1b).lt.1.d-10)cycle ! old version
+            if(dabs(coef_fit*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.1.d-10)cycle
+!           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 
+          enddo
+        enddo
+
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 1, ao_num
+      do j = 1, i-1
+        int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test', wall1 - wall0
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao_num, n_points_final_grid)]
+!
+!  BEGIN_DOC
+!  !
+!  ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
+!  !
+!  END_DOC
+!
+  implicit none
+  integer                       :: i, j, ipoint, i_1s, i_fit
+  double precision              :: r(3), expo_fit, coef_fit
+  double precision              :: coef, beta, B_center(3)
+  double precision              :: tmp
+  double precision              :: wall0, wall1
+
+  double precision, allocatable :: int_fit_v(:),big_array(:,:,:)
+  double precision, external    :: overlap_gauss_r12_ao_with1s
+
+  print*, ' providing int2_grad1u2_grad2u2_j1b2_test_v ...'
+
+  provide mu_erf final_grid_points_transp j1b_pen
+  call wall_time(wall0)
+
+ double precision :: int_j1b
+ big_array(:,:,:) = 0.d0
+ allocate(big_array(n_points_final_grid,ao_num, ao_num))
+ !$OMP PARALLEL DEFAULT (NONE)                                       &
+     !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,&
+     !$OMP          coef_fit, expo_fit, int_fit_v, tmp,int_j1b)                &
+     !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b3_size,&
+     !$OMP          final_grid_points_transp, ng_fit_jast,               &
+     !$OMP          expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2,      &
+     !$OMP          List_comb_thr_b3_coef, List_comb_thr_b3_expo,    &
+     !$OMP          List_comb_thr_b3_cent, big_array,&
+     !$OMP          ao_abs_comb_b3_j1b,ao_overlap_abs)
+!
+ allocate(int_fit_v(n_points_final_grid))
+ !$OMP DO SCHEDULE(dynamic)
+ do i = 1, ao_num
+   do j = i, ao_num
+
+     if(ao_overlap_abs(j,i) .lt. 1.d-12) then
+       cycle
+     endif
+
+      do i_1s = 1, List_comb_thr_b3_size(j,i)
+
+         coef        = List_comb_thr_b3_coef  (i_1s,j,i)
+         beta        = List_comb_thr_b3_expo  (i_1s,j,i)
+         int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+!         if(dabs(coef)*dabs(int_j1b).lt.1.d-15)cycle
+         B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
+         B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
+         B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
+
+       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) * coef
+
+         call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, size(final_grid_points_transp,1),&
+               expo_fit, i, j, int_fit_v, size(int_fit_v,1),n_points_final_grid)
+
+         do ipoint = 1, n_points_final_grid
+           big_array(ipoint,j,i) += coef_fit * int_fit_v(ipoint)
+         enddo
+
+       enddo
+
+     enddo
+   enddo
+ enddo
+ !$OMP END DO
+ deallocate(int_fit_v)
+ !$OMP END PARALLEL
+ 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)
+    enddo
+   enddo
+  enddo
+
+  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)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test_v', wall1 - wall0
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2
+  !
+  END_DOC
+
+  implicit none
+  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, 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 ...'
+
+  sq_pi_3_2 = (dacos(-1.d0))**(1.5d0)
+
+  provide mu_erf final_grid_points j1b_pen
+  call wall_time(wall0)
+
+  int2_u2_j1b2_test = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
+ !$OMP          coef_fit, expo_fit, int_fit, tmp, int_j1b,factor_ij_1s,beta_ij,center_ij_1s)          & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b3_size, & 
+ !$OMP          final_grid_points, ng_fit_jast,                     &
+ !$OMP          expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2,           &
+ !$OMP          List_comb_thr_b3_coef, List_comb_thr_b3_expo,sq_pi_3_2,       & 
+ !$OMP          List_comb_thr_b3_cent, int2_u2_j1b2_test,ao_abs_comb_b3_j1b)
+ !$OMP DO
+  do ipoint = 1, n_points_final_grid
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+
+    do i = 1, ao_num
+      do j = i, ao_num
+
+        tmp = 0.d0
+
+        ! --- --- ---
+        ! i_1s = 1
+        ! --- --- ---
+
+        int_j1b = ao_abs_comb_b3_j1b(1,j,i)
+        if(dabs(int_j1b).lt.1.d-10) cycle
+        do i_fit = 1, ng_fit_jast
+          expo_fit = expo_gauss_j_mu_x_2(i_fit)
+          coef_fit = coef_gauss_j_mu_x_2(i_fit)
+          if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.1.d-10)cycle
+          int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
+          tmp += coef_fit * int_fit
+        enddo
+
+        ! --- --- ---
+        ! i_1s > 1
+        ! --- --- ---
+
+        do i_1s = 2, List_comb_thr_b3_size(j,i)
+
+          coef        = List_comb_thr_b3_coef  (i_1s,j,i)
+          beta        = List_comb_thr_b3_expo  (i_1s,j,i)
+          int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+          if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
+          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)
+
+          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)
+            !DIR$ FORCEINLINE
+            call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
+!            if(dabs(coef_fit*coef*factor_ij_1s*int_j1b).lt.1.d-10)cycle ! old version
+            if(dabs(coef_fit*coef*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.1.d-10)cycle
+            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
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        int2_u2_j1b2_test(j,i,ipoint) = int2_u2_j1b2_test(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print*, ' wall time for int2_u2_j1b2_test', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n_points_final_grid, 3)]
+
+  BEGIN_DOC
+  !
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint, i_1s, i_fit
+  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 :: wall0, wall1, sq_pi_3_2,sq_alpha
+
+  print*, ' providing int2_u_grad1u_x_j1b2_test ...'
+
+  sq_pi_3_2 = dacos(-1.D0)**(1.d0)
+  provide mu_erf final_grid_points j1b_pen
+  call wall_time(wall0)
+
+  int2_u_grad1u_x_j1b2_test = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
+ !$OMP          coef_fit, expo_fit, int_fit, alpha_1s, dist,        &
+ !$OMP          alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp,     & 
+ !$OMP          tmp_x, tmp_y, tmp_z,int_j1b,sq_alpha)                        & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b3_size, & 
+ !$OMP          final_grid_points, ng_fit_jast,                     &
+ !$OMP          expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf,       &
+ !$OMP          List_comb_thr_b3_coef, List_comb_thr_b3_expo,       & 
+ !$OMP          List_comb_thr_b3_cent, int2_u_grad1u_x_j1b2_test,ao_abs_comb_b3_j1b,sq_pi_3_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_x = 0.d0
+        tmp_y = 0.d0
+        tmp_z = 0.d0
+        do i_1s = 1, List_comb_thr_b3_size(j,i)
+
+          coef        = List_comb_thr_b3_coef  (i_1s,j,i)
+          beta        = List_comb_thr_b3_expo  (i_1s,j,i)
+          int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+          if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
+          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)
+          do i_fit = 1, ng_fit_jast
+    
+            expo_fit = expo_gauss_j_mu_1_erf(i_fit)
+            coef_fit = coef_gauss_j_mu_1_erf(i_fit)
+    
+            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)) 
+
+            alpha_1s     = beta + expo_fit
+            alpha_1s_inv = 1.d0 / alpha_1s 
+
+            centr_1s(1)  = alpha_1s_inv * (beta * B_center(1) + expo_fit * r(1))
+            centr_1s(2)  = alpha_1s_inv * (beta * B_center(2) + expo_fit * r(2))
+            centr_1s(3)  = alpha_1s_inv * (beta * B_center(3) + expo_fit * r(3))
+
+            expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist 
+            coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
+            sq_alpha = alpha_1s_inv * dsqrt(alpha_1s_inv)
+!            if(dabs(coef_tmp*int_j1b) .lt. 1d-10) cycle ! old version
+            if(dabs(coef_tmp*int_j1b*sq_pi_3_2*sq_alpha) .lt. 1d-10) cycle
+            
+            call NAI_pol_x_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r, int_fit)
+
+            tmp_x += coef_tmp * int_fit(1)
+            tmp_y += coef_tmp * int_fit(2)
+            tmp_z += coef_tmp * int_fit(3)
+          enddo
+
+          ! ---
+
+        enddo
+
+        int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = tmp_x
+        int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = tmp_y
+        int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = tmp_z
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$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_test(j,i,ipoint,1) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,1)
+        int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,2)
+        int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,3)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print*, ' wall time for int2_u_grad1u_x_j1b2_test', wall1 - wall0
+
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu]
+  !
+  END_DOC
+
+  implicit none
+  integer                       :: i, j, ipoint, i_1s, i_fit
+  double precision              :: r(3), int_fit, expo_fit, coef_fit, coef_tmp
+  double precision              :: coef, beta, B_center(3), dist
+  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 :: 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 ...'
+
+  dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
+
+  provide mu_erf final_grid_points j1b_pen ao_overlap_abs List_comb_thr_b3_cent
+  call wall_time(wall0)
+
+
+  int2_u_grad1u_j1b2_test = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
+ !$OMP          coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist,   &
+ !$OMP          beta_ij,center_ij_1s,factor_ij_1s,               &
+ !$OMP          int_j1b,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp)     &
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b3_size, &
+ !$OMP          final_grid_points, ng_fit_jast,                  &
+ !$OMP          expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf,       &
+ !$OMP          ao_prod_dist_grid, ao_prod_sigma, ao_overlap_abs_grid,ao_prod_center,dsqpi_3_2,   &
+ !$OMP          List_comb_thr_b3_coef, List_comb_thr_b3_expo,  ao_abs_comb_b3_j1b,     &
+ !$OMP          List_comb_thr_b3_cent, int2_u_grad1u_j1b2_test)
+ !$OMP DO
+  do ipoint = 1, n_points_final_grid
+    do i = 1, ao_num
+      do j = i, ao_num
+
+        if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-10) cycle
+
+        r(1) = final_grid_points(1,ipoint)
+        r(2) = final_grid_points(2,ipoint)
+        r(3) = final_grid_points(3,ipoint)
+
+        tmp = 0.d0
+
+        ! --- --- ---
+        ! i_1s = 1
+        ! --- --- ---
+
+        int_j1b = ao_abs_comb_b3_j1b(1,j,i)
+        if(dabs(int_j1b).lt.1.d-10) cycle
+        do i_fit = 1, ng_fit_jast
+          expo_fit = expo_gauss_j_mu_1_erf(i_fit)
+          if(dabs(int_j1b)*dsqpi_3_2*expo_fit**(-1.5d0).lt.1.d-15) cycle
+          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
+        enddo
+
+        ! --- --- ---
+        ! i_1s > 1
+        ! --- --- ---
+
+        do i_1s = 2, List_comb_thr_b3_size(j,i)
+
+          coef        = List_comb_thr_b3_coef  (i_1s,j,i)
+          beta        = List_comb_thr_b3_expo  (i_1s,j,i)
+          int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
+          if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
+          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)
+          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))
+          do i_fit = 1, ng_fit_jast
+            expo_fit = expo_gauss_j_mu_1_erf(i_fit)
+            call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
+            if(factor_ij_1s*dabs(coef*int_j1b)*dsqpi_3_2*beta_ij**(-1.5d0).lt.1.d-15)cycle
+            coef_fit = coef_gauss_j_mu_1_erf(i_fit)
+
+            alpha_1s     = beta + expo_fit
+            alpha_1s_inv = 1.d0 / alpha_1s
+            centr_1s(1)  = alpha_1s_inv * (beta * B_center(1) + expo_fit * r(1))
+            centr_1s(2)  = alpha_1s_inv * (beta * B_center(2) + expo_fit * r(2))
+            centr_1s(3)  = alpha_1s_inv * (beta * B_center(3) + expo_fit * r(3))
+
+            expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist
+            if(expo_coef_1s .gt. 20.d0) cycle
+            coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
+            if(dabs(coef_tmp) .lt. 1d-08) cycle
+
+            int_fit = NAI_pol_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s,  1.d+9, r)
+
+            tmp += coef_tmp * int_fit
+          enddo
+        enddo
+
+        int2_u_grad1u_j1b2_test(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        int2_u_grad1u_j1b2_test(j,i,ipoint) = int2_u_grad1u_j1b2_test(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print*, ' wall time for int2_u_grad1u_j1b2_test', wall1 - wall0
+
+END_PROVIDER
+
+! ---

src/ao_many_one_e_ints/grad2_jmu_modif.irp.f

@@ -0,0 +1,420 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
+  !
+  END_DOC
+
+  implicit none
+  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)
+  double precision              :: tmp
+  double precision              :: wall0, wall1
+
+  double precision, external    :: overlap_gauss_r12_ao
+  double precision, external    :: overlap_gauss_r12_ao_with1s
+
+  print*, ' providing int2_grad1u2_grad2u2_j1b2 ...'
+  call wall_time(wall0)
+
+  provide mu_erf final_grid_points j1b_pen
+
+  int2_grad1u2_grad2u2_j1b2 = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
+ !$OMP          coef_fit, expo_fit, int_fit, tmp)                   & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_all_comb_b3_size, & 
+ !$OMP          final_grid_points, ng_fit_jast,                     &
+ !$OMP          expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2,         &
+ !$OMP          List_all_comb_b3_coef, List_all_comb_b3_expo,       & 
+ !$OMP          List_all_comb_b3_cent, int2_grad1u2_grad2u2_j1b2)
+ !$OMP DO
+  do ipoint = 1, n_points_final_grid
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+
+    do i = 1, ao_num
+      do j = i, ao_num
+
+        tmp = 0.d0
+        do i_fit = 1, ng_fit_jast
+
+          expo_fit = expo_gauss_1_erf_x_2(i_fit)
+          coef_fit = coef_gauss_1_erf_x_2(i_fit)
+
+          ! ---
+
+          int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
+          tmp += -0.25d0 * coef_fit * int_fit
+!          if(dabs(coef_fit*int_fit) .lt. 1d-12) cycle
+
+          ! ---
+
+          do i_1s = 2, List_all_comb_b3_size
+
+            coef        = List_all_comb_b3_coef  (i_1s)
+            beta        = List_all_comb_b3_expo  (i_1s)
+            B_center(1) = List_all_comb_b3_cent(1,i_1s)
+            B_center(2) = List_all_comb_b3_cent(2,i_1s)
+            B_center(3) = List_all_comb_b3_cent(3,i_1s)
+
+            int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
+
+            tmp += -0.25d0 * coef * coef_fit * int_fit
+          enddo
+
+          ! ---
+
+        enddo
+
+        int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        int2_grad1u2_grad2u2_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
+  double precision              :: r(3), int_fit, expo_fit, coef_fit
+  double precision              :: coef, beta, B_center(3), tmp
+  double precision              :: wall0, wall1
+
+  double precision, external    :: overlap_gauss_r12_ao
+  double precision, external    :: overlap_gauss_r12_ao_with1s
+
+  print*, ' providing int2_u2_j1b2 ...'
+  call wall_time(wall0)
+
+  provide mu_erf final_grid_points j1b_pen
+
+  int2_u2_j1b2 = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
+ !$OMP          coef_fit, expo_fit, int_fit, tmp)                   & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_all_comb_b3_size, & 
+ !$OMP          final_grid_points, ng_fit_jast,                     &
+ !$OMP          expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2,           &
+ !$OMP          List_all_comb_b3_coef, List_all_comb_b3_expo,       & 
+ !$OMP          List_all_comb_b3_cent, int2_u2_j1b2)
+ !$OMP DO
+  do ipoint = 1, n_points_final_grid
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+
+    do i = 1, ao_num
+      do j = i, ao_num
+
+        tmp = 0.d0
+        do i_fit = 1, ng_fit_jast
+
+          expo_fit = expo_gauss_j_mu_x_2(i_fit)
+          coef_fit = coef_gauss_j_mu_x_2(i_fit)
+
+          ! ---
+
+          int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
+          tmp += coef_fit * int_fit
+!          if(dabs(coef_fit*int_fit) .lt. 1d-12) cycle
+
+          ! ---
+
+          do i_1s = 2, List_all_comb_b3_size
+         
+            coef        = List_all_comb_b3_coef  (i_1s)
+            beta        = List_all_comb_b3_expo  (i_1s)
+            B_center(1) = List_all_comb_b3_cent(1,i_1s)
+            B_center(2) = List_all_comb_b3_cent(2,i_1s)
+            B_center(3) = List_all_comb_b3_cent(3,i_1s)
+
+            int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
+
+            tmp += coef * coef_fit * int_fit
+          enddo
+
+          ! ---
+
+        enddo
+
+        int2_u2_j1b2(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        int2_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
+  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
+  double precision :: wall0, wall1
+
+  print*, ' providing int2_u_grad1u_x_j1b2 ...'
+  call wall_time(wall0)
+
+  provide mu_erf final_grid_points j1b_pen
+
+  int2_u_grad1u_x_j1b2 = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
+ !$OMP          coef_fit, expo_fit, int_fit, alpha_1s, dist,        &
+ !$OMP          alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp,     & 
+ !$OMP          tmp_x, tmp_y, tmp_z)                                & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_all_comb_b3_size, & 
+ !$OMP          final_grid_points, ng_fit_jast,                     &
+ !$OMP          expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf,       &
+ !$OMP          List_all_comb_b3_coef, List_all_comb_b3_expo,       & 
+ !$OMP          List_all_comb_b3_cent, int2_u_grad1u_x_j1b2)
+ !$OMP DO
+
+  do ipoint = 1, n_points_final_grid
+    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_x = 0.d0
+        tmp_y = 0.d0
+        tmp_z = 0.d0
+        do i_fit = 1, ng_fit_jast
+
+          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(i, j, expo_fit, r, 1.d+9, r, int_fit)
+          tmp_x += coef_fit * int_fit(1)
+          tmp_y += coef_fit * int_fit(2)
+          tmp_z += coef_fit * int_fit(3)
+!          if( dabs(coef_fit)*(dabs(int_fit(1)) + dabs(int_fit(2)) + dabs(int_fit(3))) .lt. 3d-10 ) cycle
+
+          ! ---
+
+          do i_1s = 2, List_all_comb_b3_size
+          
+            coef        = List_all_comb_b3_coef  (i_1s)
+            beta        = List_all_comb_b3_expo  (i_1s)
+            B_center(1) = List_all_comb_b3_cent(1,i_1s)
+            B_center(2) = List_all_comb_b3_cent(2,i_1s)
+            B_center(3) = List_all_comb_b3_cent(3,i_1s)
+            dist        = (B_center(1) - r(1)) * (B_center(1) - r(1)) &
+                        + (B_center(2) - r(2)) * (B_center(2) - r(2)) &
+                        + (B_center(3) - r(3)) * (B_center(3) - r(3)) 
+
+            alpha_1s     = beta + expo_fit
+            alpha_1s_inv = 1.d0 / alpha_1s 
+
+            centr_1s(1)  = alpha_1s_inv * (beta * B_center(1) + expo_fit * r(1))
+            centr_1s(2)  = alpha_1s_inv * (beta * B_center(2) + expo_fit * r(2))
+            centr_1s(3)  = alpha_1s_inv * (beta * B_center(3) + expo_fit * r(3))
+
+            expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist 
+            coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
+!            if(dabs(coef_tmp) .lt. 1d-12) cycle
+            
+            call NAI_pol_x_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r, int_fit)
+
+            tmp_x += coef_tmp * int_fit(1)
+            tmp_y += coef_tmp * int_fit(2)
+            tmp_z += coef_tmp * int_fit(3)
+          enddo
+
+          ! ---
+
+        enddo
+
+        int2_u_grad1u_x_j1b2(j,i,ipoint,1) = tmp_x
+        int2_u_grad1u_x_j1b2(j,i,ipoint,2) = tmp_y
+        int2_u_grad1u_x_j1b2(j,i,ipoint,3) = tmp_z
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$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 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu]
+  !
+  END_DOC
+
+  implicit none
+  integer                       :: i, j, ipoint, i_1s, i_fit
+  double precision              :: r(3), int_fit, expo_fit, coef_fit, coef_tmp
+  double precision              :: coef, beta, B_center(3), dist
+  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
+
+  print*, ' providing int2_u_grad1u_j1b2 ...'
+  call wall_time(wall0)
+
+  provide mu_erf final_grid_points j1b_pen
+
+  int2_u_grad1u_j1b2 = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
+ !$OMP          coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist,   &
+ !$OMP          alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp)     & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_all_comb_b3_size, & 
+ !$OMP          final_grid_points, ng_fit_jast,                     &
+ !$OMP          expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf,       &
+ !$OMP          List_all_comb_b3_coef, List_all_comb_b3_expo,       & 
+ !$OMP          List_all_comb_b3_cent, int2_u_grad1u_j1b2)
+ !$OMP DO
+  do ipoint = 1, n_points_final_grid
+    do i = 1, ao_num
+      do j = i, ao_num
+        r(1) = final_grid_points(1,ipoint)
+        r(2) = final_grid_points(2,ipoint)
+        r(3) = final_grid_points(3,ipoint)
+
+        tmp = 0.d0
+        do i_fit = 1, ng_fit_jast
+
+          expo_fit = expo_gauss_j_mu_1_erf(i_fit)
+          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)
+!          if(dabs(coef_fit)*dabs(int_fit) .lt. 1d-12) cycle
+
+          tmp += coef_fit * int_fit
+
+          ! ---
+
+          do i_1s = 2, List_all_comb_b3_size
+
+            coef        = List_all_comb_b3_coef  (i_1s)
+            beta        = List_all_comb_b3_expo  (i_1s)
+            B_center(1) = List_all_comb_b3_cent(1,i_1s)
+            B_center(2) = List_all_comb_b3_cent(2,i_1s)
+            B_center(3) = List_all_comb_b3_cent(3,i_1s)
+            dist        = (B_center(1) - r(1)) * (B_center(1) - r(1)) &
+                        + (B_center(2) - r(2)) * (B_center(2) - r(2)) &
+                        + (B_center(3) - r(3)) * (B_center(3) - r(3))
+
+            alpha_1s     = beta + expo_fit
+            alpha_1s_inv = 1.d0 / alpha_1s 
+            centr_1s(1)  = alpha_1s_inv * (beta * B_center(1) + expo_fit * r(1))
+            centr_1s(2)  = alpha_1s_inv * (beta * B_center(2) + expo_fit * r(2))
+            centr_1s(3)  = alpha_1s_inv * (beta * B_center(3) + expo_fit * r(3))
+
+            expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist
+            if(expo_coef_1s .gt. 80.d0) cycle
+            coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
+            if(dabs(coef_tmp) .lt. 1d-12) cycle
+
+            int_fit = NAI_pol_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s,  1.d+9, r)
+
+            tmp += coef_tmp * int_fit
+          enddo
+
+          ! ---
+
+        enddo
+
+        int2_u_grad1u_j1b2(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        int2_u_grad1u_j1b2(j,i,ipoint) = int2_u_grad1u_j1b2(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print*, ' wall time for int2_u_grad1u_j1b2', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+

src/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f

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

src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f

@@ -0,0 +1,396 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R|
+  !
+  END_DOC
+
+  implicit none
+  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           :: 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 ...'
+
+  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
+
+ !$OMP PARALLEL DEFAULT (NONE)                                                         &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp, int_j1b)& 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points, &
+ !$OMP          List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_j1b,  &
+ !$OMP          v_ij_erf_rk_cst_mu_j1b_test, mu_erf,                                   &
+ !$OMP          ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2)
+ !$OMP DO
+  !do ipoint = 1, 10
+  do ipoint = 1, n_points_final_grid
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+
+    do i = 1, ao_num
+      do j = i, ao_num
+        if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-20)cycle
+
+        tmp = 0.d0
+        do i_1s = 1, 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)
+          if(dabs(coef)*dabs(int_j1b).lt.1.d-10)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)
+          ! TODO :: cycle on the 1 - erf(mur12)
+          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)
+
+          tmp += coef * (int_mu - int_coulomb)
+        enddo
+
+        v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+ 
+  call wall_time(wall1)
+  print*, ' wall time for v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0
+
+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_DOC
+  ! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint, i_1s
+  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
+
+  print*, ' providing x_v_ij_erf_rk_cst_mu_j1b_test ...'
+
+  dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
+
+  provide expo_erfc_mu_gauss ao_prod_sigma ao_prod_center
+  call wall_time(wall0)
+
+  x_v_ij_erf_rk_cst_mu_j1b_test = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                                        &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb,      & 
+ !$OMP          int_j1b, tmp_x, tmp_y, tmp_z,factor_ij_1s,beta_ij,center_ij_1s)       & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points,&
+ !$OMP          List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,  &
+ !$OMP          x_v_ij_erf_rk_cst_mu_j1b_test, mu_erf,ao_abs_comb_b2_j1b,         &
+ !$OMP          ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma)
+! !$OMP          ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,expo_erfc_mu_gauss)
+ !$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
+        if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-10)cycle
+
+        tmp_x = 0.d0
+        tmp_y = 0.d0
+        tmp_z = 0.d0
+        do i_1s = 1, 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)
+          if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
+          B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
+          B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
+          B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
+
+!          if(ao_prod_center(1,j,i).ne.10000.d0)then
+!           ! approximate 1 - erf(mu r12) by a gaussian * 10
+!           !DIR$ FORCEINLINE
+!           call gaussian_product(expo_erfc_mu_gauss,r,     &
+!                ao_prod_sigma(j,i),ao_prod_center(1,j,i),  & 
+!                factor_ij_1s,beta_ij,center_ij_1s)
+!           if(dabs(coef * factor_ij_1s*int_j1b*10.d0 * dsqpi_3_2 * beta_ij**(-1.5d0)).lt.1.d-10)cycle 
+!          endif
+          call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints        )
+          call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center,  1.d+9, r, ints_coulomb)
+
+          tmp_x += coef * (ints(1) - ints_coulomb(1))
+          tmp_y += coef * (ints(2) - ints_coulomb(2))
+          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_j1b_test(j,i,ipoint,2) = tmp_y
+        x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = tmp_z
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  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_j1b_test(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,2)
+        x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,3)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+! TODO analytically
+BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
+  !
+  END_DOC
+
+  implicit none
+  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)
+  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, external :: overlap_gauss_r12_ao
+  double precision, external :: overlap_gauss_r12_ao_with1s
+
+  print*, ' providing v_ij_u_cst_mu_j1b_test ...'
+
+  dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
+
+  provide mu_erf final_grid_points j1b_pen
+  call wall_time(wall0)
+
+  v_ij_u_cst_mu_j1b_test = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
+ !$OMP          beta_ij_u, factor_ij_1s_u, center_ij_1s_u,          &
+ !$OMP          coef_fit, expo_fit, int_fit, tmp,coeftot,int_j1b)   & 
+ !$OMP SHARED  (n_points_final_grid, ao_num,                        & 
+ !$OMP          final_grid_points, ng_fit_jast,                     &
+ !$OMP          expo_gauss_j_mu_x, coef_gauss_j_mu_x,               &
+ !$OMP          List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, & 
+ !$OMP          List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_test,ao_abs_comb_b2_j1b,   &
+ !$OMP          ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_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
+        if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-20)cycle
+
+        tmp = 0.d0
+
+        ! --- --- ---
+        ! i_1s = 1
+        ! --- --- ---
+
+        int_j1b = ao_abs_comb_b2_j1b(1,j,i)
+        if(dabs(int_j1b).lt.1.d-10) cycle
+        do i_fit = 1, ng_fit_jast
+          expo_fit = expo_gauss_j_mu_x(i_fit)
+          coef_fit = coef_gauss_j_mu_x(i_fit)
+          if(ao_overlap_abs_grid(j,i).lt.1.d-15) cycle
+          int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
+          tmp += coef_fit * int_fit
+        enddo
+
+        ! --- --- ---
+        ! i_1s > 1
+        ! --- --- ---
+
+        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)
+          if(dabs(coef)*dabs(int_j1b).lt.1.d-10)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)
+          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)
+            coeftot = coef * coef_fit
+            if(dabs(coeftot).lt.1.d-15)cycle
+            call gaussian_product(beta,B_center,expo_fit,r,factor_ij_1s_u,beta_ij_u,center_ij_1s_u)
+            if(factor_ij_1s_u*ao_overlap_abs_grid(j,i).lt.1.d-15)cycle
+            int_fit  = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
+            tmp += coef * coef_fit * int_fit
+          enddo
+        enddo
+
+        v_ij_u_cst_mu_j1b_test(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        v_ij_u_cst_mu_j1b_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_test(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+ 
+  call wall_time(wall1)
+  print*, ' wall time for v_ij_u_cst_mu_j1b_test', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) with u(mu,r12) \approx 1/2 mu e^{-2.5 * mu (r12)^2}
+  !
+  END_DOC
+
+  implicit none
+  integer                    :: i, j, ipoint, i_1s
+  double precision           :: r(3), int_fit, expo_fit, coef_fit
+  double precision           :: coef, beta, B_center(3)
+  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, 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
+
+ !$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 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          ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_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
+        if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-20)cycle
+
+        tmp = 0.d0
+
+        ! --- --- ---
+        ! i_1s = 1
+        ! --- --- ---
+
+        int_j1b = ao_abs_comb_b2_j1b(1,j,i)
+        if(dabs(int_j1b).lt.1.d-10) cycle
+        expo_fit = expo_good_j_mu_1gauss
+        int_fit  = overlap_gauss_r12_ao(r, expo_fit, i, j)
+        tmp += int_fit
+
+        ! --- --- ---
+        ! i_1s > 1
+        ! --- --- ---
+
+        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)
+          if(dabs(coef)*dabs(int_j1b).lt.1.d-10)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)
+!          do i_fit = 1, ng_fit_jast
+            expo_fit = expo_good_j_mu_1gauss
+            coef_fit = 1.d0
+            coeftot = coef * coef_fit
+            if(dabs(coeftot).lt.1.d-15)cycle
+            call gaussian_product(beta,B_center,expo_fit,r,factor_ij_1s_u,beta_ij_u,center_ij_1s_u)
+            if(factor_ij_1s_u*ao_overlap_abs_grid(j,i).lt.1.d-15)cycle
+            int_fit  = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
+            tmp += coef * coef_fit * int_fit
+!          enddo
+        enddo
+
+        v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_ng_1_test(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+ 
+  call wall_time(wall1)
+  print*, ' wall time for v_ij_u_cst_mu_j1b_ng_1_test', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+

src/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f

@@ -0,0 +1,300 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R|
+  !
+  END_DOC
+
+  implicit none
+  integer                    :: i, j, ipoint, i_1s
+  double precision           :: r(3), int_mu, int_coulomb
+  double precision           :: coef, beta, B_center(3)
+  double precision           :: tmp
+  double precision           :: wall0, wall1
+  double precision, external :: NAI_pol_mult_erf_ao_with1s
+
+  print *, ' providing v_ij_erf_rk_cst_mu_j1b ...'
+  call wall_time(wall0)
+
+  provide mu_erf final_grid_points j1b_pen
+
+  v_ij_erf_rk_cst_mu_j1b = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                                         &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp) & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_all_comb_b2_size, final_grid_points, &
+ !$OMP          List_all_comb_b2_coef, List_all_comb_b2_expo, List_all_comb_b2_cent,   &
+ !$OMP          v_ij_erf_rk_cst_mu_j1b, mu_erf)
+ !$OMP DO
+  !do ipoint = 1, 10
+  do ipoint = 1, n_points_final_grid
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+
+    do i = 1, ao_num
+      do j = i, ao_num
+
+        tmp = 0.d0
+
+        ! ---
+
+        coef        = List_all_comb_b2_coef  (1)
+        beta        = List_all_comb_b2_expo  (1)
+        B_center(1) = List_all_comb_b2_cent(1,1)
+        B_center(2) = List_all_comb_b2_cent(2,1)
+        B_center(3) = List_all_comb_b2_cent(3,1)
+
+        int_mu      = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
+        int_coulomb = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center,  1.d+9, r)
+!        if(dabs(coef)*dabs(int_mu - int_coulomb) .lt. 1d-12) cycle
+
+        tmp += coef * (int_mu - int_coulomb)
+
+        ! ---
+
+        do i_1s = 2, List_all_comb_b2_size
+
+          coef        = List_all_comb_b2_coef  (i_1s)
+          beta        = List_all_comb_b2_expo  (i_1s)
+          B_center(1) = List_all_comb_b2_cent(1,i_1s)
+          B_center(2) = List_all_comb_b2_cent(2,i_1s)
+          B_center(3) = List_all_comb_b2_cent(3,i_1s)
+
+          int_mu      = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
+          int_coulomb = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center,  1.d+9, r)
+
+          tmp += coef * (int_mu - int_coulomb)
+        enddo
+
+        ! ---
+
+        v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+ 
+  call wall_time(wall1)
+  print*, ' wall time for v_ij_erf_rk_cst_mu_j1b', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid, 3)]
+
+  BEGIN_DOC
+  ! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint, i_1s
+  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
+
+  print*, ' providing x_v_ij_erf_rk_cst_mu_j1b ...'
+  call wall_time(wall0)
+
+  x_v_ij_erf_rk_cst_mu_j1b = 0.d0
+
+ !$OMP PARALLEL DEFAULT (NONE)                                                        &
+ !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb,      & 
+ !$OMP          tmp_x, tmp_y, tmp_z)                                                  & 
+ !$OMP SHARED  (n_points_final_grid, ao_num, List_all_comb_b2_size, final_grid_points,&
+ !$OMP          List_all_comb_b2_coef, List_all_comb_b2_expo, List_all_comb_b2_cent,  &
+ !$OMP          x_v_ij_erf_rk_cst_mu_j1b, mu_erf)
+ !$OMP DO
+  !do ipoint = 1, 10
+  do ipoint = 1, n_points_final_grid
+    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_x = 0.d0
+        tmp_y = 0.d0
+        tmp_z = 0.d0
+
+        ! ---
+
+        coef        = List_all_comb_b2_coef  (1)
+        beta        = List_all_comb_b2_expo  (1)
+        B_center(1) = List_all_comb_b2_cent(1,1)
+        B_center(2) = List_all_comb_b2_cent(2,1)
+        B_center(3) = List_all_comb_b2_cent(3,1)
+
+        call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints        )
+        call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center,  1.d+9, r, ints_coulomb)
+
+!        if( dabs(coef)*(dabs(ints(1)-ints_coulomb(1)) + dabs(ints(2)-ints_coulomb(2)) + dabs(ints(3)-ints_coulomb(3))) .lt. 3d-10) cycle
+
+        tmp_x += coef * (ints(1) - ints_coulomb(1))
+        tmp_y += coef * (ints(2) - ints_coulomb(2))
+        tmp_z += coef * (ints(3) - ints_coulomb(3))
+
+        ! ---
+
+        do i_1s = 2, List_all_comb_b2_size
+
+          coef        = List_all_comb_b2_coef  (i_1s)
+          beta        = List_all_comb_b2_expo  (i_1s)
+          B_center(1) = List_all_comb_b2_cent(1,i_1s)
+          B_center(2) = List_all_comb_b2_cent(2,i_1s)
+          B_center(3) = List_all_comb_b2_cent(3,i_1s)
+
+          call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints        )
+          call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center,  1.d+9, r, ints_coulomb)
+
+          tmp_x += coef * (ints(1) - ints_coulomb(1))
+          tmp_y += coef * (ints(2) - ints_coulomb(2))
+          tmp_z += coef * (ints(3) - ints_coulomb(3))
+        enddo
+
+        ! ---
+
+        x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,1) = tmp_x
+        x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,2) = tmp_y
+        x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,3) = tmp_z
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  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_j1b(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2)
+        x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b =', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+! TODO analytically
+BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
+  !
+  END_DOC
+
+  implicit none
+  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)
+  double precision           :: tmp
+  double precision           :: wall0, wall1
+
+  double precision, external :: overlap_gauss_r12_ao_with1s
+
+  print*, ' providing v_ij_u_cst_mu_j1b ...'
+  call wall_time(wall0)
+
+  provide mu_erf final_grid_points j1b_pen
+
+  v_ij_u_cst_mu_j1b = 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          final_grid_points, ng_fit_jast,                     &
+ !$OMP          expo_gauss_j_mu_x, coef_gauss_j_mu_x,               &
+ !$OMP          List_all_comb_b2_coef, List_all_comb_b2_expo,       & 
+ !$OMP          List_all_comb_b2_cent, v_ij_u_cst_mu_j1b)
+ !$OMP DO
+  !do ipoint = 1, 10
+  do ipoint = 1, n_points_final_grid
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+
+    do i = 1, ao_num
+      do j = i, ao_num
+
+        tmp = 0.d0
+        do i_fit = 1, ng_fit_jast
+
+          expo_fit = expo_gauss_j_mu_x(i_fit)
+          coef_fit = coef_gauss_j_mu_x(i_fit)
+
+          ! ---
+
+          coef        = List_all_comb_b2_coef  (1)
+          beta        = List_all_comb_b2_expo  (1)
+          B_center(1) = List_all_comb_b2_cent(1,1)
+          B_center(2) = List_all_comb_b2_cent(2,1)
+          B_center(3) = List_all_comb_b2_cent(3,1)
+
+          int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
+!          if(dabs(int_fit*coef) .lt. 1d-12) cycle
+
+          tmp += coef * coef_fit * int_fit
+
+          ! ---
+
+          do i_1s = 2, List_all_comb_b2_size
+
+            coef        = List_all_comb_b2_coef  (i_1s)
+            beta        = List_all_comb_b2_expo  (i_1s)
+            B_center(1) = List_all_comb_b2_cent(1,i_1s)
+            B_center(2) = List_all_comb_b2_cent(2,i_1s)
+            B_center(3) = List_all_comb_b2_cent(3,i_1s)
+
+            int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
+
+            tmp += coef * coef_fit * int_fit
+          enddo
+
+          ! ---
+
+        enddo
+
+        v_ij_u_cst_mu_j1b(j,i,ipoint) = tmp
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        v_ij_u_cst_mu_j1b(j,i,ipoint) = v_ij_u_cst_mu_j1b(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+ 
+  call wall_time(wall1)
+  print*, ' wall time for v_ij_u_cst_mu_j1b', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+

src/ao_many_one_e_ints/grad_related_ints.irp.f

@@ -0,0 +1,437 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu, (ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R| - 1) / |r - R|
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: r(3)
+  double precision :: int_mu, int_coulomb
+  double precision :: wall0, wall1
+
+  double precision :: NAI_pol_mult_erf_ao
+
+  print*, ' providing v_ij_erf_rk_cst_mu ...'
+
+  provide mu_erf final_grid_points 
+  call wall_time(wall0)
+
+  v_ij_erf_rk_cst_mu = 0.d0
+
+ !$OMP PARALLEL                                       &
+ !$OMP DEFAULT (NONE)                                 &
+ !$OMP PRIVATE (i, j, ipoint, r, int_mu, int_coulomb) & 
+ !$OMP SHARED  (ao_num, n_points_final_grid, v_ij_erf_rk_cst_mu, final_grid_points, mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+  do ipoint = 1, n_points_final_grid
+    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
+
+        int_mu      = NAI_pol_mult_erf_ao(i, j, mu_erf, r)
+        int_coulomb = NAI_pol_mult_erf_ao(i, j,  1.d+9, r)
+
+        v_ij_erf_rk_cst_mu(j,i,ipoint) = int_mu - int_coulomb
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+ 
+  do ipoint = 1, n_points_final_grid
+    do i = 2, ao_num
+      do j = 1, i-1
+        v_ij_erf_rk_cst_mu(j,i,ipoint) = v_ij_erf_rk_cst_mu(i,j,ipoint)
+      enddo
+    enddo
+  enddo
+ 
+  call wall_time(wall1)
+  print*, ' wall time for v_ij_erf_rk_cst_mu = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_transp, (n_points_final_grid, ao_num, ao_num)]
+
+  BEGIN_DOC
+  ! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R| - 1)/|r - R|
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: r(3)
+  double precision :: int_mu, int_coulomb
+  double precision :: wall0, wall1
+  double precision :: NAI_pol_mult_erf_ao
+
+  print *, ' providing v_ij_erf_rk_cst_mu_transp ...'
+
+  provide mu_erf final_grid_points 
+  call wall_time(wall0)
+
+ !$OMP PARALLEL                                  &
+ !$OMP DEFAULT (NONE)                            &
+ !$OMP PRIVATE (i,j,ipoint,r,int_mu,int_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,v_ij_erf_rk_cst_mu_transp,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+  do 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
+        int_mu      = NAI_pol_mult_erf_ao(i, j, mu_erf, r)
+        int_coulomb = NAI_pol_mult_erf_ao(i, j,  1.d+9, r)
+
+        v_ij_erf_rk_cst_mu_transp(ipoint,j,i) = int_mu - int_coulomb
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do i = 2, ao_num
+    do j = 1, i-1
+      do ipoint = 1, n_points_final_grid
+        v_ij_erf_rk_cst_mu_transp(ipoint,j,i) = v_ij_erf_rk_cst_mu_transp(ipoint,i,j)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for v_ij_erf_rk_cst_mu_transp = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_tmp, (3, ao_num, ao_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  ! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: r(3), ints(3), ints_coulomb(3)
+  double precision :: wall0, wall1
+
+  print*, ' providing x_v_ij_erf_rk_cst_mu_tmp ...'
+
+  call wall_time(wall0)
+
+ !$OMP PARALLEL                                 &
+ !$OMP DEFAULT (NONE)                           &
+ !$OMP PRIVATE (i,j,ipoint,r,ints,ints_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,x_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+  do ipoint = 1, n_points_final_grid
+    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_x_mult_erf_ao(i, j, mu_erf, r, ints        )
+        call NAI_pol_x_mult_erf_ao(i, j, 1.d+9 , r, ints_coulomb)
+
+        x_v_ij_erf_rk_cst_mu_tmp(1,j,i,ipoint) = ints(1) - ints_coulomb(1)
+        x_v_ij_erf_rk_cst_mu_tmp(2,j,i,ipoint) = ints(2) - ints_coulomb(2)
+        x_v_ij_erf_rk_cst_mu_tmp(3,j,i,ipoint) = ints(3) - ints_coulomb(3)
+      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
+        x_v_ij_erf_rk_cst_mu_tmp(1,j,i,ipoint) = x_v_ij_erf_rk_cst_mu_tmp(1,i,j,ipoint)
+        x_v_ij_erf_rk_cst_mu_tmp(2,j,i,ipoint) = x_v_ij_erf_rk_cst_mu_tmp(2,i,j,ipoint)
+        x_v_ij_erf_rk_cst_mu_tmp(3,j,i,ipoint) = x_v_ij_erf_rk_cst_mu_tmp(3,i,j,ipoint)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for x_v_ij_erf_rk_cst_mu_tmp = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu, (ao_num, ao_num, n_points_final_grid, 3)]
+
+  BEGIN_DOC
+  ! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: wall0, wall1
+
+  print *, ' providing x_v_ij_erf_rk_cst_mu ...'
+
+  call wall_time(wall0)
+
+  do ipoint = 1, n_points_final_grid
+    do i = 1, ao_num
+      do j = 1, ao_num
+        x_v_ij_erf_rk_cst_mu(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_tmp(1,j,i,ipoint)
+        x_v_ij_erf_rk_cst_mu(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_tmp(2,j,i,ipoint)
+        x_v_ij_erf_rk_cst_mu(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_tmp(3,j,i,ipoint)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for x_v_ij_erf_rk_cst_mu = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_transp, (ao_num, ao_num,3,n_points_final_grid)]
+
+  BEGIN_DOC
+  ! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: wall0, wall1
+
+  print *, ' providing x_v_ij_erf_rk_cst_mu_transp ...'
+
+  call wall_time(wall0)
+
+  do ipoint = 1, n_points_final_grid
+    do i = 1, ao_num
+      do j = 1, ao_num
+        x_v_ij_erf_rk_cst_mu_transp(j,i,1,ipoint) = x_v_ij_erf_rk_cst_mu_tmp(1,j,i,ipoint)
+        x_v_ij_erf_rk_cst_mu_transp(j,i,2,ipoint) = x_v_ij_erf_rk_cst_mu_tmp(2,j,i,ipoint)
+        x_v_ij_erf_rk_cst_mu_transp(j,i,3,ipoint) = x_v_ij_erf_rk_cst_mu_tmp(3,j,i,ipoint)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for x_v_ij_erf_rk_cst_mu_transp = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_transp_bis, (n_points_final_grid, ao_num, ao_num, 3)]
+
+  BEGIN_DOC
+  ! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: wall0, wall1
+
+  print *, ' providing x_v_ij_erf_rk_cst_mu_transp_bis ...'
+
+  call wall_time(wall0)
+
+  do i = 1, ao_num
+    do j = 1, ao_num
+      do ipoint = 1, n_points_final_grid
+        x_v_ij_erf_rk_cst_mu_transp_bis(ipoint,j,i,1) = x_v_ij_erf_rk_cst_mu_tmp(1,j,i,ipoint)
+        x_v_ij_erf_rk_cst_mu_transp_bis(ipoint,j,i,2) = x_v_ij_erf_rk_cst_mu_tmp(2,j,i,ipoint)
+        x_v_ij_erf_rk_cst_mu_transp_bis(ipoint,j,i,3) = x_v_ij_erf_rk_cst_mu_tmp(3,j,i,ipoint)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for x_v_ij_erf_rk_cst_mu_transp_bis = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, d_dx_v_ij_erf_rk_cst_mu_tmp, (3, n_points_final_grid, ao_num, ao_num)]
+
+  BEGIN_DOC
+  ! d_dx_v_ij_erf_rk_cst_mu_tmp(m,R,j,i) = int dr phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r) 
+  !
+  ! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
+  END_DOC
+
+ implicit none
+ integer          :: i, j, ipoint
+ double precision :: r(3), ints(3), ints_coulomb(3)
+ double precision :: wall0, wall1
+
+  print *, ' providing d_dx_v_ij_erf_rk_cst_mu_tmp ...'
+
+  call wall_time(wall0)
+
+ !$OMP PARALLEL                                 &
+ !$OMP DEFAULT (NONE)                           &
+ !$OMP PRIVATE (i,j,ipoint,r,ints,ints_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,d_dx_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+  do 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 = 1, ao_num
+        call phi_j_erf_mu_r_dxyz_phi(j, i, mu_erf, r, ints)
+        call phi_j_erf_mu_r_dxyz_phi(j, i,  1.d+9, r, ints_coulomb)
+
+        d_dx_v_ij_erf_rk_cst_mu_tmp(1,ipoint,j,i) = ints(1) - ints_coulomb(1)
+        d_dx_v_ij_erf_rk_cst_mu_tmp(2,ipoint,j,i) = ints(2) - ints_coulomb(2)
+        d_dx_v_ij_erf_rk_cst_mu_tmp(3,ipoint,j,i) = ints(3) - ints_coulomb(3)
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for d_dx_v_ij_erf_rk_cst_mu_tmp = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, d_dx_v_ij_erf_rk_cst_mu, (n_points_final_grid, ao_num, ao_num, 3)]
+
+  BEGIN_DOC
+  !
+  ! d_dx_v_ij_erf_rk_cst_mu_tmp(j,i,R,m) = int dr phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r) 
+  !
+  ! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: wall0, wall1
+
+  print *, ' providing d_dx_v_ij_erf_rk_cst_mu ...'
+
+  call wall_time(wall0)
+  do i = 1, ao_num
+    do j = 1, ao_num
+      do ipoint = 1, n_points_final_grid
+        d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,1) = d_dx_v_ij_erf_rk_cst_mu_tmp(1,ipoint,j,i)
+        d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,2) = d_dx_v_ij_erf_rk_cst_mu_tmp(2,ipoint,j,i)
+        d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,3) = d_dx_v_ij_erf_rk_cst_mu_tmp(3,ipoint,j,i)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for d_dx_v_ij_erf_rk_cst_mu = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_d_dx_v_ij_erf_rk_cst_mu_tmp, (3, n_points_final_grid, ao_num, ao_num)]
+
+  BEGIN_DOC
+  !
+  ! x_d_dx_v_ij_erf_rk_cst_mu_tmp(m,j,i,R) = int dr x phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r) 
+  !
+  ! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: r(3), ints(3), ints_coulomb(3)
+  double precision :: wall0, wall1
+
+  print *, ' providing x_d_dx_v_ij_erf_rk_cst_mu_tmp ...'
+
+  call wall_time(wall0)
+
+ !$OMP PARALLEL                                 &
+ !$OMP DEFAULT (NONE)                           &
+ !$OMP PRIVATE (i,j,ipoint,r,ints,ints_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,x_d_dx_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+  do 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 = 1, ao_num
+        call phi_j_erf_mu_r_xyz_dxyz_phi(j, i, mu_erf, r, ints)
+        call phi_j_erf_mu_r_xyz_dxyz_phi(j, i,  1.d+9, r, ints_coulomb)
+
+        x_d_dx_v_ij_erf_rk_cst_mu_tmp(1,ipoint,j,i) = ints(1) - ints_coulomb(1)
+        x_d_dx_v_ij_erf_rk_cst_mu_tmp(2,ipoint,j,i) = ints(2) - ints_coulomb(2)
+        x_d_dx_v_ij_erf_rk_cst_mu_tmp(3,ipoint,j,i) = ints(3) - ints_coulomb(3)
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for x_d_dx_v_ij_erf_rk_cst_mu_tmp = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_d_dx_v_ij_erf_rk_cst_mu, (n_points_final_grid,ao_num, ao_num,3)]
+
+  BEGIN_DOC
+  !
+  ! x_d_dx_v_ij_erf_rk_cst_mu_tmp(j,i,R,m) = int dr x phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r) 
+  !
+  ! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: wall0, wall1
+
+  print *, ' providing x_d_dx_v_ij_erf_rk_cst_mu ...'
+
+  call wall_time(wall0)
+
+  do i = 1, ao_num
+    do j = 1, ao_num
+      do ipoint = 1, n_points_final_grid
+        x_d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,1) = x_d_dx_v_ij_erf_rk_cst_mu_tmp(1,ipoint,j,i)
+        x_d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,2) = x_d_dx_v_ij_erf_rk_cst_mu_tmp(2,ipoint,j,i)
+        x_d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,3) = x_d_dx_v_ij_erf_rk_cst_mu_tmp(3,ipoint,j,i)
+      enddo
+    enddo
+  enddo
+ 
+  call wall_time(wall1)
+  print *, ' wall time for x_d_dx_v_ij_erf_rk_cst_mu = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+

src/ao_many_one_e_ints/list_grid.irp.f

@@ -0,0 +1,59 @@
+ BEGIN_PROVIDER [ integer, n_pts_grid_ao_prod, (ao_num, ao_num)]
+&BEGIN_PROVIDER [ integer, max_n_pts_grid_ao_prod]
+ implicit none
+ integer :: i,j,ipoint
+ double precision :: overlap, r(3),thr, overlap_abs_gauss_r12_ao,overlap_gauss_r12_ao
+ double precision :: sigma,dist,center_ij(3),fact_gauss, alpha, center(3)
+ n_pts_grid_ao_prod = 0
+ thr = 1.d-11
+ print*,' expo_good_j_mu_1gauss = ',expo_good_j_mu_1gauss
+ !$OMP PARALLEL DEFAULT (NONE)                                      &
+ !$OMP PRIVATE (ipoint, i, j, r, overlap, fact_gauss, alpha, center,dist,sigma,center_ij) &
+ !$OMP SHARED  (n_points_final_grid, ao_num, thr, ao_overlap_abs_grid,n_pts_grid_ao_prod,expo_good_j_mu_1gauss,&
+ !$OMP          final_grid_points,ao_prod_center,ao_prod_sigma,ao_nucl)
+ !$OMP DO
+ do i = 1, ao_num
+! do i = 3,3
+  do j = 1, ao_num
+! do i = 22,22
+!  do j = 9,9
+   center_ij(1:3) = ao_prod_center(1:3,j,i)
+   sigma = ao_prod_sigma(j,i)
+   sigma *= sigma
+   sigma = 0.5d0 /sigma
+!   if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-10)cycle
+   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)
+    dist  = (center_ij(1) - r(1))*(center_ij(1) - r(1))
+    dist += (center_ij(2) - r(2))*(center_ij(2) - r(2))
+    dist += (center_ij(3) - r(3))*(center_ij(3) - r(3))
+    dist = dsqrt(dist)
+    call gaussian_product(sigma, center_ij, expo_good_j_mu_1gauss, r, fact_gauss, alpha, center)
+!    print*,''
+!    print*,j,i,ao_overlap_abs_grid(j,i),ao_overlap_abs(j,i)
+!    print*,r
+!    print*,dist,sigma
+!    print*,fact_gauss
+    if( fact_gauss*ao_overlap_abs_grid(j,i).lt.1.d-11)cycle
+    if(ao_nucl(i) == ao_nucl(j))then
+     overlap = overlap_abs_gauss_r12_ao(r, expo_good_j_mu_1gauss, i, j)
+    else
+     overlap = overlap_gauss_r12_ao(r, expo_good_j_mu_1gauss, i, j)
+    endif
+!    print*,overlap
+    if(dabs(overlap).lt.thr)cycle
+    n_pts_grid_ao_prod(j,i) += 1
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ integer :: list(ao_num)
+ do i = 1, ao_num
+  list(i) = maxval(n_pts_grid_ao_prod(:,i))
+ enddo
+ max_n_pts_grid_ao_prod = maxval(list)
+END_PROVIDER

src/ao_many_one_e_ints/listj1b.irp.f

@@ -0,0 +1,237 @@
+
+! ---
+
+BEGIN_PROVIDER [ integer, List_all_comb_b2_size]
+
+  implicit none
+
+  List_all_comb_b2_size = 2**nucl_num
+
+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
+
+  List_all_comb_b2_coef = 0.d0
+  List_all_comb_b2_expo = 0.d0
+  List_all_comb_b2_cent = 0.d0
+
+  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
+
+  !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
+
+  List_all_comb_b3_size = 3**nucl_num
+
+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
+  double precision :: tmp_alphaj, tmp_alphak, facto
+
+  provide j1b_pen
+
+  List_all_comb_b3_coef = 0.d0
+  List_all_comb_b3_expo = 0.d0
+  List_all_comb_b3_cent = 0.d0
+
+  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
+
+  !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
+
+! ---
+

src/ao_many_one_e_ints/listj1b_sorted.irp.f

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

src/ao_many_one_e_ints/prim_int_erf_gauss.irp.f

@@ -0,0 +1,195 @@
+double precision function NAI_pol_mult_erf_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  BEGIN_DOC
+  ! Computes the following integral R^3 :
+  !
+  ! .. math::
+  ! 
+  !   \int dr  (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$ exp(-delta (r - D)^2 ).
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta  ! pure gaussian "D" 
+ double precision, intent(in)    :: C_center(3),mu      ! coulomb center "C" and "mu" in the erf(mu*x)/x function
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ double precision  :: NAI_pol_mult_erf
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3)
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ accu = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    accu += coefxyz * NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B,alpha_new,beta,C_center,n_pt_max_integrals,mu)
+   enddo
+  enddo
+ enddo
+ NAI_pol_mult_erf_gauss_r12 = fact_a_new * accu 
+end
+
+subroutine erfc_mu_gauss_xyz(D_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in,xyz_ints)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-delta (r - D)^2 ) x/y/z * (1 - erf(mu |r-r'|))/ |r-r'| * (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  !   xyz_ints(1) = x , xyz_ints(2) = y, xyz_ints(3) = z, xyz_ints(4) = x^0 
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta,mu  ! pure gaussian "D" and mu parameter
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3),n_pt_in
+ double precision, intent(out)   :: xyz_ints(4)
+
+ double precision  :: NAI_pol_mult_erf
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr,contrib,contrib_inf,mu_inf
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,mm
+ integer           :: power_B_tmp(3)
+ dim1=100
+ mu_inf = 1.d+10
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ xyz_ints = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+     power_B_tmp = power_B
+     contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)  
+     contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)  
+     xyz_ints(4) += (contrib_inf - contrib) * coefxyz ! usual term with no x/y/z 
+                                      
+     do mm = 1, 3 
+      ! (x phi_i ) * phi_j 
+      ! x * (x - B_x)^b_x = B_x (x - B_x)^b_x + 1 * (x - B_x)^{b_x+1}
+      
+      !
+      ! first contribution :: B_x (x - B_x)^b_x :: usual integral multiplied by B_x
+      power_B_tmp = power_B
+      contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)  
+      contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)  
+      xyz_ints(mm) += (contrib_inf - contrib) * B_center(mm) * coefxyz 
+                                                       
+      !
+      ! second contribution :: (x - B_x)^(b_x+1) :: integral with b_x=>b_x+1 
+      power_B_tmp(mm) += 1
+      contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)  
+      contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)  
+      xyz_ints(mm) += (contrib_inf -  contrib) * coefxyz     
+     enddo
+   enddo
+  enddo
+ enddo
+ xyz_ints *= fact_a_new 
+end
+
+
+double precision function erf_mu_gauss(D_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-delta (r - D)^2 ) erf(mu*|r-r'|)/ |r-r'| * (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta,mu  ! pure gaussian "D" and mu parameter
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3),n_pt_in
+
+ double precision  :: NAI_pol_mult_erf
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr,contrib,contrib_inf,mu_inf
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,mm
+ dim1=100
+ mu_inf = 1.d+10
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ erf_mu_gauss = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B,alpha_new,beta,D_center,n_pt_in,mu)
+    erf_mu_gauss += contrib * coefxyz     
+   enddo
+  enddo
+ enddo
+ erf_mu_gauss *= fact_a_new 
+end
+

src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f

@@ -0,0 +1,340 @@
+! ---
+
+double precision function overlap_gauss_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta)
+
+  BEGIN_DOC
+  !
+  ! Computes the following integral :
+  !
+  ! .. math                      ::
+  !
+  !   \int dr exp(-delta (r - D)^2 ) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  END_DOC
+
+  include 'constants.include.F'
+
+  implicit none
+  double precision, intent(in) :: D_center(3), delta  ! pure gaussian "D"
+  double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+  integer, intent(in)          :: power_A(3),power_B(3)
+
+  double precision             :: overlap_x,overlap_y,overlap_z,overlap
+  ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+  double precision             :: A_new(0:max_dim,3)! new polynom
+  double precision             :: A_center_new(3)   ! new center
+  integer                      :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+  double precision             :: alpha_new         ! new exponent
+  double precision             :: fact_a_new        ! constant factor
+  double precision             :: accu, coefx, coefy, coefz, coefxy, coefxyz, thr
+  integer                      :: d(3), i, lx, ly, lz, iorder_tmp(3), dim1
+
+  dim1 = 100
+  thr  = 1.d-10
+  d(:) = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+  overlap_gauss_r12 = 0.d0
+
+  ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order
+  call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new ,&
+      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+  if(fact_a_new.lt.thr)return
+  ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+  accu = 0.d0
+  do lx = 0, iorder_a_new(1)
+    coefx = A_new(lx,1)*fact_a_new
+    if(dabs(coefx).lt.thr)cycle
+    iorder_tmp(1) = lx
+
+    do ly = 0, iorder_a_new(2)
+      coefy  = A_new(ly,2)
+      coefxy = coefx * coefy
+      if(dabs(coefxy) .lt. thr) cycle
+      iorder_tmp(2) = ly
+
+      do lz = 0, iorder_a_new(3)
+        coefz   = A_new(lz,3)
+        coefxyz = coefxy * coefz
+        if(dabs(coefxyz) .lt. thr) cycle
+        iorder_tmp(3) = lz
+
+        call overlap_gaussian_xyz( A_center_new, B_center, alpha_new, beta, iorder_tmp, power_B &
+                                 , overlap_x, overlap_y, overlap_z, overlap, dim1)
+
+        accu += coefxyz * overlap
+      enddo
+    enddo
+  enddo
+  overlap_gauss_r12 = accu
+end
+
+!---
+double precision function overlap_abs_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math                      ::
+  !
+  !   \int dr exp(-delta (r - D)^2 ) |(x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )|
+  !
+  END_DOC
+
+  implicit none
+  include 'constants.include.F'
+  double precision, intent(in)   :: D_center(3), delta  ! pure gaussian "D"
+  double precision, intent(in)   :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+  integer, intent(in)            :: power_A(3),power_B(3)
+
+  double precision               :: overlap_x,overlap_y,overlap_z,overlap
+  ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+  double precision               :: A_new(0:max_dim,3)! new polynom
+  double precision               :: A_center_new(3)   ! new center
+  integer                        :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+  double precision               :: alpha_new         ! new exponent
+  double precision               :: fact_a_new        ! constant factor
+  double precision               :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr,dx,lower_exp_val
+  integer                        :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1
+  dim1=50
+  lower_exp_val = 40.d0
+  thr = 1.d-12
+  d(:) = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+  overlap_abs_gauss_r12 = 0.d0
+
+  ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order
+  call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new ,&
+      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+  if(fact_a_new.lt.thr)return
+  ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+  accu = 0.d0
+  do lx = 0, iorder_a_new(1)
+    coefx = A_new(lx,1)*fact_a_new
+!    if(dabs(coefx).lt.thr)cycle
+    iorder_tmp(1) = lx
+    do ly = 0, iorder_a_new(2)
+      coefy = A_new(ly,2)
+      coefxy = coefx * coefy
+      if(dabs(coefxy).lt.thr)cycle
+      iorder_tmp(2) = ly
+      do lz = 0, iorder_a_new(3)
+        coefz = A_new(lz,3)
+        coefxyz = coefxy * coefz
+        if(dabs(coefxyz).lt.thr)cycle
+        iorder_tmp(3) = lz
+        call overlap_x_abs(A_center_new(1),B_center(1),alpha_new,beta,iorder_tmp(1),power_B(1),overlap_x,lower_exp_val,dx,dim1)
+        call overlap_x_abs(A_center_new(2),B_center(2),alpha_new,beta,iorder_tmp(2),power_B(2),overlap_y,lower_exp_val,dx,dim1)
+        call overlap_x_abs(A_center_new(3),B_center(3),alpha_new,beta,iorder_tmp(3),power_B(3),overlap_z,lower_exp_val,dx,dim1)
+        accu += dabs(coefxyz * overlap_x * overlap_y * overlap_z)
+      enddo
+    enddo
+  enddo
+  overlap_abs_gauss_r12= accu
+end
+
+!---
+
+! TODO apply Gaussian product three times first
+subroutine overlap_gauss_r12_v(D_center, LD_D, delta, A_center, B_center, power_A, power_B, alpha, beta, rvec, LD_rvec, n_points)
+
+  BEGIN_DOC
+  !
+  ! Computes the following integral :
+  !
+  !   \int dr exp(-delta (r - D)^2) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2)
+  !   using an array of D_centers
+  !
+  ! n_points: nb of integrals
+  !
+  END_DOC
+
+  implicit none
+
+  include 'constants.include.F'
+
+  integer,          intent(in)  :: LD_D, LD_rvec, n_points
+  integer,          intent(in)  :: power_A(3), power_B(3)
+  double precision, intent(in)  :: D_center(LD_D,3), delta
+  double precision, intent(in)  :: A_center(3), B_center(3), alpha, beta 
+  double precision, intent(out) :: rvec(LD_rvec)
+
+  integer                       :: maxab
+  integer                       :: d(3), i, lx, ly, lz, iorder_tmp(3), ipoint
+  double precision              :: overlap_x, overlap_y, overlap_z
+  double precision              :: alpha_new
+  double precision              :: accu, thr, coefxy
+  integer,          allocatable :: iorder_a_new(:)
+  double precision, allocatable :: overlap(:)
+  double precision, allocatable :: A_new(:,:,:), A_center_new(:,:)
+  double precision, allocatable :: fact_a_new(:)
+
+  thr  = 1.d-10
+  d(:) = 0
+
+  maxab = maxval(power_A(1:3))
+
+  allocate(A_new(n_points,0:maxab,3), A_center_new(n_points,3), fact_a_new(n_points), iorder_a_new(3), overlap(n_points))
+
+  call give_explicit_poly_and_gaussian_v(A_new, maxab, A_center_new, alpha_new, fact_a_new, iorder_a_new, delta, alpha, d, power_A, D_center, LD_D, A_center, n_points)
+
+  rvec(:) = 0.d0
+
+  do lx = 0, iorder_a_new(1)
+    iorder_tmp(1) = lx
+
+    do ly = 0, iorder_a_new(2)
+      iorder_tmp(2) = ly
+
+      do lz = 0, iorder_a_new(3)
+        iorder_tmp(3) = lz
+
+        call overlap_gaussian_xyz_v(A_center_new, B_center, alpha_new, beta, iorder_tmp, power_B, overlap, n_points)
+
+        do ipoint = 1, n_points
+          rvec(ipoint) = rvec(ipoint) + A_new(ipoint,lx,1) * A_new(ipoint,ly,2) * A_new(ipoint,lz,3) * overlap(ipoint)
+        enddo
+      enddo
+    enddo
+  enddo
+
+  do ipoint = 1, n_points
+    rvec(ipoint) = rvec(ipoint) * fact_a_new(ipoint)
+  enddo
+
+  deallocate(A_new, A_center_new, fact_a_new, iorder_a_new, overlap)
+
+end subroutine overlap_gauss_r12_v
+
+!---
+
+subroutine overlap_gauss_xyz_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta, gauss_ints)
+
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  !
+  !   gauss_ints(m) = \int dr exp(-delta (r - D)^2 ) * x/y/z (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  ! with m == 1 ==> x, m == 2 ==> y, m == 3 ==> z
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta  ! pure gaussian "D"
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+ double precision, intent(out)   :: gauss_ints(3)
+
+ double precision  :: overlap_x,overlap_y,overlap_z,overlap
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ integer           :: power_B_new(3)
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: coefx,coefy,coefz,coefxy,coefxyz,thr
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,m
+ dim1=100
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , &
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ gauss_ints = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    do m = 1, 3
+     ! change (x-Bx)^bx --> (x-Bx)^(bx+1) + Bx(x-Bx)^bx
+     power_B_new = power_B
+     power_B_new(m) += 1 ! (x-Bx)^(bx+1)
+     call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
+     gauss_ints(m) += coefxyz * overlap
+
+     power_B_new = power_B
+     call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
+     gauss_ints(m) += coefxyz * overlap * B_center(m) ! Bx (x-Bx)^(bx)
+    enddo
+   enddo
+  enddo
+ enddo
+ gauss_ints *= fact_a_new
+end
+
+double precision function overlap_gauss_xyz_r12_specific(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,mx)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  !
+  !    \int dr exp(-delta (r - D)^2 ) * x/y/z (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  ! with mx == 1 ==> x, mx == 2 ==> y, mx == 3 ==> z
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta  ! pure gaussian "D"
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3),mx
+
+ double precision  :: overlap_x,overlap_y,overlap_z,overlap
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ integer           :: power_B_new(3)
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: coefx,coefy,coefz,coefxy,coefxyz,thr
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,m
+ dim1=100
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , &
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ overlap_gauss_xyz_r12_specific = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    m = mx
+    ! change (x-Bx)^bx --> (x-Bx)^(bx+1) + Bx(x-Bx)^bx
+    power_B_new = power_B
+    power_B_new(m) += 1 ! (x-Bx)^(bx+1)
+    call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
+    overlap_gauss_xyz_r12_specific += coefxyz * overlap
+
+    power_B_new = power_B
+    call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
+    overlap_gauss_xyz_r12_specific += coefxyz * overlap * B_center(m) ! Bx (x-Bx)^(bx)
+   enddo
+  enddo
+ enddo
+ overlap_gauss_xyz_r12_specific *= fact_a_new
+end

src/ao_many_one_e_ints/stg_gauss_int.irp.f

@@ -0,0 +1,121 @@
+double precision function ovlp_stg_gauss_int_phi_ij(D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta)
+  BEGIN_DOC
+  ! Computes the following integral : 
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-gam (r - D)) exp(-delta * (r -D)^2) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  END_DOC
+
+ implicit none
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" in r-r_D
+ double precision, intent(in)    :: delta            ! gaussian        in r-r_D
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ integer :: i
+ double precision :: integral,gama_gauss
+ double precision, allocatable :: expos_slat(:)
+ allocate(expos_slat(n_max_fit_slat))
+ double precision :: overlap_gauss_r12
+ ovlp_stg_gauss_int_phi_ij = 0.d0
+ call expo_fit_slater_gam(gam,expos_slat)
+ do i = 1, n_max_fit_slat
+  gama_gauss = expos_slat(i)+delta 
+  integral = overlap_gauss_r12(D_center,gama_gauss,A_center,B_center,power_A,power_B,alpha,beta)
+  ovlp_stg_gauss_int_phi_ij += coef_fit_slat_gauss(i) * integral
+ enddo
+end
+
+
+double precision function erf_mu_stg_gauss_int_phi_ij(D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  BEGIN_DOC
+  ! Computes the following integral : 
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-gam(r - D)-delta(r - D)^2) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" in r-r_D
+ double precision, intent(in)    :: delta            ! gaussian        in r-r_D
+ double precision, intent(in)    :: C_center(3),mu      ! coulomb center "C" and "mu" in the erf(mu*x)/x function
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ integer :: i
+ double precision :: NAI_pol_mult_erf_gauss_r12
+ double precision :: integral,gama_gauss
+ double precision, allocatable :: expos_slat(:)
+ allocate(expos_slat(n_max_fit_slat))
+ erf_mu_stg_gauss_int_phi_ij = 0.d0
+ call expo_fit_slater_gam(gam,expos_slat)
+ do i = 1, n_max_fit_slat
+  gama_gauss = expos_slat(i) + delta
+  integral = NAI_pol_mult_erf_gauss_r12(D_center,gama_gauss,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  erf_mu_stg_gauss_int_phi_ij += coef_fit_slat_gauss(i) * integral
+ enddo
+end
+
+double precision function overlap_stg_gauss(D_center,gam,A_center,B_center,power_A,power_B,alpha,beta)
+  BEGIN_DOC
+  ! Computes the following integral : 
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-gam (r - D)) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  END_DOC
+
+ implicit none
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" 
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+ 
+ integer :: i
+ double precision :: expos_slat(n_max_fit_slat),integral,delta
+ double precision :: overlap_gauss_r12
+ overlap_stg_gauss = 0.d0
+ call expo_fit_slater_gam(gam,expos_slat)
+ do i = 1, n_max_fit_slat
+  delta = expos_slat(i) 
+  integral = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
+  overlap_stg_gauss += coef_fit_slat_gauss(i) * integral
+ enddo
+end
+
+double precision function erf_mu_stg_gauss(D_center,gam,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  BEGIN_DOC
+  ! Computes the following integral : 
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-gam(r - D)) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), gam    ! pure Slater "D" 
+ double precision, intent(in)    :: C_center(3),mu      ! coulomb center "C" and "mu" in the erf(mu*x)/x function
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ 
+ integer :: i
+ double precision :: expos_slat(n_max_fit_slat),integral,delta
+ double precision :: NAI_pol_mult_erf_gauss_r12
+ erf_mu_stg_gauss = 0.d0
+ call expo_fit_slater_gam(gam,expos_slat)
+ do i = 1, n_max_fit_slat
+  delta = expos_slat(i) 
+  integral = NAI_pol_mult_erf_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  erf_mu_stg_gauss += coef_fit_slat_gauss(i) * integral
+ enddo
+end

src/ao_many_one_e_ints/taylor_exp.irp.f

@@ -0,0 +1,101 @@
+double precision function exp_dl(x,n)
+ implicit none
+ double precision, intent(in) :: x
+ integer         , intent(in) :: n
+ integer :: i
+ exp_dl = 1.d0
+ do i = 1, n
+  exp_dl += fact_inv(i) * x**dble(i)
+ enddo
+end
+
+subroutine exp_dl_rout(x,n, array)
+ implicit none
+ double precision, intent(in) :: x
+ integer         , intent(in) :: n
+ double precision, intent(out)::  array(0:n)
+ integer :: i
+ double precision :: accu
+ accu = 1.d0
+ array(0) = 1.d0
+ do i = 1, n
+  accu += fact_inv(i) * x**dble(i)
+  array(i) = accu
+ enddo
+end
+
+subroutine exp_dl_ovlp_stg_phi_ij(zeta,D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,n_taylor,array_ints,integral_taylor,exponent_exp)
+  BEGIN_DOC
+  ! Computes the following integrals : 
+  !
+  ! .. math::
+  ! 
+  !   array(i) = \int dr EXP{exponent_exp * [exp(-gam*i (r - D)) exp(-delta*i * (r -D)^2)] (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  !
+  ! and gives back the Taylor expansion of the exponential in integral_taylor
+  END_DOC
+
+ implicit none
+ double precision, intent(in)    :: zeta             ! prefactor of the argument of the exp(-zeta*x)
+ integer, intent(in)             :: n_taylor         ! order of the Taylor expansion of the exponential
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" in r-r_D
+ double precision, intent(in)    :: delta            ! gaussian        in r-r_D
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ double precision, intent(in)    :: exponent_exp
+ integer, intent(in)             :: power_A(3),power_B(3)
+ double precision, intent(out)   :: array_ints(0:n_taylor),integral_taylor
+
+ integer :: i,dim1
+ double precision :: delta_exp,gam_exp,ovlp_stg_gauss_int_phi_ij
+ double precision :: overlap_x,overlap_y,overlap_z,overlap
+ dim1=100
+ call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1)
+ array_ints(0) = overlap
+ integral_taylor = array_ints(0)
+ do i = 1, n_taylor
+  delta_exp = dble(i) * delta
+  gam_exp   = dble(i) * gam
+  array_ints(i) = ovlp_stg_gauss_int_phi_ij(D_center,gam_exp,delta_exp,A_center,B_center,power_A,power_B,alpha,beta)
+  integral_taylor += (-zeta*exponent_exp)**dble(i) * fact_inv(i) * array_ints(i)
+ enddo
+
+end
+
+subroutine exp_dl_erf_stg_phi_ij(zeta,D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu,n_taylor,array_ints,integral_taylor)
+  BEGIN_DOC
+  ! Computes the following integrals : 
+  !
+  ! .. math::
+  ! 
+  !   array(i) = \int dr exp(-gam*i (r - D)) exp(-delta*i * (r -D)^2) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  !
+  ! and gives back the Taylor expansion of the exponential in integral_taylor
+  END_DOC
+
+ implicit none
+ integer, intent(in)             :: n_taylor         ! order of the Taylor expansion of the exponential
+ double precision, intent(in)    :: zeta             ! prefactor of the argument of the exp(-zeta*x)
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" in r-r_D
+ double precision, intent(in)    :: delta            ! gaussian        in r-r_D
+ double precision, intent(in)    :: C_center(3),mu      ! coulomb center "C" and "mu" in the erf(mu*x)/x function
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+ double precision, intent(out)   :: array_ints(0:n_taylor),integral_taylor
+
+ integer :: i,dim1
+ double precision :: delta_exp,gam_exp,NAI_pol_mult_erf,erf_mu_stg_gauss_int_phi_ij
+ dim1=100
+ 
+ array_ints(0) = NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_max_integrals,mu)
+ integral_taylor = array_ints(0)
+ do i = 1, n_taylor
+  delta_exp = dble(i) * delta
+  gam_exp   = dble(i) * gam
+  array_ints(i) = erf_mu_stg_gauss_int_phi_ij(D_center,gam_exp,delta_exp,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  integral_taylor += (-zeta)**dble(i) * fact_inv(i) * array_ints(i)
+ enddo
+
+end

src/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f

@@ -0,0 +1,343 @@
+ BEGIN_PROVIDER [double precision, coef_xyz_ao, (2,3,ao_num)]
+&BEGIN_PROVIDER [integer, power_xyz_ao, (2,3,ao_num)]
+ implicit none
+ BEGIN_DOC
+! coefficient for the basis function :: (x * phi_i(r), y * phi_i(r), * z_phi(r))
+!
+! x * (x - A_x)^a_x = A_x (x - A_x)^a_x + 1 * (x - A_x)^{a_x+1}
+ END_DOC
+ integer :: i,j,k,num_ao,power_ao(1:3)
+ double precision :: center_ao(1:3)
+ do i = 1, ao_num
+  power_ao(1:3)= ao_power(i,1:3) 
+  num_ao = ao_nucl(i)
+  center_ao(1:3) = nucl_coord(num_ao,1:3)
+  do j = 1, 3
+   coef_xyz_ao(1,j,i) = center_ao(j) ! A_x (x - A_x)^a_x
+   power_xyz_ao(1,j,i)= power_ao(j)
+   coef_xyz_ao(2,j,i) = 1.d0         ! 1 * (x - A_x)^a_{x+1}
+   power_xyz_ao(2,j,i)= power_ao(j) + 1
+  enddo
+ enddo
+END_PROVIDER 
+
+ BEGIN_PROVIDER [ double precision, ao_coef_ord_grad_transp, (2,3,ao_prim_num_max,ao_num) ]
+&BEGIN_PROVIDER [ integer, power_ord_grad_transp, (2,3,ao_num) ]
+  implicit none
+  BEGIN_DOC
+  ! grad AO in terms of polynoms and coefficients 
+  ! 
+  ! WARNING !!!! SOME polynoms might be negative !!!!! 
+  !
+  ! WHEN IT IS THE CASE, coefficients are ZERO 
+  END_DOC
+  integer                        :: i,j,power_ao(3), m,kk
+  do j=1, ao_num
+    power_ao(1:3)= ao_power(j,1:3) 
+    do m = 1, 3
+     power_ord_grad_transp(1,m,j) = power_ao(m) - 1
+     power_ord_grad_transp(2,m,j) = power_ao(m) + 1
+    enddo
+    do i=1, ao_prim_num_max
+     do m = 1, 3
+       ao_coef_ord_grad_transp(1,m,i,j) = ao_coef_normalized_ordered(j,i) * dble(power_ao(m)) ! a_x * c_i 
+       ao_coef_ord_grad_transp(2,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j) ! -2 * c_i * alpha_i 
+       do kk = 1, 2
+        if(power_ord_grad_transp(kk,m,j).lt.0)then
+         ao_coef_ord_grad_transp(kk,m,i,j) = 0.d0
+        endif
+       enddo
+     enddo
+    enddo
+  enddo
+
+END_PROVIDER
+
+ BEGIN_PROVIDER [ double precision, ao_coef_ord_xyz_grad_transp, (4,3,ao_prim_num_max,ao_num) ]
+&BEGIN_PROVIDER [ integer, power_ord_xyz_grad_transp, (4,3,ao_num) ]
+  implicit none
+  BEGIN_DOC
+  ! x * d/dx of an AO in terms of polynoms and coefficients 
+  !
+  ! WARNING !!!! SOME polynoms might be negative !!!!! 
+  !
+  ! WHEN IT IS THE CASE, coefficients are ZERO 
+  END_DOC
+  integer                        :: i,j,power_ao(3), m,num_ao,kk
+  double precision :: center_ao(1:3)
+  do j=1, ao_num
+   power_ao(1:3)= ao_power(j,1:3) 
+   num_ao = ao_nucl(j)
+   center_ao(1:3) = nucl_coord(num_ao,1:3)
+   do m = 1, 3
+     power_ord_xyz_grad_transp(1,m,j)   = power_ao(m) - 1
+     power_ord_xyz_grad_transp(2,m,j)   = power_ao(m)
+     power_ord_xyz_grad_transp(3,m,j)   = power_ao(m) + 1
+     power_ord_xyz_grad_transp(4,m,j)   = power_ao(m) + 2
+     do kk = 1, 4
+      if(power_ord_xyz_grad_transp(kk,m,j).lt.0)then
+       power_ord_xyz_grad_transp(kk,m,j) = -1
+      endif
+     enddo
+   enddo
+   do i=1, ao_prim_num_max
+    do m = 1, 3
+     ao_coef_ord_xyz_grad_transp(1,m,i,j) = dble(power_ao(m)) * ao_coef_normalized_ordered(j,i) * center_ao(m)
+     ao_coef_ord_xyz_grad_transp(2,m,i,j) = dble(power_ao(m)) * ao_coef_normalized_ordered(j,i) 
+     ao_coef_ord_xyz_grad_transp(3,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j) * center_ao(m)
+     ao_coef_ord_xyz_grad_transp(4,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j) 
+     do kk = 1, 4
+      if(power_ord_xyz_grad_transp(kk,m,j).lt.0)then
+       ao_coef_ord_xyz_grad_transp(kk,m,i,j) = 0.d0
+      endif
+     enddo
+    enddo
+   enddo
+  enddo
+
+END_PROVIDER
+
+subroutine xyz_grad_phi_ao(r,i_ao,xyz_grad_phi)
+ implicit none
+ integer, intent(in) :: i_ao
+ double precision, intent(in) :: r(3)
+ double precision, intent(out):: xyz_grad_phi(3) ! x * d/dx phi i, y * d/dy phi_i, z * d/dz phi_
+ double precision :: center_ao(3),beta
+ double precision :: accu(3,4),dr(3),r2,pol_usual(3)
+ integer :: m,power_ao(3),num_ao,j_prim
+ power_ao(1:3)= ao_power(i_ao,1:3) 
+ num_ao = ao_nucl(i_ao)
+ center_ao(1:3) = nucl_coord(num_ao,1:3)
+ dr(1) = (r(1) - center_ao(1))
+ dr(2) = (r(2) - center_ao(2))
+ dr(3) = (r(3) - center_ao(3))
+ r2 = 0.d0
+ do m = 1, 3
+  r2 += dr(m)*dr(m)
+ enddo
+ ! computes the gaussian part 
+ accu = 0.d0
+ do j_prim =1,ao_prim_num(i_ao)
+   beta = ao_expo_ordered_transp(j_prim,i_ao)
+   if(dabs(beta*r2).gt.50.d0)cycle
+   do m = 1, 3
+    accu(m,1) += ao_coef_ord_xyz_grad_transp(1,m,j_prim,i_ao) * dexp(-beta*r2) 
+    accu(m,2) += ao_coef_ord_xyz_grad_transp(2,m,j_prim,i_ao) * dexp(-beta*r2) 
+    accu(m,3) += ao_coef_ord_xyz_grad_transp(3,m,j_prim,i_ao) * dexp(-beta*r2) 
+    accu(m,4) += ao_coef_ord_xyz_grad_transp(4,m,j_prim,i_ao) * dexp(-beta*r2) 
+   enddo
+ enddo
+ ! computes the polynom part
+ pol_usual = 0.d0
+ pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2)) 
+
+ xyz_grad_phi = 0.d0
+ do m = 1, 3
+  xyz_grad_phi(m) += accu(m,2) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(2,m,i_ao))
+  xyz_grad_phi(m) += accu(m,3) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(3,m,i_ao))
+  xyz_grad_phi(m) += accu(m,4) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(4,m,i_ao))
+  if(power_ord_xyz_grad_transp(1,m,i_ao).lt.0)cycle
+  xyz_grad_phi(m) += accu(m,1) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(1,m,i_ao))
+ enddo
+end
+
+subroutine grad_phi_ao(r,i_ao,grad_xyz_phi)
+ implicit none
+ integer, intent(in) :: i_ao
+ double precision, intent(in) :: r(3)
+ double precision, intent(out):: grad_xyz_phi(3) ! x * phi i, y * phi_i, z * phi_
+ double precision :: center_ao(3),beta
+ double precision :: accu(3,2),dr(3),r2,pol_usual(3)
+ integer :: m,power_ao(3),num_ao,j_prim
+ power_ao(1:3)= ao_power(i_ao,1:3) 
+ num_ao = ao_nucl(i_ao)
+ center_ao(1:3) = nucl_coord(num_ao,1:3)
+ dr(1) = (r(1) - center_ao(1))
+ dr(2) = (r(2) - center_ao(2))
+ dr(3) = (r(3) - center_ao(3))
+ r2 = 0.d0
+ do m = 1, 3
+  r2 += dr(m)*dr(m)
+ enddo
+ ! computes the gaussian part 
+ accu = 0.d0
+ do j_prim =1,ao_prim_num(i_ao)
+   beta = ao_expo_ordered_transp(j_prim,i_ao)
+   if(dabs(beta*r2).gt.50.d0)cycle
+   do m = 1, 3
+    accu(m,1) += ao_coef_ord_grad_transp(1,m,j_prim,i_ao) * dexp(-beta*r2) 
+    accu(m,2) += ao_coef_ord_grad_transp(2,m,j_prim,i_ao) * dexp(-beta*r2) 
+   enddo
+ enddo
+ ! computes the polynom part
+ pol_usual = 0.d0
+ pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2)) 
+ do m = 1, 3
+  grad_xyz_phi(m)  = accu(m,2) * pol_usual(m) * dr(m)**dble(power_ord_grad_transp(2,m,i_ao))
+  if(power_ao(m)==0)cycle
+  grad_xyz_phi(m) += accu(m,1) * pol_usual(m) * dr(m)**dble(power_ord_grad_transp(1,m,i_ao))
+ enddo
+end
+
+subroutine xyz_phi_ao(r,i_ao,xyz_phi)
+ implicit none
+ integer, intent(in) :: i_ao
+ double precision, intent(in) :: r(3)
+ double precision, intent(out):: xyz_phi(3) ! x * phi i, y * phi_i, z * phi_i
+ double precision :: center_ao(3),beta
+ double precision :: accu,dr(3),r2,pol_usual(3)
+ integer :: m,power_ao(3),num_ao
+ power_ao(1:3)= ao_power(i_ao,1:3) 
+ num_ao = ao_nucl(i_ao)
+ center_ao(1:3) = nucl_coord(num_ao,1:3)
+ dr(1) = (r(1) - center_ao(1))
+ dr(2) = (r(2) - center_ao(2))
+ dr(3) = (r(3) - center_ao(3))
+ r2 = 0.d0
+ do m = 1, 3
+  r2 += dr(m)*dr(m)
+ enddo
+ ! computes the gaussian part 
+ accu = 0.d0
+ do m=1,ao_prim_num(i_ao)
+   beta = ao_expo_ordered_transp(m,i_ao)
+   if(dabs(beta*r2).gt.50.d0)cycle
+   accu += ao_coef_normalized_ordered_transp(m,i_ao) * dexp(-beta*r2)
+ enddo
+ ! computes the polynom part
+ pol_usual = 0.d0
+ pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2)) 
+ do m = 1, 3
+  xyz_phi(m) = accu * pol_usual(m) * dr(m)**(dble(power_ao(m))) * ( coef_xyz_ao(1,m,i_ao) + coef_xyz_ao(2,m,i_ao) * dr(m) )
+ enddo
+end
+
+
+subroutine test_pol_xyz
+ implicit none
+ integer :: ipoint,i,j,m,jpoint
+ double precision :: r1(3),derf_mu_x
+ double precision :: weight1,r12,xyz_phi(3),grad_phi(3),xyz_grad_phi(3)
+ double precision, allocatable :: aos_array(:),aos_grad_array(:,:)
+ double precision :: num_xyz_phi(3),num_grad_phi(3),num_xyz_grad_phi(3)
+ double precision :: accu_xyz_phi(3),accu_grad_phi(3),accu_xyz_grad_phi(3)
+ double precision :: meta_accu_xyz_phi(3),meta_accu_grad_phi(3),meta_accu_xyz_grad_phi(3)
+ allocate(aos_array(ao_num),aos_grad_array(3,ao_num))
+ meta_accu_xyz_phi     = 0.d0
+ meta_accu_grad_phi    = 0.d0
+ meta_accu_xyz_grad_phi= 0.d0
+ do i = 1, ao_num
+  accu_xyz_phi     = 0.d0
+  accu_grad_phi    = 0.d0
+  accu_xyz_grad_phi= 0.d0
+
+  do ipoint = 1, n_points_final_grid
+   r1(:) = final_grid_points(:,ipoint)
+   weight1 = final_weight_at_r_vector(ipoint)
+   call give_all_aos_and_grad_at_r(r1,aos_array,aos_grad_array)
+   do m = 1, 3
+    num_xyz_phi(m)      = r1(m) *  aos_array(i)  
+    num_grad_phi(m)     = aos_grad_array(m,i)  
+    num_xyz_grad_phi(m) = r1(m) *  aos_grad_array(m,i) 
+   enddo
+   call xyz_phi_ao(r1,i,xyz_phi)
+   call grad_phi_ao(r1,i,grad_phi)
+   call xyz_grad_phi_ao(r1,i,xyz_grad_phi)
+   do m = 1, 3
+    accu_xyz_phi(m)      += weight1 * dabs(num_xyz_phi(m)      -  xyz_phi(m)     )
+    accu_grad_phi(m)     += weight1 * dabs(num_grad_phi(m)     -  grad_phi(m)    )
+    accu_xyz_grad_phi(m) += weight1 * dabs(num_xyz_grad_phi(m) -  xyz_grad_phi(m))
+   enddo
+  enddo
+  print*,''
+  print*,''
+  print*,'i,',i
+  print*,''
+  do m = 1, 3
+!    print*, 'm, accu_xyz_phi(m)  ' ,m, accu_xyz_phi(m)  
+!    print*, 'm, accu_grad_phi(m) ' ,m, accu_grad_phi(m)         
+    print*, 'm, accu_xyz_grad_phi' ,m, accu_xyz_grad_phi(m)
+  enddo
+  do m = 1, 3
+   meta_accu_xyz_phi(m) += dabs(accu_xyz_phi(m))
+   meta_accu_grad_phi(m) += dabs(accu_grad_phi(m))
+   meta_accu_xyz_grad_phi(m) += dabs(accu_xyz_grad_phi(m))
+  enddo
+ enddo
+  do m = 1, 3
+!    print*, 'm, meta_accu_xyz_phi(m)  ' ,m, meta_accu_xyz_phi(m)  
+!    print*, 'm, meta_accu_grad_phi(m) ' ,m, meta_accu_grad_phi(m)         
+    print*, 'm, meta_accu_xyz_grad_phi' ,m, meta_accu_xyz_grad_phi(m)
+  enddo
+
+
+
+end
+
+subroutine test_ints_semi_bis
+ implicit none
+ integer :: ipoint,i,j,m
+ double precision :: r1(3), aos_grad_array_r1(3, ao_num), aos_array_r1(ao_num)
+ double precision :: C_center(3), weight1,mu_in,r12,derf_mu_x,dxyz_ints(3),NAI_pol_mult_erf_ao
+ double precision :: ao_mat(ao_num,ao_num),ao_xmat(3,ao_num,ao_num),accu1, accu2(3)
+ mu_in = 0.5d0
+ C_center = 0.d0
+ C_center(1) = 0.25d0
+ C_center(3) = 1.12d0
+ C_center(2) = -1.d0
+ ao_mat = 0.d0
+ ao_xmat = 0.d0
+ do ipoint = 1, n_points_final_grid
+  r1(1) = final_grid_points(1,ipoint)
+  r1(2) = final_grid_points(2,ipoint)
+  r1(3) = final_grid_points(3,ipoint)
+  call give_all_aos_and_grad_at_r(r1,aos_array_r1,aos_grad_array_r1)
+  weight1 = final_weight_at_r_vector(ipoint)
+  r12 = (r1(1) - C_center(1))**2.d0 + (r1(2) - C_center(2))**2.d0 + (r1(3) - C_center(3))**2.d0 
+  r12 = dsqrt(r12)
+  do i = 1, ao_num
+   do j = 1, ao_num
+    ao_mat(j,i)  += aos_array_r1(i) * aos_array_r1(j) * weight1 * derf_mu_x(mu_in,r12)
+    do m = 1, 3
+     ao_xmat(m,j,i) += r1(m) * aos_array_r1(j) * aos_grad_array_r1(m,i) * weight1 * derf_mu_x(mu_in,r12)
+    enddo
+   enddo
+  enddo
+ enddo
+
+ accu1 = 0.d0
+ accu2 = 0.d0
+ accu1relat = 0.d0
+ accu2relat = 0.d0
+ double precision :: accu1relat, accu2relat(3)
+ double precision :: contrib(3)
+ do i = 1, ao_num
+  do j = 1, ao_num
+   call phi_j_erf_mu_r_xyz_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
+   print*,''
+   print*,'i,j',i,j
+   print*,dxyz_ints(:)
+   print*,ao_xmat(:,j,i)
+   do m = 1, 3
+    contrib(m) = dabs(ao_xmat(m,j,i) - dxyz_ints(m))
+    accu2(m) += contrib(m)
+    if(dabs(ao_xmat(m,j,i)).gt.1.d-10)then
+     accu2relat(m) += dabs(ao_xmat(m,j,i) - dxyz_ints(m))/dabs(ao_xmat(m,j,i))
+    endif
+   enddo
+    print*,contrib
+  enddo
+   print*,''
+ enddo
+ print*,'accu2relat = '
+ print*, accu2relat /dble(ao_num * ao_num)
+
+end
+
+

src/ao_one_e_ints/pot_ao_erf_ints.irp.f

@@ -46,34 +46,37 @@ double precision function NAI_pol_mult_erf_ao(i_ao,j_ao,mu_in,C_center)
 
 end
 
+double precision function NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in, mu_in)
 
-
-double precision function NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)
   BEGIN_DOC
+  !
   ! Computes the following integral :
   !
   ! .. math::
   !
   !   \int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
-  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !   \frac{\erf(\mu |r - R_C |)}{| r - R_C |}$.
   !
   END_DOC
 
+  include 'utils/constants.include.F'
+
   implicit none
   integer,          intent(in) :: n_pt_in
-  double precision,intent(in)    :: C_center(3),A_center(3),B_center(3),alpha,beta,mu_in
+  integer,          intent(in) :: power_A(3), power_B(3)
-  integer, intent(in)            :: power_A(3),power_B(3)
+  double precision, intent(in) :: C_center(3), A_center(3), B_center(3), alpha, beta, mu_in
-  integer                        :: i,j,k,l,n_pt
+
-  double precision               :: P_center(3)
+  integer                      :: i, n_pt, n_pt_out
+  double precision             :: P_center(3)
+  double precision             :: d(0:n_pt_in), coeff, dist, const, factor
+  double precision             :: const_factor, dist_integral
+  double precision             :: accu, p_inv, p, rho, p_inv_2
+  double precision             :: p_new
+
+  double precision             :: rint
 
-  double precision               :: d(0:n_pt_in),pouet,coeff,dist,const,pouet_2,factor
-  double precision               :: I_n_special_exact,integrate_bourrin,I_n_bibi
-  double precision               :: V_e_n,const_factor,dist_integral,tmp
-  double precision               :: accu,rint,p_inv,p,rho,p_inv_2
-  integer                        :: n_pt_out,lmax
-  include 'utils/constants.include.F'
   p       = alpha + beta
-  p_inv = 1.d0/p
+  p_inv   = 1.d0 / p
   p_inv_2 = 0.5d0 * p_inv
   rho     = alpha * beta * p_inv
 
@@ -81,76 +84,263 @@ double precision function NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alp
   dist_integral = 0.d0
   do i = 1, 3
     P_center(i)    = (alpha * A_center(i) + beta * B_center(i)) * p_inv
-    dist += (A_center(i) - B_center(i))*(A_center(i) - B_center(i))
+    dist          += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
-    dist_integral += (P_center(i) - C_center(i))*(P_center(i) - C_center(i))
+    dist_integral += (P_center(i) - C_center(i)) * (P_center(i) - C_center(i))
   enddo
-  const_factor = dist*rho
+  const_factor = dist * rho
-  if(const_factor > 80.d0)then
+  if(const_factor > 80.d0) then
     NAI_pol_mult_erf = 0.d0
     return
   endif
-  double precision               :: p_new
+
-  p_new = mu_in/dsqrt(p+ mu_in * mu_in)
+  p_new  = mu_in / dsqrt(p + mu_in * mu_in)
   factor = dexp(-const_factor)
   coeff  = dtwo_pi * factor * p_inv * p_new
-  lmax = 20
 
-  !  print*, "b"
+  n_pt  =  2 * ( (power_A(1) + power_B(1)) + (power_A(2) + power_B(2)) + (power_A(3) + power_B(3)) )
+  const = p * dist_integral * p_new * p_new
+  if(n_pt == 0) then
+    NAI_pol_mult_erf = coeff * rint(0, const)
+    return
+  endif
+
   do i = 0, n_pt_in
     d(i) = 0.d0
   enddo
-  n_pt =  2 * ( (power_A(1) + power_B(1)) +(power_A(2) + power_B(2)) +(power_A(3) + power_B(3)) )
-  const = p * dist_integral * p_new * p_new
-  if (n_pt == 0) then
-    pouet = rint(0,const)
-    NAI_pol_mult_erf = coeff * pouet
-    return
-  endif
-
   ! call give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in)
   p_new = p_new * p_new
-  call give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in,p,p_inv,p_inv_2,p_new,P_center)
+  call give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
 
-
+  if(n_pt_out < 0) then
-  if(n_pt_out<0)then
     NAI_pol_mult_erf = 0.d0
     return
   endif
-  accu = 0.d0
 
   ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
-  do i =0 ,n_pt_out,2
+  accu = 0.d0
-    accu +=  d(i) * rint(i/2,const)
+  do i = 0, n_pt_out, 2
+    accu += d(i) * rint(i/2, const)
   enddo
   NAI_pol_mult_erf = accu * coeff
 
-end
+end function NAI_pol_mult_erf
+
+! ---
 
 
-subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,beta,&
+double precision function NAI_pol_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center)
-      power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in,p,p_inv,p_inv_2,p_new,P_center)
+
+  BEGIN_DOC
+  !
+  ! Computes the following integral :
+  ! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
+  !
+  END_DOC
+
+  implicit none
+  integer,          intent(in)   :: i_ao, j_ao
+  double precision, intent(in)   :: beta, B_center(3)
+  double precision, intent(in)   :: mu_in, C_center(3)
+
+  integer                        :: i, j, power_A1(3), power_A2(3), n_pt_in
+  double precision               :: A1_center(3), A2_center(3), alpha1, alpha2, coef12, coef1, integral
+
+  double precision, external     :: NAI_pol_mult_erf_with1s, NAI_pol_mult_erf_ao
+
+  ASSERT(beta .ge. 0.d0)
+  if(beta .lt. 1d-10) then
+    NAI_pol_mult_erf_ao_with1s = NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
+    return
+  endif
+
+  power_A1(1:3) = ao_power(i_ao,1:3)
+  power_A2(1:3) = ao_power(j_ao,1:3)
+
+  A1_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
+  A2_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
+
+  n_pt_in = n_pt_max_integrals
+
+  NAI_pol_mult_erf_ao_with1s = 0.d0
+  do i = 1, ao_prim_num(i_ao)
+    alpha1 = ao_expo_ordered_transp           (i,i_ao)
+    coef1  = ao_coef_normalized_ordered_transp(i,i_ao)
+
+    do j = 1, ao_prim_num(j_ao)
+      alpha2 = ao_expo_ordered_transp(j,j_ao)
+      coef12 = coef1 * ao_coef_normalized_ordered_transp(j,j_ao)
+      if(dabs(coef12) .lt. 1d-14) cycle
+
+      integral = NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
+                                        , beta, B_center, C_center, n_pt_in, mu_in )
+
+      NAI_pol_mult_erf_ao_with1s += integral * coef12
+    enddo
+  enddo
+
+end function NAI_pol_mult_erf_ao_with1s
+
+subroutine NAI_pol_mult_erf_with1s_v(A1_center, A2_center, power_A1, power_A2, alpha1, alpha2, beta, B_center, LD_B, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
+
+  BEGIN_DOC
+  !
+  ! Computes the following integral :
+  !
+  ! .. math                      ::
+  !
+  !   \int dx (x - A1_x)^a_1 (x - B1_x)^a_2 \exp(-\alpha_1 (x - A1_x)^2 - \alpha_2 (x - A2_x)^2)
+  !   \int dy (y - A1_y)^b_1 (y - B1_y)^b_2 \exp(-\alpha_1 (y - A1_y)^2 - \alpha_2 (y - A2_y)^2)
+  !   \int dz (x - A1_z)^c_1 (z - B1_z)^c_2 \exp(-\alpha_1 (z - A1_z)^2 - \alpha_2 (z - A2_z)^2)
+  !   \exp(-\beta (r - B)^2)
+  !   \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+  integer,          intent(in)  :: n_pt_in, LD_B, LD_C, LD_resv, n_points
+  integer,          intent(in)  :: power_A1(3), power_A2(3)
+  double precision, intent(in)  :: A1_center(3), A2_center(3)
+  double precision, intent(in)  :: C_center(LD_C,3), B_center(LD_B,3)
+  double precision, intent(in)  :: alpha1, alpha2, beta, mu_in
+  double precision, intent(out) :: res_v(LD_resv)
+
+  integer                       :: i, n_pt, n_pt_out, ipoint
+  double precision              :: alpha12, alpha12_inv, alpha12_inv_2, rho12, A12_center(3), dist12, const_factor12
+  double precision              :: p, p_inv, p_inv_2, rho, P_center(3), dist, const_factor
+  double precision              :: dist_integral
+  double precision              :: d(0:n_pt_in), coeff, const, factor
+  double precision              :: accu
+  double precision              :: p_new, p_new2, coef_tmp, cons_tmp
+
+  double precision              :: rint
+
+
+  res_V(1:LD_resv) = 0.d0
+
+  ! e^{-alpha1 (r - A1)^2} e^{-alpha2 (r - A2)^2} = e^{-K12} e^{-alpha12 (r - A12)^2}
+  alpha12       = alpha1 + alpha2
+  alpha12_inv   = 1.d0 / alpha12
+  alpha12_inv_2 = 0.5d0 * alpha12_inv
+  rho12         = alpha1 * alpha2 * alpha12_inv
+  A12_center(1) = (alpha1 * A1_center(1) + alpha2 * A2_center(1)) * alpha12_inv
+  A12_center(2) = (alpha1 * A1_center(2) + alpha2 * A2_center(2)) * alpha12_inv
+  A12_center(3) = (alpha1 * A1_center(3) + alpha2 * A2_center(3)) * alpha12_inv
+  dist12        = (A1_center(1) - A2_center(1)) * (A1_center(1) - A2_center(1))&
+                + (A1_center(2) - A2_center(2)) * (A1_center(2) - A2_center(2))&
+                + (A1_center(3) - A2_center(3)) * (A1_center(3) - A2_center(3))
+
+  const_factor12 = dist12 * rho12
+  if(const_factor12 > 80.d0) then
+    return
+  endif
+
+  ! e^{-K12} e^{-alpha12 (r - A12)^2} e^{-beta (r - B)^2} = e^{-K} e^{-p (r - P)^2}
+  p        = alpha12 + beta
+  p_inv    = 1.d0 / p
+  p_inv_2  = 0.5d0 * p_inv
+  rho      = alpha12 * beta * p_inv
+  p_new    = mu_in / dsqrt(p + mu_in * mu_in)
+  p_new2   = p_new * p_new
+  coef_tmp = dtwo_pi * p_inv * p_new
+  cons_tmp = p * p_new2
+  n_pt     =  2 * (power_A1(1) + power_A2(1) + power_A1(2) + power_A2(2) + power_A1(3) + power_A2(3) )
+
+  if(n_pt == 0) then
+
+    do ipoint = 1, n_points
+
+      dist = (A12_center(1) - B_center(ipoint,1)) * (A12_center(1) - B_center(ipoint,1))&
+           + (A12_center(2) - B_center(ipoint,2)) * (A12_center(2) - B_center(ipoint,2))&
+           + (A12_center(3) - B_center(ipoint,3)) * (A12_center(3) - B_center(ipoint,3))
+      const_factor = const_factor12 + dist * rho
+      if(const_factor > 80.d0) cycle
+      coeff = coef_tmp * dexp(-const_factor)
+
+      P_center(1) = (alpha12 * A12_center(1) + beta * B_center(ipoint,1)) * p_inv
+      P_center(2) = (alpha12 * A12_center(2) + beta * B_center(ipoint,2)) * p_inv
+      P_center(3) = (alpha12 * A12_center(3) + beta * B_center(ipoint,3)) * p_inv
+      dist_integral = (P_center(1) - C_center(ipoint,1)) * (P_center(1) - C_center(ipoint,1))&
+                    + (P_center(2) - C_center(ipoint,2)) * (P_center(2) - C_center(ipoint,2))&
+                    + (P_center(3) - C_center(ipoint,3)) * (P_center(3) - C_center(ipoint,3))
+      const = cons_tmp * dist_integral
+
+      res_v(ipoint) = coeff * rint(0, const)
+    enddo
+
+  else
+
+    do ipoint = 1, n_points
+  
+      dist = (A12_center(1) - B_center(ipoint,1)) * (A12_center(1) - B_center(ipoint,1))&
+           + (A12_center(2) - B_center(ipoint,2)) * (A12_center(2) - B_center(ipoint,2))&
+           + (A12_center(3) - B_center(ipoint,3)) * (A12_center(3) - B_center(ipoint,3)) 
+      const_factor = const_factor12 + dist * rho
+      if(const_factor > 80.d0) cycle
+      coeff = coef_tmp * dexp(-const_factor)
+  
+      P_center(1) = (alpha12 * A12_center(1) + beta * B_center(ipoint,1)) * p_inv
+      P_center(2) = (alpha12 * A12_center(2) + beta * B_center(ipoint,2)) * p_inv
+      P_center(3) = (alpha12 * A12_center(3) + beta * B_center(ipoint,3)) * p_inv
+      dist_integral = (P_center(1) - C_center(ipoint,1)) * (P_center(1) - C_center(ipoint,1))&
+                    + (P_center(2) - C_center(ipoint,2)) * (P_center(2) - C_center(ipoint,2))&
+                    + (P_center(3) - C_center(ipoint,3)) * (P_center(3) - C_center(ipoint,3))
+      const = cons_tmp * dist_integral
+  
+      do i = 0, n_pt_in
+        d(i) = 0.d0
+      enddo
+      !TODO: VECTORIZE HERE
+      call give_polynomial_mult_center_one_e_erf_opt(A1_center, A2_center, power_A1, power_A2, C_center(ipoint,1:3), n_pt_in, d, n_pt_out, p_inv_2, p_new2, P_center)
+  
+      if(n_pt_out < 0) then
+        cycle
+      endif
+  
+      ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
+      accu = 0.d0
+      do i = 0, n_pt_out, 2
+        accu += d(i) * rint(i/2, const)
+      enddo
+  
+      res_v(ipoint) = accu * coeff
+    enddo
+
+  endif
+
+end subroutine NAI_pol_mult_erf_with1s_v
+
+! ---
+
+subroutine give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
+
   BEGIN_DOC
   ! Returns the explicit polynomial in terms of the $t$ variable of the
   ! following polynomial:
   !
   ! $I_{x1}(a_x, d_x,p,q) \times I_{x1}(a_y, d_y,p,q) \times I_{x1}(a_z, d_z,p,q)$.
   END_DOC
+
   implicit none
   integer,          intent(in)  :: n_pt_in
-  integer,intent(out)            :: n_pt_out
-  double precision, intent(in)   :: A_center(3), B_center(3),C_center(3),p,p_inv,p_inv_2,p_new,P_center(3)
-  double precision, intent(in)   :: alpha,beta,mu_in
   integer,          intent(in)  :: power_A(3), power_B(3)
-  integer                        :: a_x,b_x,a_y,b_y,a_z,b_z
+  double precision, intent(in)  :: A_center(3), B_center(3), C_center(3), p_inv_2, p_new, P_center(3)
-  double precision               :: d(0:n_pt_in)
+  integer,          intent(out) :: n_pt_out
+  double precision, intent(out) :: d(0:n_pt_in)
+
+  integer                       :: a_x, b_x, a_y, b_y, a_z, b_z
+  integer                       :: n_pt1, n_pt2, n_pt3, dim, i
+  integer                       :: n_pt_tmp
   double precision              :: d1(0:n_pt_in)
   double precision              :: d2(0:n_pt_in)
   double precision              :: d3(0:n_pt_in)
   double precision              :: accu
+  double precision              :: R1x(0:2), B01(0:2), R1xp(0:2), R2x(0:2)
+
   accu = 0.d0
   ASSERT (n_pt_in > 1)
 
-  double precision               :: R1x(0:2), B01(0:2), R1xp(0:2),R2x(0:2)
   R1x(0) = (P_center(1) - A_center(1))
   R1x(1) = 0.d0
   R1x(2) = -(P_center(1) - C_center(1))* p_new
@@ -161,27 +351,22 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,bet
   !R1xp = (P_x - B_x) - (P_x - C_x) ( t * mu/sqrt(p+mu^2) )^2
   R2x(0) =  p_inv_2
   R2x(1) = 0.d0
-  R2x(2)  = -p_inv_2* p_new
+  R2x(2) = -p_inv_2 * p_new
   !R2x  = 0.5 / p - 0.5/p ( t * mu/sqrt(p+mu^2) )^2
-  do i = 0,n_pt_in
+
-    d(i) = 0.d0
+  do i = 0, n_pt_in
-  enddo
+    d (i) = 0.d0
-  do i = 0,n_pt_in
     d1(i) = 0.d0
-  enddo
-  do i = 0,n_pt_in
     d2(i) = 0.d0
-  enddo
-  do i = 0,n_pt_in
     d3(i) = 0.d0
   enddo
-  integer                        :: n_pt1,n_pt2,n_pt3,dim,i
+
   n_pt1 = n_pt_in
   n_pt2 = n_pt_in
   n_pt3 = n_pt_in
   a_x = power_A(1)
   b_x = power_B(1)
-  call I_x1_pol_mult_one_e(a_x,b_x,R1x,R1xp,R2x,d1,n_pt1,n_pt_in)
+  call I_x1_pol_mult_one_e(a_x, b_x, R1x, R1xp, R2x, d1, n_pt1, n_pt_in)
   if(n_pt1<0)then
     n_pt_out = -1
     do i = 0,n_pt_in
@@ -200,7 +385,7 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,bet
   !R1xp = (P_x - B_x) - (P_x - C_x) ( t * mu/sqrt(p+mu^2) )^2
   a_y = power_A(2)
   b_y = power_B(2)
-  call I_x1_pol_mult_one_e(a_y,b_y,R1x,R1xp,R2x,d2,n_pt2,n_pt_in)
+  call I_x1_pol_mult_one_e(a_y, b_y, R1x, R1xp, R2x, d2, n_pt2, n_pt_in)
   if(n_pt2<0)then
     n_pt_out = -1
     do i = 0,n_pt_in
@@ -209,51 +394,151 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,bet
     return
   endif
 
-
   R1x(0) = (P_center(3) - A_center(3))
   R1x(1) = 0.d0
-  R1x(2)  = -(P_center(3) - C_center(3))* p_new
+  R1x(2) = -(P_center(3) - C_center(3)) * p_new
   ! R1x = (P_x - A_x) - (P_x - C_x) ( t * mu/sqrt(p+mu^2) )^2
   R1xp(0) = (P_center(3) - B_center(3))
   R1xp(1) = 0.d0
-  R1xp(2)  =-(P_center(3) - C_center(3))* p_new
+  R1xp(2) =-(P_center(3) - C_center(3)) * p_new
   !R2x  = 0.5 / p - 0.5/p ( t * mu/sqrt(p+mu^2) )^2
   a_z = power_A(3)
   b_z = power_B(3)
 
-  call I_x1_pol_mult_one_e(a_z,b_z,R1x,R1xp,R2x,d3,n_pt3,n_pt_in)
+  call I_x1_pol_mult_one_e(a_z, b_z, R1x, R1xp, R2x, d3, n_pt3, n_pt_in)
-  if(n_pt3<0)then
+  if(n_pt3 < 0) then
     n_pt_out = -1
     do i = 0,n_pt_in
       d(i) = 0.d0
     enddo
     return
   endif
-  integer                        :: n_pt_tmp
+
   n_pt_tmp = 0
-  call multiply_poly(d1,n_pt1,d2,n_pt2,d,n_pt_tmp)
+  call multiply_poly(d1, n_pt1, d2, n_pt2, d, n_pt_tmp)
-  do i = 0,n_pt_tmp
+  do i = 0, n_pt_tmp
     d1(i) = 0.d0
   enddo
   n_pt_out = 0
-  call multiply_poly(d ,n_pt_tmp ,d3,n_pt3,d1,n_pt_out)
+  call multiply_poly(d, n_pt_tmp, d3, n_pt3, d1, n_pt_out)
   do i = 0, n_pt_out
     d(i) = d1(i)
   enddo
 
-end
+end subroutine give_polynomial_mult_center_one_e_erf_opt
+
+! ---
+subroutine NAI_pol_mult_erf_v(A_center, B_center, power_A, power_B, alpha, beta, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
+
+  BEGIN_DOC
+  !
+  ! Computes the following integral :
+  !
+  ! .. math::
+  !
+  !   \int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu |r - R_C |)}{| r - R_C |}$.
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer,          intent(in)  :: n_pt_in, n_points, LD_C, LD_resv
+  integer,          intent(in)  :: power_A(3), power_B(3)
+  double precision, intent(in)  :: A_center(3), B_center(3), alpha, beta, mu_in
+  double precision, intent(in)  :: C_center(LD_C,3)
+  double precision, intent(out) :: res_v(LD_resv)
+
+  integer                       :: i, n_pt, n_pt_out, ipoint
+  double precision              :: P_center(3)
+  double precision              :: d(0:n_pt_in), coeff, dist, const, factor
+  double precision              :: const_factor, dist_integral
+  double precision              :: accu, p_inv, p, rho, p_inv_2
+  double precision              :: p_new, p_new2, coef_tmp
+
+  double precision              :: rint
+
+  res_V(1:LD_resv) = 0.d0
+
+  p        = alpha + beta
+  p_inv    = 1.d0 / p
+  p_inv_2  = 0.5d0 * p_inv
+  rho      = alpha * beta * p_inv
+  p_new    = mu_in / dsqrt(p + mu_in * mu_in)
+  p_new2   = p_new * p_new
+  coef_tmp = p * p_new2
+
+  dist = 0.d0
+  do i = 1, 3
+    P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
+    dist       += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
+  enddo
+
+  const_factor = dist * rho
+  if(const_factor > 80.d0) then
+    return
+  endif
+  factor = dexp(-const_factor)
+  coeff  = dtwo_pi * factor * p_inv * p_new
+
+  n_pt =  2 * ( power_A(1) + power_B(1) + power_A(2) + power_B(2) + power_A(3) + power_B(3) )
+
+  if(n_pt == 0) then
+
+    do ipoint = 1, n_points
+      dist_integral = 0.d0
+      do i = 1, 3
+        dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
+      enddo
+      const = coef_tmp * dist_integral
+
+      res_v(ipoint) = coeff * rint(0, const)
+    enddo
+
+  else
+
+    do ipoint = 1, n_points
+      dist_integral = 0.d0
+      do i = 1, 3
+        dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
+      enddo
+      const = coef_tmp * dist_integral
+
+      do i = 0, n_pt_in
+        d(i) = 0.d0
+      enddo
+      call give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center(ipoint,1:3), n_pt_in, d, n_pt_out, p_inv_2, p_new2, P_center)                                                                                                                                                                                                                                                                                                                                                                                                                                                                  
+
+      if(n_pt_out < 0) then
+        res_v(ipoint) = 0.d0
+        cycle
+      endif
+
+      ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
+      accu = 0.d0
+      do i = 0, n_pt_out, 2
+        accu += d(i) * rint(i/2, const)
+      enddo
+
+      res_v(ipoint) = accu * coeff
+    enddo
+
+  endif
+
+end subroutine NAI_pol_mult_erf_v
 
 
+subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in)
 
-
-subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,&
-      power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in)
   BEGIN_DOC
   ! Returns the explicit polynomial in terms of the $t$ variable of the
   ! following polynomial:
   !
   ! $I_{x1}(a_x, d_x,p,q) \times I_{x1}(a_y, d_y,p,q) \times I_{x1}(a_z, d_z,p,q)$.
   END_DOC
+
   implicit none
   integer, intent(in)            :: n_pt_in
   integer,intent(out)            :: n_pt_out
@@ -374,3 +659,113 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,&
 
 end
 
+double precision function NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
+                                                 , beta, B_center, C_center, n_pt_in, mu_in )
+
+  BEGIN_DOC
+  !
+  ! Computes the following integral :
+  !
+  ! .. math::
+  !
+  !   \int dx (x - A1_x)^a_1 (x - B1_x)^a_2 \exp(-\alpha_1 (x - A1_x)^2 - \alpha_2 (x - A2_x)^2)
+  !   \int dy (y - A1_y)^b_1 (y - B1_y)^b_2 \exp(-\alpha_1 (y - A1_y)^2 - \alpha_2 (y - A2_y)^2)
+  !   \int dz (x - A1_z)^c_1 (z - B1_z)^c_2 \exp(-\alpha_1 (z - A1_z)^2 - \alpha_2 (z - A2_z)^2)
+  !   \exp(-\beta (r - B)^2)
+  !   \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+  integer,          intent(in) :: n_pt_in
+  integer,          intent(in) :: power_A1(3), power_A2(3)
+  double precision, intent(in) :: C_center(3), A1_center(3), A2_center(3), B_center(3)
+  double precision, intent(in) :: alpha1, alpha2, beta, mu_in
+
+  integer                      :: i, n_pt, n_pt_out
+  double precision             :: alpha12, alpha12_inv, alpha12_inv_2, rho12, A12_center(3), dist12, const_factor12
+  double precision             :: p, p_inv, p_inv_2, rho, P_center(3), dist, const_factor
+  double precision             :: dist_integral
+  double precision             :: d(0:n_pt_in), coeff, const, factor
+  double precision             :: accu
+  double precision             :: p_new
+
+  double precision             :: rint
+
+
+  ! e^{-alpha1 (r - A1)^2} e^{-alpha2 (r - A2)^2} = e^{-K12} e^{-alpha12 (r - A12)^2}
+  alpha12       = alpha1 + alpha2
+  alpha12_inv   = 1.d0 / alpha12
+  alpha12_inv_2 = 0.5d0 * alpha12_inv
+  rho12         = alpha1 * alpha2 * alpha12_inv
+  A12_center(1) = (alpha1 * A1_center(1) + alpha2 * A2_center(1)) * alpha12_inv
+  A12_center(2) = (alpha1 * A1_center(2) + alpha2 * A2_center(2)) * alpha12_inv
+  A12_center(3) = (alpha1 * A1_center(3) + alpha2 * A2_center(3)) * alpha12_inv
+  dist12        = (A1_center(1) - A2_center(1)) * (A1_center(1) - A2_center(1)) &
+                + (A1_center(2) - A2_center(2)) * (A1_center(2) - A2_center(2)) &
+                + (A1_center(3) - A2_center(3)) * (A1_center(3) - A2_center(3))
+
+  const_factor12 = dist12 * rho12
+  if(const_factor12 > 80.d0) then
+    NAI_pol_mult_erf_with1s = 0.d0
+    return
+  endif
+
+  ! ---
+
+  ! e^{-K12} e^{-alpha12 (r - A12)^2} e^{-beta (r - B)^2} = e^{-K} e^{-p (r - P)^2}
+  p           = alpha12 + beta
+  p_inv       = 1.d0 / p
+  p_inv_2     = 0.5d0 * p_inv
+  rho         = alpha12 * beta * p_inv
+  P_center(1) = (alpha12 * A12_center(1) + beta * B_center(1)) * p_inv
+  P_center(2) = (alpha12 * A12_center(2) + beta * B_center(2)) * p_inv
+  P_center(3) = (alpha12 * A12_center(3) + beta * B_center(3)) * p_inv
+  dist        = (A12_center(1) - B_center(1)) * (A12_center(1) - B_center(1)) &
+              + (A12_center(2) - B_center(2)) * (A12_center(2) - B_center(2)) &
+              + (A12_center(3) - B_center(3)) * (A12_center(3) - B_center(3))
+
+  const_factor = const_factor12 + dist * rho
+  if(const_factor > 80.d0) then
+    NAI_pol_mult_erf_with1s = 0.d0
+    return
+  endif
+
+  dist_integral = (P_center(1) - C_center(1)) * (P_center(1) - C_center(1)) &
+                + (P_center(2) - C_center(2)) * (P_center(2) - C_center(2)) &
+                + (P_center(3) - C_center(3)) * (P_center(3) - C_center(3))
+
+  ! ---
+
+  p_new  = mu_in / dsqrt(p + mu_in * mu_in)
+  factor = dexp(-const_factor)
+  coeff  = dtwo_pi * factor * p_inv * p_new
+
+  n_pt  =  2 * ( (power_A1(1) + power_A2(1)) + (power_A1(2) + power_A2(2)) + (power_A1(3) + power_A2(3)) )
+  const = p * dist_integral * p_new * p_new
+  if(n_pt == 0) then
+    NAI_pol_mult_erf_with1s = coeff * rint(0, const)
+    return
+  endif
+
+  do i = 0, n_pt_in
+    d(i) = 0.d0
+  enddo
+  p_new = p_new * p_new
+  call give_polynomial_mult_center_one_e_erf_opt( A1_center, A2_center, power_A1, power_A2, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
+
+  if(n_pt_out < 0) then
+    NAI_pol_mult_erf_with1s = 0.d0
+    return
+  endif
+
+  ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
+  accu = 0.d0
+  do i = 0, n_pt_out, 2
+    accu += d(i) * rint(i/2, const)
+  enddo
+  NAI_pol_mult_erf_with1s = accu * coeff
+
+end function NAI_pol_mult_erf_with1s

src/ao_one_e_ints/pot_ao_ints.irp.f

@@ -80,6 +80,10 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
     IF (DO_PSEUDO) THEN
        ao_integrals_n_e += ao_pseudo_integrals
     ENDIF
+    IF(point_charges) THEN
+       ao_integrals_n_e += ao_integrals_pt_chrg
+    ENDIF
+
 
   endif
 

src/ao_one_e_ints/pot_pt_charges.irp.f

@@ -0,0 +1,108 @@
+
+BEGIN_PROVIDER [ double precision, ao_integrals_pt_chrg, (ao_num,ao_num)]
+
+  BEGIN_DOC
+  !  Point charge-electron interaction, in the |AO| basis set.
+  !
+  !  :math:`\langle \chi_i | -\sum_charge charge * \frac{1}{|r-R_charge|} | \chi_j \rangle`
+  !
+  ! Notice the minus sign convention as it is supposed to be for electrons. 
+  END_DOC
+
+  implicit none
+  integer          :: num_A, num_B, power_A(3), power_B(3)
+  integer          :: i, j, k, l, n_pt_in, m
+  double precision :: alpha, beta
+  double precision :: A_center(3),B_center(3),C_center(3)
+  double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
+
+  ao_integrals_pt_chrg = 0.d0
+
+!  if (read_ao_integrals_pt_chrg) then
+!
+!    call ezfio_get_ao_one_e_ints_ao_integrals_pt_chrg(ao_integrals_pt_chrg)
+!    print *,  'AO N-e integrals read from disk'
+!
+!  else
+
+!    if(use_cosgtos) then
+!      !print *, " use_cosgtos for ao_integrals_pt_chrg ?", use_cosgtos
+!
+!      do j = 1, ao_num
+!        do i = 1, ao_num
+!          ao_integrals_pt_chrg(i,j) = ao_integrals_pt_chrg_cosgtos(i,j)
+!        enddo
+!      enddo
+!
+!    else
+
+      !$OMP PARALLEL                                                   &
+          !$OMP DEFAULT (NONE)                                         &
+          !$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,&
+          !$OMP          num_A,num_B,Z,c,c1,n_pt_in)                      &
+          !$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,pts_charge_coord,ao_coef_normalized_ordered_transp,nucl_coord,&
+          !$OMP         n_pt_max_integrals,ao_integrals_pt_chrg,n_pts_charge,pts_charge_z)
+
+      n_pt_in = n_pt_max_integrals
+
+      !$OMP DO SCHEDULE (dynamic)
+
+      do j = 1, ao_num
+        num_A = ao_nucl(j)
+        power_A(1:3)= ao_power(j,1:3)
+        A_center(1:3) = nucl_coord(num_A,1:3)
+
+        do i = 1, ao_num
+
+          num_B = ao_nucl(i)
+          power_B(1:3)= ao_power(i,1:3)
+          B_center(1:3) = nucl_coord(num_B,1:3)
+
+          do l=1,ao_prim_num(j)
+            alpha = ao_expo_ordered_transp(l,j)
+
+            do m=1,ao_prim_num(i)
+              beta = ao_expo_ordered_transp(m,i)
+
+              double precision               :: c, c1
+              c = 0.d0
+
+              do  k = 1, n_pts_charge
+                double precision               :: Z
+                Z = pts_charge_z(k)
+
+                C_center(1:3) = pts_charge_coord(k,1:3)
+
+                c1 = NAI_pol_mult( A_center, B_center, power_A, power_B &
+                                 , alpha, beta, C_center, n_pt_in )
+
+                c = c - Z * c1
+
+              enddo
+              ao_integrals_pt_chrg(i,j) = ao_integrals_pt_chrg(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
+
+
+!    IF(do_pseudo) THEN
+!       ao_integrals_pt_chrg += ao_pseudo_integrals
+!    ENDIF
+
+!  endif
+
+
+!  if (write_ao_integrals_pt_chrg) then
+!    call ezfio_set_ao_one_e_ints_ao_integrals_pt_chrg(ao_integrals_pt_chrg)
+!    print *,  'AO N-e integrals written to disk'
+!  endif
+
+END_PROVIDER

src/ao_tc_eff_map/NEED

@@ -0,0 +1,5 @@
+ao_two_e_erf_ints
+mo_one_e_ints
+ao_many_one_e_ints
+dft_utils_in_r
+tc_keywords

src/ao_tc_eff_map/README.rst

@@ -0,0 +1,12 @@
+ao_tc_eff_map
+=============
+
+This is a module to obtain the integrals on the AO basis of the SCALAR HERMITIAN 
+effective potential defined in Eq. 32 of JCP 154, 084119 (2021)
+It also contains the modification by a one-body Jastrow factor.  
+
+The main routine/providers are
+
++) ao_tc_sym_two_e_pot_map : map of the SCALAR PART of total effective two-electron on the AO basis in PHYSICIST notations. It might contain the two-electron term coming from the one-e correlation factor. 
++) get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map) : routine to get the integrals from ao_tc_sym_two_e_pot_map. 
++) ao_tc_sym_two_e_pot(i,j,k,l) : FUNCTION that returns the scalar part of TC-potential EXCLUDING the erf(mu r12)/r12. See two_e_ints_gauss.irp.f for more details. 

src/ao_tc_eff_map/compute_ints_eff_pot.irp.f

@@ -0,0 +1,76 @@
+
+
+subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_value)
+
+  use map_module
+
+  BEGIN_DOC
+  !  Parallel client for AO integrals
+  END_DOC
+
+  implicit none
+
+  integer, intent(in)             :: j, l
+  integer,intent(out)             :: n_integrals
+  integer(key_kind),intent(out)   :: buffer_i(ao_num*ao_num)
+  real(integral_kind),intent(out) :: buffer_value(ao_num*ao_num)
+
+  integer                         :: i, k
+  integer                         :: kk, m, j1, i1
+  double precision                :: cpu_1, cpu_2, wall_1, wall_2
+  double precision                :: integral, wall_0, integral_pot, integral_erf
+  double precision                :: thr
+
+  logical, external               :: ao_two_e_integral_zero
+  double precision                :: ao_tc_sym_two_e_pot, ao_two_e_integral_erf
+  double precision                :: j1b_gauss_2e_j1, j1b_gauss_2e_j2
+
+
+  PROVIDE j1b_type
+
+  thr = ao_integrals_threshold
+
+  n_integrals = 0
+
+  j1 = j+ishft(l*l-l,-1)
+  do k = 1, ao_num           ! r1
+    i1 = ishft(k*k-k,-1)
+    if (i1 > j1) then
+      exit
+    endif
+    do i = 1, k
+      i1 += 1
+      if (i1 > j1) then
+        exit
+      endif
+
+      if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr) then
+        cycle
+      endif
+
+      !DIR$ FORCEINLINE
+      integral_pot = ao_tc_sym_two_e_pot  (i, k, j, l)  ! i,k : r1    j,l : r2
+      integral_erf = ao_two_e_integral_erf(i, k, j, l)
+      integral     = integral_erf + integral_pot
+
+      if( j1b_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
+
+      n_integrals += 1
+      !DIR$ FORCEINLINE
+      call two_e_integrals_index(i, j, k, l, buffer_i(n_integrals))
+      buffer_value(n_integrals) = integral
+    enddo
+  enddo
+
+end subroutine compute_ao_tc_sym_two_e_pot_jl
+

src/ao_tc_eff_map/fit_j.irp.f

@@ -0,0 +1,510 @@
+ 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 ]
+ implicit none 
+ expo_erfc_gauss = 1.41211d0
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, expo_erfc_mu_gauss ]
+ implicit none 
+ expo_erfc_mu_gauss = expo_erfc_gauss * mu_erf * mu_erf
+END_PROVIDER 
+
+ BEGIN_PROVIDER [ double precision, expo_good_j_mu_1gauss ]
+&BEGIN_PROVIDER [ double precision, coef_good_j_mu_1gauss ]
+ 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) ]
+ implicit none
+ BEGIN_DOC
+ ! F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) is fitted with a gaussian and a Slater
+ !
+ !      \approx - 1/sqrt(pi) * exp(-alpha * x ) exp(-beta * x**2)
+ !
+ ! where alpha = expo_j_xmu(1) and beta = expo_j_xmu(2)
+ END_DOC
+ expo_j_xmu(1) = 1.7477d0
+ expo_j_xmu(2) = 0.668662d0
+
+END_PROVIDER 
+
+! ---
+
+ BEGIN_PROVIDER [double precision, expo_gauss_j_mu_x, (ng_fit_jast)]
+&BEGIN_PROVIDER [double precision, coef_gauss_j_mu_x, (ng_fit_jast)]
+
+  BEGIN_DOC
+  !
+  ! J(mu,r12) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) is expressed as 
+  !
+  ! J(mu,r12) = 0.5/mu * F(r12*mu) where F(x) =  x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) 
+  !
+  ! F(x) is fitted by - 1/sqrt(pi) * exp(-alpha * x) exp(-beta * x^2) (see expo_j_xmu) 
+  ! 
+  ! The slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians 
+  !
+  ! See Appendix 2 of JCP 154, 084119 (2021)
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i
+  double precision :: tmp
+  double precision :: expos(ng_fit_jast), alpha, beta
+
+  if(ng_fit_jast .eq. 1) then
+
+    coef_gauss_j_mu_x = (/ -0.47947881d0 /)
+    expo_gauss_j_mu_x = (/ 3.4987848d0   /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x(i) = tmp * expo_gauss_j_mu_x(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 2) then
+
+    coef_gauss_j_mu_x = (/ -0.18390742d0, -0.35512656d0 /)
+    expo_gauss_j_mu_x = (/ 31.9279947d0 ,  2.11428789d0 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x(i) = tmp * expo_gauss_j_mu_x(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 3) then
+
+    coef_gauss_j_mu_x = (/ -0.07501725d0, -0.28499012d0, -0.1953932d0  /)
+    expo_gauss_j_mu_x = (/ 206.74058566d0, 1.72974157d0, 11.18735164d0 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x(i) = tmp * expo_gauss_j_mu_x(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 5) then
+
+    coef_gauss_j_mu_x = (/ -0.01832955d0 , -0.10188952d0 , -0.20710858d0 , -0.18975032d0 , -0.04641657d0  /)
+    expo_gauss_j_mu_x = (/ 4.33116687d+03, 2.61292842d+01, 1.43447161d+00, 4.92767426d+00, 2.10654699d+02 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x(i) = tmp * expo_gauss_j_mu_x(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 6) then
+
+    coef_gauss_j_mu_x = (/ -0.08783664d0 , -0.16088711d0 , -0.18464486d0 , -0.0368509d0  , -0.08130028d0 , -0.0126972d0   /)
+    expo_gauss_j_mu_x = (/ 4.09729729d+01, 7.11620618d+00, 2.03692338d+00, 4.10831731d+02, 1.12480198d+00, 1.00000000d+04 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x(i) = tmp * expo_gauss_j_mu_x(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 7) then
+
+    coef_gauss_j_mu_x = (/ -0.01756495d0 , -0.01023623d0  , -0.06548959d0  , -0.03539446d0  , -0.17150646d0  , -0.15071096d0  , -0.11326834d0   /)
+    expo_gauss_j_mu_x = (/ 9.88572565d+02,  1.21363371d+04,  3.69794870d+01,  1.67364529d+02,  3.03962934d+00,  1.27854005d+00,  9.76383343d+00 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x(i) = tmp * expo_gauss_j_mu_x(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 8) then
+
+    coef_gauss_j_mu_x = (/ -0.11489205d0 , -0.16008968d0 , -0.12892456d0 , -0.04250838d0 , -0.0718451d0  , -0.02394051d0 , -0.00913353d0 , -0.01285182d0  /)
+    expo_gauss_j_mu_x = (/ 6.97632442d+00, 2.56010878d+00, 1.22760977d+00, 7.47697124d+01, 2.16104215d+01, 2.96549728d+02, 1.40773328d+04, 1.43335159d+03 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x(i) = tmp * expo_gauss_j_mu_x(i)
+    enddo
+
+  !elseif(ng_fit_jast .eq. 9) then
+
+  !  coef_gauss_j_mu_x = (/ /)
+  !  expo_gauss_j_mu_x = (/ /)
+
+  !  tmp = mu_erf * mu_erf
+  !  do i = 1, ng_fit_jast
+  !    expo_gauss_j_mu_x(i) = tmp * expo_gauss_j_mu_x(i)
+  !  enddo
+
+  elseif(ng_fit_jast .eq. 20) then
+
+    ASSERT(n_max_fit_slat == 20)
+
+    alpha = expo_j_xmu(1) * mu_erf
+    call expo_fit_slater_gam(alpha, expos)
+    beta = expo_j_xmu(2) * mu_erf * mu_erf
+
+    tmp = -1.0d0 / sqrt(dacos(-1.d0))
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x(i) = expos(i) + beta
+      coef_gauss_j_mu_x(i) = tmp * coef_fit_slat_gauss(i) 
+    enddo
+
+  else
+
+    print *, ' not implemented yet'
+    stop
+  
+  endif
+
+  tmp = 0.5d0 / mu_erf
+  do i = 1, ng_fit_jast
+    coef_gauss_j_mu_x(i) = tmp * coef_gauss_j_mu_x(i) 
+  enddo
+
+END_PROVIDER 
+
+! ---
+
+ BEGIN_PROVIDER [double precision, expo_gauss_j_mu_x_2, (ng_fit_jast)]
+&BEGIN_PROVIDER [double precision, coef_gauss_j_mu_x_2, (ng_fit_jast)]
+
+  BEGIN_DOC
+  !
+  ! J(mu,r12)^2 = 0.25/mu^2 F(r12*mu)^2
+  !
+  ! F(x)^2 = 1/pi * exp(-2 * alpha * x) exp(-2 * beta * x^2) 
+  ! 
+  ! The slater function exp(-2 * alpha * x) is fitted with n_max_fit_slat gaussians 
+  !
+  ! See Appendix 2 of JCP 154, 084119 (2021)
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i
+  double precision :: tmp
+  double precision :: expos(ng_fit_jast), alpha, beta
+  double precision :: alpha_opt, beta_opt
+
+  if(ng_fit_jast .eq. 1) then
+
+    coef_gauss_j_mu_x_2 = (/ 0.26699573d0  /)
+    expo_gauss_j_mu_x_2 = (/ 11.71029824d0 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x_2(i) = tmp * expo_gauss_j_mu_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 2) then
+
+    coef_gauss_j_mu_x_2 = (/ 0.11627934d0  , 0.18708824d0 /)
+    expo_gauss_j_mu_x_2 = (/ 102.41386863d0, 6.36239771d0 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x_2(i) = tmp * expo_gauss_j_mu_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 3) then
+
+    coef_gauss_j_mu_x_2 = (/ 0.04947216d0  , 0.14116238d0, 0.12276501d0  /)
+    expo_gauss_j_mu_x_2 = (/ 635.29701766d0, 4.87696954d0, 33.36745891d0 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x_2(i) = tmp * expo_gauss_j_mu_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 5) then
+
+    coef_gauss_j_mu_x_2 = (/ 0.01461527d0  , 0.03257147d0  , 0.08831354d0  , 0.11411794d0  , 0.06858783d0   /)
+    expo_gauss_j_mu_x_2 = (/ 8.76554470d+03, 4.90224577d+02, 3.68267125d+00, 1.29663940d+01, 6.58240931d+01 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x_2(i) = tmp * expo_gauss_j_mu_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 6) then
+
+    coef_gauss_j_mu_x_2 = (/ 0.01347632d0  , 0.03929124d0  , 0.06289468d0  , 0.10702493d0  , 0.06999865d0  , 0.02558191d0   /)
+    expo_gauss_j_mu_x_2 = (/ 1.00000000d+04, 1.20900717d+02, 3.20346191d+00, 8.92157196d+00, 3.28119120d+01, 6.49045808d+02 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x_2(i) = tmp * expo_gauss_j_mu_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 7) then
+
+    coef_gauss_j_mu_x_2 = (/ 0.05202849d0  , 0.01031081d0  , 0.04699157d0  , 0.01451002d0  , 0.07442576d0  , 0.02692033d0  , 0.09311842d0   /)
+    expo_gauss_j_mu_x_2 = (/ 3.04469415d+00, 1.40682034d+04, 7.45960945d+01, 1.43067466d+03, 2.16815661d+01, 2.95750306d+02, 7.23471236d+00 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x_2(i) = tmp * expo_gauss_j_mu_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 8) then
+
+    coef_gauss_j_mu_x_2 = (/ 0.00942115d0  , 0.07332421d0  , 0.0508308d0   , 0.08204949d0  , 0.0404099d0   , 0.03201288d0  , 0.01911313d0  , 0.01114732d0   /)
+    expo_gauss_j_mu_x_2 = (/ 1.56957321d+04, 1.52867810d+01, 4.36016903d+01, 5.96818956d+00, 2.85535269d+00, 1.36064008d+02, 4.71968910d+02, 1.92022350d+03 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x_2(i) = tmp * expo_gauss_j_mu_x_2(i)
+    enddo
+
+  !elseif(ng_fit_jast .eq. 9) then
+
+  !  coef_gauss_j_mu_x_2 = (/  /)
+  !  expo_gauss_j_mu_x_2 = (/  /)
+  !  
+  !  tmp = mu_erf * mu_erf
+  !  do i = 1, ng_fit_jast
+  !    expo_gauss_j_mu_x_2(i) = tmp * expo_gauss_j_mu_x_2(i)
+  !  enddo
+
+  elseif(ng_fit_jast .eq. 20) then
+
+    ASSERT(n_max_fit_slat == 20)
+
+    !alpha_opt = 2.d0 * expo_j_xmu(1)
+    !beta_opt  = 2.d0 * expo_j_xmu(2)
+   
+    ! direct opt
+    alpha_opt = 3.52751759d0
+    beta_opt  = 1.26214809d0
+  
+    alpha = alpha_opt * mu_erf
+    call expo_fit_slater_gam(alpha, expos)
+    beta = beta_opt * mu_erf * mu_erf
+    
+    tmp = 1.d0 / dacos(-1.d0)
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_x_2(i) = expos(i) + beta
+      coef_gauss_j_mu_x_2(i) = tmp * coef_fit_slat_gauss(i) 
+    enddo
+
+  else
+
+    print *, ' not implemented yet'
+    stop
+  
+  endif
+
+  tmp = 0.25d0 / (mu_erf * mu_erf)
+  do i = 1, ng_fit_jast
+    coef_gauss_j_mu_x_2(i) = tmp * coef_gauss_j_mu_x_2(i)
+  enddo
+
+END_PROVIDER 
+
+! ---
+
+ BEGIN_PROVIDER [double precision, expo_gauss_j_mu_1_erf, (ng_fit_jast)]
+&BEGIN_PROVIDER [double precision, coef_gauss_j_mu_1_erf, (ng_fit_jast)]
+
+  BEGIN_DOC
+  !
+  ! J(mu,r12) x \frac{1 - erf(mu * r12)}{2} = 
+  !
+  ! - \frac{1}{4 \sqrt{\pi} \mu} \exp(-(alpha1 + alpha2) * mu * r12 - (beta1 + beta2) * mu^2 * r12^2)
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i
+  double precision :: tmp
+  double precision :: expos(ng_fit_jast), alpha, beta
+  double precision :: alpha_opt, beta_opt
+
+  if(ng_fit_jast .eq. 1) then
+
+    coef_gauss_j_mu_1_erf = (/ -0.47742461d0 /)
+    expo_gauss_j_mu_1_erf = (/ 8.72255696d0  /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_1_erf(i) = tmp * expo_gauss_j_mu_1_erf(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 2) then
+
+    coef_gauss_j_mu_1_erf = (/ -0.19342649d0, -0.34563835d0 /)
+    expo_gauss_j_mu_1_erf = (/ 78.66099999d0,  5.04324363d0 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_1_erf(i) = tmp * expo_gauss_j_mu_1_erf(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 3) then
+
+    coef_gauss_j_mu_1_erf = (/ -0.0802541d0  , -0.27019258d0, -0.20546681d0 /)
+    expo_gauss_j_mu_1_erf = (/ 504.53350764d0,  4.01408169d0, 26.5758329d0  /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_1_erf(i) = tmp * expo_gauss_j_mu_1_erf(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 5) then
+
+    coef_gauss_j_mu_1_erf = (/ -0.02330531d0 , -0.11888176d0 , -0.16476192d0 , -0.19874713d0 , -0.05889174d0  /)
+    expo_gauss_j_mu_1_erf = (/ 1.00000000d+04, 4.66067922d+01, 3.04359857d+00, 9.54726649d+00, 3.59796835d+02 /)
+    
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_1_erf(i) = tmp * expo_gauss_j_mu_1_erf(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 6) then
+
+    coef_gauss_j_mu_1_erf = (/ -0.01865654d0 , -0.18319251d0 , -0.06543196d0 , -0.11522778d0 , -0.14825793d0 , -0.03327101d0  /)
+    expo_gauss_j_mu_1_erf = (/ 1.00000000d+04, 8.05593848d+00, 1.27986190d+02, 2.92674319d+01, 2.93583623d+00, 7.65609148d+02 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_1_erf(i) = tmp * expo_gauss_j_mu_1_erf(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 7) then
+
+    coef_gauss_j_mu_1_erf = (/ -0.11853067d0 , -0.01522824d0  , -0.07419098d0  , -0.022202d0    , -0.12242283d0  , -0.04177571d0  , -0.16983107d0  /)
+    expo_gauss_j_mu_1_erf = (/ 2.74057056d+00,  1.37626591d+04,  6.65578663d+01,  1.34693031d+03,  1.90547699d+01,  2.69445390d+02,  6.31845879d+00/)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_1_erf(i) = tmp * expo_gauss_j_mu_1_erf(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 8) then
+
+    coef_gauss_j_mu_1_erf = (/ -0.12263328d0 , -0.04965255d0 , -0.15463564d0 , -0.09675781d0 , -0.0807023d0  , -0.02923298d0 , -0.01381381d0 , -0.01675923d0  /)
+    expo_gauss_j_mu_1_erf = (/ 1.36101994d+01, 1.24908367d+02, 5.29061388d+00, 2.60692516d+00, 3.93396935d+01, 4.43071610d+02, 1.54902240d+04, 1.85170446d+03 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_1_erf(i) = tmp * expo_gauss_j_mu_1_erf(i)
+    enddo
+
+  !elseif(ng_fit_jast .eq. 9) then
+
+  !  coef_gauss_j_mu_1_erf = (/  /)
+  !  expo_gauss_j_mu_1_erf = (/  /)
+
+  !  tmp = mu_erf * mu_erf
+  !  do i = 1, ng_fit_jast
+  !    expo_gauss_j_mu_1_erf(i) = tmp * expo_gauss_j_mu_1_erf(i)
+  !  enddo
+
+  elseif(ng_fit_jast .eq. 20) then
+
+    ASSERT(n_max_fit_slat == 20)
+
+    !alpha_opt = expo_j_xmu(1) + expo_gauss_1_erf_x(1)
+    !beta_opt  = expo_j_xmu(2) + expo_gauss_1_erf_x(2)
+   
+    ! direct opt
+    alpha_opt = 2.87875632d0
+    beta_opt  = 1.34801003d0
+    
+    alpha = alpha_opt * mu_erf
+    call expo_fit_slater_gam(alpha, expos)
+    beta = beta_opt * mu_erf * mu_erf
+    
+    tmp = -1.d0 / dsqrt(dacos(-1.d0))
+    do i = 1, ng_fit_jast
+      expo_gauss_j_mu_1_erf(i) = expos(i) + beta
+      coef_gauss_j_mu_1_erf(i) = tmp * coef_fit_slat_gauss(i) 
+    enddo
+
+  else
+
+    print *, ' not implemented yet'
+    stop
+  
+  endif
+
+  tmp = 0.25d0 / mu_erf
+  do i = 1, ng_fit_jast
+    coef_gauss_j_mu_1_erf(i) = tmp * coef_gauss_j_mu_1_erf(i)
+  enddo
+
+END_PROVIDER 
+
+! ---
+
+double precision  function F_x_j(x)
+ implicit none
+ BEGIN_DOC 
+ ! F_x_j(x) = dimension-less correlation factor = x (1 - erf(x)) - 1/sqrt(pi) exp(-x^2)
+ END_DOC
+ double precision, intent(in) :: x
+ F_x_j = x * (1.d0 - derf(x)) - 1/dsqrt(dacos(-1.d0)) * dexp(-x**2)
+
+end
+
+double precision function j_mu_F_x_j(x)
+ implicit none
+ BEGIN_DOC 
+ ! j_mu_F_x_j(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
+ !
+ !         = 1/(2*mu) * F_x_j(mu*x)
+ END_DOC
+ double precision :: F_x_j
+ double precision, intent(in) :: x
+ j_mu_F_x_j = 0.5d0/mu_erf * F_x_j(x*mu_erf)
+end
+
+double precision function j_mu(x)
+ 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)
+ implicit none
+ BEGIN_DOC 
+ ! j_mu_fit_gauss(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2)
+ !
+ ! but fitted with gaussians 
+ END_DOC
+ double precision, intent(in) :: x
+ integer :: i
+ double precision :: alpha,coef
+ j_mu_fit_gauss = 0.d0
+ do i = 1, n_max_fit_slat
+  alpha = expo_gauss_j_mu_x(i) 
+  coef  = coef_gauss_j_mu_x(i) 
+  j_mu_fit_gauss +=  coef * dexp(-alpha*x*x)
+ enddo
+ 
+end
+
+! ---
+

src/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f

@@ -0,0 +1,194 @@
+subroutine ao_tc_sym_two_e_pot_in_map_slave_tcp(i)
+  implicit none
+  integer, intent(in)            :: i
+  BEGIN_DOC
+! Computes a buffer of integrals. i is the ID of the current thread.
+  END_DOC
+  call ao_tc_sym_two_e_pot_in_map_slave(0,i)
+end
+
+
+subroutine ao_tc_sym_two_e_pot_in_map_slave_inproc(i)
+  implicit none
+  integer, intent(in)            :: i
+  BEGIN_DOC
+! Computes a buffer of integrals. i is the ID of the current thread.
+  END_DOC
+  call ao_tc_sym_two_e_pot_in_map_slave(1,i)
+end
+
+
+
+
+
+subroutine ao_tc_sym_two_e_pot_in_map_slave(thread,iproc)
+  use map_module
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Computes a buffer of integrals
+  END_DOC
+
+  integer, intent(in)            :: thread, iproc
+
+  integer                        :: j,l,n_integrals
+  integer                        :: rc
+  real(integral_kind), allocatable :: buffer_value(:)
+  integer(key_kind), allocatable :: buffer_i(:)
+
+  integer                        :: worker_id, task_id
+  character*(512)                :: task
+
+  integer(ZMQ_PTR),external      :: new_zmq_to_qp_run_socket
+  integer(ZMQ_PTR)               :: zmq_to_qp_run_socket
+
+  integer(ZMQ_PTR), external     :: new_zmq_push_socket
+  integer(ZMQ_PTR)               :: zmq_socket_push
+
+  character*(64)                 :: state
+
+  zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
+
+  integer, external :: connect_to_taskserver
+  if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
+    call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
+    return
+  endif
+
+  zmq_socket_push      = new_zmq_push_socket(thread)
+
+  allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
+
+
+  do
+    integer, external :: get_task_from_taskserver
+    if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) == -1) then
+      exit
+    endif
+    if (task_id == 0) exit
+    read(task,*) j, l
+    integer, external :: task_done_to_taskserver
+    call compute_ao_tc_sym_two_e_pot_jl(j,l,n_integrals,buffer_i,buffer_value)
+    if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
+        stop 'Unable to send task_done'
+    endif
+    call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
+  enddo
+
+  integer, external :: disconnect_from_taskserver
+  if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
+    continue
+  endif
+  deallocate( buffer_i, buffer_value )
+  call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
+  call end_zmq_push_socket(zmq_socket_push,thread)
+
+end
+
+
+subroutine ao_tc_sym_two_e_pot_in_map_collector(zmq_socket_pull)
+  use map_module
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Collects results from the AO integral calculation
+  END_DOC
+
+  integer(ZMQ_PTR), intent(in)   :: zmq_socket_pull
+  integer                        :: j,l,n_integrals
+  integer                        :: rc
+
+  real(integral_kind), allocatable :: buffer_value(:)
+  integer(key_kind), allocatable :: buffer_i(:)
+
+  integer(ZMQ_PTR),external      :: new_zmq_to_qp_run_socket
+  integer(ZMQ_PTR)               :: zmq_to_qp_run_socket
+
+  integer(ZMQ_PTR), external     :: new_zmq_pull_socket
+
+  integer*8                      :: control, accu, sze
+  integer                        :: task_id, more
+
+  zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
+
+  sze = ao_num*ao_num
+  allocate ( buffer_i(sze), buffer_value(sze) )
+
+  accu = 0_8
+  more = 1
+  do while (more == 1)
+
+    rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
+    if (rc == -1) then
+      n_integrals = 0
+      return
+    endif
+    if (rc /= 4) then
+      print *, irp_here,  ': f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)'
+      stop 'error'
+    endif
+
+    if (n_integrals >= 0) then
+
+      if (n_integrals > sze) then
+        deallocate (buffer_value, buffer_i)
+        sze = n_integrals
+        allocate (buffer_value(sze), buffer_i(sze))
+      endif
+
+      rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
+      if (rc /= key_kind*n_integrals) then
+        print *,  rc, key_kind, n_integrals
+        print *, irp_here,  ': f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)'
+        stop 'error'
+      endif
+
+      rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
+      if (rc /= integral_kind*n_integrals) then
+        print *, irp_here,  ': f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)'
+        stop 'error'
+      endif
+
+      rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
+
+IRP_IF ZMQ_PUSH
+IRP_ELSE
+      rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
+      if (rc /= 4) then
+        print *,  irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
+        stop 'error'
+      endif
+IRP_ENDIF
+
+
+      call insert_into_ao_tc_sym_two_e_pot_map(n_integrals,buffer_i,buffer_value)
+      accu += n_integrals
+      if (task_id /= 0) then
+        integer, external :: zmq_delete_task
+        if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
+          stop 'Unable to delete task'
+        endif
+      endif
+    endif
+
+  enddo
+
+  deallocate( buffer_i, buffer_value )
+
+  integer (map_size_kind) :: get_ao_tc_sym_two_e_pot_map_size
+  control = get_ao_tc_sym_two_e_pot_map_size(ao_tc_sym_two_e_pot_map)
+
+  if (control /= accu) then
+      print *, ''
+      print *, irp_here
+      print *, 'Control : ', control
+      print *, 'Accu    : ', accu
+      print *, 'Some integrals were lost during the parallel computation.'
+      print *, 'Try to reduce the number of threads.'
+      stop
+  endif
+
+  call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
+
+end
+

src/ao_tc_eff_map/map_integrals_eff_pot.irp.f

@@ -0,0 +1,313 @@
+use map_module
+
+!! AO Map
+!! ======
+
+BEGIN_PROVIDER [ type(map_type), ao_tc_sym_two_e_pot_map ]
+  implicit none
+  BEGIN_DOC
+  ! |AO| integrals
+  END_DOC
+  integer(key_kind)              :: key_max
+  integer(map_size_kind)         :: sze
+  call two_e_integrals_index(ao_num,ao_num,ao_num,ao_num,key_max)
+  sze = key_max
+  call map_init(ao_tc_sym_two_e_pot_map,sze)
+  print*,  'ao_tc_sym_two_e_pot_map map initialized : ', sze
+END_PROVIDER
+
+ BEGIN_PROVIDER [ integer, ao_tc_sym_two_e_pot_cache_min ]
+&BEGIN_PROVIDER [ integer, ao_tc_sym_two_e_pot_cache_max ]
+ implicit none
+ BEGIN_DOC
+ ! Min and max values of the AOs for which the integrals are in the cache
+ END_DOC
+ ao_tc_sym_two_e_pot_cache_min = max(1,ao_num - 63)
+ ao_tc_sym_two_e_pot_cache_max = ao_num
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, ao_tc_sym_two_e_pot_cache, (0:64*64*64*64) ]
+
+  use map_module
+  implicit none
+
+  BEGIN_DOC
+  ! Cache of |AO| integrals for fast access
+  END_DOC
+
+  integer                        :: i,j,k,l,ii
+  integer(key_kind)              :: idx
+  real(integral_kind)            :: integral
+
+  PROVIDE ao_tc_sym_two_e_pot_in_map
+
+ !$OMP PARALLEL DO PRIVATE (i,j,k,l,idx,ii,integral)
+  do l = ao_tc_sym_two_e_pot_cache_min, ao_tc_sym_two_e_pot_cache_max
+    do k = ao_tc_sym_two_e_pot_cache_min, ao_tc_sym_two_e_pot_cache_max
+      do j = ao_tc_sym_two_e_pot_cache_min, ao_tc_sym_two_e_pot_cache_max
+        do i = ao_tc_sym_two_e_pot_cache_min, ao_tc_sym_two_e_pot_cache_max
+          !DIR$ FORCEINLINE
+          call two_e_integrals_index(i, j, k, l, idx)
+          !DIR$ FORCEINLINE
+          call map_get(ao_tc_sym_two_e_pot_map, idx, integral)
+          ii = l-ao_tc_sym_two_e_pot_cache_min
+          ii = ior( ishft(ii,6), k-ao_tc_sym_two_e_pot_cache_min)
+          ii = ior( ishft(ii,6), j-ao_tc_sym_two_e_pot_cache_min)
+          ii = ior( ishft(ii,6), i-ao_tc_sym_two_e_pot_cache_min)
+          ao_tc_sym_two_e_pot_cache(ii) = integral
+        enddo
+      enddo
+    enddo
+  enddo
+  !$OMP END PARALLEL DO
+
+END_PROVIDER
+
+! ---
+
+subroutine insert_into_ao_tc_sym_two_e_pot_map(n_integrals, buffer_i, buffer_values)
+
+  use map_module
+  implicit none
+
+  BEGIN_DOC
+  ! Create new entry into |AO| map
+  END_DOC
+
+  integer, intent(in)                :: n_integrals
+  integer(key_kind), intent(inout)   :: buffer_i(n_integrals)
+  real(integral_kind), intent(inout) :: buffer_values(n_integrals)
+
+  call map_append(ao_tc_sym_two_e_pot_map, buffer_i, buffer_values, n_integrals)
+
+end
+
+! ---
+
+double precision function get_ao_tc_sym_two_e_pot(i, j, k, l, map) result(result)
+
+  use map_module
+
+  implicit none
+
+  BEGIN_DOC
+  ! Gets one |AO| two-electron integral from the |AO| map
+  END_DOC
+
+  integer, intent(in)            :: i,j,k,l
+  integer(key_kind)              :: idx
+  type(map_type), intent(inout)  :: map
+  integer                        :: ii
+  real(integral_kind)            :: tmp
+  logical, external              :: ao_two_e_integral_zero
+
+  PROVIDE ao_tc_sym_two_e_pot_in_map ao_tc_sym_two_e_pot_cache ao_tc_sym_two_e_pot_cache_min
+
+  !DIR$ FORCEINLINE
+!  if (ao_two_e_integral_zero(i,j,k,l)) then
+  if (.False.) then
+    tmp = 0.d0
+  !else if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < ao_integrals_threshold) then
+  !  tmp = 0.d0
+  else
+    ii = l-ao_tc_sym_two_e_pot_cache_min
+    ii = ior(ii, k-ao_tc_sym_two_e_pot_cache_min)
+    ii = ior(ii, j-ao_tc_sym_two_e_pot_cache_min)
+    ii = ior(ii, i-ao_tc_sym_two_e_pot_cache_min)
+    if (iand(ii, -64) /= 0) then
+      !DIR$ FORCEINLINE
+      call two_e_integrals_index(i, j, k, l, idx)
+      !DIR$ FORCEINLINE
+      call map_get(map, idx, tmp)
+      tmp = tmp
+    else
+      ii = l-ao_tc_sym_two_e_pot_cache_min
+      ii = ior( ishft(ii,6), k-ao_tc_sym_two_e_pot_cache_min)
+      ii = ior( ishft(ii,6), j-ao_tc_sym_two_e_pot_cache_min)
+      ii = ior( ishft(ii,6), i-ao_tc_sym_two_e_pot_cache_min)
+      tmp = ao_tc_sym_two_e_pot_cache(ii)
+    endif
+  endif
+
+  result = tmp
+
+end
+
+! ---
+
+subroutine get_many_ao_tc_sym_two_e_pot(j,k,l,sze,out_val)
+  use map_module
+  BEGIN_DOC
+  ! Gets multiple |AO| two-electron integral from the |AO| map .
+  ! All i are retrieved for j,k,l fixed.
+  END_DOC
+  implicit none
+  integer, intent(in)            :: j,k,l, sze
+  real(integral_kind), intent(out) :: out_val(sze)
+
+  integer                        :: i
+  integer(key_kind)              :: hash
+  double precision               :: thresh
+! logical, external              :: ao_one_e_integral_zero
+  PROVIDE ao_tc_sym_two_e_pot_in_map ao_tc_sym_two_e_pot_map
+  thresh = ao_integrals_threshold
+
+! if (ao_one_e_integral_zero(j,l)) then
+  if (.False.) then
+    out_val = 0.d0
+    return
+  endif
+
+  double precision :: get_ao_tc_sym_two_e_pot
+  do i=1,sze
+    out_val(i) = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map)
+  enddo
+
+end
+
+subroutine get_many_ao_tc_sym_two_e_pot_non_zero(j,k,l,sze,out_val,out_val_index,non_zero_int)
+  use map_module
+  implicit none
+  BEGIN_DOC
+  ! Gets multiple |AO| two-electron integrals from the |AO| map .
+  ! All non-zero i are retrieved for j,k,l fixed.
+  END_DOC
+  integer, intent(in)            :: j,k,l, sze
+  real(integral_kind), intent(out) :: out_val(sze)
+  integer, intent(out)           :: out_val_index(sze),non_zero_int
+
+  integer                        :: i
+  integer(key_kind)              :: hash
+  double precision               :: thresh,tmp
+! logical, external              :: ao_one_e_integral_zero
+  PROVIDE ao_tc_sym_two_e_pot_in_map
+  thresh = ao_integrals_threshold
+
+  non_zero_int = 0
+! if (ao_one_e_integral_zero(j,l)) then
+  if (.False.) then
+    out_val = 0.d0
+    return
+  endif
+
+  non_zero_int = 0
+  do i=1,sze
+    integer, external :: ao_l4
+    double precision, external :: ao_two_e_integral_eff_pot
+    !DIR$ FORCEINLINE
+    !if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thresh) then
+    !  cycle
+    !endif
+    call two_e_integrals_index(i,j,k,l,hash)
+    call map_get(ao_tc_sym_two_e_pot_map, hash,tmp)
+    if (dabs(tmp) < thresh ) cycle
+    non_zero_int = non_zero_int+1
+    out_val_index(non_zero_int) = i
+    out_val(non_zero_int) = tmp
+  enddo
+
+end
+
+
+function get_ao_tc_sym_two_e_pot_map_size()
+  implicit none
+  integer (map_size_kind) :: get_ao_tc_sym_two_e_pot_map_size
+  BEGIN_DOC
+  ! Returns the number of elements in the |AO| map
+  END_DOC
+  get_ao_tc_sym_two_e_pot_map_size = ao_tc_sym_two_e_pot_map % n_elements
+end
+
+subroutine clear_ao_tc_sym_two_e_pot_map
+  implicit none
+  BEGIN_DOC
+  ! Frees the memory of the |AO| map
+  END_DOC
+  call map_deinit(ao_tc_sym_two_e_pot_map)
+  FREE ao_tc_sym_two_e_pot_map
+end
+
+
+
+subroutine dump_ao_tc_sym_two_e_pot(filename)
+  use map_module
+  implicit none
+  BEGIN_DOC
+  ! Save to disk the |AO| eff_pot integrals
+  END_DOC
+  character*(*), intent(in)      :: filename
+  integer(cache_key_kind), pointer :: key(:)
+  real(integral_kind), pointer   :: val(:)
+  integer*8                      :: i,j, n
+  call ezfio_set_work_empty(.False.)
+  open(unit=66,file=filename,FORM='unformatted')
+  write(66) integral_kind, key_kind
+  write(66) ao_tc_sym_two_e_pot_map%sorted, ao_tc_sym_two_e_pot_map%map_size,    &
+      ao_tc_sym_two_e_pot_map%n_elements
+  do i=0_8,ao_tc_sym_two_e_pot_map%map_size
+    write(66) ao_tc_sym_two_e_pot_map%map(i)%sorted, ao_tc_sym_two_e_pot_map%map(i)%map_size,&
+        ao_tc_sym_two_e_pot_map%map(i)%n_elements
+  enddo
+  do i=0_8,ao_tc_sym_two_e_pot_map%map_size
+    key => ao_tc_sym_two_e_pot_map%map(i)%key
+    val => ao_tc_sym_two_e_pot_map%map(i)%value
+    n = ao_tc_sym_two_e_pot_map%map(i)%n_elements
+    write(66) (key(j), j=1,n), (val(j), j=1,n)
+  enddo
+  close(66)
+
+end
+
+
+
+integer function load_ao_tc_sym_two_e_pot(filename)
+  implicit none
+  BEGIN_DOC
+  ! Read from disk the |AO| eff_pot integrals
+  END_DOC
+  character*(*), intent(in)      :: filename
+  integer*8                      :: i
+  integer(cache_key_kind), pointer :: key(:)
+  real(integral_kind), pointer   :: val(:)
+  integer                        :: iknd, kknd
+  integer*8                      :: n, j
+  load_ao_tc_sym_two_e_pot = 1
+  open(unit=66,file=filename,FORM='unformatted',STATUS='UNKNOWN')
+  read(66,err=98,end=98) iknd, kknd
+  if (iknd /= integral_kind) then
+    print *,  'Wrong integrals kind in file :', iknd
+    stop 1
+  endif
+  if (kknd /= key_kind) then
+    print *,  'Wrong key kind in file :', kknd
+    stop 1
+  endif
+  read(66,err=98,end=98) ao_tc_sym_two_e_pot_map%sorted, ao_tc_sym_two_e_pot_map%map_size,&
+      ao_tc_sym_two_e_pot_map%n_elements
+  do i=0_8, ao_tc_sym_two_e_pot_map%map_size
+    read(66,err=99,end=99) ao_tc_sym_two_e_pot_map%map(i)%sorted,          &
+        ao_tc_sym_two_e_pot_map%map(i)%map_size, ao_tc_sym_two_e_pot_map%map(i)%n_elements
+    call cache_map_reallocate(ao_tc_sym_two_e_pot_map%map(i),ao_tc_sym_two_e_pot_map%map(i)%map_size)
+  enddo
+  do i=0_8, ao_tc_sym_two_e_pot_map%map_size
+    key => ao_tc_sym_two_e_pot_map%map(i)%key
+    val => ao_tc_sym_two_e_pot_map%map(i)%value
+    n = ao_tc_sym_two_e_pot_map%map(i)%n_elements
+    read(66,err=99,end=99) (key(j), j=1,n), (val(j), j=1,n)
+  enddo
+  call map_sort(ao_tc_sym_two_e_pot_map)
+  load_ao_tc_sym_two_e_pot = 0
+  return
+  99 continue
+  call map_deinit(ao_tc_sym_two_e_pot_map)
+  98 continue
+  stop 'Problem reading ao_tc_sym_two_e_pot_map file in work/'
+
+end
+
+
+
+

src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f

@@ -0,0 +1,332 @@
+! ---
+
+BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)]
+
+  BEGIN_DOC
+  !
+  !  :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle` 
+  !
+  END_DOC
+
+  implicit none
+
+  integer          :: num_A, num_B
+  integer          :: power_A(3), power_B(3)
+  integer          :: i, j, k1, k2, l, m
+  double precision :: alpha, beta, gama1, gama2, coef1, coef2
+  double precision :: A_center(3), B_center(3), C_center1(3), C_center2(3)
+  double precision :: c1, c
+
+  integer          :: dim1
+  double precision :: overlap_y, d_a_2, overlap_z, overlap
+
+  double precision :: int_gauss_4G
+
+  PROVIDE j1b_type j1b_pen j1b_coeff
+
+  ! --------------------------------------------------------------------------------
+  ! -- Dummy call to provide everything
+  dim1        = 100
+  A_center(:) = 0.d0
+  B_center(:) = 1.d0
+  alpha       = 1.d0
+  beta        = 0.1d0
+  power_A(:)  = 1
+  power_B(:)  = 0
+  call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                           , overlap_y, d_a_2, overlap_z, overlap, dim1 )
+  ! --------------------------------------------------------------------------------
+  
+
+  j1b_gauss_hermII(1:ao_num,1:ao_num) = 0.d0
+
+  if(j1b_type .eq. 1) then
+  ! \tau_1b = \sum_iA -[1 - 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 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 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)
+              C_center1(1:3) = nucl_coord(k1,1:3)
+  
+              do k2 = 1, nucl_num
+                gama2          = j1b_pen(k2)
+                C_center2(1:3) = nucl_coord(k2,1:3)
+  
+                ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB >
+                c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2     &
+                                 , power_A, power_B, alpha, beta, gama1, gama2  )
+  
+                c = c - 2.d0 * gama1 * gama2 * c1
+              enddo
+            enddo
+  
+            j1b_gauss_hermII(i,j) = j1b_gauss_hermII(i,j)      & 
+                      + ao_coef_normalized_ordered_transp(l,j) &
+                      * ao_coef_normalized_ordered_transp(m,i) * c
+          enddo
+        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
+
+
+
+
+
+!_____________________________________________________________________________________________________________
+!
+!               < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB >
+!
+double precision function int_gauss_4G( A_center, B_center, C_center1, C_center2, power_A, power_B &
+                                      , alpha, beta, gama1, gama2 )
+
+  ! for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  integer         , intent(in) :: power_A(3), power_B(3)
+  double precision, intent(in) :: A_center(3), B_center(3), C_center1(3), C_center2(3)
+  double precision, intent(in) :: alpha, beta, gama1, gama2
+
+  integer                      :: i, dim1, power_C
+  integer                      :: iorder(3)
+  double precision             :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
+  double precision             :: gama, fact_C, C_center(3)
+  double precision             :: cx0, cy0, cz0, c_tmp1, c_tmp2, cx, cy, cz
+  double precision             :: int_tmp
+
+  double precision             :: overlap_gaussian_x
+
+  dim1 = 100
+
+  ! P_AB(0:max_dim,3) polynomial
+  ! AB_center(3)      new center
+  ! AB_expo           new exponent
+  ! fact_AB           constant factor
+  ! iorder(3)         i_order(i) = order of the polynomials
+  call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
+
+  call gaussian_product(gama1, C_center1, gama2, C_center2, fact_C, gama, C_center)
+
+  ! <<<
+  ! to avoid multi-evaluation
+  power_C = 0
+
+  cx0 = 0.d0
+  do i = 0, iorder(1)
+    cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cy0 = 0.d0
+  do i = 0, iorder(2)
+    cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cz0 = 0.d0
+  do i = 0, iorder(3)
+    cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+  ! >>>
+
+  int_tmp = 0.d0
+
+  ! -----------------------------------------------------------------------------------------------
+  !
+  ! x term:
+  !          < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (x - x_C1) (x - x_C2) | XB > 
+  !
+
+  c_tmp1 = 2.d0 * C_center(1) - C_center1(1) - C_center2(1)
+  c_tmp2 = ( C_center(1) - C_center1(1) ) * ( C_center(1) - C_center2(1) ) 
+
+  cx = 0.d0
+  do i = 0, iorder(1)
+    
+    ! < XA | exp[-gama r_C^2] (x - x_C)^2 | XB >
+    power_C = 2
+    cx      = cx + P_AB(i,1) &
+            * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] (x - x_C) | XB >
+    power_C = 1
+    cx      = cx + P_AB(i,1) * c_tmp1 &
+            * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] | XB >
+    power_C = 0
+    cx      = cx + P_AB(i,1) * c_tmp2 &
+            * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+
+  enddo
+
+  int_tmp += cx * cy0 * cz0
+
+  ! -----------------------------------------------------------------------------------------------
+
+
+  ! -----------------------------------------------------------------------------------------------
+  !
+  ! y term:
+  !          < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (y - y_C1) (y - y_C2) | XB > 
+  !
+
+  c_tmp1 = 2.d0 * C_center(2) - C_center1(2) - C_center2(2)
+  c_tmp2 = ( C_center(2) - C_center1(2) ) * ( C_center(2) - C_center2(2) ) 
+
+  cy = 0.d0
+  do i = 0, iorder(2)
+    
+    ! < XA | exp[-gama r_C^2] (y - y_C)^2 | XB >
+    power_C = 2
+    cy      = cy + P_AB(i,2) &
+            * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] (y - y_C) | XB >
+    power_C = 1
+    cy      = cy + P_AB(i,2) * c_tmp1 &
+            * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] | XB >
+    power_C = 0
+    cy      = cy + P_AB(i,2) * c_tmp2 &
+            * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+
+  enddo
+
+  int_tmp += cx0 * cy * cz0
+
+  ! -----------------------------------------------------------------------------------------------
+
+
+  ! -----------------------------------------------------------------------------------------------
+  !
+  ! z term:
+  !          < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (z - z_C1) (z - z_C2) | XB > 
+  !
+
+  c_tmp1 = 2.d0 * C_center(3) - C_center1(3) - C_center2(3)
+  c_tmp2 = ( C_center(3) - C_center1(3) ) * ( C_center(3) - C_center2(3) ) 
+
+  cz = 0.d0
+  do i = 0, iorder(3)
+    
+    ! < XA | exp[-gama r_C^2] (z - z_C)^2 | XB >
+    power_C = 2
+    cz      = cz + P_AB(i,3) &
+            * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] (z - z_C) | XB >
+    power_C = 1
+    cz      = cz + P_AB(i,3) * c_tmp1 &
+            * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] | XB >
+    power_C = 0
+    cz      = cz + P_AB(i,3) * c_tmp2 &
+            * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+
+  enddo
+
+  int_tmp += cx0 * cy0 * cz
+
+  ! -----------------------------------------------------------------------------------------------
+
+  int_gauss_4G = fact_AB * fact_C * int_tmp
+
+  return
+end function int_gauss_4G
+!_____________________________________________________________________________________________________________
+!_____________________________________________________________________________________________________________
+
+

src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f

@@ -0,0 +1,303 @@
+! ---
+
+BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)]
+
+  BEGIN_DOC
+  !
+  !  :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \rangle` 
+  !
+  END_DOC
+
+  implicit none
+
+  integer          :: num_A, num_B
+  integer          :: power_A(3), power_B(3)
+  integer          :: i, j, k, l, m
+  double precision :: alpha, beta, gama, coef
+  double precision :: A_center(3), B_center(3), C_center(3)
+  double precision :: c1, c2, c
+
+  integer          :: dim1
+  double precision :: overlap_y, d_a_2, overlap_z, overlap
+
+  double precision :: int_gauss_r0, int_gauss_r2
+
+  PROVIDE j1b_type j1b_pen j1b_coeff
+
+  ! --------------------------------------------------------------------------------
+  ! -- Dummy call to provide everything
+  dim1        = 100
+  A_center(:) = 0.d0
+  B_center(:) = 1.d0
+  alpha       = 1.d0
+  beta        = 0.1d0
+  power_A(:)  = 1
+  power_B(:)  = 0
+  call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                           , overlap_y, d_a_2, overlap_z, overlap, dim1 )
+  ! --------------------------------------------------------------------------------
+  
+  j1b_gauss_hermI(1:ao_num,1:ao_num) = 0.d0
+
+  if(j1b_type .eq. 1) then
+  ! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)]
+
+ !$OMP PARALLEL                                                 &
+ !$OMP DEFAULT (NONE)                                           &
+ !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama,               &
+ !$OMP          A_center, B_center, C_center, power_A, power_B, &
+ !$OMP          num_A, num_B, c1, c2, c)                        &
+ !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp,     & 
+ !$OMP         ao_power, ao_nucl, nucl_coord,                   &
+ !$OMP         ao_coef_normalized_ordered_transp,               &
+ !$OMP         nucl_num, j1b_pen, j1b_gauss_hermI)
+ !$OMP DO SCHEDULE (dynamic)
+    do j = 1, ao_num
+      num_A         = ao_nucl(j)
+      power_A(1:3)  = ao_power(j,1:3)
+      A_center(1:3) = nucl_coord(num_A,1:3)
+  
+      do i = 1, ao_num
+        num_B         = ao_nucl(i)
+        power_B(1:3)  = ao_power(i,1:3)
+        B_center(1:3) = nucl_coord(num_B,1:3)
+  
+        do l = 1, ao_prim_num(j)
+          alpha = ao_expo_ordered_transp(l,j)
+  
+          do m = 1, ao_prim_num(i)
+            beta = ao_expo_ordered_transp(m,i)
+  
+            c = 0.d0
+            do k = 1, nucl_num
+              gama          = j1b_pen(k)
+              C_center(1:3) = nucl_coord(k,1:3)
+  
+              ! < XA | exp[-gama r_C^2] | XB >
+              c1 = int_gauss_r0( A_center, B_center, C_center        &
+                               , power_A, power_B, alpha, beta, gama )
+  
+              ! < XA | r_A^2 exp[-gama r_C^2] | XB >
+              c2 = int_gauss_r2( A_center, B_center, C_center        &
+                               , power_A, power_B, alpha, beta, gama )
+  
+              c = c + 3.d0 * gama * c1 - 2.d0 * gama * gama * c2
+            enddo
+  
+            j1b_gauss_hermI(i,j) = j1b_gauss_hermI(i,j)      & 
+                    + ao_coef_normalized_ordered_transp(l,j) &
+                    * ao_coef_normalized_ordered_transp(m,i) * c
+          enddo
+        enddo
+      enddo
+    enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  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
+
+
+!_____________________________________________________________________________________________________________
+!
+!                             < XA | exp[-gama r_C^2] | XB >
+!
+double precision function int_gauss_r0(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
+
+  ! for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  integer         , intent(in) :: power_A(3), power_B(3)
+  double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
+  double precision, intent(in) :: alpha, beta, gama 
+
+  integer                      :: i, power_C, dim1
+  integer                      :: iorder(3)
+  integer                      :: nmax
+  double precision             :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
+  double precision             :: cx, cy, cz 
+
+  double precision             :: overlap_gaussian_x 
+
+  dim1 = 100
+
+  ! P_AB(0:max_dim,3) polynomial
+  ! AB_center(3)      new center
+  ! AB_expo           new exponent
+  ! fact_AB           constant factor
+  ! iorder(3)         i_order(i) = order of the polynomials
+  call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
+
+  if( fact_AB .lt. 1d-20 ) then
+    int_gauss_r0 = 0.d0
+    return
+  endif
+
+  power_C = 0
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+
+  int_gauss_r0 = fact_AB * cx * cy * cz
+
+  return
+end function int_gauss_r0 
+!_____________________________________________________________________________________________________________
+!_____________________________________________________________________________________________________________
+
+
+
+!_____________________________________________________________________________________________________________
+!
+!                             < XA | r_C^2 exp[-gama r_C^2] | XB >
+!
+double precision function int_gauss_r2(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
+
+  ! for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  integer,          intent(in) :: power_A(3), power_B(3)
+  double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
+  double precision, intent(in) :: alpha, beta, gama 
+
+  integer                      :: i, power_C, dim1
+  integer                      :: iorder(3)
+  double precision             :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
+  double precision             :: cx0, cy0, cz0, cx, cy, cz
+  double precision             :: int_tmp
+
+  double precision             :: overlap_gaussian_x
+
+  dim1 = 100
+
+  ! P_AB(0:max_dim,3) polynomial centered on AB_center
+  ! AB_center(3)      new center
+  ! AB_expo           new exponent
+  ! fact_AB           constant factor
+  ! iorder(3)         i_order(i) = order of the polynomials
+  call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
+
+  ! <<<
+  ! to avoid multi-evaluation
+  power_C = 0
+
+  cx0 = 0.d0
+  do i = 0, iorder(1)
+    cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cy0 = 0.d0
+  do i = 0, iorder(2)
+    cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cz0 = 0.d0
+  do i = 0, iorder(3)
+    cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+  ! >>>
+
+  int_tmp = 0.d0
+
+  power_C = 2
+
+  ! ( x - XC)^2
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  int_tmp += cx * cy0 * cz0
+
+  ! ( y - YC)^2
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  int_tmp += cx0 * cy * cz0
+
+  ! ( z - ZC)^2
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+  int_tmp += cx0 * cy0 * cz
+
+  int_gauss_r2 = fact_AB * int_tmp
+
+  return
+end function int_gauss_r2
+!_____________________________________________________________________________________________________________
+!_____________________________________________________________________________________________________________
+
+

src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f

@@ -0,0 +1,371 @@
+! ---
+
+BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)]
+
+  BEGIN_DOC
+  !
+  !  j1b_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{1b} \cdot grad | \chi_i \rangle  
+  !
+  END_DOC
+
+  implicit none
+
+  integer          :: num_A, num_B
+  integer          :: power_A(3), power_B(3)
+  integer          :: i, j, k, l, m
+  double precision :: alpha, beta, gama, coef
+  double precision :: A_center(3), B_center(3), C_center(3)
+  double precision :: c1, c
+
+  integer          :: dim1
+  double precision :: overlap_y, d_a_2, overlap_z, overlap
+
+  double precision :: int_gauss_deriv
+
+  PROVIDE j1b_type j1b_pen j1b_coeff
+
+  ! --------------------------------------------------------------------------------
+  ! -- Dummy call to provide everything
+  dim1        = 100
+  A_center(:) = 0.d0
+  B_center(:) = 1.d0
+  alpha       = 1.d0
+  beta        = 0.1d0
+  power_A(:)  = 1
+  power_B(:)  = 0
+  call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                           , overlap_y, d_a_2, overlap_z, overlap, dim1 )
+  ! --------------------------------------------------------------------------------
+  
+
+  j1b_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0
+
+   if(j1b_type .eq. 1) then
+  ! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)] 
+
+ !$OMP PARALLEL                                                 &
+ !$OMP DEFAULT (NONE)                                           &
+ !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama,               &
+ !$OMP          A_center, B_center, C_center, power_A, power_B, &
+ !$OMP          num_A, num_B, c1, c)                            &
+ !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp,     & 
+ !$OMP         ao_power, ao_nucl, nucl_coord,                   &
+ !$OMP         ao_coef_normalized_ordered_transp,               &
+ !$OMP         nucl_num, j1b_pen, j1b_gauss_nonherm)
+ !$OMP DO SCHEDULE (dynamic)
+    do j = 1, ao_num
+      num_A         = ao_nucl(j)
+      power_A(1:3)  = ao_power(j,1:3)
+      A_center(1:3) = nucl_coord(num_A,1:3)
+  
+      do i = 1, ao_num
+        num_B         = ao_nucl(i)
+        power_B(1:3)  = ao_power(i,1:3)
+        B_center(1:3) = nucl_coord(num_B,1:3)
+  
+        do l = 1, ao_prim_num(j)
+          alpha = ao_expo_ordered_transp(l,j)
+  
+          do m = 1, ao_prim_num(i)
+            beta = ao_expo_ordered_transp(m,i)
+  
+            c = 0.d0
+            do k = 1, nucl_num
+              gama          = j1b_pen(k)
+              C_center(1:3) = nucl_coord(k,1:3)
+  
+              !  \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle
+              c1 = int_gauss_deriv( A_center, B_center, C_center        &
+                                  , power_A, power_B, alpha, beta, gama )
+  
+              c = c + 2.d0 * gama * c1 
+            enddo
+  
+            j1b_gauss_nonherm(i,j) =  j1b_gauss_nonherm(i,j) & 
+                    + ao_coef_normalized_ordered_transp(l,j) &
+                    * ao_coef_normalized_ordered_transp(m,i) * c
+          enddo
+        enddo
+      enddo
+    enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  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
+
+
+
+
+
+!_____________________________________________________________________________________________________________
+!
+!                            < XA | exp[-gama r_C^2] r_C \cdot grad | XB >
+!
+double precision function int_gauss_deriv(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
+
+  ! for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
+  integer         , intent(in) :: power_A(3), power_B(3)
+  double precision, intent(in) :: alpha, beta, gama 
+
+  integer                      :: i, power_C, dim1
+  integer                      :: iorder(3), power_D(3)
+  double precision             :: AB_expo
+  double precision             :: fact_AB, center_AB(3), pol_AB(0:max_dim,3)
+  double precision             :: cx, cy, cz
+
+  double precision             :: overlap_gaussian_x
+
+  dim1 = 100
+
+  int_gauss_deriv = 0.d0
+
+  ! ===============
+  ! term I:
+  !     \partial_x
+  ! ===============
+
+  if( power_B(1) .ge. 1 ) then
+
+    power_D(1) = power_B(1) - 1
+    power_D(2) = power_B(2)
+    power_D(3) = power_B(3)
+
+    call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                        , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+    power_C = 1
+    cx = 0.d0
+    do i = 0, iorder(1)
+      cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 0
+    cy = 0.d0
+    do i = 0, iorder(2)
+      cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 0
+    cz = 0.d0
+    do i = 0, iorder(3)
+      cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+    enddo
+
+    int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(1)) * cx * cy * cz
+  endif
+
+  ! ===============
+
+  power_D(1) = power_B(1) + 1
+  power_D(2) = power_B(2)
+  power_D(3) = power_B(3)
+
+  call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+  power_C = 1
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 0
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 0
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+
+  int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
+
+  ! ===============
+  ! ===============
+
+
+  ! ===============
+  ! term II:
+  !     \partial_y
+  ! ===============
+
+  if( power_B(2) .ge. 1 ) then
+
+    power_D(1) = power_B(1) 
+    power_D(2) = power_B(2) - 1
+    power_D(3) = power_B(3)
+
+    call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                        , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+    power_C = 0
+    cx = 0.d0
+    do i = 0, iorder(1)
+      cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 1
+    cy = 0.d0
+    do i = 0, iorder(2)
+      cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 0
+    cz = 0.d0
+    do i = 0, iorder(3)
+      cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+    enddo
+
+    int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(2)) * cx * cy * cz
+  endif
+
+  ! ===============
+
+  power_D(1) = power_B(1) 
+  power_D(2) = power_B(2) + 1
+  power_D(3) = power_B(3)
+
+  call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+  power_C = 0
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 1
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 0
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+
+  int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
+
+  ! ===============
+  ! ===============
+
+  ! ===============
+  ! term III:
+  !     \partial_z
+  ! ===============
+
+  if( power_B(3) .ge. 1 ) then
+
+    power_D(1) = power_B(1) 
+    power_D(2) = power_B(2) 
+    power_D(3) = power_B(3) - 1
+
+    call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                        , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+    power_C = 0
+    cx = 0.d0
+    do i = 0, iorder(1)
+      cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 0
+    cy = 0.d0
+    do i = 0, iorder(2)
+      cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 1
+    cz = 0.d0
+    do i = 0, iorder(3)
+      cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+    enddo
+
+    int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(3)) * cx * cy * cz
+  endif
+
+  ! ===============
+
+  power_D(1) = power_B(1) 
+  power_D(2) = power_B(2)
+  power_D(3) = power_B(3) + 1
+
+  call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+  power_C = 0
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 0
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 1
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+
+  int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
+
+  ! ===============
+  ! ===============
+
+  return
+end function int_gauss_deriv
+!_____________________________________________________________________________________________________________
+!_____________________________________________________________________________________________________________
+
+

src/ao_tc_eff_map/potential.irp.f

@@ -0,0 +1,335 @@
+! ---
+
+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
+
+  n_gauss_eff_pot = ng_fit_jast + 1
+
+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 
+
+! ---
+
+ BEGIN_PROVIDER [double precision, expo_gauss_eff_pot, (n_gauss_eff_pot)]
+&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'
+
+  implicit none
+  integer :: i
+ 
+  ! fit of the -0.25 * (1 - erf(mu*x))^2 with n_max_fit_slat gaussians 
+  do i = 1, ng_fit_jast
+   expo_gauss_eff_pot(i) = expo_gauss_1_erf_x_2(i) 
+   coef_gauss_eff_pot(i) = -0.25d0 * coef_gauss_1_erf_x_2(i) ! -1/4 * (1 - erf(mu*x))^2
+  enddo
+
+  ! Analytical Gaussian part of the potential: + 1/(\sqrt(pi)mu) * exp(-(mu*x)^2) 
+  expo_gauss_eff_pot(ng_fit_jast+1) = mu_erf * mu_erf
+  coef_gauss_eff_pot(ng_fit_jast+1) =  1.d0 * mu_erf * inv_sq_pi
+
+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
+  double precision, intent(in) :: x, mu
+
+  eff_pot_gauss =  mu/dsqrt(dacos(-1.d0)) * dexp(-mu*mu*x*x) - 0.25d0 * (1.d0 - derf(mu*x))**2.d0
+
+end
+
+! -------------------------------------------------------------------------------------------------
+! ---
+
+double precision function eff_pot_fit_gauss(x)
+ implicit none
+ BEGIN_DOC
+ ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) 
+ ! 
+ ! but fitted with gaussians 
+ END_DOC
+ double precision, intent(in) :: x
+ integer :: i
+ double precision :: alpha
+ eff_pot_fit_gauss = derf(mu_erf*x)/x
+ do i = 1, n_gauss_eff_pot
+  alpha = expo_gauss_eff_pot(i)
+  eff_pot_fit_gauss += coef_gauss_eff_pot(i) * dexp(-alpha*x*x)
+ enddo
+end
+
+BEGIN_PROVIDER [integer, n_fit_1_erf_x]
+ implicit none
+ BEGIN_DOC
+! 
+ END_DOC
+ n_fit_1_erf_x = 2
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [double precision, expos_slat_gauss_1_erf_x, (n_fit_1_erf_x)]
+ implicit none
+ BEGIN_DOC
+! 1 - erf(mu*x) is fitted with a Slater and gaussian as in Eq.A15 of  JCP 154, 084119 (2021)
+!
+! 1 - erf(mu*x) = e^{-expos_slat_gauss_1_erf_x(1) * mu *x} * e^{-expos_slat_gauss_1_erf_x(2) * mu^2 * x^2}
+ END_DOC
+ expos_slat_gauss_1_erf_x(1) = 1.09529d0
+ expos_slat_gauss_1_erf_x(2) = 0.756023d0
+END_PROVIDER 
+
+! ---
+
+ BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x, (n_max_fit_slat)]
+&BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x, (n_max_fit_slat)]
+
+  BEGIN_DOC
+  !
+  ! (1 - erf(mu*x)) = \sum_i coef_gauss_1_erf_x(i) * exp(-expo_gauss_1_erf_x(i) * x^2)
+  !
+  ! This is based on a fit of (1 - erf(mu*x)) by exp(-alpha * x) exp(-beta*mu^2x^2) 
+  !
+  ! and the slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians 
+  !
+  ! See Appendix 2 of JCP 154, 084119 (2021)
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i
+  double precision :: expos(n_max_fit_slat), alpha, beta
+
+  alpha = expos_slat_gauss_1_erf_x(1) * mu_erf
+  call expo_fit_slater_gam(alpha, expos)
+  beta = expos_slat_gauss_1_erf_x(2) * mu_erf * mu_erf
+ 
+  do i = 1, n_max_fit_slat
+    expo_gauss_1_erf_x(i) = expos(i) + beta
+    coef_gauss_1_erf_x(i) = coef_fit_slat_gauss(i)
+  enddo
+
+END_PROVIDER 
+
+! ---
+
+double precision function fit_1_erf_x(x)
+
+  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
+
+  fit_1_erf_x = 0.d0
+  do i = 1, n_max_fit_slat
+    fit_1_erf_x += dexp(-expo_gauss_1_erf_x(i) *x*x) * coef_gauss_1_erf_x(i)
+  enddo
+
+end
+
+! ---
+
+ BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x_2, (ng_fit_jast)]
+&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
+  integer          :: i
+  double precision :: expos(ng_fit_jast), alpha, beta, tmp
+
+  if(ng_fit_jast .eq. 1) then
+
+    coef_gauss_1_erf_x_2 = (/ 0.85345277d0 /)
+    expo_gauss_1_erf_x_2 = (/ 6.23519457d0 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_1_erf_x_2(i) = tmp * expo_gauss_1_erf_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 2) then
+
+    coef_gauss_1_erf_x_2 = (/ 0.31030624d0 , 0.64364964d0 /)
+    expo_gauss_1_erf_x_2 = (/ 55.39184787d0, 3.92151407d0 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_1_erf_x_2(i) = tmp * expo_gauss_1_erf_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 3) then
+
+    coef_gauss_1_erf_x_2 = (/ 0.33206082d0 , 0.52347449d0, 0.12605012d0   /)
+    expo_gauss_1_erf_x_2 = (/ 19.90272209d0, 3.2671671d0 , 336.47320445d0 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_1_erf_x_2(i) = tmp * expo_gauss_1_erf_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 5) then
+
+    coef_gauss_1_erf_x_2 = (/ 0.02956716d0, 0.17025555d0, 0.32774114d0, 0.39034764d0, 0.07822781d0 /)
+    expo_gauss_1_erf_x_2 = (/ 6467.28126d0, 46.9071990d0, 9.09617721d0, 2.76883328d0, 360.367093d0 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_1_erf_x_2(i) = tmp * expo_gauss_1_erf_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 6) then
+
+    coef_gauss_1_erf_x_2 = (/ 0.18331042d0  , 0.10971118d0  , 0.29949169d0  , 0.34853132d0  , 0.0394275d0   , 0.01874444d0   /)
+    expo_gauss_1_erf_x_2 = (/ 2.54293498d+01, 1.40317872d+02, 7.14630801d+00, 2.65517675d+00, 1.45142619d+03, 1.00000000d+04 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_1_erf_x_2(i) = tmp * expo_gauss_1_erf_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 7) then
+
+    coef_gauss_1_erf_x_2 = (/ 0.0213619d0   , 0.03221511d0  , 0.29966689d0  , 0.19178934d0  , 0.06154732d0  , 0.28214555d0  , 0.11125985d0   /)
+    expo_gauss_1_erf_x_2 = (/ 1.34727067d+04, 1.27166613d+03, 5.52584567d+00, 1.67753218d+01, 2.46145691d+02, 2.47971820d+00, 5.95141293d+01 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_1_erf_x_2(i) = tmp * expo_gauss_1_erf_x_2(i)
+    enddo
+
+  elseif(ng_fit_jast .eq. 8) then
+
+    coef_gauss_1_erf_x_2 = (/ 0.28189124d0  , 0.19518669d0  , 0.12161735d0  , 0.24257438d0  , 0.07309656d0  , 0.042435d0    , 0.01926109d0  , 0.02393415d0   /)
+    expo_gauss_1_erf_x_2 = (/ 4.69795903d+00, 1.21379451d+01, 3.55527053d+01, 2.39227172d+00, 1.14827721d+02, 4.16320213d+02, 1.52813587d+04, 1.78516557d+03 /)
+
+    tmp = mu_erf * mu_erf
+    do i = 1, ng_fit_jast
+      expo_gauss_1_erf_x_2(i) = tmp * expo_gauss_1_erf_x_2(i)
+    enddo
+
+  !elseif(ng_fit_jast .eq. 9) then
+
+  !  coef_gauss_1_erf_x_2 = (/  /)
+  !  expo_gauss_1_erf_x_2 = (/  /)
+
+  !  tmp = mu_erf * mu_erf
+  !  do i = 1, ng_fit_jast
+  !    expo_gauss_1_erf_x_2(i) = tmp * expo_gauss_1_erf_x_2(i)
+  !  enddo
+
+  elseif(ng_fit_jast .eq. 20) then
+
+    ASSERT(n_max_fit_slat == 20)
+
+    alpha = 2.d0 * expos_slat_gauss_1_erf_x(1) * mu_erf
+    call expo_fit_slater_gam(alpha, expos)
+    beta = 2.d0 * expos_slat_gauss_1_erf_x(2) * mu_erf * mu_erf
+    do i = 1, n_max_fit_slat
+      expo_gauss_1_erf_x_2(i) = expos(i) + beta
+      coef_gauss_1_erf_x_2(i) = coef_fit_slat_gauss(i)
+    enddo
+
+  else
+
+    print *, ' not implemented yet'
+    stop
+
+  endif
+
+END_PROVIDER 
+
+! ---
+
+double precision function fit_1_erf_x_2(x)
+ implicit none
+ double precision, intent(in) :: x
+ BEGIN_DOC
+! fit_1_erf_x_2(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))^2
+ END_DOC
+ integer :: i
+ fit_1_erf_x_2 = 0.d0
+ do i = 1, n_max_fit_slat
+  fit_1_erf_x_2 += dexp(-expo_gauss_1_erf_x_2(i) *x*x) * coef_gauss_1_erf_x_2(i)
+ enddo
+
+end
+
+subroutine inv_r_times_poly(r, dist_r, dist_vec, poly)
+ implicit none
+ BEGIN_DOC
+! returns 
+!
+! poly(1) = x / sqrt(x^2+y^2+z^2), poly(2) = y / sqrt(x^2+y^2+z^2), poly(3) = z / sqrt(x^2+y^2+z^2)
+!
+! with the arguments  
+!
+! r(1)  = x, r(2) = y, r(3) = z, dist_r = sqrt(x^2+y^2+z^2)
+!
+! dist_vec(1) = sqrt(y^2+z^2), dist_vec(2) = sqrt(x^2+z^2), dist_vec(3) = sqrt(x^2+y^2)
+ END_DOC
+ double precision, intent(in) :: r(3), dist_r, dist_vec(3)
+ double precision, intent(out):: poly(3)
+ double precision :: inv_dist
+ integer :: i
+ if (dist_r.gt. 1.d-8)then
+  inv_dist = 1.d0/dist_r
+  do i = 1, 3
+   poly(i) = r(i) * inv_dist 
+  enddo
+ else
+  do i = 1, 3
+   if(dabs(r(i)).lt.dist_vec(i))then
+    inv_dist = 1.d0/dist_r
+    poly(i) = r(i) * inv_dist 
+   else !if(dabs(r(i)))then
+    poly(i) = 1.d0 
+!    poly(i) = 0.d0 
+   endif
+  enddo
+ endif
+end                      

src/ao_tc_eff_map/providers_ao_eff_pot.irp.f

@@ -0,0 +1,86 @@
+
+BEGIN_PROVIDER [ logical, ao_tc_sym_two_e_pot_in_map ]
+  implicit none
+  use f77_zmq
+  use map_module
+  BEGIN_DOC
+  !  Map of Atomic integrals
+  !     i(r1) j(r2) 1/r12 k(r1) l(r2)
+  END_DOC
+
+  integer                        :: i,j,k,l
+  double precision               :: ao_tc_sym_two_e_pot,cpu_1,cpu_2, wall_1, wall_2
+  double precision               :: integral, wall_0
+  include 'utils/constants.include.F'
+
+  ! For integrals file
+  integer(key_kind),allocatable  :: buffer_i(:)
+  integer,parameter              :: size_buffer = 1024*64
+  real(integral_kind),allocatable :: buffer_value(:)
+
+  integer                        :: n_integrals, rc
+  integer                        :: kk, m, j1, i1, lmax
+  character*(64)                 :: fmt
+
+  !double precision               :: j1b_gauss_coul_debug
+  !integral = j1b_gauss_coul_debug(1,1,1,1)
+
+  integral = ao_tc_sym_two_e_pot(1,1,1,1)
+
+  double precision               :: map_mb
+
+  print*, 'Providing the ao_tc_sym_two_e_pot_map integrals'
+  call wall_time(wall_0)
+  call wall_time(wall_1)
+  call cpu_time(cpu_1)
+
+  integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
+  call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_tc_sym_two_e_pot')
+
+  character(len=:), allocatable :: task
+  allocate(character(len=ao_num*12) :: task)
+  write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
+  do l=1,ao_num
+    write(task,fmt) (i,l, i=1,l)
+    integer, external :: add_task_to_taskserver
+    if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
+      stop 'Unable to add task to server'
+    endif
+  enddo
+  deallocate(task)
+
+  integer, external :: zmq_set_running
+  if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
+    print *,  irp_here, ': Failed in zmq_set_running'
+  endif
+
+  PROVIDE nproc
+  !$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
+      i = omp_get_thread_num()
+      if (i==0) then
+        call ao_tc_sym_two_e_pot_in_map_collector(zmq_socket_pull)
+      else
+        call ao_tc_sym_two_e_pot_in_map_slave_inproc(i)
+      endif
+  !$OMP END PARALLEL
+
+  call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_tc_sym_two_e_pot')
+
+
+  print*, 'Sorting the map'
+  call map_sort(ao_tc_sym_two_e_pot_map)
+  call cpu_time(cpu_2)
+  call wall_time(wall_2)
+  integer(map_size_kind)         :: get_ao_tc_sym_two_e_pot_map_size, ao_eff_pot_map_size
+  ao_eff_pot_map_size = get_ao_tc_sym_two_e_pot_map_size()
+
+  print*, 'AO eff_pot integrals provided:'
+  print*, ' Size of AO eff_pot map :         ', map_mb(ao_tc_sym_two_e_pot_map) ,'MB'
+  print*, ' Number of AO eff_pot integrals :', ao_eff_pot_map_size
+  print*, ' cpu  time :',cpu_2 - cpu_1, 's'
+  print*, ' wall time :',wall_2 - wall_1, 's  ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
+
+  ao_tc_sym_two_e_pot_in_map = .True.
+
+
+END_PROVIDER

src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f

@@ -0,0 +1,728 @@
+! ---
+
+double precision function j1b_gauss_2e_j1(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ (1 - erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                                    + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                                    - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
+  !                                                    - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision    :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: j1b_gauss_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)
+    return
+  endif
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_2e_j1 = 0.d0
+
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p1_inv = 1.d0 / pp1
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+          q1_inv = 1.d0 / qq1
+
+          call get_cxcycz_j1( dim1, cx, cy, cz                                  &
+                            , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                            , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+          j1b_gauss_2e_j1 = j1b_gauss_2e_j1 + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  return
+end function j1b_gauss_2e_j1
+
+! ---
+
+double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ (1 - erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                                    + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                                    - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
+  !                                                    - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in)           :: i, j, k, l
+
+  integer                       :: p, q, r, s
+  integer                       :: num_i, num_j, num_k, num_l, num_ii 
+  integer                       :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer                       :: iorder_p(3), iorder_q(3)
+  integer                       :: dim1
+
+  double precision              :: coef1, coef2, coef3, coef4
+  double precision              :: expo1, expo2, expo3, expo4
+  double precision              :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision              :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision              :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision              :: cx, cy, cz
+  double precision              :: schwartz_ij, thr
+  double precision, allocatable :: schwartz_kl(:,:) 
+
+  PROVIDE j1b_pen
+
+  dim1 = n_pt_max_integrals
+  thr  = ao_integrals_threshold * ao_integrals_threshold
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+
+  allocate( schwartz_kl(0:ao_prim_num(l) , 0:ao_prim_num(k)) )
+
+  schwartz_kl(0,0) = 0.d0
+  do r = 1, ao_prim_num(k)
+    expo3 = ao_expo_ordered_transp(r,k)
+    coef3 = ao_coef_normalized_ordered_transp(r,k) * ao_coef_normalized_ordered_transp(r,k)
+
+    schwartz_kl(0,r) = 0.d0
+    do s = 1, ao_prim_num(l)
+      expo4 = ao_expo_ordered_transp(s,l)
+      coef4 = coef3 * ao_coef_normalized_ordered_transp(s,l) * ao_coef_normalized_ordered_transp(s,l)
+
+      call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                          , K_power, L_power, K_center, L_center, dim1 )
+      q1_inv = 1.d0 / qq1
+
+      call get_cxcycz_j1( dim1, cx, cy, cz                                  &
+                        , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q &
+                        , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+      schwartz_kl(s,r) = coef4 * dabs( cx + cy + cz )
+      schwartz_kl(0,r) = max( schwartz_kl(0,r) , schwartz_kl(s,r) )
+    enddo
+
+    schwartz_kl(0,0) = max( schwartz_kl(0,r) , schwartz_kl(0,0) )
+  enddo
+
+
+  j1b_gauss_2e_j1_schwartz = 0.d0
+
+  do p = 1, ao_prim_num(i)
+    expo1 = ao_expo_ordered_transp(p, i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      expo2 = ao_expo_ordered_transp(q, j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p1_inv = 1.d0 / pp1
+
+      call get_cxcycz_j1( dim1, cx, cy, cz                                  &
+                        , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                        , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p )
+
+      schwartz_ij = coef2 * coef2 * dabs( cx + cy + cz )
+      if( schwartz_kl(0,0) * schwartz_ij < thr ) cycle
+
+      do r = 1, ao_prim_num(k)
+        if( schwartz_kl(0,r) * schwartz_ij < thr ) cycle
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          if( schwartz_kl(s,r) * schwartz_ij < thr ) cycle
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+          q1_inv = 1.d0 / qq1
+
+          call get_cxcycz_j1( dim1, cx, cy, cz                                  &
+                            , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                            , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+          j1b_gauss_2e_j1_schwartz = j1b_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  deallocate( schwartz_kl )
+
+  return
+end function j1b_gauss_2e_j1_schwartz
+
+! ---
+
+subroutine get_cxcycz_j1( dim1, cx, cy, cz                                  &
+                        , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                        , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer,          intent(in)  :: dim1
+  integer,          intent(in)  :: iorder_p(3), iorder_q(3)
+  double precision, intent(in)  :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision, intent(in)  :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision, intent(out) :: cx, cy, cz
+
+  integer                       :: ii
+  integer                       :: shift_P(3), shift_Q(3)
+  double precision              :: expoii, factii, Centerii(3)
+  double precision              :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2, p2_inv
+  double precision              :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2, q2_inv
+  double precision              :: ff, gg
+
+  double precision              :: general_primitive_integral_erf_shifted
+  double precision              :: general_primitive_integral_coul_shifted
+
+  PROVIDE j1b_pen
+
+  cx = 0.d0
+  cy = 0.d0
+  cz = 0.d0
+  do ii = 1, nucl_num
+
+    expoii        = j1b_pen(ii)
+    Centerii(1:3) = nucl_coord(ii, 1:3)
+
+    call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)
+    fact_p2 = fact_p1 * factii
+    p2_inv  = 1.d0 / pp2
+    call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new )
+
+    call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center)
+    fact_q2 = fact_q1 * factii
+    q2_inv  = 1.d0 / qq2
+    call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new )
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !                     [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+    ! ----------------------------------------------------------------------------------------------------
+
+    shift_Q = (/ 0, 0, 0 /)
+
+    ! x term:
+    ff = P2_center(1) - Centerii(1) 
+
+    shift_P = (/ 2, 0, 0 /)
+    cx = cx + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 1, 0, 0 /)
+    cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cx = cx - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+    shift_P = (/ 0, 0, 0 /)
+    cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cx = cx - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P2_center(2) - Centerii(2) 
+
+    shift_P = (/ 0, 2, 0 /)
+    cy = cy + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 0, 1, 0 /)
+    cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cy = cy - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+    shift_P = (/ 0, 0, 0 /)
+    cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cy = cy - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P2_center(3) - Centerii(3) 
+
+    shift_P = (/ 0, 0, 2 /)
+    cz = cz + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 0, 0, 1 /)
+    cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cz = cz - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+    shift_P = (/ 0, 0, 0 /)
+    cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cz = cz - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !                     [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
+    ! ----------------------------------------------------------------------------------------------------
+
+    shift_P = (/ 0, 0, 0 /)
+
+    ! x term:
+    ff = Q2_center(1) - Centerii(1) 
+
+    shift_Q = (/ 2, 0, 0 /)
+    cx = cx + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cx = cx - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cx = cx - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = Q2_center(2) - Centerii(2) 
+
+    shift_Q = (/ 0, 2, 0 /)
+    cy = cy + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cy = cy - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cy = cy - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = Q2_center(3) - Centerii(3) 
+
+    shift_Q = (/ 0, 0, 2 /)
+    cz = cz + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cz = cz - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cz = cz - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !              - [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
+    ! ----------------------------------------------------------------------------------------------------
+
+    ! x term:
+    ff = P2_center(1) - Centerii(1) 
+    gg = Q1_center(1) - Centerii(1) 
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P2_center(2) - Centerii(2) 
+    gg = Q1_center(2) - Centerii(2) 
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P2_center(3) - Centerii(3) 
+    gg = Q1_center(3) - Centerii(3) 
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !              - [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+    ! ----------------------------------------------------------------------------------------------------
+
+    ! x term:
+    ff = P1_center(1) - Centerii(1) 
+    gg = Q2_center(1) - Centerii(1) 
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P1_center(2) - Centerii(2) 
+    gg = Q2_center(2) - Centerii(2) 
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P1_center(3) - Centerii(3) 
+    gg = Q2_center(3) - Centerii(3) 
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+  enddo
+
+  return
+end subroutine get_cxcycz_j1
+
+! ---
+

src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f

@@ -0,0 +1,729 @@
+! ---
+
+double precision function j1b_gauss_2e_j2(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A c_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ (1 - erf(mu r12) / r12 ] \sum_A a_A c_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                                        + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                                        - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
+  !                                                        - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision    :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: j1b_gauss_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)
+    return
+  endif
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_2e_j2 = 0.d0
+
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p1_inv = 1.d0 / pp1
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+          q1_inv = 1.d0 / qq1
+
+          call get_cxcycz_j2( dim1, cx, cy, cz                                  &
+                            , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                            , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+          j1b_gauss_2e_j2 = j1b_gauss_2e_j2 + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  return
+end function j1b_gauss_2e_j2
+
+! ---
+
+double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A c_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ (1 - erf(mu r12) / r12 ] \sum_A a_A c_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                                        + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                                        - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
+  !                                                        - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in)           :: i, j, k, l
+
+  integer                       :: p, q, r, s
+  integer                       :: num_i, num_j, num_k, num_l, num_ii 
+  integer                       :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer                       :: iorder_p(3), iorder_q(3)
+  integer                       :: dim1
+
+  double precision              :: coef1, coef2, coef3, coef4
+  double precision              :: expo1, expo2, expo3, expo4
+  double precision              :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision              :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision              :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision              :: cx, cy, cz
+  double precision              :: schwartz_ij, thr
+  double precision, allocatable :: schwartz_kl(:,:) 
+
+  dim1 = n_pt_max_integrals
+  thr  = ao_integrals_threshold * ao_integrals_threshold
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+
+  allocate( schwartz_kl(0:ao_prim_num(l) , 0:ao_prim_num(k)) )
+
+  schwartz_kl(0,0) = 0.d0
+  do r = 1, ao_prim_num(k)
+    expo3 = ao_expo_ordered_transp(r,k)
+    coef3 = ao_coef_normalized_ordered_transp(r,k) * ao_coef_normalized_ordered_transp(r,k)
+
+    schwartz_kl(0,r) = 0.d0
+    do s = 1, ao_prim_num(l)
+      expo4 = ao_expo_ordered_transp(s,l)
+      coef4 = coef3 * ao_coef_normalized_ordered_transp(s,l) * ao_coef_normalized_ordered_transp(s,l)
+
+      call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                          , K_power, L_power, K_center, L_center, dim1 )
+      q1_inv = 1.d0 / qq1
+
+      call get_cxcycz_j2( dim1, cx, cy, cz                                  &
+                        , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q &
+                        , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+      schwartz_kl(s,r) = coef4 * dabs( cx + cy + cz )
+      schwartz_kl(0,r) = max( schwartz_kl(0,r) , schwartz_kl(s,r) )
+    enddo
+
+    schwartz_kl(0,0) = max( schwartz_kl(0,r) , schwartz_kl(0,0) )
+  enddo
+
+
+  j1b_gauss_2e_j2_schwartz = 0.d0
+
+  do p = 1, ao_prim_num(i)
+    expo1 = ao_expo_ordered_transp(p, i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      expo2 = ao_expo_ordered_transp(q, j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p1_inv = 1.d0 / pp1
+
+      call get_cxcycz_j2( dim1, cx, cy, cz                                  &
+                        , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                        , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p )
+
+      schwartz_ij = coef2 * coef2 * dabs( cx + cy + cz )
+      if( schwartz_kl(0,0) * schwartz_ij < thr ) cycle
+
+      do r = 1, ao_prim_num(k)
+        if( schwartz_kl(0,r) * schwartz_ij < thr ) cycle
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          if( schwartz_kl(s,r) * schwartz_ij < thr ) cycle
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+          q1_inv = 1.d0 / qq1
+
+          call get_cxcycz_j2( dim1, cx, cy, cz                                  &
+                            , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                            , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+          j1b_gauss_2e_j2_schwartz = j1b_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  deallocate( schwartz_kl )
+
+  return
+end function j1b_gauss_2e_j2_schwartz
+
+! ---
+
+subroutine get_cxcycz_j2( dim1, cx, cy, cz                                  &
+                        , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                        , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer,          intent(in)  :: dim1
+  integer,          intent(in)  :: iorder_p(3), iorder_q(3)
+  double precision, intent(in)  :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision, intent(in)  :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision, intent(out) :: cx, cy, cz
+
+  integer                       :: ii
+  integer                       :: shift_P(3), shift_Q(3)
+  double precision              :: coefii, expoii, factii, Centerii(3)
+  double precision              :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2, p2_inv
+  double precision              :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2, q2_inv
+  double precision              :: ff, gg
+
+  double precision              :: general_primitive_integral_erf_shifted
+  double precision              :: general_primitive_integral_coul_shifted
+
+  PROVIDE j1b_pen j1b_coeff
+
+  cx = 0.d0
+  cy = 0.d0
+  cz = 0.d0
+  do ii = 1, nucl_num
+
+    expoii        = j1b_pen  (ii)
+    coefii        = j1b_coeff(ii)
+    Centerii(1:3) = nucl_coord(ii, 1:3)
+
+    call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)
+    fact_p2 = fact_p1 * factii
+    p2_inv  = 1.d0 / pp2
+    call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new )
+
+    call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center)
+    fact_q2 = fact_q1 * factii
+    q2_inv  = 1.d0 / qq2
+    call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new )
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !                     [ (1-erf(mu r12)) / r12 ] \sum_A a_A c_A [ (r1-RA)^2 exp(-aA r1A^2)
+    ! ----------------------------------------------------------------------------------------------------
+
+    shift_Q = (/ 0, 0, 0 /)
+
+    ! x term:
+    ff = P2_center(1) - Centerii(1) 
+
+    shift_P = (/ 2, 0, 0 /)
+    cx = cx + expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx - expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 1, 0, 0 /)
+    cx = cx + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cx = cx - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1  &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+
+    shift_P = (/ 0, 0, 0 /)
+    cx = cx + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cx = cx - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P2_center(2) - Centerii(2) 
+
+    shift_P = (/ 0, 2, 0 /)
+    cy = cy + expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy - expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 0, 1, 0 /)
+    cy = cy + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cy = cy - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+    shift_P = (/ 0, 0, 0 /)
+    cy = cy + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cy = cy - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P2_center(3) - Centerii(3) 
+
+    shift_P = (/ 0, 0, 2 /)
+    cz = cz + expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz - expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 0, 0, 1 /)
+    cz = cz + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cz = cz - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+    shift_P = (/ 0, 0, 0 /)
+    cz = cz + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cz = cz - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !                     [ (1-erf(mu r12)) / r12 ] \sum_A a_A c_A [ (r2-RA)^2 exp(-aA r2A^2)
+    ! ----------------------------------------------------------------------------------------------------
+
+    shift_P = (/ 0, 0, 0 /)
+
+    ! x term:
+    ff = Q2_center(1) - Centerii(1) 
+
+    shift_Q = (/ 2, 0, 0 /)
+    cx = cx + expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx - expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cx = cx - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cx = cx - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = Q2_center(2) - Centerii(2) 
+
+    shift_Q = (/ 0, 2, 0 /)
+    cy = cy + expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy - expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cy = cy - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cy = cy - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = Q2_center(3) - Centerii(3) 
+
+    shift_Q = (/ 0, 0, 2 /)
+    cz = cz + expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz - expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cz = cz - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cz = cz - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !              - [ (1-erf(mu r12)) / r12 ] \sum_A a_A c_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
+    ! ----------------------------------------------------------------------------------------------------
+
+    ! x term:
+    ff = P2_center(1) - Centerii(1) 
+    gg = Q1_center(1) - Centerii(1) 
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1  &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1  &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cx = cx + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P2_center(2) - Centerii(2) 
+    gg = Q1_center(2) - Centerii(2) 
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1  &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1  &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cy = cy + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P2_center(3) - Centerii(3) 
+    gg = Q1_center(3) - Centerii(3) 
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1  &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1  &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cz = cz + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                      , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                      , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !              - [ (1-erf(mu r12)) / r12 ] \sum_A a_A c_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+    ! ----------------------------------------------------------------------------------------------------
+
+    ! x term:
+    ff = P1_center(1) - Centerii(1) 
+    gg = Q2_center(1) - Centerii(1) 
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1  &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1  &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cx = cx + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P1_center(2) - Centerii(2) 
+    gg = Q2_center(2) - Centerii(2) 
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1  &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1  &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cy = cy + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P1_center(3) - Centerii(3) 
+    gg = Q2_center(3) - Centerii(3) 
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * coefii * general_primitive_integral_coul_shifted( dim1      &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * coefii * general_primitive_integral_erf_shifted( dim1       &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1  &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1  &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cz = cz + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                      , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                      , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+  enddo
+
+  return
+end subroutine get_cxcycz_j2
+
+! ---
+

src/ao_tc_eff_map/two_e_ints_gauss.irp.f

@@ -0,0 +1,327 @@
+double precision function ao_tc_sym_two_e_pot(i,j,k,l)
+  implicit none
+  BEGIN_DOC
+  !  integral of the AO basis <ik|jl> or (ij|kl)
+  !     i(r1) j(r1) (tc_pot(r12,mu)) k(r2) l(r2)
+  !
+  ! where (tc_pot(r12,mu)) is the scalar part of the potential EXCLUDING the term erf(mu r12)/r12. 
+  !
+  ! See Eq. (32) of JCP 154, 084119 (2021). 
+  END_DOC
+  integer,intent(in)             :: i,j,k,l
+  integer                        :: p,q,r,s
+  double precision               :: I_center(3),J_center(3),K_center(3),L_center(3)
+  integer                        :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
+  double precision               :: integral
+  include 'utils/constants.include.F'
+  double precision               :: P_new(0:max_dim,3),P_center(3),fact_p,pp
+  double precision               :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq
+  integer                        :: iorder_p(3), iorder_q(3)
+  double precision, allocatable  :: schwartz_kl(:,:)
+  double precision               :: schwartz_ij
+  double precision :: scw_gauss_int,general_primitive_integral_gauss
+
+  dim1 = n_pt_max_integrals
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+  ao_tc_sym_two_e_pot = 0.d0
+  double precision               :: thr
+  thr = ao_integrals_threshold*ao_integrals_threshold
+
+  allocate(schwartz_kl(0:ao_prim_num(l),0:ao_prim_num(k)))
+
+      double precision               :: coef3
+      double precision               :: coef2
+      double precision               :: p_inv,q_inv
+      double precision               :: coef1
+      double precision               :: coef4
+
+    do p = 1, 3
+      I_power(p) = ao_power(i,p)
+      J_power(p) = ao_power(j,p)
+      K_power(p) = ao_power(k,p)
+      L_power(p) = ao_power(l,p)
+      I_center(p) = nucl_coord(num_i,p)
+      J_center(p) = nucl_coord(num_j,p)
+      K_center(p) = nucl_coord(num_k,p)
+      L_center(p) = nucl_coord(num_l,p)
+    enddo
+
+    schwartz_kl(0,0) = 0.d0
+    do r = 1, ao_prim_num(k)
+      coef1 = ao_coef_normalized_ordered_transp(r,k)*ao_coef_normalized_ordered_transp(r,k)
+      schwartz_kl(0,r) = 0.d0
+      do s = 1, ao_prim_num(l)
+        coef2 = coef1 * ao_coef_normalized_ordered_transp(s,l) * ao_coef_normalized_ordered_transp(s,l)
+        call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q,&
+            ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),                 &
+            K_power,L_power,K_center,L_center,dim1)
+        q_inv = 1.d0/qq
+        scw_gauss_int = general_primitive_integral_gauss(dim1,              &
+                Q_new,Q_center,fact_q,qq,q_inv,iorder_q,             &
+                Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
+
+        schwartz_kl(s,r) = dabs(scw_gauss_int * coef2)
+        schwartz_kl(0,r) = max(schwartz_kl(0,r),schwartz_kl(s,r))
+      enddo
+      schwartz_kl(0,0) = max(schwartz_kl(0,r),schwartz_kl(0,0))
+    enddo
+    do p = 1, ao_prim_num(i)
+      coef1 = ao_coef_normalized_ordered_transp(p,i)
+      do q = 1, ao_prim_num(j)
+        coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
+        call give_explicit_poly_and_gaussian(P_new,P_center,pp,fact_p,iorder_p,&
+            ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),                 &
+            I_power,J_power,I_center,J_center,dim1)
+        p_inv = 1.d0/pp
+        scw_gauss_int = general_primitive_integral_gauss(dim1,              &
+                P_new,P_center,fact_p,pp,p_inv,iorder_p,             &
+                P_new,P_center,fact_p,pp,p_inv,iorder_p)
+        schwartz_ij = dabs(scw_gauss_int * coef2*coef2)
+        if (schwartz_kl(0,0)*schwartz_ij < thr) then
+           cycle
+        endif
+        do r = 1, ao_prim_num(k)
+          if (schwartz_kl(0,r)*schwartz_ij < thr) then
+             cycle
+          endif
+          coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
+          do s = 1, ao_prim_num(l)
+            if (schwartz_kl(s,r)*schwartz_ij < thr) then
+               cycle
+            endif
+            coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
+            call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q, &
+                ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),            &
+                K_power,L_power,K_center,L_center,dim1)
+            q_inv = 1.d0/qq
+            integral = general_primitive_integral_gauss(dim1,              &
+                P_new,P_center,fact_p,pp,p_inv,iorder_p,             &
+                Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
+            ao_tc_sym_two_e_pot = ao_tc_sym_two_e_pot + coef4 * integral
+          enddo ! s
+        enddo  ! r
+      enddo   ! q
+    enddo    ! p
+
+  deallocate (schwartz_kl)
+
+end
+
+
+double precision function general_primitive_integral_gauss(dim,      &
+      P_new,P_center,fact_p,p,p_inv,iorder_p,                        &
+      Q_new,Q_center,fact_q,q,q_inv,iorder_q)
+  implicit none
+  BEGIN_DOC
+  ! Computes the integral <pq|rs> where p,q,r,s are Gaussian primitives
+  END_DOC
+  integer,intent(in)             :: dim
+  include 'utils/constants.include.F'
+  double precision, intent(in)   :: P_new(0:max_dim,3),P_center(3),fact_p,p,p_inv
+  double precision, intent(in)   :: Q_new(0:max_dim,3),Q_center(3),fact_q,q,q_inv
+  integer, intent(in)            :: iorder_p(3)
+  integer, intent(in)            :: iorder_q(3)
+
+  double precision               :: r_cut,gama_r_cut,rho,dist
+  double precision               :: dx(0:max_dim),Ix_pol(0:max_dim),dy(0:max_dim),Iy_pol(0:max_dim),dz(0:max_dim),Iz_pol(0:max_dim)
+  integer                        :: n_Ix,n_Iy,n_Iz,nx,ny,nz
+  double precision               :: bla
+  integer                        :: ix,iy,iz,jx,jy,jz,i
+  double precision               :: a,b,c,d,e,f,accu,pq,const
+  double precision               :: pq_inv, p10_1, p10_2, p01_1, p01_2,pq_inv_2
+  integer                        :: n_pt_tmp,n_pt_out, iorder
+  double precision               :: d1(0:max_dim),d_poly(0:max_dim),rint,d1_screened(0:max_dim)
+  double precision :: thr
+
+  thr = ao_integrals_threshold
+
+  general_primitive_integral_gauss = 0.d0
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx,Ix_pol,dy,Iy_pol,dz,Iz_pol
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
+
+  ! Gaussian Product
+  ! ----------------
+
+  pq = p_inv*0.5d0*q_inv
+  pq_inv = 0.5d0/(p+q)
+  p10_1 = q*pq  ! 1/(2p)
+  p01_1 = p*pq  ! 1/(2q)
+  pq_inv_2 = pq_inv+pq_inv
+  p10_2 = pq_inv_2 * p10_1*q !0.5d0*q/(pq + p*p)
+  p01_2 = pq_inv_2 * p01_1*p !0.5d0*p/(q*q + pq)
+
+
+  accu = 0.d0
+  iorder = iorder_p(1)+iorder_q(1)+iorder_p(1)+iorder_q(1)
+  do ix=0,iorder
+    Ix_pol(ix) = 0.d0
+  enddo
+  n_Ix = 0
+  do ix = 0, iorder_p(1)
+    if (abs(P_new(ix,1)) < thr) cycle
+    a = P_new(ix,1)
+    do jx = 0, iorder_q(1)
+      d = a*Q_new(jx,1)
+      if (abs(d) < thr) cycle
+      !DIR$ FORCEINLINE
+      call give_polynom_mult_center_x(P_center(1),Q_center(1),ix,jx,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dx,nx)
+      !DIR$ FORCEINLINE
+      call add_poly_multiply(dx,nx,d,Ix_pol,n_Ix)
+    enddo
+  enddo
+  if (n_Ix == -1) then
+    return
+  endif
+  iorder = iorder_p(2)+iorder_q(2)+iorder_p(2)+iorder_q(2)
+  do ix=0, iorder
+    Iy_pol(ix) = 0.d0
+  enddo
+  n_Iy = 0
+  do iy = 0, iorder_p(2)
+    if (abs(P_new(iy,2)) > thr) then
+      b = P_new(iy,2)
+      do jy = 0, iorder_q(2)
+        e = b*Q_new(jy,2)
+        if (abs(e) < thr) cycle
+        !DIR$ FORCEINLINE
+        call   give_polynom_mult_center_x(P_center(2),Q_center(2),iy,jy,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dy,ny)
+        !DIR$ FORCEINLINE
+        call add_poly_multiply(dy,ny,e,Iy_pol,n_Iy)
+      enddo
+    endif
+  enddo
+  if (n_Iy == -1) then
+    return
+  endif
+
+  iorder = iorder_p(3)+iorder_q(3)+iorder_p(3)+iorder_q(3)
+  do ix=0,iorder
+    Iz_pol(ix) = 0.d0
+  enddo
+  n_Iz = 0
+  do iz = 0, iorder_p(3)
+    if (abs(P_new(iz,3)) > thr) then
+      c = P_new(iz,3)
+      do jz = 0, iorder_q(3)
+        f = c*Q_new(jz,3)
+        if (abs(f) < thr) cycle
+        !DIR$ FORCEINLINE
+        call   give_polynom_mult_center_x(P_center(3),Q_center(3),iz,jz,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dz,nz)
+        !DIR$ FORCEINLINE
+        call add_poly_multiply(dz,nz,f,Iz_pol,n_Iz)
+      enddo
+    endif
+  enddo
+  if (n_Iz == -1) then
+    return
+  endif
+
+  rho = p*q *pq_inv_2
+  dist =  (P_center(1) - Q_center(1))*(P_center(1) - Q_center(1)) +  &
+      (P_center(2) - Q_center(2))*(P_center(2) - Q_center(2)) +      &
+      (P_center(3) - Q_center(3))*(P_center(3) - Q_center(3))
+  const = dist*rho
+
+  n_pt_tmp = n_Ix+n_Iy
+  do i=0,n_pt_tmp
+    d_poly(i)=0.d0
+  enddo
+
+  !DIR$ FORCEINLINE
+  call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
+  if (n_pt_tmp == -1) then
+    return
+  endif
+  n_pt_out = n_pt_tmp+n_Iz
+  do i=0,n_pt_out
+    d1(i)=0.d0
+  enddo
+
+  !DIR$ FORCEINLINE
+  call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
+
+  double precision :: aa,c_a,t_a,rho_old,w_a,pi_3,prefactor,inv_pq_3_2
+  double precision :: gauss_int
+  integer :: m
+  gauss_int = 0.d0
+  pi_3 = pi*pi*pi
+  inv_pq_3_2 = (p_inv * q_inv)**(1.5d0)
+  rho_old = (p*q)/(p+q)
+  prefactor = pi_3 * inv_pq_3_2 * fact_p * fact_q 
+  do i = 1, n_gauss_eff_pot ! browse the gaussians with different expo/coef
+  !do i = 1, n_gauss_eff_pot-1
+   aa = expo_gauss_eff_pot(i) 
+   c_a = coef_gauss_eff_pot(i)
+   t_a = dsqrt( aa /(rho_old + aa) ) 
+   w_a = dexp(-t_a*t_a*rho_old*dist)
+   accu = 0.d0
+   ! evaluation of the polynom Ix(t_a) * Iy(t_a) * Iz(t_a)
+   do m = 0, n_pt_out,2
+    accu += d1(m) * (t_a)**(dble(m)) 
+   enddo
+   ! equation A8 of PRA-70-062505 (2004) of Toul. Col. Sav. 
+   gauss_int = gauss_int + c_a * prefactor * (1.d0 - t_a*t_a)**(1.5d0) * w_a * accu
+  enddo
+
+  general_primitive_integral_gauss = gauss_int
+end
+
+subroutine compute_ao_integrals_gauss_jl(j,l,n_integrals,buffer_i,buffer_value)
+  implicit none
+  use map_module
+  BEGIN_DOC
+  !  Parallel client for AO integrals
+  END_DOC
+
+  integer, intent(in)            :: j,l
+  integer,intent(out)            :: n_integrals
+  integer(key_kind),intent(out)  :: buffer_i(ao_num*ao_num)
+  real(integral_kind),intent(out) :: buffer_value(ao_num*ao_num)
+
+  integer                        :: i,k
+  double precision               :: cpu_1,cpu_2, wall_1, wall_2
+  double precision               :: integral, wall_0
+  double precision               :: thr,ao_tc_sym_two_e_pot
+  integer                        :: kk, m, j1, i1
+  logical, external              :: ao_two_e_integral_zero
+
+  thr = ao_integrals_threshold
+
+  n_integrals = 0
+
+  j1 = j+ishft(l*l-l,-1)
+  do k = 1, ao_num           ! r1
+    i1 = ishft(k*k-k,-1)
+    if (i1 > j1) then
+      exit
+    endif
+    do i = 1, k
+      i1 += 1
+      if (i1 > j1) then
+        exit
+      endif
+!      if (ao_two_e_integral_zero(i,j,k,l)) then
+      if (.False.) then
+        cycle
+      endif
+      if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr ) then
+        cycle
+      endif
+      !DIR$ FORCEINLINE
+      integral = ao_tc_sym_two_e_pot(i,k,j,l)  ! i,k : r1    j,l : r2
+      if (abs(integral) < thr) then
+        cycle
+      endif
+      n_integrals += 1
+      !DIR$ FORCEINLINE
+      call two_e_integrals_index(i,j,k,l,buffer_i(n_integrals))
+      buffer_value(n_integrals) = integral
+    enddo
+  enddo
+
+end

src/ao_tc_eff_map/useful_sub.irp.f

@@ -0,0 +1,364 @@
+! ---
+
+!______________________________________________________________________________________________________________________
+!______________________________________________________________________________________________________________________
+
+double precision function general_primitive_integral_coul_shifted( dim                                                  &
+                                                                 , P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P &
+                                                                 , Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q )
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer,          intent(in) :: dim
+  integer,          intent(in) :: iorder_p(3), shift_P(3)
+  integer,          intent(in) :: iorder_q(3), shift_Q(3)
+  double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv
+  double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv
+
+  integer                      :: n_Ix, n_Iy, n_Iz, nx, ny, nz
+  integer                      :: ix, iy, iz, jx, jy, jz, i
+  integer                      :: n_pt_tmp, n_pt_out, iorder
+  integer                      :: ii, jj
+  double precision             :: rho, dist
+  double precision             :: dx(0:max_dim), Ix_pol(0:max_dim)
+  double precision             :: dy(0:max_dim), Iy_pol(0:max_dim)
+  double precision             :: dz(0:max_dim), Iz_pol(0:max_dim)
+  double precision             :: a, b, c, d, e, f, accu, pq, const
+  double precision             :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2
+  double precision             :: d1(0:max_dim), d_poly(0:max_dim)
+  double precision             :: p_plus_q
+
+  double precision             :: rint_sum
+
+  general_primitive_integral_coul_shifted = 0.d0
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
+
+  ! Gaussian Product
+  ! ----------------
+  p_plus_q = (p+q) 
+  pq       = p_inv * 0.5d0 * q_inv
+  pq_inv   = 0.5d0 / p_plus_q
+  p10_1    = q * pq             ! 1/(2p)
+  p01_1    = p * pq             ! 1/(2q)
+  pq_inv_2 = pq_inv + pq_inv
+  p10_2    = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p)
+  p01_2    = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq)
+
+  accu = 0.d0
+
+  iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1)
+  iorder = iorder + shift_P(1) + shift_Q(1)
+  iorder = iorder + shift_P(1) + shift_Q(1)
+  !DIR$ VECTOR ALIGNED
+  do ix = 0, iorder
+    Ix_pol(ix) = 0.d0
+  enddo
+  n_Ix = 0
+  do ix = 0, iorder_p(1)
+
+    ii = ix + shift_P(1)
+    a  = P_new(ix,1)
+    if(abs(a) < thresh) cycle
+
+    do jx = 0, iorder_q(1)
+
+      jj = jx + shift_Q(1)
+      d  = a * Q_new(jx,1)
+      if(abs(d) < thresh) cycle
+
+      !DEC$ FORCEINLINE
+      call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj &
+                                     , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx )
+      !DEC$ FORCEINLINE
+      call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix)
+    enddo
+  enddo
+  if(n_Ix == -1) then
+    return
+  endif
+
+  iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2)
+  iorder = iorder + shift_P(2) + shift_Q(2)
+  iorder = iorder + shift_P(2) + shift_Q(2)
+  !DIR$ VECTOR ALIGNED
+  do ix = 0, iorder
+    Iy_pol(ix) = 0.d0
+  enddo
+  n_Iy = 0
+  do iy = 0, iorder_p(2)
+
+    if(abs(P_new(iy,2)) > thresh) then
+
+      ii = iy + shift_P(2)
+      b  = P_new(iy,2)
+
+      do jy = 0, iorder_q(2)
+
+        jj = jy + shift_Q(2)
+        e  = b * Q_new(jy,2)
+        if(abs(e) < thresh) cycle
+
+        !DEC$ FORCEINLINE
+        call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj &
+                                       , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny )
+        !DEC$ FORCEINLINE
+        call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy)
+      enddo
+    endif
+  enddo
+  if(n_Iy == -1) then
+    return
+  endif
+
+  iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3)
+  iorder = iorder + shift_P(3) + shift_Q(3)
+  iorder = iorder + shift_P(3) + shift_Q(3)
+  do ix = 0, iorder
+    Iz_pol(ix) = 0.d0
+  enddo
+  n_Iz = 0
+  do iz = 0, iorder_p(3)
+
+    if( abs(P_new(iz,3)) > thresh ) then
+
+      ii = iz + shift_P(3)
+      c  = P_new(iz,3)
+
+      do jz = 0, iorder_q(3)
+
+        jj = jz + shift_Q(3)
+        f  = c * Q_new(jz,3)
+        if(abs(f) < thresh) cycle
+
+        !DEC$ FORCEINLINE
+        call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj &
+                                       , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz )
+        !DEC$ FORCEINLINE
+        call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz)
+      enddo
+    endif
+  enddo
+  if(n_Iz == -1) then
+    return
+  endif
+
+  rho = p * q * pq_inv_2
+  dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
+       + (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
+       + (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
+  const = dist*rho
+
+  n_pt_tmp = n_Ix + n_Iy
+  do i = 0, n_pt_tmp
+    d_poly(i) = 0.d0
+  enddo
+
+  !DEC$ FORCEINLINE
+  call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp)
+  if(n_pt_tmp == -1) then
+    return
+  endif
+  n_pt_out = n_pt_tmp + n_Iz
+  do i = 0, n_pt_out
+    d1(i) = 0.d0
+  enddo
+
+  !DEC$ FORCEINLINE
+  call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out)
+  accu = accu + rint_sum(n_pt_out, const, d1)
+
+  general_primitive_integral_coul_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q)
+
+  return
+end function general_primitive_integral_coul_shifted
+!______________________________________________________________________________________________________________________
+!______________________________________________________________________________________________________________________
+
+
+
+!______________________________________________________________________________________________________________________
+!______________________________________________________________________________________________________________________
+
+double precision function general_primitive_integral_erf_shifted( dim                                                  &
+                                                                , P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P &
+                                                                , Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q )
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer,          intent(in) :: dim
+  integer,          intent(in) :: iorder_p(3), shift_P(3)
+  integer,          intent(in) :: iorder_q(3), shift_Q(3)
+  double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv
+  double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv
+
+  integer                      :: n_Ix, n_Iy, n_Iz, nx, ny, nz
+  integer                      :: ix, iy, iz, jx, jy, jz, i
+  integer                      :: n_pt_tmp, n_pt_out, iorder
+  integer                      :: ii, jj
+  double precision             :: rho, dist
+  double precision             :: dx(0:max_dim), Ix_pol(0:max_dim)
+  double precision             :: dy(0:max_dim), Iy_pol(0:max_dim)
+  double precision             :: dz(0:max_dim), Iz_pol(0:max_dim)
+  double precision             :: a, b, c, d, e, f, accu, pq, const
+  double precision             :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2
+  double precision             :: d1(0:max_dim), d_poly(0:max_dim)
+  double precision             :: p_plus_q
+
+  double precision             :: rint_sum
+
+  general_primitive_integral_erf_shifted = 0.d0
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
+
+  ! Gaussian Product
+  ! ----------------
+  p_plus_q = (p+q) * ( (p*q)/(p+q) + mu_erf*mu_erf ) / (mu_erf*mu_erf)
+  pq       = p_inv * 0.5d0 * q_inv
+  pq_inv   = 0.5d0 / p_plus_q
+  p10_1    = q * pq             ! 1/(2p)
+  p01_1    = p * pq             ! 1/(2q)
+  pq_inv_2 = pq_inv + pq_inv
+  p10_2    = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p)
+  p01_2    = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq)
+
+  accu = 0.d0
+
+  iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1)
+  iorder = iorder + shift_P(1) + shift_Q(1)
+  iorder = iorder + shift_P(1) + shift_Q(1)
+  !DIR$ VECTOR ALIGNED
+  do ix = 0, iorder
+    Ix_pol(ix) = 0.d0
+  enddo
+  n_Ix = 0
+  do ix = 0, iorder_p(1)
+
+    ii = ix + shift_P(1)
+    a  = P_new(ix,1)
+    if(abs(a) < thresh) cycle
+
+    do jx = 0, iorder_q(1)
+
+      jj = jx + shift_Q(1)
+      d  = a * Q_new(jx,1)
+      if(abs(d) < thresh) cycle
+
+      !DEC$ FORCEINLINE
+      call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj &
+                                     , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx )
+      !DEC$ FORCEINLINE
+      call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix)
+    enddo
+  enddo
+  if(n_Ix == -1) then
+    return
+  endif
+
+  iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2)
+  iorder = iorder + shift_P(2) + shift_Q(2)
+  iorder = iorder + shift_P(2) + shift_Q(2)
+  !DIR$ VECTOR ALIGNED
+  do ix = 0, iorder
+    Iy_pol(ix) = 0.d0
+  enddo
+  n_Iy = 0
+  do iy = 0, iorder_p(2)
+
+    if(abs(P_new(iy,2)) > thresh) then
+
+      ii = iy + shift_P(2)
+      b  = P_new(iy,2)
+
+      do jy = 0, iorder_q(2)
+
+        jj = jy + shift_Q(2)
+        e  = b * Q_new(jy,2)
+        if(abs(e) < thresh) cycle
+
+        !DEC$ FORCEINLINE
+        call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj &
+                                       , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny )
+        !DEC$ FORCEINLINE
+        call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy)
+      enddo
+    endif
+  enddo
+  if(n_Iy == -1) then
+    return
+  endif
+
+  iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3)
+  iorder = iorder + shift_P(3) + shift_Q(3)
+  iorder = iorder + shift_P(3) + shift_Q(3)
+  do ix = 0, iorder
+    Iz_pol(ix) = 0.d0
+  enddo
+  n_Iz = 0
+  do iz = 0, iorder_p(3)
+
+    if( abs(P_new(iz,3)) > thresh ) then
+
+      ii = iz + shift_P(3)
+      c  = P_new(iz,3)
+
+      do jz = 0, iorder_q(3)
+
+        jj = jz + shift_Q(3)
+        f  = c * Q_new(jz,3)
+        if(abs(f) < thresh) cycle
+
+        !DEC$ FORCEINLINE
+        call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj &
+                                       , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz )
+        !DEC$ FORCEINLINE
+        call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz)
+      enddo
+    endif
+  enddo
+  if(n_Iz == -1) then
+    return
+  endif
+
+  rho = p * q * pq_inv_2
+  dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
+       + (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
+       + (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
+  const = dist*rho
+
+  n_pt_tmp = n_Ix + n_Iy
+  do i = 0, n_pt_tmp
+    d_poly(i) = 0.d0
+  enddo
+
+  !DEC$ FORCEINLINE
+  call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp)
+  if(n_pt_tmp == -1) then
+    return
+  endif
+  n_pt_out = n_pt_tmp + n_Iz
+  do i = 0, n_pt_out
+    d1(i) = 0.d0
+  enddo
+
+  !DEC$ FORCEINLINE
+  call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out)
+  accu = accu + rint_sum(n_pt_out, const, d1)
+
+  general_primitive_integral_erf_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q)
+
+  return
+end function general_primitive_integral_erf_shifted
+!______________________________________________________________________________________________________________________
+!______________________________________________________________________________________________________________________
+
+
+
+
+

src/ao_two_e_ints/map_integrals.irp.f

@@ -321,14 +321,15 @@ BEGIN_PROVIDER [ double precision, ao_integrals_cache, (0:64*64*64*64) ]
   !$OMP END PARALLEL DO
 END_PROVIDER
 
+! ---
 
-double precision function get_ao_two_e_integral(i,j,k,l,map) result(result)
+double precision function get_ao_two_e_integral(i, j, k, l, map) result(result)
   use map_module
   implicit none
   BEGIN_DOC
-  ! Gets one AO bi-electronic integral from the AO map
+  ! Gets one AO bi-electronic integral from the AO map in PHYSICIST NOTATION
   !
-  ! i,j,k,l in physicist notation <ij|kl>
+  ! <1:k, 2:l |1:i, 2:j> 
   END_DOC
   integer, intent(in)            :: i,j,k,l
   integer(key_kind)              :: idx

src/ao_two_e_ints/two_e_integrals.irp.f

@@ -101,6 +101,7 @@ double precision function ao_two_e_integral(i,j,k,l)
     endif
 
   endif
+
 end
 
 double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)

src/basis_correction/TODO

@@ -1 +1,4 @@
 change all correlation functionals with the pbe_on_top general
+factor 2 in two-rdm involved in: 
+  on-top, mu(r), pbe-on-top, sc_basis_corr and so on 
+  casscf : state_av_act_2_rdm_spin_trace_mo

src/basis_correction/pbe_on_top.irp.f

@@ -46,8 +46,8 @@
     ! You take the on-top of the CAS wave function computed separately
     on_top = total_cas_on_top_density(ipoint,istate)
    endif
-!  We take the extrapolated on-top pair density * 2 because of normalization
+!  We take the extrapolated on-top pair density 
-   on_top_extrap = 2.d0 * mu_correction_of_on_top(mu,on_top)
+   on_top_extrap = mu_correction_of_on_top(mu,on_top)
 
    call ec_md_pbe_on_top_general(mu,rho_a,rho_b,grad_rho_a,grad_rho_b,on_top_extrap,eps_c_md_on_top_PBE)
  
@@ -108,8 +108,8 @@
     ! You take the on-top of the CAS wave function computed separately
     on_top = total_cas_on_top_density(ipoint,istate)
    endif
-!  We take the extrapolated on-top pair density * 2 because of normalization
+!  We take the extrapolated on-top pair density 
-   on_top_extrap = 2.d0 * mu_correction_of_on_top(mu,on_top)
+   on_top_extrap = mu_correction_of_on_top(mu,on_top)
 
    call ec_md_pbe_on_top_general(mu,rho_a,rho_b,grad_rho_a,grad_rho_b,on_top_extrap,eps_c_md_on_top_PBE)
  
@@ -170,8 +170,8 @@
     ! You take the on-top of the CAS wave function computed separately
     on_top = total_cas_on_top_density(ipoint,istate)
    endif
-!  We DO NOT take the extrapolated on-top pair density, but there is  * 2 because of normalization
+!  We DO NOT take the extrapolated on-top pair density
-   on_top_extrap = 2.d0 * on_top
+   on_top_extrap =  on_top
 
    call ec_md_pbe_on_top_general(mu,rho_a,rho_b,grad_rho_a,grad_rho_b,on_top_extrap,eps_c_md_on_top_PBE)
  

src/basis_correction/print_routine.irp.f

@@ -18,7 +18,7 @@ subroutine print_basis_correction
  print*, ''
  print*, 'For more details look at Journal of Chemical Physics 149, 194301 1-15 (2018)        '
  print*, '                         Journal of Physical Chemistry Letters 10, 2931-2937 (2019) '
- print*, '                         ???REF SC?'
+ print*, '                         Journal of Chemical Physics 152, 174104 (2020)             '
  print*, '****************************************'
  print*, '****************************************'
  print*, 'mu_of_r_potential = ',mu_of_r_potential
@@ -56,14 +56,14 @@ subroutine print_basis_correction
    print*,''
    print*,'********************************************'
    print*,'********************************************'
-   print*,'+) PBE-on-top Ecmd functional : (??????? REF-SCF ??????????)' 
+   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 : (??????? REF-SCF ??????????)' 
+   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)

src/bi_ort_ints/NEED

@@ -0,0 +1,4 @@
+non_h_ints_mu
+ao_tc_eff_map
+bi_ortho_mos
+tc_keywords

src/bi_ort_ints/README.rst

@@ -0,0 +1,25 @@
+===========
+bi_ort_ints
+===========
+
+This module contains all necessary integrals for the TC Hamiltonian in a bi-orthonormal (BO) MO Basis.
+See in bi_ortho_basis for more information. 
+The main providers are : 
+
+One-electron integrals 
+----------------------
++) ao_one_e_integrals_tc_tot : total one-electron Hamiltonian which might include non hermitian part coming from one-e correlation factor. 
++) mo_bi_ortho_tc_one_e : one-electron Hamiltonian (h_core+one-J terms) on the BO-MO basis. 
++) mo_bi_orth_bipole_x  : x-component of the dipole operator on the BO-MO basis. (Same for y,z) 
+
+Two-electron integrals 
+----------------------
++) ao_two_e_tc_tot : Total two-electron operator (including the non-hermitian term of the TC Hamiltonian) on the AO basis
++) mo_bi_ortho_tc_two_e : Total two-electron operator on the BO-MO basis
+
+Three-electron integrals 
+------------------------
++) three_body_ints_bi_ort : 6-indices three-electron tensor (-L) on the BO-MO basis. WARNING :: N^6 storage !
++) three_e_3_idx_direct_bi_ort : DIRECT term with 3 different indices of the -L operator. These terms appear in the DIAGONAL matrix element of the -L operator. The 5 other permutations needed to compute matrix elements can be found in three_body_ijm.irp.f 
++) three_e_4_idx_direct_bi_ort : DIRECT term with 4 different indices of the -L operator. These terms appear in the OFF-DIAGONAL matrix element of the -L operator including SINGLE EXCITATIONS. The 5 other permutations needed to compute matrix elements can be found in three_body_ijmk.irp.f 
++) three_e_5_idx_direct_bi_ort : DIRECT term with 5 different indices of the -L operator. These terms appear in the OFF-DIAGONAL matrix element of the -L operator including DOUBLE EXCITATIONS. The 5 other permutations needed to compute matrix elements can be found in three_body_ijmkl.irp.f 

src/bi_ort_ints/bi_ort_ints.irp.f

@@ -0,0 +1,44 @@
+program bi_ort_ints
+  implicit none
+  BEGIN_DOC
+! TODO : Put the documentation of the program here
+  END_DOC
+  my_grid_becke = .True.
+  my_n_pt_r_grid = 10
+  my_n_pt_a_grid = 14
+  touch  my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
+ call test_3e
+end
+
+subroutine test_3e
+ implicit none
+ integer :: i,k,j,l,m,n,ipoint
+ double precision :: accu, contrib,new,ref
+ i = 1
+ k = 1
+ accu = 0.d0
+ do i = 1, mo_num
+  do k = 1, mo_num 
+   do j = 1, mo_num
+    do l = 1, mo_num 
+     do m = 1, mo_num
+      do n = 1, mo_num
+        call give_integrals_3_body_bi_ort(n, l, k, m, j, i, new)
+        call give_integrals_3_body_bi_ort_old(n, l, k, m, j, i, ref)
+        contrib = dabs(new - ref)
+        accu += contrib
+        if(contrib .gt. 1.d-10)then
+         print*,'pb !!'
+         print*,i,k,j,l,m,n
+         print*,ref,new,contrib
+        endif
+      enddo
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+ print*,'accu = ',accu/dble(mo_num)**6
+
+
+end

src/bi_ort_ints/biorthog_mo_for_h.irp.f

@@ -0,0 +1,153 @@
+
+! ---
+
+double precision function bi_ortho_mo_coul_ints(l, k, j, i)
+
+  BEGIN_DOC
+  !
+  ! < mo^L_k mo^L_l | 1/r12 | mo^R_i mo^R_j >
+  !
+  END_DOC
+
+  implicit none
+  integer, intent(in) :: i, j, k, l
+  integer             :: m, n, p, q
+
+  bi_ortho_mo_coul_ints = 0.d0
+  do m = 1, ao_num
+    do p = 1, ao_num
+      do n = 1, ao_num
+        do q = 1, ao_num
+          !                                   p1h1p2h2   l1                  l2              r1               r2
+          bi_ortho_mo_coul_ints += ao_two_e_coul(n,q,m,p) * mo_l_coef(m,l) * mo_l_coef(n,k) * mo_r_coef(p,j) * mo_r_coef(q,i)
+        enddo
+      enddo
+    enddo
+  enddo
+
+end function bi_ortho_mo_coul_ints
+
+! ---
+
+! TODO :: transform into DEGEMM
+
+BEGIN_PROVIDER [double precision, mo_bi_ortho_coul_e_chemist, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! mo_bi_ortho_coul_e_chemist(k,i,l,j) = < k l | 1/r12 | i j > where i,j are right MOs and k,l are left MOs
+  !
+  END_DOC
+
+  implicit none
+  integer                       :: i, j, k, l, m, n, p, q
+  double precision, allocatable :: mo_tmp_1(:,:,:,:), mo_tmp_2(:,:,:,:)
+
+  allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
+  mo_tmp_1 = 0.d0
+
+  do m = 1, ao_num
+    do p = 1, ao_num
+      do n = 1, ao_num
+        do q = 1, ao_num
+          do k = 1, mo_num
+            !       (k n|p m)    = sum_q c_qk * (q n|p m)
+            mo_tmp_1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_coul(q,n,p,m)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+
+  allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
+  mo_tmp_2 = 0.d0
+
+  do m = 1, ao_num
+    do p = 1, ao_num
+      do n = 1, ao_num
+        do i = 1, mo_num
+          do k = 1, mo_num
+            !       (k i|p m) = sum_n c_ni * (k n|p m)
+            mo_tmp_2(k,i,p,m) += mo_r_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+  deallocate(mo_tmp_1)
+
+  allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
+  mo_tmp_1 = 0.d0
+  do m = 1, ao_num
+    do p = 1, ao_num
+      do l = 1, mo_num
+        do i = 1, mo_num
+          do k = 1, mo_num
+            mo_tmp_1(k,i,l,m) += mo_l_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+  deallocate(mo_tmp_2)
+
+  mo_bi_ortho_coul_e_chemist = 0.d0 
+  do m = 1, ao_num
+    do j = 1, mo_num
+      do l = 1, mo_num
+        do i = 1, mo_num
+          do k = 1, mo_num
+            mo_bi_ortho_coul_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * mo_tmp_1(k,i,l,m)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+  deallocate(mo_tmp_1)
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [double precision, mo_bi_ortho_coul_e, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! mo_bi_ortho_coul_e(k,l,i,j) = < k l | 1/r12 | i j > where i,j are right MOs and k,l are left MOs
+  !
+  END_DOC
+
+  implicit none
+  integer :: i, j, k, l
+
+  do j = 1, mo_num
+    do i = 1, mo_num
+      do l = 1, mo_num
+        do k = 1, mo_num
+           !    < k l | V12 | i j >                  (k i|l j)
+           mo_bi_ortho_coul_e(k,l,i,j) = mo_bi_ortho_coul_e_chemist(k,i,l,j)
+        enddo
+      enddo
+    enddo
+  enddo
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, mo_bi_ortho_one_e, (mo_num, mo_num)]
+
+  BEGIN_DOC 
+  !
+  ! mo_bi_ortho_one_e(k,i) = < MO^L_k | h_c | MO^R_i >
+  !
+  END_DOC
+
+  implicit none
+
+  call ao_to_mo_bi_ortho(ao_one_e_integrals, ao_num, mo_bi_ortho_one_e , mo_num)
+
+END_PROVIDER 
+
+! ---
+

src/bi_ort_ints/one_e_bi_ort.irp.f

@@ -0,0 +1,75 @@
+
+! ---
+
+BEGIN_PROVIDER [double precision, ao_one_e_integrals_tc_tot, (ao_num,ao_num)]
+
+  implicit none
+  integer :: i, j
+
+  ao_one_e_integrals_tc_tot = ao_one_e_integrals      
+
+  provide j1b_type
+
+  if( (j1b_type .eq. 1) .or. (j1b_type .eq. 2) ) then
+
+    do i = 1, ao_num
+      do j = 1, ao_num
+        ao_one_e_integrals_tc_tot(j,i) += ( j1b_gauss_hermI  (j,i) &
+                                          + j1b_gauss_hermII (j,i) &
+                                          + j1b_gauss_nonherm(j,i) )
+      enddo
+    enddo
+
+  endif
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! mo_bi_ortho_tc_one_e(k,i) = <MO^L_k | h_c | MO^R_i>
+  !
+  END_DOC
+
+  implicit none
+ 
+  call ao_to_mo_bi_ortho(ao_one_e_integrals_tc_tot, ao_num, mo_bi_ortho_tc_one_e, mo_num)
+
+END_PROVIDER 
+
+! ---
+
+ BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_x , (mo_num,mo_num)]
+&BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_y , (mo_num,mo_num)]
+&BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_z , (mo_num,mo_num)]
+ BEGIN_DOC
+ ! array of the integrals of Left MO_i * x Right MO_j
+ ! array of the integrals of Left MO_i * y Right MO_j
+ ! array of the integrals of Left MO_i * z Right MO_j
+ END_DOC
+ implicit none
+
+  call ao_to_mo_bi_ortho(                                                     &
+      ao_dipole_x,                                                   &
+      size(ao_dipole_x,1),                                           &
+      mo_bi_orth_bipole_x,                                                   &
+      size(mo_bi_orth_bipole_x,1)                                            &
+      )
+  call ao_to_mo_bi_ortho(                                                     &
+      ao_dipole_y,                                                   &
+      size(ao_dipole_y,1),                                           &
+      mo_bi_orth_bipole_y,                                                   &
+      size(mo_bi_orth_bipole_y,1)                                            &
+      )
+  call ao_to_mo_bi_ortho(                                                     &
+      ao_dipole_z,                                                   &
+      size(ao_dipole_z,1),                                           &
+      mo_bi_orth_bipole_z,                                                   &
+      size(mo_bi_orth_bipole_z,1)                                            &
+      )
+
+END_PROVIDER
+

src/bi_ort_ints/semi_num_ints_mo.irp.f

@@ -0,0 +1,318 @@
+
+! ---
+
+! TODO :: optimization : transform into a DGEMM
+
+BEGIN_PROVIDER [ double precision, mo_v_ki_bi_ortho_erf_rk_cst_mu, (mo_num, mo_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! mo_v_ki_bi_ortho_erf_rk_cst_mu(k,i,ip) = int dr chi_k(r) phi_i(r) (erf(mu |r - R_ip|) - 1 )/(2|r - R_ip|) on the BI-ORTHO MO basis 
+  ! 
+  ! where phi_k(r) is a LEFT MOs and phi_i(r) is a RIGHT MO
+  !
+  ! R_ip = the "ip"-th point of the DFT Grid
+  !
+  END_DOC
+
+  implicit none
+  integer :: ipoint
+ !$OMP PARALLEL         &
+ !$OMP DEFAULT (NONE)   &
+ !$OMP PRIVATE (ipoint) & 
+ !$OMP SHARED (n_points_final_grid,v_ij_erf_rk_cst_mu,mo_v_ki_bi_ortho_erf_rk_cst_mu)
+ !$OMP DO SCHEDULE (dynamic)
+  do ipoint = 1, n_points_final_grid
+    call ao_to_mo_bi_ortho( v_ij_erf_rk_cst_mu            (1,1,ipoint), size(v_ij_erf_rk_cst_mu,             1) &
+                          , mo_v_ki_bi_ortho_erf_rk_cst_mu(1,1,ipoint), size(mo_v_ki_bi_ortho_erf_rk_cst_mu, 1) )
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  mo_v_ki_bi_ortho_erf_rk_cst_mu = mo_v_ki_bi_ortho_erf_rk_cst_mu * 0.5d0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, mo_v_ki_bi_ortho_erf_rk_cst_mu_transp, (n_points_final_grid, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/(2|r - R|) on the BI-ORTHO MO basis
+  !
+  END_DOC
+
+  implicit none
+  integer :: ipoint, i, j
+
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do ipoint = 1, n_points_final_grid
+        mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,j,i) = mo_v_ki_bi_ortho_erf_rk_cst_mu(j,i,ipoint)
+      enddo
+    enddo
+  enddo
+
+! FREE mo_v_ki_bi_ortho_erf_rk_cst_mu
+
+END_PROVIDER 
+
+! ---
+
+! TODO :: optimization : transform into a DGEMM
+
+BEGIN_PROVIDER [ double precision, mo_x_v_ki_bi_ortho_erf_rk_cst_mu, (mo_num, mo_num, 3, n_points_final_grid)]
+
+  BEGIN_DOC
+  !
+  ! mo_x_v_ki_bi_ortho_erf_rk_cst_mu(k,i,m,ip) = int dr x(m) * chi_k(r) phi_i(r) (erf(mu |r - R_ip|) - 1)/2|r - R_ip| on the BI-ORTHO MO basis 
+  !
+  ! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => x(m) = x, m=2 => x(m) = y, m=3 => x(m) = z,
+  !
+  ! R_ip = the "ip"-th point of the DFT Grid
+  !
+  END_DOC
+
+  implicit none
+  integer :: ipoint
+
+ !$OMP PARALLEL         &
+ !$OMP DEFAULT (NONE)   &
+ !$OMP PRIVATE (ipoint) & 
+ !$OMP SHARED (n_points_final_grid,x_v_ij_erf_rk_cst_mu_transp,mo_x_v_ki_bi_ortho_erf_rk_cst_mu)
+ !$OMP DO SCHEDULE (dynamic)
+  do ipoint = 1, n_points_final_grid
+
+    call ao_to_mo_bi_ortho( x_v_ij_erf_rk_cst_mu_transp     (1,1,1,ipoint), size(x_v_ij_erf_rk_cst_mu_transp,      1) &
+                          , mo_x_v_ki_bi_ortho_erf_rk_cst_mu(1,1,1,ipoint), size(mo_x_v_ki_bi_ortho_erf_rk_cst_mu, 1) )
+    call ao_to_mo_bi_ortho( x_v_ij_erf_rk_cst_mu_transp     (1,1,2,ipoint), size(x_v_ij_erf_rk_cst_mu_transp,      1) &
+                          , mo_x_v_ki_bi_ortho_erf_rk_cst_mu(1,1,2,ipoint), size(mo_x_v_ki_bi_ortho_erf_rk_cst_mu, 1) )
+    call ao_to_mo_bi_ortho( x_v_ij_erf_rk_cst_mu_transp     (1,1,3,ipoint), size(x_v_ij_erf_rk_cst_mu_transp,      1) &
+                          , mo_x_v_ki_bi_ortho_erf_rk_cst_mu(1,1,3,ipoint), size(mo_x_v_ki_bi_ortho_erf_rk_cst_mu, 1) )
+
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  mo_x_v_ki_bi_ortho_erf_rk_cst_mu = 0.5d0 * mo_x_v_ki_bi_ortho_erf_rk_cst_mu
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_transp, (ao_num, ao_num, 3, n_points_final_grid)]
+
+  implicit none
+  integer          :: i, j, ipoint
+  double precision :: wall0, wall1
+
+  print *, ' providing int2_grad1_u12_ao_transp ...'
+  call wall_time(wall0)
+
+  if(test_cycle_tc)then
+   do ipoint = 1, n_points_final_grid
+     do i = 1, ao_num
+       do j = 1, ao_num
+         int2_grad1_u12_ao_transp(j,i,1,ipoint) = int2_grad1_u12_ao_test(j,i,ipoint,1)
+         int2_grad1_u12_ao_transp(j,i,2,ipoint) = int2_grad1_u12_ao_test(j,i,ipoint,2)
+         int2_grad1_u12_ao_transp(j,i,3,ipoint) = int2_grad1_u12_ao_test(j,i,ipoint,3)
+       enddo
+     enddo
+   enddo
+  else
+   do ipoint = 1, n_points_final_grid
+     do i = 1, ao_num
+       do j = 1, ao_num
+         int2_grad1_u12_ao_transp(j,i,1,ipoint) = int2_grad1_u12_ao(j,i,ipoint,1)
+         int2_grad1_u12_ao_transp(j,i,2,ipoint) = int2_grad1_u12_ao(j,i,ipoint,2)
+         int2_grad1_u12_ao_transp(j,i,3,ipoint) = int2_grad1_u12_ao(j,i,ipoint,3)
+       enddo
+     enddo
+   enddo
+  endif
+  call wall_time(wall1)
+  print *, ' wall time for int2_grad1_u12_ao_transp ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_grad1_u12_bimo_transp, (mo_num, mo_num, 3, n_points_final_grid)]
+
+  implicit none
+  integer :: ipoint
+  double precision :: wall0, wall1
+
+  !print *, ' providing int2_grad1_u12_bimo_transp'
+
+  call wall_time(wall0)
+  !$OMP PARALLEL         &
+  !$OMP DEFAULT (NONE)   &
+  !$OMP PRIVATE (ipoint) & 
+  !$OMP SHARED (n_points_final_grid,int2_grad1_u12_ao_transp,int2_grad1_u12_bimo_transp)
+  !$OMP DO SCHEDULE (dynamic)
+   do ipoint = 1, n_points_final_grid
+     call ao_to_mo_bi_ortho( int2_grad1_u12_ao_transp  (1,1,1,ipoint), size(int2_grad1_u12_ao_transp  , 1) &
+                           , int2_grad1_u12_bimo_transp(1,1,1,ipoint), size(int2_grad1_u12_bimo_transp, 1) )
+     call ao_to_mo_bi_ortho( int2_grad1_u12_ao_transp  (1,1,2,ipoint), size(int2_grad1_u12_ao_transp  , 1) &
+                           , int2_grad1_u12_bimo_transp(1,1,2,ipoint), size(int2_grad1_u12_bimo_transp, 1) )
+     call ao_to_mo_bi_ortho( int2_grad1_u12_ao_transp  (1,1,3,ipoint), size(int2_grad1_u12_ao_transp  , 1) &
+                           , int2_grad1_u12_bimo_transp(1,1,3,ipoint), size(int2_grad1_u12_bimo_transp, 1) )
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  !print *, ' Wall time for providing int2_grad1_u12_bimo_transp',wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_grad1_u12_bimo_t, (n_points_final_grid,3, mo_num, mo_num )]
+ implicit none
+ integer          :: i, j, ipoint
+ do ipoint = 1, n_points_final_grid
+   do i = 1, mo_num
+     do j = 1, mo_num
+      int2_grad1_u12_bimo_t(ipoint,1,j,i) = int2_grad1_u12_bimo_transp(j,i,1,ipoint)
+      int2_grad1_u12_bimo_t(ipoint,2,j,i) = int2_grad1_u12_bimo_transp(j,i,2,ipoint)
+      int2_grad1_u12_bimo_t(ipoint,3,j,i) = int2_grad1_u12_bimo_transp(j,i,3,ipoint)
+     enddo                                  
+   enddo
+ enddo
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_t, (n_points_final_grid, 3, ao_num, ao_num)]
+
+  implicit none
+  integer :: i, j, ipoint
+
+  do ipoint = 1, n_points_final_grid
+    do i = 1, ao_num
+      do j = 1, ao_num
+        int2_grad1_u12_ao_t(ipoint,1,j,i) = int2_grad1_u12_ao(j,i,ipoint,1)
+        int2_grad1_u12_ao_t(ipoint,2,j,i) = int2_grad1_u12_ao(j,i,ipoint,2)
+        int2_grad1_u12_ao_t(ipoint,3,j,i) = int2_grad1_u12_ao(j,i,ipoint,3)
+      enddo                                  
+    enddo
+  enddo
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp, (n_points_final_grid, 3, mo_num, mo_num)]
+
+  implicit none
+  integer :: i, j, ipoint
+
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do ipoint = 1, n_points_final_grid
+        mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,1,j,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu(j,i,1,ipoint)
+        mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,2,j,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu(j,i,2,ipoint)
+        mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,3,j,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu(j,i,3,ipoint)
+      enddo
+    enddo
+  enddo
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_W_ki_bi_ortho_erf_rk, (n_points_final_grid, 3, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! x_W_ki_bi_ortho_erf_rk(ip,m,k,i) = \int dr chi_k(r) \frac{(1 - erf(mu |r-R_ip|))}{2|r-R_ip|} (x(m)-R_ip(m)) phi_i(r) ON THE BI-ORTHO MO BASIS 
+  !
+  ! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => X(m) = x, m=2 => X(m) = y, m=3 => X(m) = z,
+  !
+  ! R_ip = the "ip"-th point of the DFT Grid
+  END_DOC
+ 
+  implicit none
+  include 'constants.include.F'
+ 
+  integer          :: ipoint, m, i, k
+  double precision :: xyz
+  double precision :: wall0, wall1
+ 
+  print*, ' providing x_W_ki_bi_ortho_erf_rk ...'
+  call wall_time(wall0)
+
+ !$OMP PARALLEL                   &
+ !$OMP DEFAULT (NONE)             &
+ !$OMP PRIVATE (ipoint,m,i,k,xyz) & 
+ !$OMP SHARED (x_W_ki_bi_ortho_erf_rk,n_points_final_grid,mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_num,final_grid_points) 
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do m = 1, 3
+        do ipoint = 1, n_points_final_grid
+          xyz = final_grid_points(m,ipoint)
+          x_W_ki_bi_ortho_erf_rk(ipoint,m,k,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,m,k,i) - xyz * mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,k,i)
+        enddo
+      enddo
+    enddo
+  enddo
+
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ ! FREE mo_v_ki_bi_ortho_erf_rk_cst_mu_transp 
+ ! FREE mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp
+
+  call wall_time(wall1)
+  print *, ' time to provide x_W_ki_bi_ortho_erf_rk = ', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_W_ki_bi_ortho_erf_rk_diag, (n_points_final_grid, 3, mo_num)]
+  BEGIN_DOC
+  ! x_W_ki_bi_ortho_erf_rk_diag(ip,m,i) = \int dr chi_i(r) (1 - erf(mu |r-R_ip|)) (x(m)-X(m)_ip) phi_i(r) ON THE BI-ORTHO MO BASIS 
+!
+! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => X(m) = x, m=2 => X(m) = y, m=3 => X(m) = z,
+!
+! R_ip = the "ip"-th point of the DFT Grid
+  END_DOC
+
+  implicit none
+  include 'constants.include.F'
+ 
+  integer          :: ipoint, m, i
+  double precision :: xyz
+  double precision :: wall0, wall1
+ 
+  print*,'providing x_W_ki_bi_ortho_erf_rk_diag ...'
+  call wall_time(wall0)
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (ipoint,m,i,xyz) & 
+ !$OMP SHARED (x_W_ki_bi_ortho_erf_rk_diag,n_points_final_grid,mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_num,final_grid_points) 
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do m = 1, 3
+      do ipoint = 1, n_points_final_grid
+        xyz = final_grid_points(m,ipoint)
+        x_W_ki_bi_ortho_erf_rk_diag(ipoint,m,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,m,i,i) - xyz * mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,i,i)
+      enddo
+    enddo
+  enddo
+
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print*,'time to provide x_W_ki_bi_ortho_erf_rk_diag = ',wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+

src/bi_ort_ints/three_body_ijm.irp.f

@@ -0,0 +1,366 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the direct terms 
+  !
+  ! three_e_3_idx_direct_bi_ort(m,j,i) = <mji|-L|mji>
+  ! 
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, m
+  double precision :: integral, wall1, wall0
+
+  three_e_3_idx_direct_bi_ort = 0.d0
+  print *, ' Providing the three_e_3_idx_direct_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_direct_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = j, mo_num
+        call give_integrals_3_body_bi_ort(m, j, i, m, j, i, integral)
+        three_e_3_idx_direct_bi_ort(m,j,i) = -1.d0 * integral 
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, j
+        three_e_3_idx_direct_bi_ort(m,j,i) = three_e_3_idx_direct_bi_ort(j,m,i)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_3_idx_direct_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the first cyclic permutation 
+  !
+  ! three_e_3_idx_cycle_1_bi_ort(m,j,i) = <mji|-L|jim>
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, m
+  double precision :: integral, wall1, wall0
+
+  three_e_3_idx_cycle_1_bi_ort = 0.d0
+  print *, ' Providing the three_e_3_idx_cycle_1_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_cycle_1_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = j, mo_num
+        call give_integrals_3_body_bi_ort(m, j, i, j, i, m, integral)
+        three_e_3_idx_cycle_1_bi_ort(m,j,i) = -1.d0 * integral 
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, j
+        three_e_3_idx_cycle_1_bi_ort(m,j,i) = three_e_3_idx_cycle_1_bi_ort(j,m,i)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_3_idx_cycle_1_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the second cyclic permutation 
+  !
+  ! three_e_3_idx_direct_bi_ort(m,j,i) = <mji|-L|imj>
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, m
+  double precision :: integral, wall1, wall0
+
+  three_e_3_idx_cycle_2_bi_ort = 0.d0
+  print *, ' Providing the three_e_3_idx_cycle_2_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_cycle_2_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = j, mo_num
+        call give_integrals_3_body_bi_ort(m, j, i, i, m, j, integral)
+        three_e_3_idx_cycle_2_bi_ort(m,j,i) = -1.d0 * integral 
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, j
+        three_e_3_idx_cycle_2_bi_ort(m,j,i) = three_e_3_idx_cycle_2_bi_ort(j,m,i)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_3_idx_cycle_2_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_exch23_bi_ort, (mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the permutations of particle 2 and 3
+  !
+  ! three_e_3_idx_exch23_bi_ort(m,j,i) = <mji|-L|jmi>
+  ! 
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, m
+  double precision :: integral, wall1, wall0
+
+  three_e_3_idx_exch23_bi_ort = 0.d0
+  print*,'Providing the three_e_3_idx_exch23_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_exch23_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = j, mo_num
+        call give_integrals_3_body_bi_ort(m, j, i, j, m, i, integral)
+        three_e_3_idx_exch23_bi_ort(m,j,i) = -1.d0 * integral 
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, j
+        three_e_3_idx_exch23_bi_ort(m,j,i) = three_e_3_idx_exch23_bi_ort(j,m,i)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_3_idx_exch23_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_exch13_bi_ort, (mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the permutations of particle 1 and 3
+  !
+  ! three_e_3_idx_exch13_bi_ort(m,j,i) = <mji|-L|ijm>
+  ! 
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer :: i,j,m
+  double precision :: integral, wall1, wall0
+
+  three_e_3_idx_exch13_bi_ort = 0.d0
+  print *, ' Providing the three_e_3_idx_exch13_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_exch13_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = j, mo_num
+        call give_integrals_3_body_bi_ort(m, j, i, i, j, m,integral)
+        three_e_3_idx_exch13_bi_ort(m,j,i) = -1.d0 * integral 
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, j
+        three_e_3_idx_exch13_bi_ort(m,j,i) = three_e_3_idx_exch13_bi_ort(j,m,i)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_3_idx_exch13_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort, (mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the permutations of particle 1 and 2
+  !
+  ! three_e_3_idx_exch12_bi_ort(m,j,i) = <mji|-L|mij>
+  ! 
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, m
+  double precision :: integral, wall1, wall0
+
+  three_e_3_idx_exch12_bi_ort = 0.d0
+  print *, ' Providing the three_e_3_idx_exch12_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_exch12_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m, j, i, m, i, j, integral)
+        three_e_3_idx_exch12_bi_ort(m,j,i) = -1.d0 * integral 
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_3_idx_exch12_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort_new, (mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the permutations of particle 1 and 2
+  !
+  ! three_e_3_idx_exch12_bi_ort_new(m,j,i) = <mji|-L|mij>
+  ! 
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, m
+  double precision :: integral, wall1, wall0
+
+  three_e_3_idx_exch12_bi_ort_new = 0.d0
+  print *, ' Providing the three_e_3_idx_exch12_bi_ort_new ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_exch12_bi_ort_new)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = j, mo_num
+        call give_integrals_3_body_bi_ort(m, j, i, m, i, j, integral)
+        three_e_3_idx_exch12_bi_ort_new(m,j,i) = -1.d0 * integral 
+    enddo
+   enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, j
+        three_e_3_idx_exch12_bi_ort_new(m,j,i) = three_e_3_idx_exch12_bi_ort_new(j,m,i)
+      enddo
+    enddo
+  enddo
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_3_idx_exch12_bi_ort_new', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+

src/bi_ort_ints/three_body_ijmk.irp.f

@@ -0,0 +1,284 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_4_idx_direct_bi_ort(m,j,k,i) = <mjk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+ implicit none
+ integer          :: i, j, k, m
+ double precision :: integral, wall1, wall0
+
+  three_e_4_idx_direct_bi_ort = 0.d0
+  print *, ' Providing the three_e_4_idx_direct_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                   &
+ !$OMP DEFAULT (NONE)             &
+ !$OMP PRIVATE (i,j,k,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_4_idx_direct_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do m = 1, mo_num
+          call give_integrals_3_body_bi_ort(m, j, k, m, j, i, integral)
+          three_e_4_idx_direct_bi_ort(m,j,k,i) = -1.d0 * integral 
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_4_idx_direct_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = <mjk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m
+  double precision :: integral, wall1, wall0
+
+  three_e_4_idx_cycle_1_bi_ort = 0.d0
+  print *, ' Providing the three_e_4_idx_cycle_1_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                   &
+ !$OMP DEFAULT (NONE)             &
+ !$OMP PRIVATE (i,j,k,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_4_idx_cycle_1_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do m = 1, mo_num
+          call give_integrals_3_body_bi_ort(m, j, k, j, i, m, integral)
+          three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = -1.d0 * integral 
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_4_idx_cycle_1_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! --
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = <mjk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m
+  double precision :: integral, wall1, wall0
+
+  three_e_4_idx_cycle_2_bi_ort = 0.d0
+  print *, ' Providing the three_e_4_idx_cycle_2_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                   &
+ !$OMP DEFAULT (NONE)             &
+ !$OMP PRIVATE (i,j,k,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_4_idx_cycle_2_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do m = 1, mo_num
+          call give_integrals_3_body_bi_ort(m, j, k, i, m, j, integral)
+          three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = -1.d0 * integral 
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_4_idx_cycle_2_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_4_idx_exch23_bi_ort(m,j,k,i) = <mjk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m
+  double precision :: integral, wall1, wall0
+
+  three_e_4_idx_exch23_bi_ort = 0.d0
+  print *, ' Providing the three_e_4_idx_exch23_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                   &
+ !$OMP DEFAULT (NONE)             &
+ !$OMP PRIVATE (i,j,k,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_4_idx_exch23_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do m = 1, mo_num
+          call give_integrals_3_body_bi_ort(m, j, k, j, m, i, integral)
+          three_e_4_idx_exch23_bi_ort(m,j,k,i) = -1.d0 * integral 
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_4_idx_exch23_bi_ort', wall1 - wall0
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_4_idx_exch13_bi_ort(m,j,k,i) = <mjk|-L|ijm> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m
+  double precision :: integral, wall1, wall0
+
+  three_e_4_idx_exch13_bi_ort = 0.d0
+  print *, ' Providing the three_e_4_idx_exch13_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                   &
+ !$OMP DEFAULT (NONE)             &
+ !$OMP PRIVATE (i,j,k,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_4_idx_exch13_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do m = 1, mo_num
+          call give_integrals_3_body_bi_ort(m, j, k, i, j, m, integral)
+          three_e_4_idx_exch13_bi_ort(m,j,k,i) = -1.d0 * integral 
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_4_idx_exch13_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  ! 
+  ! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_4_idx_exch12_bi_ort(m,j,k,i) = <mjk|-L|mij> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  ! 
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m
+  double precision :: integral, wall1, wall0
+
+  three_e_4_idx_exch12_bi_ort = 0.d0
+  print *, ' Providing the three_e_4_idx_exch12_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                   &
+ !$OMP DEFAULT (NONE)             &
+ !$OMP PRIVATE (i,j,k,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_4_idx_exch12_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do m = 1, mo_num
+          call give_integrals_3_body_bi_ort(m, j, k, m, i, j, integral)
+          three_e_4_idx_exch12_bi_ort(m,j,k,i) = -1.d0 * integral 
+        enddo
+      enddo
+    enddo
+  enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_4_idx_exch12_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+

src/bi_ort_ints/three_body_ijmkl.irp.f

@@ -0,0 +1,296 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_5_idx_direct_bi_ort(m,l,j,k,i) = <mlk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m, l
+  double precision :: integral, wall1, wall0
+
+  three_e_5_idx_direct_bi_ort = 0.d0
+  print *, ' Providing the three_e_5_idx_direct_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                     &
+ !$OMP DEFAULT (NONE)               &
+ !$OMP PRIVATE (i,j,k,m,l,integral) & 
+ !$OMP SHARED (mo_num,three_e_5_idx_direct_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do l = 1, mo_num
+          do m = 1, mo_num
+            call give_integrals_3_body_bi_ort(m, l, k, m, j, i, integral)
+            three_e_5_idx_direct_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_5_idx_direct_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = <mlk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m, l
+  double precision :: integral, wall1, wall0
+
+  three_e_5_idx_cycle_1_bi_ort = 0.d0
+  print *, ' Providing the three_e_5_idx_cycle_1_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                     &
+ !$OMP DEFAULT (NONE)               &
+ !$OMP PRIVATE (i,j,k,m,l,integral) & 
+ !$OMP SHARED (mo_num,three_e_5_idx_cycle_1_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do l = 1, mo_num
+          do m = 1, mo_num
+            call give_integrals_3_body_bi_ort(m, l, k, j, i, m, integral)
+            three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_5_idx_cycle_1_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = <mlk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m, l
+  double precision :: integral, wall1, wall0
+
+  three_e_5_idx_cycle_2_bi_ort = 0.d0
+  print *, ' Providing the three_e_5_idx_cycle_2_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                     &
+ !$OMP DEFAULT (NONE)               &
+ !$OMP PRIVATE (i,j,k,m,l,integral) & 
+ !$OMP SHARED (mo_num,three_e_5_idx_cycle_2_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do m = 1, mo_num
+          do l = 1, mo_num
+            call give_integrals_3_body_bi_ort(m, l, k, i, m, j, integral)
+            three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_5_idx_cycle_2_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = <mlk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m, l
+  double precision :: integral, wall1, wall0
+
+  three_e_5_idx_exch23_bi_ort = 0.d0
+  print *, ' Providing the three_e_5_idx_exch23_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                     &
+ !$OMP DEFAULT (NONE)               &
+ !$OMP PRIVATE (i,j,k,m,l,integral) & 
+ !$OMP SHARED (mo_num,three_e_5_idx_exch23_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do l = 1, mo_num
+          do m = 1, mo_num
+            call give_integrals_3_body_bi_ort(m, l, k, j, m, i, integral)
+            three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_5_idx_exch23_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = <mlk|-L|ijm> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m, l
+  double precision :: integral, wall1, wall0
+
+  three_e_5_idx_exch13_bi_ort = 0.d0
+  print *, ' Providing the three_e_5_idx_exch13_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                     &
+ !$OMP DEFAULT (NONE)               &
+ !$OMP PRIVATE (i,j,k,m,l,integral) & 
+ !$OMP SHARED (mo_num,three_e_5_idx_exch13_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do l = 1, mo_num
+          do m = 1, mo_num
+            call give_integrals_3_body_bi_ort(m, l, k, i, j, m, integral)
+            three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_5_idx_exch13_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+  !
+  ! three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = <mlk|-L|mij> ::: notice that i is the RIGHT MO and k is the LEFT MO
+  !
+  ! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j, k, m, l
+  double precision :: integral, wall1, wall0
+
+  three_e_5_idx_exch12_bi_ort = 0.d0
+  print *, ' Providing the three_e_5_idx_exch12_bi_ort ...'
+  call wall_time(wall0)
+
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                     &
+ !$OMP DEFAULT (NONE)               &
+ !$OMP PRIVATE (i,j,k,m,l,integral) & 
+ !$OMP SHARED (mo_num,three_e_5_idx_exch12_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do j = 1, mo_num
+        do l = 1, mo_num
+          do m = 1, mo_num
+            call give_integrals_3_body_bi_ort(m, l, k, m, i, j, integral)
+            three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print *, ' wall time for three_e_5_idx_exch12_bi_ort', wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+

src/bi_ort_ints/three_body_ints_bi_ort.irp.f

@@ -0,0 +1,207 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, three_body_ints_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num, mo_num)]
+
+ BEGIN_DOC
+! matrix element of the -L  three-body operator 
+!
+! notice the -1 sign: in this way three_body_ints_bi_ort can be directly used to compute Slater rules :)
+ END_DOC
+
+ implicit none
+ integer          :: i, j, k, l, m, n
+ double precision :: integral, wall1, wall0
+ character*(128)  :: name_file 
+
+  three_body_ints_bi_ort = 0.d0
+  print *, ' Providing the three_body_ints_bi_ort ...'
+  call wall_time(wall0)
+  name_file = 'six_index_tensor'
+
+! if(read_three_body_ints_bi_ort)then
+!  call read_fcidump_3_tc(three_body_ints_bi_ort)
+! else
+!  if(read_three_body_ints_bi_ort)then
+!   print*,'Reading three_body_ints_bi_ort from disk ...'
+!   call read_array_6_index_tensor(mo_num,three_body_ints_bi_ort,name_file)
+!  else
+
+  !provide x_W_ki_bi_ortho_erf_rk 
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+
+ !$OMP PARALLEL                       &
+ !$OMP DEFAULT (NONE)                 &
+ !$OMP PRIVATE (i,j,k,l,m,n,integral) & 
+ !$OMP SHARED (mo_num,three_body_ints_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, mo_num
+        do k = 1, mo_num
+          do l = 1, mo_num
+            do n = 1, mo_num
+              call give_integrals_3_body_bi_ort(n, l, k, m, j, i, integral)
+
+              three_body_ints_bi_ort(n,l,k,m,j,i) = -1.d0 * integral 
+            enddo
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+!  endif
+! endif
+
+  call wall_time(wall1)
+  print *, ' wall time for three_body_ints_bi_ort', wall1 - wall0
+! if(write_three_body_ints_bi_ort)then
+!  print*,'Writing three_body_ints_bi_ort on disk ...'
+!  call write_array_6_index_tensor(mo_num,three_body_ints_bi_ort,name_file)
+!  call ezfio_set_three_body_ints_bi_ort_io_three_body_ints_bi_ort("Read")
+! endif
+
+END_PROVIDER 
+
+! ---
+
+subroutine give_integrals_3_body_bi_ort(n, l, k, m, j, i, integral)
+
+  BEGIN_DOC
+  !
+  ! < n l k | -L | m j i > with a BI-ORTHONORMAL MOLECULAR ORBITALS 
+  !
+  END_DOC
+
+  implicit none
+  integer,          intent(in)  :: n, l, k, m, j, i
+  double precision, intent(out) :: integral
+  integer                       :: ipoint
+  double precision              :: weight
+
+  integral = 0.d0
+  do ipoint = 1, n_points_final_grid
+    weight = final_weight_at_r_vector(ipoint)                                                                          
+
+    integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i)        & 
+              * ( int2_grad1_u12_bimo_t(ipoint,1,n,m) * int2_grad1_u12_bimo_t(ipoint,1,l,j) &
+                + int2_grad1_u12_bimo_t(ipoint,2,n,m) * int2_grad1_u12_bimo_t(ipoint,2,l,j) &
+                + int2_grad1_u12_bimo_t(ipoint,3,n,m) * int2_grad1_u12_bimo_t(ipoint,3,l,j) )
+    integral += weight * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j)        & 
+              * ( int2_grad1_u12_bimo_t(ipoint,1,n,m) * int2_grad1_u12_bimo_t(ipoint,1,k,i) &
+                + int2_grad1_u12_bimo_t(ipoint,2,n,m) * int2_grad1_u12_bimo_t(ipoint,2,k,i) &
+                + int2_grad1_u12_bimo_t(ipoint,3,n,m) * int2_grad1_u12_bimo_t(ipoint,3,k,i) )
+    integral += weight * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m)        &
+              * ( int2_grad1_u12_bimo_t(ipoint,1,l,j) * int2_grad1_u12_bimo_t(ipoint,1,k,i) &
+                + int2_grad1_u12_bimo_t(ipoint,2,l,j) * int2_grad1_u12_bimo_t(ipoint,2,k,i) &
+                + int2_grad1_u12_bimo_t(ipoint,3,l,j) * int2_grad1_u12_bimo_t(ipoint,3,k,i) )
+
+  enddo
+
+end subroutine give_integrals_3_body_bi_ort
+
+! ---
+
+subroutine give_integrals_3_body_bi_ort_old(n, l, k, m, j, i, integral)
+
+  BEGIN_DOC
+  !
+  ! < n l k | -L | m j i > with a BI-ORTHONORMAL MOLECULAR ORBITALS 
+  !
+  END_DOC
+
+  implicit none
+  integer,          intent(in)  :: n, l, k, m, j, i
+  double precision, intent(out) :: integral
+  integer                       :: ipoint
+  double precision              :: weight
+
+  integral = 0.d0
+  do ipoint = 1, n_points_final_grid
+    weight = final_weight_at_r_vector(ipoint)                                                                          
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) & 
+!              * ( x_W_ki_bi_ortho_erf_rk(ipoint,1,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,1,l,j)  &
+!                + x_W_ki_bi_ortho_erf_rk(ipoint,2,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,2,l,j)  &
+!                + x_W_ki_bi_ortho_erf_rk(ipoint,3,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,3,l,j)  )
+!    integral += weight * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j) & 
+!              * ( x_W_ki_bi_ortho_erf_rk(ipoint,1,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,1,k,i)  &
+!                + x_W_ki_bi_ortho_erf_rk(ipoint,2,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,2,k,i)  &
+!                + x_W_ki_bi_ortho_erf_rk(ipoint,3,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,3,k,i)  )
+!    integral += weight * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m) &
+!              * ( x_W_ki_bi_ortho_erf_rk(ipoint,1,l,j) * x_W_ki_bi_ortho_erf_rk(ipoint,1,k,i)  &
+!                + x_W_ki_bi_ortho_erf_rk(ipoint,2,l,j) * x_W_ki_bi_ortho_erf_rk(ipoint,2,k,i)  &
+!                + x_W_ki_bi_ortho_erf_rk(ipoint,3,l,j) * x_W_ki_bi_ortho_erf_rk(ipoint,3,k,i)  )
+
+!    integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) & 
+!              * ( int2_grad1_u12_bimo(1,n,m,ipoint) * int2_grad1_u12_bimo(1,l,j,ipoint)        &
+!                + int2_grad1_u12_bimo(2,n,m,ipoint) * int2_grad1_u12_bimo(2,l,j,ipoint)        &
+!                + int2_grad1_u12_bimo(3,n,m,ipoint) * int2_grad1_u12_bimo(3,l,j,ipoint)        )
+!    integral += weight * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j) & 
+!              * ( int2_grad1_u12_bimo(1,n,m,ipoint) * int2_grad1_u12_bimo(1,k,i,ipoint)        &
+!                + int2_grad1_u12_bimo(2,n,m,ipoint) * int2_grad1_u12_bimo(2,k,i,ipoint)        &
+!                + int2_grad1_u12_bimo(3,n,m,ipoint) * int2_grad1_u12_bimo(3,k,i,ipoint)        )
+!    integral += weight * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m) &
+!              * ( int2_grad1_u12_bimo(1,l,j,ipoint) * int2_grad1_u12_bimo(1,k,i,ipoint)        &
+!                + int2_grad1_u12_bimo(2,l,j,ipoint) * int2_grad1_u12_bimo(2,k,i,ipoint)        &
+!                + int2_grad1_u12_bimo(3,l,j,ipoint) * int2_grad1_u12_bimo(3,k,i,ipoint)        )
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+    integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i)        & 
+              * ( int2_grad1_u12_bimo_transp(n,m,1,ipoint) * int2_grad1_u12_bimo_transp(l,j,1,ipoint) &
+                + int2_grad1_u12_bimo_transp(n,m,2,ipoint) * int2_grad1_u12_bimo_transp(l,j,2,ipoint) &
+                + int2_grad1_u12_bimo_transp(n,m,3,ipoint) * int2_grad1_u12_bimo_transp(l,j,3,ipoint) )
+    integral += weight * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j)        & 
+              * ( int2_grad1_u12_bimo_transp(n,m,1,ipoint) * int2_grad1_u12_bimo_transp(k,i,1,ipoint) &
+                + int2_grad1_u12_bimo_transp(n,m,2,ipoint) * int2_grad1_u12_bimo_transp(k,i,2,ipoint) &
+                + int2_grad1_u12_bimo_transp(n,m,3,ipoint) * int2_grad1_u12_bimo_transp(k,i,3,ipoint) )
+    integral += weight * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m)        &
+              * ( int2_grad1_u12_bimo_transp(l,j,1,ipoint) * int2_grad1_u12_bimo_transp(k,i,1,ipoint) &
+                + int2_grad1_u12_bimo_transp(l,j,2,ipoint) * int2_grad1_u12_bimo_transp(k,i,2,ipoint) &
+                + int2_grad1_u12_bimo_transp(l,j,3,ipoint) * int2_grad1_u12_bimo_transp(k,i,3,ipoint) )
+
+  enddo
+
+end subroutine give_integrals_3_body_bi_ort_old
+
+! ---
+
+subroutine give_integrals_3_body_bi_ort_ao(n, l, k, m, j, i, integral)
+
+  BEGIN_DOC
+  !
+  ! < n l k | -L | m j i > with a BI-ORTHONORMAL ATOMIC ORBITALS 
+  !
+  END_DOC
+
+  implicit none
+  integer,          intent(in)  :: n, l, k, m, j, i
+  double precision, intent(out) :: integral
+  integer                       :: ipoint
+  double precision              :: weight
+
+  integral = 0.d0
+  do ipoint = 1, n_points_final_grid
+    weight = final_weight_at_r_vector(ipoint)                                                                          
+
+    integral += weight * aos_in_r_array_transp(ipoint,k) * aos_in_r_array_transp(ipoint,i) & 
+              * ( int2_grad1_u12_ao_t(ipoint,1,n,m) * int2_grad1_u12_ao_t(ipoint,1,l,j)    &
+                + int2_grad1_u12_ao_t(ipoint,2,n,m) * int2_grad1_u12_ao_t(ipoint,2,l,j)    &
+                + int2_grad1_u12_ao_t(ipoint,3,n,m) * int2_grad1_u12_ao_t(ipoint,3,l,j) )
+    integral += weight * aos_in_r_array_transp(ipoint,l) * aos_in_r_array_transp(ipoint,j) & 
+              * ( int2_grad1_u12_ao_t(ipoint,1,n,m) * int2_grad1_u12_ao_t(ipoint,1,k,i)    &
+                + int2_grad1_u12_ao_t(ipoint,2,n,m) * int2_grad1_u12_ao_t(ipoint,2,k,i)    &
+                + int2_grad1_u12_ao_t(ipoint,3,n,m) * int2_grad1_u12_ao_t(ipoint,3,k,i) )
+    integral += weight * aos_in_r_array_transp(ipoint,n) * aos_in_r_array_transp(ipoint,m) &
+              * ( int2_grad1_u12_ao_t(ipoint,1,l,j) * int2_grad1_u12_ao_t(ipoint,1,k,i)    &
+                + int2_grad1_u12_ao_t(ipoint,2,l,j) * int2_grad1_u12_ao_t(ipoint,2,k,i)    &
+                + int2_grad1_u12_ao_t(ipoint,3,l,j) * int2_grad1_u12_ao_t(ipoint,3,k,i) )
+
+  enddo
+
+end subroutine give_integrals_3_body_bi_ort_ao
+
+! ---

src/bi_ort_ints/total_twoe_pot.irp.f

@@ -0,0 +1,271 @@
+
+
+! ---
+
+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. 3) then
+
+    do j = 1, ao_num
+      do l = 1, ao_num
+        do i = 1, ao_num
+          do k = 1, ao_num
+            ao_two_e_tc_tot(k,i,l,j) = ao_tc_int_chemist(k,i,l,j)
+            !write(222,*) ao_two_e_tc_tot(k,i,l,j) 
+          enddo
+        enddo
+      enddo
+    enddo
+
+  else
+
+    PROVIDE ao_tc_sym_two_e_pot_in_map
+
+    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
+
+  endif
+
+END_PROVIDER 
+
+! ---
+
+double precision function bi_ortho_mo_ints(l, k, j, i)
+
+  BEGIN_DOC
+  !
+  ! <mo^L_k mo^L_l | V^TC(r_12) | mo^R_i mo^R_j>
+  !
+  ! WARNING :: very naive, super slow, only used to DEBUG.
+  !
+  END_DOC
+
+  implicit none
+  integer, intent(in) :: i, j, k, l
+  integer             :: m, n, p, q
+
+  bi_ortho_mo_ints = 0.d0
+  do m = 1, ao_num
+    do p = 1, ao_num
+      do n = 1, ao_num
+        do q = 1, ao_num
+          !                                   p1h1p2h2   l1                  l2              r1               r2
+          bi_ortho_mo_ints += ao_two_e_tc_tot(n,q,m,p) * mo_l_coef(m,l) * mo_l_coef(n,k) * mo_r_coef(p,j) * mo_r_coef(q,i)
+        enddo
+      enddo
+    enddo
+  enddo
+
+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
+  !
+  ! mo_bi_ortho_tc_two_e_chemist(k,i,l,j) = <k l|V(r_12)|i j> where i,j are right MOs and k,l are left MOs
+  !
+  END_DOC
+
+  implicit none
+  integer                       :: i, j, k, l, m, n, p, q
+  double precision, allocatable :: mo_tmp_1(:,:,:,:), mo_tmp_2(:,:,:,:)
+
+  allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
+  mo_tmp_1 = 0.d0
+
+  do m = 1, ao_num
+    do p = 1, ao_num
+      do n = 1, ao_num
+        do q = 1, ao_num
+          do k = 1, mo_num
+            !       (k n|p m)    = sum_q c_qk * (q n|p m)
+            mo_tmp_1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_tc_tot(q,n,p,m)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+
+  allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
+  mo_tmp_2 = 0.d0
+
+  do m = 1, ao_num
+    do p = 1, ao_num
+      do n = 1, ao_num
+        do i = 1, mo_num
+          do k = 1, mo_num
+            !       (k i|p m) = sum_n c_ni * (k n|p m)
+            mo_tmp_2(k,i,p,m) += mo_r_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+  deallocate(mo_tmp_1)
+
+  allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
+  mo_tmp_1 = 0.d0
+  do m = 1, ao_num
+    do p = 1, ao_num
+      do l = 1, mo_num
+        do i = 1, mo_num
+          do k = 1, mo_num
+            mo_tmp_1(k,i,l,m) += mo_l_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+  deallocate(mo_tmp_2)
+
+  mo_bi_ortho_tc_two_e_chemist = 0.d0 
+  do m = 1, ao_num
+    do j = 1, mo_num
+      do l = 1, mo_num
+        do i = 1, mo_num
+          do k = 1, mo_num
+            mo_bi_ortho_tc_two_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * mo_tmp_1(k,i,l,m)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+  deallocate(mo_tmp_1)
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num, mo_num)]
+
+  BEGIN_DOC
+  !
+  ! mo_bi_ortho_tc_two_e(k,l,i,j) = <k l| V(r_12) |i j> where i,j are right MOs and k,l are left MOs
+  !
+  ! the potential V(r_12) contains ALL TWO-E CONTRIBUTION OF THE TC-HAMILTONIAN
+  !
+  END_DOC
+
+  implicit none
+  integer :: i, j, k, l
+
+  do j = 1, mo_num
+    do i = 1, mo_num
+      do l = 1, mo_num
+        do k = 1, mo_num
+           !              < k l | V12 | i j >                          (k i|l j)
+           mo_bi_ortho_tc_two_e(k,l,i,j) = mo_bi_ortho_tc_two_e_chemist(k,i,l,j)
+        enddo
+      enddo
+    enddo
+  enddo
+
+END_PROVIDER 
+
+! ---
+
+
+ BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num) ]
+&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_exchange, (mo_num,mo_num) ]
+&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_anti, (mo_num,mo_num) ]
+  implicit none
+  BEGIN_DOC
+  ! mo_bi_ortho_tc_two_e_jj(i,j) = J_ij = <ji|W-K|ji>
+  ! mo_bi_ortho_tc_two_e_jj_exchange(i,j) = K_ij = <ij|W-K|ji>
+  ! mo_bi_ortho_tc_two_e_jj_anti(i,j) = J_ij - K_ij
+  END_DOC
+
+  integer                        :: i,j
+  double precision               :: get_two_e_integral
+
+  mo_bi_ortho_tc_two_e_jj = 0.d0
+  mo_bi_ortho_tc_two_e_jj_exchange = 0.d0
+
+  do i=1,mo_num
+    do j=1,mo_num
+      mo_bi_ortho_tc_two_e_jj(i,j) = mo_bi_ortho_tc_two_e(j,i,j,i)
+      mo_bi_ortho_tc_two_e_jj_exchange(i,j) = mo_bi_ortho_tc_two_e(i,j,j,i)
+      mo_bi_ortho_tc_two_e_jj_anti(i,j) = mo_bi_ortho_tc_two_e_jj(i,j) - mo_bi_ortho_tc_two_e_jj_exchange(i,j)
+    enddo
+  enddo
+
+END_PROVIDER
+
+ BEGIN_PROVIDER [double precision, tc_2e_3idx_coulomb_integrals, (mo_num,mo_num, mo_num)]
+&BEGIN_PROVIDER [double precision, tc_2e_3idx_exchange_integrals,(mo_num,mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+ ! tc_2e_3idx_coulomb_integrals(j,k,i)  = <jk|ji> 
+ !
+ ! tc_2e_3idx_exchange_integrals(j,k,i) = <kj|ji> 
+ END_DOC
+ integer :: i,j,k,l
+ double precision :: get_two_e_integral
+ double precision :: integral
+
+ do i = 1, mo_num
+  do k = 1, mo_num
+   do j = 1, mo_num
+     tc_2e_3idx_coulomb_integrals(j, k,i) = mo_bi_ortho_tc_two_e(j ,k ,j ,i ) 
+     tc_2e_3idx_exchange_integrals(j,k,i) = mo_bi_ortho_tc_two_e(k ,j ,j ,i ) 
+   enddo
+  enddo
+ enddo
+
+END_PROVIDER

src/bi_ortho_mos/EZFIO.cfg

@@ -0,0 +1,11 @@
+[mo_r_coef]
+type: double precision
+doc: right-coefficient of the i-th |AO| on the j-th |MO|
+interface: ezfio
+size: (ao_basis.ao_num,mo_basis.mo_num)
+
+[mo_l_coef]
+type: double precision
+doc: right-coefficient of the i-th |AO| on the j-th |MO|
+interface: ezfio
+size: (ao_basis.ao_num,mo_basis.mo_num)

src/bi_ortho_mos/NEED

@@ -0,0 +1,3 @@
+mo_basis
+becke_numerical_grid
+dft_utils_in_r

src/bi_ortho_mos/bi_density.irp.f

@@ -0,0 +1,70 @@
+
+! ---
+
+BEGIN_PROVIDER [double precision, TCSCF_bi_ort_dm_ao_alpha, (ao_num, ao_num) ]
+
+  BEGIN_DOC
+  ! TCSCF_bi_ort_dm_ao_alpha(i,j) = <Chi_0| a^dagger_i,alpha a_j,alpha |Phi_0> where i,j are AO basis. 
+  !
+  ! This is the equivalent of the alpha density of the HF Slater determinant, but with a couple of bi-orthonormal Slater determinant |Chi_0> and |Phi_0>
+  END_DOC
+
+  implicit none
+
+  PROVIDE mo_l_coef mo_r_coef
+
+  call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0               &
+            , mo_l_coef, size(mo_l_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
+            !, mo_r_coef, size(mo_r_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
+            , 0.d0, TCSCF_bi_ort_dm_ao_alpha, size(TCSCF_bi_ort_dm_ao_alpha, 1) )
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, TCSCF_bi_ort_dm_ao_beta, (ao_num, ao_num) ]
+
+  BEGIN_DOC
+  ! TCSCF_bi_ort_dm_ao_beta(i,j) = <Chi_0| a^dagger_i,beta a_j,beta |Phi_0> where i,j are AO basis. 
+  !
+  ! This is the equivalent of the beta density of the HF Slater determinant, but with a couple of bi-orthonormal Slater determinant |Chi_0> and |Phi_0>
+  END_DOC
+
+  implicit none
+
+  PROVIDE mo_l_coef mo_r_coef
+
+  call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0                &
+            , mo_l_coef, size(mo_l_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
+            !, mo_r_coef, size(mo_r_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
+            , 0.d0, TCSCF_bi_ort_dm_ao_beta, size(TCSCF_bi_ort_dm_ao_beta, 1) )
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, TCSCF_bi_ort_dm_ao, (ao_num, ao_num) ]
+
+  BEGIN_DOC
+  ! TCSCF_bi_ort_dm_ao(i,j) = <Chi_0| a^dagger_i,beta+alpha a_j,beta+alpha |Phi_0> where i,j are AO basis. 
+  !
+  ! This is the equivalent of the total electronic density of the HF Slater determinant, but with a couple of bi-orthonormal Slater determinant |Chi_0> and |Phi_0>
+  END_DOC
+
+  implicit none
+
+  PROVIDE mo_l_coef mo_r_coef
+
+  ASSERT(size(TCSCF_bi_ort_dm_ao, 1) == size(TCSCF_bi_ort_dm_ao_alpha, 1))
+
+  if(elec_alpha_num==elec_beta_num) then
+    TCSCF_bi_ort_dm_ao = TCSCF_bi_ort_dm_ao_alpha + TCSCF_bi_ort_dm_ao_alpha
+  else
+    ASSERT(size(TCSCF_bi_ort_dm_ao, 1) == size(TCSCF_bi_ort_dm_ao_beta, 1))
+    TCSCF_bi_ort_dm_ao = TCSCF_bi_ort_dm_ao_alpha + TCSCF_bi_ort_dm_ao_beta
+  endif
+
+END_PROVIDER
+
+! ---
+