From b567cd891f5757292892363940e9da6baf2e7330 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 09:46:11 +0200 Subject: [PATCH 01/84] Fix f77zmq --- configure | 8 ++++++-- external/qp2-dependencies | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/configure b/configure index 5b50d0d7..9b4c4b03 100755 --- a/configure +++ b/configure @@ -17,7 +17,11 @@ git submodule init git submodule update # Update ARM or x86 dependencies -ARCHITECTURE=$(uname -m) +SYSTEM=$(uname -s) +if [[ $SYSTEM = "Linux" ]] ; then + SYSTEM="" +fi +ARCHITECTURE=$(uname -m)$SYSTEM cd ${QP_ROOT}/external/qp2-dependencies git checkout master git pull @@ -232,7 +236,7 @@ EOF execute << EOF cd "\${QP_ROOT}"/external - tar --gunzip --extract --file qp2-dependencies/f77-zmq-4.3.2.tar.gz + tar --gunzip --extract --file qp2-dependencies/f77-zmq-4.3.?.tar.gz cd f77-zmq-* ./configure --prefix=\$QP_ROOT export ZMQ_H="\$QP_ROOT"/include/zmq.h diff --git a/external/qp2-dependencies b/external/qp2-dependencies index ce14f57b..fd43778e 160000 --- a/external/qp2-dependencies +++ b/external/qp2-dependencies @@ -1 +1 @@ -Subproject commit ce14f57b50511825a9fedb096749200779d3f4d4 +Subproject commit fd43778e12bb5858c4c780c34346be0f158b8cc7 From 6757810f566384c8cb053a50631adc2bf5c72627 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 10:10:28 +0200 Subject: [PATCH 02/84] Added config/gfortran_macos.cfg --- config/gfortran_macos.cfg | 62 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) create mode 100644 config/gfortran_macos.cfg diff --git a/config/gfortran_macos.cfg b/config/gfortran_macos.cfg new file mode 100644 index 00000000..b7781a68 --- /dev/null +++ b/config/gfortran_macos.cfg @@ -0,0 +1,62 @@ +# Common flags +############## +# +# -ffree-line-length-none : Needed for IRPF90 which produces long lines +# -lblas -llapack : Link with libblas and liblapack libraries provided by the system +# -I . : Include the curent directory (Mandatory) +# +# --ninja : Allow the utilisation of ninja. (Mandatory) +# --align=32 : Align all provided arrays on a 32-byte boundary +# +# +[COMMON] +FC : gfortran -ffree-line-length-none -I . -g -fPIC +LAPACK_LIB : -llapack -lblas +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DSET_NESTED -DMACOS + +# 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 + From a2b2c9958a15a58287a24fd5bc8bfdef98e450ca Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 10:13:44 +0200 Subject: [PATCH 03/84] Fixed huge_tlb flag on mac --- src/utils/fortran_mmap.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/utils/fortran_mmap.c b/src/utils/fortran_mmap.c index 52df2476..ea37c582 100644 --- a/src/utils/fortran_mmap.c +++ b/src/utils/fortran_mmap.c @@ -22,7 +22,11 @@ void* mmap_fortran(char* filename, size_t bytes, int* file_descr, int read_only) perror("Error opening mmap file for reading"); exit(EXIT_FAILURE); } +#ifdef _GNU_SOURCE map = mmap(NULL, bytes, PROT_READ, MAP_SHARED | MAP_HUGETLB, fd, 0); +#else + map = mmap(NULL, bytes, PROT_READ, MAP_SHARED, fd, 0); +#endif if (map == MAP_FAILED) { /* try again without huge pages */ map = mmap(NULL, bytes, PROT_READ, MAP_SHARED, fd, 0); @@ -53,7 +57,11 @@ void* mmap_fortran(char* filename, size_t bytes, int* file_descr, int read_only) exit(EXIT_FAILURE); } +#ifdef _GNU_SOURCE map = mmap(NULL, bytes, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_HUGETLB, fd, 0); +#else + map = mmap(NULL, bytes, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0); +#endif if (map == MAP_FAILED) { /* try again without huge pages */ map = mmap(NULL, bytes, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0); From b51679b35ecc59ea8746401cc0e9b8cc14aace0a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 11:20:51 +0200 Subject: [PATCH 04/84] Fix zcat --- bin/zcat | 15 +++++++++++++++ configure | 1 + external/qp2-dependencies | 2 +- scripts/compilation/qp_create_ninja | 3 ++- src/ezfio_files/00.create.bats | 1 - 5 files changed, 19 insertions(+), 3 deletions(-) create mode 100755 bin/zcat diff --git a/bin/zcat b/bin/zcat new file mode 100755 index 00000000..ebf64b7d --- /dev/null +++ b/bin/zcat @@ -0,0 +1,15 @@ +#!/usr/bin/env python3 + +import sys +import gzip + +# Check if a file path has been provided +if len(sys.argv) < 2: + print("Usage: zcat ") + sys.exit(1) + +# Open the gzip file +with gzip.open(sys.argv[1], "rt") as f: + # Read the contents of the file and print to standard output + print(f.read()) + diff --git a/configure b/configure index 9b4c4b03..d4e27ede 100755 --- a/configure +++ b/configure @@ -226,6 +226,7 @@ EOF cd "\${QP_ROOT}"/external tar --gunzip --extract --file qp2-dependencies/zeromq-4.2.5.tar.gz cd zeromq-* + [[ ${SYSTEM} = Darwin ]] && ./autogen.sh ./configure --prefix="\$QP_ROOT" --without-libsodium --enable-libunwind=no make -j 8 make install diff --git a/external/qp2-dependencies b/external/qp2-dependencies index fd43778e..b9e877d9 160000 --- a/external/qp2-dependencies +++ b/external/qp2-dependencies @@ -1 +1 @@ -Subproject commit fd43778e12bb5858c4c780c34346be0f158b8cc7 +Subproject commit b9e877d9a9444a2aac23ec94b4a174caa4a10dd2 diff --git a/scripts/compilation/qp_create_ninja b/scripts/compilation/qp_create_ninja index aad85778..aa93afb3 100755 --- a/scripts/compilation/qp_create_ninja +++ b/scripts/compilation/qp_create_ninja @@ -40,7 +40,8 @@ from qp_path import QP_ROOT, QP_SRC, QP_EZFIO LIB = " -lz" EZFIO_LIB = join("$QP_ROOT", "lib", "libezfio_irp.a") -ZMQ_LIB = join("$QP_ROOT", "lib", "libf77zmq.a") + " " + join("$QP_ROOT", "lib", "libzmq.a") + " -lstdc++ -lrt -ldl" +ZMQ_LIB = "-lzmq -lf77zmq" +#ZMQ_LIB = join("$QP_ROOT", "lib", "libf77zmq.a") + " " + join("$QP_ROOT", "lib", "libzmq.a") + " -lstdc++ -lrt -ldl" ROOT_BUILD_NINJA = join("$QP_ROOT", "config", "build.ninja") ROOT_BUILD_NINJA_EXP = join(QP_ROOT, "config", "build.ninja") ROOT_BUILD_NINJA_EXP_tmp = join(QP_ROOT, "config", "build.ninja.tmp") diff --git a/src/ezfio_files/00.create.bats b/src/ezfio_files/00.create.bats index cfa6247d..496519f4 100644 --- a/src/ezfio_files/00.create.bats +++ b/src/ezfio_files/00.create.bats @@ -25,7 +25,6 @@ function run { @test "B-B" { - qp set_file b2_stretched.ezfio run b2_stretched.zmt 1 0 6-31g } From b2a593dd2fc8326a03defd20d7f30aa6b0291b4a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 11:27:51 +0200 Subject: [PATCH 05/84] Improved zcat --- bin/zcat | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/bin/zcat b/bin/zcat index ebf64b7d..ae11ce84 100755 --- a/bin/zcat +++ b/bin/zcat @@ -1,15 +1,22 @@ -#!/usr/bin/env python3 +#!/bin/bash +# On Darwin: try gzcat if available, otherwise use Python + +if [[ $(uname -s) = Darwin ]] ; then + which gzcat &> /dev/null + if [[ $? -eq 0 ]] ; then + exec gzcat $@ + else + + exec python3 << EOF import sys import gzip - -# Check if a file path has been provided -if len(sys.argv) < 2: - print("Usage: zcat ") - sys.exit(1) - -# Open the gzip file -with gzip.open(sys.argv[1], "rt") as f: - # Read the contents of the file and print to standard output +with gzip.open("$1", "rt") as f: print(f.read()) +EOF + fi +else + command=$(which -a zcat | grep -v 'qp2/bin/' | head -1) + exec command +fi From fd1494482ff9f5d1748f84736611ecbcf51f770b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 11:37:26 +0200 Subject: [PATCH 06/84] Fix create_executables_list.sh on Darwin --- scripts/module/create_executables_list.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/module/create_executables_list.sh b/scripts/module/create_executables_list.sh index 67e1aba2..74880249 100755 --- a/scripts/module/create_executables_list.sh +++ b/scripts/module/create_executables_list.sh @@ -11,7 +11,7 @@ fi cd ${QP_ROOT}/data rm -f executables -EXES=$(find -L ${QP_ROOT}/src -maxdepth 2 -depth -executable -type f | grep -e "${QP_ROOT}/src/[^/]*/[^/]*$" |sort ) +EXES=$(find -L ${QP_ROOT}/src -maxdepth 2 -depth -perm +111 -type f | grep -e "${QP_ROOT}/src/[^/]*/[^/]*$" |sort ) for EXE in $EXES do From 0db547ab4b881d12a44ce4944f74874f006e6c9a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 12:22:04 +0200 Subject: [PATCH 07/84] Fix RSS on mac --- src/utils/memory.irp.f | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/utils/memory.irp.f b/src/utils/memory.irp.f index d5a066a1..336ac6ac 100644 --- a/src/utils/memory.irp.f +++ b/src/utils/memory.irp.f @@ -29,6 +29,8 @@ subroutine resident_memory(value) call usleep(10) value = 0.d0 +IRP_IF MACOS +IRP_ELSE iunit = getUnitAndOpen('/proc/self/status','r') do read(iunit,*,err=10,end=20) key, value @@ -39,6 +41,7 @@ subroutine resident_memory(value) end do 20 continue close(iunit) +IRP_ENDIF value = value / (1024.d0*1024.d0) call omp_unset_lock(file_lock) end function @@ -53,6 +56,9 @@ subroutine total_memory(value) character*(32) :: key double precision, intent(out) :: value + value = 0.d0 +IRP_IF MACOS +IRP_ELSE iunit = getUnitAndOpen('/proc/self/status','r') do read(iunit,*,err=10,end=20) key, value @@ -63,6 +69,7 @@ subroutine total_memory(value) end do 20 continue close(iunit) +IRP_ENDIF value = value / (1024.d0*1024.d0) end function From 7a6598f6ddf9e84ce09962a1b66c0d4adfcbb334 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 12:33:27 +0200 Subject: [PATCH 08/84] Fix oom killer on MacOS --- src/ezfio_files/ezfio.irp.f | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/ezfio_files/ezfio.irp.f b/src/ezfio_files/ezfio.irp.f index 4f53b173..cc1ceb4e 100644 --- a/src/ezfio_files/ezfio.irp.f +++ b/src/ezfio_files/ezfio.irp.f @@ -31,6 +31,8 @@ BEGIN_PROVIDER [ character*(1024), ezfio_filename ] call ezfio_set_file(ezfio_filename) +IRP_IF MACOS +IRP_ELSE ! Adjust out-of-memory killer flag such that the current process will be ! killed first by the OOM killer, allowing compute nodes to survive integer :: getpid @@ -38,6 +40,7 @@ BEGIN_PROVIDER [ character*(1024), ezfio_filename ] write(pidc,*) getpid() write(command,*) 'echo 15 > /proc//'//trim(adjustl(pidc))//'/oom_adj' call system(command) +IRP_ENDIF PROVIDE file_lock From e920be45876fc2cd3d4d2a409fb5c7ee08898dc8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 12:43:31 +0200 Subject: [PATCH 09/84] python -> python3 --- external/qp2-dependencies | 2 +- src/nuclei/write_pt_charges.py | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/external/qp2-dependencies b/external/qp2-dependencies index b9e877d9..fd43778e 160000 --- a/external/qp2-dependencies +++ b/external/qp2-dependencies @@ -1 +1 @@ -Subproject commit b9e877d9a9444a2aac23ec94b4a174caa4a10dd2 +Subproject commit fd43778e12bb5858c4c780c34346be0f158b8cc7 diff --git a/src/nuclei/write_pt_charges.py b/src/nuclei/write_pt_charges.py index 6dbcd5b8..dffe469b 100644 --- a/src/nuclei/write_pt_charges.py +++ b/src/nuclei/write_pt_charges.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 import os import sys @@ -52,7 +52,7 @@ fncharges.write(" "+str(n_charges)+'\n') fncharges.close() mv_in_ezfio(EZFIO,tmp) -# Write the file containing the charges and set in EZFIO folder +# Write the file containing the charges and set in EZFIO folder tmp="pts_charge_z" fcharges = open(tmp,'w') fcharges.write(" 1\n") From d64dfb3d5959ae63296482b867149adc6c8199a8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 12:45:15 +0200 Subject: [PATCH 10/84] Python -> Python3 --- src/hartree_fock/10.hf.bats | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hartree_fock/10.hf.bats b/src/hartree_fock/10.hf.bats index df566032..85e98ecc 100644 --- a/src/hartree_fock/10.hf.bats +++ b/src/hartree_fock/10.hf.bats @@ -39,7 +39,7 @@ rm -rf $EZFIO qp create_ezfio -b def2-svp hcn.xyz -o $EZFIO qp run scf mv hcn_charges.xyz ${EZFIO}_point_charges.xyz -python write_pt_charges.py ${EZFIO} +python3 write_pt_charges.py ${EZFIO} qp set nuclei point_charges True qp run scf | tee ${EZFIO}.pt_charges.out energy="$(ezfio get hartree_fock energy)" From 6a47bb309dac85a900291da319030668c664a4d4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 12:47:54 +0200 Subject: [PATCH 11/84] Add python bash in bin --- bin/python | 4 ++++ 1 file changed, 4 insertions(+) create mode 100755 bin/python diff --git a/bin/python b/bin/python new file mode 100755 index 00000000..c5b1d08f --- /dev/null +++ b/bin/python @@ -0,0 +1,4 @@ +#!/bin/bash + +exec python3 $@ + From 538b6bf149dea036bf413f86690d26795f5b8d2f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 13:03:46 +0200 Subject: [PATCH 12/84] introduce std=legacy flag --- config/gfortran_macos.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/gfortran_macos.cfg b/config/gfortran_macos.cfg index b7781a68..4fffca29 100644 --- a/config/gfortran_macos.cfg +++ b/config/gfortran_macos.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -ffree-line-length-none -I . -g -fPIC +FC : gfortran -ffree-line-length-none -I . -g -fPIC -std=legacy LAPACK_LIB : -llapack -lblas IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DSET_NESTED -DMACOS From 1cbb555220d718989de7f10a6c0a6e80a6a00875 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 14:26:09 +0200 Subject: [PATCH 13/84] Added -std=legacy to gfortran files --- config/gfortran.cfg | 2 +- config/gfortran_armpl.cfg | 2 +- config/gfortran_avx.cfg | 2 +- config/gfortran_debug.cfg | 2 +- config/gfortran_mpi.cfg | 2 +- config/gfortran_openblas.cfg | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index 33ce48ba..41181c32 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -g -ffree-line-length-none -I . -fPIC -march=native +FC : gfortran -g -ffree-line-length-none -I . -fPIC -march=native -std=legacy LAPACK_LIB : -lblas -llapack IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED diff --git a/config/gfortran_armpl.cfg b/config/gfortran_armpl.cfg index fb5ee1cc..db0904e2 100644 --- a/config/gfortran_armpl.cfg +++ b/config/gfortran_armpl.cfg @@ -13,7 +13,7 @@ # # [COMMON] -FC : gfortran -g -ffree-line-length-none -I . -fPIC -march=native +FC : gfortran -g -ffree-line-length-none -I . -fPIC -march=native -std=legacy LAPACK_LIB : -larmpl_lp64 IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED diff --git a/config/gfortran_avx.cfg b/config/gfortran_avx.cfg index 747dff67..5b51c640 100644 --- a/config/gfortran_avx.cfg +++ b/config/gfortran_avx.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -ffree-line-length-none -I . -mavx -g -fPIC +FC : gfortran -ffree-line-length-none -I . -mavx -g -fPIC -std=legacy LAPACK_LIB : -llapack -lblas IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DSET_NESTED diff --git a/config/gfortran_debug.cfg b/config/gfortran_debug.cfg index 51e5a500..f903142a 100644 --- a/config/gfortran_debug.cfg +++ b/config/gfortran_debug.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -g -ffree-line-length-none -I . -fPIC +FC : gfortran -g -ffree-line-length-none -I . -fPIC -std=legacy LAPACK_LIB : -lblas -llapack IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED diff --git a/config/gfortran_mpi.cfg b/config/gfortran_mpi.cfg index 1af3ca45..7cc88f1f 100644 --- a/config/gfortran_mpi.cfg +++ b/config/gfortran_mpi.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : mpif90 -ffree-line-length-none -I . -g -fPIC +FC : mpif90 -ffree-line-length-none -I . -g -fPIC -std=legacy LAPACK_LIB : -lblas -llapack IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DMPI -DSET_NESTED diff --git a/config/gfortran_openblas.cfg b/config/gfortran_openblas.cfg index ab67d8c3..5db46fce 100644 --- a/config/gfortran_openblas.cfg +++ b/config/gfortran_openblas.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -g -ffree-line-length-none -I . -fPIC -march=native +FC : gfortran -g -ffree-line-length-none -I . -fPIC -march=native -std=legacy LAPACK_LIB : -lopenblas IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED From 5e555a269657cf6121fd024014a79ad93a76947e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 14:34:11 +0200 Subject: [PATCH 14/84] Update qpsh for Darwin --- bin/qpsh | 3 ++- external/qp2-dependencies | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/bin/qpsh b/bin/qpsh index 1c511248..8db562bb 100755 --- a/bin/qpsh +++ b/bin/qpsh @@ -1,6 +1,7 @@ #!/bin/bash -export QP_ROOT=$(dirname "$(readlink -f "$0")")/.. +REALPATH=$( cd "$(dirname "$0")" ; pwd -P ) +export QP_ROOT=${REALPATH}/.. bash --init-file <(cat << EOF [[ -f /etc/bashrc ]] && source /etc/bashrc diff --git a/external/qp2-dependencies b/external/qp2-dependencies index fd43778e..b9e877d9 160000 --- a/external/qp2-dependencies +++ b/external/qp2-dependencies @@ -1 +1 @@ -Subproject commit fd43778e12bb5858c4c780c34346be0f158b8cc7 +Subproject commit b9e877d9a9444a2aac23ec94b4a174caa4a10dd2 From 85ba1583d517fa85044af8e1c48d7d4d82814344 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 14:45:44 +0200 Subject: [PATCH 15/84] Fix configure for Linux --- configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure b/configure index d4e27ede..3dd03017 100755 --- a/configure +++ b/configure @@ -226,7 +226,7 @@ EOF cd "\${QP_ROOT}"/external tar --gunzip --extract --file qp2-dependencies/zeromq-4.2.5.tar.gz cd zeromq-* - [[ ${SYSTEM} = Darwin ]] && ./autogen.sh + [[ "${SYSTEM}" = "Darwin" ]] && ./autogen.sh ./configure --prefix="\$QP_ROOT" --without-libsodium --enable-libunwind=no make -j 8 make install From 3632cb9c706f602a78954dddcba4ad3b26edea5b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 14:52:03 +0200 Subject: [PATCH 16/84] Fix -lzmq --- scripts/compilation/qp_create_ninja | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/compilation/qp_create_ninja b/scripts/compilation/qp_create_ninja index aa93afb3..167dbca9 100755 --- a/scripts/compilation/qp_create_ninja +++ b/scripts/compilation/qp_create_ninja @@ -40,7 +40,7 @@ from qp_path import QP_ROOT, QP_SRC, QP_EZFIO LIB = " -lz" EZFIO_LIB = join("$QP_ROOT", "lib", "libezfio_irp.a") -ZMQ_LIB = "-lzmq -lf77zmq" +ZMQ_LIB = "-lf77zmq -lzmq" #ZMQ_LIB = join("$QP_ROOT", "lib", "libf77zmq.a") + " " + join("$QP_ROOT", "lib", "libzmq.a") + " -lstdc++ -lrt -ldl" ROOT_BUILD_NINJA = join("$QP_ROOT", "config", "build.ninja") ROOT_BUILD_NINJA_EXP = join(QP_ROOT, "config", "build.ninja") From 2bd1a07b6cdc9ae367722cf15ad65eb77caebbad Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 15:55:43 +0200 Subject: [PATCH 17/84] Fix zcat --- bin/zcat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bin/zcat b/bin/zcat index ae11ce84..715d4842 100755 --- a/bin/zcat +++ b/bin/zcat @@ -17,6 +17,6 @@ EOF fi else command=$(which -a zcat | grep -v 'qp2/bin/' | head -1) - exec command + exec $command $@ fi From f66ee4343abb41c993727982424d3a17972b3aa0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2023 16:02:43 +0200 Subject: [PATCH 18/84] Fixed minor bugs --- scripts/module/create_executables_list.sh | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/scripts/module/create_executables_list.sh b/scripts/module/create_executables_list.sh index 74880249..41d8853d 100755 --- a/scripts/module/create_executables_list.sh +++ b/scripts/module/create_executables_list.sh @@ -11,7 +11,11 @@ fi cd ${QP_ROOT}/data rm -f executables +if [[ "$(uname -s)" = "Darwin" ]] ; then EXES=$(find -L ${QP_ROOT}/src -maxdepth 2 -depth -perm +111 -type f | grep -e "${QP_ROOT}/src/[^/]*/[^/]*$" |sort ) +else +EXES=$(find -L ${QP_ROOT}/src -maxdepth 2 -depth -executable -type f | grep -e "${QP_ROOT}/src/[^/]*/[^/]*$" |sort ) +fi for EXE in $EXES do From e8dbceb4a8e97310ee0d7d5f42845fb36b701202 Mon Sep 17 00:00:00 2001 From: Abdallah Ammar Date: Sat, 23 Sep 2023 10:24:51 +0200 Subject: [PATCH 19/84] minor modif --- src/non_h_ints_mu/tc_integ_num.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/non_h_ints_mu/tc_integ_num.irp.f b/src/non_h_ints_mu/tc_integ_num.irp.f index ee34f531..5a088331 100644 --- a/src/non_h_ints_mu/tc_integ_num.irp.f +++ b/src/non_h_ints_mu/tc_integ_num.irp.f @@ -47,7 +47,7 @@ call total_memory(mem) mem = max(1.d0, qp_max_mem - mem) n_double = mem * 1.d8 - n_blocks = min(n_double / (n_points_extra_final_grid * 4), 1.d0*n_points_final_grid) + n_blocks = int(min(n_double / (n_points_extra_final_grid * 4.d0), 1.d0*n_points_final_grid)) n_rest = int(mod(n_points_final_grid, n_blocks)) n_pass = int((n_points_final_grid - n_rest) / n_blocks) From ede0bf7152f514f2ac05eb7f162c61534f6f59eb Mon Sep 17 00:00:00 2001 From: Abdallah Ammar Date: Sat, 23 Sep 2023 10:30:38 +0200 Subject: [PATCH 20/84] minor modif --- src/tc_keywords/j1b_pen.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tc_keywords/j1b_pen.irp.f b/src/tc_keywords/j1b_pen.irp.f index 2d5e59a9..56bc63dc 100644 --- a/src/tc_keywords/j1b_pen.irp.f +++ b/src/tc_keywords/j1b_pen.irp.f @@ -91,7 +91,7 @@ print *, ' parameters for nuclei jastrow' print *, ' i, Z, j1b_pen, j1b_pen_coef' do i = 1, nucl_num - write(*,"(I4, 2x, 3(E15.7, 2X))"), i, nucl_charge(i), j1b_pen(i), j1b_pen_coef(i) + write(*,"(I4, 2x, 3(E15.7, 2X))") i, nucl_charge(i), j1b_pen(i), j1b_pen_coef(i) enddo END_PROVIDER From 03754f1d5f73072a9f28f4cc0268f6efa3b1ed5d Mon Sep 17 00:00:00 2001 From: Abdallah Ammar Date: Sat, 23 Sep 2023 11:26:25 +0200 Subject: [PATCH 21/84] noL_0e in tc-scf --- src/tc_scf/fock_three_hermit.irp.f | 7 ++++++- src/tc_scf/rh_tcscf_diis.irp.f | 12 +++--------- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/tc_scf/fock_three_hermit.irp.f b/src/tc_scf/fock_three_hermit.irp.f index 6c132189..00d47fae 100644 --- a/src/tc_scf/fock_three_hermit.irp.f +++ b/src/tc_scf/fock_three_hermit.irp.f @@ -95,7 +95,12 @@ BEGIN_PROVIDER [double precision, diag_three_elem_hf] if(.not. three_body_h_tc) then - diag_three_elem_hf = 0.d0 + if(noL_standard) then + PROVIDE noL_0e + diag_three_elem_hf = noL_0e + else + diag_three_elem_hf = 0.d0 + endif else diff --git a/src/tc_scf/rh_tcscf_diis.irp.f b/src/tc_scf/rh_tcscf_diis.irp.f index 0504373c..66fc83bd 100644 --- a/src/tc_scf/rh_tcscf_diis.irp.f +++ b/src/tc_scf/rh_tcscf_diis.irp.f @@ -71,10 +71,7 @@ subroutine rh_tcscf_diis() etc_tot = TC_HF_energy etc_1e = TC_HF_one_e_energy etc_2e = TC_HF_two_e_energy - etc_3e = 0.d0 - if(three_body_h_tc) then - etc_3e = diag_three_elem_hf - endif + etc_3e = diag_three_elem_hf !tc_grad = grad_non_hermit er_DIIS = maxval(abs(FQS_SQF_mo)) e_delta = dabs(etc_tot - e_save) @@ -202,10 +199,7 @@ subroutine rh_tcscf_diis() etc_tot = TC_HF_energy etc_1e = TC_HF_one_e_energy etc_2e = TC_HF_two_e_energy - etc_3e = 0.d0 - if(three_body_h_tc) then - etc_3e = diag_three_elem_hf - endif + etc_3e = diag_three_elem_hf !tc_grad = grad_non_hermit er_DIIS = maxval(abs(FQS_SQF_mo)) e_delta = dabs(etc_tot - e_save) @@ -245,7 +239,7 @@ subroutine rh_tcscf_diis() write(json_unit, json_real_fmt) ' delta Energy ', e_delta write(json_unit, json_real_fmt) ' DIIS error ', er_DIIS write(json_unit, json_real_fmt) ' level_shift ', level_shift_tcscf - write(json_unit, json_real_fmt) ' DIIS ', dim_DIIS + write(json_unit, json_int_fmt) ' DIIS ', dim_DIIS write(json_unit, json_real_fmt) ' Wall time (min)', (t1-t0)/60.d0 call unlock_io From 6ad2dd668f977151eec89a27e1ba588e80ae6af1 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 27 Sep 2023 11:21:47 +0200 Subject: [PATCH 22/84] Less memory with QMCkl Jastrow --- src/non_h_ints_mu/jast_deriv.irp.f | 147 +++++++++++++++-------------- 1 file changed, 77 insertions(+), 70 deletions(-) diff --git a/src/non_h_ints_mu/jast_deriv.irp.f b/src/non_h_ints_mu/jast_deriv.irp.f index 7a4717f7..4137c51c 100644 --- a/src/non_h_ints_mu/jast_deriv.irp.f +++ b/src/non_h_ints_mu/jast_deriv.irp.f @@ -121,8 +121,11 @@ double precision :: f f = 1.d0 / dble(elec_num - 1) - integer*8 :: n_points, k - n_points = n_points_extra_final_grid * n_points_final_grid + integer*8 :: n_points, n_points_max, k + integer :: ipoint_block, ipoint_end + + n_points_max = n_points_extra_final_grid * n_points_final_grid + n_points = 100_8*n_points_extra_final_grid double precision, allocatable :: rij(:,:,:) allocate( rij(3, 2, n_points) ) @@ -131,92 +134,96 @@ integer(qmckl_exit_code) :: rc double precision, allocatable :: gl(:,:,:) + allocate( gl(2,4,n_points) ) - k=0 - do ipoint = 1, n_points_final_grid ! r1 - do jpoint = 1, n_points_extra_final_grid ! r2 - k=k+1 - rij(1:3, 1, k) = final_grid_points (1:3, ipoint) - rij(1:3, 2, k) = final_grid_points_extra(1:3, jpoint) + do ipoint_block = 1, n_points_final_grid, 100 ! r1 + ipoint_end = min(n_points_final_grid, ipoint_block+100) + + k=0 + do ipoint = ipoint_block, ipoint_end + do jpoint = 1, n_points_extra_final_grid ! r2 + k=k+1 + rij(1:3, 1, k) = final_grid_points (1:3, ipoint) + rij(1:3, 2, k) = final_grid_points_extra(1:3, jpoint) + end do enddo - enddo + rc = qmckl_set_electron_coord(qmckl_ctx_jastrow, 'N', n_points, rij, n_points*6_8) + if (rc /= QMCKL_SUCCESS) then + print *, irp_here, 'qmckl error in set_electron_coord' + rc = qmckl_check(qmckl_ctx_jastrow, rc) + stop -1 + endif - rc = qmckl_set_electron_coord(qmckl_ctx_jastrow, 'N', n_points, rij, n_points*6_8) - if (rc /= QMCKL_SUCCESS) then - print *, irp_here, 'qmckl error in set_electron_coord' - rc = qmckl_check(qmckl_ctx_jastrow, rc) - stop -1 - endif + ! --- + ! e-e term + rc = qmckl_get_jastrow_champ_factor_ee_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) + if (rc /= QMCKL_SUCCESS) then + print *, irp_here, ' qmckl error in fact_ee_gl' + rc = qmckl_check(qmckl_ctx_jastrow, rc) + stop -1 + endif - ! --- - ! e-e term - - rc = qmckl_get_jastrow_champ_factor_ee_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) - if (rc /= QMCKL_SUCCESS) then - print *, irp_here, ' qmckl error in fact_ee_gl' - rc = qmckl_check(qmckl_ctx_jastrow, rc) - stop -1 - endif - - k=0 - do ipoint = 1, n_points_final_grid ! r1 - do jpoint = 1, n_points_extra_final_grid ! r2 - k=k+1 - grad1_u12_num(jpoint,ipoint,1) = gl(1,1,k) - grad1_u12_num(jpoint,ipoint,2) = gl(1,2,k) - grad1_u12_num(jpoint,ipoint,3) = gl(1,3,k) + k=0 + do ipoint = ipoint_block, ipoint_end + do jpoint = 1, n_points_extra_final_grid ! r2 + k=k+1 + grad1_u12_num(jpoint,ipoint,1) = gl(1,1,k) + grad1_u12_num(jpoint,ipoint,2) = gl(1,2,k) + grad1_u12_num(jpoint,ipoint,3) = gl(1,3,k) + enddo enddo - enddo - ! --- - ! e-e-n term + ! --- + ! e-e-n term -! rc = qmckl_get_jastrow_champ_factor_een_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) -! if (rc /= QMCKL_SUCCESS) then -! print *, irp_here, 'qmckl error in fact_een_gl' -! rc = qmckl_check(qmckl_ctx_jastrow, rc) -! stop -1 -! endif +! rc = qmckl_get_jastrow_champ_factor_een_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) +! if (rc /= QMCKL_SUCCESS) then +! print *, irp_here, 'qmckl error in fact_een_gl' +! rc = qmckl_check(qmckl_ctx_jastrow, rc) +! stop -1 +! endif ! -! k=0 -! do ipoint = 1, n_points_final_grid ! r1 -! do jpoint = 1, n_points_extra_final_grid ! r2 -! k=k+1 -! grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + gl(1,1,k) -! grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + gl(1,2,k) -! grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + gl(1,3,k) -! enddo -! enddo +! k=0 +! do ipoint = 1, n_points_final_grid ! r1 +! do jpoint = 1, n_points_extra_final_grid ! r2 +! k=k+1 +! grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + gl(1,1,k) +! grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + gl(1,2,k) +! grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + gl(1,3,k) +! enddo +! enddo ! --- ! e-n term - rc = qmckl_get_jastrow_champ_factor_en_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) - if (rc /= QMCKL_SUCCESS) then - print *, irp_here, 'qmckl error in fact_en_gl' - rc = qmckl_check(qmckl_ctx_jastrow, rc) - stop -1 - endif + rc = qmckl_get_jastrow_champ_factor_en_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) + if (rc /= QMCKL_SUCCESS) then + print *, irp_here, 'qmckl error in fact_en_gl' + rc = qmckl_check(qmckl_ctx_jastrow, rc) + stop -1 + endif - k=0 - do ipoint = 1, n_points_final_grid ! r1 - do jpoint = 1, n_points_extra_final_grid ! r2 - k = k+1 - grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + f * gl(1,1,k) - grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + f * gl(1,2,k) - grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + f * gl(1,3,k) + k=0 + do ipoint = ipoint_block, ipoint_end ! r1 + do jpoint = 1, n_points_extra_final_grid ! r2 + k = k+1 + grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + f * gl(1,1,k) + grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + f * gl(1,2,k) + grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + f * gl(1,3,k) + + dx = grad1_u12_num(jpoint,ipoint,1) + dy = grad1_u12_num(jpoint,ipoint,2) + dz = grad1_u12_num(jpoint,ipoint,3) + grad1_u12_squared_num(jpoint,ipoint) = dx*dx + dy*dy + dz*dz + enddo enddo - do jpoint = 1, n_points_extra_final_grid ! r2 - dx = grad1_u12_num(jpoint,ipoint,1) - dy = grad1_u12_num(jpoint,ipoint,2) - dz = grad1_u12_num(jpoint,ipoint,3) - grad1_u12_squared_num(jpoint,ipoint) = dx*dx + dy*dy + dz*dz - enddo - enddo + enddo !ipoint_block + + deallocate(gl, rij) From 8806aee2bd3498cc806f47be458ae1041e5d899a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 27 Sep 2023 16:02:08 +0200 Subject: [PATCH 23/84] Update for qmckl-0.5.3 --- src/non_h_ints_mu/qmckl.irp.f | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/non_h_ints_mu/qmckl.irp.f b/src/non_h_ints_mu/qmckl.irp.f index b9802371..1df80457 100644 --- a/src/non_h_ints_mu/qmckl.irp.f +++ b/src/non_h_ints_mu/qmckl.irp.f @@ -6,11 +6,10 @@ BEGIN_PROVIDER [ integer*8, qmckl_ctx_jastrow ] ! Context for the QMCKL library END_DOC integer(qmckl_exit_code) :: rc - logical(c_bool) :: c_true = .True. qmckl_ctx_jastrow = qmckl_context_create() - rc = qmckl_set_jastrow_champ_spin_independent(qmckl_ctx_jastrow, c_true) + rc = qmckl_set_jastrow_champ_spin_independent(qmckl_ctx_jastrow, 1) rc = qmckl_check(qmckl_ctx_jastrow, rc) if (rc /= QMCKL_SUCCESS) stop -1 From 541d7f5ff91b246bd9454d4f14879ca54470e837 Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 3 Oct 2023 20:04:34 +0200 Subject: [PATCH 24/84] added attachment orbitals --- src/determinants/density_matrix.irp.f | 98 +++++++++++++++ src/determinants/dipole_moments.irp.f | 16 +-- src/tc_bi_ortho/tc_bi_ortho_prop.irp.f | 15 +++ src/tc_bi_ortho/tc_prop.irp.f | 1 + src/tools/attachement_orb.irp.f | 168 +++++++++++++++++++++++++ 5 files changed, 290 insertions(+), 8 deletions(-) create mode 100644 src/tools/attachement_orb.irp.f diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index ce4d96c2..46726df0 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -493,3 +493,101 @@ subroutine get_occupation_from_dets(istate,occupation) enddo end +BEGIN_PROVIDER [double precision, difference_dm, (mo_num, mo_num, N_states)] + implicit none + BEGIN_DOC +! difference_dm(i,j,istate) = dm(i,j,1) - dm(i,j,istate) + END_DOC + integer :: istate + do istate = 1, N_states + difference_dm(:,:,istate) = one_e_dm_mo_alpha(:,:,1) + one_e_dm_mo_beta(:,:,1) & + - (one_e_dm_mo_alpha(:,:,istate) + one_e_dm_mo_beta(:,:,istate)) + enddo +END_PROVIDER + + BEGIN_PROVIDER [double precision, difference_dm_eigvect, (mo_num, mo_num, N_states) ] +&BEGIN_PROVIDER [double precision, difference_dm_eigval, (mo_num, N_states) ] + implicit none + BEGIN_DOC +! eigenvalues and eigevenctors of the difference_dm + END_DOC + integer :: istate,i + do istate = 2, N_states + call lapack_diag(difference_dm_eigval(1,istate),difference_dm_eigvect(1,1,istate)& + ,difference_dm(1,1,istate),mo_num,mo_num) + print*,'Eigenvalues of difference_dm for state ',istate + do i = 1, mo_num + print*,i,difference_dm_eigval(i,istate) + enddo + enddo +END_PROVIDER + + BEGIN_PROVIDER [ integer , n_attachment, (N_states)] +&BEGIN_PROVIDER [ integer , n_dettachment, (N_states)] +&BEGIN_PROVIDER [ integer , list_attachment, (mo_num,N_states)] +&BEGIN_PROVIDER [ integer , list_dettachment, (mo_num,N_states)] + implicit none + integer :: i,istate + integer :: list_attachment_tmp(mo_num) + n_attachment = 0 + n_dettachment = 0 + do istate = 2, N_states + do i = 1, mo_num + if(difference_dm_eigval(i,istate).lt.0.d0)then ! dettachment_orbitals + n_dettachment(istate) += 1 + list_dettachment(n_dettachment(istate),istate) = i ! they are already sorted + else + n_attachment(istate) += 1 + list_attachment_tmp(n_attachment(istate)) = i ! they are not sorted + endif + enddo + ! sorting the attachment + do i = 0, n_attachment(istate) - 1 + list_attachment(i+1,istate) = list_attachment_tmp(n_attachment(istate) - i) + enddo + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ double precision, attachment_numbers_sorted, (mo_num, N_states)] +&BEGIN_PROVIDER [ double precision, dettachment_numbers_sorted, (mo_num, N_states)] + implicit none + integer :: i,istate + do istate = 2, N_states + print*,'dettachment' + do i = 1, n_dettachment(istate) + dettachment_numbers_sorted(i,istate) = difference_dm_eigval(list_dettachment(i,istate),istate) + print*,i,list_dettachment(i,istate),dettachment_numbers_sorted(i,istate) + enddo + print*,'attachment' + do i = 1, n_attachment(istate) + attachment_numbers_sorted(i,istate) = difference_dm_eigval(list_attachment(i,istate),istate) + print*,i,list_attachment(i,istate),attachment_numbers_sorted(i,istate) + enddo + enddo + END_PROVIDER + + BEGIN_PROVIDER [ double precision, attachment_orbitals, (ao_num, mo_num, N_states)] +&BEGIN_PROVIDER [ double precision, dettachment_orbitals, (ao_num, mo_num, N_states)] + implicit none + integer :: i,j,k,istate + attachment_orbitals = 0.d0 + dettachment_orbitals = 0.d0 + do istate = 2, N_states + do i = 1, n_dettachment(istate) + do j = 1, mo_num + do k = 1, ao_num + dettachment_orbitals(k,list_dettachment(i,istate),istate) += mo_coef(k,j) * difference_dm_eigvect(j,list_dettachment(i,istate),istate) + enddo + enddo + enddo + do i = 1, n_attachment(istate) + do j = 1, mo_num + do k = 1, ao_num + attachment_orbitals(k,i,istate) += mo_coef(k,j) * difference_dm_eigvect(j,list_attachment(i,istate),istate) + enddo + enddo + enddo + enddo + +END_PROVIDER diff --git a/src/determinants/dipole_moments.irp.f b/src/determinants/dipole_moments.irp.f index e445c56b..dae04369 100644 --- a/src/determinants/dipole_moments.irp.f +++ b/src/determinants/dipole_moments.irp.f @@ -26,10 +26,10 @@ enddo enddo -! print*,'electron part for z_dipole = ',z_dipole_moment -! print*,'electron part for y_dipole = ',y_dipole_moment -! print*,'electron part for x_dipole = ',x_dipole_moment -! + print*,'electron part for z_dipole = ',z_dipole_moment + print*,'electron part for y_dipole = ',y_dipole_moment + print*,'electron part for x_dipole = ',x_dipole_moment + nuclei_part_z = 0.d0 nuclei_part_y = 0.d0 nuclei_part_x = 0.d0 @@ -38,10 +38,10 @@ nuclei_part_y += nucl_charge(i) * nucl_coord(i,2) nuclei_part_x += nucl_charge(i) * nucl_coord(i,1) enddo -! print*,'nuclei part for z_dipole = ',nuclei_part_z -! print*,'nuclei part for y_dipole = ',nuclei_part_y -! print*,'nuclei part for x_dipole = ',nuclei_part_x -! + print*,'nuclei part for z_dipole = ',nuclei_part_z + print*,'nuclei part for y_dipole = ',nuclei_part_y + print*,'nuclei part for x_dipole = ',nuclei_part_x + do istate = 1, N_states z_dipole_moment(istate) += nuclei_part_z y_dipole_moment(istate) += nuclei_part_y diff --git a/src/tc_bi_ortho/tc_bi_ortho_prop.irp.f b/src/tc_bi_ortho/tc_bi_ortho_prop.irp.f index 9168fb3d..a5fe9249 100644 --- a/src/tc_bi_ortho/tc_bi_ortho_prop.irp.f +++ b/src/tc_bi_ortho/tc_bi_ortho_prop.irp.f @@ -34,4 +34,19 @@ subroutine test do i= 1, 3 print*,tc_bi_ortho_dipole(i,1) enddo + integer, allocatable :: occ(:,:) + integer :: n_occ_ab(2) + allocate(occ(N_int*bit_kind_size,2)) + call bitstring_to_list_ab(ref_bitmask, occ, n_occ_ab, N_int) + integer :: ispin,j,jorb + double precision :: accu + accu = 0.d0 + do ispin=1, 2 + do i = 1, n_occ_ab(ispin) + jorb = occ(i,ispin) + accu += mo_bi_orth_bipole_z(jorb,jorb) + enddo + enddo + print*,'accu = ',accu + end diff --git a/src/tc_bi_ortho/tc_prop.irp.f b/src/tc_bi_ortho/tc_prop.irp.f index a13dc9a2..3375fed6 100644 --- a/src/tc_bi_ortho/tc_prop.irp.f +++ b/src/tc_bi_ortho/tc_prop.irp.f @@ -90,6 +90,7 @@ enddo enddo enddo + print*,'tc_bi_ortho_dipole(3) elec = ',tc_bi_ortho_dipole(3,1) nuclei_part = 0.d0 do m = 1, 3 diff --git a/src/tools/attachement_orb.irp.f b/src/tools/attachement_orb.irp.f new file mode 100644 index 00000000..92a51ca8 --- /dev/null +++ b/src/tools/attachement_orb.irp.f @@ -0,0 +1,168 @@ +program molden_detachment_attachment + implicit none + read_wf=.True. + touch read_wf + call molden_attachment +end + +subroutine molden_attachment + implicit none + BEGIN_DOC + ! Produces a Molden file + END_DOC + character*(128) :: output + integer :: i_unit_output,getUnitAndOpen + integer :: i,j,k,l + double precision, parameter :: a0 = 0.529177249d0 + + PROVIDE ezfio_filename + + output=trim(ezfio_filename)//'.attachement.mol' + print*,'output = ',trim(output) + + i_unit_output = getUnitAndOpen(output,'w') + + write(i_unit_output,'(A)') '[Molden Format]' + + write(i_unit_output,'(A)') '[Atoms] Angs' + do i = 1, nucl_num + write(i_unit_output,'(A2,2X,I4,2X,I4,3(2X,F15.10))') & + trim(element_name(int(nucl_charge(i)))), & + i, & + int(nucl_charge(i)), & + nucl_coord(i,1)*a0, nucl_coord(i,2)*a0, nucl_coord(i,3)*a0 + enddo + + write(i_unit_output,'(A)') '[GTO]' + + character*(1) :: character_shell + integer :: i_shell,i_prim,i_ao + integer :: iorder(ao_num) + integer :: nsort(ao_num) + + i_shell = 0 + i_prim = 0 + do i=1,nucl_num + write(i_unit_output,*) i, 0 + do j=1,nucl_num_shell_aos(i) + i_shell +=1 + i_ao = nucl_list_shell_aos(i,j) + character_shell = trim(ao_l_char(i_ao)) + write(i_unit_output,*) character_shell, ao_prim_num(i_ao), '1.00' + do k = 1, ao_prim_num(i_ao) + i_prim +=1 + write(i_unit_output,'(ES20.10,2X,ES20.10)') ao_expo(i_ao,k), ao_coef(i_ao,k) + enddo + l = i_ao + do while ( ao_l(l) == ao_l(i_ao) ) + nsort(l) = i*10000 + j*100 + l += 1 + if (l > ao_num) exit + enddo + enddo + write(i_unit_output,*)'' + enddo + + + do i=1,ao_num + iorder(i) = i + ! p + if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 1 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 2 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 3 + ! d + else if ((ao_power(i,1) == 2 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 1 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 2 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 2 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 2 )) then + nsort(i) += 3 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 4 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 5 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 6 + ! f + else if ((ao_power(i,1) == 3 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 1 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 3 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 2 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 3 )) then + nsort(i) += 3 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 2 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 4 + else if ((ao_power(i,1) == 2 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 5 + else if ((ao_power(i,1) == 2 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 6 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 2 )) then + nsort(i) += 7 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 2 )) then + nsort(i) += 8 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 2 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 9 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 10 + ! g + else if ((ao_power(i,1) == 4 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 1 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 4 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 2 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 4 )) then + nsort(i) += 3 + else if ((ao_power(i,1) == 3 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 4 + else if ((ao_power(i,1) == 3 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 5 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 3 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 6 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 3 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 7 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 3 )) then + nsort(i) += 8 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 3 )) then + nsort(i) += 9 + else if ((ao_power(i,1) == 2 ).and.(ao_power(i,2) == 2 ).and.(ao_power(i,3) == 0 )) then + nsort(i) += 10 + else if ((ao_power(i,1) == 2 ).and.(ao_power(i,2) == 0 ).and.(ao_power(i,3) == 2 )) then + nsort(i) += 11 + else if ((ao_power(i,1) == 0 ).and.(ao_power(i,2) == 2 ).and.(ao_power(i,3) == 2 )) then + nsort(i) += 12 + else if ((ao_power(i,1) == 2 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 13 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 2 ).and.(ao_power(i,3) == 1 )) then + nsort(i) += 14 + else if ((ao_power(i,1) == 1 ).and.(ao_power(i,2) == 1 ).and.(ao_power(i,3) == 2 )) then + nsort(i) += 15 + endif + enddo + + call isort(nsort,iorder,ao_num) + write(i_unit_output,'(A)') '[MO]' + integer :: istate + istate = 2 + do i=1,n_dettachment(istate) + write (i_unit_output,*) 'Sym= 1' + write (i_unit_output,*) 'Ene=', dettachment_numbers_sorted(i,istate) + write (i_unit_output,*) 'Spin= Alpha' + write (i_unit_output,*) 'Occup=', dettachment_numbers_sorted(i,istate) + do j=1,ao_num + write(i_unit_output, '(I6,2X,ES20.10)') j, dettachment_orbitals(iorder(j),i,istate) + enddo + enddo + do i=1,n_attachment(istate) + write (i_unit_output,*) 'Sym= 1' + write (i_unit_output,*) 'Ene=', attachment_numbers_sorted(i,istate) + write (i_unit_output,*) 'Spin= Alpha' + write (i_unit_output,*) 'Occup=', attachment_numbers_sorted(i,istate) + do j=1,ao_num + write(i_unit_output, '(I6,2X,ES20.10)') j, attachment_orbitals(iorder(j),i,istate) + enddo + enddo + close(i_unit_output) +end + From aefd81dffe2e57d87ec463d98b0a8c7b76b478c2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Oct 2023 15:05:01 +0200 Subject: [PATCH 25/84] Updated EZFIO --- external/ezfio | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/ezfio b/external/ezfio index dba01c4f..66d3dd5d 160000 --- a/external/ezfio +++ b/external/ezfio @@ -1 +1 @@ -Subproject commit dba01c4fe0ff7b84c5ecfb1c7c77ec68781311b3 +Subproject commit 66d3dd5d8e05ca564a0c815d636cb58d213a8828 From 2b62bfc999e0205b62910ed882829d9fa0320871 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 6 Oct 2023 11:28:20 +0200 Subject: [PATCH 26/84] working on casscf_cipsi --- src/casscf_cipsi/EZFIO.cfg | 6 ++ src/casscf_cipsi/README.rst | 36 +++++++++++ src/casscf_cipsi/casscf.irp.f | 83 ++++++++++++++++++------- src/casscf_cipsi/densities.irp.f | 29 +++++++++ src/casscf_cipsi/mcscf_fock.irp.f | 13 +++- src/cipsi/stochastic_cipsi.irp.f | 5 +- src/fci/fci.irp.f | 4 +- src/mo_optimization/cipsi_orb_opt.irp.f | 4 +- 8 files changed, 153 insertions(+), 27 deletions(-) diff --git a/src/casscf_cipsi/EZFIO.cfg b/src/casscf_cipsi/EZFIO.cfg index 2a1f1926..18e0b6b1 100644 --- a/src/casscf_cipsi/EZFIO.cfg +++ b/src/casscf_cipsi/EZFIO.cfg @@ -73,3 +73,9 @@ type: logical doc: If |true|, the pt2_max value in the CIPSI iterations will automatically adapt, otherwise it is fixed at the value given in the EZFIO folder interface: ezfio,provider,ocaml default: True + +[small_active_space] +type: logical +doc: If |true|, the pt2_max value in the CIPSI is set to 10-10 and will not change +interface: ezfio,provider,ocaml +default: False diff --git a/src/casscf_cipsi/README.rst b/src/casscf_cipsi/README.rst index 08bfd95b..fb60f13f 100644 --- a/src/casscf_cipsi/README.rst +++ b/src/casscf_cipsi/README.rst @@ -3,3 +3,39 @@ casscf ====== |CASSCF| program with the CIPSI algorithm. + +Example of inputs +----------------- + +a) Small active space : standard CASSCF +--------------------------------------- +Let's do O2 (triplet) in aug-cc-pvdz with the following geometry (xyz format, Bohr units) +3 + + O 0.0000000000 0.0000000000 -1.1408000000 + O 0.0000000000 0.0000000000 1.1408000000 + +# Create the ezfio folder +qp create_ezfio -b aug-cc-pvdz O2.xyz -m 3 -a -o O2_avdz + +# Start with an ROHF guess +qp run scf | tee ${EZFIO_FILE}.rohf.out + +# Get the ROHF energy for check +qp get hartree_fock energy # should be -149.4684509 + +# Define the full valence active space: the two 1s are doubly occupied, the other 8 valence orbitals are active +# CASSCF(12e,10orb) +qp set_mo_class -c "[1-2]" -a "[3-10]" -v "[11-46]" + +# Specify that you want an near exact CASSCF, i.e. the CIPSI selection will stop at pt2_max = 10^-10 +qp set casscf_cipsi small_active_space True +# RUN THE CASSCF +qp run casscf | tee ${EZFIO_FILE}.casscf.out + + +b) Large active space : Exploit the selected CI in the active space +------------------------------------------------------------------- +Let us start from the small active space calculation orbitals and add another shell of + + diff --git a/src/casscf_cipsi/casscf.irp.f b/src/casscf_cipsi/casscf.irp.f index 02954ebf..68e5c4fb 100644 --- a/src/casscf_cipsi/casscf.irp.f +++ b/src/casscf_cipsi/casscf.irp.f @@ -8,17 +8,22 @@ program casscf ! touch no_vvvv_integrals n_det_max_full = 500 touch n_det_max_full - pt2_relative_error = 0.04 + if(small_active_space)then + pt2_relative_error = 0.00001 + else + pt2_relative_error = 0.04 + endif touch pt2_relative_error -! call run_stochastic_cipsi call run end subroutine run implicit none - double precision :: energy_old, energy, pt2_max_before, ept2_before,delta_E + double precision :: energy_old, energy, pt2_max_before,delta_E logical :: converged,state_following_casscf_cipsi_save - integer :: iteration + integer :: iteration,istate + double precision, allocatable :: E_PT2(:), PT2(:), Ev(:), ept2_before(:) + allocate(E_PT2(N_states), PT2(N_states), Ev(N_states), ept2_before(N_states)) converged = .False. energy = 0.d0 @@ -28,13 +33,19 @@ subroutine run state_following_casscf = .True. touch state_following_casscf ept2_before = 0.d0 - if(adaptive_pt2_max)then - pt2_max = 0.005 + if(small_active_space)then + pt2_max = 1.d-10 SOFT_TOUCH pt2_max + else + if(adaptive_pt2_max)then + pt2_max = 0.005 + SOFT_TOUCH pt2_max + endif endif do while (.not.converged) print*,'pt2_max = ',pt2_max - call run_stochastic_cipsi + call run_stochastic_cipsi(Ev,PT2) + E_PT2(1:N_states) = Ev(1:N_states) + PT2(1:N_states) energy_old = energy energy = eone+etwo+ecore pt2_max_before = pt2_max @@ -42,15 +53,13 @@ subroutine run call write_time(6) call write_int(6,iteration,'CAS-SCF iteration = ') call write_double(6,energy,'CAS-SCF energy = ') - if(n_states == 1)then - double precision :: E_PT2, PT2 - call ezfio_get_casscf_cipsi_energy_pt2(E_PT2) - call ezfio_get_casscf_cipsi_energy(PT2) - PT2 -= E_PT2 - call write_double(6,E_PT2,'E + PT2 energy = ') - call write_double(6,PT2,' PT2 = ') +! if(n_states == 1)then +! call ezfio_get_casscf_cipsi_energy_pt2(E_PT2) +! call ezfio_get_casscf_cipsi_energy(PT2) + call write_double(6,E_PT2(1:N_states),'E + PT2 energy = ') + call write_double(6,PT2(1:N_states),' PT2 = ') call write_double(6,pt2_max,' PT2_MAX = ') - endif +! endif print*,'' call write_double(6,norm_grad_vec2,'Norm of gradients = ') @@ -65,15 +74,20 @@ subroutine run else if (criterion_casscf == "gradients")then converged = norm_grad_vec2 < thresh_scf else if (criterion_casscf == "e_pt2")then - delta_E = dabs(E_PT2 - ept2_before) + delta_E = 0.d0 + do istate = 1, N_states + delta_E += dabs(E_PT2(istate) - ept2_before(istate)) + enddo converged = dabs(delta_E) < thresh_casscf endif ept2_before = E_PT2 - if(adaptive_pt2_max)then - pt2_max = dabs(energy_improvement / (pt2_relative_error)) - pt2_max = min(pt2_max, pt2_max_before) - if(n_act_orb.ge.n_big_act_orb)then - pt2_max = max(pt2_max,pt2_min_casscf) + if(.not.small_active_space)then + if(adaptive_pt2_max)then + pt2_max = dabs(energy_improvement / (pt2_relative_error)) + pt2_max = min(pt2_max, pt2_max_before) + if(n_act_orb.ge.n_big_act_orb)then + pt2_max = max(pt2_max,pt2_min_casscf) + endif endif endif print*,'' @@ -94,8 +108,10 @@ subroutine run read_wf = .True. call clear_mo_map SOFT_TOUCH mo_coef N_det psi_det psi_coef - if(adaptive_pt2_max)then - SOFT_TOUCH pt2_max + if(.not.small_active_space)then + if(adaptive_pt2_max)then + SOFT_TOUCH pt2_max + endif endif if(iteration .gt. 3)then state_following_casscf = state_following_casscf_cipsi_save @@ -104,6 +120,27 @@ subroutine run endif enddo + integer :: i +! print*,'Converged CASSCF ' +! print*,'--------------------------' +! write(6,*) ' occupation numbers of orbitals ' +! do i=1,mo_num +! write(6,*) i,occnum(i) +! end do +! +! write(6,*) +! write(6,*) ' the diagonal of the inactive effective Fock matrix ' +! write(6,'(5(i3,F12.5))') (i,Fipq(i,i),i=1,mo_num) +! write(6,*) + print*,'Fock ROHF ' + do i = 1, ao_num + write(33,*)fock_matrix_ao_alpha(i,1:ao_num) + enddo + print*,'Fock MCSCF' + do i = 1, ao_num + write(34,*)mcscf_fock_alpha(i,1:ao_num) + enddo + end diff --git a/src/casscf_cipsi/densities.irp.f b/src/casscf_cipsi/densities.irp.f index bebcf5d7..54ff86e1 100644 --- a/src/casscf_cipsi/densities.irp.f +++ b/src/casscf_cipsi/densities.irp.f @@ -17,6 +17,35 @@ BEGIN_PROVIDER [real*8, D0tu, (n_act_orb,n_act_orb) ] END_PROVIDER + BEGIN_PROVIDER [double precision, D0tu_alpha_ao, (ao_num, ao_num)] +&BEGIN_PROVIDER [double precision, D0tu_beta_ao, (ao_num, ao_num)] + implicit none + integer :: i,ii,j,u,t,uu,tt + double precision, allocatable :: D0_tmp_alpha(:,:),D0_tmp_beta(:,:) + allocate(D0_tmp_alpha(mo_num, mo_num),D0_tmp_beta(mo_num, mo_num)) + D0_tmp_beta = 0.d0 + D0_tmp_alpha = 0.d0 + do i = 1, n_core_inact_orb + ii = list_core_inact(i) + D0_tmp_alpha(ii,ii) = 1.d0 + D0_tmp_beta(ii,ii) = 1.d0 + enddo + print*,'Diagonal elements of the 1RDM in the active space' + do u=1,n_act_orb + uu = list_act(u) + print*,uu,one_e_dm_mo_alpha_average(uu,uu),one_e_dm_mo_beta_average(uu,uu) + do t=1,n_act_orb + tt = list_act(t) + D0_tmp_alpha(tt,uu) = one_e_dm_mo_alpha_average(tt,uu) + D0_tmp_beta(tt,uu) = one_e_dm_mo_beta_average(tt,uu) + enddo + enddo + + call mo_to_ao_no_overlap(D0_tmp_alpha,mo_num,D0tu_alpha_ao,ao_num) + call mo_to_ao_no_overlap(D0_tmp_beta,mo_num,D0tu_beta_ao,ao_num) + +END_PROVIDER + BEGIN_PROVIDER [real*8, P0tuvx, (n_act_orb,n_act_orb,n_act_orb,n_act_orb) ] BEGIN_DOC ! The second-order density matrix in the basis of the starting MOs ONLY IN THE RANGE OF ACTIVE MOS diff --git a/src/casscf_cipsi/mcscf_fock.irp.f b/src/casscf_cipsi/mcscf_fock.irp.f index e4568405..519dfff7 100644 --- a/src/casscf_cipsi/mcscf_fock.irp.f +++ b/src/casscf_cipsi/mcscf_fock.irp.f @@ -77,4 +77,15 @@ BEGIN_PROVIDER [real*8, Fapq, (mo_num,mo_num) ] END_PROVIDER - + BEGIN_PROVIDER [ double precision, mcscf_fock_alpha, (ao_num, ao_num)] +&BEGIN_PROVIDER [ double precision, mcscf_fock_beta, (ao_num, ao_num)] + implicit none + BEGIN_DOC + ! mcscf_fock_alpha are set to usual Fock like operator but computed with the MCSCF densities + END_DOC + SCF_density_matrix_ao_alpha = D0tu_alpha_ao + SCF_density_matrix_ao_beta = D0tu_beta_ao + soft_touch SCF_density_matrix_ao_alpha SCF_density_matrix_ao_beta + mcscf_fock_beta = fock_matrix_ao_beta + mcscf_fock_alpha = fock_matrix_ao_alpha +END_PROVIDER diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f index 339f7084..3a895280 100644 --- a/src/cipsi/stochastic_cipsi.irp.f +++ b/src/cipsi/stochastic_cipsi.irp.f @@ -1,10 +1,11 @@ -subroutine run_stochastic_cipsi +subroutine run_stochastic_cipsi(Ev,PT2) use selection_types implicit none BEGIN_DOC ! Selected Full Configuration Interaction with Stochastic selection and PT2. END_DOC integer :: i,j,k + double precision, intent(out) :: Ev(N_states), PT2(N_states) double precision, allocatable :: zeros(:) integer :: to_select type(pt2_type) :: pt2_data, pt2_data_err @@ -139,6 +140,8 @@ subroutine run_stochastic_cipsi call print_mol_properties() call write_cipsi_json(pt2_data,pt2_data_err) endif + Ev(1:N_states) = psi_energy_with_nucl_rep(1:N_states) + PT2(1:N_states) = pt2_data % pt2(1:N_states) call pt2_dealloc(pt2_data) call pt2_dealloc(pt2_data_err) diff --git a/src/fci/fci.irp.f b/src/fci/fci.irp.f index bb2a93f8..9de48a01 100644 --- a/src/fci/fci.irp.f +++ b/src/fci/fci.irp.f @@ -41,8 +41,10 @@ program fci write(json_unit,json_array_open_fmt) 'fci' + double precision, allocatable :: Ev(:),PT2(:) + allocate(Ev(N_states), PT2(N_state)) if (do_pt2) then - call run_stochastic_cipsi + call run_stochastic_cipsi(Ev,PT2) else call run_cipsi endif diff --git a/src/mo_optimization/cipsi_orb_opt.irp.f b/src/mo_optimization/cipsi_orb_opt.irp.f index ae3aa1bf..7e3a79eb 100644 --- a/src/mo_optimization/cipsi_orb_opt.irp.f +++ b/src/mo_optimization/cipsi_orb_opt.irp.f @@ -11,11 +11,13 @@ subroutine run_optimization implicit none double precision :: e_cipsi, e_opt, delta_e + double precision, allocatable :: Ev(:),PT2(:) integer :: nb_iter,i logical :: not_converged character (len=100) :: filename PROVIDE psi_det psi_coef mo_two_e_integrals_in_map ao_pseudo_integrals + allocate(Ev(N_states),PT2(N_states)) not_converged = .True. nb_iter = 0 @@ -38,7 +40,7 @@ subroutine run_optimization print*,'' print*,'********** cipsi step **********' ! cispi calculation - call run_stochastic_cipsi + call run_stochastic_cipsi(Ev,PT2) ! State average energy after the cipsi step call state_average_energy(e_cipsi) From 106a2eafff25df0004f49395761fb107aad80d20 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 6 Oct 2023 11:46:24 +0200 Subject: [PATCH 27/84] Update qmckl --- configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure b/configure index 893c7148..c328c4f0 100755 --- a/configure +++ b/configure @@ -231,7 +231,7 @@ EOF EOF elif [[ ${PACKAGE} = qmckl ]] ; then - VERSION=0.5.3 + VERSION=0.5.4 execute << EOF cd "\${QP_ROOT}"/external wget https://github.com/TREX-CoE/qmckl/releases/download/v${VERSION}/qmckl-${VERSION}.tar.gz From 1739ec4f4ad2a5ee438e5293100f3b3f2ec8c9d4 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 6 Oct 2023 14:50:17 +0200 Subject: [PATCH 28/84] added some mcscf fock printing --- src/casscf_cipsi/README.rst | 2 + src/casscf_cipsi/casscf.irp.f | 22 +++--- src/casscf_cipsi/mcscf_fock.irp.f | 114 ++++++++++++++++++++++++++++-- 3 files changed, 121 insertions(+), 17 deletions(-) diff --git a/src/casscf_cipsi/README.rst b/src/casscf_cipsi/README.rst index fb60f13f..155d90da 100644 --- a/src/casscf_cipsi/README.rst +++ b/src/casscf_cipsi/README.rst @@ -39,3 +39,5 @@ b) Large active space : Exploit the selected CI in the active space Let us start from the small active space calculation orbitals and add another shell of + +TODO : print FOCK MCSCF NEW in the MO BASIS AT THE END OF THE CASSCF diff --git a/src/casscf_cipsi/casscf.irp.f b/src/casscf_cipsi/casscf.irp.f index 68e5c4fb..06a2bc52 100644 --- a/src/casscf_cipsi/casscf.irp.f +++ b/src/casscf_cipsi/casscf.irp.f @@ -121,24 +121,22 @@ subroutine run enddo integer :: i -! print*,'Converged CASSCF ' -! print*,'--------------------------' -! write(6,*) ' occupation numbers of orbitals ' -! do i=1,mo_num -! write(6,*) i,occnum(i) -! end do + print*,'Converged CASSCF ' + print*,'--------------------------' + write(6,*) ' occupation numbers of orbitals ' + do i=1,mo_num + write(6,*) i,occnum(i) + end do + print*,'--------------' ! ! write(6,*) ! write(6,*) ' the diagonal of the inactive effective Fock matrix ' ! write(6,'(5(i3,F12.5))') (i,Fipq(i,i),i=1,mo_num) ! write(6,*) - print*,'Fock ROHF ' - do i = 1, ao_num - write(33,*)fock_matrix_ao_alpha(i,1:ao_num) - enddo print*,'Fock MCSCF' - do i = 1, ao_num - write(34,*)mcscf_fock_alpha(i,1:ao_num) + do i = 1, mo_num + write(*,*)i,mcscf_fock_diag_mo(i) +! write(*,*)mcscf_fock_alpha_mo(i,i) enddo diff --git a/src/casscf_cipsi/mcscf_fock.irp.f b/src/casscf_cipsi/mcscf_fock.irp.f index 519dfff7..0f4b7a99 100644 --- a/src/casscf_cipsi/mcscf_fock.irp.f +++ b/src/casscf_cipsi/mcscf_fock.irp.f @@ -77,15 +77,119 @@ BEGIN_PROVIDER [real*8, Fapq, (mo_num,mo_num) ] END_PROVIDER - BEGIN_PROVIDER [ double precision, mcscf_fock_alpha, (ao_num, ao_num)] -&BEGIN_PROVIDER [ double precision, mcscf_fock_beta, (ao_num, ao_num)] + BEGIN_PROVIDER [ double precision, mcscf_fock_alpha_ao, (ao_num, ao_num)] +&BEGIN_PROVIDER [ double precision, mcscf_fock_beta_ao, (ao_num, ao_num)] implicit none BEGIN_DOC - ! mcscf_fock_alpha are set to usual Fock like operator but computed with the MCSCF densities + ! mcscf_fock_alpha_ao are set to usual Fock like operator but computed with the MCSCF densities on the AO basis END_DOC SCF_density_matrix_ao_alpha = D0tu_alpha_ao SCF_density_matrix_ao_beta = D0tu_beta_ao soft_touch SCF_density_matrix_ao_alpha SCF_density_matrix_ao_beta - mcscf_fock_beta = fock_matrix_ao_beta - mcscf_fock_alpha = fock_matrix_ao_alpha + mcscf_fock_beta_ao = fock_matrix_ao_beta + mcscf_fock_alpha_ao = fock_matrix_ao_alpha +END_PROVIDER + + + BEGIN_PROVIDER [ double precision, mcscf_fock_alpha_mo, (mo_num, mo_num)] +&BEGIN_PROVIDER [ double precision, mcscf_fock_beta_mo, (mo_num, mo_num)] + implicit none + BEGIN_DOC + ! Mo_mcscf_fock_alpha are set to usual Fock like operator but computed with the MCSCF densities on the MO basis + END_DOC + + call ao_to_mo(mcscf_fock_alpha_ao,ao_num,mcscf_fock_alpha_mo,mo_num) + call ao_to_mo(mcscf_fock_beta_ao,ao_num,mcscf_fock_beta_mo,mo_num) + +END_PROVIDER + + BEGIN_PROVIDER [ double precision, mcscf_fock_mo, (mo_num,mo_num) ] +&BEGIN_PROVIDER [ double precision, mcscf_fock_diag_mo, (mo_num)] + implicit none + BEGIN_DOC + ! MCSF Fock matrix on the MO basis. + ! For open shells, the ROHF Fock Matrix is :: + ! + ! | Rcc | F^b | Fcv | + ! |-----------------------| + ! | F^b | Roo | F^a | + ! |-----------------------| + ! | Fcv | F^a | Rvv | + ! + ! C: Core, O: Open, V: Virtual + ! + ! Rcc = Acc Fcc^a + Bcc Fcc^b + ! Roo = Aoo Foo^a + Boo Foo^b + ! Rvv = Avv Fvv^a + Bvv Fvv^b + ! Fcv = (F^a + F^b)/2 + ! + ! F^a: Fock matrix alpha (MO), F^b: Fock matrix beta (MO) + ! A,B: Coupling parameters + ! + ! J. Chem. Phys. 133, 141102 (2010), https://doi.org/10.1063/1.3503173 + ! Coupling parameters from J. Chem. Phys. 125, 204110 (2006); https://doi.org/10.1063/1.2393223. + ! cc oo vv + ! A -0.5 0.5 1.5 + ! B 1.5 0.5 -0.5 + ! + END_DOC + integer :: i,j,n + if (elec_alpha_num == elec_beta_num) then + mcscf_fock_mo = mcscf_fock_alpha_mo + else + ! Core + do j = 1, elec_beta_num + ! Core + do i = 1, elec_beta_num + mcscf_fock_mo(i,j) = - 0.5d0 * mcscf_fock_alpha_mo(i,j) & + + 1.5d0 * mcscf_fock_beta_mo(i,j) + enddo + ! Open + do i = elec_beta_num+1, elec_alpha_num + mcscf_fock_mo(i,j) = mcscf_fock_beta_mo(i,j) + enddo + ! Virtual + do i = elec_alpha_num+1, mo_num + mcscf_fock_mo(i,j) = 0.5d0 * mcscf_fock_alpha_mo(i,j) & + + 0.5d0 * mcscf_fock_beta_mo(i,j) + enddo + enddo + ! Open + do j = elec_beta_num+1, elec_alpha_num + ! Core + do i = 1, elec_beta_num + mcscf_fock_mo(i,j) = mcscf_fock_beta_mo(i,j) + enddo + ! Open + do i = elec_beta_num+1, elec_alpha_num + mcscf_fock_mo(i,j) = 0.5d0 * mcscf_fock_alpha_mo(i,j) & + + 0.5d0 * mcscf_fock_beta_mo(i,j) + enddo + ! Virtual + do i = elec_alpha_num+1, mo_num + mcscf_fock_mo(i,j) = mcscf_fock_alpha_mo(i,j) + enddo + enddo + ! Virtual + do j = elec_alpha_num+1, mo_num + ! Core + do i = 1, elec_beta_num + mcscf_fock_mo(i,j) = 0.5d0 * mcscf_fock_alpha_mo(i,j) & + + 0.5d0 * mcscf_fock_beta_mo(i,j) + enddo + ! Open + do i = elec_beta_num+1, elec_alpha_num + mcscf_fock_mo(i,j) = mcscf_fock_alpha_mo(i,j) + enddo + ! Virtual + do i = elec_alpha_num+1, mo_num + mcscf_fock_mo(i,j) = 1.5d0 * mcscf_fock_alpha_mo(i,j) & + - 0.5d0 * mcscf_fock_beta_mo(i,j) + enddo + enddo + endif + + do i = 1, mo_num + mcscf_fock_diag_mo(i) = mcscf_fock_mo(i,i) + enddo END_PROVIDER From d9b2298d9a0d380b2ea26b1702d7d0d805b8c06a Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 6 Oct 2023 15:36:38 +0200 Subject: [PATCH 29/84] improved casscf and added README.rst --- src/casscf_cipsi/README.rst | 12 ++++++++---- src/casscf_cipsi/casscf.irp.f | 2 ++ src/cipsi/stochastic_cipsi.irp.f | 4 ++-- src/two_body_rdm/state_av_act_2rdm.irp.f | 2 +- src/two_body_rdm/test_2_rdm.irp.f | 2 +- 5 files changed, 14 insertions(+), 8 deletions(-) diff --git a/src/casscf_cipsi/README.rst b/src/casscf_cipsi/README.rst index 155d90da..f84cde75 100644 --- a/src/casscf_cipsi/README.rst +++ b/src/casscf_cipsi/README.rst @@ -32,12 +32,16 @@ qp set_mo_class -c "[1-2]" -a "[3-10]" -v "[11-46]" qp set casscf_cipsi small_active_space True # RUN THE CASSCF qp run casscf | tee ${EZFIO_FILE}.casscf.out +# you should find around -149.7243542 b) Large active space : Exploit the selected CI in the active space ------------------------------------------------------------------- -Let us start from the small active space calculation orbitals and add another shell of +#Let us start from the small active space calculation orbitals and add another 10 virtuals: CASSCF(12e,20orb) +qp set_mo_class -c "[1-2]" -a "[3-20]" -v "[21-46]" +# As this active space is larger, you unset the small_active_space feature +qp set casscf_cipsi small_active_space False +# As it is a large active space, the energy convergence thereshold is set to be 0.0001 +qp run casscf | tee ${EZFIO_FILE}.casscf_large.out +# you should find around -149.9046 - - -TODO : print FOCK MCSCF NEW in the MO BASIS AT THE END OF THE CASSCF diff --git a/src/casscf_cipsi/casscf.irp.f b/src/casscf_cipsi/casscf.irp.f index 06a2bc52..ba4d8eea 100644 --- a/src/casscf_cipsi/casscf.irp.f +++ b/src/casscf_cipsi/casscf.irp.f @@ -11,6 +11,7 @@ program casscf if(small_active_space)then pt2_relative_error = 0.00001 else + thresh_scf = 1.d-4 pt2_relative_error = 0.04 endif touch pt2_relative_error @@ -45,6 +46,7 @@ subroutine run do while (.not.converged) print*,'pt2_max = ',pt2_max call run_stochastic_cipsi(Ev,PT2) + print*,'Ev,PT2',Ev(1),PT2(1) E_PT2(1:N_states) = Ev(1:N_states) + PT2(1:N_states) energy_old = energy energy = eone+etwo+ecore diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f index 3a895280..289040f0 100644 --- a/src/cipsi/stochastic_cipsi.irp.f +++ b/src/cipsi/stochastic_cipsi.irp.f @@ -80,12 +80,14 @@ subroutine run_stochastic_cipsi(Ev,PT2) to_select = max(N_states_diag, to_select) + Ev(1:N_states) = psi_energy_with_nucl_rep(1:N_states) call pt2_dealloc(pt2_data) call pt2_dealloc(pt2_data_err) call pt2_alloc(pt2_data, N_states) call pt2_alloc(pt2_data_err, N_states) call ZMQ_pt2(psi_energy_with_nucl_rep,pt2_data,pt2_data_err,relative_error,to_select) ! Stochastic PT2 and selection + PT2(1:N_states) = pt2_data % pt2(1:N_states) correlation_energy_ratio = (psi_energy_with_nucl_rep(1) - hf_energy_ref) / & (psi_energy_with_nucl_rep(1) + pt2_data % rpt2(1) - hf_energy_ref) correlation_energy_ratio = min(1.d0,correlation_energy_ratio) @@ -140,8 +142,6 @@ subroutine run_stochastic_cipsi(Ev,PT2) call print_mol_properties() call write_cipsi_json(pt2_data,pt2_data_err) endif - Ev(1:N_states) = psi_energy_with_nucl_rep(1:N_states) - PT2(1:N_states) = pt2_data % pt2(1:N_states) call pt2_dealloc(pt2_data) call pt2_dealloc(pt2_data_err) diff --git a/src/two_body_rdm/state_av_act_2rdm.irp.f b/src/two_body_rdm/state_av_act_2rdm.irp.f index ea636212..e1bd6439 100644 --- a/src/two_body_rdm/state_av_act_2rdm.irp.f +++ b/src/two_body_rdm/state_av_act_2rdm.irp.f @@ -123,7 +123,7 @@ state_av_act_2_rdm_spin_trace_mo = state_av_act_2_rdm_ab_mo & + state_av_act_2_rdm_aa_mo & + state_av_act_2_rdm_bb_mo - +! ! call orb_range_2_rdm_state_av_openmp(state_av_act_2_rdm_spin_trace_mo,n_act_orb,n_act_orb,list_act,state_weights,ispin,psi_coef,size(psi_coef,2),size(psi_coef,1)) call wall_time(wall_2) diff --git a/src/two_body_rdm/test_2_rdm.irp.f b/src/two_body_rdm/test_2_rdm.irp.f index 4eb8f9f0..123261d8 100644 --- a/src/two_body_rdm/test_2_rdm.irp.f +++ b/src/two_body_rdm/test_2_rdm.irp.f @@ -2,7 +2,7 @@ program test_2_rdm implicit none read_wf = .True. touch read_wf -! call routine_active_only + call routine_active_only call routine_full_mos end From 999839b83938ff9797db92b777dcc6de88fbfda1 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 11 Oct 2023 09:42:10 +0200 Subject: [PATCH 30/84] Fixed reversed order in print of extrapolation --- external/ezfio | 2 +- src/iterations/print_extrapolation.irp.f | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/external/ezfio b/external/ezfio index 66d3dd5d..d5805497 160000 --- a/external/ezfio +++ b/external/ezfio @@ -1 +1 @@ -Subproject commit 66d3dd5d8e05ca564a0c815d636cb58d213a8828 +Subproject commit d5805497fa0ef30e70e055cde1ecec2963303e93 diff --git a/src/iterations/print_extrapolation.irp.f b/src/iterations/print_extrapolation.irp.f index a7f85693..24c9845f 100644 --- a/src/iterations/print_extrapolation.irp.f +++ b/src/iterations/print_extrapolation.irp.f @@ -37,7 +37,7 @@ subroutine print_extrapolated_energy write(*,*) 'minimum PT2 ', 'Extrapolated energy ', ' Excitation (a.u) ', ' Excitation (eV) ' write(*,*) '=========== ', '=================== ', '=================== ', '===================' do k=2,N_iter_p - write(*,'(F11.4,X,3(X,F18.8))') pt2_iterations(i,k), extrapolated_energy(k,i), & + write(*,'(F11.4,X,3(X,F18.8))') pt2_iterations(i,N_iter_p+1-k), extrapolated_energy(k,i), & extrapolated_energy(k,i) - extrapolated_energy(k,1), & (extrapolated_energy(k,i) - extrapolated_energy(k,1) ) * 27.211396641308d0 enddo From bce700526d73f5b77e837bc8f34a453c3a504b92 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 11 Oct 2023 10:24:55 +0200 Subject: [PATCH 31/84] Better behavior when DSYGV Failed --- .../diagonalization_hs2_dressed.irp.f | 53 ++++++++++--------- 1 file changed, 29 insertions(+), 24 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 7b559925..1ead9d78 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -286,7 +286,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ ! Small h(N_st_diag*itermax,N_st_diag*itermax), & - h_p(N_st_diag*itermax,N_st_diag*itermax), & +! h_p(N_st_diag*itermax,N_st_diag*itermax), & y(N_st_diag*itermax,N_st_diag*itermax), & s_(N_st_diag*itermax,N_st_diag*itermax), & s_tmp(N_st_diag*itermax,N_st_diag*itermax), & @@ -340,7 +340,10 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ exit endif - do iter=1,itermax-1 + iter = 0 + do while (iter < itermax-1) + iter += 1 +! do iter=1,itermax-1 shift = N_st_diag*(iter-1) shift2 = N_st_diag*iter @@ -430,30 +433,30 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ call dgemm('T','N', shift2, shift2, sze, & 1.d0, U, size(U,1), W, size(W,1), & - 0.d0, h, size(h_p,1)) + 0.d0, h, size(h,1)) call dgemm('T','N', shift2, shift2, sze, & 1.d0, U, size(U,1), U, size(U,1), & 0.d0, s_tmp, size(s_tmp,1)) - ! Penalty method - ! -------------- - - if (s2_eig) then - h_p = s_ - do k=1,shift2 - h_p(k,k) = h_p(k,k) - expected_s2 - enddo - if (only_expected_s2) then - alpha = 0.1d0 - h_p = h + alpha*h_p - else - alpha = 0.0001d0 - h_p = h + alpha*h_p - endif - else - h_p = h - alpha = 0.d0 - endif +! ! Penalty method +! ! -------------- +! +! if (s2_eig) then +! h_p = s_ +! do k=1,shift2 +! h_p(k,k) = h_p(k,k) - expected_s2 +! enddo +! if (only_expected_s2) then +! alpha = 0.1d0 +! h_p = h + alpha*h_p +! else +! alpha = 0.0001d0 +! h_p = h + alpha*h_p +! endif +! else +! h_p = h +! alpha = 0.d0 +! endif ! Diagonalize h_p ! --------------- @@ -473,8 +476,10 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ call dsygv(1,'V','U',shift2,y,size(y,1), & s_tmp,size(s_tmp,1), lambda, work,lwork,info) deallocate(work) - if (info /= 0) then - stop 'DSYGV Diagonalization failed' + if (info > 0) then + ! Numerical errors propagate. We need to reduce the number of iterations + itermax = iter-1 + exit endif ! Compute Energy for each eigenvector From a64d02ab427a2b886e19390a33c4fa395f69ed9c Mon Sep 17 00:00:00 2001 From: eginer Date: Wed, 11 Oct 2023 15:45:51 +0200 Subject: [PATCH 32/84] trying to work on natorb --- bin/qp_reset | 2 + external/ezfio | 2 +- src/non_hermit_dav/biorthog.irp.f | 6 +- .../lapack_diag_non_hermit.irp.f | 90 ++++++++++++++----- src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f | 8 +- src/tc_scf/routines_rotates.irp.f | 1 + 6 files changed, 81 insertions(+), 28 deletions(-) diff --git a/bin/qp_reset b/bin/qp_reset index d94ab24c..b144c4ce 100755 --- a/bin/qp_reset +++ b/bin/qp_reset @@ -97,6 +97,8 @@ if [[ $dets -eq 1 ]] ; then rm --force -- ${ezfio}/determinants/psi_{det,coef}.gz rm --force -- ${ezfio}/determinants/n_det_qp_edit rm --force -- ${ezfio}/determinants/psi_{det,coef}_qp_edit.gz + rm --force -- ${ezfio}/tc_bi_ortho/psi_{l,r}_coef_bi_ortho.gz + fi if [[ $mos -eq 1 ]] ; then diff --git a/external/ezfio b/external/ezfio index d5805497..dba01c4f 160000 --- a/external/ezfio +++ b/external/ezfio @@ -1 +1 @@ -Subproject commit d5805497fa0ef30e70e055cde1ecec2963303e93 +Subproject commit dba01c4fe0ff7b84c5ecfb1c7c77ec68781311b3 diff --git a/src/non_hermit_dav/biorthog.irp.f b/src/non_hermit_dav/biorthog.irp.f index 78fddf54..da33f75a 100644 --- a/src/non_hermit_dav/biorthog.irp.f +++ b/src/non_hermit_dav/biorthog.irp.f @@ -331,7 +331,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei !thr = 100d0 thr = Im_thresh_tcscf do i = 1, n - !print*, 'Re(i) + Im(i)', WR(i), WI(i) + print*, 'Re(i) + Im(i)', WR(i), WI(i) if(dabs(WI(i)) .lt. thr) then n_good += 1 else @@ -405,7 +405,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .lt. thr_d) ) then - !print *, ' lapack vectors are normalized and bi-orthogonalized' + print *, ' lapack vectors are normalized and bi-orthogonalized' deallocate(S) return @@ -422,7 +422,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei else - !print *, ' lapack vectors are not normalized neither bi-orthogonalized' + print *, ' lapack vectors are not normalized neither bi-orthogonalized' ! --- diff --git a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f b/src/non_hermit_dav/lapack_diag_non_hermit.irp.f index 0d652af4..6e5719c1 100644 --- a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f +++ b/src/non_hermit_dav/lapack_diag_non_hermit.irp.f @@ -1857,7 +1857,7 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ integer :: i, j double precision, allocatable :: SS(:,:) - !print *, ' check bi-orthogonality' + print *, ' check bi-orthogonality' ! --- @@ -1865,10 +1865,10 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ , Vl, size(Vl, 1), Vr, size(Vr, 1) & , 0.d0, S, size(S, 1) ) - !print *, ' overlap matrix:' - !do i = 1, m - ! write(*,'(1000(F16.10,X))') S(i,:) - !enddo + print *, ' overlap matrix:' + do i = 1, m + write(*,'(1000(F16.10,X))') S(i,:) + enddo accu_d = 0.d0 accu_nd = 0.d0 @@ -1883,8 +1883,8 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ enddo accu_nd = dsqrt(accu_nd) / dble(m) - !print *, ' accu_nd = ', accu_nd - !print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m) + print *, ' accu_nd = ', accu_nd + print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m) ! --- @@ -1987,11 +1987,11 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) enddo enddo - !do i = 1, n - ! if(deg_num(i) .gt. 1) then - ! print *, ' degen on', i, deg_num(i), e0(i) - ! endif - !enddo + do i = 1, n + if(deg_num(i) .gt. 1) then + print *, ' degen on', i, deg_num(i), e0(i) + endif + enddo ! --- @@ -2010,7 +2010,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) ! --- - call impose_orthog_svd(n, m, L) +! call impose_orthog_svd(n, m, L) call impose_orthog_svd(n, m, R) !call impose_orthog_GramSchmidt(n, m, L) !call impose_orthog_GramSchmidt(n, m, R) @@ -2030,7 +2030,8 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) !call bi_ortho_s_inv_half(m, L, R, S_inv_half) !deallocate(S, S_inv_half) - call impose_biorthog_svd(n, m, L, R) +! call impose_biorthog_svd(n, m, L, R) +! call impose_biorthog_inverse(n, m, L, R) !call impose_biorthog_qr(n, m, thr_d, thr_nd, L, R) @@ -2045,6 +2046,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) endif enddo + call impose_biorthog_inverse(n, n, L0, R0) end subroutine impose_biorthog_degen_eigvec @@ -2420,10 +2422,10 @@ subroutine impose_biorthog_svd(n, m, L, R) , L, size(L, 1), R, size(R, 1) & , 0.d0, S, size(S, 1) ) - !print *, ' overlap bef SVD: ' - !do i = 1, m - ! write(*, '(1000(F16.10,X))') S(i,:) - !enddo + print *, ' overlap bef SVD: ' + do i = 1, m + write(*, '(1000(F16.10,X))') S(i,:) + enddo ! --- @@ -2495,10 +2497,10 @@ subroutine impose_biorthog_svd(n, m, L, R) , L, size(L, 1), R, size(R, 1) & , 0.d0, S, size(S, 1) ) - !print *, ' overlap aft SVD: ' - !do i = 1, m - ! write(*, '(1000(F16.10,X))') S(i,:) - !enddo + print *, ' overlap aft SVD: ' + do i = 1, m + write(*, '(1000(F16.10,X))') S(i,:) + enddo deallocate(S) @@ -2506,6 +2508,50 @@ subroutine impose_biorthog_svd(n, m, L, R) end subroutine impose_biorthog_svd +subroutine impose_biorthog_inverse(n, m, L, R) + + implicit none + + integer, intent(in) :: n, m + double precision, intent(inout) :: L(n,m) + double precision, intent(in) :: R(n,m) + double precision, allocatable :: Lt(:,:),S(:,:) + integer :: i,j + allocate(Lt(m,n)) + allocate(S(m,m)) + + call dgemm( 'T', 'N', m, m, n, 1.d0 & + , L, size(L, 1), R, size(R, 1) & + , 0.d0, S, size(S, 1) ) + + print *, ' overlap bef SVD: ' + do i = 1, m + write(*, '(1000(F16.10,X))') S(i,:) + enddo + + call get_pseudo_inverse(R,n,n,m,Lt,m,1.d-6) + do i = 1, m + do j = 1, n + L(j,i) = Lt(i,j) + enddo + enddo + ! --- + + call dgemm( 'T', 'N', m, m, n, 1.d0 & + , L, size(L, 1), R, size(R, 1) & + , 0.d0, S, size(S, 1) ) + + print *, ' overlap aft SVD: ' + do i = 1, m + write(*, '(1000(F16.10,X))') S(i,:) + enddo + + deallocate(S,Lt) + + +end subroutine impose_biorthog_svd + + ! --- subroutine impose_weighted_biorthog_qr(m, n, thr_d, thr_nd, Vl, W, Vr) diff --git a/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f b/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f index 47ade8df..6b239cfc 100644 --- a/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f +++ b/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f @@ -22,6 +22,7 @@ program tc_natorb_bi_ortho call print_energy_and_mos() call save_tc_natorb() + call print_angles_tc() !call minimize_tc_orb_angles() end @@ -35,9 +36,12 @@ subroutine save_tc_natorb() print*,'Saving the natorbs ' provide natorb_tc_leigvec_ao natorb_tc_reigvec_ao + mo_l_coef = natorb_tc_leigvec_ao + mo_r_coef = natorb_tc_reigvec_ao + touch mo_l_coef mo_r_coef - call ezfio_set_bi_ortho_mos_mo_l_coef(natorb_tc_leigvec_ao) - call ezfio_set_bi_ortho_mos_mo_r_coef(natorb_tc_reigvec_ao) + call ezfio_set_bi_ortho_mos_mo_l_coef(mo_l_coef) + call ezfio_set_bi_ortho_mos_mo_r_coef(mo_r_coef) call save_ref_determinant_nstates_1() call ezfio_set_determinants_read_wf(.False.) diff --git a/src/tc_scf/routines_rotates.irp.f b/src/tc_scf/routines_rotates.irp.f index 588382b5..cc825429 100644 --- a/src/tc_scf/routines_rotates.irp.f +++ b/src/tc_scf/routines_rotates.irp.f @@ -402,6 +402,7 @@ subroutine print_energy_and_mos(good_angles) print *, ' TC energy = ', TC_HF_energy print *, ' TC SCF energy gradient = ', grad_non_hermit print *, ' Max angle Left/right = ', max_angle_left_right + call print_angles_tc() if(max_angle_left_right .lt. thresh_lr_angle) then print *, ' Maximum angle BELOW 45 degrees, everthing is OK !' From 8a026209082893932c8b96ccca754f6cf3a3a88e Mon Sep 17 00:00:00 2001 From: eginer Date: Thu, 12 Oct 2023 16:15:17 +0200 Subject: [PATCH 33/84] minor modif --- src/fci/fci.irp.f | 2 +- src/non_hermit_dav/biorthog.irp.f | 82 ++++++++++++++-- .../lapack_diag_non_hermit.irp.f | 94 ++++++++++++++++++- src/tc_bi_ortho/tc_natorb.irp.f | 7 ++ 4 files changed, 176 insertions(+), 9 deletions(-) diff --git a/src/fci/fci.irp.f b/src/fci/fci.irp.f index 9de48a01..2059a53b 100644 --- a/src/fci/fci.irp.f +++ b/src/fci/fci.irp.f @@ -42,7 +42,7 @@ program fci write(json_unit,json_array_open_fmt) 'fci' double precision, allocatable :: Ev(:),PT2(:) - allocate(Ev(N_states), PT2(N_state)) + allocate(Ev(N_states), PT2(N_states)) if (do_pt2) then call run_stochastic_cipsi(Ev,PT2) else diff --git a/src/non_hermit_dav/biorthog.irp.f b/src/non_hermit_dav/biorthog.irp.f index da33f75a..13917c5a 100644 --- a/src/non_hermit_dav/biorthog.irp.f +++ b/src/non_hermit_dav/biorthog.irp.f @@ -270,7 +270,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei integer, intent(out) :: n_real_eigv double precision, intent(out) :: reigvec(n,n), leigvec(n,n), eigval(n) - integer :: i, j + integer :: i, j,k integer :: n_good double precision :: thr, thr_cut, thr_diag, thr_norm double precision :: accu_d, accu_nd @@ -278,6 +278,8 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei integer, allocatable :: list_good(:), iorder(:) double precision, allocatable :: WR(:), WI(:), VL(:,:), VR(:,:) double precision, allocatable :: S(:,:) + double precision, allocatable :: phi_1_tilde(:),phi_2_tilde(:),chi_1_tilde(:),chi_2_tilde(:) + allocate(phi_1_tilde(n),phi_2_tilde(n),chi_1_tilde(n),chi_2_tilde(n)) ! ------------------------------------------------------------------------------------- @@ -301,11 +303,78 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei call lapack_diag_non_sym(n, A, WR, WI, VL, VR) !call lapack_diag_non_sym_new(n, A, WR, WI, VL, VR) - !print *, ' ' - !print *, ' eigenvalues' - !do i = 1, n - ! write(*, '(1000(F16.10,X))') WR(i), WI(i) - !enddo + + + print *, ' ' + print *, ' eigenvalues' + i = 1 + do while(i .le. n) + write(*, '(I3,X,1000(F16.10,X))')i, WR(i), WI(i) + if(.false.)then + if(WI(i).ne.0.d0)then + print*,'*****************' + print*,'WARNING ! IMAGINARY EIGENVALUES !!!' + write(*, '(1000(F16.10,X))') WR(i), WI(i+1) + ! phi = VR(:,i), psi = VR(:,i+1), |Phi_i> = phi + j psi , |Phi_i+1> = phi - j psi + ! chi = VL(:,i), xhi = VL(:,i+1), |Chi_i> = chi + j xhi , |Chi_i+1> = chi - j xhi + ! + accu_chi_phi = 0.d0 + accu_xhi_psi = 0.d0 + accu_chi_psi = 0.d0 + accu_xhi_phi = 0.d0 + double precision :: accu_chi_phi, accu_xhi_psi, accu_chi_psi, accu_xhi_phi + double precision :: mat_ovlp(2,2),eigval_tmp(2),eigvec(2,2),mat_ovlp_orig(2,2) + do j = 1, n + accu_chi_phi += VL(j,i) * VR(j,i) + accu_xhi_psi += VL(j,i+1) * VR(j,i+1) + accu_chi_psi += VL(j,i) * VR(j,i+1) + accu_xhi_phi += VL(j,i+1) * VR(j,i) + enddo + mat_ovlp_orig(1,1) = accu_chi_phi + mat_ovlp_orig(2,1) = accu_xhi_phi + mat_ovlp_orig(1,2) = accu_chi_psi + mat_ovlp_orig(2,2) = accu_xhi_psi + print*,'old overlap matrix ' + write(*,'(100(F16.10,X))')mat_ovlp_orig(1:2,1) + write(*,'(100(F16.10,X))')mat_ovlp_orig(1:2,2) + + + mat_ovlp(1,1) = accu_xhi_phi + mat_ovlp(2,1) = accu_chi_phi + mat_ovlp(1,2) = accu_xhi_psi + mat_ovlp(2,2) = accu_chi_psi + !print*,'accu_chi_phi = ',accu_chi_phi + !print*,'accu_xhi_psi = ',accu_xhi_psi + !print*,'accu_chi_psi = ',accu_chi_psi + !print*,'accu_xhi_phi = ',accu_xhi_phi + print*,'new overlap matrix ' + write(*,'(100(F16.10,X))')mat_ovlp(1:2,1) + write(*,'(100(F16.10,X))')mat_ovlp(1:2,2) + call lapack_diag(eigval_tmp,eigvec,mat_ovlp,2,2) + print*,'eigval_tmp(1) = ',eigval_tmp(1) + print*,'eigvec(1) = ',eigvec(1:2,1) + print*,'eigval_tmp(2) = ',eigval_tmp(2) + print*,'eigvec(2) = ',eigvec(1:2,2) + print*,'*****************' + phi_1_tilde = 0.d0 + phi_2_tilde = 0.d0 + chi_1_tilde = 0.d0 + chi_2_tilde = 0.d0 + do j = 1, n + phi_1_tilde(j) += VR(j,i) * eigvec(1,1) + VR(j,i+1) * eigvec(2,1) + phi_2_tilde(j) += VR(j,i) * eigvec(1,2) + VR(j,i+1) * eigvec(2,2) + chi_1_tilde(j) += VL(j,i+1) * eigvec(1,1) + VL(j,i) * eigvec(2,1) + chi_2_tilde(j) += VL(j,i+1) * eigvec(1,2) + VL(j,i) * eigvec(2,2) + enddo + VR(1:n,i) = phi_1_tilde(1:n) + VR(1:n,i+1) = phi_2_tilde(1:n) +! Vl(1:n,i) = -chi_1_tilde(1:n) +! Vl(1:n,i+1) = chi_2_tilde(1:n) + i+=1 + endif + endif + i+=1 + enddo !print *, ' right eigenvect bef' !do i = 1, n ! write(*, '(1000(F16.10,X))') VR(:,i) @@ -429,6 +498,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei ! call impose_orthog_degen_eigvec(n, eigval, reigvec) ! call impose_orthog_degen_eigvec(n, eigval, leigvec) + call reorder_degen_eigvec(n, eigval, leigvec, reigvec) call impose_biorthog_degen_eigvec(n, eigval, leigvec, reigvec) diff --git a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f b/src/non_hermit_dav/lapack_diag_non_hermit.irp.f index 6e5719c1..836bf707 100644 --- a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f +++ b/src/non_hermit_dav/lapack_diag_non_hermit.irp.f @@ -1944,6 +1944,96 @@ subroutine check_orthog(n, m, V, accu_d, accu_nd, S) end subroutine check_orthog ! --- +subroutine reorder_degen_eigvec(n, e0, L0, R0) + + implicit none + + integer, intent(in) :: n + double precision, intent(in) :: e0(n) + double precision, intent(inout) :: L0(n,n), R0(n,n) + + logical :: complex_root + integer :: i, j, k, m + double precision :: ei, ej, de, de_thr + double precision :: accu_d, accu_nd + integer, allocatable :: deg_num(:) + double precision, allocatable :: L(:,:), R(:,:), S(:,:), S_inv_half(:,:) + + ! --- + + allocate( deg_num(n) ) + do i = 1, n + deg_num(i) = 1 + enddo + + de_thr = thr_degen_tc + + do i = 1, n-1 + ei = e0(i) + + ! already considered in degen vectors + if(deg_num(i).eq.0) cycle + + do j = i+1, n + ej = e0(j) + de = dabs(ei - ej) + + if(de .lt. de_thr) then + deg_num(i) = deg_num(i) + 1 + deg_num(j) = 0 + endif + + enddo + enddo + + do i = 1, n + if(deg_num(i) .gt. 1) then + print *, ' degen on', i, deg_num(i), e0(i) + endif + enddo + + ! --- + + do i = 1, n + m = deg_num(i) + + if(m .gt. 1) then + + allocate(L(n,m)) + allocate(R(n,m),S(m,m)) + + do j = 1, m + L(1:n,j) = L0(1:n,i+j-1) + R(1:n,j) = R0(1:n,i+j-1) + enddo + + call dgemm( 'T', 'N', m, m, n, 1.d0 & + , L, size(L, 1), R, size(R, 1) & + , 0.d0, S, size(S, 1) ) + print*,'Overlap matrix ' + accu_nd = 0.D0 + do j = 1, m + write(*,'(100(F16.10,X))')S(1:m,j) + do k = 1, m + if(j==k)cycle + accu_nd += dabs(S(j,k)) + enddo + enddo + print*,'accu_nd = ',accu_nd +! if(accu_nd .gt.1.d-10)then +! stop +! endif + do j = 1, m + L0(1:n,i+j-1) = L(1:n,j) + R0(1:n,i+j-1) = R(1:n,j) + enddo + + deallocate(L, R,S) + + endif + enddo + +end subroutine reorder_degen_eigvec subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) @@ -2030,7 +2120,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) !call bi_ortho_s_inv_half(m, L, R, S_inv_half) !deallocate(S, S_inv_half) -! call impose_biorthog_svd(n, m, L, R) + call impose_biorthog_svd(n, m, L, R) ! call impose_biorthog_inverse(n, m, L, R) !call impose_biorthog_qr(n, m, thr_d, thr_nd, L, R) @@ -2046,7 +2136,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) endif enddo - call impose_biorthog_inverse(n, n, L0, R0) +! call impose_biorthog_inverse(n, n, L0, R0) end subroutine impose_biorthog_degen_eigvec diff --git a/src/tc_bi_ortho/tc_natorb.irp.f b/src/tc_bi_ortho/tc_natorb.irp.f index a72d356a..17238231 100644 --- a/src/tc_bi_ortho/tc_natorb.irp.f +++ b/src/tc_bi_ortho/tc_natorb.irp.f @@ -32,6 +32,13 @@ thr_d = 1.d-6 thr_nd = 1.d-6 thr_deg = 1.d-3 + do i = 1, mo_num + do j = 1, mo_num + if(dabs(dm_tmp(j,i)).lt.thr_d)then + dm_tmp(j,i) = 0.d0 + endif + enddo + enddo ! if(n_core_orb.ne.0)then ! call diag_mat_per_fock_degen_core( fock_diag, dm_tmp, list_core, n_core_orb, mo_num, thr_d, thr_nd, thr_deg & ! , natorb_tc_leigvec_mo, natorb_tc_reigvec_mo, natorb_tc_eigval) From a4a799837bc7dba8ca2c7e39abc6716056cf5de7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 13 Oct 2023 15:10:51 +0200 Subject: [PATCH 34/84] Fix natorb with numerical integrals of Jastrow --- configure | 19 +++++++++++++++++-- src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f | 15 ++++++++++++++- src/tc_bi_ortho/tc_natorb.irp.f | 6 ++++++ 3 files changed, 37 insertions(+), 3 deletions(-) diff --git a/configure b/configure index c328c4f0..3ccdf37b 100755 --- a/configure +++ b/configure @@ -211,6 +211,7 @@ EOF execute << EOF cd "\${QP_ROOT}"/external wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz + rm -rf trexio-${VERSION} tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz cd trexio-${VERSION} ./configure --prefix=\${QP_ROOT} --without-hdf5 CFLAGS='-g' @@ -224,6 +225,7 @@ EOF execute << EOF cd "\${QP_ROOT}"/external wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz + rm -rf trexio-${VERSION} tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz cd trexio-${VERSION} ./configure --prefix=\${QP_ROOT} CFLAGS="-g" @@ -235,11 +237,24 @@ EOF execute << EOF cd "\${QP_ROOT}"/external wget https://github.com/TREX-CoE/qmckl/releases/download/v${VERSION}/qmckl-${VERSION}.tar.gz + rm -rf qmckl-${VERSION} tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz cd qmckl-${VERSION} ./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc CFLAGS='-g' make && make -j 4 check && make install EOF + elif [[ ${PACKAGE} = qmckl-intel ]] ; then + + VERSION=0.5.4 + execute << EOF + cd "\${QP_ROOT}"/external + wget https://github.com/TREX-CoE/qmckl/releases/download/v${VERSION}/qmckl-${VERSION}.tar.gz + rm -rf qmckl-${VERSION} + tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz + cd qmckl-${VERSION} + ./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc --with-icc --with-ifort CFLAGS='-g' + make && make -j 4 check && make install +EOF elif [[ ${PACKAGE} = gmp ]] ; then @@ -378,13 +393,13 @@ fi TREXIO=$(find_lib -ltrexio) if [[ ${TREXIO} = $(not_found) ]] ; then - error "TREXIO (trexio,trexio-nohdf5) is not installed. If you don't have HDF5, use trexio-nohdf5" + error "TREXIO (trexio | trexio-nohdf5) is not installed. If you don't have HDF5, use trexio-nohdf5" fail fi QMCKL=$(find_lib -lqmckl) if [[ ${QMCKL} = $(not_found) ]] ; then - error "QMCkl (qmckl) is not installed." + error "QMCkl (qmckl | qmckl-intel) is not installed." fail fi diff --git a/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f b/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f index 6b239cfc..ffcd9b22 100644 --- a/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f +++ b/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f @@ -15,7 +15,20 @@ program tc_natorb_bi_ortho PROVIDE tc_grid1_a tc_grid1_r my_n_pt_r_grid = tc_grid1_r my_n_pt_a_grid = tc_grid1_a - touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + if(j1b_type .ge. 100) then + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + + call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') + call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') + endif + + read_wf = .True. touch read_wf diff --git a/src/tc_bi_ortho/tc_natorb.irp.f b/src/tc_bi_ortho/tc_natorb.irp.f index a72d356a..50f448d6 100644 --- a/src/tc_bi_ortho/tc_natorb.irp.f +++ b/src/tc_bi_ortho/tc_natorb.irp.f @@ -29,6 +29,12 @@ write(*, '(100(F16.10,X))') -dm_tmp(:,i) enddo + print *, ' Transition density matrix AO' + do i = 1, ao_num + write(*, '(100(F16.10,X))') tc_transition_matrix_ao(:,i,1,1) + enddo + stop + thr_d = 1.d-6 thr_nd = 1.d-6 thr_deg = 1.d-3 From 676d5c3a7366bb11e98d6f42905e52904f986e86 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 15 Oct 2023 14:01:49 +0200 Subject: [PATCH 35/84] Fixed missing variables in openmp block --- src/ao_one_e_ints/kin_ao_ints.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ao_one_e_ints/kin_ao_ints.irp.f b/src/ao_one_e_ints/kin_ao_ints.irp.f index a5ee0670..3a97d095 100644 --- a/src/ao_one_e_ints/kin_ao_ints.irp.f +++ b/src/ao_one_e_ints/kin_ao_ints.irp.f @@ -52,7 +52,7 @@ !$OMP DEFAULT(NONE) & !$OMP PRIVATE(A_center,B_center,power_A,power_B,& !$OMP overlap_y, overlap_z, overlap, & - !$OMP alpha, beta,i,j,c,d_a_2,d_2,deriv_tmp, & + !$OMP alpha, beta, n, l, i,j,c,d_a_2,d_2,deriv_tmp, & !$OMP overlap_x0,overlap_y0,overlap_z0) & !$OMP SHARED(nucl_coord,ao_power,ao_prim_num, & !$OMP ao_deriv2_x,ao_deriv2_y,ao_deriv2_z,ao_num,ao_coef_normalized_ordered_transp,ao_nucl, & From 8b34372baa47feb8f4dfb350eb6d24cbc08e1d61 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 16 Oct 2023 16:18:58 +0200 Subject: [PATCH 36/84] Merged erf modules, and moved mu_erf into hamiltonian module --- scripts/module/module_handler.py | 4 +--- src/ao_tc_eff_map/NEED | 2 +- src/ao_two_e_erf_ints/EZFIO.cfg | 13 ------------ src/ao_two_e_erf_ints/NEED | 1 - src/ao_two_e_erf_ints/README.rst | 19 ------------------ src/ao_two_e_ints/EZFIO.cfg | 7 +++++++ src/ao_two_e_ints/NEED | 1 + .../integrals_erf_in_map_slave.irp.f | 0 .../map_integrals_erf.irp.f | 0 .../providers_ao_erf.irp.f | 0 .../routines_save_integrals_erf.irp.f | 0 .../two_e_integrals_erf.irp.f | 0 src/dft_one_e/NEED | 2 -- src/dummy/NEED | 3 +-- src/hamiltonian/EZFIO.cfg | 8 ++++++++ src/hamiltonian/NEED | 0 src/hamiltonian/README.rst | 5 +++++ src/mo_two_e_erf_ints/EZFIO.cfg | 6 ------ src/mo_two_e_erf_ints/NEED | 3 --- src/mo_two_e_erf_ints/README.rst | 20 ------------------- src/mo_two_e_ints/EZFIO.cfg | 7 +++++++ .../core_quantities_erf.irp.f | 0 .../ints_erf_3_index.irp.f | 0 .../map_integrals_erf.irp.f | 0 .../mo_bi_integrals_erf.irp.f | 0 .../routines_save_integrals_erf.irp.f | 0 src/tools/NEED | 1 - 27 files changed, 31 insertions(+), 71 deletions(-) delete mode 100644 src/ao_two_e_erf_ints/EZFIO.cfg delete mode 100644 src/ao_two_e_erf_ints/NEED delete mode 100644 src/ao_two_e_erf_ints/README.rst rename src/{ao_two_e_erf_ints => ao_two_e_ints}/integrals_erf_in_map_slave.irp.f (100%) rename src/{ao_two_e_erf_ints => ao_two_e_ints}/map_integrals_erf.irp.f (100%) rename src/{ao_two_e_erf_ints => ao_two_e_ints}/providers_ao_erf.irp.f (100%) rename src/{ao_two_e_erf_ints => ao_two_e_ints}/routines_save_integrals_erf.irp.f (100%) rename src/{ao_two_e_erf_ints => ao_two_e_ints}/two_e_integrals_erf.irp.f (100%) create mode 100644 src/hamiltonian/EZFIO.cfg create mode 100644 src/hamiltonian/NEED create mode 100644 src/hamiltonian/README.rst delete mode 100644 src/mo_two_e_erf_ints/EZFIO.cfg delete mode 100644 src/mo_two_e_erf_ints/NEED delete mode 100644 src/mo_two_e_erf_ints/README.rst rename src/{mo_two_e_erf_ints => mo_two_e_ints}/core_quantities_erf.irp.f (100%) rename src/{mo_two_e_erf_ints => mo_two_e_ints}/ints_erf_3_index.irp.f (100%) rename src/{mo_two_e_erf_ints => mo_two_e_ints}/map_integrals_erf.irp.f (100%) rename src/{mo_two_e_erf_ints => mo_two_e_ints}/mo_bi_integrals_erf.irp.f (100%) rename src/{mo_two_e_erf_ints => mo_two_e_ints}/routines_save_integrals_erf.irp.f (100%) diff --git a/scripts/module/module_handler.py b/scripts/module/module_handler.py index fbdee171..43030fc8 100755 --- a/scripts/module/module_handler.py +++ b/scripts/module/module_handler.py @@ -115,9 +115,7 @@ def get_l_module_descendant(d_child, l_module): except KeyError: print("Error: ", file=sys.stderr) print("`{0}` is not a submodule".format(module), file=sys.stderr) - print("Check the typo (spelling, case, '/', etc.) ", file=sys.stderr) -# pass - sys.exit(1) + raise return list(set(l)) diff --git a/src/ao_tc_eff_map/NEED b/src/ao_tc_eff_map/NEED index d9edb325..f768b75f 100644 --- a/src/ao_tc_eff_map/NEED +++ b/src/ao_tc_eff_map/NEED @@ -1,4 +1,4 @@ -ao_two_e_erf_ints +ao_two_e_ints mo_one_e_ints ao_many_one_e_ints dft_utils_in_r diff --git a/src/ao_two_e_erf_ints/EZFIO.cfg b/src/ao_two_e_erf_ints/EZFIO.cfg deleted file mode 100644 index 0af0e1d8..00000000 --- a/src/ao_two_e_erf_ints/EZFIO.cfg +++ /dev/null @@ -1,13 +0,0 @@ -[io_ao_two_e_integrals_erf] -type: Disk_access -doc: Read/Write |AO| integrals with the long range interaction from/to disk [ Write | Read | None ] -interface: ezfio,provider,ocaml -default: None - -[mu_erf] -type: double precision -doc: cutting of the interaction in the range separated model -interface: ezfio,provider,ocaml -default: 0.5 -ezfio_name: mu_erf - diff --git a/src/ao_two_e_erf_ints/NEED b/src/ao_two_e_erf_ints/NEED deleted file mode 100644 index b30cc39d..00000000 --- a/src/ao_two_e_erf_ints/NEED +++ /dev/null @@ -1 +0,0 @@ -ao_two_e_ints diff --git a/src/ao_two_e_erf_ints/README.rst b/src/ao_two_e_erf_ints/README.rst deleted file mode 100644 index 45c72b84..00000000 --- a/src/ao_two_e_erf_ints/README.rst +++ /dev/null @@ -1,19 +0,0 @@ -====================== -ao_two_e_erf_ints -====================== - -Here, all two-electron integrals (:math:`erf(\mu r_{12})/r_{12}`) are computed. -As they have 4 indices and many are zero, they are stored in a map, as defined -in :file:`utils/map_module.f90`. - -The main parameter of this module is :option:`ao_two_e_erf_ints mu_erf` which is the range-separation parameter. - -To fetch an |AO| integral, use the -`get_ao_two_e_integral_erf(i,j,k,l,ao_integrals_erf_map)` function. - - -The conventions are: -* For |AO| integrals : (ij|kl) = (11|22) = = <12|12> - - - diff --git a/src/ao_two_e_ints/EZFIO.cfg b/src/ao_two_e_ints/EZFIO.cfg index 9c017813..a489516e 100644 --- a/src/ao_two_e_ints/EZFIO.cfg +++ b/src/ao_two_e_ints/EZFIO.cfg @@ -35,3 +35,10 @@ type: logical doc: Perform Cholesky decomposition of AO integrals interface: ezfio,provider,ocaml default: False + +[io_ao_two_e_integrals_erf] +type: Disk_access +doc: Read/Write |AO| erf integrals from/to disk [ Write | Read | None ] +interface: ezfio,provider,ocaml +default: None + diff --git a/src/ao_two_e_ints/NEED b/src/ao_two_e_ints/NEED index ffc5e8be..542962ec 100644 --- a/src/ao_two_e_ints/NEED +++ b/src/ao_two_e_ints/NEED @@ -1,3 +1,4 @@ +hamiltonian ao_one_e_ints pseudo bitmask diff --git a/src/ao_two_e_erf_ints/integrals_erf_in_map_slave.irp.f b/src/ao_two_e_ints/integrals_erf_in_map_slave.irp.f similarity index 100% rename from src/ao_two_e_erf_ints/integrals_erf_in_map_slave.irp.f rename to src/ao_two_e_ints/integrals_erf_in_map_slave.irp.f diff --git a/src/ao_two_e_erf_ints/map_integrals_erf.irp.f b/src/ao_two_e_ints/map_integrals_erf.irp.f similarity index 100% rename from src/ao_two_e_erf_ints/map_integrals_erf.irp.f rename to src/ao_two_e_ints/map_integrals_erf.irp.f diff --git a/src/ao_two_e_erf_ints/providers_ao_erf.irp.f b/src/ao_two_e_ints/providers_ao_erf.irp.f similarity index 100% rename from src/ao_two_e_erf_ints/providers_ao_erf.irp.f rename to src/ao_two_e_ints/providers_ao_erf.irp.f diff --git a/src/ao_two_e_erf_ints/routines_save_integrals_erf.irp.f b/src/ao_two_e_ints/routines_save_integrals_erf.irp.f similarity index 100% rename from src/ao_two_e_erf_ints/routines_save_integrals_erf.irp.f rename to src/ao_two_e_ints/routines_save_integrals_erf.irp.f diff --git a/src/ao_two_e_erf_ints/two_e_integrals_erf.irp.f b/src/ao_two_e_ints/two_e_integrals_erf.irp.f similarity index 100% rename from src/ao_two_e_erf_ints/two_e_integrals_erf.irp.f rename to src/ao_two_e_ints/two_e_integrals_erf.irp.f diff --git a/src/dft_one_e/NEED b/src/dft_one_e/NEED index 615ee97e..667859a5 100644 --- a/src/dft_one_e/NEED +++ b/src/dft_one_e/NEED @@ -4,6 +4,4 @@ mo_one_e_ints mo_two_e_ints ao_one_e_ints ao_two_e_ints -mo_two_e_erf_ints -ao_two_e_erf_ints mu_of_r diff --git a/src/dummy/NEED b/src/dummy/NEED index 3d5eb1f7..1dcb7a25 100644 --- a/src/dummy/NEED +++ b/src/dummy/NEED @@ -1,6 +1,5 @@ ao_basis ao_one_e_ints -ao_two_e_erf_ints ao_two_e_ints aux_quantities becke_numerical_grid @@ -24,13 +23,13 @@ functionals generators_cas generators_full hartree_fock +hamiltonian iterations kohn_sham kohn_sham_rs mo_basis mo_guess mo_one_e_ints -mo_two_e_erf_ints mo_two_e_ints mpi nuclei diff --git a/src/hamiltonian/EZFIO.cfg b/src/hamiltonian/EZFIO.cfg new file mode 100644 index 00000000..672bfdfa --- /dev/null +++ b/src/hamiltonian/EZFIO.cfg @@ -0,0 +1,8 @@ +[mu_erf] +type: double precision +doc: cutting of the interaction in the range separated model +interface: ezfio,provider,ocaml +default: 0.5 +ezfio_name: mu_erf + + diff --git a/src/hamiltonian/NEED b/src/hamiltonian/NEED new file mode 100644 index 00000000..e69de29b diff --git a/src/hamiltonian/README.rst b/src/hamiltonian/README.rst new file mode 100644 index 00000000..c237f8d2 --- /dev/null +++ b/src/hamiltonian/README.rst @@ -0,0 +1,5 @@ +=========== +hamiltonian +=========== + +Parameters of the Hamiltonian. diff --git a/src/mo_two_e_erf_ints/EZFIO.cfg b/src/mo_two_e_erf_ints/EZFIO.cfg deleted file mode 100644 index 57137e65..00000000 --- a/src/mo_two_e_erf_ints/EZFIO.cfg +++ /dev/null @@ -1,6 +0,0 @@ -[io_mo_two_e_integrals_erf] -type: Disk_access -doc: Read/Write MO integrals with the long range interaction from/to disk [ Write | Read | None ] -interface: ezfio,provider,ocaml -default: None - diff --git a/src/mo_two_e_erf_ints/NEED b/src/mo_two_e_erf_ints/NEED deleted file mode 100644 index 7adb17a1..00000000 --- a/src/mo_two_e_erf_ints/NEED +++ /dev/null @@ -1,3 +0,0 @@ -ao_two_e_erf_ints -mo_two_e_ints -mo_basis diff --git a/src/mo_two_e_erf_ints/README.rst b/src/mo_two_e_erf_ints/README.rst deleted file mode 100644 index b118e0c7..00000000 --- a/src/mo_two_e_erf_ints/README.rst +++ /dev/null @@ -1,20 +0,0 @@ -====================== -mo_two_e_erf_ints -====================== - -Here, all two-electron integrals (:math:`erf({\mu}_{erf} * r_{12})/r_{12}`) are computed. -As they have 4 indices and many are zero, they are stored in a map, as defined -in :file:`Utils/map_module.f90`. - -The range separation parameter :math:`{\mu}_{erf}` is the variable :option:`ao_two_e_erf_ints mu_erf`. - -To fetch an |MO| integral, use -`get_mo_two_e_integral_erf(i,j,k,l,mo_integrals_map_erf)` - -The conventions are: - -* For |MO| integrals : = <12|12> - -Be aware that it might not be the same conventions for |MO| and |AO| integrals. - - diff --git a/src/mo_two_e_ints/EZFIO.cfg b/src/mo_two_e_ints/EZFIO.cfg index ea47c51c..088a2416 100644 --- a/src/mo_two_e_ints/EZFIO.cfg +++ b/src/mo_two_e_ints/EZFIO.cfg @@ -17,3 +17,10 @@ doc: If `True`, computes all integrals except for the integrals having 3 or 4 vi interface: ezfio,provider,ocaml default: false +[io_mo_two_e_integrals_erf] +type: Disk_access +doc: Read/Write MO integrals with the long range interaction from/to disk [ Write | Read | None ] +interface: ezfio,provider,ocaml +default: None + + diff --git a/src/mo_two_e_erf_ints/core_quantities_erf.irp.f b/src/mo_two_e_ints/core_quantities_erf.irp.f similarity index 100% rename from src/mo_two_e_erf_ints/core_quantities_erf.irp.f rename to src/mo_two_e_ints/core_quantities_erf.irp.f diff --git a/src/mo_two_e_erf_ints/ints_erf_3_index.irp.f b/src/mo_two_e_ints/ints_erf_3_index.irp.f similarity index 100% rename from src/mo_two_e_erf_ints/ints_erf_3_index.irp.f rename to src/mo_two_e_ints/ints_erf_3_index.irp.f diff --git a/src/mo_two_e_erf_ints/map_integrals_erf.irp.f b/src/mo_two_e_ints/map_integrals_erf.irp.f similarity index 100% rename from src/mo_two_e_erf_ints/map_integrals_erf.irp.f rename to src/mo_two_e_ints/map_integrals_erf.irp.f diff --git a/src/mo_two_e_erf_ints/mo_bi_integrals_erf.irp.f b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f similarity index 100% rename from src/mo_two_e_erf_ints/mo_bi_integrals_erf.irp.f rename to src/mo_two_e_ints/mo_bi_integrals_erf.irp.f diff --git a/src/mo_two_e_erf_ints/routines_save_integrals_erf.irp.f b/src/mo_two_e_ints/routines_save_integrals_erf.irp.f similarity index 100% rename from src/mo_two_e_erf_ints/routines_save_integrals_erf.irp.f rename to src/mo_two_e_ints/routines_save_integrals_erf.irp.f diff --git a/src/tools/NEED b/src/tools/NEED index 0f4e17b0..ea465e92 100644 --- a/src/tools/NEED +++ b/src/tools/NEED @@ -1,5 +1,4 @@ fci -mo_two_e_erf_ints aux_quantities hartree_fock two_body_rdm From ad498b073e9103d1c0fdd4f17426c274aacefce8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 16 Oct 2023 16:29:28 +0200 Subject: [PATCH 37/84] Added use_only_lr for long-range only integrals --- src/ao_two_e_ints/EZFIO.cfg | 5 +++++ src/ao_two_e_ints/two_e_integrals.irp.f | 16 ++++++++-------- 2 files changed, 13 insertions(+), 8 deletions(-) diff --git a/src/ao_two_e_ints/EZFIO.cfg b/src/ao_two_e_ints/EZFIO.cfg index a489516e..ff932b0c 100644 --- a/src/ao_two_e_ints/EZFIO.cfg +++ b/src/ao_two_e_ints/EZFIO.cfg @@ -42,3 +42,8 @@ doc: Read/Write |AO| erf integrals from/to disk [ Write | Read | None ] interface: ezfio,provider,ocaml default: None +[use_only_lr] +type: logical +doc: If true, use only the long range part of the two-electron integrals instead of 1/r12 +interface: ezfio, provider, ocaml +default: False diff --git a/src/ao_two_e_ints/two_e_integrals.irp.f b/src/ao_two_e_ints/two_e_integrals.irp.f index 148ebb62..b55b5f0d 100644 --- a/src/ao_two_e_ints/two_e_integrals.irp.f +++ b/src/ao_two_e_ints/two_e_integrals.irp.f @@ -21,9 +21,9 @@ double precision function ao_two_e_integral(i, j, k, l) double precision :: P_new(0:max_dim,3),P_center(3),fact_p,pp double precision :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq - double precision :: ao_two_e_integral_schwartz_accel - - double precision :: ao_two_e_integral_cosgtos + double precision, external :: ao_two_e_integral_erf + double precision, external :: ao_two_e_integral_cosgtos + double precision, external :: ao_two_e_integral_schwartz_accel if(use_cosgtos) then @@ -31,13 +31,15 @@ double precision function ao_two_e_integral(i, j, k, l) ao_two_e_integral = ao_two_e_integral_cosgtos(i, j, k, l) - else + else if (use_only_lr) then - if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then + ao_two_e_integral = ao_two_e_integral_erf(i, j, k, l) + + else if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l) - else + else dim1 = n_pt_max_integrals @@ -117,8 +119,6 @@ double precision function ao_two_e_integral(i, j, k, l) enddo ! q enddo ! p - endif - endif endif From 14d5268d1b986654c90d328c293b0d28ec6a05fa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 16 Oct 2023 16:37:08 +0200 Subject: [PATCH 38/84] Fixing compilation --- src/ao_two_e_ints/providers_ao_erf.irp.f | 2 +- src/ao_two_e_ints/routines_save_integrals_erf.irp.f | 2 +- src/dft_one_e/mu_erf_dft.irp.f | 2 +- src/mo_two_e_ints/mo_bi_integrals_erf.irp.f | 2 +- src/mo_two_e_ints/routines_save_integrals_erf.irp.f | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ao_two_e_ints/providers_ao_erf.irp.f b/src/ao_two_e_ints/providers_ao_erf.irp.f index 293df29f..ddc1ec45 100644 --- a/src/ao_two_e_ints/providers_ao_erf.irp.f +++ b/src/ao_two_e_ints/providers_ao_erf.irp.f @@ -90,7 +90,7 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ] if (write_ao_two_e_integrals_erf) then call ezfio_set_work_empty(.False.) call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_erf',ao_integrals_erf_map) - call ezfio_set_ao_two_e_erf_ints_io_ao_two_e_integrals_erf("Read") + call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals_erf("Read") endif END_PROVIDER diff --git a/src/ao_two_e_ints/routines_save_integrals_erf.irp.f b/src/ao_two_e_ints/routines_save_integrals_erf.irp.f index 4b0cfad0..d980bc05 100644 --- a/src/ao_two_e_ints/routines_save_integrals_erf.irp.f +++ b/src/ao_two_e_ints/routines_save_integrals_erf.irp.f @@ -4,7 +4,7 @@ subroutine save_erf_two_e_integrals_ao PROVIDE ao_two_e_integrals_erf_in_map call ezfio_set_work_empty(.False.) call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_erf',ao_integrals_erf_map) - call ezfio_set_ao_two_e_erf_ints_io_ao_two_e_integrals_erf('Read') + call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals_erf('Read') end subroutine save_erf_two_e_ints_ao_into_ints_ao diff --git a/src/dft_one_e/mu_erf_dft.irp.f b/src/dft_one_e/mu_erf_dft.irp.f index 0b870564..08779f0e 100644 --- a/src/dft_one_e/mu_erf_dft.irp.f +++ b/src/dft_one_e/mu_erf_dft.irp.f @@ -3,7 +3,7 @@ BEGIN_PROVIDER [double precision, mu_erf_dft] BEGIN_DOC ! range separation parameter used in RS-DFT. ! -! It is set to mu_erf in order to be consistent with the module "ao_two_e_erf_ints" +! It is set to mu_erf in order to be consistent with the module "hamiltonian" END_DOC mu_erf_dft = mu_erf diff --git a/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f index e009b7d9..e7765d71 100644 --- a/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f @@ -55,7 +55,7 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_erf_in_map ] if (write_mo_two_e_integrals_erf) then call ezfio_set_work_empty(.False.) call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_erf',mo_integrals_erf_map) - call ezfio_set_mo_two_e_erf_ints_io_mo_two_e_integrals_erf("Read") + call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals_erf("Read") endif END_PROVIDER diff --git a/src/mo_two_e_ints/routines_save_integrals_erf.irp.f b/src/mo_two_e_ints/routines_save_integrals_erf.irp.f index 52fb8f63..9915b206 100644 --- a/src/mo_two_e_ints/routines_save_integrals_erf.irp.f +++ b/src/mo_two_e_ints/routines_save_integrals_erf.irp.f @@ -4,7 +4,7 @@ subroutine save_erf_two_e_integrals_mo PROVIDE mo_two_e_integrals_erf_in_map call ezfio_set_work_empty(.False.) call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_erf',mo_integrals_erf_map) - call ezfio_set_mo_two_e_erf_ints_io_mo_two_e_integrals_erf('Read') + call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals_erf('Read') end From c7599febfb1e35987fc67dc174d7d4845d296557 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 17 Oct 2023 00:28:47 +0200 Subject: [PATCH 39/84] Fix bug in Jastrow --- src/non_h_ints_mu/jast_deriv.irp.f | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/non_h_ints_mu/jast_deriv.irp.f b/src/non_h_ints_mu/jast_deriv.irp.f index 4137c51c..19b900da 100644 --- a/src/non_h_ints_mu/jast_deriv.irp.f +++ b/src/non_h_ints_mu/jast_deriv.irp.f @@ -138,7 +138,7 @@ allocate( gl(2,4,n_points) ) do ipoint_block = 1, n_points_final_grid, 100 ! r1 - ipoint_end = min(n_points_final_grid, ipoint_block+100) + ipoint_end = min(n_points_final_grid, ipoint_block+99) k=0 do ipoint = ipoint_block, ipoint_end @@ -223,8 +223,6 @@ enddo !ipoint_block - - deallocate(gl, rij) else From d4d42f2851f815ff520f78c3bcd7615b8240dcc2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 17 Oct 2023 17:52:43 +0200 Subject: [PATCH 40/84] Fixing tests --- src/kohn_sham_rs/61.rsks.bats | 2 +- src/tc_scf/11.tc_scf.bats | 46 +++++++++++++++++------------------ 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/src/kohn_sham_rs/61.rsks.bats b/src/kohn_sham_rs/61.rsks.bats index 90b82142..29d43c3b 100644 --- a/src/kohn_sham_rs/61.rsks.bats +++ b/src/kohn_sham_rs/61.rsks.bats @@ -13,7 +13,7 @@ function run() { qp set scf_utils thresh_scf 1.e-10 qp set dft_keywords exchange_functional $functional qp set dft_keywords correlation_functional $functional - qp set ao_two_e_erf_ints mu_erf 0.5 + qp set hamiltonian mu_erf 0.5 qp set becke_numerical_grid grid_type_sgn 1 qp_reset --mos $1 qp run rs_ks_scf diff --git a/src/tc_scf/11.tc_scf.bats b/src/tc_scf/11.tc_scf.bats index 91b52540..b81c2f4b 100644 --- a/src/tc_scf/11.tc_scf.bats +++ b/src/tc_scf/11.tc_scf.bats @@ -8,15 +8,15 @@ function run_Ne() { rm -rf Ne_tc_scf echo Ne > Ne.xyz qp create_ezfio -b cc-pcvdz Ne.xyz -o Ne_tc_scf - qp run scf + qp run scf - qp set ao_two_e_erf_ints mu_erf 0.87 + qp set hamiltonian mu_erf 0.87 qp set tc_keywords j1b_type 3 - qp set tc_keywords j1b_pen [1.5] - qp set tc_keywords bi_ortho True + qp set tc_keywords j1b_pen [1.5] + qp set tc_keywords bi_ortho True qp set tc_keywords test_cycle_tc True - qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out + qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out eref=-128.552134 energy="$(qp get tc_scf bitc_energy)" eq $energy $eref 1e-6 @@ -24,22 +24,22 @@ function run_Ne() { @test "Ne" { - run_Ne + run_Ne } function run_C() { rm -rf C_tc_scf echo C > C.xyz qp create_ezfio -b cc-pcvdz C.xyz -o C_tc_scf -m 3 - qp run scf + qp run scf - qp set ao_two_e_erf_ints mu_erf 0.87 + qp set hamiltonian mu_erf 0.87 qp set tc_keywords j1b_type 3 - qp set tc_keywords j1b_pen [1.5] - qp set tc_keywords bi_ortho True + qp set tc_keywords j1b_pen [1.5] + qp set tc_keywords bi_ortho True qp set tc_keywords test_cycle_tc True - qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out + qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out eref=-37.691254356408791 energy="$(qp get tc_scf bitc_energy)" eq $energy $eref 1e-6 @@ -47,7 +47,7 @@ function run_C() { @test "C" { - run_C + run_C } @@ -55,15 +55,15 @@ function run_O() { rm -rf O_tc_scf echo O > O.xyz qp create_ezfio -b cc-pcvdz O.xyz -o O_tc_scf -m 3 - qp run scf + qp run scf - qp set ao_two_e_erf_ints mu_erf 0.87 + qp set hamiltonian mu_erf 0.87 qp set tc_keywords j1b_type 3 - qp set tc_keywords j1b_pen [1.5] - qp set tc_keywords bi_ortho True + qp set tc_keywords j1b_pen [1.5] + qp set tc_keywords bi_ortho True qp set tc_keywords test_cycle_tc True - qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out + qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out eref=-74.814687229354590 energy="$(qp get tc_scf bitc_energy)" eq $energy $eref 1e-6 @@ -71,7 +71,7 @@ function run_O() { @test "O" { - run_O + run_O } @@ -79,16 +79,16 @@ function run_O() { function run_ch2() { rm -rf ch2_tc_scf cp ${QP_ROOT}/tests/input/ch2.xyz . - qp create_ezfio -b "C:cc-pcvdz|H:cc-pvdz" ch2.xyz -o ch2_tc_scf - qp run scf + qp create_ezfio -b "C:cc-pcvdz|H:cc-pvdz" ch2.xyz -o ch2_tc_scf + qp run scf - qp set ao_two_e_erf_ints mu_erf 0.87 + qp set hamiltonian mu_erf 0.87 qp set tc_keywords j1b_type 3 qp set tc_keywords j1b_pen '[1.5,10000,10000]' qp set tc_keywords bi_ortho True qp set tc_keywords test_cycle_tc True - qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out + qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out eref=-38.903247818077737 energy="$(qp get tc_scf bitc_energy)" eq $energy $eref 1e-6 @@ -96,6 +96,6 @@ function run_ch2() { @test "ch2" { - run_ch2 + run_ch2 } From 16565bbda4955d024d758e78e3fda592f834337c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 17 Oct 2023 23:28:08 +0200 Subject: [PATCH 41/84] Fixing tests --- src/basis_correction/51.basis_c.bats | 4 ++-- src/casscf_cipsi/50.casscf.bats | 4 ++-- src/cis/20.cis.bats | 10 +++++----- src/cisd/30.cisd.bats | 4 ++-- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/basis_correction/51.basis_c.bats b/src/basis_correction/51.basis_c.bats index 2682361b..914b482b 100644 --- a/src/basis_correction/51.basis_c.bats +++ b/src/basis_correction/51.basis_c.bats @@ -10,8 +10,8 @@ function run() { qp set perturbation do_pt2 False qp set determinants n_det_max 8000 qp set determinants n_states 1 - qp set davidson threshold_davidson 1.e-10 - qp set davidson n_states_diag 8 + qp set davidson_keywords threshold_davidson 1.e-10 + qp set davidson_keywords n_states_diag 8 qp run fci energy1="$(ezfio get fci energy | tr '[]' ' ' | cut -d ',' -f 1)" eq $energy1 $1 $thresh diff --git a/src/casscf_cipsi/50.casscf.bats b/src/casscf_cipsi/50.casscf.bats index a0db725d..9f63dfe2 100644 --- a/src/casscf_cipsi/50.casscf.bats +++ b/src/casscf_cipsi/50.casscf.bats @@ -9,8 +9,8 @@ function run_stoch() { test_exe casscf || skip qp set perturbation do_pt2 True qp set determinants n_det_max $3 - qp set davidson threshold_davidson 1.e-10 - qp set davidson n_states_diag 4 + qp set davidson_keywords threshold_davidson 1.e-10 + qp set davidson_keywords n_states_diag 4 qp run casscf | tee casscf.out energy1="$(ezfio get casscf energy_pt2 | tr '[]' ' ' | cut -d ',' -f 1)" eq $energy1 $1 $thresh diff --git a/src/cis/20.cis.bats b/src/cis/20.cis.bats index 4f255c7b..4a5c6e45 100644 --- a/src/cis/20.cis.bats +++ b/src/cis/20.cis.bats @@ -9,7 +9,7 @@ function run() { qp set_file $1 qp edit --check qp set determinants n_states 3 - qp set davidson threshold_davidson 1.e-12 + qp set davidson_keywords threshold_davidson 1.e-12 qp set mo_two_e_ints io_mo_two_e_integrals Write qp set_frozen_core qp run cis @@ -59,7 +59,7 @@ function run() { @test "ClO" { # 1.65582s 2.06465s [[ -n $TRAVIS ]] && skip - run clo.ezfio -534.263560525680 -534.256601571199 -534.062020844428 + run clo.ezfio -534.2635737789097 -534.2566081298855 -534.0620070783308 } @test "SO" { # 1.9667s 2.91234s @@ -69,7 +69,7 @@ function run() { @test "OH" { # 2.201s 2.65573s [[ -n $TRAVIS ]] && skip - run oh.ezfio -75.4314648243896 -75.4254639668256 -75.2707675632313 + run oh.ezfio -75.4314822573358 -75.4254733392003 -75.2707586997333 } @test "H2O2" { # 2.27079s 3.07875s @@ -109,7 +109,7 @@ function run() { @test "DHNO" { # 6.42976s 12.9899s [[ -n $TRAVIS ]] && skip - run dhno.ezfio -130.4472288472718 -130.3571808164850 -130.2196257046987 + run dhno.ezfio -130.447238897118 -130.357186843611 -130.219626716369 } @test "CH4" { # 6.4969s 10.9157s @@ -129,7 +129,7 @@ function run() { @test "[Cu(NH3)4]2+" { # 29.7711s 3.45478m [[ -n ${TRAVIS} ]] && skip - run cu_nh3_4_2plus.ezfio -1862.97958885180 -1862.92457657404 -1862.91134959451 + run cu_nh3_4_2plus.ezfio -1862.97958844302 -1862.92454785007 -1862.91130869967 } diff --git a/src/cisd/30.cisd.bats b/src/cisd/30.cisd.bats index 6b8fddb6..fefc3e6d 100644 --- a/src/cisd/30.cisd.bats +++ b/src/cisd/30.cisd.bats @@ -8,8 +8,8 @@ function run() { test_exe cisd || skip qp edit --check qp set determinants n_states 2 - qp set davidson threshold_davidson 1.e-12 - qp set davidson n_states_diag 24 + qp set davidson_keywords threshold_davidson 1.e-12 + qp set davidson_keywords n_states_diag 24 qp run cis qp run cisd energy1="$(qp get cisd energy | tr '[]' ' ' | cut -d ',' -f 1)" From 50800f41c39eb45901a91d458840cc7953f73b49 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 18 Oct 2023 00:13:10 +0200 Subject: [PATCH 42/84] Fixing tests --- src/cisd/30.cisd.bats | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/cisd/30.cisd.bats b/src/cisd/30.cisd.bats index fefc3e6d..5ec11e4b 100644 --- a/src/cisd/30.cisd.bats +++ b/src/cisd/30.cisd.bats @@ -10,8 +10,7 @@ function run() { qp set determinants n_states 2 qp set davidson_keywords threshold_davidson 1.e-12 qp set davidson_keywords n_states_diag 24 - qp run cis - qp run cisd + qp run cisd energy1="$(qp get cisd energy | tr '[]' ' ' | cut -d ',' -f 1)" energy2="$(qp get cisd energy | tr '[]' ' ' | cut -d ',' -f 2)" eq $energy1 $1 $thresh @@ -19,7 +18,7 @@ function run() { } -@test "B-B" { # +@test "B-B" { # qp set_file b2_stretched.ezfio qp set_frozen_core run -49.120607088648597 -49.055152453388231 @@ -34,7 +33,7 @@ function run() { @test "HBO" { # 4.42968s 19.6099s qp set_file hbo.ezfio qp set_frozen_core - run -100.2019254455993 -99.79484127741013 + run -100.2019254455993 -99.79484127741013 } @test "HCO" { # 6.6077s 28.6801s @@ -46,7 +45,7 @@ function run() { @test "H2O" { # 7.0651s 30.6642s qp set_file h2o.ezfio qp set_frozen_core - run -76.22975602077072 -75.80609108747208 + run -76.22975602077072 -75.80609108747208 } @@ -78,7 +77,7 @@ function run() { [[ -n $TRAVIS ]] && skip qp set_file oh.ezfio qp set_frozen_core - run -75.6087472926588 -75.5370393736601 + run -75.6088105201621 -75.5370802925698 } @test "CH4" { # 19.821s 1.38648m @@ -105,8 +104,9 @@ function run() { @test "DHNO" { # 24.7077s 1.46487m [[ -n $TRAVIS ]] && skip qp set_file dhno.ezfio - qp set_mo_class --core="[1-7]" --act="[8-64]" - run -130.458814562403 -130.356308303681 + qp set_mo_class --core="[1-7]" --act="[8-64]" + run -130.4659881027444 -130.2692384198501 +# run -130.458814562403 -130.356308303681 } @test "H3COH" { # 24.7248s 1.85043m @@ -120,7 +120,7 @@ function run() { [[ -n $TRAVIS ]] && skip qp set_file cu_nh3_4_2plus.ezfio qp set_mo_class --core="[1-24]" --act="[25-45]" --del="[46-87]" - run -1862.98689579931 -1862.6883044626563 + run -1862.98310702274 -1862.88506319755 } @@ -135,14 +135,14 @@ function run() { [[ -n $TRAVIS ]] && skip qp set_file c2h2.ezfio qp set_mo_class --act="[1-30]" --del="[31-36]" - run -12.3566731164213 -11.9495394759914 + run -12.3566731164213 -11.9495394759914 } @test "ClO" { # 37.6949s [[ -n $TRAVIS ]] && skip qp set_file clo.ezfio qp set_frozen_core - run -534.5404021326773 -534.3818725793897 + run -534.540464615019 -534.381904487587 } @test "F2" { # 45.2078s @@ -155,7 +155,7 @@ function run() { @test "SO2" { # 47.6922s [[ -n $TRAVIS ]] && skip qp set_file so2.ezfio - qp set_mo_class --core="[1-8]" --act="[9-87]" + qp set_mo_class --core="[1-8]" --act="[9-87]" run -41.5746738710350 -41.3800467740750 } @@ -177,7 +177,7 @@ function run() { [[ -n $TRAVIS ]] && skip qp set_file n2.ezfio qp set_mo_class --core="[1,2]" --act="[3-40]" --del="[41-60]" - run -109.275693633982 -108.757794570948 + run -109.275693633982 -108.757794570948 } @test "HCN" { # 133.8696s From a3db8bb242c16f822d7a112b6c043be69c7abb21 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 18 Oct 2023 09:08:37 +0200 Subject: [PATCH 43/84] Fix ezfio save --- src/ao_two_e_ints/providers_ao_erf.irp.f | 2 +- src/ao_two_e_ints/routines_save_integrals_erf.irp.f | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ao_two_e_ints/providers_ao_erf.irp.f b/src/ao_two_e_ints/providers_ao_erf.irp.f index 293df29f..ff8c31a2 100644 --- a/src/ao_two_e_ints/providers_ao_erf.irp.f +++ b/src/ao_two_e_ints/providers_ao_erf.irp.f @@ -90,7 +90,7 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ] if (write_ao_two_e_integrals_erf) then call ezfio_set_work_empty(.False.) call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_erf',ao_integrals_erf_map) - call ezfio_set_ao_two_e_erf_ints_io_ao_two_e_integrals_erf("Read") + call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals_erf('Read') endif END_PROVIDER diff --git a/src/ao_two_e_ints/routines_save_integrals_erf.irp.f b/src/ao_two_e_ints/routines_save_integrals_erf.irp.f index 4b0cfad0..d980bc05 100644 --- a/src/ao_two_e_ints/routines_save_integrals_erf.irp.f +++ b/src/ao_two_e_ints/routines_save_integrals_erf.irp.f @@ -4,7 +4,7 @@ subroutine save_erf_two_e_integrals_ao PROVIDE ao_two_e_integrals_erf_in_map call ezfio_set_work_empty(.False.) call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_erf',ao_integrals_erf_map) - call ezfio_set_ao_two_e_erf_ints_io_ao_two_e_integrals_erf('Read') + call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals_erf('Read') end subroutine save_erf_two_e_ints_ao_into_ints_ao From 1b7463b86bd417ddba48aa5218384d340671f041 Mon Sep 17 00:00:00 2001 From: Abdallah Ammar Date: Wed, 18 Oct 2023 23:53:47 +0200 Subject: [PATCH 44/84] fixed sgn error in jast_deriv --- src/non_h_ints_mu/jast_deriv.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/non_h_ints_mu/jast_deriv.irp.f b/src/non_h_ints_mu/jast_deriv.irp.f index 6b8445b1..6de3d80d 100644 --- a/src/non_h_ints_mu/jast_deriv.irp.f +++ b/src/non_h_ints_mu/jast_deriv.irp.f @@ -57,7 +57,7 @@ r2(2) = final_grid_points_extra(2,jpoint) r2(3) = final_grid_points_extra(3,jpoint) - call grad1_j12_mu(r1, r2, grad1_u2b) + call grad1_j12_mu(r2, r1, grad1_u2b) dx = grad1_u2b(1) dy = grad1_u2b(2) @@ -100,7 +100,7 @@ v1b_r2 = j1b_nucl(r2) u2b_r12 = j12_mu(r1, r2) - call grad1_j12_mu(r1, r2, grad1_u2b) + call grad1_j12_mu(r2, r1, grad1_u2b) dx = (grad1_u2b(1) * v1b_r1 + u2b_r12 * grad1_v1b(1)) * v1b_r2 dy = (grad1_u2b(2) * v1b_r1 + u2b_r12 * grad1_v1b(2)) * v1b_r2 From aa9ad710a9ec36376cf647e74be1eaab056d6146 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 19 Oct 2023 17:42:27 +0200 Subject: [PATCH 45/84] add lib64 to library_path --- etc/paths.rc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/paths.rc b/etc/paths.rc index 84c2d12f..dc1741e8 100644 --- a/etc/paths.rc +++ b/etc/paths.rc @@ -32,7 +32,7 @@ export PYTHONPATH=$(qp_prepend_export "PYTHONPATH" "${QP_EZFIO}/Python":"${QP_PY export PATH=$(qp_prepend_export "PATH" "${QP_PYTHON}":"${QP_ROOT}"/bin:"${QP_ROOT}"/ocaml) -export LD_LIBRARY_PATH=$(qp_prepend_export "LD_LIBRARY_PATH" "${QP_ROOT}"/lib) +export LD_LIBRARY_PATH=$(qp_prepend_export "LD_LIBRARY_PATH" "${QP_ROOT}"/lib:"${QP_ROOT}"/lib64) export LIBRARY_PATH=$(qp_prepend_export "LIBRARY_PATH" "${QP_ROOT}"/lib:"${QP_ROOT}"/lib64) From 06b8370e42d24e29da1a82b9667ed48586e6b821 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 19 Oct 2023 17:51:17 +0200 Subject: [PATCH 46/84] Update irpf90 --- external/irpf90 | 2 +- src/mo_two_e_ints/mo_bi_integrals_erf.irp.f | 14 ++++++++------ src/mu_of_r/mu_of_r_conditions.irp.f | 2 +- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/external/irpf90 b/external/irpf90 index 0007f72f..4ab1b175 160000 --- a/external/irpf90 +++ b/external/irpf90 @@ -1 +1 @@ -Subproject commit 0007f72f677fe7d61c5e1ed461882cb239517102 +Subproject commit 4ab1b175fc7ed0d96c1912f13dc53579b24157a6 diff --git a/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f index e7765d71..1afc1f3c 100644 --- a/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f @@ -9,25 +9,27 @@ subroutine mo_two_e_integrals_erf_index(i,j,k,l,i1) integer(key_kind) :: p,q,r,s,i2 p = min(i,k) r = max(i,k) - p = p+ishft(r*r-r,-1) + p = p+shiftr(r*r-r,1) q = min(j,l) s = max(j,l) - q = q+ishft(s*s-s,-1) + q = q+shiftr(s*s-s,1) i1 = min(p,q) i2 = max(p,q) - i1 = i1+ishft(i2*i2-i2,-1) + i1 = i1+shiftr(i2*i2-i2,1) end BEGIN_PROVIDER [ logical, mo_two_e_integrals_erf_in_map ] use map_module implicit none - integer(bit_kind) :: mask_ijkl(N_int,4) - integer(bit_kind) :: mask_ijk(N_int,3) - BEGIN_DOC ! If True, the map of MO two-electron integrals is provided END_DOC + integer(bit_kind) :: mask_ijkl(N_int,4) + integer(bit_kind) :: mask_ijk(N_int,3) + double precision :: cpu_1, cpu_2, wall_1, wall_2 + + PROVIDE mo_class real :: map_mb diff --git a/src/mu_of_r/mu_of_r_conditions.irp.f b/src/mu_of_r/mu_of_r_conditions.irp.f index f9c3b3b3..959950a6 100644 --- a/src/mu_of_r/mu_of_r_conditions.irp.f +++ b/src/mu_of_r/mu_of_r_conditions.irp.f @@ -128,7 +128,7 @@ BEGIN_PROVIDER [double precision, mu_average_prov, (N_states)] implicit none BEGIN_DOC - ! average value of mu(r) weighted with the total one-e density and divised by the number of electrons + ! average value of mu(r) weighted with the total one-e density and divided by the number of electrons ! ! !!!!!! WARNING !!!!!! if no_core_density == .True. then all contributions from the core orbitals ! From 88010afecdc4be310e2ea3eef0cea411bb4e0b6c Mon Sep 17 00:00:00 2001 From: eginer Date: Wed, 25 Oct 2023 15:11:34 +0200 Subject: [PATCH 47/84] added jastrow mu(r) which seems to work --- src/non_h_ints_mu/jast_deriv_utils.irp.f | 86 +++++++++++++++++++++--- src/non_h_ints_mu/plot_mu_of_r.irp.f | 15 +++-- src/tc_keywords/EZFIO.cfg | 6 ++ src/tools/print_sorted_wf_coef.irp.f | 2 +- 4 files changed, 94 insertions(+), 15 deletions(-) diff --git a/src/non_h_ints_mu/jast_deriv_utils.irp.f b/src/non_h_ints_mu/jast_deriv_utils.irp.f index bcbe16af..745d00ad 100644 --- a/src/non_h_ints_mu/jast_deriv_utils.irp.f +++ b/src/non_h_ints_mu/jast_deriv_utils.irp.f @@ -99,6 +99,7 @@ subroutine grad1_j12_mu(r1, r2, grad) stop endif + grad = -grad return end subroutine grad1_j12_mu @@ -486,6 +487,13 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) !!!!!!!!! rho1,rho2,rho1+rho2 call get_all_rho_grad_rho(r1,r2,rho1,rho2,grad_rho1) rho_tot = rho1 + rho2 +! if(rho_tot.lt.1.d-10)rho_tot = 1.d-10 + if(rho_tot.lt.1.d-10)then + mu_val = mu_erf + mu_der = 0.d0 + return + endif + if(rho_tot.lt.1.d-10)rho_tot = 1.d-10 inv_rho_tot = 1.d0/rho_tot ! f(rho) = mu_r_ct * rho**beta_rho_power + mu_erf @@ -506,18 +514,26 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) ! d/dx1 f[rho(r1)] = [0.5 alpha / sqrt(rho(r1)) ] (d rho(r1) / dx1) ! ! d/dx1 (rho(r1) f[rho(r1)] = rho(r1) * d/dx1 f[rho(r1)] + f[rho(r1)] * d/dx1 rho(r1) - !!!!!!!!! rho1,rho2,rho1+rho2 call get_all_rho_grad_rho(r1,r2,rho1,rho2,grad_rho1) rho_tot = rho1 + rho2 +! if(rho_tot.lt.1.d-10)rho_tot = 1.d-10 + if(rho_tot.lt.1.d-10)then + mu_val = mu_erf + mu_der = 0.d0 + return + endif + if(rho_tot.lt.1.d-10)rho_tot = 1.d-10 inv_rho_tot = 1.d0/rho_tot - ! f(rho) = mu_r_ct * rho**beta_rho_power + mu_erf - call get_all_f_rho_simple(rho1,rho2,mu_r_ct,mu_erf,beta_rho_power,f_rho1,d_drho_f_rho1,f_rho2) + ! f(rho) = (mu_r_ct* rho)**beta_rho_power * erf(zeta_erf_mu_of_r * rho) + mu_eff * (1 - erf(zeta_erf_mu_of_r*rho)) + call get_all_f_rho_erf(rho1,rho2,mu_r_ct,beta_rho_power,mu_erf,zeta_erf_mu_of_r,f_rho1,d_drho_f_rho1,f_rho2) d_dx1_f_rho1(1:3) = d_drho_f_rho1 * grad_rho1(1:3) d_dx_rho_f_rho(1:3) = rho1 * d_dx1_f_rho1(1:3) + f_rho1 * grad_rho1(1:3) - mu_val = 0.5d0 * ( f_rho1 + f_rho2) - mu_der(1:3) = d_dx_rho_f_rho(1:3) + nume = rho1 * f_rho1 + rho2 * f_rho2 + mu_val = nume * inv_rho_tot + mu_der(1:3) = inv_rho_tot*inv_rho_tot * (rho_tot * d_dx_rho_f_rho(1:3) - grad_rho1(1:3) * nume) + else print *, ' j1b_type = ', j1b_type, 'not implemented yet' stop @@ -676,8 +692,17 @@ subroutine get_all_f_rho_simple(rho1,rho2,alpha,mu0,beta,f_rho1,d_drho_f_rho1,f_ double precision, intent(in) :: rho1,rho2,alpha,mu0,beta double precision, intent(out):: f_rho1,d_drho_f_rho1,f_rho2 double precision :: tmp - call f_mu_and_deriv_mu_simple(rho1,alpha,mu0,beta,f_rho1,d_drho_f_rho1) - call f_mu_and_deriv_mu_simple(rho2,alpha,mu0,beta,f_rho2,tmp) + if(rho1.lt.1.d-10)then + f_rho1 = 0.d0 + d_drho_f_rho1 = 0.d0 + else + call f_mu_and_deriv_mu_simple(rho1,alpha,mu0,beta,f_rho1,d_drho_f_rho1) + endif + if(rho2.lt.1.d-10)then + f_rho2 = 0.d0 + else + call f_mu_and_deriv_mu_simple(rho2,alpha,mu0,beta,f_rho2,tmp) + endif end subroutine f_mu_and_deriv_mu_simple(rho,alpha,mu0,beta,f_mu,d_drho_f_mu) @@ -691,10 +716,53 @@ subroutine f_mu_and_deriv_mu_simple(rho,alpha,mu0,beta,f_mu,d_drho_f_mu) END_DOC double precision, intent(in) :: rho,alpha,mu0,beta double precision, intent(out) :: f_mu,d_drho_f_mu - f_mu = alpha * (rho)**beta + mu0 - d_drho_f_mu = alpha * beta * rho**(beta-1.d0) + f_mu = alpha**beta * (rho)**beta + mu0 + d_drho_f_mu = alpha**beta * beta * rho**(beta-1.d0) end ! --- +subroutine f_mu_and_deriv_mu_erf(rho,alpha,zeta,mu0,beta,f_mu,d_drho_f_mu) + implicit none + include 'constants.include.F' + BEGIN_DOC +! function giving mu as a function of rho +! +! f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) +! +! and its derivative with respect to rho d_drho_f_mu +! +! d_drho_f_mu = 2 beta/sqrt(pi) * exp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) +! + alpha * zeta * (alpha *rho)**(zeta-1) * erf(beta*rho) + END_DOC + double precision, intent(in) :: rho,alpha,mu0,beta,zeta + double precision, intent(out) :: f_mu,d_drho_f_mu + f_mu = (alpha * rho)**zeta * derf(beta * rho) + mu0 * (1.d0 - derf(beta*rho)) + d_drho_f_mu = 2.d0 * beta * inv_sq_pi * dexp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) & + + alpha * zeta * (alpha *rho)**(zeta-1) * derf(beta*rho) + +end + + +subroutine get_all_f_rho_erf(rho1,rho2,alpha,zeta,mu0,beta,f_rho1,d_drho_f_rho1,f_rho2) + implicit none + BEGIN_DOC +! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) +! with f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) + END_DOC + double precision, intent(in) :: rho1,rho2,alpha,mu0,beta,zeta + double precision, intent(out):: f_rho1,d_drho_f_rho1,f_rho2 + double precision :: tmp + if(rho1.lt.1.d-10)then + f_rho1 = mu_erf + d_drho_f_rho1 = 0.d0 + else + call f_mu_and_deriv_mu_erf(rho1,alpha,zeta,mu0,beta,f_rho1,d_drho_f_rho1) + endif + if(rho2.lt.1.d-10)then + f_rho2 = mu_erf + else + call f_mu_and_deriv_mu_erf(rho2,alpha,zeta,mu0,beta,f_rho2,tmp) + endif +end diff --git a/src/non_h_ints_mu/plot_mu_of_r.irp.f b/src/non_h_ints_mu/plot_mu_of_r.irp.f index 1100cd7c..3a5984bd 100644 --- a/src/non_h_ints_mu/plot_mu_of_r.irp.f +++ b/src/non_h_ints_mu/plot_mu_of_r.irp.f @@ -13,9 +13,9 @@ subroutine routine_print integer :: i_unit_output,getUnitAndOpen output=trim(ezfio_filename)//'.mu_of_r' i_unit_output = getUnitAndOpen(output,'w') - integer :: ipoint,nx - double precision :: xmax,xmin,r(3),dx - double precision :: mu_val, mu_der(3),dm_a,dm_b,grad + integer :: ipoint,nx,i + double precision :: xmax,xmin,r(3),dx,sigma + double precision :: mu_val, mu_der(3),dm_a,dm_b,grad,grad_dm_a(3), grad_dm_b(3) xmax = 5.D0 xmin = -5.D0 nx = 10000 @@ -24,10 +24,15 @@ subroutine routine_print r(1) = xmin do ipoint = 1, nx call mu_r_val_and_grad(r, r, mu_val, mu_der) - call dm_dft_alpha_beta_at_r(r,dm_a,dm_b) + call density_and_grad_alpha_beta(r,dm_a,dm_b, grad_dm_a, grad_dm_b) + sigma = 0.d0 + do i = 1,3 + sigma += grad_dm_a(i)**2 + enddo + sigma=dsqrt(sigma) grad = mu_der(1)**2 + mu_der(2)**2 + mu_der(3)**2 grad = dsqrt(grad) - write(i_unit_output,'(100(F16.7,X))')r(1),mu_val,dm_a+dm_b,grad + write(i_unit_output,'(100(F16.7,X))')r(1),mu_val,dm_a+dm_b,grad,sigma/dm_a r(1) += dx enddo end diff --git a/src/tc_keywords/EZFIO.cfg b/src/tc_keywords/EZFIO.cfg index 9b9aaca8..0c993957 100644 --- a/src/tc_keywords/EZFIO.cfg +++ b/src/tc_keywords/EZFIO.cfg @@ -166,6 +166,12 @@ doc: a parameter used to define mu(r) interface: ezfio, provider, ocaml default: 0.5 +[zeta_erf_mu_of_r] +type: double precision +doc: a parameter used to define mu(r) +interface: ezfio, provider, ocaml +default: 10. + [thr_degen_tc] type: Threshold doc: Threshold to determine if two orbitals are degenerate in TCSCF in order to avoid random quasi orthogonality between the right- and left-eigenvector for the same eigenvalue diff --git a/src/tools/print_sorted_wf_coef.irp.f b/src/tools/print_sorted_wf_coef.irp.f index fa0f1eab..b3c0cb34 100644 --- a/src/tools/print_sorted_wf_coef.irp.f +++ b/src/tools/print_sorted_wf_coef.irp.f @@ -13,7 +13,7 @@ subroutine routine output=trim(ezfio_filename)//'.wf_sorted' i_unit_output = getUnitAndOpen(output,'w') do i= 1, N_det - write(i_unit_output,*)i,dabs(psi_coef_sorted(i,1)) + write(i_unit_output,*)i,dabs(psi_coef_sorted(i,1)),dabs(psi_coef_sorted(i,1)/psi_coef_sorted(1,1)) enddo end From c895000b45d119ba436f9c6e4f1b4f82c37fd673 Mon Sep 17 00:00:00 2001 From: eginer Date: Wed, 25 Oct 2023 19:29:11 +0200 Subject: [PATCH 48/84] beginning to tests mu(r) --- src/tc_keywords/EZFIO.cfg | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tc_keywords/EZFIO.cfg b/src/tc_keywords/EZFIO.cfg index 0c993957..ac2cfda2 100644 --- a/src/tc_keywords/EZFIO.cfg +++ b/src/tc_keywords/EZFIO.cfg @@ -158,19 +158,19 @@ default: 0 type: double precision doc: a parameter used to define mu(r) interface: ezfio, provider, ocaml -default: 6.203504908994001e-1 +default: 1.5 [beta_rho_power] type: double precision doc: a parameter used to define mu(r) interface: ezfio, provider, ocaml -default: 0.5 +default: 0.33333 [zeta_erf_mu_of_r] type: double precision doc: a parameter used to define mu(r) interface: ezfio, provider, ocaml -default: 10. +default: 1. [thr_degen_tc] type: Threshold From 9fc4b6d63bbfa3f91d29a7a8f2c5452cb357bed9 Mon Sep 17 00:00:00 2001 From: Abdallah Ammar Date: Sat, 28 Oct 2023 21:53:04 +0200 Subject: [PATCH 49/84] v0 of tc-dRPA --- .../lapack_diag_non_hermit.irp.f | 12 +- src/tc_bi_ortho/ORBITALS.irp.f | 38 ++++ src/tc_bi_ortho/drpa_matrix.irp.f | 116 +++++++++++ src/tc_bi_ortho/tc_effect_int.irp.f | 39 ++++ src/tc_bi_ortho/tc_rpa.irp.f | 181 ++++++++++++++++++ src/utils/util.irp.f | 19 ++ 6 files changed, 403 insertions(+), 2 deletions(-) create mode 100644 src/tc_bi_ortho/ORBITALS.irp.f create mode 100644 src/tc_bi_ortho/drpa_matrix.irp.f create mode 100644 src/tc_bi_ortho/tc_effect_int.irp.f create mode 100644 src/tc_bi_ortho/tc_rpa.irp.f diff --git a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f b/src/non_hermit_dav/lapack_diag_non_hermit.irp.f index 836bf707..09fcee24 100644 --- a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f +++ b/src/non_hermit_dav/lapack_diag_non_hermit.irp.f @@ -1944,6 +1944,7 @@ subroutine check_orthog(n, m, V, accu_d, accu_nd, S) end subroutine check_orthog ! --- + subroutine reorder_degen_eigvec(n, e0, L0, R0) implicit none @@ -1953,7 +1954,7 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) double precision, intent(inout) :: L0(n,n), R0(n,n) logical :: complex_root - integer :: i, j, k, m + integer :: i, j, k, m, ii double precision :: ei, ej, de, de_thr double precision :: accu_d, accu_nd integer, allocatable :: deg_num(:) @@ -1986,11 +1987,18 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) enddo enddo + ii = 0 do i = 1, n if(deg_num(i) .gt. 1) then print *, ' degen on', i, deg_num(i), e0(i) + ii = ii + 1 endif enddo + if(ii .eq. 0) then + print*, ' WARNING: bi-orthogonality is lost but there is no degeneracies' + print*, ' rotations may change energy' + endif + print *, ii, ' type of degeneracies' ! --- @@ -2013,7 +2021,7 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) print*,'Overlap matrix ' accu_nd = 0.D0 do j = 1, m - write(*,'(100(F16.10,X))')S(1:m,j) + write(*,'(100(F16.10,X))') S(1:m,j) do k = 1, m if(j==k)cycle accu_nd += dabs(S(j,k)) diff --git a/src/tc_bi_ortho/ORBITALS.irp.f b/src/tc_bi_ortho/ORBITALS.irp.f new file mode 100644 index 00000000..fdc4758d --- /dev/null +++ b/src/tc_bi_ortho/ORBITALS.irp.f @@ -0,0 +1,38 @@ + +! --- + + BEGIN_PROVIDER [integer, nC_orb] +&BEGIN_PROVIDER [integer, nO_orb] +&BEGIN_PROVIDER [integer, nV_orb] +&BEGIN_PROVIDER [integer, nR_orb] +&BEGIN_PROVIDER [integer, nS_exc] + + BEGIN_DOC + ! + ! nC_orb = number of core orbitals + ! nO_orb = number of occupied orbitals + ! nV_orb = number of virtual orbitals + ! nR_orb = number of Rydberg orbitals + ! nS_exc = number of single excitation + ! + END_DOC + + implicit none + + nC_orb = 0 + nO_orb = elec_beta_num - nC_orb + nV_orb = mo_num - (nC_orb + nO_orb) + nR_orb = 0 + nS_exc = (nO_orb-nC_orb) * (nV_orb-nR_orb) + + print *, ' nC_orb = ', nC_orb + print *, ' nO_orb = ', nO_orb + print *, ' nV_orb = ', nV_orb + print *, ' nR_orb = ', nR_orb + print *, ' nS_exc = ', nS_exc + +END_PROVIDER + +! --- + + diff --git a/src/tc_bi_ortho/drpa_matrix.irp.f b/src/tc_bi_ortho/drpa_matrix.irp.f new file mode 100644 index 00000000..56891ca2 --- /dev/null +++ b/src/tc_bi_ortho/drpa_matrix.irp.f @@ -0,0 +1,116 @@ + +BEGIN_PROVIDER [double precision, M_RPA, (2*nS_exc, 2*nS_exc)] + + BEGIN_DOC + ! + ! full matrix for direct RPA calculation + ! with the TC-Hamiltonian + ! + END_DOC + + implicit none + integer :: ia, i, a, jb, j, b + double precision :: e(mo_num) + double precision, external :: Kronecker_delta + + PROVIDE mo_tc_effec2e_int + PROVIDE Fock_matrix_tc_diag_mo_tot + + e(1:mo_num) = Fock_matrix_tc_diag_mo_tot(1:mo_num) + + + ! --- --- --- + ! block A + + ia = 0 + do i = nC_orb+1, nO_orb + do a = nO_orb+1, mo_num-nR_orb + ia = ia + 1 + + jb = 0 + do j = nC_orb+1, nO_orb + do b = nO_orb+1, mo_num-nR_orb + jb = jb + 1 + + M_RPA(ia,jb) = (e(a) - e(i)) * Kronecker_delta(i,j) * Kronecker_delta(a,b) + 2.d0 * mo_tc_effec2e_int(a,j,i,b) + enddo + enddo + enddo + enddo + + ! + ! --- --- --- + + + ! --- --- --- + ! block B + + ia = 0 + do i = nC_orb+1, nO_orb + do a = nO_orb+1, mo_num-nR_orb + ia = ia + 1 + + jb = nS_exc + do j = nC_orb+1, nO_orb + do b = nO_orb+1, mo_num-nR_orb + jb = jb + 1 + + M_RPA(ia,jb) = 2.d0 * mo_tc_effec2e_int(a,b,i,j) + enddo + enddo + enddo + enddo + + ! + ! --- --- --- + + + ! --- --- --- + ! block C + + ia = nS_exc + do i = nC_orb+1, nO_orb + do a = nO_orb+1, mo_num-nR_orb + ia = ia + 1 + + jb = 0 + do j = nC_orb+1, nO_orb + do b = nO_orb+1, mo_num-nR_orb + jb = jb + 1 + + M_RPA(ia,jb) = 2.d0 * mo_tc_effec2e_int(i,j,a,b) + enddo + enddo + enddo + enddo + + ! + ! --- --- --- + + + ! --- --- --- + ! block D + + ia = nS_exc + do i = nC_orb+1, nO_orb + do a = nO_orb+1, mo_num-nR_orb + ia = ia + 1 + + jb = nS_exc + do j = nC_orb+1, nO_orb + do b = nO_orb+1, mo_num-nR_orb + jb = jb + 1 + + M_RPA(ia,jb) = (e(a) - e(i)) * Kronecker_delta(i,j) * Kronecker_delta(a,b) + 2.d0 * mo_tc_effec2e_int(i,b,a,j) + enddo + enddo + enddo + enddo + + ! + ! --- --- --- + + +END_PROVIDER + + diff --git a/src/tc_bi_ortho/tc_effect_int.irp.f b/src/tc_bi_ortho/tc_effect_int.irp.f new file mode 100644 index 00000000..48a786d2 --- /dev/null +++ b/src/tc_bi_ortho/tc_effect_int.irp.f @@ -0,0 +1,39 @@ + + +BEGIN_PROVIDER [double precision, mo_tc_effec2e_int, (mo_num, mo_num, mo_num, mo_num)] + + BEGIN_DOC + ! + ! mo_tc_effec2e_int(p,q,s,t) = < p q| V(12) | s t > + \sum_i < p q i | L(123)| s t i > + ! + ! the potential V(12) contains ALL TWO-E CONTRIBUTION OF THE TC-HAMILTONIAN + ! + END_DOC + + implicit none + integer :: i, j, k, l, ii + double precision :: integral + + PROVIDE mo_bi_ortho_tc_two_e_chemist + + do j = 1, mo_num + do i = 1, mo_num + do l = 1, mo_num + do k = 1, mo_num + mo_tc_effec2e_int(k,l,i,j) = mo_bi_ortho_tc_two_e_chemist(k,i,l,j) + + do ii = 1, elec_alpha_num + call give_integrals_3_body_bi_ort(k, l, ii, i, j, ii, integral) + mo_tc_effec2e_int(k,l,i,j) -= 2.d0 * integral + enddo + enddo + enddo + enddo + enddo + + FREE mo_bi_ortho_tc_two_e_chemist + +END_PROVIDER + +! --- + diff --git a/src/tc_bi_ortho/tc_rpa.irp.f b/src/tc_bi_ortho/tc_rpa.irp.f new file mode 100644 index 00000000..c9818a1d --- /dev/null +++ b/src/tc_bi_ortho/tc_rpa.irp.f @@ -0,0 +1,181 @@ +program tc_rpa + + BEGIN_DOC + ! + ! + ! + END_DOC + + my_grid_becke = .True. + PROVIDE tc_grid1_a tc_grid1_r + my_n_pt_r_grid = tc_grid1_r + my_n_pt_a_grid = tc_grid1_a + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + if(j1b_type .ge. 100) then + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + + call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') + call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') + endif + + + call main() + +end + +! --- + +subroutine main() + + implicit none + integer :: i, j, n + integer :: n_good, n_real_eigv + double precision :: thr_cpx, thr_d, thr_nd + double precision :: accu_d, accu_nd + integer, allocatable :: list_good(:), iorder(:) + double precision, allocatable :: WR(:), WI(:), VL(:,:), VR(:,:) + double precision, allocatable :: Omega_p(:), Reigvec_p(:,:), Leigvec_p(:,:) + double precision, allocatable :: Omega_m(:), Reigvec_m(:,:), Leigvec_m(:,:) + double precision, allocatable :: S(:,:) + + PROVIDE M_RPA + + print *, ' ' + print *, ' Computing left/right eigenvectors for TC-RPA ...' + print *, ' ' + + + n = 2 * nS_exc + + thr_cpx = 1d-7 + thr_d = 1d-07 + thr_nd = 1d-07 + + + allocate(WR(n), WI(n), VL(n,n), VR(n,n)) + call lapack_diag_non_sym(n, M_RPA, WR, WI, VL, VR) + FREE M_RPA + + print *, ' excitation energies:' + do i = 1, nS_exc + write(*, '(I3, X, 1000(F16.10,X))') i, WR(i), WI(i) + if(dabs(WI(i)) .gt. thr_cpx) then + print *, ' WARNING ! IMAGINARY EIGENVALUES !!!' + write(*, '(1000(F16.10,X))') WR(i), WI(i+1) + endif + enddo + + print *, ' ' + print *, ' desexcitation energies:' + do i = nS_exc+1, n + write(*, '(I3, X, 1000(F16.10,X))') i, WR(i), WI(i) + if(dabs(WI(i)) .gt. thr_cpx) then + print *, ' WARNING ! IMAGINARY EIGENVALUES !!!' + write(*, '(1000(F16.10,X))') WR(i), WI(i+1) + endif + enddo + + + ! track & sort the real eigenvalues + + n_good = 0 + do i = 1, nS_exc + if(dabs(WI(i)) .lt. thr_cpx) then + if(dabs(WI(nS_exc+i)) .lt. thr_cpx) then + n_good += 1 + endif + endif + enddo + n_real_eigv = n_good + + print *, ' ' + print *, ' nb of real eigenvalues = ', n_real_eigv + print *, ' total nb of eigenvalues = ', nS_exc + + allocate(Omega_p(n_real_eigv), Reigvec_p(n,n_real_eigv), Leigvec_p(n,n_real_eigv)) + allocate(Omega_m(n_real_eigv), Reigvec_m(n,n_real_eigv), Leigvec_m(n,n_real_eigv)) + + n_good = 0 + do i = 1, nS_exc + if(dabs(WI(i)) .lt. thr_cpx) then + if(dabs(WI(nS_exc+i)) .lt. thr_cpx) then + n_good += 1 + + Omega_p(n_good) = WR(i) + do j = 1, n + Reigvec_p(j,n_good) = VR(j,n_good) + Leigvec_p(j,n_good) = VL(j,n_good) + enddo + + Omega_m(n_good) = WR(nS_exc+i) + do j = 1, n + Reigvec_m(j,n_good) = VR(j,nS_exc+n_good) + Leigvec_m(j,n_good) = VL(j,nS_exc+n_good) + enddo + endif + endif + enddo + + deallocate(WR, WI, VL, VR) + + + ! check bi-orthogonality + + ! first block + + allocate(S(n_real_eigv,n_real_eigv)) + + call check_biorthog(n, n_real_eigv, Leigvec_p, Reigvec_p, accu_d, accu_nd, S, thr_d, thr_nd, .false.) + print *, ' accu_d = ', accu_d + print *, ' accu_nd = ', accu_nd + + if((accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .lt. thr_d)) then + print *, ' RPA first-block eigenvectors are normalized and bi-orthogonalized' + else + print *, ' RPA first-block eigenvectors are neither normalized nor bi-orthogonalized' + + call reorder_degen_eigvec(n, Omega_p, Leigvec_p, Reigvec_p) + call impose_biorthog_degen_eigvec(n, Omega_p, Leigvec_p, Reigvec_p) + + call check_biorthog(n, n_real_eigv, Leigvec_p, Reigvec_p, accu_d, accu_nd, S, thr_d, thr_nd, .false.) + if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv)) .gt. thr_d) ) then + call check_biorthog_binormalize(n, n_real_eigv, Leigvec_p, Reigvec_p, thr_d, thr_nd, .true.) + endif + call check_biorthog(n, n_real_eigv, Leigvec_p, Reigvec_p, accu_d, accu_nd, S, thr_d, thr_nd, .true.) + endif + + + ! second block + + call check_biorthog(n, n_real_eigv, Leigvec_m, Reigvec_m, accu_d, accu_nd, S, thr_d, thr_nd, .false.) + print *, ' accu_d = ', accu_d + print *, ' accu_nd = ', accu_nd + + if((accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .lt. thr_d)) then + print *, ' RPA first-block eigenvectors are normalized and bi-orthogonalized' + else + print *, ' RPA first-block eigenvectors are neither normalized nor bi-orthogonalized' + + call reorder_degen_eigvec(n, Omega_m, Leigvec_m, Reigvec_m) + call impose_biorthog_degen_eigvec(n, Omega_m, Leigvec_m, Reigvec_m) + + call check_biorthog(n, n_real_eigv, Leigvec_m, Reigvec_m, accu_d, accu_nd, S, thr_d, thr_nd, .false.) + if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv)) .gt. thr_d) ) then + call check_biorthog_binormalize(n, n_real_eigv, Leigvec_m, Reigvec_m, thr_d, thr_nd, .true.) + endif + call check_biorthog(n, n_real_eigv, Leigvec_m, Reigvec_m, accu_d, accu_nd, S, thr_d, thr_nd, .true.) + endif + + deallocate(S) + + return + +end + +! --- + diff --git a/src/utils/util.irp.f b/src/utils/util.irp.f index ebb13781..785d6539 100644 --- a/src/utils/util.irp.f +++ b/src/utils/util.irp.f @@ -579,5 +579,24 @@ logical function is_same_spin(sigma_1, sigma_2) end function is_same_spin ! --- + +function Kronecker_delta(i, j) result(delta) + BEGIN_DOC + ! Kronecker Delta + END_DOC + + implicit none + integer, intent(in) :: i, j + double precision :: delta + + if(i == j) then + delta = 1.d0 + else + delta = 0.d0 + endif + +end function Kronecker_delta + +! --- From 8ceb5734aa1059e8f73cf17c6451d6ce05651311 Mon Sep 17 00:00:00 2001 From: pfloos Date: Mon, 30 Oct 2023 11:43:03 +0100 Subject: [PATCH 50/84] remove non standard characters --- src/fci_tc_bi/scripts_fci_tc/h2o.sh | 4 ++-- src/tc_bi_ortho/h_mat_triple.irp.f | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fci_tc_bi/scripts_fci_tc/h2o.sh b/src/fci_tc_bi/scripts_fci_tc/h2o.sh index d0afca30..697beeb5 100644 --- a/src/fci_tc_bi/scripts_fci_tc/h2o.sh +++ b/src/fci_tc_bi/scripts_fci_tc/h2o.sh @@ -23,10 +23,10 @@ cd $StartDir ############################################################################ #### EXAMPLE OF SCRIPT TO RUN A CIPSI CALCULATION ON 5 STATES ON THE Ne^+ CATION -#### USING NATURAL ORBITALS OF A SMALL CIPSI AS MOS +#### USING NATURAL ORBITALS OF A SMALL CIPSI AS MOS #### ALL STATES WILL HAVE THE SAME SPIN SIMETRY : A DOUBLET -####### YOU PUT THE PATH TO YOUR +####### YOU PUT THE PATH TO YOUR QP_ROOT=/home_lct/eginer/programs/qp2 source ${QP_ROOT}/quantum_package.rc ####### YOU LOAD SOME LIBRARIES diff --git a/src/tc_bi_ortho/h_mat_triple.irp.f b/src/tc_bi_ortho/h_mat_triple.irp.f index 4c8c107a..6f5697a2 100644 --- a/src/tc_bi_ortho/h_mat_triple.irp.f +++ b/src/tc_bi_ortho/h_mat_triple.irp.f @@ -325,7 +325,7 @@ end subroutine triple_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe, hthree, htot) use bitmasks BEGIN_DOC -! for triple excitation +! for triple excitation !! !! WARNING !! ! From b95c8142a53d514b5199f3b9f9cb18a2a7024fd7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 7 Nov 2023 10:27:34 +0100 Subject: [PATCH 51/84] Moved many modules in plugins/local for quicker installation --- plugins/.gitignore | 1 - {src => plugins/local}/ao_many_one_e_ints/NEED | 0 {src => plugins/local}/ao_many_one_e_ints/README.rst | 0 {src => plugins/local}/ao_many_one_e_ints/ao_erf_gauss.irp.f | 0 .../local}/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/ao_gaus_gauss.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/fit_slat_gauss.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/grad2_jmu_manu.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/grad2_jmu_modif.irp.f | 0 .../local}/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f | 0 .../local}/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f | 0 .../local}/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f | 0 .../local}/ao_many_one_e_ints/grad_related_ints.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/list_grid.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/listj1b.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/listj1b_sorted.irp.f | 0 .../local}/ao_many_one_e_ints/prim_int_erf_gauss.irp.f | 0 .../local}/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/stg_gauss_int.irp.f | 0 {src => plugins/local}/ao_many_one_e_ints/taylor_exp.irp.f | 0 .../local}/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/NEED | 0 {src => plugins/local}/ao_tc_eff_map/README.rst | 0 {src => plugins/local}/ao_tc_eff_map/compute_ints_eff_pot.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/fit_j.irp.f | 0 .../local}/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/map_integrals_eff_pot.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/one_e_1bgauss_lap.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/potential.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/providers_ao_eff_pot.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/two_e_1bgauss_j1.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/two_e_1bgauss_j2.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/two_e_ints_gauss.irp.f | 0 {src => plugins/local}/ao_tc_eff_map/useful_sub.irp.f | 0 {src => plugins/local}/aux_quantities/EZFIO.cfg | 0 {src => plugins/local}/aux_quantities/NEED | 0 {src => plugins/local}/aux_quantities/README.rst | 0 {src => plugins/local}/basis_correction/51.basis_c.bats | 0 {src => plugins/local}/basis_correction/NEED | 0 {src => plugins/local}/basis_correction/README.rst | 0 {src => plugins/local}/basis_correction/TODO | 0 {src => plugins/local}/basis_correction/basis_correction.irp.f | 0 {src => plugins/local}/basis_correction/eff_xi_based_func.irp.f | 0 {src => plugins/local}/basis_correction/pbe_on_top.irp.f | 0 {src => plugins/local}/basis_correction/print_routine.irp.f | 0 {src => plugins/local}/basis_correction/print_su_pbe_ot.irp.f | 0 {src => plugins/local}/basis_correction/weak_corr_func.irp.f | 0 {src => plugins/local}/bi_ort_ints/NEED | 0 {src => plugins/local}/bi_ort_ints/README.rst | 0 {src => plugins/local}/bi_ort_ints/bi_ort_ints.irp.f | 0 {src => plugins/local}/bi_ort_ints/biorthog_mo_for_h.irp.f | 0 {src => plugins/local}/bi_ort_ints/no_dressing.irp.f | 0 {src => plugins/local}/bi_ort_ints/no_dressing_energy.irp.f | 0 {src => plugins/local}/bi_ort_ints/no_dressing_naive.irp.f | 0 {src => plugins/local}/bi_ort_ints/one_e_bi_ort.irp.f | 0 {src => plugins/local}/bi_ort_ints/semi_num_ints_mo.irp.f | 0 {src => plugins/local}/bi_ort_ints/three_body_ijm.irp.f | 0 {src => plugins/local}/bi_ort_ints/three_body_ijmk.irp.f | 0 {src => plugins/local}/bi_ort_ints/three_body_ijmk_n4.irp.f | 0 {src => plugins/local}/bi_ort_ints/three_body_ijmk_old.irp.f | 0 {src => plugins/local}/bi_ort_ints/three_body_ijmkl.irp.f | 0 {src => plugins/local}/bi_ort_ints/three_body_ijmkl_old.irp.f | 0 {src => plugins/local}/bi_ort_ints/three_body_ints_bi_ort.irp.f | 0 {src => plugins/local}/bi_ort_ints/total_twoe_pot.irp.f | 0 {src => plugins/local}/bi_ortho_mos/EZFIO.cfg | 0 {src => plugins/local}/bi_ortho_mos/NEED | 0 {src => plugins/local}/bi_ortho_mos/bi_density.irp.f | 0 {src => plugins/local}/bi_ortho_mos/bi_ort_mos_in_r.irp.f | 0 {src => plugins/local}/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f | 0 {src => plugins/local}/bi_ortho_mos/mos_rl.irp.f | 0 {src => plugins/local}/bi_ortho_mos/overlap.irp.f | 0 {src => plugins/local}/cas_based_on_top/NEED | 0 {src => plugins/local}/cas_based_on_top/README.rst | 0 {src => plugins/local}/cas_based_on_top/c_i_a_v_mos.irp.f | 0 {src => plugins/local}/cas_based_on_top/cas_based_density.irp.f | 0 {src => plugins/local}/cas_based_on_top/cas_based_on_top.irp.f | 0 {src => plugins/local}/cas_based_on_top/cas_dens_prov.irp.f | 0 {src => plugins/local}/cas_based_on_top/cas_dens_rout.irp.f | 0 {src => plugins/local}/cas_based_on_top/cas_one_e_rdm.irp.f | 0 {src => plugins/local}/cas_based_on_top/eff_spin_dens.irp.f | 0 {src => plugins/local}/cas_based_on_top/example.irp.f | 0 {src => plugins/local}/cas_based_on_top/on_top_cas_prov.irp.f | 0 {src => plugins/local}/cas_based_on_top/on_top_cas_rout.irp.f | 0 {src => plugins/local}/cas_based_on_top/on_top_grad.irp.f | 0 {src => plugins/local}/cas_based_on_top/two_body_dens_rout.irp.f | 0 {src => plugins/local}/casscf_tc_bi/NEED | 0 {src => plugins/local}/casscf_tc_bi/det_manip.irp.f | 0 {src => plugins/local}/casscf_tc_bi/grad_dm.irp.f | 0 {src => plugins/local}/casscf_tc_bi/grad_old.irp.f | 0 {src => plugins/local}/casscf_tc_bi/gradient.irp.f | 0 {src => plugins/local}/casscf_tc_bi/test_tc_casscf.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/EZFIO.cfg | 0 {src => plugins/local}/cipsi_tc_bi_ortho/NEED | 0 {src => plugins/local}/cipsi_tc_bi_ortho/cipsi.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/energy.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/environment.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/fock_diag.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/get_d.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/get_d0_good.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/get_d1_good.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/get_d2_good.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/lock_2rdm.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/pouet | 0 {src => plugins/local}/cipsi_tc_bi_ortho/pt2.irp.f | 0 .../local}/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/pt2_type.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/run_pt2_slave.irp.f | 0 .../local}/cipsi_tc_bi_ortho/run_selection_slave.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/selection.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/selection_buffer.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/selection_types.f90 | 0 {src => plugins/local}/cipsi_tc_bi_ortho/selection_weight.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/slave_cipsi.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/write_cipsi_json.irp.f | 0 {src => plugins/local}/cipsi_tc_bi_ortho/zmq_selection.irp.f | 0 {src => plugins/local}/fci_tc_bi/13.fci_tc_bi_ortho.bats | 0 {src => plugins/local}/fci_tc_bi/EZFIO.cfg | 0 {src => plugins/local}/fci_tc_bi/NEED | 0 {src => plugins/local}/fci_tc_bi/class.irp.f | 0 {src => plugins/local}/fci_tc_bi/copy_wf.irp.f | 0 {src => plugins/local}/fci_tc_bi/diagonalize_ci.irp.f | 0 {src => plugins/local}/fci_tc_bi/fci_tc_bi_ortho.irp.f | 0 {src => plugins/local}/fci_tc_bi/generators.irp.f | 0 {src => plugins/local}/fci_tc_bi/pt2_tc.irp.f | 0 {src => plugins/local}/fci_tc_bi/save_energy.irp.f | 0 {src => plugins/local}/fci_tc_bi/scripts_fci_tc/CH2.xyz | 0 {src => plugins/local}/fci_tc_bi/scripts_fci_tc/FH.xyz | 0 .../local}/fci_tc_bi/scripts_fci_tc/extract_tables.sh | 0 {src => plugins/local}/fci_tc_bi/scripts_fci_tc/h2o.sh | 0 {src => plugins/local}/fci_tc_bi/scripts_fci_tc/h2o.xyz | 0 {src => plugins/local}/fci_tc_bi/scripts_fci_tc/script.sh | 0 {src => plugins/local}/fci_tc_bi/selectors.irp.f | 0 {src => plugins/local}/fci_tc_bi/zmq.irp.f | 0 {src => plugins/local}/jastrow/EZFIO.cfg | 0 {src => plugins/local}/jastrow/NEED | 0 {src => plugins/local}/jastrow/README.md | 0 {src => plugins/local}/mo_localization/84.mo_localization.bats | 0 {src => plugins/local}/mo_localization/EZFIO.cfg | 0 {src => plugins/local}/mo_localization/NEED | 0 {src => plugins/local}/mo_localization/README.md | 0 {src => plugins/local}/mo_localization/break_spatial_sym.irp.f | 0 {src => plugins/local}/mo_localization/debug_gradient_loc.irp.f | 0 {src => plugins/local}/mo_localization/debug_hessian_loc.irp.f | 0 {src => plugins/local}/mo_localization/kick_the_mos.irp.f | 0 {src => plugins/local}/mo_localization/localization.irp.f | 0 {src => plugins/local}/mo_localization/localization_sub.irp.f | 0 {src => plugins/local}/mo_localization/org/TANGLE_org_mode.sh | 0 {src => plugins/local}/mo_localization/org/break_spatial_sym.org | 0 .../local}/mo_localization/org/debug_gradient_loc.org | 0 {src => plugins/local}/mo_localization/org/debug_hessian_loc.org | 0 {src => plugins/local}/mo_localization/org/kick_the_mos.org | 0 {src => plugins/local}/mo_localization/org/localization.org | 0 {src => plugins/local}/mu_of_r/EZFIO.cfg | 0 {src => plugins/local}/mu_of_r/NEED | 0 {src => plugins/local}/mu_of_r/README.rst | 0 {src => plugins/local}/mu_of_r/basis_def.irp.f | 0 {src => plugins/local}/mu_of_r/example.irp.f | 0 {src => plugins/local}/mu_of_r/f_hf_utils.irp.f | 0 {src => plugins/local}/mu_of_r/f_psi_i_a_v_utils.irp.f | 0 {src => plugins/local}/mu_of_r/f_psi_old.irp.f | 0 {src => plugins/local}/mu_of_r/f_psi_utils.irp.f | 0 {src => plugins/local}/mu_of_r/f_val_general.irp.f | 0 {src => plugins/local}/mu_of_r/mu_of_r_conditions.irp.f | 0 {src => plugins/local}/mu_of_r/test_proj_op.irp.f | 0 {src => plugins/local}/non_h_ints_mu/NEED | 0 {src => plugins/local}/non_h_ints_mu/README.rst | 0 {src => plugins/local}/non_h_ints_mu/debug_fit.irp.f | 0 {src => plugins/local}/non_h_ints_mu/debug_integ_jmu_modif.irp.f | 0 {src => plugins/local}/non_h_ints_mu/grad_squared.irp.f | 0 {src => plugins/local}/non_h_ints_mu/grad_squared_manu.irp.f | 0 {src => plugins/local}/non_h_ints_mu/grad_tc_int.irp.f | 0 {src => plugins/local}/non_h_ints_mu/j12_nucl_utils.irp.f | 0 {src => plugins/local}/non_h_ints_mu/jast_deriv.irp.f | 0 {src => plugins/local}/non_h_ints_mu/jast_deriv_utils.irp.f | 0 {src => plugins/local}/non_h_ints_mu/jast_deriv_utils_vect.irp.f | 0 {src => plugins/local}/non_h_ints_mu/new_grad_tc.irp.f | 0 {src => plugins/local}/non_h_ints_mu/new_grad_tc_manu.irp.f | 0 {src => plugins/local}/non_h_ints_mu/numerical_integ.irp.f | 0 {src => plugins/local}/non_h_ints_mu/plot_mu_of_r.irp.f | 0 {src => plugins/local}/non_h_ints_mu/qmckl.irp.f | 0 {src => plugins/local}/non_h_ints_mu/tc_integ_an.irp.f | 0 {src => plugins/local}/non_h_ints_mu/tc_integ_num.irp.f | 0 {src => plugins/local}/non_h_ints_mu/test_non_h_ints.irp.f | 0 {src => plugins/local}/non_h_ints_mu/total_tc_int.irp.f | 0 {src => plugins/local}/non_hermit_dav/NEED | 0 {src => plugins/local}/non_hermit_dav/biorthog.irp.f | 0 {src => plugins/local}/non_hermit_dav/gram_schmit.irp.f | 0 {src => plugins/local}/non_hermit_dav/htilde_mat.irp.f | 0 .../local}/non_hermit_dav/lapack_diag_non_hermit.irp.f | 0 {src => plugins/local}/non_hermit_dav/new_routines.irp.f | 0 {src => plugins/local}/non_hermit_dav/project.irp.f | 0 {src => plugins/local}/non_hermit_dav/utils.irp.f | 0 {src => plugins/local}/ortho_three_e_ints/NEED | 0 .../local}/ortho_three_e_ints/io_6_index_tensor.irp.f | 0 .../local}/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f | 0 {src => plugins/local}/tc_bi_ortho/31.tc_bi_ortho.bats | 0 {src => plugins/local}/tc_bi_ortho/EZFIO.cfg | 0 {src => plugins/local}/tc_bi_ortho/NEED | 0 {src => plugins/local}/tc_bi_ortho/compute_deltamu_right.irp.f | 0 {src => plugins/local}/tc_bi_ortho/dav_h_tc_s2.irp.f | 0 {src => plugins/local}/tc_bi_ortho/dressing_vectors_lr.irp.f | 0 {src => plugins/local}/tc_bi_ortho/e_corr_bi_ortho.irp.f | 0 {src => plugins/local}/tc_bi_ortho/h_biortho.irp.f | 0 {src => plugins/local}/tc_bi_ortho/h_mat_triple.irp.f | 0 {src => plugins/local}/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f | 0 {src => plugins/local}/tc_bi_ortho/h_tc_s2_u0.irp.f | 0 {src => plugins/local}/tc_bi_ortho/h_tc_u0.irp.f | 0 {src => plugins/local}/tc_bi_ortho/normal_ordered.irp.f | 0 .../local}/tc_bi_ortho/normal_ordered_contractions.irp.f | 0 {src => plugins/local}/tc_bi_ortho/normal_ordered_old.irp.f | 0 {src => plugins/local}/tc_bi_ortho/normal_ordered_v0.irp.f | 0 {src => plugins/local}/tc_bi_ortho/print_he_tc_energy.irp.f | 0 {src => plugins/local}/tc_bi_ortho/print_tc_dump.irp.f | 0 {src => plugins/local}/tc_bi_ortho/print_tc_energy.irp.f | 0 {src => plugins/local}/tc_bi_ortho/print_tc_spin_dens.irp.f | 0 {src => plugins/local}/tc_bi_ortho/print_tc_var.irp.f | 0 {src => plugins/local}/tc_bi_ortho/print_tc_wf.irp.f | 0 {src => plugins/local}/tc_bi_ortho/psi_det_tc_sorted.irp.f | 0 {src => plugins/local}/tc_bi_ortho/psi_left_qmc.irp.f | 0 {src => plugins/local}/tc_bi_ortho/psi_r_l_prov.irp.f | 0 {src => plugins/local}/tc_bi_ortho/pt2_tc_cisd.irp.f | 0 .../local}/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f | 0 {src => plugins/local}/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f | 0 {src => plugins/local}/tc_bi_ortho/select_dets_bi_ortho.irp.f | 0 {src => plugins/local}/tc_bi_ortho/slater_tc_3e_slow.irp.f | 0 {src => plugins/local}/tc_bi_ortho/slater_tc_opt.irp.f | 0 {src => plugins/local}/tc_bi_ortho/slater_tc_opt_diag.irp.f | 0 {src => plugins/local}/tc_bi_ortho/slater_tc_opt_double.irp.f | 0 {src => plugins/local}/tc_bi_ortho/slater_tc_opt_single.irp.f | 0 {src => plugins/local}/tc_bi_ortho/slater_tc_slow.irp.f | 0 {src => plugins/local}/tc_bi_ortho/spin_mulliken.irp.f | 0 {src => plugins/local}/tc_bi_ortho/symmetrized_3_e_int.irp.f | 0 .../local}/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_bi_ortho.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_bi_ortho_prop.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_cisd_sc2.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_cisd_sc2_utils.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_h_eigvectors.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_hmat.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_natorb.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_prop.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_som.irp.f | 0 {src => plugins/local}/tc_bi_ortho/tc_utils.irp.f | 0 {src => plugins/local}/tc_bi_ortho/test_natorb.irp.f | 0 {src => plugins/local}/tc_bi_ortho/test_normal_order.irp.f | 0 {src => plugins/local}/tc_bi_ortho/test_s2_tc.irp.f | 0 {src => plugins/local}/tc_bi_ortho/test_spin_dens.irp.f | 0 {src => plugins/local}/tc_bi_ortho/test_tc_bi_ortho.irp.f | 0 {src => plugins/local}/tc_bi_ortho/test_tc_fock.irp.f | 0 {src => plugins/local}/tc_bi_ortho/test_tc_two_rdm.irp.f | 0 {src => plugins/local}/tc_bi_ortho/two_rdm_naive.irp.f | 0 {src => plugins/local}/tc_keywords/EZFIO.cfg | 0 {src => plugins/local}/tc_keywords/NEED | 0 {src => plugins/local}/tc_keywords/j1b_pen.irp.f | 0 {src => plugins/local}/tc_keywords/tc_keywords.irp.f | 0 {src => plugins/local}/tc_scf/11.tc_scf.bats | 0 {src => plugins/local}/tc_scf/EZFIO.cfg | 0 {src => plugins/local}/tc_scf/NEED | 0 {src => plugins/local}/tc_scf/combine_lr_tcscf.irp.f | 0 {src => plugins/local}/tc_scf/diago_bi_ort_tcfock.irp.f | 0 {src => plugins/local}/tc_scf/diago_vartcfock.irp.f | 0 {src => plugins/local}/tc_scf/diis_tcscf.irp.f | 0 {src => plugins/local}/tc_scf/fock_3e_bi_ortho_cs.irp.f | 0 {src => plugins/local}/tc_scf/fock_3e_bi_ortho_os.irp.f | 0 {src => plugins/local}/tc_scf/fock_3e_bi_ortho_uhf.irp.f | 0 {src => plugins/local}/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f | 0 {src => plugins/local}/tc_scf/fock_hermit.irp.f | 0 {src => plugins/local}/tc_scf/fock_tc.irp.f | 0 {src => plugins/local}/tc_scf/fock_tc_mo_tot.irp.f | 0 {src => plugins/local}/tc_scf/fock_three_bi_ortho.irp.f | 0 {src => plugins/local}/tc_scf/fock_three_hermit.irp.f | 0 {src => plugins/local}/tc_scf/fock_vartc.irp.f | 0 {src => plugins/local}/tc_scf/integrals_in_r_stuff.irp.f | 0 {src => plugins/local}/tc_scf/minimize_tc_angles.irp.f | 0 {src => plugins/local}/tc_scf/molden_lr_mos.irp.f | 0 {src => plugins/local}/tc_scf/print_fit_param.irp.f | 0 {src => plugins/local}/tc_scf/print_tcscf_energy.irp.f | 0 {src => plugins/local}/tc_scf/rh_tcscf_diis.irp.f | 0 {src => plugins/local}/tc_scf/rh_tcscf_simple.irp.f | 0 {src => plugins/local}/tc_scf/rh_vartcscf_simple.irp.f | 0 {src => plugins/local}/tc_scf/rotate_tcscf_orbitals.irp.f | 0 {src => plugins/local}/tc_scf/routines_rotates.irp.f | 0 {src => plugins/local}/tc_scf/tc_petermann_factor.irp.f | 0 {src => plugins/local}/tc_scf/tc_scf.irp.f | 0 {src => plugins/local}/tc_scf/tc_scf_dm.irp.f | 0 {src => plugins/local}/tc_scf/tc_scf_energy.irp.f | 0 {src => plugins/local}/tc_scf/tcscf_energy_naive.irp.f | 0 {src => plugins/local}/tc_scf/test_int.irp.f | 0 {src => plugins/local}/tc_scf/three_e_energy_bi_ortho.irp.f | 0 {src => plugins/local}/utils_trust_region/EZFIO.cfg | 0 {src => plugins/local}/utils_trust_region/NEED | 0 {src => plugins/local}/utils_trust_region/README.md | 0 {src => plugins/local}/utils_trust_region/algo_trust.irp.f | 0 .../local}/utils_trust_region/apply_mo_rotation.irp.f | 0 {src => plugins/local}/utils_trust_region/mat_to_vec_index.irp.f | 0 {src => plugins/local}/utils_trust_region/org/TANGLE_org_mode.sh | 0 {src => plugins/local}/utils_trust_region/org/algo_trust.org | 0 .../local}/utils_trust_region/org/apply_mo_rotation.org | 0 .../local}/utils_trust_region/org/mat_to_vec_index.org | 0 .../local}/utils_trust_region/org/rotation_matrix.org | 0 .../local}/utils_trust_region/org/rotation_matrix_iterative.org | 0 .../utils_trust_region/org/sub_to_full_rotation_matrix.org | 0 .../local}/utils_trust_region/org/trust_region_expected_e.org | 0 .../utils_trust_region/org/trust_region_optimal_lambda.org | 0 .../local}/utils_trust_region/org/trust_region_rho.org | 0 .../local}/utils_trust_region/org/trust_region_step.org | 0 .../local}/utils_trust_region/org/vec_to_mat_index.org | 0 {src => plugins/local}/utils_trust_region/org/vec_to_mat_v2.org | 0 {src => plugins/local}/utils_trust_region/pi.h | 0 {src => plugins/local}/utils_trust_region/rotation_matrix.irp.f | 0 .../local}/utils_trust_region/rotation_matrix_iterative.irp.f | 0 .../local}/utils_trust_region/sub_to_full_rotation_matrix.irp.f | 0 .../local}/utils_trust_region/trust_region_expected_e.irp.f | 0 .../local}/utils_trust_region/trust_region_optimal_lambda.irp.f | 0 {src => plugins/local}/utils_trust_region/trust_region_rho.irp.f | 0 .../local}/utils_trust_region/trust_region_step.irp.f | 0 {src => plugins/local}/utils_trust_region/vec_to_mat_index.irp.f | 0 {src => plugins/local}/utils_trust_region/vec_to_mat_v2.irp.f | 0 321 files changed, 1 deletion(-) rename {src => plugins/local}/ao_many_one_e_ints/NEED (100%) rename {src => plugins/local}/ao_many_one_e_ints/README.rst (100%) rename {src => plugins/local}/ao_many_one_e_ints/ao_erf_gauss.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/ao_gaus_gauss.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/fit_slat_gauss.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/grad2_jmu_manu.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/grad2_jmu_modif.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/grad_related_ints.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/list_grid.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/listj1b.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/listj1b_sorted.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/prim_int_erf_gauss.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/stg_gauss_int.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/taylor_exp.irp.f (100%) rename {src => plugins/local}/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/NEED (100%) rename {src => plugins/local}/ao_tc_eff_map/README.rst (100%) rename {src => plugins/local}/ao_tc_eff_map/compute_ints_eff_pot.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/fit_j.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/map_integrals_eff_pot.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/one_e_1bgauss_lap.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/potential.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/providers_ao_eff_pot.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/two_e_1bgauss_j1.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/two_e_1bgauss_j2.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/two_e_ints_gauss.irp.f (100%) rename {src => plugins/local}/ao_tc_eff_map/useful_sub.irp.f (100%) rename {src => plugins/local}/aux_quantities/EZFIO.cfg (100%) rename {src => plugins/local}/aux_quantities/NEED (100%) rename {src => plugins/local}/aux_quantities/README.rst (100%) rename {src => plugins/local}/basis_correction/51.basis_c.bats (100%) rename {src => plugins/local}/basis_correction/NEED (100%) rename {src => plugins/local}/basis_correction/README.rst (100%) rename {src => plugins/local}/basis_correction/TODO (100%) rename {src => plugins/local}/basis_correction/basis_correction.irp.f (100%) rename {src => plugins/local}/basis_correction/eff_xi_based_func.irp.f (100%) rename {src => plugins/local}/basis_correction/pbe_on_top.irp.f (100%) rename {src => plugins/local}/basis_correction/print_routine.irp.f (100%) rename {src => plugins/local}/basis_correction/print_su_pbe_ot.irp.f (100%) rename {src => plugins/local}/basis_correction/weak_corr_func.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/NEED (100%) rename {src => plugins/local}/bi_ort_ints/README.rst (100%) rename {src => plugins/local}/bi_ort_ints/bi_ort_ints.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/biorthog_mo_for_h.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/no_dressing.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/no_dressing_energy.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/no_dressing_naive.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/one_e_bi_ort.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/semi_num_ints_mo.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/three_body_ijm.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/three_body_ijmk.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/three_body_ijmk_n4.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/three_body_ijmk_old.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/three_body_ijmkl.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/three_body_ijmkl_old.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/three_body_ints_bi_ort.irp.f (100%) rename {src => plugins/local}/bi_ort_ints/total_twoe_pot.irp.f (100%) rename {src => plugins/local}/bi_ortho_mos/EZFIO.cfg (100%) rename {src => plugins/local}/bi_ortho_mos/NEED (100%) rename {src => plugins/local}/bi_ortho_mos/bi_density.irp.f (100%) rename {src => plugins/local}/bi_ortho_mos/bi_ort_mos_in_r.irp.f (100%) rename {src => plugins/local}/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f (100%) rename {src => plugins/local}/bi_ortho_mos/mos_rl.irp.f (100%) rename {src => plugins/local}/bi_ortho_mos/overlap.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/NEED (100%) rename {src => plugins/local}/cas_based_on_top/README.rst (100%) rename {src => plugins/local}/cas_based_on_top/c_i_a_v_mos.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/cas_based_density.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/cas_based_on_top.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/cas_dens_prov.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/cas_dens_rout.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/cas_one_e_rdm.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/eff_spin_dens.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/example.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/on_top_cas_prov.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/on_top_cas_rout.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/on_top_grad.irp.f (100%) rename {src => plugins/local}/cas_based_on_top/two_body_dens_rout.irp.f (100%) rename {src => plugins/local}/casscf_tc_bi/NEED (100%) rename {src => plugins/local}/casscf_tc_bi/det_manip.irp.f (100%) rename {src => plugins/local}/casscf_tc_bi/grad_dm.irp.f (100%) rename {src => plugins/local}/casscf_tc_bi/grad_old.irp.f (100%) rename {src => plugins/local}/casscf_tc_bi/gradient.irp.f (100%) rename {src => plugins/local}/casscf_tc_bi/test_tc_casscf.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/EZFIO.cfg (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/NEED (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/cipsi.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/energy.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/environment.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/fock_diag.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/get_d.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/get_d0_good.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/get_d1_good.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/get_d2_good.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/lock_2rdm.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/pouet (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/pt2.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/pt2_type.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/run_pt2_slave.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/run_selection_slave.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/selection.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/selection_buffer.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/selection_types.f90 (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/selection_weight.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/slave_cipsi.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/write_cipsi_json.irp.f (100%) rename {src => plugins/local}/cipsi_tc_bi_ortho/zmq_selection.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/13.fci_tc_bi_ortho.bats (100%) rename {src => plugins/local}/fci_tc_bi/EZFIO.cfg (100%) rename {src => plugins/local}/fci_tc_bi/NEED (100%) rename {src => plugins/local}/fci_tc_bi/class.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/copy_wf.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/diagonalize_ci.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/fci_tc_bi_ortho.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/generators.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/pt2_tc.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/save_energy.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/scripts_fci_tc/CH2.xyz (100%) rename {src => plugins/local}/fci_tc_bi/scripts_fci_tc/FH.xyz (100%) rename {src => plugins/local}/fci_tc_bi/scripts_fci_tc/extract_tables.sh (100%) rename {src => plugins/local}/fci_tc_bi/scripts_fci_tc/h2o.sh (100%) rename {src => plugins/local}/fci_tc_bi/scripts_fci_tc/h2o.xyz (100%) rename {src => plugins/local}/fci_tc_bi/scripts_fci_tc/script.sh (100%) rename {src => plugins/local}/fci_tc_bi/selectors.irp.f (100%) rename {src => plugins/local}/fci_tc_bi/zmq.irp.f (100%) rename {src => plugins/local}/jastrow/EZFIO.cfg (100%) rename {src => plugins/local}/jastrow/NEED (100%) rename {src => plugins/local}/jastrow/README.md (100%) rename {src => plugins/local}/mo_localization/84.mo_localization.bats (100%) rename {src => plugins/local}/mo_localization/EZFIO.cfg (100%) rename {src => plugins/local}/mo_localization/NEED (100%) rename {src => plugins/local}/mo_localization/README.md (100%) rename {src => plugins/local}/mo_localization/break_spatial_sym.irp.f (100%) rename {src => plugins/local}/mo_localization/debug_gradient_loc.irp.f (100%) rename {src => plugins/local}/mo_localization/debug_hessian_loc.irp.f (100%) rename {src => plugins/local}/mo_localization/kick_the_mos.irp.f (100%) rename {src => plugins/local}/mo_localization/localization.irp.f (100%) rename {src => plugins/local}/mo_localization/localization_sub.irp.f (100%) rename {src => plugins/local}/mo_localization/org/TANGLE_org_mode.sh (100%) rename {src => plugins/local}/mo_localization/org/break_spatial_sym.org (100%) rename {src => plugins/local}/mo_localization/org/debug_gradient_loc.org (100%) rename {src => plugins/local}/mo_localization/org/debug_hessian_loc.org (100%) rename {src => plugins/local}/mo_localization/org/kick_the_mos.org (100%) rename {src => plugins/local}/mo_localization/org/localization.org (100%) rename {src => plugins/local}/mu_of_r/EZFIO.cfg (100%) rename {src => plugins/local}/mu_of_r/NEED (100%) rename {src => plugins/local}/mu_of_r/README.rst (100%) rename {src => plugins/local}/mu_of_r/basis_def.irp.f (100%) rename {src => plugins/local}/mu_of_r/example.irp.f (100%) rename {src => plugins/local}/mu_of_r/f_hf_utils.irp.f (100%) rename {src => plugins/local}/mu_of_r/f_psi_i_a_v_utils.irp.f (100%) rename {src => plugins/local}/mu_of_r/f_psi_old.irp.f (100%) rename {src => plugins/local}/mu_of_r/f_psi_utils.irp.f (100%) rename {src => plugins/local}/mu_of_r/f_val_general.irp.f (100%) rename {src => plugins/local}/mu_of_r/mu_of_r_conditions.irp.f (100%) rename {src => plugins/local}/mu_of_r/test_proj_op.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/NEED (100%) rename {src => plugins/local}/non_h_ints_mu/README.rst (100%) rename {src => plugins/local}/non_h_ints_mu/debug_fit.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/debug_integ_jmu_modif.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/grad_squared.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/grad_squared_manu.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/grad_tc_int.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/j12_nucl_utils.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/jast_deriv.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/jast_deriv_utils.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/jast_deriv_utils_vect.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/new_grad_tc.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/new_grad_tc_manu.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/numerical_integ.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/plot_mu_of_r.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/qmckl.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/tc_integ_an.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/tc_integ_num.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/test_non_h_ints.irp.f (100%) rename {src => plugins/local}/non_h_ints_mu/total_tc_int.irp.f (100%) rename {src => plugins/local}/non_hermit_dav/NEED (100%) rename {src => plugins/local}/non_hermit_dav/biorthog.irp.f (100%) rename {src => plugins/local}/non_hermit_dav/gram_schmit.irp.f (100%) rename {src => plugins/local}/non_hermit_dav/htilde_mat.irp.f (100%) rename {src => plugins/local}/non_hermit_dav/lapack_diag_non_hermit.irp.f (100%) rename {src => plugins/local}/non_hermit_dav/new_routines.irp.f (100%) rename {src => plugins/local}/non_hermit_dav/project.irp.f (100%) rename {src => plugins/local}/non_hermit_dav/utils.irp.f (100%) rename {src => plugins/local}/ortho_three_e_ints/NEED (100%) rename {src => plugins/local}/ortho_three_e_ints/io_6_index_tensor.irp.f (100%) rename {src => plugins/local}/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/31.tc_bi_ortho.bats (100%) rename {src => plugins/local}/tc_bi_ortho/EZFIO.cfg (100%) rename {src => plugins/local}/tc_bi_ortho/NEED (100%) rename {src => plugins/local}/tc_bi_ortho/compute_deltamu_right.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/dav_h_tc_s2.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/dressing_vectors_lr.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/e_corr_bi_ortho.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/h_biortho.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/h_mat_triple.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/h_tc_s2_u0.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/h_tc_u0.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/normal_ordered.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/normal_ordered_contractions.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/normal_ordered_old.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/normal_ordered_v0.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/print_he_tc_energy.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/print_tc_dump.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/print_tc_energy.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/print_tc_spin_dens.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/print_tc_var.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/print_tc_wf.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/psi_det_tc_sorted.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/psi_left_qmc.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/psi_r_l_prov.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/pt2_tc_cisd.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/select_dets_bi_ortho.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/slater_tc_3e_slow.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/slater_tc_opt.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/slater_tc_opt_diag.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/slater_tc_opt_double.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/slater_tc_opt_single.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/slater_tc_slow.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/spin_mulliken.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/symmetrized_3_e_int.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_bi_ortho.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_bi_ortho_prop.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_cisd_sc2.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_cisd_sc2_utils.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_h_eigvectors.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_hmat.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_natorb.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_prop.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_som.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/tc_utils.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/test_natorb.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/test_normal_order.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/test_s2_tc.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/test_spin_dens.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/test_tc_bi_ortho.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/test_tc_fock.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/test_tc_two_rdm.irp.f (100%) rename {src => plugins/local}/tc_bi_ortho/two_rdm_naive.irp.f (100%) rename {src => plugins/local}/tc_keywords/EZFIO.cfg (100%) rename {src => plugins/local}/tc_keywords/NEED (100%) rename {src => plugins/local}/tc_keywords/j1b_pen.irp.f (100%) rename {src => plugins/local}/tc_keywords/tc_keywords.irp.f (100%) rename {src => plugins/local}/tc_scf/11.tc_scf.bats (100%) rename {src => plugins/local}/tc_scf/EZFIO.cfg (100%) rename {src => plugins/local}/tc_scf/NEED (100%) rename {src => plugins/local}/tc_scf/combine_lr_tcscf.irp.f (100%) rename {src => plugins/local}/tc_scf/diago_bi_ort_tcfock.irp.f (100%) rename {src => plugins/local}/tc_scf/diago_vartcfock.irp.f (100%) rename {src => plugins/local}/tc_scf/diis_tcscf.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_3e_bi_ortho_cs.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_3e_bi_ortho_os.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_3e_bi_ortho_uhf.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_hermit.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_tc.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_tc_mo_tot.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_three_bi_ortho.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_three_hermit.irp.f (100%) rename {src => plugins/local}/tc_scf/fock_vartc.irp.f (100%) rename {src => plugins/local}/tc_scf/integrals_in_r_stuff.irp.f (100%) rename {src => plugins/local}/tc_scf/minimize_tc_angles.irp.f (100%) rename {src => plugins/local}/tc_scf/molden_lr_mos.irp.f (100%) rename {src => plugins/local}/tc_scf/print_fit_param.irp.f (100%) rename {src => plugins/local}/tc_scf/print_tcscf_energy.irp.f (100%) rename {src => plugins/local}/tc_scf/rh_tcscf_diis.irp.f (100%) rename {src => plugins/local}/tc_scf/rh_tcscf_simple.irp.f (100%) rename {src => plugins/local}/tc_scf/rh_vartcscf_simple.irp.f (100%) rename {src => plugins/local}/tc_scf/rotate_tcscf_orbitals.irp.f (100%) rename {src => plugins/local}/tc_scf/routines_rotates.irp.f (100%) rename {src => plugins/local}/tc_scf/tc_petermann_factor.irp.f (100%) rename {src => plugins/local}/tc_scf/tc_scf.irp.f (100%) rename {src => plugins/local}/tc_scf/tc_scf_dm.irp.f (100%) rename {src => plugins/local}/tc_scf/tc_scf_energy.irp.f (100%) rename {src => plugins/local}/tc_scf/tcscf_energy_naive.irp.f (100%) rename {src => plugins/local}/tc_scf/test_int.irp.f (100%) rename {src => plugins/local}/tc_scf/three_e_energy_bi_ortho.irp.f (100%) rename {src => plugins/local}/utils_trust_region/EZFIO.cfg (100%) rename {src => plugins/local}/utils_trust_region/NEED (100%) rename {src => plugins/local}/utils_trust_region/README.md (100%) rename {src => plugins/local}/utils_trust_region/algo_trust.irp.f (100%) rename {src => plugins/local}/utils_trust_region/apply_mo_rotation.irp.f (100%) rename {src => plugins/local}/utils_trust_region/mat_to_vec_index.irp.f (100%) rename {src => plugins/local}/utils_trust_region/org/TANGLE_org_mode.sh (100%) rename {src => plugins/local}/utils_trust_region/org/algo_trust.org (100%) rename {src => plugins/local}/utils_trust_region/org/apply_mo_rotation.org (100%) rename {src => plugins/local}/utils_trust_region/org/mat_to_vec_index.org (100%) rename {src => plugins/local}/utils_trust_region/org/rotation_matrix.org (100%) rename {src => plugins/local}/utils_trust_region/org/rotation_matrix_iterative.org (100%) rename {src => plugins/local}/utils_trust_region/org/sub_to_full_rotation_matrix.org (100%) rename {src => plugins/local}/utils_trust_region/org/trust_region_expected_e.org (100%) rename {src => plugins/local}/utils_trust_region/org/trust_region_optimal_lambda.org (100%) rename {src => plugins/local}/utils_trust_region/org/trust_region_rho.org (100%) rename {src => plugins/local}/utils_trust_region/org/trust_region_step.org (100%) rename {src => plugins/local}/utils_trust_region/org/vec_to_mat_index.org (100%) rename {src => plugins/local}/utils_trust_region/org/vec_to_mat_v2.org (100%) rename {src => plugins/local}/utils_trust_region/pi.h (100%) rename {src => plugins/local}/utils_trust_region/rotation_matrix.irp.f (100%) rename {src => plugins/local}/utils_trust_region/rotation_matrix_iterative.irp.f (100%) rename {src => plugins/local}/utils_trust_region/sub_to_full_rotation_matrix.irp.f (100%) rename {src => plugins/local}/utils_trust_region/trust_region_expected_e.irp.f (100%) rename {src => plugins/local}/utils_trust_region/trust_region_optimal_lambda.irp.f (100%) rename {src => plugins/local}/utils_trust_region/trust_region_rho.irp.f (100%) rename {src => plugins/local}/utils_trust_region/trust_region_step.irp.f (100%) rename {src => plugins/local}/utils_trust_region/vec_to_mat_index.irp.f (100%) rename {src => plugins/local}/utils_trust_region/vec_to_mat_v2.irp.f (100%) diff --git a/plugins/.gitignore b/plugins/.gitignore index 241e560d..8b137891 100644 --- a/plugins/.gitignore +++ b/plugins/.gitignore @@ -1,2 +1 @@ -* diff --git a/src/ao_many_one_e_ints/NEED b/plugins/local/ao_many_one_e_ints/NEED similarity index 100% rename from src/ao_many_one_e_ints/NEED rename to plugins/local/ao_many_one_e_ints/NEED diff --git a/src/ao_many_one_e_ints/README.rst b/plugins/local/ao_many_one_e_ints/README.rst similarity index 100% rename from src/ao_many_one_e_ints/README.rst rename to plugins/local/ao_many_one_e_ints/README.rst diff --git a/src/ao_many_one_e_ints/ao_erf_gauss.irp.f b/plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f similarity index 100% rename from src/ao_many_one_e_ints/ao_erf_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f diff --git a/src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f b/plugins/local/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f similarity index 100% rename from src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f rename to plugins/local/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f diff --git a/src/ao_many_one_e_ints/ao_gaus_gauss.irp.f b/plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f similarity index 100% rename from src/ao_many_one_e_ints/ao_gaus_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f diff --git a/src/ao_many_one_e_ints/fit_slat_gauss.irp.f b/plugins/local/ao_many_one_e_ints/fit_slat_gauss.irp.f similarity index 100% rename from src/ao_many_one_e_ints/fit_slat_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/fit_slat_gauss.irp.f diff --git a/src/ao_many_one_e_ints/grad2_jmu_manu.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f similarity index 100% rename from src/ao_many_one_e_ints/grad2_jmu_manu.irp.f rename to plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f diff --git a/src/ao_many_one_e_ints/grad2_jmu_modif.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f similarity index 100% rename from src/ao_many_one_e_ints/grad2_jmu_modif.irp.f rename to plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f diff --git a/src/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f similarity index 100% rename from src/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f rename to plugins/local/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f diff --git a/src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f similarity index 100% rename from src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f rename to plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f diff --git a/src/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f similarity index 100% rename from src/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f rename to plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f diff --git a/src/ao_many_one_e_ints/grad_related_ints.irp.f b/plugins/local/ao_many_one_e_ints/grad_related_ints.irp.f similarity index 100% rename from src/ao_many_one_e_ints/grad_related_ints.irp.f rename to plugins/local/ao_many_one_e_ints/grad_related_ints.irp.f diff --git a/src/ao_many_one_e_ints/list_grid.irp.f b/plugins/local/ao_many_one_e_ints/list_grid.irp.f similarity index 100% rename from src/ao_many_one_e_ints/list_grid.irp.f rename to plugins/local/ao_many_one_e_ints/list_grid.irp.f diff --git a/src/ao_many_one_e_ints/listj1b.irp.f b/plugins/local/ao_many_one_e_ints/listj1b.irp.f similarity index 100% rename from src/ao_many_one_e_ints/listj1b.irp.f rename to plugins/local/ao_many_one_e_ints/listj1b.irp.f diff --git a/src/ao_many_one_e_ints/listj1b_sorted.irp.f b/plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f similarity index 100% rename from src/ao_many_one_e_ints/listj1b_sorted.irp.f rename to plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f diff --git a/src/ao_many_one_e_ints/prim_int_erf_gauss.irp.f b/plugins/local/ao_many_one_e_ints/prim_int_erf_gauss.irp.f similarity index 100% rename from src/ao_many_one_e_ints/prim_int_erf_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/prim_int_erf_gauss.irp.f diff --git a/src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f b/plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f similarity index 100% rename from src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f diff --git a/src/ao_many_one_e_ints/stg_gauss_int.irp.f b/plugins/local/ao_many_one_e_ints/stg_gauss_int.irp.f similarity index 100% rename from src/ao_many_one_e_ints/stg_gauss_int.irp.f rename to plugins/local/ao_many_one_e_ints/stg_gauss_int.irp.f diff --git a/src/ao_many_one_e_ints/taylor_exp.irp.f b/plugins/local/ao_many_one_e_ints/taylor_exp.irp.f similarity index 100% rename from src/ao_many_one_e_ints/taylor_exp.irp.f rename to plugins/local/ao_many_one_e_ints/taylor_exp.irp.f diff --git a/src/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f b/plugins/local/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f similarity index 100% rename from src/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f rename to plugins/local/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f diff --git a/src/ao_tc_eff_map/NEED b/plugins/local/ao_tc_eff_map/NEED similarity index 100% rename from src/ao_tc_eff_map/NEED rename to plugins/local/ao_tc_eff_map/NEED diff --git a/src/ao_tc_eff_map/README.rst b/plugins/local/ao_tc_eff_map/README.rst similarity index 100% rename from src/ao_tc_eff_map/README.rst rename to plugins/local/ao_tc_eff_map/README.rst diff --git a/src/ao_tc_eff_map/compute_ints_eff_pot.irp.f b/plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f similarity index 100% rename from src/ao_tc_eff_map/compute_ints_eff_pot.irp.f rename to plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f diff --git a/src/ao_tc_eff_map/fit_j.irp.f b/plugins/local/ao_tc_eff_map/fit_j.irp.f similarity index 100% rename from src/ao_tc_eff_map/fit_j.irp.f rename to plugins/local/ao_tc_eff_map/fit_j.irp.f diff --git a/src/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f b/plugins/local/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f similarity index 100% rename from src/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f rename to plugins/local/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f diff --git a/src/ao_tc_eff_map/map_integrals_eff_pot.irp.f b/plugins/local/ao_tc_eff_map/map_integrals_eff_pot.irp.f similarity index 100% rename from src/ao_tc_eff_map/map_integrals_eff_pot.irp.f rename to plugins/local/ao_tc_eff_map/map_integrals_eff_pot.irp.f diff --git a/src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f similarity index 100% rename from src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f rename to plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f diff --git a/src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f similarity index 100% rename from src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f rename to plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f diff --git a/src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f similarity index 100% rename from src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f rename to plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f diff --git a/src/ao_tc_eff_map/potential.irp.f b/plugins/local/ao_tc_eff_map/potential.irp.f similarity index 100% rename from src/ao_tc_eff_map/potential.irp.f rename to plugins/local/ao_tc_eff_map/potential.irp.f diff --git a/src/ao_tc_eff_map/providers_ao_eff_pot.irp.f b/plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f similarity index 100% rename from src/ao_tc_eff_map/providers_ao_eff_pot.irp.f rename to plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f diff --git a/src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f similarity index 100% rename from src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f rename to plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f diff --git a/src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f similarity index 100% rename from src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f rename to plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f diff --git a/src/ao_tc_eff_map/two_e_ints_gauss.irp.f b/plugins/local/ao_tc_eff_map/two_e_ints_gauss.irp.f similarity index 100% rename from src/ao_tc_eff_map/two_e_ints_gauss.irp.f rename to plugins/local/ao_tc_eff_map/two_e_ints_gauss.irp.f diff --git a/src/ao_tc_eff_map/useful_sub.irp.f b/plugins/local/ao_tc_eff_map/useful_sub.irp.f similarity index 100% rename from src/ao_tc_eff_map/useful_sub.irp.f rename to plugins/local/ao_tc_eff_map/useful_sub.irp.f diff --git a/src/aux_quantities/EZFIO.cfg b/plugins/local/aux_quantities/EZFIO.cfg similarity index 100% rename from src/aux_quantities/EZFIO.cfg rename to plugins/local/aux_quantities/EZFIO.cfg diff --git a/src/aux_quantities/NEED b/plugins/local/aux_quantities/NEED similarity index 100% rename from src/aux_quantities/NEED rename to plugins/local/aux_quantities/NEED diff --git a/src/aux_quantities/README.rst b/plugins/local/aux_quantities/README.rst similarity index 100% rename from src/aux_quantities/README.rst rename to plugins/local/aux_quantities/README.rst diff --git a/src/basis_correction/51.basis_c.bats b/plugins/local/basis_correction/51.basis_c.bats similarity index 100% rename from src/basis_correction/51.basis_c.bats rename to plugins/local/basis_correction/51.basis_c.bats diff --git a/src/basis_correction/NEED b/plugins/local/basis_correction/NEED similarity index 100% rename from src/basis_correction/NEED rename to plugins/local/basis_correction/NEED diff --git a/src/basis_correction/README.rst b/plugins/local/basis_correction/README.rst similarity index 100% rename from src/basis_correction/README.rst rename to plugins/local/basis_correction/README.rst diff --git a/src/basis_correction/TODO b/plugins/local/basis_correction/TODO similarity index 100% rename from src/basis_correction/TODO rename to plugins/local/basis_correction/TODO diff --git a/src/basis_correction/basis_correction.irp.f b/plugins/local/basis_correction/basis_correction.irp.f similarity index 100% rename from src/basis_correction/basis_correction.irp.f rename to plugins/local/basis_correction/basis_correction.irp.f diff --git a/src/basis_correction/eff_xi_based_func.irp.f b/plugins/local/basis_correction/eff_xi_based_func.irp.f similarity index 100% rename from src/basis_correction/eff_xi_based_func.irp.f rename to plugins/local/basis_correction/eff_xi_based_func.irp.f diff --git a/src/basis_correction/pbe_on_top.irp.f b/plugins/local/basis_correction/pbe_on_top.irp.f similarity index 100% rename from src/basis_correction/pbe_on_top.irp.f rename to plugins/local/basis_correction/pbe_on_top.irp.f diff --git a/src/basis_correction/print_routine.irp.f b/plugins/local/basis_correction/print_routine.irp.f similarity index 100% rename from src/basis_correction/print_routine.irp.f rename to plugins/local/basis_correction/print_routine.irp.f diff --git a/src/basis_correction/print_su_pbe_ot.irp.f b/plugins/local/basis_correction/print_su_pbe_ot.irp.f similarity index 100% rename from src/basis_correction/print_su_pbe_ot.irp.f rename to plugins/local/basis_correction/print_su_pbe_ot.irp.f diff --git a/src/basis_correction/weak_corr_func.irp.f b/plugins/local/basis_correction/weak_corr_func.irp.f similarity index 100% rename from src/basis_correction/weak_corr_func.irp.f rename to plugins/local/basis_correction/weak_corr_func.irp.f diff --git a/src/bi_ort_ints/NEED b/plugins/local/bi_ort_ints/NEED similarity index 100% rename from src/bi_ort_ints/NEED rename to plugins/local/bi_ort_ints/NEED diff --git a/src/bi_ort_ints/README.rst b/plugins/local/bi_ort_ints/README.rst similarity index 100% rename from src/bi_ort_ints/README.rst rename to plugins/local/bi_ort_ints/README.rst diff --git a/src/bi_ort_ints/bi_ort_ints.irp.f b/plugins/local/bi_ort_ints/bi_ort_ints.irp.f similarity index 100% rename from src/bi_ort_ints/bi_ort_ints.irp.f rename to plugins/local/bi_ort_ints/bi_ort_ints.irp.f diff --git a/src/bi_ort_ints/biorthog_mo_for_h.irp.f b/plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f similarity index 100% rename from src/bi_ort_ints/biorthog_mo_for_h.irp.f rename to plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f diff --git a/src/bi_ort_ints/no_dressing.irp.f b/plugins/local/bi_ort_ints/no_dressing.irp.f similarity index 100% rename from src/bi_ort_ints/no_dressing.irp.f rename to plugins/local/bi_ort_ints/no_dressing.irp.f diff --git a/src/bi_ort_ints/no_dressing_energy.irp.f b/plugins/local/bi_ort_ints/no_dressing_energy.irp.f similarity index 100% rename from src/bi_ort_ints/no_dressing_energy.irp.f rename to plugins/local/bi_ort_ints/no_dressing_energy.irp.f diff --git a/src/bi_ort_ints/no_dressing_naive.irp.f b/plugins/local/bi_ort_ints/no_dressing_naive.irp.f similarity index 100% rename from src/bi_ort_ints/no_dressing_naive.irp.f rename to plugins/local/bi_ort_ints/no_dressing_naive.irp.f diff --git a/src/bi_ort_ints/one_e_bi_ort.irp.f b/plugins/local/bi_ort_ints/one_e_bi_ort.irp.f similarity index 100% rename from src/bi_ort_ints/one_e_bi_ort.irp.f rename to plugins/local/bi_ort_ints/one_e_bi_ort.irp.f diff --git a/src/bi_ort_ints/semi_num_ints_mo.irp.f b/plugins/local/bi_ort_ints/semi_num_ints_mo.irp.f similarity index 100% rename from src/bi_ort_ints/semi_num_ints_mo.irp.f rename to plugins/local/bi_ort_ints/semi_num_ints_mo.irp.f diff --git a/src/bi_ort_ints/three_body_ijm.irp.f b/plugins/local/bi_ort_ints/three_body_ijm.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijm.irp.f rename to plugins/local/bi_ort_ints/three_body_ijm.irp.f diff --git a/src/bi_ort_ints/three_body_ijmk.irp.f b/plugins/local/bi_ort_ints/three_body_ijmk.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmk.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmk.irp.f diff --git a/src/bi_ort_ints/three_body_ijmk_n4.irp.f b/plugins/local/bi_ort_ints/three_body_ijmk_n4.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmk_n4.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmk_n4.irp.f diff --git a/src/bi_ort_ints/three_body_ijmk_old.irp.f b/plugins/local/bi_ort_ints/three_body_ijmk_old.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmk_old.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmk_old.irp.f diff --git a/src/bi_ort_ints/three_body_ijmkl.irp.f b/plugins/local/bi_ort_ints/three_body_ijmkl.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmkl.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmkl.irp.f diff --git a/src/bi_ort_ints/three_body_ijmkl_old.irp.f b/plugins/local/bi_ort_ints/three_body_ijmkl_old.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmkl_old.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmkl_old.irp.f diff --git a/src/bi_ort_ints/three_body_ints_bi_ort.irp.f b/plugins/local/bi_ort_ints/three_body_ints_bi_ort.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ints_bi_ort.irp.f rename to plugins/local/bi_ort_ints/three_body_ints_bi_ort.irp.f diff --git a/src/bi_ort_ints/total_twoe_pot.irp.f b/plugins/local/bi_ort_ints/total_twoe_pot.irp.f similarity index 100% rename from src/bi_ort_ints/total_twoe_pot.irp.f rename to plugins/local/bi_ort_ints/total_twoe_pot.irp.f diff --git a/src/bi_ortho_mos/EZFIO.cfg b/plugins/local/bi_ortho_mos/EZFIO.cfg similarity index 100% rename from src/bi_ortho_mos/EZFIO.cfg rename to plugins/local/bi_ortho_mos/EZFIO.cfg diff --git a/src/bi_ortho_mos/NEED b/plugins/local/bi_ortho_mos/NEED similarity index 100% rename from src/bi_ortho_mos/NEED rename to plugins/local/bi_ortho_mos/NEED diff --git a/src/bi_ortho_mos/bi_density.irp.f b/plugins/local/bi_ortho_mos/bi_density.irp.f similarity index 100% rename from src/bi_ortho_mos/bi_density.irp.f rename to plugins/local/bi_ortho_mos/bi_density.irp.f diff --git a/src/bi_ortho_mos/bi_ort_mos_in_r.irp.f b/plugins/local/bi_ortho_mos/bi_ort_mos_in_r.irp.f similarity index 100% rename from src/bi_ortho_mos/bi_ort_mos_in_r.irp.f rename to plugins/local/bi_ortho_mos/bi_ort_mos_in_r.irp.f diff --git a/src/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f b/plugins/local/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f similarity index 100% rename from src/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f rename to plugins/local/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f diff --git a/src/bi_ortho_mos/mos_rl.irp.f b/plugins/local/bi_ortho_mos/mos_rl.irp.f similarity index 100% rename from src/bi_ortho_mos/mos_rl.irp.f rename to plugins/local/bi_ortho_mos/mos_rl.irp.f diff --git a/src/bi_ortho_mos/overlap.irp.f b/plugins/local/bi_ortho_mos/overlap.irp.f similarity index 100% rename from src/bi_ortho_mos/overlap.irp.f rename to plugins/local/bi_ortho_mos/overlap.irp.f diff --git a/src/cas_based_on_top/NEED b/plugins/local/cas_based_on_top/NEED similarity index 100% rename from src/cas_based_on_top/NEED rename to plugins/local/cas_based_on_top/NEED diff --git a/src/cas_based_on_top/README.rst b/plugins/local/cas_based_on_top/README.rst similarity index 100% rename from src/cas_based_on_top/README.rst rename to plugins/local/cas_based_on_top/README.rst diff --git a/src/cas_based_on_top/c_i_a_v_mos.irp.f b/plugins/local/cas_based_on_top/c_i_a_v_mos.irp.f similarity index 100% rename from src/cas_based_on_top/c_i_a_v_mos.irp.f rename to plugins/local/cas_based_on_top/c_i_a_v_mos.irp.f diff --git a/src/cas_based_on_top/cas_based_density.irp.f b/plugins/local/cas_based_on_top/cas_based_density.irp.f similarity index 100% rename from src/cas_based_on_top/cas_based_density.irp.f rename to plugins/local/cas_based_on_top/cas_based_density.irp.f diff --git a/src/cas_based_on_top/cas_based_on_top.irp.f b/plugins/local/cas_based_on_top/cas_based_on_top.irp.f similarity index 100% rename from src/cas_based_on_top/cas_based_on_top.irp.f rename to plugins/local/cas_based_on_top/cas_based_on_top.irp.f diff --git a/src/cas_based_on_top/cas_dens_prov.irp.f b/plugins/local/cas_based_on_top/cas_dens_prov.irp.f similarity index 100% rename from src/cas_based_on_top/cas_dens_prov.irp.f rename to plugins/local/cas_based_on_top/cas_dens_prov.irp.f diff --git a/src/cas_based_on_top/cas_dens_rout.irp.f b/plugins/local/cas_based_on_top/cas_dens_rout.irp.f similarity index 100% rename from src/cas_based_on_top/cas_dens_rout.irp.f rename to plugins/local/cas_based_on_top/cas_dens_rout.irp.f diff --git a/src/cas_based_on_top/cas_one_e_rdm.irp.f b/plugins/local/cas_based_on_top/cas_one_e_rdm.irp.f similarity index 100% rename from src/cas_based_on_top/cas_one_e_rdm.irp.f rename to plugins/local/cas_based_on_top/cas_one_e_rdm.irp.f diff --git a/src/cas_based_on_top/eff_spin_dens.irp.f b/plugins/local/cas_based_on_top/eff_spin_dens.irp.f similarity index 100% rename from src/cas_based_on_top/eff_spin_dens.irp.f rename to plugins/local/cas_based_on_top/eff_spin_dens.irp.f diff --git a/src/cas_based_on_top/example.irp.f b/plugins/local/cas_based_on_top/example.irp.f similarity index 100% rename from src/cas_based_on_top/example.irp.f rename to plugins/local/cas_based_on_top/example.irp.f diff --git a/src/cas_based_on_top/on_top_cas_prov.irp.f b/plugins/local/cas_based_on_top/on_top_cas_prov.irp.f similarity index 100% rename from src/cas_based_on_top/on_top_cas_prov.irp.f rename to plugins/local/cas_based_on_top/on_top_cas_prov.irp.f diff --git a/src/cas_based_on_top/on_top_cas_rout.irp.f b/plugins/local/cas_based_on_top/on_top_cas_rout.irp.f similarity index 100% rename from src/cas_based_on_top/on_top_cas_rout.irp.f rename to plugins/local/cas_based_on_top/on_top_cas_rout.irp.f diff --git a/src/cas_based_on_top/on_top_grad.irp.f b/plugins/local/cas_based_on_top/on_top_grad.irp.f similarity index 100% rename from src/cas_based_on_top/on_top_grad.irp.f rename to plugins/local/cas_based_on_top/on_top_grad.irp.f diff --git a/src/cas_based_on_top/two_body_dens_rout.irp.f b/plugins/local/cas_based_on_top/two_body_dens_rout.irp.f similarity index 100% rename from src/cas_based_on_top/two_body_dens_rout.irp.f rename to plugins/local/cas_based_on_top/two_body_dens_rout.irp.f diff --git a/src/casscf_tc_bi/NEED b/plugins/local/casscf_tc_bi/NEED similarity index 100% rename from src/casscf_tc_bi/NEED rename to plugins/local/casscf_tc_bi/NEED diff --git a/src/casscf_tc_bi/det_manip.irp.f b/plugins/local/casscf_tc_bi/det_manip.irp.f similarity index 100% rename from src/casscf_tc_bi/det_manip.irp.f rename to plugins/local/casscf_tc_bi/det_manip.irp.f diff --git a/src/casscf_tc_bi/grad_dm.irp.f b/plugins/local/casscf_tc_bi/grad_dm.irp.f similarity index 100% rename from src/casscf_tc_bi/grad_dm.irp.f rename to plugins/local/casscf_tc_bi/grad_dm.irp.f diff --git a/src/casscf_tc_bi/grad_old.irp.f b/plugins/local/casscf_tc_bi/grad_old.irp.f similarity index 100% rename from src/casscf_tc_bi/grad_old.irp.f rename to plugins/local/casscf_tc_bi/grad_old.irp.f diff --git a/src/casscf_tc_bi/gradient.irp.f b/plugins/local/casscf_tc_bi/gradient.irp.f similarity index 100% rename from src/casscf_tc_bi/gradient.irp.f rename to plugins/local/casscf_tc_bi/gradient.irp.f diff --git a/src/casscf_tc_bi/test_tc_casscf.irp.f b/plugins/local/casscf_tc_bi/test_tc_casscf.irp.f similarity index 100% rename from src/casscf_tc_bi/test_tc_casscf.irp.f rename to plugins/local/casscf_tc_bi/test_tc_casscf.irp.f diff --git a/src/cipsi_tc_bi_ortho/EZFIO.cfg b/plugins/local/cipsi_tc_bi_ortho/EZFIO.cfg similarity index 100% rename from src/cipsi_tc_bi_ortho/EZFIO.cfg rename to plugins/local/cipsi_tc_bi_ortho/EZFIO.cfg diff --git a/src/cipsi_tc_bi_ortho/NEED b/plugins/local/cipsi_tc_bi_ortho/NEED similarity index 100% rename from src/cipsi_tc_bi_ortho/NEED rename to plugins/local/cipsi_tc_bi_ortho/NEED diff --git a/src/cipsi_tc_bi_ortho/cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/cipsi.irp.f rename to plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f diff --git a/src/cipsi_tc_bi_ortho/energy.irp.f b/plugins/local/cipsi_tc_bi_ortho/energy.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/energy.irp.f rename to plugins/local/cipsi_tc_bi_ortho/energy.irp.f diff --git a/src/cipsi_tc_bi_ortho/environment.irp.f b/plugins/local/cipsi_tc_bi_ortho/environment.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/environment.irp.f rename to plugins/local/cipsi_tc_bi_ortho/environment.irp.f diff --git a/src/cipsi_tc_bi_ortho/fock_diag.irp.f b/plugins/local/cipsi_tc_bi_ortho/fock_diag.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/fock_diag.irp.f rename to plugins/local/cipsi_tc_bi_ortho/fock_diag.irp.f diff --git a/src/cipsi_tc_bi_ortho/get_d.irp.f b/plugins/local/cipsi_tc_bi_ortho/get_d.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/get_d.irp.f rename to plugins/local/cipsi_tc_bi_ortho/get_d.irp.f diff --git a/src/cipsi_tc_bi_ortho/get_d0_good.irp.f b/plugins/local/cipsi_tc_bi_ortho/get_d0_good.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/get_d0_good.irp.f rename to plugins/local/cipsi_tc_bi_ortho/get_d0_good.irp.f diff --git a/src/cipsi_tc_bi_ortho/get_d1_good.irp.f b/plugins/local/cipsi_tc_bi_ortho/get_d1_good.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/get_d1_good.irp.f rename to plugins/local/cipsi_tc_bi_ortho/get_d1_good.irp.f diff --git a/src/cipsi_tc_bi_ortho/get_d2_good.irp.f b/plugins/local/cipsi_tc_bi_ortho/get_d2_good.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/get_d2_good.irp.f rename to plugins/local/cipsi_tc_bi_ortho/get_d2_good.irp.f diff --git a/src/cipsi_tc_bi_ortho/lock_2rdm.irp.f b/plugins/local/cipsi_tc_bi_ortho/lock_2rdm.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/lock_2rdm.irp.f rename to plugins/local/cipsi_tc_bi_ortho/lock_2rdm.irp.f diff --git a/src/cipsi_tc_bi_ortho/pouet b/plugins/local/cipsi_tc_bi_ortho/pouet similarity index 100% rename from src/cipsi_tc_bi_ortho/pouet rename to plugins/local/cipsi_tc_bi_ortho/pouet diff --git a/src/cipsi_tc_bi_ortho/pt2.irp.f b/plugins/local/cipsi_tc_bi_ortho/pt2.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/pt2.irp.f rename to plugins/local/cipsi_tc_bi_ortho/pt2.irp.f diff --git a/src/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f b/plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f rename to plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f diff --git a/src/cipsi_tc_bi_ortho/pt2_type.irp.f b/plugins/local/cipsi_tc_bi_ortho/pt2_type.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/pt2_type.irp.f rename to plugins/local/cipsi_tc_bi_ortho/pt2_type.irp.f diff --git a/src/cipsi_tc_bi_ortho/run_pt2_slave.irp.f b/plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/run_pt2_slave.irp.f rename to plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f diff --git a/src/cipsi_tc_bi_ortho/run_selection_slave.irp.f b/plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/run_selection_slave.irp.f rename to plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f diff --git a/src/cipsi_tc_bi_ortho/selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/selection.irp.f rename to plugins/local/cipsi_tc_bi_ortho/selection.irp.f diff --git a/src/cipsi_tc_bi_ortho/selection_buffer.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/selection_buffer.irp.f rename to plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f diff --git a/src/cipsi_tc_bi_ortho/selection_types.f90 b/plugins/local/cipsi_tc_bi_ortho/selection_types.f90 similarity index 100% rename from src/cipsi_tc_bi_ortho/selection_types.f90 rename to plugins/local/cipsi_tc_bi_ortho/selection_types.f90 diff --git a/src/cipsi_tc_bi_ortho/selection_weight.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/selection_weight.irp.f rename to plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f diff --git a/src/cipsi_tc_bi_ortho/slave_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/slave_cipsi.irp.f rename to plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f diff --git a/src/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f rename to plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f diff --git a/src/cipsi_tc_bi_ortho/write_cipsi_json.irp.f b/plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/write_cipsi_json.irp.f rename to plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f diff --git a/src/cipsi_tc_bi_ortho/zmq_selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/zmq_selection.irp.f rename to plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f diff --git a/src/fci_tc_bi/13.fci_tc_bi_ortho.bats b/plugins/local/fci_tc_bi/13.fci_tc_bi_ortho.bats similarity index 100% rename from src/fci_tc_bi/13.fci_tc_bi_ortho.bats rename to plugins/local/fci_tc_bi/13.fci_tc_bi_ortho.bats diff --git a/src/fci_tc_bi/EZFIO.cfg b/plugins/local/fci_tc_bi/EZFIO.cfg similarity index 100% rename from src/fci_tc_bi/EZFIO.cfg rename to plugins/local/fci_tc_bi/EZFIO.cfg diff --git a/src/fci_tc_bi/NEED b/plugins/local/fci_tc_bi/NEED similarity index 100% rename from src/fci_tc_bi/NEED rename to plugins/local/fci_tc_bi/NEED diff --git a/src/fci_tc_bi/class.irp.f b/plugins/local/fci_tc_bi/class.irp.f similarity index 100% rename from src/fci_tc_bi/class.irp.f rename to plugins/local/fci_tc_bi/class.irp.f diff --git a/src/fci_tc_bi/copy_wf.irp.f b/plugins/local/fci_tc_bi/copy_wf.irp.f similarity index 100% rename from src/fci_tc_bi/copy_wf.irp.f rename to plugins/local/fci_tc_bi/copy_wf.irp.f diff --git a/src/fci_tc_bi/diagonalize_ci.irp.f b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f similarity index 100% rename from src/fci_tc_bi/diagonalize_ci.irp.f rename to plugins/local/fci_tc_bi/diagonalize_ci.irp.f diff --git a/src/fci_tc_bi/fci_tc_bi_ortho.irp.f b/plugins/local/fci_tc_bi/fci_tc_bi_ortho.irp.f similarity index 100% rename from src/fci_tc_bi/fci_tc_bi_ortho.irp.f rename to plugins/local/fci_tc_bi/fci_tc_bi_ortho.irp.f diff --git a/src/fci_tc_bi/generators.irp.f b/plugins/local/fci_tc_bi/generators.irp.f similarity index 100% rename from src/fci_tc_bi/generators.irp.f rename to plugins/local/fci_tc_bi/generators.irp.f diff --git a/src/fci_tc_bi/pt2_tc.irp.f b/plugins/local/fci_tc_bi/pt2_tc.irp.f similarity index 100% rename from src/fci_tc_bi/pt2_tc.irp.f rename to plugins/local/fci_tc_bi/pt2_tc.irp.f diff --git a/src/fci_tc_bi/save_energy.irp.f b/plugins/local/fci_tc_bi/save_energy.irp.f similarity index 100% rename from src/fci_tc_bi/save_energy.irp.f rename to plugins/local/fci_tc_bi/save_energy.irp.f diff --git a/src/fci_tc_bi/scripts_fci_tc/CH2.xyz b/plugins/local/fci_tc_bi/scripts_fci_tc/CH2.xyz similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/CH2.xyz rename to plugins/local/fci_tc_bi/scripts_fci_tc/CH2.xyz diff --git a/src/fci_tc_bi/scripts_fci_tc/FH.xyz b/plugins/local/fci_tc_bi/scripts_fci_tc/FH.xyz similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/FH.xyz rename to plugins/local/fci_tc_bi/scripts_fci_tc/FH.xyz diff --git a/src/fci_tc_bi/scripts_fci_tc/extract_tables.sh b/plugins/local/fci_tc_bi/scripts_fci_tc/extract_tables.sh similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/extract_tables.sh rename to plugins/local/fci_tc_bi/scripts_fci_tc/extract_tables.sh diff --git a/src/fci_tc_bi/scripts_fci_tc/h2o.sh b/plugins/local/fci_tc_bi/scripts_fci_tc/h2o.sh similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/h2o.sh rename to plugins/local/fci_tc_bi/scripts_fci_tc/h2o.sh diff --git a/src/fci_tc_bi/scripts_fci_tc/h2o.xyz b/plugins/local/fci_tc_bi/scripts_fci_tc/h2o.xyz similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/h2o.xyz rename to plugins/local/fci_tc_bi/scripts_fci_tc/h2o.xyz diff --git a/src/fci_tc_bi/scripts_fci_tc/script.sh b/plugins/local/fci_tc_bi/scripts_fci_tc/script.sh similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/script.sh rename to plugins/local/fci_tc_bi/scripts_fci_tc/script.sh diff --git a/src/fci_tc_bi/selectors.irp.f b/plugins/local/fci_tc_bi/selectors.irp.f similarity index 100% rename from src/fci_tc_bi/selectors.irp.f rename to plugins/local/fci_tc_bi/selectors.irp.f diff --git a/src/fci_tc_bi/zmq.irp.f b/plugins/local/fci_tc_bi/zmq.irp.f similarity index 100% rename from src/fci_tc_bi/zmq.irp.f rename to plugins/local/fci_tc_bi/zmq.irp.f diff --git a/src/jastrow/EZFIO.cfg b/plugins/local/jastrow/EZFIO.cfg similarity index 100% rename from src/jastrow/EZFIO.cfg rename to plugins/local/jastrow/EZFIO.cfg diff --git a/src/jastrow/NEED b/plugins/local/jastrow/NEED similarity index 100% rename from src/jastrow/NEED rename to plugins/local/jastrow/NEED diff --git a/src/jastrow/README.md b/plugins/local/jastrow/README.md similarity index 100% rename from src/jastrow/README.md rename to plugins/local/jastrow/README.md diff --git a/src/mo_localization/84.mo_localization.bats b/plugins/local/mo_localization/84.mo_localization.bats similarity index 100% rename from src/mo_localization/84.mo_localization.bats rename to plugins/local/mo_localization/84.mo_localization.bats diff --git a/src/mo_localization/EZFIO.cfg b/plugins/local/mo_localization/EZFIO.cfg similarity index 100% rename from src/mo_localization/EZFIO.cfg rename to plugins/local/mo_localization/EZFIO.cfg diff --git a/src/mo_localization/NEED b/plugins/local/mo_localization/NEED similarity index 100% rename from src/mo_localization/NEED rename to plugins/local/mo_localization/NEED diff --git a/src/mo_localization/README.md b/plugins/local/mo_localization/README.md similarity index 100% rename from src/mo_localization/README.md rename to plugins/local/mo_localization/README.md diff --git a/src/mo_localization/break_spatial_sym.irp.f b/plugins/local/mo_localization/break_spatial_sym.irp.f similarity index 100% rename from src/mo_localization/break_spatial_sym.irp.f rename to plugins/local/mo_localization/break_spatial_sym.irp.f diff --git a/src/mo_localization/debug_gradient_loc.irp.f b/plugins/local/mo_localization/debug_gradient_loc.irp.f similarity index 100% rename from src/mo_localization/debug_gradient_loc.irp.f rename to plugins/local/mo_localization/debug_gradient_loc.irp.f diff --git a/src/mo_localization/debug_hessian_loc.irp.f b/plugins/local/mo_localization/debug_hessian_loc.irp.f similarity index 100% rename from src/mo_localization/debug_hessian_loc.irp.f rename to plugins/local/mo_localization/debug_hessian_loc.irp.f diff --git a/src/mo_localization/kick_the_mos.irp.f b/plugins/local/mo_localization/kick_the_mos.irp.f similarity index 100% rename from src/mo_localization/kick_the_mos.irp.f rename to plugins/local/mo_localization/kick_the_mos.irp.f diff --git a/src/mo_localization/localization.irp.f b/plugins/local/mo_localization/localization.irp.f similarity index 100% rename from src/mo_localization/localization.irp.f rename to plugins/local/mo_localization/localization.irp.f diff --git a/src/mo_localization/localization_sub.irp.f b/plugins/local/mo_localization/localization_sub.irp.f similarity index 100% rename from src/mo_localization/localization_sub.irp.f rename to plugins/local/mo_localization/localization_sub.irp.f diff --git a/src/mo_localization/org/TANGLE_org_mode.sh b/plugins/local/mo_localization/org/TANGLE_org_mode.sh similarity index 100% rename from src/mo_localization/org/TANGLE_org_mode.sh rename to plugins/local/mo_localization/org/TANGLE_org_mode.sh diff --git a/src/mo_localization/org/break_spatial_sym.org b/plugins/local/mo_localization/org/break_spatial_sym.org similarity index 100% rename from src/mo_localization/org/break_spatial_sym.org rename to plugins/local/mo_localization/org/break_spatial_sym.org diff --git a/src/mo_localization/org/debug_gradient_loc.org b/plugins/local/mo_localization/org/debug_gradient_loc.org similarity index 100% rename from src/mo_localization/org/debug_gradient_loc.org rename to plugins/local/mo_localization/org/debug_gradient_loc.org diff --git a/src/mo_localization/org/debug_hessian_loc.org b/plugins/local/mo_localization/org/debug_hessian_loc.org similarity index 100% rename from src/mo_localization/org/debug_hessian_loc.org rename to plugins/local/mo_localization/org/debug_hessian_loc.org diff --git a/src/mo_localization/org/kick_the_mos.org b/plugins/local/mo_localization/org/kick_the_mos.org similarity index 100% rename from src/mo_localization/org/kick_the_mos.org rename to plugins/local/mo_localization/org/kick_the_mos.org diff --git a/src/mo_localization/org/localization.org b/plugins/local/mo_localization/org/localization.org similarity index 100% rename from src/mo_localization/org/localization.org rename to plugins/local/mo_localization/org/localization.org diff --git a/src/mu_of_r/EZFIO.cfg b/plugins/local/mu_of_r/EZFIO.cfg similarity index 100% rename from src/mu_of_r/EZFIO.cfg rename to plugins/local/mu_of_r/EZFIO.cfg diff --git a/src/mu_of_r/NEED b/plugins/local/mu_of_r/NEED similarity index 100% rename from src/mu_of_r/NEED rename to plugins/local/mu_of_r/NEED diff --git a/src/mu_of_r/README.rst b/plugins/local/mu_of_r/README.rst similarity index 100% rename from src/mu_of_r/README.rst rename to plugins/local/mu_of_r/README.rst diff --git a/src/mu_of_r/basis_def.irp.f b/plugins/local/mu_of_r/basis_def.irp.f similarity index 100% rename from src/mu_of_r/basis_def.irp.f rename to plugins/local/mu_of_r/basis_def.irp.f diff --git a/src/mu_of_r/example.irp.f b/plugins/local/mu_of_r/example.irp.f similarity index 100% rename from src/mu_of_r/example.irp.f rename to plugins/local/mu_of_r/example.irp.f diff --git a/src/mu_of_r/f_hf_utils.irp.f b/plugins/local/mu_of_r/f_hf_utils.irp.f similarity index 100% rename from src/mu_of_r/f_hf_utils.irp.f rename to plugins/local/mu_of_r/f_hf_utils.irp.f diff --git a/src/mu_of_r/f_psi_i_a_v_utils.irp.f b/plugins/local/mu_of_r/f_psi_i_a_v_utils.irp.f similarity index 100% rename from src/mu_of_r/f_psi_i_a_v_utils.irp.f rename to plugins/local/mu_of_r/f_psi_i_a_v_utils.irp.f diff --git a/src/mu_of_r/f_psi_old.irp.f b/plugins/local/mu_of_r/f_psi_old.irp.f similarity index 100% rename from src/mu_of_r/f_psi_old.irp.f rename to plugins/local/mu_of_r/f_psi_old.irp.f diff --git a/src/mu_of_r/f_psi_utils.irp.f b/plugins/local/mu_of_r/f_psi_utils.irp.f similarity index 100% rename from src/mu_of_r/f_psi_utils.irp.f rename to plugins/local/mu_of_r/f_psi_utils.irp.f diff --git a/src/mu_of_r/f_val_general.irp.f b/plugins/local/mu_of_r/f_val_general.irp.f similarity index 100% rename from src/mu_of_r/f_val_general.irp.f rename to plugins/local/mu_of_r/f_val_general.irp.f diff --git a/src/mu_of_r/mu_of_r_conditions.irp.f b/plugins/local/mu_of_r/mu_of_r_conditions.irp.f similarity index 100% rename from src/mu_of_r/mu_of_r_conditions.irp.f rename to plugins/local/mu_of_r/mu_of_r_conditions.irp.f diff --git a/src/mu_of_r/test_proj_op.irp.f b/plugins/local/mu_of_r/test_proj_op.irp.f similarity index 100% rename from src/mu_of_r/test_proj_op.irp.f rename to plugins/local/mu_of_r/test_proj_op.irp.f diff --git a/src/non_h_ints_mu/NEED b/plugins/local/non_h_ints_mu/NEED similarity index 100% rename from src/non_h_ints_mu/NEED rename to plugins/local/non_h_ints_mu/NEED diff --git a/src/non_h_ints_mu/README.rst b/plugins/local/non_h_ints_mu/README.rst similarity index 100% rename from src/non_h_ints_mu/README.rst rename to plugins/local/non_h_ints_mu/README.rst diff --git a/src/non_h_ints_mu/debug_fit.irp.f b/plugins/local/non_h_ints_mu/debug_fit.irp.f similarity index 100% rename from src/non_h_ints_mu/debug_fit.irp.f rename to plugins/local/non_h_ints_mu/debug_fit.irp.f diff --git a/src/non_h_ints_mu/debug_integ_jmu_modif.irp.f b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f similarity index 100% rename from src/non_h_ints_mu/debug_integ_jmu_modif.irp.f rename to plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f diff --git a/src/non_h_ints_mu/grad_squared.irp.f b/plugins/local/non_h_ints_mu/grad_squared.irp.f similarity index 100% rename from src/non_h_ints_mu/grad_squared.irp.f rename to plugins/local/non_h_ints_mu/grad_squared.irp.f diff --git a/src/non_h_ints_mu/grad_squared_manu.irp.f b/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f similarity index 100% rename from src/non_h_ints_mu/grad_squared_manu.irp.f rename to plugins/local/non_h_ints_mu/grad_squared_manu.irp.f diff --git a/src/non_h_ints_mu/grad_tc_int.irp.f b/plugins/local/non_h_ints_mu/grad_tc_int.irp.f similarity index 100% rename from src/non_h_ints_mu/grad_tc_int.irp.f rename to plugins/local/non_h_ints_mu/grad_tc_int.irp.f diff --git a/src/non_h_ints_mu/j12_nucl_utils.irp.f b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f similarity index 100% rename from src/non_h_ints_mu/j12_nucl_utils.irp.f rename to plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f diff --git a/src/non_h_ints_mu/jast_deriv.irp.f b/plugins/local/non_h_ints_mu/jast_deriv.irp.f similarity index 100% rename from src/non_h_ints_mu/jast_deriv.irp.f rename to plugins/local/non_h_ints_mu/jast_deriv.irp.f diff --git a/src/non_h_ints_mu/jast_deriv_utils.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f similarity index 100% rename from src/non_h_ints_mu/jast_deriv_utils.irp.f rename to plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f diff --git a/src/non_h_ints_mu/jast_deriv_utils_vect.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f similarity index 100% rename from src/non_h_ints_mu/jast_deriv_utils_vect.irp.f rename to plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f diff --git a/src/non_h_ints_mu/new_grad_tc.irp.f b/plugins/local/non_h_ints_mu/new_grad_tc.irp.f similarity index 100% rename from src/non_h_ints_mu/new_grad_tc.irp.f rename to plugins/local/non_h_ints_mu/new_grad_tc.irp.f diff --git a/src/non_h_ints_mu/new_grad_tc_manu.irp.f b/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f similarity index 100% rename from src/non_h_ints_mu/new_grad_tc_manu.irp.f rename to plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f diff --git a/src/non_h_ints_mu/numerical_integ.irp.f b/plugins/local/non_h_ints_mu/numerical_integ.irp.f similarity index 100% rename from src/non_h_ints_mu/numerical_integ.irp.f rename to plugins/local/non_h_ints_mu/numerical_integ.irp.f diff --git a/src/non_h_ints_mu/plot_mu_of_r.irp.f b/plugins/local/non_h_ints_mu/plot_mu_of_r.irp.f similarity index 100% rename from src/non_h_ints_mu/plot_mu_of_r.irp.f rename to plugins/local/non_h_ints_mu/plot_mu_of_r.irp.f diff --git a/src/non_h_ints_mu/qmckl.irp.f b/plugins/local/non_h_ints_mu/qmckl.irp.f similarity index 100% rename from src/non_h_ints_mu/qmckl.irp.f rename to plugins/local/non_h_ints_mu/qmckl.irp.f diff --git a/src/non_h_ints_mu/tc_integ_an.irp.f b/plugins/local/non_h_ints_mu/tc_integ_an.irp.f similarity index 100% rename from src/non_h_ints_mu/tc_integ_an.irp.f rename to plugins/local/non_h_ints_mu/tc_integ_an.irp.f diff --git a/src/non_h_ints_mu/tc_integ_num.irp.f b/plugins/local/non_h_ints_mu/tc_integ_num.irp.f similarity index 100% rename from src/non_h_ints_mu/tc_integ_num.irp.f rename to plugins/local/non_h_ints_mu/tc_integ_num.irp.f diff --git a/src/non_h_ints_mu/test_non_h_ints.irp.f b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f similarity index 100% rename from src/non_h_ints_mu/test_non_h_ints.irp.f rename to plugins/local/non_h_ints_mu/test_non_h_ints.irp.f diff --git a/src/non_h_ints_mu/total_tc_int.irp.f b/plugins/local/non_h_ints_mu/total_tc_int.irp.f similarity index 100% rename from src/non_h_ints_mu/total_tc_int.irp.f rename to plugins/local/non_h_ints_mu/total_tc_int.irp.f diff --git a/src/non_hermit_dav/NEED b/plugins/local/non_hermit_dav/NEED similarity index 100% rename from src/non_hermit_dav/NEED rename to plugins/local/non_hermit_dav/NEED diff --git a/src/non_hermit_dav/biorthog.irp.f b/plugins/local/non_hermit_dav/biorthog.irp.f similarity index 100% rename from src/non_hermit_dav/biorthog.irp.f rename to plugins/local/non_hermit_dav/biorthog.irp.f diff --git a/src/non_hermit_dav/gram_schmit.irp.f b/plugins/local/non_hermit_dav/gram_schmit.irp.f similarity index 100% rename from src/non_hermit_dav/gram_schmit.irp.f rename to plugins/local/non_hermit_dav/gram_schmit.irp.f diff --git a/src/non_hermit_dav/htilde_mat.irp.f b/plugins/local/non_hermit_dav/htilde_mat.irp.f similarity index 100% rename from src/non_hermit_dav/htilde_mat.irp.f rename to plugins/local/non_hermit_dav/htilde_mat.irp.f diff --git a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f similarity index 100% rename from src/non_hermit_dav/lapack_diag_non_hermit.irp.f rename to plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f diff --git a/src/non_hermit_dav/new_routines.irp.f b/plugins/local/non_hermit_dav/new_routines.irp.f similarity index 100% rename from src/non_hermit_dav/new_routines.irp.f rename to plugins/local/non_hermit_dav/new_routines.irp.f diff --git a/src/non_hermit_dav/project.irp.f b/plugins/local/non_hermit_dav/project.irp.f similarity index 100% rename from src/non_hermit_dav/project.irp.f rename to plugins/local/non_hermit_dav/project.irp.f diff --git a/src/non_hermit_dav/utils.irp.f b/plugins/local/non_hermit_dav/utils.irp.f similarity index 100% rename from src/non_hermit_dav/utils.irp.f rename to plugins/local/non_hermit_dav/utils.irp.f diff --git a/src/ortho_three_e_ints/NEED b/plugins/local/ortho_three_e_ints/NEED similarity index 100% rename from src/ortho_three_e_ints/NEED rename to plugins/local/ortho_three_e_ints/NEED diff --git a/src/ortho_three_e_ints/io_6_index_tensor.irp.f b/plugins/local/ortho_three_e_ints/io_6_index_tensor.irp.f similarity index 100% rename from src/ortho_three_e_ints/io_6_index_tensor.irp.f rename to plugins/local/ortho_three_e_ints/io_6_index_tensor.irp.f diff --git a/src/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f b/plugins/local/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f similarity index 100% rename from src/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f rename to plugins/local/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f diff --git a/src/tc_bi_ortho/31.tc_bi_ortho.bats b/plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats similarity index 100% rename from src/tc_bi_ortho/31.tc_bi_ortho.bats rename to plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats diff --git a/src/tc_bi_ortho/EZFIO.cfg b/plugins/local/tc_bi_ortho/EZFIO.cfg similarity index 100% rename from src/tc_bi_ortho/EZFIO.cfg rename to plugins/local/tc_bi_ortho/EZFIO.cfg diff --git a/src/tc_bi_ortho/NEED b/plugins/local/tc_bi_ortho/NEED similarity index 100% rename from src/tc_bi_ortho/NEED rename to plugins/local/tc_bi_ortho/NEED diff --git a/src/tc_bi_ortho/compute_deltamu_right.irp.f b/plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f similarity index 100% rename from src/tc_bi_ortho/compute_deltamu_right.irp.f rename to plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f diff --git a/src/tc_bi_ortho/dav_h_tc_s2.irp.f b/plugins/local/tc_bi_ortho/dav_h_tc_s2.irp.f similarity index 100% rename from src/tc_bi_ortho/dav_h_tc_s2.irp.f rename to plugins/local/tc_bi_ortho/dav_h_tc_s2.irp.f diff --git a/src/tc_bi_ortho/dressing_vectors_lr.irp.f b/plugins/local/tc_bi_ortho/dressing_vectors_lr.irp.f similarity index 100% rename from src/tc_bi_ortho/dressing_vectors_lr.irp.f rename to plugins/local/tc_bi_ortho/dressing_vectors_lr.irp.f diff --git a/src/tc_bi_ortho/e_corr_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/e_corr_bi_ortho.irp.f similarity index 100% rename from src/tc_bi_ortho/e_corr_bi_ortho.irp.f rename to plugins/local/tc_bi_ortho/e_corr_bi_ortho.irp.f diff --git a/src/tc_bi_ortho/h_biortho.irp.f b/plugins/local/tc_bi_ortho/h_biortho.irp.f similarity index 100% rename from src/tc_bi_ortho/h_biortho.irp.f rename to plugins/local/tc_bi_ortho/h_biortho.irp.f diff --git a/src/tc_bi_ortho/h_mat_triple.irp.f b/plugins/local/tc_bi_ortho/h_mat_triple.irp.f similarity index 100% rename from src/tc_bi_ortho/h_mat_triple.irp.f rename to plugins/local/tc_bi_ortho/h_mat_triple.irp.f diff --git a/src/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f b/plugins/local/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f similarity index 100% rename from src/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f rename to plugins/local/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f diff --git a/src/tc_bi_ortho/h_tc_s2_u0.irp.f b/plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f similarity index 100% rename from src/tc_bi_ortho/h_tc_s2_u0.irp.f rename to plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f diff --git a/src/tc_bi_ortho/h_tc_u0.irp.f b/plugins/local/tc_bi_ortho/h_tc_u0.irp.f similarity index 100% rename from src/tc_bi_ortho/h_tc_u0.irp.f rename to plugins/local/tc_bi_ortho/h_tc_u0.irp.f diff --git a/src/tc_bi_ortho/normal_ordered.irp.f b/plugins/local/tc_bi_ortho/normal_ordered.irp.f similarity index 100% rename from src/tc_bi_ortho/normal_ordered.irp.f rename to plugins/local/tc_bi_ortho/normal_ordered.irp.f diff --git a/src/tc_bi_ortho/normal_ordered_contractions.irp.f b/plugins/local/tc_bi_ortho/normal_ordered_contractions.irp.f similarity index 100% rename from src/tc_bi_ortho/normal_ordered_contractions.irp.f rename to plugins/local/tc_bi_ortho/normal_ordered_contractions.irp.f diff --git a/src/tc_bi_ortho/normal_ordered_old.irp.f b/plugins/local/tc_bi_ortho/normal_ordered_old.irp.f similarity index 100% rename from src/tc_bi_ortho/normal_ordered_old.irp.f rename to plugins/local/tc_bi_ortho/normal_ordered_old.irp.f diff --git a/src/tc_bi_ortho/normal_ordered_v0.irp.f b/plugins/local/tc_bi_ortho/normal_ordered_v0.irp.f similarity index 100% rename from src/tc_bi_ortho/normal_ordered_v0.irp.f rename to plugins/local/tc_bi_ortho/normal_ordered_v0.irp.f diff --git a/src/tc_bi_ortho/print_he_tc_energy.irp.f b/plugins/local/tc_bi_ortho/print_he_tc_energy.irp.f similarity index 100% rename from src/tc_bi_ortho/print_he_tc_energy.irp.f rename to plugins/local/tc_bi_ortho/print_he_tc_energy.irp.f diff --git a/src/tc_bi_ortho/print_tc_dump.irp.f b/plugins/local/tc_bi_ortho/print_tc_dump.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_dump.irp.f rename to plugins/local/tc_bi_ortho/print_tc_dump.irp.f diff --git a/src/tc_bi_ortho/print_tc_energy.irp.f b/plugins/local/tc_bi_ortho/print_tc_energy.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_energy.irp.f rename to plugins/local/tc_bi_ortho/print_tc_energy.irp.f diff --git a/src/tc_bi_ortho/print_tc_spin_dens.irp.f b/plugins/local/tc_bi_ortho/print_tc_spin_dens.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_spin_dens.irp.f rename to plugins/local/tc_bi_ortho/print_tc_spin_dens.irp.f diff --git a/src/tc_bi_ortho/print_tc_var.irp.f b/plugins/local/tc_bi_ortho/print_tc_var.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_var.irp.f rename to plugins/local/tc_bi_ortho/print_tc_var.irp.f diff --git a/src/tc_bi_ortho/print_tc_wf.irp.f b/plugins/local/tc_bi_ortho/print_tc_wf.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_wf.irp.f rename to plugins/local/tc_bi_ortho/print_tc_wf.irp.f diff --git a/src/tc_bi_ortho/psi_det_tc_sorted.irp.f b/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f similarity index 100% rename from src/tc_bi_ortho/psi_det_tc_sorted.irp.f rename to plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f diff --git a/src/tc_bi_ortho/psi_left_qmc.irp.f b/plugins/local/tc_bi_ortho/psi_left_qmc.irp.f similarity index 100% rename from src/tc_bi_ortho/psi_left_qmc.irp.f rename to plugins/local/tc_bi_ortho/psi_left_qmc.irp.f diff --git a/src/tc_bi_ortho/psi_r_l_prov.irp.f b/plugins/local/tc_bi_ortho/psi_r_l_prov.irp.f similarity index 100% rename from src/tc_bi_ortho/psi_r_l_prov.irp.f rename to plugins/local/tc_bi_ortho/psi_r_l_prov.irp.f diff --git a/src/tc_bi_ortho/pt2_tc_cisd.irp.f b/plugins/local/tc_bi_ortho/pt2_tc_cisd.irp.f similarity index 100% rename from src/tc_bi_ortho/pt2_tc_cisd.irp.f rename to plugins/local/tc_bi_ortho/pt2_tc_cisd.irp.f diff --git a/src/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f b/plugins/local/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f similarity index 100% rename from src/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f rename to plugins/local/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f diff --git a/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f b/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f similarity index 100% rename from src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f rename to plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f diff --git a/src/tc_bi_ortho/select_dets_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/select_dets_bi_ortho.irp.f similarity index 100% rename from src/tc_bi_ortho/select_dets_bi_ortho.irp.f rename to plugins/local/tc_bi_ortho/select_dets_bi_ortho.irp.f diff --git a/src/tc_bi_ortho/slater_tc_3e_slow.irp.f b/plugins/local/tc_bi_ortho/slater_tc_3e_slow.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_3e_slow.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_3e_slow.irp.f diff --git a/src/tc_bi_ortho/slater_tc_opt.irp.f b/plugins/local/tc_bi_ortho/slater_tc_opt.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_opt.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_opt.irp.f diff --git a/src/tc_bi_ortho/slater_tc_opt_diag.irp.f b/plugins/local/tc_bi_ortho/slater_tc_opt_diag.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_opt_diag.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_opt_diag.irp.f diff --git a/src/tc_bi_ortho/slater_tc_opt_double.irp.f b/plugins/local/tc_bi_ortho/slater_tc_opt_double.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_opt_double.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_opt_double.irp.f diff --git a/src/tc_bi_ortho/slater_tc_opt_single.irp.f b/plugins/local/tc_bi_ortho/slater_tc_opt_single.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_opt_single.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_opt_single.irp.f diff --git a/src/tc_bi_ortho/slater_tc_slow.irp.f b/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_slow.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_slow.irp.f diff --git a/src/tc_bi_ortho/spin_mulliken.irp.f b/plugins/local/tc_bi_ortho/spin_mulliken.irp.f similarity index 100% rename from src/tc_bi_ortho/spin_mulliken.irp.f rename to plugins/local/tc_bi_ortho/spin_mulliken.irp.f diff --git a/src/tc_bi_ortho/symmetrized_3_e_int.irp.f b/plugins/local/tc_bi_ortho/symmetrized_3_e_int.irp.f similarity index 100% rename from src/tc_bi_ortho/symmetrized_3_e_int.irp.f rename to plugins/local/tc_bi_ortho/symmetrized_3_e_int.irp.f diff --git a/src/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f b/plugins/local/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f similarity index 100% rename from src/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f rename to plugins/local/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f diff --git a/src/tc_bi_ortho/tc_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_bi_ortho.irp.f rename to plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f diff --git a/src/tc_bi_ortho/tc_bi_ortho_prop.irp.f b/plugins/local/tc_bi_ortho/tc_bi_ortho_prop.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_bi_ortho_prop.irp.f rename to plugins/local/tc_bi_ortho/tc_bi_ortho_prop.irp.f diff --git a/src/tc_bi_ortho/tc_cisd_sc2.irp.f b/plugins/local/tc_bi_ortho/tc_cisd_sc2.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_cisd_sc2.irp.f rename to plugins/local/tc_bi_ortho/tc_cisd_sc2.irp.f diff --git a/src/tc_bi_ortho/tc_cisd_sc2_utils.irp.f b/plugins/local/tc_bi_ortho/tc_cisd_sc2_utils.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_cisd_sc2_utils.irp.f rename to plugins/local/tc_bi_ortho/tc_cisd_sc2_utils.irp.f diff --git a/src/tc_bi_ortho/tc_h_eigvectors.irp.f b/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_h_eigvectors.irp.f rename to plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f diff --git a/src/tc_bi_ortho/tc_hmat.irp.f b/plugins/local/tc_bi_ortho/tc_hmat.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_hmat.irp.f rename to plugins/local/tc_bi_ortho/tc_hmat.irp.f diff --git a/src/tc_bi_ortho/tc_natorb.irp.f b/plugins/local/tc_bi_ortho/tc_natorb.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_natorb.irp.f rename to plugins/local/tc_bi_ortho/tc_natorb.irp.f diff --git a/src/tc_bi_ortho/tc_prop.irp.f b/plugins/local/tc_bi_ortho/tc_prop.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_prop.irp.f rename to plugins/local/tc_bi_ortho/tc_prop.irp.f diff --git a/src/tc_bi_ortho/tc_som.irp.f b/plugins/local/tc_bi_ortho/tc_som.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_som.irp.f rename to plugins/local/tc_bi_ortho/tc_som.irp.f diff --git a/src/tc_bi_ortho/tc_utils.irp.f b/plugins/local/tc_bi_ortho/tc_utils.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_utils.irp.f rename to plugins/local/tc_bi_ortho/tc_utils.irp.f diff --git a/src/tc_bi_ortho/test_natorb.irp.f b/plugins/local/tc_bi_ortho/test_natorb.irp.f similarity index 100% rename from src/tc_bi_ortho/test_natorb.irp.f rename to plugins/local/tc_bi_ortho/test_natorb.irp.f diff --git a/src/tc_bi_ortho/test_normal_order.irp.f b/plugins/local/tc_bi_ortho/test_normal_order.irp.f similarity index 100% rename from src/tc_bi_ortho/test_normal_order.irp.f rename to plugins/local/tc_bi_ortho/test_normal_order.irp.f diff --git a/src/tc_bi_ortho/test_s2_tc.irp.f b/plugins/local/tc_bi_ortho/test_s2_tc.irp.f similarity index 100% rename from src/tc_bi_ortho/test_s2_tc.irp.f rename to plugins/local/tc_bi_ortho/test_s2_tc.irp.f diff --git a/src/tc_bi_ortho/test_spin_dens.irp.f b/plugins/local/tc_bi_ortho/test_spin_dens.irp.f similarity index 100% rename from src/tc_bi_ortho/test_spin_dens.irp.f rename to plugins/local/tc_bi_ortho/test_spin_dens.irp.f diff --git a/src/tc_bi_ortho/test_tc_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/test_tc_bi_ortho.irp.f similarity index 100% rename from src/tc_bi_ortho/test_tc_bi_ortho.irp.f rename to plugins/local/tc_bi_ortho/test_tc_bi_ortho.irp.f diff --git a/src/tc_bi_ortho/test_tc_fock.irp.f b/plugins/local/tc_bi_ortho/test_tc_fock.irp.f similarity index 100% rename from src/tc_bi_ortho/test_tc_fock.irp.f rename to plugins/local/tc_bi_ortho/test_tc_fock.irp.f diff --git a/src/tc_bi_ortho/test_tc_two_rdm.irp.f b/plugins/local/tc_bi_ortho/test_tc_two_rdm.irp.f similarity index 100% rename from src/tc_bi_ortho/test_tc_two_rdm.irp.f rename to plugins/local/tc_bi_ortho/test_tc_two_rdm.irp.f diff --git a/src/tc_bi_ortho/two_rdm_naive.irp.f b/plugins/local/tc_bi_ortho/two_rdm_naive.irp.f similarity index 100% rename from src/tc_bi_ortho/two_rdm_naive.irp.f rename to plugins/local/tc_bi_ortho/two_rdm_naive.irp.f diff --git a/src/tc_keywords/EZFIO.cfg b/plugins/local/tc_keywords/EZFIO.cfg similarity index 100% rename from src/tc_keywords/EZFIO.cfg rename to plugins/local/tc_keywords/EZFIO.cfg diff --git a/src/tc_keywords/NEED b/plugins/local/tc_keywords/NEED similarity index 100% rename from src/tc_keywords/NEED rename to plugins/local/tc_keywords/NEED diff --git a/src/tc_keywords/j1b_pen.irp.f b/plugins/local/tc_keywords/j1b_pen.irp.f similarity index 100% rename from src/tc_keywords/j1b_pen.irp.f rename to plugins/local/tc_keywords/j1b_pen.irp.f diff --git a/src/tc_keywords/tc_keywords.irp.f b/plugins/local/tc_keywords/tc_keywords.irp.f similarity index 100% rename from src/tc_keywords/tc_keywords.irp.f rename to plugins/local/tc_keywords/tc_keywords.irp.f diff --git a/src/tc_scf/11.tc_scf.bats b/plugins/local/tc_scf/11.tc_scf.bats similarity index 100% rename from src/tc_scf/11.tc_scf.bats rename to plugins/local/tc_scf/11.tc_scf.bats diff --git a/src/tc_scf/EZFIO.cfg b/plugins/local/tc_scf/EZFIO.cfg similarity index 100% rename from src/tc_scf/EZFIO.cfg rename to plugins/local/tc_scf/EZFIO.cfg diff --git a/src/tc_scf/NEED b/plugins/local/tc_scf/NEED similarity index 100% rename from src/tc_scf/NEED rename to plugins/local/tc_scf/NEED diff --git a/src/tc_scf/combine_lr_tcscf.irp.f b/plugins/local/tc_scf/combine_lr_tcscf.irp.f similarity index 100% rename from src/tc_scf/combine_lr_tcscf.irp.f rename to plugins/local/tc_scf/combine_lr_tcscf.irp.f diff --git a/src/tc_scf/diago_bi_ort_tcfock.irp.f b/plugins/local/tc_scf/diago_bi_ort_tcfock.irp.f similarity index 100% rename from src/tc_scf/diago_bi_ort_tcfock.irp.f rename to plugins/local/tc_scf/diago_bi_ort_tcfock.irp.f diff --git a/src/tc_scf/diago_vartcfock.irp.f b/plugins/local/tc_scf/diago_vartcfock.irp.f similarity index 100% rename from src/tc_scf/diago_vartcfock.irp.f rename to plugins/local/tc_scf/diago_vartcfock.irp.f diff --git a/src/tc_scf/diis_tcscf.irp.f b/plugins/local/tc_scf/diis_tcscf.irp.f similarity index 100% rename from src/tc_scf/diis_tcscf.irp.f rename to plugins/local/tc_scf/diis_tcscf.irp.f diff --git a/src/tc_scf/fock_3e_bi_ortho_cs.irp.f b/plugins/local/tc_scf/fock_3e_bi_ortho_cs.irp.f similarity index 100% rename from src/tc_scf/fock_3e_bi_ortho_cs.irp.f rename to plugins/local/tc_scf/fock_3e_bi_ortho_cs.irp.f diff --git a/src/tc_scf/fock_3e_bi_ortho_os.irp.f b/plugins/local/tc_scf/fock_3e_bi_ortho_os.irp.f similarity index 100% rename from src/tc_scf/fock_3e_bi_ortho_os.irp.f rename to plugins/local/tc_scf/fock_3e_bi_ortho_os.irp.f diff --git a/src/tc_scf/fock_3e_bi_ortho_uhf.irp.f b/plugins/local/tc_scf/fock_3e_bi_ortho_uhf.irp.f similarity index 100% rename from src/tc_scf/fock_3e_bi_ortho_uhf.irp.f rename to plugins/local/tc_scf/fock_3e_bi_ortho_uhf.irp.f diff --git a/src/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f b/plugins/local/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f similarity index 100% rename from src/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f rename to plugins/local/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f diff --git a/src/tc_scf/fock_hermit.irp.f b/plugins/local/tc_scf/fock_hermit.irp.f similarity index 100% rename from src/tc_scf/fock_hermit.irp.f rename to plugins/local/tc_scf/fock_hermit.irp.f diff --git a/src/tc_scf/fock_tc.irp.f b/plugins/local/tc_scf/fock_tc.irp.f similarity index 100% rename from src/tc_scf/fock_tc.irp.f rename to plugins/local/tc_scf/fock_tc.irp.f diff --git a/src/tc_scf/fock_tc_mo_tot.irp.f b/plugins/local/tc_scf/fock_tc_mo_tot.irp.f similarity index 100% rename from src/tc_scf/fock_tc_mo_tot.irp.f rename to plugins/local/tc_scf/fock_tc_mo_tot.irp.f diff --git a/src/tc_scf/fock_three_bi_ortho.irp.f b/plugins/local/tc_scf/fock_three_bi_ortho.irp.f similarity index 100% rename from src/tc_scf/fock_three_bi_ortho.irp.f rename to plugins/local/tc_scf/fock_three_bi_ortho.irp.f diff --git a/src/tc_scf/fock_three_hermit.irp.f b/plugins/local/tc_scf/fock_three_hermit.irp.f similarity index 100% rename from src/tc_scf/fock_three_hermit.irp.f rename to plugins/local/tc_scf/fock_three_hermit.irp.f diff --git a/src/tc_scf/fock_vartc.irp.f b/plugins/local/tc_scf/fock_vartc.irp.f similarity index 100% rename from src/tc_scf/fock_vartc.irp.f rename to plugins/local/tc_scf/fock_vartc.irp.f diff --git a/src/tc_scf/integrals_in_r_stuff.irp.f b/plugins/local/tc_scf/integrals_in_r_stuff.irp.f similarity index 100% rename from src/tc_scf/integrals_in_r_stuff.irp.f rename to plugins/local/tc_scf/integrals_in_r_stuff.irp.f diff --git a/src/tc_scf/minimize_tc_angles.irp.f b/plugins/local/tc_scf/minimize_tc_angles.irp.f similarity index 100% rename from src/tc_scf/minimize_tc_angles.irp.f rename to plugins/local/tc_scf/minimize_tc_angles.irp.f diff --git a/src/tc_scf/molden_lr_mos.irp.f b/plugins/local/tc_scf/molden_lr_mos.irp.f similarity index 100% rename from src/tc_scf/molden_lr_mos.irp.f rename to plugins/local/tc_scf/molden_lr_mos.irp.f diff --git a/src/tc_scf/print_fit_param.irp.f b/plugins/local/tc_scf/print_fit_param.irp.f similarity index 100% rename from src/tc_scf/print_fit_param.irp.f rename to plugins/local/tc_scf/print_fit_param.irp.f diff --git a/src/tc_scf/print_tcscf_energy.irp.f b/plugins/local/tc_scf/print_tcscf_energy.irp.f similarity index 100% rename from src/tc_scf/print_tcscf_energy.irp.f rename to plugins/local/tc_scf/print_tcscf_energy.irp.f diff --git a/src/tc_scf/rh_tcscf_diis.irp.f b/plugins/local/tc_scf/rh_tcscf_diis.irp.f similarity index 100% rename from src/tc_scf/rh_tcscf_diis.irp.f rename to plugins/local/tc_scf/rh_tcscf_diis.irp.f diff --git a/src/tc_scf/rh_tcscf_simple.irp.f b/plugins/local/tc_scf/rh_tcscf_simple.irp.f similarity index 100% rename from src/tc_scf/rh_tcscf_simple.irp.f rename to plugins/local/tc_scf/rh_tcscf_simple.irp.f diff --git a/src/tc_scf/rh_vartcscf_simple.irp.f b/plugins/local/tc_scf/rh_vartcscf_simple.irp.f similarity index 100% rename from src/tc_scf/rh_vartcscf_simple.irp.f rename to plugins/local/tc_scf/rh_vartcscf_simple.irp.f diff --git a/src/tc_scf/rotate_tcscf_orbitals.irp.f b/plugins/local/tc_scf/rotate_tcscf_orbitals.irp.f similarity index 100% rename from src/tc_scf/rotate_tcscf_orbitals.irp.f rename to plugins/local/tc_scf/rotate_tcscf_orbitals.irp.f diff --git a/src/tc_scf/routines_rotates.irp.f b/plugins/local/tc_scf/routines_rotates.irp.f similarity index 100% rename from src/tc_scf/routines_rotates.irp.f rename to plugins/local/tc_scf/routines_rotates.irp.f diff --git a/src/tc_scf/tc_petermann_factor.irp.f b/plugins/local/tc_scf/tc_petermann_factor.irp.f similarity index 100% rename from src/tc_scf/tc_petermann_factor.irp.f rename to plugins/local/tc_scf/tc_petermann_factor.irp.f diff --git a/src/tc_scf/tc_scf.irp.f b/plugins/local/tc_scf/tc_scf.irp.f similarity index 100% rename from src/tc_scf/tc_scf.irp.f rename to plugins/local/tc_scf/tc_scf.irp.f diff --git a/src/tc_scf/tc_scf_dm.irp.f b/plugins/local/tc_scf/tc_scf_dm.irp.f similarity index 100% rename from src/tc_scf/tc_scf_dm.irp.f rename to plugins/local/tc_scf/tc_scf_dm.irp.f diff --git a/src/tc_scf/tc_scf_energy.irp.f b/plugins/local/tc_scf/tc_scf_energy.irp.f similarity index 100% rename from src/tc_scf/tc_scf_energy.irp.f rename to plugins/local/tc_scf/tc_scf_energy.irp.f diff --git a/src/tc_scf/tcscf_energy_naive.irp.f b/plugins/local/tc_scf/tcscf_energy_naive.irp.f similarity index 100% rename from src/tc_scf/tcscf_energy_naive.irp.f rename to plugins/local/tc_scf/tcscf_energy_naive.irp.f diff --git a/src/tc_scf/test_int.irp.f b/plugins/local/tc_scf/test_int.irp.f similarity index 100% rename from src/tc_scf/test_int.irp.f rename to plugins/local/tc_scf/test_int.irp.f diff --git a/src/tc_scf/three_e_energy_bi_ortho.irp.f b/plugins/local/tc_scf/three_e_energy_bi_ortho.irp.f similarity index 100% rename from src/tc_scf/three_e_energy_bi_ortho.irp.f rename to plugins/local/tc_scf/three_e_energy_bi_ortho.irp.f diff --git a/src/utils_trust_region/EZFIO.cfg b/plugins/local/utils_trust_region/EZFIO.cfg similarity index 100% rename from src/utils_trust_region/EZFIO.cfg rename to plugins/local/utils_trust_region/EZFIO.cfg diff --git a/src/utils_trust_region/NEED b/plugins/local/utils_trust_region/NEED similarity index 100% rename from src/utils_trust_region/NEED rename to plugins/local/utils_trust_region/NEED diff --git a/src/utils_trust_region/README.md b/plugins/local/utils_trust_region/README.md similarity index 100% rename from src/utils_trust_region/README.md rename to plugins/local/utils_trust_region/README.md diff --git a/src/utils_trust_region/algo_trust.irp.f b/plugins/local/utils_trust_region/algo_trust.irp.f similarity index 100% rename from src/utils_trust_region/algo_trust.irp.f rename to plugins/local/utils_trust_region/algo_trust.irp.f diff --git a/src/utils_trust_region/apply_mo_rotation.irp.f b/plugins/local/utils_trust_region/apply_mo_rotation.irp.f similarity index 100% rename from src/utils_trust_region/apply_mo_rotation.irp.f rename to plugins/local/utils_trust_region/apply_mo_rotation.irp.f diff --git a/src/utils_trust_region/mat_to_vec_index.irp.f b/plugins/local/utils_trust_region/mat_to_vec_index.irp.f similarity index 100% rename from src/utils_trust_region/mat_to_vec_index.irp.f rename to plugins/local/utils_trust_region/mat_to_vec_index.irp.f diff --git a/src/utils_trust_region/org/TANGLE_org_mode.sh b/plugins/local/utils_trust_region/org/TANGLE_org_mode.sh similarity index 100% rename from src/utils_trust_region/org/TANGLE_org_mode.sh rename to plugins/local/utils_trust_region/org/TANGLE_org_mode.sh diff --git a/src/utils_trust_region/org/algo_trust.org b/plugins/local/utils_trust_region/org/algo_trust.org similarity index 100% rename from src/utils_trust_region/org/algo_trust.org rename to plugins/local/utils_trust_region/org/algo_trust.org diff --git a/src/utils_trust_region/org/apply_mo_rotation.org b/plugins/local/utils_trust_region/org/apply_mo_rotation.org similarity index 100% rename from src/utils_trust_region/org/apply_mo_rotation.org rename to plugins/local/utils_trust_region/org/apply_mo_rotation.org diff --git a/src/utils_trust_region/org/mat_to_vec_index.org b/plugins/local/utils_trust_region/org/mat_to_vec_index.org similarity index 100% rename from src/utils_trust_region/org/mat_to_vec_index.org rename to plugins/local/utils_trust_region/org/mat_to_vec_index.org diff --git a/src/utils_trust_region/org/rotation_matrix.org b/plugins/local/utils_trust_region/org/rotation_matrix.org similarity index 100% rename from src/utils_trust_region/org/rotation_matrix.org rename to plugins/local/utils_trust_region/org/rotation_matrix.org diff --git a/src/utils_trust_region/org/rotation_matrix_iterative.org b/plugins/local/utils_trust_region/org/rotation_matrix_iterative.org similarity index 100% rename from src/utils_trust_region/org/rotation_matrix_iterative.org rename to plugins/local/utils_trust_region/org/rotation_matrix_iterative.org diff --git a/src/utils_trust_region/org/sub_to_full_rotation_matrix.org b/plugins/local/utils_trust_region/org/sub_to_full_rotation_matrix.org similarity index 100% rename from src/utils_trust_region/org/sub_to_full_rotation_matrix.org rename to plugins/local/utils_trust_region/org/sub_to_full_rotation_matrix.org diff --git a/src/utils_trust_region/org/trust_region_expected_e.org b/plugins/local/utils_trust_region/org/trust_region_expected_e.org similarity index 100% rename from src/utils_trust_region/org/trust_region_expected_e.org rename to plugins/local/utils_trust_region/org/trust_region_expected_e.org diff --git a/src/utils_trust_region/org/trust_region_optimal_lambda.org b/plugins/local/utils_trust_region/org/trust_region_optimal_lambda.org similarity index 100% rename from src/utils_trust_region/org/trust_region_optimal_lambda.org rename to plugins/local/utils_trust_region/org/trust_region_optimal_lambda.org diff --git a/src/utils_trust_region/org/trust_region_rho.org b/plugins/local/utils_trust_region/org/trust_region_rho.org similarity index 100% rename from src/utils_trust_region/org/trust_region_rho.org rename to plugins/local/utils_trust_region/org/trust_region_rho.org diff --git a/src/utils_trust_region/org/trust_region_step.org b/plugins/local/utils_trust_region/org/trust_region_step.org similarity index 100% rename from src/utils_trust_region/org/trust_region_step.org rename to plugins/local/utils_trust_region/org/trust_region_step.org diff --git a/src/utils_trust_region/org/vec_to_mat_index.org b/plugins/local/utils_trust_region/org/vec_to_mat_index.org similarity index 100% rename from src/utils_trust_region/org/vec_to_mat_index.org rename to plugins/local/utils_trust_region/org/vec_to_mat_index.org diff --git a/src/utils_trust_region/org/vec_to_mat_v2.org b/plugins/local/utils_trust_region/org/vec_to_mat_v2.org similarity index 100% rename from src/utils_trust_region/org/vec_to_mat_v2.org rename to plugins/local/utils_trust_region/org/vec_to_mat_v2.org diff --git a/src/utils_trust_region/pi.h b/plugins/local/utils_trust_region/pi.h similarity index 100% rename from src/utils_trust_region/pi.h rename to plugins/local/utils_trust_region/pi.h diff --git a/src/utils_trust_region/rotation_matrix.irp.f b/plugins/local/utils_trust_region/rotation_matrix.irp.f similarity index 100% rename from src/utils_trust_region/rotation_matrix.irp.f rename to plugins/local/utils_trust_region/rotation_matrix.irp.f diff --git a/src/utils_trust_region/rotation_matrix_iterative.irp.f b/plugins/local/utils_trust_region/rotation_matrix_iterative.irp.f similarity index 100% rename from src/utils_trust_region/rotation_matrix_iterative.irp.f rename to plugins/local/utils_trust_region/rotation_matrix_iterative.irp.f diff --git a/src/utils_trust_region/sub_to_full_rotation_matrix.irp.f b/plugins/local/utils_trust_region/sub_to_full_rotation_matrix.irp.f similarity index 100% rename from src/utils_trust_region/sub_to_full_rotation_matrix.irp.f rename to plugins/local/utils_trust_region/sub_to_full_rotation_matrix.irp.f diff --git a/src/utils_trust_region/trust_region_expected_e.irp.f b/plugins/local/utils_trust_region/trust_region_expected_e.irp.f similarity index 100% rename from src/utils_trust_region/trust_region_expected_e.irp.f rename to plugins/local/utils_trust_region/trust_region_expected_e.irp.f diff --git a/src/utils_trust_region/trust_region_optimal_lambda.irp.f b/plugins/local/utils_trust_region/trust_region_optimal_lambda.irp.f similarity index 100% rename from src/utils_trust_region/trust_region_optimal_lambda.irp.f rename to plugins/local/utils_trust_region/trust_region_optimal_lambda.irp.f diff --git a/src/utils_trust_region/trust_region_rho.irp.f b/plugins/local/utils_trust_region/trust_region_rho.irp.f similarity index 100% rename from src/utils_trust_region/trust_region_rho.irp.f rename to plugins/local/utils_trust_region/trust_region_rho.irp.f diff --git a/src/utils_trust_region/trust_region_step.irp.f b/plugins/local/utils_trust_region/trust_region_step.irp.f similarity index 100% rename from src/utils_trust_region/trust_region_step.irp.f rename to plugins/local/utils_trust_region/trust_region_step.irp.f diff --git a/src/utils_trust_region/vec_to_mat_index.irp.f b/plugins/local/utils_trust_region/vec_to_mat_index.irp.f similarity index 100% rename from src/utils_trust_region/vec_to_mat_index.irp.f rename to plugins/local/utils_trust_region/vec_to_mat_index.irp.f diff --git a/src/utils_trust_region/vec_to_mat_v2.irp.f b/plugins/local/utils_trust_region/vec_to_mat_v2.irp.f similarity index 100% rename from src/utils_trust_region/vec_to_mat_v2.irp.f rename to plugins/local/utils_trust_region/vec_to_mat_v2.irp.f From 22ed2e8baf1d1711c1f3e7f2ed0117df6a5b54e3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 7 Nov 2023 10:40:56 +0100 Subject: [PATCH 52/84] Fixed configure problem --- {plugins/local => src}/aux_quantities/EZFIO.cfg | 0 {plugins/local => src}/aux_quantities/NEED | 0 {plugins/local => src}/aux_quantities/README.rst | 0 {plugins/local => src}/cas_based_on_top/NEED | 0 {plugins/local => src}/cas_based_on_top/README.rst | 0 {plugins/local => src}/cas_based_on_top/c_i_a_v_mos.irp.f | 0 {plugins/local => src}/cas_based_on_top/cas_based_density.irp.f | 0 {plugins/local => src}/cas_based_on_top/cas_based_on_top.irp.f | 0 {plugins/local => src}/cas_based_on_top/cas_dens_prov.irp.f | 0 {plugins/local => src}/cas_based_on_top/cas_dens_rout.irp.f | 0 {plugins/local => src}/cas_based_on_top/cas_one_e_rdm.irp.f | 0 {plugins/local => src}/cas_based_on_top/eff_spin_dens.irp.f | 0 {plugins/local => src}/cas_based_on_top/example.irp.f | 0 {plugins/local => src}/cas_based_on_top/on_top_cas_prov.irp.f | 0 {plugins/local => src}/cas_based_on_top/on_top_cas_rout.irp.f | 0 {plugins/local => src}/cas_based_on_top/on_top_grad.irp.f | 0 {plugins/local => src}/cas_based_on_top/two_body_dens_rout.irp.f | 0 {plugins/local => src}/mu_of_r/EZFIO.cfg | 0 {plugins/local => src}/mu_of_r/NEED | 0 {plugins/local => src}/mu_of_r/README.rst | 0 {plugins/local => src}/mu_of_r/basis_def.irp.f | 0 {plugins/local => src}/mu_of_r/example.irp.f | 0 {plugins/local => src}/mu_of_r/f_hf_utils.irp.f | 0 {plugins/local => src}/mu_of_r/f_psi_i_a_v_utils.irp.f | 0 {plugins/local => src}/mu_of_r/f_psi_old.irp.f | 0 {plugins/local => src}/mu_of_r/f_psi_utils.irp.f | 0 {plugins/local => src}/mu_of_r/f_val_general.irp.f | 0 {plugins/local => src}/mu_of_r/mu_of_r_conditions.irp.f | 0 {plugins/local => src}/mu_of_r/test_proj_op.irp.f | 0 {plugins/local => src}/utils_trust_region/EZFIO.cfg | 0 {plugins/local => src}/utils_trust_region/NEED | 0 {plugins/local => src}/utils_trust_region/README.md | 0 {plugins/local => src}/utils_trust_region/algo_trust.irp.f | 0 {plugins/local => src}/utils_trust_region/apply_mo_rotation.irp.f | 0 {plugins/local => src}/utils_trust_region/mat_to_vec_index.irp.f | 0 {plugins/local => src}/utils_trust_region/org/TANGLE_org_mode.sh | 0 {plugins/local => src}/utils_trust_region/org/algo_trust.org | 0 .../local => src}/utils_trust_region/org/apply_mo_rotation.org | 0 .../local => src}/utils_trust_region/org/mat_to_vec_index.org | 0 {plugins/local => src}/utils_trust_region/org/rotation_matrix.org | 0 .../utils_trust_region/org/rotation_matrix_iterative.org | 0 .../utils_trust_region/org/sub_to_full_rotation_matrix.org | 0 .../utils_trust_region/org/trust_region_expected_e.org | 0 .../utils_trust_region/org/trust_region_optimal_lambda.org | 0 .../local => src}/utils_trust_region/org/trust_region_rho.org | 0 .../local => src}/utils_trust_region/org/trust_region_step.org | 0 .../local => src}/utils_trust_region/org/vec_to_mat_index.org | 0 {plugins/local => src}/utils_trust_region/org/vec_to_mat_v2.org | 0 {plugins/local => src}/utils_trust_region/pi.h | 0 {plugins/local => src}/utils_trust_region/rotation_matrix.irp.f | 0 .../utils_trust_region/rotation_matrix_iterative.irp.f | 0 .../utils_trust_region/sub_to_full_rotation_matrix.irp.f | 0 .../utils_trust_region/trust_region_expected_e.irp.f | 0 .../utils_trust_region/trust_region_optimal_lambda.irp.f | 0 {plugins/local => src}/utils_trust_region/trust_region_rho.irp.f | 0 {plugins/local => src}/utils_trust_region/trust_region_step.irp.f | 0 {plugins/local => src}/utils_trust_region/vec_to_mat_index.irp.f | 0 {plugins/local => src}/utils_trust_region/vec_to_mat_v2.irp.f | 0 58 files changed, 0 insertions(+), 0 deletions(-) rename {plugins/local => src}/aux_quantities/EZFIO.cfg (100%) rename {plugins/local => src}/aux_quantities/NEED (100%) rename {plugins/local => src}/aux_quantities/README.rst (100%) rename {plugins/local => src}/cas_based_on_top/NEED (100%) rename {plugins/local => src}/cas_based_on_top/README.rst (100%) rename {plugins/local => src}/cas_based_on_top/c_i_a_v_mos.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/cas_based_density.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/cas_based_on_top.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/cas_dens_prov.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/cas_dens_rout.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/cas_one_e_rdm.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/eff_spin_dens.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/example.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/on_top_cas_prov.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/on_top_cas_rout.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/on_top_grad.irp.f (100%) rename {plugins/local => src}/cas_based_on_top/two_body_dens_rout.irp.f (100%) rename {plugins/local => src}/mu_of_r/EZFIO.cfg (100%) rename {plugins/local => src}/mu_of_r/NEED (100%) rename {plugins/local => src}/mu_of_r/README.rst (100%) rename {plugins/local => src}/mu_of_r/basis_def.irp.f (100%) rename {plugins/local => src}/mu_of_r/example.irp.f (100%) rename {plugins/local => src}/mu_of_r/f_hf_utils.irp.f (100%) rename {plugins/local => src}/mu_of_r/f_psi_i_a_v_utils.irp.f (100%) rename {plugins/local => src}/mu_of_r/f_psi_old.irp.f (100%) rename {plugins/local => src}/mu_of_r/f_psi_utils.irp.f (100%) rename {plugins/local => src}/mu_of_r/f_val_general.irp.f (100%) rename {plugins/local => src}/mu_of_r/mu_of_r_conditions.irp.f (100%) rename {plugins/local => src}/mu_of_r/test_proj_op.irp.f (100%) rename {plugins/local => src}/utils_trust_region/EZFIO.cfg (100%) rename {plugins/local => src}/utils_trust_region/NEED (100%) rename {plugins/local => src}/utils_trust_region/README.md (100%) rename {plugins/local => src}/utils_trust_region/algo_trust.irp.f (100%) rename {plugins/local => src}/utils_trust_region/apply_mo_rotation.irp.f (100%) rename {plugins/local => src}/utils_trust_region/mat_to_vec_index.irp.f (100%) rename {plugins/local => src}/utils_trust_region/org/TANGLE_org_mode.sh (100%) rename {plugins/local => src}/utils_trust_region/org/algo_trust.org (100%) rename {plugins/local => src}/utils_trust_region/org/apply_mo_rotation.org (100%) rename {plugins/local => src}/utils_trust_region/org/mat_to_vec_index.org (100%) rename {plugins/local => src}/utils_trust_region/org/rotation_matrix.org (100%) rename {plugins/local => src}/utils_trust_region/org/rotation_matrix_iterative.org (100%) rename {plugins/local => src}/utils_trust_region/org/sub_to_full_rotation_matrix.org (100%) rename {plugins/local => src}/utils_trust_region/org/trust_region_expected_e.org (100%) rename {plugins/local => src}/utils_trust_region/org/trust_region_optimal_lambda.org (100%) rename {plugins/local => src}/utils_trust_region/org/trust_region_rho.org (100%) rename {plugins/local => src}/utils_trust_region/org/trust_region_step.org (100%) rename {plugins/local => src}/utils_trust_region/org/vec_to_mat_index.org (100%) rename {plugins/local => src}/utils_trust_region/org/vec_to_mat_v2.org (100%) rename {plugins/local => src}/utils_trust_region/pi.h (100%) rename {plugins/local => src}/utils_trust_region/rotation_matrix.irp.f (100%) rename {plugins/local => src}/utils_trust_region/rotation_matrix_iterative.irp.f (100%) rename {plugins/local => src}/utils_trust_region/sub_to_full_rotation_matrix.irp.f (100%) rename {plugins/local => src}/utils_trust_region/trust_region_expected_e.irp.f (100%) rename {plugins/local => src}/utils_trust_region/trust_region_optimal_lambda.irp.f (100%) rename {plugins/local => src}/utils_trust_region/trust_region_rho.irp.f (100%) rename {plugins/local => src}/utils_trust_region/trust_region_step.irp.f (100%) rename {plugins/local => src}/utils_trust_region/vec_to_mat_index.irp.f (100%) rename {plugins/local => src}/utils_trust_region/vec_to_mat_v2.irp.f (100%) diff --git a/plugins/local/aux_quantities/EZFIO.cfg b/src/aux_quantities/EZFIO.cfg similarity index 100% rename from plugins/local/aux_quantities/EZFIO.cfg rename to src/aux_quantities/EZFIO.cfg diff --git a/plugins/local/aux_quantities/NEED b/src/aux_quantities/NEED similarity index 100% rename from plugins/local/aux_quantities/NEED rename to src/aux_quantities/NEED diff --git a/plugins/local/aux_quantities/README.rst b/src/aux_quantities/README.rst similarity index 100% rename from plugins/local/aux_quantities/README.rst rename to src/aux_quantities/README.rst diff --git a/plugins/local/cas_based_on_top/NEED b/src/cas_based_on_top/NEED similarity index 100% rename from plugins/local/cas_based_on_top/NEED rename to src/cas_based_on_top/NEED diff --git a/plugins/local/cas_based_on_top/README.rst b/src/cas_based_on_top/README.rst similarity index 100% rename from plugins/local/cas_based_on_top/README.rst rename to src/cas_based_on_top/README.rst diff --git a/plugins/local/cas_based_on_top/c_i_a_v_mos.irp.f b/src/cas_based_on_top/c_i_a_v_mos.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/c_i_a_v_mos.irp.f rename to src/cas_based_on_top/c_i_a_v_mos.irp.f diff --git a/plugins/local/cas_based_on_top/cas_based_density.irp.f b/src/cas_based_on_top/cas_based_density.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/cas_based_density.irp.f rename to src/cas_based_on_top/cas_based_density.irp.f diff --git a/plugins/local/cas_based_on_top/cas_based_on_top.irp.f b/src/cas_based_on_top/cas_based_on_top.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/cas_based_on_top.irp.f rename to src/cas_based_on_top/cas_based_on_top.irp.f diff --git a/plugins/local/cas_based_on_top/cas_dens_prov.irp.f b/src/cas_based_on_top/cas_dens_prov.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/cas_dens_prov.irp.f rename to src/cas_based_on_top/cas_dens_prov.irp.f diff --git a/plugins/local/cas_based_on_top/cas_dens_rout.irp.f b/src/cas_based_on_top/cas_dens_rout.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/cas_dens_rout.irp.f rename to src/cas_based_on_top/cas_dens_rout.irp.f diff --git a/plugins/local/cas_based_on_top/cas_one_e_rdm.irp.f b/src/cas_based_on_top/cas_one_e_rdm.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/cas_one_e_rdm.irp.f rename to src/cas_based_on_top/cas_one_e_rdm.irp.f diff --git a/plugins/local/cas_based_on_top/eff_spin_dens.irp.f b/src/cas_based_on_top/eff_spin_dens.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/eff_spin_dens.irp.f rename to src/cas_based_on_top/eff_spin_dens.irp.f diff --git a/plugins/local/cas_based_on_top/example.irp.f b/src/cas_based_on_top/example.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/example.irp.f rename to src/cas_based_on_top/example.irp.f diff --git a/plugins/local/cas_based_on_top/on_top_cas_prov.irp.f b/src/cas_based_on_top/on_top_cas_prov.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/on_top_cas_prov.irp.f rename to src/cas_based_on_top/on_top_cas_prov.irp.f diff --git a/plugins/local/cas_based_on_top/on_top_cas_rout.irp.f b/src/cas_based_on_top/on_top_cas_rout.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/on_top_cas_rout.irp.f rename to src/cas_based_on_top/on_top_cas_rout.irp.f diff --git a/plugins/local/cas_based_on_top/on_top_grad.irp.f b/src/cas_based_on_top/on_top_grad.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/on_top_grad.irp.f rename to src/cas_based_on_top/on_top_grad.irp.f diff --git a/plugins/local/cas_based_on_top/two_body_dens_rout.irp.f b/src/cas_based_on_top/two_body_dens_rout.irp.f similarity index 100% rename from plugins/local/cas_based_on_top/two_body_dens_rout.irp.f rename to src/cas_based_on_top/two_body_dens_rout.irp.f diff --git a/plugins/local/mu_of_r/EZFIO.cfg b/src/mu_of_r/EZFIO.cfg similarity index 100% rename from plugins/local/mu_of_r/EZFIO.cfg rename to src/mu_of_r/EZFIO.cfg diff --git a/plugins/local/mu_of_r/NEED b/src/mu_of_r/NEED similarity index 100% rename from plugins/local/mu_of_r/NEED rename to src/mu_of_r/NEED diff --git a/plugins/local/mu_of_r/README.rst b/src/mu_of_r/README.rst similarity index 100% rename from plugins/local/mu_of_r/README.rst rename to src/mu_of_r/README.rst diff --git a/plugins/local/mu_of_r/basis_def.irp.f b/src/mu_of_r/basis_def.irp.f similarity index 100% rename from plugins/local/mu_of_r/basis_def.irp.f rename to src/mu_of_r/basis_def.irp.f diff --git a/plugins/local/mu_of_r/example.irp.f b/src/mu_of_r/example.irp.f similarity index 100% rename from plugins/local/mu_of_r/example.irp.f rename to src/mu_of_r/example.irp.f diff --git a/plugins/local/mu_of_r/f_hf_utils.irp.f b/src/mu_of_r/f_hf_utils.irp.f similarity index 100% rename from plugins/local/mu_of_r/f_hf_utils.irp.f rename to src/mu_of_r/f_hf_utils.irp.f diff --git a/plugins/local/mu_of_r/f_psi_i_a_v_utils.irp.f b/src/mu_of_r/f_psi_i_a_v_utils.irp.f similarity index 100% rename from plugins/local/mu_of_r/f_psi_i_a_v_utils.irp.f rename to src/mu_of_r/f_psi_i_a_v_utils.irp.f diff --git a/plugins/local/mu_of_r/f_psi_old.irp.f b/src/mu_of_r/f_psi_old.irp.f similarity index 100% rename from plugins/local/mu_of_r/f_psi_old.irp.f rename to src/mu_of_r/f_psi_old.irp.f diff --git a/plugins/local/mu_of_r/f_psi_utils.irp.f b/src/mu_of_r/f_psi_utils.irp.f similarity index 100% rename from plugins/local/mu_of_r/f_psi_utils.irp.f rename to src/mu_of_r/f_psi_utils.irp.f diff --git a/plugins/local/mu_of_r/f_val_general.irp.f b/src/mu_of_r/f_val_general.irp.f similarity index 100% rename from plugins/local/mu_of_r/f_val_general.irp.f rename to src/mu_of_r/f_val_general.irp.f diff --git a/plugins/local/mu_of_r/mu_of_r_conditions.irp.f b/src/mu_of_r/mu_of_r_conditions.irp.f similarity index 100% rename from plugins/local/mu_of_r/mu_of_r_conditions.irp.f rename to src/mu_of_r/mu_of_r_conditions.irp.f diff --git a/plugins/local/mu_of_r/test_proj_op.irp.f b/src/mu_of_r/test_proj_op.irp.f similarity index 100% rename from plugins/local/mu_of_r/test_proj_op.irp.f rename to src/mu_of_r/test_proj_op.irp.f diff --git a/plugins/local/utils_trust_region/EZFIO.cfg b/src/utils_trust_region/EZFIO.cfg similarity index 100% rename from plugins/local/utils_trust_region/EZFIO.cfg rename to src/utils_trust_region/EZFIO.cfg diff --git a/plugins/local/utils_trust_region/NEED b/src/utils_trust_region/NEED similarity index 100% rename from plugins/local/utils_trust_region/NEED rename to src/utils_trust_region/NEED diff --git a/plugins/local/utils_trust_region/README.md b/src/utils_trust_region/README.md similarity index 100% rename from plugins/local/utils_trust_region/README.md rename to src/utils_trust_region/README.md diff --git a/plugins/local/utils_trust_region/algo_trust.irp.f b/src/utils_trust_region/algo_trust.irp.f similarity index 100% rename from plugins/local/utils_trust_region/algo_trust.irp.f rename to src/utils_trust_region/algo_trust.irp.f diff --git a/plugins/local/utils_trust_region/apply_mo_rotation.irp.f b/src/utils_trust_region/apply_mo_rotation.irp.f similarity index 100% rename from plugins/local/utils_trust_region/apply_mo_rotation.irp.f rename to src/utils_trust_region/apply_mo_rotation.irp.f diff --git a/plugins/local/utils_trust_region/mat_to_vec_index.irp.f b/src/utils_trust_region/mat_to_vec_index.irp.f similarity index 100% rename from plugins/local/utils_trust_region/mat_to_vec_index.irp.f rename to src/utils_trust_region/mat_to_vec_index.irp.f diff --git a/plugins/local/utils_trust_region/org/TANGLE_org_mode.sh b/src/utils_trust_region/org/TANGLE_org_mode.sh similarity index 100% rename from plugins/local/utils_trust_region/org/TANGLE_org_mode.sh rename to src/utils_trust_region/org/TANGLE_org_mode.sh diff --git a/plugins/local/utils_trust_region/org/algo_trust.org b/src/utils_trust_region/org/algo_trust.org similarity index 100% rename from plugins/local/utils_trust_region/org/algo_trust.org rename to src/utils_trust_region/org/algo_trust.org diff --git a/plugins/local/utils_trust_region/org/apply_mo_rotation.org b/src/utils_trust_region/org/apply_mo_rotation.org similarity index 100% rename from plugins/local/utils_trust_region/org/apply_mo_rotation.org rename to src/utils_trust_region/org/apply_mo_rotation.org diff --git a/plugins/local/utils_trust_region/org/mat_to_vec_index.org b/src/utils_trust_region/org/mat_to_vec_index.org similarity index 100% rename from plugins/local/utils_trust_region/org/mat_to_vec_index.org rename to src/utils_trust_region/org/mat_to_vec_index.org diff --git a/plugins/local/utils_trust_region/org/rotation_matrix.org b/src/utils_trust_region/org/rotation_matrix.org similarity index 100% rename from plugins/local/utils_trust_region/org/rotation_matrix.org rename to src/utils_trust_region/org/rotation_matrix.org diff --git a/plugins/local/utils_trust_region/org/rotation_matrix_iterative.org b/src/utils_trust_region/org/rotation_matrix_iterative.org similarity index 100% rename from plugins/local/utils_trust_region/org/rotation_matrix_iterative.org rename to src/utils_trust_region/org/rotation_matrix_iterative.org diff --git a/plugins/local/utils_trust_region/org/sub_to_full_rotation_matrix.org b/src/utils_trust_region/org/sub_to_full_rotation_matrix.org similarity index 100% rename from plugins/local/utils_trust_region/org/sub_to_full_rotation_matrix.org rename to src/utils_trust_region/org/sub_to_full_rotation_matrix.org diff --git a/plugins/local/utils_trust_region/org/trust_region_expected_e.org b/src/utils_trust_region/org/trust_region_expected_e.org similarity index 100% rename from plugins/local/utils_trust_region/org/trust_region_expected_e.org rename to src/utils_trust_region/org/trust_region_expected_e.org diff --git a/plugins/local/utils_trust_region/org/trust_region_optimal_lambda.org b/src/utils_trust_region/org/trust_region_optimal_lambda.org similarity index 100% rename from plugins/local/utils_trust_region/org/trust_region_optimal_lambda.org rename to src/utils_trust_region/org/trust_region_optimal_lambda.org diff --git a/plugins/local/utils_trust_region/org/trust_region_rho.org b/src/utils_trust_region/org/trust_region_rho.org similarity index 100% rename from plugins/local/utils_trust_region/org/trust_region_rho.org rename to src/utils_trust_region/org/trust_region_rho.org diff --git a/plugins/local/utils_trust_region/org/trust_region_step.org b/src/utils_trust_region/org/trust_region_step.org similarity index 100% rename from plugins/local/utils_trust_region/org/trust_region_step.org rename to src/utils_trust_region/org/trust_region_step.org diff --git a/plugins/local/utils_trust_region/org/vec_to_mat_index.org b/src/utils_trust_region/org/vec_to_mat_index.org similarity index 100% rename from plugins/local/utils_trust_region/org/vec_to_mat_index.org rename to src/utils_trust_region/org/vec_to_mat_index.org diff --git a/plugins/local/utils_trust_region/org/vec_to_mat_v2.org b/src/utils_trust_region/org/vec_to_mat_v2.org similarity index 100% rename from plugins/local/utils_trust_region/org/vec_to_mat_v2.org rename to src/utils_trust_region/org/vec_to_mat_v2.org diff --git a/plugins/local/utils_trust_region/pi.h b/src/utils_trust_region/pi.h similarity index 100% rename from plugins/local/utils_trust_region/pi.h rename to src/utils_trust_region/pi.h diff --git a/plugins/local/utils_trust_region/rotation_matrix.irp.f b/src/utils_trust_region/rotation_matrix.irp.f similarity index 100% rename from plugins/local/utils_trust_region/rotation_matrix.irp.f rename to src/utils_trust_region/rotation_matrix.irp.f diff --git a/plugins/local/utils_trust_region/rotation_matrix_iterative.irp.f b/src/utils_trust_region/rotation_matrix_iterative.irp.f similarity index 100% rename from plugins/local/utils_trust_region/rotation_matrix_iterative.irp.f rename to src/utils_trust_region/rotation_matrix_iterative.irp.f diff --git a/plugins/local/utils_trust_region/sub_to_full_rotation_matrix.irp.f b/src/utils_trust_region/sub_to_full_rotation_matrix.irp.f similarity index 100% rename from plugins/local/utils_trust_region/sub_to_full_rotation_matrix.irp.f rename to src/utils_trust_region/sub_to_full_rotation_matrix.irp.f diff --git a/plugins/local/utils_trust_region/trust_region_expected_e.irp.f b/src/utils_trust_region/trust_region_expected_e.irp.f similarity index 100% rename from plugins/local/utils_trust_region/trust_region_expected_e.irp.f rename to src/utils_trust_region/trust_region_expected_e.irp.f diff --git a/plugins/local/utils_trust_region/trust_region_optimal_lambda.irp.f b/src/utils_trust_region/trust_region_optimal_lambda.irp.f similarity index 100% rename from plugins/local/utils_trust_region/trust_region_optimal_lambda.irp.f rename to src/utils_trust_region/trust_region_optimal_lambda.irp.f diff --git a/plugins/local/utils_trust_region/trust_region_rho.irp.f b/src/utils_trust_region/trust_region_rho.irp.f similarity index 100% rename from plugins/local/utils_trust_region/trust_region_rho.irp.f rename to src/utils_trust_region/trust_region_rho.irp.f diff --git a/plugins/local/utils_trust_region/trust_region_step.irp.f b/src/utils_trust_region/trust_region_step.irp.f similarity index 100% rename from plugins/local/utils_trust_region/trust_region_step.irp.f rename to src/utils_trust_region/trust_region_step.irp.f diff --git a/plugins/local/utils_trust_region/vec_to_mat_index.irp.f b/src/utils_trust_region/vec_to_mat_index.irp.f similarity index 100% rename from plugins/local/utils_trust_region/vec_to_mat_index.irp.f rename to src/utils_trust_region/vec_to_mat_index.irp.f diff --git a/plugins/local/utils_trust_region/vec_to_mat_v2.irp.f b/src/utils_trust_region/vec_to_mat_v2.irp.f similarity index 100% rename from plugins/local/utils_trust_region/vec_to_mat_v2.irp.f rename to src/utils_trust_region/vec_to_mat_v2.irp.f From 62386b2dbdc1ab3b9e70ba6940e6d9c321e7dffa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 7 Nov 2023 10:42:19 +0100 Subject: [PATCH 53/84] Set qmckl as optional --- configure | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/configure b/configure index 7fd73839..e211cfd7 100755 --- a/configure +++ b/configure @@ -195,7 +195,7 @@ if [[ "${PACKAGES}.x" != ".x" ]] ; then fi if [[ ${PACKAGES} = all ]] ; then - PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats trexio qmckl" + PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats trexio" fi @@ -402,11 +402,11 @@ if [[ ${TREXIO} = $(not_found) ]] ; then fail fi -QMCKL=$(find_lib -lqmckl) -if [[ ${QMCKL} = $(not_found) ]] ; then - error "QMCkl (qmckl | qmckl-intel) is not installed." - fail -fi +#QMCKL=$(find_lib -lqmckl) +#if [[ ${QMCKL} = $(not_found) ]] ; then +# error "QMCkl (qmckl | qmckl-intel) is not installed." +# fail +#fi F77ZMQ=$(find_lib -lzmq -lf77zmq -lpthread) if [[ ${F77ZMQ} = $(not_found) ]] ; then From c41737b49409ee1d85e278bb15bfeace5adeb8e7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 7 Nov 2023 11:12:10 +0100 Subject: [PATCH 54/84] Fixing compilation --- {src => plugins/local}/qmckl/LIB | 0 {src => plugins/local}/qmckl/NEED | 0 {src => plugins/local}/qmckl/README.md | 0 {src => plugins/local}/qmckl/qmckl.F90 | 0 4 files changed, 0 insertions(+), 0 deletions(-) rename {src => plugins/local}/qmckl/LIB (100%) rename {src => plugins/local}/qmckl/NEED (100%) rename {src => plugins/local}/qmckl/README.md (100%) rename {src => plugins/local}/qmckl/qmckl.F90 (100%) diff --git a/src/qmckl/LIB b/plugins/local/qmckl/LIB similarity index 100% rename from src/qmckl/LIB rename to plugins/local/qmckl/LIB diff --git a/src/qmckl/NEED b/plugins/local/qmckl/NEED similarity index 100% rename from src/qmckl/NEED rename to plugins/local/qmckl/NEED diff --git a/src/qmckl/README.md b/plugins/local/qmckl/README.md similarity index 100% rename from src/qmckl/README.md rename to plugins/local/qmckl/README.md diff --git a/src/qmckl/qmckl.F90 b/plugins/local/qmckl/qmckl.F90 similarity index 100% rename from src/qmckl/qmckl.F90 rename to plugins/local/qmckl/qmckl.F90 From c0e76b8f267c3185e20bd24dab9f118f18bc0553 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 7 Nov 2023 11:28:18 +0100 Subject: [PATCH 55/84] More robust zcat --- bin/zcat | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bin/zcat b/bin/zcat index 715d4842..7ccecf07 100755 --- a/bin/zcat +++ b/bin/zcat @@ -16,7 +16,8 @@ with gzip.open("$1", "rt") as f: EOF fi else - command=$(which -a zcat | grep -v 'qp2/bin/' | head -1) + SCRIPTPATH="$( cd -- "$(dirname "$0")" >/dev/null 2>&1 ; pwd -P )" + command=$(which -a zcat | grep -v "$SCRIPTPATH/" | head -1) exec $command $@ fi From 7690a8d654403be06c84ebe89e7f09297243db74 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 7 Nov 2023 11:50:41 +0100 Subject: [PATCH 56/84] Fix bug in casscf --- src/casscf_cipsi/casscf.irp.f | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/casscf_cipsi/casscf.irp.f b/src/casscf_cipsi/casscf.irp.f index ba4d8eea..addca236 100644 --- a/src/casscf_cipsi/casscf.irp.f +++ b/src/casscf_cipsi/casscf.irp.f @@ -58,8 +58,10 @@ subroutine run ! if(n_states == 1)then ! call ezfio_get_casscf_cipsi_energy_pt2(E_PT2) ! call ezfio_get_casscf_cipsi_energy(PT2) - call write_double(6,E_PT2(1:N_states),'E + PT2 energy = ') - call write_double(6,PT2(1:N_states),' PT2 = ') + do istate=1,N_states + call write_double(6,E_PT2(istate),'E + PT2 energy = ') + call write_double(6,PT2(istate),' PT2 = ') + enddo call write_double(6,pt2_max,' PT2_MAX = ') ! endif From d4d4393956fa38b5f2b3eb2e8699bf89e38490ca Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 11 Nov 2023 16:13:23 +0100 Subject: [PATCH 57/84] cas_ful -> cas_full --- ocaml/qptypes_generator.ml | 4 +- plugins/local/basis_correction/README.rst | 2 +- .../local/basis_correction/pbe_on_top.irp.f | 6 +- .../basis_correction/print_routine.irp.f | 14 +- scripts/qp_import_trexio.py | 1 + src/hartree_fock/fock_matrix_hf.irp.f | 1 - src/mo_two_e_ints/mo_bi_integrals_erf.irp.f | 139 ++++++++++++++++-- src/mu_of_r/EZFIO.cfg | 2 +- src/mu_of_r/mu_of_r_conditions.irp.f | 2 +- src/mu_of_r/test_proj_op.irp.f | 2 +- .../state_av_full_orb_2_rdm.irp.f | 9 +- src/utils/constants.include.F | 2 +- 12 files changed, 146 insertions(+), 38 deletions(-) diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index a5ac22f2..32506650 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -154,8 +154,8 @@ let input_ezfio = " * N_int_number : int determinants_n_int - 1 : 30 - N_int > 30 + 1 : 128 + N_int > 128 * Det_number : int determinants_n_det diff --git a/plugins/local/basis_correction/README.rst b/plugins/local/basis_correction/README.rst index 311fec1c..7669a9b2 100644 --- a/plugins/local/basis_correction/README.rst +++ b/plugins/local/basis_correction/README.rst @@ -12,7 +12,7 @@ This basis set correction relies mainy on : When HF is a qualitative representation of the electron pairs (i.e. weakly correlated systems), such an approach for \mu(r) is OK. See for instance JPCL, 10, 2931-2937 (2019) for typical flavours of the results. Thanks to the trivial nature of such a two-body rdm, the equation (22) of J. Chem. Phys. 149, 194301 (2018) can be rewritten in a very efficient way, and therefore the limiting factor of such an approach is the AO->MO four-index transformation of the two-electron integrals. - b) "mu_of_r_potential = cas_ful" uses the two-body rdm of CAS-like wave function (i.e. linear combination of Slater determinants developped in an active space with the MOs stored in the EZFIO folder). + b) "mu_of_r_potential = cas_full" uses the two-body rdm of CAS-like wave function (i.e. linear combination of Slater determinants developped in an active space with the MOs stored in the EZFIO folder). If the CAS is properly chosen (i.e. the CAS-like wave function qualitatively represents the wave function of the systems), then such an approach is OK for \mu(r) even in the case of strong correlation. +) The use of DFT correlation functionals with multi-determinant reference (Ecmd). These functionals are originally defined in the RS-DFT framework (see for instance Theor. Chem. Acc.114, 305(2005)) and design to capture short-range correlation effects. A important quantity arising in the Ecmd is the exact on-top pair density of the system, and the main differences of approximated Ecmd relies on different approximations for the exact on-top pair density. diff --git a/plugins/local/basis_correction/pbe_on_top.irp.f b/plugins/local/basis_correction/pbe_on_top.irp.f index 9167f459..be3a23d7 100644 --- a/plugins/local/basis_correction/pbe_on_top.irp.f +++ b/plugins/local/basis_correction/pbe_on_top.irp.f @@ -39,7 +39,7 @@ grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate) grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate) - if(mu_of_r_potential == "cas_ful")then + if(mu_of_r_potential == "cas_full")then ! You take the on-top of the CAS wave function which is computed with mu(r) on_top = on_top_cas_mu_r(ipoint,istate) else @@ -101,7 +101,7 @@ grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate) grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate) - if(mu_of_r_potential == "cas_ful")then + if(mu_of_r_potential == "cas_full")then ! You take the on-top of the CAS wave function which is computed with mu(r) on_top = on_top_cas_mu_r(ipoint,istate) else @@ -163,7 +163,7 @@ grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate) grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate) - if(mu_of_r_potential == "cas_ful")then + if(mu_of_r_potential == "cas_full")then ! You take the on-top of the CAS wave function which is computed with mu(r) on_top = on_top_cas_mu_r(ipoint,istate) else diff --git a/plugins/local/basis_correction/print_routine.irp.f b/plugins/local/basis_correction/print_routine.irp.f index c2558d22..96faba30 100644 --- a/plugins/local/basis_correction/print_routine.irp.f +++ b/plugins/local/basis_correction/print_routine.irp.f @@ -4,8 +4,8 @@ subroutine print_basis_correction provide mu_average_prov if(mu_of_r_potential.EQ."hf")then provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r - else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated")then - provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r + else if(mu_of_r_potential.EQ."cas_full".or.mu_of_r_potential.EQ."cas_truncated")then + provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r provide ecmd_pbe_on_top_mu_of_r ecmd_pbe_on_top_su_mu_of_r endif @@ -25,7 +25,7 @@ subroutine print_basis_correction if(mu_of_r_potential.EQ."hf")then print*, '' print*,'Using a HF-like two-body density to define mu(r)' - print*,'This assumes that HF is a qualitative representation of the wave function ' + print*,'This assumes that HF is a qualitative representation of the wave function ' print*,'********************************************' print*,'Functionals more suited for weak correlation' print*,'********************************************' @@ -38,10 +38,10 @@ subroutine print_basis_correction write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-UEG , state ',istate,' = ',ecmd_pbe_ueg_mu_of_r(istate) enddo - else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then + else if(mu_of_r_potential.EQ."cas_full".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then print*, '' print*,'Using a CAS-like two-body density to define mu(r)' - print*,'This assumes that the CAS is a qualitative representation of the wave function ' + print*,'This assumes that the CAS is a qualitative representation of the wave function ' print*,'********************************************' print*,'Functionals more suited for weak correlation' print*,'********************************************' @@ -56,14 +56,14 @@ subroutine print_basis_correction print*,'' print*,'********************************************' print*,'********************************************' - print*,'+) PBE-on-top Ecmd functional : JCP, 152, 174104 (2020) ' + print*,'+) PBE-on-top Ecmd functional : JCP, 152, 174104 (2020) ' print*,'PBE at mu=0, extrapolated ontop pair density at large mu, usual spin-polarization' do istate = 1, N_states write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-OT , state ',istate,' = ',ecmd_pbe_on_top_mu_of_r(istate) enddo print*,'' print*,'********************************************' - print*,'+) PBE-on-top no spin polarization Ecmd functional : JCP, 152, 174104 (2020)' + print*,'+) PBE-on-top no spin polarization Ecmd functional : JCP, 152, 174104 (2020)' print*,'PBE at mu=0, extrapolated ontop pair density at large mu, and ZERO SPIN POLARIZATION' do istate = 1, N_states write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD SU-PBE-OT , state ',istate,' = ',ecmd_pbe_on_top_su_mu_of_r(istate) diff --git a/scripts/qp_import_trexio.py b/scripts/qp_import_trexio.py index b3222601..9251a1b0 100755 --- a/scripts/qp_import_trexio.py +++ b/scripts/qp_import_trexio.py @@ -142,6 +142,7 @@ def write_ezfio(trexio_filename, filename): try: basis_type = trexio.read_basis_type(trexio_file) + print ("BASIS TYPE: ", basis_type.lower()) if basis_type.lower() in ["gaussian", "slater"]: shell_num = trexio.read_basis_shell_num(trexio_file) prim_num = trexio.read_basis_prim_num(trexio_file) diff --git a/src/hartree_fock/fock_matrix_hf.irp.f b/src/hartree_fock/fock_matrix_hf.irp.f index a5ab6a60..65b3d63c 100644 --- a/src/hartree_fock/fock_matrix_hf.irp.f +++ b/src/hartree_fock/fock_matrix_hf.irp.f @@ -174,7 +174,6 @@ END_PROVIDER allocate (X(cholesky_ao_num)) - ! X(j) = \sum_{mn} SCF_density_matrix_ao(m,n) * cholesky_ao(m,n,j) call dgemm('T','N',cholesky_ao_num,1,ao_num*ao_num,1.d0, & cholesky_ao, ao_num*ao_num, & diff --git a/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f index 1afc1f3c..a1910fd4 100644 --- a/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f @@ -31,37 +31,144 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_erf_in_map ] PROVIDE mo_class - real :: map_mb - mo_two_e_integrals_erf_in_map = .True. if (read_mo_two_e_integrals_erf) then print*,'Reading the MO integrals_erf' call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_erf',mo_integrals_erf_map) print*, 'MO integrals_erf provided' return - else - PROVIDE ao_two_e_integrals_erf_in_map endif - ! call four_index_transform_block(ao_integrals_erf_map,mo_integrals_erf_map, & - ! mo_coef, size(mo_coef,1), & - ! 1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, & - ! 1, 1, 1, 1, mo_num, mo_num, mo_num, mo_num) - call add_integrals_to_map_erf(full_ijkl_bitmask_4) - integer*8 :: get_mo_erf_map_size, mo_erf_map_size - mo_erf_map_size = get_mo_erf_map_size() + PROVIDE ao_two_e_integrals_erf_in_map -! print*,'Molecular integrals ERF provided:' -! print*,' Size of MO ERF map ', map_mb(mo_integrals_erf_map) ,'MB' -! print*,' Number of MO ERF integrals: ', mo_erf_map_size - if (write_mo_two_e_integrals_erf) then + print *, '' + print *, 'AO -> MO ERF integrals transformation' + print *, '-------------------------------------' + print *, '' + + call wall_time(wall_1) + call cpu_time(cpu_1) + + if (dble(ao_num)**4 * 32.d-9 < dble(qp_max_mem)) then + call four_idx_dgemm_erf + else + call add_integrals_to_map_erf(full_ijkl_bitmask_4) + endif + + call wall_time(wall_2) + call cpu_time(cpu_2) + + integer*8 :: get_mo_erf_map_size, mo_erf_map_size + mo_erf_map_size = get_mo_erf_map_size() + + double precision, external :: map_mb + print*,'Molecular integrals provided:' + print*,' Size of MO map ', map_mb(mo_integrals_erf_map) ,'MB' + print*,' Number of MO integrals: ', mo_erf_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), ')' + + if (write_mo_two_e_integrals_erf.and.mpi_master) then call ezfio_set_work_empty(.False.) call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_erf',mo_integrals_erf_map) - call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals_erf("Read") + call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals_erf('Read') endif END_PROVIDER +subroutine four_idx_dgemm_erf + implicit none + integer :: p,q,r,s,i,j,k,l + double precision, allocatable :: a1(:,:,:,:) + double precision, allocatable :: a2(:,:,:,:) + + if (ao_num > 1289) then + print *, irp_here, ': Integer overflow in ao_num**3' + endif + + allocate (a1(ao_num,ao_num,ao_num,ao_num)) + + print *, 'Getting AOs' + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(q,r,s) + do s=1,ao_num + do r=1,ao_num + do q=1,ao_num + call get_ao_two_e_integrals_erf(q,r,s,ao_num,a1(1,q,r,s)) + enddo + enddo + enddo + !$OMP END PARALLEL DO + + + print *, '1st transformation' + ! 1st transformation + allocate (a2(ao_num,ao_num,ao_num,mo_num)) + call dgemm('T','N', (ao_num*ao_num*ao_num), mo_num, ao_num, 1.d0, a1, ao_num, mo_coef, ao_num, 0.d0, a2, (ao_num*ao_num*ao_num)) + + ! 2nd transformation + print *, '2nd transformation' + deallocate (a1) + allocate (a1(ao_num,ao_num,mo_num,mo_num)) + call dgemm('T','N', (ao_num*ao_num*mo_num), mo_num, ao_num, 1.d0, a2, ao_num, mo_coef, ao_num, 0.d0, a1, (ao_num*ao_num*mo_num)) + + ! 3rd transformation + print *, '3rd transformation' + deallocate (a2) + allocate (a2(ao_num,mo_num,mo_num,mo_num)) + call dgemm('T','N', (ao_num*mo_num*mo_num), mo_num, ao_num, 1.d0, a1, ao_num, mo_coef, ao_num, 0.d0, a2, (ao_num*mo_num*mo_num)) + + ! 4th transformation + print *, '4th transformation' + deallocate (a1) + allocate (a1(mo_num,mo_num,mo_num,mo_num)) + call dgemm('T','N', (mo_num*mo_num*mo_num), mo_num, ao_num, 1.d0, a2, ao_num, mo_coef, ao_num, 0.d0, a1, (mo_num*mo_num*mo_num)) + + deallocate (a2) + + integer :: n_integrals, size_buffer + integer(key_kind) , allocatable :: buffer_i(:) + real(integral_kind), allocatable :: buffer_value(:) + size_buffer = min(ao_num*ao_num*ao_num,16000000) + + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l,buffer_value,buffer_i,n_integrals) + allocate ( buffer_i(size_buffer), buffer_value(size_buffer) ) + + n_integrals = 0 + !$OMP DO + do l=1,mo_num + do k=1,mo_num + do j=1,l + do i=1,k + if (abs(a1(i,j,k,l)) < mo_integrals_threshold) then + cycle + endif + n_integrals += 1 + buffer_value(n_integrals) = a1(i,j,k,l) + !DIR$ FORCEINLINE + call mo_two_e_integrals_index(i,j,k,l,buffer_i(n_integrals)) + if (n_integrals == size_buffer) then + call map_append(mo_integrals_erf_map, buffer_i, buffer_value, n_integrals) + n_integrals = 0 + endif + enddo + enddo + enddo + enddo + !$OMP END DO + + call map_append(mo_integrals_erf_map, buffer_i, buffer_value, n_integrals) + + deallocate(buffer_i, buffer_value) + !$OMP END PARALLEL + + deallocate (a1) + + call map_sort(mo_integrals_erf_map) + call map_unique(mo_integrals_erf_map) + +end subroutine + + BEGIN_PROVIDER [ double precision, mo_two_e_int_erf_jj_from_ao, (mo_num,mo_num) ] &BEGIN_PROVIDER [ double precision, mo_two_e_int_erf_jj_exchange_from_ao, (mo_num,mo_num) ] diff --git a/src/mu_of_r/EZFIO.cfg b/src/mu_of_r/EZFIO.cfg index c774ec82..a66b00ef 100644 --- a/src/mu_of_r/EZFIO.cfg +++ b/src/mu_of_r/EZFIO.cfg @@ -6,7 +6,7 @@ size: (becke_numerical_grid.n_points_final_grid,determinants.n_states) [mu_of_r_potential] type: character*(32) -doc: type of potential for the mu(r) interaction: can be [ hf| cas_ful | cas_truncated | pure_act] +doc: type of potential for the mu(r) interaction: can be [ hf| cas_full | cas_truncated | pure_act] interface: ezfio, provider, ocaml default: hf diff --git a/src/mu_of_r/mu_of_r_conditions.irp.f b/src/mu_of_r/mu_of_r_conditions.irp.f index 959950a6..6b49b9df 100644 --- a/src/mu_of_r/mu_of_r_conditions.irp.f +++ b/src/mu_of_r/mu_of_r_conditions.irp.f @@ -26,7 +26,7 @@ do ipoint = 1, n_points_final_grid if(mu_of_r_potential.EQ."hf")then mu_of_r_prov(ipoint,istate) = mu_of_r_hf(ipoint) - else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then + else if(mu_of_r_potential.EQ."cas_full".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then mu_of_r_prov(ipoint,istate) = mu_of_r_psi_cas(ipoint,istate) else print*,'you requested the following mu_of_r_potential' diff --git a/src/mu_of_r/test_proj_op.irp.f b/src/mu_of_r/test_proj_op.irp.f index 1d46da5e..f9aba094 100644 --- a/src/mu_of_r/test_proj_op.irp.f +++ b/src/mu_of_r/test_proj_op.irp.f @@ -9,7 +9,7 @@ program projected_operators ! orbitals coming from core no_core_density = .True. touch no_core_density - mu_of_r_potential = "cas_ful" + mu_of_r_potential = "cas_full" touch mu_of_r_potential print*,'Using Valence Only functions' ! call test_f_HF_valence_ab diff --git a/src/two_body_rdm/state_av_full_orb_2_rdm.irp.f b/src/two_body_rdm/state_av_full_orb_2_rdm.irp.f index 5fb9e475..851e6b24 100644 --- a/src/two_body_rdm/state_av_full_orb_2_rdm.irp.f +++ b/src/two_body_rdm/state_av_full_orb_2_rdm.irp.f @@ -8,7 +8,7 @@ ! ! = \sum_{istate} w(istate) * ! -! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active +! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active ! ! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\alpha} * N_{\beta} * 2 ! @@ -149,7 +149,7 @@ ! ! = \sum_{istate} w(istate) * ! -! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active +! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active ! ! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\alpha} * (N_{\alpha} - 1) ! @@ -262,7 +262,7 @@ ! ! = \sum_{istate} w(istate) * ! -! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active +! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active ! ! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\beta} * (N_{\beta} - 1) ! @@ -376,7 +376,7 @@ ! = \sum_{istate} w(istate) * \sum_{sigma,sigma'} ! ! -! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active +! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active ! ! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{elec} * (N_{elec} - 1) ! @@ -619,3 +619,4 @@ !$OMP END PARALLEL END_PROVIDER + diff --git a/src/utils/constants.include.F b/src/utils/constants.include.F index d1727701..422eff95 100644 --- a/src/utils/constants.include.F +++ b/src/utils/constants.include.F @@ -1,6 +1,6 @@ integer, parameter :: max_dim = 511 integer, parameter :: SIMD_vector = 32 -integer, parameter :: N_int_max = 32 +integer, parameter :: N_int_max = 128 double precision, parameter :: pi = dacos(-1.d0) double precision, parameter :: inv_pi = 1.d0/dacos(-1.d0) From 6a1c10f4fb1e75954a4e0053acf8ec171e89a108 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 16 Nov 2023 19:21:18 +0100 Subject: [PATCH 58/84] Fix missing mo_label in qp_convert --- bin/qp_convert_output_to_ezfio | 1 + 1 file changed, 1 insertion(+) diff --git a/bin/qp_convert_output_to_ezfio b/bin/qp_convert_output_to_ezfio index 091423e4..0523b6a7 100755 --- a/bin/qp_convert_output_to_ezfio +++ b/bin/qp_convert_output_to_ezfio @@ -256,6 +256,7 @@ def write_ezfio(res, filename): MoTag = res.determinants_mo_type ezfio.set_mo_basis_mo_label('Orthonormalized') + ezfio.set_determinants_mo_label('Orthonormalized') MO_type = MoTag allMOs = res.mo_sets[MO_type] From 6e8b1e5d0c6a4a61efe0c164c76b13abda647722 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 17 Nov 2023 14:56:25 +0100 Subject: [PATCH 59/84] added density matrix nstates on AO basis --- src/determinants/density_matrix.irp.f | 32 ++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index ce4d96c2..af035a2a 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -445,7 +445,7 @@ END_PROVIDER mo_beta = one_e_dm_mo_beta_average(j,i) ! if(dabs(dm_mo).le.1.d-10)cycle one_e_dm_ao_alpha(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_alpha - one_e_dm_ao_beta(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_beta + one_e_dm_ao_beta(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_beta enddo enddo enddo @@ -453,6 +453,36 @@ END_PROVIDER END_PROVIDER + BEGIN_PROVIDER [ double precision, one_e_dm_ao_alpha_nstates, (ao_num,ao_num,N_states) ] +&BEGIN_PROVIDER [ double precision, one_e_dm_ao_beta_nstates, (ao_num,ao_num,N_states) ] + BEGIN_DOC + ! One body density matrix on the |AO| basis : $\rho_{AO}(\alpha), \rho_{AO}(\beta)$. + END_DOC + implicit none + integer :: i,j,k,l,istate + double precision :: mo_alpha,mo_beta + + one_e_dm_ao_alpha_nstates = 0.d0 + one_e_dm_ao_beta_nstates = 0.d0 + do istate = 1, N_states + do k = 1, ao_num + do l = 1, ao_num + do i = 1, mo_num + do j = 1, mo_num + mo_alpha = one_e_dm_mo_alpha(j,i,istate) + mo_beta = one_e_dm_mo_beta(j,i,istate) + ! if(dabs(dm_mo).le.1.d-10)cycle + one_e_dm_ao_alpha_nstates(l,k,istate) += mo_coef(k,i) * mo_coef(l,j) * mo_alpha + one_e_dm_ao_beta_nstates(l,k,istate) += mo_coef(k,i) * mo_coef(l,j) * mo_beta + enddo + enddo + enddo + enddo + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ double precision, one_e_dm_ao, (ao_num, ao_num)] implicit none BEGIN_DOC From b25489e14c5b1bd73c26eecfc9396b118d4f600a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 27 Nov 2023 14:25:05 +0100 Subject: [PATCH 60/84] Fix modifying determinants before mo_label exists --- ocaml/Input_determinants_by_hand.ml | 33 +++++++++++++++++++++++------ src/trexio/EZFIO.cfg | 2 +- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index fb0aef7f..0cc47f63 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -13,6 +13,7 @@ module Determinants_by_hand : sig psi_coef : Det_coef.t array; psi_det : Determinant.t array; state_average_weight : Positive_float.t array; + mo_label : MO_label.t; } [@@deriving sexp] val read : ?full:bool -> unit -> t option val write : ?force:bool -> t -> unit @@ -34,11 +35,21 @@ end = struct psi_coef : Det_coef.t array; psi_det : Determinant.t array; state_average_weight : Positive_float.t array; + mo_label : MO_label.t; } [@@deriving sexp] ;; let get_default = Qpackage.get_ezfio_default "determinants";; + let read_mo_label () = + if not (Ezfio.has_determinants_mo_label ()) then + if Ezfio.has_mo_basis_mo_label () then ( + let label = Ezfio.get_mo_basis_mo_label () in + Ezfio.set_determinants_mo_label label) ; + Ezfio.get_determinants_mo_label () + |> MO_label.of_string + ;; + let read_n_int () = if not (Ezfio.has_determinants_n_int()) then Ezfio.get_mo_basis_mo_num () @@ -222,7 +233,7 @@ end = struct and n_states = States_number.to_int n_states in - let r = + let r = Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c in Ezfio.set_determinants_psi_coef r; @@ -283,19 +294,23 @@ end = struct |> Array.concat |> Array.to_list in - let r = + let r = Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; Det_number.to_int n_det |] ~data:data in Ezfio.set_determinants_psi_det r; Ezfio.set_determinants_psi_det_qp_edit r ;; + let write_mo_label a = + MO_label.to_string a + |> Ezfio.set_determinants_mo_label + let read ?(full=true) () = let n_det_qp_edit = read_n_det_qp_edit () in let n_det = read_n_det () in - let read_only = + let read_only = if full then false else n_det_qp_edit <> n_det in @@ -311,6 +326,7 @@ end = struct psi_det = read_psi_det ~read_only () ; n_states = read_n_states () ; state_average_weight = read_state_average_weight () ; + mo_label = read_mo_label () ; } with _ -> None else @@ -328,6 +344,7 @@ end = struct psi_det ; n_states ; state_average_weight ; + mo_label ; } = write_n_int n_int ; write_bit_kind bit_kind; @@ -340,7 +357,9 @@ end = struct write_psi_coef ~n_det:n_det ~n_states:n_states psi_coef ; write_psi_det ~n_int:n_int ~n_det:n_det psi_det end; - write_state_average_weight state_average_weight + write_state_average_weight state_average_weight ; + write_mo_label mo_label ; + () ;; @@ -439,7 +458,7 @@ psi_det = %s in (* Split into header and determinants data *) - let idx = + let idx = match String_ext.substr_index r ~pos:0 ~pattern:"\nDeterminants" with | Some x -> x | None -> assert false @@ -545,6 +564,8 @@ psi_det = %s let bitkind = Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind |> Bit_kind.to_int) + and mo_label = + Printf.sprintf "(mo_label %s)" (MO_label.to_string @@ read_mo_label ()) and n_int = Printf.sprintf "(n_int %d)" (N_int_number.get_max ()) and n_states = @@ -553,7 +574,7 @@ psi_det = %s Printf.sprintf "(n_det_qp_edit %d)" (Det_number.to_int @@ read_n_det_qp_edit ()) in let s = - String.concat "" [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ] + String.concat "" [ header ; mo_label ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ] in diff --git a/src/trexio/EZFIO.cfg b/src/trexio/EZFIO.cfg index 8c11478e..88828520 100644 --- a/src/trexio/EZFIO.cfg +++ b/src/trexio/EZFIO.cfg @@ -18,7 +18,7 @@ default: True [export_mos] type: logical -doc: If True, export basis set and AOs +doc: If True, export MO coefficients interface: ezfio, ocaml, provider default: True From 4f296efb662715a1b33bfd1cecb80da27669537f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 5 Dec 2023 17:19:47 +0100 Subject: [PATCH 61/84] Fixed qp_export_as_tgz --- {src/ccsd/org => scripts}/TANGLE_org_mode.sh | 0 src/mo_optimization/org/TANGLE_org_mode.sh | 7 ------- src/utils_cc/org/TANGLE_org_mode.sh | 7 ------- src/utils_trust_region/org/TANGLE_org_mode.sh | 7 ------- 4 files changed, 21 deletions(-) rename {src/ccsd/org => scripts}/TANGLE_org_mode.sh (100%) delete mode 100755 src/mo_optimization/org/TANGLE_org_mode.sh delete mode 100755 src/utils_cc/org/TANGLE_org_mode.sh delete mode 100755 src/utils_trust_region/org/TANGLE_org_mode.sh diff --git a/src/ccsd/org/TANGLE_org_mode.sh b/scripts/TANGLE_org_mode.sh similarity index 100% rename from src/ccsd/org/TANGLE_org_mode.sh rename to scripts/TANGLE_org_mode.sh diff --git a/src/mo_optimization/org/TANGLE_org_mode.sh b/src/mo_optimization/org/TANGLE_org_mode.sh deleted file mode 100755 index 059cbe7d..00000000 --- a/src/mo_optimization/org/TANGLE_org_mode.sh +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh - -list='ls *.org' -for element in $list -do - emacs --batch $element -f org-babel-tangle -done diff --git a/src/utils_cc/org/TANGLE_org_mode.sh b/src/utils_cc/org/TANGLE_org_mode.sh deleted file mode 100755 index 059cbe7d..00000000 --- a/src/utils_cc/org/TANGLE_org_mode.sh +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh - -list='ls *.org' -for element in $list -do - emacs --batch $element -f org-babel-tangle -done diff --git a/src/utils_trust_region/org/TANGLE_org_mode.sh b/src/utils_trust_region/org/TANGLE_org_mode.sh deleted file mode 100755 index 059cbe7d..00000000 --- a/src/utils_trust_region/org/TANGLE_org_mode.sh +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh - -list='ls *.org' -for element in $list -do - emacs --batch $element -f org-babel-tangle -done From 6235c2015d98c2ed1f89eeca13555cff0e7c8785 Mon Sep 17 00:00:00 2001 From: Abdallah Ammar Date: Fri, 22 Dec 2023 20:15:58 +0100 Subject: [PATCH 62/84] added non-sym diag for tc-rpa --- .../dav_ext_rout_nonsym_B1space.irp.f | 2 +- src/hartree_fock/print_scf_int.irp.f | 114 +++++++++++ .../lapack_diag_non_hermit.irp.f | 41 ++-- src/tc_bi_ortho/drpa_matrix.irp.f | 116 ----------- src/tc_bi_ortho/tc_effect_int.irp.f | 39 ---- src/tc_bi_ortho/tc_rpa.irp.f | 181 ------------------ src/utils/util.irp.f | 40 ++++ 7 files changed, 182 insertions(+), 351 deletions(-) create mode 100644 src/hartree_fock/print_scf_int.irp.f delete mode 100644 src/tc_bi_ortho/drpa_matrix.irp.f delete mode 100644 src/tc_bi_ortho/tc_effect_int.irp.f delete mode 100644 src/tc_bi_ortho/tc_rpa.irp.f diff --git a/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f b/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f index 4b7b9cc9..d89aaadb 100644 --- a/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f +++ b/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f @@ -346,7 +346,7 @@ subroutine davidson_general_ext_rout_nonsym_b1space(u_in, H_jj, energies, sze, N endif if(i_omax(l) .ne. l) then - print *, ' !!! WARNONG !!!' + print *, ' !!! WARNING !!!' print *, ' index of state', l, i_omax(l) endif enddo diff --git a/src/hartree_fock/print_scf_int.irp.f b/src/hartree_fock/print_scf_int.irp.f new file mode 100644 index 00000000..ee7590f6 --- /dev/null +++ b/src/hartree_fock/print_scf_int.irp.f @@ -0,0 +1,114 @@ + +program print_scf_int + + call main() + +end + +subroutine main() + + implicit none + integer :: i, j, k, l + + print *, " Hcore:" + do j = 1, ao_num + do i = 1, ao_num + print *, i, j, ao_one_e_integrals(i,j) + enddo + enddo + + print *, " P:" + do j = 1, ao_num + do i = 1, ao_num + print *, i, j, SCF_density_matrix_ao_alpha(i,j) + enddo + enddo + + + double precision :: integ, density_a, density_b, density + double precision :: J_scf(ao_num, ao_num) + double precision :: K_scf(ao_num, ao_num) + + + double precision, external :: get_ao_two_e_integral + PROVIDE ao_integrals_map + + print *, " J:" + !do j = 1, ao_num + ! do l = 1, ao_num + ! do i = 1, ao_num + ! do k = 1, ao_num + ! ! < 1:k, 2:l | 1:i, 2:j > + ! print *, '< k l | i j >', k, l, i, j + ! print *, get_ao_two_e_integral(i, j, k, l, ao_integrals_map) + ! enddo + ! enddo + ! enddo + !enddo + + !do k = 1, ao_num + ! do i = 1, ao_num + ! do j = 1, ao_num + ! do l = 1, ao_num + ! ! ( 1:k, 1:i | 2:l, 2:j ) + ! print *, '(k i | l j)', k, i, l, j + ! print *, get_ao_two_e_integral(l, j, k, i, ao_integrals_map) + ! enddo + ! enddo + ! print *, '' + ! enddo + !enddo + + J_scf = 0.d0 + K_scf = 0.d0 + do i = 1, ao_num + do k = 1, ao_num + do j = 1, ao_num + do l = 1, ao_num + + density_a = SCF_density_matrix_ao_alpha(l,j) + density_b = SCF_density_matrix_ao_beta (l,j) + density = density_a + density_b + + integ = get_ao_two_e_integral(l, j, k, i, ao_integrals_map) + J_scf(k,i) += density * integ + integ = get_ao_two_e_integral(l, i, k, j, ao_integrals_map) + K_scf(k,i) -= density_a * integ + enddo + enddo + enddo + enddo + + print *, 'J x P' + do i = 1, ao_num + do k = 1, ao_num + print *, k, i, J_scf(k,i) + enddo + enddo + + print *, '' + print *, 'K x P' + do i = 1, ao_num + do k = 1, ao_num + print *, k, i, K_scf(k,i) + enddo + enddo + + print *, '' + print *, 'F in AO' + do i = 1, ao_num + do k = 1, ao_num + print *, k, i, Fock_matrix_ao(k,i) + enddo + enddo + + print *, '' + print *, 'F in MO' + do i = 1, ao_num + do k = 1, ao_num + print *, k, i, 2.d0 * Fock_matrix_mo_alpha(k,i) + enddo + enddo + +end + diff --git a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f b/src/non_hermit_dav/lapack_diag_non_hermit.irp.f index 09fcee24..1144f29f 100644 --- a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f +++ b/src/non_hermit_dav/lapack_diag_non_hermit.irp.f @@ -1883,8 +1883,13 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ enddo accu_nd = dsqrt(accu_nd) / dble(m) - print *, ' accu_nd = ', accu_nd - print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m) + if((accu_nd .gt. thr_nd) .or. dabs(accu_d-dble(m))/dble(m) .gt. thr_d) then + print *, ' non bi-orthogonal vectors !' + print *, ' accu_nd = ', accu_nd + print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m) + else + print *, ' vectors are bi-orthogonaly' + endif ! --- @@ -1994,10 +1999,13 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) ii = ii + 1 endif enddo + if(ii .eq. 0) then print*, ' WARNING: bi-orthogonality is lost but there is no degeneracies' print*, ' rotations may change energy' + stop endif + print *, ii, ' type of degeneracies' ! --- @@ -2018,17 +2026,18 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) call dgemm( 'T', 'N', m, m, n, 1.d0 & , L, size(L, 1), R, size(R, 1) & , 0.d0, S, size(S, 1) ) - print*,'Overlap matrix ' - accu_nd = 0.D0 + + print*, 'Overlap matrix ' + accu_nd = 0.d0 do j = 1, m - write(*,'(100(F16.10,X))') S(1:m,j) - do k = 1, m - if(j==k)cycle - accu_nd += dabs(S(j,k)) - enddo + write(*,'(100(F16.10,X))') S(1:m,j) + do k = 1, m + if(j==k) cycle + accu_nd += dabs(S(j,k)) + enddo enddo print*,'accu_nd = ',accu_nd -! if(accu_nd .gt.1.d-10)then +! if(accu_nd .gt.1.d-10) then ! stop ! endif do j = 1, m @@ -2036,13 +2045,15 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) R0(1:n,i+j-1) = R(1:n,j) enddo - deallocate(L, R,S) + deallocate(L, R, S) endif enddo end subroutine reorder_degen_eigvec +! --- + subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) implicit none @@ -2108,8 +2119,10 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) ! --- -! call impose_orthog_svd(n, m, L) call impose_orthog_svd(n, m, R) + L(:,:) = R(:,:) + + !call impose_orthog_svd(n, m, L) !call impose_orthog_GramSchmidt(n, m, L) !call impose_orthog_GramSchmidt(n, m, R) @@ -2128,8 +2141,8 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) !call bi_ortho_s_inv_half(m, L, R, S_inv_half) !deallocate(S, S_inv_half) - call impose_biorthog_svd(n, m, L, R) -! call impose_biorthog_inverse(n, m, L, R) + !call impose_biorthog_svd(n, m, L, R) + !call impose_biorthog_inverse(n, m, L, R) !call impose_biorthog_qr(n, m, thr_d, thr_nd, L, R) diff --git a/src/tc_bi_ortho/drpa_matrix.irp.f b/src/tc_bi_ortho/drpa_matrix.irp.f deleted file mode 100644 index 56891ca2..00000000 --- a/src/tc_bi_ortho/drpa_matrix.irp.f +++ /dev/null @@ -1,116 +0,0 @@ - -BEGIN_PROVIDER [double precision, M_RPA, (2*nS_exc, 2*nS_exc)] - - BEGIN_DOC - ! - ! full matrix for direct RPA calculation - ! with the TC-Hamiltonian - ! - END_DOC - - implicit none - integer :: ia, i, a, jb, j, b - double precision :: e(mo_num) - double precision, external :: Kronecker_delta - - PROVIDE mo_tc_effec2e_int - PROVIDE Fock_matrix_tc_diag_mo_tot - - e(1:mo_num) = Fock_matrix_tc_diag_mo_tot(1:mo_num) - - - ! --- --- --- - ! block A - - ia = 0 - do i = nC_orb+1, nO_orb - do a = nO_orb+1, mo_num-nR_orb - ia = ia + 1 - - jb = 0 - do j = nC_orb+1, nO_orb - do b = nO_orb+1, mo_num-nR_orb - jb = jb + 1 - - M_RPA(ia,jb) = (e(a) - e(i)) * Kronecker_delta(i,j) * Kronecker_delta(a,b) + 2.d0 * mo_tc_effec2e_int(a,j,i,b) - enddo - enddo - enddo - enddo - - ! - ! --- --- --- - - - ! --- --- --- - ! block B - - ia = 0 - do i = nC_orb+1, nO_orb - do a = nO_orb+1, mo_num-nR_orb - ia = ia + 1 - - jb = nS_exc - do j = nC_orb+1, nO_orb - do b = nO_orb+1, mo_num-nR_orb - jb = jb + 1 - - M_RPA(ia,jb) = 2.d0 * mo_tc_effec2e_int(a,b,i,j) - enddo - enddo - enddo - enddo - - ! - ! --- --- --- - - - ! --- --- --- - ! block C - - ia = nS_exc - do i = nC_orb+1, nO_orb - do a = nO_orb+1, mo_num-nR_orb - ia = ia + 1 - - jb = 0 - do j = nC_orb+1, nO_orb - do b = nO_orb+1, mo_num-nR_orb - jb = jb + 1 - - M_RPA(ia,jb) = 2.d0 * mo_tc_effec2e_int(i,j,a,b) - enddo - enddo - enddo - enddo - - ! - ! --- --- --- - - - ! --- --- --- - ! block D - - ia = nS_exc - do i = nC_orb+1, nO_orb - do a = nO_orb+1, mo_num-nR_orb - ia = ia + 1 - - jb = nS_exc - do j = nC_orb+1, nO_orb - do b = nO_orb+1, mo_num-nR_orb - jb = jb + 1 - - M_RPA(ia,jb) = (e(a) - e(i)) * Kronecker_delta(i,j) * Kronecker_delta(a,b) + 2.d0 * mo_tc_effec2e_int(i,b,a,j) - enddo - enddo - enddo - enddo - - ! - ! --- --- --- - - -END_PROVIDER - - diff --git a/src/tc_bi_ortho/tc_effect_int.irp.f b/src/tc_bi_ortho/tc_effect_int.irp.f deleted file mode 100644 index 48a786d2..00000000 --- a/src/tc_bi_ortho/tc_effect_int.irp.f +++ /dev/null @@ -1,39 +0,0 @@ - - -BEGIN_PROVIDER [double precision, mo_tc_effec2e_int, (mo_num, mo_num, mo_num, mo_num)] - - BEGIN_DOC - ! - ! mo_tc_effec2e_int(p,q,s,t) = < p q| V(12) | s t > + \sum_i < p q i | L(123)| s t i > - ! - ! the potential V(12) contains ALL TWO-E CONTRIBUTION OF THE TC-HAMILTONIAN - ! - END_DOC - - implicit none - integer :: i, j, k, l, ii - double precision :: integral - - PROVIDE mo_bi_ortho_tc_two_e_chemist - - do j = 1, mo_num - do i = 1, mo_num - do l = 1, mo_num - do k = 1, mo_num - mo_tc_effec2e_int(k,l,i,j) = mo_bi_ortho_tc_two_e_chemist(k,i,l,j) - - do ii = 1, elec_alpha_num - call give_integrals_3_body_bi_ort(k, l, ii, i, j, ii, integral) - mo_tc_effec2e_int(k,l,i,j) -= 2.d0 * integral - enddo - enddo - enddo - enddo - enddo - - FREE mo_bi_ortho_tc_two_e_chemist - -END_PROVIDER - -! --- - diff --git a/src/tc_bi_ortho/tc_rpa.irp.f b/src/tc_bi_ortho/tc_rpa.irp.f deleted file mode 100644 index c9818a1d..00000000 --- a/src/tc_bi_ortho/tc_rpa.irp.f +++ /dev/null @@ -1,181 +0,0 @@ -program tc_rpa - - BEGIN_DOC - ! - ! - ! - END_DOC - - my_grid_becke = .True. - PROVIDE tc_grid1_a tc_grid1_r - my_n_pt_r_grid = tc_grid1_r - my_n_pt_a_grid = tc_grid1_a - touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - - if(j1b_type .ge. 100) then - my_extra_grid_becke = .True. - PROVIDE tc_grid2_a tc_grid2_r - my_n_pt_r_extra_grid = tc_grid2_r - my_n_pt_a_extra_grid = tc_grid2_a - touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid - - call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') - call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') - endif - - - call main() - -end - -! --- - -subroutine main() - - implicit none - integer :: i, j, n - integer :: n_good, n_real_eigv - double precision :: thr_cpx, thr_d, thr_nd - double precision :: accu_d, accu_nd - integer, allocatable :: list_good(:), iorder(:) - double precision, allocatable :: WR(:), WI(:), VL(:,:), VR(:,:) - double precision, allocatable :: Omega_p(:), Reigvec_p(:,:), Leigvec_p(:,:) - double precision, allocatable :: Omega_m(:), Reigvec_m(:,:), Leigvec_m(:,:) - double precision, allocatable :: S(:,:) - - PROVIDE M_RPA - - print *, ' ' - print *, ' Computing left/right eigenvectors for TC-RPA ...' - print *, ' ' - - - n = 2 * nS_exc - - thr_cpx = 1d-7 - thr_d = 1d-07 - thr_nd = 1d-07 - - - allocate(WR(n), WI(n), VL(n,n), VR(n,n)) - call lapack_diag_non_sym(n, M_RPA, WR, WI, VL, VR) - FREE M_RPA - - print *, ' excitation energies:' - do i = 1, nS_exc - write(*, '(I3, X, 1000(F16.10,X))') i, WR(i), WI(i) - if(dabs(WI(i)) .gt. thr_cpx) then - print *, ' WARNING ! IMAGINARY EIGENVALUES !!!' - write(*, '(1000(F16.10,X))') WR(i), WI(i+1) - endif - enddo - - print *, ' ' - print *, ' desexcitation energies:' - do i = nS_exc+1, n - write(*, '(I3, X, 1000(F16.10,X))') i, WR(i), WI(i) - if(dabs(WI(i)) .gt. thr_cpx) then - print *, ' WARNING ! IMAGINARY EIGENVALUES !!!' - write(*, '(1000(F16.10,X))') WR(i), WI(i+1) - endif - enddo - - - ! track & sort the real eigenvalues - - n_good = 0 - do i = 1, nS_exc - if(dabs(WI(i)) .lt. thr_cpx) then - if(dabs(WI(nS_exc+i)) .lt. thr_cpx) then - n_good += 1 - endif - endif - enddo - n_real_eigv = n_good - - print *, ' ' - print *, ' nb of real eigenvalues = ', n_real_eigv - print *, ' total nb of eigenvalues = ', nS_exc - - allocate(Omega_p(n_real_eigv), Reigvec_p(n,n_real_eigv), Leigvec_p(n,n_real_eigv)) - allocate(Omega_m(n_real_eigv), Reigvec_m(n,n_real_eigv), Leigvec_m(n,n_real_eigv)) - - n_good = 0 - do i = 1, nS_exc - if(dabs(WI(i)) .lt. thr_cpx) then - if(dabs(WI(nS_exc+i)) .lt. thr_cpx) then - n_good += 1 - - Omega_p(n_good) = WR(i) - do j = 1, n - Reigvec_p(j,n_good) = VR(j,n_good) - Leigvec_p(j,n_good) = VL(j,n_good) - enddo - - Omega_m(n_good) = WR(nS_exc+i) - do j = 1, n - Reigvec_m(j,n_good) = VR(j,nS_exc+n_good) - Leigvec_m(j,n_good) = VL(j,nS_exc+n_good) - enddo - endif - endif - enddo - - deallocate(WR, WI, VL, VR) - - - ! check bi-orthogonality - - ! first block - - allocate(S(n_real_eigv,n_real_eigv)) - - call check_biorthog(n, n_real_eigv, Leigvec_p, Reigvec_p, accu_d, accu_nd, S, thr_d, thr_nd, .false.) - print *, ' accu_d = ', accu_d - print *, ' accu_nd = ', accu_nd - - if((accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .lt. thr_d)) then - print *, ' RPA first-block eigenvectors are normalized and bi-orthogonalized' - else - print *, ' RPA first-block eigenvectors are neither normalized nor bi-orthogonalized' - - call reorder_degen_eigvec(n, Omega_p, Leigvec_p, Reigvec_p) - call impose_biorthog_degen_eigvec(n, Omega_p, Leigvec_p, Reigvec_p) - - call check_biorthog(n, n_real_eigv, Leigvec_p, Reigvec_p, accu_d, accu_nd, S, thr_d, thr_nd, .false.) - if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv)) .gt. thr_d) ) then - call check_biorthog_binormalize(n, n_real_eigv, Leigvec_p, Reigvec_p, thr_d, thr_nd, .true.) - endif - call check_biorthog(n, n_real_eigv, Leigvec_p, Reigvec_p, accu_d, accu_nd, S, thr_d, thr_nd, .true.) - endif - - - ! second block - - call check_biorthog(n, n_real_eigv, Leigvec_m, Reigvec_m, accu_d, accu_nd, S, thr_d, thr_nd, .false.) - print *, ' accu_d = ', accu_d - print *, ' accu_nd = ', accu_nd - - if((accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .lt. thr_d)) then - print *, ' RPA first-block eigenvectors are normalized and bi-orthogonalized' - else - print *, ' RPA first-block eigenvectors are neither normalized nor bi-orthogonalized' - - call reorder_degen_eigvec(n, Omega_m, Leigvec_m, Reigvec_m) - call impose_biorthog_degen_eigvec(n, Omega_m, Leigvec_m, Reigvec_m) - - call check_biorthog(n, n_real_eigv, Leigvec_m, Reigvec_m, accu_d, accu_nd, S, thr_d, thr_nd, .false.) - if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv)) .gt. thr_d) ) then - call check_biorthog_binormalize(n, n_real_eigv, Leigvec_m, Reigvec_m, thr_d, thr_nd, .true.) - endif - call check_biorthog(n, n_real_eigv, Leigvec_m, Reigvec_m, accu_d, accu_nd, S, thr_d, thr_nd, .true.) - endif - - deallocate(S) - - return - -end - -! --- - diff --git a/src/utils/util.irp.f b/src/utils/util.irp.f index 785d6539..97cbde67 100644 --- a/src/utils/util.irp.f +++ b/src/utils/util.irp.f @@ -600,3 +600,43 @@ end function Kronecker_delta ! --- +subroutine diagonalize_sym_matrix(N, A, e) + + BEGIN_DOC + ! + ! Diagonalize a symmetric matrix + ! + END_DOC + + implicit none + + integer, intent(in) :: N + double precision, intent(inout) :: A(N,N) + double precision, intent(out) :: e(N) + + integer :: lwork, info + double precision, allocatable :: work(:) + + allocate(work(1)) + + lwork = -1 + call dsyev('V', 'U', N, A, N, e, work, lwork, info) + lwork = int(work(1)) + + deallocate(work) + + allocate(work(lwork)) + + call dsyev('V', 'U', N, A, N, e, work, lwork, info) + deallocate(work) + + if(info /= 0) then + print*,'Problem in diagonalize_sym_matrix (dsyev)!!' + endif + +end subroutine diagonalize_sym_matrix + +! --- + + + From 368450f72bec8e20f80d57c582d38eb5bf3763ec Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Sat, 23 Dec 2023 12:32:02 +0100 Subject: [PATCH 63/84] few modif in tc-scf --- plugins/local/non_hermit_dav/biorthog.irp.f | 15 ++++---- .../lapack_diag_non_hermit.irp.f | 11 +++--- src/tc_bi_ortho/ORBITALS.irp.f | 38 ------------------- 3 files changed, 14 insertions(+), 50 deletions(-) delete mode 100644 src/tc_bi_ortho/ORBITALS.irp.f diff --git a/plugins/local/non_hermit_dav/biorthog.irp.f b/plugins/local/non_hermit_dav/biorthog.irp.f index 13917c5a..87a118f4 100644 --- a/plugins/local/non_hermit_dav/biorthog.irp.f +++ b/plugins/local/non_hermit_dav/biorthog.irp.f @@ -386,7 +386,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei thr_diag = 1d-06 thr_norm = 1d+10 - call check_EIGVEC(n, n, A, WR, VL, VR, thr_diag, thr_norm, .false.) + !call check_EIGVEC(n, n, A, WR, VL, VR, thr_diag, thr_norm, .false.) ! ! ------------------------------------------------------------------------------------- @@ -479,15 +479,16 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei return ! accu_nd is modified after adding the normalization - !elseif( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .gt. thr_d) ) then + elseif( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .gt. thr_d) ) then - ! print *, ' lapack vectors are not normalized but bi-orthogonalized' - ! call check_biorthog_binormalize(n, n_real_eigv, leigvec, reigvec, thr_d, thr_nd, .true.) + print *, ' lapack vectors are not normalized but bi-orthogonalized' + call check_biorthog_binormalize(n, n_real_eigv, leigvec, reigvec, thr_d, thr_nd, .true.) - ! call check_EIGVEC(n, n, A, eigval, leigvec, reigvec, thr_diag, thr_norm, .true.) + call check_biorthog(n, n_real_eigv, leigvec, reigvec, accu_d, accu_nd, S, thr_d, thr_nd, .true.) + call check_EIGVEC(n, n, A, eigval, leigvec, reigvec, thr_diag, thr_norm, .true.) - ! deallocate(S) - ! return + deallocate(S) + return else diff --git a/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f index 1144f29f..c7e9fe09 100644 --- a/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f +++ b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f @@ -1865,10 +1865,11 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ , Vl, size(Vl, 1), Vr, size(Vr, 1) & , 0.d0, S, size(S, 1) ) - print *, ' overlap matrix:' - do i = 1, m - write(*,'(1000(F16.10,X))') S(i,:) - enddo + ! print ca juste s'il y a besoin + !print *, ' overlap matrix:' + !do i = 1, m + ! write(*,'(1000(F16.10,X))') S(i,:) + !enddo accu_d = 0.d0 accu_nd = 0.d0 @@ -1888,7 +1889,7 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ print *, ' accu_nd = ', accu_nd print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m) else - print *, ' vectors are bi-orthogonaly' + print *, ' vectors are bi-orthogonals' endif ! --- diff --git a/src/tc_bi_ortho/ORBITALS.irp.f b/src/tc_bi_ortho/ORBITALS.irp.f deleted file mode 100644 index fdc4758d..00000000 --- a/src/tc_bi_ortho/ORBITALS.irp.f +++ /dev/null @@ -1,38 +0,0 @@ - -! --- - - BEGIN_PROVIDER [integer, nC_orb] -&BEGIN_PROVIDER [integer, nO_orb] -&BEGIN_PROVIDER [integer, nV_orb] -&BEGIN_PROVIDER [integer, nR_orb] -&BEGIN_PROVIDER [integer, nS_exc] - - BEGIN_DOC - ! - ! nC_orb = number of core orbitals - ! nO_orb = number of occupied orbitals - ! nV_orb = number of virtual orbitals - ! nR_orb = number of Rydberg orbitals - ! nS_exc = number of single excitation - ! - END_DOC - - implicit none - - nC_orb = 0 - nO_orb = elec_beta_num - nC_orb - nV_orb = mo_num - (nC_orb + nO_orb) - nR_orb = 0 - nS_exc = (nO_orb-nC_orb) * (nV_orb-nR_orb) - - print *, ' nC_orb = ', nC_orb - print *, ' nO_orb = ', nO_orb - print *, ' nV_orb = ', nV_orb - print *, ' nR_orb = ', nR_orb - print *, ' nS_exc = ', nS_exc - -END_PROVIDER - -! --- - - From e3beae681b55b2a1d150ce716e43925f44333f0d Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Sat, 23 Dec 2023 16:35:08 +0100 Subject: [PATCH 64/84] handling degerated vectors correctly for bi-orthogonality --- plugins/local/non_hermit_dav/biorthog.irp.f | 26 +- .../lapack_diag_non_hermit.irp.f | 287 +++++++++--------- 2 files changed, 154 insertions(+), 159 deletions(-) diff --git a/plugins/local/non_hermit_dav/biorthog.irp.f b/plugins/local/non_hermit_dav/biorthog.irp.f index 87a118f4..3d8de028 100644 --- a/plugins/local/non_hermit_dav/biorthog.irp.f +++ b/plugins/local/non_hermit_dav/biorthog.irp.f @@ -275,10 +275,11 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei double precision :: thr, thr_cut, thr_diag, thr_norm double precision :: accu_d, accu_nd - integer, allocatable :: list_good(:), iorder(:) + integer, allocatable :: list_good(:), iorder(:), deg_num(:) double precision, allocatable :: WR(:), WI(:), VL(:,:), VR(:,:) double precision, allocatable :: S(:,:) double precision, allocatable :: phi_1_tilde(:),phi_2_tilde(:),chi_1_tilde(:),chi_2_tilde(:) + allocate(phi_1_tilde(n),phi_2_tilde(n),chi_1_tilde(n),chi_2_tilde(n)) @@ -496,18 +497,10 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei ! --- -! call impose_orthog_degen_eigvec(n, eigval, reigvec) -! call impose_orthog_degen_eigvec(n, eigval, leigvec) - - call reorder_degen_eigvec(n, eigval, leigvec, reigvec) - call impose_biorthog_degen_eigvec(n, eigval, leigvec, reigvec) - - - !call impose_orthog_biorthog_degen_eigvec(n, thr_d, thr_nd, eigval, leigvec, reigvec) - - !call impose_unique_biorthog_degen_eigvec(n, eigval, mo_coef, ao_overlap, leigvec, reigvec) - - ! --- + allocate(deg_num(n)) + call reorder_degen_eigvec(n, deg_num, eigval, leigvec, reigvec) + call impose_biorthog_degen_eigvec(n, deg_num, eigval, leigvec, reigvec) + deallocate(deg_num) call check_biorthog(n, n_real_eigv, leigvec, reigvec, accu_d, accu_nd, S, thr_d, thr_nd, .false.) if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv)) .gt. thr_d) ) then @@ -515,12 +508,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei endif call check_biorthog(n, n_real_eigv, leigvec, reigvec, accu_d, accu_nd, S, thr_d, thr_nd, .true.) - !call impose_biorthog_qr(n, n_real_eigv, thr_d, thr_nd, leigvec, reigvec) - !call impose_biorthog_lu(n, n_real_eigv, thr_d, thr_nd, leigvec, reigvec) - - ! --- - - call check_EIGVEC(n, n, A, eigval, leigvec, reigvec, thr_diag, thr_norm, .true.) + !call check_EIGVEC(n, n, A, eigval, leigvec, reigvec, thr_diag, thr_norm, .true.) deallocate(S) diff --git a/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f index c7e9fe09..4d51b79e 100644 --- a/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f +++ b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f @@ -1865,7 +1865,7 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ , Vl, size(Vl, 1), Vr, size(Vr, 1) & , 0.d0, S, size(S, 1) ) - ! print ca juste s'il y a besoin + ! print S s'il y a besoin !print *, ' overlap matrix:' !do i = 1, m ! write(*,'(1000(F16.10,X))') S(i,:) @@ -1877,11 +1877,13 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ do j = 1, m if(i==j) then accu_d = accu_d + dabs(S(i,i)) + !print*, i, S(i,i) else accu_nd = accu_nd + S(j,i) * S(j,i) endif enddo enddo + !accu_nd = dsqrt(accu_nd) / dble(m*m) accu_nd = dsqrt(accu_nd) / dble(m) if((accu_nd .gt. thr_nd) .or. dabs(accu_d-dble(m))/dble(m) .gt. thr_d) then @@ -1951,24 +1953,21 @@ end subroutine check_orthog ! --- -subroutine reorder_degen_eigvec(n, e0, L0, R0) +subroutine reorder_degen_eigvec(n, deg_num, e0, L0, R0) implicit none integer, intent(in) :: n - double precision, intent(in) :: e0(n) - double precision, intent(inout) :: L0(n,n), R0(n,n) + double precision, intent(inout) :: e0(n), L0(n,n), R0(n,n) + integer, intent(out) :: deg_num(n) logical :: complex_root - integer :: i, j, k, m, ii + integer :: i, j, k, m, ii, j_tmp double precision :: ei, ej, de, de_thr double precision :: accu_d, accu_nd - integer, allocatable :: deg_num(:) + double precision :: e0_tmp, L0_tmp(n), R0_tmp(n) double precision, allocatable :: L(:,:), R(:,:), S(:,:), S_inv_half(:,:) - ! --- - - allocate( deg_num(n) ) do i = 1, n deg_num(i) = 1 enddo @@ -1979,24 +1978,41 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) ei = e0(i) ! already considered in degen vectors - if(deg_num(i).eq.0) cycle + if(deg_num(i) .eq. 0) cycle + ii = 0 do j = i+1, n ej = e0(j) de = dabs(ei - ej) if(de .lt. de_thr) then - deg_num(i) = deg_num(i) + 1 - deg_num(j) = 0 - endif + ii = ii + 1 + + j_tmp = i + ii + deg_num(j_tmp) = 0 + + e0_tmp = e0(j_tmp) + e0(j_tmp) = e0(j) + e0(j) = e0_tmp + + L0_tmp(1:n) = L0(1:n,j_tmp) + L0(1:n,j_tmp) = L0(1:n,j) + L0(1:n,j) = L0_tmp(1:n) + + R0_tmp(1:n) = R0(1:n,j_tmp) + R0(1:n,j_tmp) = R0(1:n,j) + R0(1:n,j) = R0_tmp(1:n) + endif enddo + + deg_num(i) = ii + 1 enddo ii = 0 do i = 1, n if(deg_num(i) .gt. 1) then - print *, ' degen on', i, deg_num(i), e0(i) + !print *, ' degen on', i, deg_num(i), e0(i) ii = ii + 1 endif enddo @@ -2011,55 +2027,55 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) ! --- - do i = 1, n - m = deg_num(i) - - if(m .gt. 1) then - - allocate(L(n,m)) - allocate(R(n,m),S(m,m)) - - do j = 1, m - L(1:n,j) = L0(1:n,i+j-1) - R(1:n,j) = R0(1:n,i+j-1) - enddo - - call dgemm( 'T', 'N', m, m, n, 1.d0 & - , L, size(L, 1), R, size(R, 1) & - , 0.d0, S, size(S, 1) ) - - print*, 'Overlap matrix ' - accu_nd = 0.d0 - do j = 1, m - write(*,'(100(F16.10,X))') S(1:m,j) - do k = 1, m - if(j==k) cycle - accu_nd += dabs(S(j,k)) - enddo - enddo - print*,'accu_nd = ',accu_nd -! if(accu_nd .gt.1.d-10) then -! stop -! endif - do j = 1, m - L0(1:n,i+j-1) = L(1:n,j) - R0(1:n,i+j-1) = R(1:n,j) - enddo - - deallocate(L, R, S) - - endif - enddo - +! do i = 1, n +! m = deg_num(i) +! +! if(m .gt. 1) then +! +! allocate(L(n,m)) +! allocate(R(n,m),S(m,m)) +! +! do j = 1, m +! L(1:n,j) = L0(1:n,i+j-1) +! R(1:n,j) = R0(1:n,i+j-1) +! enddo +! +! !call dgemm( 'T', 'N', m, m, n, 1.d0 & +! ! , L, size(L, 1), R, size(R, 1) & +! ! , 0.d0, S, size(S, 1) ) +! !print*, 'Overlap matrix ' +! !accu_nd = 0.d0 +! !do j = 1, m +! ! write(*,'(100(F16.10,X))') S(1:m,j) +! ! do k = 1, m +! ! if(j==k) cycle +! ! accu_nd += dabs(S(j,k)) +! ! enddo +! !enddo +! !print*,'accu_nd = ',accu_nd +!! if(accu_nd .gt.1.d-10) then +!! stop +!! endif +! +! do j = 1, m +! L0(1:n,i+j-1) = L(1:n,j) +! R0(1:n,i+j-1) = R(1:n,j) +! enddo +! +! deallocate(L, R, S) +! +! endif +! enddo +! end subroutine reorder_degen_eigvec ! --- -subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) +subroutine impose_biorthog_degen_eigvec(n, deg_num, e0, L0, R0) implicit none - integer, intent(in) :: n + integer, intent(in) :: n, deg_num(n) double precision, intent(in) :: e0(n) double precision, intent(inout) :: L0(n,n), R0(n,n) @@ -2067,41 +2083,13 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) integer :: i, j, k, m double precision :: ei, ej, de, de_thr double precision :: accu_d, accu_nd - integer, allocatable :: deg_num(:) double precision, allocatable :: L(:,:), R(:,:), S(:,:), S_inv_half(:,:) - ! --- - - allocate( deg_num(n) ) - do i = 1, n - deg_num(i) = 1 - enddo - - de_thr = thr_degen_tc - - do i = 1, n-1 - ei = e0(i) - - ! already considered in degen vectors - if(deg_num(i).eq.0) cycle - - do j = i+1, n - ej = e0(j) - de = dabs(ei - ej) - - if(de .lt. de_thr) then - deg_num(i) = deg_num(i) + 1 - deg_num(j) = 0 - endif - - enddo - enddo - - do i = 1, n - if(deg_num(i) .gt. 1) then - print *, ' degen on', i, deg_num(i), e0(i) - endif - enddo + !do i = 1, n + ! if(deg_num(i) .gt. 1) then + ! print *, ' degen on', i, deg_num(i), e0(i) + ! endif + !enddo ! --- @@ -2110,8 +2098,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) if(m .gt. 1) then - allocate(L(n,m)) - allocate(R(n,m)) + allocate(L(n,m), R(n,m), S(m,m)) do j = 1, m L(1:n,j) = L0(1:n,i+j-1) @@ -2120,8 +2107,51 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) ! --- - call impose_orthog_svd(n, m, R) - L(:,:) = R(:,:) + !print*, 'Overlap matrix before' + call dgemm( 'T', 'N', m, m, n, 1.d0 & + , L, size(L, 1), R, size(R, 1) & + , 0.d0, S, size(S, 1) ) + + accu_nd = 0.d0 + do j = 1, m + !write(*,'(100(F16.10,X))') S(1:m,j) + do k = 1, m + if(j==k) cycle + accu_nd += dabs(S(j,k)) + enddo + enddo + + if(accu_nd .lt. 1d-12) then + deallocate(S, L, R) + cycle + endif + + !print*, ' accu_nd before = ', accu_nd + + call impose_biorthog_svd(n, m, L, R) + + !print*, 'Overlap matrix after' + call dgemm( 'T', 'N', m, m, n, 1.d0 & + , L, size(L, 1), R, size(R, 1) & + , 0.d0, S, size(S, 1) ) + accu_nd = 0.d0 + do j = 1, m + !write(*,'(100(F16.10,X))') S(1:m,j) + do k = 1, m + if(j==k) cycle + accu_nd += dabs(S(j,k)) + enddo + enddo + !print*,' accu_nd after = ', accu_nd + if(accu_nd .gt. 1d-12) then + print*, ' your strategy for degenerates orbitals failed !' + print*, m, 'deg on', i + stop + endif + + deallocate(S) + + ! --- !call impose_orthog_svd(n, m, L) !call impose_orthog_GramSchmidt(n, m, L) @@ -2142,7 +2172,6 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) !call bi_ortho_s_inv_half(m, L, R, S_inv_half) !deallocate(S, S_inv_half) - !call impose_biorthog_svd(n, m, L, R) !call impose_biorthog_inverse(n, m, L, R) !call impose_biorthog_qr(n, m, thr_d, thr_nd, L, R) @@ -2158,7 +2187,6 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) endif enddo -! call impose_biorthog_inverse(n, n, L0, R0) end subroutine impose_biorthog_degen_eigvec @@ -2526,18 +2554,16 @@ subroutine impose_biorthog_svd(n, m, L, R) double precision, allocatable :: S(:,:), tmp(:,:) double precision, allocatable :: U(:,:), V(:,:), Vt(:,:), D(:) - ! --- - allocate(S(m,m)) call dgemm( 'T', 'N', m, m, n, 1.d0 & , L, size(L, 1), R, size(R, 1) & , 0.d0, S, size(S, 1) ) - print *, ' overlap bef SVD: ' - do i = 1, m - write(*, '(1000(F16.10,X))') S(i,:) - enddo + !print *, ' overlap bef SVD: ' + !do i = 1, m + ! write(*, '(1000(F16.10,X))') S(i,:) + !enddo ! --- @@ -2574,52 +2600,33 @@ subroutine impose_biorthog_svd(n, m, L, R) ! --- - allocate(tmp(n,m)) + ! R <-- R x V x D^{-0.5} + ! L <-- L x U x D^{-0.5} - ! tmp <-- R x V - call dgemm( 'N', 'N', n, m, m, 1.d0 & - , R, size(R, 1), V, size(V, 1) & - , 0.d0, tmp, size(tmp, 1) ) - deallocate(V) - ! R <-- tmp x sigma^-0.5 - do j = 1, m - do i = 1, n - R(i,j) = tmp(i,j) * D(j) - enddo - enddo - - ! tmp <-- L x U - call dgemm( 'N', 'N', n, m, m, 1.d0 & - , L, size(L, 1), U, size(U, 1) & - , 0.d0, tmp, size(tmp, 1) ) - deallocate(U) - ! L <-- tmp x sigma^-0.5 - do j = 1, m - do i = 1, n - L(i,j) = tmp(i,j) * D(j) - enddo - enddo - - deallocate(D, tmp) - - ! --- - - allocate(S(m,m)) - call dgemm( 'T', 'N', m, m, n, 1.d0 & - , L, size(L, 1), R, size(R, 1) & - , 0.d0, S, size(S, 1) ) - - print *, ' overlap aft SVD: ' do i = 1, m - write(*, '(1000(F16.10,X))') S(i,:) + do j = 1, m + V(j,i) = V(j,i) * D(i) + U(j,i) = U(j,i) * D(i) + enddo enddo - deallocate(S) + allocate(tmp(n,m)) + tmp(:,:) = R(:,:) + call dgemm( 'N', 'N', n, m, m, 1.d0 & + , tmp, size(tmp, 1), V, size(V, 1) & + , 0.d0, R, size(R, 1)) - ! --- + tmp(:,:) = L(:,:) + call dgemm( 'N', 'N', n, m, m, 1.d0 & + , tmp, size(tmp, 1), U, size(U, 1) & + , 0.d0, L, size(L, 1)) + + deallocate(tmp, U, V, D) end subroutine impose_biorthog_svd +! --- + subroutine impose_biorthog_inverse(n, m, L, R) implicit none @@ -2661,7 +2668,7 @@ subroutine impose_biorthog_inverse(n, m, L, R) deallocate(S,Lt) -end subroutine impose_biorthog_svd +end subroutine impose_biorthog_inverse ! --- From bc1957c45af8fb56687aba4b101c5f99a619e5a6 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Thu, 28 Dec 2023 17:11:22 +0100 Subject: [PATCH 65/84] print angles for tc-scf --- plugins/local/non_h_ints_mu/tc_integ_an.irp.f | 16 ++++++++-------- plugins/local/non_hermit_dav/biorthog.irp.f | 8 ++++---- plugins/local/tc_scf/tc_scf.irp.f | 13 ++++++++++++- 3 files changed, 24 insertions(+), 13 deletions(-) diff --git a/plugins/local/non_h_ints_mu/tc_integ_an.irp.f b/plugins/local/non_h_ints_mu/tc_integ_an.irp.f index a6459761..a69b2a74 100644 --- a/plugins/local/non_h_ints_mu/tc_integ_an.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ_an.irp.f @@ -106,11 +106,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f elseif(j1b_type .ge. 100) then -! PROVIDE int2_grad1_u12_ao_num -! int2_grad1_u12_ao = int2_grad1_u12_ao_num + PROVIDE int2_grad1_u12_ao_num + int2_grad1_u12_ao = int2_grad1_u12_ao_num - PROVIDE int2_grad1_u12_ao_num_1shot - int2_grad1_u12_ao = int2_grad1_u12_ao_num_1shot + !PROVIDE int2_grad1_u12_ao_num_1shot + !int2_grad1_u12_ao = int2_grad1_u12_ao_num_1shot else @@ -225,11 +225,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p elseif(j1b_type .ge. 100) then - ! PROVIDE int2_grad1_u12_square_ao_num - ! int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num + PROVIDE int2_grad1_u12_square_ao_num + int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num - PROVIDE int2_grad1_u12_square_ao_num_1shot - int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num_1shot + !PROVIDE int2_grad1_u12_square_ao_num_1shot + !int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num_1shot else diff --git a/plugins/local/non_hermit_dav/biorthog.irp.f b/plugins/local/non_hermit_dav/biorthog.irp.f index 3d8de028..ab12150f 100644 --- a/plugins/local/non_hermit_dav/biorthog.irp.f +++ b/plugins/local/non_hermit_dav/biorthog.irp.f @@ -306,11 +306,11 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei - print *, ' ' - print *, ' eigenvalues' + !print *, ' ' + !print *, ' eigenvalues' i = 1 do while(i .le. n) - write(*, '(I3,X,1000(F16.10,X))')i, WR(i), WI(i) + !write(*, '(I3,X,1000(F16.10,X))')i, WR(i), WI(i) if(.false.)then if(WI(i).ne.0.d0)then print*,'*****************' @@ -401,7 +401,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei !thr = 100d0 thr = Im_thresh_tcscf do i = 1, n - print*, 'Re(i) + Im(i)', WR(i), WI(i) + !print*, 'Re(i) + Im(i)', WR(i), WI(i) if(dabs(WI(i)) .lt. thr) then n_good += 1 else diff --git a/plugins/local/tc_scf/tc_scf.irp.f b/plugins/local/tc_scf/tc_scf.irp.f index 22f66484..fb86a752 100644 --- a/plugins/local/tc_scf/tc_scf.irp.f +++ b/plugins/local/tc_scf/tc_scf.irp.f @@ -7,6 +7,8 @@ program tc_scf END_DOC implicit none + integer :: i + logical :: good_angles write(json_unit,json_array_open_fmt) 'tc-scf' @@ -69,7 +71,16 @@ program tc_scf stop endif - call minimize_tc_orb_angles() + PROVIDE Fock_matrix_tc_diag_mo_tot + print*, ' Eigenvalues:' + do i = 1, mo_num + print*, i, Fock_matrix_tc_diag_mo_tot(i) + enddo + + ! TODO + ! rotate angles in separate code only if necessary + !call minimize_tc_orb_angles() + call print_energy_and_mos(good_angles) endif From f5bacaa999af44ff31144c7ae976aedc13e072e2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 10 Jan 2024 11:09:17 +0100 Subject: [PATCH 66/84] Added generate_cas_space and cas_complete --- src/bitmask/generate_cas_space.irp.f | 87 ++++++++++++++++++++++++++++ src/tools/cas_complete.irp.f | 13 +++++ 2 files changed, 100 insertions(+) create mode 100644 src/bitmask/generate_cas_space.irp.f create mode 100644 src/tools/cas_complete.irp.f diff --git a/src/bitmask/generate_cas_space.irp.f b/src/bitmask/generate_cas_space.irp.f new file mode 100644 index 00000000..47a2ca30 --- /dev/null +++ b/src/bitmask/generate_cas_space.irp.f @@ -0,0 +1,87 @@ +subroutine generate_cas_space + use bitmasks + implicit none + BEGIN_DOC +! Generates the CAS space + END_DOC + integer :: i, sze, ncore, n_alpha_act, n_beta_act + integer(bit_kind) :: o(N_int) + integer(bit_kind) :: u + integer :: mo_list(elec_alpha_num) + + integer :: k,n,m + integer(bit_kind) :: t, t1, t2 + + call list_to_bitstring(o, list_core_inact, n_core_inact_orb, N_int) + + ! Count number of active electrons + n_alpha_act = 0 + n_beta_act = 0 + do i=1, n_act_orb + if (list_act(i) <= elec_alpha_num) then + n_alpha_act += 1 + endif + if (list_act(i) <= elec_beta_num) then + n_beta_act += 1 + endif + enddo + if (n_act_orb > 64) then + stop 'More than 64 active MOs' + endif + + print *, '' + print *, 'CAS(', n_alpha_act+n_beta_act, ', ', n_act_orb, ')' + print *, '' + + n_det_alpha_unique = binom_int(n_act_orb, n_alpha_act) + TOUCH n_det_alpha_unique + + n = n_alpha_act + u = shiftl(1_bit_kind,n) - 1_bit_kind + + k=0 + do while (u < shiftl(1_bit_kind,n_act_orb)) + k = k+1 + call bitstring_to_list(u, mo_list, m, 1) + do i=1,m + mo_list(i) = list_act( mo_list(i) ) + enddo + call list_to_bitstring(psi_det_alpha_unique(1,k), mo_list, m, N_int) + do i=1,N_int + psi_det_alpha_unique(i,k) = ior(psi_det_alpha_unique(i,k), o(i)) + enddo + t = ior(u,u-1) + t1 = t+1 + t2 = shiftr((iand(not(t),t1)-1), trailz(u)+1) + u = ior(t1,t2) + enddo + + n_det_beta_unique = binom_int(n_act_orb, n_beta_act) + TOUCH n_det_beta_unique + + n = n_beta_act + u = shiftl(1_bit_kind,n) -1_bit_kind + + k=0 + do while (u < shiftl(1_bit_kind,n_act_orb)) + k = k+1 + call bitstring_to_list(u, mo_list, m, 1) + do i=1,m + mo_list(i) = list_act( mo_list(i) ) + enddo + call list_to_bitstring(psi_det_beta_unique(1,k), mo_list, m, N_int) + do i=1,N_int + psi_det_beta_unique(i,k) = ior(psi_det_beta_unique(i,k), o(i)) + enddo + t = ior(u,u-1) + t1 = t+1 + t2 = shiftr((iand(not(t),t1)-1), trailz(u)+1) + u = ior(t1,t2) + enddo + + call generate_all_alpha_beta_det_products + + print *, 'Ndet = ', N_det + +end + diff --git a/src/tools/cas_complete.irp.f b/src/tools/cas_complete.irp.f new file mode 100644 index 00000000..301c9979 --- /dev/null +++ b/src/tools/cas_complete.irp.f @@ -0,0 +1,13 @@ +program cas_complete + implicit none + BEGIN_DOC +! Diagonalizes the Hamiltonian in the complete active space + END_DOC + + call generate_cas_space + call diagonalize_ci + call save_wavefunction + +end + + From bc042cefa2a3e7ad7bb57099aa012349d2fd652c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 10 Jan 2024 11:14:49 +0100 Subject: [PATCH 67/84] Fixed previous commit --- src/{bitmask => determinants}/generate_cas_space.irp.f | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/{bitmask => determinants}/generate_cas_space.irp.f (100%) diff --git a/src/bitmask/generate_cas_space.irp.f b/src/determinants/generate_cas_space.irp.f similarity index 100% rename from src/bitmask/generate_cas_space.irp.f rename to src/determinants/generate_cas_space.irp.f From ef60141fbfd3a89916111812a2e16bbbf0c695a9 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Mon, 15 Jan 2024 12:02:38 +0100 Subject: [PATCH 68/84] new keywords for Jastrow --- plugins/local/ao_many_one_e_ints/NEED | 1 + .../ao_many_one_e_ints/ao_erf_gauss.irp.f | 38 +- .../ao_many_one_e_ints/ao_gaus_gauss.irp.f | 89 ++- .../ao_many_one_e_ints/grad2_jmu_manu.irp.f | 198 +++--- .../ao_many_one_e_ints/grad2_jmu_modif.irp.f | 153 ++--- .../grad2_jmu_modif_vect.irp.f | 453 ------------- .../grad_lapl_jmu_manu.irp.f | 115 ++-- .../grad_lapl_jmu_modif.irp.f | 237 +++---- .../ao_many_one_e_ints/lin_fc_rsdft.irp.f | 574 +++++++++++++++++ .../local/ao_many_one_e_ints/listj1b.irp.f | 231 ++++--- .../ao_many_one_e_ints/listj1b_sorted.irp.f | 346 +++++----- .../prim_int_gauss_gauss.irp.f | 2 +- .../ao_tc_eff_map/compute_ints_eff_pot.irp.f | 11 +- .../ao_tc_eff_map/one_e_1bgauss_grad2.irp.f | 145 ++--- .../ao_tc_eff_map/one_e_1bgauss_lap.irp.f | 142 ++--- .../ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f | 130 ++-- .../ao_tc_eff_map/providers_ao_eff_pot.irp.f | 3 - .../ao_tc_eff_map/two_e_1bgauss_j1.irp.f | 27 +- .../ao_tc_eff_map/two_e_1bgauss_j2.irp.f | 26 +- .../local/bi_ort_ints/biorthog_mo_for_h.irp.f | 37 +- plugins/local/bi_ort_ints/one_e_bi_ort.irp.f | 17 - .../local/bi_ort_ints/total_twoe_pot.irp.f | 90 --- plugins/local/non_h_ints_mu/debug_fit.irp.f | 342 +--------- .../non_h_ints_mu/debug_integ_jmu_modif.irp.f | 343 +++++----- .../local/non_h_ints_mu/grad_squared.irp.f | 419 +----------- .../non_h_ints_mu/grad_squared_manu.irp.f | 84 ++- .../local/non_h_ints_mu/j12_nucl_utils.irp.f | 449 ++++--------- plugins/local/non_h_ints_mu/jast_1e.irp.f | 123 ++++ plugins/local/non_h_ints_mu/jast_deriv.irp.f | 58 +- .../non_h_ints_mu/jast_deriv_utils.irp.f | 432 +++++++------ .../non_h_ints_mu/jast_deriv_utils_vect.irp.f | 120 ++-- plugins/local/non_h_ints_mu/new_grad_tc.irp.f | 171 ----- .../non_h_ints_mu/new_grad_tc_manu.irp.f | 61 +- .../local/non_h_ints_mu/numerical_integ.irp.f | 221 +++---- plugins/local/non_h_ints_mu/tc_integ.irp.f | 601 ++++++++++++++++++ plugins/local/non_h_ints_mu/tc_integ_an.irp.f | 248 -------- .../local/non_h_ints_mu/test_non_h_ints.irp.f | 154 ++--- .../local/non_h_ints_mu/total_tc_int.irp.f | 479 +++++++++----- .../tc_bi_ortho/compute_deltamu_right.irp.f | 6 +- .../local/tc_bi_ortho/print_tc_energy.irp.f | 3 - .../tc_bi_ortho/save_tc_bi_ortho_nat.irp.f | 2 +- .../local/tc_bi_ortho/slater_tc_slow.irp.f | 10 - plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f | 2 +- plugins/local/tc_bi_ortho/tc_som.irp.f | 6 - plugins/local/tc_keywords/EZFIO.cfg | 30 +- plugins/local/tc_keywords/j1b_pen.irp.f | 155 ----- plugins/local/tc_scf/print_tcscf_energy.irp.f | 10 +- plugins/local/tc_scf/tc_scf.irp.f | 21 +- plugins/local/tc_scf/test_int.irp.f | 356 ++--------- src/dft_utils_in_r/ao_prod_mlti_pl.irp.f | 4 - src/hamiltonian/EZFIO.cfg | 60 ++ src/hamiltonian/NEED | 2 + .../hamiltonian}/fit_j.irp.f | 199 ++++-- src/hamiltonian/fit_potential.irp.f | 335 ++++++++++ src/hamiltonian/fit_slat_gauss.irp.f | 94 +++ src/hamiltonian/j1b_pen.irp.f | 100 +++ src/hamiltonian/jast_1e_param.irp.f | 100 +++ 57 files changed, 4300 insertions(+), 4565 deletions(-) delete mode 100644 plugins/local/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f create mode 100644 plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f create mode 100644 plugins/local/non_h_ints_mu/jast_1e.irp.f delete mode 100644 plugins/local/non_h_ints_mu/new_grad_tc.irp.f create mode 100644 plugins/local/non_h_ints_mu/tc_integ.irp.f delete mode 100644 plugins/local/non_h_ints_mu/tc_integ_an.irp.f delete mode 100644 plugins/local/tc_keywords/j1b_pen.irp.f rename {plugins/local/ao_tc_eff_map => src/hamiltonian}/fit_j.irp.f (83%) create mode 100644 src/hamiltonian/fit_potential.irp.f create mode 100644 src/hamiltonian/fit_slat_gauss.irp.f create mode 100644 src/hamiltonian/j1b_pen.irp.f create mode 100644 src/hamiltonian/jast_1e_param.irp.f diff --git a/plugins/local/ao_many_one_e_ints/NEED b/plugins/local/ao_many_one_e_ints/NEED index c57219cd..6e16c74a 100644 --- a/plugins/local/ao_many_one_e_ints/NEED +++ b/plugins/local/ao_many_one_e_ints/NEED @@ -4,3 +4,4 @@ becke_numerical_grid mo_one_e_ints dft_utils_in_r tc_keywords +hamiltonian diff --git a/plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f b/plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f index 823536cc..46124c44 100644 --- a/plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f +++ b/plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f @@ -98,7 +98,7 @@ double precision function phi_j_erf_mu_r_phi(i, j, mu_in, C_center) enddo enddo -end function phi_j_erf_mu_r_phi +end ! --- @@ -201,7 +201,7 @@ subroutine erf_mu_gauss_ij_ao(i, j, mu, C_center, delta, gauss_ints) enddo enddo -end subroutine erf_mu_gauss_ij_ao +end ! --- @@ -266,7 +266,7 @@ subroutine NAI_pol_x_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints) enddo enddo -end subroutine NAI_pol_x_mult_erf_ao +end ! --- @@ -340,7 +340,7 @@ subroutine NAI_pol_x_mult_erf_ao_v0(i_ao, j_ao, mu_in, C_center, LD_C, ints, LD_ deallocate(integral) -end subroutine NAI_pol_x_mult_erf_ao_v0 +end ! --- @@ -420,7 +420,7 @@ subroutine NAI_pol_x_mult_erf_ao_v(i_ao, j_ao, mu_in, C_center, LD_C, ints, LD_i deallocate(integral) -end subroutine NAI_pol_x_mult_erf_ao_v +end ! --- @@ -479,7 +479,7 @@ double precision function NAI_pol_x_mult_erf_ao_x(i_ao, j_ao, mu_in, C_center) enddo enddo -end function NAI_pol_x_mult_erf_ao_x +end ! --- @@ -538,7 +538,7 @@ double precision function NAI_pol_x_mult_erf_ao_y(i_ao, j_ao, mu_in, C_center) enddo enddo -end function NAI_pol_x_mult_erf_ao_y +end ! --- @@ -597,7 +597,7 @@ double precision function NAI_pol_x_mult_erf_ao_z(i_ao, j_ao, mu_in, C_center) enddo enddo -end function NAI_pol_x_mult_erf_ao_z +end ! --- @@ -667,7 +667,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_x(i_ao, j_ao, beta, B_cen enddo enddo -end function NAI_pol_x_mult_erf_ao_with1s_x +end ! --- @@ -737,7 +737,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_y(i_ao, j_ao, beta, B_cen enddo enddo -end function NAI_pol_x_mult_erf_ao_with1s_y +end ! --- @@ -807,7 +807,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_z(i_ao, j_ao, beta, B_cen enddo enddo -end function NAI_pol_x_mult_erf_ao_with1s_z +end ! --- @@ -880,7 +880,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_cen enddo enddo -end subroutine NAI_pol_x_mult_erf_ao_with1s +end ! --- @@ -967,7 +967,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s_v0(i_ao, j_ao, beta, B_center, LD_B, mu_ deallocate(integral) -end subroutine NAI_pol_x_mult_erf_ao_with1s_v0 +end ! --- @@ -1057,7 +1057,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s_v(i_ao, j_ao, beta, B_center, LD_B, mu_i deallocate(integral) -end subroutine NAI_pol_x_mult_erf_ao_with1s_v +end ! --- @@ -1175,7 +1175,7 @@ subroutine NAI_pol_x2_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_ce enddo enddo -end subroutine NAI_pol_x2_mult_erf_ao_with1s +end ! --- @@ -1241,7 +1241,7 @@ subroutine NAI_pol_x2_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints) enddo enddo -end subroutine NAI_pol_x2_mult_erf_ao +end ! --- @@ -1320,7 +1320,7 @@ subroutine NAI_pol_012_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_c enddo enddo -end subroutine NAI_pol_012_mult_erf_ao_with1s +end ! --- @@ -1328,7 +1328,7 @@ subroutine NAI_pol_012_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints) BEGIN_DOC ! - ! Computes the following integral : + ! Computes the following integrals : ! ! int(1) = $\int_{-\infty}^{infty} dr x^0 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$. ! @@ -1395,7 +1395,7 @@ subroutine NAI_pol_012_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints) enddo enddo -end subroutine NAI_pol_012_mult_erf_ao +end ! --- diff --git a/plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f b/plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f index d2115d9e..1e4f340c 100644 --- a/plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f +++ b/plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f @@ -152,7 +152,7 @@ double precision function overlap_gauss_r12_ao(D_center, delta, i, j) enddo enddo -end function overlap_gauss_r12_ao +end ! -- @@ -199,7 +199,7 @@ double precision function overlap_abs_gauss_r12_ao(D_center, delta, i, j) enddo enddo -end function overlap_gauss_r12_ao +end ! -- @@ -257,7 +257,7 @@ subroutine overlap_gauss_r12_ao_v(D_center, LD_D, delta, i, j, resv, LD_resv, n_ deallocate(analytical_j) -end subroutine overlap_gauss_r12_ao_v +end ! --- @@ -327,7 +327,7 @@ double precision function overlap_gauss_r12_ao_with1s(B_center, beta, D_center, enddo enddo -end function overlap_gauss_r12_ao_with1s +end ! --- @@ -420,7 +420,86 @@ subroutine overlap_gauss_r12_ao_with1s_v(B_center, beta, D_center, LD_D, delta, deallocate(fact_g, G_center, analytical_j) -end subroutine overlap_gauss_r12_ao_with1s_v +end + +! --- + +subroutine overlap_gauss_r12_ao_012(D_center, delta, i, j, ints) + + BEGIN_DOC + ! + ! Computes the following integrals : + ! + ! ints(1) = $\int_{-\infty}^{infty} dr x^0 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! + ! ints(2) = $\int_{-\infty}^{infty} dr x^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! ints(3) = $\int_{-\infty}^{infty} dr y^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! ints(4) = $\int_{-\infty}^{infty} dr z^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! + ! ints(5) = $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! ints(6) = $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! ints(7) = $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! + END_DOC + + include 'utils/constants.include.F' + + implicit none + + integer, intent(in) :: i, j + double precision, intent(in) :: delta, D_center(3) + double precision, intent(out) :: ints(7) + + integer :: k, l, m + integer :: power_A(3), power_B(3), power_A1(3), power_A2(3) + double precision :: A_center(3), B_center(3), alpha, beta, coef1, coef + double precision :: integral0, integral1, integral2 + + double precision, external :: overlap_gauss_r12 + + ints = 0.d0 + + if(ao_overlap_abs(j,i).lt.1.d-12) then + return + endif + + power_A(1:3) = ao_power(i,1:3) + power_B(1:3) = ao_power(j,1:3) + + A_center(1:3) = nucl_coord(ao_nucl(i),1:3) + B_center(1:3) = nucl_coord(ao_nucl(j),1:3) + + do l = 1, ao_prim_num(i) + alpha = ao_expo_ordered_transp (l,i) + coef1 = ao_coef_normalized_ordered_transp(l,i) + + do k = 1, ao_prim_num(j) + beta = ao_expo_ordered_transp(k,j) + coef = coef1 * ao_coef_normalized_ordered_transp(k,j) + + if(dabs(coef) .lt. 1d-12) cycle + + integral0 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta) + + ints(1) += coef * integral0 + + do m = 1, 3 + power_A1 = power_A + power_A1(m) += 1 + integral1 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A1, power_B, alpha, beta) + ints(1+m) += coef * (integral1 + A_center(m)*integral0) + + power_A2 = power_A + power_A2(m) += 2 + integral2 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A2, power_B, alpha, beta) + ints(4+m) += coef * (integral2 + A_center(m) * (2.d0*integral1 + A_center(m)*integral0)) + enddo + + enddo ! k + enddo ! l + + return +end ! --- diff --git a/plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f index 14170ede..5879d83f 100644 --- a/plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f @@ -1,11 +1,11 @@ ! --- -BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2 + ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2 ! END_DOC @@ -15,30 +15,30 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n double precision :: coef, beta, B_center(3) double precision :: tmp double precision :: wall0, wall1 - double precision :: int_gauss, dsqpi_3_2, int_j1b + double precision :: int_gauss, dsqpi_3_2, int_env double precision :: factor_ij_1s, beta_ij, center_ij_1s(3), sq_pi_3_2 double precision, allocatable :: int_fit_v(:) double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing int2_grad1u2_grad2u2_j1b2_test ...' + print*, ' providing int2_grad1u2_grad2u2_env2_test ...' sq_pi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points_transp j1b_pen List_comb_thr_b3_coef + provide mu_erf final_grid_points_transp List_comb_thr_b3_coef call wall_time(wall0) - int2_grad1u2_grad2u2_j1b2_test(:,:,:) = 0.d0 + int2_grad1u2_grad2u2_env2_test(:,:,:) = 0.d0 - !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & - !$OMP coef_fit, expo_fit, int_fit_v, tmp,int_gauss,int_j1b,factor_ij_1s,beta_ij,center_ij_1s) & - !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size, & - !$OMP final_grid_points_transp, ng_fit_jast, & - !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & - !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & - !$OMP List_comb_thr_b3_cent, int2_grad1u2_grad2u2_j1b2_test, ao_abs_comb_b3_j1b, & - !$OMP ao_overlap_abs,sq_pi_3_2,thrsh_cycle_tc) + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & + !$OMP coef_fit, expo_fit, int_fit_v, tmp,int_gauss,int_env,factor_ij_1s,beta_ij,center_ij_1s) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size, & + !$OMP final_grid_points_transp, ng_fit_jast, & + !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & + !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & + !$OMP List_comb_thr_b3_cent, int2_grad1u2_grad2u2_env2_test, ao_abs_comb_b3_env, & + !$OMP ao_overlap_abs,sq_pi_3_2,thrsh_cycle_tc) !$OMP DO SCHEDULE(dynamic) do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -54,13 +54,13 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b3_j1b(1,j,i) + int_env = ao_abs_comb_b3_env(1,j,i) do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_1_erf_x_2(i_fit) coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) -! if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle +! if(dabs(coef_fit*int_env*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle int_gauss = overlap_gauss_r12_ao(r, expo_fit, i, j) - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss + int2_grad1u2_grad2u2_env2_test(j,i,ipoint) += coef_fit * int_gauss enddo ! --- --- --- @@ -71,7 +71,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) + int_env = ao_abs_comb_b3_env(i_1s,j,i) B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -81,11 +81,11 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n !DIR$ FORCEINLINE call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s) coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) * coef -! if(dabs(coef_fit*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle +! if(dabs(coef_fit*factor_ij_1s*int_env*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle ! call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, & ! expo_fit, i, j, int_fit_v, n_points_final_grid) int_gauss = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss + int2_grad1u2_grad2u2_env2_test(j,i,ipoint) += coef_fit * int_gauss enddo enddo @@ -98,26 +98,26 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n do ipoint = 1, n_points_final_grid do i = 1, ao_num do j = 1, i-1 - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint) + int2_grad1u2_grad2u2_env2_test(j,i,ipoint) = int2_grad1u2_grad2u2_env2_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test', wall1 - wall0 + print*, ' wall time for int2_grad1u2_grad2u2_env2_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao_num, n_points_final_grid)] -! -! BEGIN_DOC -! ! -! ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2 -! ! -! END_DOC -! +BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test_v, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2 + ! + END_DOC + implicit none integer :: i, j, ipoint, i_1s, i_fit double precision :: r(3), expo_fit, coef_fit @@ -128,24 +128,24 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao double precision, allocatable :: int_fit_v(:),big_array(:,:,:) double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing int2_grad1u2_grad2u2_j1b2_test_v ...' + print*, ' providing int2_grad1u2_grad2u2_env2_test_v ...' - provide mu_erf final_grid_points_transp j1b_pen + provide mu_erf final_grid_points_transp call wall_time(wall0) - double precision :: int_j1b + double precision :: int_env big_array(:,:,:) = 0.d0 allocate(big_array(n_points_final_grid,ao_num, ao_num)) !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,& - !$OMP coef_fit, expo_fit, int_fit_v, tmp,int_j1b) & - !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size,& - !$OMP final_grid_points_transp, ng_fit_jast, & - !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & - !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & - !$OMP List_comb_thr_b3_cent, big_array,& - !$OMP ao_abs_comb_b3_j1b,ao_overlap_abs,thrsh_cycle_tc) -! + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,& + !$OMP coef_fit, expo_fit, int_fit_v, tmp,int_env) & + !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size,& + !$OMP final_grid_points_transp, ng_fit_jast, & + !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & + !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & + !$OMP List_comb_thr_b3_cent, big_array,& + !$OMP ao_abs_comb_b3_env,ao_overlap_abs,thrsh_cycle_tc) + ! allocate(int_fit_v(n_points_final_grid)) !$OMP DO SCHEDULE(dynamic) do i = 1, ao_num @@ -159,7 +159,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) + int_env = ao_abs_comb_b3_env(i_1s,j,i) B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -187,7 +187,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao do i = 1, ao_num do j = i, ao_num do ipoint = 1, n_points_final_grid - int2_grad1u2_grad2u2_j1b2_test_v(j,i,ipoint) = big_array(ipoint,j,i) + int2_grad1u2_grad2u2_env2_test_v(j,i,ipoint) = big_array(ipoint,j,i) enddo enddo enddo @@ -195,23 +195,23 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_grad1u2_grad2u2_j1b2_test_v(j,i,ipoint) = big_array(ipoint,i,j) + int2_grad1u2_grad2u2_env2_test_v(j,i,ipoint) = big_array(ipoint,i,j) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test_v', wall1 - wall0 + print*, ' wall time for int2_grad1u2_grad2u2_env2_test_v (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_u2_env2_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2 + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [u_12^mu]^2 ! END_DOC @@ -219,29 +219,29 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ integer :: i, j, ipoint, i_1s, i_fit double precision :: r(3), int_fit, expo_fit, coef_fit double precision :: coef, beta, B_center(3), tmp - double precision :: wall0, wall1,int_j1b + double precision :: wall0, wall1,int_env double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s double precision :: factor_ij_1s,beta_ij,center_ij_1s(3),sq_pi_3_2 - print*, ' providing int2_u2_j1b2_test ...' + print*, ' providing int2_u2_env2_test ...' sq_pi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf final_grid_points call wall_time(wall0) - int2_u2_j1b2_test = 0.d0 + int2_u2_env2_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & - !$OMP coef_fit, expo_fit, int_fit, tmp, int_j1b,factor_ij_1s,beta_ij,center_ij_1s) & + !$OMP coef_fit, expo_fit, int_fit, tmp, int_env,factor_ij_1s,beta_ij,center_ij_1s) & !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, & !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo,sq_pi_3_2, & - !$OMP List_comb_thr_b3_cent, int2_u2_j1b2_test,ao_abs_comb_b3_j1b,thrsh_cycle_tc) + !$OMP List_comb_thr_b3_cent, int2_u2_env2_test,ao_abs_comb_b3_env,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -257,12 +257,12 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b3_j1b(1,j,i) - if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle + int_env = ao_abs_comb_b3_env(1,j,i) + if(dabs(int_env).lt.thrsh_cycle_tc) cycle do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_j_mu_x_2(i_fit) coef_fit = coef_gauss_j_mu_x_2(i_fit) -! if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle +! if(dabs(coef_fit*int_env*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j) tmp += coef_fit * int_fit enddo @@ -275,8 +275,8 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b3_env(i_1s,j,i) +! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -286,13 +286,13 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ coef_fit = coef_gauss_j_mu_x_2(i_fit) !DIR$ FORCEINLINE call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s) -! if(dabs(coef_fit*coef*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle +! if(dabs(coef_fit*coef*factor_ij_1s*int_env*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) tmp += coef * coef_fit * int_fit enddo enddo - int2_u2_j1b2_test(j,i,ipoint) = tmp + int2_u2_env2_test(j,i,ipoint) = tmp enddo enddo enddo @@ -302,23 +302,23 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u2_j1b2_test(j,i,ipoint) = int2_u2_j1b2_test(i,j,ipoint) + int2_u2_env2_test(j,i,ipoint) = int2_u2_env2_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u2_j1b2_test', wall1 - wall0 + print*, ' wall time for int2_u2_env2_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (ao_num,ao_num,n_points_final_grid,3)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 ! END_DOC @@ -327,27 +327,27 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n double precision :: r(3), int_fit(3), expo_fit, coef_fit double precision :: coef, beta, B_center(3), dist double precision :: alpha_1s, alpha_1s_inv, centr_1s(3), expo_coef_1s, coef_tmp - double precision :: tmp_x, tmp_y, tmp_z, int_j1b + double precision :: tmp_x, tmp_y, tmp_z, int_env double precision :: wall0, wall1, sq_pi_3_2,sq_alpha - print*, ' providing int2_u_grad1u_x_j1b2_test ...' + print*, ' providing int2_u_grad1u_x_env2_test ...' sq_pi_3_2 = dacos(-1.D0)**(1.d0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf final_grid_points call wall_time(wall0) - int2_u_grad1u_x_j1b2_test = 0.d0 + int2_u_grad1u_x_env2_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, alpha_1s, dist, & !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, & - !$OMP tmp_x, tmp_y, tmp_z,int_j1b,sq_alpha) & + !$OMP tmp_x, tmp_y, tmp_z,int_env,sq_alpha) & !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & - !$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_j1b2_test,ao_abs_comb_b3_j1b,sq_pi_3_2,thrsh_cycle_tc) + !$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_env2_test,ao_abs_comb_b3_env,sq_pi_3_2,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid @@ -365,8 +365,8 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) - if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b3_env(i_1s,j,i) + if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -389,7 +389,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist coef_tmp = coef * coef_fit * dexp(-expo_coef_1s) sq_alpha = alpha_1s_inv * dsqrt(alpha_1s_inv) -! if(dabs(coef_tmp*int_j1b*sq_pi_3_2*sq_alpha) .lt. thrsh_cycle_tc) cycle +! if(dabs(coef_tmp*int_env*sq_pi_3_2*sq_alpha) .lt. thrsh_cycle_tc) cycle call NAI_pol_x_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r, int_fit) @@ -402,9 +402,9 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n enddo - int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = tmp_x - int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = tmp_y - int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = tmp_z + int2_u_grad1u_x_env2_test(j,i,ipoint,1) = tmp_x + int2_u_grad1u_x_env2_test(j,i,ipoint,2) = tmp_y + int2_u_grad1u_x_env2_test(j,i,ipoint,3) = tmp_z enddo enddo enddo @@ -414,24 +414,25 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,1) - int2_u_grad1u_x_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) + int2_u_grad1u_x_env2_test(j,i,ipoint,1) = int2_u_grad1u_x_env2_test(i,j,ipoint,1) + int2_u_grad1u_x_env2_test(j,i,ipoint,2) = int2_u_grad1u_x_env2_test(i,j,ipoint,2) + int2_u_grad1u_x_env2_test(j,i,ipoint,3) = int2_u_grad1u_x_env2_test(i,j,ipoint,3) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u_grad1u_x_j1b2_test', wall1 - wall0 + print*, ' wall time for int2_u_grad1u_x_env2_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER +! --- -BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] ! END_DOC @@ -442,31 +443,31 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p double precision :: alpha_1s, alpha_1s_inv, centr_1s(3), expo_coef_1s, tmp double precision :: wall0, wall1 double precision, external :: NAI_pol_mult_erf_ao_with1s - double precision :: j12_mu_r12,int_j1b + double precision :: j12_mu_r12,int_env double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2 double precision :: beta_ij,center_ij_1s(3),factor_ij_1s - print*, ' providing int2_u_grad1u_j1b2_test ...' + print*, ' providing int2_u_grad1u_env2_test ...' dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen ao_overlap_abs List_comb_thr_b3_cent + provide mu_erf final_grid_points ao_overlap_abs List_comb_thr_b3_cent call wall_time(wall0) - int2_u_grad1u_j1b2_test = 0.d0 + int2_u_grad1u_env2_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist, & !$OMP beta_ij,center_ij_1s,factor_ij_1s, & - !$OMP int_j1b,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) & + !$OMP int_env,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) & !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & !$OMP ao_prod_dist_grid, ao_prod_sigma, ao_overlap_abs_grid,ao_prod_center,dsqpi_3_2, & - !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, ao_abs_comb_b3_j1b, & - !$OMP List_comb_thr_b3_cent, int2_u_grad1u_j1b2_test,thrsh_cycle_tc) + !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, ao_abs_comb_b3_env, & + !$OMP List_comb_thr_b3_cent, int2_u_grad1u_env2_test,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid do i = 1, ao_num @@ -484,11 +485,9 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b3_j1b(1,j,i) -! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle + int_env = ao_abs_comb_b3_env(1,j,i) do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_j_mu_1_erf(i_fit) -! if(dabs(int_j1b)*dsqpi_3_2*expo_fit**(-1.5d0).lt.thrsh_cycle_tc) cycle coef_fit = coef_gauss_j_mu_1_erf(i_fit) int_fit = NAI_pol_mult_erf_ao_with1s(i, j, expo_fit, r, 1.d+9, r) tmp += coef_fit * int_fit @@ -502,8 +501,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b3_env(i_1s,j,i) B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -513,7 +511,6 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_j_mu_1_erf(i_fit) call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s) -! if(factor_ij_1s*dabs(coef*int_j1b)*dsqpi_3_2*beta_ij**(-1.5d0).lt.thrsh_cycle_tc)cycle coef_fit = coef_gauss_j_mu_1_erf(i_fit) alpha_1s = beta + expo_fit @@ -533,7 +530,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p enddo enddo - int2_u_grad1u_j1b2_test(j,i,ipoint) = tmp + int2_u_grad1u_env2_test(j,i,ipoint) = tmp enddo enddo enddo @@ -543,14 +540,15 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u_grad1u_j1b2_test(j,i,ipoint) = int2_u_grad1u_j1b2_test(i,j,ipoint) + int2_u_grad1u_env2_test(j,i,ipoint) = int2_u_grad1u_env2_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u_grad1u_j1b2_test', wall1 - wall0 + print*, ' wall time for int2_u_grad1u_env2_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- + diff --git a/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f index fda2db82..b1fc6134 100644 --- a/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f @@ -21,7 +21,8 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin print*, ' providing int2_grad1u2_grad2u2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points int2_grad1u2_grad2u2 = 0.d0 @@ -63,17 +64,17 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin enddo call wall_time(wall1) - print*, ' wall time for int2_grad1u2_grad2u2 =', wall1 - wall0 + print*, ' wall time for int2_grad1u2_grad2u2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2 + ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2 ! END_DOC @@ -87,21 +88,22 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing int2_grad1u2_grad2u2_j1b2 ...' + print*, ' providing int2_grad1u2_grad2u2_env2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points - int2_grad1u2_grad2u2_j1b2 = 0.d0 + int2_grad1u2_grad2u2_env2 = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP 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 SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & - !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & - !$OMP List_all_comb_b3_cent, int2_grad1u2_grad2u2_j1b2) + !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP List_env1s_square_cent, int2_grad1u2_grad2u2_env2) !$OMP DO do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -125,14 +127,14 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n ! --- - do i_1s = 2, List_all_comb_b3_size + do i_1s = 2, List_env1s_square_size - coef = List_all_comb_b3_coef (i_1s) + coef = List_env1s_square_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b3_expo (i_1s) - 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) + beta = List_env1s_square_expo (i_1s) + B_center(1) = List_env1s_square_cent(1,i_1s) + B_center(2) = List_env1s_square_cent(2,i_1s) + B_center(3) = List_env1s_square_cent(3,i_1s) int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) @@ -143,7 +145,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n enddo - int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = tmp + int2_grad1u2_grad2u2_env2(j,i,ipoint) = tmp enddo enddo enddo @@ -153,23 +155,23 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2(i,j,ipoint) + int2_grad1u2_grad2u2_env2(j,i,ipoint) = int2_grad1u2_grad2u2_env2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_grad1u2_grad2u2_j1b2 =', wall1 - wall0 + print*, ' wall time for int2_grad1u2_grad2u2_env2 (min) =', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_u2_env2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2 + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [u_12^mu]^2 ! END_DOC @@ -182,21 +184,22 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_ double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing int2_u2_j1b2 ...' + print*, ' providing int2_u2_env2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points - int2_u2_j1b2 = 0.d0 + int2_u2_env2 = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP 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 SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, & - !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & - !$OMP List_all_comb_b3_cent, int2_u2_j1b2) + !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP List_env1s_square_cent, int2_u2_env2) !$OMP DO do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -220,14 +223,14 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_ ! --- - do i_1s = 2, List_all_comb_b3_size + do i_1s = 2, List_env1s_square_size - coef = List_all_comb_b3_coef (i_1s) + coef = List_env1s_square_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b3_expo (i_1s) - 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) + beta = List_env1s_square_expo (i_1s) + B_center(1) = List_env1s_square_cent(1,i_1s) + B_center(2) = List_env1s_square_cent(2,i_1s) + B_center(3) = List_env1s_square_cent(3,i_1s) int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) @@ -238,7 +241,7 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_ enddo - int2_u2_j1b2(j,i,ipoint) = tmp + int2_u2_env2(j,i,ipoint) = tmp enddo enddo enddo @@ -248,23 +251,23 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_ do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u2_j1b2(j,i,ipoint) = int2_u2_j1b2(i,j,ipoint) + int2_u2_env2(j,i,ipoint) = int2_u2_env2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u2_j1b2', wall1 - wall0 + print*, ' wall time for int2_u2_env2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2, (ao_num, ao_num, n_points_final_grid, 3)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 ! END_DOC @@ -276,23 +279,24 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin double precision :: tmp_x, tmp_y, tmp_z double precision :: wall0, wall1 - print*, ' providing int2_u_grad1u_x_j1b2 ...' + print*, ' providing int2_u_grad1u_x_env2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points - int2_u_grad1u_x_j1b2 = 0.d0 + int2_u_grad1u_x_env2 = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP 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 SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & - !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & - !$OMP List_all_comb_b3_cent, int2_u_grad1u_x_j1b2) + !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP List_env1s_square_cent, int2_u_grad1u_x_env2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -321,14 +325,14 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin ! --- - do i_1s = 2, List_all_comb_b3_size + do i_1s = 2, List_env1s_square_size - coef = List_all_comb_b3_coef (i_1s) + coef = List_env1s_square_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b3_expo (i_1s) - 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) + beta = List_env1s_square_expo (i_1s) + B_center(1) = List_env1s_square_cent(1,i_1s) + B_center(2) = List_env1s_square_cent(2,i_1s) + B_center(3) = List_env1s_square_cent(3,i_1s) dist = (B_center(1) - r(1)) * (B_center(1) - r(1)) & + (B_center(2) - r(2)) * (B_center(2) - r(2)) & + (B_center(3) - r(3)) * (B_center(3) - r(3)) @@ -355,9 +359,9 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin enddo - int2_u_grad1u_x_j1b2(j,i,ipoint,1) = tmp_x - int2_u_grad1u_x_j1b2(j,i,ipoint,2) = tmp_y - int2_u_grad1u_x_j1b2(j,i,ipoint,3) = tmp_z + int2_u_grad1u_x_env2(j,i,ipoint,1) = tmp_x + int2_u_grad1u_x_env2(j,i,ipoint,2) = tmp_y + int2_u_grad1u_x_env2(j,i,ipoint,3) = tmp_z enddo enddo enddo @@ -367,25 +371,25 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u_grad1u_x_j1b2(j,i,ipoint,1) = int2_u_grad1u_x_j1b2(i,j,ipoint,1) - int2_u_grad1u_x_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) + int2_u_grad1u_x_env2(j,i,ipoint,1) = int2_u_grad1u_x_env2(i,j,ipoint,1) + int2_u_grad1u_x_env2(j,i,ipoint,2) = int2_u_grad1u_x_env2(i,j,ipoint,2) + int2_u_grad1u_x_env2(j,i,ipoint,3) = int2_u_grad1u_x_env2(i,j,ipoint,3) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u_grad1u_x_j1b2 = ', wall1 - wall0 + print*, ' wall time for int2_u_grad1u_x_env2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [ double precision, int2_u_grad1u_env2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] ! END_DOC @@ -397,22 +401,23 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points double precision :: wall0, wall1 double precision, external :: NAI_pol_mult_erf_ao_with1s - print*, ' providing int2_u_grad1u_j1b2 ...' + print*, ' providing int2_u_grad1u_env2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points - int2_u_grad1u_j1b2 = 0.d0 + int2_u_grad1u_env2 = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP 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 SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & - !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & - !$OMP List_all_comb_b3_cent, int2_u_grad1u_j1b2) + !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP List_env1s_square_cent, int2_u_grad1u_env2) !$OMP DO do ipoint = 1, n_points_final_grid do i = 1, ao_num @@ -436,14 +441,14 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points ! --- - do i_1s = 2, List_all_comb_b3_size + do i_1s = 2, List_env1s_square_size - coef = List_all_comb_b3_coef (i_1s) + coef = List_env1s_square_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b3_expo (i_1s) - 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) + beta = List_env1s_square_expo (i_1s) + B_center(1) = List_env1s_square_cent(1,i_1s) + B_center(2) = List_env1s_square_cent(2,i_1s) + B_center(3) = List_env1s_square_cent(3,i_1s) dist = (B_center(1) - r(1)) * (B_center(1) - r(1)) & + (B_center(2) - r(2)) * (B_center(2) - r(2)) & + (B_center(3) - r(3)) * (B_center(3) - r(3)) @@ -468,7 +473,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points enddo - int2_u_grad1u_j1b2(j,i,ipoint) = tmp + int2_u_grad1u_env2(j,i,ipoint) = tmp enddo enddo enddo @@ -478,13 +483,13 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u_grad1u_j1b2(j,i,ipoint) = int2_u_grad1u_j1b2(i,j,ipoint) + int2_u_grad1u_env2(j,i,ipoint) = int2_u_grad1u_env2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u_grad1u_j1b2', wall1 - wall0 + print*, ' wall time for int2_u_grad1u_env2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER diff --git a/plugins/local/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f deleted file mode 100644 index 21927371..00000000 --- a/plugins/local/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f +++ /dev/null @@ -1,453 +0,0 @@ -! -!! --- -! -!BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)] -! -! BEGIN_DOC -! ! -! ! -\frac{1}{4} int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2 -! ! -! END_DOC -! -! implicit none -! integer :: i, j, ipoint, i_1s, i_fit -! integer :: i_mask_grid -! double precision :: r(3), expo_fit, coef_fit -! double precision :: coef, beta, B_center(3) -! double precision :: wall0, wall1 -! -! integer, allocatable :: n_mask_grid(:) -! double precision, allocatable :: r_mask_grid(:,:) -! double precision, allocatable :: int_fit_v(:) -! -! print*, ' providing int2_grad1u2_grad2u2_j1b2' -! -! provide mu_erf final_grid_points_transp j1b_pen -! call wall_time(wall0) -! -! int2_grad1u2_grad2u2_j1b2(:,:,:) = 0.d0 -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,& -! !$OMP coef_fit, expo_fit, int_fit_v, n_mask_grid, & -! !$OMP i_mask_grid, r_mask_grid) & -! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size,& -! !$OMP final_grid_points_transp, n_max_fit_slat, & -! !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & -! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & -! !$OMP List_all_comb_b3_cent, int2_grad1u2_grad2u2_j1b2, & -! !$OMP ao_overlap_abs) -! -! allocate(int_fit_v(n_points_final_grid)) -! allocate(n_mask_grid(n_points_final_grid)) -! allocate(r_mask_grid(n_points_final_grid,3)) -! -! !$OMP DO SCHEDULE(dynamic) -! do i = 1, ao_num -! do j = i, ao_num -! -! if(ao_overlap_abs(j,i) .lt. 1.d-12) then -! cycle -! endif -! -! do i_fit = 1, n_max_fit_slat -! -! expo_fit = expo_gauss_1_erf_x_2(i_fit) -! coef_fit = coef_gauss_1_erf_x_2(i_fit) * (-0.25d0) -! -! ! --- -! -! call overlap_gauss_r12_ao_v(final_grid_points_transp, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, n_points_final_grid) -! -! i_mask_grid = 0 ! dim -! n_mask_grid = 0 ! ind -! r_mask_grid = 0.d0 ! val -! do ipoint = 1, n_points_final_grid -! -! int2_grad1u2_grad2u2_j1b2(j,i,ipoint) += coef_fit * int_fit_v(ipoint) -! -! if(dabs(int_fit_v(ipoint)) .gt. 1d-10) then -! i_mask_grid += 1 -! n_mask_grid(i_mask_grid ) = ipoint -! r_mask_grid(i_mask_grid,1) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid,2) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid,3) = final_grid_points_transp(ipoint,3) -! endif -! -! enddo -! -! if(i_mask_grid .eq. 0) cycle -! -! ! --- -! -! do i_1s = 2, List_all_comb_b3_size -! -! coef = List_all_comb_b3_coef (i_1s) * coef_fit -! beta = List_all_comb_b3_expo (i_1s) -! B_center(1) = List_all_comb_b3_cent(1,i_1s) -! B_center(2) = List_all_comb_b3_cent(2,i_1s) -! B_center(3) = List_all_comb_b3_cent(3,i_1s) -! -! call overlap_gauss_r12_ao_with1s_v(B_center, beta, r_mask_grid, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, i_mask_grid) -! -! do ipoint = 1, i_mask_grid -! int2_grad1u2_grad2u2_j1b2(j,i,n_mask_grid(ipoint)) += coef * int_fit_v(ipoint) -! enddo -! -! enddo -! -! ! --- -! -! enddo -! enddo -! enddo -! !$OMP END DO -! -! deallocate(n_mask_grid) -! deallocate(r_mask_grid) -! deallocate(int_fit_v) -! -! !$OMP END PARALLEL -! -! do ipoint = 1, n_points_final_grid -! do i = 2, ao_num -! do j = 1, i-1 -! int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2(i,j,ipoint) -! enddo -! enddo -! enddo -! -! call wall_time(wall1) -! print*, ' wall time for int2_grad1u2_grad2u2_j1b2', wall1 - wall0 -! -!END_PROVIDER -! -!! --- -! -!BEGIN_PROVIDER [ double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_grid)] -! -! BEGIN_DOC -! ! -! ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2 -! ! -! END_DOC -! -! implicit none -! integer :: i, j, ipoint, i_1s, i_fit -! integer :: i_mask_grid -! double precision :: r(3), expo_fit, coef_fit -! double precision :: coef, beta, B_center(3), tmp -! double precision :: wall0, wall1 -! -! integer, allocatable :: n_mask_grid(:) -! double precision, allocatable :: r_mask_grid(:,:) -! double precision, allocatable :: int_fit_v(:) -! -! print*, ' providing int2_u2_j1b2' -! -! provide mu_erf final_grid_points_transp j1b_pen -! call wall_time(wall0) -! -! int2_u2_j1b2(:,:,:) = 0.d0 -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & -! !$OMP coef_fit, expo_fit, int_fit_v, & -! !$OMP i_mask_grid, n_mask_grid, r_mask_grid ) & -! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, & -! !$OMP final_grid_points_transp, n_max_fit_slat, & -! !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, & -! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & -! !$OMP List_all_comb_b3_cent, int2_u2_j1b2) -! -! allocate(n_mask_grid(n_points_final_grid)) -! allocate(r_mask_grid(n_points_final_grid,3)) -! allocate(int_fit_v(n_points_final_grid)) -! -! !$OMP DO SCHEDULE(dynamic) -! do i = 1, ao_num -! do j = i, ao_num -! -! do i_fit = 1, n_max_fit_slat -! -! expo_fit = expo_gauss_j_mu_x_2(i_fit) -! coef_fit = coef_gauss_j_mu_x_2(i_fit) -! -! ! --- -! -! call overlap_gauss_r12_ao_v(final_grid_points_transp, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, n_points_final_grid) -! -! i_mask_grid = 0 ! dim -! n_mask_grid = 0 ! ind -! r_mask_grid = 0.d0 ! val -! -! do ipoint = 1, n_points_final_grid -! int2_u2_j1b2(j,i,ipoint) += coef_fit * int_fit_v(ipoint) -! -! if(dabs(int_fit_v(ipoint)) .gt. 1d-10) then -! i_mask_grid += 1 -! n_mask_grid(i_mask_grid ) = ipoint -! r_mask_grid(i_mask_grid,1) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid,2) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid,3) = final_grid_points_transp(ipoint,3) -! endif -! enddo -! -! if(i_mask_grid .eq. 0) cycle -! -! ! --- -! -! do i_1s = 2, List_all_comb_b3_size -! -! coef = List_all_comb_b3_coef (i_1s) * coef_fit -! beta = List_all_comb_b3_expo (i_1s) -! B_center(1) = List_all_comb_b3_cent(1,i_1s) -! B_center(2) = List_all_comb_b3_cent(2,i_1s) -! B_center(3) = List_all_comb_b3_cent(3,i_1s) -! -! call overlap_gauss_r12_ao_with1s_v(B_center, beta, r_mask_grid, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, i_mask_grid) -! -! do ipoint = 1, i_mask_grid -! int2_u2_j1b2(j,i,n_mask_grid(ipoint)) += coef * int_fit_v(ipoint) -! enddo -! -! enddo -! -! ! --- -! -! enddo -! enddo -! enddo -! !$OMP END DO -! -! deallocate(n_mask_grid) -! deallocate(r_mask_grid) -! deallocate(int_fit_v) -! -! !$OMP END PARALLEL -! -! do ipoint = 1, n_points_final_grid -! do i = 2, ao_num -! do j = 1, i-1 -! int2_u2_j1b2(j,i,ipoint) = int2_u2_j1b2(i,j,ipoint) -! enddo -! enddo -! enddo -! -! call wall_time(wall1) -! print*, ' wall time for int2_u2_j1b2', wall1 - wall0 -! -!END_PROVIDER -! -!! --- -! -!BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_points_final_grid, 3)] -! -! BEGIN_DOC -! ! -! ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 -! ! -! END_DOC -! -! implicit none -! -! integer :: i, j, ipoint, i_1s, i_fit -! integer :: i_mask_grid1, i_mask_grid2, i_mask_grid3, i_mask_grid(3) -! double precision :: x, y, z, expo_fit, coef_fit -! double precision :: coef, beta, B_center(3) -! double precision :: alpha_1s, alpha_1s_inv, expo_coef_1s -! double precision :: wall0, wall1 -! -! integer, allocatable :: n_mask_grid(:,:) -! double precision, allocatable :: r_mask_grid(:,:,:) -! double precision, allocatable :: int_fit_v(:,:), dist(:,:), centr_1s(:,:,:) -! -! print*, ' providing int2_u_grad1u_x_j1b2' -! -! provide mu_erf final_grid_points_transp j1b_pen -! call wall_time(wall0) -! -! int2_u_grad1u_x_j1b2(:,:,:,:) = 0.d0 -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, x, y, z, coef, beta, & -! !$OMP coef_fit, expo_fit, int_fit_v, alpha_1s, dist, B_center,& -! !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, & -! !$OMP i_mask_grid1, i_mask_grid2, i_mask_grid3, i_mask_grid, & -! !$OMP n_mask_grid, r_mask_grid) & -! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, & -! !$OMP final_grid_points_transp, n_max_fit_slat, & -! !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & -! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & -! !$OMP List_all_comb_b3_cent, int2_u_grad1u_x_j1b2) -! -! allocate(dist(n_points_final_grid,3)) -! allocate(centr_1s(n_points_final_grid,3,3)) -! allocate(n_mask_grid(n_points_final_grid,3)) -! allocate(r_mask_grid(n_points_final_grid,3,3)) -! allocate(int_fit_v(n_points_final_grid,3)) -! -! !$OMP DO SCHEDULE(dynamic) -! do i = 1, ao_num -! do j = i, ao_num -! do i_fit = 1, n_max_fit_slat -! -! expo_fit = expo_gauss_j_mu_1_erf(i_fit) -! coef_fit = coef_gauss_j_mu_1_erf(i_fit) -! -! ! --- -! -! call NAI_pol_x_mult_erf_ao_with1s_v0(i, j, expo_fit, final_grid_points_transp, n_points_final_grid, 1.d+9, final_grid_points_transp, n_points_final_grid, int_fit_v, n_points_final_grid, n_points_final_grid) -! -! i_mask_grid1 = 0 ! dim -! i_mask_grid2 = 0 ! dim -! i_mask_grid3 = 0 ! dim -! n_mask_grid = 0 ! ind -! r_mask_grid = 0.d0 ! val -! do ipoint = 1, n_points_final_grid -! -! ! --- -! -! int2_u_grad1u_x_j1b2(j,i,ipoint,1) += coef_fit * int_fit_v(ipoint,1) -! -! if(dabs(int_fit_v(ipoint,1)) .gt. 1d-10) then -! i_mask_grid1 += 1 -! n_mask_grid(i_mask_grid1, 1) = ipoint -! r_mask_grid(i_mask_grid1,1,1) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid1,2,1) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid1,3,1) = final_grid_points_transp(ipoint,3) -! endif -! -! ! --- -! -! int2_u_grad1u_x_j1b2(j,i,ipoint,2) += coef_fit * int_fit_v(ipoint,2) -! -! if(dabs(int_fit_v(ipoint,2)) .gt. 1d-10) then -! i_mask_grid2 += 1 -! n_mask_grid(i_mask_grid2, 2) = ipoint -! r_mask_grid(i_mask_grid2,1,2) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid2,2,2) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid2,3,2) = final_grid_points_transp(ipoint,3) -! endif -! -! ! --- -! -! int2_u_grad1u_x_j1b2(j,i,ipoint,3) += coef_fit * int_fit_v(ipoint,3) -! -! if(dabs(int_fit_v(ipoint,3)) .gt. 1d-10) then -! i_mask_grid3 += 1 -! n_mask_grid(i_mask_grid3, 3) = ipoint -! r_mask_grid(i_mask_grid3,1,3) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid3,2,3) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid3,3,3) = final_grid_points_transp(ipoint,3) -! endif -! -! ! --- -! -! enddo -! -! if((i_mask_grid1+i_mask_grid2+i_mask_grid3) .eq. 0) cycle -! -! i_mask_grid(1) = i_mask_grid1 -! i_mask_grid(2) = i_mask_grid2 -! i_mask_grid(3) = i_mask_grid3 -! -! ! --- -! -! do i_1s = 2, List_all_comb_b3_size -! -! coef = List_all_comb_b3_coef (i_1s) * coef_fit -! beta = List_all_comb_b3_expo (i_1s) -! B_center(1) = List_all_comb_b3_cent(1,i_1s) -! B_center(2) = List_all_comb_b3_cent(2,i_1s) -! B_center(3) = List_all_comb_b3_cent(3,i_1s) -! -! alpha_1s = beta + expo_fit -! alpha_1s_inv = 1.d0 / alpha_1s -! expo_coef_1s = beta * expo_fit * alpha_1s_inv -! -! do ipoint = 1, i_mask_grid1 -! -! x = r_mask_grid(ipoint,1,1) -! y = r_mask_grid(ipoint,2,1) -! z = r_mask_grid(ipoint,3,1) -! -! centr_1s(ipoint,1,1) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x) -! centr_1s(ipoint,2,1) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y) -! centr_1s(ipoint,3,1) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z) -! -! dist(ipoint,1) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z) -! enddo -! -! do ipoint = 1, i_mask_grid2 -! -! x = r_mask_grid(ipoint,1,2) -! y = r_mask_grid(ipoint,2,2) -! z = r_mask_grid(ipoint,3,2) -! -! centr_1s(ipoint,1,2) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x) -! centr_1s(ipoint,2,2) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y) -! centr_1s(ipoint,3,2) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z) -! -! dist(ipoint,2) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z) -! enddo -! -! do ipoint = 1, i_mask_grid3 -! -! x = r_mask_grid(ipoint,1,3) -! y = r_mask_grid(ipoint,2,3) -! z = r_mask_grid(ipoint,3,3) -! -! centr_1s(ipoint,1,3) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x) -! centr_1s(ipoint,2,3) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y) -! centr_1s(ipoint,3,3) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z) -! -! dist(ipoint,3) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z) -! enddo -! -! call NAI_pol_x_mult_erf_ao_with1s_v(i, j, alpha_1s, centr_1s, n_points_final_grid, 1.d+9, r_mask_grid, n_points_final_grid, int_fit_v, n_points_final_grid, i_mask_grid) -! -! do ipoint = 1, i_mask_grid1 -! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,1),1) += coef * dexp(-expo_coef_1s * dist(ipoint,1)) * int_fit_v(ipoint,1) -! enddo -! -! do ipoint = 1, i_mask_grid2 -! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,2),2) += coef * dexp(-expo_coef_1s * dist(ipoint,2)) * int_fit_v(ipoint,2) -! enddo -! -! do ipoint = 1, i_mask_grid3 -! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,3),3) += coef * dexp(-expo_coef_1s * dist(ipoint,3)) * int_fit_v(ipoint,3) -! enddo -! -! enddo -! -! ! --- -! -! enddo -! enddo -! enddo -! !$OMP END DO -! -! deallocate(dist) -! deallocate(centr_1s) -! deallocate(n_mask_grid) -! deallocate(r_mask_grid) -! deallocate(int_fit_v) -! -! !$OMP END PARALLEL -! -! do ipoint = 1, n_points_final_grid -! do i = 2, ao_num -! do j = 1, i-1 -! int2_u_grad1u_x_j1b2(j,i,ipoint,1) = int2_u_grad1u_x_j1b2(i,j,ipoint,1) -! int2_u_grad1u_x_j1b2(j,i,ipoint,2) = int2_u_grad1u_x_j1b2(i,j,ipoint,2) -! int2_u_grad1u_x_j1b2(j,i,ipoint,3) = int2_u_grad1u_x_j1b2(i,j,ipoint,3) -! enddo -! enddo -! enddo -! -! call wall_time(wall1) -! print*, ' wall time for int2_u_grad1u_x_j1b2 =', wall1 - wall0 -! -!END_PROVIDER -! diff --git a/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f index 66a2b961..6c163df6 100644 --- a/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f @@ -1,11 +1,11 @@ ! --- -BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R| + ! int dr phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R| - 1) / |r - R| ! END_DOC @@ -13,24 +13,23 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, integer :: i, j, ipoint, i_1s double precision :: r(3), int_mu, int_coulomb double precision :: coef, beta, B_center(3) - double precision :: tmp,int_j1b + double precision :: tmp,int_env double precision :: wall0, wall1 double precision, external :: NAI_pol_mult_erf_ao_with1s double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2 - print*, ' providing v_ij_erf_rk_cst_mu_j1b_test ...' + print*, ' providing v_ij_erf_rk_cst_mu_env_test ...' dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen call wall_time(wall0) - v_ij_erf_rk_cst_mu_j1b_test = 0.d0 + v_ij_erf_rk_cst_mu_env_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp, int_j1b)& + !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp, int_env)& !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points, & - !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_j1b, & - !$OMP v_ij_erf_rk_cst_mu_j1b_test, mu_erf, & + !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_env, & + !$OMP v_ij_erf_rk_cst_mu_env_test, mu_erf, & !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc) !$OMP DO !do ipoint = 1, 10 @@ -48,8 +47,8 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, coef = List_comb_thr_b2_coef (i_1s,j,i) beta = List_comb_thr_b2_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b2_env(i_1s,j,i) +! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i) @@ -60,7 +59,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, tmp += coef * (int_mu - int_coulomb) enddo - v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = tmp + v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) = tmp enddo enddo enddo @@ -70,22 +69,22 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint) + v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_env_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0 + print*, ' wall time for v_ij_erf_rk_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid, 3)] BEGIN_DOC - ! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R| + ! int dr x phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R|) - 1)/|r - R| END_DOC implicit none @@ -93,23 +92,23 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu double precision :: coef, beta, B_center(3), r(3), ints(3), ints_coulomb(3) double precision :: tmp_x, tmp_y, tmp_z double precision :: wall0, wall1 - double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2,int_j1b,factor_ij_1s,beta_ij,center_ij_1s + double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2,int_env,factor_ij_1s,beta_ij,center_ij_1s - print*, ' providing x_v_ij_erf_rk_cst_mu_j1b_test ...' + print*, ' providing x_v_ij_erf_rk_cst_mu_env_test ...' dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) provide expo_erfc_mu_gauss ao_prod_sigma ao_prod_center call wall_time(wall0) - x_v_ij_erf_rk_cst_mu_j1b_test = 0.d0 + x_v_ij_erf_rk_cst_mu_env_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb, & - !$OMP int_j1b, tmp_x, tmp_y, tmp_z,factor_ij_1s,beta_ij,center_ij_1s) & + !$OMP int_env, tmp_x, tmp_y, tmp_z,factor_ij_1s,beta_ij,center_ij_1s) & !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points,& !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent, & - !$OMP x_v_ij_erf_rk_cst_mu_j1b_test, mu_erf,ao_abs_comb_b2_j1b, & + !$OMP x_v_ij_erf_rk_cst_mu_env_test, mu_erf,ao_abs_comb_b2_env, & !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,thrsh_cycle_tc) ! !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,expo_erfc_mu_gauss) !$OMP DO @@ -129,8 +128,8 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu coef = List_comb_thr_b2_coef (i_1s,j,i) beta = List_comb_thr_b2_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i) - ! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b2_env(i_1s,j,i) + ! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i) @@ -143,9 +142,9 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu tmp_z += coef * (ints(3) - ints_coulomb(3)) enddo - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = tmp_x - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,2) = tmp_y - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = tmp_z + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,1) = tmp_x + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,2) = tmp_y + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,3) = tmp_z enddo enddo enddo @@ -155,26 +154,26 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,1) - x_v_ij_erf_rk_cst_mu_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) + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,1) + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,2) + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,3) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0 + print*, ' wall time for x_v_ij_erf_rk_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- ! TODO analytically -BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) ! END_DOC @@ -185,29 +184,28 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po double precision :: tmp double precision :: wall0, wall1 double precision :: beta_ij_u, factor_ij_1s_u, center_ij_1s_u(3), coeftot - double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_j1b + double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_env double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing v_ij_u_cst_mu_j1b_test ...' + print*, ' providing v_ij_u_cst_mu_env_test ...' dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen call wall_time(wall0) - v_ij_u_cst_mu_j1b_test = 0.d0 + v_ij_u_cst_mu_env_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP beta_ij_u, factor_ij_1s_u, center_ij_1s_u, & - !$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_j1b) & + !$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_env) & !$OMP SHARED (n_points_final_grid, ao_num, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, & !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, & - !$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_test,ao_abs_comb_b2_j1b, & + !$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_env_test,ao_abs_comb_b2_env, & !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid @@ -225,8 +223,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b2_j1b(1,j,i) - ! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle + int_env = ao_abs_comb_b2_env(1,j,i) + ! if(dabs(int_env).lt.thrsh_cycle_tc) cycle do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_j_mu_x(i_fit) coef_fit = coef_gauss_j_mu_x(i_fit) @@ -242,8 +240,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po do i_1s = 2, List_comb_thr_b2_size(j,i) coef = List_comb_thr_b2_coef (i_1s,j,i) beta = List_comb_thr_b2_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b2_env(i_1s,j,i) +! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i) @@ -259,7 +257,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po enddo enddo - v_ij_u_cst_mu_j1b_test(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_test(j,i,ipoint) = tmp enddo enddo enddo @@ -269,23 +267,23 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_test(i,j,ipoint) + v_ij_u_cst_mu_env_test(j,i,ipoint) = v_ij_u_cst_mu_env_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_test', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) with u(mu,r12) \approx 1/2 mu e^{-2.5 * mu (r12)^2} + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) with u(mu,r12) \approx 1/2 mu e^{-2.5 * mu (r12)^2} ! END_DOC @@ -296,27 +294,26 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, double precision :: tmp double precision :: wall0, wall1 double precision :: beta_ij_u, factor_ij_1s_u, center_ij_1s_u(3), coeftot - double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_j1b + double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_env double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen call wall_time(wall0) - v_ij_u_cst_mu_j1b_ng_1_test = 0.d0 + v_ij_u_cst_mu_env_ng_1_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, & !$OMP beta_ij_u, factor_ij_1s_u, center_ij_1s_u, & - !$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_j1b) & + !$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_env) & !$OMP SHARED (n_points_final_grid, ao_num, & !$OMP final_grid_points, expo_good_j_mu_1gauss,coef_good_j_mu_1gauss, & !$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, & !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, & - !$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_ng_1_test,ao_abs_comb_b2_j1b, & + !$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_env_ng_1_test,ao_abs_comb_b2_env, & !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid @@ -334,8 +331,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b2_j1b(1,j,i) -! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle + int_env = ao_abs_comb_b2_env(1,j,i) +! if(dabs(int_env).lt.thrsh_cycle_tc) cycle expo_fit = expo_good_j_mu_1gauss int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j) tmp += int_fit @@ -347,8 +344,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, do i_1s = 2, List_comb_thr_b2_size(j,i) coef = List_comb_thr_b2_coef (i_1s,j,i) beta = List_comb_thr_b2_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b2_env(i_1s,j,i) +! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i) @@ -364,7 +361,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, ! enddo enddo - v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint) = tmp enddo enddo enddo @@ -374,13 +371,13 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_ng_1_test(i,j,ipoint) + v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_env_ng_1_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_ng_1_test', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_ng_1_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER diff --git a/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f index 24b33eb5..00e2d5fc 100644 --- a/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f @@ -1,11 +1,11 @@ ! --- -BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R| + ! int dr phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R| - 1) / |r - R| ! END_DOC @@ -17,18 +17,20 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po double precision :: wall0, wall1 double precision, external :: NAI_pol_mult_erf_ao_with1s - print *, ' providing v_ij_erf_rk_cst_mu_j1b ...' + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE env_expo + + print *, ' providing v_ij_erf_rk_cst_mu_env ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen - - v_ij_erf_rk_cst_mu_j1b = 0.d0 + v_ij_erf_rk_cst_mu_env = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, 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 SHARED (n_points_final_grid, ao_num, List_env1s_size, final_grid_points, & + !$OMP List_env1s_coef, List_env1s_expo, List_env1s_cent, & + !$OMP v_ij_erf_rk_cst_mu_env, mu_erf) !$OMP DO !do ipoint = 1, 10 do ipoint = 1, n_points_final_grid @@ -43,28 +45,27 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po ! --- - coef = List_all_comb_b2_coef (1) - 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) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) int_mu = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r) int_coulomb = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r) -! if(dabs(coef)*dabs(int_mu - int_coulomb) .lt. 1d-12) cycle tmp += coef * (int_mu - int_coulomb) ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - 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) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) int_mu = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r) int_coulomb = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r) @@ -74,7 +75,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po ! --- - v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) = tmp + v_ij_erf_rk_cst_mu_env(j,i,ipoint) = tmp enddo enddo enddo @@ -84,22 +85,22 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) + v_ij_erf_rk_cst_mu_env(j,i,ipoint) = v_ij_erf_rk_cst_mu_env(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_erf_rk_cst_mu_j1b', wall1 - wall0 + print*, ' wall time for v_ij_erf_rk_cst_mu_env (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_points_final_grid, 3)] BEGIN_DOC - ! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R| + ! int dr x phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R|) - 1)/|r - R| END_DOC implicit none @@ -108,17 +109,17 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ double precision :: tmp_x, tmp_y, tmp_z double precision :: wall0, wall1 - print*, ' providing x_v_ij_erf_rk_cst_mu_j1b ...' + print*, ' providing x_v_ij_erf_rk_cst_mu_env ...' call wall_time(wall0) - x_v_ij_erf_rk_cst_mu_j1b = 0.d0 + x_v_ij_erf_rk_cst_mu_env = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb, & !$OMP tmp_x, tmp_y, tmp_z) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, final_grid_points,& - !$OMP 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 SHARED (n_points_final_grid, ao_num, List_env1s_size, final_grid_points,& + !$OMP List_env1s_coef, List_env1s_expo, List_env1s_cent, & + !$OMP x_v_ij_erf_rk_cst_mu_env, mu_erf) !$OMP DO !do ipoint = 1, 10 do ipoint = 1, n_points_final_grid @@ -135,11 +136,11 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ ! --- - coef = List_all_comb_b2_coef (1) - 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) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints ) call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, ints_coulomb) @@ -152,14 +153,14 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - 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) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints ) call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, ints_coulomb) @@ -171,9 +172,9 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ ! --- - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,1) = tmp_x - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,2) = tmp_y - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,3) = tmp_z + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,1) = tmp_x + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,2) = tmp_y + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,3) = tmp_z enddo enddo enddo @@ -183,25 +184,25 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1) - x_v_ij_erf_rk_cst_mu_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) + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b =', wall1 - wall0 + print*, ' wall time for x_v_ij_erf_rk_cst_mu_env (min) =', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_fit, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) ! END_DOC @@ -214,23 +215,23 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing v_ij_u_cst_mu_j1b_fit ...' + print*, ' providing v_ij_u_cst_mu_env_fit ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf final_grid_points env_expo PROVIDE ng_fit_jast expo_gauss_j_mu_x coef_gauss_j_mu_x - PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent + PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent - v_ij_u_cst_mu_j1b_fit = 0.d0 + v_ij_u_cst_mu_env_fit = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, tmp) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, & - !$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, & - !$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_fit) + !$OMP List_env1s_coef, List_env1s_expo, & + !$OMP List_env1s_cent, v_ij_u_cst_mu_env_fit) !$OMP DO do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -247,11 +248,11 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi ! --- - coef = List_all_comb_b2_coef (1) - 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) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) @@ -259,14 +260,14 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - 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) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) @@ -277,7 +278,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi enddo - v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_fit(j,i,ipoint) = tmp enddo enddo enddo @@ -287,23 +288,23 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = v_ij_u_cst_mu_j1b_fit(i,j,ipoint) + v_ij_u_cst_mu_env_fit(j,i,ipoint) = v_ij_u_cst_mu_env_fit(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_fit', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_fit (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an_old, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) ! END_DOC @@ -322,24 +323,24 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p double precision, external :: overlap_gauss_r12_ao_with1s double precision, external :: NAI_pol_mult_erf_ao_with1s - print*, ' providing v_ij_u_cst_mu_j1b_an_old ...' + print*, ' providing v_ij_u_cst_mu_env_an_old ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen - PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent + provide mu_erf final_grid_points env_expo + PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent ct = inv_sq_pi_2 / mu_erf - v_ij_u_cst_mu_j1b_an_old = 0.d0 + v_ij_u_cst_mu_env_an_old = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, & !$OMP r1_2, tmp, int_c1, int_e1, int_o, int_c2, & !$OMP int_e2, int_c3, int_e3) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, & !$OMP final_grid_points, mu_erf, ct, & - !$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, & - !$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an_old) + !$OMP List_env1s_coef, List_env1s_expo, & + !$OMP List_env1s_cent, v_ij_u_cst_mu_env_an_old) !$OMP DO do ipoint = 1, n_points_final_grid @@ -353,11 +354,11 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p ! --- - coef = List_all_comb_b2_coef (1) - 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) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r) int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r) @@ -379,14 +380,14 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - 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) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r) int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r) @@ -410,7 +411,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p ! --- - v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_an_old(j,i,ipoint) = tmp enddo enddo enddo @@ -420,23 +421,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) = v_ij_u_cst_mu_j1b_an_old(i,j,ipoint) + v_ij_u_cst_mu_env_an_old(j,i,ipoint) = v_ij_u_cst_mu_env_an_old(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_an_old', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_an_old (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) ! END_DOC @@ -454,23 +455,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point double precision, external :: overlap_gauss_r12_ao_with1s double precision, external :: NAI_pol_mult_erf_ao_with1s - print*, ' providing v_ij_u_cst_mu_j1b_an ...' + print*, ' providing v_ij_u_cst_mu_env_an ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen - PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent + provide mu_erf final_grid_points env_expo + PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent ct = inv_sq_pi_2 / mu_erf - v_ij_u_cst_mu_j1b_an = 0.d0 + v_ij_u_cst_mu_env_an = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, & !$OMP r1_2, tmp, int_c, int_e, int_o) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, & !$OMP final_grid_points, mu_erf, ct, & - !$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, & - !$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an) + !$OMP List_env1s_coef, List_env1s_expo, & + !$OMP List_env1s_cent, v_ij_u_cst_mu_env_an) !$OMP DO do ipoint = 1, n_points_final_grid @@ -484,11 +485,11 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point ! --- - coef = List_all_comb_b2_coef (1) - 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) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c) call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e) @@ -504,14 +505,14 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - 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) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c) call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e) @@ -529,7 +530,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point ! --- - v_ij_u_cst_mu_j1b_an(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_an(j,i,ipoint) = tmp enddo enddo enddo @@ -539,13 +540,13 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_an(j,i,ipoint) = v_ij_u_cst_mu_j1b_an(i,j,ipoint) + v_ij_u_cst_mu_env_an(j,i,ipoint) = v_ij_u_cst_mu_env_an(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_an', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_an (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER diff --git a/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f b/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f new file mode 100644 index 00000000..8d97d514 --- /dev/null +++ b/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f @@ -0,0 +1,574 @@ + +! --- + + BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_2, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_LinFcRSDFT_long_Du_0 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] + ! + ! Ir2_LinFcRSDFT_long_Du_x = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * x2 + ! Ir2_LinFcRSDFT_long_Du_y = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * y2 + ! Ir2_LinFcRSDFT_long_Du_z = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * z2 + ! + ! Ir2_LinFcRSDFT_long_Du_2 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * r2^2 + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s + double precision :: r(3), int_clb(7), int_erf(7) + double precision :: c_1s, e_1s, R_1s(3) + double precision :: tmp_Du_0, tmp_Du_x, tmp_Du_y, tmp_Du_z, tmp_Du_2 + double precision :: wall0, wall1 + + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent + + + print *, ' providing Ir2_LinFcRSDFT_long_Du ...' + call wall_time(wall0) + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, r, c_1s, e_1s, R_1s, int_erf, int_clb, & + !$OMP tmp_Du_0, tmp_Du_x, tmp_Du_y, tmp_Du_z, tmp_Du_2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_erf, & + !$OMP List_env1s_size, List_env1s_expo, & + !$OMP List_env1s_coef, List_env1s_cent, & + !$OMP Ir2_LinFcRSDFT_long_Du_0, Ir2_LinFcRSDFT_long_Du_x, & + !$OMP Ir2_LinFcRSDFT_long_Du_y, Ir2_LinFcRSDFT_long_Du_z, & + !$OMP Ir2_LinFcRSDFT_long_Du_2) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + do i = 1, ao_num + do j = i, ao_num + + call NAI_pol_012_mult_erf_ao(i, j, 1.d+9, r, int_clb) + call NAI_pol_012_mult_erf_ao(i, j, mu_erf, r, int_erf) + + tmp_Du_0 = int_clb(1) - int_erf(1) + tmp_Du_x = int_clb(2) - int_erf(2) + tmp_Du_y = int_clb(3) - int_erf(3) + tmp_Du_z = int_clb(4) - int_erf(4) + tmp_Du_2 = int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7) + + do i_1s = 2, List_env1s_size + + e_1s = List_env1s_expo(i_1s) + c_1s = List_env1s_coef(i_1s) + R_1s(1) = List_env1s_cent(1,i_1s) + R_1s(2) = List_env1s_cent(2,i_1s) + R_1s(3) = List_env1s_cent(3,i_1s) + + call NAI_pol_012_mult_erf_ao_with1s(i, j, e_1s, R_1s, 1.d+9, r, int_clb) + call NAI_pol_012_mult_erf_ao_with1s(i, j, e_1s, R_1s, mu_erf, r, int_erf) + + tmp_Du_0 = tmp_Du_0 + c_1s * (int_clb(1) - int_erf(1)) + tmp_Du_x = tmp_Du_x + c_1s * (int_clb(2) - int_erf(2)) + tmp_Du_y = tmp_Du_y + c_1s * (int_clb(3) - int_erf(3)) + tmp_Du_z = tmp_Du_z + c_1s * (int_clb(4) - int_erf(4)) + tmp_Du_2 = tmp_Du_2 + c_1s * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)) + enddo + + Ir2_LinFcRSDFT_long_Du_0(j,i,ipoint) = tmp_Du_0 + Ir2_LinFcRSDFT_long_Du_x(j,i,ipoint) = tmp_Du_x + Ir2_LinFcRSDFT_long_Du_y(j,i,ipoint) = tmp_Du_y + Ir2_LinFcRSDFT_long_Du_z(j,i,ipoint) = tmp_Du_z + Ir2_LinFcRSDFT_long_Du_2(j,i,ipoint) = tmp_Du_2 + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + Ir2_LinFcRSDFT_long_Du_0(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) + Ir2_LinFcRSDFT_long_Du_x(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_x(i,j,ipoint) + Ir2_LinFcRSDFT_long_Du_y(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_y(i,j,ipoint) + Ir2_LinFcRSDFT_long_Du_z(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_z(i,j,ipoint) + Ir2_LinFcRSDFT_long_Du_2(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_LinFcRSDFT_long_Du (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_LinFcRSDFT_gauss_Du = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) e^{-(mu r_12)^2} + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s + double precision :: r(3) + double precision :: coef, beta, B_center(3) + double precision :: tmp_Du + double precision :: mu_sq, dx, dy, dz, tmp_arg, rmu_sq(3) + double precision :: e_1s, c_1s, R_1s(3) + double precision :: wall0, wall1 + + double precision, external :: overlap_gauss_r12_ao + + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent + + + print *, ' providing Ir2_LinFcRSDFT_gauss_Du ...' + call wall_time(wall0) + + mu_sq = mu_erf * mu_erf + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, dx, dy, dz, r, tmp_arg, coef, & + !$OMP rmu_sq, e_1s, c_1s, R_1s, beta, B_center, tmp_Du) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & + !$OMP List_env1s_size, List_env1s_expo, & + !$OMP List_env1s_coef, List_env1s_cent, & + !$OMP Ir2_LinFcRSDFT_gauss_Du) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + rmu_sq(1) = mu_sq * r(1) + rmu_sq(2) = mu_sq * r(2) + rmu_sq(3) = mu_sq * r(3) + + do i = 1, ao_num + do j = i, ao_num + + tmp_Du = overlap_gauss_r12_ao(r, mu_sq, j, i) + + do i_1s = 2, List_env1s_size + + e_1s = List_env1s_expo(i_1s) + c_1s = List_env1s_coef(i_1s) + R_1s(1) = List_env1s_cent(1,i_1s) + R_1s(2) = List_env1s_cent(2,i_1s) + R_1s(3) = List_env1s_cent(3,i_1s) + + dx = r(1) - R_1s(1) + dy = r(2) - R_1s(2) + dz = r(3) - R_1s(3) + + beta = mu_sq + e_1s + tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta + coef = c_1s * dexp(-tmp_arg) + B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta + B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta + B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta + + tmp_Du += coef * overlap_gauss_r12_ao(B_center, beta, j, i) + enddo + + Ir2_LinFcRSDFT_gauss_Du(j,i,ipoint) = tmp_Du + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + + Ir2_LinFcRSDFT_gauss_Du(j,i,ipoint) = Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_LinFcRSDFT_gauss_Du (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_2, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_LinFcRSDFT_long_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] + ! + ! Ir2_LinFcRSDFT_long_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * x2 + ! Ir2_LinFcRSDFT_long_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * y2 + ! Ir2_LinFcRSDFT_long_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * z2 + ! + ! Ir2_LinFcRSDFT_long_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * r2^2 + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s + double precision :: r(3), int_clb(7), int_erf(7) + double precision :: coef, beta, B_center(3) + double precision :: tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2 + double precision :: mu_sq, tmp_arg, dx, dy, dz, rmu_sq(3) + double precision :: e_1s, c_1s, R_1s(3) + double precision :: wall0, wall1 + + + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent + + print *, ' providing Ir2_LinFcRSDFT_long_Du2 ...' + call wall_time(wall0) + + mu_sq = mu_erf * mu_erf + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, r, rmu_sq, dx, dy, dz, & + !$OMP e_1s, c_1s, R_1s, tmp_arg, coef, beta, B_center, & + !$OMP int_erf, int_clb, & + !$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & + !$OMP mu_erf, List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_LinFcRSDFT_long_Du2_0, Ir2_LinFcRSDFT_long_Du2_x, & + !$OMP Ir2_LinFcRSDFT_long_Du2_y, Ir2_LinFcRSDFT_long_Du2_z, & + !$OMP Ir2_LinFcRSDFT_long_Du2_2) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + rmu_sq(1) = mu_sq * r(1) + rmu_sq(2) = mu_sq * r(2) + rmu_sq(3) = mu_sq * r(3) + + do i = 1, ao_num + do j = i, ao_num + + call NAI_pol_012_mult_erf_ao_with1s(i, j, mu_sq, r, 1.d+9, r, int_clb) + call NAI_pol_012_mult_erf_ao_with1s(i, j, mu_sq, r, mu_erf, r, int_erf) + + tmp_Du2_0 = int_clb(1) - int_erf(1) + tmp_Du2_x = int_clb(2) - int_erf(2) + tmp_Du2_y = int_clb(3) - int_erf(3) + tmp_Du2_z = int_clb(4) - int_erf(4) + tmp_Du2_2 = int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7) + + do i_1s = 2, List_env1s_square_size + + e_1s = List_env1s_square_expo(i_1s) + c_1s = List_env1s_square_coef(i_1s) + R_1s(1) = List_env1s_square_cent(1,i_1s) + R_1s(2) = List_env1s_square_cent(2,i_1s) + R_1s(3) = List_env1s_square_cent(3,i_1s) + + dx = r(1) - R_1s(1) + dy = r(2) - R_1s(2) + dz = r(3) - R_1s(3) + + beta = mu_sq + e_1s + tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta + coef = c_1s * dexp(-tmp_arg) + B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta + B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta + B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta + + call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_clb) + call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_erf) + + tmp_Du2_0 = tmp_Du2_0 + coef * (int_clb(1) - int_erf(1)) + tmp_Du2_x = tmp_Du2_x + coef * (int_clb(2) - int_erf(2)) + tmp_Du2_y = tmp_Du2_y + coef * (int_clb(3) - int_erf(3)) + tmp_Du2_z = tmp_Du2_z + coef * (int_clb(4) - int_erf(4)) + tmp_Du2_2 = tmp_Du2_2 + coef * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)) + enddo + + Ir2_LinFcRSDFT_long_Du2_0(j,i,ipoint) = tmp_Du2_0 + Ir2_LinFcRSDFT_long_Du2_x(j,i,ipoint) = tmp_Du2_x + Ir2_LinFcRSDFT_long_Du2_y(j,i,ipoint) = tmp_Du2_y + Ir2_LinFcRSDFT_long_Du2_z(j,i,ipoint) = tmp_Du2_z + Ir2_LinFcRSDFT_long_Du2_2(j,i,ipoint) = tmp_Du2_2 + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + Ir2_LinFcRSDFT_long_Du2_0(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_0(i,j,ipoint) + Ir2_LinFcRSDFT_long_Du2_x(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_x(i,j,ipoint) + Ir2_LinFcRSDFT_long_Du2_y(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_y(i,j,ipoint) + Ir2_LinFcRSDFT_long_Du2_z(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_z(i,j,ipoint) + Ir2_LinFcRSDFT_long_Du2_2(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_LinFcRSDFT_long_Du2 (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du2, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_LinFcRSDFT_gauss_Du2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 e^{-(mu r_12)^2} + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s + double precision :: r(3) + double precision :: coef, beta, B_center(3) + double precision :: tmp_Du2 + double precision :: mu_sq, dx, dy, dz, tmp_arg, rmu_sq(3) + double precision :: e_1s, c_1s, R_1s(3) + double precision :: wall0, wall1 + + double precision, external :: overlap_gauss_r12_ao + + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent + + + print *, ' providing Ir2_LinFcRSDFT_gauss_Du2 ...' + call wall_time(wall0) + + mu_sq = 2.d0 * mu_erf * mu_erf + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, dx, dy, dz, r, tmp_arg, coef, & + !$OMP rmu_sq, e_1s, c_1s, R_1s, beta, B_center, tmp_Du2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & + !$OMP List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_LinFcRSDFT_gauss_Du2) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + rmu_sq(1) = mu_sq * r(1) + rmu_sq(2) = mu_sq * r(2) + rmu_sq(3) = mu_sq * r(3) + + do i = 1, ao_num + do j = i, ao_num + + tmp_Du2 = overlap_gauss_r12_ao(r, mu_sq, j, i) + + do i_1s = 2, List_env1s_square_size + + e_1s = List_env1s_square_expo(i_1s) + c_1s = List_env1s_square_coef(i_1s) + R_1s(1) = List_env1s_square_cent(1,i_1s) + R_1s(2) = List_env1s_square_cent(2,i_1s) + R_1s(3) = List_env1s_square_cent(3,i_1s) + + dx = r(1) - R_1s(1) + dy = r(2) - R_1s(2) + dz = r(3) - R_1s(3) + + beta = mu_sq + e_1s + tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta + coef = c_1s * dexp(-tmp_arg) + B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta + B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta + B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta + + tmp_Du2 += coef * overlap_gauss_r12_ao(B_center, beta, j, i) + enddo + + Ir2_LinFcRSDFT_gauss_Du2(j,i,ipoint) = tmp_Du2 + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + + Ir2_LinFcRSDFT_gauss_Du2(j,i,ipoint) = Ir2_LinFcRSDFT_gauss_Du2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_LinFcRSDFT_gauss_Du2 (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_2, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_LinFcRSDFT_short_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 + ! + ! Ir2_LinFcRSDFT_short_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * x2 + ! Ir2_LinFcRSDFT_short_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * y2 + ! Ir2_LinFcRSDFT_short_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * z2 + ! + ! Ir2_LinFcRSDFT_short_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * r2^2 + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s, i_fit + double precision :: r(3), ints(7) + double precision :: coef, beta, B_center(3) + double precision :: tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2 + double precision :: tmp_arg, dx, dy, dz + double precision :: expo_fit, coef_fit, e_1s, c_1s, R_1s(3) + double precision :: wall0, wall1 + + PROVIDE final_grid_points + PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent + PROVIDE ng_fit_jast expo_gauss_1_erf_x_2 coef_gauss_1_erf_x_2 + + print *, ' providing Ir2_LinFcRSDFT_short_Du2 ...' + call wall_time(wall0) + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, dx, dy, dz, & + !$OMP expo_fit, coef_fit, e_1s, c_1s, R_1s, & + !$OMP tmp_arg, coef, beta, B_center, ints, & + !$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, & + !$OMP ng_fit_jast, expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & + !$OMP List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_LinFcRSDFT_short_Du2_0, Ir2_LinFcRSDFT_short_Du2_x, & + !$OMP Ir2_LinFcRSDFT_short_Du2_y, Ir2_LinFcRSDFT_short_Du2_z, & + !$OMP Ir2_LinFcRSDFT_short_Du2_2) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + do i = 1, ao_num + do j = i, ao_num + + tmp_Du2_0 = 0.d0 + tmp_Du2_x = 0.d0 + tmp_Du2_y = 0.d0 + tmp_Du2_z = 0.d0 + tmp_Du2_2 = 0.d0 + do i_fit = 1, ng_fit_jast + + expo_fit = expo_gauss_1_erf_x_2(i_fit) + coef_fit = coef_gauss_1_erf_x_2(i_fit) + + call overlap_gauss_r12_ao_012(r, expo_fit, i, j, ints) + + tmp_Du2_0 += coef_fit * ints(1) + tmp_Du2_x += coef_fit * ints(2) + tmp_Du2_y += coef_fit * ints(3) + tmp_Du2_z += coef_fit * ints(4) + tmp_Du2_2 += coef_fit * (ints(5) + ints(6) + ints(7)) + + do i_1s = 2, List_env1s_square_size + + e_1s = List_env1s_square_expo(i_1s) + c_1s = List_env1s_square_coef(i_1s) + R_1s(1) = List_env1s_square_cent(1,i_1s) + R_1s(2) = List_env1s_square_cent(2,i_1s) + R_1s(3) = List_env1s_square_cent(3,i_1s) + + dx = r(1) - R_1s(1) + dy = r(2) - R_1s(2) + dz = r(3) - R_1s(3) + + beta = expo_fit + e_1s + tmp_arg = expo_fit * e_1s * (dx*dx + dy*dy + dz*dz) / beta + coef = coef_fit * c_1s * dexp(-tmp_arg) + B_center(1) = (expo_fit * r(1) + e_1s * R_1s(1)) / beta + B_center(2) = (expo_fit * r(2) + e_1s * R_1s(2)) / beta + B_center(3) = (expo_fit * r(3) + e_1s * R_1s(3)) / beta + + call overlap_gauss_r12_ao_012(B_center, beta, i, j, ints) + + tmp_Du2_0 += coef * ints(1) + tmp_Du2_x += coef * ints(2) + tmp_Du2_y += coef * ints(3) + tmp_Du2_z += coef * ints(4) + tmp_Du2_2 += coef * (ints(5) + ints(6) + ints(7)) + enddo ! i_1s + enddo ! i_fit + + Ir2_LinFcRSDFT_short_Du2_0(j,i,ipoint) = tmp_Du2_0 + Ir2_LinFcRSDFT_short_Du2_x(j,i,ipoint) = tmp_Du2_x + Ir2_LinFcRSDFT_short_Du2_y(j,i,ipoint) = tmp_Du2_y + Ir2_LinFcRSDFT_short_Du2_z(j,i,ipoint) = tmp_Du2_z + Ir2_LinFcRSDFT_short_Du2_2(j,i,ipoint) = tmp_Du2_2 + enddo ! j + enddo ! i + enddo ! ipoint + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + Ir2_LinFcRSDFT_short_Du2_0(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_0(i,j,ipoint) + Ir2_LinFcRSDFT_short_Du2_x(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_x(i,j,ipoint) + Ir2_LinFcRSDFT_short_Du2_y(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_y(i,j,ipoint) + Ir2_LinFcRSDFT_short_Du2_z(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_z(i,j,ipoint) + Ir2_LinFcRSDFT_short_Du2_2(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_LinFcRSDFT_short_Du2 (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + diff --git a/plugins/local/ao_many_one_e_ints/listj1b.irp.f b/plugins/local/ao_many_one_e_ints/listj1b.irp.f index 33ca8085..845b93d7 100644 --- a/plugins/local/ao_many_one_e_ints/listj1b.irp.f +++ b/plugins/local/ao_many_one_e_ints/listj1b.irp.f @@ -1,34 +1,34 @@ ! --- -BEGIN_PROVIDER [integer, List_all_comb_b2_size] +BEGIN_PROVIDER [integer, List_env1s_size] implicit none - PROVIDE j1b_type + PROVIDE env_type - if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + if(env_type .eq. "prod-gauss") then - List_all_comb_b2_size = 2**nucl_num + List_env1s_size = 2**nucl_num - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "sum-gauss") then - List_all_comb_b2_size = nucl_num + 1 + List_env1s_size = nucl_num + 1 else - print *, 'j1b_type = ', j1b_type, 'is not implemented' + print *, ' Error in List_env1s_size: Unknown env_type = ', env_type stop endif - print *, ' nb of linear terms in the envelope is ', List_all_comb_b2_size + print *, ' nb of 1s-Gaussian in the envelope = ', List_env1s_size END_PROVIDER ! --- -BEGIN_PROVIDER [integer, List_all_comb_b2, (nucl_num, List_all_comb_b2_size)] +BEGIN_PROVIDER [integer, List_env1s, (nucl_num, List_env1s_size)] implicit none integer :: i, j @@ -38,12 +38,12 @@ BEGIN_PROVIDER [integer, List_all_comb_b2, (nucl_num, List_all_comb_b2_size)] stop endif - List_all_comb_b2 = 0 + List_env1s = 0 - do i = 0, List_all_comb_b2_size-1 + do i = 0, List_env1s_size-1 do j = 0, nucl_num-1 if (btest(i,j)) then - List_all_comb_b2(j+1,i+1) = 1 + List_env1s(j+1,i+1) = 1 endif enddo enddo @@ -52,134 +52,127 @@ 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)] + BEGIN_PROVIDER [ double precision, List_env1s_coef, ( List_env1s_size)] +&BEGIN_PROVIDER [ double precision, List_env1s_expo, ( List_env1s_size)] +&BEGIN_PROVIDER [ double precision, List_env1s_cent, (3, List_env1s_size)] implicit none integer :: i, j, k, phase double precision :: tmp_alphaj, tmp_alphak double precision :: tmp_cent_x, tmp_cent_y, tmp_cent_z - provide j1b_pen - provide j1b_pen_coef + provide env_type env_expo env_coef - List_all_comb_b2_coef = 0.d0 - List_all_comb_b2_expo = 0.d0 - List_all_comb_b2_cent = 0.d0 + List_env1s_coef = 0.d0 + List_env1s_expo = 0.d0 + List_env1s_cent = 0.d0 - if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + if(env_type .eq. "prod-gauss") then - do i = 1, List_all_comb_b2_size + do i = 1, List_env1s_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_alphaj = dble(List_env1s(j,i)) * env_expo(j) + List_env1s_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 + if(List_env1s_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) + List_env1s_cent(1,i) = tmp_cent_x / List_env1s_expo(i) + List_env1s_cent(2,i) = tmp_cent_y / List_env1s_expo(i) + List_env1s_cent(3,i) = tmp_cent_z / List_env1s_expo(i) enddo ! --- - do i = 1, List_all_comb_b2_size + do i = 1, List_env1s_size do j = 2, nucl_num, 1 - tmp_alphaj = dble(List_all_comb_b2(j,i)) * j1b_pen(j) + tmp_alphaj = dble(List_env1s(j,i)) * env_expo(j) do k = 1, j-1, 1 - tmp_alphak = dble(List_all_comb_b2(k,i)) * j1b_pen(k) + tmp_alphak = dble(List_env1s(k,i)) * env_expo(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)) & + List_env1s_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 + if(List_env1s_expo(i) .lt. 1d-10) cycle - List_all_comb_b2_coef(i) = List_all_comb_b2_coef(i) / List_all_comb_b2_expo(i) + List_env1s_coef(i) = List_env1s_coef(i) / List_env1s_expo(i) enddo ! --- - do i = 1, List_all_comb_b2_size + do i = 1, List_env1s_size phase = 0 do j = 1, nucl_num - phase += List_all_comb_b2(j,i) + phase += List_env1s(j,i) enddo - List_all_comb_b2_coef(i) = (-1.d0)**dble(phase) * dexp(-List_all_comb_b2_coef(i)) + List_env1s_coef(i) = (-1.d0)**dble(phase) * dexp(-List_env1s_coef(i)) enddo - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "sum-gauss") then - List_all_comb_b2_coef( 1) = 1.d0 - List_all_comb_b2_expo( 1) = 0.d0 - List_all_comb_b2_cent(1:3,1) = 0.d0 + List_env1s_coef( 1) = 1.d0 + List_env1s_expo( 1) = 0.d0 + List_env1s_cent(1:3,1) = 0.d0 do i = 1, nucl_num - List_all_comb_b2_coef( i+1) = -1.d0 * j1b_pen_coef(i) - List_all_comb_b2_expo( i+1) = j1b_pen(i) - List_all_comb_b2_cent(1,i+1) = nucl_coord(i,1) - List_all_comb_b2_cent(2,i+1) = nucl_coord(i,2) - List_all_comb_b2_cent(3,i+1) = nucl_coord(i,3) + List_env1s_coef( i+1) = -1.d0 * env_coef(i) + List_env1s_expo( i+1) = env_expo(i) + List_env1s_cent(1,i+1) = nucl_coord(i,1) + List_env1s_cent(2,i+1) = nucl_coord(i,2) + List_env1s_cent(3,i+1) = nucl_coord(i,3) enddo else - print *, 'j1b_type = ', j1b_type, 'is not implemented' + print *, ' Error in List_env1s: Unknown env_type = ', env_type stop endif - !print *, ' coeff, expo & cent of list b2' - !do i = 1, List_all_comb_b2_size - ! print*, i, List_all_comb_b2_coef(i), List_all_comb_b2_expo(i) - ! print*, List_all_comb_b2_cent(1,i), List_all_comb_b2_cent(2,i), List_all_comb_b2_cent(3,i) - !enddo - END_PROVIDER ! --- -BEGIN_PROVIDER [ integer, List_all_comb_b3_size] +BEGIN_PROVIDER [integer, List_env1s_square_size] implicit none double precision :: tmp - if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + if(env_type .eq. "prod-gauss") then - List_all_comb_b3_size = 3**nucl_num + List_env1s_square_size = 3**nucl_num - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "sum-gauss") then tmp = 0.5d0 * dble(nucl_num) * (dble(nucl_num) + 3.d0) - List_all_comb_b3_size = int(tmp) + 1 + List_env1s_square_size = int(tmp) + 1 else - print *, 'j1b_type = ', j1b_type, 'is not implemented' + print *, ' Error in List_env1s_square_size: Unknown env_type = ', env_type stop endif - print *, ' nb of linear terms in the square of the envelope is ', List_all_comb_b3_size + print *, ' nb of 1s-Gaussian in the square of envelope = ', List_env1s_square_size END_PROVIDER ! --- -BEGIN_PROVIDER [integer, List_all_comb_b3, (nucl_num, List_all_comb_b3_size)] +BEGIN_PROVIDER [integer, List_env1s_square, (nucl_num, List_env1s_square_size)] implicit none integer :: i, j, ii, jj @@ -190,13 +183,13 @@ BEGIN_PROVIDER [integer, List_all_comb_b3, (nucl_num, List_all_comb_b3_size)] stop endif - List_all_comb_b3(:,:) = 0 - List_all_comb_b3(:,List_all_comb_b3_size) = 2 + List_env1s_square(:,:) = 0 + List_env1s_square(:,List_env1s_square_size) = 2 allocate(p(nucl_num)) p = 0 - do i = 2, List_all_comb_b3_size-1 + do i = 2, List_env1s_square_size-1 do j = 1, nucl_num ii = 0 @@ -205,7 +198,7 @@ BEGIN_PROVIDER [integer, List_all_comb_b3, (nucl_num, List_all_comb_b3_size)] enddo p(j) = modulo(i-1-ii, 3**j) / 3**(j-1) - List_all_comb_b3(j,i) = p(j) + List_env1s_square(j,i) = p(j) enddo enddo @@ -213,9 +206,9 @@ 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)] + BEGIN_PROVIDER [ double precision, List_env1s_square_coef, ( List_env1s_square_size)] +&BEGIN_PROVIDER [ double precision, List_env1s_square_expo, ( List_env1s_square_size)] +&BEGIN_PROVIDER [ double precision, List_env1s_square_cent, (3, List_env1s_square_size)] implicit none integer :: i, j, k, phase @@ -225,98 +218,96 @@ END_PROVIDER double precision :: xi, yi, zi, xj, yj, zj double precision :: dx, dy, dz, r2 - provide j1b_pen - provide j1b_pen_coef + provide env_type env_expo env_coef - List_all_comb_b3_coef = 0.d0 - List_all_comb_b3_expo = 0.d0 - List_all_comb_b3_cent = 0.d0 + List_env1s_square_coef = 0.d0 + List_env1s_square_expo = 0.d0 + List_env1s_square_cent = 0.d0 - if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + if(env_type .eq. "prod-gauss") then - do i = 1, List_all_comb_b3_size + do i = 1, List_env1s_square_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) + tmp_alphaj = dble(List_env1s_square(j,i)) * env_expo(j) + List_env1s_square_expo(i) += tmp_alphaj + List_env1s_square_cent(1,i) += tmp_alphaj * nucl_coord(j,1) + List_env1s_square_cent(2,i) += tmp_alphaj * nucl_coord(j,2) + List_env1s_square_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) + if(List_env1s_square_expo(i) .lt. 1d-10) cycle - 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) + List_env1s_square_cent(1,i) = List_env1s_square_cent(1,i) / List_env1s_square_expo(i) + List_env1s_square_cent(2,i) = List_env1s_square_cent(2,i) / List_env1s_square_expo(i) + List_env1s_square_cent(3,i) = List_env1s_square_cent(3,i) / List_env1s_square_expo(i) enddo ! --- - do i = 1, List_all_comb_b3_size + do i = 1, List_env1s_square_size do j = 2, nucl_num, 1 - tmp_alphaj = dble(List_all_comb_b3(j,i)) * j1b_pen(j) + tmp_alphaj = dble(List_env1s_square(j,i)) * env_expo(j) do k = 1, j-1, 1 - tmp_alphak = dble(List_all_comb_b3(k,i)) * j1b_pen(k) + tmp_alphak = dble(List_env1s_square(k,i)) * env_expo(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)) & + List_env1s_square_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 + if(List_env1s_square_expo(i) .lt. 1d-10) cycle - List_all_comb_b3_coef(i) = List_all_comb_b3_coef(i) / List_all_comb_b3_expo(i) + List_env1s_square_coef(i) = List_env1s_square_coef(i) / List_env1s_square_expo(i) enddo ! --- - do i = 1, List_all_comb_b3_size + do i = 1, List_env1s_square_size facto = 1.d0 phase = 0 do j = 1, nucl_num - tmp_alphaj = dble(List_all_comb_b3(j,i)) + tmp_alphaj = dble(List_env1s_square(j,i)) facto *= 2.d0 / (gamma(tmp_alphaj+1.d0) * gamma(3.d0-tmp_alphaj)) - phase += List_all_comb_b3(j,i) + phase += List_env1s_square(j,i) enddo - List_all_comb_b3_coef(i) = (-1.d0)**dble(phase) * facto * dexp(-List_all_comb_b3_coef(i)) + List_env1s_square_coef(i) = (-1.d0)**dble(phase) * facto * dexp(-List_env1s_square_coef(i)) enddo - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "sum-gauss") then ii = 1 - List_all_comb_b3_coef( ii) = 1.d0 - List_all_comb_b3_expo( ii) = 0.d0 - List_all_comb_b3_cent(1:3,ii) = 0.d0 + List_env1s_square_coef( ii) = 1.d0 + List_env1s_square_expo( ii) = 0.d0 + List_env1s_square_cent(1:3,ii) = 0.d0 do i = 1, nucl_num ii = ii + 1 - List_all_comb_b3_coef( ii) = -2.d0 * j1b_pen_coef(i) - List_all_comb_b3_expo( ii) = j1b_pen(i) - List_all_comb_b3_cent(1,ii) = nucl_coord(i,1) - List_all_comb_b3_cent(2,ii) = nucl_coord(i,2) - List_all_comb_b3_cent(3,ii) = nucl_coord(i,3) + List_env1s_square_coef( ii) = -2.d0 * env_coef(i) + List_env1s_square_expo( ii) = env_expo(i) + List_env1s_square_cent(1,ii) = nucl_coord(i,1) + List_env1s_square_cent(2,ii) = nucl_coord(i,2) + List_env1s_square_cent(3,ii) = nucl_coord(i,3) enddo do i = 1, nucl_num ii = ii + 1 - List_all_comb_b3_coef( ii) = 1.d0 * j1b_pen_coef(i) * j1b_pen_coef(i) - List_all_comb_b3_expo( ii) = 2.d0 * j1b_pen(i) - List_all_comb_b3_cent(1,ii) = nucl_coord(i,1) - List_all_comb_b3_cent(2,ii) = nucl_coord(i,2) - List_all_comb_b3_cent(3,ii) = nucl_coord(i,3) + List_env1s_square_coef( ii) = 1.d0 * env_coef(i) * env_coef(i) + List_env1s_square_expo( ii) = 2.d0 * env_expo(i) + List_env1s_square_cent(1,ii) = nucl_coord(i,1) + List_env1s_square_cent(2,ii) = nucl_coord(i,2) + List_env1s_square_cent(3,ii) = nucl_coord(i,3) enddo do i = 1, nucl_num-1 - tmp1 = j1b_pen(i) + tmp1 = env_expo(i) xi = nucl_coord(i,1) yi = nucl_coord(i,2) @@ -324,7 +315,7 @@ END_PROVIDER do j = i+1, nucl_num - tmp2 = j1b_pen(j) + tmp2 = env_expo(j) tmp3 = tmp1 + tmp2 tmp4 = 1.d0 / tmp3 @@ -339,27 +330,21 @@ END_PROVIDER ii = ii + 1 ! x 2 to avoid doing integrals twice - List_all_comb_b3_coef( ii) = 2.d0 * dexp(-tmp1*tmp2*tmp4*r2) * j1b_pen_coef(i) * j1b_pen_coef(j) - List_all_comb_b3_expo( ii) = tmp3 - List_all_comb_b3_cent(1,ii) = tmp4 * (tmp1 * xi + tmp2 * xj) - List_all_comb_b3_cent(2,ii) = tmp4 * (tmp1 * yi + tmp2 * yj) - List_all_comb_b3_cent(3,ii) = tmp4 * (tmp1 * zi + tmp2 * zj) + List_env1s_square_coef( ii) = 2.d0 * dexp(-tmp1*tmp2*tmp4*r2) * env_coef(i) * env_coef(j) + List_env1s_square_expo( ii) = tmp3 + List_env1s_square_cent(1,ii) = tmp4 * (tmp1 * xi + tmp2 * xj) + List_env1s_square_cent(2,ii) = tmp4 * (tmp1 * yi + tmp2 * yj) + List_env1s_square_cent(3,ii) = tmp4 * (tmp1 * zi + tmp2 * zj) enddo enddo else - print *, 'j1b_type = ', j1b_type, 'is not implemented' + print *, ' Error in List_env1s_square: Unknown env_type = ', env_type stop endif - !print *, ' coeff, expo & cent of list b3' - !do i = 1, List_all_comb_b3_size - ! print*, i, List_all_comb_b3_coef(i), List_all_comb_b3_expo(i) - ! print*, List_all_comb_b3_cent(1,i), List_all_comb_b3_cent(2,i), List_all_comb_b3_cent(3,i) - !enddo - END_PROVIDER ! --- diff --git a/plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f b/plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f index 9bcce449..ad57739b 100644 --- a/plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f +++ b/plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f @@ -1,181 +1,197 @@ - BEGIN_PROVIDER [ integer, List_comb_thr_b2_size, (ao_num, ao_num)] -&BEGIN_PROVIDER [ integer, max_List_comb_thr_b2_size] - implicit none - integer :: i_1s,i,j,ipoint - double precision :: coef,beta,center(3),int_j1b - double precision :: r(3),weight,dist - List_comb_thr_b2_size = 0 - print*,'List_all_comb_b2_size = ',List_all_comb_b2_size -! pause - do i = 1, ao_num - do j = i, ao_num - do i_1s = 1, List_all_comb_b2_size - coef = List_all_comb_b2_coef (i_1s) - if(dabs(coef).lt.thrsh_cycle_tc)cycle - beta = List_all_comb_b2_expo (i_1s) - beta = max(beta,1.d-12) - center(1:3) = List_all_comb_b2_cent(1:3,i_1s) - int_j1b = 0.d0 - do ipoint = 1, n_points_extra_final_grid - r(1:3) = final_grid_points_extra(1:3,ipoint) - weight = final_weight_at_r_vector_extra(ipoint) - dist = ( center(1) - r(1) )*( center(1) - r(1) ) - dist += ( center(2) - r(2) )*( center(2) - r(2) ) - dist += ( center(3) - r(3) )*( center(3) - r(3) ) - int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight - enddo - if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then - List_comb_thr_b2_size(j,i) += 1 - endif - enddo - enddo - enddo - do i = 1, ao_num - do j = 1, i-1 - List_comb_thr_b2_size(j,i) = List_comb_thr_b2_size(i,j) +! --- + + BEGIN_PROVIDER [integer, List_comb_thr_b2_size, (ao_num, ao_num)] +&BEGIN_PROVIDER [integer, max_List_comb_thr_b2_size] + + implicit none + integer :: i_1s, i, j, ipoint + integer :: list(ao_num) + double precision :: coef,beta,center(3),int_env + double precision :: r(3),weight,dist + + List_comb_thr_b2_size = 0 + print*,'List_env1s_size = ',List_env1s_size + + do i = 1, ao_num + do j = i, ao_num + do i_1s = 1, List_env1s_size + coef = List_env1s_coef(i_1s) + if(dabs(coef).lt.thrsh_cycle_tc) cycle + beta = List_env1s_expo(i_1s) + beta = max(beta,1.d-12) + center(1:3) = List_env1s_cent(1:3,i_1s) + int_env = 0.d0 + do ipoint = 1, n_points_extra_final_grid + r(1:3) = final_grid_points_extra(1:3,ipoint) + weight = final_weight_at_r_vector_extra(ipoint) + dist = ( center(1) - r(1) )*( center(1) - r(1) ) + dist += ( center(2) - r(2) )*( center(2) - r(2) ) + dist += ( center(3) - r(3) )*( center(3) - r(3) ) + int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight + enddo + if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then + List_comb_thr_b2_size(j,i) += 1 + endif + enddo + enddo enddo - enddo - integer :: list(ao_num) - do i = 1, ao_num - list(i) = maxval(List_comb_thr_b2_size(:,i)) - enddo - max_List_comb_thr_b2_size = maxval(list) - print*,'max_List_comb_thr_b2_size = ',max_List_comb_thr_b2_size - -END_PROVIDER - BEGIN_PROVIDER [ double precision, List_comb_thr_b2_coef, ( max_List_comb_thr_b2_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_expo, ( max_List_comb_thr_b2_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_cent, (3, max_List_comb_thr_b2_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, ao_abs_comb_b2_j1b, ( max_List_comb_thr_b2_size ,ao_num, ao_num)] - implicit none - integer :: i_1s,i,j,ipoint,icount - double precision :: coef,beta,center(3),int_j1b - double precision :: r(3),weight,dist - ao_abs_comb_b2_j1b = 10000000.d0 - do i = 1, ao_num - do j = i, ao_num - icount = 0 - do i_1s = 1, List_all_comb_b2_size - coef = List_all_comb_b2_coef (i_1s) - if(dabs(coef).lt.thrsh_cycle_tc)cycle - beta = List_all_comb_b2_expo (i_1s) - center(1:3) = List_all_comb_b2_cent(1:3,i_1s) - int_j1b = 0.d0 - do ipoint = 1, n_points_extra_final_grid - r(1:3) = final_grid_points_extra(1:3,ipoint) - weight = final_weight_at_r_vector_extra(ipoint) - dist = ( center(1) - r(1) )*( center(1) - r(1) ) - dist += ( center(2) - r(2) )*( center(2) - r(2) ) - dist += ( center(3) - r(3) )*( center(3) - r(3) ) - int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight - enddo - if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then - icount += 1 - List_comb_thr_b2_coef(icount,j,i) = coef - List_comb_thr_b2_expo(icount,j,i) = beta - List_comb_thr_b2_cent(1:3,icount,j,i) = center(1:3) - ao_abs_comb_b2_j1b(icount,j,i) = int_j1b - endif - enddo - enddo - enddo - - 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) + 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 - enddo + do i = 1, ao_num + list(i) = maxval(List_comb_thr_b2_size(:,i)) + enddo + + max_List_comb_thr_b2_size = maxval(list) + print*, ' max_List_comb_thr_b2_size = ',max_List_comb_thr_b2_size END_PROVIDER +! --- - BEGIN_PROVIDER [ integer, List_comb_thr_b3_size, (ao_num, ao_num)] -&BEGIN_PROVIDER [ integer, max_List_comb_thr_b3_size] - implicit none - integer :: i_1s,i,j,ipoint - double precision :: coef,beta,center(3),int_j1b - double precision :: r(3),weight,dist - List_comb_thr_b3_size = 0 - print*,'List_all_comb_b3_size = ',List_all_comb_b3_size - do i = 1, ao_num - do j = 1, ao_num - do i_1s = 1, List_all_comb_b3_size - coef = List_all_comb_b3_coef (i_1s) - beta = List_all_comb_b3_expo (i_1s) - center(1:3) = List_all_comb_b3_cent(1:3,i_1s) - if(dabs(coef).lt.thrsh_cycle_tc)cycle - int_j1b = 0.d0 - do ipoint = 1, n_points_extra_final_grid - r(1:3) = final_grid_points_extra(1:3,ipoint) - weight = final_weight_at_r_vector_extra(ipoint) - dist = ( center(1) - r(1) )*( center(1) - r(1) ) - dist += ( center(2) - r(2) )*( center(2) - r(2) ) - dist += ( center(3) - r(3) )*( center(3) - r(3) ) - int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight - enddo - if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then - List_comb_thr_b3_size(j,i) += 1 - endif - enddo - enddo - enddo -! do i = 1, ao_num -! do j = 1, i-1 -! List_comb_thr_b3_size(j,i) = List_comb_thr_b3_size(i,j) -! enddo -! enddo + BEGIN_PROVIDER [ double precision, List_comb_thr_b2_coef, ( max_List_comb_thr_b2_size,ao_num,ao_num)] +&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_expo, ( max_List_comb_thr_b2_size,ao_num,ao_num)] +&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_cent, (3,max_List_comb_thr_b2_size,ao_num,ao_num)] +&BEGIN_PROVIDER [ double precision, ao_abs_comb_b2_env , ( max_List_comb_thr_b2_size,ao_num,ao_num)] + + implicit none + integer :: i_1s,i,j,ipoint,icount + double precision :: coef,beta,center(3),int_env + double precision :: r(3),weight,dist + + ao_abs_comb_b2_env = 10000000.d0 + do i = 1, ao_num + do j = i, ao_num + icount = 0 + do i_1s = 1, List_env1s_size + coef = List_env1s_coef (i_1s) + if(dabs(coef).lt.thrsh_cycle_tc)cycle + beta = List_env1s_expo (i_1s) + center(1:3) = List_env1s_cent(1:3,i_1s) + int_env = 0.d0 + do ipoint = 1, n_points_extra_final_grid + r(1:3) = final_grid_points_extra(1:3,ipoint) + weight = final_weight_at_r_vector_extra(ipoint) + dist = ( center(1) - r(1) )*( center(1) - r(1) ) + dist += ( center(2) - r(2) )*( center(2) - r(2) ) + dist += ( center(3) - r(3) )*( center(3) - r(3) ) + int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight + enddo + if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then + icount += 1 + List_comb_thr_b2_coef(icount,j,i) = coef + List_comb_thr_b2_expo(icount,j,i) = beta + List_comb_thr_b2_cent(1:3,icount,j,i) = center(1:3) + ao_abs_comb_b2_env(icount,j,i) = int_env + endif + enddo + enddo + enddo + + do i = 1, ao_num + do j = 1, i-1 + do icount = 1, List_comb_thr_b2_size(j,i) + List_comb_thr_b2_coef(icount,j,i) = List_comb_thr_b2_coef(icount,i,j) + List_comb_thr_b2_expo(icount,j,i) = List_comb_thr_b2_expo(icount,i,j) + List_comb_thr_b2_cent(1:3,icount,j,i) = List_comb_thr_b2_cent(1:3,icount,i,j) + enddo + enddo + enddo + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [integer, List_comb_thr_b3_size, (ao_num,ao_num)] +&BEGIN_PROVIDER [integer, max_List_comb_thr_b3_size] + + implicit none + integer :: i_1s,i,j,ipoint 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 + double precision :: coef,beta,center(3),int_env + double precision :: r(3),weight,dist + + List_comb_thr_b3_size = 0 + print*,'List_env1s_square_size = ',List_env1s_square_size + do i = 1, ao_num + do j = 1, ao_num + do i_1s = 1, List_env1s_square_size + coef = List_env1s_square_coef (i_1s) + beta = List_env1s_square_expo (i_1s) + center(1:3) = List_env1s_square_cent(1:3,i_1s) + if(dabs(coef).lt.thrsh_cycle_tc)cycle + int_env = 0.d0 + do ipoint = 1, n_points_extra_final_grid + r(1:3) = final_grid_points_extra(1:3,ipoint) + weight = final_weight_at_r_vector_extra(ipoint) + dist = ( center(1) - r(1) )*( center(1) - r(1) ) + dist += ( center(2) - r(2) )*( center(2) - r(2) ) + dist += ( center(3) - r(3) )*( center(3) - r(3) ) + int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight + enddo + if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc) then + List_comb_thr_b3_size(j,i) += 1 + endif + enddo + enddo + enddo + + do i = 1, ao_num + list(i) = maxval(List_comb_thr_b3_size(:,i)) + enddo + + max_List_comb_thr_b3_size = maxval(list) + print*, ' max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size END_PROVIDER - BEGIN_PROVIDER [ double precision, List_comb_thr_b3_coef, ( max_List_comb_thr_b3_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, List_comb_thr_b3_expo, ( max_List_comb_thr_b3_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, List_comb_thr_b3_cent, (3, max_List_comb_thr_b3_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, ao_abs_comb_b3_j1b, ( max_List_comb_thr_b3_size ,ao_num, ao_num)] - implicit none - integer :: i_1s,i,j,ipoint,icount - double precision :: coef,beta,center(3),int_j1b - double precision :: r(3),weight,dist - ao_abs_comb_b3_j1b = 10000000.d0 - do i = 1, ao_num - do j = 1, ao_num - icount = 0 - do i_1s = 1, List_all_comb_b3_size - coef = List_all_comb_b3_coef (i_1s) - beta = List_all_comb_b3_expo (i_1s) - beta = max(beta,1.d-12) - center(1:3) = List_all_comb_b3_cent(1:3,i_1s) - if(dabs(coef).lt.thrsh_cycle_tc)cycle - int_j1b = 0.d0 - do ipoint = 1, n_points_extra_final_grid - r(1:3) = final_grid_points_extra(1:3,ipoint) - weight = final_weight_at_r_vector_extra(ipoint) - dist = ( center(1) - r(1) )*( center(1) - r(1) ) - dist += ( center(2) - r(2) )*( center(2) - r(2) ) - dist += ( center(3) - r(3) )*( center(3) - r(3) ) - int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight - enddo - if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then - icount += 1 - List_comb_thr_b3_coef(icount,j,i) = coef - List_comb_thr_b3_expo(icount,j,i) = beta - List_comb_thr_b3_cent(1:3,icount,j,i) = center(1:3) - ao_abs_comb_b3_j1b(icount,j,i) = int_j1b - endif - enddo - enddo - enddo +! --- + + BEGIN_PROVIDER [double precision, List_comb_thr_b3_coef, ( max_List_comb_thr_b3_size,ao_num,ao_num)] +&BEGIN_PROVIDER [double precision, List_comb_thr_b3_expo, ( max_List_comb_thr_b3_size,ao_num,ao_num)] +&BEGIN_PROVIDER [double precision, List_comb_thr_b3_cent, (3, max_List_comb_thr_b3_size,ao_num,ao_num)] +&BEGIN_PROVIDER [double precision, ao_abs_comb_b3_env , ( max_List_comb_thr_b3_size,ao_num,ao_num)] + + implicit none + integer :: i_1s,i,j,ipoint,icount + double precision :: coef,beta,center(3),int_env + double precision :: r(3),weight,dist + + ao_abs_comb_b3_env = 10000000.d0 + do i = 1, ao_num + do j = 1, ao_num + icount = 0 + do i_1s = 1, List_env1s_square_size + coef = List_env1s_square_coef (i_1s) + beta = List_env1s_square_expo (i_1s) + beta = max(beta,1.d-12) + center(1:3) = List_env1s_square_cent(1:3,i_1s) + if(dabs(coef).lt.thrsh_cycle_tc)cycle + int_env = 0.d0 + do ipoint = 1, n_points_extra_final_grid + r(1:3) = final_grid_points_extra(1:3,ipoint) + weight = final_weight_at_r_vector_extra(ipoint) + dist = ( center(1) - r(1) )*( center(1) - r(1) ) + dist += ( center(2) - r(2) )*( center(2) - r(2) ) + dist += ( center(3) - r(3) )*( center(3) - r(3) ) + int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight + enddo + if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then + icount += 1 + List_comb_thr_b3_coef(icount,j,i) = coef + List_comb_thr_b3_expo(icount,j,i) = beta + List_comb_thr_b3_cent(1:3,icount,j,i) = center(1:3) + ao_abs_comb_b3_env(icount,j,i) = int_env + endif + enddo + enddo + enddo END_PROVIDER +! --- + diff --git a/plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f b/plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f index 54c2d95b..0eaad715 100644 --- a/plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f +++ b/plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f @@ -200,7 +200,7 @@ subroutine overlap_gauss_r12_v(D_center, LD_D, delta, A_center, B_center, power_ deallocate(A_new, A_center_new, fact_a_new, iorder_a_new, overlap) -end subroutine overlap_gauss_r12_v +end !--- diff --git a/plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f b/plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f index 963a49a6..8097cbc2 100644 --- a/plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f +++ b/plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f @@ -23,10 +23,9 @@ subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_va logical, external :: ao_two_e_integral_zero double precision :: ao_tc_sym_two_e_pot, ao_two_e_integral_erf - double precision :: j1b_gauss_2e_j1, j1b_gauss_2e_j2 + double precision :: env_gauss_2e_j1, env_gauss_2e_j2 - PROVIDE j1b_type thr = ao_integrals_threshold @@ -53,14 +52,6 @@ subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_va integral_erf = ao_two_e_integral_erf(i, k, j, l) integral = integral_erf + integral_pot - !if( j1b_type .eq. 1 ) then - ! !print *, ' j1b type 1 is added' - ! integral = integral + j1b_gauss_2e_j1(i, k, j, l) - !elseif( j1b_type .eq. 2 ) then - ! !print *, ' j1b type 2 is added' - ! integral = integral + j1b_gauss_2e_j2(i, k, j, l) - !endif - if(abs(integral) < thr) then cycle endif diff --git a/plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f index 50c396de..bcd2a9a5 100644 --- a/plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f +++ b/plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f @@ -1,10 +1,10 @@ ! --- -BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] +BEGIN_PROVIDER [double precision, env_gauss_hermII, (ao_num,ao_num)] BEGIN_DOC ! - ! :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle` + ! :math:`\langle \chi_A | -0.5 \grad \tau_{env} \cdot \grad \tau_{env} | \chi_B \rangle` ! END_DOC @@ -22,8 +22,6 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] double precision :: int_gauss_4G - PROVIDE j1b_type j1b_pen j1b_coeff - ! -------------------------------------------------------------------------------- ! -- Dummy call to provide everything dim1 = 100 @@ -38,10 +36,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] ! -------------------------------------------------------------------------------- - j1b_gauss_hermII(1:ao_num,1:ao_num) = 0.d0 - - if(j1b_type .eq. 1) then - ! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)] + env_gauss_hermII(1:ao_num,1:ao_num) = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -51,113 +46,51 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & !$OMP ao_power, ao_nucl, nucl_coord, & !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_hermII) + !$OMP nucl_num, env_expo, env_gauss_hermII) !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - 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 + do j = 1, ao_num + num_A = ao_nucl(j) + power_A(1:3) = ao_power(j,1:3) + A_center(1:3) = nucl_coord(num_A,1:3) + + do i = 1, ao_num + num_B = ao_nucl(i) + power_B(1:3) = ao_power(i,1:3) + B_center(1:3) = nucl_coord(num_B,1:3) + + do l = 1, ao_prim_num(j) + alpha = ao_expo_ordered_transp(l,j) + + do m = 1, ao_prim_num(i) + beta = ao_expo_ordered_transp(m,i) + + c = 0.d0 + do k1 = 1, nucl_num + gama1 = env_expo(k1) + C_center1(1:3) = nucl_coord(k1,1:3) + + do k2 = 1, nucl_num + gama2 = env_expo(k2) + C_center2(1:3) = nucl_coord(k2,1:3) + + ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB > + c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2 & + , power_A, power_B, alpha, beta, gama1, gama2 ) + + c = c - 2.d0 * gama1 * gama2 * c1 enddo - - j1b_gauss_hermII(i,j) = j1b_gauss_hermII(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c enddo + + env_gauss_hermII(i,j) = env_gauss_hermII(i,j) & + + ao_coef_normalized_ordered_transp(l,j) & + * ao_coef_normalized_ordered_transp(m,i) * c enddo enddo enddo + enddo !$OMP END DO !$OMP END PARALLEL - elseif(j1b_type .eq. 2) then - ! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)] - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, k1, k2, l, m, alpha, beta, gama1, gama2, & - !$OMP A_center, B_center, C_center1, C_center2, & - !$OMP power_A, power_B, num_A, num_B, c1, c, & - !$OMP coef1, coef2) & - !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & - !$OMP ao_power, ao_nucl, nucl_coord, & - !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_hermII, & - !$OMP j1b_coeff) - !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k1 = 1, nucl_num - gama1 = j1b_pen (k1) - coef1 = j1b_coeff(k1) - C_center1(1:3) = nucl_coord(k1,1:3) - - do k2 = 1, nucl_num - gama2 = j1b_pen (k2) - coef2 = j1b_coeff(k2) - C_center2(1:3) = nucl_coord(k2,1:3) - - ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB > - c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2 & - , power_A, power_B, alpha, beta, gama1, gama2 ) - - c = c - 2.d0 * gama1 * gama2 * coef1 * coef2 * c1 - enddo - enddo - - j1b_gauss_hermII(i,j) = j1b_gauss_hermII(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c - enddo - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - endif - END_PROVIDER diff --git a/plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f index 0a0b7610..6c9365c9 100644 --- a/plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f +++ b/plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f @@ -1,10 +1,10 @@ ! --- -BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] +BEGIN_PROVIDER [double precision, env_gauss_hermI, (ao_num,ao_num)] BEGIN_DOC ! - ! :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \rangle` + ! :math:`\langle \chi_A | -0.5 \Delta \tau_{env} | \chi_B \rangle` ! END_DOC @@ -22,8 +22,6 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] double precision :: int_gauss_r0, int_gauss_r2 - PROVIDE j1b_type j1b_pen j1b_coeff - ! -------------------------------------------------------------------------------- ! -- Dummy call to provide everything dim1 = 100 @@ -37,10 +35,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] , overlap_y, d_a_2, overlap_z, overlap, dim1 ) ! -------------------------------------------------------------------------------- - j1b_gauss_hermI(1:ao_num,1:ao_num) = 0.d0 - - if(j1b_type .eq. 1) then - ! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)] + env_gauss_hermI(1:ao_num,1:ao_num) = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -50,109 +45,50 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & !$OMP ao_power, ao_nucl, nucl_coord, & !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_hermI) + !$OMP nucl_num, env_expo, env_gauss_hermI) !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - 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 + do j = 1, ao_num + num_A = ao_nucl(j) + power_A(1:3) = ao_power(j,1:3) + A_center(1:3) = nucl_coord(num_A,1:3) + + do i = 1, ao_num + num_B = ao_nucl(i) + power_B(1:3) = ao_power(i,1:3) + B_center(1:3) = nucl_coord(num_B,1:3) + + do l = 1, ao_prim_num(j) + alpha = ao_expo_ordered_transp(l,j) + + do m = 1, ao_prim_num(i) + beta = ao_expo_ordered_transp(m,i) + + c = 0.d0 + do k = 1, nucl_num + gama = env_expo(k) + C_center(1:3) = nucl_coord(k,1:3) + + ! < XA | exp[-gama r_C^2] | XB > + c1 = int_gauss_r0( A_center, B_center, C_center & + , power_A, power_B, alpha, beta, gama ) + + ! < XA | r_A^2 exp[-gama r_C^2] | XB > + c2 = int_gauss_r2( A_center, B_center, C_center & + , power_A, power_B, alpha, beta, gama ) + + c = c + 3.d0 * gama * c1 - 2.d0 * gama * gama * c2 enddo + + env_gauss_hermI(i,j) = env_gauss_hermI(i,j) & + + ao_coef_normalized_ordered_transp(l,j) & + * ao_coef_normalized_ordered_transp(m,i) * c enddo enddo enddo + enddo !$OMP END DO !$OMP END PARALLEL - elseif(j1b_type .eq. 2) then - ! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)] - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, coef, & - !$OMP A_center, B_center, C_center, power_A, power_B, & - !$OMP num_A, num_B, c1, c2, c) & - !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & - !$OMP ao_power, ao_nucl, nucl_coord, & - !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_hermI, & - !$OMP j1b_coeff) - !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k = 1, nucl_num - gama = j1b_pen (k) - coef = j1b_coeff(k) - C_center(1:3) = nucl_coord(k,1:3) - - ! < XA | exp[-gama r_C^2] | XB > - c1 = int_gauss_r0( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - ! < XA | r_A^2 exp[-gama r_C^2] | XB > - c2 = int_gauss_r2( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - c = c + 3.d0 * gama * coef * c1 - 2.d0 * gama * gama * coef * c2 - enddo - - j1b_gauss_hermI(i,j) = j1b_gauss_hermI(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c - enddo - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - endif - END_PROVIDER diff --git a/plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f index bd881d32..0ff23716 100644 --- a/plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f +++ b/plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f @@ -1,10 +1,11 @@ + ! --- -BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] +BEGIN_PROVIDER [double precision, env_gauss_nonherm, (ao_num,ao_num)] BEGIN_DOC ! - ! j1b_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{1b} \cdot grad | \chi_i \rangle + ! env_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{env} \cdot grad | \chi_i \rangle ! END_DOC @@ -22,8 +23,6 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] double precision :: int_gauss_deriv - PROVIDE j1b_type j1b_pen j1b_coeff - ! -------------------------------------------------------------------------------- ! -- Dummy call to provide everything dim1 = 100 @@ -38,10 +37,8 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] ! -------------------------------------------------------------------------------- - j1b_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0 + env_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0 - if(j1b_type .eq. 1) then - ! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)] !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -51,101 +48,46 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & !$OMP ao_power, ao_nucl, nucl_coord, & !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_nonherm) + !$OMP nucl_num, env_expo, env_gauss_nonherm) !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - 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 + do j = 1, ao_num + num_A = ao_nucl(j) + power_A(1:3) = ao_power(j,1:3) + A_center(1:3) = nucl_coord(num_A,1:3) + + do i = 1, ao_num + num_B = ao_nucl(i) + power_B(1:3) = ao_power(i,1:3) + B_center(1:3) = nucl_coord(num_B,1:3) + + do l = 1, ao_prim_num(j) + alpha = ao_expo_ordered_transp(l,j) + + do m = 1, ao_prim_num(i) + beta = ao_expo_ordered_transp(m,i) + + c = 0.d0 + do k = 1, nucl_num + gama = env_expo(k) + C_center(1:3) = nucl_coord(k,1:3) + + ! \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle + c1 = int_gauss_deriv( A_center, B_center, C_center & + , power_A, power_B, alpha, beta, gama ) + + c = c + 2.d0 * gama * c1 enddo + + env_gauss_nonherm(i,j) = env_gauss_nonherm(i,j) & + + ao_coef_normalized_ordered_transp(l,j) & + * ao_coef_normalized_ordered_transp(m,i) * c enddo enddo enddo + enddo !$OMP END DO !$OMP END PARALLEL - elseif(j1b_type .eq. 2) then - ! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)] - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, coef, & - !$OMP A_center, B_center, C_center, power_A, power_B, & - !$OMP num_A, num_B, c1, c) & - !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & - !$OMP ao_power, ao_nucl, nucl_coord, & - !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_nonherm, & - !$OMP j1b_coeff) - !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k = 1, nucl_num - gama = j1b_pen (k) - coef = j1b_coeff(k) - C_center(1:3) = nucl_coord(k,1:3) - - ! \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle - c1 = int_gauss_deriv( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - c = c + 2.d0 * gama * coef * c1 - enddo - - j1b_gauss_nonherm(i,j) = j1b_gauss_nonherm(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c - enddo - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - endif - END_PROVIDER diff --git a/plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f b/plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f index 055bf323..1c454e40 100644 --- a/plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f +++ b/plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f @@ -22,9 +22,6 @@ BEGIN_PROVIDER [ logical, ao_tc_sym_two_e_pot_in_map ] integer :: kk, m, j1, i1, lmax character*(64) :: fmt - !double precision :: j1b_gauss_coul_debug - !integral = j1b_gauss_coul_debug(1,1,1,1) - integral = ao_tc_sym_two_e_pot(1,1,1,1) double precision :: map_mb diff --git a/plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f index c36ee9b4..572406e2 100644 --- a/plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f +++ b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f @@ -1,6 +1,6 @@ ! --- -double precision function j1b_gauss_2e_j1(i, j, k, l) +double precision function env_gauss_2e_j1(i, j, k, l) BEGIN_DOC ! @@ -36,10 +36,10 @@ double precision function j1b_gauss_2e_j1(i, j, k, l) double precision :: I_center(3), J_center(3), K_center(3), L_center(3) double precision :: ff, gg, cx, cy, cz - double precision :: j1b_gauss_2e_j1_schwartz + double precision :: env_gauss_2e_j1_schwartz if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then - j1b_gauss_2e_j1 = j1b_gauss_2e_j1_schwartz(i, j, k, l) + env_gauss_2e_j1 = env_gauss_2e_j1_schwartz(i, j, k, l) return endif @@ -59,7 +59,7 @@ double precision function j1b_gauss_2e_j1(i, j, k, l) L_center(p) = nucl_coord(num_l,p) enddo - j1b_gauss_2e_j1 = 0.d0 + env_gauss_2e_j1 = 0.d0 do p = 1, ao_prim_num(i) coef1 = ao_coef_normalized_ordered_transp(p, i) @@ -89,18 +89,18 @@ double precision function j1b_gauss_2e_j1(i, j, k, l) , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_2e_j1 = j1b_gauss_2e_j1 + coef4 * ( cx + cy + cz ) + env_gauss_2e_j1 = env_gauss_2e_j1 + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q enddo ! p return -end function j1b_gauss_2e_j1 +end ! --- -double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) +double precision function env_gauss_2e_j1_schwartz(i, j, k, l) BEGIN_DOC ! @@ -137,8 +137,6 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) double precision :: schwartz_ij, thr double precision, allocatable :: schwartz_kl(:,:) - PROVIDE j1b_pen - dim1 = n_pt_max_integrals thr = ao_integrals_threshold * ao_integrals_threshold @@ -186,8 +184,7 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) schwartz_kl(0,0) = max( schwartz_kl(0,r) , schwartz_kl(0,0) ) enddo - - j1b_gauss_2e_j1_schwartz = 0.d0 + env_gauss_2e_j1_schwartz = 0.d0 do p = 1, ao_prim_num(i) expo1 = ao_expo_ordered_transp(p, i) @@ -226,7 +223,7 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_2e_j1_schwartz = j1b_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz ) + env_gauss_2e_j1_schwartz = env_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q @@ -235,7 +232,7 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) deallocate( schwartz_kl ) return -end function j1b_gauss_2e_j1_schwartz +end ! --- @@ -263,14 +260,12 @@ subroutine get_cxcycz_j1( dim1, cx, cy, cz & double precision :: general_primitive_integral_erf_shifted double precision :: general_primitive_integral_coul_shifted - PROVIDE j1b_pen - cx = 0.d0 cy = 0.d0 cz = 0.d0 do ii = 1, nucl_num - expoii = j1b_pen(ii) + expoii = env_expo(ii) Centerii(1:3) = nucl_coord(ii, 1:3) call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center) diff --git a/plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f index a61b5336..a04656c3 100644 --- a/plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f +++ b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f @@ -1,6 +1,6 @@ ! --- -double precision function j1b_gauss_2e_j2(i, j, k, l) +double precision function env_gauss_2e_j2(i, j, k, l) BEGIN_DOC ! @@ -36,12 +36,12 @@ double precision function j1b_gauss_2e_j2(i, j, k, l) double precision :: I_center(3), J_center(3), K_center(3), L_center(3) double precision :: ff, gg, cx, cy, cz - double precision :: j1b_gauss_2e_j2_schwartz + double precision :: env_gauss_2e_j2_schwartz dim1 = n_pt_max_integrals if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then - j1b_gauss_2e_j2 = j1b_gauss_2e_j2_schwartz(i, j, k, l) + env_gauss_2e_j2 = env_gauss_2e_j2_schwartz(i, j, k, l) return endif @@ -61,7 +61,7 @@ double precision function j1b_gauss_2e_j2(i, j, k, l) L_center(p) = nucl_coord(num_l,p) enddo - j1b_gauss_2e_j2 = 0.d0 + env_gauss_2e_j2 = 0.d0 do p = 1, ao_prim_num(i) coef1 = ao_coef_normalized_ordered_transp(p, i) @@ -91,18 +91,18 @@ double precision function j1b_gauss_2e_j2(i, j, k, l) , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_2e_j2 = j1b_gauss_2e_j2 + coef4 * ( cx + cy + cz ) + env_gauss_2e_j2 = env_gauss_2e_j2 + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q enddo ! p return -end function j1b_gauss_2e_j2 +end ! --- -double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) +double precision function env_gauss_2e_j2_schwartz(i, j, k, l) BEGIN_DOC ! @@ -187,7 +187,7 @@ double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) enddo - j1b_gauss_2e_j2_schwartz = 0.d0 + env_gauss_2e_j2_schwartz = 0.d0 do p = 1, ao_prim_num(i) expo1 = ao_expo_ordered_transp(p, i) @@ -226,7 +226,7 @@ double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_2e_j2_schwartz = j1b_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz ) + env_gauss_2e_j2_schwartz = env_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q @@ -235,7 +235,7 @@ double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) deallocate( schwartz_kl ) return -end function j1b_gauss_2e_j2_schwartz +end ! --- @@ -263,15 +263,13 @@ subroutine get_cxcycz_j2( dim1, cx, cy, cz & double precision :: general_primitive_integral_erf_shifted double precision :: general_primitive_integral_coul_shifted - PROVIDE j1b_pen j1b_coeff - cx = 0.d0 cy = 0.d0 cz = 0.d0 do ii = 1, nucl_num - expoii = j1b_pen (ii) - coefii = j1b_coeff(ii) + expoii = env_expo(ii) + coefii = env_coef(ii) Centerii(1:3) = nucl_coord(ii, 1:3) call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center) diff --git a/plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f b/plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f index 452c13f1..613a684f 100644 --- a/plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f +++ b/plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f @@ -1,4 +1,39 @@ + +! --- + +BEGIN_PROVIDER [double precision, ao_two_e_coul, (ao_num, ao_num, ao_num, ao_num) ] + + BEGIN_DOC + ! + ! ao_two_e_coul(k,i,l,j) = ( k i | 1/r12 | l j ) = < l k | 1/r12 | j i > + ! + END_DOC + + integer :: i, j, k, l + double precision, external :: get_ao_two_e_integral + + PROVIDE ao_integrals_map + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(ao_num, ao_two_e_coul, ao_integrals_map) & + !$OMP PRIVATE(i, j, k, l) + !$OMP DO + do j = 1, ao_num + do l = 1, ao_num + do i = 1, ao_num + do k = 1, ao_num + ! < 1:k, 2:l | 1:i, 2:j > + ao_two_e_coul(k,i,l,j) = get_ao_two_e_integral(i, j, k, l, ao_integrals_map) + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +END_PROVIDER + ! --- double precision function bi_ortho_mo_coul_ints(l, k, j, i) @@ -25,7 +60,7 @@ double precision function bi_ortho_mo_coul_ints(l, k, j, i) enddo enddo -end function bi_ortho_mo_coul_ints +end ! --- diff --git a/plugins/local/bi_ort_ints/one_e_bi_ort.irp.f b/plugins/local/bi_ort_ints/one_e_bi_ort.irp.f index 0ecc2a84..85cae273 100644 --- a/plugins/local/bi_ort_ints/one_e_bi_ort.irp.f +++ b/plugins/local/bi_ort_ints/one_e_bi_ort.irp.f @@ -8,23 +8,6 @@ BEGIN_PROVIDER [double precision, ao_one_e_integrals_tc_tot, (ao_num,ao_num)] ao_one_e_integrals_tc_tot = ao_one_e_integrals - !provide j1b_type - - !if( (j1b_type .eq. 1) .or. (j1b_type .eq. 2) ) then - ! - ! print *, ' do things properly !' - ! stop - - ! !do i = 1, ao_num - ! ! do j = 1, ao_num - ! ! ao_one_e_integrals_tc_tot(j,i) += ( j1b_gauss_hermI (j,i) & - ! ! + j1b_gauss_hermII (j,i) & - ! ! + j1b_gauss_nonherm(j,i) ) - ! ! enddo - ! !enddo - - !endif - END_PROVIDER ! --- diff --git a/plugins/local/bi_ort_ints/total_twoe_pot.irp.f b/plugins/local/bi_ort_ints/total_twoe_pot.irp.f index 37a31a51..5e6a24e9 100644 --- a/plugins/local/bi_ort_ints/total_twoe_pot.irp.f +++ b/plugins/local/bi_ort_ints/total_twoe_pot.irp.f @@ -1,91 +1,4 @@ - -! --- - -BEGIN_PROVIDER [double precision, ao_two_e_vartc_tot, (ao_num, ao_num, ao_num, ao_num) ] - - integer :: i, j, k, l - - provide j1b_type - provide mo_r_coef mo_l_coef - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_two_e_vartc_tot(k,i,l,j) = ao_vartc_int_chemist(k,i,l,j) - enddo - enddo - enddo - enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num) ] - - BEGIN_DOC - ! - ! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) = where V^TC(r_12) is the total TC operator - ! - ! including both hermitian and non hermitian parts. THIS IS IN CHEMIST NOTATION. - ! - ! WARNING :: non hermitian ! acts on "the right functions" (i,j) - ! - END_DOC - - integer :: i, j, k, l - double precision :: integral_sym, integral_nsym - double precision, external :: get_ao_tc_sym_two_e_pot - - provide j1b_type - - if(j1b_type .eq. 0) then - - PROVIDE ao_tc_sym_two_e_pot_in_map - - !!! TODO :: OPENMP - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - - integral_sym = get_ao_tc_sym_two_e_pot(i, j, k, l, ao_tc_sym_two_e_pot_map) - ! ao_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the AO basis - integral_nsym = ao_non_hermit_term_chemist(k,i,l,j) - - !print *, ' sym integ = ', integral_sym - !print *, ' non-sym integ = ', integral_nsym - - ao_two_e_tc_tot(k,i,l,j) = integral_sym + integral_nsym - !write(111,*) ao_two_e_tc_tot(k,i,l,j) - enddo - enddo - enddo - enddo - - else - - PROVIDE ao_tc_int_chemist - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_two_e_tc_tot(k,i,l,j) = ao_tc_int_chemist(k,i,l,j) - !write(222,*) ao_two_e_tc_tot(k,i,l,j) - enddo - enddo - enddo - enddo - - FREE ao_tc_int_chemist - - endif - -END_PROVIDER - ! --- double precision function bi_ortho_mo_ints(l, k, j, i) @@ -118,8 +31,6 @@ end function bi_ortho_mo_ints ! --- -! TODO :: transform into DEGEMM - BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num, mo_num, mo_num)] BEGIN_DOC @@ -267,7 +178,6 @@ END_PROVIDER ! --- - BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num)] &BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_exchange, (mo_num,mo_num)] &BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_anti, (mo_num,mo_num)] diff --git a/plugins/local/non_h_ints_mu/debug_fit.irp.f b/plugins/local/non_h_ints_mu/debug_fit.irp.f index d3152836..3934bb06 100644 --- a/plugins/local/non_h_ints_mu/debug_fit.irp.f +++ b/plugins/local/non_h_ints_mu/debug_fit.irp.f @@ -11,9 +11,12 @@ program debug_fit my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - PROVIDE mu_erf j1b_pen + PROVIDE j2e_type mu_erf + PROVIDE j1e_type j1e_coef j1e_expo + PROVIDE env_type env_coef env_expo + provide tc_integ_type - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r @@ -21,12 +24,8 @@ program debug_fit touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid endif - !call test_j1b_nucl() - !call test_grad_j1b_nucl() - !call test_lapl_j1b_nucl() - - !call test_list_b2() - !call test_list_b3() + !call test_env_nucl() + !call test_grad_env_nucl() !call test_fit_u() !call test_fit_u2() @@ -38,17 +37,17 @@ end ! --- -subroutine test_j1b_nucl() +subroutine test_env_nucl() implicit none integer :: ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz double precision :: r(3) - double precision, external :: j1b_nucl + double precision, external :: env_nucl - print*, ' test_j1b_nucl ...' + print*, ' test_env_nucl ...' - PROVIDE v_1b + PROVIDE env_val eps_ij = 1d-7 acc_tot = 0.d0 @@ -60,11 +59,11 @@ subroutine test_j1b_nucl() r(2) = final_grid_points(2,ipoint) r(3) = final_grid_points(3,ipoint) - i_exc = v_1b(ipoint) - i_num = j1b_nucl(r) + i_exc = env_val(ipoint) + i_num = env_nucl(r) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in v_1b on', ipoint + print *, ' problem in env_val on', ipoint print *, ' analyt = ', i_exc print *, ' numeri = ', i_num print *, ' diff = ', acc_ij @@ -78,23 +77,23 @@ subroutine test_j1b_nucl() print*, ' normalz = ', normalz return -end subroutine test_j1b_nucl +end ! --- -subroutine test_grad_j1b_nucl() +subroutine test_grad_env_nucl() implicit none integer :: ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz double precision :: r(3) - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num - print*, ' test_grad_j1b_nucl ...' + PROVIDE env_grad - PROVIDE v_1b_grad + print*, ' test_grad_env_nucl ...' eps_ij = 1d-7 acc_tot = 0.d0 @@ -106,31 +105,31 @@ subroutine test_grad_j1b_nucl() r(2) = final_grid_points(2,ipoint) r(3) = final_grid_points(3,ipoint) - i_exc = v_1b_grad(1,ipoint) - i_num = grad_x_j1b_nucl_num(r) + i_exc = env_grad(1,ipoint) + i_num = grad_x_env_nucl_num(r) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in x of v_1b_grad on', ipoint + print *, ' problem in x of env_grad on', ipoint print *, ' analyt = ', i_exc print *, ' numeri = ', i_num print *, ' diff = ', acc_ij endif - i_exc = v_1b_grad(2,ipoint) - i_num = grad_y_j1b_nucl_num(r) + i_exc = env_grad(2,ipoint) + i_num = grad_y_env_nucl_num(r) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in y of v_1b_grad on', ipoint + print *, ' problem in y of env_grad on', ipoint print *, ' analyt = ', i_exc print *, ' numeri = ', i_num print *, ' diff = ', acc_ij endif - i_exc = v_1b_grad(3,ipoint) - i_num = grad_z_j1b_nucl_num(r) + i_exc = env_grad(3,ipoint) + i_num = grad_z_env_nucl_num(r) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in z of v_1b_grad on', ipoint + print *, ' problem in z of env_grad on', ipoint print *, ' analyt = ', i_exc print *, ' numeri = ', i_num print *, ' diff = ', acc_ij @@ -144,278 +143,7 @@ subroutine test_grad_j1b_nucl() print*, ' normalz = ', normalz return -end subroutine test_grad_j1b_nucl - -! --- - -subroutine test_lapl_j1b_nucl() - - implicit none - integer :: ipoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision :: r(3) - double precision, external :: lapl_j1b_nucl - - print*, ' test_lapl_j1b_nucl ...' - - PROVIDE v_1b_lapl - - eps_ij = 1d-5 - acc_tot = 0.d0 - normalz = 0.d0 - - 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) - - i_exc = v_1b_lapl(ipoint) - i_num = lapl_j1b_nucl(r) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in v_1b_lapl on', ipoint - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz - - return -end subroutine test_lapl_j1b_nucl - -! --- - -subroutine test_list_b2() - - implicit none - integer :: ipoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision :: r(3) - double precision, external :: j1b_nucl - - print*, ' test_list_b2 ...' - - PROVIDE v_1b_list_b2 - - eps_ij = 1d-7 - acc_tot = 0.d0 - normalz = 0.d0 - - 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) - - i_exc = v_1b_list_b2(ipoint) - i_num = j1b_nucl(r) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in list_b2 on', ipoint - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz - - return -end subroutine test_list_b2 - -! --- - -subroutine test_list_b3() - - implicit none - integer :: ipoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_tmp, i_num, normalz - double precision :: r(3) - double precision :: grad_num(3), eps_der, eps_lap, tmp_der, tmp_lap, i0, ip, im - double precision, external :: j1b_nucl_square - - print*, ' test_list_b3 ...' - - eps_ij = 1d-7 - - eps_der = 1d-5 - tmp_der = 0.5d0 / eps_der - - eps_lap = 1d-4 - tmp_lap = 1.d0 / (eps_lap*eps_lap) - - ! --- - - PROVIDE v_1b_list_b3 - - acc_tot = 0.d0 - normalz = 0.d0 - 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) - - i_exc = v_1b_list_b3(ipoint) - i_num = j1b_nucl_square(r) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot on val = ', acc_tot - print*, ' normalz on val = ', normalz - - ! --- - - PROVIDE v_1b_square_grad - - acc_tot = 0.d0 - normalz = 0.d0 - 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) - - i_exc = v_1b_square_grad(ipoint,1) - r(1) = r(1) + eps_der - ip = j1b_nucl_square(r) - r(1) = r(1) - 2.d0 * eps_der - im = j1b_nucl_square(r) - r(1) = r(1) + eps_der - i_num = tmp_der * (ip - im) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in grad_x list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - acc_tot += acc_ij - normalz += dabs(i_num) - - i_exc = v_1b_square_grad(ipoint,2) - r(2) = r(2) + eps_der - ip = j1b_nucl_square(r) - r(2) = r(2) - 2.d0 * eps_der - im = j1b_nucl_square(r) - r(2) = r(2) + eps_der - i_num = tmp_der * (ip - im) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in grad_y list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - acc_tot += acc_ij - normalz += dabs(i_num) - - i_exc = v_1b_square_grad(ipoint,3) - r(3) = r(3) + eps_der - ip = j1b_nucl_square(r) - r(3) = r(3) - 2.d0 * eps_der - im = j1b_nucl_square(r) - r(3) = r(3) + eps_der - i_num = tmp_der * (ip - im) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in grad_z list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot on grad = ', acc_tot - print*, ' normalz on grad = ', normalz - - ! --- - - PROVIDE v_1b_square_lapl - - acc_tot = 0.d0 - normalz = 0.d0 - 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) - i0 = j1b_nucl_square(r) - - i_exc = v_1b_square_lapl(ipoint) - - r(1) = r(1) + eps_lap - ip = j1b_nucl_square(r) - r(1) = r(1) - 2.d0 * eps_lap - im = j1b_nucl_square(r) - r(1) = r(1) + eps_lap - i_num = tmp_lap * (ip - 2.d0 * i0 + im) - - r(2) = r(2) + eps_lap - ip = j1b_nucl_square(r) - r(2) = r(2) - 2.d0 * eps_lap - im = j1b_nucl_square(r) - r(2) = r(2) + eps_lap - i_num = i_num + tmp_lap * (ip - 2.d0 * i0 + im) - - r(3) = r(3) + eps_lap - ip = j1b_nucl_square(r) - r(3) = r(3) - 2.d0 * eps_lap - im = j1b_nucl_square(r) - r(3) = r(3) + eps_lap - i_num = i_num + tmp_lap * (ip - 2.d0 * i0 + im) - - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in lapl list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot on lapl = ', acc_tot - print*, ' normalz on lapl = ', normalz - - ! --- - - return -end subroutine test_list_b3 +end ! --- @@ -516,7 +244,7 @@ subroutine test_fit_ugradu() enddo return -end subroutine test_fit_ugradu +end ! --- @@ -582,7 +310,7 @@ subroutine test_fit_u() enddo return -end subroutine test_fit_u +end ! --- @@ -649,7 +377,7 @@ subroutine test_fit_u2() enddo return -end subroutine test_fit_u2 +end ! --- @@ -714,7 +442,7 @@ subroutine test_grad1_u12_withsq_num() print*, ' accuracy (%) = ', 100.d0 * acc_tot / normalz return -end subroutine test_grad1_u12_withsq_num +end ! --- diff --git a/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f index b9e8df25..415e4fc0 100644 --- a/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f +++ b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f @@ -11,40 +11,40 @@ program debug_integ_jmu_modif my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - PROVIDE mu_erf j1b_pen + PROVIDE mu_erf -! call test_v_ij_u_cst_mu_j1b() -! call test_v_ij_erf_rk_cst_mu_j1b() -! call test_x_v_ij_erf_rk_cst_mu_j1b() -! call test_int2_u2_j1b2() -! call test_int2_grad1u2_grad2u2_j1b2() -! call test_int2_u_grad1u_total_j1b2() +! call test_v_ij_u_cst_mu_env() +! call test_v_ij_erf_rk_cst_mu_env() +! call test_x_v_ij_erf_rk_cst_mu_env() +! call test_int2_u2_env2() +! call test_int2_grad1u2_grad2u2_env2() +! call test_int2_u_grad1u_total_env2() ! -! call test_int2_grad1_u12_ao() +! call test_int2_grad1_u12_ao_num() ! ! call test_grad12_j12() - call test_tchint_rsdft() -! call test_u12sq_j1bsq() -! call test_u12_grad1_u12_j1b_grad1_j1b() -! !call test_gradu_squared_u_ij_mu() +! call test_u12sq_envsq() +! call test_u12_grad1_u12_env_grad1_env() !call test_vect_overlap_gauss_r12_ao() !call test_vect_overlap_gauss_r12_ao_with1s() + !call test_Ir2_LinFcRSDFT_long_Du_0() + end ! --- -subroutine test_v_ij_u_cst_mu_j1b() +subroutine test_v_ij_u_cst_mu_env() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_v_ij_u_cst_mu_j1b + double precision, external :: num_v_ij_u_cst_mu_env - print*, ' test_v_ij_u_cst_mu_j1b ...' + print*, ' test_v_ij_u_cst_mu_env ...' - PROVIDE v_ij_u_cst_mu_j1b_fit + PROVIDE v_ij_u_cst_mu_env_fit eps_ij = 1d-3 acc_tot = 0.d0 @@ -54,11 +54,11 @@ subroutine test_v_ij_u_cst_mu_j1b() do j = 1, ao_num do i = 1, ao_num - i_exc = v_ij_u_cst_mu_j1b_fit(i,j,ipoint) - i_num = num_v_ij_u_cst_mu_j1b (i,j,ipoint) + i_exc = v_ij_u_cst_mu_env_fit(i,j,ipoint) + i_num = num_v_ij_u_cst_mu_env (i,j,ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in v_ij_u_cst_mu_j1b_fit on', i, j, ipoint + print *, ' problem in v_ij_u_cst_mu_env_fit on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -70,24 +70,23 @@ subroutine test_v_ij_u_cst_mu_j1b() enddo enddo - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz + print*, ' acc_tot (%) = ', 100.d0 * acc_tot / normalz return -end subroutine test_v_ij_u_cst_mu_j1b +end ! --- -subroutine test_v_ij_erf_rk_cst_mu_j1b() +subroutine test_v_ij_erf_rk_cst_mu_env() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_v_ij_erf_rk_cst_mu_j1b + double precision, external :: num_v_ij_erf_rk_cst_mu_env - print*, ' test_v_ij_erf_rk_cst_mu_j1b ...' + print*, ' test_v_ij_erf_rk_cst_mu_env ...' - PROVIDE v_ij_erf_rk_cst_mu_j1b + PROVIDE v_ij_erf_rk_cst_mu_env eps_ij = 1d-3 acc_tot = 0.d0 @@ -98,11 +97,11 @@ subroutine test_v_ij_erf_rk_cst_mu_j1b() do j = 1, ao_num do i = 1, ao_num - i_exc = v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) - i_num = num_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) + i_exc = v_ij_erf_rk_cst_mu_env(i,j,ipoint) + i_num = num_v_ij_erf_rk_cst_mu_env(i,j,ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in v_ij_erf_rk_cst_mu_j1b on', i, j, ipoint + print *, ' problem in v_ij_erf_rk_cst_mu_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -118,20 +117,20 @@ subroutine test_v_ij_erf_rk_cst_mu_j1b() print*, ' normalz = ', normalz return -end subroutine test_v_ij_erf_rk_cst_mu_j1b +end ! --- -subroutine test_x_v_ij_erf_rk_cst_mu_j1b() +subroutine test_x_v_ij_erf_rk_cst_mu_env() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz double precision :: integ(3) - print*, ' test_x_v_ij_erf_rk_cst_mu_j1b ...' + print*, ' test_x_v_ij_erf_rk_cst_mu_env ...' - PROVIDE x_v_ij_erf_rk_cst_mu_j1b + PROVIDE x_v_ij_erf_rk_cst_mu_env eps_ij = 1d-3 acc_tot = 0.d0 @@ -142,13 +141,13 @@ subroutine test_x_v_ij_erf_rk_cst_mu_j1b() do j = 1, ao_num do i = 1, ao_num - call num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) + call num_x_v_ij_erf_rk_cst_mu_env(i, j, ipoint, integ) - i_exc = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1) + i_exc = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) i_num = integ(1) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in x part of x_v_ij_erf_rk_cst_mu_j1b on', i, j, ipoint + print *, ' problem in x part of x_v_ij_erf_rk_cst_mu_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -156,11 +155,11 @@ subroutine test_x_v_ij_erf_rk_cst_mu_j1b() acc_tot += acc_ij normalz += dabs(i_num) - i_exc = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2) + i_exc = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) i_num = integ(2) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in y part of x_v_ij_erf_rk_cst_mu_j1b on', i, j, ipoint + print *, ' problem in y part of x_v_ij_erf_rk_cst_mu_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -168,11 +167,11 @@ subroutine test_x_v_ij_erf_rk_cst_mu_j1b() acc_tot += acc_ij normalz += dabs(i_num) - i_exc = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3) + i_exc = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) i_num = integ(3) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in z part of x_v_ij_erf_rk_cst_mu_j1b on', i, j, ipoint + print *, ' problem in z part of x_v_ij_erf_rk_cst_mu_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -188,35 +187,34 @@ subroutine test_x_v_ij_erf_rk_cst_mu_j1b() print*, ' normalz = ', normalz return -end subroutine test_x_v_ij_erf_rk_cst_mu_j1b +end ! --- -subroutine test_int2_u2_j1b2() +subroutine test_int2_u2_env2() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_int2_u2_j1b2 + double precision, external :: num_int2_u2_env2 - print*, ' test_int2_u2_j1b2 ...' + print*, ' test_int2_u2_env2 ...' - PROVIDE int2_u2_j1b2 + PROVIDE int2_u2_env2 eps_ij = 1d-3 acc_tot = 0.d0 normalz = 0.d0 - !do ipoint = 1, 10 do ipoint = 1, n_points_final_grid do j = 1, ao_num do i = 1, ao_num - i_exc = int2_u2_j1b2(i,j,ipoint) - i_num = num_int2_u2_j1b2(i,j,ipoint) + i_exc = int2_u2_env2(i,j,ipoint) + i_num = num_int2_u2_env2(i,j,ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in int2_u2_j1b2 on', i, j, ipoint + print *, ' problem in int2_u2_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -233,20 +231,20 @@ subroutine test_int2_u2_j1b2() print*, ' normalz = ', normalz return -end subroutine test_int2_u2_j1b2 +end ! --- -subroutine test_int2_grad1u2_grad2u2_j1b2() +subroutine test_int2_grad1u2_grad2u2_env2() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_int2_grad1u2_grad2u2_j1b2 + double precision, external :: num_int2_grad1u2_grad2u2_env2 - print*, ' test_int2_grad1u2_grad2u2_j1b2 ...' + print*, ' test_int2_grad1u2_grad2u2_env2 ...' - PROVIDE int2_grad1u2_grad2u2_j1b2 + PROVIDE int2_grad1u2_grad2u2_env2 eps_ij = 1d-3 acc_tot = 0.d0 @@ -257,11 +255,11 @@ subroutine test_int2_grad1u2_grad2u2_j1b2() do j = 1, ao_num do i = 1, ao_num - i_exc = int2_grad1u2_grad2u2_j1b2(i,j,ipoint) - i_num = num_int2_grad1u2_grad2u2_j1b2(i,j,ipoint) + i_exc = int2_grad1u2_grad2u2_env2(i,j,ipoint) + i_num = num_int2_grad1u2_grad2u2_env2(i,j,ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in int2_grad1u2_grad2u2_j1b2 on', i, j, ipoint + print *, ' problem in int2_grad1u2_grad2u2_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -277,18 +275,18 @@ subroutine test_int2_grad1u2_grad2u2_j1b2() print*, ' normalz = ', normalz return -end subroutine test_int2_grad1u2_grad2u2_j1b2 +end ! --- -subroutine test_int2_grad1_u12_ao() +subroutine test_int2_grad1_u12_ao_num() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz double precision :: integ(3) - print*, ' test_int2_grad1_u12_ao ...' + print*, ' test_int2_grad1_u12_ao_num ...' PROVIDE int2_grad1_u12_ao @@ -346,11 +344,11 @@ subroutine test_int2_grad1_u12_ao() print*, ' normalz = ', normalz return -end subroutine test_int2_grad1_u12_ao +end ! --- -subroutine test_int2_u_grad1u_total_j1b2() +subroutine test_int2_u_grad1u_total_env2() implicit none integer :: i, j, ipoint @@ -358,10 +356,10 @@ subroutine test_int2_u_grad1u_total_j1b2() double precision :: x, y, z double precision :: integ(3) - print*, ' test_int2_u_grad1u_total_j1b2 ...' + print*, ' test_int2_u_grad1u_total_env2 ...' - PROVIDE int2_u_grad1u_j1b2 - PROVIDE int2_u_grad1u_x_j1b2 + PROVIDE int2_u_grad1u_env2 + PROVIDE int2_u_grad1u_x_env2 eps_ij = 1d-3 acc_tot = 0.d0 @@ -376,13 +374,13 @@ subroutine test_int2_u_grad1u_total_j1b2() do j = 1, ao_num do i = 1, ao_num - call num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) + call num_int2_u_grad1u_total_env2(i, j, ipoint, integ) - i_exc = x * int2_u_grad1u_j1b2(i,j,ipoint) - int2_u_grad1u_x_j1b2(i,j,ipoint,1) + i_exc = x * int2_u_grad1u_env2(i,j,ipoint) - int2_u_grad1u_x_env2(i,j,ipoint,1) i_num = integ(1) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in x part of int2_u_grad1u_total_j1b2 on', i, j, ipoint + print *, ' problem in x part of int2_u_grad1u_total_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -390,11 +388,11 @@ subroutine test_int2_u_grad1u_total_j1b2() acc_tot += acc_ij normalz += dabs(i_num) - i_exc = y * int2_u_grad1u_j1b2(i,j,ipoint) - int2_u_grad1u_x_j1b2(i,j,ipoint,2) + i_exc = y * int2_u_grad1u_env2(i,j,ipoint) - int2_u_grad1u_x_env2(i,j,ipoint,2) i_num = integ(2) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in y part of int2_u_grad1u_total_j1b2 on', i, j, ipoint + print *, ' problem in y part of int2_u_grad1u_total_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -402,11 +400,11 @@ subroutine test_int2_u_grad1u_total_j1b2() acc_tot += acc_ij normalz += dabs(i_num) - i_exc = z * int2_u_grad1u_j1b2(i,j,ipoint) - int2_u_grad1u_x_j1b2(i,j,ipoint,3) + i_exc = z * int2_u_grad1u_env2(i,j,ipoint) - int2_u_grad1u_x_env2(i,j,ipoint,3) i_num = integ(3) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in z part of int2_u_grad1u_total_j1b2 on', i, j, ipoint + print *, ' problem in z part of int2_u_grad1u_total_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -422,109 +420,7 @@ subroutine test_int2_u_grad1u_total_j1b2() print*, ' normalz = ', normalz return -end subroutine test_int2_u_grad1u_total_j1b2 - -! --- - -subroutine test_gradu_squared_u_ij_mu() - - implicit none - integer :: i, j, ipoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_gradu_squared_u_ij_mu - - print*, ' test_gradu_squared_u_ij_mu ...' - - PROVIDE gradu_squared_u_ij_mu - - eps_ij = 1d-3 - acc_tot = 0.d0 - normalz = 0.d0 - - do ipoint = 1, n_points_final_grid - do j = 1, ao_num - do i = 1, ao_num - - i_exc = gradu_squared_u_ij_mu(i,j,ipoint) - i_num = num_gradu_squared_u_ij_mu(i, j, ipoint) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in gradu_squared_u_ij_mu on', i, j, ipoint - print *, ' analyt integ = ', i_exc - print *, ' numeri integ = ', i_num - print *, ' diff = ', acc_ij - endif - acc_tot += acc_ij - normalz += dabs(i_num) - - enddo - enddo - enddo - - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz - - return -end subroutine test_gradu_squared_u_ij_mu - -! --- - -subroutine test_tchint_rsdft() - - implicit none - integer :: i, j, m, ipoint, jpoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision :: x(3), y(3), dj_1(3), dj_2(3), dj_3(3) - - print*, ' test rsdft_jastrow ...' - - PROVIDE grad1_u12_num - - eps_ij = 1d-4 - acc_tot = 0.d0 - normalz = 0.d0 - - do ipoint = 1, n_points_final_grid - x(1) = final_grid_points(1,ipoint) - x(2) = final_grid_points(2,ipoint) - x(3) = final_grid_points(3,ipoint) - - do jpoint = 1, n_points_extra_final_grid - y(1) = final_grid_points_extra(1,jpoint) - y(2) = final_grid_points_extra(2,jpoint) - y(3) = final_grid_points_extra(3,jpoint) - - dj_1(1) = grad1_u12_num(jpoint,ipoint,1) - dj_1(2) = grad1_u12_num(jpoint,ipoint,2) - dj_1(3) = grad1_u12_num(jpoint,ipoint,3) - - call get_tchint_rsdft_jastrow(x, y, dj_2) - - do m = 1, 3 - i_exc = dj_1(m) - i_num = dj_2(m) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem on', ipoint, jpoint, m - print *, ' x = ', x - print *, ' y = ', y - print *, ' exc, num, diff = ', i_exc, i_num, acc_ij - call grad1_jmu_modif_num(x, y, dj_3) - print *, ' check = ', dj_3(m) - stop - endif - - acc_tot += acc_ij - normalz += dabs(i_exc) - enddo - enddo - enddo - - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz - - return -end subroutine test_tchint_rsdft +end ! --- @@ -567,20 +463,20 @@ subroutine test_grad12_j12() print*, ' normalz = ', normalz return -end subroutine test_grad12_j12 +end ! --- -subroutine test_u12sq_j1bsq() +subroutine test_u12sq_envsq() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_u12sq_j1bsq + double precision, external :: num_u12sq_envsq - print*, ' test_u12sq_j1bsq ...' + print*, ' test_u12sq_envsq ...' - PROVIDE u12sq_j1bsq + PROVIDE u12sq_envsq eps_ij = 1d-3 acc_tot = 0.d0 @@ -590,11 +486,11 @@ subroutine test_u12sq_j1bsq() do j = 1, ao_num do i = 1, ao_num - i_exc = u12sq_j1bsq(i,j,ipoint) - i_num = num_u12sq_j1bsq(i, j, ipoint) + i_exc = u12sq_envsq(i,j,ipoint) + i_num = num_u12sq_envsq(i, j, ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in u12sq_j1bsq on', i, j, ipoint + print *, ' problem in u12sq_envsq on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -610,20 +506,20 @@ subroutine test_u12sq_j1bsq() print*, ' normalz = ', normalz return -end subroutine test_u12sq_j1bsq +end ! --- -subroutine test_u12_grad1_u12_j1b_grad1_j1b() +subroutine test_u12_grad1_u12_env_grad1_env() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_u12_grad1_u12_j1b_grad1_j1b + double precision, external :: num_u12_grad1_u12_env_grad1_env - print*, ' test_u12_grad1_u12_j1b_grad1_j1b ...' + print*, ' test_u12_grad1_u12_env_grad1_env ...' - PROVIDE u12_grad1_u12_j1b_grad1_j1b + PROVIDE u12_grad1_u12_env_grad1_env eps_ij = 1d-3 acc_tot = 0.d0 @@ -633,11 +529,11 @@ subroutine test_u12_grad1_u12_j1b_grad1_j1b() do j = 1, ao_num do i = 1, ao_num - i_exc = u12_grad1_u12_j1b_grad1_j1b(i,j,ipoint) - i_num = num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint) + i_exc = u12_grad1_u12_env_grad1_env(i,j,ipoint) + i_num = num_u12_grad1_u12_env_grad1_env(i, j, ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in u12_grad1_u12_j1b_grad1_j1b on', i, j, ipoint + print *, ' problem in u12_grad1_u12_env_grad1_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -653,7 +549,7 @@ subroutine test_u12_grad1_u12_j1b_grad1_j1b() print*, ' normalz = ', normalz return -end subroutine test_u12_grad1_u12_j1b_grad1_j1b +end ! --- @@ -670,7 +566,7 @@ subroutine test_vect_overlap_gauss_r12_ao() print *, ' test_vect_overlap_gauss_r12_ao ...' - provide mu_erf final_grid_points_transp j1b_pen + provide mu_erf final_grid_points_transp expo_fit = expo_gauss_j_mu_x_2(1) @@ -740,7 +636,7 @@ subroutine test_vect_overlap_gauss_r12_ao() print*, ' normalz = ', normalz return -end subroutine test_vect_overlap_gauss_r12_ao +end ! --- @@ -757,13 +653,13 @@ subroutine test_vect_overlap_gauss_r12_ao_with1s() print *, ' test_vect_overlap_gauss_r12_ao_with1s ...' - provide mu_erf final_grid_points_transp j1b_pen + provide mu_erf final_grid_points_transp expo_fit = expo_gauss_j_mu_x_2(1) - beta = List_all_comb_b3_expo (2) - B_center(1) = List_all_comb_b3_cent(1,2) - B_center(2) = List_all_comb_b3_cent(2,2) - B_center(3) = List_all_comb_b3_cent(3,2) + beta = List_env1s_square_expo (2) + B_center(1) = List_env1s_square_cent(1,2) + B_center(2) = List_env1s_square_cent(2,2) + B_center(3) = List_env1s_square_cent(3,2) ! --- @@ -831,5 +727,52 @@ subroutine test_vect_overlap_gauss_r12_ao_with1s() print*, ' normalz = ', normalz return -end subroutine test_vect_overlap_gauss_r12_ao +end + +! --- + +subroutine test_Ir2_LinFcRSDFT_long_Du_0() + + implicit none + integer :: i, j, ipoint + double precision :: i_old, i_new + double precision :: acc_ij, acc_tot, eps_ij, normalz + + print*, ' test_Ir2_LinFcRSDFT_long_Du_0 ...' + + PROVIDE v_ij_erf_rk_cst_mu_env + PROVIDE Ir2_LinFcRSDFT_long_Du_0 + + eps_ij = 1d-10 + acc_tot = 0.d0 + normalz = 0.d0 + + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + + i_old = v_ij_erf_rk_cst_mu_env (i,j,ipoint) + i_new = Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) + + acc_ij = dabs(i_old - i_new) + if(acc_ij .gt. eps_ij) then + print *, ' problem in Ir2_LinFcRSDFT_long_Du_0 on', i, j, ipoint + print *, ' old integ = ', i_old + print *, ' new integ = ', i_new + print *, ' diff = ', acc_ij + stop + endif + + acc_tot += acc_ij + normalz += dabs(i_old) + enddo + enddo + enddo + + print*, ' acc_tot (%) = ', 100.d0 * acc_tot / normalz + + return +end + +! --- diff --git a/plugins/local/non_h_ints_mu/grad_squared.irp.f b/plugins/local/non_h_ints_mu/grad_squared.irp.f index 8c6d35dc..342e1fe7 100644 --- a/plugins/local/non_h_ints_mu/grad_squared.irp.f +++ b/plugins/local/non_h_ints_mu/grad_squared.irp.f @@ -1,224 +1,7 @@ ! --- -! TODO : strong optmization : write the loops in a different way -! : for each couple of AO, the gaussian product are done once for all - -BEGIN_PROVIDER [ double precision, gradu_squared_u_ij_mu, (ao_num, ao_num, n_points_final_grid) ] - - BEGIN_DOC - ! - ! if J(r1,r2) = u12: - ! - ! gradu_squared_u_ij_mu = -0.50 x \int r2 [ (grad_1 u12)^2 + (grad_2 u12^2)] \phi_i(2) \phi_j(2) - ! = -0.25 x \int r2 (1 - erf(mu*r12))^2 \phi_i(2) \phi_j(2) - ! and - ! (1 - erf(mu*r12))^2 = \sum_i coef_gauss_1_erf_x_2(i) * exp(-expo_gauss_1_erf_x_2(i) * r12^2) - ! - ! if J(r1,r2) = u12 x v1 x v2 - ! - ! gradu_squared_u_ij_mu = -0.50 x \int r2 \phi_i(2) \phi_j(2) [ v1^2 v2^2 ((grad_1 u12)^2 + (grad_2 u12^2)) + u12^2 v2^2 (grad_1 v1)^2 + 2 u12 v1 v2^2 (grad_1 u12) . (grad_1 v1) ] - ! = -0.25 x v1^2 \int r2 \phi_i(2) \phi_j(2) [1 - erf(mu r12)]^2 v2^2 - ! + -0.50 x (grad_1 v1)^2 \int r2 \phi_i(2) \phi_j(2) u12^2 v2^2 - ! + -1.00 x v1 (grad_1 v1) \int r2 \phi_i(2) \phi_j(2) (grad_1 u12) v2^2 - ! = v1^2 x int2_grad1u2_grad2u2_j1b2 - ! + -0.5 x (grad_1 v1)^2 x int2_u2_j1b2 - ! + -1.0 X V1 x (grad_1 v1) \cdot [ int2_u_grad1u_j1b2 x r - int2_u_grad1u_x_j1b ] - ! - ! - END_DOC - - implicit none - integer :: ipoint, i, j, m, igauss - double precision :: x, y, z, r(3), delta, coef - double precision :: tmp_v, tmp_x, tmp_y, tmp_z - double precision :: tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9 - double precision :: time0, time1 - double precision, external :: overlap_gauss_r12_ao - - print*, ' providing gradu_squared_u_ij_mu ...' - call wall_time(time0) - - PROVIDE j1b_type - - if(j1b_type .eq. 3) then - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - tmp_v = v_1b (ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) - - tmp1 = tmp_v * tmp_v - tmp2 = -0.5d0 * (tmp_x * tmp_x + tmp_y * tmp_y + tmp_z * tmp_z) - tmp3 = tmp_v * tmp_x - tmp4 = tmp_v * tmp_y - tmp5 = tmp_v * tmp_z - - tmp6 = -x * tmp3 - tmp7 = -y * tmp4 - tmp8 = -z * tmp5 - - do j = 1, ao_num - do i = 1, ao_num - - tmp9 = int2_u_grad1u_j1b2(i,j,ipoint) - - gradu_squared_u_ij_mu(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_j1b2(i,j,ipoint) & - + tmp2 * int2_u2_j1b2 (i,j,ipoint) & - + tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_j1b2(i,j,ipoint,1) & - + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_j1b2(i,j,ipoint,2) & - + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_j1b2(i,j,ipoint,3) - enddo - enddo - enddo - - else - - gradu_squared_u_ij_mu = 0.d0 - 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 j = 1, ao_num - do i = 1, ao_num - do igauss = 1, n_max_fit_slat - delta = expo_gauss_1_erf_x_2(igauss) - coef = coef_gauss_1_erf_x_2(igauss) - gradu_squared_u_ij_mu(i,j,ipoint) += -0.25d0 * coef * overlap_gauss_r12_ao(r, delta, i, j) - enddo - enddo - enddo - enddo - - endif - - call wall_time(time1) - print*, ' Wall time for gradu_squared_u_ij_mu = ', time1 - time0 - -END_PROVIDER - -! --- - -!BEGIN_PROVIDER [double precision, tc_grad_square_ao_loop, (ao_num, ao_num, ao_num, ao_num)] -! -! BEGIN_DOC -! ! -! ! tc_grad_square_ao_loop(k,i,l,j) = -1/2 -! ! -! END_DOC -! -! implicit none -! integer :: ipoint, i, j, k, l -! double precision :: weight1, ao_ik_r, ao_i_r -! double precision, allocatable :: ac_mat(:,:,:,:) -! -! allocate(ac_mat(ao_num,ao_num,ao_num,ao_num)) -! ac_mat = 0.d0 -! -! do ipoint = 1, n_points_final_grid -! weight1 = final_weight_at_r_vector(ipoint) -! -! do i = 1, ao_num -! ao_i_r = weight1 * aos_in_r_array_transp(ipoint,i) -! -! do k = 1, ao_num -! ao_ik_r = ao_i_r * aos_in_r_array_transp(ipoint,k) -! -! do j = 1, ao_num -! do l = 1, ao_num -! ac_mat(k,i,l,j) += ao_ik_r * gradu_squared_u_ij_mu(l,j,ipoint) -! enddo -! enddo -! enddo -! enddo -! enddo -! -! do j = 1, ao_num -! do l = 1, ao_num -! do i = 1, ao_num -! do k = 1, ao_num -! tc_grad_square_ao_loop(k,i,l,j) = ac_mat(k,i,l,j) + ac_mat(l,j,k,i) -! !write(11,*) tc_grad_square_ao_loop(k,i,l,j) -! enddo -! enddo -! enddo -! enddo -! -! deallocate(ac_mat) -! -!END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, tc_grad_square_ao_loop, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! tc_grad_square_ao_loop(k,i,l,j) = 1/2 - ! - END_DOC - - implicit none - integer :: ipoint, i, j, k, l - double precision :: weight1, ao_ik_r, ao_i_r - double precision :: time0, time1 - double precision, allocatable :: ac_mat(:,:,:,:), bc_mat(:,:,:,:) - - print*, ' providing tc_grad_square_ao_loop ...' - call wall_time(time0) - - allocate(ac_mat(ao_num,ao_num,ao_num,ao_num)) - ac_mat = 0.d0 - allocate(bc_mat(ao_num,ao_num,ao_num,ao_num)) - bc_mat = 0.d0 - - do ipoint = 1, n_points_final_grid - weight1 = final_weight_at_r_vector(ipoint) - - do i = 1, ao_num - !ao_i_r = weight1 * aos_in_r_array_transp(ipoint,i) - ao_i_r = weight1 * aos_in_r_array(i,ipoint) - - do k = 1, ao_num - !ao_ik_r = ao_i_r * aos_in_r_array_transp(ipoint,k) - ao_ik_r = ao_i_r * aos_in_r_array(k,ipoint) - - do j = 1, ao_num - do l = 1, ao_num - ac_mat(k,i,l,j) += ao_ik_r * ( u12sq_j1bsq(l,j,ipoint) + u12_grad1_u12_j1b_grad1_j1b(l,j,ipoint) ) - bc_mat(k,i,l,j) += ao_ik_r * grad12_j12(l,j,ipoint) - enddo - enddo - enddo - enddo - enddo - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - tc_grad_square_ao_loop(k,i,l,j) = ac_mat(k,i,l,j) + ac_mat(l,j,k,i) + bc_mat(k,i,l,j) - enddo - enddo - enddo - enddo - - deallocate(ac_mat) - deallocate(bc_mat) - - call wall_time(time1) - print*, ' Wall time for tc_grad_square_ao_loop = ', time1 - time0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, grad12_j12, (ao_num, ao_num, n_points_final_grid) ] +BEGIN_PROVIDER [double precision, grad12_j12, (ao_num, ao_num, n_points_final_grid)] implicit none integer :: ipoint, i, j, m, igauss @@ -230,48 +13,28 @@ BEGIN_PROVIDER [ double precision, grad12_j12, (ao_num, ao_num, n_points_final_g print*, ' providing grad12_j12 ...' call wall_time(time0) - PROVIDE j1b_type - PROVIDE int2_grad1u2_grad2u2_j1b2 + PROVIDE int2_grad1u2_grad2u2_env2 do ipoint = 1, n_points_final_grid - tmp1 = v_1b(ipoint) + tmp1 = env_val(ipoint) tmp1 = tmp1 * tmp1 do j = 1, ao_num do i = 1, ao_num - grad12_j12(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_j1b2(i,j,ipoint) + grad12_j12(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_env2(i,j,ipoint) enddo enddo enddo - FREE int2_grad1u2_grad2u2_j1b2 - - !if(j1b_type .eq. 0) then - ! grad12_j12 = 0.d0 - ! 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 j = 1, ao_num - ! do i = 1, ao_num - ! do igauss = 1, n_max_fit_slat - ! delta = expo_gauss_1_erf_x_2(igauss) - ! coef = coef_gauss_1_erf_x_2(igauss) - ! grad12_j12(i,j,ipoint) += -0.25d0 * coef * overlap_gauss_r12_ao(r, delta, i, j) - ! enddo - ! enddo - ! enddo - ! enddo - !endif + FREE int2_grad1u2_grad2u2_env2 call wall_time(time1) - print*, ' Wall time for grad12_j12 = ', time1 - time0 - call print_memory_usage() + print*, ' Wall time for grad12_j12 (min) = ', (time1 - time0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, u12sq_j1bsq, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, u12sq_envsq, (ao_num, ao_num, n_points_final_grid)] implicit none integer :: ipoint, i, j @@ -279,33 +42,32 @@ BEGIN_PROVIDER [double precision, u12sq_j1bsq, (ao_num, ao_num, n_points_final_g double precision :: tmp1 double precision :: time0, time1 - print*, ' providing u12sq_j1bsq ...' + print*, ' providing u12sq_envsq ...' call wall_time(time0) ! do not free here - PROVIDE int2_u2_j1b2 + PROVIDE int2_u2_env2 do ipoint = 1, n_points_final_grid - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) tmp1 = -0.5d0 * (tmp_x * tmp_x + tmp_y * tmp_y + tmp_z * tmp_z) do j = 1, ao_num do i = 1, ao_num - u12sq_j1bsq(i,j,ipoint) = tmp1 * int2_u2_j1b2(i,j,ipoint) + u12sq_envsq(i,j,ipoint) = tmp1 * int2_u2_env2(i,j,ipoint) enddo enddo enddo call wall_time(time1) - print*, ' Wall time for u12sq_j1bsq = ', time1 - time0 - call print_memory_usage() + print*, ' Wall time for u12sq_envsq (min) = ', (time1 - time0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b, (ao_num, ao_num, n_points_final_grid) ] +BEGIN_PROVIDER [double precision, u12_grad1_u12_env_grad1_env, (ao_num, ao_num, n_points_final_grid)] implicit none integer :: ipoint, i, j, m, igauss @@ -315,21 +77,21 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b, (ao_num, ao_num, double precision :: time0, time1 double precision, external :: overlap_gauss_r12_ao - print*, ' providing u12_grad1_u12_j1b_grad1_j1b ...' + print*, ' providing u12_grad1_u12_env_grad1_env ...' call wall_time(time0) - PROVIDE int2_u_grad1u_j1b2 - PROVIDE int2_u_grad1u_x_j1b2 + PROVIDE int2_u_grad1u_env2 + PROVIDE int2_u_grad1u_x_env2 do ipoint = 1, n_points_final_grid x = final_grid_points(1,ipoint) y = final_grid_points(2,ipoint) z = final_grid_points(3,ipoint) - tmp_v = v_1b (ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) + tmp_v = env_val (ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) tmp3 = tmp_v * tmp_x tmp4 = tmp_v * tmp_y @@ -342,143 +104,20 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b, (ao_num, ao_num, do j = 1, ao_num do i = 1, ao_num - tmp9 = int2_u_grad1u_j1b2(i,j,ipoint) + tmp9 = int2_u_grad1u_env2(i,j,ipoint) - u12_grad1_u12_j1b_grad1_j1b(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_j1b2(i,j,ipoint,1) & - + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_j1b2(i,j,ipoint,2) & - + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_j1b2(i,j,ipoint,3) + u12_grad1_u12_env_grad1_env(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_env2(i,j,ipoint,1) & + + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_env2(i,j,ipoint,2) & + + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_env2(i,j,ipoint,3) enddo enddo enddo - FREE int2_u_grad1u_j1b2 - FREE int2_u_grad1u_x_j1b2 + FREE int2_u_grad1u_env2 + FREE int2_u_grad1u_x_env2 call wall_time(time1) - print*, ' Wall time for u12_grad1_u12_j1b_grad1_j1b = ', time1 - time0 - call print_memory_usage() - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, tc_grad_square_ao, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! tc_grad_square_ao(k,i,l,j) = -1/2 - ! - END_DOC - - implicit none - integer :: ipoint, i, j, k, l - double precision :: weight1, ao_k_r, ao_i_r - double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq - double precision :: time0, time1 - double precision, allocatable :: b_mat(:,:,:), tmp(:,:,:) - - print*, ' providing tc_grad_square_ao ...' - call wall_time(time0) - - if(read_tc_integ) then - - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_square_ao', action="read") - read(11) tc_grad_square_ao - close(11) - - else - - ! --- - - PROVIDE int2_grad1_u12_square_ao - - allocate(b_mat(n_points_final_grid,ao_num,ao_num)) - - b_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint) & - !$OMP SHARED (aos_in_r_array_transp, b_mat, ao_num, n_points_final_grid, final_weight_at_r_vector) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - b_mat(ipoint,k,i) = final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,k) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - tc_grad_square_ao = 0.d0 - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_grad1_u12_square_ao(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & - , 0.d0, tc_grad_square_ao, ao_num*ao_num) - - FREE int2_grad1_u12_square_ao - - ! --- - - if(((j1b_type .eq. 3) .or. (j1b_type .eq. 4)) .and. use_ipp) then - - print*, " going through Manu's IPP" - - ! an additional term is added here directly instead of - ! being added in int2_grad1_u12_square_ao for performance - - PROVIDE int2_u2_j1b2 - - b_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & - !$OMP SHARED (aos_in_r_array_transp, b_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & - !$OMP v_1b_square_grad, v_1b_square_lapl, aos_grad_in_r_array_transp_bis) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - - weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) - - ao_i_r = aos_in_r_array_transp(ipoint,i) - ao_k_r = aos_in_r_array_transp(ipoint,k) - - b_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * v_1b_square_lapl(ipoint) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * v_1b_square_grad(ipoint,1) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * v_1b_square_grad(ipoint,2) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * v_1b_square_grad(ipoint,3) ) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_u2_j1b2(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & - , 1.d0, tc_grad_square_ao, ao_num*ao_num) - - FREE int2_u2_j1b2 - endif - - ! --- - - deallocate(b_mat) - call sum_A_At(tc_grad_square_ao(1,1,1,1), ao_num*ao_num) - - endif - - if(write_tc_integ.and.mpi_master) then - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_square_ao', action="write") - call ezfio_set_work_empty(.False.) - write(11) tc_grad_square_ao - close(11) - call ezfio_set_tc_keywords_io_tc_integ('Read') - endif - - call wall_time(time1) - print*, ' Wall time for tc_grad_square_ao = ', time1 - time0 - call print_memory_usage() + print*, ' Wall time for u12_grad1_u12_env_grad1_env (min) = ', (time1 - time0) / 60.d0 END_PROVIDER diff --git a/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f b/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f index dcfeff47..f4056c32 100644 --- a/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f +++ b/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f @@ -1,4 +1,6 @@ +! --- + BEGIN_PROVIDER [double precision, tc_grad_square_ao_test, (ao_num, ao_num, ao_num, ao_num)] BEGIN_DOC @@ -24,7 +26,7 @@ BEGIN_PROVIDER [double precision, tc_grad_square_ao_test, (ao_num, ao_num, ao_nu else - provide u12sq_j1bsq_test u12_grad1_u12_j1b_grad1_j1b_test grad12_j12_test + provide u12sq_envsq_test u12_grad1_u12_env_grad1_env_test grad12_j12_test allocate(b_mat(n_points_final_grid,ao_num,ao_num), tmp(ao_num,ao_num,n_points_final_grid)) @@ -48,12 +50,12 @@ BEGIN_PROVIDER [double precision, tc_grad_square_ao_test, (ao_num, ao_num, ao_nu !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (j, l, ipoint) & - !$OMP SHARED (tmp, ao_num, n_points_final_grid, u12sq_j1bsq_test, u12_grad1_u12_j1b_grad1_j1b_test, grad12_j12_test) + !$OMP SHARED (tmp, ao_num, n_points_final_grid, u12sq_envsq_test, u12_grad1_u12_env_grad1_env_test, grad12_j12_test) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid do j = 1, ao_num do l = 1, ao_num - tmp(l,j,ipoint) = u12sq_j1bsq_test(l,j,ipoint) + u12_grad1_u12_j1b_grad1_j1b_test(l,j,ipoint) + 0.5d0 * grad12_j12_test(l,j,ipoint) + tmp(l,j,ipoint) = u12sq_envsq_test(l,j,ipoint) + u12_grad1_u12_env_grad1_env_test(l,j,ipoint) + 0.5d0 * grad12_j12_test(l,j,ipoint) enddo enddo enddo @@ -102,7 +104,7 @@ BEGIN_PROVIDER [double precision, tc_grad_square_ao_test_ref, (ao_num, ao_num, a print*, ' providing tc_grad_square_ao_test_ref ...' call wall_time(time0) - provide u12sq_j1bsq_test u12_grad1_u12_j1b_grad1_j1b_test grad12_j12_test + provide u12sq_envsq_test u12_grad1_u12_env_grad1_env_test grad12_j12_test allocate(ac_mat(ao_num,ao_num,ao_num,ao_num), b_mat(n_points_final_grid,ao_num,ao_num), tmp(ao_num,ao_num,n_points_final_grid)) @@ -126,12 +128,12 @@ BEGIN_PROVIDER [double precision, tc_grad_square_ao_test_ref, (ao_num, ao_num, a !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (j, l, ipoint) & - !$OMP SHARED (tmp, ao_num, n_points_final_grid, u12sq_j1bsq_test, u12_grad1_u12_j1b_grad1_j1b_test, grad12_j12_test) + !$OMP SHARED (tmp, ao_num, n_points_final_grid, u12sq_envsq_test, u12_grad1_u12_env_grad1_env_test, grad12_j12_test) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid do j = 1, ao_num do l = 1, ao_num - tmp(l,j,ipoint) = u12sq_j1bsq_test(l,j,ipoint) + u12_grad1_u12_j1b_grad1_j1b_test(l,j,ipoint) + 0.5d0 * grad12_j12_test(l,j,ipoint) + tmp(l,j,ipoint) = u12sq_envsq_test(l,j,ipoint) + u12_grad1_u12_env_grad1_env_test(l,j,ipoint) + 0.5d0 * grad12_j12_test(l,j,ipoint) enddo enddo enddo @@ -170,7 +172,7 @@ END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, u12sq_j1bsq_test, (ao_num, ao_num, n_points_final_grid) ] +BEGIN_PROVIDER [ double precision, u12sq_envsq_test, (ao_num, ao_num, n_points_final_grid) ] implicit none integer :: ipoint, i, j @@ -178,29 +180,29 @@ BEGIN_PROVIDER [ double precision, u12sq_j1bsq_test, (ao_num, ao_num, n_points_f double precision :: tmp1 double precision :: time0, time1 - print*, ' providing u12sq_j1bsq_test ...' + print*, ' providing u12sq_envsq_test ...' call wall_time(time0) do ipoint = 1, n_points_final_grid - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) tmp1 = -0.5d0 * (tmp_x * tmp_x + tmp_y * tmp_y + tmp_z * tmp_z) do j = 1, ao_num do i = 1, ao_num - u12sq_j1bsq_test(i,j,ipoint) = tmp1 * int2_u2_j1b2_test(i,j,ipoint) + u12sq_envsq_test(i,j,ipoint) = tmp1 * int2_u2_env2_test(i,j,ipoint) enddo enddo enddo call wall_time(time1) - print*, ' Wall time for u12sq_j1bsq_test = ', time1 - time0 + print*, ' Wall time for u12sq_envsq_test (min) = ', (time1 - time0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao_num, n_points_final_grid) ] +BEGIN_PROVIDER [double precision, u12_grad1_u12_env_grad1_env_test, (ao_num, ao_num, n_points_final_grid)] implicit none integer :: ipoint, i, j, m, igauss @@ -210,9 +212,9 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao double precision :: time0, time1 double precision, external :: overlap_gauss_r12_ao - print*, ' providing u12_grad1_u12_j1b_grad1_j1b_test ...' + print*, ' providing u12_grad1_u12_env_grad1_env_test ...' - provide int2_u_grad1u_x_j1b2_test + provide int2_u_grad1u_x_env2_test call wall_time(time0) do ipoint = 1, n_points_final_grid @@ -220,10 +222,10 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao x = final_grid_points(1,ipoint) y = final_grid_points(2,ipoint) z = final_grid_points(3,ipoint) - tmp_v = v_1b (ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) + tmp_v = env_val (ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) tmp3 = tmp_v * tmp_x tmp4 = tmp_v * tmp_y @@ -236,23 +238,23 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao do j = 1, ao_num do i = 1, ao_num - tmp9 = int2_u_grad1u_j1b2_test(i,j,ipoint) + tmp9 = int2_u_grad1u_env2_test(i,j,ipoint) - u12_grad1_u12_j1b_grad1_j1b_test(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_j1b2_test(i,j,ipoint,1) & - + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_j1b2_test(i,j,ipoint,2) & - + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_j1b2_test(i,j,ipoint,3) + u12_grad1_u12_env_grad1_env_test(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_env2_test(i,j,ipoint,1) & + + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_env2_test(i,j,ipoint,2) & + + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_env2_test(i,j,ipoint,3) enddo enddo enddo call wall_time(time1) - print*, ' Wall time for u12_grad1_u12_j1b_grad1_j1b_test = ', time1 - time0 + print*, ' Wall time for u12_grad1_u12_env_grad1_env_test (min) = ', (time1 - time0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, grad12_j12_test, (ao_num, ao_num, n_points_final_grid) ] +BEGIN_PROVIDER [double precision, grad12_j12_test, (ao_num, ao_num, n_points_final_grid)] implicit none integer :: ipoint, i, j, m, igauss @@ -260,46 +262,32 @@ BEGIN_PROVIDER [ double precision, grad12_j12_test, (ao_num, ao_num, n_points_fi double precision :: tmp1 double precision :: time0, time1 double precision, external :: overlap_gauss_r12_ao - provide int2_grad1u2_grad2u2_j1b2_test + + provide int2_grad1u2_grad2u2_env2_test print*, ' providing grad12_j12_test ...' call wall_time(time0) - PROVIDE j1b_type - - if(j1b_type .eq. 3) then + if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then do ipoint = 1, n_points_final_grid - tmp1 = v_1b(ipoint) + tmp1 = env_val(ipoint) tmp1 = tmp1 * tmp1 do j = 1, ao_num do i = 1, ao_num - grad12_j12_test(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint) + grad12_j12_test(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_env2_test(i,j,ipoint) enddo enddo enddo else - grad12_j12_test = 0.d0 - 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 j = 1, ao_num - do i = 1, ao_num - do igauss = 1, n_max_fit_slat - delta = expo_gauss_1_erf_x_2(igauss) - coef = coef_gauss_1_erf_x_2(igauss) - grad12_j12_test(i,j,ipoint) += -0.25d0 * coef * overlap_gauss_r12_ao(r, delta, i, j) - enddo - enddo - enddo - enddo + print *, ' Error in grad12_j12_test: Unknown Jastrow' + stop endif call wall_time(time1) - print*, ' Wall time for grad12_j12_test = ', time1 - time0 + print*, ' Wall time for grad12_j12_test (min) = ', (time1 - time0) / 60.d0 END_PROVIDER diff --git a/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f index 7dd13f14..528b5e13 100644 --- a/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f +++ b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f @@ -1,14 +1,14 @@ ! --- -BEGIN_PROVIDER [ double precision, v_1b, (n_points_final_grid)] +BEGIN_PROVIDER [double precision, env_val, (n_points_final_grid)] implicit none integer :: ipoint, i, j, phase double precision :: x, y, z, dx, dy, dz double precision :: a, d, e, fact_r - if(j1b_type .eq. 3) then + if(env_type .eq. "prod-gauss") then ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] @@ -20,7 +20,7 @@ BEGIN_PROVIDER [ double precision, v_1b, (n_points_final_grid)] fact_r = 1.d0 do j = 1, nucl_num - a = j1b_pen(j) + a = env_expo(j) dx = x - nucl_coord(j,1) dy = y - nucl_coord(j,2) dz = z - nucl_coord(j,3) @@ -30,10 +30,10 @@ BEGIN_PROVIDER [ double precision, v_1b, (n_points_final_grid)] fact_r = fact_r * e enddo - v_1b(ipoint) = fact_r + env_val(ipoint) = fact_r enddo - elseif(j1b_type .eq. 4) then + elseif(env_type .eq. "sum-gauss") then ! v(r) = 1 - \sum_{a} \beta_a \exp(-\alpha_a (r - r_a)^2) @@ -45,21 +45,21 @@ BEGIN_PROVIDER [ double precision, v_1b, (n_points_final_grid)] fact_r = 1.d0 do j = 1, nucl_num - a = j1b_pen(j) + a = env_expo(j) dx = x - nucl_coord(j,1) dy = y - nucl_coord(j,2) dz = z - nucl_coord(j,3) d = dx*dx + dy*dy + dz*dz - fact_r = fact_r - j1b_pen_coef(j) * dexp(-a*d) + fact_r = fact_r - env_coef(j) * dexp(-a*d) enddo - v_1b(ipoint) = fact_r + env_val(ipoint) = fact_r enddo else - print*, 'j1b_type = ', j1b_type, 'is not implemented for v_1b' + print *, ' Error in env_val: Unknown env_type = ', env_type stop endif @@ -68,7 +68,7 @@ END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, v_1b_grad, (3, n_points_final_grid)] +BEGIN_PROVIDER [double precision, env_grad, (3, n_points_final_grid)] implicit none integer :: ipoint, i, j, phase @@ -77,9 +77,7 @@ BEGIN_PROVIDER [double precision, v_1b_grad, (3, n_points_final_grid)] double precision :: fact_x, fact_y, fact_z double precision :: ax_der, ay_der, az_der, a_expo - PROVIDE j1b_type - - if(j1b_type .eq. 3) then + if(env_type .eq. "prod-gauss") then ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] @@ -92,7 +90,7 @@ BEGIN_PROVIDER [double precision, v_1b_grad, (3, n_points_final_grid)] fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 - do i = 1, List_all_comb_b2_size + do i = 1, List_env1s_size phase = 0 a_expo = 0.d0 @@ -100,12 +98,12 @@ BEGIN_PROVIDER [double precision, v_1b_grad, (3, n_points_final_grid)] ay_der = 0.d0 az_der = 0.d0 do j = 1, nucl_num - a = dble(List_all_comb_b2(j,i)) * j1b_pen(j) + a = dble(List_env1s(j,i)) * env_expo(j) dx = x - nucl_coord(j,1) dy = y - nucl_coord(j,2) dz = z - nucl_coord(j,3) - phase += List_all_comb_b2(j,i) + phase += List_env1s(j,i) a_expo += a * (dx*dx + dy*dy + dz*dz) ax_der += a * dx ay_der += a * dy @@ -118,12 +116,12 @@ BEGIN_PROVIDER [double precision, v_1b_grad, (3, n_points_final_grid)] fact_z += e * az_der enddo - v_1b_grad(1,ipoint) = fact_x - v_1b_grad(2,ipoint) = fact_y - v_1b_grad(3,ipoint) = fact_z + env_grad(1,ipoint) = fact_x + env_grad(2,ipoint) = fact_y + env_grad(3,ipoint) = fact_z enddo - elseif(j1b_type .eq. 4) then + elseif(env_type .eq. "sum-gauss") then ! v(r) = 1 - \sum_{a} \beta_a \exp(-\alpha_a (r - r_a)^2) @@ -143,22 +141,22 @@ BEGIN_PROVIDER [double precision, v_1b_grad, (3, n_points_final_grid)] dz = z - nucl_coord(j,3) r2 = dx*dx + dy*dy + dz*dz - a = j1b_pen(j) - e = a * j1b_pen_coef(j) * dexp(-a * r2) + a = env_expo(j) + e = a * env_coef(j) * dexp(-a * r2) ax_der += e * dx ay_der += e * dy az_der += e * dz enddo - v_1b_grad(1,ipoint) = 2.d0 * ax_der - v_1b_grad(2,ipoint) = 2.d0 * ay_der - v_1b_grad(3,ipoint) = 2.d0 * az_der + env_grad(1,ipoint) = 2.d0 * ax_der + env_grad(2,ipoint) = 2.d0 * ay_der + env_grad(3,ipoint) = 2.d0 * az_der enddo else - print*, 'j1b_type = ', j1b_type, 'is not implemented' + print *, ' Error in env_grad: Unknown env_type = ', env_type stop endif @@ -167,126 +165,8 @@ END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, v_1b_lapl, (n_points_final_grid)] - - implicit none - integer :: ipoint, i, j, phase - double precision :: x, y, z, dx, dy, dz - double precision :: a, e, b - double precision :: fact_r - double precision :: ax_der, ay_der, az_der, a_expo - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_r = 0.d0 - do i = 1, List_all_comb_b2_size - - phase = 0 - b = 0.d0 - a_expo = 0.d0 - ax_der = 0.d0 - ay_der = 0.d0 - az_der = 0.d0 - do j = 1, nucl_num - a = dble(List_all_comb_b2(j,i)) * j1b_pen(j) - dx = x - nucl_coord(j,1) - dy = y - nucl_coord(j,2) - dz = z - nucl_coord(j,3) - - phase += List_all_comb_b2(j,i) - b += a - a_expo += a * (dx*dx + dy*dy + dz*dz) - ax_der += a * dx - ay_der += a * dy - az_der += a * dz - enddo - - fact_r += (-1.d0)**dble(phase) * (-6.d0*b + 4.d0*(ax_der*ax_der + ay_der*ay_der + az_der*az_der) ) * dexp(-a_expo) - enddo - - v_1b_lapl(ipoint) = fact_r - enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, v_1b_list_b2, (n_points_final_grid)] - - implicit none - integer :: i, ipoint - double precision :: x, y, z, coef, expo, dx, dy, dz - double precision :: fact_r - - PROVIDE List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_r = 0.d0 - do i = 1, List_all_comb_b2_size - - coef = List_all_comb_b2_coef(i) - expo = List_all_comb_b2_expo(i) - - dx = x - List_all_comb_b2_cent(1,i) - dy = y - List_all_comb_b2_cent(2,i) - dz = z - List_all_comb_b2_cent(3,i) - - fact_r += coef * dexp(-expo * (dx*dx + dy*dy + dz*dz)) - enddo - - v_1b_list_b2(ipoint) = fact_r - enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, v_1b_list_b3, (n_points_final_grid)] - - implicit none - integer :: i, ipoint - double precision :: x, y, z, coef, expo, dx, dy, dz - double precision :: fact_r - - PROVIDE List_all_comb_b3_coef List_all_comb_b3_expo List_all_comb_b3_cent - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_r = 0.d0 - do i = 1, List_all_comb_b3_size - - coef = List_all_comb_b3_coef(i) - expo = List_all_comb_b3_expo(i) - - dx = x - List_all_comb_b3_cent(1,i) - dy = y - List_all_comb_b3_cent(2,i) - dz = z - List_all_comb_b3_cent(3,i) - - fact_r += coef * dexp(-expo * (dx*dx + dy*dy + dz*dz)) - enddo - - v_1b_list_b3(ipoint) = fact_r - enddo - -END_PROVIDER - -! --- - - BEGIN_PROVIDER [double precision, v_1b_square_grad, (n_points_final_grid,3)] -&BEGIN_PROVIDER [double precision, v_1b_square_lapl, (n_points_final_grid) ] + BEGIN_PROVIDER [double precision, env_square_grad, (n_points_final_grid,3)] +&BEGIN_PROVIDER [double precision, env_square_lapl, (n_points_final_grid) ] implicit none integer :: ipoint, i @@ -294,42 +174,51 @@ END_PROVIDER double precision :: coef, expo, a_expo, tmp double precision :: fact_x, fact_y, fact_z, fact_r - PROVIDE List_all_comb_b3_coef List_all_comb_b3_expo List_all_comb_b3_cent + PROVIDE List_env1s_square_coef List_env1s_square_expo List_env1s_square_cent - do ipoint = 1, n_points_final_grid + if((env_type .eq. "prod-gauss") .or. (env_type .eq. "sum-gauss")) then - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) + do ipoint = 1, n_points_final_grid - fact_x = 0.d0 - fact_y = 0.d0 - fact_z = 0.d0 - fact_r = 0.d0 - do i = 1, List_all_comb_b3_size + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) - coef = List_all_comb_b3_coef(i) - expo = List_all_comb_b3_expo(i) + fact_x = 0.d0 + fact_y = 0.d0 + fact_z = 0.d0 + fact_r = 0.d0 + do i = 1, List_env1s_square_size - dx = x - List_all_comb_b3_cent(1,i) - dy = y - List_all_comb_b3_cent(2,i) - dz = z - List_all_comb_b3_cent(3,i) - r2 = dx * dx + dy * dy + dz * dz + coef = List_env1s_square_coef(i) + expo = List_env1s_square_expo(i) - a_expo = expo * r2 - tmp = coef * expo * dexp(-a_expo) + dx = x - List_env1s_square_cent(1,i) + dy = y - List_env1s_square_cent(2,i) + dz = z - List_env1s_square_cent(3,i) + r2 = dx * dx + dy * dy + dz * dz - fact_x += tmp * dx - fact_y += tmp * dy - fact_z += tmp * dz - fact_r += tmp * (3.d0 - 2.d0 * a_expo) + a_expo = expo * r2 + tmp = coef * expo * dexp(-a_expo) + + fact_x += tmp * dx + fact_y += tmp * dy + fact_z += tmp * dz + fact_r += tmp * (3.d0 - 2.d0 * a_expo) + enddo + + env_square_grad(ipoint,1) = -2.d0 * fact_x + env_square_grad(ipoint,2) = -2.d0 * fact_y + env_square_grad(ipoint,3) = -2.d0 * fact_z + env_square_lapl(ipoint) = -2.d0 * fact_r enddo - v_1b_square_grad(ipoint,1) = -2.d0 * fact_x - v_1b_square_grad(ipoint,2) = -2.d0 * fact_y - v_1b_square_grad(ipoint,3) = -2.d0 * fact_z - v_1b_square_lapl(ipoint) = -2.d0 * fact_r - enddo + else + + print *, ' Error in env_val_square_grad & env_val_square_lapl: Unknown env_type = ', env_type + stop + + endif END_PROVIDER @@ -348,7 +237,7 @@ double precision function j12_mu_r12(r12) j12_mu_r12 = 0.5d0 * r12 * (1.d0 - derf(mu_r12)) - inv_sq_pi_2 * dexp(-mu_r12*mu_r12) / mu_erf return -end function j12_mu_r12 +end ! --- @@ -361,7 +250,7 @@ double precision function jmu_modif(r1, r2) jmu_modif = j12_mu(r1, r2) * j12_nucl(r1, r2) return -end function jmu_modif +end ! --- @@ -385,7 +274,7 @@ double precision function j12_mu_gauss(r1, r2) enddo return -end function j12_mu_gauss +end ! --- @@ -393,140 +282,138 @@ double precision function j12_nucl(r1, r2) implicit none double precision, intent(in) :: r1(3), r2(3) - double precision, external :: j1b_nucl + double precision, external :: env_nucl - j12_nucl = j1b_nucl(r1) * j1b_nucl(r2) + j12_nucl = env_nucl(r1) * env_nucl(r2) return -end function j12_nucl +end ! --- -! --------------------------------------------------------------------------------------- - -double precision function grad_x_j1b_nucl_num(r) +double precision function grad_x_env_nucl_num(r) implicit none double precision, intent(in) :: r(3) double precision :: r_eps(3), eps, fp, fm, delta - double precision, external :: j1b_nucl + double precision, external :: env_nucl eps = 1d-6 r_eps = r delta = max(eps, dabs(eps*r(1))) r_eps(1) = r_eps(1) + delta - fp = j1b_nucl(r_eps) + fp = env_nucl(r_eps) r_eps(1) = r_eps(1) - 2.d0 * delta - fm = j1b_nucl(r_eps) + fm = env_nucl(r_eps) - grad_x_j1b_nucl_num = 0.5d0 * (fp - fm) / delta + grad_x_env_nucl_num = 0.5d0 * (fp - fm) / delta return -end function grad_x_j1b_nucl_num +end -double precision function grad_y_j1b_nucl_num(r) +! --- + +double precision function grad_y_env_nucl_num(r) implicit none double precision, intent(in) :: r(3) double precision :: r_eps(3), eps, fp, fm, delta - double precision, external :: j1b_nucl + double precision, external :: env_nucl eps = 1d-6 r_eps = r delta = max(eps, dabs(eps*r(2))) r_eps(2) = r_eps(2) + delta - fp = j1b_nucl(r_eps) + fp = env_nucl(r_eps) r_eps(2) = r_eps(2) - 2.d0 * delta - fm = j1b_nucl(r_eps) + fm = env_nucl(r_eps) - grad_y_j1b_nucl_num = 0.5d0 * (fp - fm) / delta + grad_y_env_nucl_num = 0.5d0 * (fp - fm) / delta return -end function grad_y_j1b_nucl_num +end -double precision function grad_z_j1b_nucl_num(r) +! --- + +double precision function grad_z_env_nucl_num(r) implicit none double precision, intent(in) :: r(3) double precision :: r_eps(3), eps, fp, fm, delta - double precision, external :: j1b_nucl + double precision, external :: env_nucl eps = 1d-6 r_eps = r delta = max(eps, dabs(eps*r(3))) r_eps(3) = r_eps(3) + delta - fp = j1b_nucl(r_eps) + fp = env_nucl(r_eps) r_eps(3) = r_eps(3) - 2.d0 * delta - fm = j1b_nucl(r_eps) + fm = env_nucl(r_eps) - grad_z_j1b_nucl_num = 0.5d0 * (fp - fm) / delta + grad_z_env_nucl_num = 0.5d0 * (fp - fm) / delta return -end function grad_z_j1b_nucl_num - -! --------------------------------------------------------------------------------------- +end ! --- -double precision function lapl_j1b_nucl(r) +double precision function lapl_env_nucl(r) implicit none double precision, intent(in) :: r(3) double precision :: r_eps(3), eps, fp, fm, delta - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num eps = 1d-5 r_eps = r - lapl_j1b_nucl = 0.d0 + lapl_env_nucl = 0.d0 ! --- delta = max(eps, dabs(eps*r(1))) r_eps(1) = r_eps(1) + delta - fp = grad_x_j1b_nucl_num(r_eps) + fp = grad_x_env_nucl_num(r_eps) r_eps(1) = r_eps(1) - 2.d0 * delta - fm = grad_x_j1b_nucl_num(r_eps) + fm = grad_x_env_nucl_num(r_eps) r_eps(1) = r_eps(1) + delta - lapl_j1b_nucl += 0.5d0 * (fp - fm) / delta + lapl_env_nucl += 0.5d0 * (fp - fm) / delta ! --- delta = max(eps, dabs(eps*r(2))) r_eps(2) = r_eps(2) + delta - fp = grad_y_j1b_nucl_num(r_eps) + fp = grad_y_env_nucl_num(r_eps) r_eps(2) = r_eps(2) - 2.d0 * delta - fm = grad_y_j1b_nucl_num(r_eps) + fm = grad_y_env_nucl_num(r_eps) r_eps(2) = r_eps(2) + delta - lapl_j1b_nucl += 0.5d0 * (fp - fm) / delta + lapl_env_nucl += 0.5d0 * (fp - fm) / delta ! --- delta = max(eps, dabs(eps*r(3))) r_eps(3) = r_eps(3) + delta - fp = grad_z_j1b_nucl_num(r_eps) + fp = grad_z_env_nucl_num(r_eps) r_eps(3) = r_eps(3) - 2.d0 * delta - fm = grad_z_j1b_nucl_num(r_eps) + fm = grad_z_env_nucl_num(r_eps) r_eps(3) = r_eps(3) + delta - lapl_j1b_nucl += 0.5d0 * (fp - fm) / delta + lapl_env_nucl += 0.5d0 * (fp - fm) / delta ! --- return -end function lapl_j1b_nucl +end ! --- -! --------------------------------------------------------------------------------------- - double precision function grad1_x_jmu_modif(r1, r2) implicit none @@ -546,7 +433,9 @@ double precision function grad1_x_jmu_modif(r1, r2) grad1_x_jmu_modif = 0.5d0 * (fp - fm) / delta return -end function grad1_x_jmu_modif +end + +! --- double precision function grad1_y_jmu_modif(r1, r2) @@ -567,7 +456,9 @@ double precision function grad1_y_jmu_modif(r1, r2) grad1_y_jmu_modif = 0.5d0 * (fp - fm) / delta return -end function grad1_y_jmu_modif +end + +! --- double precision function grad1_z_jmu_modif(r1, r2) @@ -588,14 +479,10 @@ double precision function grad1_z_jmu_modif(r1, r2) grad1_z_jmu_modif = 0.5d0 * (fp - fm) / delta return -end function grad1_z_jmu_modif - -! --------------------------------------------------------------------------------------- +end ! --- -! --------------------------------------------------------------------------------------- - double precision function grad1_x_j12_mu_num(r1, r2) implicit none @@ -615,7 +502,9 @@ double precision function grad1_x_j12_mu_num(r1, r2) grad1_x_j12_mu_num = 0.5d0 * (fp - fm) / delta return -end function grad1_x_j12_mu_num +end + +! --- double precision function grad1_y_j12_mu_num(r1, r2) @@ -636,7 +525,9 @@ double precision function grad1_y_j12_mu_num(r1, r2) grad1_y_j12_mu_num = 0.5d0 * (fp - fm) / delta return -end function grad1_y_j12_mu_num +end + +! --- double precision function grad1_z_j12_mu_num(r1, r2) @@ -657,9 +548,9 @@ double precision function grad1_z_j12_mu_num(r1, r2) grad1_z_j12_mu_num = 0.5d0 * (fp - fm) / delta return -end function grad1_z_j12_mu_num +end -! --------------------------------------------------------------------------------------- +! --- subroutine grad1_jmu_modif_num(r1, r2, grad) @@ -671,103 +562,23 @@ subroutine grad1_jmu_modif_num(r1, r2, grad) double precision :: tmp0, tmp1, tmp2, grad_u12(3) double precision, external :: j12_mu - double precision, external :: j1b_nucl - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: env_nucl + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num call grad1_j12_mu(r1, r2, grad_u12) - tmp0 = j1b_nucl(r1) - tmp1 = j1b_nucl(r2) + tmp0 = env_nucl(r1) + tmp1 = env_nucl(r2) tmp2 = j12_mu(r1, r2) - grad(1) = (tmp0 * grad_u12(1) + tmp2 * grad_x_j1b_nucl_num(r1)) * tmp1 - grad(2) = (tmp0 * grad_u12(2) + tmp2 * grad_y_j1b_nucl_num(r1)) * tmp1 - grad(3) = (tmp0 * grad_u12(3) + tmp2 * grad_z_j1b_nucl_num(r1)) * tmp1 + grad(1) = (tmp0 * grad_u12(1) + tmp2 * grad_x_env_nucl_num(r1)) * tmp1 + grad(2) = (tmp0 * grad_u12(2) + tmp2 * grad_y_env_nucl_num(r1)) * tmp1 + grad(3) = (tmp0 * grad_u12(3) + tmp2 * grad_z_env_nucl_num(r1)) * tmp1 return -end subroutine grad1_jmu_modif_num +end ! --- -subroutine get_tchint_rsdft_jastrow(x, y, dj) - - implicit none - double precision, intent(in) :: x(3), y(3) - double precision, intent(out) :: dj(3) - integer :: at - double precision :: a, mu_tmp, inv_sq_pi_2 - double precision :: tmp_x, tmp_y, tmp_z, tmp - double precision :: dx2, dy2, pos(3), dxy, dxy2 - double precision :: v1b_x, v1b_y - double precision :: u2b, grad1_u2b(3), grad1_v1b(3) - - PROVIDE mu_erf - - inv_sq_pi_2 = 0.5d0 / dsqrt(dacos(-1.d0)) - - dj = 0.d0 - -! double precision, external :: j12_mu, j1b_nucl -! v1b_x = j1b_nucl(x) -! v1b_y = j1b_nucl(y) -! call grad1_j1b_nucl(x, grad1_v1b) -! u2b = j12_mu(x, y) -! call grad1_j12_mu(x, y, grad1_u2b) - - ! 1b terms - v1b_x = 1.d0 - v1b_y = 1.d0 - tmp_x = 0.d0 - tmp_y = 0.d0 - tmp_z = 0.d0 - do at = 1, nucl_num - - a = j1b_pen(at) - pos(1) = nucl_coord(at,1) - pos(2) = nucl_coord(at,2) - pos(3) = nucl_coord(at,3) - - dx2 = sum((x-pos)**2) - dy2 = sum((y-pos)**2) - tmp = dexp(-a*dx2) * a - - v1b_x = v1b_x - dexp(-a*dx2) - v1b_y = v1b_y - dexp(-a*dy2) - - tmp_x = tmp_x + tmp * (x(1) - pos(1)) - tmp_y = tmp_y + tmp * (x(2) - pos(2)) - tmp_z = tmp_z + tmp * (x(3) - pos(3)) - end do - grad1_v1b(1) = 2.d0 * tmp_x - grad1_v1b(2) = 2.d0 * tmp_y - grad1_v1b(3) = 2.d0 * tmp_z - - ! 2b terms - dxy2 = sum((x-y)**2) - dxy = dsqrt(dxy2) - mu_tmp = mu_erf * dxy - u2b = 0.5d0 * dxy * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf - - if(dxy .lt. 1d-8) then - grad1_u2b(1) = 0.d0 - grad1_u2b(2) = 0.d0 - grad1_u2b(3) = 0.d0 - else - tmp = 0.5d0 * (1.d0 - derf(mu_tmp)) / dxy - grad1_u2b(1) = tmp * (x(1) - y(1)) - grad1_u2b(2) = tmp * (x(2) - y(2)) - grad1_u2b(3) = tmp * (x(3) - y(3)) - endif - - dj(1) = (grad1_u2b(1) * v1b_x + u2b * grad1_v1b(1)) * v1b_y - dj(2) = (grad1_u2b(2) * v1b_x + u2b * grad1_v1b(2)) * v1b_y - dj(3) = (grad1_u2b(3) * v1b_x + u2b * grad1_v1b(3)) * v1b_y - - return -end subroutine get_tchint_rsdft_jastrow - -! --- - - diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f new file mode 100644 index 00000000..4894f30b --- /dev/null +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -0,0 +1,123 @@ + +! --- + +BEGIN_PROVIDER [double precision, j1e_val, (n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, p + double precision :: x, y, z, dx, dy, dz, d2 + double precision :: a, c, tmp + + if(j1e_type .eq. "none") then + + j1e_val = 0.d0 + + elseif(j1e_type .eq. "gauss") then + + ! \sum_{A} \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) + + PROVIDE j1e_size j1e_coef j1e_expo + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + tmp = 0.d0 + do j = 1, nucl_num + + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + d2 = dx*dx + dy*dy + dz*dz + + do p = 1, j1e_size + + c = j1e_coef(p,j) + a = j1e_expo(p,j) + + tmp = tmp + c * dexp(-a*d2) + enddo + enddo + + j1e_val(ipoint) = tmp + enddo + + else + + print *, ' Error: Unknown j1e_type = ', j1e_type + stop + + endif + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, j1e_dx, (n_points_final_grid)] +&BEGIN_PROVIDER [double precision, j1e_dy, (n_points_final_grid)] +&BEGIN_PROVIDER [double precision, j1e_dz, (n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, p + double precision :: x, y, z, dx, dy, dz, d2 + double precision :: a, c, g, tmp_x, tmp_y, tmp_z + + if(j1e_type .eq. "none") then + + j1e_dx = 0.d0 + j1e_dy = 0.d0 + j1e_dz = 0.d0 + + elseif(j1e_type .eq. "gauss") then + + ! - \sum_{A} (r - R_A) \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) + + PROVIDE j1e_size j1e_coef j1e_expo + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + tmp_x = 0.d0 + tmp_y = 0.d0 + tmp_z = 0.d0 + do j = 1, nucl_num + + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + d2 = dx*dx + dy*dy + dz*dz + + do p = 1, j1e_size + + c = j1e_coef(p,j) + a = j1e_expo(p,j) + g = c * a * dexp(-a*d2) + + tmp_x = tmp_x - g * dx + tmp_y = tmp_y - g * dy + tmp_z = tmp_z - g * dz + enddo + enddo + + j1e_dx(ipoint) = tmp_x + j1e_dy(ipoint) = tmp_y + j1e_dz(ipoint) = tmp_z + enddo + + else + + print *, ' Error: Unknown j1e_type = ', j1e_type + stop + + endif + +END_PROVIDER + +! --- + + diff --git a/plugins/local/non_h_ints_mu/jast_deriv.irp.f b/plugins/local/non_h_ints_mu/jast_deriv.irp.f index 851e9d35..a097dec8 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv.irp.f @@ -1,33 +1,27 @@ ! --- - BEGIN_PROVIDER [ double precision, grad1_u12_num, (n_points_extra_final_grid, n_points_final_grid, 3)] -&BEGIN_PROVIDER [ double precision, grad1_u12_squared_num, (n_points_extra_final_grid, n_points_final_grid)] + BEGIN_PROVIDER [double precision, grad1_u12_num, (n_points_extra_final_grid, n_points_final_grid, 3)] +&BEGIN_PROVIDER [double precision, grad1_u12_squared_num, (n_points_extra_final_grid, n_points_final_grid)] BEGIN_DOC ! + ! ! grad_1 u(r1,r2) - ! - ! this will be integrated numerically over r2: - ! we use grid for r1 and extra_grid for r2 - ! - ! for 99 < j1b_type < 199 - ! - ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) - ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) + ! numerical integration over r1 & r2 ! END_DOC implicit none integer :: ipoint, jpoint double precision :: r1(3), r2(3) - double precision :: v1b_r1, v1b_r2, u2b_r12 - double precision :: grad1_v1b(3), grad1_u2b(3) + double precision :: v_r1, v_r2, u2b_r12 + double precision :: grad1_v(3), grad1_u2b(3) double precision :: dx, dy, dz double precision :: time0, time1 - double precision, external :: j12_mu, j1b_nucl + double precision, external :: j12_mu, env_nucl - PROVIDE j1b_type + PROVIDE env_type PROVIDE final_grid_points_extra print*, ' providing grad1_u12_num & grad1_u12_squared_num ...' @@ -36,12 +30,12 @@ grad1_u12_num = 0.d0 grad1_u12_squared_num = 0.d0 - if( (j1b_type .eq. 100) .or. & - (j1b_type .ge. 200) .and. (j1b_type .lt. 300) ) then + if( ((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) .or. & + (j2e_type .eq. "rs-dft-murho") ) then !$OMP PARALLEL & !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, jpoint, r1, r2, v1b_r1, v1b_r2, u2b_r12, grad1_v1b, grad1_u2b, dx, dy, dz) & + !$OMP PRIVATE (ipoint, jpoint, r1, r2, v_r1, v_r2, u2b_r12, grad1_v, grad1_u2b, dx, dy, dz) & !$OMP SHARED (n_points_final_grid, n_points_extra_final_grid, final_grid_points, & !$OMP final_grid_points_extra, grad1_u12_num, grad1_u12_squared_num) !$OMP DO SCHEDULE (static) @@ -73,14 +67,14 @@ !$OMP END DO !$OMP END PARALLEL - elseif((j1b_type .gt. 100) .and. (j1b_type .lt. 200)) then + elseif((j2e_type .eq. "rs-dft") .and. (env_type .ne. "none")) then PROVIDE final_grid_points - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, jpoint, r1, r2, v1b_r1, v1b_r2, u2b_r12, grad1_v1b, grad1_u2b, dx, dy, dz) & - !$OMP SHARED (n_points_final_grid, n_points_extra_final_grid, final_grid_points, & + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, jpoint, r1, r2, v_r1, v_r2, u2b_r12, grad1_v, grad1_u2b, dx, dy, dz) & + !$OMP SHARED (n_points_final_grid, n_points_extra_final_grid, final_grid_points, & !$OMP final_grid_points_extra, grad1_u12_num, grad1_u12_squared_num) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid ! r1 @@ -89,8 +83,8 @@ r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - v1b_r1 = j1b_nucl(r1) - call grad1_j1b_nucl(r1, grad1_v1b) + v_r1 = env_nucl(r1) + call grad1_env_nucl(r1, grad1_v) do jpoint = 1, n_points_extra_final_grid ! r2 @@ -98,13 +92,13 @@ r2(2) = final_grid_points_extra(2,jpoint) r2(3) = final_grid_points_extra(3,jpoint) - v1b_r2 = j1b_nucl(r2) + v_r2 = env_nucl(r2) u2b_r12 = j12_mu(r1, r2) call grad1_j12_mu(r2, r1, grad1_u2b) - dx = (grad1_u2b(1) * v1b_r1 + u2b_r12 * grad1_v1b(1)) * v1b_r2 - dy = (grad1_u2b(2) * v1b_r1 + u2b_r12 * grad1_v1b(2)) * v1b_r2 - dz = (grad1_u2b(3) * v1b_r1 + u2b_r12 * grad1_v1b(3)) * v1b_r2 + dx = (grad1_u2b(1) * v_r1 + u2b_r12 * grad1_v(1)) * v_r2 + dy = (grad1_u2b(2) * v_r1 + u2b_r12 * grad1_v(2)) * v_r2 + dz = (grad1_u2b(3) * v_r1 + u2b_r12 * grad1_v(3)) * v_r2 grad1_u12_num(jpoint,ipoint,1) = dx grad1_u12_num(jpoint,ipoint,2) = dy @@ -116,7 +110,7 @@ !$OMP END DO !$OMP END PARALLEL - elseif (j1b_type .eq. 1000) then + elseif(j2e_type .eq. "champ") then double precision :: f f = 1.d0 / dble(elec_num - 1) @@ -227,13 +221,13 @@ else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + print *, ' Error in grad1_u12_num & grad1_u12_squared_num: Unknown Jastrow' stop - endif + endif ! j2e_type call wall_time(time1) - print*, ' Wall time for grad1_u12_num & grad1_u12_squared_num (min) =', (time1-time0)/60.d0 + print*, ' Wall time for grad1_u12_num & grad1_u12_squared_num (min) = ', (time1-time0)/60.d0 END_PROVIDER diff --git a/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f index 745d00ad..9b5e9fe8 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f @@ -9,7 +9,7 @@ double precision function j12_mu(r1, r2) double precision, intent(in) :: r1(3), r2(3) double precision :: mu_tmp, r12 - if((j1b_type .ge. 0) .and. (j1b_type .lt. 200)) then + if(j2e_type .eq. "rs-dft") then r12 = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & + (r1(2) - r2(2)) * (r1(2) - r2(2)) & @@ -20,13 +20,13 @@ double precision function j12_mu(r1, r2) else - print *, ' j1b_type = ', j1b_type, 'not implemented for j12_mu' + print *, ' Error in j12_mu: Unknown j2e_type = ', j2e_type stop - endif + endif ! j2e_type return -end function j12_mu +end ! --- @@ -36,11 +36,11 @@ subroutine grad1_j12_mu(r1, r2, grad) ! ! gradient of j(mu(r1,r2),r12) form of jastrow. ! - ! if mu(r1,r2) = cst ---> j1b_type < 200 and + ! if mu(r1,r2) = cst ---> ! ! d/dx1 j(mu,r12) = 0.5 * (1 - erf(mu *r12))/r12 * (x1 - x2) ! - ! if mu(r1,r2) /= cst ---> 200 < j1b_type < 300 and + ! if mu(r1,r2) /= cst ---> ! ! d/dx1 j(mu(r1,r2),r12) = exp(-(mu(r1,r2)*r12)**2) /(2 *sqrt(pi) * mu(r1,r2)**2 ) d/dx1 mu(r1,r2) ! + 0.5 * (1 - erf(mu(r1,r2) *r12))/r12 * (x1 - x2) @@ -53,10 +53,11 @@ subroutine grad1_j12_mu(r1, r2, grad) double precision, intent(in) :: r1(3), r2(3) double precision, intent(out) :: grad(3) double precision :: dx, dy, dz, r12, tmp + double precision :: mu_val, mu_tmp, mu_der(3) grad = 0.d0 - if((j1b_type .ge. 0) .and. (j1b_type .lt. 200)) then + if(j2e_type .eq. "rs-dft") then dx = r1(1) - r2(1) dy = r1(2) - r2(2) @@ -71,9 +72,7 @@ subroutine grad1_j12_mu(r1, r2, grad) grad(2) = tmp * dy grad(3) = tmp * dz - elseif((j1b_type .ge. 200) .and. (j1b_type .lt. 300)) then - - double precision :: mu_val, mu_tmp, mu_der(3) + elseif(j2e_type .eq. "rs-dft-murho") then dx = r1(1) - r2(1) dy = r1(2) - r2(2) @@ -95,152 +94,153 @@ subroutine grad1_j12_mu(r1, r2, grad) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + print *, ' Error in grad1_j12_mu: Unknown j2e_type = ', j2e_type stop - endif + endif ! j2e_type + grad = -grad return -end subroutine grad1_j12_mu +end ! --- -double precision function j1b_nucl(r) +double precision function env_nucl(r) implicit none double precision, intent(in) :: r(3) integer :: i double precision :: a, d, e, x, y, z - if((j1b_type .eq. 2) .or. (j1b_type .eq. 102)) then + if(env_type .eq. "sum-slat") then - j1b_nucl = 1.d0 + env_nucl = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - j1b_nucl = j1b_nucl - dexp(-a*dsqrt(d)) + env_nucl = env_nucl - env_coef(i) * dexp(-a*dsqrt(d)) enddo - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + elseif(env_type .eq. "prod-gauss") then - j1b_nucl = 1.d0 + env_nucl = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) e = 1.d0 - dexp(-a*d) - j1b_nucl = j1b_nucl * e + env_nucl = env_nucl * e enddo - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "sum-gauss") then - j1b_nucl = 1.d0 + env_nucl = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - j1b_nucl = j1b_nucl - j1b_pen_coef(i) * dexp(-a*d) + env_nucl = env_nucl - env_coef(i) * dexp(-a*d) enddo - elseif((j1b_type .eq. 5) .or. (j1b_type .eq. 105)) then + elseif(env_type .eq. "sum-quartic") then - j1b_nucl = 1.d0 + env_nucl = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - j1b_nucl = j1b_nucl - dexp(-a*d*d) + env_nucl = env_nucl - env_coef(i) * dexp(-a*d*d) enddo else - print *, ' j1b_type = ', j1b_type, 'not implemented for j1b_nucl' + print *, ' Error in grad1_env_nucl: Unknown env_type = ', env_type stop endif return -end function j1b_nucl +end ! --- -double precision function j1b_nucl_square(r) +double precision function env_nucl_square(r) implicit none double precision, intent(in) :: r(3) integer :: i double precision :: a, d, e, x, y, z - if((j1b_type .eq. 2) .or. (j1b_type .eq. 102)) then + if(env_type .eq. "sum-slat") then - j1b_nucl_square = 1.d0 + env_nucl_square = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - j1b_nucl_square = j1b_nucl_square - dexp(-a*dsqrt(d)) + env_nucl_square = env_nucl_square - env_coef(i) * dexp(-a*dsqrt(d)) enddo - j1b_nucl_square = j1b_nucl_square * j1b_nucl_square + env_nucl_square = env_nucl_square * env_nucl_square - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + elseif(env_type .eq. "prod-gauss") then - j1b_nucl_square = 1.d0 + env_nucl_square = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) e = 1.d0 - dexp(-a*d) - j1b_nucl_square = j1b_nucl_square * e + env_nucl_square = env_nucl_square * e enddo - j1b_nucl_square = j1b_nucl_square * j1b_nucl_square + env_nucl_square = env_nucl_square * env_nucl_square - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "sum-gauss") then - j1b_nucl_square = 1.d0 + env_nucl_square = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - j1b_nucl_square = j1b_nucl_square - j1b_pen_coef(i) * dexp(-a*d) + env_nucl_square = env_nucl_square - env_coef(i) * dexp(-a*d) enddo - j1b_nucl_square = j1b_nucl_square * j1b_nucl_square + env_nucl_square = env_nucl_square * env_nucl_square - elseif((j1b_type .eq. 5) .or. (j1b_type .eq. 105)) then + elseif(env_type .eq. "sum-quartic") then - j1b_nucl_square = 1.d0 + env_nucl_square = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - j1b_nucl_square = j1b_nucl_square - dexp(-a*d*d) + env_nucl_square = env_nucl_square - env_coef(i) * dexp(-a*d*d) enddo - j1b_nucl_square = j1b_nucl_square * j1b_nucl_square + env_nucl_square = env_nucl_square * env_nucl_square else - print *, ' j1b_type = ', j1b_type, 'not implemented for j1b_nucl_square' + print *, ' Error in grad1_env_nucl: Unknown env_type = ', env_type stop endif return -end function j1b_nucl_square +end ! --- -subroutine grad1_j1b_nucl(r, grad) +subroutine grad1_env_nucl(r, grad) implicit none double precision, intent(in) :: r(3) @@ -251,18 +251,18 @@ subroutine grad1_j1b_nucl(r, grad) double precision :: fact_x, fact_y, fact_z double precision :: ax_der, ay_der, az_der, a_expo - if((j1b_type .eq. 2) .or. (j1b_type .eq. 102)) then + if(env_type .eq. "sum-slat") then fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = dsqrt(x*x + y*y + z*z) - e = a * dexp(-a*d) / d + e = a * env_coef(i) * dexp(-a*d) / d fact_x += e * x fact_y += e * y @@ -273,7 +273,7 @@ subroutine grad1_j1b_nucl(r, grad) grad(2) = fact_y grad(3) = fact_z - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + elseif(env_type .eq. "prod-gauss") then x = r(1) y = r(2) @@ -282,7 +282,7 @@ subroutine grad1_j1b_nucl(r, grad) fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 - do i = 1, List_all_comb_b2_size + do i = 1, List_env1s_size phase = 0 a_expo = 0.d0 @@ -290,12 +290,12 @@ subroutine grad1_j1b_nucl(r, grad) ay_der = 0.d0 az_der = 0.d0 do j = 1, nucl_num - a = dble(List_all_comb_b2(j,i)) * j1b_pen(j) + a = dble(List_env1s(j,i)) * env_expo(j) dx = x - nucl_coord(j,1) dy = y - nucl_coord(j,2) dz = z - nucl_coord(j,3) - phase += List_all_comb_b2(j,i) + phase += List_env1s(j,i) a_expo += a * (dx*dx + dy*dy + dz*dz) ax_der += a * dx ay_der += a * dy @@ -312,18 +312,18 @@ subroutine grad1_j1b_nucl(r, grad) grad(2) = fact_y grad(3) = fact_z - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "sum-gauss") then fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - e = a * j1b_pen_coef(i) * dexp(-a*d) + e = a * env_coef(i) * dexp(-a*d) fact_x += e * x fact_y += e * y @@ -334,18 +334,18 @@ subroutine grad1_j1b_nucl(r, grad) grad(2) = 2.d0 * fact_y grad(3) = 2.d0 * fact_z - elseif((j1b_type .eq. 5) .or. (j1b_type .eq. 105)) then + elseif(env_type .eq. "sum-quartic") then fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - e = a * d * dexp(-a*d*d) + e = a * env_coef(i) * d * dexp(-a*d*d) fact_x += e * x fact_y += e * y @@ -358,13 +358,13 @@ subroutine grad1_j1b_nucl(r, grad) else - print *, ' j1b_type = ', j1b_type, 'not implemented for grad1_j1b_nucl' + print *, ' Error in grad1_env_nucl: Unknown env_type = ', env_type stop endif return -end subroutine grad1_j1b_nucl +end ! --- @@ -380,7 +380,10 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) double precision :: f_rho1, f_rho2, d_drho_f_rho1 double precision :: d_dx1_f_rho1(3),d_dx_rho_f_rho(3),nume - if(j1b_type .eq. 200) then + PROVIDE murho_type + PROVIDE mu_r_ct mu_erf + + if(murho_type .eq. 1) then ! ! r = 0.5 (r1 + r2) @@ -391,8 +394,6 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) ! d mu[rho(r)] / dx = [0.5 alpha / sqrt(rho) - mu0 exp(-rho)] (d rho(r) / dx) ! - PROVIDE mu_r_ct mu_erf - r(1) = 0.5d0 * (r1(1) + r2(1)) r(2) = 0.5d0 * (r1(2) + r2(2)) r(3) = 0.5d0 * (r1(3) + r2(3)) @@ -413,7 +414,7 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) mu_der(2) = tmp3 * (grad_dm_a(2,1) + grad_dm_b(2,1)) mu_der(3) = tmp3 * (grad_dm_a(3,1) + grad_dm_b(3,1)) - elseif(j1b_type .eq. 201) then + elseif(murho_type .eq. 2) then ! ! r = 0.5 (r1 + r2) @@ -424,8 +425,6 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) ! d mu[rho(r)] / dx = [0.5 alpha / sqrt(rho) - mu0 exp(-rho)] (d rho(r) / dx) ! - PROVIDE mu_r_ct mu_erf - r(1) = 0.5d0 * (r1(1) + r2(1)) r(2) = 0.5d0 * (r1(2) + r2(2)) r(3) = 0.5d0 * (r1(3) + r2(3)) @@ -442,7 +441,7 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) mu_der(2) = tmp3 * (grad_dm_a(2,1) + grad_dm_b(2,1)) mu_der(3) = tmp3 * (grad_dm_a(3,1) + grad_dm_b(3,1)) - elseif(j1b_type .eq. 202) then + elseif(murho_type .eq. 3) then ! mu(r1,r2) = {rho(r1) f[rho(r1)] + rho(r2) f[rho(r2)]} / RHO ! @@ -469,7 +468,8 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) nume = rho1 * f_rho1 + rho2 * f_rho2 mu_val = nume * inv_rho_tot mu_der(1:3) = inv_rho_tot*inv_rho_tot * (rho_tot * d_dx_rho_f_rho(1:3) - grad_rho1(1:3) * nume) - elseif(j1b_type .eq. 203) then + + elseif(murho_type .eq. 4) then ! mu(r1,r2) = {rho(r1) f[rho(r1)] + rho(r2) f[rho(r2)]} / RHO ! @@ -503,7 +503,8 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) nume = rho1 * f_rho1 + rho2 * f_rho2 mu_val = nume * inv_rho_tot mu_der(1:3) = inv_rho_tot*inv_rho_tot * (rho_tot * d_dx_rho_f_rho(1:3) - grad_rho1(1:3) * nume) - elseif(j1b_type .eq. 204) then + + elseif(murho_type .eq. 5) then ! mu(r1,r2) = 1/2 * (f[rho(r1)] + f[rho(r2)]} ! @@ -535,23 +536,24 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) mu_der(1:3) = inv_rho_tot*inv_rho_tot * (rho_tot * d_dx_rho_f_rho(1:3) - grad_rho1(1:3) * nume) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + + print *, ' Error in mu_r_val_and_grad: Unknown env_type = ', env_type stop endif return -end subroutine mu_r_val_and_grad +end ! --- -subroutine grad1_j1b_nucl_square_num(r1, grad) +subroutine grad1_env_nucl_square_num(r1, grad) implicit none double precision, intent(in) :: r1(3) double precision, intent(out) :: grad(3) double precision :: r(3), eps, tmp_eps, vp, vm - double precision, external :: j1b_nucl_square + double precision, external :: env_nucl_square eps = 1d-5 tmp_eps = 0.5d0 / eps @@ -559,28 +561,28 @@ subroutine grad1_j1b_nucl_square_num(r1, grad) r(1:3) = r1(1:3) r(1) = r(1) + eps - vp = j1b_nucl_square(r) + vp = env_nucl_square(r) r(1) = r(1) - 2.d0 * eps - vm = j1b_nucl_square(r) + vm = env_nucl_square(r) r(1) = r(1) + eps grad(1) = tmp_eps * (vp - vm) r(2) = r(2) + eps - vp = j1b_nucl_square(r) + vp = env_nucl_square(r) r(2) = r(2) - 2.d0 * eps - vm = j1b_nucl_square(r) + vm = env_nucl_square(r) r(2) = r(2) + eps grad(2) = tmp_eps * (vp - vm) r(3) = r(3) + eps - vp = j1b_nucl_square(r) + vp = env_nucl_square(r) r(3) = r(3) - 2.d0 * eps - vm = j1b_nucl_square(r) + vm = env_nucl_square(r) r(3) = r(3) + eps grad(3) = tmp_eps * (vp - vm) return -end subroutine grad1_j1b_nucl_square_num +end ! --- @@ -622,7 +624,7 @@ subroutine grad1_j12_mu_square_num(r1, r2, grad) grad(3) = tmp_eps * (vp - vm) return -end subroutine grad1_j12_mu_square_num +end ! --- @@ -635,134 +637,172 @@ double precision function j12_mu_square(r1, r2) j12_mu_square = j12_mu(r1, r2) * j12_mu(r1, r2) return -end function j12_mu_square +end ! --- -subroutine f_mu_and_deriv_mu(rho,alpha,mu0,beta,f_mu,d_drho_f_mu) - implicit none - BEGIN_DOC -! function giving mu as a function of rho -! -! f_mu = alpha * rho**beta + mu0 * exp(-rho) -! -! and its derivative with respect to rho d_drho_f_mu - END_DOC - double precision, intent(in) :: rho,alpha,mu0,beta - double precision, intent(out) :: f_mu,d_drho_f_mu - f_mu = alpha * (rho)**beta + mu0 * dexp(-rho) - d_drho_f_mu = alpha * beta * rho**(beta-1.d0) - mu0 * dexp(-rho) +subroutine f_mu_and_deriv_mu(rho, alpha, mu0, beta, f_mu, d_drho_f_mu) + + BEGIN_DOC + ! function giving mu as a function of rho + ! + ! f_mu = alpha * rho**beta + mu0 * exp(-rho) + ! + ! and its derivative with respect to rho d_drho_f_mu + END_DOC + + implicit none + double precision, intent(in) :: rho, alpha, mu0, beta + double precision, intent(out) :: f_mu, d_drho_f_mu + + f_mu = alpha * (rho)**beta + mu0 * dexp(-rho) + d_drho_f_mu = alpha * beta * rho**(beta-1.d0) - mu0 * dexp(-rho) end +! --- + +subroutine get_all_rho_grad_rho(r1, r2, rho1, rho2, grad_rho1) + + BEGIN_DOC + ! returns the density in r1,r2 and grad_rho at r1 + END_DOC + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision, intent(out) :: grad_rho1(3), rho1, rho2 + double precision :: dm_a(1), dm_b(1), grad_dm_a(3,1), grad_dm_b(3,1) + + call density_and_grad_alpha_beta(r1, dm_a, dm_b, grad_dm_a, grad_dm_b) + rho1 = dm_a(1) + dm_b(1) + grad_rho1(1:3) = grad_dm_a(1:3,1) + grad_dm_b(1:3,1) + call density_and_grad_alpha_beta(r2, dm_a, dm_b, grad_dm_a, grad_dm_b) + rho2 = dm_a(1) + dm_b(1) -subroutine get_all_rho_grad_rho(r1,r2,rho1,rho2,grad_rho1) - implicit none - BEGIN_DOC -! returns the density in r1,r2 and grad_rho at r1 - END_DOC - double precision, intent(in) :: r1(3),r2(3) - double precision, intent(out):: grad_rho1(3),rho1,rho2 - double precision :: dm_a(1), dm_b(1), grad_dm_a(3,1), grad_dm_b(3,1) - call density_and_grad_alpha_beta(r1, dm_a, dm_b, grad_dm_a, grad_dm_b) - rho1 = dm_a(1) + dm_b(1) - grad_rho1(1:3) = grad_dm_a(1:3,1) + grad_dm_b(1:3,1) - call density_and_grad_alpha_beta(r2, dm_a, dm_b, grad_dm_a, grad_dm_b) - rho2 = dm_a(1) + dm_b(1) end -subroutine get_all_f_rho(rho1,rho2,alpha,mu0,beta,f_rho1,d_drho_f_rho1,f_rho2) - implicit none - BEGIN_DOC -! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) - END_DOC - double precision, intent(in) :: rho1,rho2,alpha,mu0,beta - double precision, intent(out):: f_rho1,d_drho_f_rho1,f_rho2 - double precision :: tmp - call f_mu_and_deriv_mu(rho1,alpha,mu0,beta,f_rho1,d_drho_f_rho1) - call f_mu_and_deriv_mu(rho2,alpha,mu0,beta,f_rho2,tmp) +! --- + +subroutine get_all_f_rho(rho1, rho2, alpha, mu0, beta, f_rho1, d_drho_f_rho1, f_rho2) + + BEGIN_DOC + ! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) + END_DOC + + implicit none + double precision, intent(in) :: rho1, rho2, alpha, mu0, beta + double precision, intent(out) :: f_rho1, d_drho_f_rho1, f_rho2 + double precision :: tmp + + call f_mu_and_deriv_mu(rho1, alpha, mu0, beta, f_rho1, d_drho_f_rho1) + call f_mu_and_deriv_mu(rho2, alpha, mu0, beta, f_rho2, tmp) + end +! --- subroutine get_all_f_rho_simple(rho1,rho2,alpha,mu0,beta,f_rho1,d_drho_f_rho1,f_rho2) - implicit none - BEGIN_DOC -! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) - END_DOC - double precision, intent(in) :: rho1,rho2,alpha,mu0,beta - double precision, intent(out):: f_rho1,d_drho_f_rho1,f_rho2 - double precision :: tmp - if(rho1.lt.1.d-10)then - f_rho1 = 0.d0 - d_drho_f_rho1 = 0.d0 - else - call f_mu_and_deriv_mu_simple(rho1,alpha,mu0,beta,f_rho1,d_drho_f_rho1) - endif - if(rho2.lt.1.d-10)then - f_rho2 = 0.d0 - else - call f_mu_and_deriv_mu_simple(rho2,alpha,mu0,beta,f_rho2,tmp) - endif + + BEGIN_DOC + ! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) + END_DOC + + implicit none + double precision, intent(in) :: rho1, rho2, alpha, mu0, beta + double precision, intent(out) :: f_rho1, d_drho_f_rho1, f_rho2 + double precision :: tmp + + if(rho1.lt.1.d-10) then + f_rho1 = 0.d0 + d_drho_f_rho1 = 0.d0 + else + call f_mu_and_deriv_mu_simple(rho1, alpha, mu0, beta, f_rho1, d_drho_f_rho1) + endif + + if(rho2.lt.1.d-10)then + f_rho2 = 0.d0 + else + call f_mu_and_deriv_mu_simple(rho2, alpha, mu0, beta, f_rho2, tmp) + endif + end -subroutine f_mu_and_deriv_mu_simple(rho,alpha,mu0,beta,f_mu,d_drho_f_mu) - implicit none - BEGIN_DOC -! function giving mu as a function of rho -! -! f_mu = alpha * rho**beta + mu0 -! -! and its derivative with respect to rho d_drho_f_mu - END_DOC - double precision, intent(in) :: rho,alpha,mu0,beta - double precision, intent(out) :: f_mu,d_drho_f_mu - f_mu = alpha**beta * (rho)**beta + mu0 - d_drho_f_mu = alpha**beta * beta * rho**(beta-1.d0) +! --- + +subroutine f_mu_and_deriv_mu_simple(rho, alpha, mu0, beta, f_mu, d_drho_f_mu) + + BEGIN_DOC + ! function giving mu as a function of rho + ! + ! f_mu = alpha * rho**beta + mu0 + ! + ! and its derivative with respect to rho d_drho_f_mu + END_DOC + + implicit none + double precision, intent(in) :: rho, alpha, mu0, beta + double precision, intent(out) :: f_mu, d_drho_f_mu + + f_mu = alpha**beta * (rho)**beta + mu0 + d_drho_f_mu = alpha**beta * beta * rho**(beta-1.d0) end ! --- subroutine f_mu_and_deriv_mu_erf(rho,alpha,zeta,mu0,beta,f_mu,d_drho_f_mu) - implicit none + include 'constants.include.F' - BEGIN_DOC -! function giving mu as a function of rho -! -! f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) -! -! and its derivative with respect to rho d_drho_f_mu -! -! d_drho_f_mu = 2 beta/sqrt(pi) * exp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) -! + alpha * zeta * (alpha *rho)**(zeta-1) * erf(beta*rho) - END_DOC - double precision, intent(in) :: rho,alpha,mu0,beta,zeta - double precision, intent(out) :: f_mu,d_drho_f_mu - f_mu = (alpha * rho)**zeta * derf(beta * rho) + mu0 * (1.d0 - derf(beta*rho)) - d_drho_f_mu = 2.d0 * beta * inv_sq_pi * dexp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) & - + alpha * zeta * (alpha *rho)**(zeta-1) * derf(beta*rho) + + BEGIN_DOC + ! function giving mu as a function of rho + ! + ! f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) + ! + ! and its derivative with respect to rho d_drho_f_mu + ! + ! d_drho_f_mu = 2 beta/sqrt(pi) * exp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) + ! + alpha * zeta * (alpha *rho)**(zeta-1) * erf(beta*rho) + END_DOC + + implicit none + double precision, intent(in) :: rho, alpha, mu0, beta, zeta + double precision, intent(out) :: f_mu, d_drho_f_mu + + f_mu = (alpha * rho)**zeta * derf(beta * rho) + mu0 * (1.d0 - derf(beta*rho)) + d_drho_f_mu = 2.d0 * beta * inv_sq_pi * dexp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) & + + alpha * zeta * (alpha *rho)**(zeta-1) * derf(beta*rho) end +! --- + +subroutine get_all_f_rho_erf(rho1, rho2, alpha, zeta, mu0, beta, f_rho1, d_drho_f_rho1, f_rho2) + + BEGIN_DOC + ! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) + ! with f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) + END_DOC + + implicit none + double precision, intent(in) :: rho1, rho2, alpha, mu0, beta, zeta + double precision, intent(out) :: f_rho1, d_drho_f_rho1, f_rho2 + double precision :: tmp + + if(rho1 .lt. 1.d-10) then + f_rho1 = mu_erf + d_drho_f_rho1 = 0.d0 + else + call f_mu_and_deriv_mu_erf(rho1, alpha, zeta, mu0, beta, f_rho1, d_drho_f_rho1) + endif + + if(rho2 .lt. 1.d-10)then + f_rho2 = mu_erf + else + call f_mu_and_deriv_mu_erf(rho2, alpha, zeta, mu0, beta, f_rho2, tmp) + endif -subroutine get_all_f_rho_erf(rho1,rho2,alpha,zeta,mu0,beta,f_rho1,d_drho_f_rho1,f_rho2) - implicit none - BEGIN_DOC -! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) -! with f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) - END_DOC - double precision, intent(in) :: rho1,rho2,alpha,mu0,beta,zeta - double precision, intent(out):: f_rho1,d_drho_f_rho1,f_rho2 - double precision :: tmp - if(rho1.lt.1.d-10)then - f_rho1 = mu_erf - d_drho_f_rho1 = 0.d0 - else - call f_mu_and_deriv_mu_erf(rho1,alpha,zeta,mu0,beta,f_rho1,d_drho_f_rho1) - endif - if(rho2.lt.1.d-10)then - f_rho2 = mu_erf - else - call f_mu_and_deriv_mu_erf(rho2,alpha,zeta,mu0,beta,f_rho2,tmp) - endif end + +! --- + diff --git a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f index f9512827..bb64ad77 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f @@ -10,11 +10,6 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) ! this will be integrated numerically over r2: ! we use grid for r1 and extra_grid for r2 ! - ! for 99 < j1b_type < 199 - ! - ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) - ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) - ! END_DOC implicit none @@ -23,18 +18,18 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) double precision, intent(out) :: resx(n_grid2), resy(n_grid2), resz(n_grid2), res(n_grid2) integer :: jpoint - double precision :: v1b_r1 - double precision :: grad1_v1b(3) - double precision, allocatable :: v1b_r2(:) + double precision :: env_r1 + double precision :: grad1_env(3) + double precision, allocatable :: env_r2(:) double precision, allocatable :: u2b_r12(:) double precision, allocatable :: gradx1_u2b(:), grady1_u2b(:), gradz1_u2b(:) - double precision, external :: j1b_nucl + double precision, external :: env_nucl - PROVIDE j1b_type + PROVIDE j1e_type j2e_type env_type PROVIDE final_grid_points_extra - if( (j1b_type .eq. 100) .or. & - (j1b_type .ge. 200) .and. (j1b_type .lt. 300) ) then + if( ((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) .or. & + (j2e_type .eq. "rs-dft-murho") ) then call grad1_j12_mu_r1_seq(r1, n_grid2, resx, resy, resz) do jpoint = 1, n_points_extra_final_grid @@ -43,41 +38,44 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) + resz(jpoint) * resz(jpoint) enddo - elseif((j1b_type .gt. 100) .and. (j1b_type .lt. 200)) then + elseif((j2e_type .eq. "rs-dft") .and. (env_type .ne. "none")) then - allocate(v1b_r2(n_grid2)) + ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) + ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) + + allocate(env_r2(n_grid2)) allocate(u2b_r12(n_grid2)) allocate(gradx1_u2b(n_grid2)) allocate(grady1_u2b(n_grid2)) allocate(gradz1_u2b(n_grid2)) - v1b_r1 = j1b_nucl(r1) - call grad1_j1b_nucl(r1, grad1_v1b) + env_r1 = env_nucl(r1) + call grad1_env_nucl(r1, grad1_env) - call j1b_nucl_r1_seq(n_grid2, v1b_r2) + call env_nucl_r1_seq(n_grid2, env_r2) call j12_mu_r1_seq(r1, n_grid2, u2b_r12) call grad1_j12_mu_r1_seq(r1, n_grid2, gradx1_u2b, grady1_u2b, gradz1_u2b) do jpoint = 1, n_points_extra_final_grid - resx(jpoint) = (gradx1_u2b(jpoint) * v1b_r1 + u2b_r12(jpoint) * grad1_v1b(1)) * v1b_r2(jpoint) - resy(jpoint) = (grady1_u2b(jpoint) * v1b_r1 + u2b_r12(jpoint) * grad1_v1b(2)) * v1b_r2(jpoint) - resz(jpoint) = (gradz1_u2b(jpoint) * v1b_r1 + u2b_r12(jpoint) * grad1_v1b(3)) * v1b_r2(jpoint) + resx(jpoint) = (gradx1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(1)) * env_r2(jpoint) + resy(jpoint) = (grady1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(2)) * env_r2(jpoint) + resz(jpoint) = (gradz1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(3)) * env_r2(jpoint) res (jpoint) = resx(jpoint) * resx(jpoint) & + resy(jpoint) * resy(jpoint) & + resz(jpoint) * resz(jpoint) enddo - deallocate(v1b_r2, u2b_r12, gradx1_u2b, grady1_u2b, gradz1_u2b) + deallocate(env_r2, u2b_r12, gradx1_u2b, grady1_u2b, gradz1_u2b) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + print *, ' Error in get_grad1_u12_withsq_r1_seq: Unknown Jastrow' stop endif return -end subroutine get_grad1_u12_withsq_r1_seq +end ! --- @@ -87,11 +85,11 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) ! ! gradient of j(mu(r1,r2),r12) form of jastrow. ! - ! if mu(r1,r2) = cst ---> j1b_type < 200 and + ! if mu(r1,r2) = cst ---> ! ! d/dx1 j(mu,r12) = 0.5 * (1 - erf(mu *r12))/r12 * (x1 - x2) ! - ! if mu(r1,r2) /= cst ---> 200 < j1b_type < 300 and + ! if mu(r1,r2) /= cst ---> ! ! d/dx1 j(mu(r1,r2),r12) = exp(-(mu(r1,r2)*r12)**2) /(2 *sqrt(pi) * mu(r1,r2)**2 ) d/dx1 mu(r1,r2) ! + 0.5 * (1 - erf(mu(r1,r2) *r12))/r12 * (x1 - x2) @@ -110,8 +108,9 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) integer :: jpoint double precision :: r2(3) double precision :: dx, dy, dz, r12, tmp + double precision :: mu_val, mu_tmp, mu_der(3) - if((j1b_type .ge. 0) .and. (j1b_type .lt. 200)) then + if(j2e_type .eq. "rs-dft") then do jpoint = 1, n_points_extra_final_grid ! r2 @@ -138,9 +137,7 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) gradz(jpoint) = tmp * dz enddo - elseif((j1b_type .ge. 200) .and. (j1b_type .lt. 300)) then - - double precision :: mu_val, mu_tmp, mu_der(3) + elseif(j2e_type .eq. "rs-dft-murho") then do jpoint = 1, n_points_extra_final_grid ! r2 @@ -176,13 +173,13 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + print *, ' Error in grad1_j12_mu_r1_seq: Unknown j2e_type = ', j2e_type stop - endif + endif ! j2e_type return -end subroutine grad1_j12_mu_r1_seq +end ! --- @@ -201,35 +198,26 @@ subroutine j12_mu_r1_seq(r1, n_grid2, res) PROVIDE final_grid_points_extra - if((j1b_type .ge. 0) .and. (j1b_type .lt. 200)) then + do jpoint = 1, n_points_extra_final_grid ! r2 - do jpoint = 1, n_points_extra_final_grid ! r2 + r2(1) = final_grid_points_extra(1,jpoint) + r2(2) = final_grid_points_extra(2,jpoint) + r2(3) = final_grid_points_extra(3,jpoint) - r2(1) = final_grid_points_extra(1,jpoint) - r2(2) = final_grid_points_extra(2,jpoint) - r2(3) = final_grid_points_extra(3,jpoint) + r12 = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & + + (r1(2) - r2(2)) * (r1(2) - r2(2)) & + + (r1(3) - r2(3)) * (r1(3) - r2(3)) ) + mu_tmp = mu_erf * r12 - r12 = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & - + (r1(2) - r2(2)) * (r1(2) - r2(2)) & - + (r1(3) - r2(3)) * (r1(3) - r2(3)) ) - mu_tmp = mu_erf * r12 - - res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf - enddo - - else - - print *, ' j1b_type = ', j1b_type, 'not implemented for j12_mu_r1_seq' - stop - - endif + res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf + enddo return -end subroutine j12_mu_r1_seq +end ! --- -subroutine j1b_nucl_r1_seq(n_grid2, res) +subroutine env_nucl_r1_seq(n_grid2, res) ! TODO ! change loops order @@ -242,7 +230,7 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) integer :: i, jpoint double precision :: a, d, e, x, y, z - if((j1b_type .eq. 2) .or. (j1b_type .eq. 102)) then + if(env_type .eq. "sum-slat") then res = 1.d0 @@ -252,16 +240,16 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) r(3) = final_grid_points_extra(3,jpoint) do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - res(jpoint) -= dexp(-a*dsqrt(d)) + res(jpoint) -= env_coef(i) * dexp(-a*dsqrt(d)) enddo enddo - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + elseif(env_type .eq. "prod-gauss") then res = 1.d0 @@ -271,7 +259,7 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) r(3) = final_grid_points_extra(3,jpoint) do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) @@ -281,7 +269,7 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) enddo enddo - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "sum-gauss") then res = 1.d0 @@ -291,15 +279,15 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) r(3) = final_grid_points_extra(3,jpoint) do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - res(jpoint) -= j1b_pen_coef(i) * dexp(-a*d) + res(jpoint) -= env_coef(i) * dexp(-a*d) enddo enddo - elseif((j1b_type .eq. 5) .or. (j1b_type .eq. 105)) then + elseif(env_type .eq. "sum-quartic") then res = 1.d0 @@ -309,24 +297,24 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) r(3) = final_grid_points_extra(3,jpoint) do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - res(jpoint) -= dexp(-a*d*d) + res(jpoint) -= env_coef(i) * dexp(-a*d*d) enddo enddo else - print *, ' j1b_type = ', j1b_type, 'not implemented for j1b_nucl_r1_seq' + print *, ' Error in env_nucl_r1_seq: Unknown env_type = ', env_type stop endif return -end subroutine j1b_nucl_r1_seq +end ! --- diff --git a/plugins/local/non_h_ints_mu/new_grad_tc.irp.f b/plugins/local/non_h_ints_mu/new_grad_tc.irp.f deleted file mode 100644 index ab3cc3be..00000000 --- a/plugins/local/non_h_ints_mu/new_grad_tc.irp.f +++ /dev/null @@ -1,171 +0,0 @@ - -! --- - -BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao_loop, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! tc_grad_and_lapl_ao_loop(k,i,l,j) = < k l | -1/2 \Delta_1 u(r1,r2) - \grad_1 u(r1,r2) . \grad_1 | ij > - ! - ! = 1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) - ! - ! This is obtained by integration by parts. - ! - END_DOC - - implicit none - integer :: ipoint, i, j, k, l - double precision :: weight1, contrib_x, contrib_y, contrib_z, tmp_x, tmp_y, tmp_z - double precision :: ao_k_r, ao_i_r, ao_i_dx, ao_i_dy, ao_i_dz - double precision :: ao_j_r, ao_l_r, ao_l_dx, ao_l_dy, ao_l_dz - double precision :: time0, time1 - double precision, allocatable :: ac_mat(:,:,:,:) - - print*, ' providing tc_grad_and_lapl_ao_loop ...' - call wall_time(time0) - - allocate(ac_mat(ao_num,ao_num,ao_num,ao_num)) - ac_mat = 0.d0 - - ! --- - - do ipoint = 1, n_points_final_grid - weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) - - do i = 1, ao_num - ao_i_r = weight1 * aos_in_r_array (i,ipoint) - ao_i_dx = weight1 * aos_grad_in_r_array(i,ipoint,1) - ao_i_dy = weight1 * aos_grad_in_r_array(i,ipoint,2) - ao_i_dz = weight1 * aos_grad_in_r_array(i,ipoint,3) - - do k = 1, ao_num - ao_k_r = aos_in_r_array(k,ipoint) - - tmp_x = ao_k_r * ao_i_dx - ao_i_r * aos_grad_in_r_array(k,ipoint,1) - tmp_y = ao_k_r * ao_i_dy - ao_i_r * aos_grad_in_r_array(k,ipoint,2) - tmp_z = ao_k_r * ao_i_dz - ao_i_r * aos_grad_in_r_array(k,ipoint,3) - - do j = 1, ao_num - do l = 1, ao_num - - contrib_x = int2_grad1_u12_ao(l,j,ipoint,1) * tmp_x - contrib_y = int2_grad1_u12_ao(l,j,ipoint,2) * tmp_y - contrib_z = int2_grad1_u12_ao(l,j,ipoint,3) * tmp_z - - ac_mat(k,i,l,j) += contrib_x + contrib_y + contrib_z - enddo - enddo - enddo - enddo - enddo - - ! --- - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - tc_grad_and_lapl_ao_loop(k,i,l,j) = ac_mat(k,i,l,j) + ac_mat(l,j,k,i) - enddo - enddo - enddo - enddo - - deallocate(ac_mat) - - call wall_time(time1) - print*, ' Wall time for tc_grad_and_lapl_ao_loop = ', time1 - time0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! tc_grad_and_lapl_ao(k,i,l,j) = < k l | -1/2 \Delta_1 u(r1,r2) - \grad_1 u(r1,r2) . \grad_1 | ij > - ! - ! = -1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) - ! = 1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 (-1) \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) - ! - ! -1 in \int dr2 - ! - ! This is obtained by integration by parts. - ! - END_DOC - - implicit none - integer :: ipoint, i, j, k, l, m - double precision :: weight1, ao_k_r, ao_i_r - double precision :: time0, time1 - double precision, allocatable :: b_mat(:,:,:,:) - - print*, ' providing tc_grad_and_lapl_ao ...' - call wall_time(time0) - - if(read_tc_integ) then - - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_and_lapl_ao', action="read") - read(11) tc_grad_and_lapl_ao - close(11) - - else - - PROVIDE int2_grad1_u12_ao - - allocate(b_mat(n_points_final_grid,ao_num,ao_num,3)) - - b_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & - !$OMP SHARED (aos_in_r_array_transp, aos_grad_in_r_array_transp_bis, b_mat, & - !$OMP ao_num, n_points_final_grid, final_weight_at_r_vector) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - - weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) - ao_i_r = aos_in_r_array_transp(ipoint,i) - ao_k_r = aos_in_r_array_transp(ipoint,k) - - b_mat(ipoint,k,i,1) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) - b_mat(ipoint,k,i,2) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) - b_mat(ipoint,k,i,3) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - tc_grad_and_lapl_ao = 0.d0 - do m = 1, 3 - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, b_mat(1,1,1,m), n_points_final_grid & - , 1.d0, tc_grad_and_lapl_ao, ao_num*ao_num) - enddo - deallocate(b_mat) - - call sum_A_At(tc_grad_and_lapl_ao(1,1,1,1), ao_num*ao_num) - - endif - - if(write_tc_integ.and.mpi_master) then - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_and_lapl_ao', action="write") - call ezfio_set_work_empty(.False.) - write(11) tc_grad_and_lapl_ao - close(11) - call ezfio_set_tc_keywords_io_tc_integ('Read') - endif - - call wall_time(time1) - print*, ' Wall time for tc_grad_and_lapl_ao = ', time1 - time0 - call print_memory_usage() - -END_PROVIDER - -! --- - - diff --git a/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f b/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f index 7ab5b327..61d6c82c 100644 --- a/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f +++ b/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f @@ -3,6 +3,15 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po BEGIN_DOC ! + ! !!!!!! WARNING !!!!!!!!! + ! + ! DEFINED WITH - SIGN + ! + ! FOR 3e-iontegrals this doesn't matter + ! + ! !!!!!! WARNING !!!!!!!!! + ! + ! ! int2_grad1_u12_ao_test(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) ! ! where r1 = r(ipoint) @@ -16,9 +25,9 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po ! ! int2_grad1_u12_ao_test(i,j,ipoint,:) = v1 x [ 0.5 x \int dr2 [(r1 - r2) (erf(mu * r12)-1)r_12] v2 \phi_i(r2) \phi_j(r2) ] ! - \grad_1 v1 x [ \int dr2 u12 v2 \phi_i(r2) \phi_j(r2) ] - ! = 0.5 v_1b(ipoint) * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) * r(:) - ! - 0.5 v_1b(ipoint) * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,:) - ! - v_1b_grad[:,ipoint] * v_ij_u_cst_mu_j1b(i,j,ipoint) + ! = 0.5 env_val(ipoint) * v_ij_erf_rk_cst_mu_env(i,j,ipoint) * r(:) + ! - 0.5 env_val(ipoint) * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,:) + ! - env_grad[:,ipoint] * v_ij_u_cst_mu_env(i,j,ipoint) ! ! END_DOC @@ -31,8 +40,6 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po print*, ' providing int2_grad1_u12_ao_test ...' call wall_time(time0) - PROVIDE j1b_type - if(read_tc_integ) then open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao_test', action="read") @@ -41,41 +48,33 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po else - if(j1b_type .eq. 3) then + if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + do ipoint = 1, n_points_final_grid x = final_grid_points(1,ipoint) y = final_grid_points(2,ipoint) z = final_grid_points(3,ipoint) - tmp0 = 0.5d0 * v_1b(ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) + tmp0 = 0.5d0 * env_val(ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) do j = 1, ao_num do i = 1, ao_num - tmp1 = tmp0 * v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint) - tmp2 = v_ij_u_cst_mu_j1b_test(i,j,ipoint) - int2_grad1_u12_ao_test(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,1) - tmp2 * tmp_x - int2_grad1_u12_ao_test(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,2) - tmp2 * tmp_y - int2_grad1_u12_ao_test(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,3) - tmp2 * tmp_z + tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env_test(i,j,ipoint) + tmp2 = v_ij_u_cst_mu_env_test(i,j,ipoint) + int2_grad1_u12_ao_test(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,1) - tmp2 * tmp_x + int2_grad1_u12_ao_test(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,2) - tmp2 * tmp_y + int2_grad1_u12_ao_test(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,3) - tmp2 * tmp_z enddo enddo enddo + else - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) - int2_grad1_u12_ao_test(i,j,ipoint,1) = tmp1 * x - x_v_ij_erf_rk_cst_mu_tmp(i,j,ipoint,1) - int2_grad1_u12_ao_test(i,j,ipoint,2) = tmp1 * y - x_v_ij_erf_rk_cst_mu_tmp(i,j,ipoint,2) - int2_grad1_u12_ao_test(i,j,ipoint,3) = tmp1 * z - x_v_ij_erf_rk_cst_mu_tmp(i,j,ipoint,3) - enddo - enddo - enddo - int2_grad1_u12_ao_test *= 0.5d0 - endif + + print *, ' Error in int2_grad1_u12_ao_test: Unknown j2e_type = ', j2e_type + stop + + endif ! j2e_type endif @@ -191,7 +190,7 @@ BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao_test, (ao_num, ao_num, ao_ endif call wall_time(time1) - print*, ' Wall time for tc_grad_and_lapl_ao_test = ', time1 - time0 + print*, ' Wall time for tc_grad_and_lapl_ao_test (min) = ', (time1 - time0) / 60.d0 END_PROVIDER diff --git a/plugins/local/non_h_ints_mu/numerical_integ.irp.f b/plugins/local/non_h_ints_mu/numerical_integ.irp.f index f9457247..5436b857 100644 --- a/plugins/local/non_h_ints_mu/numerical_integ.irp.f +++ b/plugins/local/non_h_ints_mu/numerical_integ.irp.f @@ -1,11 +1,11 @@ ! --- -double precision function num_v_ij_u_cst_mu_j1b(i, j, ipoint) +double precision function num_v_ij_u_cst_mu_env(i, j, ipoint) BEGIN_DOC ! - ! \int dr2 u12 \phi_i(r2) \phi_j(r2) x v_1b(r2) + ! \int dr2 u12 \phi_i(r2) \phi_j(r2) x v_env(r2) ! END_DOC @@ -17,31 +17,31 @@ double precision function num_v_ij_u_cst_mu_j1b(i, j, ipoint) double precision :: r1(3), r2(3) double precision, external :: ao_value - double precision, external :: j12_mu, j1b_nucl, j12_mu_gauss + double precision, external :: j12_mu, env_nucl, j12_mu_gauss r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_v_ij_u_cst_mu_j1b = 0.d0 + num_v_ij_u_cst_mu_env = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) r2(2) = final_grid_points(2,jpoint) r2(3) = final_grid_points(3,jpoint) - num_v_ij_u_cst_mu_j1b += ao_value(i, r2) * ao_value(j, r2) * j12_mu_gauss(r1, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint) + num_v_ij_u_cst_mu_env += ao_value(i, r2) * ao_value(j, r2) * j12_mu_gauss(r1, r2) * env_nucl(r2) * final_weight_at_r_vector(jpoint) enddo return -end function num_v_ij_u_cst_mu_j1b +end ! --- -double precision function num_int2_u2_j1b2(i, j, ipoint) +double precision function num_int2_u2_env2(i, j, ipoint) BEGIN_DOC ! - ! \int dr2 u12^2 \phi_i(r2) \phi_j(r2) x v_1b(r2)^2 + ! \int dr2 u12^2 \phi_i(r2) \phi_j(r2) x v_env(r2)^2 ! END_DOC @@ -54,14 +54,14 @@ double precision function num_int2_u2_j1b2(i, j, ipoint) double precision :: dx, dy, dz, r12, x2, tmp1, tmp2, tmp3, coef, expo double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_int2_u2_j1b2 = 0.d0 + num_int2_u2_env2 = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) r2(2) = final_grid_points(2,jpoint) @@ -72,7 +72,7 @@ double precision function num_int2_u2_j1b2(i, j, ipoint) x2 = dx * dx + dy * dy + dz * dz r12 = dsqrt(x2) - tmp1 = j1b_nucl(r2) + tmp1 = env_nucl(r2) tmp2 = tmp1 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) !tmp3 = 0.d0 @@ -84,19 +84,19 @@ double precision function num_int2_u2_j1b2(i, j, ipoint) tmp3 = j12_mu(r1, r2) tmp3 = tmp3 * tmp3 - num_int2_u2_j1b2 += tmp2 * tmp3 + num_int2_u2_env2 += tmp2 * tmp3 enddo return -end function num_int2_u2_j1b2 +end ! --- -double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint) +double precision function num_int2_grad1u2_grad2u2_env2(i, j, ipoint) BEGIN_DOC ! - ! \int dr2 \frac{-[erf(mu r12) -1]^2}{4} \phi_i(r2) \phi_j(r2) x v_1b(r2)^2 + ! \int dr2 \frac{-[erf(mu r12) -1]^2}{4} \phi_i(r2) \phi_j(r2) x v_env(r2)^2 ! END_DOC @@ -109,13 +109,13 @@ double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint) double precision :: dx, dy, dz, r12, x2, tmp1, tmp2, tmp3, coef, expo double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_int2_grad1u2_grad2u2_j1b2 = 0.d0 + num_int2_grad1u2_grad2u2_env2 = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) r2(2) = final_grid_points(2,jpoint) @@ -126,7 +126,7 @@ double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint) x2 = dx * dx + dy * dy + dz * dz r12 = dsqrt(x2) - tmp1 = j1b_nucl(r2) + tmp1 = env_nucl(r2) tmp2 = tmp1 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) !tmp3 = 0.d0 @@ -140,19 +140,19 @@ double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint) tmp3 = -0.25d0 * tmp3 - num_int2_grad1u2_grad2u2_j1b2 += tmp2 * tmp3 + num_int2_grad1u2_grad2u2_env2 += tmp2 * tmp3 enddo return -end function num_int2_grad1u2_grad2u2_j1b2 +end ! --- -double precision function num_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint) +double precision function num_v_ij_erf_rk_cst_mu_env(i, j, ipoint) BEGIN_DOC ! - ! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_1b(r2) + ! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_env(r2) ! END_DOC @@ -165,13 +165,13 @@ double precision function num_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint) double precision :: dx, dy, dz, r12, tmp1, tmp2 double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_v_ij_erf_rk_cst_mu_j1b = 0.d0 + num_v_ij_erf_rk_cst_mu_env = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) r2(2) = final_grid_points(2,jpoint) @@ -183,21 +183,21 @@ double precision function num_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint) if(r12 .lt. 1d-10) cycle tmp1 = (derf(mu_erf * r12) - 1.d0) / r12 - tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint) + tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * env_nucl(r2) * final_weight_at_r_vector(jpoint) - num_v_ij_erf_rk_cst_mu_j1b += tmp2 + num_v_ij_erf_rk_cst_mu_env += tmp2 enddo return -end function num_v_ij_erf_rk_cst_mu_j1b +end ! --- -subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) +subroutine num_x_v_ij_erf_rk_cst_mu_env(i, j, ipoint, integ) BEGIN_DOC ! - ! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_1b(r2) x r2 + ! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_env(r2) x r2 ! END_DOC @@ -212,7 +212,7 @@ subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) double precision :: tmp_x, tmp_y, tmp_z double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) @@ -232,7 +232,7 @@ subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) if(r12 .lt. 1d-10) cycle tmp1 = (derf(mu_erf * r12) - 1.d0) / r12 - tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint) + tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * env_nucl(r2) * final_weight_at_r_vector(jpoint) tmp_x += tmp2 * r2(1) tmp_y += tmp2 * r2(2) @@ -244,7 +244,7 @@ subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) integ(3) = tmp_z return -end subroutine num_x_v_ij_erf_rk_cst_mu_j1b +end ! --- @@ -252,7 +252,7 @@ subroutine num_int2_grad1_u12_ao(i, j, ipoint, integ) BEGIN_DOC ! - ! \int dr2 [-grad_1 u12] \phi_i(r2) \phi_j(r2) x v12_1b(r1, r2) + ! \int dr2 [-grad_1 u12] \phi_i(r2) \phi_j(r2) x v12_env(r1, r2) ! END_DOC @@ -292,78 +292,7 @@ subroutine num_int2_grad1_u12_ao(i, j, ipoint, integ) integ(3) = tmp_z return -end subroutine num_int2_grad1_u12_ao - -! --- - -double precision function num_gradu_squared_u_ij_mu(i, j, ipoint) - - BEGIN_DOC - ! - ! -0.50 x \int r2 \phi_i(2) \phi_j(2) x v2^2 - ! [ v1^2 ((grad_1 u12)^2 + (grad_2 u12^2)]) - ! + u12^2 (grad_1 v1)^2 - ! + 2 u12 v1 (grad_1 u12) . (grad_1 v1) - ! - END_DOC - - - implicit none - - integer, intent(in) :: i, j, ipoint - - integer :: jpoint - double precision :: r1(3), r2(3) - double precision :: tmp_x, tmp_y, tmp_z, r12 - double precision :: dx1_v1, dy1_v1, dz1_v1, grad_u12(3) - double precision :: tmp1, v1_tmp, v2_tmp, u12_tmp - double precision :: fst_term, scd_term, thd_term, tmp - - double precision, external :: ao_value - double precision, external :: j1b_nucl - double precision, external :: j12_mu - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num - - r1(1) = final_grid_points(1,ipoint) - r1(2) = final_grid_points(2,ipoint) - r1(3) = final_grid_points(3,ipoint) - - num_gradu_squared_u_ij_mu = 0.d0 - do jpoint = 1, n_points_final_grid - - r2(1) = final_grid_points(1,jpoint) - r2(2) = final_grid_points(2,jpoint) - r2(3) = final_grid_points(3,jpoint) - - tmp_x = r1(1) - r2(1) - tmp_y = r1(2) - r2(2) - tmp_z = r1(3) - r2(3) - r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z) - - dx1_v1 = grad_x_j1b_nucl_num(r1) - dy1_v1 = grad_y_j1b_nucl_num(r1) - dz1_v1 = grad_z_j1b_nucl_num(r1) - - call grad1_j12_mu(r1, r2, grad_u12) - - tmp1 = 1.d0 - derf(mu_erf * r12) - v1_tmp = j1b_nucl(r1) - v2_tmp = j1b_nucl(r2) - u12_tmp = j12_mu(r1, r2) - - fst_term = 0.5d0 * tmp1 * tmp1 * v1_tmp * v1_tmp - scd_term = u12_tmp * u12_tmp * (dx1_v1*dx1_v1 + dy1_v1*dy1_v1 + dz1_v1*dz1_v1) - thd_term = 2.d0 * v1_tmp * u12_tmp * (dx1_v1*grad_u12(1) + dy1_v1*grad_u12(2) + dz1_v1*grad_u12(3)) - - tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * (fst_term + scd_term + thd_term) * v2_tmp * v2_tmp - - num_gradu_squared_u_ij_mu += tmp - enddo - - return -end function num_gradu_squared_u_ij_mu +end ! --- @@ -388,11 +317,11 @@ double precision function num_grad12_j12(i, j, ipoint) double precision :: fst_term, scd_term, thd_term, tmp double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) @@ -410,15 +339,15 @@ double precision function num_grad12_j12(i, j, ipoint) tmp_z = r1(3) - r2(3) r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z) - dx1_v1 = grad_x_j1b_nucl_num(r1) - dy1_v1 = grad_y_j1b_nucl_num(r1) - dz1_v1 = grad_z_j1b_nucl_num(r1) + dx1_v1 = grad_x_env_nucl_num(r1) + dy1_v1 = grad_y_env_nucl_num(r1) + dz1_v1 = grad_z_env_nucl_num(r1) call grad1_j12_mu(r1, r2, grad_u12) tmp1 = 1.d0 - derf(mu_erf * r12) - v1_tmp = j1b_nucl(r1) - v2_tmp = j1b_nucl(r2) + v1_tmp = env_nucl(r1) + v2_tmp = env_nucl(r2) u12_tmp = j12_mu(r1, r2) fst_term = 0.5d0 * tmp1 * tmp1 * v1_tmp * v1_tmp @@ -429,11 +358,11 @@ double precision function num_grad12_j12(i, j, ipoint) enddo return -end function num_grad12_j12 +end ! --- -double precision function num_u12sq_j1bsq(i, j, ipoint) +double precision function num_u12sq_envsq(i, j, ipoint) BEGIN_DOC ! @@ -454,17 +383,17 @@ double precision function num_u12sq_j1bsq(i, j, ipoint) double precision :: fst_term, scd_term, thd_term, tmp double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_u12sq_j1bsq = 0.d0 + num_u12sq_envsq = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) @@ -476,30 +405,30 @@ double precision function num_u12sq_j1bsq(i, j, ipoint) tmp_z = r1(3) - r2(3) r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z) - dx1_v1 = grad_x_j1b_nucl_num(r1) - dy1_v1 = grad_y_j1b_nucl_num(r1) - dz1_v1 = grad_z_j1b_nucl_num(r1) + dx1_v1 = grad_x_env_nucl_num(r1) + dy1_v1 = grad_y_env_nucl_num(r1) + dz1_v1 = grad_z_env_nucl_num(r1) call grad1_j12_mu(r1, r2, grad_u12) tmp1 = 1.d0 - derf(mu_erf * r12) - v1_tmp = j1b_nucl(r1) - v2_tmp = j1b_nucl(r2) + v1_tmp = env_nucl(r1) + v2_tmp = env_nucl(r2) u12_tmp = j12_mu(r1, r2) scd_term = u12_tmp * u12_tmp * (dx1_v1*dx1_v1 + dy1_v1*dy1_v1 + dz1_v1*dz1_v1) tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * scd_term * v2_tmp * v2_tmp - num_u12sq_j1bsq += tmp + num_u12sq_envsq += tmp enddo return -end function num_u12sq_j1bsq +end ! --- -double precision function num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint) +double precision function num_u12_grad1_u12_env_grad1_env(i, j, ipoint) BEGIN_DOC ! @@ -520,17 +449,17 @@ double precision function num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint) double precision :: fst_term, scd_term, thd_term, tmp double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_u12_grad1_u12_j1b_grad1_j1b = 0.d0 + num_u12_grad1_u12_env_grad1_env = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) @@ -542,34 +471,34 @@ double precision function num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint) tmp_z = r1(3) - r2(3) r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z) - dx1_v1 = grad_x_j1b_nucl_num(r1) - dy1_v1 = grad_y_j1b_nucl_num(r1) - dz1_v1 = grad_z_j1b_nucl_num(r1) + dx1_v1 = grad_x_env_nucl_num(r1) + dy1_v1 = grad_y_env_nucl_num(r1) + dz1_v1 = grad_z_env_nucl_num(r1) call grad1_j12_mu(r1, r2, grad_u12) tmp1 = 1.d0 - derf(mu_erf * r12) - v1_tmp = j1b_nucl(r1) - v2_tmp = j1b_nucl(r2) + v1_tmp = env_nucl(r1) + v2_tmp = env_nucl(r2) u12_tmp = j12_mu(r1, r2) thd_term = 2.d0 * v1_tmp * u12_tmp * (dx1_v1*grad_u12(1) + dy1_v1*grad_u12(2) + dz1_v1*grad_u12(3)) tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * thd_term * v2_tmp * v2_tmp - num_u12_grad1_u12_j1b_grad1_j1b += tmp + num_u12_grad1_u12_env_grad1_env += tmp enddo return -end function num_u12_grad1_u12_j1b_grad1_j1b +end ! --- -subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) +subroutine num_int2_u_grad1u_total_env2(i, j, ipoint, integ) BEGIN_DOC ! - ! \int dr2 u12 (grad_1 u12) \phi_i(r2) \phi_j(r2) x v_1b(r2)^2 + ! \int dr2 u12 (grad_1 u12) \phi_i(r2) \phi_j(r2) x v_env(r2)^2 ! END_DOC @@ -584,7 +513,7 @@ subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) double precision :: tmp_x, tmp_y, tmp_z double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu r1(1) = final_grid_points(1,ipoint) @@ -604,7 +533,7 @@ subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) r12 = dsqrt( dx * dx + dy * dy + dz * dz ) if(r12 .lt. 1d-10) cycle - tmp0 = j1b_nucl(r2) + tmp0 = env_nucl(r2) tmp1 = 0.5d0 * j12_mu(r1, r2) * (1.d0 - derf(mu_erf * r12)) / r12 tmp2 = tmp0 * tmp0 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) @@ -618,6 +547,6 @@ subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) integ(3) = tmp_z return -end subroutine num_int2_u_grad1u_total_j1b2 +end ! --- diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f new file mode 100644 index 00000000..7962ed15 --- /dev/null +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -0,0 +1,601 @@ + +BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_final_grid, 3)] + + BEGIN_DOC + ! + ! int2_grad1_u12_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) + ! + ! where r1 = r(ipoint) + ! + END_DOC + + implicit none + integer :: ipoint, i, j, m, jpoint + double precision :: time0, time1 + double precision :: x, y, z, r2 + double precision :: dx, dy, dz + double precision :: tmp_ct + double precision :: tmp0, tmp1, tmp2 + double precision :: tmp0_x, tmp0_y, tmp0_z + double precision :: tmp1_x, tmp1_y, tmp1_z + + PROVIDE j2e_type + PROVIDE j1e_type + + call wall_time(time0) + + print*, ' providing int2_grad1_u12_ao ...' + + if(read_tc_integ) then + + print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") + read(11) int2_grad1_u12_ao + close(11) + + else + + if(tc_integ_type .eq. "analytic") then + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet.' + stop + + elseif(tc_integ_type .eq. "numeric") then + + print *, ' Numerical integration over r1 and r2 will be performed' + + ! TODO combine 1shot & int2_grad1_u12_ao_num + + PROVIDE int2_grad1_u12_ao_num + int2_grad1_u12_ao = int2_grad1_u12_ao_num + + !PROVIDE int2_grad1_u12_ao_num_1shot + !int2_grad1_u12_ao = int2_grad1_u12_ao_num_1shot + + elseif(tc_integ_type .eq. "semi-analytic") then + + print*, ' Numerical integration over r1, with analytical integration over r2' + + ! --- + + if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + + PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu + + int2_grad1_u12_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & + !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & + !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u12_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + do j = 1, ao_num + do i = 1, ao_num + tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) + int2_grad1_u12_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) + int2_grad1_u12_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + + PROVIDE env_type env_val env_grad + PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + + int2_grad1_u12_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & + !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u12_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + tmp0 = 0.5d0 * env_val(ipoint) + tmp0_x = env_grad(1,ipoint) + tmp0_y = env_grad(2,ipoint) + tmp0_z = env_grad(3,ipoint) + do j = 1, ao_num + do i = 1, ao_num + tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) + tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x + int2_grad1_u12_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y + int2_grad1_u12_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then + + PROVIDE mu_erf + PROVIDE env_type env_val env_grad + PROVIDE Ir2_LinFcRSDFT_long_Du_0 Ir2_LinFcRSDFT_long_Du_x Ir2_LinFcRSDFT_long_Du_y Ir2_LinFcRSDFT_long_Du_z Ir2_LinFcRSDFT_long_Du_2 + PROVIDE Ir2_LinFcRSDFT_gauss_Du + + tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + + int2_grad1_u12_ao = 0.d0 + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & + !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct, env_val, env_grad, Ir2_LinFcRSDFT_long_Du_0, & + !$OMP Ir2_LinFcRSDFT_long_Du_x, Ir2_LinFcRSDFT_long_Du_y, & + !$OMP Ir2_LinFcRSDFT_long_Du_z, Ir2_LinFcRSDFT_gauss_Du, & + !$OMP Ir2_LinFcRSDFT_long_Du_2, int2_grad1_u12_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx = env_grad(1,ipoint) + dy = env_grad(2,ipoint) + dz = env_grad(3,ipoint) + + tmp0_x = 0.5d0 * (env_val(ipoint) * x + r2 * dx) + tmp0_y = 0.5d0 * (env_val(ipoint) * y + r2 * dy) + tmp0_z = 0.5d0 * (env_val(ipoint) * z + r2 * dz) + + tmp1 = 0.5d0 * env_val(ipoint) + + tmp1_x = tmp_ct * dx + tmp1_y = tmp_ct * dy + tmp1_z = tmp_ct * dz + + do j = 1, ao_num + do i = 1, ao_num + + tmp2 = 0.5d0 * Ir2_LinFcRSDFT_long_Du_2(i,j,ipoint) - x * Ir2_LinFcRSDFT_long_Du_x(i,j,ipoint) - y * Ir2_LinFcRSDFT_long_Du_y(i,j,ipoint) - z * Ir2_LinFcRSDFT_long_Du_z(i,j,ipoint) + + int2_grad1_u12_ao(i,j,ipoint,1) = -Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_LinFcRSDFT_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,2) = -Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_LinFcRSDFT_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,3) = -Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_LinFcRSDFT_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + else + + print *, ' Error in int2_grad1_u12_ao: Unknown Jastrow' + stop + + endif ! j2e_type + + ! --- + + if(j1e_type .ne. "none") then + + PROVIDE elec_num + PROVIDE ao_overlap + PROVIDE j1e_dx j1e_dy j1e_dz + + tmp_ct = 1.d0 / (dble(elec_num) - 1.d0) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, tmp_ct, & + !$OMP j1e_dx, j1e_dy, j1e_dz, ao_overlap, int2_grad1_u12_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + tmp0_x = tmp_ct * j1e_dx(ipoint) + tmp0_y = tmp_ct * j1e_dy(ipoint) + tmp0_z = tmp_ct * j1e_dz(ipoint) + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_ao(i,j,ipoint,1) = int2_grad1_u12_ao(i,j,ipoint,1) + tmp0_x * ao_overlap(i,j) + int2_grad1_u12_ao(i,j,ipoint,2) = int2_grad1_u12_ao(i,j,ipoint,2) + tmp0_y * ao_overlap(i,j) + int2_grad1_u12_ao(i,j,ipoint,3) = int2_grad1_u12_ao(i,j,ipoint,3) + tmp0_z * ao_overlap(i,j) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + else + + FREE Ir2_LinFcRSDFT_long_Du_0 Ir2_LinFcRSDFT_long_Du_x Ir2_LinFcRSDFT_long_Du_y Ir2_LinFcRSDFT_long_Du_z Ir2_LinFcRSDFT_gauss_Du Ir2_LinFcRSDFT_long_Du_2 + + endif ! j1e_type + + ! --- + + else + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' + stop + + endif ! tc_integ_type + + endif ! read_tc_integ + + + if(write_tc_integ .and. mpi_master) then + + print*, ' Writing int2_grad1_u12_ao in ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="write") + call ezfio_set_work_empty(.False.) + write(11) int2_grad1_u12_ao + close(11) + call ezfio_set_tc_keywords_io_tc_integ('Read') + endif + + call wall_time(time1) + print*, ' wall time for int2_grad1_u12_ao (min) =', (time1-time0)/60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! int2_grad1_u12_square_ao = -(1/2) x int dr2 chi_l(r2) chi_j(r2) [grad_1 u(r1,r2)]^2 + ! + END_DOC + + implicit none + integer :: ipoint, i, j, m, jpoint + double precision :: x, y, z, r2 + double precision :: dx, dy, dz, dr2 + double precision :: dx1, dy1, dz1, dx2, dy2, dz2, dr12 + double precision :: tmp_ct, tmp_ct1, tmp_ct2 + double precision :: tmp0, tmp1, tmp2 + double precision :: tmp3, tmp4, tmp5, tmp6 + double precision :: tmp0_x, tmp0_y, tmp0_z + double precision :: tmp1_x, tmp1_y, tmp1_z + double precision :: time0, time1 + + PROVIDE j2e_type + PROVIDE j1e_type + PROVIDE tc_integ_type + + call wall_time(time0) + + print*, ' providing int2_grad1_u12_square_ao ...' + + if(tc_integ_type .eq. "analytic") then + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet.' + stop + + elseif(tc_integ_type .eq. "numeric") then + + print *, ' Numerical integration over r1 and r2 will be performed' + + ! TODO combine 1shot & int2_grad1_u12_square_ao_num + + PROVIDE int2_grad1_u12_square_ao_num + int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num + + !PROVIDE int2_grad1_u12_square_ao_num_1shot + !int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num_1shot + + elseif(tc_integ_type .eq. "semi-analytic") then + + print*, ' Numerical integration over r1, with analytical integration over r2' + + ! --- + + if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + + PROVIDE int2_grad1u2_grad2u2 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, int2_grad1u2_grad2u2) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1u2_grad2u2(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE int2_grad1u2_grad2u2 + + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + + PROVIDE mu_erf + PROVIDE env_val env_grad + + if(use_ipp) then + + ! the term u12_grad1_u12_env_grad1_env is added directly for performance + PROVIDE u12sq_envsq grad12_j12 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_envsq, grad12_j12) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_envsq(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE u12sq_envsq grad12_j12 + + else + + PROVIDE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_envsq, grad12_j12, u12_grad1_u12_env_grad1_env) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_envsq(i,j,ipoint) + u12_grad1_u12_env_grad1_env(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 + + endif ! use_ipp + + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then + + PROVIDE mu_erf + PROVIDE env_type env_val env_grad + + if(use_ipp) then + + ! do not free int2_u2_env2 here + PROVIDE int2_u2_env2 + PROVIDE int2_grad1u2_grad2u2_env2 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint, tmp0_x, tmp0_y, tmp0_z, tmp1, tmp2) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, & + !$OMP env_val, env_grad, int2_u2_env2, int2_grad1u2_grad2u2_env2) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + tmp0_x = env_grad(1,ipoint) + tmp0_y = env_grad(2,ipoint) + tmp0_z = env_grad(3,ipoint) + tmp1 = -0.5d0 * (tmp0_x * tmp0_x + tmp0_y * tmp0_y + tmp0_z * tmp0_z) + tmp2 = 0.5d0 * env_val(ipoint) * env_val(ipoint) + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * int2_u2_env2(i,j,ipoint) + tmp2 * int2_grad1u2_grad2u2_env2(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE int2_grad1u2_grad2u2_env2 + + else + + PROVIDE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_envsq, grad12_j12, u12_grad1_u12_env_grad1_env) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_envsq(i,j,ipoint) + u12_grad1_u12_env_grad1_env(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 + + endif ! use_ipp + +! elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then +! +! PROVIDE mu_erf +! PROVIDE env_val env_grad +! PROVIDE Ir2_LinFcRSDFT_short_Du2_0 Ir2_LinFcRSDFT_short_Du2_x Ir2_LinFcRSDFT_short_Du2_y Ir2_LinFcRSDFT_short_Du2_z Ir2_LinFcRSDFT_short_Du2_2 +! PROVIDE Ir2_LinFcRSDFT_long_Du2_0 Ir2_LinFcRSDFT_long_Du2_x Ir2_LinFcRSDFT_long_Du2_y Ir2_LinFcRSDFT_long_Du2_z Ir2_LinFcRSDFT_long_Du2_2 +! PROVIDE Ir2_LinFcRSDFT_gauss_Du2 +! +! tmp_ct = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) +! tmp_ct2 = tmp_ct * tmp_ct +! +! int2_grad1_u12_square_ao = 0.d0 +! +! !$OMP PARALLEL & +! !$OMP DEFAULT (NONE) & +! !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, dr2, & +! !$OMP tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, & +! !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & +! !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & +! !$OMP tmp_ct, tmp_ct2, env_val, env_grad, & +! !$OMP Ir2_LinFcRSDFT_long_Du2_0, Ir2_LinFcRSDFT_long_Du2_x, & +! !$OMP Ir2_LinFcRSDFT_long_Du2_y, Ir2_LinFcRSDFT_long_Du2_z, & +! !$OMP Ir2_LinFcRSDFT_gauss_Du2, Ir2_LinFcRSDFT_long_Du2_2, & +! !$OMP Ir2_LinFcRSDFT_short_Du2_0, Ir2_LinFcRSDFT_short_Du2_x, & +! !$OMP Ir2_LinFcRSDFT_short_Du2_y, Ir2_LinFcRSDFT_short_Du2_z, & +! !$OMP Ir2_LinFcRSDFT_short_Du2_2, int2_grad1_u12_square_ao) +! !$OMP DO SCHEDULE (static) +! do ipoint = 1, n_points_final_grid +! +! x = final_grid_points(1,ipoint) +! y = final_grid_points(2,ipoint) +! z = final_grid_points(3,ipoint) +! r2 = x*x + y*y + z*z +! +! dx = env_grad(1,ipoint) +! dy = env_grad(2,ipoint) +! dz = env_grad(3,ipoint) +! dr2 = dx*dx + dy*dy + dz*dz +! +! tmp0_x = 0.5d0 * (dr2 * x + env_val(ipoint) * dx) +! tmp0_y = 0.5d0 * (dr2 * y + env_val(ipoint) * dy) +! tmp0_z = 0.5d0 * (dr2 * z + env_val(ipoint) * dz) +! +! tmp1 = 0.25d0 * (env_val(ipoint)*env_val(ipoint) + r2*dr2 + 2.d0*env_val(ipoint)*(x*dx+y*dy+z*dz)) +! tmp3 = 0.25d0 * dr2 +! tmp4 = tmp3 * tmp_ct2 +! tmp5 = 0.50d0 * tmp_ct * (r2*dr2 + env_val(ipoint)*(x*dx+y*dy+z*dz)) +! tmp6 = 0.50d0 * tmp_ct * dr2 +! +! tmp1_x = 0.5d0 * tmp_ct * (2.d0*dr2*x + env_val(ipoint)*dx) +! tmp1_y = 0.5d0 * tmp_ct * (2.d0*dr2*y + env_val(ipoint)*dy) +! tmp1_z = 0.5d0 * tmp_ct * (2.d0*dr2*z + env_val(ipoint)*dz) +! +! do j = 1, ao_num +! do i = 1, ao_num +! +! tmp2 = tmp1_x * Ir2_LinFcRSDFT_long_Du2_x (i,j,ipoint) + tmp1_y * Ir2_LinFcRSDFT_long_Du2_y (i,j,ipoint) + tmp1_z * Ir2_LinFcRSDFT_long_Du2_z (i,j,ipoint) & +! - tmp0_x * Ir2_LinFcRSDFT_short_Du2_x(i,j,ipoint) - tmp0_y * Ir2_LinFcRSDFT_short_Du2_y(i,j,ipoint) - tmp0_z * Ir2_LinFcRSDFT_short_Du2_z(i,j,ipoint) +! +! int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * Ir2_LinFcRSDFT_short_Du2_0(i,j,ipoint) + tmp2 + tmp3 * Ir2_LinFcRSDFT_short_Du2_2(i,j,ipoint) & +! + tmp4 * Ir2_LinFcRSDFT_gauss_Du2(i,j,ipoint) - tmp5 * Ir2_LinFcRSDFT_long_Du2_0(i,j,ipoint) & +! - tmp6 * Ir2_LinFcRSDFT_long_Du2_2(i,j,ipoint) +! enddo +! enddo +! enddo +! !$OMP END DO +! !$OMP END PARALLEL +! +! int2_grad1_u12_square_ao = -0.5d0 * int2_grad1_u12_square_ao + + else + + print *, ' Error in int2_grad1_u12_square_ao: Unknown Jhastrow' + stop + + endif ! j2e_type + + ! --- + + if(j1e_type .ne. "none") then + + PROVIDE elec_num + PROVIDE ao_overlap + PROVIDE j1e_dx j1e_dy j1e_dz + + tmp_ct1 = 1.0d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + tmp_ct2 = 1.0d0 / (dble(elec_num) - 1.d0) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx1, dy1, dz1, & + !$OMP dx2, dy2, dz2, dr12, tmp0, tmp1, tmp2, tmp3, tmp4, & + !$OMP tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct1, tmp_ct2, env_val, env_grad, & + !$OMP j1e_dx, j1e_dy, j1e_dz, & + !$OMP Ir2_LinFcRSDFT_long_Du_0, Ir2_LinFcRSDFT_long_Du_2, & + !$OMP Ir2_LinFcRSDFT_long_Du_x, Ir2_LinFcRSDFT_long_Du_y, & + !$OMP Ir2_LinFcRSDFT_long_Du_z, Ir2_LinFcRSDFT_gauss_Du, & + !$OMP ao_overlap, int2_grad1_u12_square_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx1 = env_grad(1,ipoint) + dy1 = env_grad(2,ipoint) + dz1 = env_grad(3,ipoint) + + dx2 = j1e_dx(ipoint) + dy2 = j1e_dy(ipoint) + dz2 = j1e_dz(ipoint) + + dr12 = dx1*dx2 + dy1*dy2 + dz1*dz2 + + tmp0 = tmp_ct2 * (env_val(ipoint) * (dx2*x + dy2*y + dz2*z) + r2*dr12) + tmp1 = tmp_ct2 * dr12 + tmp2 = tmp_ct1 * tmp_ct2 * dr12 + tmp3 = tmp_ct2 * tmp_ct2 * (dx2*dx2 + dy2*dy2 + dz2*dz2) + + tmp0_x = tmp_ct2 * (env_val(ipoint) * dx2 + 2.d0 * dr12 * x) + tmp0_y = tmp_ct2 * (env_val(ipoint) * dy2 + 2.d0 * dr12 * y) + tmp0_z = tmp_ct2 * (env_val(ipoint) * dz2 + 2.d0 * dr12 * z) + + do j = 1, ao_num + do i = 1, ao_num + + tmp4 = tmp0_x * Ir2_LinFcRSDFT_long_Du_x(i,j,ipoint) + tmp0_y * Ir2_LinFcRSDFT_long_Du_y(i,j,ipoint) + tmp0_z * Ir2_LinFcRSDFT_long_Du_z(i,j,ipoint) + + int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1_u12_square_ao(i,j,ipoint) & + + tmp0 * Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_LinFcRSDFT_long_Du_2(i,j,ipoint) & + - tmp2 * Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) & + + tmp3 * ao_overlap(i,j) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE Ir2_LinFcRSDFT_long_Du_0 Ir2_LinFcRSDFT_long_Du_x Ir2_LinFcRSDFT_long_Du_y Ir2_LinFcRSDFT_long_Du_z Ir2_LinFcRSDFT_gauss_Du Ir2_LinFcRSDFT_long_Du_2 + + endif ! j1e_type + + ! --- + + else + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' + stop + + endif ! tc_integ_type + + call wall_time(time1) + print*, ' wall time for int2_grad1_u12_square_ao (min) = ', (time1-time0) / 60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + diff --git a/plugins/local/non_h_ints_mu/tc_integ_an.irp.f b/plugins/local/non_h_ints_mu/tc_integ_an.irp.f deleted file mode 100644 index a69b2a74..00000000 --- a/plugins/local/non_h_ints_mu/tc_integ_an.irp.f +++ /dev/null @@ -1,248 +0,0 @@ - -BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_final_grid, 3)] - - BEGIN_DOC - ! - ! TODO - ! combine with int2_grad1_u12_square_ao to avoid repeated calculation ? - ! - ! int2_grad1_u12_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) - ! - ! where r1 = r(ipoint) - ! - ! if J(r1,r2) = u12 (j1b_type .eq. 1) - ! - ! int2_grad1_u12_ao(i,j,ipoint,:) = 0.5 x \int dr2 [(r1 - r2) (erf(mu * r12)-1)r_12] \phi_i(r2) \phi_j(r2) - ! = 0.5 * [ v_ij_erf_rk_cst_mu(i,j,ipoint) * r(:) - x_v_ij_erf_rk_cst_mu(i,j,ipoint,:) ] - ! - ! if J(r1,r2) = u12 x v1 x v2 (j1b_type .eq. 3) - ! - ! int2_grad1_u12_ao(i,j,ipoint,:) = v1 x [ 0.5 x \int dr2 [(r1 - r2) (erf(mu * r12)-1)r_12] v2 \phi_i(r2) \phi_j(r2) ] - ! - \grad_1 v1 x [ \int dr2 u12 v2 \phi_i(r2) \phi_j(r2) ] - ! = 0.5 v_1b(ipoint) * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) * r(:) - ! - 0.5 v_1b(ipoint) * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,:) - ! - v_1b_grad[:,ipoint] * v_ij_u_cst_mu_j1b(i,j,ipoint) - ! - END_DOC - - implicit none - integer :: ipoint, i, j, m, jpoint - double precision :: time0, time1 - double precision :: x, y, z, w, tmp_x, tmp_y, tmp_z, tmp0, tmp1, tmp2 - - print*, ' providing int2_grad1_u12_ao ...' - call wall_time(time0) - - PROVIDE j1b_type - - if(read_tc_integ) then - - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") - read(11) int2_grad1_u12_ao - - else - - if(j1b_type .eq. 0) then - - PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - - int2_grad1_u12_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & - !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & - !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u12_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) - int2_grad1_u12_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) - int2_grad1_u12_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 4)) then - - PROVIDE v_1b_grad - PROVIDE v_ij_erf_rk_cst_mu_j1b v_ij_u_cst_mu_j1b_an x_v_ij_erf_rk_cst_mu_j1b - - int2_grad1_u12_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp_x, tmp_y, tmp_z) & - !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points, v_1b, v_1b_grad & - !$OMP , v_ij_erf_rk_cst_mu_j1b, v_ij_u_cst_mu_j1b_an, x_v_ij_erf_rk_cst_mu_j1b, int2_grad1_u12_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - tmp0 = 0.5d0 * v_1b(ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = tmp0 * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) - tmp2 = v_ij_u_cst_mu_j1b_an(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1) - tmp2 * tmp_x - int2_grad1_u12_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2) - tmp2 * tmp_y - int2_grad1_u12_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3) - tmp2 * tmp_z - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - FREE v_ij_erf_rk_cst_mu_j1b v_ij_u_cst_mu_j1b_an x_v_ij_erf_rk_cst_mu_j1b - - elseif(j1b_type .ge. 100) then - - PROVIDE int2_grad1_u12_ao_num - int2_grad1_u12_ao = int2_grad1_u12_ao_num - - !PROVIDE int2_grad1_u12_ao_num_1shot - !int2_grad1_u12_ao = int2_grad1_u12_ao_num_1shot - - else - - print *, ' j1b_type = ', j1b_type, 'not implemented yet' - stop - - endif - endif - - if(write_tc_integ.and.mpi_master) then - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="write") - call ezfio_set_work_empty(.False.) - write(11) int2_grad1_u12_ao - close(11) - call ezfio_set_tc_keywords_io_tc_integ('Read') - endif - - call wall_time(time1) - print*, ' wall time for int2_grad1_u12_ao =', time1-time0 - call print_memory_usage() - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_points_final_grid)] - - BEGIN_DOC - ! - ! int2_grad1_u12_square_ao = -(1/2) x int dr2 chi_l(r2) chi_j(r2) [grad_1 u(r1,r2)]^2 - ! - END_DOC - - implicit none - integer :: ipoint, i, j, m, jpoint - double precision :: time0, time1 - double precision :: x, y, z, w, tmp_x, tmp_y, tmp_z, tmp0, tmp1, tmp2 - - print*, ' providing int2_grad1_u12_square_ao ...' - call wall_time(time0) - - PROVIDE j1b_type - - if(j1b_type .eq. 0) then - - PROVIDE int2_grad1u2_grad2u2 - - int2_grad1_u12_square_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, int2_grad1u2_grad2u2) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - do j = 1, ao_num - do i = 1, ao_num - int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1u2_grad2u2(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 4)) then - - if(use_ipp) then - - ! the term u12_grad1_u12_j1b_grad1_j1b is added directly for performance - PROVIDE u12sq_j1bsq grad12_j12 - - int2_grad1_u12_square_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_j1bsq, grad12_j12) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - do j = 1, ao_num - do i = 1, ao_num - int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_j1bsq(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - FREE u12sq_j1bsq grad12_j12 - - else - - PROVIDE u12sq_j1bsq u12_grad1_u12_j1b_grad1_j1b grad12_j12 - - int2_grad1_u12_square_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_j1bsq, grad12_j12, u12_grad1_u12_j1b_grad1_j1b) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - do j = 1, ao_num - do i = 1, ao_num - int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_j1bsq(i,j,ipoint) + u12_grad1_u12_j1b_grad1_j1b(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - FREE u12sq_j1bsq u12_grad1_u12_j1b_grad1_j1b grad12_j12 - - endif - - elseif(j1b_type .ge. 100) then - - PROVIDE int2_grad1_u12_square_ao_num - int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num - - !PROVIDE int2_grad1_u12_square_ao_num_1shot - !int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num_1shot - - else - - print *, ' j1b_type = ', j1b_type, 'not implemented yet' - stop - - endif - - call wall_time(time1) - print*, ' wall time for int2_grad1_u12_square_ao =', time1-time0 - call print_memory_usage() - -END_PROVIDER - -! --- - diff --git a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f index 84674fa0..c57f8400 100644 --- a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f +++ b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f @@ -11,7 +11,7 @@ program test_non_h my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r @@ -20,12 +20,11 @@ program test_non_h endif - !call routine_grad_squared() !call routine_fit() !call test_ipp() - !call test_v_ij_u_cst_mu_j1b_an() + !call test_v_ij_u_cst_mu_env_an() call test_int2_grad1_u12_square_ao() call test_int2_grad1_u12_ao() @@ -33,81 +32,6 @@ end ! --- -subroutine routine_lapl_grad - implicit none - integer :: i,j,k,l - double precision :: grad_lapl, get_ao_tc_sym_two_e_pot,new,accu,contrib - double precision :: ao_two_e_integral_erf,get_ao_two_e_integral,count_n,accu_relat -! !!!!!!!!!!!!!!!!!!!!! WARNING -! THIS ROUTINE MAKES SENSE ONLY IF HAND MODIFIED coef_gauss_eff_pot(1:n_max_fit_slat) = 0. to cancel (1-erf(mu*r12))^2 - accu = 0.d0 - accu_relat = 0.d0 - count_n = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - grad_lapl = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map) ! pure gaussian part : comes from Lapl - grad_lapl += ao_two_e_integral_erf(i, k, j, l) ! erf(mu r12)/r12 : comes from Lapl - grad_lapl += ao_non_hermit_term_chemist(k,i,l,j) ! \grad u(r12) . grad - new = tc_grad_and_lapl_ao(k,i,l,j) - new += get_ao_two_e_integral(i,j,k,l,ao_integrals_map) - contrib = dabs(new - grad_lapl) - if(dabs(grad_lapl).gt.1.d-12)then - count_n += 1.d0 - accu_relat += 2.0d0 * contrib/dabs(grad_lapl+new) - endif - if(contrib.gt.1.d-10)then - print*,i,j,k,l - print*,grad_lapl,new,contrib - print*,2.0d0*contrib/dabs(grad_lapl+new+1.d-12) - endif - accu += contrib - enddo - enddo - enddo - enddo - print*,'accu = ',accu/count_n - print*,'accu/rel = ',accu_relat/count_n - -end - -subroutine routine_grad_squared - implicit none - integer :: i,j,k,l - double precision :: grad_squared, get_ao_tc_sym_two_e_pot,new,accu,contrib - double precision :: count_n,accu_relat -! !!!!!!!!!!!!!!!!!!!!! WARNING -! THIS ROUTINE MAKES SENSE ONLY IF HAND MODIFIED coef_gauss_eff_pot(n_max_fit_slat:n_max_fit_slat+1) = 0. to cancel exp(-'mu*r12)^2) - accu = 0.d0 - accu_relat = 0.d0 - count_n = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - grad_squared = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map) ! pure gaussian part : comes from Lapl - new = tc_grad_square_ao(k,i,l,j) - contrib = dabs(new - grad_squared) - if(dabs(grad_squared).gt.1.d-12)then - count_n += 1.d0 - accu_relat += 2.0d0 * contrib/dabs(grad_squared+new) - endif - if(contrib.gt.1.d-10)then - print*,i,j,k,l - print*,grad_squared,new,contrib - print*,2.0d0*contrib/dabs(grad_squared+new+1.d-12) - endif - accu += contrib - enddo - enddo - enddo - enddo - print*,'accu = ',accu/count_n - print*,'accu/rel = ',accu_relat/count_n - -end - subroutine routine_fit implicit none integer :: i,nx @@ -145,7 +69,7 @@ subroutine test_ipp() allocate(I1(ao_num,ao_num,ao_num,ao_num)) I1 = 0.d0 - PROVIDE u12_grad1_u12_j1b_grad1_j1b + PROVIDE u12_grad1_u12_env_grad1_env !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -163,7 +87,7 @@ subroutine test_ipp() !$OMP END PARALLEL call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , u12_grad1_u12_j1b_grad1_j1b(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & + , u12_grad1_u12_env_grad1_env(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & , 0.d0, I1, ao_num*ao_num) ! --- @@ -173,14 +97,14 @@ subroutine test_ipp() allocate(I2(ao_num,ao_num,ao_num,ao_num)) I2 = 0.d0 - PROVIDE int2_u2_j1b2 + PROVIDE int2_u2_env2 b_mat = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & !$OMP SHARED (aos_in_r_array_transp, b_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & - !$OMP v_1b_square_grad, v_1b_square_lapl, aos_grad_in_r_array_transp_bis) + !$OMP env_square_grad, env_square_lapl, aos_grad_in_r_array_transp_bis) !$OMP DO SCHEDULE (static) do i = 1, ao_num do k = 1, ao_num @@ -191,10 +115,10 @@ subroutine test_ipp() ao_i_r = aos_in_r_array_transp(ipoint,i) ao_k_r = aos_in_r_array_transp(ipoint,k) - b_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * v_1b_square_lapl(ipoint) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * v_1b_square_grad(ipoint,1) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * v_1b_square_grad(ipoint,2) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * v_1b_square_grad(ipoint,3) ) + b_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * env_square_lapl(ipoint) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) enddo enddo enddo @@ -202,7 +126,7 @@ subroutine test_ipp() !$OMP END PARALLEL call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_u2_j1b2(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & + , int2_u2_env2(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & , 0.d0, I2, ao_num*ao_num) ! --- @@ -268,7 +192,7 @@ subroutine I_grade_gradu_naive1(i, j, k, l, int) double precision :: weight2_x, weight2_y, weight2_z double precision :: aor_i, aor_j, aor_k, aor_l double precision :: e1_val, e2_val, e1_der(3), u12_val, u12_der(3) - double precision, external :: j1b_nucl, j12_mu + double precision, external :: env_nucl, j12_mu int = 0.d0 @@ -281,8 +205,8 @@ subroutine I_grade_gradu_naive1(i, j, k, l, int) aor_i = aos_in_r_array_transp(ipoint,i) aor_k = aos_in_r_array_transp(ipoint,k) - e1_val = j1b_nucl(r1) - call grad1_j1b_nucl(r1, e1_der) + e1_val = env_nucl(r1) + call grad1_env_nucl(r1, e1_der) weight1_x = aor_i * aor_k * e1_val * final_weight_at_r_vector(ipoint) * e1_der(1) weight1_y = aor_i * aor_k * e1_val * final_weight_at_r_vector(ipoint) * e1_der(2) @@ -297,7 +221,7 @@ subroutine I_grade_gradu_naive1(i, j, k, l, int) aor_j = aos_in_r_array_extra_transp(jpoint,j) aor_l = aos_in_r_array_extra_transp(jpoint,l) - e2_val = j1b_nucl(r2) + e2_val = env_nucl(r2) u12_val = j12_mu(r1, r2) call grad1_j12_mu(r1, r2, u12_der) @@ -326,7 +250,7 @@ subroutine I_grade_gradu_naive2(i, j, k, l, int) double precision :: weight2_x, weight2_y, weight2_z double precision :: aor_i, aor_j, aor_k, aor_l double precision :: e1_square_der(3), e2_val, u12_square_der(3) - double precision, external :: j1b_nucl + double precision, external :: env_nucl int = 0.d0 @@ -339,7 +263,7 @@ subroutine I_grade_gradu_naive2(i, j, k, l, int) aor_i = aos_in_r_array_transp(ipoint,i) aor_k = aos_in_r_array_transp(ipoint,k) - call grad1_j1b_nucl_square_num(r1, e1_square_der) + call grad1_env_nucl_square_num(r1, e1_square_der) weight1_x = aor_i * aor_k * final_weight_at_r_vector(ipoint) * e1_square_der(1) weight1_y = aor_i * aor_k * final_weight_at_r_vector(ipoint) * e1_square_der(2) @@ -354,7 +278,7 @@ subroutine I_grade_gradu_naive2(i, j, k, l, int) aor_j = aos_in_r_array_extra_transp(jpoint,j) aor_l = aos_in_r_array_extra_transp(jpoint,l) - e2_val = j1b_nucl(r2) + e2_val = env_nucl(r2) call grad1_j12_mu_square_num(r1, r2, u12_square_der) weight2_x = aor_j * aor_l * e2_val * e2_val * final_weight_at_r_vector_extra(jpoint) * u12_square_der(1) @@ -380,7 +304,7 @@ subroutine I_grade_gradu_naive3(i, j, k, l, int) double precision :: weight1, weight2 double precision :: aor_j, aor_l double precision :: grad(3), e2_val, u12_val - double precision, external :: j1b_nucl, j12_mu + double precision, external :: env_nucl, j12_mu int = 0.d0 @@ -403,7 +327,7 @@ subroutine I_grade_gradu_naive3(i, j, k, l, int) aor_j = aos_in_r_array_extra_transp(jpoint,j) aor_l = aos_in_r_array_extra_transp(jpoint,l) - e2_val = j1b_nucl(r2) + e2_val = env_nucl(r2) u12_val = j12_mu(r1, r2) weight2 = aor_j * aor_l * e2_val * e2_val * u12_val * u12_val * final_weight_at_r_vector_extra(jpoint) @@ -427,7 +351,7 @@ subroutine I_grade_gradu_naive4(i, j, k, l, int) double precision :: weight1, weight2 double precision :: aor_j, aor_l, aor_k, aor_i double precision :: grad(3), e2_val, u12_val - double precision, external :: j1b_nucl, j12_mu + double precision, external :: env_nucl, j12_mu int = 0.d0 @@ -440,10 +364,10 @@ subroutine I_grade_gradu_naive4(i, j, k, l, int) aor_i = aos_in_r_array_transp(ipoint,i) aor_k = aos_in_r_array_transp(ipoint,k) - weight1 = final_weight_at_r_vector(ipoint) * ( aor_k * aor_i * v_1b_square_lapl(ipoint) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,1) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * v_1b_square_grad(ipoint,1) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,2) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * v_1b_square_grad(ipoint,2) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,3) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * v_1b_square_grad(ipoint,3) ) + weight1 = final_weight_at_r_vector(ipoint) * ( aor_k * aor_i * env_square_lapl(ipoint) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,1) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,2) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,3) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) do jpoint = 1, n_points_extra_final_grid ! r2 @@ -454,7 +378,7 @@ subroutine I_grade_gradu_naive4(i, j, k, l, int) aor_j = aos_in_r_array_extra_transp(jpoint,j) aor_l = aos_in_r_array_extra_transp(jpoint,l) - e2_val = j1b_nucl(r2) + e2_val = env_nucl(r2) u12_val = j12_mu(r1, r2) weight2 = aor_j * aor_l * e2_val * e2_val * u12_val * u12_val * final_weight_at_r_vector_extra(jpoint) @@ -464,7 +388,7 @@ subroutine I_grade_gradu_naive4(i, j, k, l, int) enddo return -end subroutine I_grade_gradu_naive4 +end ! --- @@ -485,16 +409,16 @@ subroutine I_grade_gradu_seminaive(i, j, k, l, int) aor_i = aos_in_r_array_transp(ipoint,i) aor_k = aos_in_r_array_transp(ipoint,k) - weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) * ( aor_k * aor_i * v_1b_square_lapl(ipoint) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,1) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * v_1b_square_grad(ipoint,1) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,2) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * v_1b_square_grad(ipoint,2) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,3) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * v_1b_square_grad(ipoint,3) ) + weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) * ( aor_k * aor_i * env_square_lapl(ipoint) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,1) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,2) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,3) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) - int = int + weight1 * int2_u2_j1b2(j,l,ipoint) + int = int + weight1 * int2_u2_env2(j,l,ipoint) enddo return -end subroutine I_grade_gradu_seminaive +end ! --- @@ -508,7 +432,7 @@ subroutine aos_ik_grad1_esquare(i, k, r1, val) double precision :: der(3), aos_array(ao_num), aos_grad_array(3,ao_num) call give_all_aos_and_grad_at_r(r1, aos_array, aos_grad_array) - call grad1_j1b_nucl_square_num(r1, der) + call grad1_env_nucl_square_num(r1, der) tmp = aos_array(i) * aos_array(k) val(1) = tmp * der(1) @@ -559,14 +483,14 @@ end subroutine grad1_aos_ik_grad1_esquare ! --- -subroutine test_v_ij_u_cst_mu_j1b_an() +subroutine test_v_ij_u_cst_mu_env_an() implicit none integer :: i, j, ipoint double precision :: I_old, I_new double precision :: norm, accu, thr, diff - PROVIDE v_ij_u_cst_mu_j1b_an_old v_ij_u_cst_mu_j1b_an + PROVIDE v_ij_u_cst_mu_env_an_old v_ij_u_cst_mu_env_an thr = 1d-12 norm = 0.d0 @@ -575,8 +499,8 @@ subroutine test_v_ij_u_cst_mu_j1b_an() do i = 1, ao_num do j = 1, ao_num - I_old = v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) - I_new = v_ij_u_cst_mu_j1b_an (j,i,ipoint) + I_old = v_ij_u_cst_mu_env_an_old(j,i,ipoint) + I_new = v_ij_u_cst_mu_env_an (j,i,ipoint) diff = dabs(I_new-I_old) if(diff .gt. thr) then @@ -595,7 +519,7 @@ subroutine test_v_ij_u_cst_mu_j1b_an() print*, ' accuracy(%) = ', 100.d0 * accu / norm return -end subroutine test_v_ij_u_cst_mu_j1b_an +end ! --- diff --git a/plugins/local/non_h_ints_mu/total_tc_int.irp.f b/plugins/local/non_h_ints_mu/total_tc_int.irp.f index 9c19e0ac..a940455e 100644 --- a/plugins/local/non_h_ints_mu/total_tc_int.irp.f +++ b/plugins/local/non_h_ints_mu/total_tc_int.irp.f @@ -1,188 +1,383 @@ ! --- -BEGIN_PROVIDER [double precision, ao_vartc_int_chemist, (ao_num, ao_num, ao_num, ao_num)] +BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num)] + + BEGIN_DOC + ! + ! CHEMIST NOTATION IS USED + ! + ! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) + ! = where V^TC(r_12) is the total TC operator + ! = tc_grad_and_lapl_ao(k,i,l,j) + tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) + ! + ! where: + ! + ! tc_grad_and_lapl_ao(k,i,l,j) = < k l | -1/2 \Delta_1 u(r1,r2) - \grad_1 u(r1,r2) . \grad_1 | ij > + ! = -1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) + ! = 1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 (-1) \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) + ! + ! tc_grad_square_ao(k,i,l,j) = -1/2 + ! + ! ao_two_e_coul(k,i,l,j) = < l k | 1/r12 | j i > = ( k i | 1/r12 | l j ) + ! + END_DOC implicit none - integer :: i, j, k, l - double precision :: wall1, wall0 + integer :: i, j, k, l, m, ipoint + double precision :: wall1, wall0 + double precision :: weight1, ao_k_r, ao_i_r + double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq + double precision :: time0, time1 + double precision, allocatable :: b_mat(:,:,:,:), c_mat(:,:,:) + double precision, external :: get_ao_two_e_integral + + PROVIDE env_type + PROVIDE j2e_type + PROVIDE j1e_type - print *, ' providing ao_vartc_int_chemist ...' call wall_time(wall0) - - if(test_cycle_tc) then - PROVIDE j1b_type - if(j1b_type .ne. 3) then - print*, ' TC integrals with cycle can not be used for j1b_type =', j1b_type - stop - endif + print *, ' providing ao_two_e_tc_tot ...' + print*, ' j2e_type: ', j2e_type + print*, ' j1e_type: ', j1e_type + print*, ' env_type: ', env_type - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_vartc_int_chemist(k,i,l,j) = tc_grad_square_ao_test(k,i,l,j) + ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo + if(read_tc_integ) then + + print*, ' Reading ao_two_e_tc_tot from ', trim(ezfio_filename) // '/work/ao_two_e_tc_tot' + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/ao_two_e_tc_tot', action="read") + read(11) ao_two_e_tc_tot + close(11) else + PROVIDE tc_integ_type + print*, ' approach for integrals: ', tc_integ_type + + ! --- + + PROVIDE int2_grad1_u12_ao + + allocate(b_mat(n_points_final_grid,ao_num,ao_num,3)) + + b_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, aos_grad_in_r_array_transp_bis, b_mat, & + !$OMP ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + b_mat(ipoint,k,i,1) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) + b_mat(ipoint,k,i,2) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) + b_mat(ipoint,k,i,3) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + ao_two_e_tc_tot = 0.d0 + do m = 1, 3 + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, b_mat(1,1,1,m), n_points_final_grid & + , 1.d0, ao_two_e_tc_tot, ao_num*ao_num) + enddo + deallocate(b_mat) + + ! --- + + PROVIDE int2_grad1_u12_square_ao + + allocate(c_mat(n_points_final_grid,ao_num,ao_num)) + + c_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + c_mat(ipoint,k,i) = final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,k) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_grad1_u12_square_ao(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 0.d0, ao_two_e_tc_tot, ao_num*ao_num) + + FREE int2_grad1_u12_square_ao + + if( (j2e_type .eq. "rs-dft") .and. & + ((env_type .eq. "prod_gauss") .or. (env_type .eq. "sum-gauss")) .and. & + use_ipp ) then + + print*, " going through Manu's IPP" + + ! an additional term is added here directly instead of + ! being added in int2_grad1_u12_square_ao for performance + + PROVIDE int2_u2_env2 + + c_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & + !$OMP env_square_grad, env_square_lapl, aos_grad_in_r_array_transp_bis) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) + + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + c_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * env_square_lapl(ipoint) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_u2_env2(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 1.d0, ao_two_e_tc_tot, ao_num*ao_num) + + FREE int2_u2_env2 + endif ! use_ipp + + deallocate(c_mat) + + ! --- + + call sum_A_At(ao_two_e_tc_tot(1,1,1,1), ao_num*ao_num) + + PROVIDE ao_integrals_map + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(ao_num, ao_two_e_tc_tot, ao_integrals_map) & + !$OMP PRIVATE(i, j, k, l) + !$OMP DO do j = 1, ao_num do l = 1, ao_num do i = 1, ao_num do k = 1, ao_num - ao_vartc_int_chemist(k,i,l,j) = tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) + ! < 1:i, 2:j | 1:k, 2:l > + ao_two_e_tc_tot(k,i,l,j) = ao_two_e_tc_tot(k,i,l,j) + get_ao_two_e_integral(i, j, k, l, ao_integrals_map) enddo enddo enddo enddo + !$OMP END DO + !$OMP END PARALLEL - endif - - call wall_time(wall1) - print *, ' wall time for ao_vartc_int_chemist ', wall1 - wall0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_tc_int_chemist, (ao_num, ao_num, ao_num, ao_num)] - - implicit none - integer :: i, j, k, l - double precision :: wall1, wall0 - - PROVIDE j1b_type - - print *, ' providing ao_tc_int_chemist ...' - call wall_time(wall0) - - if(test_cycle_tc) then - - if(j1b_type .ne. 3) then - print*, ' TC integrals with cycle can not be used for j1b_type =', j1b_type - stop + if(tc_integ_type .ge. "numeric") then + FREE int2_grad1_u12_ao_num int2_grad1_u12_square_ao_num endif - ao_tc_int_chemist = ao_tc_int_chemist_test + endif ! read_tc_integ - else - - PROVIDE tc_grad_square_ao tc_grad_and_lapl_ao ao_two_e_coul - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_tc_int_chemist(k,i,l,j) = tc_grad_square_ao(k,i,l,j) + tc_grad_and_lapl_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) -! ao_tc_int_chemist(k,i,l,j) = ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo + if(write_tc_integ .and. mpi_master) then + print*, ' Saving ao_two_e_tc_tot in ', trim(ezfio_filename) // '/work/ao_two_e_tc_tot' + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/ao_two_e_tc_tot', action="write") + call ezfio_set_work_empty(.False.) + write(11) ao_two_e_tc_tot + close(11) + call ezfio_set_tc_keywords_io_tc_integ('Read') endif - FREE tc_grad_square_ao tc_grad_and_lapl_ao ao_two_e_coul - - if(j1b_type .ge. 100) then - FREE int2_grad1_u12_ao_num int2_grad1_u12_square_ao_num - endif - - - call wall_time(wall1) - print *, ' wall time for ao_tc_int_chemist ', wall1 - wall0 + call wall_time(time1) + print*, ' Wall time for ao_two_e_tc_tot (min) = ', (time1 - time0) / 60.d0 call print_memory_usage() END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, ao_tc_int_chemist_no_cycle, (ao_num, ao_num, ao_num, ao_num)] - - implicit none - integer :: i, j, k, l - double precision :: wall1, wall0 - - print *, ' providing ao_tc_int_chemist_no_cycle ...' - call wall_time(wall0) - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_tc_int_chemist_no_cycle(k,i,l,j) = tc_grad_square_ao(k,i,l,j) + tc_grad_and_lapl_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) - !ao_tc_int_chemist(k,i,l,j) = ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo - - call wall_time(wall1) - print *, ' wall time for ao_tc_int_chemist_no_cycle ', wall1 - wall0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_tc_int_chemist_test, (ao_num, ao_num, ao_num, ao_num)] - - implicit none - integer :: i, j, k, l - double precision :: wall1, wall0 - - print *, ' providing ao_tc_int_chemist_test ...' - call wall_time(wall0) - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_tc_int_chemist_test(k,i,l,j) = tc_grad_square_ao_test(k,i,l,j) + tc_grad_and_lapl_ao_test(k,i,l,j) + ao_two_e_coul(k,i,l,j) -! ao_tc_int_chemist_test(k,i,l,j) = ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo - - call wall_time(wall1) - print *, ' wall time for ao_tc_int_chemist_test ', wall1 - wall0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_two_e_coul, (ao_num, ao_num, ao_num, ao_num) ] +BEGIN_PROVIDER [double precision, ao_two_e_vartc_tot, (ao_num, ao_num, ao_num, ao_num)] BEGIN_DOC ! - ! ao_two_e_coul(k,i,l,j) = ( k i | 1/r12 | l j ) = < l k | 1/r12 | j i > + ! CHEMIST NOTATION IS USED + ! + ! ao_two_e_vartc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) + ! = where V^TC(r_12) is the total TC operator + ! = tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) + ! + ! where: + ! + ! tc_grad_square_ao(k,i,l,j) = -1/2 + ! + ! ao_two_e_coul(k,i,l,j) = < l k | 1/r12 | j i > = ( k i | 1/r12 | l j ) ! END_DOC - integer :: i, j, k, l - double precision, external :: get_ao_two_e_integral + implicit none + integer :: i, j, k, l, ipoint + double precision :: wall1, wall0 + double precision :: weight1, ao_k_r, ao_i_r + double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq + double precision :: time0, time1 + double precision, allocatable :: c_mat(:,:,:) + double precision, external :: get_ao_two_e_integral - PROVIDE ao_integrals_map + PROVIDE env_type + PROVIDE j2e_type + PROVIDE j1e_type - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP SHARED(ao_num, ao_two_e_coul, ao_integrals_map) & - !$OMP PRIVATE(i, j, k, l) - !$OMP DO - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ! < 1:k, 2:l | 1:i, 2:j > - ao_two_e_coul(k,i,l,j) = get_ao_two_e_integral(i, j, k, l, ao_integrals_map) + call wall_time(wall0) + + print *, ' providing ao_two_e_vartc_tot ...' + print*, ' j2e_type: ', j2e_type + print*, ' j1e_type: ', j1e_type + print*, ' env_type: ', env_type + + if(read_tc_integ) then + + print*, ' Reading ao_two_e_vartc_tot from ', trim(ezfio_filename) // '/work/ao_two_e_vartc_tot' + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/ao_two_e_vartc_tot', action="read") + read(11) ao_two_e_vartc_tot + close(11) + + else + + PROVIDE tc_integ_type + print*, ' approach for integrals: ', tc_integ_type + + PROVIDE int2_grad1_u12_square_ao + + allocate(c_mat(n_points_final_grid,ao_num,ao_num)) + + c_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + c_mat(ipoint,k,i) = final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,k) enddo enddo enddo - enddo - !$OMP END DO - !$OMP END PARALLEL + !$OMP END DO + !$OMP END PARALLEL + + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_grad1_u12_square_ao(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 0.d0, ao_two_e_vartc_tot, ao_num*ao_num) + + FREE int2_grad1_u12_square_ao + + if( (j2e_type .eq. "rs-dft") .and. & + ((env_type .eq. "prod_gauss") .or. (env_type .eq. "sum-gauss")) .and. & + use_ipp ) then + + print*, " going through Manu's IPP" + + ! an additional term is added here directly instead of + ! being added in int2_grad1_u12_square_ao for performance + + PROVIDE int2_u2_env2 + + c_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & + !$OMP env_square_grad, env_square_lapl, aos_grad_in_r_array_transp_bis) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) + + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + c_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * env_square_lapl(ipoint) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_u2_env2(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 1.d0, ao_two_e_vartc_tot, ao_num*ao_num) + + FREE int2_u2_env2 + endif ! use_ipp + + deallocate(c_mat) + + ! --- + + call sum_A_At(ao_two_e_vartc_tot(1,1,1,1), ao_num*ao_num) + + PROVIDE ao_integrals_map + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(ao_num, ao_two_e_vartc_tot, ao_integrals_map) & + !$OMP PRIVATE(i, j, k, l) + !$OMP DO + do j = 1, ao_num + do l = 1, ao_num + do i = 1, ao_num + do k = 1, ao_num + ! < 1:i, 2:j | 1:k, 2:l > + ao_two_e_vartc_tot(k,i,l,j) = ao_two_e_vartc_tot(k,i,l,j) + get_ao_two_e_integral(i, j, k, l, ao_integrals_map) + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + if(tc_integ_type .ge. "numeric") then + FREE int2_grad1_u12_ao_num int2_grad1_u12_square_ao_num + endif + + endif ! read_tc_integ + + if(write_tc_integ .and. mpi_master) then + print*, ' Saving ao_two_e_vartc_tot in ', trim(ezfio_filename) // '/work/ao_two_e_vartc_tot' + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/ao_two_e_vartc_tot', action="write") + call ezfio_set_work_empty(.False.) + write(11) ao_two_e_vartc_tot + close(11) + call ezfio_set_tc_keywords_io_tc_integ('Read') + endif + + call wall_time(time1) + print*, ' Wall time for ao_two_e_vartc_tot (min) = ', (time1 - time0) / 60.d0 + call print_memory_usage() END_PROVIDER diff --git a/plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f b/plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f index ab9dc093..1142658d 100644 --- a/plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f +++ b/plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f @@ -24,10 +24,6 @@ subroutine delta_right() integer :: k double precision, allocatable :: delta(:,:) - print *, j1b_type - print *, j1b_pen - print *, mu_erf - allocate( delta(N_det,N_states) ) delta = 0.d0 @@ -48,7 +44,7 @@ subroutine delta_right() deallocate(delta) return -end subroutine delta_right +end ! --- diff --git a/plugins/local/tc_bi_ortho/print_tc_energy.irp.f b/plugins/local/tc_bi_ortho/print_tc_energy.irp.f index 7bca72a1..fe7c2d10 100644 --- a/plugins/local/tc_bi_ortho/print_tc_energy.irp.f +++ b/plugins/local/tc_bi_ortho/print_tc_energy.irp.f @@ -17,9 +17,6 @@ program print_tc_energy read_wf = .True. touch read_wf - PROVIDE j1b_type - print*, 'j1b_type = ', j1b_type - call write_tc_energy() end diff --git a/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f b/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f index ffcd9b22..6b3acce6 100644 --- a/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f +++ b/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f @@ -17,7 +17,7 @@ program tc_natorb_bi_ortho my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r diff --git a/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f b/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f index b1751069..02352a32 100644 --- a/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f +++ b/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f @@ -260,7 +260,6 @@ subroutine single_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, ! ! PROVIDE core_bitmask core_fock_operator mo_integrals_erf_map -! PROVIDE j1b_gauss other_spin(1) = 2 other_spin(2) = 1 @@ -295,15 +294,6 @@ subroutine single_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, hmono = mo_bi_ortho_tc_one_e(p1,h1) * phase -! if(j1b_gauss .eq. 1) then -! print*,'j1b not implemented for bi ortho TC' -! print*,'stopping ....' -! stop -! !hmono += ( mo_j1b_gauss_hermI (h1,p1) & -! ! + mo_j1b_gauss_hermII (h1,p1) & -! ! + mo_j1b_gauss_nonherm(h1,p1) ) * phase -! endif - ! if(core_tc_op)then ! print*,'core_tc_op not already taken into account for bi ortho' ! print*,'stopping ...' diff --git a/plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f index e27672a2..64982ab6 100644 --- a/plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f +++ b/plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f @@ -13,7 +13,7 @@ program tc_bi_ortho my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r diff --git a/plugins/local/tc_bi_ortho/tc_som.irp.f b/plugins/local/tc_bi_ortho/tc_som.irp.f index 427508d2..1d11c81b 100644 --- a/plugins/local/tc_bi_ortho/tc_som.irp.f +++ b/plugins/local/tc_bi_ortho/tc_som.irp.f @@ -17,12 +17,6 @@ program tc_som my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - PROVIDE mu_erf - print *, ' mu = ', mu_erf - PROVIDE j1b_type - print *, ' j1b_type = ', j1b_type - print *, j1b_pen - read_wf = .true. touch read_wf diff --git a/plugins/local/tc_keywords/EZFIO.cfg b/plugins/local/tc_keywords/EZFIO.cfg index ac2cfda2..ee2d5112 100644 --- a/plugins/local/tc_keywords/EZFIO.cfg +++ b/plugins/local/tc_keywords/EZFIO.cfg @@ -130,30 +130,6 @@ doc: if +1: only positive is selected, -1: only negative is selected, :0 both po interface: ezfio,provider,ocaml default: 0 -[j1b_pen] -type: double precision -doc: exponents of the 1-body Jastrow -interface: ezfio -size: (nuclei.nucl_num) - -[j1b_pen_coef] -type: double precision -doc: coefficients of the 1-body Jastrow -interface: ezfio -size: (nuclei.nucl_num) - -[j1b_coeff] -type: double precision -doc: coeff of the 1-body Jastrow -interface: ezfio -size: (nuclei.nucl_num) - -[j1b_type] -type: integer -doc: type of 1-body Jastrow -interface: ezfio, provider, ocaml -default: 0 - [mu_r_ct] type: double precision doc: a parameter used to define mu(r) @@ -304,3 +280,9 @@ doc: size of radial grid over r2 interface: ezfio,provider,ocaml default: 50 +[tc_integ_type] +type: character*(32) +doc: approach used to evaluate TC integrals [analytic | numeric | semi-analytic] +interface: ezfio,ocaml,provider +default: semi-analytic + diff --git a/plugins/local/tc_keywords/j1b_pen.irp.f b/plugins/local/tc_keywords/j1b_pen.irp.f deleted file mode 100644 index d509fc7e..00000000 --- a/plugins/local/tc_keywords/j1b_pen.irp.f +++ /dev/null @@ -1,155 +0,0 @@ - -! --- - - BEGIN_PROVIDER [ double precision, j1b_pen , (nucl_num) ] -&BEGIN_PROVIDER [ double precision, j1b_pen_coef, (nucl_num) ] - - BEGIN_DOC - ! parameters of the 1-body Jastrow - END_DOC - - implicit none - logical :: exists - integer :: i - integer :: ierr - - PROVIDE ezfio_filename - - ! --- - - if (mpi_master) then - call ezfio_has_tc_keywords_j1b_pen(exists) - endif - - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - - IRP_IF MPI - include 'mpif.h' - call MPI_BCAST(j1b_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_pen with MPI' - endif - IRP_ENDIF - - if (exists) then - if (mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1b_pen ] <<<<< ..' - call ezfio_get_tc_keywords_j1b_pen(j1b_pen) - IRP_IF MPI - call MPI_BCAST(j1b_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_pen with MPI' - endif - IRP_ENDIF - endif - else - do i = 1, nucl_num - j1b_pen(i) = 1d5 - enddo - endif - - ! --- - - if (mpi_master) then - call ezfio_has_tc_keywords_j1b_pen_coef(exists) - endif - - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - - IRP_IF MPI - call MPI_BCAST(j1b_pen_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_pen_coef with MPI' - endif - IRP_ENDIF - - if (exists) then - if (mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1b_pen_coef ] <<<<< ..' - call ezfio_get_tc_keywords_j1b_pen_coef(j1b_pen_coef) - IRP_IF MPI - call MPI_BCAST(j1b_pen_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_pen_coef with MPI' - endif - IRP_ENDIF - endif - else - do i = 1, nucl_num - j1b_pen_coef(i) = 1d0 - enddo - endif - - ! --- - - print *, ' parameters for nuclei jastrow' - print *, ' i, Z, j1b_pen, j1b_pen_coef' - do i = 1, nucl_num - write(*,'(I4, 2x, 3(E15.7, 2X))') i, nucl_charge(i), j1b_pen(i), j1b_pen_coef(i) - enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, j1b_coeff, (nucl_num) ] - - BEGIN_DOC - ! coefficients of the 1-body Jastrow - END_DOC - - implicit none - logical :: exists - - PROVIDE ezfio_filename - - if (mpi_master) then - call ezfio_has_tc_keywords_j1b_coeff(exists) - endif - - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - - IRP_IF MPI - include 'mpif.h' - integer :: ierr - call MPI_BCAST(j1b_coeff, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_coeff with MPI' - endif - IRP_ENDIF - - if (exists) then - - if (mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1b_coeff ] <<<<< ..' - call ezfio_get_tc_keywords_j1b_coeff(j1b_coeff) - IRP_IF MPI - call MPI_BCAST(j1b_coeff, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_coeff with MPI' - endif - IRP_ENDIF - endif - - else - - integer :: i - do i = 1, nucl_num - j1b_coeff(i) = 0d5 - enddo - - endif - -END_PROVIDER - -! --- - diff --git a/plugins/local/tc_scf/print_tcscf_energy.irp.f b/plugins/local/tc_scf/print_tcscf_energy.irp.f index 05b8df23..6f9afd9a 100644 --- a/plugins/local/tc_scf/print_tcscf_energy.irp.f +++ b/plugins/local/tc_scf/print_tcscf_energy.irp.f @@ -24,11 +24,15 @@ subroutine main() implicit none double precision :: etc_tot, etc_1e, etc_2e, etc_3e - PROVIDE mu_erf - PROVIDE j1b_type + PROVIDE j2e_type mu_erf + PROVIDE j1e_type j1e_coef j1e_expo + PROVIDE env_type env_coef env_expo + + print*, ' j2e_type = ', j2e_type + print*, ' j1e_type = ', j1e_type + print*, ' env_type = ', env_type print*, ' mu_erf = ', mu_erf - print*, ' j1b_type = ', j1b_type etc_tot = TC_HF_energy etc_1e = TC_HF_one_e_energy diff --git a/plugins/local/tc_scf/tc_scf.irp.f b/plugins/local/tc_scf/tc_scf.irp.f index fb86a752..d8c5ab66 100644 --- a/plugins/local/tc_scf/tc_scf.irp.f +++ b/plugins/local/tc_scf/tc_scf.irp.f @@ -10,9 +10,16 @@ program tc_scf integer :: i logical :: good_angles - write(json_unit,json_array_open_fmt) 'tc-scf' + PROVIDE j1e_type + PROVIDE j2e_type + PROVIDE tcscf_algorithm + PROVIDE var_tc - print *, ' starting ...' + print *, ' TC-SCF with:' + print *, ' j1e_type = ', j1e_type + print *, ' j2e_type = ', j2e_type + + write(json_unit,json_array_open_fmt) 'tc-scf' my_grid_becke = .True. PROVIDE tc_grid1_a tc_grid1_r @@ -24,13 +31,7 @@ program tc_scf call write_int(6, my_n_pt_a_grid, 'angular external grid over') - PROVIDE mu_erf - print *, ' mu = ', mu_erf - PROVIDE j1b_type - print *, ' j1b_type = ', j1b_type - print *, j1b_pen - - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r @@ -44,8 +45,6 @@ program tc_scf !call create_guess() !call orthonormalize_mos() - PROVIDE tcscf_algorithm - PROVIDE var_tc if(var_tc) then diff --git a/plugins/local/tc_scf/test_int.irp.f b/plugins/local/tc_scf/test_int.irp.f index 4aa67d04..adaacfa5 100644 --- a/plugins/local/tc_scf/test_int.irp.f +++ b/plugins/local/tc_scf/test_int.irp.f @@ -1,7 +1,7 @@ program test_ints BEGIN_DOC -! TODO : Put the documentation of the program here + ! TODO : Put the documentation of the program here END_DOC implicit none @@ -20,37 +20,28 @@ program test_ints touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid !! OK -! call routine_int2_u_grad1u_j1b2 +! call routine_int2_u_grad1u_env2 ! OK -! call routine_v_ij_erf_rk_cst_mu_j1b +! call routine_v_ij_erf_rk_cst_mu_env ! OK -! call routine_x_v_ij_erf_rk_cst_mu_j1b +! call routine_x_v_ij_erf_rk_cst_mu_env ! OK -! call routine_int2_u2_j1b2 +! call routine_int2_u2_env2 ! OK -! call routine_int2_u_grad1u_x_j1b2 +! call routine_int2_u_grad1u_x_env2 ! OK -! call routine_int2_grad1u2_grad2u2_j1b2 -! call routine_int2_u_grad1u_j1b2 -! call test_total_grad_lapl -! call test_total_grad_square +! call routine_int2_grad1u2_grad2u2_env2 +! call routine_int2_u_grad1u_env2 ! call test_int2_grad1_u12_ao_test -! call routine_v_ij_u_cst_mu_j1b_test -! call test_ao_tc_int_chemist +! call routine_v_ij_u_cst_mu_env_test ! call test_grid_points_ao -! call test_tc_scf !call test_int_gauss !call test_fock_3e_uhf_ao() !call test_fock_3e_uhf_mo() - !call test_tc_grad_and_lapl_ao() - !call test_tc_grad_square_ao() - !call test_two_e_tc_non_hermit_integral() -! call test_tc_grad_square_ao_test() - !!PROVIDE TC_HF_energy VARTC_HF_energy !!print *, ' TC_HF_energy = ', TC_HF_energy !!print *, ' VARTC_HF_energy = ', VARTC_HF_energy @@ -64,47 +55,21 @@ end ! --- -subroutine test_tc_scf - implicit none - integer :: i -! provide int2_u_grad1u_x_j1b2_test - provide x_v_ij_erf_rk_cst_mu_j1b_test -! do i = 1, ng_fit_jast -! print*,expo_gauss_1_erf_x_2(i),coef_gauss_1_erf_x_2(i) -! enddo -! provide tc_grad_square_ao_test -! provide tc_grad_and_lapl_ao_test -! provide int2_u_grad1u_x_j1b2_test -! provide x_v_ij_erf_rk_cst_mu_j1b_test -! print*,'TC_HF_energy = ',TC_HF_energy -! print*,'grad_non_hermit = ',grad_non_hermit -end - -subroutine test_ao_tc_int_chemist - implicit none - provide ao_tc_int_chemist -! provide ao_tc_int_chemist_test -! provide tc_grad_square_ao_test -! provide tc_grad_and_lapl_ao_test -end - -! --- - -subroutine routine_test_j1b +subroutine routine_test_env implicit none integer :: i,icount,j icount = 0 - do i = 1, List_all_comb_b3_size - if(dabs(List_all_comb_b3_coef(i)).gt.1.d-10)then + do i = 1, List_env1s_square_size + if(dabs(List_env1s_square_coef(i)).gt.1.d-10)then print*,'' - print*,List_all_comb_b3_expo(i),List_all_comb_b3_coef(i) - print*,List_all_comb_b3_cent(1:3,i) + print*,List_env1s_square_expo(i),List_env1s_square_coef(i) + print*,List_env1s_square_cent(1:3,i) print*,'' icount += 1 endif enddo - print*,'List_all_comb_b3_coef,icount = ',List_all_comb_b3_size,icount + print*,'List_env1s_square_coef,icount = ',List_env1s_square_size,icount do i = 1, ao_num do j = 1, ao_num do icount = 1, List_comb_thr_b3_size(j,i) @@ -116,11 +81,11 @@ subroutine routine_test_j1b ! enddo enddo enddo - print*,'max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size,List_all_comb_b3_size + print*,'max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size,List_env1s_square_size end -subroutine routine_int2_u_grad1u_j1b2 +subroutine routine_int2_u_grad1u_env2 implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -136,8 +101,8 @@ subroutine routine_int2_u_grad1u_j1b2 do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += int2_u_grad1u_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += int2_u_grad1u_j1b2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += int2_u_grad1u_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += int2_u_grad1u_env2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -160,7 +125,7 @@ subroutine routine_int2_u_grad1u_j1b2 enddo print*,'******' print*,'******' - print*,'routine_int2_u_grad1u_j1b2' + print*,'routine_int2_u_grad1u_env2' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -168,7 +133,7 @@ subroutine routine_int2_u_grad1u_j1b2 end -subroutine routine_v_ij_erf_rk_cst_mu_j1b +subroutine routine_v_ij_erf_rk_cst_mu_env implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -183,8 +148,8 @@ subroutine routine_v_ij_erf_rk_cst_mu_j1b do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += v_ij_erf_rk_cst_mu_env(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -207,7 +172,7 @@ subroutine routine_v_ij_erf_rk_cst_mu_j1b enddo print*,'******' print*,'******' - print*,'routine_v_ij_erf_rk_cst_mu_j1b' + print*,'routine_v_ij_erf_rk_cst_mu_env' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -216,7 +181,7 @@ subroutine routine_v_ij_erf_rk_cst_mu_j1b end -subroutine routine_x_v_ij_erf_rk_cst_mu_j1b +subroutine routine_x_v_ij_erf_rk_cst_mu_env implicit none integer :: i,j,ipoint,k,l,m double precision :: weight,accu_relat, accu_abs, contrib @@ -232,8 +197,8 @@ subroutine routine_x_v_ij_erf_rk_cst_mu_j1b do i = 1, ao_num do j = 1, ao_num do m = 1, 3 - array(j,i,l,k) += x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += x_v_ij_erf_rk_cst_mu_j1b (j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += x_v_ij_erf_rk_cst_mu_env (j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -258,7 +223,7 @@ subroutine routine_x_v_ij_erf_rk_cst_mu_j1b print*,'******' print*,'******' - print*,'routine_x_v_ij_erf_rk_cst_mu_j1b' + print*,'routine_x_v_ij_erf_rk_cst_mu_env' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -268,7 +233,7 @@ end -subroutine routine_v_ij_u_cst_mu_j1b_test +subroutine routine_v_ij_u_cst_mu_env_test implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -283,8 +248,8 @@ subroutine routine_v_ij_u_cst_mu_j1b_test do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += v_ij_u_cst_mu_j1b_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += v_ij_u_cst_mu_j1b_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += v_ij_u_cst_mu_env_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += v_ij_u_cst_mu_env_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -307,15 +272,13 @@ subroutine routine_v_ij_u_cst_mu_j1b_test enddo print*,'******' print*,'******' - print*,'routine_v_ij_u_cst_mu_j1b_test' + print*,'routine_v_ij_u_cst_mu_env_test' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 - - end -subroutine routine_int2_grad1u2_grad2u2_j1b2 +subroutine routine_int2_grad1u2_grad2u2_env2 implicit none integer :: i,j,ipoint,k,l integer :: ii , jj @@ -341,17 +304,17 @@ subroutine routine_int2_grad1u2_grad2u2_j1b2 do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight -! !array(j,i,l,k) += int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight -! array_ref(j,i,l,k) += int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += int2_grad1u2_grad2u2_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight +! !array(j,i,l,k) += int2_grad1u2_grad2u2_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight +! array_ref(j,i,l,k) += int2_grad1u2_grad2u2_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight ! !array(j,i,l,k) += ints(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight -! array_ref(j,i,l,k) += int2_grad1u2_grad2u2_j1b2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight +! array_ref(j,i,l,k) += int2_grad1u2_grad2u2_env2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight array_ref(j,i,l,k) += ints(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight -! if(dabs(int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint)).gt.1.d-6)then -! if(dabs(int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint)).gt.1.d-6)then +! if(dabs(int2_grad1u2_grad2u2_env2_test(j,i,ipoint)).gt.1.d-6)then +! if(dabs(int2_grad1u2_grad2u2_env2_test(j,i,ipoint) - int2_grad1u2_grad2u2_env2_test(j,i,ipoint)).gt.1.d-6)then ! print*,j,i,ipoint -! print*,int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) , int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint), dabs(int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint)) -! print*,int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint) , int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint), dabs(int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint) - int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint)) +! print*,int2_grad1u2_grad2u2_env2_test(j,i,ipoint) , int2_grad1u2_grad2u2_env2_test(j,i,ipoint), dabs(int2_grad1u2_grad2u2_env2_test(j,i,ipoint) - int2_grad1u2_grad2u2_env2_test(j,i,ipoint)) +! print*,int2_grad1u2_grad2u2_env2_test(i,j,ipoint) , int2_grad1u2_grad2u2_env2_test(i,j,ipoint), dabs(int2_grad1u2_grad2u2_env2_test(i,j,ipoint) - int2_grad1u2_grad2u2_env2_test(i,j,ipoint)) ! stop ! endif ! endif @@ -394,7 +357,7 @@ subroutine routine_int2_grad1u2_grad2u2_j1b2 end -subroutine routine_int2_u2_j1b2 +subroutine routine_int2_u2_env2 implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -410,8 +373,8 @@ subroutine routine_int2_u2_j1b2 do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += int2_u2_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += int2_u2_j1b2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += int2_u2_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += int2_u2_env2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -434,7 +397,7 @@ subroutine routine_int2_u2_j1b2 enddo print*,'******' print*,'******' - print*,'routine_int2_u2_j1b2' + print*,'routine_int2_u2_env2' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -443,7 +406,7 @@ subroutine routine_int2_u2_j1b2 end -subroutine routine_int2_u_grad1u_x_j1b2 +subroutine routine_int2_u_grad1u_x_env2 implicit none integer :: i,j,ipoint,k,l,m double precision :: weight,accu_relat, accu_abs, contrib @@ -460,8 +423,8 @@ subroutine routine_int2_u_grad1u_x_j1b2 do i = 1, ao_num do j = 1, ao_num do m = 1, 3 - array(j,i,l,k) += int2_u_grad1u_x_j1b2_test(j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += int2_u_grad1u_x_j1b2 (j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += int2_u_grad1u_x_env2_test(j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += int2_u_grad1u_x_env2 (j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -485,7 +448,7 @@ subroutine routine_int2_u_grad1u_x_j1b2 enddo print*,'******' print*,'******' - print*,'routine_int2_u_grad1u_x_j1b2' + print*,'routine_int2_u_grad1u_x_env2' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -493,7 +456,7 @@ subroutine routine_int2_u_grad1u_x_j1b2 end -subroutine routine_v_ij_u_cst_mu_j1b +subroutine routine_v_ij_u_cst_mu_env implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -509,8 +472,8 @@ subroutine routine_v_ij_u_cst_mu_j1b do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += v_ij_u_cst_mu_j1b_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += v_ij_u_cst_mu_j1b_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += v_ij_u_cst_mu_env_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += v_ij_u_cst_mu_env_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -533,7 +496,7 @@ subroutine routine_v_ij_u_cst_mu_j1b enddo print*,'******' print*,'******' - print*,'routine_v_ij_u_cst_mu_j1b' + print*,'routine_v_ij_u_cst_mu_env' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -674,66 +637,10 @@ subroutine test_fock_3e_uhf_mo() ! --- -end subroutine test_fock_3e_uhf_mo +end ! --- -subroutine test_total_grad_lapl - implicit none - integer :: i,j,ipoint,k,l - double precision :: weight,accu_relat, accu_abs, contrib - accu_relat = 0.d0 - accu_abs = 0.d0 - do k = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do j = 1, ao_num - contrib = dabs(tc_grad_and_lapl_ao_test(j,i,l,k) - tc_grad_and_lapl_ao(j,i,l,k)) - accu_abs += contrib - if(dabs(tc_grad_and_lapl_ao(j,i,l,k)).gt.1.d-10)then - accu_relat += contrib/dabs(tc_grad_and_lapl_ao(j,i,l,k)) - endif - enddo - enddo - enddo - enddo - print*,'******' - print*,'******' - print*,' test_total_grad_lapl' - print*,'accu_abs = ',accu_abs/dble(ao_num)**4 - print*,'accu_relat = ',accu_relat/dble(ao_num)**4 - - -end - -subroutine test_total_grad_square - implicit none - integer :: i,j,ipoint,k,l - double precision :: weight,accu_relat, accu_abs, contrib - accu_relat = 0.d0 - accu_abs = 0.d0 - do k = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do j = 1, ao_num - contrib = dabs(tc_grad_square_ao_test(j,i,l,k) - tc_grad_square_ao(j,i,l,k)) - accu_abs += contrib - if(dabs(tc_grad_square_ao(j,i,l,k)).gt.1.d-10)then - accu_relat += contrib/dabs(tc_grad_square_ao(j,i,l,k)) - endif - enddo - enddo - enddo - enddo - print*,'******' - print*,'******' - print*,'test_total_grad_square' - print*,'accu_abs = ',accu_abs/dble(ao_num)**4 - print*,'accu_relat = ',accu_relat/dble(ao_num)**4 - - -end - subroutine test_grid_points_ao implicit none integer :: i,j,ipoint,icount,icount_good, icount_bad,icount_full @@ -748,26 +655,26 @@ subroutine test_grid_points_ao icount_bad = 0 icount_full = 0 do ipoint = 1, n_points_final_grid -! if(dabs(int2_u_grad1u_x_j1b2_test(j,i,ipoint,1)) & -! + dabs(int2_u_grad1u_x_j1b2_test(j,i,ipoint,2)) & -! + dabs(int2_u_grad1u_x_j1b2_test(j,i,ipoint,3)) ) -! if(dabs(int2_u2_j1b2_test(j,i,ipoint)).gt.thr)then +! if(dabs(int2_u_grad1u_x_env2_test(j,i,ipoint,1)) & +! + dabs(int2_u_grad1u_x_env2_test(j,i,ipoint,2)) & +! + dabs(int2_u_grad1u_x_env2_test(j,i,ipoint,3)) ) +! if(dabs(int2_u2_env2_test(j,i,ipoint)).gt.thr)then ! icount += 1 ! endif - if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then + if(dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then icount_full += 1 endif - if(dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint)).gt.thr)then + if(dabs(v_ij_u_cst_mu_env_test(j,i,ipoint)).gt.thr)then icount += 1 - if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then + if(dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then icount_good += 1 else print*,j,i,ipoint - print*,dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint)),dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)),dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint))/dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint)) + print*,dabs(v_ij_u_cst_mu_env_test(j,i,ipoint)), dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint)),dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint))/dabs(v_ij_u_cst_mu_env_test(j,i,ipoint)) icount_bad += 1 endif endif -! if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr)then +! if(dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint)).gt.thr)then ! endif enddo print*,'' @@ -822,90 +729,6 @@ end ! --- -subroutine test_tc_grad_and_lapl_ao() - - implicit none - integer :: i, j, k, l - double precision :: diff_tot, diff, thr_ih, norm - - thr_ih = 1d-10 - - PROVIDE tc_grad_and_lapl_ao tc_grad_and_lapl_ao_loop - - norm = 0.d0 - diff_tot = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - - diff = dabs(tc_grad_and_lapl_ao_loop(l,k,j,i) - tc_grad_and_lapl_ao(l,k,j,i)) - if(diff .gt. thr_ih) then - print *, ' difference on ', l, k, j, i - print *, ' loops : ', tc_grad_and_lapl_ao_loop(l,k,j,i) - print *, ' lapack: ', tc_grad_and_lapl_ao (l,k,j,i) - !stop - endif - - norm += dabs(tc_grad_and_lapl_ao_loop(l,k,j,i)) - diff_tot += diff - enddo - enddo - enddo - enddo - - print *, ' diff tot = ', diff_tot / norm - print *, ' norm = ', norm - print *, ' ' - - return - -end - -! --- - -subroutine test_tc_grad_square_ao() - - implicit none - integer :: i, j, k, l - double precision :: diff_tot, diff, thr_ih, norm - - thr_ih = 1d-10 - - PROVIDE tc_grad_square_ao tc_grad_square_ao_loop - - norm = 0.d0 - diff_tot = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - - diff = dabs(tc_grad_square_ao_loop(l,k,j,i) - tc_grad_square_ao(l,k,j,i)) - if(diff .gt. thr_ih) then - print *, ' difference on ', l, k, j, i - print *, ' loops : ', tc_grad_square_ao_loop(l,k,j,i) - print *, ' lapack: ', tc_grad_square_ao (l,k,j,i) - !stop - endif - - norm += dabs(tc_grad_square_ao_loop(l,k,j,i)) - diff_tot += diff - enddo - enddo - enddo - enddo - - print *, ' diff tot = ', diff_tot / norm - print *, ' norm = ', norm - print *, ' ' - - return - -end - -! --- - subroutine test_two_e_tc_non_hermit_integral() implicit none @@ -973,52 +796,6 @@ end ! --- -subroutine test_tc_grad_square_ao_test() - - implicit none - integer :: i, j, k, l - double precision :: diff_tot, diff, thr_ih, norm - - print*, ' test_tc_grad_square_ao_test ' - - thr_ih = 1d-7 - - PROVIDE tc_grad_square_ao_test tc_grad_square_ao_test_ref - - norm = 0.d0 - diff_tot = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - - - diff = dabs(tc_grad_square_ao_test(l,k,j,i) - tc_grad_square_ao_test_ref(l,k,j,i)) - if(diff .gt. thr_ih) then - print *, ' difference on ', l, k, j, i - print *, ' new : ', tc_grad_square_ao_test (l,k,j,i) - print *, ' ref : ', tc_grad_square_ao_test_ref(l,k,j,i) - !stop - endif - - norm += dabs(tc_grad_square_ao_test_ref(l,k,j,i)) - diff_tot += diff - enddo - enddo - enddo - enddo - - print *, ' diff tot = ', diff_tot / norm - print *, ' norm = ', norm - print *, ' ' - - return -end - -! --- - - - subroutine test_old_ints implicit none integer :: i,j,k,l @@ -1034,7 +811,6 @@ subroutine test_old_ints ! 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) ! old = integral_sym + integral_nsym -! old = tc_grad_square_ao(k,i,l,j) + tc_grad_and_lapl_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) new = ao_tc_int_chemist_test(k,i,l,j) old = ao_tc_int_chemist_no_cycle(k,i,l,j) contrib = dabs(old - new) @@ -1146,7 +922,7 @@ subroutine test_fock_3e_uhf_mo_cs() print *, ' diff tot (%) = ', 100.d0 * diff_tot / norm return -end subroutine test_fock_3e_uhf_mo_cs +end ! --- @@ -1185,7 +961,7 @@ subroutine test_fock_3e_uhf_mo_a() print *, ' diff tot (%) = ', 100.d0 * diff_tot / norm return -end subroutine test_fock_3e_uhf_mo_a +end ! --- @@ -1224,7 +1000,7 @@ subroutine test_fock_3e_uhf_mo_b() print *, ' diff tot (%) = ', 100.d0 * diff_tot / norm return -end subroutine test_fock_3e_uhf_mo_b +end ! --- diff --git a/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f b/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f index 39ea0cdf..dac7c1cc 100644 --- a/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f +++ b/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f @@ -149,7 +149,3 @@ BEGIN_PROVIDER [ double precision, ao_prod_dist_grid, (ao_num, ao_num, n_points_ END_PROVIDER -!BEGIN_PROVIDER [ double precision, ao_abs_prod_j1b, (ao_num, ao_num)] -! implicit none -! -!END_PROVIDER diff --git a/src/hamiltonian/EZFIO.cfg b/src/hamiltonian/EZFIO.cfg index 672bfdfa..652a3e33 100644 --- a/src/hamiltonian/EZFIO.cfg +++ b/src/hamiltonian/EZFIO.cfg @@ -5,4 +5,64 @@ interface: ezfio,provider,ocaml default: 0.5 ezfio_name: mu_erf +[j2e_type] +type: character*(32) +doc: type of the 2e-Jastrow: [ rs-dft | rs-dft-murho | champ ] +interface: ezfio,provider,ocaml +default: lin-fc-rs-dft + +[j1e_type] +type: character*(32) +doc: type of the 1e-Jastrow: [ none | gauss ] +interface: ezfio,provider,ocaml +default: none + +[j1e_size] +type: integer +doc: number of functions per atom in 1e-Jastrow +interface: ezfio,provider,ocaml +default: 1 + +[j1e_coef] +type: double precision +doc: linear coef of functions in 1e-Jastrow +interface: ezfio +size: (hamiltonian.j1e_size,nuclei.nucl_num) + +[j1e_expo] +type: double precision +doc: exponenets of functions in 1e-Jastrow +interface: ezfio +size: (hamiltonian.j1e_size,nuclei.nucl_num) + +[env_type] +type: character*(32) +doc: type of 1-body Jastrow: [ prod-gauss | sum-gauss | sum-slat | sum-quartic ] +interface: ezfio, provider, ocaml +default: sum-gauss + +[env_expo] +type: double precision +doc: exponents of the 1-body Jastrow +interface: ezfio +size: (nuclei.nucl_num) + +[env_coef] +type: double precision +doc: coefficients of the 1-body Jastrow +interface: ezfio +size: (nuclei.nucl_num) + +[murho_type] +type: integer +doc: type of mu(rho) Jastrow +interface: ezfio, provider, ocaml +default: 0 + +[ng_fit_jast] +type: integer +doc: nb of Gaussians used to fit Jastrow fcts +interface: ezfio,provider,ocaml +default: 20 + diff --git a/src/hamiltonian/NEED b/src/hamiltonian/NEED index e69de29b..f1c051ff 100644 --- a/src/hamiltonian/NEED +++ b/src/hamiltonian/NEED @@ -0,0 +1,2 @@ +ezfio_files +nuclei diff --git a/plugins/local/ao_tc_eff_map/fit_j.irp.f b/src/hamiltonian/fit_j.irp.f similarity index 83% rename from plugins/local/ao_tc_eff_map/fit_j.irp.f rename to src/hamiltonian/fit_j.irp.f index 0fc3da2f..8a2d0036 100644 --- a/plugins/local/ao_tc_eff_map/fit_j.irp.f +++ b/src/hamiltonian/fit_j.irp.f @@ -1,41 +1,67 @@ - BEGIN_PROVIDER [ double precision, expo_j_xmu_1gauss ] -&BEGIN_PROVIDER [ double precision, coef_j_xmu_1gauss ] - implicit none - BEGIN_DOC - ! Upper bound long range fit of F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) - ! - ! with a single gaussian. - ! - ! Such a function can be used to screen integrals with F(x). - END_DOC - expo_j_xmu_1gauss = 0.5d0 - coef_j_xmu_1gauss = 1.d0 -END_PROVIDER + ! --- -BEGIN_PROVIDER [ double precision, expo_erfc_gauss ] - implicit none - expo_erfc_gauss = 1.41211d0 + 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_mu_gauss ] - implicit none - expo_erfc_mu_gauss = expo_erfc_gauss * mu_erf * mu_erf +! --- + +BEGIN_PROVIDER [double precision, expo_erfc_gauss] + + implicit none + + expo_erfc_gauss = 1.41211d0 + END_PROVIDER - BEGIN_PROVIDER [ double precision, expo_good_j_mu_1gauss ] -&BEGIN_PROVIDER [ double precision, coef_good_j_mu_1gauss ] - implicit none - BEGIN_DOC - ! exponent of Gaussian in order to obtain an upper bound of J(r12,mu) - ! - ! Can be used to scree integrals with J(r12,mu) - END_DOC - expo_good_j_mu_1gauss = 2.D0 * mu_erf * expo_j_xmu_1gauss - coef_good_j_mu_1gauss = 0.5d0/mu_erf * coef_j_xmu_1gauss - END_PROVIDER +! --- -BEGIN_PROVIDER [ double precision, expo_j_xmu, (n_fit_1_erf_x) ] +BEGIN_PROVIDER [double precision, expo_erfc_mu_gauss] + + implicit none + + expo_erfc_mu_gauss = expo_erfc_gauss * mu_erf * mu_erf + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, expo_good_j_mu_1gauss] +&BEGIN_PROVIDER [double precision, coef_good_j_mu_1gauss] + + BEGIN_DOC + ! + ! exponent of Gaussian in order to obtain an upper bound of J(r12,mu) + ! + ! Can be used to scree integrals with J(r12,mu) + ! + END_DOC + + implicit none + + expo_good_j_mu_1gauss = 2.d0 * mu_erf * expo_j_xmu_1gauss + coef_good_j_mu_1gauss = 0.5d0/mu_erf * coef_j_xmu_1gauss + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, expo_j_xmu, (n_fit_1_erf_x)] BEGIN_DOC ! F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) is fitted with a gaussian and a Slater @@ -465,53 +491,86 @@ END_PROVIDER ! --- double precision function F_x_j(x) - implicit none - BEGIN_DOC - ! 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) + + BEGIN_DOC + ! + ! dimension-less correlation factor: + ! + ! F_x_j(x) = x (1 - erf(x)) - 1/sqrt(pi) exp(-x^2) + ! + END_DOC + + implicit none + double precision, intent(in) :: x + + F_x_j = x * (1.d0 - derf(x)) - 1/dsqrt(dacos(-1.d0)) * dexp(-x**2) 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) + + BEGIN_DOC + ! + ! correlation factor: + ! + ! j_mu_F_x_j(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) + ! = 1/(2*mu) * F_x_j(mu*x) + ! + END_DOC + + implicit none + double precision, intent(in) :: x + double precision :: F_x_j + + j_mu_F_x_j = 0.5d0/mu_erf * F_x_j(x*mu_erf) + 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 + BEGIN_DOC + ! + ! correlation factor: + ! + ! j_mu(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) + ! + END_DOC + + implicit none + double precision, intent(in) :: x + + j_mu = 0.5d0* x * (1.d0 - derf(mu_erf*x)) - 0.5d0/( dsqrt(dacos(-1.d0))*mu_erf) * dexp(-(mu_erf*x)*(mu_erf*x)) + +end + +! --- + +double precision function j_mu_fit_gauss(x) + + BEGIN_DOC + ! + ! correlation factor fitted with gaussians: + ! + ! j_mu_fit_gauss(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) + ! + ! + END_DOC + + implicit none + double precision, intent(in) :: x + integer :: i + double precision :: alpha, coef + + j_mu_fit_gauss = 0.d0 + do i = 1, n_max_fit_slat + alpha = expo_gauss_j_mu_x(i) + coef = coef_gauss_j_mu_x(i) + j_mu_fit_gauss += coef * dexp(-alpha*x*x) + enddo end diff --git a/src/hamiltonian/fit_potential.irp.f b/src/hamiltonian/fit_potential.irp.f new file mode 100644 index 00000000..0bdf9c5b --- /dev/null +++ b/src/hamiltonian/fit_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) + + BEGIN_DOC + ! + ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) + ! + ! but fitted with gaussians + ! + END_DOC + + implicit none + double precision, intent(in) :: x + integer :: i + double precision :: alpha + + eff_pot_fit_gauss = derf(mu_erf*x)/x + do i = 1, n_gauss_eff_pot + alpha = expo_gauss_eff_pot(i) + eff_pot_fit_gauss += coef_gauss_eff_pot(i) * dexp(-alpha*x*x) + enddo + +end + +! --- + +BEGIN_PROVIDER [integer, n_fit_1_erf_x] + + implicit none + + n_fit_1_erf_x = 2 + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, expos_slat_gauss_1_erf_x, (n_fit_1_erf_x)] + + BEGIN_DOC + ! + ! 1 - erf(mu*x) is fitted with a Slater and gaussian as in Eq.A15 of JCP 154, 084119 (2021) + ! + ! 1 - erf(mu*x) = e^{-expos_slat_gauss_1_erf_x(1) * mu *x} * e^{-expos_slat_gauss_1_erf_x(2) * mu^2 * x^2} + ! + END_DOC + + implicit none + + expos_slat_gauss_1_erf_x(1) = 1.09529d0 + expos_slat_gauss_1_erf_x(2) = 0.756023d0 + +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 + double precision, intent(in) :: x + integer :: i + + fit_1_erf_x = 0.d0 + do i = 1, n_max_fit_slat + fit_1_erf_x += dexp(-expo_gauss_1_erf_x(i) *x*x) * coef_gauss_1_erf_x(i) + enddo + +end + +! --- + + BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x_2, (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) + + BEGIN_DOC + ! + ! fit_1_erf_x_2(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))^2 + ! + END_DOC + + implicit none + double precision, intent(in) :: x + integer :: i + + fit_1_erf_x_2 = 0.d0 + do i = 1, n_max_fit_slat + fit_1_erf_x_2 += dexp(-expo_gauss_1_erf_x_2(i) *x*x) * coef_gauss_1_erf_x_2(i) + enddo + +end + +! --- diff --git a/src/hamiltonian/fit_slat_gauss.irp.f b/src/hamiltonian/fit_slat_gauss.irp.f new file mode 100644 index 00000000..052ad072 --- /dev/null +++ b/src/hamiltonian/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 + diff --git a/src/hamiltonian/j1b_pen.irp.f b/src/hamiltonian/j1b_pen.irp.f new file mode 100644 index 00000000..64fcc90f --- /dev/null +++ b/src/hamiltonian/j1b_pen.irp.f @@ -0,0 +1,100 @@ + +! --- + + BEGIN_PROVIDER [ double precision, env_expo , (nucl_num) ] +&BEGIN_PROVIDER [ double precision, env_coef, (nucl_num) ] + + BEGIN_DOC + ! parameters of the 1-body Jastrow + END_DOC + + implicit none + logical :: exists + integer :: i + integer :: ierr + + PROVIDE ezfio_filename + + ! --- + + if (mpi_master) then + call ezfio_has_hamiltonian_env_expo(exists) + endif + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + + IRP_IF MPI + include 'mpif.h' + call MPI_BCAST(env_expo, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read env_expo with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: env_expo ] <<<<< ..' + call ezfio_get_hamiltonian_env_expo(env_expo) + IRP_IF MPI + call MPI_BCAST(env_expo, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read env_expo with MPI' + endif + IRP_ENDIF + endif + else + do i = 1, nucl_num + env_expo(i) = 1d5 + enddo + endif + + ! --- + + if (mpi_master) then + call ezfio_has_hamiltonian_env_coef(exists) + endif + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + + IRP_IF MPI + call MPI_BCAST(env_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read env_coef with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: env_coef ] <<<<< ..' + call ezfio_get_hamiltonian_env_coef(env_coef) + IRP_IF MPI + call MPI_BCAST(env_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read env_coef with MPI' + endif + IRP_ENDIF + endif + else + do i = 1, nucl_num + env_coef(i) = 1d0 + enddo + endif + + ! --- + + print *, ' parameters for nuclei jastrow' + print *, ' i, Z, env_expo, env_coef' + do i = 1, nucl_num + write(*,'(I4, 2x, 3(E15.7, 2X))') i, nucl_charge(i), env_expo(i), env_coef(i) + enddo + +END_PROVIDER + +! --- + diff --git a/src/hamiltonian/jast_1e_param.irp.f b/src/hamiltonian/jast_1e_param.irp.f new file mode 100644 index 00000000..9413f723 --- /dev/null +++ b/src/hamiltonian/jast_1e_param.irp.f @@ -0,0 +1,100 @@ + +! --- + + BEGIN_PROVIDER [double precision, j1e_expo, (j1e_size, nucl_num)] +&BEGIN_PROVIDER [double precision, j1e_coef, (j1e_size, nucl_num)] + + BEGIN_DOC + ! + ! parameters of the 1e-Jastrow + ! + END_DOC + + implicit none + logical :: exists + integer :: i, j + integer :: ierr + + PROVIDE ezfio_filename + + ! --- + + if (mpi_master) then + call ezfio_has_hamiltonian_j1e_expo(exists) + endif + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + + IRP_IF MPI + include 'mpif.h' + call MPI_BCAST(j1e_expo, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_expo with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: j1e_expo ] <<<<< ..' + call ezfio_get_hamiltonian_j1e_expo(j1e_expo) + IRP_IF MPI + call MPI_BCAST(j1e_expo, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_expo with MPI' + endif + IRP_ENDIF + endif + else + j1e_expo = 1.d0 + endif + + ! --- + + if (mpi_master) then + call ezfio_has_hamiltonian_j1e_coef(exists) + endif + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + + IRP_IF MPI + call MPI_BCAST(j1e_coef, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_coef with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef ] <<<<< ..' + call ezfio_get_hamiltonian_j1e_coef(j1e_coef) + IRP_IF MPI + call MPI_BCAST(j1e_coef, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_coef with MPI' + endif + IRP_ENDIF + endif + else + j1e_coef = 0.d0 + endif + + ! --- + + print *, ' parameters of the 1e-Jastrow' + do i = 1, nucl_num + print*, ' for Z = ', nucl_charge(i) + do j = 1, j1e_size + write(*,'(I4, 2x, 2(E15.7, 2X))') j, j1e_coef(j,i), j1e_expo(j,i) + enddo + enddo + +END_PROVIDER + +! --- + From b4ba0eda6f3e5cbd3bb1d499a982a304bf14cf05 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Mon, 15 Jan 2024 12:05:26 +0100 Subject: [PATCH 69/84] new keywords for Jastrow --- .../ao_many_one_e_ints/fit_slat_gauss.irp.f | 94 ----- plugins/local/ao_tc_eff_map/potential.irp.f | 335 ------------------ plugins/local/ao_tc_eff_map/useful_sub.irp.f | 49 ++- .../non_h_ints_mu/jast_deriv_utils.irp.f | 4 +- .../non_h_ints_mu/jast_deriv_utils_vect.irp.f | 13 +- .../local/non_h_ints_mu/tc_integ_num.irp.f | 2 + .../local/non_h_ints_mu/total_tc_int.irp.f | 263 +++----------- plugins/local/tc_keywords/EZFIO.cfg | 16 +- plugins/local/tc_scf/fock_vartc.irp.f | 10 +- plugins/local/tc_scf/test_int.irp.f | 36 -- 10 files changed, 115 insertions(+), 707 deletions(-) delete mode 100644 plugins/local/ao_many_one_e_ints/fit_slat_gauss.irp.f delete mode 100644 plugins/local/ao_tc_eff_map/potential.irp.f diff --git a/plugins/local/ao_many_one_e_ints/fit_slat_gauss.irp.f b/plugins/local/ao_many_one_e_ints/fit_slat_gauss.irp.f deleted file mode 100644 index 052ad072..00000000 --- a/plugins/local/ao_many_one_e_ints/fit_slat_gauss.irp.f +++ /dev/null @@ -1,94 +0,0 @@ - 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 - diff --git a/plugins/local/ao_tc_eff_map/potential.irp.f b/plugins/local/ao_tc_eff_map/potential.irp.f deleted file mode 100644 index 5b72b567..00000000 --- a/plugins/local/ao_tc_eff_map/potential.irp.f +++ /dev/null @@ -1,335 +0,0 @@ -! --- - -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 diff --git a/plugins/local/ao_tc_eff_map/useful_sub.irp.f b/plugins/local/ao_tc_eff_map/useful_sub.irp.f index 4cfdcad2..4c5efac1 100644 --- a/plugins/local/ao_tc_eff_map/useful_sub.irp.f +++ b/plugins/local/ao_tc_eff_map/useful_sub.irp.f @@ -174,7 +174,7 @@ double precision function general_primitive_integral_coul_shifted( dim general_primitive_integral_coul_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q) return -end function general_primitive_integral_coul_shifted +end !______________________________________________________________________________________________________________________ !______________________________________________________________________________________________________________________ @@ -354,7 +354,7 @@ double precision function general_primitive_integral_erf_shifted( dim general_primitive_integral_erf_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q) return -end function general_primitive_integral_erf_shifted +end !______________________________________________________________________________________________________________________ !______________________________________________________________________________________________________________________ @@ -362,3 +362,48 @@ end function general_primitive_integral_erf_shifted + +! --- + +subroutine inv_r_times_poly(r, dist_r, dist_vec, poly) + + BEGIN_DOC + ! + ! returns + ! + ! poly(1) = x / sqrt(x^2+y^2+z^2), poly(2) = y / sqrt(x^2+y^2+z^2), poly(3) = z / sqrt(x^2+y^2+z^2) + ! + ! with the arguments + ! + ! r(1) = x, r(2) = y, r(3) = z, dist_r = sqrt(x^2+y^2+z^2) + ! + ! dist_vec(1) = sqrt(y^2+z^2), dist_vec(2) = sqrt(x^2+z^2), dist_vec(3) = sqrt(x^2+y^2) + ! + END_DOC + + implicit none + double precision, intent(in) :: r(3), dist_r, dist_vec(3) + double precision, intent(out) :: poly(3) + integer :: i + double precision :: inv_dist + + if (dist_r .gt. 1.d-8)then + inv_dist = 1.d0/dist_r + do i = 1, 3 + poly(i) = r(i) * inv_dist + enddo + else + do i = 1, 3 + if(dabs(r(i)).lt.dist_vec(i)) then + inv_dist = 1.d0/dist_r + poly(i) = r(i) * inv_dist + else + poly(i) = 1.d0 + endif + enddo + endif + +end + +! --- + diff --git a/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f index 9b5e9fe8..d67809ee 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f @@ -161,7 +161,7 @@ double precision function env_nucl(r) else - print *, ' Error in grad1_env_nucl: Unknown env_type = ', env_type + print *, ' Error in env_nucl: Unknown env_type = ', env_type stop endif @@ -230,7 +230,7 @@ double precision function env_nucl_square(r) else - print *, ' Error in grad1_env_nucl: Unknown env_type = ', env_type + print *, ' Error in env_nucl_square: Unknown env_type = ', env_type stop endif diff --git a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f index bb64ad77..0cb6f06c 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f @@ -7,8 +7,7 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) ! ! grad_1 u(r1,r2) ! - ! this will be integrated numerically over r2: - ! we use grid for r1 and extra_grid for r2 + ! we use grid for r1 and extra_grid for r2 ! END_DOC @@ -29,13 +28,11 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) PROVIDE final_grid_points_extra if( ((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) .or. & - (j2e_type .eq. "rs-dft-murho") ) then + (j2e_type .eq. "rs-dft-murho") ) then call grad1_j12_mu_r1_seq(r1, n_grid2, resx, resy, resz) do jpoint = 1, n_points_extra_final_grid - res(jpoint) = resx(jpoint) * resx(jpoint) & - + resy(jpoint) * resy(jpoint) & - + resz(jpoint) * resz(jpoint) + res(jpoint) = resx(jpoint) * resx(jpoint) + resy(jpoint) * resy(jpoint) + resz(jpoint) * resz(jpoint) enddo elseif((j2e_type .eq. "rs-dft") .and. (env_type .ne. "none")) then @@ -60,9 +57,7 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) resx(jpoint) = (gradx1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(1)) * env_r2(jpoint) resy(jpoint) = (grady1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(2)) * env_r2(jpoint) resz(jpoint) = (gradz1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(3)) * env_r2(jpoint) - res (jpoint) = resx(jpoint) * resx(jpoint) & - + resy(jpoint) * resy(jpoint) & - + resz(jpoint) * resz(jpoint) + res (jpoint) = resx(jpoint) * resx(jpoint) + resy(jpoint) * resy(jpoint) + resz(jpoint) * resz(jpoint) enddo deallocate(env_r2, u2b_r12, gradx1_u2b, grady1_u2b, gradz1_u2b) diff --git a/plugins/local/non_h_ints_mu/tc_integ_num.irp.f b/plugins/local/non_h_ints_mu/tc_integ_num.irp.f index 5a088331..bc31ee91 100644 --- a/plugins/local/non_h_ints_mu/tc_integ_num.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ_num.irp.f @@ -1,4 +1,6 @@ +! --- + BEGIN_PROVIDER [double precision, int2_grad1_u12_ao_num , (ao_num,ao_num,n_points_final_grid,3)] &BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao_num, (ao_num,ao_num,n_points_final_grid) ] diff --git a/plugins/local/non_h_ints_mu/total_tc_int.irp.f b/plugins/local/non_h_ints_mu/total_tc_int.irp.f index a940455e..9df1a8a6 100644 --- a/plugins/local/non_h_ints_mu/total_tc_int.irp.f +++ b/plugins/local/non_h_ints_mu/total_tc_int.irp.f @@ -10,6 +10,11 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n ! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) ! = where V^TC(r_12) is the total TC operator ! = tc_grad_and_lapl_ao(k,i,l,j) + tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) + ! AND IF(var_tc): + ! + ! ao_two_e_tot(k,i,l,j) = (ki|V^TC(r_12) + [(V^TC)(r_12)]^\dagger|lj) / 2.0 + ! = tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) + ! ! ! where: ! @@ -25,7 +30,6 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n implicit none integer :: i, j, k, l, m, ipoint - double precision :: wall1, wall0 double precision :: weight1, ao_k_r, ao_i_r double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq double precision :: time0, time1 @@ -36,7 +40,7 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n PROVIDE j2e_type PROVIDE j1e_type - call wall_time(wall0) + call wall_time(time0) print *, ' providing ao_two_e_tc_tot ...' print*, ' j2e_type: ', j2e_type @@ -58,44 +62,6 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n ! --- - PROVIDE int2_grad1_u12_ao - - allocate(b_mat(n_points_final_grid,ao_num,ao_num,3)) - - b_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & - !$OMP SHARED (aos_in_r_array_transp, aos_grad_in_r_array_transp_bis, b_mat, & - !$OMP ao_num, n_points_final_grid, final_weight_at_r_vector) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - - weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) - ao_i_r = aos_in_r_array_transp(ipoint,i) - ao_k_r = aos_in_r_array_transp(ipoint,k) - - b_mat(ipoint,k,i,1) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) - b_mat(ipoint,k,i,2) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) - b_mat(ipoint,k,i,3) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - ao_two_e_tc_tot = 0.d0 - do m = 1, 3 - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, b_mat(1,1,1,m), n_points_final_grid & - , 1.d0, ao_two_e_tc_tot, ao_num*ao_num) - enddo - deallocate(b_mat) - - ! --- - PROVIDE int2_grad1_u12_square_ao allocate(c_mat(n_points_final_grid,ao_num,ao_num)) @@ -122,12 +88,11 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n FREE int2_grad1_u12_square_ao - if( (j2e_type .eq. "rs-dft") .and. & + if( (tc_integ_type .eq. "semi-analytic") .and. & + (j2e_type .eq. "rs-dft") .and. & ((env_type .eq. "prod_gauss") .or. (env_type .eq. "sum-gauss")) .and. & use_ipp ) then - print*, " going through Manu's IPP" - ! an additional term is added here directly instead of ! being added in int2_grad1_u12_square_ao for performance @@ -170,6 +135,47 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n ! --- + if(.not. var_tc) then + + PROVIDE int2_grad1_u12_ao + + allocate(b_mat(n_points_final_grid,ao_num,ao_num,3)) + + b_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, aos_grad_in_r_array_transp_bis, b_mat, & + !$OMP ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + b_mat(ipoint,k,i,1) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) + b_mat(ipoint,k,i,2) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) + b_mat(ipoint,k,i,3) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do m = 1, 3 + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, b_mat(1,1,1,m), n_points_final_grid & + , 1.d0, ao_two_e_tc_tot, ao_num*ao_num) + enddo + deallocate(b_mat) + + endif ! var_tc + + ! --- + call sum_A_At(ao_two_e_tc_tot(1,1,1,1), ao_num*ao_num) PROVIDE ao_integrals_map @@ -191,7 +197,7 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n !$OMP END DO !$OMP END PARALLEL - if(tc_integ_type .ge. "numeric") then + if(tc_integ_type .eq. "numeric") then FREE int2_grad1_u12_ao_num int2_grad1_u12_square_ao_num endif @@ -214,172 +220,3 @@ END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, ao_two_e_vartc_tot, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! CHEMIST NOTATION IS USED - ! - ! ao_two_e_vartc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) - ! = where V^TC(r_12) is the total TC operator - ! = tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) - ! - ! where: - ! - ! tc_grad_square_ao(k,i,l,j) = -1/2 - ! - ! ao_two_e_coul(k,i,l,j) = < l k | 1/r12 | j i > = ( k i | 1/r12 | l j ) - ! - END_DOC - - implicit none - integer :: i, j, k, l, ipoint - double precision :: wall1, wall0 - double precision :: weight1, ao_k_r, ao_i_r - double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq - double precision :: time0, time1 - double precision, allocatable :: c_mat(:,:,:) - double precision, external :: get_ao_two_e_integral - - PROVIDE env_type - PROVIDE j2e_type - PROVIDE j1e_type - - call wall_time(wall0) - - print *, ' providing ao_two_e_vartc_tot ...' - print*, ' j2e_type: ', j2e_type - print*, ' j1e_type: ', j1e_type - print*, ' env_type: ', env_type - - if(read_tc_integ) then - - print*, ' Reading ao_two_e_vartc_tot from ', trim(ezfio_filename) // '/work/ao_two_e_vartc_tot' - - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/ao_two_e_vartc_tot', action="read") - read(11) ao_two_e_vartc_tot - close(11) - - else - - PROVIDE tc_integ_type - print*, ' approach for integrals: ', tc_integ_type - - PROVIDE int2_grad1_u12_square_ao - - allocate(c_mat(n_points_final_grid,ao_num,ao_num)) - - c_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint) & - !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - c_mat(ipoint,k,i) = final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,k) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_grad1_u12_square_ao(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & - , 0.d0, ao_two_e_vartc_tot, ao_num*ao_num) - - FREE int2_grad1_u12_square_ao - - if( (j2e_type .eq. "rs-dft") .and. & - ((env_type .eq. "prod_gauss") .or. (env_type .eq. "sum-gauss")) .and. & - use_ipp ) then - - print*, " going through Manu's IPP" - - ! an additional term is added here directly instead of - ! being added in int2_grad1_u12_square_ao for performance - - PROVIDE int2_u2_env2 - - c_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & - !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & - !$OMP env_square_grad, env_square_lapl, aos_grad_in_r_array_transp_bis) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - - weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) - - ao_i_r = aos_in_r_array_transp(ipoint,i) - ao_k_r = aos_in_r_array_transp(ipoint,k) - - c_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * env_square_lapl(ipoint) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_u2_env2(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & - , 1.d0, ao_two_e_vartc_tot, ao_num*ao_num) - - FREE int2_u2_env2 - endif ! use_ipp - - deallocate(c_mat) - - ! --- - - call sum_A_At(ao_two_e_vartc_tot(1,1,1,1), ao_num*ao_num) - - PROVIDE ao_integrals_map - - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP SHARED(ao_num, ao_two_e_vartc_tot, ao_integrals_map) & - !$OMP PRIVATE(i, j, k, l) - !$OMP DO - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ! < 1:i, 2:j | 1:k, 2:l > - ao_two_e_vartc_tot(k,i,l,j) = ao_two_e_vartc_tot(k,i,l,j) + get_ao_two_e_integral(i, j, k, l, ao_integrals_map) - enddo - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - if(tc_integ_type .ge. "numeric") then - FREE int2_grad1_u12_ao_num int2_grad1_u12_square_ao_num - endif - - endif ! read_tc_integ - - if(write_tc_integ .and. mpi_master) then - print*, ' Saving ao_two_e_vartc_tot in ', trim(ezfio_filename) // '/work/ao_two_e_vartc_tot' - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/ao_two_e_vartc_tot', action="write") - call ezfio_set_work_empty(.False.) - write(11) ao_two_e_vartc_tot - close(11) - call ezfio_set_tc_keywords_io_tc_integ('Read') - endif - - call wall_time(time1) - print*, ' Wall time for ao_two_e_vartc_tot (min) = ', (time1 - time0) / 60.d0 - call print_memory_usage() - -END_PROVIDER - -! --- - diff --git a/plugins/local/tc_keywords/EZFIO.cfg b/plugins/local/tc_keywords/EZFIO.cfg index ee2d5112..93ff790f 100644 --- a/plugins/local/tc_keywords/EZFIO.cfg +++ b/plugins/local/tc_keywords/EZFIO.cfg @@ -160,12 +160,6 @@ doc: If |true|, maximize the overlap between orthogonalized left- and right eige interface: ezfio,provider,ocaml default: False -[ng_fit_jast] -type: integer -doc: nb of Gaussians used to fit Jastrow fcts -interface: ezfio,provider,ocaml -default: 20 - [max_dim_diis_tcscf] type: integer doc: Maximum size of the DIIS extrapolation procedure @@ -258,7 +252,7 @@ default: True [tc_grid1_a] type: integer -doc: size of angular grid over r1 +doc: size of angular grid over r1: [ 6 | 14 | 26 | 38 | 50 | 74 | 86 | 110 | 146 | 170 | 194 | 230 | 266 | 302 | 350 | 434 | 590 | 770 | 974 | 1202 | 1454 | 1730 | 2030 | 2354 | 2702 | 3074 | 3470 | 3890 | 4334 | 4802 | 5294 | 5810 ] interface: ezfio,provider,ocaml default: 50 @@ -270,19 +264,19 @@ default: 30 [tc_grid2_a] type: integer -doc: size of angular grid over r2 +doc: size of angular grid over r2: [ 6 | 14 | 26 | 38 | 50 | 74 | 86 | 110 | 146 | 170 | 194 | 230 | 266 | 302 | 350 | 434 | 590 | 770 | 974 | 1202 | 1454 | 1730 | 2030 | 2354 | 2702 | 3074 | 3470 | 3890 | 4334 | 4802 | 5294 | 5810 ] interface: ezfio,provider,ocaml -default: 194 +default: 266 [tc_grid2_r] type: integer doc: size of radial grid over r2 interface: ezfio,provider,ocaml -default: 50 +default: 70 [tc_integ_type] type: character*(32) -doc: approach used to evaluate TC integrals [analytic | numeric | semi-analytic] +doc: approach used to evaluate TC integrals [ analytic | numeric | semi-analytic ] interface: ezfio,ocaml,provider default: semi-analytic diff --git a/plugins/local/tc_scf/fock_vartc.irp.f b/plugins/local/tc_scf/fock_vartc.irp.f index 03899b07..2b4a57e5 100644 --- a/plugins/local/tc_scf/fock_vartc.irp.f +++ b/plugins/local/tc_scf/fock_vartc.irp.f @@ -13,9 +13,9 @@ two_e_vartc_integral_alpha = 0.d0 two_e_vartc_integral_beta = 0.d0 - !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (i, j, k, l, density_a, density_b, density, tmp_a, tmp_b, I_coul, I_kjli) & - !$OMP SHARED (ao_num, TCSCF_density_matrix_ao_alpha, TCSCF_density_matrix_ao_beta, ao_two_e_vartc_tot, & + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (i, j, k, l, density_a, density_b, density, tmp_a, tmp_b, I_coul, I_kjli) & + !$OMP SHARED (ao_num, TCSCF_density_matrix_ao_alpha, TCSCF_density_matrix_ao_beta, ao_two_e_tc_tot, & !$OMP two_e_vartc_integral_alpha, two_e_vartc_integral_beta) allocate(tmp_a(ao_num,ao_num), tmp_b(ao_num,ao_num)) @@ -31,8 +31,8 @@ do i = 1, ao_num do k = 1, ao_num - I_coul = density * ao_two_e_vartc_tot(k,i,l,j) - I_kjli = ao_two_e_vartc_tot(k,j,l,i) + I_coul = density * ao_two_e_tc_tot(k,i,l,j) + I_kjli = ao_two_e_tc_tot(k,j,l,i) tmp_a(k,i) += I_coul - density_a * I_kjli tmp_b(k,i) += I_coul - density_b * I_kjli diff --git a/plugins/local/tc_scf/test_int.irp.f b/plugins/local/tc_scf/test_int.irp.f index adaacfa5..e135fcd8 100644 --- a/plugins/local/tc_scf/test_int.irp.f +++ b/plugins/local/tc_scf/test_int.irp.f @@ -45,7 +45,6 @@ program test_ints !!PROVIDE TC_HF_energy VARTC_HF_energy !!print *, ' TC_HF_energy = ', TC_HF_energy !!print *, ' VARTC_HF_energy = ', VARTC_HF_energy -! call test_old_ints call test_fock_3e_uhf_mo_cs() call test_fock_3e_uhf_mo_a() @@ -796,41 +795,6 @@ end ! --- -subroutine test_old_ints - implicit none - integer :: i,j,k,l - double precision :: old, new, contrib, get_ao_tc_sym_two_e_pot - double precision :: integral_sym , integral_nsym,accu - PROVIDE ao_tc_sym_two_e_pot_in_map - accu = 0.d0 - 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) -! old = integral_sym + integral_nsym - new = ao_tc_int_chemist_test(k,i,l,j) - old = ao_tc_int_chemist_no_cycle(k,i,l,j) - contrib = dabs(old - new) - if(contrib.gt.1.d-6)then - print*,'problem !!' - print*,i,j,k,l - print*,old, new, contrib - endif - accu += contrib - enddo - enddo - enddo - enddo - print*,'******' - print*,'******' - print*,'in test_old_ints' - print*,'accu = ',accu/dble(ao_num**4) - -end - subroutine test_int2_grad1_u12_ao_test implicit none integer :: i,j,ipoint,m,k,l From fbcd70db2c695a7bc00be259c02e6a8617282a48 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Mon, 15 Jan 2024 19:02:05 +0100 Subject: [PATCH 70/84] hamiltonian -> jastrow --- .../ao_many_one_e_ints/lin_fc_rsdft.irp.f | 210 +++++++++--------- plugins/local/ao_tc_eff_map/NEED | 2 + plugins/local/jastrow/EZFIO.cfg | 61 ++++- .../local/jastrow/env_param.irp.f | 8 +- .../local/jastrow}/fit_j.irp.f | 0 .../local/jastrow}/fit_potential.irp.f | 0 .../local/jastrow}/fit_slat_gauss.irp.f | 0 .../local/jastrow}/jast_1e_param.irp.f | 8 +- plugins/local/non_h_ints_mu/NEED | 1 + .../non_h_ints_mu/debug_integ_jmu_modif.irp.f | 14 +- plugins/local/non_h_ints_mu/tc_integ.irp.f | 106 ++++----- .../local/non_h_ints_mu/total_tc_int.irp.f | 1 + src/hamiltonian/EZFIO.cfg | 61 ----- 13 files changed, 234 insertions(+), 238 deletions(-) rename src/hamiltonian/j1b_pen.irp.f => plugins/local/jastrow/env_param.irp.f (91%) rename {src/hamiltonian => plugins/local/jastrow}/fit_j.irp.f (100%) rename {src/hamiltonian => plugins/local/jastrow}/fit_potential.irp.f (100%) rename {src/hamiltonian => plugins/local/jastrow}/fit_slat_gauss.irp.f (100%) rename {src/hamiltonian => plugins/local/jastrow}/jast_1e_param.irp.f (91%) diff --git a/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f b/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f index 8d97d514..8685e563 100644 --- a/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f +++ b/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f @@ -1,21 +1,21 @@ ! --- - BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_0, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_x, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_y, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_z, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du_2, (ao_num, ao_num, n_points_final_grid)] + BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_LinFcRSDFT_long_Du_0 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] + ! Ir2_rsdft_long_Du_0 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] ! - ! Ir2_LinFcRSDFT_long_Du_x = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * x2 - ! Ir2_LinFcRSDFT_long_Du_y = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * y2 - ! Ir2_LinFcRSDFT_long_Du_z = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * z2 + ! Ir2_rsdft_long_Du_x = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * x2 + ! Ir2_rsdft_long_Du_y = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * y2 + ! Ir2_rsdft_long_Du_z = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * z2 ! - ! Ir2_LinFcRSDFT_long_Du_2 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * r2^2 + ! Ir2_rsdft_long_Du_2 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * r2^2 ! END_DOC @@ -32,18 +32,18 @@ PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent - print *, ' providing Ir2_LinFcRSDFT_long_Du ...' + print *, ' providing Ir2_rsdft_long_Du ...' call wall_time(wall0) !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, c_1s, e_1s, R_1s, int_erf, int_clb, & !$OMP tmp_Du_0, tmp_Du_x, tmp_Du_y, tmp_Du_z, tmp_Du_2) & !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_erf, & - !$OMP List_env1s_size, List_env1s_expo, & - !$OMP List_env1s_coef, List_env1s_cent, & - !$OMP Ir2_LinFcRSDFT_long_Du_0, Ir2_LinFcRSDFT_long_Du_x, & - !$OMP Ir2_LinFcRSDFT_long_Du_y, Ir2_LinFcRSDFT_long_Du_z, & - !$OMP Ir2_LinFcRSDFT_long_Du_2) + !$OMP List_env1s_size, List_env1s_expo, & + !$OMP List_env1s_coef, List_env1s_cent, & + !$OMP Ir2_rsdft_long_Du_0, Ir2_rsdft_long_Du_x, & + !$OMP Ir2_rsdft_long_Du_y, Ir2_rsdft_long_Du_z, & + !$OMP Ir2_rsdft_long_Du_2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -81,11 +81,11 @@ tmp_Du_2 = tmp_Du_2 + c_1s * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)) enddo - Ir2_LinFcRSDFT_long_Du_0(j,i,ipoint) = tmp_Du_0 - Ir2_LinFcRSDFT_long_Du_x(j,i,ipoint) = tmp_Du_x - Ir2_LinFcRSDFT_long_Du_y(j,i,ipoint) = tmp_Du_y - Ir2_LinFcRSDFT_long_Du_z(j,i,ipoint) = tmp_Du_z - Ir2_LinFcRSDFT_long_Du_2(j,i,ipoint) = tmp_Du_2 + Ir2_rsdft_long_Du_0(j,i,ipoint) = tmp_Du_0 + Ir2_rsdft_long_Du_x(j,i,ipoint) = tmp_Du_x + Ir2_rsdft_long_Du_y(j,i,ipoint) = tmp_Du_y + Ir2_rsdft_long_Du_z(j,i,ipoint) = tmp_Du_z + Ir2_rsdft_long_Du_2(j,i,ipoint) = tmp_Du_2 enddo enddo enddo @@ -95,27 +95,27 @@ do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - Ir2_LinFcRSDFT_long_Du_0(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) - Ir2_LinFcRSDFT_long_Du_x(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_x(i,j,ipoint) - Ir2_LinFcRSDFT_long_Du_y(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_y(i,j,ipoint) - Ir2_LinFcRSDFT_long_Du_z(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_z(i,j,ipoint) - Ir2_LinFcRSDFT_long_Du_2(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du_2(i,j,ipoint) + Ir2_rsdft_long_Du_0(j,i,ipoint) = Ir2_rsdft_long_Du_0(i,j,ipoint) + Ir2_rsdft_long_Du_x(j,i,ipoint) = Ir2_rsdft_long_Du_x(i,j,ipoint) + Ir2_rsdft_long_Du_y(j,i,ipoint) = Ir2_rsdft_long_Du_y(i,j,ipoint) + Ir2_rsdft_long_Du_z(j,i,ipoint) = Ir2_rsdft_long_Du_z(i,j,ipoint) + Ir2_rsdft_long_Du_2(j,i,ipoint) = Ir2_rsdft_long_Du_2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_LinFcRSDFT_long_Du (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_rsdft_long_Du (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_LinFcRSDFT_gauss_Du = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) e^{-(mu r_12)^2} + ! Ir2_rsdft_gauss_Du = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) e^{-(mu r_12)^2} ! END_DOC @@ -136,7 +136,7 @@ BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du, (ao_num, ao_num, n_po PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent - print *, ' providing Ir2_LinFcRSDFT_gauss_Du ...' + print *, ' providing Ir2_rsdft_gauss_Du ...' call wall_time(wall0) mu_sq = mu_erf * mu_erf @@ -145,9 +145,9 @@ BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du, (ao_num, ao_num, n_po !$OMP PRIVATE (ipoint, i, j, i_1s, dx, dy, dz, r, tmp_arg, coef, & !$OMP rmu_sq, e_1s, c_1s, R_1s, beta, B_center, tmp_Du) & !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & - !$OMP List_env1s_size, List_env1s_expo, & - !$OMP List_env1s_coef, List_env1s_cent, & - !$OMP Ir2_LinFcRSDFT_gauss_Du) + !$OMP List_env1s_size, List_env1s_expo, & + !$OMP List_env1s_coef, List_env1s_cent, & + !$OMP Ir2_rsdft_gauss_Du) !$OMP DO do ipoint = 1, n_points_final_grid @@ -186,7 +186,7 @@ BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du, (ao_num, ao_num, n_po tmp_Du += coef * overlap_gauss_r12_ao(B_center, beta, j, i) enddo - Ir2_LinFcRSDFT_gauss_Du(j,i,ipoint) = tmp_Du + Ir2_rsdft_gauss_Du(j,i,ipoint) = tmp_Du enddo enddo enddo @@ -197,33 +197,33 @@ BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du, (ao_num, ao_num, n_po do i = 2, ao_num do j = 1, i-1 - Ir2_LinFcRSDFT_gauss_Du(j,i,ipoint) = Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) + Ir2_rsdft_gauss_Du(j,i,ipoint) = Ir2_rsdft_gauss_Du(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_LinFcRSDFT_gauss_Du (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_rsdft_gauss_Du (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- - BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_0, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_x, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_y, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_z, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_long_Du2_2, (ao_num, ao_num, n_points_final_grid)] + BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_LinFcRSDFT_long_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] + ! Ir2_rsdft_long_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] ! - ! Ir2_LinFcRSDFT_long_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * x2 - ! Ir2_LinFcRSDFT_long_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * y2 - ! Ir2_LinFcRSDFT_long_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * z2 + ! Ir2_rsdft_long_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * x2 + ! Ir2_rsdft_long_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * y2 + ! Ir2_rsdft_long_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * z2 ! - ! Ir2_LinFcRSDFT_long_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * r2^2 + ! Ir2_rsdft_long_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * r2^2 ! END_DOC @@ -242,22 +242,22 @@ END_PROVIDER PROVIDE final_grid_points PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent - print *, ' providing Ir2_LinFcRSDFT_long_Du2 ...' + print *, ' providing Ir2_rsdft_long_Du2 ...' call wall_time(wall0) mu_sq = mu_erf * mu_erf - !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, i_1s, r, rmu_sq, dx, dy, dz, & - !$OMP e_1s, c_1s, R_1s, tmp_arg, coef, beta, B_center, & - !$OMP int_erf, int_clb, & - !$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) & - !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & - !$OMP mu_erf, List_env1s_square_size, List_env1s_square_expo, & - !$OMP List_env1s_square_coef, List_env1s_square_cent, & - !$OMP Ir2_LinFcRSDFT_long_Du2_0, Ir2_LinFcRSDFT_long_Du2_x, & - !$OMP Ir2_LinFcRSDFT_long_Du2_y, Ir2_LinFcRSDFT_long_Du2_z, & - !$OMP Ir2_LinFcRSDFT_long_Du2_2) + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, r, rmu_sq, dx, dy, dz, & + !$OMP e_1s, c_1s, R_1s, tmp_arg, coef, beta, B_center, & + !$OMP int_erf, int_clb, & + !$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & + !$OMP mu_erf, List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_rsdft_long_Du2_0, Ir2_rsdft_long_Du2_x, & + !$OMP Ir2_rsdft_long_Du2_y, Ir2_rsdft_long_Du2_z, & + !$OMP Ir2_rsdft_long_Du2_2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -310,11 +310,11 @@ END_PROVIDER tmp_Du2_2 = tmp_Du2_2 + coef * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)) enddo - Ir2_LinFcRSDFT_long_Du2_0(j,i,ipoint) = tmp_Du2_0 - Ir2_LinFcRSDFT_long_Du2_x(j,i,ipoint) = tmp_Du2_x - Ir2_LinFcRSDFT_long_Du2_y(j,i,ipoint) = tmp_Du2_y - Ir2_LinFcRSDFT_long_Du2_z(j,i,ipoint) = tmp_Du2_z - Ir2_LinFcRSDFT_long_Du2_2(j,i,ipoint) = tmp_Du2_2 + Ir2_rsdft_long_Du2_0(j,i,ipoint) = tmp_Du2_0 + Ir2_rsdft_long_Du2_x(j,i,ipoint) = tmp_Du2_x + Ir2_rsdft_long_Du2_y(j,i,ipoint) = tmp_Du2_y + Ir2_rsdft_long_Du2_z(j,i,ipoint) = tmp_Du2_z + Ir2_rsdft_long_Du2_2(j,i,ipoint) = tmp_Du2_2 enddo enddo enddo @@ -324,27 +324,27 @@ END_PROVIDER do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - Ir2_LinFcRSDFT_long_Du2_0(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_0(i,j,ipoint) - Ir2_LinFcRSDFT_long_Du2_x(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_x(i,j,ipoint) - Ir2_LinFcRSDFT_long_Du2_y(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_y(i,j,ipoint) - Ir2_LinFcRSDFT_long_Du2_z(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_z(i,j,ipoint) - Ir2_LinFcRSDFT_long_Du2_2(j,i,ipoint) = Ir2_LinFcRSDFT_long_Du2_2(i,j,ipoint) + Ir2_rsdft_long_Du2_0(j,i,ipoint) = Ir2_rsdft_long_Du2_0(i,j,ipoint) + Ir2_rsdft_long_Du2_x(j,i,ipoint) = Ir2_rsdft_long_Du2_x(i,j,ipoint) + Ir2_rsdft_long_Du2_y(j,i,ipoint) = Ir2_rsdft_long_Du2_y(i,j,ipoint) + Ir2_rsdft_long_Du2_z(j,i,ipoint) = Ir2_rsdft_long_Du2_z(i,j,ipoint) + Ir2_rsdft_long_Du2_2(j,i,ipoint) = Ir2_rsdft_long_Du2_2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_LinFcRSDFT_long_Du2 (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_rsdft_long_Du2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du2, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_LinFcRSDFT_gauss_Du2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 e^{-(mu r_12)^2} + ! Ir2_rsdft_gauss_Du2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 e^{-(mu r_12)^2} ! END_DOC @@ -365,7 +365,7 @@ BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du2, (ao_num, ao_num, n_p PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent - print *, ' providing Ir2_LinFcRSDFT_gauss_Du2 ...' + print *, ' providing Ir2_rsdft_gauss_Du2 ...' call wall_time(wall0) mu_sq = 2.d0 * mu_erf * mu_erf @@ -374,9 +374,9 @@ BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du2, (ao_num, ao_num, n_p !$OMP PRIVATE (ipoint, i, j, i_1s, dx, dy, dz, r, tmp_arg, coef, & !$OMP rmu_sq, e_1s, c_1s, R_1s, beta, B_center, tmp_Du2) & !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & - !$OMP List_env1s_square_size, List_env1s_square_expo, & - !$OMP List_env1s_square_coef, List_env1s_square_cent, & - !$OMP Ir2_LinFcRSDFT_gauss_Du2) + !$OMP List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_rsdft_gauss_Du2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -415,7 +415,7 @@ BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du2, (ao_num, ao_num, n_p tmp_Du2 += coef * overlap_gauss_r12_ao(B_center, beta, j, i) enddo - Ir2_LinFcRSDFT_gauss_Du2(j,i,ipoint) = tmp_Du2 + Ir2_rsdft_gauss_Du2(j,i,ipoint) = tmp_Du2 enddo enddo enddo @@ -426,33 +426,33 @@ BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_gauss_Du2, (ao_num, ao_num, n_p do i = 2, ao_num do j = 1, i-1 - Ir2_LinFcRSDFT_gauss_Du2(j,i,ipoint) = Ir2_LinFcRSDFT_gauss_Du2(i,j,ipoint) + Ir2_rsdft_gauss_Du2(j,i,ipoint) = Ir2_rsdft_gauss_Du2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_LinFcRSDFT_gauss_Du2 (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_rsdft_gauss_Du2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- - BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_0, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_x, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_y, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_z, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_LinFcRSDFT_short_Du2_2, (ao_num, ao_num, n_points_final_grid)] + BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_LinFcRSDFT_short_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 + ! Ir2_rsdft_short_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 ! - ! Ir2_LinFcRSDFT_short_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * x2 - ! Ir2_LinFcRSDFT_short_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * y2 - ! Ir2_LinFcRSDFT_short_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * z2 + ! Ir2_rsdft_short_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * x2 + ! Ir2_rsdft_short_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * y2 + ! Ir2_rsdft_short_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * z2 ! - ! Ir2_LinFcRSDFT_short_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * r2^2 + ! Ir2_rsdft_short_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * r2^2 ! END_DOC @@ -470,7 +470,7 @@ END_PROVIDER PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent PROVIDE ng_fit_jast expo_gauss_1_erf_x_2 coef_gauss_1_erf_x_2 - print *, ' providing Ir2_LinFcRSDFT_short_Du2 ...' + print *, ' providing Ir2_rsdft_short_Du2 ...' call wall_time(wall0) !$OMP PARALLEL DEFAULT (NONE) & @@ -480,11 +480,11 @@ END_PROVIDER !$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) & !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, & !$OMP ng_fit_jast, expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & - !$OMP List_env1s_square_size, List_env1s_square_expo, & - !$OMP List_env1s_square_coef, List_env1s_square_cent, & - !$OMP Ir2_LinFcRSDFT_short_Du2_0, Ir2_LinFcRSDFT_short_Du2_x, & - !$OMP Ir2_LinFcRSDFT_short_Du2_y, Ir2_LinFcRSDFT_short_Du2_z, & - !$OMP Ir2_LinFcRSDFT_short_Du2_2) + !$OMP List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_rsdft_short_Du2_0, Ir2_rsdft_short_Du2_x, & + !$OMP Ir2_rsdft_short_Du2_y, Ir2_rsdft_short_Du2_z, & + !$OMP Ir2_rsdft_short_Du2_2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -542,11 +542,11 @@ END_PROVIDER enddo ! i_1s enddo ! i_fit - Ir2_LinFcRSDFT_short_Du2_0(j,i,ipoint) = tmp_Du2_0 - Ir2_LinFcRSDFT_short_Du2_x(j,i,ipoint) = tmp_Du2_x - Ir2_LinFcRSDFT_short_Du2_y(j,i,ipoint) = tmp_Du2_y - Ir2_LinFcRSDFT_short_Du2_z(j,i,ipoint) = tmp_Du2_z - Ir2_LinFcRSDFT_short_Du2_2(j,i,ipoint) = tmp_Du2_2 + Ir2_rsdft_short_Du2_0(j,i,ipoint) = tmp_Du2_0 + Ir2_rsdft_short_Du2_x(j,i,ipoint) = tmp_Du2_x + Ir2_rsdft_short_Du2_y(j,i,ipoint) = tmp_Du2_y + Ir2_rsdft_short_Du2_z(j,i,ipoint) = tmp_Du2_z + Ir2_rsdft_short_Du2_2(j,i,ipoint) = tmp_Du2_2 enddo ! j enddo ! i enddo ! ipoint @@ -556,17 +556,17 @@ END_PROVIDER do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - Ir2_LinFcRSDFT_short_Du2_0(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_0(i,j,ipoint) - Ir2_LinFcRSDFT_short_Du2_x(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_x(i,j,ipoint) - Ir2_LinFcRSDFT_short_Du2_y(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_y(i,j,ipoint) - Ir2_LinFcRSDFT_short_Du2_z(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_z(i,j,ipoint) - Ir2_LinFcRSDFT_short_Du2_2(j,i,ipoint) = Ir2_LinFcRSDFT_short_Du2_2(i,j,ipoint) + Ir2_rsdft_short_Du2_0(j,i,ipoint) = Ir2_rsdft_short_Du2_0(i,j,ipoint) + Ir2_rsdft_short_Du2_x(j,i,ipoint) = Ir2_rsdft_short_Du2_x(i,j,ipoint) + Ir2_rsdft_short_Du2_y(j,i,ipoint) = Ir2_rsdft_short_Du2_y(i,j,ipoint) + Ir2_rsdft_short_Du2_z(j,i,ipoint) = Ir2_rsdft_short_Du2_z(i,j,ipoint) + Ir2_rsdft_short_Du2_2(j,i,ipoint) = Ir2_rsdft_short_Du2_2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_LinFcRSDFT_short_Du2 (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_rsdft_short_Du2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER diff --git a/plugins/local/ao_tc_eff_map/NEED b/plugins/local/ao_tc_eff_map/NEED index f768b75f..b12b0999 100644 --- a/plugins/local/ao_tc_eff_map/NEED +++ b/plugins/local/ao_tc_eff_map/NEED @@ -3,3 +3,5 @@ mo_one_e_ints ao_many_one_e_ints dft_utils_in_r tc_keywords +hamiltonian +jastrow diff --git a/plugins/local/jastrow/EZFIO.cfg b/plugins/local/jastrow/EZFIO.cfg index b41185a3..8f05eb01 100644 --- a/plugins/local/jastrow/EZFIO.cfg +++ b/plugins/local/jastrow/EZFIO.cfg @@ -1,8 +1,21 @@ -[jast_type] -doc: Type of Jastrow [None| Mu | Qmckl] + +[j2e_type] type: character*(32) +doc: type of the 2e-Jastrow: [ none | rs-dft | rs-dft-murho | champ ] +interface: ezfio,provider,ocaml +default: rs-dft + +[j1e_type] +type: character*(32) +doc: type of the 1e-Jastrow: [ none | gauss ] +interface: ezfio,provider,ocaml +default: none + +[env_type] +type: character*(32) +doc: type of 1-body Jastrow: [ none | prod-gauss | sum-gauss | sum-slat | sum-quartic ] interface: ezfio, provider, ocaml -default: None +default: sum-gauss [jast_qmckl_type_nucl_num] doc: Number of different nuclei types in QMCkl jastrow @@ -64,6 +77,46 @@ type: double precision size: (jastrow.jast_qmckl_c_vector_size) interface: ezfio, provider - +[j1e_size] +type: integer +doc: number of functions per atom in 1e-Jastrow +interface: ezfio,provider,ocaml +default: 1 + +[j1e_coef] +type: double precision +doc: linear coef of functions in 1e-Jastrow +interface: ezfio +size: (jastrow.j1e_size,nuclei.nucl_num) + +[j1e_expo] +type: double precision +doc: exponenets of functions in 1e-Jastrow +interface: ezfio +size: (jastrow.j1e_size,nuclei.nucl_num) + +[env_expo] +type: double precision +doc: exponents of the 1-body Jastrow +interface: ezfio +size: (nuclei.nucl_num) + +[env_coef] +type: double precision +doc: coefficients of the 1-body Jastrow +interface: ezfio +size: (nuclei.nucl_num) + +[murho_type] +type: integer +doc: type of mu(rho) Jastrow +interface: ezfio, provider, ocaml +default: 0 + +[ng_fit_jast] +type: integer +doc: nb of Gaussians used to fit Jastrow fcts +interface: ezfio,provider,ocaml +default: 20 diff --git a/src/hamiltonian/j1b_pen.irp.f b/plugins/local/jastrow/env_param.irp.f similarity index 91% rename from src/hamiltonian/j1b_pen.irp.f rename to plugins/local/jastrow/env_param.irp.f index 64fcc90f..8102a484 100644 --- a/src/hamiltonian/j1b_pen.irp.f +++ b/plugins/local/jastrow/env_param.irp.f @@ -18,7 +18,7 @@ ! --- if (mpi_master) then - call ezfio_has_hamiltonian_env_expo(exists) + call ezfio_has_jastrow_env_expo(exists) endif IRP_IF MPI_DEBUG @@ -37,7 +37,7 @@ if (exists) then if (mpi_master) then write(6,'(A)') '.. >>>>> [ IO READ: env_expo ] <<<<< ..' - call ezfio_get_hamiltonian_env_expo(env_expo) + call ezfio_get_jastrow_env_expo(env_expo) IRP_IF MPI call MPI_BCAST(env_expo, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then @@ -54,7 +54,7 @@ ! --- if (mpi_master) then - call ezfio_has_hamiltonian_env_coef(exists) + call ezfio_has_jastrow_env_coef(exists) endif IRP_IF MPI_DEBUG @@ -72,7 +72,7 @@ if (exists) then if (mpi_master) then write(6,'(A)') '.. >>>>> [ IO READ: env_coef ] <<<<< ..' - call ezfio_get_hamiltonian_env_coef(env_coef) + call ezfio_get_jastrow_env_coef(env_coef) IRP_IF MPI call MPI_BCAST(env_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then diff --git a/src/hamiltonian/fit_j.irp.f b/plugins/local/jastrow/fit_j.irp.f similarity index 100% rename from src/hamiltonian/fit_j.irp.f rename to plugins/local/jastrow/fit_j.irp.f diff --git a/src/hamiltonian/fit_potential.irp.f b/plugins/local/jastrow/fit_potential.irp.f similarity index 100% rename from src/hamiltonian/fit_potential.irp.f rename to plugins/local/jastrow/fit_potential.irp.f diff --git a/src/hamiltonian/fit_slat_gauss.irp.f b/plugins/local/jastrow/fit_slat_gauss.irp.f similarity index 100% rename from src/hamiltonian/fit_slat_gauss.irp.f rename to plugins/local/jastrow/fit_slat_gauss.irp.f diff --git a/src/hamiltonian/jast_1e_param.irp.f b/plugins/local/jastrow/jast_1e_param.irp.f similarity index 91% rename from src/hamiltonian/jast_1e_param.irp.f rename to plugins/local/jastrow/jast_1e_param.irp.f index 9413f723..16c8cedc 100644 --- a/src/hamiltonian/jast_1e_param.irp.f +++ b/plugins/local/jastrow/jast_1e_param.irp.f @@ -20,7 +20,7 @@ ! --- if (mpi_master) then - call ezfio_has_hamiltonian_j1e_expo(exists) + call ezfio_has_jastrow_j1e_expo(exists) endif IRP_IF MPI_DEBUG @@ -39,7 +39,7 @@ if (exists) then if (mpi_master) then write(6,'(A)') '.. >>>>> [ IO READ: j1e_expo ] <<<<< ..' - call ezfio_get_hamiltonian_j1e_expo(j1e_expo) + call ezfio_get_jastrow_j1e_expo(j1e_expo) IRP_IF MPI call MPI_BCAST(j1e_expo, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then @@ -54,7 +54,7 @@ ! --- if (mpi_master) then - call ezfio_has_hamiltonian_j1e_coef(exists) + call ezfio_has_jastrow_j1e_coef(exists) endif IRP_IF MPI_DEBUG @@ -72,7 +72,7 @@ if (exists) then if (mpi_master) then write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef ] <<<<< ..' - call ezfio_get_hamiltonian_j1e_coef(j1e_coef) + call ezfio_get_jastrow_j1e_coef(j1e_coef) IRP_IF MPI call MPI_BCAST(j1e_coef, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then diff --git a/plugins/local/non_h_ints_mu/NEED b/plugins/local/non_h_ints_mu/NEED index c44c65af..48c1c24b 100644 --- a/plugins/local/non_h_ints_mu/NEED +++ b/plugins/local/non_h_ints_mu/NEED @@ -1,4 +1,5 @@ qmckl +hamiltonian jastrow ao_tc_eff_map bi_ortho_mos diff --git a/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f index 415e4fc0..515b6da5 100644 --- a/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f +++ b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f @@ -29,7 +29,7 @@ program debug_integ_jmu_modif !call test_vect_overlap_gauss_r12_ao() !call test_vect_overlap_gauss_r12_ao_with1s() - !call test_Ir2_LinFcRSDFT_long_Du_0() + !call test_Ir2_rsdft_long_Du_0() end @@ -731,17 +731,17 @@ end ! --- -subroutine test_Ir2_LinFcRSDFT_long_Du_0() +subroutine test_Ir2_rsdft_long_Du_0() implicit none integer :: i, j, ipoint double precision :: i_old, i_new double precision :: acc_ij, acc_tot, eps_ij, normalz - print*, ' test_Ir2_LinFcRSDFT_long_Du_0 ...' + print*, ' test_Ir2_rsdft_long_Du_0 ...' PROVIDE v_ij_erf_rk_cst_mu_env - PROVIDE Ir2_LinFcRSDFT_long_Du_0 + PROVIDE Ir2_rsdft_long_Du_0 eps_ij = 1d-10 acc_tot = 0.d0 @@ -751,12 +751,12 @@ subroutine test_Ir2_LinFcRSDFT_long_Du_0() do j = 1, ao_num do i = 1, ao_num - i_old = v_ij_erf_rk_cst_mu_env (i,j,ipoint) - i_new = Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) + i_old = v_ij_erf_rk_cst_mu_env(i,j,ipoint) + i_new = Ir2_rsdft_long_Du_0 (i,j,ipoint) acc_ij = dabs(i_old - i_new) if(acc_ij .gt. eps_ij) then - print *, ' problem in Ir2_LinFcRSDFT_long_Du_0 on', i, j, ipoint + print *, ' problem in Ir2_rsdft_long_Du_0 on', i, j, ipoint print *, ' old integ = ', i_old print *, ' new integ = ', i_new print *, ' diff = ', acc_ij diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f index 7962ed15..cb1d2beb 100644 --- a/plugins/local/non_h_ints_mu/tc_integ.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -125,22 +125,22 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f PROVIDE mu_erf PROVIDE env_type env_val env_grad - PROVIDE Ir2_LinFcRSDFT_long_Du_0 Ir2_LinFcRSDFT_long_Du_x Ir2_LinFcRSDFT_long_Du_y Ir2_LinFcRSDFT_long_Du_z Ir2_LinFcRSDFT_long_Du_2 - PROVIDE Ir2_LinFcRSDFT_gauss_Du + PROVIDE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_long_Du_2 + PROVIDE Ir2_rsdft_gauss_Du tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) int2_grad1_u12_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & - !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & - !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & - !$OMP tmp_ct, env_val, env_grad, Ir2_LinFcRSDFT_long_Du_0, & - !$OMP Ir2_LinFcRSDFT_long_Du_x, Ir2_LinFcRSDFT_long_Du_y, & - !$OMP Ir2_LinFcRSDFT_long_Du_z, Ir2_LinFcRSDFT_gauss_Du, & - !$OMP Ir2_LinFcRSDFT_long_Du_2, int2_grad1_u12_ao) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & + !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct, env_val, env_grad, Ir2_rsdft_long_Du_0, & + !$OMP Ir2_rsdft_long_Du_x, Ir2_rsdft_long_Du_y, & + !$OMP Ir2_rsdft_long_Du_z, Ir2_rsdft_gauss_Du, & + !$OMP Ir2_rsdft_long_Du_2, int2_grad1_u12_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid @@ -166,11 +166,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f do j = 1, ao_num do i = 1, ao_num - tmp2 = 0.5d0 * Ir2_LinFcRSDFT_long_Du_2(i,j,ipoint) - x * Ir2_LinFcRSDFT_long_Du_x(i,j,ipoint) - y * Ir2_LinFcRSDFT_long_Du_y(i,j,ipoint) - z * Ir2_LinFcRSDFT_long_Du_z(i,j,ipoint) + tmp2 = 0.5d0 * Ir2_rsdft_long_Du_2(i,j,ipoint) - x * Ir2_rsdft_long_Du_x(i,j,ipoint) - y * Ir2_rsdft_long_Du_y(i,j,ipoint) - z * Ir2_rsdft_long_Du_z(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,1) = -Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_LinFcRSDFT_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,2) = -Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_LinFcRSDFT_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,3) = -Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_LinFcRSDFT_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,1) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_rsdft_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_rsdft_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,2) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_rsdft_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_rsdft_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,3) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_rsdft_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_rsdft_gauss_Du(i,j,ipoint) enddo enddo enddo @@ -217,7 +217,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f else - FREE Ir2_LinFcRSDFT_long_Du_0 Ir2_LinFcRSDFT_long_Du_x Ir2_LinFcRSDFT_long_Du_y Ir2_LinFcRSDFT_long_Du_z Ir2_LinFcRSDFT_gauss_Du Ir2_LinFcRSDFT_long_Du_2 + FREE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_gauss_Du Ir2_rsdft_long_Du_2 endif ! j1e_type @@ -440,28 +440,28 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p ! ! PROVIDE mu_erf ! PROVIDE env_val env_grad -! PROVIDE Ir2_LinFcRSDFT_short_Du2_0 Ir2_LinFcRSDFT_short_Du2_x Ir2_LinFcRSDFT_short_Du2_y Ir2_LinFcRSDFT_short_Du2_z Ir2_LinFcRSDFT_short_Du2_2 -! PROVIDE Ir2_LinFcRSDFT_long_Du2_0 Ir2_LinFcRSDFT_long_Du2_x Ir2_LinFcRSDFT_long_Du2_y Ir2_LinFcRSDFT_long_Du2_z Ir2_LinFcRSDFT_long_Du2_2 -! PROVIDE Ir2_LinFcRSDFT_gauss_Du2 +! PROVIDE Ir2_rsdft_short_Du2_0 Ir2_rsdft_short_Du2_x Ir2_rsdft_short_Du2_y Ir2_rsdft_short_Du2_z Ir2_rsdft_short_Du2_2 +! PROVIDE Ir2_rsdft_long_Du2_0 Ir2_rsdft_long_Du2_x Ir2_rsdft_long_Du2_y Ir2_rsdft_long_Du2_z Ir2_rsdft_long_Du2_2 +! PROVIDE Ir2_rsdft_gauss_Du2 ! ! tmp_ct = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) ! tmp_ct2 = tmp_ct * tmp_ct ! ! int2_grad1_u12_square_ao = 0.d0 ! -! !$OMP PARALLEL & -! !$OMP DEFAULT (NONE) & -! !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, dr2, & -! !$OMP tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, & -! !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & -! !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & -! !$OMP tmp_ct, tmp_ct2, env_val, env_grad, & -! !$OMP Ir2_LinFcRSDFT_long_Du2_0, Ir2_LinFcRSDFT_long_Du2_x, & -! !$OMP Ir2_LinFcRSDFT_long_Du2_y, Ir2_LinFcRSDFT_long_Du2_z, & -! !$OMP Ir2_LinFcRSDFT_gauss_Du2, Ir2_LinFcRSDFT_long_Du2_2, & -! !$OMP Ir2_LinFcRSDFT_short_Du2_0, Ir2_LinFcRSDFT_short_Du2_x, & -! !$OMP Ir2_LinFcRSDFT_short_Du2_y, Ir2_LinFcRSDFT_short_Du2_z, & -! !$OMP Ir2_LinFcRSDFT_short_Du2_2, int2_grad1_u12_square_ao) +! !$OMP PARALLEL & +! !$OMP DEFAULT (NONE) & +! !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, dr2, & +! !$OMP tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, & +! !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & +! !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & +! !$OMP tmp_ct, tmp_ct2, env_val, env_grad, & +! !$OMP Ir2_rsdft_long_Du2_0, Ir2_rsdft_long_Du2_x, & +! !$OMP Ir2_rsdft_long_Du2_y, Ir2_rsdft_long_Du2_z, & +! !$OMP Ir2_rsdft_gauss_Du2, Ir2_rsdft_long_Du2_2, & +! !$OMP Ir2_rsdft_short_Du2_0, Ir2_rsdft_short_Du2_x, & +! !$OMP Ir2_rsdft_short_Du2_y, Ir2_rsdft_short_Du2_z, & +! !$OMP Ir2_rsdft_short_Du2_2, int2_grad1_u12_square_ao) ! !$OMP DO SCHEDULE (static) ! do ipoint = 1, n_points_final_grid ! @@ -492,12 +492,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p ! do j = 1, ao_num ! do i = 1, ao_num ! -! tmp2 = tmp1_x * Ir2_LinFcRSDFT_long_Du2_x (i,j,ipoint) + tmp1_y * Ir2_LinFcRSDFT_long_Du2_y (i,j,ipoint) + tmp1_z * Ir2_LinFcRSDFT_long_Du2_z (i,j,ipoint) & -! - tmp0_x * Ir2_LinFcRSDFT_short_Du2_x(i,j,ipoint) - tmp0_y * Ir2_LinFcRSDFT_short_Du2_y(i,j,ipoint) - tmp0_z * Ir2_LinFcRSDFT_short_Du2_z(i,j,ipoint) +! tmp2 = tmp1_x * Ir2_rsdft_long_Du2_x (i,j,ipoint) + tmp1_y * Ir2_rsdft_long_Du2_y (i,j,ipoint) + tmp1_z * Ir2_rsdft_long_Du2_z (i,j,ipoint) & +! - tmp0_x * Ir2_rsdft_short_Du2_x(i,j,ipoint) - tmp0_y * Ir2_rsdft_short_Du2_y(i,j,ipoint) - tmp0_z * Ir2_rsdft_short_Du2_z(i,j,ipoint) ! -! int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * Ir2_LinFcRSDFT_short_Du2_0(i,j,ipoint) + tmp2 + tmp3 * Ir2_LinFcRSDFT_short_Du2_2(i,j,ipoint) & -! + tmp4 * Ir2_LinFcRSDFT_gauss_Du2(i,j,ipoint) - tmp5 * Ir2_LinFcRSDFT_long_Du2_0(i,j,ipoint) & -! - tmp6 * Ir2_LinFcRSDFT_long_Du2_2(i,j,ipoint) +! int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * Ir2_rsdft_short_Du2_0(i,j,ipoint) + tmp2 + tmp3 * Ir2_rsdft_short_Du2_2(i,j,ipoint) & +! + tmp4 * Ir2_rsdft_gauss_Du2(i,j,ipoint) - tmp5 * Ir2_rsdft_long_Du2_0(i,j,ipoint) & +! - tmp6 * Ir2_rsdft_long_Du2_2(i,j,ipoint) ! enddo ! enddo ! enddo @@ -524,17 +524,17 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p tmp_ct1 = 1.0d0 / (dsqrt(dacos(-1.d0)) * mu_erf) tmp_ct2 = 1.0d0 / (dble(elec_num) - 1.d0) - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx1, dy1, dz1, & - !$OMP dx2, dy2, dz2, dr12, tmp0, tmp1, tmp2, tmp3, tmp4, & - !$OMP tmp0_x, tmp0_y, tmp0_z) & - !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & - !$OMP tmp_ct1, tmp_ct2, env_val, env_grad, & - !$OMP j1e_dx, j1e_dy, j1e_dz, & - !$OMP Ir2_LinFcRSDFT_long_Du_0, Ir2_LinFcRSDFT_long_Du_2, & - !$OMP Ir2_LinFcRSDFT_long_Du_x, Ir2_LinFcRSDFT_long_Du_y, & - !$OMP Ir2_LinFcRSDFT_long_Du_z, Ir2_LinFcRSDFT_gauss_Du, & + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx1, dy1, dz1, & + !$OMP dx2, dy2, dz2, dr12, tmp0, tmp1, tmp2, tmp3, tmp4, & + !$OMP tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct1, tmp_ct2, env_val, env_grad, & + !$OMP j1e_dx, j1e_dy, j1e_dz, & + !$OMP Ir2_rsdft_long_Du_0, Ir2_rsdft_long_Du_2, & + !$OMP Ir2_rsdft_long_Du_x, Ir2_rsdft_long_Du_y, & + !$OMP Ir2_rsdft_long_Du_z, Ir2_rsdft_gauss_Du, & !$OMP ao_overlap, int2_grad1_u12_square_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid @@ -566,11 +566,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p do j = 1, ao_num do i = 1, ao_num - tmp4 = tmp0_x * Ir2_LinFcRSDFT_long_Du_x(i,j,ipoint) + tmp0_y * Ir2_LinFcRSDFT_long_Du_y(i,j,ipoint) + tmp0_z * Ir2_LinFcRSDFT_long_Du_z(i,j,ipoint) + tmp4 = tmp0_x * Ir2_rsdft_long_Du_x(i,j,ipoint) + tmp0_y * Ir2_rsdft_long_Du_y(i,j,ipoint) + tmp0_z * Ir2_rsdft_long_Du_z(i,j,ipoint) - int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1_u12_square_ao(i,j,ipoint) & - + tmp0 * Ir2_LinFcRSDFT_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_LinFcRSDFT_long_Du_2(i,j,ipoint) & - - tmp2 * Ir2_LinFcRSDFT_gauss_Du(i,j,ipoint) & + int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1_u12_square_ao(i,j,ipoint) & + + tmp0 * Ir2_rsdft_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_rsdft_long_Du_2(i,j,ipoint) & + - tmp2 * Ir2_rsdft_gauss_Du(i,j,ipoint) & + tmp3 * ao_overlap(i,j) enddo enddo @@ -578,7 +578,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p !$OMP END DO !$OMP END PARALLEL - FREE Ir2_LinFcRSDFT_long_Du_0 Ir2_LinFcRSDFT_long_Du_x Ir2_LinFcRSDFT_long_Du_y Ir2_LinFcRSDFT_long_Du_z Ir2_LinFcRSDFT_gauss_Du Ir2_LinFcRSDFT_long_Du_2 + FREE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_gauss_Du Ir2_rsdft_long_Du_2 endif ! j1e_type diff --git a/plugins/local/non_h_ints_mu/total_tc_int.irp.f b/plugins/local/non_h_ints_mu/total_tc_int.irp.f index 9df1a8a6..2fbeeb3a 100644 --- a/plugins/local/non_h_ints_mu/total_tc_int.irp.f +++ b/plugins/local/non_h_ints_mu/total_tc_int.irp.f @@ -36,6 +36,7 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n double precision, allocatable :: b_mat(:,:,:,:), c_mat(:,:,:) double precision, external :: get_ao_two_e_integral + PROVIDe tc_integ_type PROVIDE env_type PROVIDE j2e_type PROVIDE j1e_type diff --git a/src/hamiltonian/EZFIO.cfg b/src/hamiltonian/EZFIO.cfg index 652a3e33..9b51c560 100644 --- a/src/hamiltonian/EZFIO.cfg +++ b/src/hamiltonian/EZFIO.cfg @@ -5,64 +5,3 @@ interface: ezfio,provider,ocaml default: 0.5 ezfio_name: mu_erf -[j2e_type] -type: character*(32) -doc: type of the 2e-Jastrow: [ rs-dft | rs-dft-murho | champ ] -interface: ezfio,provider,ocaml -default: lin-fc-rs-dft - -[j1e_type] -type: character*(32) -doc: type of the 1e-Jastrow: [ none | gauss ] -interface: ezfio,provider,ocaml -default: none - -[j1e_size] -type: integer -doc: number of functions per atom in 1e-Jastrow -interface: ezfio,provider,ocaml -default: 1 - -[j1e_coef] -type: double precision -doc: linear coef of functions in 1e-Jastrow -interface: ezfio -size: (hamiltonian.j1e_size,nuclei.nucl_num) - -[j1e_expo] -type: double precision -doc: exponenets of functions in 1e-Jastrow -interface: ezfio -size: (hamiltonian.j1e_size,nuclei.nucl_num) - -[env_type] -type: character*(32) -doc: type of 1-body Jastrow: [ prod-gauss | sum-gauss | sum-slat | sum-quartic ] -interface: ezfio, provider, ocaml -default: sum-gauss - -[env_expo] -type: double precision -doc: exponents of the 1-body Jastrow -interface: ezfio -size: (nuclei.nucl_num) - -[env_coef] -type: double precision -doc: coefficients of the 1-body Jastrow -interface: ezfio -size: (nuclei.nucl_num) - -[murho_type] -type: integer -doc: type of mu(rho) Jastrow -interface: ezfio, provider, ocaml -default: 0 - -[ng_fit_jast] -type: integer -doc: nb of Gaussians used to fit Jastrow fcts -interface: ezfio,provider,ocaml -default: 20 - - From c3c65927cad4ff2c29b6c948a96cee235775f89e Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Mon, 15 Jan 2024 23:35:26 +0100 Subject: [PATCH 71/84] added charge-harmonizer one-body Jastrow --- plugins/local/non_h_ints_mu/jast_1e.irp.f | 137 +++++++++++-- .../local/non_h_ints_mu/jast_1e_utils.irp.f | 181 ++++++++++++++++++ plugins/local/non_h_ints_mu/tc_integ.irp.f | 30 +-- .../local/non_h_ints_mu/test_non_h_ints.irp.f | 138 +++++++++++-- 4 files changed, 442 insertions(+), 44 deletions(-) create mode 100644 plugins/local/non_h_ints_mu/jast_1e_utils.irp.f diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f index 4894f30b..e6a692b5 100644 --- a/plugins/local/non_h_ints_mu/jast_1e.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -7,6 +7,12 @@ BEGIN_PROVIDER [double precision, j1e_val, (n_points_final_grid)] integer :: ipoint, i, j, p double precision :: x, y, z, dx, dy, dz, d2 double precision :: a, c, tmp + double precision :: time0, time1 + + PROVIDE j1e_type + + call wall_time(time0) + print*, ' providing j1e_val ...' if(j1e_type .eq. "none") then @@ -46,29 +52,40 @@ BEGIN_PROVIDER [double precision, j1e_val, (n_points_final_grid)] else - print *, ' Error: Unknown j1e_type = ', j1e_type + print *, ' Error in j1e_val: Unknown j1e_type = ', j1e_type stop endif + call wall_time(time1) + print*, ' Wall time for j1e_val (min) = ', (time1 - time0) / 60.d0 + call print_memory_usage() + END_PROVIDER ! --- - BEGIN_PROVIDER [double precision, j1e_dx, (n_points_final_grid)] -&BEGIN_PROVIDER [double precision, j1e_dy, (n_points_final_grid)] -&BEGIN_PROVIDER [double precision, j1e_dz, (n_points_final_grid)] + BEGIN_PROVIDER [double precision, j1e_gradx, (n_points_final_grid)] +&BEGIN_PROVIDER [double precision, j1e_grady, (n_points_final_grid)] +&BEGIN_PROVIDER [double precision, j1e_gradz, (n_points_final_grid)] implicit none - integer :: ipoint, i, j, p - double precision :: x, y, z, dx, dy, dz, d2 - double precision :: a, c, g, tmp_x, tmp_y, tmp_z + integer :: ipoint, i, j, p + double precision :: x, y, z, dx, dy, dz, d2 + double precision :: a, c, g, tmp_x, tmp_y, tmp_z + double precision :: time0, time1 + double precision, allocatable :: Pa(:,:), Pb(:,:), Pt(:,:) + + PROVIDE j1e_type + + call wall_time(time0) + print*, ' providing j1e_grad ...' if(j1e_type .eq. "none") then - j1e_dx = 0.d0 - j1e_dy = 0.d0 - j1e_dz = 0.d0 + j1e_gradx = 0.d0 + j1e_grady = 0.d0 + j1e_gradz = 0.d0 elseif(j1e_type .eq. "gauss") then @@ -104,14 +121,105 @@ END_PROVIDER enddo enddo - j1e_dx(ipoint) = tmp_x - j1e_dy(ipoint) = tmp_y - j1e_dz(ipoint) = tmp_z + j1e_gradx(ipoint) = 2.d0 * tmp_x + j1e_grady(ipoint) = 2.d0 * tmp_y + j1e_gradz(ipoint) = 2.d0 * tmp_z + enddo + + elseif(j1e_type .eq. "charge-harmonizer") then + + ! The - sign is in the integral over r2 + ! [(N-1)/2N] x \sum_{\mu,\nu} P_{\mu,\nu} \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_\mu(r2) \phi_nu(r2) + + PROVIDE elec_alpha_num elec_beta_num elec_num + PROVIDE mo_coef + PROVIDE int2_grad1_u2b_ao + + allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) + + call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pa, size(Pa, 1)) + + if(elec_alpha_num .eq. elec_beta_num) then + Pb = Pa + else + call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pb, size(Pb, 1)) + endif + Pt = Pa + Pb + + g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,1), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradx, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,2), ao_num*ao_num, Pt, 1, 0.d0, j1e_grady, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,3), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradz, 1) + + deallocate(Pa, Pb, Pt) + + else + + print *, ' Error in j1e_grad: Unknown j1e_type = ', j1e_type + stop + + endif + + call wall_time(time1) + print*, ' Wall time for j1e_grad (min) = ', (time1 - time0) / 60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, j1e_lapl, (n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, p + double precision :: x, y, z, dx, dy, dz, d2 + double precision :: a, c, g, tmp + + if(j1e_type .eq. "none") then + + j1e_lapl = 0.d0 + + elseif(j1e_type .eq. "gauss") then + + ! - \sum_{A} (r - R_A) \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) + + PROVIDE j1e_size j1e_coef j1e_expo + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + tmp = 0.d0 + do j = 1, nucl_num + + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + d2 = dx*dx + dy*dy + dz*dz + + do p = 1, j1e_size + + c = j1e_coef(p,j) + a = j1e_expo(p,j) + g = c * a * dexp(-a*d2) + + tmp = tmp + (2.d0 * a * d2 - 3.d0) * g + enddo + enddo + + j1e_lapl(ipoint) = tmp enddo else - print *, ' Error: Unknown j1e_type = ', j1e_type + print *, ' Error in j1e_lapl: Unknown j1e_type = ', j1e_type stop endif @@ -120,4 +228,3 @@ END_PROVIDER ! --- - diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f new file mode 100644 index 00000000..2cfde97a --- /dev/null +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -0,0 +1,181 @@ + +! --- + +BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_final_grid, 3)] + + BEGIN_DOC + ! + ! int2_grad1_u2b_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J_2b(r1,r2)] \phi_i(r2) \phi_j(r2) + ! + ! where r1 = r(ipoint) + ! + END_DOC + + implicit none + integer :: ipoint, i, j, m, jpoint + double precision :: time0, time1 + double precision :: x, y, z, r2 + double precision :: dx, dy, dz + double precision :: tmp_ct + double precision :: tmp0, tmp1, tmp2 + double precision :: tmp0_x, tmp0_y, tmp0_z + double precision :: tmp1_x, tmp1_y, tmp1_z + + PROVIDE j2e_type + + call wall_time(time0) + + print*, ' providing int2_grad1_u2b_ao ...' + + if(tc_integ_type .eq. "numeric") then + + ! TODO combine 1shot & int2_grad1_u12_ao_num + + PROVIDE int2_grad1_u12_ao_num + int2_grad1_u2b_ao = int2_grad1_u12_ao_num + + !PROVIDE int2_grad1_u12_ao_num_1shot + !int2_grad1_u2b_ao = int2_grad1_u12_ao_num_1shot + + elseif(tc_integ_type .eq. "semi-analytic") then + + ! --- + + if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + + PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu + + int2_grad1_u2b_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & + !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & + !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u2b_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + do j = 1, ao_num + do i = 1, ao_num + tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) + int2_grad1_u2b_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) + int2_grad1_u2b_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + + PROVIDE env_type env_val env_grad + PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + + int2_grad1_u2b_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & + !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u2b_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + tmp0 = 0.5d0 * env_val(ipoint) + tmp0_x = env_grad(1,ipoint) + tmp0_y = env_grad(2,ipoint) + tmp0_z = env_grad(3,ipoint) + do j = 1, ao_num + do i = 1, ao_num + tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) + tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x + int2_grad1_u2b_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y + int2_grad1_u2b_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then + + PROVIDE mu_erf + PROVIDE env_type env_val env_grad + PROVIDE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_long_Du_2 + PROVIDE Ir2_rsdft_gauss_Du + + tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + + int2_grad1_u2b_ao = 0.d0 + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & + !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct, env_val, env_grad, Ir2_rsdft_long_Du_0, & + !$OMP Ir2_rsdft_long_Du_x, Ir2_rsdft_long_Du_y, & + !$OMP Ir2_rsdft_long_Du_z, Ir2_rsdft_gauss_Du, & + !$OMP Ir2_rsdft_long_Du_2, int2_grad1_u2b_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx = env_grad(1,ipoint) + dy = env_grad(2,ipoint) + dz = env_grad(3,ipoint) + + tmp0_x = 0.5d0 * (env_val(ipoint) * x + r2 * dx) + tmp0_y = 0.5d0 * (env_val(ipoint) * y + r2 * dy) + tmp0_z = 0.5d0 * (env_val(ipoint) * z + r2 * dz) + + tmp1 = 0.5d0 * env_val(ipoint) + + tmp1_x = tmp_ct * dx + tmp1_y = tmp_ct * dy + tmp1_z = tmp_ct * dz + + do j = 1, ao_num + do i = 1, ao_num + + tmp2 = 0.5d0 * Ir2_rsdft_long_Du_2(i,j,ipoint) - x * Ir2_rsdft_long_Du_x(i,j,ipoint) - y * Ir2_rsdft_long_Du_y(i,j,ipoint) - z * Ir2_rsdft_long_Du_z(i,j,ipoint) + + int2_grad1_u2b_ao(i,j,ipoint,1) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_rsdft_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_rsdft_gauss_Du(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,2) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_rsdft_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_rsdft_gauss_Du(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,3) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_rsdft_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_rsdft_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + else + + print *, ' Error in int2_grad1_u2b_ao: Unknown Jastrow' + stop + + endif ! j2e_type + + else + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' + stop + + endif ! tc_integ_type + + call wall_time(time1) + print*, ' wall time for int2_grad1_u2b_ao (min) =', (time1-time0)/60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f index cb1d2beb..10324251 100644 --- a/plugins/local/non_h_ints_mu/tc_integ.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -119,8 +119,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f !$OMP END DO !$OMP END PARALLEL - FREE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then PROVIDE mu_erf @@ -190,7 +188,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f PROVIDE elec_num PROVIDE ao_overlap - PROVIDE j1e_dx j1e_dy j1e_dz + PROVIDE j1e_gradx j1e_grady j1e_gradz tmp_ct = 1.d0 / (dble(elec_num) - 1.d0) @@ -198,12 +196,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f !$OMP DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, tmp0_x, tmp0_y, tmp0_z) & !$OMP SHARED (ao_num, n_points_final_grid, tmp_ct, & - !$OMP j1e_dx, j1e_dy, j1e_dz, ao_overlap, int2_grad1_u12_ao) + !$OMP j1e_gradx, j1e_grady, j1e_gradz, ao_overlap, int2_grad1_u12_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid - tmp0_x = tmp_ct * j1e_dx(ipoint) - tmp0_y = tmp_ct * j1e_dy(ipoint) - tmp0_z = tmp_ct * j1e_dz(ipoint) + tmp0_x = tmp_ct * j1e_gradx(ipoint) + tmp0_y = tmp_ct * j1e_grady(ipoint) + tmp0_z = tmp_ct * j1e_gradz(ipoint) do j = 1, ao_num do i = 1, ao_num int2_grad1_u12_ao(i,j,ipoint,1) = int2_grad1_u12_ao(i,j,ipoint,1) + tmp0_x * ao_overlap(i,j) @@ -217,7 +215,13 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f else - FREE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_gauss_Du Ir2_rsdft_long_Du_2 + if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + FREE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + FREE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then + FREE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_gauss_Du Ir2_rsdft_long_Du_2 + endif endif ! j1e_type @@ -519,7 +523,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p PROVIDE elec_num PROVIDE ao_overlap - PROVIDE j1e_dx j1e_dy j1e_dz + PROVIDE j1e_gradx j1e_grady j1e_gradz tmp_ct1 = 1.0d0 / (dsqrt(dacos(-1.d0)) * mu_erf) tmp_ct2 = 1.0d0 / (dble(elec_num) - 1.d0) @@ -531,7 +535,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p !$OMP tmp0_x, tmp0_y, tmp0_z) & !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & !$OMP tmp_ct1, tmp_ct2, env_val, env_grad, & - !$OMP j1e_dx, j1e_dy, j1e_dz, & + !$OMP j1e_gradx, j1e_grady, j1e_gradz, & !$OMP Ir2_rsdft_long_Du_0, Ir2_rsdft_long_Du_2, & !$OMP Ir2_rsdft_long_Du_x, Ir2_rsdft_long_Du_y, & !$OMP Ir2_rsdft_long_Du_z, Ir2_rsdft_gauss_Du, & @@ -548,9 +552,9 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p dy1 = env_grad(2,ipoint) dz1 = env_grad(3,ipoint) - dx2 = j1e_dx(ipoint) - dy2 = j1e_dy(ipoint) - dz2 = j1e_dz(ipoint) + dx2 = j1e_gradx(ipoint) + dy2 = j1e_grady(ipoint) + dz2 = j1e_gradz(ipoint) dr12 = dx1*dx2 + dy1*dy2 + dz1*dz2 diff --git a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f index c57f8400..6a30d909 100644 --- a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f +++ b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f @@ -26,28 +26,33 @@ program test_non_h !call test_v_ij_u_cst_mu_env_an() - call test_int2_grad1_u12_square_ao() - call test_int2_grad1_u12_ao() + !call test_int2_grad1_u12_square_ao() + !call test_int2_grad1_u12_ao() + + call test_j1e_grad() end ! --- subroutine routine_fit - implicit none - integer :: i,nx - double precision :: dx,xmax,x,j_mu,j_mu_F_x_j,j_mu_fit_gauss - nx = 500 - xmax = 5.d0 - dx = xmax/dble(nx) - x = 0.d0 - print*,'coucou',mu_erf - do i = 1, nx - write(33,'(100(F16.10,X))') x,j_mu(x),j_mu_F_x_j(x),j_mu_fit_gauss(x) - x += dx - enddo + + implicit none + integer :: i,nx + double precision :: dx,xmax,x,j_mu,j_mu_F_x_j,j_mu_fit_gauss + + nx = 500 + xmax = 5.d0 + dx = xmax/dble(nx) + x = 0.d0 + print*,'coucou',mu_erf + do i = 1, nx + write(33,'(100(F16.10,X))') x,j_mu(x),j_mu_F_x_j(x),j_mu_fit_gauss(x) + x += dx + enddo end +! --- subroutine test_ipp() @@ -561,7 +566,7 @@ subroutine test_int2_grad1_u12_square_ao() print*, ' accuracy(%) = ', 100.d0 * accu / norm return -end subroutine test_int2_grad1_u12_square_ao +end ! --- @@ -605,7 +610,108 @@ subroutine test_int2_grad1_u12_ao() print*, ' accuracy(%) = ', 100.d0 * accu / norm return -end subroutine test_int2_grad1_u12_ao +end + +! --- + +subroutine test_j1e_grad() + + implicit none + integer :: i, j, ipoint + double precision :: g + double precision :: x_loops, x_dgemm, diff, thr, accu, norm + double precision, allocatable :: pa(:,:), Pb(:,:), Pt(:,:) + double precision, allocatable :: x(:), y(:), z(:) + + PROVIDE int2_grad1_u2b_ao + PROVIDE mo_coef + + allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) + + call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pa, size(Pa, 1)) + + if(elec_alpha_num .eq. elec_beta_num) then + Pb = Pa + else + call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pb, size(Pb, 1)) + endif + Pt = Pa + Pa + + + g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + + allocate(x(n_points_final_grid), y(n_points_final_grid), z(n_points_final_grid)) + + do ipoint = 1, n_points_final_grid + x(ipoint) = 0.d0 + y(ipoint) = 0.d0 + z(ipoint) = 0.d0 + do i = 1, ao_num + do j = 1, ao_num + x(ipoint) = x(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,1) + y(ipoint) = y(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,2) + z(ipoint) = z(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,3) + enddo + enddo + enddo + + deallocate(Pa, Pb, Pt) + + ! --- + + thr = 1d-10 + norm = 0.d0 + accu = 0.d0 + do ipoint = 1, n_points_final_grid + + x_loops = x (ipoint) + x_dgemm = j1e_gradx(ipoint) + diff = dabs(x_loops - x_dgemm) + if(diff .gt. thr) then + print *, ' problem in j1e_gradx on:', ipoint + print *, ' loops :', x_loops + print *, ' dgemm :', x_dgemm + stop + endif + accu += diff + norm += dabs(x_loops) + + x_loops = y (ipoint) + x_dgemm = j1e_grady(ipoint) + diff = dabs(x_loops - x_dgemm) + if(diff .gt. thr) then + print *, ' problem in j1e_grady on:', ipoint + print *, ' loops :', x_loops + print *, ' dgemm :', x_dgemm + stop + endif + accu += diff + norm += dabs(x_loops) + + x_loops = z (ipoint) + x_dgemm = j1e_gradz(ipoint) + diff = dabs(x_loops - x_dgemm) + if(diff .gt. thr) then + print *, ' problem in j1e_gradz on:', ipoint + print *, ' loops :', x_loops + print *, ' dgemm :', x_dgemm + stop + endif + accu += diff + norm += dabs(x_loops) + + enddo + + deallocate(x, y, z) + + print*, ' accuracy(%) = ', 100.d0 * accu / norm + + return +end ! --- From da7edff3b7875eb08a31d98072f65c668239d492 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Tue, 16 Jan 2024 00:02:25 +0100 Subject: [PATCH 72/84] added README for Jastrow --- plugins/local/jastrow/README.md | 62 +++++++++++++++++++++- plugins/local/non_h_ints_mu/tc_integ.irp.f | 12 ++++- 2 files changed, 71 insertions(+), 3 deletions(-) diff --git a/plugins/local/jastrow/README.md b/plugins/local/jastrow/README.md index aefb6ad5..f3cd363c 100644 --- a/plugins/local/jastrow/README.md +++ b/plugins/local/jastrow/README.md @@ -1,3 +1,63 @@ # Jastrow -Information relative to the Jastrow factor in trans-correlated calculations. +Information related to the Jastrow factor in trans-correlated calculations. + +The main keywords are: +- `j2e_type` +- `j1e_type` +- `env_type` + +## j2e_type Options + +1. **none:** No 2e-Jastrow is used. + +2. **rs-dft:** 2e-Jastrow inspired by Range Separated Density Functional Theory. It has the following shape: + \begin{equation} + \tau = \frac{1}{2} \sum_{i,j \neq i} u(\mathbf{r}_i, \mathbf{r}_j), + \end{equation} + with, + \begin{equation} + u(\mathbf{r}_1, \mathbf{r}_2) = u(r_{12}) = \frac{r_{12}}{2} \left[ 1 - \text{erf}(\mu \, r_{12}) \right] - \frac{\exp\left[- (\mu \, r_{12})^2\right]}{2 \sqrt{\pi} \mu}. + \end{equation} + + + +## env_type Options + +The Jastrow used is multiplied by an envelope \(v\): + +\begin{equation} +\tau = \frac{1}{2} \sum_{i,j \neq i} u(\mathbf{r}_i, \mathbf{r}_j) \, v(\mathbf{r}_i) \, v(\mathbf{r}_j) +\end{equation} + +- if `env_type` is **none**: No envelope is used. + +- if `env_type` is **prod-gauss**: \(v(\mathbf{r}) = \prod_{a} \left(1 - e^{-\alpha_a (\mathbf{r} - \mathbf{R}_a)^2 } \right)\) + +- if `env_type` is **sum-gauss**: \(v(\mathbf{r}) = 1 - \sum_{a} \left(1 - c_a e^{-\alpha_a (\mathbf{r} - \mathbf{R}_a)^2 } \right)\) + +Here, \(A\) designates the nuclei, and the coefficients and exponents are defined in the tables `enc_coef` and `env_expo` respectively. + + + +## j1e_type Options + +The Jastrow used is: + +\begin{equation} +\tau = \sum_i u_{1e}(\mathbf{r}_i) +\end{equation} + +- if `j1e_type` is **none**: No one-electron Jastrow is used. + +- if `j1e_type` is **gauss**: We use \(u_{1e}(\mathbf{r}) = \sum_A \sum_{p_A} c_{p_A} e^{-\alpha_{p_A} (\mathbf{r} - \mathbf{R}_A)^2}\), where the \(c_p\) and \(\alpha_p\) are defined by the tables `j1e_coef` and `j1e_expo`, respectively. + +- if `j1e_type` is **charge-harmonizer**: The one-electron Jastrow factor depends on the two-electron Jastrow factor \(u_{2e}\) such that the one-electron term is added to compensate for the unfavorable effect of altering the charge density caused by the two-electron factor: +\begin{equation} +u_{1e}(\mathbf{r}_1) = - \frac{N-1}{2N} \sum_{\sigma} \int d\mathbf{r}_2 \rho^{\sigma}(\mathbf{r}_2) u_{2e}(\mathbf{r}_1, \mathbf{r}_2), +\end{equation} + +Feel free to review and let me know if any further adjustments are needed. + + + diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f index 10324251..ee4a7c04 100644 --- a/plugins/local/non_h_ints_mu/tc_integ.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -59,7 +59,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f ! --- - if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + if(j2e_type .eq. "none") then + + int2_grad1_u12_ao = 0.d0 + + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu @@ -307,7 +311,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p ! --- - if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + if(j2e_type .eq. "none") then + + int2_grad1_u12_square_ao = 0.d0 + + elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then PROVIDE int2_grad1u2_grad2u2 From ea67ba86322eafb412675d0b928c1017b6b2c71d Mon Sep 17 00:00:00 2001 From: AbdAmmar <59544987+AbdAmmar@users.noreply.github.com> Date: Tue, 16 Jan 2024 00:08:46 +0100 Subject: [PATCH 73/84] Update README.md --- plugins/local/jastrow/README.md | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/plugins/local/jastrow/README.md b/plugins/local/jastrow/README.md index f3cd363c..33ed177b 100644 --- a/plugins/local/jastrow/README.md +++ b/plugins/local/jastrow/README.md @@ -12,14 +12,8 @@ The main keywords are: 1. **none:** No 2e-Jastrow is used. 2. **rs-dft:** 2e-Jastrow inspired by Range Separated Density Functional Theory. It has the following shape: - \begin{equation} - \tau = \frac{1}{2} \sum_{i,j \neq i} u(\mathbf{r}_i, \mathbf{r}_j), - \end{equation} - with, - \begin{equation} - u(\mathbf{r}_1, \mathbf{r}_2) = u(r_{12}) = \frac{r_{12}}{2} \left[ 1 - \text{erf}(\mu \, r_{12}) \right] - \frac{\exp\left[- (\mu \, r_{12})^2\right]}{2 \sqrt{\pi} \mu}. - \end{equation} - + \[ \tau = \frac{1}{2} \sum_{i,j \neq i} u(\mathbf{r}_i, \mathbf{r}_j) \] + with, \[ u(\mathbf{r}_1, \mathbf{r}_2) = u(r_{12}) = \frac{r_{12}}{2} \left[ 1 - \text{erf}(\mu \, r_{12}) \right] - \frac{\exp\left[- (\mu \, r_{12})^2\right]}{2 \sqrt{\pi} \mu} \] ## env_type Options From 2f40ff5776183eab249c238765007182b03cde48 Mon Sep 17 00:00:00 2001 From: AbdAmmar <59544987+AbdAmmar@users.noreply.github.com> Date: Tue, 16 Jan 2024 01:13:44 +0100 Subject: [PATCH 74/84] Update README.md --- plugins/local/jastrow/README.md | 57 ++++++++++++++++++++------------- 1 file changed, 34 insertions(+), 23 deletions(-) diff --git a/plugins/local/jastrow/README.md b/plugins/local/jastrow/README.md index 33ed177b..0b74b6c6 100644 --- a/plugins/local/jastrow/README.md +++ b/plugins/local/jastrow/README.md @@ -12,46 +12,57 @@ The main keywords are: 1. **none:** No 2e-Jastrow is used. 2. **rs-dft:** 2e-Jastrow inspired by Range Separated Density Functional Theory. It has the following shape: - \[ \tau = \frac{1}{2} \sum_{i,j \neq i} u(\mathbf{r}_i, \mathbf{r}_j) \] - with, \[ u(\mathbf{r}_1, \mathbf{r}_2) = u(r_{12}) = \frac{r_{12}}{2} \left[ 1 - \text{erf}(\mu \, r_{12}) \right] - \frac{\exp\left[- (\mu \, r_{12})^2\right]}{2 \sqrt{\pi} \mu} \] +

+ +

+ with, +

+ +

## env_type Options -The Jastrow used is multiplied by an envelope \(v\): - -\begin{equation} -\tau = \frac{1}{2} \sum_{i,j \neq i} u(\mathbf{r}_i, \mathbf{r}_j) \, v(\mathbf{r}_i) \, v(\mathbf{r}_j) -\end{equation} +The 2-electron Jastrow is multiplied by an envelope \(v\): +

+ +

- if `env_type` is **none**: No envelope is used. -- if `env_type` is **prod-gauss**: \(v(\mathbf{r}) = \prod_{a} \left(1 - e^{-\alpha_a (\mathbf{r} - \mathbf{R}_a)^2 } \right)\) +- if `env_type` is **prod-gauss**: +

+ +

-- if `env_type` is **sum-gauss**: \(v(\mathbf{r}) = 1 - \sum_{a} \left(1 - c_a e^{-\alpha_a (\mathbf{r} - \mathbf{R}_a)^2 } \right)\) - -Here, \(A\) designates the nuclei, and the coefficients and exponents are defined in the tables `enc_coef` and `env_expo` respectively. +- if `env_type` is **sum-gauss**: +

+ +

+Here, \(A\) designates the nuclei, and the coefficients and exponents are defined in the tables `env_coef` and `env_expo` respectively. ## j1e_type Options -The Jastrow used is: - -\begin{equation} -\tau = \sum_i u_{1e}(\mathbf{r}_i) -\end{equation} +The 1-electron Jastrow used is: +

+ +

- if `j1e_type` is **none**: No one-electron Jastrow is used. -- if `j1e_type` is **gauss**: We use \(u_{1e}(\mathbf{r}) = \sum_A \sum_{p_A} c_{p_A} e^{-\alpha_{p_A} (\mathbf{r} - \mathbf{R}_A)^2}\), where the \(c_p\) and \(\alpha_p\) are defined by the tables `j1e_coef` and `j1e_expo`, respectively. +- if `j1e_type` is **gauss**: We use +

+ +

+ -- if `j1e_type` is **charge-harmonizer**: The one-electron Jastrow factor depends on the two-electron Jastrow factor \(u_{2e}\) such that the one-electron term is added to compensate for the unfavorable effect of altering the charge density caused by the two-electron factor: -\begin{equation} -u_{1e}(\mathbf{r}_1) = - \frac{N-1}{2N} \sum_{\sigma} \int d\mathbf{r}_2 \rho^{\sigma}(\mathbf{r}_2) u_{2e}(\mathbf{r}_1, \mathbf{r}_2), -\end{equation} - -Feel free to review and let me know if any further adjustments are needed. +are defined by the tables `j1e_coef` and `j1e_expo`, respectively. +- if `j1e_type` is **charge-harmonizer**: The one-electron Jastrow factor aims to offset the adverse impact of modifying the charge density induced by the two-electron factor +

+ +

From 7bcc963a326567ef6a9a2da6fdfafdd4d84d42d9 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Tue, 16 Jan 2024 19:07:20 +0100 Subject: [PATCH 75/84] homogenisation avec qmch=chem --- .../ao_many_one_e_ints/lin_fc_rsdft.irp.f | 178 +++++++++--------- .../local/ao_many_one_e_ints/listj1b.irp.f | 16 +- plugins/local/jastrow/EZFIO.cfg | 12 +- plugins/local/jastrow/README.md | 10 +- .../non_h_ints_mu/debug_integ_jmu_modif.irp.f | 12 +- .../non_h_ints_mu/grad_squared_manu.irp.f | 2 +- .../local/non_h_ints_mu/j12_nucl_utils.irp.f | 10 +- plugins/local/non_h_ints_mu/jast_1e.irp.f | 14 +- .../local/non_h_ints_mu/jast_1e_utils.irp.f | 26 +-- plugins/local/non_h_ints_mu/jast_deriv.irp.f | 8 +- .../non_h_ints_mu/jast_deriv_utils.irp.f | 30 +-- .../non_h_ints_mu/jast_deriv_utils_vect.irp.f | 18 +- .../non_h_ints_mu/new_grad_tc_manu.irp.f | 2 +- plugins/local/non_h_ints_mu/tc_integ.irp.f | 101 +++++----- .../local/non_h_ints_mu/total_tc_int.irp.f | 4 +- 15 files changed, 222 insertions(+), 221 deletions(-) diff --git a/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f b/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f index 8685e563..3483872b 100644 --- a/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f +++ b/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f @@ -1,21 +1,21 @@ ! --- - BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_0, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_x, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_y, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_z, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du_2, (ao_num, ao_num, n_points_final_grid)] + BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_rsdft_long_Du_0 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] + ! Ir2_Mu_long_Du_0 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] ! - ! Ir2_rsdft_long_Du_x = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * x2 - ! Ir2_rsdft_long_Du_y = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * y2 - ! Ir2_rsdft_long_Du_z = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * z2 + ! Ir2_Mu_long_Du_x = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * x2 + ! Ir2_Mu_long_Du_y = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * y2 + ! Ir2_Mu_long_Du_z = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * z2 ! - ! Ir2_rsdft_long_Du_2 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * r2^2 + ! Ir2_Mu_long_Du_2 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * r2^2 ! END_DOC @@ -32,7 +32,7 @@ PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent - print *, ' providing Ir2_rsdft_long_Du ...' + print *, ' providing Ir2_Mu_long_Du ...' call wall_time(wall0) !$OMP PARALLEL DEFAULT (NONE) & @@ -41,9 +41,9 @@ !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_erf, & !$OMP List_env1s_size, List_env1s_expo, & !$OMP List_env1s_coef, List_env1s_cent, & - !$OMP Ir2_rsdft_long_Du_0, Ir2_rsdft_long_Du_x, & - !$OMP Ir2_rsdft_long_Du_y, Ir2_rsdft_long_Du_z, & - !$OMP Ir2_rsdft_long_Du_2) + !$OMP Ir2_Mu_long_Du_0, Ir2_Mu_long_Du_x, & + !$OMP Ir2_Mu_long_Du_y, Ir2_Mu_long_Du_z, & + !$OMP Ir2_Mu_long_Du_2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -81,11 +81,11 @@ tmp_Du_2 = tmp_Du_2 + c_1s * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)) enddo - Ir2_rsdft_long_Du_0(j,i,ipoint) = tmp_Du_0 - Ir2_rsdft_long_Du_x(j,i,ipoint) = tmp_Du_x - Ir2_rsdft_long_Du_y(j,i,ipoint) = tmp_Du_y - Ir2_rsdft_long_Du_z(j,i,ipoint) = tmp_Du_z - Ir2_rsdft_long_Du_2(j,i,ipoint) = tmp_Du_2 + Ir2_Mu_long_Du_0(j,i,ipoint) = tmp_Du_0 + Ir2_Mu_long_Du_x(j,i,ipoint) = tmp_Du_x + Ir2_Mu_long_Du_y(j,i,ipoint) = tmp_Du_y + Ir2_Mu_long_Du_z(j,i,ipoint) = tmp_Du_z + Ir2_Mu_long_Du_2(j,i,ipoint) = tmp_Du_2 enddo enddo enddo @@ -95,27 +95,27 @@ do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - Ir2_rsdft_long_Du_0(j,i,ipoint) = Ir2_rsdft_long_Du_0(i,j,ipoint) - Ir2_rsdft_long_Du_x(j,i,ipoint) = Ir2_rsdft_long_Du_x(i,j,ipoint) - Ir2_rsdft_long_Du_y(j,i,ipoint) = Ir2_rsdft_long_Du_y(i,j,ipoint) - Ir2_rsdft_long_Du_z(j,i,ipoint) = Ir2_rsdft_long_Du_z(i,j,ipoint) - Ir2_rsdft_long_Du_2(j,i,ipoint) = Ir2_rsdft_long_Du_2(i,j,ipoint) + Ir2_Mu_long_Du_0(j,i,ipoint) = Ir2_Mu_long_Du_0(i,j,ipoint) + Ir2_Mu_long_Du_x(j,i,ipoint) = Ir2_Mu_long_Du_x(i,j,ipoint) + Ir2_Mu_long_Du_y(j,i,ipoint) = Ir2_Mu_long_Du_y(i,j,ipoint) + Ir2_Mu_long_Du_z(j,i,ipoint) = Ir2_Mu_long_Du_z(i,j,ipoint) + Ir2_Mu_long_Du_2(j,i,ipoint) = Ir2_Mu_long_Du_2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_rsdft_long_Du (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_Mu_long_Du (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, Ir2_Mu_gauss_Du, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_rsdft_gauss_Du = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) e^{-(mu r_12)^2} + ! Ir2_Mu_gauss_Du = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) e^{-(mu r_12)^2} ! END_DOC @@ -136,7 +136,7 @@ BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du, (ao_num, ao_num, n_points_ PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent - print *, ' providing Ir2_rsdft_gauss_Du ...' + print *, ' providing Ir2_Mu_gauss_Du ...' call wall_time(wall0) mu_sq = mu_erf * mu_erf @@ -147,7 +147,7 @@ BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du, (ao_num, ao_num, n_points_ !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & !$OMP List_env1s_size, List_env1s_expo, & !$OMP List_env1s_coef, List_env1s_cent, & - !$OMP Ir2_rsdft_gauss_Du) + !$OMP Ir2_Mu_gauss_Du) !$OMP DO do ipoint = 1, n_points_final_grid @@ -186,7 +186,7 @@ BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du, (ao_num, ao_num, n_points_ tmp_Du += coef * overlap_gauss_r12_ao(B_center, beta, j, i) enddo - Ir2_rsdft_gauss_Du(j,i,ipoint) = tmp_Du + Ir2_Mu_gauss_Du(j,i,ipoint) = tmp_Du enddo enddo enddo @@ -197,33 +197,33 @@ BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du, (ao_num, ao_num, n_points_ do i = 2, ao_num do j = 1, i-1 - Ir2_rsdft_gauss_Du(j,i,ipoint) = Ir2_rsdft_gauss_Du(i,j,ipoint) + Ir2_Mu_gauss_Du(j,i,ipoint) = Ir2_Mu_gauss_Du(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_rsdft_gauss_Du (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_Mu_gauss_Du (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- - BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_0, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_x, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_y, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_z, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_long_Du2_2, (ao_num, ao_num, n_points_final_grid)] + BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_rsdft_long_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] + ! Ir2_Mu_long_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] ! - ! Ir2_rsdft_long_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * x2 - ! Ir2_rsdft_long_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * y2 - ! Ir2_rsdft_long_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * z2 + ! Ir2_Mu_long_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * x2 + ! Ir2_Mu_long_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * y2 + ! Ir2_Mu_long_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * z2 ! - ! Ir2_rsdft_long_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * r2^2 + ! Ir2_Mu_long_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * r2^2 ! END_DOC @@ -242,7 +242,7 @@ END_PROVIDER PROVIDE final_grid_points PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent - print *, ' providing Ir2_rsdft_long_Du2 ...' + print *, ' providing Ir2_Mu_long_Du2 ...' call wall_time(wall0) mu_sq = mu_erf * mu_erf @@ -255,9 +255,9 @@ END_PROVIDER !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & !$OMP mu_erf, List_env1s_square_size, List_env1s_square_expo, & !$OMP List_env1s_square_coef, List_env1s_square_cent, & - !$OMP Ir2_rsdft_long_Du2_0, Ir2_rsdft_long_Du2_x, & - !$OMP Ir2_rsdft_long_Du2_y, Ir2_rsdft_long_Du2_z, & - !$OMP Ir2_rsdft_long_Du2_2) + !$OMP Ir2_Mu_long_Du2_0, Ir2_Mu_long_Du2_x, & + !$OMP Ir2_Mu_long_Du2_y, Ir2_Mu_long_Du2_z, & + !$OMP Ir2_Mu_long_Du2_2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -310,11 +310,11 @@ END_PROVIDER tmp_Du2_2 = tmp_Du2_2 + coef * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)) enddo - Ir2_rsdft_long_Du2_0(j,i,ipoint) = tmp_Du2_0 - Ir2_rsdft_long_Du2_x(j,i,ipoint) = tmp_Du2_x - Ir2_rsdft_long_Du2_y(j,i,ipoint) = tmp_Du2_y - Ir2_rsdft_long_Du2_z(j,i,ipoint) = tmp_Du2_z - Ir2_rsdft_long_Du2_2(j,i,ipoint) = tmp_Du2_2 + Ir2_Mu_long_Du2_0(j,i,ipoint) = tmp_Du2_0 + Ir2_Mu_long_Du2_x(j,i,ipoint) = tmp_Du2_x + Ir2_Mu_long_Du2_y(j,i,ipoint) = tmp_Du2_y + Ir2_Mu_long_Du2_z(j,i,ipoint) = tmp_Du2_z + Ir2_Mu_long_Du2_2(j,i,ipoint) = tmp_Du2_2 enddo enddo enddo @@ -324,27 +324,27 @@ END_PROVIDER do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - Ir2_rsdft_long_Du2_0(j,i,ipoint) = Ir2_rsdft_long_Du2_0(i,j,ipoint) - Ir2_rsdft_long_Du2_x(j,i,ipoint) = Ir2_rsdft_long_Du2_x(i,j,ipoint) - Ir2_rsdft_long_Du2_y(j,i,ipoint) = Ir2_rsdft_long_Du2_y(i,j,ipoint) - Ir2_rsdft_long_Du2_z(j,i,ipoint) = Ir2_rsdft_long_Du2_z(i,j,ipoint) - Ir2_rsdft_long_Du2_2(j,i,ipoint) = Ir2_rsdft_long_Du2_2(i,j,ipoint) + Ir2_Mu_long_Du2_0(j,i,ipoint) = Ir2_Mu_long_Du2_0(i,j,ipoint) + Ir2_Mu_long_Du2_x(j,i,ipoint) = Ir2_Mu_long_Du2_x(i,j,ipoint) + Ir2_Mu_long_Du2_y(j,i,ipoint) = Ir2_Mu_long_Du2_y(i,j,ipoint) + Ir2_Mu_long_Du2_z(j,i,ipoint) = Ir2_Mu_long_Du2_z(i,j,ipoint) + Ir2_Mu_long_Du2_2(j,i,ipoint) = Ir2_Mu_long_Du2_2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_rsdft_long_Du2 (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_Mu_long_Du2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du2, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, Ir2_Mu_gauss_Du2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_rsdft_gauss_Du2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 e^{-(mu r_12)^2} + ! Ir2_Mu_gauss_Du2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 e^{-(mu r_12)^2} ! END_DOC @@ -365,7 +365,7 @@ BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du2, (ao_num, ao_num, n_points PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent - print *, ' providing Ir2_rsdft_gauss_Du2 ...' + print *, ' providing Ir2_Mu_gauss_Du2 ...' call wall_time(wall0) mu_sq = 2.d0 * mu_erf * mu_erf @@ -376,7 +376,7 @@ BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du2, (ao_num, ao_num, n_points !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & !$OMP List_env1s_square_size, List_env1s_square_expo, & !$OMP List_env1s_square_coef, List_env1s_square_cent, & - !$OMP Ir2_rsdft_gauss_Du2) + !$OMP Ir2_Mu_gauss_Du2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -415,7 +415,7 @@ BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du2, (ao_num, ao_num, n_points tmp_Du2 += coef * overlap_gauss_r12_ao(B_center, beta, j, i) enddo - Ir2_rsdft_gauss_Du2(j,i,ipoint) = tmp_Du2 + Ir2_Mu_gauss_Du2(j,i,ipoint) = tmp_Du2 enddo enddo enddo @@ -426,33 +426,33 @@ BEGIN_PROVIDER [double precision, Ir2_rsdft_gauss_Du2, (ao_num, ao_num, n_points do i = 2, ao_num do j = 1, i-1 - Ir2_rsdft_gauss_Du2(j,i,ipoint) = Ir2_rsdft_gauss_Du2(i,j,ipoint) + Ir2_Mu_gauss_Du2(j,i,ipoint) = Ir2_Mu_gauss_Du2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_rsdft_gauss_Du2 (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_Mu_gauss_Du2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- - BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_0, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_x, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_y, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_z, (ao_num, ao_num, n_points_final_grid)] -&BEGIN_PROVIDER [double precision, Ir2_rsdft_short_Du2_2, (ao_num, ao_num, n_points_final_grid)] + BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! Ir2_rsdft_short_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 + ! Ir2_Mu_short_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 ! - ! Ir2_rsdft_short_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * x2 - ! Ir2_rsdft_short_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * y2 - ! Ir2_rsdft_short_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * z2 + ! Ir2_Mu_short_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * x2 + ! Ir2_Mu_short_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * y2 + ! Ir2_Mu_short_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * z2 ! - ! Ir2_rsdft_short_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * r2^2 + ! Ir2_Mu_short_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * r2^2 ! END_DOC @@ -470,7 +470,7 @@ END_PROVIDER PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent PROVIDE ng_fit_jast expo_gauss_1_erf_x_2 coef_gauss_1_erf_x_2 - print *, ' providing Ir2_rsdft_short_Du2 ...' + print *, ' providing Ir2_Mu_short_Du2 ...' call wall_time(wall0) !$OMP PARALLEL DEFAULT (NONE) & @@ -482,9 +482,9 @@ END_PROVIDER !$OMP ng_fit_jast, expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & !$OMP List_env1s_square_size, List_env1s_square_expo, & !$OMP List_env1s_square_coef, List_env1s_square_cent, & - !$OMP Ir2_rsdft_short_Du2_0, Ir2_rsdft_short_Du2_x, & - !$OMP Ir2_rsdft_short_Du2_y, Ir2_rsdft_short_Du2_z, & - !$OMP Ir2_rsdft_short_Du2_2) + !$OMP Ir2_Mu_short_Du2_0, Ir2_Mu_short_Du2_x, & + !$OMP Ir2_Mu_short_Du2_y, Ir2_Mu_short_Du2_z, & + !$OMP Ir2_Mu_short_Du2_2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -542,11 +542,11 @@ END_PROVIDER enddo ! i_1s enddo ! i_fit - Ir2_rsdft_short_Du2_0(j,i,ipoint) = tmp_Du2_0 - Ir2_rsdft_short_Du2_x(j,i,ipoint) = tmp_Du2_x - Ir2_rsdft_short_Du2_y(j,i,ipoint) = tmp_Du2_y - Ir2_rsdft_short_Du2_z(j,i,ipoint) = tmp_Du2_z - Ir2_rsdft_short_Du2_2(j,i,ipoint) = tmp_Du2_2 + Ir2_Mu_short_Du2_0(j,i,ipoint) = tmp_Du2_0 + Ir2_Mu_short_Du2_x(j,i,ipoint) = tmp_Du2_x + Ir2_Mu_short_Du2_y(j,i,ipoint) = tmp_Du2_y + Ir2_Mu_short_Du2_z(j,i,ipoint) = tmp_Du2_z + Ir2_Mu_short_Du2_2(j,i,ipoint) = tmp_Du2_2 enddo ! j enddo ! i enddo ! ipoint @@ -556,17 +556,17 @@ END_PROVIDER do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - Ir2_rsdft_short_Du2_0(j,i,ipoint) = Ir2_rsdft_short_Du2_0(i,j,ipoint) - Ir2_rsdft_short_Du2_x(j,i,ipoint) = Ir2_rsdft_short_Du2_x(i,j,ipoint) - Ir2_rsdft_short_Du2_y(j,i,ipoint) = Ir2_rsdft_short_Du2_y(i,j,ipoint) - Ir2_rsdft_short_Du2_z(j,i,ipoint) = Ir2_rsdft_short_Du2_z(i,j,ipoint) - Ir2_rsdft_short_Du2_2(j,i,ipoint) = Ir2_rsdft_short_Du2_2(i,j,ipoint) + Ir2_Mu_short_Du2_0(j,i,ipoint) = Ir2_Mu_short_Du2_0(i,j,ipoint) + Ir2_Mu_short_Du2_x(j,i,ipoint) = Ir2_Mu_short_Du2_x(i,j,ipoint) + Ir2_Mu_short_Du2_y(j,i,ipoint) = Ir2_Mu_short_Du2_y(i,j,ipoint) + Ir2_Mu_short_Du2_z(j,i,ipoint) = Ir2_Mu_short_Du2_z(i,j,ipoint) + Ir2_Mu_short_Du2_2(j,i,ipoint) = Ir2_Mu_short_Du2_2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for Ir2_rsdft_short_Du2 (min) = ', (wall1 - wall0) / 60.d0 + print*, ' wall time for Ir2_Mu_short_Du2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER diff --git a/plugins/local/ao_many_one_e_ints/listj1b.irp.f b/plugins/local/ao_many_one_e_ints/listj1b.irp.f index 845b93d7..2b049943 100644 --- a/plugins/local/ao_many_one_e_ints/listj1b.irp.f +++ b/plugins/local/ao_many_one_e_ints/listj1b.irp.f @@ -7,11 +7,11 @@ BEGIN_PROVIDER [integer, List_env1s_size] PROVIDE env_type - if(env_type .eq. "prod-gauss") then + if(env_type .eq. "Prod_Gauss") then List_env1s_size = 2**nucl_num - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then List_env1s_size = nucl_num + 1 @@ -67,7 +67,7 @@ END_PROVIDER List_env1s_expo = 0.d0 List_env1s_cent = 0.d0 - if(env_type .eq. "prod-gauss") then + if(env_type .eq. "Prod_Gauss") then do i = 1, List_env1s_size @@ -121,7 +121,7 @@ END_PROVIDER List_env1s_coef(i) = (-1.d0)**dble(phase) * dexp(-List_env1s_coef(i)) enddo - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then List_env1s_coef( 1) = 1.d0 List_env1s_expo( 1) = 0.d0 @@ -150,11 +150,11 @@ BEGIN_PROVIDER [integer, List_env1s_square_size] implicit none double precision :: tmp - if(env_type .eq. "prod-gauss") then + if(env_type .eq. "Prod_Gauss") then List_env1s_square_size = 3**nucl_num - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then tmp = 0.5d0 * dble(nucl_num) * (dble(nucl_num) + 3.d0) List_env1s_square_size = int(tmp) + 1 @@ -224,7 +224,7 @@ END_PROVIDER List_env1s_square_expo = 0.d0 List_env1s_square_cent = 0.d0 - if(env_type .eq. "prod-gauss") then + if(env_type .eq. "Prod_Gauss") then do i = 1, List_env1s_square_size @@ -280,7 +280,7 @@ END_PROVIDER List_env1s_square_coef(i) = (-1.d0)**dble(phase) * facto * dexp(-List_env1s_square_coef(i)) enddo - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then ii = 1 List_env1s_square_coef( ii) = 1.d0 diff --git a/plugins/local/jastrow/EZFIO.cfg b/plugins/local/jastrow/EZFIO.cfg index 8f05eb01..2eac6aa2 100644 --- a/plugins/local/jastrow/EZFIO.cfg +++ b/plugins/local/jastrow/EZFIO.cfg @@ -1,21 +1,21 @@ [j2e_type] type: character*(32) -doc: type of the 2e-Jastrow: [ none | rs-dft | rs-dft-murho | champ ] +doc: type of the 2e-Jastrow: [ None | Mu | Mur | Qmckl ] interface: ezfio,provider,ocaml -default: rs-dft +default: Mu [j1e_type] type: character*(32) -doc: type of the 1e-Jastrow: [ none | gauss ] +doc: type of the 1e-Jastrow: [ None | Gauss | Charge_Harmonizer ] interface: ezfio,provider,ocaml -default: none +default: None [env_type] type: character*(32) -doc: type of 1-body Jastrow: [ none | prod-gauss | sum-gauss | sum-slat | sum-quartic ] +doc: type of 1-body Jastrow: [ None | Prod_Gauss | Sum_Gauss | Sum_Slat | Sum_Quartic ] interface: ezfio, provider, ocaml -default: sum-gauss +default: Sum_Gauss [jast_qmckl_type_nucl_num] doc: Number of different nuclei types in QMCkl jastrow diff --git a/plugins/local/jastrow/README.md b/plugins/local/jastrow/README.md index 0b74b6c6..f7ea8e02 100644 --- a/plugins/local/jastrow/README.md +++ b/plugins/local/jastrow/README.md @@ -11,7 +11,7 @@ The main keywords are: 1. **none:** No 2e-Jastrow is used. -2. **rs-dft:** 2e-Jastrow inspired by Range Separated Density Functional Theory. It has the following shape: +2. **Mu:** 2e-Jastrow inspired by Range Separated Density Functional Theory. It has the following shape:

@@ -30,12 +30,12 @@ The 2-electron Jastrow is multiplied by an envelope \(v\): - if `env_type` is **none**: No envelope is used. -- if `env_type` is **prod-gauss**: +- if `env_type` is **Prod_Gauss**:

-- if `env_type` is **sum-gauss**: +- if `env_type` is **Sum_Gauss**:

@@ -52,7 +52,7 @@ The 1-electron Jastrow used is: - if `j1e_type` is **none**: No one-electron Jastrow is used. -- if `j1e_type` is **gauss**: We use +- if `j1e_type` is **Gauss**: We use

@@ -60,7 +60,7 @@ The 1-electron Jastrow used is: are defined by the tables `j1e_coef` and `j1e_expo`, respectively. -- if `j1e_type` is **charge-harmonizer**: The one-electron Jastrow factor aims to offset the adverse impact of modifying the charge density induced by the two-electron factor +- if `j1e_type` is **Charge_Harmonizer**: The one-electron Jastrow factor aims to offset the adverse impact of modifying the charge density induced by the two-electron factor

diff --git a/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f index 515b6da5..8d3a163c 100644 --- a/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f +++ b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f @@ -29,7 +29,7 @@ program debug_integ_jmu_modif !call test_vect_overlap_gauss_r12_ao() !call test_vect_overlap_gauss_r12_ao_with1s() - !call test_Ir2_rsdft_long_Du_0() + !call test_Ir2_Mu_long_Du_0() end @@ -731,17 +731,17 @@ end ! --- -subroutine test_Ir2_rsdft_long_Du_0() +subroutine test_Ir2_Mu_long_Du_0() implicit none integer :: i, j, ipoint double precision :: i_old, i_new double precision :: acc_ij, acc_tot, eps_ij, normalz - print*, ' test_Ir2_rsdft_long_Du_0 ...' + print*, ' test_Ir2_Mu_long_Du_0 ...' PROVIDE v_ij_erf_rk_cst_mu_env - PROVIDE Ir2_rsdft_long_Du_0 + PROVIDE Ir2_Mu_long_Du_0 eps_ij = 1d-10 acc_tot = 0.d0 @@ -752,11 +752,11 @@ subroutine test_Ir2_rsdft_long_Du_0() do i = 1, ao_num i_old = v_ij_erf_rk_cst_mu_env(i,j,ipoint) - i_new = Ir2_rsdft_long_Du_0 (i,j,ipoint) + i_new = Ir2_Mu_long_Du_0 (i,j,ipoint) acc_ij = dabs(i_old - i_new) if(acc_ij .gt. eps_ij) then - print *, ' problem in Ir2_rsdft_long_Du_0 on', i, j, ipoint + print *, ' problem in Ir2_Mu_long_Du_0 on', i, j, ipoint print *, ' old integ = ', i_old print *, ' new integ = ', i_new print *, ' diff = ', acc_ij diff --git a/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f b/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f index f4056c32..8bfddf7e 100644 --- a/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f +++ b/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f @@ -267,7 +267,7 @@ BEGIN_PROVIDER [double precision, grad12_j12_test, (ao_num, ao_num, n_points_fin print*, ' providing grad12_j12_test ...' call wall_time(time0) - if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + if((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then do ipoint = 1, n_points_final_grid tmp1 = env_val(ipoint) diff --git a/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f index 528b5e13..40b55ee0 100644 --- a/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f +++ b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f @@ -8,7 +8,7 @@ BEGIN_PROVIDER [double precision, env_val, (n_points_final_grid)] double precision :: x, y, z, dx, dy, dz double precision :: a, d, e, fact_r - if(env_type .eq. "prod-gauss") then + if(env_type .eq. "Prod_Gauss") then ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] @@ -33,7 +33,7 @@ BEGIN_PROVIDER [double precision, env_val, (n_points_final_grid)] env_val(ipoint) = fact_r enddo - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then ! v(r) = 1 - \sum_{a} \beta_a \exp(-\alpha_a (r - r_a)^2) @@ -77,7 +77,7 @@ BEGIN_PROVIDER [double precision, env_grad, (3, n_points_final_grid)] double precision :: fact_x, fact_y, fact_z double precision :: ax_der, ay_der, az_der, a_expo - if(env_type .eq. "prod-gauss") then + if(env_type .eq. "Prod_Gauss") then ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] @@ -121,7 +121,7 @@ BEGIN_PROVIDER [double precision, env_grad, (3, n_points_final_grid)] env_grad(3,ipoint) = fact_z enddo - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then ! v(r) = 1 - \sum_{a} \beta_a \exp(-\alpha_a (r - r_a)^2) @@ -176,7 +176,7 @@ END_PROVIDER PROVIDE List_env1s_square_coef List_env1s_square_expo List_env1s_square_cent - if((env_type .eq. "prod-gauss") .or. (env_type .eq. "sum-gauss")) then + if((env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss")) then do ipoint = 1, n_points_final_grid diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f index e6a692b5..96275887 100644 --- a/plugins/local/non_h_ints_mu/jast_1e.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -14,11 +14,11 @@ BEGIN_PROVIDER [double precision, j1e_val, (n_points_final_grid)] call wall_time(time0) print*, ' providing j1e_val ...' - if(j1e_type .eq. "none") then + if(j1e_type .eq. "None") then j1e_val = 0.d0 - elseif(j1e_type .eq. "gauss") then + elseif(j1e_type .eq. "Gauss") then ! \sum_{A} \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) @@ -81,13 +81,13 @@ END_PROVIDER call wall_time(time0) print*, ' providing j1e_grad ...' - if(j1e_type .eq. "none") then + if(j1e_type .eq. "None") then j1e_gradx = 0.d0 j1e_grady = 0.d0 j1e_gradz = 0.d0 - elseif(j1e_type .eq. "gauss") then + elseif(j1e_type .eq. "Gauss") then ! - \sum_{A} (r - R_A) \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) @@ -126,7 +126,7 @@ END_PROVIDER j1e_gradz(ipoint) = 2.d0 * tmp_z enddo - elseif(j1e_type .eq. "charge-harmonizer") then + elseif(j1e_type .eq. "Charge_Harmonizer") then ! The - sign is in the integral over r2 ! [(N-1)/2N] x \sum_{\mu,\nu} P_{\mu,\nu} \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_\mu(r2) \phi_nu(r2) @@ -180,11 +180,11 @@ BEGIN_PROVIDER [double precision, j1e_lapl, (n_points_final_grid)] double precision :: x, y, z, dx, dy, dz, d2 double precision :: a, c, g, tmp - if(j1e_type .eq. "none") then + if(j1e_type .eq. "None") then j1e_lapl = 0.d0 - elseif(j1e_type .eq. "gauss") then + elseif(j1e_type .eq. "Gauss") then ! - \sum_{A} (r - R_A) \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f index 2cfde97a..1e95f80a 100644 --- a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -41,7 +41,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f ! --- - if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu @@ -68,7 +68,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f !$OMP END DO !$OMP END PARALLEL - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then PROVIDE env_type env_val env_grad PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env @@ -101,12 +101,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f !$OMP END DO !$OMP END PARALLEL - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then PROVIDE mu_erf PROVIDE env_type env_val env_grad - PROVIDE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_long_Du_2 - PROVIDE Ir2_rsdft_gauss_Du + PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 + PROVIDE Ir2_Mu_gauss_Du tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) @@ -117,10 +117,10 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & - !$OMP tmp_ct, env_val, env_grad, Ir2_rsdft_long_Du_0, & - !$OMP Ir2_rsdft_long_Du_x, Ir2_rsdft_long_Du_y, & - !$OMP Ir2_rsdft_long_Du_z, Ir2_rsdft_gauss_Du, & - !$OMP Ir2_rsdft_long_Du_2, int2_grad1_u2b_ao) + !$OMP tmp_ct, env_val, env_grad, Ir2_Mu_long_Du_0, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & + !$OMP Ir2_Mu_long_Du_2, int2_grad1_u2b_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid @@ -146,11 +146,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f do j = 1, ao_num do i = 1, ao_num - tmp2 = 0.5d0 * Ir2_rsdft_long_Du_2(i,j,ipoint) - x * Ir2_rsdft_long_Du_x(i,j,ipoint) - y * Ir2_rsdft_long_Du_y(i,j,ipoint) - z * Ir2_rsdft_long_Du_z(i,j,ipoint) + tmp2 = 0.5d0 * Ir2_Mu_long_Du_2(i,j,ipoint) - x * Ir2_Mu_long_Du_x(i,j,ipoint) - y * Ir2_Mu_long_Du_y(i,j,ipoint) - z * Ir2_Mu_long_Du_z(i,j,ipoint) - int2_grad1_u2b_ao(i,j,ipoint,1) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_rsdft_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_rsdft_gauss_Du(i,j,ipoint) - int2_grad1_u2b_ao(i,j,ipoint,2) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_rsdft_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_rsdft_gauss_Du(i,j,ipoint) - int2_grad1_u2b_ao(i,j,ipoint,3) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_rsdft_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_rsdft_gauss_Du(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,1) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,2) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,3) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) enddo enddo enddo diff --git a/plugins/local/non_h_ints_mu/jast_deriv.irp.f b/plugins/local/non_h_ints_mu/jast_deriv.irp.f index a097dec8..9a430135 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv.irp.f @@ -30,8 +30,8 @@ grad1_u12_num = 0.d0 grad1_u12_squared_num = 0.d0 - if( ((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) .or. & - (j2e_type .eq. "rs-dft-murho") ) then + if( ((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) .or. & + (j2e_type .eq. "Mur") ) then !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -67,7 +67,7 @@ !$OMP END DO !$OMP END PARALLEL - elseif((j2e_type .eq. "rs-dft") .and. (env_type .ne. "none")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .ne. "None")) then PROVIDE final_grid_points @@ -110,7 +110,7 @@ !$OMP END DO !$OMP END PARALLEL - elseif(j2e_type .eq. "champ") then + elseif(j2e_type .eq. "Qmckl") then double precision :: f f = 1.d0 / dble(elec_num - 1) diff --git a/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f index d67809ee..79822508 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f @@ -9,7 +9,7 @@ double precision function j12_mu(r1, r2) double precision, intent(in) :: r1(3), r2(3) double precision :: mu_tmp, r12 - if(j2e_type .eq. "rs-dft") then + if(j2e_type .eq. "Mu") then r12 = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & + (r1(2) - r2(2)) * (r1(2) - r2(2)) & @@ -57,7 +57,7 @@ subroutine grad1_j12_mu(r1, r2, grad) grad = 0.d0 - if(j2e_type .eq. "rs-dft") then + if(j2e_type .eq. "Mu") then dx = r1(1) - r2(1) dy = r1(2) - r2(2) @@ -72,7 +72,7 @@ subroutine grad1_j12_mu(r1, r2, grad) grad(2) = tmp * dy grad(3) = tmp * dz - elseif(j2e_type .eq. "rs-dft-murho") then + elseif(j2e_type .eq. "Mur") then dx = r1(1) - r2(1) dy = r1(2) - r2(2) @@ -113,7 +113,7 @@ double precision function env_nucl(r) integer :: i double precision :: a, d, e, x, y, z - if(env_type .eq. "sum-slat") then + if(env_type .eq. "Sum_Slat") then env_nucl = 1.d0 do i = 1, nucl_num @@ -124,7 +124,7 @@ double precision function env_nucl(r) env_nucl = env_nucl - env_coef(i) * dexp(-a*dsqrt(d)) enddo - elseif(env_type .eq. "prod-gauss") then + elseif(env_type .eq. "Prod_Gauss") then env_nucl = 1.d0 do i = 1, nucl_num @@ -136,7 +136,7 @@ double precision function env_nucl(r) env_nucl = env_nucl * e enddo - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then env_nucl = 1.d0 do i = 1, nucl_num @@ -147,7 +147,7 @@ double precision function env_nucl(r) env_nucl = env_nucl - env_coef(i) * dexp(-a*d) enddo - elseif(env_type .eq. "sum-quartic") then + elseif(env_type .eq. "Sum_Quartic") then env_nucl = 1.d0 do i = 1, nucl_num @@ -178,7 +178,7 @@ double precision function env_nucl_square(r) integer :: i double precision :: a, d, e, x, y, z - if(env_type .eq. "sum-slat") then + if(env_type .eq. "Sum_Slat") then env_nucl_square = 1.d0 do i = 1, nucl_num @@ -190,7 +190,7 @@ double precision function env_nucl_square(r) enddo env_nucl_square = env_nucl_square * env_nucl_square - elseif(env_type .eq. "prod-gauss") then + elseif(env_type .eq. "Prod_Gauss") then env_nucl_square = 1.d0 do i = 1, nucl_num @@ -203,7 +203,7 @@ double precision function env_nucl_square(r) enddo env_nucl_square = env_nucl_square * env_nucl_square - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then env_nucl_square = 1.d0 do i = 1, nucl_num @@ -215,7 +215,7 @@ double precision function env_nucl_square(r) enddo env_nucl_square = env_nucl_square * env_nucl_square - elseif(env_type .eq. "sum-quartic") then + elseif(env_type .eq. "Sum_Quartic") then env_nucl_square = 1.d0 do i = 1, nucl_num @@ -251,7 +251,7 @@ subroutine grad1_env_nucl(r, grad) double precision :: fact_x, fact_y, fact_z double precision :: ax_der, ay_der, az_der, a_expo - if(env_type .eq. "sum-slat") then + if(env_type .eq. "Sum_Slat") then fact_x = 0.d0 fact_y = 0.d0 @@ -273,7 +273,7 @@ subroutine grad1_env_nucl(r, grad) grad(2) = fact_y grad(3) = fact_z - elseif(env_type .eq. "prod-gauss") then + elseif(env_type .eq. "Prod_Gauss") then x = r(1) y = r(2) @@ -312,7 +312,7 @@ subroutine grad1_env_nucl(r, grad) grad(2) = fact_y grad(3) = fact_z - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then fact_x = 0.d0 fact_y = 0.d0 @@ -334,7 +334,7 @@ subroutine grad1_env_nucl(r, grad) grad(2) = 2.d0 * fact_y grad(3) = 2.d0 * fact_z - elseif(env_type .eq. "sum-quartic") then + elseif(env_type .eq. "Sum_Quartic") then fact_x = 0.d0 fact_y = 0.d0 diff --git a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f index 0cb6f06c..bd7db497 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f @@ -27,15 +27,15 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) PROVIDE j1e_type j2e_type env_type PROVIDE final_grid_points_extra - if( ((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) .or. & - (j2e_type .eq. "rs-dft-murho") ) then + if( ((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) .or. & + (j2e_type .eq. "Mur") ) then call grad1_j12_mu_r1_seq(r1, n_grid2, resx, resy, resz) do jpoint = 1, n_points_extra_final_grid res(jpoint) = resx(jpoint) * resx(jpoint) + resy(jpoint) * resy(jpoint) + resz(jpoint) * resz(jpoint) enddo - elseif((j2e_type .eq. "rs-dft") .and. (env_type .ne. "none")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .ne. "None")) then ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) @@ -105,7 +105,7 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) double precision :: dx, dy, dz, r12, tmp double precision :: mu_val, mu_tmp, mu_der(3) - if(j2e_type .eq. "rs-dft") then + if(j2e_type .eq. "Mu") then do jpoint = 1, n_points_extra_final_grid ! r2 @@ -132,7 +132,7 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) gradz(jpoint) = tmp * dz enddo - elseif(j2e_type .eq. "rs-dft-murho") then + elseif(j2e_type .eq. "Mur") then do jpoint = 1, n_points_extra_final_grid ! r2 @@ -225,7 +225,7 @@ subroutine env_nucl_r1_seq(n_grid2, res) integer :: i, jpoint double precision :: a, d, e, x, y, z - if(env_type .eq. "sum-slat") then + if(env_type .eq. "Sum_Slat") then res = 1.d0 @@ -244,7 +244,7 @@ subroutine env_nucl_r1_seq(n_grid2, res) enddo enddo - elseif(env_type .eq. "prod-gauss") then + elseif(env_type .eq. "Prod_Gauss") then res = 1.d0 @@ -264,7 +264,7 @@ subroutine env_nucl_r1_seq(n_grid2, res) enddo enddo - elseif(env_type .eq. "sum-gauss") then + elseif(env_type .eq. "Sum_Gauss") then res = 1.d0 @@ -282,7 +282,7 @@ subroutine env_nucl_r1_seq(n_grid2, res) enddo enddo - elseif(env_type .eq. "sum-quartic") then + elseif(env_type .eq. "Sum_Quartic") then res = 1.d0 diff --git a/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f b/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f index 61d6c82c..5df80a0e 100644 --- a/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f +++ b/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f @@ -48,7 +48,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po else - if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + if((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then do ipoint = 1, n_points_final_grid x = final_grid_points(1,ipoint) diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f index ee4a7c04..88336485 100644 --- a/plugins/local/non_h_ints_mu/tc_integ.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -59,11 +59,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f ! --- - if(j2e_type .eq. "none") then + if(j2e_type .eq. "None") then int2_grad1_u12_ao = 0.d0 - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu @@ -90,7 +90,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f !$OMP END DO !$OMP END PARALLEL - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then PROVIDE env_type env_val env_grad PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env @@ -123,12 +123,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f !$OMP END DO !$OMP END PARALLEL - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then PROVIDE mu_erf PROVIDE env_type env_val env_grad - PROVIDE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_long_Du_2 - PROVIDE Ir2_rsdft_gauss_Du + PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 + PROVIDE Ir2_Mu_gauss_Du tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) @@ -139,10 +139,10 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & - !$OMP tmp_ct, env_val, env_grad, Ir2_rsdft_long_Du_0, & - !$OMP Ir2_rsdft_long_Du_x, Ir2_rsdft_long_Du_y, & - !$OMP Ir2_rsdft_long_Du_z, Ir2_rsdft_gauss_Du, & - !$OMP Ir2_rsdft_long_Du_2, int2_grad1_u12_ao) + !$OMP tmp_ct, env_val, env_grad, Ir2_Mu_long_Du_0, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & + !$OMP Ir2_Mu_long_Du_2, int2_grad1_u12_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid @@ -168,11 +168,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f do j = 1, ao_num do i = 1, ao_num - tmp2 = 0.5d0 * Ir2_rsdft_long_Du_2(i,j,ipoint) - x * Ir2_rsdft_long_Du_x(i,j,ipoint) - y * Ir2_rsdft_long_Du_y(i,j,ipoint) - z * Ir2_rsdft_long_Du_z(i,j,ipoint) + tmp2 = 0.5d0 * Ir2_Mu_long_Du_2(i,j,ipoint) - x * Ir2_Mu_long_Du_x(i,j,ipoint) - y * Ir2_Mu_long_Du_y(i,j,ipoint) - z * Ir2_Mu_long_Du_z(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,1) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_rsdft_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_rsdft_gauss_Du(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,2) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_rsdft_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_rsdft_gauss_Du(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,3) = -Ir2_rsdft_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_rsdft_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_rsdft_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,1) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,2) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,3) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) enddo enddo enddo @@ -188,13 +188,14 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f ! --- - if(j1e_type .ne. "none") then + if(j1e_type .ne. "None") then PROVIDE elec_num PROVIDE ao_overlap PROVIDE j1e_gradx j1e_grady j1e_gradz - tmp_ct = 1.d0 / (dble(elec_num) - 1.d0) + ! minus because we calculate \int [-\grad_1 u(1,2)] + tmp_ct = -1.d0 / (dble(elec_num) - 1.d0) !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -219,12 +220,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f else - if((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then FREE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then FREE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then - FREE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_gauss_Du Ir2_rsdft_long_Du_2 + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_gauss_Du Ir2_Mu_long_Du_2 endif endif ! j1e_type @@ -311,11 +312,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p ! --- - if(j2e_type .eq. "none") then + if(j2e_type .eq. "None") then int2_grad1_u12_square_ao = 0.d0 - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "none")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then PROVIDE int2_grad1u2_grad2u2 @@ -337,7 +338,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p FREE int2_grad1u2_grad2u2 - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "prod-gauss")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then PROVIDE mu_erf PROVIDE env_val env_grad @@ -389,7 +390,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p endif ! use_ipp - elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then PROVIDE mu_erf PROVIDE env_type env_val env_grad @@ -448,13 +449,13 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p endif ! use_ipp -! elseif((j2e_type .eq. "rs-dft") .and. (env_type .eq. "sum-gauss")) then +! elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then ! ! PROVIDE mu_erf ! PROVIDE env_val env_grad -! PROVIDE Ir2_rsdft_short_Du2_0 Ir2_rsdft_short_Du2_x Ir2_rsdft_short_Du2_y Ir2_rsdft_short_Du2_z Ir2_rsdft_short_Du2_2 -! PROVIDE Ir2_rsdft_long_Du2_0 Ir2_rsdft_long_Du2_x Ir2_rsdft_long_Du2_y Ir2_rsdft_long_Du2_z Ir2_rsdft_long_Du2_2 -! PROVIDE Ir2_rsdft_gauss_Du2 +! PROVIDE Ir2_Mu_short_Du2_0 Ir2_Mu_short_Du2_x Ir2_Mu_short_Du2_y Ir2_Mu_short_Du2_z Ir2_Mu_short_Du2_2 +! PROVIDE Ir2_Mu_long_Du2_0 Ir2_Mu_long_Du2_x Ir2_Mu_long_Du2_y Ir2_Mu_long_Du2_z Ir2_Mu_long_Du2_2 +! PROVIDE Ir2_Mu_gauss_Du2 ! ! tmp_ct = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) ! tmp_ct2 = tmp_ct * tmp_ct @@ -468,12 +469,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p ! !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & ! !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & ! !$OMP tmp_ct, tmp_ct2, env_val, env_grad, & -! !$OMP Ir2_rsdft_long_Du2_0, Ir2_rsdft_long_Du2_x, & -! !$OMP Ir2_rsdft_long_Du2_y, Ir2_rsdft_long_Du2_z, & -! !$OMP Ir2_rsdft_gauss_Du2, Ir2_rsdft_long_Du2_2, & -! !$OMP Ir2_rsdft_short_Du2_0, Ir2_rsdft_short_Du2_x, & -! !$OMP Ir2_rsdft_short_Du2_y, Ir2_rsdft_short_Du2_z, & -! !$OMP Ir2_rsdft_short_Du2_2, int2_grad1_u12_square_ao) +! !$OMP Ir2_Mu_long_Du2_0, Ir2_Mu_long_Du2_x, & +! !$OMP Ir2_Mu_long_Du2_y, Ir2_Mu_long_Du2_z, & +! !$OMP Ir2_Mu_gauss_Du2, Ir2_Mu_long_Du2_2, & +! !$OMP Ir2_Mu_short_Du2_0, Ir2_Mu_short_Du2_x, & +! !$OMP Ir2_Mu_short_Du2_y, Ir2_Mu_short_Du2_z, & +! !$OMP Ir2_Mu_short_Du2_2, int2_grad1_u12_square_ao) ! !$OMP DO SCHEDULE (static) ! do ipoint = 1, n_points_final_grid ! @@ -504,12 +505,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p ! do j = 1, ao_num ! do i = 1, ao_num ! -! tmp2 = tmp1_x * Ir2_rsdft_long_Du2_x (i,j,ipoint) + tmp1_y * Ir2_rsdft_long_Du2_y (i,j,ipoint) + tmp1_z * Ir2_rsdft_long_Du2_z (i,j,ipoint) & -! - tmp0_x * Ir2_rsdft_short_Du2_x(i,j,ipoint) - tmp0_y * Ir2_rsdft_short_Du2_y(i,j,ipoint) - tmp0_z * Ir2_rsdft_short_Du2_z(i,j,ipoint) +! tmp2 = tmp1_x * Ir2_Mu_long_Du2_x (i,j,ipoint) + tmp1_y * Ir2_Mu_long_Du2_y (i,j,ipoint) + tmp1_z * Ir2_Mu_long_Du2_z (i,j,ipoint) & +! - tmp0_x * Ir2_Mu_short_Du2_x(i,j,ipoint) - tmp0_y * Ir2_Mu_short_Du2_y(i,j,ipoint) - tmp0_z * Ir2_Mu_short_Du2_z(i,j,ipoint) ! -! int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * Ir2_rsdft_short_Du2_0(i,j,ipoint) + tmp2 + tmp3 * Ir2_rsdft_short_Du2_2(i,j,ipoint) & -! + tmp4 * Ir2_rsdft_gauss_Du2(i,j,ipoint) - tmp5 * Ir2_rsdft_long_Du2_0(i,j,ipoint) & -! - tmp6 * Ir2_rsdft_long_Du2_2(i,j,ipoint) +! int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * Ir2_Mu_short_Du2_0(i,j,ipoint) + tmp2 + tmp3 * Ir2_Mu_short_Du2_2(i,j,ipoint) & +! + tmp4 * Ir2_Mu_gauss_Du2(i,j,ipoint) - tmp5 * Ir2_Mu_long_Du2_0(i,j,ipoint) & +! - tmp6 * Ir2_Mu_long_Du2_2(i,j,ipoint) ! enddo ! enddo ! enddo @@ -527,14 +528,14 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p ! --- - if(j1e_type .ne. "none") then + if(j1e_type .ne. "None") then PROVIDE elec_num PROVIDE ao_overlap PROVIDE j1e_gradx j1e_grady j1e_gradz - tmp_ct1 = 1.0d0 / (dsqrt(dacos(-1.d0)) * mu_erf) - tmp_ct2 = 1.0d0 / (dble(elec_num) - 1.d0) + tmp_ct1 = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + tmp_ct2 = 1.d0 / (dble(elec_num) - 1.d0) !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -544,9 +545,9 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & !$OMP tmp_ct1, tmp_ct2, env_val, env_grad, & !$OMP j1e_gradx, j1e_grady, j1e_gradz, & - !$OMP Ir2_rsdft_long_Du_0, Ir2_rsdft_long_Du_2, & - !$OMP Ir2_rsdft_long_Du_x, Ir2_rsdft_long_Du_y, & - !$OMP Ir2_rsdft_long_Du_z, Ir2_rsdft_gauss_Du, & + !$OMP Ir2_Mu_long_Du_0, Ir2_Mu_long_Du_2, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & !$OMP ao_overlap, int2_grad1_u12_square_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid @@ -578,11 +579,11 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p do j = 1, ao_num do i = 1, ao_num - tmp4 = tmp0_x * Ir2_rsdft_long_Du_x(i,j,ipoint) + tmp0_y * Ir2_rsdft_long_Du_y(i,j,ipoint) + tmp0_z * Ir2_rsdft_long_Du_z(i,j,ipoint) + tmp4 = tmp0_x * Ir2_Mu_long_Du_x(i,j,ipoint) + tmp0_y * Ir2_Mu_long_Du_y(i,j,ipoint) + tmp0_z * Ir2_Mu_long_Du_z(i,j,ipoint) - int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1_u12_square_ao(i,j,ipoint) & - + tmp0 * Ir2_rsdft_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_rsdft_long_Du_2(i,j,ipoint) & - - tmp2 * Ir2_rsdft_gauss_Du(i,j,ipoint) & + int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1_u12_square_ao(i,j,ipoint) & + + tmp0 * Ir2_Mu_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_Mu_long_Du_2(i,j,ipoint) & + - tmp2 * Ir2_Mu_gauss_Du(i,j,ipoint) & + tmp3 * ao_overlap(i,j) enddo enddo @@ -590,7 +591,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p !$OMP END DO !$OMP END PARALLEL - FREE Ir2_rsdft_long_Du_0 Ir2_rsdft_long_Du_x Ir2_rsdft_long_Du_y Ir2_rsdft_long_Du_z Ir2_rsdft_gauss_Du Ir2_rsdft_long_Du_2 + FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_gauss_Du Ir2_Mu_long_Du_2 endif ! j1e_type diff --git a/plugins/local/non_h_ints_mu/total_tc_int.irp.f b/plugins/local/non_h_ints_mu/total_tc_int.irp.f index 2fbeeb3a..59f5174b 100644 --- a/plugins/local/non_h_ints_mu/total_tc_int.irp.f +++ b/plugins/local/non_h_ints_mu/total_tc_int.irp.f @@ -90,8 +90,8 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n FREE int2_grad1_u12_square_ao if( (tc_integ_type .eq. "semi-analytic") .and. & - (j2e_type .eq. "rs-dft") .and. & - ((env_type .eq. "prod_gauss") .or. (env_type .eq. "sum-gauss")) .and. & + (j2e_type .eq. "Mu") .and. & + ((env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss")) .and. & use_ipp ) then ! an additional term is added here directly instead of From 430606a61776cd44d436d8f59ecd6f4db3668360 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Tue, 16 Jan 2024 23:10:44 +0100 Subject: [PATCH 76/84] added fit 1e-Jastrow on AOs --- plugins/local/jastrow/EZFIO.cfg | 6 + plugins/local/jastrow/README.md | 7 +- .../listj1b.irp.f | 40 ++- plugins/local/non_h_ints_mu/jast_1e.irp.f | 56 ++++- .../local/non_h_ints_mu/jast_1e_utils.irp.f | 238 +++++++++++++++--- plugins/local/non_h_ints_mu/tc_integ.irp.f | 128 +++++----- .../local/non_h_ints_mu/test_non_h_ints.irp.f | 8 +- plugins/local/non_hermit_dav/biorthog.irp.f | 14 +- .../lapack_diag_non_hermit.irp.f | 65 +++-- 9 files changed, 405 insertions(+), 157 deletions(-) rename plugins/local/{ao_many_one_e_ints => jastrow}/listj1b.irp.f (92%) diff --git a/plugins/local/jastrow/EZFIO.cfg b/plugins/local/jastrow/EZFIO.cfg index 2eac6aa2..8728916d 100644 --- a/plugins/local/jastrow/EZFIO.cfg +++ b/plugins/local/jastrow/EZFIO.cfg @@ -89,6 +89,12 @@ doc: linear coef of functions in 1e-Jastrow interface: ezfio size: (jastrow.j1e_size,nuclei.nucl_num) +[j1e_coef_ao] +type: double precision +doc: coefficients of the 1-body Jastrow in AOs +interface: ezfio +size: (nuclei.nucl_num) + [j1e_expo] type: double precision doc: exponenets of functions in 1e-Jastrow diff --git a/plugins/local/jastrow/README.md b/plugins/local/jastrow/README.md index f7ea8e02..22486edd 100644 --- a/plugins/local/jastrow/README.md +++ b/plugins/local/jastrow/README.md @@ -9,7 +9,7 @@ The main keywords are: ## j2e_type Options -1. **none:** No 2e-Jastrow is used. +1. **None:** No 2e-Jastrow is used. 2. **Mu:** 2e-Jastrow inspired by Range Separated Density Functional Theory. It has the following shape:

@@ -28,7 +28,7 @@ The 2-electron Jastrow is multiplied by an envelope \(v\):

-- if `env_type` is **none**: No envelope is used. +- if `env_type` is **None**: No envelope is used. - if `env_type` is **Prod_Gauss**:

@@ -50,7 +50,7 @@ The 1-electron Jastrow used is:

-- if `j1e_type` is **none**: No one-electron Jastrow is used. +- if `j1e_type` is **None**: No one-electron Jastrow is used. - if `j1e_type` is **Gauss**: We use

@@ -65,4 +65,5 @@ are defined by the tables `j1e_coef` and `j1e_expo`, respectively.

+- if `j1e_type` is **Charge_Harmonizer_AO**: The one-electron Jastrow factor **Charge_Harmonizer** is fitted by the atomic orbitals diff --git a/plugins/local/ao_many_one_e_ints/listj1b.irp.f b/plugins/local/jastrow/listj1b.irp.f similarity index 92% rename from plugins/local/ao_many_one_e_ints/listj1b.irp.f rename to plugins/local/jastrow/listj1b.irp.f index 2b049943..49954d47 100644 --- a/plugins/local/ao_many_one_e_ints/listj1b.irp.f +++ b/plugins/local/jastrow/listj1b.irp.f @@ -7,7 +7,11 @@ BEGIN_PROVIDER [integer, List_env1s_size] PROVIDE env_type - if(env_type .eq. "Prod_Gauss") then + if(env_type .eq. "None") then + + List_env1s_size = 1 + + elseif(env_type .eq. "Prod_Gauss") then List_env1s_size = 2**nucl_num @@ -63,11 +67,17 @@ END_PROVIDER provide env_type env_expo env_coef - List_env1s_coef = 0.d0 - List_env1s_expo = 0.d0 - List_env1s_cent = 0.d0 + if(env_type .eq. "None") then - if(env_type .eq. "Prod_Gauss") then + List_env1s_coef( 1) = 1.d0 + List_env1s_expo( 1) = 0.d0 + List_env1s_cent(1:3,1) = 0.d0 + + elseif(env_type .eq. "Prod_Gauss") then + + List_env1s_coef = 0.d0 + List_env1s_expo = 0.d0 + List_env1s_cent = 0.d0 do i = 1, List_env1s_size @@ -150,7 +160,11 @@ BEGIN_PROVIDER [integer, List_env1s_square_size] implicit none double precision :: tmp - if(env_type .eq. "Prod_Gauss") then + if(env_type .eq. "None") then + + List_env1s_square_size = 1 + + elseif(env_type .eq. "Prod_Gauss") then List_env1s_square_size = 3**nucl_num @@ -220,11 +234,17 @@ END_PROVIDER provide env_type env_expo env_coef - List_env1s_square_coef = 0.d0 - List_env1s_square_expo = 0.d0 - List_env1s_square_cent = 0.d0 + if(env_type .eq. "None") then - if(env_type .eq. "Prod_Gauss") then + List_env1s_square_coef( 1) = 1.d0 + List_env1s_square_expo( 1) = 0.d0 + List_env1s_square_cent(1:3,1) = 0.d0 + + elseif(env_type .eq. "Prod_Gauss") then + + List_env1s_square_coef = 0.d0 + List_env1s_square_expo = 0.d0 + List_env1s_square_cent = 0.d0 do i = 1, List_env1s_square_size diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f index 96275887..c8da0680 100644 --- a/plugins/local/non_h_ints_mu/jast_1e.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -75,6 +75,7 @@ END_PROVIDER double precision :: a, c, g, tmp_x, tmp_y, tmp_z double precision :: time0, time1 double precision, allocatable :: Pa(:,:), Pb(:,:), Pt(:,:) + double precision, allocatable :: coef_fit(:) PROVIDE j1e_type @@ -133,7 +134,7 @@ END_PROVIDER PROVIDE elec_alpha_num elec_beta_num elec_num PROVIDE mo_coef - PROVIDE int2_grad1_u2b_ao + PROVIDE int2_grad1_u2e_ao allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) @@ -152,12 +153,59 @@ END_PROVIDER g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) - call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,1), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradx, 1) - call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,2), ao_num*ao_num, Pt, 1, 0.d0, j1e_grady, 1) - call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,3), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradz, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,1), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradx, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,2), ao_num*ao_num, Pt, 1, 0.d0, j1e_grady, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,3), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradz, 1) + + FREE int2_grad1_u2e_ao deallocate(Pa, Pb, Pt) + elseif(j1e_type .eq. "Charge_Harmonizer_AO") then + + ! \grad_1 \sum_{\eta} C_{\eta} \chi_{\eta} + ! where + ! \chi_{\eta} are the AOs + ! C_{\eta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") + ! + ! The - sign is in the parameters C_{\eta} + + PROVIDE aos_grad_in_r_array + + allocate(coef_fit(ao_num)) + + call get_j1e_coef_fit_ao(ao_num, coef_fit) + call ezfio_set_jastrow_j1e_coef_ao(coef_fit) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, ipoint, tmp_x, tmp_y, tmp_z, & + !$OMP c) & + !$OMP SHARED (n_points_final_grid, ao_num, & + !$OMP aos_grad_in_r_array, coef_fit, & + !$OMP j1e_gradx, j1e_grady, j1e_gradz) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + tmp_x = 0.d0 + tmp_y = 0.d0 + tmp_z = 0.d0 + do i = 1, ao_num + c = coef_fit(i) + tmp_x = tmp_x + c * aos_grad_in_r_array(i,ipoint,1) + tmp_y = tmp_y + c * aos_grad_in_r_array(i,ipoint,2) + tmp_z = tmp_z + c * aos_grad_in_r_array(i,ipoint,3) + enddo + + j1e_gradx(ipoint) = tmp_x + j1e_grady(ipoint) = tmp_y + j1e_gradz(ipoint) = tmp_z + enddo + !$OMP END DO + !$OMP END PARALLEL + + deallocate(coef_fit) + else print *, ' Error in j1e_grad: Unknown j1e_type = ', j1e_type diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f index 1e95f80a..defe8897 100644 --- a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -1,11 +1,106 @@ ! --- -BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, int2_u2e_ao, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int2_grad1_u2b_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J_2b(r1,r2)] \phi_i(r2) \phi_j(r2) + ! int2_u2e_ao(i,j,ipoint,:) = \int dr2 J_2e(r1,r2) \phi_i(r2) \phi_j(r2) + ! + ! where r1 = r(ipoint) + ! + END_DOC + + implicit none + integer :: ipoint, i, j, jpoint + double precision :: time0, time1 + double precision :: x, y, z, r2 + double precision :: dx, dy, dz + double precision :: tmp_ct + double precision :: tmp0, tmp1, tmp2, tmp3 + + PROVIDE j2e_type + PROVIDE Env_type + + call wall_time(time0) + print*, ' providing int2_u2e_ao ...' + + if(tc_integ_type .eq. "semi-analytic") then + + if( (j2e_type .eq. "Mu") .and. & + ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then + + PROVIDE mu_erf + PROVIDE env_type env_val + PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 + PROVIDE Ir2_Mu_gauss_Du + + tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, & + !$OMP tmp0, tmp1, tmp2, tmp3) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct, env_val, Ir2_Mu_long_Du_0, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & + !$OMP Ir2_Mu_long_Du_2, int2_u2e_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx = x * env_val(ipoint) + dy = y * env_val(ipoint) + dz = z * env_val(ipoint) + + tmp1 = 0.5d0 * env_val(ipoint) + tmp0 = tmp1 * r2 + tmp3 = tmp_ct * env_val(ipoint) + + do j = 1, ao_num + do i = 1, ao_num + + tmp2 = tmp1 * Ir2_Mu_long_Du_2(i,j,ipoint) - dx * Ir2_Mu_long_Du_x(i,j,ipoint) - dy * Ir2_Mu_long_Du_y(i,j,ipoint) - dz * Ir2_Mu_long_Du_z(i,j,ipoint) + + int2_u2e_ao(i,j,ipoint) = tmp0 * Ir2_Mu_long_Du_0(i,j,ipoint) + tmp2 - tmp3 * Ir2_Mu_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + else + + print *, ' Error in int2_u2e_ao: Unknown Jastrow' + stop + + endif ! j2e_type + + else + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' + stop + + endif ! tc_integ_type + + call wall_time(time1) + print*, ' wall time for int2_u2e_ao (min) =', (time1-time0)/60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, int2_grad1_u2e_ao, (ao_num, ao_num, n_points_final_grid, 3)] + + BEGIN_DOC + ! + ! int2_grad1_u2e_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J_2e(r1,r2)] \phi_i(r2) \phi_j(r2) ! ! where r1 = r(ipoint) ! @@ -22,35 +117,23 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f double precision :: tmp1_x, tmp1_y, tmp1_z PROVIDE j2e_type + PROVIDE Env_type call wall_time(time0) + print*, ' providing int2_grad1_u2e_ao ...' - print*, ' providing int2_grad1_u2b_ao ...' - - if(tc_integ_type .eq. "numeric") then - - ! TODO combine 1shot & int2_grad1_u12_ao_num - - PROVIDE int2_grad1_u12_ao_num - int2_grad1_u2b_ao = int2_grad1_u12_ao_num - - !PROVIDE int2_grad1_u12_ao_num_1shot - !int2_grad1_u2b_ao = int2_grad1_u12_ao_num_1shot - - elseif(tc_integ_type .eq. "semi-analytic") then - - ! --- + if(tc_integ_type .eq. "semi-analytic") then if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - int2_grad1_u2b_ao = 0.d0 + int2_grad1_u2e_ao = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & - !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u2b_ao) + !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u2e_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid x = final_grid_points(1,ipoint) @@ -59,9 +142,9 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f do j = 1, ao_num do i = 1, ao_num tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) - int2_grad1_u2b_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) - int2_grad1_u2b_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) - int2_grad1_u2b_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) + int2_grad1_u2e_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) + int2_grad1_u2e_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) + int2_grad1_u2e_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) enddo enddo enddo @@ -73,12 +156,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f PROVIDE env_type env_val env_grad PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env - int2_grad1_u2b_ao = 0.d0 + int2_grad1_u2e_ao = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & - !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u2b_ao) + !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u2e_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid x = final_grid_points(1,ipoint) @@ -92,9 +175,9 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f do i = 1, ao_num tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) - int2_grad1_u2b_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x - int2_grad1_u2b_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y - int2_grad1_u2b_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z + int2_grad1_u2e_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x + int2_grad1_u2e_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y + int2_grad1_u2e_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z enddo enddo enddo @@ -110,7 +193,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) - int2_grad1_u2b_ao = 0.d0 + int2_grad1_u2e_ao = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -120,7 +203,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f !$OMP tmp_ct, env_val, env_grad, Ir2_Mu_long_Du_0, & !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & - !$OMP Ir2_Mu_long_Du_2, int2_grad1_u2b_ao) + !$OMP Ir2_Mu_long_Du_2, int2_grad1_u2e_ao) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid @@ -148,9 +231,9 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f tmp2 = 0.5d0 * Ir2_Mu_long_Du_2(i,j,ipoint) - x * Ir2_Mu_long_Du_x(i,j,ipoint) - y * Ir2_Mu_long_Du_y(i,j,ipoint) - z * Ir2_Mu_long_Du_z(i,j,ipoint) - int2_grad1_u2b_ao(i,j,ipoint,1) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) - int2_grad1_u2b_ao(i,j,ipoint,2) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) - int2_grad1_u2b_ao(i,j,ipoint,3) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2e_ao(i,j,ipoint,1) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2e_ao(i,j,ipoint,2) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2e_ao(i,j,ipoint,3) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) enddo enddo enddo @@ -159,7 +242,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f else - print *, ' Error in int2_grad1_u2b_ao: Unknown Jastrow' + print *, ' Error in int2_grad1_u2e_ao: Unknown Jastrow' stop endif ! j2e_type @@ -172,10 +255,97 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_f endif ! tc_integ_type call wall_time(time1) - print*, ' wall time for int2_grad1_u2b_ao (min) =', (time1-time0)/60.d0 + print*, ' wall time for int2_grad1_u2e_ao (min) =', (time1-time0)/60.d0 call print_memory_usage() END_PROVIDER ! --- +subroutine get_j1e_coef_fit_ao(dim_fit, coef_fit) + + implicit none + integer , intent(in) :: dim_fit + double precision, intent(out) :: coef_fit(dim_fit) + + integer :: i, ipoint + double precision :: g + double precision, allocatable :: A(:,:), b(:), A_inv(:,:) + double precision, allocatable :: Pa(:,:), Pb(:,:), Pt(:,:) + double precision, allocatable :: u1e_tmp(:) + + PROVIDE j1e_type + PROVIDE int2_u2e_ao + PROVIDE elec_alpha_num elec_beta_num elec_num + PROVIDE mo_coef + PROVIDE ao_overlap + + ! --- --- --- + ! get u1e(r) + + allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) + + call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pa, size(Pa, 1)) + + if(elec_alpha_num .eq. elec_beta_num) then + Pb = Pa + else + call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pb, size(Pb, 1)) + endif + Pt = Pa + Pb + + allocate(u1e_tmp(n_points_final_grid)) + + g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_u2e_ao(1,1,1), ao_num*ao_num, Pt, 1, 0.d0, u1e_tmp, 1) + + FREE int2_u2e_ao + + deallocate(Pa, Pb, Pt) + + ! --- --- --- + ! get A & b + + allocate(A(ao_num,ao_num), b(ao_num)) + + A(1:ao_num,1:ao_num) = ao_overlap(1:ao_num,1:ao_num) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, ipoint) & + !$OMP SHARED (n_points_final_grid, ao_num, & + !$OMP final_weight_at_r_vector, aos_in_r_array_transp, u1e_tmp, b) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + b(i) = 0.d0 + do ipoint = 1, n_points_final_grid + b(i) = b(i) + final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * u1e_tmp(ipoint) + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + deallocate(u1e_tmp) + + ! --- --- --- + ! solve Ax = b + + allocate(A_inv(ao_num,ao_num)) + call get_inverse(A, ao_num, ao_num, A_inv, ao_num) + deallocate(A) + + ! coef_fit = A_inv x b + call dgemv("N", ao_num, ao_num, 1.d0, A_inv, ao_num, b, 1, 0.d0, coef_fit, 1) + deallocate(A_inv, b) + + return +end + +! --- + + + diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f index 88336485..ed0f8f6b 100644 --- a/plugins/local/non_h_ints_mu/tc_integ.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -63,67 +63,70 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f int2_grad1_u12_ao = 0.d0 - elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then + !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then - PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu + ! PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - int2_grad1_u12_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & - !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & - !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u12_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) - int2_grad1_u12_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) - int2_grad1_u12_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL + ! int2_grad1_u12_ao = 0.d0 + ! !$OMP PARALLEL & + ! !$OMP DEFAULT (NONE) & + ! !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & + ! !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & + ! !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u12_ao) + ! !$OMP DO SCHEDULE (static) + ! do ipoint = 1, n_points_final_grid + ! x = final_grid_points(1,ipoint) + ! y = final_grid_points(2,ipoint) + ! z = final_grid_points(3,ipoint) + ! do j = 1, ao_num + ! do i = 1, ao_num + ! tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) + ! int2_grad1_u12_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) + ! int2_grad1_u12_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) + ! int2_grad1_u12_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) + ! enddo + ! enddo + ! enddo + ! !$OMP END DO + ! !$OMP END PARALLEL - elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then + !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then - PROVIDE env_type env_val env_grad - PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + ! PROVIDE env_type env_val env_grad + ! PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env - int2_grad1_u12_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & - !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & - !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u12_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - tmp0 = 0.5d0 * env_val(ipoint) - tmp0_x = env_grad(1,ipoint) - tmp0_y = env_grad(2,ipoint) - tmp0_z = env_grad(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) - tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x - int2_grad1_u12_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y - int2_grad1_u12_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL + ! int2_grad1_u12_ao = 0.d0 + ! !$OMP PARALLEL & + ! !$OMP DEFAULT (NONE) & + ! !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & + ! !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & + ! !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u12_ao) + ! !$OMP DO SCHEDULE (static) + ! do ipoint = 1, n_points_final_grid + ! x = final_grid_points(1,ipoint) + ! y = final_grid_points(2,ipoint) + ! z = final_grid_points(3,ipoint) + ! tmp0 = 0.5d0 * env_val(ipoint) + ! tmp0_x = env_grad(1,ipoint) + ! tmp0_y = env_grad(2,ipoint) + ! tmp0_z = env_grad(3,ipoint) + ! do j = 1, ao_num + ! do i = 1, ao_num + ! tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) + ! tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) + ! int2_grad1_u12_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x + ! int2_grad1_u12_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y + ! int2_grad1_u12_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z + ! enddo + ! enddo + ! enddo + ! !$OMP END DO + ! !$OMP END PARALLEL - elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + + elseif( (j2e_type .eq. "Mu") .and. & + ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then PROVIDE mu_erf PROVIDE env_type env_val env_grad @@ -132,8 +135,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) - int2_grad1_u12_ao = 0.d0 - !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & @@ -220,11 +221,14 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f else - if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then - FREE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then - FREE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env - elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + !if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then + ! FREE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu + !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then + ! FREE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + + if( (j2e_type .eq. "Mu") .and. & + ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_gauss_Du Ir2_Mu_long_Du_2 endif diff --git a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f index 6a30d909..4ace5d1c 100644 --- a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f +++ b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f @@ -623,7 +623,7 @@ subroutine test_j1e_grad() double precision, allocatable :: pa(:,:), Pb(:,:), Pt(:,:) double precision, allocatable :: x(:), y(:), z(:) - PROVIDE int2_grad1_u2b_ao + PROVIDE int2_grad1_u2e_ao PROVIDE mo_coef allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) @@ -652,9 +652,9 @@ subroutine test_j1e_grad() z(ipoint) = 0.d0 do i = 1, ao_num do j = 1, ao_num - x(ipoint) = x(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,1) - y(ipoint) = y(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,2) - z(ipoint) = z(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,3) + x(ipoint) = x(ipoint) + g * Pt(i,j) * int2_grad1_u2e_ao(i,j,ipoint,1) + y(ipoint) = y(ipoint) + g * Pt(i,j) * int2_grad1_u2e_ao(i,j,ipoint,2) + z(ipoint) = z(ipoint) + g * Pt(i,j) * int2_grad1_u2e_ao(i,j,ipoint,3) enddo enddo enddo diff --git a/plugins/local/non_hermit_dav/biorthog.irp.f b/plugins/local/non_hermit_dav/biorthog.irp.f index ab12150f..2229e17d 100644 --- a/plugins/local/non_hermit_dav/biorthog.irp.f +++ b/plugins/local/non_hermit_dav/biorthog.irp.f @@ -142,7 +142,7 @@ subroutine non_hrmt_diag_split_degen(n, A, leigvec, reigvec, n_real_eigv, eigval enddo enddo -end subroutine non_hrmt_diag_split_degen +end ! --- @@ -248,7 +248,7 @@ subroutine non_hrmt_real_diag_new(n, A, leigvec, reigvec, n_real_eigv, eigval) print*,'Your matrix intrinsically contains complex eigenvalues' endif -end subroutine non_hrmt_real_diag_new +end ! --- @@ -519,7 +519,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei return -end subroutine non_hrmt_bieig +end ! --- @@ -692,7 +692,7 @@ subroutine non_hrmt_bieig_random_diag(n, A, leigvec, reigvec, n_real_eigv, eigva return -end subroutine non_hrmt_bieig_random_diag +end ! --- @@ -801,7 +801,7 @@ subroutine non_hrmt_real_im(n, A, leigvec, reigvec, n_real_eigv, eigval) deallocate( S ) -end subroutine non_hrmt_real_im +end ! --- @@ -906,7 +906,7 @@ subroutine non_hrmt_generalized_real_im(n, A, B, leigvec, reigvec, n_real_eigv, deallocate( S ) -end subroutine non_hrmt_generalized_real_im +end ! --- @@ -1042,7 +1042,7 @@ subroutine non_hrmt_bieig_fullvect(n, A, leigvec, reigvec, n_real_eigv, eigval) return -end subroutine non_hrmt_bieig_fullvect +end ! --- diff --git a/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f index 4d51b79e..cb38347e 100644 --- a/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f +++ b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f @@ -54,7 +54,7 @@ subroutine lapack_diag_non_sym(n, A, WR, WI, VL, VR) deallocate(Atmp, WORK) -end subroutine lapack_diag_non_sym +end subroutine non_sym_diag_inv_right(n,A,leigvec,reigvec,n_real_eigv,eigval) @@ -269,7 +269,7 @@ subroutine lapack_diag_non_sym_new(n, A, WR, WI, VL, VR) deallocate( Atmp ) deallocate( WORK, SCALE_array, RCONDE, RCONDV, IWORK ) -end subroutine lapack_diag_non_sym_new +end ! --- @@ -323,7 +323,7 @@ subroutine lapack_diag_non_sym_right(n, A, WR, WI, VR) ! write(*, '(1000(F16.10,X))') VR(:,i) ! enddo -end subroutine lapack_diag_non_sym_right +end ! --- @@ -437,7 +437,7 @@ subroutine non_hrmt_real_diag(n, A, leigvec, reigvec, n_real_eigv, eigval) print*, ' Notice that if you are interested in ground state it is not a problem :)' endif -end subroutine non_hrmt_real_diag +end ! --- @@ -495,7 +495,7 @@ subroutine lapack_diag_general_non_sym(n, A, B, WR, WI, VL, VR) deallocate( WORK, Atmp ) -end subroutine lapack_diag_general_non_sym +end ! --- @@ -570,7 +570,7 @@ subroutine non_hrmt_general_real_diag(n, A, B, reigvec, leigvec, n_real_eigv, ei enddo enddo -end subroutine non_hrmt_general_real_diag +end ! --- @@ -727,7 +727,7 @@ subroutine impose_biorthog_qr(m, n, thr_d, thr_nd, Vl, Vr) deallocate(tmp) return -end subroutine impose_biorthog_qr +end ! --- @@ -890,7 +890,7 @@ subroutine impose_biorthog_lu(m, n, Vl, Vr, S) !stop return -end subroutine impose_biorthog_lu +end ! --- @@ -996,7 +996,7 @@ subroutine check_EIGVEC(n, m, A, eigval, leigvec, reigvec, thr_diag, thr_norm, s deallocate( Mtmp ) -end subroutine check_EIGVEC +end ! --- @@ -1066,7 +1066,7 @@ subroutine check_degen(n, m, eigval, leigvec, reigvec) stop endif -end subroutine check_degen +end ! --- @@ -1169,7 +1169,7 @@ subroutine impose_weighted_orthog_svd(n, m, W, C) ! --- -end subroutine impose_weighted_orthog_svd +end ! --- @@ -1266,7 +1266,7 @@ subroutine impose_orthog_svd(n, m, C) ! --- -end subroutine impose_orthog_svd +end ! --- @@ -1365,7 +1365,7 @@ subroutine impose_orthog_svd_overlap(n, m, C, overlap) !enddo deallocate(S) -end subroutine impose_orthog_svd_overlap +end ! --- @@ -1442,7 +1442,7 @@ subroutine impose_orthog_GramSchmidt(n, m, C) ! --- -end subroutine impose_orthog_GramSchmidt +end ! --- @@ -1484,7 +1484,7 @@ subroutine impose_orthog_ones(n, deg_num, C) endif enddo -end subroutine impose_orthog_ones +end ! --- @@ -1577,7 +1577,7 @@ subroutine impose_orthog_degen_eigvec(n, e0, C0) endif enddo -end subroutine impose_orthog_degen_eigvec +end ! --- @@ -1661,7 +1661,7 @@ subroutine get_halfinv_svd(n, S) deallocate(S0, Stmp, Stmp2) -end subroutine get_halfinv_svd +end ! --- @@ -1776,7 +1776,7 @@ subroutine check_biorthog_binormalize(n, m, Vl, Vr, thr_d, thr_nd, stop_ifnot) stop endif -end subroutine check_biorthog_binormalize +end ! --- @@ -1840,7 +1840,7 @@ subroutine check_weighted_biorthog(n, m, W, Vl, Vr, thr_d, thr_nd, accu_d, accu_ stop endif -end subroutine check_weighted_biorthog +end ! --- @@ -1907,7 +1907,7 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ stop endif -end subroutine check_biorthog +end ! --- @@ -1949,7 +1949,7 @@ subroutine check_orthog(n, m, V, accu_d, accu_nd, S) !print*, ' diag acc: ', accu_d !print*, ' nondiag acc: ', accu_nd -end subroutine check_orthog +end ! --- @@ -2067,7 +2067,7 @@ subroutine reorder_degen_eigvec(n, deg_num, e0, L0, R0) ! endif ! enddo ! -end subroutine reorder_degen_eigvec +end ! --- @@ -2188,7 +2188,7 @@ subroutine impose_biorthog_degen_eigvec(n, deg_num, e0, L0, R0) endif enddo -end subroutine impose_biorthog_degen_eigvec +end ! --- @@ -2282,7 +2282,7 @@ subroutine impose_orthog_biorthog_degen_eigvec(n, thr_d, thr_nd, e0, L0, R0) endif enddo -end subroutine impose_orthog_biorthog_degen_eigvec +end ! --- @@ -2420,7 +2420,7 @@ subroutine impose_unique_biorthog_degen_eigvec(n, thr_d, thr_nd, e0, C0, W0, L0, endif enddo -end subroutine impose_unique_biorthog_degen_eigvec +end ! --- @@ -2503,7 +2503,7 @@ subroutine max_overlap_qr(m, n, S0, V) ! --- return -end subroutine max_overlap_qr +end ! --- @@ -2538,7 +2538,7 @@ subroutine max_overlap_invprod(n, m, S, V) deallocate(tmp, invS) return -end subroutine max_overlap_invprod +end ! --- @@ -2623,7 +2623,7 @@ subroutine impose_biorthog_svd(n, m, L, R) deallocate(tmp, U, V, D) -end subroutine impose_biorthog_svd +end ! --- @@ -2668,8 +2668,7 @@ subroutine impose_biorthog_inverse(n, m, L, R) deallocate(S,Lt) -end subroutine impose_biorthog_inverse - +end ! --- @@ -2831,7 +2830,7 @@ subroutine impose_weighted_biorthog_qr(m, n, thr_d, thr_nd, Vl, W, Vr) call check_weighted_biorthog_binormalize(m, n, Vl, W, Vr, thr_d, thr_nd, .false.) return -end subroutine impose_weighted_biorthog_qr +end ! --- @@ -2948,7 +2947,7 @@ subroutine check_weighted_biorthog_binormalize(n, m, Vl, W, Vr, thr_d, thr_nd, s stop endif -end subroutine check_weighted_biorthog_binormalize +end ! --- @@ -3066,7 +3065,7 @@ subroutine impose_weighted_biorthog_svd(n, m, overlap, L, R) deallocate(S) return -end subroutine impose_weighted_biorthog_svd +end ! --- From 3dd43d5bbad3a44413ced64d48c21207ca8555de Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Wed, 17 Jan 2024 01:59:15 +0100 Subject: [PATCH 77/84] fit of j1e in AO basis looks very different --- plugins/local/jastrow/EZFIO.cfg | 2 +- plugins/local/jastrow/NEED | 1 + .../local/non_h_ints_mu/j12_nucl_utils.irp.f | 19 ++- plugins/local/non_h_ints_mu/jast_1e.irp.f | 27 ++-- .../local/non_h_ints_mu/jast_1e_utils.irp.f | 83 +++-------- .../local/non_h_ints_mu/test_non_h_ints.irp.f | 136 +++++++++++++++++- 6 files changed, 182 insertions(+), 86 deletions(-) diff --git a/plugins/local/jastrow/EZFIO.cfg b/plugins/local/jastrow/EZFIO.cfg index 8728916d..a1e0a871 100644 --- a/plugins/local/jastrow/EZFIO.cfg +++ b/plugins/local/jastrow/EZFIO.cfg @@ -93,7 +93,7 @@ size: (jastrow.j1e_size,nuclei.nucl_num) type: double precision doc: coefficients of the 1-body Jastrow in AOs interface: ezfio -size: (nuclei.nucl_num) +size: (ao_basis.ao_num) [j1e_expo] type: double precision diff --git a/plugins/local/jastrow/NEED b/plugins/local/jastrow/NEED index f03c11fd..7d8fe789 100644 --- a/plugins/local/jastrow/NEED +++ b/plugins/local/jastrow/NEED @@ -1,2 +1,3 @@ nuclei electrons +ao_basis diff --git a/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f index 40b55ee0..27b92a13 100644 --- a/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f +++ b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f @@ -8,7 +8,11 @@ BEGIN_PROVIDER [double precision, env_val, (n_points_final_grid)] double precision :: x, y, z, dx, dy, dz double precision :: a, d, e, fact_r - if(env_type .eq. "Prod_Gauss") then + if(env_type .eq. "None") then + + env_val = 1.d0 + + elseif(env_type .eq. "Prod_Gauss") then ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] @@ -77,7 +81,11 @@ BEGIN_PROVIDER [double precision, env_grad, (3, n_points_final_grid)] double precision :: fact_x, fact_y, fact_z double precision :: ax_der, ay_der, az_der, a_expo - if(env_type .eq. "Prod_Gauss") then + if(env_type .eq. "None") then + + env_grad = 0.d0 + + elseif(env_type .eq. "Prod_Gauss") then ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] @@ -176,7 +184,12 @@ END_PROVIDER PROVIDE List_env1s_square_coef List_env1s_square_expo List_env1s_square_cent - if((env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss")) then + if(env_type .eq. "None") then + + env_square_grad = 0.d0 + env_square_lapl = 0.d0 + + elseif((env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss")) then do ipoint = 1, n_points_final_grid diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f index c8da0680..9700c182 100644 --- a/plugins/local/non_h_ints_mu/jast_1e.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -177,29 +177,24 @@ END_PROVIDER call get_j1e_coef_fit_ao(ao_num, coef_fit) call ezfio_set_jastrow_j1e_coef_ao(coef_fit) - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, ipoint, tmp_x, tmp_y, tmp_z, & - !$OMP c) & - !$OMP SHARED (n_points_final_grid, ao_num, & - !$OMP aos_grad_in_r_array, coef_fit, & + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, ipoint, c) & + !$OMP SHARED (n_points_final_grid, ao_num, & + !$OMP aos_grad_in_r_array, coef_fit, & !$OMP j1e_gradx, j1e_grady, j1e_gradz) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid - tmp_x = 0.d0 - tmp_y = 0.d0 - tmp_z = 0.d0 + j1e_gradx(ipoint) = 0.d0 + j1e_grady(ipoint) = 0.d0 + j1e_gradz(ipoint) = 0.d0 do i = 1, ao_num c = coef_fit(i) - tmp_x = tmp_x + c * aos_grad_in_r_array(i,ipoint,1) - tmp_y = tmp_y + c * aos_grad_in_r_array(i,ipoint,2) - tmp_z = tmp_z + c * aos_grad_in_r_array(i,ipoint,3) + j1e_gradx(ipoint) = j1e_gradx(ipoint) + c * aos_grad_in_r_array(i,ipoint,1) + j1e_grady(ipoint) = j1e_grady(ipoint) + c * aos_grad_in_r_array(i,ipoint,2) + j1e_gradz(ipoint) = j1e_gradz(ipoint) + c * aos_grad_in_r_array(i,ipoint,3) enddo - - j1e_gradx(ipoint) = tmp_x - j1e_grady(ipoint) = tmp_y - j1e_gradz(ipoint) = tmp_z enddo !$OMP END DO !$OMP END PARALLEL diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f index defe8897..80ed8c6e 100644 --- a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -58,8 +58,8 @@ BEGIN_PROVIDER [double precision, int2_u2e_ao, (ao_num, ao_num, n_points_final_g dy = y * env_val(ipoint) dz = z * env_val(ipoint) + tmp0 = 0.5d0 * env_val(ipoint) * r2 tmp1 = 0.5d0 * env_val(ipoint) - tmp0 = tmp1 * r2 tmp3 = tmp_ct * env_val(ipoint) do j = 1, ao_num @@ -124,67 +124,9 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2e_ao, (ao_num, ao_num, n_points_f if(tc_integ_type .eq. "semi-analytic") then - if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then - PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - - int2_grad1_u2e_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & - !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & - !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u2e_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) - int2_grad1_u2e_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) - int2_grad1_u2e_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) - int2_grad1_u2e_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then - - PROVIDE env_type env_val env_grad - PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env - - int2_grad1_u2e_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & - !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & - !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u2e_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - tmp0 = 0.5d0 * env_val(ipoint) - tmp0_x = env_grad(1,ipoint) - tmp0_y = env_grad(2,ipoint) - tmp0_z = env_grad(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) - tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) - int2_grad1_u2e_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x - int2_grad1_u2e_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y - int2_grad1_u2e_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + if( (j2e_type .eq. "Mu") .and. & + ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then PROVIDE mu_erf PROVIDE env_type env_val env_grad @@ -193,8 +135,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u2e_ao, (ao_num, ao_num, n_points_f tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) - int2_grad1_u2e_ao = 0.d0 - !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & @@ -300,8 +240,8 @@ subroutine get_j1e_coef_fit_ao(dim_fit, coef_fit) allocate(u1e_tmp(n_points_final_grid)) - g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) - call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_u2e_ao(1,1,1), ao_num*ao_num, Pt, 1, 0.d0, u1e_tmp, 1) + g = -0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_u2e_ao, ao_num*ao_num, Pt, 1, 0.d0, u1e_tmp, 1) FREE int2_u2e_ao @@ -340,6 +280,19 @@ subroutine get_j1e_coef_fit_ao(dim_fit, coef_fit) ! coef_fit = A_inv x b call dgemv("N", ao_num, ao_num, 1.d0, A_inv, ao_num, b, 1, 0.d0, coef_fit, 1) + + !integer :: j, k + !double precision :: tmp + !print *, ' check A_inv' + !do i = 1, ao_num + ! tmp = 0.d0 + ! do j = 1, ao_num + ! tmp += ao_overlap(i,j) * coef_fit(j) + ! enddo + ! tmp = tmp - b(i) + ! print*, i, tmp + !enddo + deallocate(A_inv, b) return diff --git a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f index 4ace5d1c..e349d412 100644 --- a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f +++ b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f @@ -19,6 +19,12 @@ program test_non_h touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid endif + PROVIDE j2e_type + PROVIDE j1e_type + PROVIDE env_type + print *, ' j2e_type = ', j2e_type + print *, ' j1e_type = ', j1e_type + print *, ' env_type = ', env_type !call routine_fit() @@ -29,7 +35,9 @@ program test_non_h !call test_int2_grad1_u12_square_ao() !call test_int2_grad1_u12_ao() - call test_j1e_grad() + !call test_j1e_grad() + + call test_j1e_fit_ao() end ! --- @@ -715,3 +723,129 @@ end ! --- +subroutine test_j1e_fit_ao() + + implicit none + integer :: i, j, ipoint + double precision :: g, c + double precision :: x_loops, x_dgemm, diff, thr, accu, norm + double precision, allocatable :: pa(:,:), Pb(:,:), Pt(:,:) + double precision, allocatable :: x(:), y(:), z(:) + double precision, allocatable :: x_fit(:), y_fit(:), z_fit(:), coef_fit(:) + + PROVIDE mo_coef + PROVIDE int2_grad1_u2e_ao + + ! --- + + allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) + + call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pa, size(Pa, 1)) + + if(elec_alpha_num .eq. elec_beta_num) then + Pb = Pa + else + call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pb, size(Pb, 1)) + endif + Pt = Pa + Pa + + allocate(x(n_points_final_grid), y(n_points_final_grid), z(n_points_final_grid)) + + g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,1), ao_num*ao_num, Pt, 1, 0.d0, x, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,2), ao_num*ao_num, Pt, 1, 0.d0, y, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,3), ao_num*ao_num, Pt, 1, 0.d0, z, 1) + + FREE int2_grad1_u2e_ao + + deallocate(Pa, Pb, Pt) + + ! --- + + allocate(x_fit(n_points_final_grid), y_fit(n_points_final_grid), z_fit(n_points_final_grid)) + allocate(coef_fit(ao_num)) + + call get_j1e_coef_fit_ao(ao_num, coef_fit) + !print *, ' coef fit in AO:' + !print*, coef_fit + +! !$OMP PARALLEL & +! !$OMP DEFAULT (NONE) & +! !$OMP PRIVATE (i, ipoint, c) & +! !$OMP SHARED (n_points_final_grid, ao_num, & +! !$OMP aos_grad_in_r_array, coef_fit, x_fit, y_fit, z_fit) +! !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x_fit(ipoint) = 0.d0 + y_fit(ipoint) = 0.d0 + z_fit(ipoint) = 0.d0 + do i = 1, ao_num + c = coef_fit(i) + x_fit(ipoint) = x_fit(ipoint) + c * aos_grad_in_r_array(i,ipoint,1) + y_fit(ipoint) = y_fit(ipoint) + c * aos_grad_in_r_array(i,ipoint,2) + z_fit(ipoint) = z_fit(ipoint) + c * aos_grad_in_r_array(i,ipoint,3) + enddo + enddo +! !$OMP END DO +! !$OMP END PARALLEL + + deallocate(coef_fit) + + ! --- + + thr = 1d-10 + norm = 0.d0 + accu = 0.d0 + do ipoint = 1, n_points_final_grid + + x_loops = x (ipoint) + x_dgemm = x_fit(ipoint) + diff = dabs(x_loops - x_dgemm) + !if(diff .gt. thr) then + ! print *, ' problem in j1e_gradx on:', ipoint + ! print *, ' loops :', x_loops + ! print *, ' dgemm :', x_dgemm + ! stop + !endif + accu += diff + norm += dabs(x_loops) + + x_loops = y (ipoint) + x_dgemm = y_fit(ipoint) + diff = dabs(x_loops - x_dgemm) + !if(diff .gt. thr) then + ! print *, ' problem in j1e_grady on:', ipoint + ! print *, ' loops :', x_loops + ! print *, ' dgemm :', x_dgemm + ! stop + !endif + accu += diff + norm += dabs(x_loops) + + x_loops = z (ipoint) + x_dgemm = z_fit(ipoint) + diff = dabs(x_loops - x_dgemm) + !if(diff .gt. thr) then + ! print *, ' problem in j1e_gradz on:', ipoint + ! print *, ' loops :', x_loops + ! print *, ' dgemm :', x_dgemm + ! stop + !endif + accu += diff + norm += dabs(x_loops) + enddo + + deallocate(x, y, z) + deallocate(x_fit, y_fit, z_fit) + + print*, ' fit accuracy (%) = ', 100.d0 * accu / norm + +end + +! --- + From bab59335f32b7976c31a960ade0054b28cffaa2b Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Wed, 17 Jan 2024 06:11:06 +0100 Subject: [PATCH 78/84] debuging 1e-Jastrow --- plugins/local/jastrow/env_param.irp.f | 12 ++-- plugins/local/jastrow/jast_1e_param.irp.f | 4 ++ plugins/local/non_h_ints_mu/tc_integ.irp.f | 66 ++++++++++++------- .../local/tc_bi_ortho/print_tc_energy.irp.f | 9 +++ 4 files changed, 60 insertions(+), 31 deletions(-) diff --git a/plugins/local/jastrow/env_param.irp.f b/plugins/local/jastrow/env_param.irp.f index 8102a484..6d26baa3 100644 --- a/plugins/local/jastrow/env_param.irp.f +++ b/plugins/local/jastrow/env_param.irp.f @@ -46,9 +46,9 @@ IRP_ENDIF endif else - do i = 1, nucl_num - env_expo(i) = 1d5 - enddo + + env_expo = 1d5 + call ezfio_set_jastrow_env_expo(env_expo) endif ! --- @@ -81,9 +81,9 @@ IRP_ENDIF endif else - do i = 1, nucl_num - env_coef(i) = 1d0 - enddo + + env_coef = 1d0 + call ezfio_set_jastrow_env_coef(env_coef) endif ! --- diff --git a/plugins/local/jastrow/jast_1e_param.irp.f b/plugins/local/jastrow/jast_1e_param.irp.f index 16c8cedc..eca150be 100644 --- a/plugins/local/jastrow/jast_1e_param.irp.f +++ b/plugins/local/jastrow/jast_1e_param.irp.f @@ -48,7 +48,9 @@ IRP_ENDIF endif else + j1e_expo = 1.d0 + call ezfio_set_jastrow_j1e_expo(j1e_expo) endif ! --- @@ -81,7 +83,9 @@ IRP_ENDIF endif else + j1e_coef = 0.d0 + call ezfio_set_jastrow_j1e_coef(j1e_coef) endif ! --- diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f index ed0f8f6b..67ab4c89 100644 --- a/plugins/local/non_h_ints_mu/tc_integ.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -195,28 +195,40 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f PROVIDE ao_overlap PROVIDE j1e_gradx j1e_grady j1e_gradz + double precision, allocatable :: int_tmp(:,:,:,:) + ! minus because we calculate \int [-\grad_1 u(1,2)] tmp_ct = -1.d0 / (dble(elec_num) - 1.d0) - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, tmp0_x, tmp0_y, tmp0_z) & - !$OMP SHARED (ao_num, n_points_final_grid, tmp_ct, & - !$OMP j1e_gradx, j1e_grady, j1e_gradz, ao_overlap, int2_grad1_u12_ao) - !$OMP DO SCHEDULE (static) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, tmp0_x, tmp0_y, tmp0_z, int_tmp) & + !$OMP SHARED (ao_num, n_points_final_grid, tmp_ct, ao_overlap, & + !$OMP j1e_gradx, j1e_grady, j1e_gradz, int2_grad1_u12_ao) + + allocate(int_tmp(ao_num,ao_num,n_points_final_grid,3)) + int_tmp = 0.d0 + + !$OMP DO do ipoint = 1, n_points_final_grid tmp0_x = tmp_ct * j1e_gradx(ipoint) tmp0_y = tmp_ct * j1e_grady(ipoint) tmp0_z = tmp_ct * j1e_gradz(ipoint) do j = 1, ao_num do i = 1, ao_num - int2_grad1_u12_ao(i,j,ipoint,1) = int2_grad1_u12_ao(i,j,ipoint,1) + tmp0_x * ao_overlap(i,j) - int2_grad1_u12_ao(i,j,ipoint,2) = int2_grad1_u12_ao(i,j,ipoint,2) + tmp0_y * ao_overlap(i,j) - int2_grad1_u12_ao(i,j,ipoint,3) = int2_grad1_u12_ao(i,j,ipoint,3) + tmp0_z * ao_overlap(i,j) + int_tmp(i,j,ipoint,1) = int_tmp(i,j,ipoint,1) + tmp0_x * ao_overlap(i,j) + int_tmp(i,j,ipoint,2) = int_tmp(i,j,ipoint,2) + tmp0_y * ao_overlap(i,j) + int_tmp(i,j,ipoint,3) = int_tmp(i,j,ipoint,3) + tmp0_z * ao_overlap(i,j) enddo enddo enddo - !$OMP END DO + !$OMP END DO NOWAIT + + !$OMP CRITICAL + int2_grad1_u12_ao = int2_grad1_u12_ao + int_tmp + !$OMP END CRITICAL + + deallocate(int_tmp) !$OMP END PARALLEL else @@ -324,7 +336,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p PROVIDE int2_grad1u2_grad2u2 - int2_grad1_u12_square_ao = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, j, ipoint) & @@ -352,7 +363,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p ! the term u12_grad1_u12_env_grad1_env is added directly for performance PROVIDE u12sq_envsq grad12_j12 - int2_grad1_u12_square_ao = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, j, ipoint) & @@ -374,7 +384,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p PROVIDE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 - int2_grad1_u12_square_ao = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, j, ipoint) & @@ -405,7 +414,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p PROVIDE int2_u2_env2 PROVIDE int2_grad1u2_grad2u2_env2 - int2_grad1_u12_square_ao = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, j, ipoint, tmp0_x, tmp0_y, tmp0_z, tmp1, tmp2) & @@ -433,7 +441,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p PROVIDE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 - int2_grad1_u12_square_ao = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, j, ipoint) & @@ -538,6 +545,8 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p PROVIDE ao_overlap PROVIDE j1e_gradx j1e_grady j1e_gradz + double precision, allocatable :: int_tmp(:,:,:) + tmp_ct1 = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) tmp_ct2 = 1.d0 / (dble(elec_num) - 1.d0) @@ -545,15 +554,18 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p !$OMP DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx1, dy1, dz1, & !$OMP dx2, dy2, dz2, dr12, tmp0, tmp1, tmp2, tmp3, tmp4, & - !$OMP tmp0_x, tmp0_y, tmp0_z) & + !$OMP tmp0_x, tmp0_y, tmp0_z, int_tmp) & !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & !$OMP tmp_ct1, tmp_ct2, env_val, env_grad, & - !$OMP j1e_gradx, j1e_grady, j1e_gradz, & + !$OMP j1e_gradx, j1e_grady, j1e_gradz, ao_overlap, & !$OMP Ir2_Mu_long_Du_0, Ir2_Mu_long_Du_2, & !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & - !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & - !$OMP ao_overlap, int2_grad1_u12_square_ao) - !$OMP DO SCHEDULE (static) + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, int2_grad1_u12_square_ao) + + allocate(int_tmp(ao_num,ao_num,n_points_final_grid)) + int_tmp = 0.d0 + + !$OMP DO do ipoint = 1, n_points_final_grid x = final_grid_points(1,ipoint) @@ -585,14 +597,18 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p tmp4 = tmp0_x * Ir2_Mu_long_Du_x(i,j,ipoint) + tmp0_y * Ir2_Mu_long_Du_y(i,j,ipoint) + tmp0_z * Ir2_Mu_long_Du_z(i,j,ipoint) - int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1_u12_square_ao(i,j,ipoint) & - + tmp0 * Ir2_Mu_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_Mu_long_Du_2(i,j,ipoint) & - - tmp2 * Ir2_Mu_gauss_Du(i,j,ipoint) & - + tmp3 * ao_overlap(i,j) + int_tmp(i,j,ipoint) = int_tmp(i,j,ipoint) + tmp0 * Ir2_Mu_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_Mu_long_Du_2(i,j,ipoint) & + - tmp2 * Ir2_Mu_gauss_Du(i,j,ipoint) + tmp3 * ao_overlap(i,j) enddo enddo enddo - !$OMP END DO + !$OMP END DO NOWAIT + + !$OMP CRITICAL + int2_grad1_u12_square_ao = int2_grad1_u12_square_ao + int_tmp + !$OMP END CRITICAL + + deallocate(int_tmp) !$OMP END PARALLEL FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_gauss_Du Ir2_Mu_long_Du_2 diff --git a/plugins/local/tc_bi_ortho/print_tc_energy.irp.f b/plugins/local/tc_bi_ortho/print_tc_energy.irp.f index fe7c2d10..ef38cbcc 100644 --- a/plugins/local/tc_bi_ortho/print_tc_energy.irp.f +++ b/plugins/local/tc_bi_ortho/print_tc_energy.irp.f @@ -17,6 +17,15 @@ program print_tc_energy read_wf = .True. touch read_wf + + PROVIDE j2e_type + PROVIDE j1e_type + PROVIDE env_type + + print *, ' j2e_type = ', j2e_type + print *, ' j1e_type = ', j1e_type + print *, ' env_type = ', env_type + call write_tc_energy() end From 35a773ef7e7aebb15abeb61d95cd62e006e981c9 Mon Sep 17 00:00:00 2001 From: Abdallah Ammar Date: Wed, 17 Jan 2024 11:10:28 +0100 Subject: [PATCH 79/84] j1e + j2e added properly --- plugins/local/non_h_ints_mu/jast_1e.irp.f | 5 +- .../local/non_h_ints_mu/jast_1e_utils.irp.f | 201 --------------- .../local/non_h_ints_mu/jast_2e_utils.irp.f | 188 ++++++++++++++ plugins/local/non_h_ints_mu/tc_integ.irp.f | 238 +++--------------- .../local/non_h_ints_mu/test_non_h_ints.irp.f | 2 +- .../local/non_h_ints_mu/total_tc_int.irp.f | 5 +- 6 files changed, 231 insertions(+), 408 deletions(-) create mode 100644 plugins/local/non_h_ints_mu/jast_2e_utils.irp.f diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f index 9700c182..b2eef504 100644 --- a/plugins/local/non_h_ints_mu/jast_1e.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -129,8 +129,7 @@ END_PROVIDER elseif(j1e_type .eq. "Charge_Harmonizer") then - ! The - sign is in the integral over r2 - ! [(N-1)/2N] x \sum_{\mu,\nu} P_{\mu,\nu} \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_\mu(r2) \phi_nu(r2) + ! -[(N-1)/2N] x \sum_{\mu,\nu} P_{\mu,\nu} \int dr2 [\grad_r1 J_2e(r1,r2)] \phi_\mu(r2) \phi_nu(r2) PROVIDE elec_alpha_num elec_beta_num elec_num PROVIDE mo_coef @@ -151,7 +150,7 @@ END_PROVIDER endif Pt = Pa + Pb - g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + g = -0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,1), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradx, 1) call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,2), ao_num*ao_num, Pt, 1, 0.d0, j1e_grady, 1) diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f index 80ed8c6e..ba7477cc 100644 --- a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -1,207 +1,6 @@ ! --- -BEGIN_PROVIDER [double precision, int2_u2e_ao, (ao_num, ao_num, n_points_final_grid)] - - BEGIN_DOC - ! - ! int2_u2e_ao(i,j,ipoint,:) = \int dr2 J_2e(r1,r2) \phi_i(r2) \phi_j(r2) - ! - ! where r1 = r(ipoint) - ! - END_DOC - - implicit none - integer :: ipoint, i, j, jpoint - double precision :: time0, time1 - double precision :: x, y, z, r2 - double precision :: dx, dy, dz - double precision :: tmp_ct - double precision :: tmp0, tmp1, tmp2, tmp3 - - PROVIDE j2e_type - PROVIDE Env_type - - call wall_time(time0) - print*, ' providing int2_u2e_ao ...' - - if(tc_integ_type .eq. "semi-analytic") then - - if( (j2e_type .eq. "Mu") .and. & - ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then - - PROVIDE mu_erf - PROVIDE env_type env_val - PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 - PROVIDE Ir2_Mu_gauss_Du - - tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, & - !$OMP tmp0, tmp1, tmp2, tmp3) & - !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & - !$OMP tmp_ct, env_val, Ir2_Mu_long_Du_0, & - !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & - !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & - !$OMP Ir2_Mu_long_Du_2, int2_u2e_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - r2 = x*x + y*y + z*z - - dx = x * env_val(ipoint) - dy = y * env_val(ipoint) - dz = z * env_val(ipoint) - - tmp0 = 0.5d0 * env_val(ipoint) * r2 - tmp1 = 0.5d0 * env_val(ipoint) - tmp3 = tmp_ct * env_val(ipoint) - - do j = 1, ao_num - do i = 1, ao_num - - tmp2 = tmp1 * Ir2_Mu_long_Du_2(i,j,ipoint) - dx * Ir2_Mu_long_Du_x(i,j,ipoint) - dy * Ir2_Mu_long_Du_y(i,j,ipoint) - dz * Ir2_Mu_long_Du_z(i,j,ipoint) - - int2_u2e_ao(i,j,ipoint) = tmp0 * Ir2_Mu_long_Du_0(i,j,ipoint) + tmp2 - tmp3 * Ir2_Mu_gauss_Du(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - else - - print *, ' Error in int2_u2e_ao: Unknown Jastrow' - stop - - endif ! j2e_type - - else - - write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' - stop - - endif ! tc_integ_type - - call wall_time(time1) - print*, ' wall time for int2_u2e_ao (min) =', (time1-time0)/60.d0 - call print_memory_usage() - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, int2_grad1_u2e_ao, (ao_num, ao_num, n_points_final_grid, 3)] - - BEGIN_DOC - ! - ! int2_grad1_u2e_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J_2e(r1,r2)] \phi_i(r2) \phi_j(r2) - ! - ! where r1 = r(ipoint) - ! - END_DOC - - implicit none - integer :: ipoint, i, j, m, jpoint - double precision :: time0, time1 - double precision :: x, y, z, r2 - double precision :: dx, dy, dz - double precision :: tmp_ct - double precision :: tmp0, tmp1, tmp2 - double precision :: tmp0_x, tmp0_y, tmp0_z - double precision :: tmp1_x, tmp1_y, tmp1_z - - PROVIDE j2e_type - PROVIDE Env_type - - call wall_time(time0) - print*, ' providing int2_grad1_u2e_ao ...' - - if(tc_integ_type .eq. "semi-analytic") then - - - if( (j2e_type .eq. "Mu") .and. & - ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then - - PROVIDE mu_erf - PROVIDE env_type env_val env_grad - PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 - PROVIDE Ir2_Mu_gauss_Du - - tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & - !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & - !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & - !$OMP tmp_ct, env_val, env_grad, Ir2_Mu_long_Du_0, & - !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & - !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & - !$OMP Ir2_Mu_long_Du_2, int2_grad1_u2e_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - r2 = x*x + y*y + z*z - - dx = env_grad(1,ipoint) - dy = env_grad(2,ipoint) - dz = env_grad(3,ipoint) - - tmp0_x = 0.5d0 * (env_val(ipoint) * x + r2 * dx) - tmp0_y = 0.5d0 * (env_val(ipoint) * y + r2 * dy) - tmp0_z = 0.5d0 * (env_val(ipoint) * z + r2 * dz) - - tmp1 = 0.5d0 * env_val(ipoint) - - tmp1_x = tmp_ct * dx - tmp1_y = tmp_ct * dy - tmp1_z = tmp_ct * dz - - do j = 1, ao_num - do i = 1, ao_num - - tmp2 = 0.5d0 * Ir2_Mu_long_Du_2(i,j,ipoint) - x * Ir2_Mu_long_Du_x(i,j,ipoint) - y * Ir2_Mu_long_Du_y(i,j,ipoint) - z * Ir2_Mu_long_Du_z(i,j,ipoint) - - int2_grad1_u2e_ao(i,j,ipoint,1) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) - int2_grad1_u2e_ao(i,j,ipoint,2) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) - int2_grad1_u2e_ao(i,j,ipoint,3) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - else - - print *, ' Error in int2_grad1_u2e_ao: Unknown Jastrow' - stop - - endif ! j2e_type - - else - - write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' - stop - - endif ! tc_integ_type - - call wall_time(time1) - print*, ' wall time for int2_grad1_u2e_ao (min) =', (time1-time0)/60.d0 - call print_memory_usage() - -END_PROVIDER - -! --- - subroutine get_j1e_coef_fit_ao(dim_fit, coef_fit) implicit none diff --git a/plugins/local/non_h_ints_mu/jast_2e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_2e_utils.irp.f new file mode 100644 index 00000000..8c25b377 --- /dev/null +++ b/plugins/local/non_h_ints_mu/jast_2e_utils.irp.f @@ -0,0 +1,188 @@ + +! --- + +BEGIN_PROVIDER [double precision, int2_u2e_ao, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! int2_u2e_ao(i,j,ipoint,:) = \int dr2 J_2e(r1,r2) \phi_i(r2) \phi_j(r2) + ! + ! where r1 = r(ipoint) + ! + END_DOC + + implicit none + integer :: ipoint, i, j, jpoint + double precision :: time0, time1 + double precision :: x, y, z, r2 + double precision :: dx, dy, dz + double precision :: tmp_ct + double precision :: tmp0, tmp1, tmp2, tmp3 + + PROVIDE j2e_type + PROVIDE Env_type + + call wall_time(time0) + print*, ' providing int2_u2e_ao ...' + + if( (j2e_type .eq. "Mu") .and. & + ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then + + PROVIDE mu_erf + PROVIDE env_type env_val + PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 + PROVIDE Ir2_Mu_gauss_Du + + tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, & + !$OMP tmp0, tmp1, tmp2, tmp3) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct, env_val, Ir2_Mu_long_Du_0, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & + !$OMP Ir2_Mu_long_Du_2, int2_u2e_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx = x * env_val(ipoint) + dy = y * env_val(ipoint) + dz = z * env_val(ipoint) + + tmp0 = 0.5d0 * env_val(ipoint) * r2 + tmp1 = 0.5d0 * env_val(ipoint) + tmp3 = tmp_ct * env_val(ipoint) + + do j = 1, ao_num + do i = 1, ao_num + + tmp2 = tmp1 * Ir2_Mu_long_Du_2(i,j,ipoint) - dx * Ir2_Mu_long_Du_x(i,j,ipoint) - dy * Ir2_Mu_long_Du_y(i,j,ipoint) - dz * Ir2_Mu_long_Du_z(i,j,ipoint) + + int2_u2e_ao(i,j,ipoint) = tmp0 * Ir2_Mu_long_Du_0(i,j,ipoint) + tmp2 - tmp3 * Ir2_Mu_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + else + + print *, ' Error in int2_u2e_ao: Unknown Jastrow' + stop + + endif ! j2e_type + + call wall_time(time1) + print*, ' wall time for int2_u2e_ao (min) =', (time1-time0)/60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, int2_grad1_u2e_ao, (ao_num, ao_num, n_points_final_grid, 3)] + + BEGIN_DOC + ! + ! int2_grad1_u2e_ao(i,j,ipoint,:) = \int dr2 [\grad_r1 J_2e(r1,r2)] \phi_i(r2) \phi_j(r2) + ! + ! where r1 = r(ipoint) + ! + END_DOC + + implicit none + integer :: ipoint, i, j, m, jpoint + double precision :: time0, time1 + double precision :: x, y, z, r2 + double precision :: dx, dy, dz + double precision :: tmp_ct + double precision :: tmp0, tmp1, tmp2 + double precision :: tmp0_x, tmp0_y, tmp0_z + double precision :: tmp1_x, tmp1_y, tmp1_z + + PROVIDE j2e_type + PROVIDE Env_type + + call wall_time(time0) + print*, ' providing int2_grad1_u2e_ao ...' + + if( (j2e_type .eq. "Mu") .and. & + ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then + + PROVIDE mu_erf + PROVIDE env_type env_val env_grad + PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 + PROVIDE Ir2_Mu_gauss_Du + + tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & + !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct, env_val, env_grad, Ir2_Mu_long_Du_0, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & + !$OMP Ir2_Mu_long_Du_2, int2_grad1_u2e_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx = env_grad(1,ipoint) + dy = env_grad(2,ipoint) + dz = env_grad(3,ipoint) + + tmp0_x = 0.5d0 * (env_val(ipoint) * x + r2 * dx) + tmp0_y = 0.5d0 * (env_val(ipoint) * y + r2 * dy) + tmp0_z = 0.5d0 * (env_val(ipoint) * z + r2 * dz) + + tmp1 = 0.5d0 * env_val(ipoint) + + tmp1_x = tmp_ct * dx + tmp1_y = tmp_ct * dy + tmp1_z = tmp_ct * dz + + do j = 1, ao_num + do i = 1, ao_num + + tmp2 = 0.5d0 * Ir2_Mu_long_Du_2(i,j,ipoint) - x * Ir2_Mu_long_Du_x(i,j,ipoint) - y * Ir2_Mu_long_Du_y(i,j,ipoint) - z * Ir2_Mu_long_Du_z(i,j,ipoint) + + int2_grad1_u2e_ao(i,j,ipoint,1) = Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x - tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) + dx * tmp2 - tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2e_ao(i,j,ipoint,2) = Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y - tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) + dy * tmp2 - tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2e_ao(i,j,ipoint,3) = Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z - tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) + dz * tmp2 - tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 + FREE Ir2_Mu_gauss_Du + + else + + print *, ' Error in int2_grad1_u2e_ao: Unknown Jastrow' + stop + + endif ! j2e_type + + call wall_time(time1) + print*, ' wall time for int2_grad1_u2e_ao (min) =', (time1-time0)/60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f index 67ab4c89..2255cb5c 100644 --- a/plugins/local/non_h_ints_mu/tc_integ.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -3,7 +3,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f BEGIN_DOC ! - ! int2_grad1_u12_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) + ! int2_grad1_u12_ao(i,j,ipoint,:) = \int dr2 [\grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) ! ! where r1 = r(ipoint) ! @@ -63,123 +63,12 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f int2_grad1_u12_ao = 0.d0 - !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then - - ! PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - - ! int2_grad1_u12_ao = 0.d0 - ! !$OMP PARALLEL & - ! !$OMP DEFAULT (NONE) & - ! !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & - ! !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & - ! !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u12_ao) - ! !$OMP DO SCHEDULE (static) - ! do ipoint = 1, n_points_final_grid - ! x = final_grid_points(1,ipoint) - ! y = final_grid_points(2,ipoint) - ! z = final_grid_points(3,ipoint) - ! do j = 1, ao_num - ! do i = 1, ao_num - ! tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) - ! int2_grad1_u12_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) - ! int2_grad1_u12_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) - ! int2_grad1_u12_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) - ! enddo - ! enddo - ! enddo - ! !$OMP END DO - ! !$OMP END PARALLEL - - !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then - - ! PROVIDE env_type env_val env_grad - ! PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env - - ! int2_grad1_u12_ao = 0.d0 - ! !$OMP PARALLEL & - ! !$OMP DEFAULT (NONE) & - ! !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & - ! !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & - ! !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u12_ao) - ! !$OMP DO SCHEDULE (static) - ! do ipoint = 1, n_points_final_grid - ! x = final_grid_points(1,ipoint) - ! y = final_grid_points(2,ipoint) - ! z = final_grid_points(3,ipoint) - ! tmp0 = 0.5d0 * env_val(ipoint) - ! tmp0_x = env_grad(1,ipoint) - ! tmp0_y = env_grad(2,ipoint) - ! tmp0_z = env_grad(3,ipoint) - ! do j = 1, ao_num - ! do i = 1, ao_num - ! tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) - ! tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) - ! int2_grad1_u12_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x - ! int2_grad1_u12_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y - ! int2_grad1_u12_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z - ! enddo - ! enddo - ! enddo - ! !$OMP END DO - ! !$OMP END PARALLEL - - !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then - elseif( (j2e_type .eq. "Mu") .and. & ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then - PROVIDE mu_erf - PROVIDE env_type env_val env_grad - PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 - PROVIDE Ir2_Mu_gauss_Du - - tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & - !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & - !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & - !$OMP tmp_ct, env_val, env_grad, Ir2_Mu_long_Du_0, & - !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & - !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & - !$OMP Ir2_Mu_long_Du_2, int2_grad1_u12_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - r2 = x*x + y*y + z*z - - dx = env_grad(1,ipoint) - dy = env_grad(2,ipoint) - dz = env_grad(3,ipoint) - - tmp0_x = 0.5d0 * (env_val(ipoint) * x + r2 * dx) - tmp0_y = 0.5d0 * (env_val(ipoint) * y + r2 * dy) - tmp0_z = 0.5d0 * (env_val(ipoint) * z + r2 * dz) - - tmp1 = 0.5d0 * env_val(ipoint) - - tmp1_x = tmp_ct * dx - tmp1_y = tmp_ct * dy - tmp1_z = tmp_ct * dz - - do j = 1, ao_num - do i = 1, ao_num - - tmp2 = 0.5d0 * Ir2_Mu_long_Du_2(i,j,ipoint) - x * Ir2_Mu_long_Du_x(i,j,ipoint) - y * Ir2_Mu_long_Du_y(i,j,ipoint) - z * Ir2_Mu_long_Du_z(i,j,ipoint) - - int2_grad1_u12_ao(i,j,ipoint,1) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,2) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,3) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - + PROVIDE int2_grad1_u2e_ao + int2_grad1_u12_ao = int2_grad1_u2e_ao + else print *, ' Error in int2_grad1_u12_ao: Unknown Jastrow' @@ -195,20 +84,13 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f PROVIDE ao_overlap PROVIDE j1e_gradx j1e_grady j1e_gradz - double precision, allocatable :: int_tmp(:,:,:,:) - - ! minus because we calculate \int [-\grad_1 u(1,2)] - tmp_ct = -1.d0 / (dble(elec_num) - 1.d0) + tmp_ct = 1.d0 / (dble(elec_num) - 1.d0) !$OMP PARALLEL & !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, tmp0_x, tmp0_y, tmp0_z, int_tmp) & + !$OMP PRIVATE (ipoint, i, j, tmp0_x, tmp0_y, tmp0_z) & !$OMP SHARED (ao_num, n_points_final_grid, tmp_ct, ao_overlap, & !$OMP j1e_gradx, j1e_grady, j1e_gradz, int2_grad1_u12_ao) - - allocate(int_tmp(ao_num,ao_num,n_points_final_grid,3)) - int_tmp = 0.d0 - !$OMP DO do ipoint = 1, n_points_final_grid tmp0_x = tmp_ct * j1e_gradx(ipoint) @@ -216,34 +98,15 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f tmp0_z = tmp_ct * j1e_gradz(ipoint) do j = 1, ao_num do i = 1, ao_num - int_tmp(i,j,ipoint,1) = int_tmp(i,j,ipoint,1) + tmp0_x * ao_overlap(i,j) - int_tmp(i,j,ipoint,2) = int_tmp(i,j,ipoint,2) + tmp0_y * ao_overlap(i,j) - int_tmp(i,j,ipoint,3) = int_tmp(i,j,ipoint,3) + tmp0_z * ao_overlap(i,j) + int2_grad1_u12_ao(i,j,ipoint,1) = int2_grad1_u12_ao(i,j,ipoint,1) + tmp0_x * ao_overlap(i,j) + int2_grad1_u12_ao(i,j,ipoint,2) = int2_grad1_u12_ao(i,j,ipoint,2) + tmp0_y * ao_overlap(i,j) + int2_grad1_u12_ao(i,j,ipoint,3) = int2_grad1_u12_ao(i,j,ipoint,3) + tmp0_z * ao_overlap(i,j) enddo enddo enddo - !$OMP END DO NOWAIT - - !$OMP CRITICAL - int2_grad1_u12_ao = int2_grad1_u12_ao + int_tmp - !$OMP END CRITICAL - - deallocate(int_tmp) + !$OMP END DO !$OMP END PARALLEL - else - - !if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then - ! FREE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then - ! FREE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env - !elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then - - if( (j2e_type .eq. "Mu") .and. & - ( (env_type .eq. "None") .or. (env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss") ) ) then - FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_gauss_Du Ir2_Mu_long_Du_2 - endif - endif ! j1e_type ! --- @@ -532,7 +395,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p else - print *, ' Error in int2_grad1_u12_square_ao: Unknown Jhastrow' + print *, ' Error in int2_grad1_u12_square_ao: Unknown Jastrow' stop endif ! j2e_type @@ -544,75 +407,46 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p PROVIDE elec_num PROVIDE ao_overlap PROVIDE j1e_gradx j1e_grady j1e_gradz + PROVIDE int2_grad1_u2e_ao - double precision, allocatable :: int_tmp(:,:,:) - - tmp_ct1 = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) - tmp_ct2 = 1.d0 / (dble(elec_num) - 1.d0) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx1, dy1, dz1, & - !$OMP dx2, dy2, dz2, dr12, tmp0, tmp1, tmp2, tmp3, tmp4, & - !$OMP tmp0_x, tmp0_y, tmp0_z, int_tmp) & - !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & - !$OMP tmp_ct1, tmp_ct2, env_val, env_grad, & - !$OMP j1e_gradx, j1e_grady, j1e_gradz, ao_overlap, & - !$OMP Ir2_Mu_long_Du_0, Ir2_Mu_long_Du_2, & - !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & - !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, int2_grad1_u12_square_ao) - - allocate(int_tmp(ao_num,ao_num,n_points_final_grid)) - int_tmp = 0.d0 + tmp_ct1 = 2.d0 / (dble(elec_num) - 1.d0) + tmp_ct2 = 1.d0 / ((dble(elec_num) - 1.d0) * (dble(elec_num) - 1.d0)) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, dx, dy, dz, r2, & + !$OMP tmp0, tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, & + !$OMP tmp_ct1, tmp_ct2, ao_overlap, & + !$OMP j1e_gradx, j1e_grady, j1e_gradz, & + !$OMP int2_grad1_u2e_ao, int2_grad1_u12_square_ao) !$OMP DO do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - r2 = x*x + y*y + z*z + dx = j1e_gradx(ipoint) + dy = j1e_grady(ipoint) + dz = j1e_gradz(ipoint) + r2 = dx*dx + dy*dy + dz*dz - dx1 = env_grad(1,ipoint) - dy1 = env_grad(2,ipoint) - dz1 = env_grad(3,ipoint) - - dx2 = j1e_gradx(ipoint) - dy2 = j1e_grady(ipoint) - dz2 = j1e_gradz(ipoint) - - dr12 = dx1*dx2 + dy1*dy2 + dz1*dz2 - - tmp0 = tmp_ct2 * (env_val(ipoint) * (dx2*x + dy2*y + dz2*z) + r2*dr12) - tmp1 = tmp_ct2 * dr12 - tmp2 = tmp_ct1 * tmp_ct2 * dr12 - tmp3 = tmp_ct2 * tmp_ct2 * (dx2*dx2 + dy2*dy2 + dz2*dz2) - - tmp0_x = tmp_ct2 * (env_val(ipoint) * dx2 + 2.d0 * dr12 * x) - tmp0_y = tmp_ct2 * (env_val(ipoint) * dy2 + 2.d0 * dr12 * y) - tmp0_z = tmp_ct2 * (env_val(ipoint) * dz2 + 2.d0 * dr12 * z) + tmp0 = tmp_ct2 * r2 + tmp0_x = tmp_ct1 * dx + tmp0_y = tmp_ct1 * dy + tmp0_z = tmp_ct1 * dz do j = 1, ao_num do i = 1, ao_num - - tmp4 = tmp0_x * Ir2_Mu_long_Du_x(i,j,ipoint) + tmp0_y * Ir2_Mu_long_Du_y(i,j,ipoint) + tmp0_z * Ir2_Mu_long_Du_z(i,j,ipoint) - int_tmp(i,j,ipoint) = int_tmp(i,j,ipoint) + tmp0 * Ir2_Mu_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_Mu_long_Du_2(i,j,ipoint) & - - tmp2 * Ir2_Mu_gauss_Du(i,j,ipoint) + tmp3 * ao_overlap(i,j) + int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1_u12_square_ao(i,j,ipoint) & + + tmp0 * ao_overlap(i,j) & + + tmp0_x * int2_grad1_u2e_ao(i,j,ipoint,1) & + + tmp0_y * int2_grad1_u2e_ao(i,j,ipoint,2) & + + tmp0_z * int2_grad1_u2e_ao(i,j,ipoint,3) enddo enddo enddo - !$OMP END DO NOWAIT - - !$OMP CRITICAL - int2_grad1_u12_square_ao = int2_grad1_u12_square_ao + int_tmp - !$OMP END CRITICAL - - deallocate(int_tmp) + !$OMP END DO !$OMP END PARALLEL - FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_gauss_Du Ir2_Mu_long_Du_2 - endif ! j1e_type ! --- diff --git a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f index e349d412..3f88c53f 100644 --- a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f +++ b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f @@ -755,7 +755,7 @@ subroutine test_j1e_fit_ao() allocate(x(n_points_final_grid), y(n_points_final_grid), z(n_points_final_grid)) - g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + g = -0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,1), ao_num*ao_num, Pt, 1, 0.d0, x, 1) call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,2), ao_num*ao_num, Pt, 1, 0.d0, y, 1) diff --git a/plugins/local/non_h_ints_mu/total_tc_int.irp.f b/plugins/local/non_h_ints_mu/total_tc_int.irp.f index 59f5174b..4cedf0e6 100644 --- a/plugins/local/non_h_ints_mu/total_tc_int.irp.f +++ b/plugins/local/non_h_ints_mu/total_tc_int.irp.f @@ -167,12 +167,15 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n !$OMP END PARALLEL do m = 1, 3 - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, -1.d0 & , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, b_mat(1,1,1,m), n_points_final_grid & , 1.d0, ao_two_e_tc_tot, ao_num*ao_num) enddo deallocate(b_mat) + FREE int2_grad1_u12_ao + FREE int2_grad1_u2e_ao + endif ! var_tc ! --- From 31bb892b657fe7a2054cc5247fbe81fdc8e09978 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 17 Jan 2024 11:45:24 +0100 Subject: [PATCH 80/84] Better error message --- ocaml/Zmatrix.ml | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/ocaml/Zmatrix.ml b/ocaml/Zmatrix.ml index 9e6ab2f8..6427f734 100644 --- a/ocaml/Zmatrix.ml +++ b/ocaml/Zmatrix.ml @@ -58,17 +58,32 @@ let int_of_atom_id : atom_id -> int = fun x -> x let float_of_distance : float StringMap.t -> distance -> float = fun map -> function | Value x -> x - | Label s -> StringMap.find s map + | Label s -> begin + try StringMap.find s map with + | Not_found -> + Printf.sprintf "Zmatrix error: distance %s undefined" s + |> failwith + end let float_of_angle : float StringMap.t -> angle -> float = fun map -> function | Value x -> x - | Label s -> StringMap.find s map + | Label s -> begin + try StringMap.find s map with + | Not_found -> + Printf.sprintf "Zmatrix error: angle %s undefined" s + |> failwith + end let float_of_dihedral : float StringMap.t -> dihedral -> float = fun map -> function | Value x -> x - | Label s -> StringMap.find s map + | Label s -> begin + try StringMap.find s map with + | Not_found -> + Printf.sprintf "Zmatrix error: dihedral %s undefined" s + |> failwith + end type line = From 8534b5c104f00f1484c1d2f5b866a75744632042 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Wed, 17 Jan 2024 19:23:24 +0100 Subject: [PATCH 81/84] fixed bug for env_type = None --- .../ao_many_one_e_ints/grad2_jmu_modif.irp.f | 58 ++-- plugins/local/non_h_ints_mu/tc_integ.irp.f | 76 +---- .../local/non_h_ints_mu/test_non_h_ints.irp.f | 265 +++++++++++++++++- .../local/non_h_ints_mu/total_tc_int.irp.f | 3 - .../local/tc_bi_ortho/slater_tc_slow.irp.f | 2 +- 5 files changed, 297 insertions(+), 107 deletions(-) diff --git a/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f index b1fc6134..bdcaac9d 100644 --- a/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f @@ -6,7 +6,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin BEGIN_DOC ! - ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) [1 - erf(mu r12)]^2 + ! \frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) [1 - erf(mu r12)]^2 ! END_DOC @@ -45,7 +45,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin expo_fit = expo_gauss_1_erf_x_2(i_fit) coef_fit = coef_gauss_1_erf_x_2(i_fit) - tmp += -0.25d0 * coef_fit * overlap_gauss_r12_ao(r, expo_fit, i, j) + tmp += 0.25d0 * coef_fit * overlap_gauss_r12_ao(r, expo_fit, i, j) enddo int2_grad1u2_grad2u2(j,i,ipoint) = tmp @@ -96,13 +96,13 @@ BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2, (ao_num, ao_num, n_ int2_grad1u2_grad2u2_env2 = 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 PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & + !$OMP coef_fit, expo_fit, int_fit, tmp) & !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & - !$OMP final_grid_points, ng_fit_jast, & - !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & - !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP final_grid_points, ng_fit_jast, & + !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & + !$OMP List_env1s_square_coef, List_env1s_square_expo, & !$OMP List_env1s_square_cent, int2_grad1u2_grad2u2_env2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -192,13 +192,13 @@ BEGIN_PROVIDER [double precision, int2_u2_env2, (ao_num, ao_num, n_points_final_ int2_u2_env2 = 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 PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & + !$OMP coef_fit, expo_fit, int_fit, tmp) & !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & - !$OMP final_grid_points, ng_fit_jast, & - !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, & - !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP final_grid_points, ng_fit_jast, & + !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, & + !$OMP List_env1s_square_coef, List_env1s_square_expo, & !$OMP List_env1s_square_cent, int2_u2_env2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -287,15 +287,15 @@ BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2, (ao_num, ao_num, n_point int2_u_grad1u_x_env2 = 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 PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & + !$OMP coef_fit, expo_fit, int_fit, alpha_1s, dist, & + !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, & + !$OMP tmp_x, tmp_y, tmp_z) & !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & - !$OMP final_grid_points, ng_fit_jast, & - !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & - !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP final_grid_points, ng_fit_jast, & + !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & + !$OMP List_env1s_square_coef, List_env1s_square_expo, & !$OMP List_env1s_square_cent, int2_u_grad1u_x_env2) !$OMP DO @@ -409,14 +409,14 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_env2, (ao_num, ao_num, n_points int2_u_grad1u_env2 = 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 PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & + !$OMP coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist, & + !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) & !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & - !$OMP final_grid_points, ng_fit_jast, & - !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & - !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP final_grid_points, ng_fit_jast, & + !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & + !$OMP List_env1s_square_coef, List_env1s_square_expo, & !$OMP List_env1s_square_cent, int2_u_grad1u_env2) !$OMP DO do ipoint = 1, n_points_final_grid diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f index 2255cb5c..775a9e4c 100644 --- a/plugins/local/non_h_ints_mu/tc_integ.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -207,7 +207,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p do ipoint = 1, n_points_final_grid do j = 1, ao_num do i = 1, ao_num - int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1u2_grad2u2(i,j,ipoint) + int2_grad1_u12_square_ao(i,j,ipoint) = -0.5d0 * int2_grad1u2_grad2u2(i,j,ipoint) enddo enddo enddo @@ -323,76 +323,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p endif ! use_ipp -! elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then -! -! PROVIDE mu_erf -! PROVIDE env_val env_grad -! PROVIDE Ir2_Mu_short_Du2_0 Ir2_Mu_short_Du2_x Ir2_Mu_short_Du2_y Ir2_Mu_short_Du2_z Ir2_Mu_short_Du2_2 -! PROVIDE Ir2_Mu_long_Du2_0 Ir2_Mu_long_Du2_x Ir2_Mu_long_Du2_y Ir2_Mu_long_Du2_z Ir2_Mu_long_Du2_2 -! PROVIDE Ir2_Mu_gauss_Du2 -! -! tmp_ct = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) -! tmp_ct2 = tmp_ct * tmp_ct -! -! int2_grad1_u12_square_ao = 0.d0 -! -! !$OMP PARALLEL & -! !$OMP DEFAULT (NONE) & -! !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, dr2, & -! !$OMP tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, & -! !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & -! !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & -! !$OMP tmp_ct, tmp_ct2, env_val, env_grad, & -! !$OMP Ir2_Mu_long_Du2_0, Ir2_Mu_long_Du2_x, & -! !$OMP Ir2_Mu_long_Du2_y, Ir2_Mu_long_Du2_z, & -! !$OMP Ir2_Mu_gauss_Du2, Ir2_Mu_long_Du2_2, & -! !$OMP Ir2_Mu_short_Du2_0, Ir2_Mu_short_Du2_x, & -! !$OMP Ir2_Mu_short_Du2_y, Ir2_Mu_short_Du2_z, & -! !$OMP Ir2_Mu_short_Du2_2, int2_grad1_u12_square_ao) -! !$OMP DO SCHEDULE (static) -! do ipoint = 1, n_points_final_grid -! -! x = final_grid_points(1,ipoint) -! y = final_grid_points(2,ipoint) -! z = final_grid_points(3,ipoint) -! r2 = x*x + y*y + z*z -! -! dx = env_grad(1,ipoint) -! dy = env_grad(2,ipoint) -! dz = env_grad(3,ipoint) -! dr2 = dx*dx + dy*dy + dz*dz -! -! tmp0_x = 0.5d0 * (dr2 * x + env_val(ipoint) * dx) -! tmp0_y = 0.5d0 * (dr2 * y + env_val(ipoint) * dy) -! tmp0_z = 0.5d0 * (dr2 * z + env_val(ipoint) * dz) -! -! tmp1 = 0.25d0 * (env_val(ipoint)*env_val(ipoint) + r2*dr2 + 2.d0*env_val(ipoint)*(x*dx+y*dy+z*dz)) -! tmp3 = 0.25d0 * dr2 -! tmp4 = tmp3 * tmp_ct2 -! tmp5 = 0.50d0 * tmp_ct * (r2*dr2 + env_val(ipoint)*(x*dx+y*dy+z*dz)) -! tmp6 = 0.50d0 * tmp_ct * dr2 -! -! tmp1_x = 0.5d0 * tmp_ct * (2.d0*dr2*x + env_val(ipoint)*dx) -! tmp1_y = 0.5d0 * tmp_ct * (2.d0*dr2*y + env_val(ipoint)*dy) -! tmp1_z = 0.5d0 * tmp_ct * (2.d0*dr2*z + env_val(ipoint)*dz) -! -! do j = 1, ao_num -! do i = 1, ao_num -! -! tmp2 = tmp1_x * Ir2_Mu_long_Du2_x (i,j,ipoint) + tmp1_y * Ir2_Mu_long_Du2_y (i,j,ipoint) + tmp1_z * Ir2_Mu_long_Du2_z (i,j,ipoint) & -! - tmp0_x * Ir2_Mu_short_Du2_x(i,j,ipoint) - tmp0_y * Ir2_Mu_short_Du2_y(i,j,ipoint) - tmp0_z * Ir2_Mu_short_Du2_z(i,j,ipoint) -! -! int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * Ir2_Mu_short_Du2_0(i,j,ipoint) + tmp2 + tmp3 * Ir2_Mu_short_Du2_2(i,j,ipoint) & -! + tmp4 * Ir2_Mu_gauss_Du2(i,j,ipoint) - tmp5 * Ir2_Mu_long_Du2_0(i,j,ipoint) & -! - tmp6 * Ir2_Mu_long_Du2_2(i,j,ipoint) -! enddo -! enddo -! enddo -! !$OMP END DO -! !$OMP END PARALLEL -! -! int2_grad1_u12_square_ao = -0.5d0 * int2_grad1_u12_square_ao - else print *, ' Error in int2_grad1_u12_square_ao: Unknown Jastrow' @@ -409,8 +339,8 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p PROVIDE j1e_gradx j1e_grady j1e_gradz PROVIDE int2_grad1_u2e_ao - tmp_ct1 = 2.d0 / (dble(elec_num) - 1.d0) - tmp_ct2 = 1.d0 / ((dble(elec_num) - 1.d0) * (dble(elec_num) - 1.d0)) + tmp_ct1 = -1.0d0 / (dble(elec_num) - 1.d0) + tmp_ct2 = -0.5d0 / ((dble(elec_num) - 1.d0) * (dble(elec_num) - 1.d0)) !$OMP PARALLEL & !$OMP DEFAULT (NONE) & diff --git a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f index 3f88c53f..90e5a7b3 100644 --- a/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f +++ b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f @@ -37,7 +37,10 @@ program test_non_h !call test_j1e_grad() - call test_j1e_fit_ao() + !call test_j1e_fit_ao() + + call test_tc_grad_and_lapl_ao_new() + call test_tc_grad_square_ao_new() end ! --- @@ -849,3 +852,263 @@ end ! --- +subroutine test_tc_grad_and_lapl_ao_new() + + implicit none + integer :: i, j, k, l + double precision :: i_old, i_new, diff, thr, accu, norm + double precision, allocatable :: tc_grad_and_lapl_ao_old(:,:,:,:) + + PROVIDE tc_grad_and_lapl_ao_new + + thr = 1d-10 + norm = 0.d0 + accu = 0.d0 + + allocate(tc_grad_and_lapl_ao_old(ao_num,ao_num,ao_num,ao_num)) + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_and_lapl_ao_old', action="read") + read(11) tc_grad_and_lapl_ao_old + close(11) + + do i = 1, ao_num + do j = 1, ao_num + do k = 1, ao_num + do l = 1, ao_num + + i_old = tc_grad_and_lapl_ao_old(l,k,j,i) + i_new = tc_grad_and_lapl_ao_new(l,k,j,i) + diff = dabs(i_old - i_new) + if(diff .gt. thr) then + print *, ' problem in tc_grad_and_lapl_ao_new on:', l, k, j, i + print *, ' old :', i_old + print *, ' new :', i_new + stop + endif + accu += diff + norm += dabs(i_old) + enddo + enddo + enddo + enddo + + deallocate(tc_grad_and_lapl_ao_old) + + print*, ' accuracy (%) = ', 100.d0 * accu / norm + +end + +! --- + +subroutine test_tc_grad_square_ao_new() + + implicit none + integer :: i, j, k, l + double precision :: i_old, i_new, diff, thr, accu, norm + double precision, allocatable :: tc_grad_square_ao_old(:,:,:,:) + + PROVIDE tc_grad_square_ao_new + + thr = 1d-10 + norm = 0.d0 + accu = 0.d0 + + allocate(tc_grad_square_ao_old(ao_num,ao_num,ao_num,ao_num)) + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_square_ao_old', action="read") + read(11) tc_grad_square_ao_old + close(11) + + do i = 1, ao_num + do j = 1, ao_num + do k = 1, ao_num + do l = 1, ao_num + + i_old = tc_grad_square_ao_old(l,k,j,i) + i_new = tc_grad_square_ao_new(l,k,j,i) + diff = dabs(i_old - i_new) + if(diff .gt. thr) then + print *, ' problem in tc_grad_and_lapl_ao_new on:', l, k, j, i + print *, ' old :', i_old + print *, ' new :', i_new + stop + endif + accu += diff + norm += dabs(i_old) + enddo + enddo + enddo + enddo + + deallocate(tc_grad_square_ao_old) + + print*, ' accuracy (%) = ', 100.d0 * accu / norm + +end + +! --- + +BEGIN_PROVIDER [double precision, tc_grad_square_ao_new, (ao_num, ao_num, ao_num, ao_num)] + + implicit none + integer :: i, j, k, l, m, ipoint + double precision :: weight1, ao_k_r, ao_i_r + double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq + double precision :: time0, time1 + double precision, allocatable :: b_mat(:,:,:,:), c_mat(:,:,:) + double precision, external :: get_ao_two_e_integral + + PROVIDe tc_integ_type + PROVIDE env_type + PROVIDE j2e_type + PROVIDE j1e_type + + call wall_time(time0) + + print *, ' providing tc_grad_square_ao_new ...' + + PROVIDE int2_grad1_u12_square_ao + + allocate(c_mat(n_points_final_grid,ao_num,ao_num)) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + c_mat(ipoint,k,i) = final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,k) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_grad1_u12_square_ao(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 0.d0, tc_grad_square_ao_new, ao_num*ao_num) + + FREE int2_grad1_u12_square_ao + + if( (tc_integ_type .eq. "semi-analytic") .and. & + (j2e_type .eq. "Mu") .and. & + ((env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss")) .and. & + use_ipp ) then + + ! an additional term is added here directly instead of + ! being added in int2_grad1_u12_square_ao for performance + + PROVIDE int2_u2_env2 + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & + !$OMP env_square_grad, env_square_lapl, aos_grad_in_r_array_transp_bis) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) + + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + c_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * env_square_lapl(ipoint) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_u2_env2(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 1.d0, tc_grad_square_ao_new, ao_num*ao_num) + + FREE int2_u2_env2 + endif ! use_ipp + + deallocate(c_mat) + + call sum_A_At(tc_grad_square_ao_new(1,1,1,1), ao_num*ao_num) + + call wall_time(time1) + print*, ' Wall time for tc_grad_square_ao_new (min) = ', (time1 - time0) / 60.d0 + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao_new, (ao_num, ao_num, ao_num, ao_num)] + + implicit none + integer :: i, j, k, l, m, ipoint + double precision :: weight1, ao_k_r, ao_i_r + double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq + double precision :: time0, time1 + double precision, allocatable :: b_mat(:,:,:,:), c_mat(:,:,:) + double precision, external :: get_ao_two_e_integral + + PROVIDe tc_integ_type + PROVIDE env_type + PROVIDE j2e_type + PROVIDE j1e_type + + call wall_time(time0) + + print *, ' providing tc_grad_square_ao_new ...' + + + PROVIDE int2_grad1_u12_ao + + allocate(b_mat(n_points_final_grid,ao_num,ao_num,3)) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, aos_grad_in_r_array_transp_bis, b_mat, & + !$OMP ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + b_mat(ipoint,k,i,1) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) + b_mat(ipoint,k,i,2) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) + b_mat(ipoint,k,i,3) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + tc_grad_and_lapl_ao_new = 0.d0 + do m = 1, 3 + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, -1.d0 & + , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, b_mat(1,1,1,m), n_points_final_grid & + , 1.d0, tc_grad_and_lapl_ao_new, ao_num*ao_num) + enddo + deallocate(b_mat) + + FREE int2_grad1_u12_ao + FREE int2_grad1_u2e_ao + + call sum_A_At(tc_grad_and_lapl_ao_new(1,1,1,1), ao_num*ao_num) + + call wall_time(time1) + print*, ' Wall time for tc_grad_and_lapl_ao_new (min) = ', (time1 - time0) / 60.d0 + +END_PROVIDER + +! --- + diff --git a/plugins/local/non_h_ints_mu/total_tc_int.irp.f b/plugins/local/non_h_ints_mu/total_tc_int.irp.f index 4cedf0e6..38da4047 100644 --- a/plugins/local/non_h_ints_mu/total_tc_int.irp.f +++ b/plugins/local/non_h_ints_mu/total_tc_int.irp.f @@ -67,7 +67,6 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n allocate(c_mat(n_points_final_grid,ao_num,ao_num)) - c_mat = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, k, ipoint) & @@ -99,7 +98,6 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n PROVIDE int2_u2_env2 - c_mat = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & @@ -142,7 +140,6 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n allocate(b_mat(n_points_final_grid,ao_num,ao_num,3)) - b_mat = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & diff --git a/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f b/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f index 02352a32..caf7d665 100644 --- a/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f +++ b/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f @@ -27,7 +27,7 @@ subroutine htilde_mu_mat_bi_ortho_tot_slow(key_j, key_i, Nint, htot) call htilde_mu_mat_bi_ortho_slow(key_j, key_i, Nint, hmono, htwoe, hthree, htot) endif -end subroutine htilde_mu_mat_bi_ortho_tot_slow +end ! -- From ba73d91fd397af199ca92085f7b7a33b916589a9 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Thu, 18 Jan 2024 12:10:49 +0100 Subject: [PATCH 82/84] AOs deb --- plugins/local/jastrow/env_param.irp.f | 8 ++- plugins/local/non_h_ints_mu/deb_aos.irp.f | 56 +++++++++++++++++++ plugins/local/non_h_ints_mu/jast_1e.irp.f | 48 +++++++++++++--- .../local/non_h_ints_mu/jast_1e_utils.irp.f | 8 +++ 4 files changed, 109 insertions(+), 11 deletions(-) create mode 100644 plugins/local/non_h_ints_mu/deb_aos.irp.f diff --git a/plugins/local/jastrow/env_param.irp.f b/plugins/local/jastrow/env_param.irp.f index 6d26baa3..689b22cd 100644 --- a/plugins/local/jastrow/env_param.irp.f +++ b/plugins/local/jastrow/env_param.irp.f @@ -1,11 +1,13 @@ ! --- - BEGIN_PROVIDER [ double precision, env_expo , (nucl_num) ] -&BEGIN_PROVIDER [ double precision, env_coef, (nucl_num) ] + BEGIN_PROVIDER [double precision, env_expo, (nucl_num)] +&BEGIN_PROVIDER [double precision, env_coef, (nucl_num)] BEGIN_DOC - ! parameters of the 1-body Jastrow + ! + ! parameters of the env of the 2e-Jastrow + ! END_DOC implicit none diff --git a/plugins/local/non_h_ints_mu/deb_aos.irp.f b/plugins/local/non_h_ints_mu/deb_aos.irp.f new file mode 100644 index 00000000..c9bc9c9a --- /dev/null +++ b/plugins/local/non_h_ints_mu/deb_aos.irp.f @@ -0,0 +1,56 @@ + +! --- + +program deb_Aos + + implicit none + + my_grid_becke = .True. + PROVIDE tc_grid1_a tc_grid1_r + my_n_pt_r_grid = tc_grid1_r + my_n_pt_a_grid = tc_grid1_a + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + if(tc_integ_type .eq. "numeric") then + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + endif + + call print_aos() + +end + +! --- + +subroutine print_aos() + + implicit none + integer :: i, ipoint + double precision :: r(3) + double precision :: ao_val, ao_der(3), ao_lap + + PROVIDE final_grid_points aos_in_r_array aos_grad_in_r_array aos_lapl_in_r_array + + do ipoint = 1, n_points_final_grid + r(:) = final_grid_points(:,ipoint) + print*, r + enddo + + do ipoint = 1, n_points_final_grid + r(:) = final_grid_points(:,ipoint) + do i = 1, ao_num + ao_val = aos_in_r_array (i,ipoint) + ao_der(:) = aos_grad_in_r_array(i,ipoint,:) + ao_lap = aos_lapl_in_r_array(1,i,ipoint) + aos_lapl_in_r_array(2,i,ipoint) + aos_lapl_in_r_array(3,i,ipoint) + write(*, '(5(f15.7, 3X))') ao_val, ao_der, ao_lap + enddo + enddo + + return +end + +! --- + diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f index b2eef504..47245938 100644 --- a/plugins/local/non_h_ints_mu/jast_1e.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -71,6 +71,8 @@ END_PROVIDER implicit none integer :: ipoint, i, j, p + integer :: ierr + logical :: exists double precision :: x, y, z, dx, dy, dz, d2 double precision :: a, c, g, tmp_x, tmp_y, tmp_z double precision :: time0, time1 @@ -116,15 +118,15 @@ END_PROVIDER a = j1e_expo(p,j) g = c * a * dexp(-a*d2) - tmp_x = tmp_x - g * dx - tmp_y = tmp_y - g * dy - tmp_z = tmp_z - g * dz + tmp_x = tmp_x + g * dx + tmp_y = tmp_y + g * dy + tmp_z = tmp_z + g * dz enddo enddo - j1e_gradx(ipoint) = 2.d0 * tmp_x - j1e_grady(ipoint) = 2.d0 * tmp_y - j1e_gradz(ipoint) = 2.d0 * tmp_z + j1e_gradx(ipoint) = -2.d0 * tmp_x + j1e_grady(ipoint) = -2.d0 * tmp_y + j1e_gradz(ipoint) = -2.d0 * tmp_z enddo elseif(j1e_type .eq. "Charge_Harmonizer") then @@ -173,8 +175,38 @@ END_PROVIDER allocate(coef_fit(ao_num)) - call get_j1e_coef_fit_ao(ao_num, coef_fit) - call ezfio_set_jastrow_j1e_coef_ao(coef_fit) + if(mpi_master) then + call ezfio_has_jastrow_j1e_coef_ao(exists) + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + call MPI_BCAST(coef_fit, ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_coef_ao with MPI' + endif + IRP_ENDIF + if(exists) then + if(mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao ] <<<<< ..' + call ezfio_get_jastrow_j1e_coef_ao(coef_fit) + IRP_IF MPI + call MPI_BCAST(coef_fit, ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_coef_ao with MPI' + endif + IRP_ENDIF + endif + else + + call get_j1e_coef_fit_ao(ao_num, coef_fit) + call ezfio_set_jastrow_j1e_coef_ao(coef_fit) + + endif + !$OMP PARALLEL & !$OMP DEFAULT (NONE) & diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f index ba7477cc..b9ea2d6f 100644 --- a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -9,16 +9,21 @@ subroutine get_j1e_coef_fit_ao(dim_fit, coef_fit) integer :: i, ipoint double precision :: g + double precision :: t0, t1 double precision, allocatable :: A(:,:), b(:), A_inv(:,:) double precision, allocatable :: Pa(:,:), Pb(:,:), Pt(:,:) double precision, allocatable :: u1e_tmp(:) + PROVIDE j1e_type PROVIDE int2_u2e_ao PROVIDE elec_alpha_num elec_beta_num elec_num PROVIDE mo_coef PROVIDE ao_overlap + call wall_time(t0) + print*, ' PROVIDING the representation of 1e-Jastrow in AOs ... ' + ! --- --- --- ! get u1e(r) @@ -94,6 +99,9 @@ subroutine get_j1e_coef_fit_ao(dim_fit, coef_fit) deallocate(A_inv, b) + call wall_time(t1) + print*, ' END after (min) ', (t1-t0)/60.d0 + return end From bb8dd171b8ae0a77f50382f817fedb49f5a1640e Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Tue, 23 Jan 2024 13:25:16 +0100 Subject: [PATCH 83/84] Charge_Harmonizer_AO: OK --- plugins/local/jastrow/EZFIO.cfg | 26 +- plugins/local/non_h_ints_mu/debug_fit.irp.f | 8 +- plugins/local/non_h_ints_mu/jast_1e.irp.f | 200 +++++++++++-- .../local/non_h_ints_mu/jast_1e_utils.irp.f | 283 ++++++++++++++++++ .../non_h_ints_mu/jast_deriv_utils_vect.irp.f | 190 ++++++++---- .../local/non_h_ints_mu/tc_integ_num.irp.f | 24 +- 6 files changed, 629 insertions(+), 102 deletions(-) diff --git a/plugins/local/jastrow/EZFIO.cfg b/plugins/local/jastrow/EZFIO.cfg index a1e0a871..0d4141af 100644 --- a/plugins/local/jastrow/EZFIO.cfg +++ b/plugins/local/jastrow/EZFIO.cfg @@ -13,7 +13,7 @@ default: None [env_type] type: character*(32) -doc: type of 1-body Jastrow: [ None | Prod_Gauss | Sum_Gauss | Sum_Slat | Sum_Quartic ] +doc: type of envelop for Jastrow: [ None | Prod_Gauss | Sum_Gauss | Sum_Slat | Sum_Quartic ] interface: ezfio, provider, ocaml default: Sum_Gauss @@ -91,10 +91,22 @@ size: (jastrow.j1e_size,nuclei.nucl_num) [j1e_coef_ao] type: double precision -doc: coefficients of the 1-body Jastrow in AOs +doc: coefficients of the 1-electrob Jastrow in AOs interface: ezfio size: (ao_basis.ao_num) +[j1e_coef_ao2] +type: double precision +doc: coefficients of the 1-electron Jastrow in AOsxAOs +interface: ezfio +size: (ao_basis.ao_num*ao_basis.ao_num) + +[j1e_coef_ao3] +type: double precision +doc: coefficients of the 1-electron Jastrow in AOsxAOs +interface: ezfio +size: (ao_basis.ao_num,3) + [j1e_expo] type: double precision doc: exponenets of functions in 1e-Jastrow @@ -103,13 +115,13 @@ size: (jastrow.j1e_size,nuclei.nucl_num) [env_expo] type: double precision -doc: exponents of the 1-body Jastrow +doc: exponents of the envelop for Jastrow interface: ezfio size: (nuclei.nucl_num) [env_coef] type: double precision -doc: coefficients of the 1-body Jastrow +doc: coefficients of the envelop for Jastrow interface: ezfio size: (nuclei.nucl_num) @@ -125,4 +137,10 @@ doc: nb of Gaussians used to fit Jastrow fcts interface: ezfio,provider,ocaml default: 20 +[a_boys] +type: double precision +doc: cutting of the interaction in the range separated model +interface: ezfio,provider,ocaml +default: 1.0 +ezfio_name: a_boys diff --git a/plugins/local/non_h_ints_mu/debug_fit.irp.f b/plugins/local/non_h_ints_mu/debug_fit.irp.f index 3934bb06..d4b917ec 100644 --- a/plugins/local/non_h_ints_mu/debug_fit.irp.f +++ b/plugins/local/non_h_ints_mu/debug_fit.irp.f @@ -401,10 +401,10 @@ subroutine test_grad1_u12_withsq_num() do ipoint = 1, n_points_final_grid - call get_grad1_u12_withsq_r1_seq(final_grid_points(1,ipoint), n_points_extra_final_grid, tmp_grad1_u12(1,ipoint,1) & - , tmp_grad1_u12(1,ipoint,2) & - , tmp_grad1_u12(1,ipoint,3) & - , tmp_grad1_u12_squared(1,ipoint)) + call get_grad1_u12_withsq_r1_seq(ipoint, n_points_extra_final_grid, tmp_grad1_u12(1,ipoint,1) & + , tmp_grad1_u12(1,ipoint,2) & + , tmp_grad1_u12(1,ipoint,3) & + , tmp_grad1_u12_squared(1,ipoint)) do jpoint = 1, n_points_extra_final_grid i_exc = grad1_u12_squared_num(jpoint,ipoint) diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f index 47245938..37ac0092 100644 --- a/plugins/local/non_h_ints_mu/jast_1e.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -70,14 +70,15 @@ END_PROVIDER &BEGIN_PROVIDER [double precision, j1e_gradz, (n_points_final_grid)] implicit none - integer :: ipoint, i, j, p + integer :: ipoint, i, j, ij, p integer :: ierr logical :: exists double precision :: x, y, z, dx, dy, dz, d2 double precision :: a, c, g, tmp_x, tmp_y, tmp_z + double precision :: cx, cy, cz double precision :: time0, time1 double precision, allocatable :: Pa(:,:), Pb(:,:), Pt(:,:) - double precision, allocatable :: coef_fit(:) + double precision, allocatable :: coef_fit(:), coef_fit2(:), coef_fit3(:,:) PROVIDE j1e_type @@ -162,21 +163,164 @@ END_PROVIDER deallocate(Pa, Pb, Pt) +! elseif(j1e_type .eq. "Charge_Harmonizer_AO") then +! +! ! \grad_1 \sum_{\eta} C_{\eta} \chi_{\eta} +! ! where +! ! \chi_{\eta} are the AOs +! ! C_{\eta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") +! ! +! ! The - sign is in the parameters C_{\eta} +! +! PROVIDE aos_grad_in_r_array +! +! allocate(coef_fit(ao_num)) +! +! if(mpi_master) then +! call ezfio_has_jastrow_j1e_coef_ao(exists) +! endif +! IRP_IF MPI_DEBUG +! print *, irp_here, mpi_rank +! call MPI_BARRIER(MPI_COMM_WORLD, ierr) +! IRP_ENDIF +! IRP_IF MPI +! include 'mpif.h' +! call MPI_BCAST(coef_fit, ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read j1e_coef_ao with MPI' +! endif +! IRP_ENDIF +! if(exists) then +! if(mpi_master) then +! write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao ] <<<<< ..' +! call ezfio_get_jastrow_j1e_coef_ao(coef_fit) +! IRP_IF MPI +! call MPI_BCAST(coef_fit, ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read j1e_coef_ao with MPI' +! endif +! IRP_ENDIF +! endif +! else +! +! call get_j1e_coef_fit_ao(ao_num, coef_fit) +! call ezfio_set_jastrow_j1e_coef_ao(coef_fit) +! +! endif +! +! !$OMP PARALLEL & +! !$OMP DEFAULT (NONE) & +! !$OMP PRIVATE (i, ipoint, c) & +! !$OMP SHARED (n_points_final_grid, ao_num, & +! !$OMP aos_grad_in_r_array, coef_fit, & +! !$OMP j1e_gradx, j1e_grady, j1e_gradz) +! !$OMP DO SCHEDULE (static) +! do ipoint = 1, n_points_final_grid +! +! j1e_gradx(ipoint) = 0.d0 +! j1e_grady(ipoint) = 0.d0 +! j1e_gradz(ipoint) = 0.d0 +! do i = 1, ao_num +! c = coef_fit(i) +! j1e_gradx(ipoint) = j1e_gradx(ipoint) + c * aos_grad_in_r_array(i,ipoint,1) +! j1e_grady(ipoint) = j1e_grady(ipoint) + c * aos_grad_in_r_array(i,ipoint,2) +! j1e_gradz(ipoint) = j1e_gradz(ipoint) + c * aos_grad_in_r_array(i,ipoint,3) +! enddo +! enddo +! !$OMP END DO +! !$OMP END PARALLEL +! +! deallocate(coef_fit) +! +! elseif(j1e_type .eq. "Charge_Harmonizer_AO2") then +! +! ! \grad_1 \sum_{\eta,\beta} C_{\eta,\beta} \chi_{\eta} \chi_{\beta} +! ! where +! ! \chi_{\eta} are the AOs +! ! C_{\eta,\beta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") +! ! +! ! The - sign is in the parameters C_{\eta,\beta} +! +! PROVIDE aos_grad_in_r_array +! +! allocate(coef_fit2(ao_num*ao_num)) +! +! if(mpi_master) then +! call ezfio_has_jastrow_j1e_coef_ao2(exists) +! endif +! IRP_IF MPI_DEBUG +! print *, irp_here, mpi_rank +! call MPI_BARRIER(MPI_COMM_WORLD, ierr) +! IRP_ENDIF +! IRP_IF MPI +! call MPI_BCAST(coef_fit2, ao_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read j1e_coef_ao2 with MPI' +! endif +! IRP_ENDIF +! if(exists) then +! if(mpi_master) then +! write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao2 ] <<<<< ..' +! call ezfio_get_jastrow_j1e_coef_ao2(coef_fit2) +! IRP_IF MPI +! call MPI_BCAST(coef_fit2, ao_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read j1e_coef_ao2 with MPI' +! endif +! IRP_ENDIF +! endif +! else +! +! call get_j1e_coef_fit_ao2(ao_num*ao_num, coef_fit2) +! call ezfio_set_jastrow_j1e_coef_ao2(coef_fit2) +! +! endif +! +! !$OMP PARALLEL & +! !$OMP DEFAULT (NONE) & +! !$OMP PRIVATE (i, j, ij, ipoint, c) & +! !$OMP SHARED (n_points_final_grid, ao_num, & +! !$OMP aos_grad_in_r_array, coef_fit2, & +! !$OMP aos_in_r_array, j1e_gradx, j1e_grady, j1e_gradz) +! !$OMP DO SCHEDULE (static) +! do ipoint = 1, n_points_final_grid +! +! j1e_gradx(ipoint) = 0.d0 +! j1e_grady(ipoint) = 0.d0 +! j1e_gradz(ipoint) = 0.d0 +! +! do i = 1, ao_num +! do j = 1, ao_num +! ij = (i-1)*ao_num + j +! +! c = coef_fit2(ij) +! +! j1e_gradx(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,1) + aos_grad_in_r_array(i,ipoint,1) * aos_in_r_array(j,ipoint)) +! j1e_grady(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,2) + aos_grad_in_r_array(i,ipoint,2) * aos_in_r_array(j,ipoint)) +! j1e_gradz(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,3) + aos_grad_in_r_array(i,ipoint,3) * aos_in_r_array(j,ipoint)) +! enddo +! enddo +! enddo +! !$OMP END DO +! !$OMP END PARALLEL +! +! deallocate(coef_fit2) + elseif(j1e_type .eq. "Charge_Harmonizer_AO") then - ! \grad_1 \sum_{\eta} C_{\eta} \chi_{\eta} + ! \sum_{\eta} \vec{C}_{\eta} \chi_{\eta} ! where ! \chi_{\eta} are the AOs - ! C_{\eta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") + ! \vec{C}_{\eta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") ! - ! The - sign is in the parameters C_{\eta} + ! The - sign is in the parameters \vec{C}_{\eta} PROVIDE aos_grad_in_r_array - allocate(coef_fit(ao_num)) + allocate(coef_fit3(ao_num,3)) if(mpi_master) then - call ezfio_has_jastrow_j1e_coef_ao(exists) + call ezfio_has_jastrow_j1e_coef_ao3(exists) endif IRP_IF MPI_DEBUG print *, irp_here, mpi_rank @@ -184,36 +328,35 @@ END_PROVIDER IRP_ENDIF IRP_IF MPI include 'mpif.h' - call MPI_BCAST(coef_fit, ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(coef_fit3, (ao_num*3), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1e_coef_ao with MPI' + stop 'Unable to read j1e_coef_ao3 with MPI' endif IRP_ENDIF if(exists) then if(mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao ] <<<<< ..' - call ezfio_get_jastrow_j1e_coef_ao(coef_fit) + write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao3 ] <<<<< ..' + call ezfio_get_jastrow_j1e_coef_ao3(coef_fit3) IRP_IF MPI - call MPI_BCAST(coef_fit, ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(coef_fit3, (ao_num*3), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1e_coef_ao with MPI' + stop 'Unable to read j1e_coef_ao3 with MPI' endif IRP_ENDIF endif else - call get_j1e_coef_fit_ao(ao_num, coef_fit) - call ezfio_set_jastrow_j1e_coef_ao(coef_fit) + call get_j1e_coef_fit_ao3(ao_num, coef_fit3) + call ezfio_set_jastrow_j1e_coef_ao3(coef_fit3) endif - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, ipoint, c) & - !$OMP SHARED (n_points_final_grid, ao_num, & - !$OMP aos_grad_in_r_array, coef_fit, & - !$OMP j1e_gradx, j1e_grady, j1e_gradz) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, ipoint, cx, cy, cz) & + !$OMP SHARED (n_points_final_grid, ao_num, & + !$OMP aos_grad_in_r_array, coef_fit3, & + !$OMP aos_in_r_array, j1e_gradx, j1e_grady, j1e_gradz) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid @@ -221,16 +364,19 @@ END_PROVIDER j1e_grady(ipoint) = 0.d0 j1e_gradz(ipoint) = 0.d0 do i = 1, ao_num - c = coef_fit(i) - j1e_gradx(ipoint) = j1e_gradx(ipoint) + c * aos_grad_in_r_array(i,ipoint,1) - j1e_grady(ipoint) = j1e_grady(ipoint) + c * aos_grad_in_r_array(i,ipoint,2) - j1e_gradz(ipoint) = j1e_gradz(ipoint) + c * aos_grad_in_r_array(i,ipoint,3) + cx = coef_fit3(i,1) + cy = coef_fit3(i,2) + cz = coef_fit3(i,3) + + j1e_gradx(ipoint) += cx * aos_in_r_array(i,ipoint) + j1e_grady(ipoint) += cy * aos_in_r_array(i,ipoint) + j1e_gradz(ipoint) += cz * aos_in_r_array(i,ipoint) enddo enddo !$OMP END DO !$OMP END PARALLEL - deallocate(coef_fit) + deallocate(coef_fit3) else diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f index b9ea2d6f..9dc0d5b0 100644 --- a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -107,5 +107,288 @@ end ! --- +subroutine get_j1e_coef_fit_ao2(dim_fit, coef_fit) + + implicit none + integer , intent(in) :: dim_fit + double precision, intent(out) :: coef_fit(dim_fit) + + integer :: i, j, k, l, ipoint + integer :: ij, kl + double precision :: g + double precision :: t0, t1 + double precision, allocatable :: A(:,:), b(:), A_inv(:,:) + double precision, allocatable :: Pa(:,:), Pb(:,:), Pt(:,:) + double precision, allocatable :: u1e_tmp(:) + PROVIDE j1e_type + PROVIDE int2_u2e_ao + PROVIDE elec_alpha_num elec_beta_num elec_num + PROVIDE mo_coef + + call wall_time(t0) + print*, ' PROVIDING the representation of 1e-Jastrow in AOs x AOx ... ' + + ! --- --- --- + ! get u1e(r) + + allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) + + call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pa, size(Pa, 1)) + + if(elec_alpha_num .eq. elec_beta_num) then + Pb = Pa + else + call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pb, size(Pb, 1)) + endif + Pt = Pa + Pb + + allocate(u1e_tmp(n_points_final_grid)) + + g = -0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_u2e_ao, ao_num*ao_num, Pt, 1, 0.d0, u1e_tmp, 1) + + FREE int2_u2e_ao + + deallocate(Pa, Pb, Pt) + + ! --- --- --- + ! get A + + allocate(A(ao_num*ao_num,ao_num*ao_num)) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, k, l, ij, kl, ipoint) & + !$OMP SHARED (n_points_final_grid, ao_num, & + !$OMP final_weight_at_r_vector, aos_in_r_array_transp, A) + !$OMP DO COLLAPSE(2) + do k = 1, ao_num + do l = 1, ao_num + kl = (k-1)*ao_num + l + + do i = 1, ao_num + do j = 1, ao_num + ij = (i-1)*ao_num + j + + A(ij,kl) = 0.d0 + do ipoint = 1, n_points_final_grid + A(ij,kl) += final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,j) & + * aos_in_r_array_transp(ipoint,k) * aos_in_r_array_transp(ipoint,l) + enddo + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + print *, ' A' + do ij = 1, ao_num*ao_num + write(*, '(100000(f15.7))') (A(ij,kl), kl = 1, ao_num*ao_num) + enddo + + ! --- --- --- + ! get b + + allocate(b(ao_num*ao_num)) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ij, ipoint) & + !$OMP SHARED (n_points_final_grid, ao_num, & + !$OMP final_weight_at_r_vector, aos_in_r_array_transp, u1e_tmp, b) + !$OMP DO COLLAPSE(2) + do i = 1, ao_num + do j = 1, ao_num + ij = (i-1)*ao_num + j + + b(ij) = 0.d0 + do ipoint = 1, n_points_final_grid + b(ij) = b(ij) + final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,j) * u1e_tmp(ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + deallocate(u1e_tmp) + + ! --- --- --- + ! solve Ax = b + + allocate(A_inv(ao_num*ao_num,ao_num*ao_num)) + call get_inverse(A, ao_num*ao_num, ao_num*ao_num, A_inv, ao_num*ao_num) + + integer :: mn + print *, ' check A_inv' + do ij = 1, ao_num*ao_num + do kl = 1, ao_num*ao_num + + tmp = 0.d0 + do mn = 1, ao_num*ao_num + tmp += A(ij,mn) * A_inv(mn,kl) + enddo + + print*, ij, kl, tmp + enddo + enddo + + ! coef_fit = A_inv x b + !call dgemv("N", ao_num*ao_num, ao_num*ao_num, 1.d0, A_inv, ao_num*ao_num, b, 1, 0.d0, coef_fit(1,1), 1) + do ij = 1, ao_num*ao_num + coef_fit(ij) = 0.d0 + do kl = 1, ao_num*ao_num + coef_fit(ij) += A_inv(ij,kl) * b(kl) + enddo + enddo + + double precision :: tmp + print *, ' check A_inv' + do ij = 1, ao_num*ao_num + tmp = 0.d0 + do kl = 1, ao_num*ao_num + tmp += A(ij,kl) * coef_fit(kl) + enddo + tmp = tmp - b(ij) + print*, ij, tmp + enddo + + deallocate(A) + deallocate(A_inv, b) + + call wall_time(t1) + print*, ' END after (min) ', (t1-t0)/60.d0 + + return +end + +! --- + +subroutine get_j1e_coef_fit_ao3(dim_fit, coef_fit) + + implicit none + integer , intent(in) :: dim_fit + double precision, intent(out) :: coef_fit(dim_fit,3) + + integer :: i, d, ipoint + double precision :: g + double precision :: t0, t1 + double precision, allocatable :: A(:,:), b(:,:), A_inv(:,:) + double precision, allocatable :: Pa(:,:), Pb(:,:), Pt(:,:) + double precision, allocatable :: u1e_tmp(:,:) + + + PROVIDE j1e_type + PROVIDE int2_grad1_u2e_ao + PROVIDE elec_alpha_num elec_beta_num elec_num + PROVIDE mo_coef + PROVIDE ao_overlap + + call wall_time(t0) + print*, ' PROVIDING the representation of 1e-Jastrow in AOs ... ' + + ! --- --- --- + ! get u1e(r) + + allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) + + call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pa, size(Pa, 1)) + + if(elec_alpha_num .eq. elec_beta_num) then + Pb = Pa + else + call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pb, size(Pb, 1)) + endif + Pt = Pa + Pb + + allocate(u1e_tmp(n_points_final_grid,3)) + + g = -0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + do d = 1, 3 + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2e_ao(1,1,1,d), ao_num*ao_num, Pt, 1, 0.d0, u1e_tmp(1,d), 1) + enddo + + deallocate(Pa, Pb, Pt) + + ! --- --- --- + ! get A & b + + allocate(A(ao_num,ao_num), b(ao_num,3)) + + A(1:ao_num,1:ao_num) = ao_overlap(1:ao_num,1:ao_num) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, ipoint) & + !$OMP SHARED (n_points_final_grid, ao_num, & + !$OMP final_weight_at_r_vector, aos_in_r_array_transp, u1e_tmp, b) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + b(i,1) = 0.d0 + b(i,2) = 0.d0 + b(i,3) = 0.d0 + do ipoint = 1, n_points_final_grid + b(i,1) = b(i,1) + final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * u1e_tmp(ipoint,1) + b(i,2) = b(i,2) + final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * u1e_tmp(ipoint,2) + b(i,3) = b(i,3) + final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * u1e_tmp(ipoint,3) + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + deallocate(u1e_tmp) + + ! --- --- --- + ! solve Ax = b + + allocate(A_inv(ao_num,ao_num)) + call get_inverse(A, ao_num, ao_num, A_inv, ao_num) + + ! coef_fit = A_inv x b + do d = 1, 3 + call dgemv("N", ao_num, ao_num, 1.d0, A_inv, ao_num, b(1,d), 1, 0.d0, coef_fit(1,d), 1) + enddo + + integer :: j + double precision :: tmp, acc, nrm + + acc = 0.d0 + nrm = 0.d0 + print *, ' check A_inv' + do d = 1, 3 + do i = 1, ao_num + tmp = 0.d0 + do j = 1, ao_num + tmp += ao_overlap(i,j) * coef_fit(j,d) + enddo + tmp = tmp - b(i,d) + if(dabs(tmp) .gt. 1d-8) then + print*, d, i, tmp + endif + + acc += dabs(tmp) + nrm += dabs(b(i,d)) + enddo + enddo + print *, ' Relative Error (%) =', 100.d0*acc/nrm + + deallocate(A, A_inv, b) + + call wall_time(t1) + print*, ' END after (min) ', (t1-t0)/60.d0 + + return +end + +! --- + diff --git a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f index bd7db497..b58d8c17 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f @@ -1,7 +1,7 @@ ! --- -subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) +subroutine get_grad1_u12_withsq_r1_seq(ipoint, n_grid2, resx, resy, resz, res) BEGIN_DOC ! @@ -12,82 +12,93 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) END_DOC implicit none - integer, intent(in) :: n_grid2 - double precision, intent(in) :: r1(3) + integer, intent(in) :: ipoint, n_grid2 double precision, intent(out) :: resx(n_grid2), resy(n_grid2), resz(n_grid2), res(n_grid2) integer :: jpoint - double precision :: env_r1 - double precision :: grad1_env(3) + double precision :: env_r1, tmp + double precision :: grad1_env(3), r1(3) double precision, allocatable :: env_r2(:) double precision, allocatable :: u2b_r12(:) double precision, allocatable :: gradx1_u2b(:), grady1_u2b(:), gradz1_u2b(:) double precision, external :: env_nucl PROVIDE j1e_type j2e_type env_type + PROVIDE final_grid_points PROVIDE final_grid_points_extra - if( ((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) .or. & - (j2e_type .eq. "Mur") ) then + r1(1) = final_grid_points(1,ipoint) + r1(2) = final_grid_points(2,ipoint) + r1(3) = final_grid_points(3,ipoint) - call grad1_j12_mu_r1_seq(r1, n_grid2, resx, resy, resz) - do jpoint = 1, n_points_extra_final_grid - res(jpoint) = resx(jpoint) * resx(jpoint) + resy(jpoint) * resy(jpoint) + resz(jpoint) * resz(jpoint) - enddo + if( (j2e_type .eq. "Mu") .or. & + (j2e_type .eq. "Mur") .or. & + (j2e_type .eq. "Boys") ) then - elseif((j2e_type .eq. "Mu") .and. (env_type .ne. "None")) then + if(env_type .eq. "None") then - ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) - ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) + call grad1_j12_r1_seq(r1, n_grid2, resx, resy, resz) - allocate(env_r2(n_grid2)) - allocate(u2b_r12(n_grid2)) - allocate(gradx1_u2b(n_grid2)) - allocate(grady1_u2b(n_grid2)) - allocate(gradz1_u2b(n_grid2)) + else - env_r1 = env_nucl(r1) - call grad1_env_nucl(r1, grad1_env) + ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) + ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) - call env_nucl_r1_seq(n_grid2, env_r2) - call j12_mu_r1_seq(r1, n_grid2, u2b_r12) - call grad1_j12_mu_r1_seq(r1, n_grid2, gradx1_u2b, grady1_u2b, gradz1_u2b) + allocate(env_r2(n_grid2)) + allocate(u2b_r12(n_grid2)) + allocate(gradx1_u2b(n_grid2)) + allocate(grady1_u2b(n_grid2)) + allocate(gradz1_u2b(n_grid2)) - do jpoint = 1, n_points_extra_final_grid - resx(jpoint) = (gradx1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(1)) * env_r2(jpoint) - resy(jpoint) = (grady1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(2)) * env_r2(jpoint) - resz(jpoint) = (gradz1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(3)) * env_r2(jpoint) - res (jpoint) = resx(jpoint) * resx(jpoint) + resy(jpoint) * resy(jpoint) + resz(jpoint) * resz(jpoint) - enddo + env_r1 = env_nucl(r1) + call grad1_env_nucl(r1, grad1_env) - deallocate(env_r2, u2b_r12, gradx1_u2b, grady1_u2b, gradz1_u2b) + call env_nucl_r1_seq(n_grid2, env_r2) + call j12_r1_seq(r1, n_grid2, u2b_r12) + call grad1_j12_r1_seq(r1, n_grid2, gradx1_u2b, grady1_u2b, gradz1_u2b) + + do jpoint = 1, n_points_extra_final_grid + resx(jpoint) = (gradx1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(1)) * env_r2(jpoint) + resy(jpoint) = (grady1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(2)) * env_r2(jpoint) + resz(jpoint) = (gradz1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(3)) * env_r2(jpoint) + enddo + + deallocate(env_r2, u2b_r12, gradx1_u2b, grady1_u2b, gradz1_u2b) + + endif ! env_type else print *, ' Error in get_grad1_u12_withsq_r1_seq: Unknown Jastrow' stop + endif ! j2e_type + + + if(j1e_type .ne. "None") then + PROVIDE j1e_gradx j1e_grady j1e_gradz + PROVIDE elec_num + tmp = 1.d0 / (dble(elec_num) - 1.d0) + do jpoint = 1, n_points_extra_final_grid + resx(jpoint) = resx(jpoint) + tmp * j1e_gradx(ipoint) + resy(jpoint) = resy(jpoint) + tmp * j1e_grady(ipoint) + resz(jpoint) = resz(jpoint) + tmp * j1e_gradz(ipoint) + enddo endif + do jpoint = 1, n_points_extra_final_grid + res(jpoint) = resx(jpoint) * resx(jpoint) + resy(jpoint) * resy(jpoint) + resz(jpoint) * resz(jpoint) + enddo + return end ! --- -subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) +subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) BEGIN_DOC ! - ! gradient of j(mu(r1,r2),r12) form of jastrow. - ! - ! if mu(r1,r2) = cst ---> - ! - ! d/dx1 j(mu,r12) = 0.5 * (1 - erf(mu *r12))/r12 * (x1 - x2) - ! - ! if mu(r1,r2) /= cst ---> - ! - ! d/dx1 j(mu(r1,r2),r12) = exp(-(mu(r1,r2)*r12)**2) /(2 *sqrt(pi) * mu(r1,r2)**2 ) d/dx1 mu(r1,r2) - ! + 0.5 * (1 - erf(mu(r1,r2) *r12))/r12 * (x1 - x2) ! END_DOC @@ -107,6 +118,9 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) if(j2e_type .eq. "Mu") then + ! d/dx1 j(mu,r12) = 0.5 * (1 - erf(mu *r12))/r12 * (x1 - x2) + ! + do jpoint = 1, n_points_extra_final_grid ! r2 r2(1) = final_grid_points_extra(1,jpoint) @@ -134,6 +148,9 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) elseif(j2e_type .eq. "Mur") then + ! d/dx1 j(mu(r1,r2),r12) = exp(-(mu(r1,r2)*r12)**2) /(2 *sqrt(pi) * mu(r1,r2)**2 ) d/dx1 mu(r1,r2) + ! + 0.5 * (1 - erf(mu(r1,r2) *r12))/r12 * (x1 - x2) + do jpoint = 1, n_points_extra_final_grid ! r2 r2(1) = final_grid_points_extra(1,jpoint) @@ -166,9 +183,40 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) gradz(jpoint) = gradz(jpoint) + tmp * dz enddo + elseif(j2e_type .eq. "Boys") then + + ! j(r12) = 0.5 r12 / (1 + a_boys r_12) + + PROVIDE a_boys + + do jpoint = 1, n_points_extra_final_grid ! r2 + + r2(1) = final_grid_points_extra(1,jpoint) + r2(2) = final_grid_points_extra(2,jpoint) + r2(3) = final_grid_points_extra(3,jpoint) + + dx = r1(1) - r2(1) + dy = r1(2) - r2(2) + dz = r1(3) - r2(3) + r12 = dsqrt(dx * dx + dy * dy + dz * dz) + if(r12 .lt. 1d-10) then + gradx(jpoint) = 0.d0 + grady(jpoint) = 0.d0 + gradz(jpoint) = 0.d0 + cycle + endif + + tmp = 1.d0 + a_boys * r12 + tmp = 0.5d0 / (r12 * tmp * tmp) + + gradx(jpoint) = tmp * dx + grady(jpoint) = tmp * dy + gradz(jpoint) = tmp * dz + enddo + else - print *, ' Error in grad1_j12_mu_r1_seq: Unknown j2e_type = ', j2e_type + print *, ' Error in grad1_j12_r1_seq: Unknown j2e_type = ', j2e_type stop endif ! j2e_type @@ -178,7 +226,7 @@ end ! --- -subroutine j12_mu_r1_seq(r1, n_grid2, res) +subroutine j12_r1_seq(r1, n_grid2, res) include 'constants.include.F' @@ -189,23 +237,57 @@ subroutine j12_mu_r1_seq(r1, n_grid2, res) integer :: jpoint double precision :: r2(3) + double precision :: dx, dy, dz double precision :: mu_tmp, r12 PROVIDE final_grid_points_extra - do jpoint = 1, n_points_extra_final_grid ! r2 + if(j2e_type .eq. "Mu") then - r2(1) = final_grid_points_extra(1,jpoint) - r2(2) = final_grid_points_extra(2,jpoint) - r2(3) = final_grid_points_extra(3,jpoint) + PROVIDE mu_erf - r12 = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & - + (r1(2) - r2(2)) * (r1(2) - r2(2)) & - + (r1(3) - r2(3)) * (r1(3) - r2(3)) ) - mu_tmp = mu_erf * r12 + do jpoint = 1, n_points_extra_final_grid ! r2 + + r2(1) = final_grid_points_extra(1,jpoint) + r2(2) = final_grid_points_extra(2,jpoint) + r2(3) = final_grid_points_extra(3,jpoint) + + dx = r1(1) - r2(1) + dy = r1(2) - r2(2) + dz = r1(3) - r2(3) + r12 = dsqrt(dx * dx + dy * dy + dz * dz) - res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf - enddo + mu_tmp = mu_erf * r12 + + res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf + enddo + + elseif(j2e_type .eq. "Boys") then + + ! j(r12) = 0.5 r12 / (1 + a_boys r_12) + + PROVIDE a_boys + + do jpoint = 1, n_points_extra_final_grid ! r2 + + r2(1) = final_grid_points_extra(1,jpoint) + r2(2) = final_grid_points_extra(2,jpoint) + r2(3) = final_grid_points_extra(3,jpoint) + + dx = r1(1) - r2(1) + dy = r1(2) - r2(2) + dz = r1(3) - r2(3) + r12 = dsqrt(dx * dx + dy * dy + dz * dz) + + res(jpoint) = 0.5d0 * r12 / (1.d0 + a_boys * r12) + enddo + + else + + print *, ' Error in j12_r1_seq: Unknown j2e_type = ', j2e_type + stop + + endif ! j2e_type return end diff --git a/plugins/local/non_h_ints_mu/tc_integ_num.irp.f b/plugins/local/non_h_ints_mu/tc_integ_num.irp.f index bc31ee91..6b6e755d 100644 --- a/plugins/local/non_h_ints_mu/tc_integ_num.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ_num.irp.f @@ -6,7 +6,7 @@ BEGIN_DOC ! - ! int2_grad1_u12_ao_num(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) + ! int2_grad1_u12_ao_num(i,j,ipoint,:) = \int dr2 [\grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) ! ! int2_grad1_u12_square_ao_num = -(1/2) x int dr2 chi_l(r2) chi_j(r2) [grad_1 u(r1,r2)]^2 ! @@ -73,10 +73,10 @@ !$OMP DO do i_blocks = 1, n_blocks ipoint = ii - 1 + i_blocks ! r1 - call get_grad1_u12_withsq_r1_seq(final_grid_points(1,ipoint), n_points_extra_final_grid, tmp_grad1_u12(1,i_blocks,1) & - , tmp_grad1_u12(1,i_blocks,2) & - , tmp_grad1_u12(1,i_blocks,3) & - , tmp_grad1_u12_squared(1,i_blocks)) + call get_grad1_u12_withsq_r1_seq(ipoint, n_points_extra_final_grid, tmp_grad1_u12(1,i_blocks,1) & + , tmp_grad1_u12(1,i_blocks,2) & + , tmp_grad1_u12(1,i_blocks,3) & + , tmp_grad1_u12_squared(1,i_blocks)) enddo !$OMP END DO !$OMP END PARALLEL @@ -109,10 +109,10 @@ !$OMP DO do i_rest = 1, n_rest ipoint = ii - 1 + i_rest ! r1 - call get_grad1_u12_withsq_r1_seq(final_grid_points(1,ipoint), n_points_extra_final_grid, tmp_grad1_u12(1,i_rest,1) & - , tmp_grad1_u12(1,i_rest,2) & - , tmp_grad1_u12(1,i_rest,3) & - , tmp_grad1_u12_squared(1,i_rest)) + call get_grad1_u12_withsq_r1_seq(ipoint, n_points_extra_final_grid, tmp_grad1_u12(1,i_rest,1) & + , tmp_grad1_u12(1,i_rest,2) & + , tmp_grad1_u12(1,i_rest,3) & + , tmp_grad1_u12_squared(1,i_rest)) enddo !$OMP END DO !$OMP END PARALLEL @@ -144,7 +144,7 @@ END_PROVIDER BEGIN_DOC ! - ! int2_grad1_u12_ao_num_1shot(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) + ! int2_grad1_u12_ao_num_1shot(i,j,ipoint,:) = \int dr2 [\grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) ! ! int2_grad1_u12_square_ao_num_1shot = -(1/2) x int dr2 chi_l(r2) chi_j(r2) [grad_1 u(r1,r2)]^2 ! @@ -178,9 +178,7 @@ END_PROVIDER !$OMP END PARALLEL do m = 1, 3 - !call dgemm( "T", "N", ao_num*ao_num, n_points_final_grid, n_points_extra_final_grid, -1.d0 & - ! this work also because of the symmetry in K(1,2) and sign compensation in L(1,2,3) - call dgemm( "T", "N", ao_num*ao_num, n_points_final_grid, n_points_extra_final_grid, +1.d0 & + call dgemm( "T", "N", ao_num*ao_num, n_points_final_grid, n_points_extra_final_grid, 1.d0 & , tmp(1,1,1), n_points_extra_final_grid, grad1_u12_num(1,1,m), n_points_extra_final_grid & , 0.d0, int2_grad1_u12_ao_num_1shot(1,1,1,m), ao_num*ao_num) enddo From 9b2ba694d9e7f71801c5dac7c8073c06d8605b47 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Wed, 24 Jan 2024 19:25:17 +0100 Subject: [PATCH 84/84] Improved AosxAos representations of 1e-Jastrow --- plugins/local/jastrow/README.md | 5 +- plugins/local/non_h_ints_mu/jast_1e.irp.f | 195 +++++++++--------- .../local/non_h_ints_mu/jast_1e_utils.irp.f | 93 ++++----- 3 files changed, 149 insertions(+), 144 deletions(-) diff --git a/plugins/local/jastrow/README.md b/plugins/local/jastrow/README.md index 22486edd..67898e23 100644 --- a/plugins/local/jastrow/README.md +++ b/plugins/local/jastrow/README.md @@ -65,5 +65,8 @@ are defined by the tables `j1e_coef` and `j1e_expo`, respectively.

-- if `j1e_type` is **Charge_Harmonizer_AO**: The one-electron Jastrow factor **Charge_Harmonizer** is fitted by the atomic orbitals +- if `j1e_type` is **Charge_Harmonizer_AO**: The one-electron Jastrow factor **Charge_Harmonizer** is fitted by the product of atomic orbitals: +

+ +

diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f index 37ac0092..fbd032ed 100644 --- a/plugins/local/non_h_ints_mu/jast_1e.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -231,96 +231,22 @@ END_PROVIDER ! !$OMP END PARALLEL ! ! deallocate(coef_fit) -! -! elseif(j1e_type .eq. "Charge_Harmonizer_AO2") then -! -! ! \grad_1 \sum_{\eta,\beta} C_{\eta,\beta} \chi_{\eta} \chi_{\beta} -! ! where -! ! \chi_{\eta} are the AOs -! ! C_{\eta,\beta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") -! ! -! ! The - sign is in the parameters C_{\eta,\beta} -! -! PROVIDE aos_grad_in_r_array -! -! allocate(coef_fit2(ao_num*ao_num)) -! -! if(mpi_master) then -! call ezfio_has_jastrow_j1e_coef_ao2(exists) -! endif -! IRP_IF MPI_DEBUG -! print *, irp_here, mpi_rank -! call MPI_BARRIER(MPI_COMM_WORLD, ierr) -! IRP_ENDIF -! IRP_IF MPI -! call MPI_BCAST(coef_fit2, ao_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) -! if (ierr /= MPI_SUCCESS) then -! stop 'Unable to read j1e_coef_ao2 with MPI' -! endif -! IRP_ENDIF -! if(exists) then -! if(mpi_master) then -! write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao2 ] <<<<< ..' -! call ezfio_get_jastrow_j1e_coef_ao2(coef_fit2) -! IRP_IF MPI -! call MPI_BCAST(coef_fit2, ao_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) -! if (ierr /= MPI_SUCCESS) then -! stop 'Unable to read j1e_coef_ao2 with MPI' -! endif -! IRP_ENDIF -! endif -! else -! -! call get_j1e_coef_fit_ao2(ao_num*ao_num, coef_fit2) -! call ezfio_set_jastrow_j1e_coef_ao2(coef_fit2) -! -! endif -! -! !$OMP PARALLEL & -! !$OMP DEFAULT (NONE) & -! !$OMP PRIVATE (i, j, ij, ipoint, c) & -! !$OMP SHARED (n_points_final_grid, ao_num, & -! !$OMP aos_grad_in_r_array, coef_fit2, & -! !$OMP aos_in_r_array, j1e_gradx, j1e_grady, j1e_gradz) -! !$OMP DO SCHEDULE (static) -! do ipoint = 1, n_points_final_grid -! -! j1e_gradx(ipoint) = 0.d0 -! j1e_grady(ipoint) = 0.d0 -! j1e_gradz(ipoint) = 0.d0 -! -! do i = 1, ao_num -! do j = 1, ao_num -! ij = (i-1)*ao_num + j -! -! c = coef_fit2(ij) -! -! j1e_gradx(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,1) + aos_grad_in_r_array(i,ipoint,1) * aos_in_r_array(j,ipoint)) -! j1e_grady(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,2) + aos_grad_in_r_array(i,ipoint,2) * aos_in_r_array(j,ipoint)) -! j1e_gradz(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,3) + aos_grad_in_r_array(i,ipoint,3) * aos_in_r_array(j,ipoint)) -! enddo -! enddo -! enddo -! !$OMP END DO -! !$OMP END PARALLEL -! -! deallocate(coef_fit2) elseif(j1e_type .eq. "Charge_Harmonizer_AO") then - ! \sum_{\eta} \vec{C}_{\eta} \chi_{\eta} + ! \grad_1 \sum_{\eta,\beta} C_{\eta,\beta} \chi_{\eta} \chi_{\beta} ! where ! \chi_{\eta} are the AOs - ! \vec{C}_{\eta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") + ! C_{\eta,\beta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") ! - ! The - sign is in the parameters \vec{C}_{\eta} + ! The - sign is in the parameters C_{\eta,\beta} PROVIDE aos_grad_in_r_array - allocate(coef_fit3(ao_num,3)) + allocate(coef_fit2(ao_num*ao_num)) if(mpi_master) then - call ezfio_has_jastrow_j1e_coef_ao3(exists) + call ezfio_has_jastrow_j1e_coef_ao2(exists) endif IRP_IF MPI_DEBUG print *, irp_here, mpi_rank @@ -328,34 +254,34 @@ END_PROVIDER IRP_ENDIF IRP_IF MPI include 'mpif.h' - call MPI_BCAST(coef_fit3, (ao_num*3), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(coef_fit2, ao_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1e_coef_ao3 with MPI' + stop 'Unable to read j1e_coef_ao2 with MPI' endif IRP_ENDIF if(exists) then if(mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao3 ] <<<<< ..' - call ezfio_get_jastrow_j1e_coef_ao3(coef_fit3) + write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao2 ] <<<<< ..' + call ezfio_get_jastrow_j1e_coef_ao2(coef_fit2) IRP_IF MPI - call MPI_BCAST(coef_fit3, (ao_num*3), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(coef_fit2, ao_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1e_coef_ao3 with MPI' + stop 'Unable to read j1e_coef_ao2 with MPI' endif IRP_ENDIF endif else - call get_j1e_coef_fit_ao3(ao_num, coef_fit3) - call ezfio_set_jastrow_j1e_coef_ao3(coef_fit3) + call get_j1e_coef_fit_ao2(ao_num*ao_num, coef_fit2) + call ezfio_set_jastrow_j1e_coef_ao2(coef_fit2) endif !$OMP PARALLEL & !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, ipoint, cx, cy, cz) & + !$OMP PRIVATE (i, j, ij, ipoint, c) & !$OMP SHARED (n_points_final_grid, ao_num, & - !$OMP aos_grad_in_r_array, coef_fit3, & + !$OMP aos_grad_in_r_array, coef_fit2, & !$OMP aos_in_r_array, j1e_gradx, j1e_grady, j1e_gradz) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid @@ -363,20 +289,95 @@ END_PROVIDER j1e_gradx(ipoint) = 0.d0 j1e_grady(ipoint) = 0.d0 j1e_gradz(ipoint) = 0.d0 - do i = 1, ao_num - cx = coef_fit3(i,1) - cy = coef_fit3(i,2) - cz = coef_fit3(i,3) - j1e_gradx(ipoint) += cx * aos_in_r_array(i,ipoint) - j1e_grady(ipoint) += cy * aos_in_r_array(i,ipoint) - j1e_gradz(ipoint) += cz * aos_in_r_array(i,ipoint) + do i = 1, ao_num + do j = 1, ao_num + ij = (i-1)*ao_num + j + + c = coef_fit2(ij) + + j1e_gradx(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,1) + aos_grad_in_r_array(i,ipoint,1) * aos_in_r_array(j,ipoint)) + j1e_grady(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,2) + aos_grad_in_r_array(i,ipoint,2) * aos_in_r_array(j,ipoint)) + j1e_gradz(ipoint) += c * (aos_in_r_array(i,ipoint) * aos_grad_in_r_array(j,ipoint,3) + aos_grad_in_r_array(i,ipoint,3) * aos_in_r_array(j,ipoint)) + enddo enddo enddo !$OMP END DO !$OMP END PARALLEL - deallocate(coef_fit3) + deallocate(coef_fit2) + +! elseif(j1e_type .eq. "Charge_Harmonizer_AO3") then +! +! ! \sum_{\eta} \vec{C}_{\eta} \chi_{\eta} +! ! where +! ! \chi_{\eta} are the AOs +! ! \vec{C}_{\eta} are fitted to mimic (j1e_type .eq. "Charge_Harmonizer") +! ! +! ! The - sign is in the parameters \vec{C}_{\eta} +! +! PROVIDE aos_grad_in_r_array +! +! allocate(coef_fit3(ao_num,3)) +! +! if(mpi_master) then +! call ezfio_has_jastrow_j1e_coef_ao3(exists) +! endif +! IRP_IF MPI_DEBUG +! print *, irp_here, mpi_rank +! call MPI_BARRIER(MPI_COMM_WORLD, ierr) +! IRP_ENDIF +! IRP_IF MPI +! !include 'mpif.h' +! call MPI_BCAST(coef_fit3, (ao_num*3), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read j1e_coef_ao3 with MPI' +! endif +! IRP_ENDIF +! if(exists) then +! if(mpi_master) then +! write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef_ao3 ] <<<<< ..' +! call ezfio_get_jastrow_j1e_coef_ao3(coef_fit3) +! IRP_IF MPI +! call MPI_BCAST(coef_fit3, (ao_num*3), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read j1e_coef_ao3 with MPI' +! endif +! IRP_ENDIF +! endif +! else +! +! call get_j1e_coef_fit_ao3(ao_num, coef_fit3) +! call ezfio_set_jastrow_j1e_coef_ao3(coef_fit3) +! +! endif +! +! !$OMP PARALLEL & +! !$OMP DEFAULT (NONE) & +! !$OMP PRIVATE (i, ipoint, cx, cy, cz) & +! !$OMP SHARED (n_points_final_grid, ao_num, & +! !$OMP aos_grad_in_r_array, coef_fit3, & +! !$OMP aos_in_r_array, j1e_gradx, j1e_grady, j1e_gradz) +! !$OMP DO SCHEDULE (static) +! do ipoint = 1, n_points_final_grid +! +! j1e_gradx(ipoint) = 0.d0 +! j1e_grady(ipoint) = 0.d0 +! j1e_gradz(ipoint) = 0.d0 +! do i = 1, ao_num +! cx = coef_fit3(i,1) +! cy = coef_fit3(i,2) +! cz = coef_fit3(i,3) +! +! j1e_gradx(ipoint) += cx * aos_in_r_array(i,ipoint) +! j1e_grady(ipoint) += cy * aos_in_r_array(i,ipoint) +! j1e_gradz(ipoint) += cz * aos_in_r_array(i,ipoint) +! enddo +! enddo +! !$OMP END DO +! !$OMP END PARALLEL +! +! deallocate(coef_fit3) else diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f index 9dc0d5b0..842908a7 100644 --- a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -80,24 +80,33 @@ subroutine get_j1e_coef_fit_ao(dim_fit, coef_fit) allocate(A_inv(ao_num,ao_num)) call get_inverse(A, ao_num, ao_num, A_inv, ao_num) - deallocate(A) ! coef_fit = A_inv x b call dgemv("N", ao_num, ao_num, 1.d0, A_inv, ao_num, b, 1, 0.d0, coef_fit, 1) - !integer :: j, k - !double precision :: tmp - !print *, ' check A_inv' - !do i = 1, ao_num - ! tmp = 0.d0 - ! do j = 1, ao_num - ! tmp += ao_overlap(i,j) * coef_fit(j) - ! enddo - ! tmp = tmp - b(i) - ! print*, i, tmp - !enddo + integer :: j + double precision :: tmp, acc, nrm - deallocate(A_inv, b) + acc = 0.d0 + nrm = 0.d0 + print *, ' check A_inv' + do i = 1, ao_num + tmp = 0.d0 + do j = 1, ao_num + tmp += ao_overlap(i,j) * coef_fit(j) + enddo + tmp = tmp - b(i) + if(dabs(tmp) .gt. 1d-8) then + print*, ' problem found in fitting 1e-Jastrow' + print*, i, tmp + endif + + acc += dabs(tmp) + nrm += dabs(b(i)) + enddo + print *, ' Relative Error (%) =', 100.d0*acc/nrm + + deallocate(A, A_inv, b) call wall_time(t1) print*, ' END after (min) ', (t1-t0)/60.d0 @@ -128,7 +137,7 @@ subroutine get_j1e_coef_fit_ao2(dim_fit, coef_fit) PROVIDE mo_coef call wall_time(t0) - print*, ' PROVIDING the representation of 1e-Jastrow in AOs x AOx ... ' + print*, ' PROVIDING the representation of 1e-Jastrow in AOs x AOs ... ' ! --- --- --- ! get u1e(r) @@ -188,10 +197,10 @@ subroutine get_j1e_coef_fit_ao2(dim_fit, coef_fit) !$OMP END DO !$OMP END PARALLEL - print *, ' A' - do ij = 1, ao_num*ao_num - write(*, '(100000(f15.7))') (A(ij,kl), kl = 1, ao_num*ao_num) - enddo +! print *, ' A' +! do ij = 1, ao_num*ao_num +! write(*, '(100000(f15.7))') (A(ij,kl), kl = 1, ao_num*ao_num) +! enddo ! --- --- --- ! get b @@ -223,44 +232,35 @@ subroutine get_j1e_coef_fit_ao2(dim_fit, coef_fit) ! solve Ax = b allocate(A_inv(ao_num*ao_num,ao_num*ao_num)) - call get_inverse(A, ao_num*ao_num, ao_num*ao_num, A_inv, ao_num*ao_num) - - integer :: mn - print *, ' check A_inv' - do ij = 1, ao_num*ao_num - do kl = 1, ao_num*ao_num - - tmp = 0.d0 - do mn = 1, ao_num*ao_num - tmp += A(ij,mn) * A_inv(mn,kl) - enddo - - print*, ij, kl, tmp - enddo - enddo + !call get_inverse(A, ao_num*ao_num, ao_num*ao_num, A_inv, ao_num*ao_num) + call get_pseudo_inverse(A, ao_num*ao_num, ao_num*ao_num, ao_num*ao_num, A_inv, ao_num*ao_num, 5d-8) ! coef_fit = A_inv x b - !call dgemv("N", ao_num*ao_num, ao_num*ao_num, 1.d0, A_inv, ao_num*ao_num, b, 1, 0.d0, coef_fit(1,1), 1) - do ij = 1, ao_num*ao_num - coef_fit(ij) = 0.d0 - do kl = 1, ao_num*ao_num - coef_fit(ij) += A_inv(ij,kl) * b(kl) - enddo - enddo + call dgemv("N", ao_num*ao_num, ao_num*ao_num, 1.d0, A_inv, ao_num*ao_num, b, 1, 0.d0, coef_fit, 1) - double precision :: tmp - print *, ' check A_inv' + integer :: mn + double precision :: tmp, acc, nrm + + acc = 0.d0 + nrm = 0.d0 do ij = 1, ao_num*ao_num tmp = 0.d0 do kl = 1, ao_num*ao_num tmp += A(ij,kl) * coef_fit(kl) enddo tmp = tmp - b(ij) - print*, ij, tmp - enddo + if(dabs(tmp) .gt. 1d-7) then + print*, ' problem found in fitting 1e-Jastrow' + print*, ij, tmp + endif - deallocate(A) - deallocate(A_inv, b) + acc += dabs(tmp) + nrm += dabs(b(ij)) + enddo + print *, ' Relative Error (%) =', 100.d0*acc/nrm + + + deallocate(A, A_inv, b) call wall_time(t1) print*, ' END after (min) ', (t1-t0)/60.d0 @@ -373,6 +373,7 @@ subroutine get_j1e_coef_fit_ao3(dim_fit, coef_fit) enddo tmp = tmp - b(i,d) if(dabs(tmp) .gt. 1d-8) then + print*, ' problem found in fitting 1e-Jastrow' print*, d, i, tmp endif