From d9cfebba5070cc37a609033389a6231b51a6af0f Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 6 Dec 2021 15:32:24 +0100 Subject: [PATCH 01/29] Added chameleon support. --- configure.ac | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/configure.ac b/configure.ac index fa3277d..8d432c7 100644 --- a/configure.ac +++ b/configure.ac @@ -105,6 +105,52 @@ AC_CHECK_LIB([pthread], [pthread_create]) # CFLAGS="${CFLAGS} ${OPENMP_CFLAGS}" #fi +# CHAMELEON +AC_ARG_WITH(chameleon, + AS_HELP_STRING([--without-chameleon], + [Do not use Chameleon. Default: auto-detect]), [ +case "$with_chameleon" in + no) + : ;; + yes) + PKG_CHECK_MODULES([LIBCHAMELEON],[chameleon >= 1.0.0], + [PKG_CFLAGS="$PKG_CFLAGS $LIBCHAMELEON_CFLAGS" + PKG_LIBS="$PKG_LIBS $LIBCHAMELEON_LIBS"] + ,[ + + ## something went wrong. + ## try to find the package without pkg-config + + ## check that the library is actually new enough. + ## by testing for a 1.0.0+ function which we use + AC_CHECK_LIB(chameleon,CHAMELEON_finalize,[LIBCHAMELEON_LIBS="-lchameleon"]) + ]) + AH_TEMPLATE(HAVE_CHAMELEON,[Chameleon support is available]) + ;; + *) + if test ! -d "$withval" ; then + AC_MSG_ERROR([--with-chameleon path does not point to a directory]) + fi + LIBCHAMELEON_LIBS="-L$with_chameleon/lib -lchameleon -lchameleon_starpu -lhqr -lcoreblas" + LIBCHAMELEON_CFLAGS="-I$with_chameleon/include $CFLAGS" + LIBCHAMELEON_CPPFLAGS="-I$with_chameleon/include $CPPFLAGS" + esac +]) + +if test "x$LIBCHAMELEON_LIBS" != "x" ; then + LIBS="$LIBS $LIBCHAMELEON_LIBS" + CFLAGS="$CFLAGS $LIBCHAMELEON_CFLAGS" + CPPFLAGS="$CPPFLAGS $LIBCHAMELEON_CPPFLAGS" + AC_CHECK_HEADERS([chameleon.h], [], [AC_MSG_ERROR("chamelon.h not found")]) + AC_DEFINE_UNQUOTED([HAVE_CHAMELEON],1,[CHAMELEON support is available]) +fi + +#AS_IF([test "x$with_chameleon" != "xno"], [ +#]) + +AC_MSG_NOTICE([CHAMELEON library support: ${with_CHAMELEON:=auto} ${LIBCHAMELEON_PATH} ${LIBCHAMELEON_LIBS}]) + + # TREXIO AC_ARG_WITH(trexio, [AS_HELP_STRING([--without-trexio],[disable support for TREXIO])], @@ -280,6 +326,7 @@ FC..............: ${FC} FCLAGS..........: ${FCFLAGS} LDFLAGS:........: ${LDFLAGS} LIBS............: ${LIBS} +USE CHAMELEON...: ${with_chameleon} Package features: ${ARGS} From e8a7b1a3f6dc6bcc68315043506b4c027cb390c9 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 27 Jan 2022 16:35:39 +0100 Subject: [PATCH 02/29] compute_asymp_jasb started. --- org/qmckl_jastrow.org | 44 ++++++++++++++++--------------------------- 1 file changed, 16 insertions(+), 28 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index ad6826f..17fa2b8 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -13,7 +13,6 @@ these factors along with their derivatives. (org-babel-lob-ingest "../tools/lib.org") #+end_src - #+begin_src c :tangle (eval h_private_func) #ifndef QMCKL_JASTROW_HPF #define QMCKL_JASTROW_HPF @@ -1328,48 +1327,37 @@ integer function qmckl_compute_asymp_jasb_f(context, bord_num, bord_vector, resc x = x * kappa_inv asymp_jasb(i) = asymp_jasb(i) + bord_vector(p + 1) * x end do - end do + end function qmckl_compute_asymp_jasb_f #+end_src +#+begin_src c :tangle (eval c) +qmckl_exit_code qmckl_compute_asymp_jasb ( + const qmckl_context context, + const int64_t bord_num, + const double* bord_vector, + const double rescale_factor_kappa_ee, + double* const asymp_jasb ) { + // Put some code here + + return QMCKL_SUCCESS; +} // end function qmckl_exit_code +#+end_src + #+CALL: generate_c_header(table=qmckl_asymp_jasb_args,rettyp=get_value("CRetType"),fname=get_value("Name")) #+RESULTS: - #+BEGIN_src c :tangle (eval h_func) :comments org + #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_asymp_jasb ( const qmckl_context context, const int64_t bord_num, const double* bord_vector, const double rescale_factor_kappa_ee, double* const asymp_jasb ); - #+END_src + #+end_src - #+CALL: generate_c_interface(table=qmckl_asymp_jasb_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+BEGIN_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_asymp_jasb & - (context, bord_num, bord_vector, rescale_factor_kappa_ee, asymp_jasb) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: bord_num - real (c_double ) , intent(in) :: bord_vector(bord_num + 1) - real (c_double ) , intent(in) , value :: rescale_factor_kappa_ee - real (c_double ) , intent(out) :: asymp_jasb(2) - - integer(c_int32_t), external :: qmckl_compute_asymp_jasb_f - info = qmckl_compute_asymp_jasb_f & - (context, bord_num, bord_vector, rescale_factor_kappa_ee, asymp_jasb) - - end function qmckl_compute_asymp_jasb - #+END_src - *** Test #+name: asymp_jasb #+begin_src python :results output :exports none :noweb yes From 158c2afb411646699ce27309a1c862f32afa5703 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 27 Jan 2022 16:38:28 +0100 Subject: [PATCH 03/29] Fixed edits. --- org/qmckl_jastrow.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 17fa2b8..0beaaa1 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -1327,7 +1327,7 @@ integer function qmckl_compute_asymp_jasb_f(context, bord_num, bord_vector, resc x = x * kappa_inv asymp_jasb(i) = asymp_jasb(i) + bord_vector(p + 1) * x end do - + end do end function qmckl_compute_asymp_jasb_f #+end_src From eb34535d22f1eeb0d7eefa8b0d9f9ef82a9f90d1 Mon Sep 17 00:00:00 2001 From: Evgeny Posenitskiy <45995097+q-posev@users.noreply.github.com> Date: Tue, 1 Feb 2022 14:21:29 +0100 Subject: [PATCH 04/29] Test QMCkl with the latest TREXIO + MacOS CI (#58) * FIX: update the metadata group of the TREXIO file This change is required to make `test_qmckl_trexio` pass with the recent additions to the TREXIO (see `unsafe` attribute of the metadata group). * Install the latest TREXIO in GH actions * Enable CI test on MacOS * Fix TREXIO installation on MacOS * Update TREXIO pkg-config path * Change PKG_CONFIG_PATH * Fix F77 issue of autoconf * Disable useless F77 check --- .github/workflows/test-build.yml | 108 +++++++++++++-------- configure.ac | 1 - share/qmckl/test_data/chbrclf/metadata.txt | 3 +- 3 files changed, 68 insertions(+), 44 deletions(-) diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index e49d444..a4dd421 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -18,70 +18,94 @@ jobs: - name: Install dependencies run: sudo apt-get install emacs autoconf libhdf5-dev - - name: Install trexio + #- name: Install trexio from the distribution tarball + # run: | + # export TAG=v2.1.0 + # export VERSION=2.1.0 + # wget https://github.com/TREX-CoE/trexio/releases/download/${TAG}/trexio-${VERSION}.tar.gz + # tar -zxf trexio-${VERSION}.tar.gz + # cd trexio-${VERSION} + # ./configure --prefix=/usr + # make -j 4 + # sudo make install + - name: Install the latest TREXIO from the GitHub clone run: | - export TAG=v2.1.0 - export VERSION=2.1.0 - wget https://github.com/TREX-CoE/trexio/releases/download/${TAG}/trexio-${VERSION}.tar.gz - tar -zxf trexio-${VERSION}.tar.gz - cd trexio-${VERSION} + git clone https://github.com/TREX-CoE/trexio.git + cd trexio + ./autogen.sh ./configure --prefix=/usr - make -j 8 + make -j 4 sudo make install - - name: Build + - name: Build QMCkl run: | ./autogen.sh ./configure --enable-silent-rules --enable-debug - make -j 8 + make -j 4 - name: Run test - run: | - make -j check + run: make -j 4 check - name: Archive test log file if: failure() uses: actions/upload-artifact@v2 with: - name: test-report + name: test-report-ubuntu path: test-suite.log - name: Dist test - run: | - make distcheck + run: make distcheck - name: Archive test log file if: failure() uses: actions/upload-artifact@v2 with: - name: dist-report + name: dist-report-ubuntu path: test-suite.log + x86_macos: -# x86_macos: -# -# runs-on: macos-latest -# name: x86 MacOS latest -# -# steps: -# - uses: actions/checkout@v2 -# - name: install dependencies -# run: | -# brew install gfortran-10 -# brew install emacs -# brew install autoconf automake libtool -# - name: install trexio -# run: | -# wget https://github.com/TREX-CoE/trexio/releases/download/v1.0/trexio-1.0.0.tar.gz -# tar -zxf trexio-1.0.0.tar.gz -# cd trexio-1.0.0 -# ./configure -# make -j 8 -# sudo make install -# - name: Run test -# run: | -# ./autogen.sh -# ./configure --enable-silent-rules --enable-debug -# make -j 8 -# make -j check -# make distcheck + runs-on: macos-latest + name: x86 MacOS latest + + steps: + - uses: actions/checkout@v2 + - name: install dependencies + run: brew install emacs hdf5 automake pkg-config + + - name: Symlink gfortran (macOS) + if: runner.os == 'macOS' + run: | + # make sure gfortran is available + # https://github.com/actions/virtual-environments/issues/2524 + # https://github.com/cbg-ethz/dce/blob/master/.github/workflows/pkgdown.yaml + sudo ln -s /usr/local/bin/gfortran-10 /usr/local/bin/gfortran + sudo mkdir /usr/local/gfortran + sudo ln -s /usr/local/Cellar/gcc@10/*/lib/gcc/10 /usr/local/gfortran/lib + gfortran --version + + - name: Install the latest TREXIO from the GitHub clone + run: | + git clone https://github.com/TREX-CoE/trexio.git + cd trexio + ./autogen.sh + ./configure --prefix=${PWD}/_install --enable-silent-rules + make -j 4 + make install + + - name: Build QMCkl + run: | + export PKG_CONFIG_PATH=${PWD}/trexio/_install/lib/pkgconfig:$PKG_CONFIG_PATH + ./autogen.sh + ./configure --enable-silent-rules --enable-debug + make -j 4 + + - name: Run test + run: make -j 4 check + + - name: Archive test log file + if: failure() + uses: actions/upload-artifact@v2 + with: + name: test-report-macos + path: test-suite.log diff --git a/configure.ac b/configure.ac index 3e0b83e..1f58783 100644 --- a/configure.ac +++ b/configure.ac @@ -75,7 +75,6 @@ AC_PROG_CC m4_version_prereq([2.70],[], [AC_PROG_CC_C99]) AS_IF([test "$ac_cv_prog_cc_c99" = "no"], [AC_MSG_ERROR([The compiler does not support C99])]) AC_PROG_CC_C_O -AC_PROG_F77 AC_PROG_FC AC_PROG_FC_C_O AC_FC_SRCEXT([f90]) diff --git a/share/qmckl/test_data/chbrclf/metadata.txt b/share/qmckl/test_data/chbrclf/metadata.txt index 834b9f7..b2f0327 100644 --- a/share/qmckl/test_data/chbrclf/metadata.txt +++ b/share/qmckl/test_data/chbrclf/metadata.txt @@ -2,9 +2,10 @@ rank_metadata_code 0 rank_metadata_author 0 metadata_code_num_isSet 0 metadata_author_num_isSet 0 +metadata_unsafe_isSet 0 len_metadata_package_version 6 metadata_package_version -2.0.0 +2.2.0 len_metadata_description 0 metadata_description metadata_code From f6f346d5117b040647e95cba8284a2f3fc1fcd6c Mon Sep 17 00:00:00 2001 From: Gianfranco Abrusci Date: Wed, 2 Feb 2022 16:37:26 +0100 Subject: [PATCH 05/29] seg fault at qmckl_compute_asymp_jasb --- org/qmckl_jastrow.org | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 0beaaa1..15223ea 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -1340,8 +1340,36 @@ qmckl_exit_code qmckl_compute_asymp_jasb ( const double rescale_factor_kappa_ee, double* const asymp_jasb ) { // Put some code here + int64_t i, p, info; + double kappa_inv, x, asym_one; - return QMCKL_SUCCESS; + kappa_inv = 1.0/ rescale_factor_kappa_ee; + + info = QMCKL_SUCCESS; + + if (context == QMCKL_NULL_CONTEXT){ + info = QMCKL_INVALID_CONTEXT; + return info; + } + + if (bord_num <= 0) { + info = QMCKL_INVALID_ARG_2; + return info; + } + asym_one = bord_vector[0] * kappa_inv / (1.0 + bord_vector[1] * kappa_inv); + asymp_jasb[0] = asym_one; + asymp_jasb[1] = 0.5 * asym_one; + + for (int i=0; i<=1; ++i) { + x = kappa_inv; + + for (int p = 1; p < bord_num-1; ++i){ + x = x * kappa_inv; + asymp_jasb[i] = asymp_jasb[i] + bord_vector[p + 1] * x; + } + } + + return info; } // end function qmckl_exit_code #+end_src From 67f80532f99f371967c8934d98fee2f3df676ea6 Mon Sep 17 00:00:00 2001 From: Gianfranco Abrusci Date: Wed, 2 Feb 2022 18:21:40 +0100 Subject: [PATCH 06/29] still failing --- org/qmckl_jastrow.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 15223ea..7c37818 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -1340,7 +1340,7 @@ qmckl_exit_code qmckl_compute_asymp_jasb ( const double rescale_factor_kappa_ee, double* const asymp_jasb ) { // Put some code here - int64_t i, p, info; + int64_t info; double kappa_inv, x, asym_one; kappa_inv = 1.0/ rescale_factor_kappa_ee; @@ -1363,7 +1363,7 @@ qmckl_exit_code qmckl_compute_asymp_jasb ( for (int i=0; i<=1; ++i) { x = kappa_inv; - for (int p = 1; p < bord_num-1; ++i){ + for (int p = 1; p < bord_num; ++i){ x = x * kappa_inv; asymp_jasb[i] = asymp_jasb[i] + bord_vector[p + 1] * x; } From 6a0c54f48c4df59ec8481a6239c027a0f6b64e7c Mon Sep 17 00:00:00 2001 From: Gianfranco Abrusci Date: Thu, 3 Feb 2022 11:40:54 +0100 Subject: [PATCH 07/29] fixed seg fault: incremented wrong counter --- org/qmckl_jastrow.org | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 7c37818..c70ef9f 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -1332,45 +1332,40 @@ integer function qmckl_compute_asymp_jasb_f(context, bord_num, bord_vector, resc end function qmckl_compute_asymp_jasb_f #+end_src -#+begin_src c :tangle (eval c) +#+begin_src c :comments org :tangle (eval c) :noweb yes qmckl_exit_code qmckl_compute_asymp_jasb ( const qmckl_context context, const int64_t bord_num, const double* bord_vector, const double rescale_factor_kappa_ee, double* const asymp_jasb ) { - // Put some code here - int64_t info; + // What is wrong here? double kappa_inv, x, asym_one; - kappa_inv = 1.0/ rescale_factor_kappa_ee; - - info = QMCKL_SUCCESS; + kappa_inv = 1.0 / rescale_factor_kappa_ee; if (context == QMCKL_NULL_CONTEXT){ - info = QMCKL_INVALID_CONTEXT; - return info; + return QMCKL_INVALID_CONTEXT; } if (bord_num <= 0) { - info = QMCKL_INVALID_ARG_2; - return info; + return QMCKL_INVALID_ARG_2; } + asym_one = bord_vector[0] * kappa_inv / (1.0 + bord_vector[1] * kappa_inv); asymp_jasb[0] = asym_one; asymp_jasb[1] = 0.5 * asym_one; - for (int i=0; i<=1; ++i) { + for (int i = 0 ; i <= 1; ++i) { x = kappa_inv; - - for (int p = 1; p < bord_num; ++i){ + for (int p = 1; p < bord_num; ++p){ x = x * kappa_inv; asymp_jasb[i] = asymp_jasb[i] + bord_vector[p + 1] * x; } } - return info; -} // end function qmckl_exit_code + return QMCKL_SUCCESS; +} #+end_src #+CALL: generate_c_header(table=qmckl_asymp_jasb_args,rettyp=get_value("CRetType"),fname=get_value("Name")) From 484c0a7d5c338da65211cd20537856b14a33b616 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 9 Feb 2022 14:37:38 +0100 Subject: [PATCH 08/29] Documentation of Jastrow --- org/qmckl_distance.org | 2 +- org/qmckl_jastrow.org | 170 ++++++++++++++++++++++++++--------------- 2 files changed, 110 insertions(+), 62 deletions(-) diff --git a/org/qmckl_distance.org b/org/qmckl_distance.org index 918d176..6d3900e 100644 --- a/org/qmckl_distance.org +++ b/org/qmckl_distance.org @@ -872,7 +872,7 @@ end function test_qmckl_dist pairs of points in two sets, one point within each set: \[ - C_{ij} = \left( 1 - \exp{-\kappa C_{ij}}\right)/\kappa + C_{ij} = \left( 1 - \exp \left(-\kappa C_{ij} \right) \right)/\kappa \] If the input array is normal (~'N'~), the xyz coordinates are in diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 0d92e00..a7675a5 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -3,10 +3,61 @@ #+SETUPFILE: ../tools/theme.setup #+INCLUDE: ../tools/lib.org -Functions for the calculation of the Jastrow factor \(f_{ee}, f_{en}, f_{een}\). -These are stored in the ~factor_ee~, ~factor_en~, and ~factor_een~ variables. -The ~jastrow~ structure contains all the information required to build -these factors along with their derivatives. +* Introduction + + The Jastrow factor depends on the electronic ($\mathbf{r}$) and + nuclear ($\mathbf{R}$) coordinates. Its defined as $\exp(J(\mathbf{r},\mathbf{R}))$, where + + \[ + J(\mathbf{r},\mathbf{R}) = J_{\text{eN}}(\mathbf{r},\mathbf{R}) + J_{\text{ee}}(\mathbf{r}) + J_{\text{eeN}}(\mathbf{r},\mathbf{R}) + \] + + In the following, we us the notations $r_{ij} = |\mathbf{r}_i - \mathbf{r}_j|$ and + $R_{i\alpha} = |\mathbf{r}_i - \mathbf{R}_\alpha|$. + + $J_{\text{eN}}$ contains electron-nucleus terms: + + \[ + J_{\text{eN}}(\mathbf{r},\mathbf{R}) = \sum_{i=1}^{N_\text{elec}} \sum_{\alpha=1}^{N_\text{nucl}} + \frac{a_1\, f(R_{i\alpha})}{1+a_2\, f(R_{i\alpha})} + + \sum_{p=2}^{N_\text{ord}^a} a_{p+1}\, [f(R_{i\alpha})]^p - J_{eN}^\infty + \] + + $J_{\text{ee}}$ contains electron-electron terms: + \[ + J_{\text{ee}}(\mathbf{r}) = + \sum_{i=1}^{N_\text{elec}} \sum_{j=1}^{i-1} + \frac{b_1\, f(r_{ij})}{1+b_2\, f(r_{ij})} + + \sum_{p=2}^{N_\text{ord}^b} a_{p+1}\, [f(r_{ij})]^p - J_{ee}^\infty + \] + + and $J_{\text{eeN}}$ contains electron-electron-Nucleus terms: + + \[ + J_{\text{eeN}}(\mathbf{r},\mathbf{R}) = + \sum_{\alpha=1}^{N_{\text{nucl}}} + \sum_{i=1}^{N_{\text{elec}}} + \sum_{j=1}^{i-1} + \sum_{p=2}^{N_{\text{ord}}} + \sum_{k=0}^{p-1} + \sum_{l=0}^{p-k-2\delta_{k,0}} + c_{lkp\alpha} \left[ g({r}_{ij}) \right]^k + \left[ \left[ g({R}_{i\alpha}) \right]^l + \left[ g({R}_{j\alpha}) \right]^l \right] + \left[ g({R}_{i\,\alpha}) \, g({R}_{j\alpha}) \right]^{(p-k-l)/2} + \] + + $c_{lkp\alpha}$ are non-zero only when $p-k-l$ is even. + + $f$ and $g$ are scaling function defined as + + \[ + f(r) = \frac{1-e^{-\kappa\, r}}{\kappa} \text{ and } + g(r) = e^{-\kappa\, r}. + \] + + The terms $J_{\text{ee}}^\infty$ and $J_{\text{eN}}^\infty$ are shifts to ensure that + $J_{\text{ee}}$ and $J_{\text{eN}}$ have an asymptotic value of zero. + * Headers :noexport: #+begin_src elisp :noexport :results none @@ -80,7 +131,7 @@ int main() { #+NAME: qmckl_jastrow_args | Variable | Type | In/Out | Description | |---------------------------+---------------------------------------+--------+-------------------------------------------------------------------| - | ~uninitialized~ | ~int32_t~ | in | Keeps bit set for uninitialized data | + | ~uninitialized~ | ~int32_t~ | in | Keeps bits set for uninitialized data | | ~aord_num~ | ~int64_t~ | in | The number of a coeffecients | | ~bord_num~ | ~int64_t~ | in | The number of b coeffecients | | ~cord_num~ | ~int64_t~ | in | The number of c coeffecients | @@ -124,12 +175,11 @@ int main() { | ~een_rescaled_n_deriv_e~ | ~double[walk_num][elec_num][4][nucl_num][0:cord_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | | | ~een_rescaled_n_deriv_e_date~ | ~uint64_t~ | Keep track of the date of creation | | - For H2O we have the following data: - #+NAME: jastrow_data - #+BEGIN_SRC python :results output + #+BEGIN_SRC python :results none :exports none import numpy as np +# For H2O we have the following data: elec_num = 10 nucl_num = 2 up_num = 5 @@ -150,46 +200,46 @@ elec_coord = [[[-0.250655104764153 , 0.503070975550133 , -0.16655 [ 0.397978144318712 , -0.254277292595981 , 2.54553335476344]]]; ee_distance_rescaled = [ -[ 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.550227800352402 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.919155060185168 ,0.937695909123175 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.893325429242815 ,0.851181978173561 ,0.978501685226877 , - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.982457268305353 ,0.976125002619471 ,0.994349933143149 , - 0.844077311588328 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.482407528408731 ,0.414816073699124 ,0.894716035479343 , - 0.876540187084407 ,0.978921170036895 ,0.000000000000000E+000, - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.459541909660400 ,0.545007215761510 ,0.883752955884551 , - 0.918958134888791 ,0.986386936267237 ,0.362209822236419 , - 0.000000000000000E+000 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.763732576854455 ,0.817282762358449 ,0.801802919535959 , - 0.900089095449775 ,0.975704636491453 ,0.707836537586060 , - 0.755705808346586 ,0.000000000000000E+000 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.904249454052971 ,0.871097965261373 ,0.982717262706270 , - 0.239901207363622 ,0.836519456769083 ,0.896135326270534 , - 0.930694340243023 ,0.917708540815567 ,0.000000000000000E+000, - 0.000000000000000E+000], -[ 0.944400908070716 ,0.922589018494961 ,0.984615718580670 , - 0.514328661540623 ,0.692362267147064 ,0.931894098453677 , - 0.956034127544344 ,0.931221472309472 ,0.540903688625053 , - 0.000000000000000E+000]] +[ 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000 ], +[ 0.550227800352402, 0.000000000000000, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000 ], +[ 0.919155060185168, 0.937695909123175, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000 ], +[ 0.893325429242815, 0.851181978173561, 0.978501685226877, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000 ], +[ 0.982457268305353, 0.976125002619471, 0.994349933143149, + 0.844077311588328, 0.000000000000000, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000 ], +[ 0.482407528408731, 0.414816073699124, 0.894716035479343, + 0.876540187084407, 0.978921170036895, 0.000000000000000, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000 ], +[ 0.459541909660400, 0.545007215761510, 0.883752955884551, + 0.918958134888791, 0.986386936267237, 0.362209822236419, + 0.000000000000000, 0.000000000000000, 0.000000000000000, + 0.000000000000000 ], +[ 0.763732576854455, 0.817282762358449, 0.801802919535959, + 0.900089095449775, 0.975704636491453, 0.707836537586060, + 0.755705808346586, 0.000000000000000, 0.000000000000000, + 0.000000000000000 ], +[ 0.904249454052971, 0.871097965261373, 0.982717262706270, + 0.239901207363622, 0.836519456769083, 0.896135326270534, + 0.930694340243023, 0.917708540815567, 0.000000000000000, + 0.000000000000000 ], +[ 0.944400908070716, 0.922589018494961, 0.984615718580670, + 0.514328661540623, 0.692362267147064, 0.931894098453677, + 0.956034127544344, 0.931221472309472, 0.540903688625053, + 0.000000000000000 ]] en_distance_rescaled = np.transpose(np.array([ [ 0.443570948411811 , 0.467602196999105 , 0.893870160799932 , @@ -276,8 +326,6 @@ kappa = 1.0 kappa_inv = 1.0/kappa #+END_SRC - #+RESULTS: jastrow_data - ** Data structure #+begin_src c :comments org :tangle (eval h_private_type) @@ -922,7 +970,7 @@ qmckl_exit_code qmckl_set_jastrow_cord_vector(qmckl_context context, double cons When the required information is completely entered, other data structures are computed to accelerate the calculations. The intermediates factors - are precontracted using BLAS LEVEL 3 operations for an optimal FLOP count. + are precontracted using BLAS LEVEL 3 operations for an optimal flop count. #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none qmckl_exit_code qmckl_finalize_jastrow(qmckl_context context); @@ -1151,14 +1199,14 @@ assert(qmckl_nucleus_provided(context)); compute. If it is the case, then the data is recomputed and the current date is stored. -** Asymptotic component for \(f_{ee}\) +** Asymptotic component for \(J_{ee}\) Calculate the asymptotic component ~asymp_jasb~ to be substracted from the final - electron-electron jastrow factor \(f_{ee}\). The asymptotic componenet is calculated + electron-electron jastrow factor \(J_{\text{ee}}\). The asymptotic component is calculated via the ~bord_vector~ and the electron-electron rescale factor ~rescale_factor_kappa~. \[ - J_{asymp} = \frac{b_1 \kappa^-1}{1 + b_2 \kappa^-1} + J_{\text{ee}}^{\infty} = \frac{b_1 \kappa^{-1}}{1 + b_2 \kappa^{-1}} \] *** Get @@ -1255,13 +1303,13 @@ qmckl_exit_code qmckl_provide_asymp_jasb(qmckl_context context) :END: #+NAME: qmckl_asymp_jasb_args - | Variable | Type | In/Out | Description | - |---------------------------+----------------------+--------+-----------------------------| - | ~context~ | ~qmckl_context~ | in | Global state | - | ~bord_num~ | ~int64_t~ | in | Number of electrons | - | ~bord_vector~ | ~double[bord_num+1]~ | in | Number of walkers | - | ~rescale_factor_kappa_ee~ | ~double~ | in | Electron coordinates | - | ~asymp_jasb~ | ~double[2]~ | out | Electron-electron distances | + | Variable | Type | In/Out | Description | + |---------------------------+----------------------+--------+-------------------------| + | ~context~ | ~qmckl_context~ | in | Global state | + | ~bord_num~ | ~int64_t~ | in | Order of the polynomial | + | ~bord_vector~ | ~double[bord_num+1]~ | in | Values of b | + | ~rescale_factor_kappa_ee~ | ~double~ | in | Electron coordinates | + | ~asymp_jasb~ | ~double[2]~ | out | Asymptotic value | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_asymp_jasb_f(context, bord_num, bord_vector, rescale_factor_kappa_ee, asymp_jasb) & From fac03ea53b387a38be093474e85fe572c69bb097 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 9 Feb 2022 18:06:46 +0100 Subject: [PATCH 09/29] Accelerate AOs --- org/qmckl_ao.org | 128 +++++++++++++++++++++++++---------------------- 1 file changed, 68 insertions(+), 60 deletions(-) diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index 8a6fbf6..28a831b 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -3443,7 +3443,7 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f( & ! Don't compute exponentials when the result will be almost zero. ! TODO : Use numerical precision here - cutoff = -dlog(1.d-15) + cutoff = -dlog(1.d-12) do inucl=1,nucl_num @@ -4094,7 +4094,7 @@ integer function qmckl_ao_polynomial_vgl_f (context, & lmax_array(1:3) = lmax if (lmax == 0) then VGL(1,1) = 1.d0 - vgL(2:5,1) = 0.d0 + VGL(2:5,1) = 0.d0 l(1:3,1) = 0 n=1 else if (lmax > 0) then @@ -4109,19 +4109,19 @@ integer function qmckl_ao_polynomial_vgl_f (context, & l (1:3,1:4) = 0 VGL(1 ,1 ) = 1.d0 - vgl(1:5,2:4) = 0.d0 + VGL(1:5,2:4) = 0.d0 l (1,2) = 1 - vgl(1,2) = pows(1,1) - vgL(2,2) = 1.d0 + VGL(1,2) = pows(1,1) + VGL(2,2) = 1.d0 l (2,3) = 1 - vgl(1,3) = pows(1,2) - vgL(3,3) = 1.d0 + VGL(1,3) = pows(1,2) + VGL(3,3) = 1.d0 l (3,4) = 1 - vgl(1,4) = pows(1,3) - vgL(4,4) = 1.d0 + VGL(1,4) = pows(1,3) + VGL(4,4) = 1.d0 n=4 endif @@ -4145,17 +4145,17 @@ integer function qmckl_ao_polynomial_vgl_f (context, & yz = pows(b,2) * pows(c,3) xz = pows(a,1) * pows(c,3) - vgl(1,n) = xy * pows(c,3) + VGL(1,n) = xy * pows(c,3) xy = dc * xy xz = db * xz yz = da * yz - vgl(2,n) = pows(a-1,1) * yz - vgl(3,n) = pows(b-1,2) * xz - vgl(4,n) = pows(c-1,3) * xy + VGL(2,n) = pows(a-1,1) * yz + VGL(3,n) = pows(b-1,2) * xz + VGL(4,n) = pows(c-1,3) * xy - vgl(5,n) = & + VGL(5,n) = & (da-1.d0) * pows(a-2,1) * yz + & (db-1.d0) * pows(b-2,2) * xz + & (dc-1.d0) * pows(c-2,3) * xy @@ -4378,7 +4378,7 @@ integer function qmckl_compute_ao_vgl_f(context, & double precision :: e_coord(3), n_coord(3) integer*8 :: n_poly - integer :: l, il, k + integer :: l, il, k, m, n integer*8 :: ipoint, inucl, ishell integer*8 :: ishell_start, ishell_end integer :: lstart(0:20) @@ -4388,25 +4388,45 @@ integer function qmckl_compute_ao_vgl_f(context, & double precision, allocatable :: poly_vgl(:,:) integer , allocatable :: powers(:,:) + integer , allocatable :: kil(:), knucl(:), kshell(:) - allocate(poly_vgl(5,ao_num), powers(3,ao_num)) + allocate(poly_vgl(8,ao_num), powers(8,ao_num)) + allocate(kil(ao_num), kshell(ao_num), knucl(nucl_num+1)) ! Pre-computed data - do l=0,20 - lstart(l) = l*(l+1)*(l+2)/6 +1 + + k=1 + do inucl=1,nucl_num + knucl(inucl) = k + ishell_start = nucleus_index(inucl) + 1 + ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) + do ishell = ishell_start, ishell_end + l = shell_ang_mom(ishell) + m = l*(l+1)*(l+2)/6 +1 + n = (l+1)*(l+2)*(l+3)/6 + do il = m, n + kil(k) = il + kshell(k) = ishell + k = k+1 + end do + end do end do + knucl(nucl_num+1) = ao_num+1 + info = QMCKL_SUCCESS ! Don't compute polynomials when the radial part is zero. ! TODO : Use numerical precision here - cutoff = -dlog(1.d-15) + cutoff = -dlog(1.d-12) do ipoint = 1, point_num e_coord(1) = coord(ipoint,1) e_coord(2) = coord(ipoint,2) e_coord(3) = coord(ipoint,3) - k=1 + + ! Express the radial part in the AO basis + do inucl=1,nucl_num n_coord(1) = nucl_coord(inucl,1) n_coord(2) = nucl_coord(inucl,2) @@ -4417,62 +4437,50 @@ integer function qmckl_compute_ao_vgl_f(context, & y = e_coord(2) - n_coord(2) z = e_coord(3) - n_coord(3) - r2 = x*x + z*z + z*z + r2 = x*x + y*y + z*z if (r2 > cutoff*nucleus_range(inucl)) then + do k = knucl(inucl), knucl(inucl+1)-1 + ao_vgl(k,ipoint,1) = 0.d0 + ao_vgl(k,ipoint,2) = 0.d0 + ao_vgl(k,ipoint,3) = 0.d0 + ao_vgl(k,ipoint,4) = 0.d0 + ao_vgl(k,ipoint,5) = 0.d0 + end do cycle end if ! Compute polynomials info = qmckl_ao_polynomial_vgl_f(context, e_coord, n_coord, & - nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, & - poly_vgl, 5_8) + nucleus_max_ang_mom(inucl), n_poly, powers, 8_8, poly_vgl, 8_8) - ! Loop over shells - ishell_start = nucleus_index(inucl) + 1 - ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) - do ishell = ishell_start, ishell_end - l = shell_ang_mom(ishell) - do il = lstart(l), lstart(l+1)-1 - ! Value - ao_vgl(k,ipoint,1) = & - poly_vgl(1,il) * shell_vgl(ishell,ipoint,1) * ao_factor(k) + do k = knucl(inucl), knucl(inucl+1)-1 + y = shell_vgl(kshell(k),ipoint,1) * ao_factor(k) - ! Grad_x - ao_vgl(k,ipoint,2) = ( & - poly_vgl(2,il) * shell_vgl(ishell,ipoint,1) + & - poly_vgl(1,il) * shell_vgl(ishell,ipoint,2) & - ) * ao_factor(k) + ao_vgl(k,ipoint,1) = y * poly_vgl(1,kil(k)) + ao_vgl(k,ipoint,2) = y * poly_vgl(2,kil(k)) + ao_vgl(k,ipoint,3) = y * poly_vgl(3,kil(k)) + ao_vgl(k,ipoint,4) = y * poly_vgl(4,kil(k)) + ao_vgl(k,ipoint,5) = y * poly_vgl(5,kil(k)) - ! Grad_y - ao_vgl(k,ipoint,3) = ( & - poly_vgl(3,il) * shell_vgl(ishell,ipoint,1) + & - poly_vgl(1,il) * shell_vgl(ishell,ipoint,3) & - ) * ao_factor(k) + x = poly_vgl(1,kil(k)) * ao_factor(k) - ! Grad_z - ao_vgl(k,ipoint,4) = ( & - poly_vgl(4,il) * shell_vgl(ishell,ipoint,1) + & - poly_vgl(1,il) * shell_vgl(ishell,ipoint,4) & - ) * ao_factor(k) + ao_vgl(k,ipoint,2) = ao_vgl(k,ipoint,2) + x * shell_vgl(kshell(k),ipoint,2) + ao_vgl(k,ipoint,3) = ao_vgl(k,ipoint,3) + x * shell_vgl(kshell(k),ipoint,3) + ao_vgl(k,ipoint,4) = ao_vgl(k,ipoint,4) + x * shell_vgl(kshell(k),ipoint,4) + ao_vgl(k,ipoint,5) = ao_vgl(k,ipoint,5) + x * shell_vgl(kshell(k),ipoint,5) - ! Lapl_z - ao_vgl(k,ipoint,5) = ( & - poly_vgl(5,il) * shell_vgl(ishell,ipoint,1) + & - poly_vgl(1,il) * shell_vgl(ishell,ipoint,5) + & - 2.d0 * ( & - poly_vgl(2,il) * shell_vgl(ishell,ipoint,2) + & - poly_vgl(3,il) * shell_vgl(ishell,ipoint,3) + & - poly_vgl(4,il) * shell_vgl(ishell,ipoint,4) ) & - ) * ao_factor(k) - - k = k+1 - end do + ao_vgl(k,ipoint,5) = ao_vgl(k,ipoint,5) + & + (ao_factor(k) + ao_factor(k)) * (& + poly_vgl(2,kil(k)) * shell_vgl(kshell(k),ipoint,2) + & + poly_vgl(3,kil(k)) * shell_vgl(kshell(k),ipoint,3) + & + poly_vgl(4,kil(k)) * shell_vgl(kshell(k),ipoint,4) ) end do + end do end do - deallocate(poly_vgl, powers) + deallocate(poly_vgl, powers, kshell, kil, knucl) end function qmckl_compute_ao_vgl_f #+end_src From 04624171f087210e2f4079f19de3bab1fb6631a0 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 14:45:20 +0100 Subject: [PATCH 10/29] Added size dimensions to aord, cord, and bord. --- org/qmckl_jastrow.org | 47 +++++++++++++++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 11 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 533a9f9..2be6159 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -678,9 +678,9 @@ qmckl_exit_code qmckl_get_jastrow_cord_vector (const qmckl_context context, doub qmckl_exit_code qmckl_set_jastrow_ord_num (qmckl_context context, const int64_t aord_num, const int64_t bord_num, const int64_t cord_num); qmckl_exit_code qmckl_set_jastrow_type_nucl_num (qmckl_context context, const int64_t type_nucl_num); qmckl_exit_code qmckl_set_jastrow_type_nucl_vector (qmckl_context context, const int64_t* type_nucl_vector, const int64_t nucl_num); -qmckl_exit_code qmckl_set_jastrow_aord_vector (qmckl_context context, const double * aord_vector); -qmckl_exit_code qmckl_set_jastrow_bord_vector (qmckl_context context, const double * bord_vector); -qmckl_exit_code qmckl_set_jastrow_cord_vector (qmckl_context context, const double * cord_vector); +qmckl_exit_code qmckl_set_jastrow_aord_vector (qmckl_context context, const double * aord_vector, int64_t size_max); +qmckl_exit_code qmckl_set_jastrow_bord_vector (qmckl_context context, const double * bord_vector, int64_t size_max); +qmckl_exit_code qmckl_set_jastrow_cord_vector (qmckl_context context, const double * cord_vector, int64_t size_max); #+end_src #+NAME:pre2 @@ -804,7 +804,7 @@ qmckl_exit_code qmckl_set_jastrow_type_nucl_vector(qmckl_context context, int64_ <> } -qmckl_exit_code qmckl_set_jastrow_aord_vector(qmckl_context context, double const * aord_vector) { +qmckl_exit_code qmckl_set_jastrow_aord_vector(qmckl_context context, double const * aord_vector, int64_t size_max) { <> int32_t mask = 1 << 3; @@ -837,11 +837,19 @@ qmckl_exit_code qmckl_set_jastrow_aord_vector(qmckl_context context, double cons return qmckl_failwith( context, rc, "qmckl_set_ord_vector", NULL); - } +} } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = (aord_num + 1) * type_nucl_num * sizeof(double); + + if (size_max < mem_info.size/sizeof(double)) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_set_jastrow_aord_vector", + "Array too small. Expected (aord_num+1)*type_nucl_num"); + } + double* new_array = (double*) qmckl_malloc(context, mem_info); if(new_array == NULL) { @@ -858,7 +866,7 @@ qmckl_exit_code qmckl_set_jastrow_aord_vector(qmckl_context context, double cons <> } -qmckl_exit_code qmckl_set_jastrow_bord_vector(qmckl_context context, double const * bord_vector) { +qmckl_exit_code qmckl_set_jastrow_bord_vector(qmckl_context context, double const * bord_vector, int64_t size_max) { <> int32_t mask = 1 << 4; @@ -892,6 +900,14 @@ qmckl_exit_code qmckl_set_jastrow_bord_vector(qmckl_context context, double cons qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = (bord_num + 1) * sizeof(double); + + if (size_max < mem_info.size/sizeof(double)) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_set_jastrow_bord_vector", + "Array too small. Expected (bord_num+1)"); + } + double* new_array = (double*) qmckl_malloc(context, mem_info); if(new_array == NULL) { @@ -908,7 +924,7 @@ qmckl_exit_code qmckl_set_jastrow_bord_vector(qmckl_context context, double cons <> } -qmckl_exit_code qmckl_set_jastrow_cord_vector(qmckl_context context, double const * cord_vector) { +qmckl_exit_code qmckl_set_jastrow_cord_vector(qmckl_context context, double const * cord_vector, int64_t size_max) { <> int32_t mask = 1 << 5; @@ -949,6 +965,14 @@ qmckl_exit_code qmckl_set_jastrow_cord_vector(qmckl_context context, double cons qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = dim_cord_vect * type_nucl_num * sizeof(double); + + if (size_max < mem_info.size/sizeof(double)) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_set_jastrow_cord_vector", + "Array too small. Expected dim_cord_vect * type_nucl_num"); + } + double* new_array = (double*) qmckl_malloc(context, mem_info); if(new_array == NULL) { @@ -1437,6 +1461,7 @@ int64_t cord_num = n2_cord_num; double* aord_vector = &(n2_aord_vector[0][0]); double* bord_vector = &(n2_bord_vector[0]); double* cord_vector = &(n2_cord_vector[0][0]); +int64_t dim_cord_vect=0; /* Initialize the Jastrow data */ rc = qmckl_init_jastrow(context); @@ -1449,13 +1474,13 @@ rc = qmckl_set_jastrow_type_nucl_num(context, type_nucl_num); assert(rc == QMCKL_SUCCESS); rc = qmckl_set_jastrow_type_nucl_vector(context, type_nucl_vector, nucl_num); assert(rc == QMCKL_SUCCESS); -rc = qmckl_set_jastrow_aord_vector(context, aord_vector); +rc = qmckl_set_jastrow_aord_vector(context, aord_vector,(aord_num+1)*type_nucl_num); assert(rc == QMCKL_SUCCESS); -rc = qmckl_set_jastrow_bord_vector(context, bord_vector); +rc = qmckl_set_jastrow_bord_vector(context, bord_vector,(bord_num+1)); assert(rc == QMCKL_SUCCESS); -rc = qmckl_set_jastrow_bord_vector(context, bord_vector); +rc = qmckl_get_jastrow_dim_cord_vect(context, &dim_cord_vect); assert(rc == QMCKL_SUCCESS); -rc = qmckl_set_jastrow_cord_vector(context, cord_vector); +rc = qmckl_set_jastrow_cord_vector(context, cord_vector,dim_cord_vect*type_nucl_num); assert(rc == QMCKL_SUCCESS); /* Check if Jastrow is properly initialized */ From 8ebcb6361078c7ac281cb253a0ba17fa0d1573a6 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 14:50:42 +0100 Subject: [PATCH 11/29] Bug Fix for icc. Fixes #60. --- org/qmckl_local_energy.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 1a1cacc..7e9e392 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -1645,7 +1645,7 @@ end function qmckl_compute_drift_vector_f #+begin_src c :tangle (eval c_test) :exports none // Calculate the Drift vector -double drift_vector[walk_num][3]; +double drift_vector[walk_num][elec_num][3]; rc = qmckl_get_drift_vector(context, &(drift_vector[0][0])); assert (rc == QMCKL_SUCCESS); From 757d81324ad320da5cc4e15dd50f75a7a957e222 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 15:09:18 +0100 Subject: [PATCH 12/29] Added size in setters. --- org/qmckl_jastrow.org | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 2be6159..6889098 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -412,10 +412,10 @@ qmckl_exit_code qmckl_get_jastrow_aord_num (qmckl_context context, int qmckl_exit_code qmckl_get_jastrow_bord_num (qmckl_context context, int64_t* const bord_num); qmckl_exit_code qmckl_get_jastrow_cord_num (qmckl_context context, int64_t* const bord_num); qmckl_exit_code qmckl_get_jastrow_type_nucl_num (qmckl_context context, int64_t* const type_nucl_num); -qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (qmckl_context context, int64_t* const type_nucl_num); -qmckl_exit_code qmckl_get_jastrow_aord_vector (qmckl_context context, double * const aord_vector); -qmckl_exit_code qmckl_get_jastrow_bord_vector (qmckl_context context, double * const bord_vector); -qmckl_exit_code qmckl_get_jastrow_cord_vector (qmckl_context context, double * const cord_vector); +qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (qmckl_context context, int64_t* const type_nucl_num, int64_t* size_max); +qmckl_exit_code qmckl_get_jastrow_aord_vector (qmckl_context context, double * const aord_vector, int64_t* size_max); +qmckl_exit_code qmckl_get_jastrow_bord_vector (qmckl_context context, double * const bord_vector, int64_t* size_max); +qmckl_exit_code qmckl_get_jastrow_cord_vector (qmckl_context context, double * const cord_vector, int64_t* size_max); #+end_src Along with these core functions, calculation of the jastrow factor @@ -559,7 +559,7 @@ qmckl_exit_code qmckl_get_jastrow_type_nucl_num (const qmckl_context context, in return QMCKL_SUCCESS; } -qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (const qmckl_context context, int64_t * const type_nucl_vector) { +qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (const qmckl_context context, int64_t * const type_nucl_vector, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -583,10 +583,11 @@ qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (const qmckl_context context, assert (ctx->jastrow.type_nucl_vector != NULL); memcpy(type_nucl_vector, ctx->jastrow.type_nucl_vector, ctx->jastrow.type_nucl_num*sizeof(int64_t)); + (*size_max) = ctx->jastrow.type_nucl_num; return QMCKL_SUCCESS; } -qmckl_exit_code qmckl_get_jastrow_aord_vector (const qmckl_context context, double * const aord_vector) { +qmckl_exit_code qmckl_get_jastrow_aord_vector (const qmckl_context context, double * const aord_vector, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -609,11 +610,13 @@ qmckl_exit_code qmckl_get_jastrow_aord_vector (const qmckl_context context, doub } assert (ctx->jastrow.aord_vector != NULL); - memcpy(aord_vector, ctx->jastrow.aord_vector, ctx->jastrow.aord_num*sizeof(double)); + int64_t sze = (ctx->jastrow.aord_num + 1)*ctx->jastrow.type_nucl_num; + memcpy(aord_vector, ctx->jastrow.aord_vector, sze*sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } -qmckl_exit_code qmckl_get_jastrow_bord_vector (const qmckl_context context, double * const bord_vector) { +qmckl_exit_code qmckl_get_jastrow_bord_vector (const qmckl_context context, double * const bord_vector, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -636,11 +639,13 @@ qmckl_exit_code qmckl_get_jastrow_bord_vector (const qmckl_context context, doub } assert (ctx->jastrow.bord_vector != NULL); - memcpy(bord_vector, ctx->jastrow.bord_vector, ctx->jastrow.bord_num*sizeof(double)); + int64_t sze=ctx->jastrow.bord_num +1; + memcpy(bord_vector, ctx->jastrow.bord_vector, sze*sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } -qmckl_exit_code qmckl_get_jastrow_cord_vector (const qmckl_context context, double * const cord_vector) { +qmckl_exit_code qmckl_get_jastrow_cord_vector (const qmckl_context context, double * const cord_vector, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -663,7 +668,14 @@ qmckl_exit_code qmckl_get_jastrow_cord_vector (const qmckl_context context, doub } assert (ctx->jastrow.cord_vector != NULL); - memcpy(cord_vector, ctx->jastrow.cord_vector, ctx->jastrow.dim_cord_vect*sizeof(double)); + + int64_t dim_cord_vect; + qmckl_exit_code rc = qmckl_get_jastrow_dim_cord_vect(context, &dim_cord_vect); + if (rc != QMCKL_SUCCESS) return rc; + + int64_t sze=dim_cord_vect * ctx->jastrow.type_nucl_num; + memcpy(cord_vector, ctx->jastrow.cord_vector, sze*sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } From fa535bdcd1c8b8f0c05edf3e9b84a2b3213d1494 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 15:17:57 +0100 Subject: [PATCH 13/29] Added size to factor_ee. --- org/qmckl_jastrow.org | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 6889098..8b77724 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -1246,11 +1246,11 @@ assert(qmckl_nucleus_provided(context)); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_asymp_jasb(qmckl_context context, double* const asymp_jasb); +qmckl_exit_code qmckl_get_jastrow_asymp_jasb(qmckl_context context, double* const asymp_jasb, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_asymp_jasb(qmckl_context context, double* const asymp_jasb) +qmckl_exit_code qmckl_get_jastrow_asymp_jasb(qmckl_context context, double* const asymp_jasb, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -1266,6 +1266,7 @@ qmckl_exit_code qmckl_get_jastrow_asymp_jasb(qmckl_context context, double* cons size_t sze = 2; memcpy(asymp_jasb, ctx->jastrow.asymp_jasb, sze * sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } @@ -1456,7 +1457,7 @@ print("asym_one : ", asym_one) print("asymp_jasb[0] : ", asymp_jasb[0]) print("asymp_jasb[1] : ", asymp_jasb[1]) #+end_src - + #+RESULTS: asymp_jasb : asym_one : 0.43340325572525706 : asymp_jasb[0] : 0.5323750557252571 @@ -1499,7 +1500,8 @@ assert(rc == QMCKL_SUCCESS); assert(qmckl_jastrow_provided(context)); double asymp_jasb[2]; -rc = qmckl_get_jastrow_asymp_jasb(context, asymp_jasb); +int64_t size_max=0; +rc = qmckl_get_jastrow_asymp_jasb(context, asymp_jasb,&size_max); // calculate asymp_jasb assert(fabs(asymp_jasb[0]-0.5323750557252571) < 1.e-12); @@ -1519,11 +1521,11 @@ f_{ee} = \sum_{i,jjastrow.factor_ee, ctx->electron.walk_num*sizeof(double)); + int64_t sze=ctx->electron.walk_num; + memcpy(factor_ee, ctx->jastrow.factor_ee, sze*sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } @@ -1800,7 +1804,8 @@ print("factor_ee :",factor_ee) assert(qmckl_jastrow_provided(context)); double factor_ee[walk_num]; -rc = qmckl_get_jastrow_factor_ee(context, factor_ee); +size_max=0; +rc = qmckl_get_jastrow_factor_ee(context, factor_ee, &size_max); // calculate factor_ee assert(fabs(factor_ee[0]+4.282760865958113) < 1.e-12); From da3c8c7cf92da589f21340c4f80b29f217828a94 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 15:27:18 +0100 Subject: [PATCH 14/29] Working on ee_distance_deriv_e. --- org/qmckl_jastrow.org | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 8b77724..9e57a04 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -1824,11 +1824,11 @@ assert(fabs(factor_ee[0]+4.282760865958113) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e); +qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e) +qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -1844,6 +1844,7 @@ qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, doubl int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num; memcpy(factor_ee_deriv_e, ctx->jastrow.factor_ee_deriv_e, sze * sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } @@ -1947,8 +1948,8 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num, integer(qmckl_context), intent(in) :: context integer*8 , intent(in) :: walk_num, elec_num, bord_num, up_num double precision , intent(in) :: bord_vector(bord_num + 1) - double precision , intent(in) :: ee_distance_rescaled(walk_num, elec_num, elec_num) - double precision , intent(in) :: ee_distance_rescaled_deriv_e(walk_num, 4, elec_num, elec_num) + double precision , intent(in) :: ee_distance_rescaled(elec_num, elec_num,walk_num) + double precision , intent(in) :: ee_distance_rescaled_deriv_e(4,elec_num, elec_num,walk_num) double precision , intent(in) :: asymp_jasb(2) double precision , intent(out) :: factor_ee_deriv_e(elec_num,4,walk_num) @@ -1987,7 +1988,7 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num, do nw =1, walk_num do j = 1, elec_num do i = 1, elec_num - x = ee_distance_rescaled(nw, i, j) + x = ee_distance_rescaled(i,j,nw) if(abs(x) < 1.0d-18) cycle pow_ser_g = 0.0d0 spin_fact = 1.0d0 @@ -1998,9 +1999,10 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num, xinv = 1.0d0 / (x + 1.0d-18) ipar = 1 - do ii = 1, 4 - dx(ii) = ee_distance_rescaled_deriv_e(nw, ii, i, j) - end do + dx(ii) = ee_distance_rescaled_deriv_e(1, i, j, nw) & + + ee_distance_rescaled_deriv_e(2, i, j, nw) & + + ee_distance_rescaled_deriv_e(3, i, j, nw) & + + ee_distance_rescaled_deriv_e(4, i, j, nw) if((i .LE. up_num .AND. j .LE. up_num ) .OR. & (i .GT. up_num .AND. j .GT. up_num)) then @@ -2011,14 +2013,14 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num, lap2 = 0.0d0 lap3 = 0.0d0 do ii = 1, 3 - x = ee_distance_rescaled(nw, i, j) + x = ee_distance_rescaled(i, j, nw) if(abs(x) < 1.0d-18) cycle do p = 2, bord_num y = p * bord_vector(p + 1) * x pow_ser_g(ii) = pow_ser_g(ii) + y * dx(ii) lap1 = lap1 + (p - 1) * y * xinv * dx(ii) * dx(ii) lap2 = lap2 + y - x = x * ee_distance_rescaled(nw, i, j) + x = x * ee_distance_rescaled(i, j, nw) end do lap3 = lap3 - 2.0d0 * bord_vector(2) * dx(ii) * dx(ii) @@ -2215,7 +2217,8 @@ assert(qmckl_jastrow_provided(context)); // calculate factor_ee_deriv_e double factor_ee_deriv_e[walk_num][4][elec_num]; -rc = qmckl_get_jastrow_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0])); +size_max=0; +rc = qmckl_get_jastrow_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0]),&size_max); // check factor_ee_deriv_e assert(fabs(factor_ee_deriv_e[0][0][0]-0.16364894652107934) < 1.e-12); From 71b0bbfaff044341c23765c83406eb794a2354cb Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 15:28:11 +0100 Subject: [PATCH 15/29] Fix test for drift. --- org/qmckl_local_energy.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 7e9e392..ccd933d 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -1647,7 +1647,7 @@ end function qmckl_compute_drift_vector_f double drift_vector[walk_num][elec_num][3]; -rc = qmckl_get_drift_vector(context, &(drift_vector[0][0])); +rc = qmckl_get_drift_vector(context, &(drift_vector[0][0][0])); assert (rc == QMCKL_SUCCESS); #+end_src * End of files :noexport: From 88e2f62d7fe6e6c98902502688528f7eaaa8b55d Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 15:36:08 +0100 Subject: [PATCH 16/29] Fixed ee_distance_rescaled index order. --- org/qmckl_jastrow.org | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 9e57a04..3d792f7 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -1638,7 +1638,7 @@ integer function qmckl_compute_factor_ee_f(context, walk_num, elec_num, up_num, integer(qmckl_context), intent(in) :: context integer*8 , intent(in) :: walk_num, elec_num, bord_num, up_num double precision , intent(in) :: bord_vector(bord_num + 1) - double precision , intent(in) :: ee_distance_rescaled(walk_num, elec_num, elec_num) + double precision , intent(in) :: ee_distance_rescaled(elec_num, elec_num, walk_num) double precision , intent(in) :: asymp_jasb(2) double precision , intent(out) :: factor_ee(walk_num) @@ -1672,13 +1672,13 @@ integer function qmckl_compute_factor_ee_f(context, walk_num, elec_num, up_num, do nw =1, walk_num do j = 1, elec_num do i = 1, j - 1 - x = ee_distance_rescaled(nw,i,j) + x = ee_distance_rescaled(i,j,nw) power_ser = 0.0d0 spin_fact = 1.0d0 ipar = 1 do p = 2, bord_num - x = x * ee_distance_rescaled(nw,i,j) + x = x * ee_distance_rescaled(i,j,nw) power_ser = power_ser + bord_vector(p + 1) * x end do @@ -1688,9 +1688,9 @@ integer function qmckl_compute_factor_ee_f(context, walk_num, elec_num, up_num, endif factor_ee(nw) = factor_ee(nw) + spin_fact * bord_vector(1) * & - ee_distance_rescaled(nw,i,j) / & + ee_distance_rescaled(i,j,nw) / & (1.0d0 + bord_vector(2) * & - ee_distance_rescaled(nw,i,j)) & + ee_distance_rescaled(i,j,nw)) & -asymp_jasb(ipar) + power_ser end do From 3348781cc2db9cbe64f07719feb3c784cf1cd5eb Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 15:37:55 +0100 Subject: [PATCH 17/29] Fixed ee_distances_rescaled_deriv_e. --- org/qmckl_jastrow.org | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 3d792f7..121894e 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -1999,10 +1999,10 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num, xinv = 1.0d0 / (x + 1.0d-18) ipar = 1 - dx(ii) = ee_distance_rescaled_deriv_e(1, i, j, nw) & - + ee_distance_rescaled_deriv_e(2, i, j, nw) & - + ee_distance_rescaled_deriv_e(3, i, j, nw) & - + ee_distance_rescaled_deriv_e(4, i, j, nw) + dx(1) = ee_distance_rescaled_deriv_e(1, i, j, nw) + dx(2) = ee_distance_rescaled_deriv_e(2, i, j, nw) + dx(3) = ee_distance_rescaled_deriv_e(3, i, j, nw) + dx(4) = ee_distance_rescaled_deriv_e(4, i, j, nw) if((i .LE. up_num .AND. j .LE. up_num ) .OR. & (i .GT. up_num .AND. j .GT. up_num)) then From f22e2b1d72b647944d6287ab95d6b75eb5c37e05 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 15:45:16 +0100 Subject: [PATCH 18/29] Working on factor_en. --- org/qmckl_jastrow.org | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 121894e..ed0e948 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -2240,11 +2240,11 @@ f_{en} = \sum_{i,jjastrow.factor_en, ctx->electron.walk_num*sizeof(double)); + int64_t sze=ctx->electron.walk_num; + memcpy(factor_en, ctx->jastrow.factor_en, sze*sizeof(double)); + (*size_max)=sze; return QMCKL_SUCCESS; } @@ -2359,7 +2361,7 @@ integer function qmckl_compute_factor_en_f(context, walk_num, elec_num, nucl_num integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num integer*8 , intent(in) :: type_nucl_vector(nucl_num) double precision , intent(in) :: aord_vector(aord_num + 1, type_nucl_num) - double precision , intent(in) :: en_distance_rescaled(walk_num, nucl_num, elec_num) + double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num) double precision , intent(out) :: factor_en(walk_num) integer*8 :: i, a, p, ipar, nw @@ -2397,18 +2399,18 @@ integer function qmckl_compute_factor_en_f(context, walk_num, elec_num, nucl_num do nw =1, walk_num do a = 1, nucl_num do i = 1, elec_num - x = en_distance_rescaled(nw, a, i) + x = en_distance_rescaled(i, a, nw) power_ser = 0.0d0 do p = 2, aord_num - x = x * en_distance_rescaled(nw, a, i) + x = x * en_distance_rescaled(i, a, nw) power_ser = power_ser + aord_vector(p + 1, type_nucl_vector(a)) * x end do factor_en(nw) = factor_en(nw) + aord_vector(1, type_nucl_vector(a)) * & - en_distance_rescaled(nw, a, i) / & + en_distance_rescaled(i, a, nw) / & (1.0d0 + aord_vector(2, type_nucl_vector(a)) * & - en_distance_rescaled(nw, a, i)) & + en_distance_rescaled(i, a, nw)) & + power_ser end do @@ -2464,7 +2466,7 @@ end function qmckl_compute_factor_en_f integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num) integer (c_int64_t) , intent(in) , value :: aord_num real (c_double ) , intent(in) :: aord_vector(aord_num + 1, type_nucl_num) - real (c_double ) , intent(in) :: en_distance_rescaled(walk_num, nucl_num, elec_num) + real (c_double ) , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num) real (c_double ) , intent(out) :: factor_en(walk_num) integer(c_int32_t), external :: qmckl_compute_factor_en_f @@ -2515,7 +2517,8 @@ print("factor_en :",factor_en) assert(qmckl_jastrow_provided(context)); double factor_en[walk_num]; -rc = qmckl_get_jastrow_factor_en(context, factor_en); +size_max=0; +rc = qmckl_get_jastrow_factor_en(context, factor_en,&size_max); // calculate factor_en assert(fabs(factor_en[0]+5.865822569188727) < 1.e-12); @@ -2657,8 +2660,8 @@ integer function qmckl_compute_factor_en_deriv_e_f(context, walk_num, elec_num, integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num integer*8 , intent(in) :: type_nucl_vector(nucl_num) double precision , intent(in) :: aord_vector(aord_num + 1, type_nucl_num) - double precision , intent(in) :: en_distance_rescaled(walk_num, elec_num, nucl_num) - double precision , intent(in) :: en_distance_rescaled_deriv_e(walk_num, 4, elec_num, nucl_num) + double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num) + double precision , intent(in) :: en_distance_rescaled_deriv_e(4, elec_num, nucl_num, walk_num) double precision , intent(out) :: factor_en_deriv_e(elec_num,4,walk_num) integer*8 :: i, a, p, ipar, nw, ii From 1bb1e1f7d3b09afc987125d4bed0765749cd34f2 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 15:50:58 +0100 Subject: [PATCH 19/29] Fix bug in calculation of en_distance_rescaled_deriv_e. --- org/qmckl_electron.org | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index 9f79bcc..5e0d5dd 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -401,7 +401,7 @@ qmckl_get_electron_rescale_factor_en (const qmckl_context context, double* const | | Normal | Transposed | |---------+--------------------------+--------------------------| | C | ~[walk_num*elec_num][3]~ | ~[3][walk_num*elec_num]~ | - | Fortran | ~(3,walk_num*elec_num)~ | ~(walk_num*elec_num, 3)~ | + | Fortran | ~(3,walk_num*elec_num)~ | ~(walk_num*elec_num, 3)~ | #+begin_src c :comments org :tangle (eval h_func) :exports none @@ -978,7 +978,7 @@ qmckl_exit_code qmckl_provide_ee_distance(qmckl_context context) | ~context~ | ~qmckl_context~ | in | Global state | | ~elec_num~ | ~int64_t~ | in | Number of electrons | | ~walk_num~ | ~int64_t~ | in | Number of walkers | - | ~coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates | + | ~coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates | | ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | out | Electron-electron distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -2493,7 +2493,7 @@ integer function qmckl_compute_en_distance_rescaled_deriv_e_f(context, elec_num, integer*8 , intent(in) :: walk_num double precision , intent(in) :: elec_coord(elec_num,walk_num,3) double precision , intent(in) :: nucl_coord(nucl_num,3) - double precision , intent(out) :: en_distance_rescaled_deriv_e(elec_num,nucl_num,walk_num) + double precision , intent(out) :: en_distance_rescaled_deriv_e(4,elec_num,nucl_num,walk_num) integer*8 :: k @@ -2529,7 +2529,7 @@ integer function qmckl_compute_en_distance_rescaled_deriv_e_f(context, elec_num, info = qmckl_distance_rescaled_deriv_e(context, 'T', 'T', elec_num, nucl_num, & elec_coord(1,k,1), elec_num*walk_num, & nucl_coord, nucl_num, & - en_distance_rescaled_deriv_e(1,1,k), elec_num, rescale_factor_kappa_en) + en_distance_rescaled_deriv_e(1,1,1,k), elec_num, rescale_factor_kappa_en) if (info /= QMCKL_SUCCESS) then exit endif From 2c7a1eb2c6b737fa750a497817be356726a3556e Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 16:06:19 +0100 Subject: [PATCH 20/29] Fix factor_en_deriv_e. --- org/qmckl_jastrow.org | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index ed0e948..c83ba45 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -2534,11 +2534,11 @@ assert(fabs(factor_en[0]+5.865822569188727) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, double* const factor_en_deriv_e); +qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, double* const factor_en_deriv_e, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, double* const factor_en_deriv_e) +qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, double* const factor_en_deriv_e, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -2554,6 +2554,7 @@ qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, doubl int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num; memcpy(factor_en_deriv_e, ctx->jastrow.factor_en_deriv_e, sze*sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } @@ -2703,7 +2704,7 @@ integer function qmckl_compute_factor_en_deriv_e_f(context, walk_num, elec_num, do nw =1, walk_num do a = 1, nucl_num do i = 1, elec_num - x = en_distance_rescaled(nw, i, a) + x = en_distance_rescaled(i,a,nw) if(abs(x) < 1.0d-18) continue power_ser_g = 0.0d0 den = 1.0d0 + aord_vector(2, type_nucl_vector(a)) * x @@ -2713,20 +2714,20 @@ integer function qmckl_compute_factor_en_deriv_e_f(context, walk_num, elec_num, xinv = 1.0d0 / x do ii = 1, 4 - dx(ii) = en_distance_rescaled_deriv_e(nw, ii, i, a) + dx(ii) = en_distance_rescaled_deriv_e(ii,i,a,nw) end do lap1 = 0.0d0 lap2 = 0.0d0 lap3 = 0.0d0 do ii = 1, 3 - x = en_distance_rescaled(nw, i, a) + x = en_distance_rescaled(i, a, nw) do p = 2, aord_num y = p * aord_vector(p + 1, type_nucl_vector(a)) * x power_ser_g(ii) = power_ser_g(ii) + y * dx(ii) lap1 = lap1 + (p - 1) * y * xinv * dx(ii) * dx(ii) lap2 = lap2 + y - x = x * en_distance_rescaled(nw, i, a) + x = x * en_distance_rescaled(i, a, nw) end do lap3 = lap3 - 2.0d0 * aord_vector(2, type_nucl_vector(a)) * dx(ii) * dx(ii) @@ -2920,7 +2921,8 @@ assert(qmckl_jastrow_provided(context)); // calculate factor_en_deriv_e double factor_en_deriv_e[walk_num][4][elec_num]; -rc = qmckl_get_jastrow_factor_en_deriv_e(context, &(factor_en_deriv_e[0][0][0])); +size_max=0; +rc = qmckl_get_jastrow_factor_en_deriv_e(context, &(factor_en_deriv_e[0][0][0]),&size_max); // check factor_en_deriv_e assert(fabs(factor_en_deriv_e[0][0][0]-0.11609919541763383) < 1.e-12); From dcb392c0afc4bcbef1c259b6fcd40a20b8d5227b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 11 Feb 2022 16:07:25 +0100 Subject: [PATCH 21/29] Swap indices 1..5 with points in AOs/MOs --- Makefile.am | 6 +- configure.ac | 10 +- org/qmckl_ao.org | 616 +++++++++++++++++++++++++++++--------- org/qmckl_mo.org | 148 ++++------ tools/Building.org | 641 ---------------------------------------- tools/build_makefile.py | 20 +- tools/build_qmckl_f.sh | 8 +- tools/config_tangle.el | 8 +- tools/tangle.sh | 2 +- 9 files changed, 558 insertions(+), 901 deletions(-) delete mode 100644 tools/Building.org diff --git a/Makefile.am b/Makefile.am index 8fae847..1137766 100644 --- a/Makefile.am +++ b/Makefile.am @@ -47,9 +47,9 @@ pkgconfig_DATA = pkgconfig/qmckl.pc qmckl_h = include/qmckl.h include_HEADERS = $(qmckl_h) -test_qmckl_f = tests/qmckl_f.f90 +test_qmckl_f = tests/qmckl_f.F90 test_qmckl_fo = tests/qmckl_f.o -src_qmckl_f = src/qmckl_f.f90 +src_qmckl_f = src/qmckl_f.F90 src_qmckl_fo = src/qmckl_f.o header_tests = tests/chbrclf.h tests/n2.h @@ -139,7 +139,7 @@ cat_h_verbose_0 = @echo " HEADER $@"; ## Rules ## ===== -SUFFIXES = .f90 .h .org .c _f.f90 _func.h _type.h _private_func.h _private_type.h +SUFFIXES = .F90 .h .org .c _f.F90 _func.h _type.h _private_func.h _private_type.h $(test_qmckl_f): $(src_qmckl_f) cp $(src_qmckl_f) $(test_qmckl_f) diff --git a/configure.ac b/configure.ac index 1f58783..6654fd7 100644 --- a/configure.ac +++ b/configure.ac @@ -71,13 +71,16 @@ AC_LANG(C) # Checks for programs. AC_PROG_CC +AC_PROG_F77 + # Make sure the c compiler supports C99 m4_version_prereq([2.70],[], [AC_PROG_CC_C99]) AS_IF([test "$ac_cv_prog_cc_c99" = "no"], [AC_MSG_ERROR([The compiler does not support C99])]) AC_PROG_CC_C_O AC_PROG_FC AC_PROG_FC_C_O -AC_FC_SRCEXT([f90]) +AC_FC_PP_DEFINE +AC_FC_SRCEXT([F90]) AC_FC_FREEFORM LT_INIT AC_PROG_INSTALL @@ -192,6 +195,10 @@ esac # Options. +AC_ARG_ENABLE(hpc, [AS_HELP_STRING([--enable-hpc],[Use HPC-optimized functions])], HAVE_HPC=$enableval, HAVE_HPC=no) +AS_IF([test "$HAVE_HPC" = "yes"], [ + AC_DEFINE([HAVE_HPC], [1], [If defined, activate HPC routines]) +]) AC_ARG_ENABLE(debug, [AS_HELP_STRING([--enable-debug],[compile for debugging])], ok=$enableval, ok=no) if test "$ok" = "yes"; then @@ -336,6 +343,7 @@ FCLAGS..........: ${FCFLAGS} LDFLAGS:........: ${LDFLAGS} LIBS............: ${LIBS} USE CHAMELEON...: ${with_chameleon} +HPC version.....: ${HAVE_HPC} Package features: ${ARGS} diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index 28a831b..d40e478 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -58,6 +58,12 @@ gradients and Laplacian of the atomic basis functions. #include #+end_src + #+begin_src f90 :tangle (eval f) :noweb yes +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + #+end_src + #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "assert.h" @@ -2460,11 +2466,11 @@ for (int64_t i=0 ; i < ao_num ; ++i) { |----------------------+-----------------------------------+----------------------------------------------------------------------------------------------| | Variable | Type | Description | |----------------------+-----------------------------------+----------------------------------------------------------------------------------------------| - | ~primitive_vgl~ | ~double[5][point_num][prim_num]~ | Value, gradients, Laplacian of the primitives at current positions | + | ~primitive_vgl~ | ~double[point_num][5][prim_num]~ | Value, gradients, Laplacian of the primitives at current positions | | ~primitive_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the primitives at current positions | - | ~shell_vgl~ | ~double[5][point_num][shell_num]~ | Value, gradients, Laplacian of the primitives at current positions | + | ~shell_vgl~ | ~double[point_num][5][shell_num]~ | Value, gradients, Laplacian of the primitives at current positions | | ~shell_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the AOs at current positions | - | ~ao_vgl~ | ~double[5][point_num][ao_num]~ | Value, gradients, Laplacian of the primitives at current positions | + | ~ao_vgl~ | ~double[point_num][5][ao_num]~ | Value, gradients, Laplacian of the primitives at current positions | | ~ao_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the AOs at current positions | @@ -3055,7 +3061,7 @@ assert(0 == test_qmckl_ao_gaussian_vgl(context)); | ~coord~ | ~double[3][point_num]~ | in | Coordinates | | ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates | | ~expo~ | ~double[prim_num]~ | in | Exponents of the primitives | - | ~primitive_vgl~ | ~double[5][point_num][prim_num]~ | out | Value, gradients and Laplacian of the primitives | + | ~primitive_vgl~ | ~double[point_num][5][prim_num]~ | out | Value, gradients and Laplacian of the primitives | #+CALL: generate_c_header(table=qmckl_ao_basis_primitive_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_primitive_gaussian_vgl")) @@ -3091,7 +3097,7 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( & double precision , intent(in) :: coord(point_num,3) double precision , intent(in) :: nucl_coord(nucl_num,3) double precision , intent(in) :: expo(prim_num) - double precision , intent(out) :: primitive_vgl(prim_num,point_num,5) + double precision , intent(out) :: primitive_vgl(prim_num,5,point_num) integer*8 :: inucl, iprim, ipoint double precision :: x, y, z, two_a, ar2, r2, v, cutoff @@ -3116,11 +3122,11 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( & v = dexp(-ar2) two_a = -2.d0 * expo(iprim) * v - primitive_vgl(iprim, ipoint, 1) = v - primitive_vgl(iprim, ipoint, 2) = two_a * x - primitive_vgl(iprim, ipoint, 3) = two_a * y - primitive_vgl(iprim, ipoint, 4) = two_a * z - primitive_vgl(iprim, ipoint, 5) = two_a * (3.d0 - 2.d0*ar2) + primitive_vgl(iprim, 1, ipoint) = v + primitive_vgl(iprim, 2, ipoint) = two_a * x + primitive_vgl(iprim, 3, ipoint) = two_a * y + primitive_vgl(iprim, 4, ipoint) = two_a * z + primitive_vgl(iprim, 5, ipoint) = two_a * (3.d0 - 2.d0*ar2) end do end do @@ -3156,7 +3162,7 @@ end function qmckl_compute_ao_basis_primitive_gaussian_vgl_f real (c_double ) , intent(in) :: coord(point_num,3) real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) real (c_double ) , intent(in) :: expo(prim_num) - real (c_double ) , intent(out) :: primitive_vgl(prim_num,point_num,5) + real (c_double ) , intent(out) :: primitive_vgl(prim_num,5,point_num) integer(c_int32_t), external :: qmckl_compute_ao_basis_primitive_gaussian_vgl_f info = qmckl_compute_ao_basis_primitive_gaussian_vgl_f & @@ -3317,17 +3323,17 @@ print ( "[7][4][26] : %e"% lf(a,x,y)) - double prim_vgl[5][elec_num*walk_num][prim_num]; + double prim_vgl[elec_num*walk_num][5][prim_num]; rc = qmckl_get_ao_basis_primitive_vgl(context, &(prim_vgl[0][0][0]), (int64_t) 5*elec_num*walk_num*prim_num ); assert (rc == QMCKL_SUCCESS); - assert( fabs(prim_vgl[0][26][7] - ( 1.0501570432064878E-003)) < 1.e-14 ); - assert( fabs(prim_vgl[1][26][7] - (-7.5014974095310560E-004)) < 1.e-14 ); - assert( fabs(prim_vgl[2][26][7] - (-3.8250692897610380E-003)) < 1.e-14 ); - assert( fabs(prim_vgl[3][26][7] - ( 3.4950559194080275E-003)) < 1.e-14 ); - assert( fabs(prim_vgl[4][26][7] - ( 2.0392163767356572E-002)) < 1.e-14 ); + assert( fabs(prim_vgl[26][0][7] - ( 1.0501570432064878E-003)) < 1.e-14 ); + assert( fabs(prim_vgl[26][1][7] - (-7.5014974095310560E-004)) < 1.e-14 ); + assert( fabs(prim_vgl[26][2][7] - (-3.8250692897610380E-003)) < 1.e-14 ); + assert( fabs(prim_vgl[26][3][7] - ( 3.4950559194080275E-003)) < 1.e-14 ); + assert( fabs(prim_vgl[26][4][7] - ( 2.0392163767356572E-002)) < 1.e-14 ); } @@ -3387,7 +3393,7 @@ for (j=0 ; j 0) then + pows(-2:0,1:3) = 1.d0 + do i=1,lmax + pows(i,1) = pows(i-1,1) * Y(1) + pows(i,2) = pows(i-1,2) * Y(2) + pows(i,3) = pows(i-1,3) * Y(3) + end do + + l (1:3,1:4) = 0 + VGL(1:4,1:5) = 0.d0 + + VGL(1 ,1 ) = 1.d0 + VGL(2:4,1:5) = 0.d0 + + l (1,2) = 1 + VGL(2,1) = pows(1,1) + VGL(2,2) = 1.d0 + + l (2,3) = 1 + VGL(3,1) = pows(1,2) + VGL(3,3) = 1.d0 + + l (3,4) = 1 + VGL(4,1) = pows(1,3) + VGL(4,4) = 1.d0 + + n=4 + endif + + ! l>=2 + dd = 2.d0 + do d=2,lmax + da = dd + do a=d,0,-1 + db = dd-da + do b=d-a,0,-1 + c = d - a - b + dc = dd - da - db + n = n+1 + + l(1,n) = a + l(2,n) = b + l(3,n) = c + + xy = pows(a,1) * pows(b,2) + yz = pows(b,2) * pows(c,3) + xz = pows(a,1) * pows(c,3) + + VGL(n,1) = xy * pows(c,3) + + xy = dc * xy + xz = db * xz + yz = da * yz + + VGL(n,2) = pows(a-1,1) * yz + VGL(n,3) = pows(b-1,2) * xz + VGL(n,4) = pows(c-1,3) * xy + + VGL(n,5) = & + (da-1.d0) * pows(a-2,1) * yz + & + (db-1.d0) * pows(b-2,2) * xz + & + (dc-1.d0) * pows(c-2,3) * xy + + db = db - 1.d0 + end do + da = da - 1.d0 + end do + dd = dd + 1.d0 + end do + + info = QMCKL_SUCCESS + +end function qmckl_ao_polynomial_transp_vgl_f + #+end_src + + #+CALL: generate_c_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_ao_polynomial_transp_vgl & + (context, X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) result(info) + + use, intrinsic :: iso_c_binding + implicit none + + integer (c_int64_t) , intent(in) , value :: context + real (c_double ) , intent(in) :: X(3) + real (c_double ) , intent(in) :: R(3) + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(inout) :: n + integer (c_int32_t) , intent(out) :: L(ldl,n) + integer (c_int64_t) , intent(in) , value :: ldl + real (c_double ) , intent(out) :: VGL(ldv,5) + integer (c_int64_t) , intent(in) , value :: ldv + + integer(c_int32_t), external :: qmckl_ao_polynomial_transp_vgl_f + info = qmckl_ao_polynomial_transp_vgl_f & + (context, X, R, lmax, n, L, ldl, VGL, ldv) + + end function qmckl_ao_polynomial_transp_vgl + #+end_src + + #+CALL: generate_f_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_ao_polynomial_transp_vgl & + (context, X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (c_int64_t) , intent(in) , value :: context + real (c_double ) , intent(in) :: X(3) + real (c_double ) , intent(in) :: R(3) + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(inout) :: n + integer (c_int32_t) , intent(out) :: L(ldl,n) + integer (c_int64_t) , intent(in) , value :: ldl + real (c_double ) , intent(out) :: VGL(ldv,5) + integer (c_int64_t) , intent(in) , value :: ldv + + end function qmckl_ao_polynomial_transp_vgl + end interface + #+end_src + *** Test :noexport: #+begin_src f90 :tangle (eval f_test) @@ -4348,11 +4551,12 @@ end function test_qmckl_ao_polynomial_vgl | ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | in | Maximum angular momentum per nucleus | | ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell | | ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs | - | ~shell_vgl~ | ~double[5][point_num][shell_num]~ | in | Value, gradients and Laplacian of the shells | - | ~ao_vgl~ | ~double[5][point_num][ao_num]~ | out | Value, gradients and Laplacian of the AOs | + | ~shell_vgl~ | ~double[point_num][5][shell_num]~ | in | Value, gradients and Laplacian of the shells | + | ~ao_vgl~ | ~double[point_num][5][ao_num]~ | out | Value, gradients and Laplacian of the AOs | +** Unoptimized version #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_ao_vgl_f(context, & +integer function qmckl_compute_ao_vgl_doc_f(context, & ao_num, shell_num, point_num, nucl_num, & coord, nucl_coord, nucleus_index, nucleus_shell_num, & nucleus_range, nucleus_max_ang_mom, shell_ang_mom, & @@ -4373,12 +4577,12 @@ integer function qmckl_compute_ao_vgl_f(context, & integer , intent(in) :: nucleus_max_ang_mom(nucl_num) integer , intent(in) :: shell_ang_mom(shell_num) double precision , intent(in) :: ao_factor(ao_num) - double precision , intent(in) :: shell_vgl(shell_num,point_num,5) - double precision , intent(out) :: ao_vgl(ao_num,point_num,5) + double precision , intent(in) :: shell_vgl(shell_num,5,point_num) + double precision , intent(out) :: ao_vgl(ao_num,5,point_num) double precision :: e_coord(3), n_coord(3) integer*8 :: n_poly - integer :: l, il, k, m, n + integer :: l, il, k integer*8 :: ipoint, inucl, ishell integer*8 :: ishell_start, ishell_end integer :: lstart(0:20) @@ -4388,102 +4592,229 @@ integer function qmckl_compute_ao_vgl_f(context, & double precision, allocatable :: poly_vgl(:,:) integer , allocatable :: powers(:,:) - integer , allocatable :: kil(:), knucl(:), kshell(:) - allocate(poly_vgl(8,ao_num), powers(8,ao_num)) - allocate(kil(ao_num), kshell(ao_num), knucl(nucl_num+1)) + allocate(poly_vgl(5,ao_num), powers(3,ao_num)) ! Pre-computed data - - k=1 - do inucl=1,nucl_num - knucl(inucl) = k - ishell_start = nucleus_index(inucl) + 1 - ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) - do ishell = ishell_start, ishell_end - l = shell_ang_mom(ishell) - m = l*(l+1)*(l+2)/6 +1 - n = (l+1)*(l+2)*(l+3)/6 - do il = m, n - kil(k) = il - kshell(k) = ishell - k = k+1 - end do - end do + do l=0,20 + lstart(l) = l*(l+1)*(l+2)/6 +1 end do - knucl(nucl_num+1) = ao_num+1 - info = QMCKL_SUCCESS ! Don't compute polynomials when the radial part is zero. - ! TODO : Use numerical precision here cutoff = -dlog(1.d-12) do ipoint = 1, point_num e_coord(1) = coord(ipoint,1) e_coord(2) = coord(ipoint,2) e_coord(3) = coord(ipoint,3) - - ! Express the radial part in the AO basis - + k=1 do inucl=1,nucl_num - n_coord(1) = nucl_coord(inucl,1) - n_coord(2) = nucl_coord(inucl,2) - n_coord(3) = nucl_coord(inucl,3) + n_coord(1) = nucl_coord(inucl,1) + n_coord(2) = nucl_coord(inucl,2) + n_coord(3) = nucl_coord(inucl,3) ! Test if the point is in the range of the nucleus x = e_coord(1) - n_coord(1) y = e_coord(2) - n_coord(2) z = e_coord(3) - n_coord(3) - r2 = x*x + y*y + z*z + r2 = x*x + z*z + z*z if (r2 > cutoff*nucleus_range(inucl)) then - do k = knucl(inucl), knucl(inucl+1)-1 - ao_vgl(k,ipoint,1) = 0.d0 - ao_vgl(k,ipoint,2) = 0.d0 - ao_vgl(k,ipoint,3) = 0.d0 - ao_vgl(k,ipoint,4) = 0.d0 - ao_vgl(k,ipoint,5) = 0.d0 - end do cycle end if - ! Compute polynomials + ! Compute polynomials info = qmckl_ao_polynomial_vgl_f(context, e_coord, n_coord, & - nucleus_max_ang_mom(inucl), n_poly, powers, 8_8, poly_vgl, 8_8) + nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, & + poly_vgl, 5_8) - do k = knucl(inucl), knucl(inucl+1)-1 - y = shell_vgl(kshell(k),ipoint,1) * ao_factor(k) + ! Loop over shells + ishell_start = nucleus_index(inucl) + 1 + ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) + do ishell = ishell_start, ishell_end + l = shell_ang_mom(ishell) + do il = lstart(l), lstart(l+1)-1 + ! Value + ao_vgl(k,1,ipoint) = & + poly_vgl(1,il) * shell_vgl(ishell,1,ipoint) * ao_factor(k) - ao_vgl(k,ipoint,1) = y * poly_vgl(1,kil(k)) - ao_vgl(k,ipoint,2) = y * poly_vgl(2,kil(k)) - ao_vgl(k,ipoint,3) = y * poly_vgl(3,kil(k)) - ao_vgl(k,ipoint,4) = y * poly_vgl(4,kil(k)) - ao_vgl(k,ipoint,5) = y * poly_vgl(5,kil(k)) + ! Grad_x + ao_vgl(k,2,ipoint) = ( & + poly_vgl(2,il) * shell_vgl(ishell,1,ipoint) + & + poly_vgl(1,il) * shell_vgl(ishell,2,ipoint) & + ) * ao_factor(k) - x = poly_vgl(1,kil(k)) * ao_factor(k) + ! Grad_y + ao_vgl(k,3,ipoint) = ( & + poly_vgl(3,il) * shell_vgl(ishell,1,ipoint) + & + poly_vgl(1,il) * shell_vgl(ishell,3,ipoint) & + ) * ao_factor(k) - ao_vgl(k,ipoint,2) = ao_vgl(k,ipoint,2) + x * shell_vgl(kshell(k),ipoint,2) - ao_vgl(k,ipoint,3) = ao_vgl(k,ipoint,3) + x * shell_vgl(kshell(k),ipoint,3) - ao_vgl(k,ipoint,4) = ao_vgl(k,ipoint,4) + x * shell_vgl(kshell(k),ipoint,4) - ao_vgl(k,ipoint,5) = ao_vgl(k,ipoint,5) + x * shell_vgl(kshell(k),ipoint,5) + ! Grad_z + ao_vgl(k,4,ipoint) = ( & + poly_vgl(4,il) * shell_vgl(ishell,1,ipoint) + & + poly_vgl(1,il) * shell_vgl(ishell,4,ipoint) & + ) * ao_factor(k) - ao_vgl(k,ipoint,5) = ao_vgl(k,ipoint,5) + & - (ao_factor(k) + ao_factor(k)) * (& - poly_vgl(2,kil(k)) * shell_vgl(kshell(k),ipoint,2) + & - poly_vgl(3,kil(k)) * shell_vgl(kshell(k),ipoint,3) + & - poly_vgl(4,kil(k)) * shell_vgl(kshell(k),ipoint,4) ) + ! Lapl_z + ao_vgl(k,5,ipoint) = ( & + poly_vgl(5,il) * shell_vgl(ishell,1,ipoint) + & + poly_vgl(1,il) * shell_vgl(ishell,5,ipoint) + & + 2.d0 * ( & + poly_vgl(2,il) * shell_vgl(ishell,2,ipoint) + & + poly_vgl(3,il) * shell_vgl(ishell,3,ipoint) + & + poly_vgl(4,il) * shell_vgl(ishell,4,ipoint) ) & + ) * ao_factor(k) + + k = k+1 + end do end do - end do end do - deallocate(poly_vgl, powers, kshell, kil, knucl) -end function qmckl_compute_ao_vgl_f + deallocate(poly_vgl, powers) +end function qmckl_compute_ao_vgl_doc_f #+end_src +** HPC version + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_ao_vgl_hpc_f(context, & + ao_num, shell_num, point_num, nucl_num, & + coord, nucl_coord, nucleus_index, nucleus_shell_num, & + nucleus_range, nucleus_max_ang_mom, shell_ang_mom, & + ao_factor, shell_vgl, ao_vgl) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: ao_num + integer*8 , intent(in) :: shell_num + integer*8 , intent(in) :: point_num + integer*8 , intent(in) :: nucl_num + double precision , intent(in) :: coord(point_num,3) + double precision , intent(in) :: nucl_coord(nucl_num,3) + integer*8 , intent(in) :: nucleus_index(nucl_num) + integer*8 , intent(in) :: nucleus_shell_num(nucl_num) + double precision , intent(in) :: nucleus_range(nucl_num) + integer , intent(in) :: nucleus_max_ang_mom(nucl_num) + integer , intent(in) :: shell_ang_mom(shell_num) + double precision , intent(in) :: ao_factor(ao_num) + double precision , intent(in) :: shell_vgl(shell_num,5,point_num) + double precision , intent(out) :: ao_vgl(ao_num,5,point_num) + + double precision :: e_coord(3), n_coord(3) + integer*8 :: n_poly + integer :: l, il, k + integer*8 :: ipoint, inucl, ishell + integer*8 :: ishell_start, ishell_end + integer :: lstart(0:20) + double precision :: x, y, z, r2 + double precision :: cutoff + integer, external :: qmckl_ao_polynomial_transp_vgl_f + + double precision, allocatable :: poly_vgl(:,:) + integer , allocatable :: powers(:,:) + + allocate(poly_vgl(ao_num,5), powers(3,ao_num)) + + ! Pre-computed data + do l=0,20 + lstart(l) = l*(l+1)*(l+2)/6 +1 + end do + + info = QMCKL_SUCCESS + + ! Don't compute polynomials when the radial part is zero. + cutoff = -dlog(1.d-12) + + do ipoint = 1, point_num + e_coord(1) = coord(ipoint,1) + e_coord(2) = coord(ipoint,2) + e_coord(3) = coord(ipoint,3) + k=1 + do inucl=1,nucl_num + n_coord(1) = nucl_coord(inucl,1) + n_coord(2) = nucl_coord(inucl,2) + n_coord(3) = nucl_coord(inucl,3) + + ! Test if the point is in the range of the nucleus + x = e_coord(1) - n_coord(1) + y = e_coord(2) - n_coord(2) + z = e_coord(3) - n_coord(3) + + r2 = x*x + z*z + z*z + + if (r2 > cutoff*nucleus_range(inucl)) then + cycle + end if + + ! Compute polynomials + info = qmckl_ao_polynomial_transp_vgl_f(context, e_coord, n_coord, & + nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, & + poly_vgl, int(ao_num,8)) + + ! Loop over shells + ishell_start = nucleus_index(inucl) + 1 + ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) + do ishell = ishell_start, ishell_end + l = shell_ang_mom(ishell) + if (shell_vgl(ishell,1,ipoint) /= 0.d0) then + do il = lstart(l), lstart(l+1)-1 + ! Value + ao_vgl(k,1,ipoint) = & + poly_vgl(il,1) * shell_vgl(ishell,1,ipoint) * ao_factor(k) + + ! Grad_x + ao_vgl(k,2,ipoint) = ( & + poly_vgl(il,2) * shell_vgl(ishell,1,ipoint) + & + poly_vgl(il,1) * shell_vgl(ishell,2,ipoint) & + ) * ao_factor(k) + + ! Grad_y + ao_vgl(k,3,ipoint) = ( & + poly_vgl(il,3) * shell_vgl(ishell,1,ipoint) + & + poly_vgl(il,1) * shell_vgl(ishell,3,ipoint) & + ) * ao_factor(k) + + ! Grad_z + ao_vgl(k,4,ipoint) = ( & + poly_vgl(il,4) * shell_vgl(ishell,1,ipoint) + & + poly_vgl(il,1) * shell_vgl(ishell,4,ipoint) & + ) * ao_factor(k) + + ! Lapl_z + ao_vgl(k,5,ipoint) = ( & + poly_vgl(il,5) * shell_vgl(ishell,1,ipoint) + & + poly_vgl(il,1) * shell_vgl(ishell,5,ipoint) + & + 2.d0 * ( & + poly_vgl(il,2) * shell_vgl(ishell,2,ipoint) + & + poly_vgl(il,3) * shell_vgl(ishell,3,ipoint) + & + poly_vgl(il,4) * shell_vgl(ishell,4,ipoint) ) & + ) * ao_factor(k) + k = k+1 + end do + else + do il = lstart(l), lstart(l+1)-1 + ao_vgl(k,1,ipoint) = 0.d0 + ao_vgl(k,2,ipoint) = 0.d0 + ao_vgl(k,3,ipoint) = 0.d0 + ao_vgl(k,4,ipoint) = 0.d0 + ao_vgl(k,5,ipoint) = 0.d0 + k = k+1 + end do + end if + end do + end do + end do + + deallocate(poly_vgl, powers) +end function qmckl_compute_ao_vgl_hpc_f + #+end_src + +** Interfaces # #+CALL: generate_c_header(table=qmckl_ao_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl")) # (Commented because the header needs to go into h_private_func @@ -4545,11 +4876,16 @@ end function qmckl_compute_ao_vgl_f integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num) integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num) real (c_double ) , intent(in) :: ao_factor(ao_num) - real (c_double ) , intent(in) :: shell_vgl(shell_num,point_num,5) - real (c_double ) , intent(out) :: ao_vgl(ao_num,point_num,5) + real (c_double ) , intent(in) :: shell_vgl(shell_num,5,point_num) + real (c_double ) , intent(out) :: ao_vgl(ao_num,5,point_num) - integer(c_int32_t), external :: qmckl_compute_ao_vgl_f - info = qmckl_compute_ao_vgl_f & +#ifdef HAVE_HPC + integer(c_int32_t), external :: qmckl_compute_ao_vgl_hpc_f + info = qmckl_compute_ao_vgl_hpc_f & +#else + integer(c_int32_t), external :: qmckl_compute_ao_vgl_doc_f + info = qmckl_compute_ao_vgl_doc_f & +#endif (context, & ao_num, & shell_num, & @@ -4750,39 +5086,39 @@ rc = qmckl_set_electron_coord (context, 'N', elec_coord, walk_num*elec_num*3); assert(rc == QMCKL_SUCCESS); -double ao_vgl[5][elec_num][ao_num]; +double ao_vgl[elec_num][5][ao_num]; rc = qmckl_get_ao_basis_ao_vgl(context, &(ao_vgl[0][0][0]), (int64_t) 5*elec_num*ao_num); assert (rc == QMCKL_SUCCESS); printf("\n"); -printf(" ao_vgl ao_vgl[0][26][219] %25.15e\n", ao_vgl[0][26][219]); -printf(" ao_vgl ao_vgl[1][26][219] %25.15e\n", ao_vgl[1][26][219]); -printf(" ao_vgl ao_vgl[0][26][220] %25.15e\n", ao_vgl[0][26][220]); -printf(" ao_vgl ao_vgl[1][26][220] %25.15e\n", ao_vgl[1][26][220]); -printf(" ao_vgl ao_vgl[0][26][221] %25.15e\n", ao_vgl[0][26][221]); -printf(" ao_vgl ao_vgl[1][26][221] %25.15e\n", ao_vgl[1][26][221]); -printf(" ao_vgl ao_vgl[0][26][222] %25.15e\n", ao_vgl[0][26][222]); -printf(" ao_vgl ao_vgl[1][26][222] %25.15e\n", ao_vgl[1][26][222]); -printf(" ao_vgl ao_vgl[0][26][223] %25.15e\n", ao_vgl[0][26][223]); -printf(" ao_vgl ao_vgl[1][26][223] %25.15e\n", ao_vgl[1][26][223]); -printf(" ao_vgl ao_vgl[0][26][224] %25.15e\n", ao_vgl[0][26][224]); -printf(" ao_vgl ao_vgl[1][26][224] %25.15e\n", ao_vgl[1][26][224]); +printf(" ao_vgl ao_vgl[0][26][219] %25.15e\n", ao_vgl[26][0][219]); +printf(" ao_vgl ao_vgl[1][26][219] %25.15e\n", ao_vgl[26][1][219]); +printf(" ao_vgl ao_vgl[0][26][220] %25.15e\n", ao_vgl[26][0][220]); +printf(" ao_vgl ao_vgl[1][26][220] %25.15e\n", ao_vgl[26][1][220]); +printf(" ao_vgl ao_vgl[0][26][221] %25.15e\n", ao_vgl[26][0][221]); +printf(" ao_vgl ao_vgl[1][26][221] %25.15e\n", ao_vgl[26][1][221]); +printf(" ao_vgl ao_vgl[0][26][222] %25.15e\n", ao_vgl[26][0][222]); +printf(" ao_vgl ao_vgl[1][26][222] %25.15e\n", ao_vgl[26][1][222]); +printf(" ao_vgl ao_vgl[0][26][223] %25.15e\n", ao_vgl[26][0][223]); +printf(" ao_vgl ao_vgl[1][26][223] %25.15e\n", ao_vgl[26][1][223]); +printf(" ao_vgl ao_vgl[0][26][224] %25.15e\n", ao_vgl[26][0][224]); +printf(" ao_vgl ao_vgl[1][26][224] %25.15e\n", ao_vgl[26][1][224]); printf("\n"); -assert( fabs(ao_vgl[0][26][219] - ( 1.020298798341620e-08)) < 1.e-14 ); -assert( fabs(ao_vgl[1][26][219] - (-4.928035238010602e-08)) < 1.e-14 ); -assert( fabs(ao_vgl[0][26][220] - ( 1.516643537739178e-08)) < 1.e-14 ); -assert( fabs(ao_vgl[1][26][220] - (-7.725221462603871e-08)) < 1.e-14 ); -assert( fabs(ao_vgl[0][26][221] - (-4.686370882518819e-09)) < 1.e-14 ); -assert( fabs(ao_vgl[1][26][221] - ( 2.387064067626827e-08)) < 1.e-14 ); -assert( fabs(ao_vgl[0][26][222] - ( 7.514816980753531e-09)) < 1.e-14 ); -assert( fabs(ao_vgl[1][26][222] - (-4.025889138635182e-08)) < 1.e-14 ); -assert( fabs(ao_vgl[0][26][223] - (-4.021908374204471e-09)) < 1.e-14 ); -assert( fabs(ao_vgl[1][26][223] - ( 2.154644255710413e-08)) < 1.e-14 ); -assert( fabs(ao_vgl[0][26][224] - ( 7.175045873560788e-10)) < 1.e-14 ); -assert( fabs(ao_vgl[1][26][224] - (-3.843864637762753e-09)) < 1.e-14 ); +assert( fabs(ao_vgl[26][0][219] - ( 1.020298798341620e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[26][1][219] - (-4.928035238010602e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[26][0][220] - ( 1.516643537739178e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[26][1][220] - (-7.725221462603871e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[26][0][221] - (-4.686370882518819e-09)) < 1.e-14 ); +assert( fabs(ao_vgl[26][1][221] - ( 2.387064067626827e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[26][0][222] - ( 7.514816980753531e-09)) < 1.e-14 ); +assert( fabs(ao_vgl[26][1][222] - (-4.025889138635182e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[26][0][223] - (-4.021908374204471e-09)) < 1.e-14 ); +assert( fabs(ao_vgl[26][1][223] - ( 2.154644255710413e-08)) < 1.e-14 ); +assert( fabs(ao_vgl[26][0][224] - ( 7.175045873560788e-10)) < 1.e-14 ); +assert( fabs(ao_vgl[26][1][224] - (-3.843864637762753e-09)) < 1.e-14 ); } #+end_src diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index 462828d..709fb31 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -90,11 +90,11 @@ int main() { Computed data: - |---------------+-------------------------+----------------------------------------------------------------------------------------| - |---------------+-------------------------+----------------------------------------------------------------------------------------| - | ~mo_vgl~ | ~[5][elec_num][mo_num]~ | Value, gradients, Laplacian of the MOs at electron positions | - | ~mo_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | - |---------------+-------------------------+----------------------------------------------------------------------------------------| + |---------------+--------------------------+-------------------------------------------------------------------------------------| + |---------------+--------------------------+-------------------------------------------------------------------------------------| + | ~mo_vgl~ | ~[point_num][5][mo_num]~ | Value, gradients, Laplacian of the MOs at point positions | + | ~mo_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at point positions | + |---------------+--------------------------+-------------------------------------------------------------------------------------| ** Data structure @@ -388,7 +388,7 @@ qmckl_exit_code qmckl_get_mo_basis_vgl(qmckl_context context, double* const mo_v qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = 5 * ctx->electron.num * ctx->mo_basis.mo_num; + size_t sze = 5 * ctx->point.num * ctx->mo_basis.mo_num; memcpy(mo_vgl, ctx->mo_basis.mo_vgl, sze * sizeof(double)); return QMCKL_SUCCESS; @@ -442,13 +442,6 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) NULL); } - if(!(ctx->electron.provided)) { - return qmckl_failwith( context, - QMCKL_NOT_PROVIDED, - "qmckl_electron", - NULL); - } - if (!ctx->mo_basis.provided) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, @@ -457,13 +450,13 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) } /* Compute if necessary */ - if (ctx->electron.coord_new_date > ctx->mo_basis.mo_vgl_date) { + if (ctx->point.date > ctx->mo_basis.mo_vgl_date) { /* Allocate array */ if (ctx->mo_basis.mo_vgl == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = 5 * ctx->electron.num * ctx->mo_basis.mo_num * sizeof(double); + mem_info.size = 5 * ctx->point.num * ctx->mo_basis.mo_num * sizeof(double); double* mo_vgl = (double*) qmckl_malloc(context, mem_info); if (mo_vgl == NULL) { @@ -478,7 +471,7 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) rc = qmckl_compute_mo_basis_vgl(context, ctx->ao_basis.ao_num, ctx->mo_basis.mo_num, - ctx->electron.num, + ctx->point.num, ctx->mo_basis.coefficient, ctx->ao_basis.ao_vgl, ctx->mo_basis.mo_vgl); @@ -504,85 +497,46 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) | ~qmckl_context~ | ~context~ | in | Global state | | ~int64_t~ | ~ao_num~ | in | Number of AOs | | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~int64_t~ | ~elec_num~ | in | Number of electrons | + | ~int64_t~ | ~point_num~ | in | Number of points | | ~double~ | ~coef_normalized[mo_num][ao_num]~ | in | AO to MO transformation matrix | - | ~double~ | ~ao_vgl[5][elec_num][ao_num]~ | in | Value, gradients and Laplacian of the AOs | - | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | out | Value, gradients and Laplacian of the MOs | + | ~double~ | ~ao_vgl[point_num][5][ao_num]~ | in | Value, gradients and Laplacian of the AOs | + | ~double~ | ~mo_vgl[point_num][5][mo_num]~ | out | Value, gradients and Laplacian of the MOs | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_mo_basis_vgl_f(context, & - ao_num, mo_num, elec_num, & + ao_num, mo_num, point_num, & coef_normalized, ao_vgl, mo_vgl) & result(info) use qmckl implicit none integer(qmckl_context), intent(in) :: context integer*8 , intent(in) :: ao_num, mo_num - integer*8 , intent(in) :: elec_num - double precision , intent(in) :: ao_vgl(ao_num,elec_num,5) + integer*8 , intent(in) :: point_num + double precision , intent(in) :: ao_vgl(ao_num,5,point_num) double precision , intent(in) :: coef_normalized(ao_num,mo_num) - double precision , intent(out) :: mo_vgl(mo_num,elec_num,5) + double precision , intent(out) :: mo_vgl(mo_num,5,point_num) character :: TransA, TransB - double precision,dimension(:,:),allocatable :: mo_vgl_big - double precision,dimension(:,:),allocatable :: ao_vgl_big - !double precision,dimension(:,:),allocatable :: coef_trans - !double precision,dimension(:),allocatable :: coef_all double precision :: alpha, beta - integer :: info_qmckl_dgemm_value - integer*8 :: M, N, K, LDA, LDB, LDC, i,j, idx - - integer*8 :: inucl, iprim, iwalk, ielec, ishell - double precision :: x, y, z, two_a, ar2, r2, v, cutoff - - allocate(mo_vgl_big(mo_num,elec_num*5)) - allocate(ao_vgl_big(ao_num,elec_num*5)) - !allocate(coef_all(mo_num*ao_num)) - !allocate(coef_trans(mo_num,ao_num)) + integer*8 :: M, N, K, LDA, LDB, LDC, i,j TransA = 'T' TransB = 'N' - alpha = 1.0d0 - beta = 0.0d0 + M = mo_num + N = point_num*5_8 + K = int(ao_num,8) + alpha = 1.d0 + beta = 0.d0 + LDA = size(coef_normalized,1) + LDB = size(ao_vgl,1) + LDC = size(mo_vgl,1) + + info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & + coef_normalized, int(size(coef_normalized,1),8), & + ao_vgl, int(size(ao_vgl,1),8), beta, & + mo_vgl,LDC) info = QMCKL_SUCCESS - info_qmckl_dgemm_value = QMCKL_SUCCESS - - ! Don't compute exponentials when the result will be almost zero. - ! TODO : Use numerical precision here - cutoff = -dlog(1.d-15) - M = mo_num - N = elec_num*5 - K = ao_num * 1_8 - LDA = size(coef_normalized,1) - idx = 0 - !do j = 1,ao_num - !do i = 1,mo_num - ! idx = idx + 1 - ! coef_all(idx) = coef_normalized(i,j) - !end do - !end do - !idx = 0 - !do j = 1,mo_num - !do i = 1,ao_num - ! idx = idx + 1 - ! coef_trans(j,i) = coef_all(idx) - !end do - !end do - - ao_vgl_big = reshape(ao_vgl(:, :, :),(/ao_num, elec_num*5_8/)) - LDB = size(ao_vgl_big,1) - LDC = size(mo_vgl_big,1) - - info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - coef_normalized,size(coef_normalized,1)*1_8, & - ao_vgl_big, size(ao_vgl_big,1)*1_8, & - beta, & - mo_vgl_big,LDC) - mo_vgl = reshape(mo_vgl_big,(/mo_num,elec_num,5_8/)) - - deallocate(mo_vgl_big) - deallocate(ao_vgl_big) end function qmckl_compute_mo_basis_vgl_f #+end_src @@ -595,7 +549,7 @@ end function qmckl_compute_mo_basis_vgl_f const qmckl_context context, const int64_t ao_num, const int64_t mo_num, - const int64_t elec_num, + const int64_t point_num, const double* coef_normalized, const double* ao_vgl, double* const mo_vgl ); @@ -607,7 +561,7 @@ end function qmckl_compute_mo_basis_vgl_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_mo_basis_vgl & - (context, ao_num, mo_num, elec_num, coef_normalized, ao_vgl, mo_vgl) & + (context, ao_num, mo_num, point_num, coef_normalized, ao_vgl, mo_vgl) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -616,14 +570,14 @@ end function qmckl_compute_mo_basis_vgl_f integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: ao_num integer (c_int64_t) , intent(in) , value :: mo_num - integer (c_int64_t) , intent(in) , value :: elec_num + integer (c_int64_t) , intent(in) , value :: point_num real (c_double ) , intent(in) :: coef_normalized(ao_num,mo_num) - real (c_double ) , intent(in) :: ao_vgl(ao_num,elec_num,5) - real (c_double ) , intent(out) :: mo_vgl(mo_num,elec_num,5) + real (c_double ) , intent(in) :: ao_vgl(ao_num,5,point_num) + real (c_double ) , intent(out) :: mo_vgl(mo_num,5,point_num) integer(c_int32_t), external :: qmckl_compute_mo_basis_vgl_f info = qmckl_compute_mo_basis_vgl_f & - (context, ao_num, mo_num, elec_num, coef_normalized, ao_vgl, mo_vgl) + (context, ao_num, mo_num, point_num, coef_normalized, ao_vgl, mo_vgl) end function qmckl_compute_mo_basis_vgl #+end_src @@ -799,9 +753,9 @@ assert(rc == QMCKL_SUCCESS); assert(qmckl_ao_basis_provided(context)); -double ao_vgl[5][walk_num][elec_num][chbrclf_ao_num]; +double ao_vgl[walk_num*elec_num][5][chbrclf_ao_num]; -rc = qmckl_get_ao_basis_ao_vgl(context, &(ao_vgl[0][0][0][0]), +rc = qmckl_get_ao_basis_ao_vgl(context, &(ao_vgl[0][0][0]), (int64_t) 5*walk_num*elec_num*chbrclf_ao_num); assert (rc == QMCKL_SUCCESS); @@ -817,7 +771,7 @@ assert (rc == QMCKL_SUCCESS); assert(qmckl_mo_basis_provided(context)); -double mo_vgl[5][elec_num][chbrclf_mo_num]; +double mo_vgl[walk_num*elec_num][5][chbrclf_mo_num]; rc = qmckl_get_mo_basis_vgl(context, &(mo_vgl[0][0][0])); assert (rc == QMCKL_SUCCESS); @@ -863,18 +817,18 @@ assert (rc == QMCKL_SUCCESS); printf("\n"); -printf(" mo_vgl mo_vgl[0][26][219] %25.15e\n", mo_vgl[0][2][3]); -printf(" mo_vgl mo_vgl[1][26][219] %25.15e\n", mo_vgl[1][2][3]); -printf(" mo_vgl mo_vgl[0][26][220] %25.15e\n", mo_vgl[0][2][3]); -printf(" mo_vgl mo_vgl[1][26][220] %25.15e\n", mo_vgl[1][2][3]); -printf(" mo_vgl mo_vgl[0][26][221] %25.15e\n", mo_vgl[0][2][3]); -printf(" mo_vgl mo_vgl[1][26][221] %25.15e\n", mo_vgl[1][2][3]); -printf(" mo_vgl mo_vgl[0][26][222] %25.15e\n", mo_vgl[0][2][3]); -printf(" mo_vgl mo_vgl[1][26][222] %25.15e\n", mo_vgl[1][2][3]); -printf(" mo_vgl mo_vgl[0][26][223] %25.15e\n", mo_vgl[0][2][3]); -printf(" mo_vgl mo_vgl[1][26][223] %25.15e\n", mo_vgl[1][2][3]); -printf(" mo_vgl mo_vgl[0][26][224] %25.15e\n", mo_vgl[0][2][3]); -printf(" mo_vgl mo_vgl[1][26][224] %25.15e\n", mo_vgl[1][2][3]); +printf(" mo_vgl mo_vgl[0][26][219] %25.15e\n", mo_vgl[2][0][3]); +printf(" mo_vgl mo_vgl[1][26][219] %25.15e\n", mo_vgl[2][1][3]); +printf(" mo_vgl mo_vgl[0][26][220] %25.15e\n", mo_vgl[2][0][3]); +printf(" mo_vgl mo_vgl[1][26][220] %25.15e\n", mo_vgl[2][1][3]); +printf(" mo_vgl mo_vgl[0][26][221] %25.15e\n", mo_vgl[2][0][3]); +printf(" mo_vgl mo_vgl[1][26][221] %25.15e\n", mo_vgl[2][1][3]); +printf(" mo_vgl mo_vgl[0][26][222] %25.15e\n", mo_vgl[2][0][3]); +printf(" mo_vgl mo_vgl[1][26][222] %25.15e\n", mo_vgl[2][1][3]); +printf(" mo_vgl mo_vgl[0][26][223] %25.15e\n", mo_vgl[2][0][3]); +printf(" mo_vgl mo_vgl[1][26][223] %25.15e\n", mo_vgl[2][1][3]); +printf(" mo_vgl mo_vgl[0][26][224] %25.15e\n", mo_vgl[2][0][3]); +printf(" mo_vgl mo_vgl[1][26][224] %25.15e\n", mo_vgl[2][1][3]); printf("\n"); } diff --git a/tools/Building.org b/tools/Building.org deleted file mode 100644 index 2cfa91c..0000000 --- a/tools/Building.org +++ /dev/null @@ -1,641 +0,0 @@ -#+TITLE: Building tools -#+STARTUP: indent overview -#+PROPERTY: header-args: :comments both - -This file contains all the tools needed to build the QMCkl library. - -* Helper functions - #+NAME: header - #+begin_src sh :tangle no :exports none :output none -echo "This file was created by tools/Building.org" - #+end_src - - #+NAME: check-src - #+begin_src bash -if [[ $(basename ${PWD}) != "src" ]] ; then - echo "This script needs to be run in the src directory" - exit -1 -fi - #+end_src - - #+NAME: url-issues - : https://github.com/trex-coe/qmckl/issues - - #+NAME: url-web - : https://trex-coe.github.io/qmckl - - #+NAME: license - #+begin_example -BSD 3-Clause License - -Copyright (c) 2020, TREX Center of Excellence -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -1. Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. - -2. Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - -3. Neither the name of the copyright holder nor the names of its - contributors may be used to endorse or promote products derived from - this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - - #+end_example - -* Makefiles -** Makefile.in -:PROPERTIES: -:header-args: :tangle ../src/Makefile.in :noweb yes :comments org -:END: - -This is the main Makefile invoked by the ~make~ command at the root -of the package. To compile the sources, it calls the =Makefile= -located in the =src= directory. This Makefile creates the source -file from the org-mode file, as well as a Makefile, -=Makefile.generated=, dedicated to the compilation of the sources. - -*** Header - -We want the Makefile to be POSIX-compliant, such that it works not -only with GNU Make. - -#+begin_src makefile -# <> - -.POSIX: -#+end_src - -*** Compiler options - -Compiler variables are obtained from the configure script (see =configure.ac=) - -#+begin_src makefile -CC = @CC@ -FC = @FC@ -CFLAGS = @CFLAGS@ -FCFLAGS = @FCFLAGS@ -LDFLAGS = @LDFLAGS@ -DEFS = @DEFS@ - -#+end_src - -*** Variables - -#+begin_src makefile -HAS_CPPCHECK = @HAS_CPPCHECK@ - -# VPATH-related substitution variables -srcdir = @srcdir@ -VPATH = @srcdir@ - -top_srcdir=$(srcdir)/.. -shared_lib=$(top_srcdir)/lib/libqmckl.so -static_lib=$(top_srcdir)/lib/libqmckl.a -qmckl_h=$(top_srcdir)/include/qmckl.h -qmckl_f=$(top_srcdir)/share/qmckl/fortran/qmckl_f.f90 - -export CC CFLAGS DEFS FC FCFLAGS LIBS top_srcdir - -ORG_SOURCE_FILES=$(wildcard $(srcdir)/*.org) -C_SOURCE_FILES=$(patsubst %.org,%.c,$(ORG_SOURCE_FILES)) -INCLUDE=-I$(top_srcdir)/include/ -#+end_src - -*** Rules - -The source files are created during the generation of the file ~Makefile.generated~. -The Makefile.generated is the one that will be distributed with the library. - -#+begin_src makefile -.PHONY: clean shared static doc all check install uninstall -.SECONDARY: # Needed to keep the produced C and Fortran files - -$(shared_lib) $(static_lib): $(qmckl_h) $(qmckl_f) Makefile.generated - $(MAKE) -f Makefile.generated $@ - -install uninstall: Makefile.generated - $(MAKE) -f Makefile.generated $@ - -$(qmckl_f) $(qmckl_h): Makefile.generated - $(top_srcdir)/tools/build_qmckl_h.sh - -shared: $(shared_lib) -static: $(static_lib) -all: shared static doc check - -check: $(static_lib) - $(MAKE) -f Makefile.generated check - -ifeq ($(HAS_CPPCHECK),1) -cppcheck: - cppcheck \ - --addon=cert \ - --enable=warning,style,performance,portability,information \ - qmckl_*.c -endif - -doc: $(ORG_SOURCE_FILES) - $(top_srcdir)/tools/build_doc.sh - -clean: - - $(MAKE) -f Makefile.generated clean - - $(RM) test_qmckl_* test_qmckl.c \ - $(qmckl_h) $(qmckl_f) \ - qmckl_*.f90 qmckl_*.c qmckl_*.h \ - Makefile.generated *.html *.txt - -veryclean: clean FORCE - - $(RM) $(top_srcdir)/share/doc/qmckl/html/*.html \ - $(top_srcdir)/share/doc/qmckl/text/*.txt - -Makefile.generated.in: Makefile $(top_srcdir)/tools/create_makefile.sh $(ORG_SOURCE_FILES) $(top_srcdir)/tools/Building.org - $(top_srcdir)/tools/create_makefile.sh - -Makefile.generated: Makefile.generated.in - cd .. ; ./config.status - -.SUFFIXES: .org .c - -.org.c: - $(top_srcdir)/tools/tangle.sh $< - -#+end_src - -** Script to generate auto-generated Makefile - :PROPERTIES: - :header-args: :tangle create_makefile.sh :noweb yes :shebang #!/bin/bash :comments org - :END: - - This script generates the Makefile that compiles the library. - The ~OUTPUT~ variable contains the name of the generated Makefile,typically - =Makefile.generated=. - - #+begin_src bash -# <> - -<> - -OUTPUT=Makefile.generated.in - #+end_src - - We start by tangling all the org-mode files. - - #+begin_src bash -${top_srcdir}/tools/tangle.sh *.org -${top_srcdir}/tools/build_qmckl_h.sh - #+end_src - - Then we create the list of ~*.o~ files to be created, for library - functions: - - #+begin_src bash -OBJECTS="qmckl_f.o" -for i in $(ls qmckl_*.c qmckl_*f.f90) ; do - FILE=${i%.*} - OBJECTS+=" ${FILE}.o" -done >> $OUTPUT - #+end_src - - for tests in C: - - #+begin_src bash -TESTS="" -for i in $(ls test_qmckl_*.c) ; do - FILE=${i%.c} - TESTS+=" ${FILE}.o" -done >> $OUTPUT - #+end_src - - and for tests in Fortran: - - #+begin_src bash -TESTS_F="" -for i in $(ls test_qmckl_*_f.f90) ; do - FILE=${i%.f90} - TESTS_F+=" ${FILE}.o" -done >> $OUTPUT - #+end_src - - Finally, we append the variables to the Makefile - - #+begin_src bash :noweb yes -cat << EOF > ${OUTPUT} -.POSIX: -.SUFFIXES: - -package = @PACKAGE_TARNAME@ -version = @PACKAGE_VERSION@ - -# VPATH-related substitution variables -srcdir = @srcdir@ -VPATH = @srcdir@ - -prefix = @prefix@ - -CC = @CC@ -DEFS = @DEFS@ -CFLAGS = @CFLAGS@ -I\$(top_srcdir)/munit/ -I\$(top_srcdir)/include -I. -CPPFLAGS = @CPPFLAGS@ -LIBS = @LIBS@ - -FC = @FC@ -FCFLAGS= @FCFLAGS@ - -OBJECT_FILES=$OBJECTS - -TESTS = $TESTS -TESTS_F = $TESTS_F - -LIBS = @LIBS@ -FCLIBS = @FCLIBS@ -EOF - -export -echo ' -<> -' >> ${OUTPUT} - - #+end_src - -and the rules: - -#+NAME: rules - #+begin_src makefile :tangle no -top_srcdir=$(srcdir)/.. -shared_lib=$(top_srcdir)/lib/libqmckl.so -static_lib=$(top_srcdir)/lib/libqmckl.a -qmckl_h=$(top_srcdir)/include/qmckl.h -qmckl_f=$(top_srcdir)/share/qmckl/fortran/qmckl_f.f90 -munit=$(top_srcdir)/munit/munit.c - -datarootdir=$(prefix)/share -datadir=$(datarootdir) -docdir=$(datarootdir)/doc/$(package) -htmldir=$(docdir)/html -libdir=$(prefix)/lib -includedir=$(prefix)/include -fortrandir=$(datarootdir)/$(package)/fortran - - -shared: $(shared_lib) -static: $(static_lib) - - -all: shared static - -$(shared_lib): $(OBJECT_FILES) - $(CC) -shared $(OBJECT_FILES) -o $(shared_lib) - -$(static_lib): $(OBJECT_FILES) - $(AR) rcs $(static_lib) $(OBJECT_FILES) - - -# Test - -qmckl_f.o: $(qmckl_f) - $(FC) $(FCFLAGS) -c $(qmckl_f) -o $@ - -test_qmckl: test_qmckl.c $(qmckl_h) $(static_lib) $(TESTS) $(TESTS_F) - $(CC) $(CFLAGS) $(CPPFLAGS) $(DEFS) $(munit) $(TESTS) $(TESTS_F) \ - $(static_lib) $(LIBS) $(FCLIBS) test_qmckl.c -o $@ - -test_qmckl_shared: test_qmckl.c $(qmckl_h) $(shared_lib) $(TESTS) $(TESTS_F) - $(CC) $(CFLAGS) $(CPPFLAGS) $(DEFS) \ - -Wl,-rpath,$(top_srcdir)/lib -L$(top_srcdir)/lib $(munit) $(TESTS) \ - $(TESTS_F) -lqmckl $(LIBS) $(FCLIBS) test_qmckl.c -o $@ - -check: test_qmckl test_qmckl_shared - ./test_qmckl - -clean: - $(RM) -- *.o *.mod $(shared_lib) $(static_lib) test_qmckl - - - - -install: - install -d $(DESTDIR)$(prefix)/lib - install -d $(DESTDIR)$(prefix)/include - install -d $(DESTDIR)$(prefix)/share/qmckl/fortran - install -d $(DESTDIR)$(prefix)/share/doc/qmckl/html/ - install -d $(DESTDIR)$(prefix)/share/doc/qmckl/text/ - install $(shared_lib) $(DESTDIR)$(libdir)/ - install $(static_lib) $(DESTDIR)$(libdir)/ - install $(qmckl_h) $(DESTDIR)$(includedir) - install $(qmckl_f) $(DESTDIR)$(fortrandir) - install $(top_srcdir)/share/doc/qmckl/html/*.html $(DESTDIR)$(docdir)/html/ - install $(top_srcdir)/share/doc/qmckl/html/*.css $(DESTDIR)$(docdir)/html/ - install $(top_srcdir)/share/doc/qmckl/text/*.txt $(DESTDIR)$(docdir)/text/ - -uninstall: - rm $(DESTDIR)$(libdir)/libqmckl.so - rm $(DESTDIR)$(libdir)/libqmckl.a - rm $(DESTDIR)$(includedir)/qmckl.h - rm -rf $(DESTDIR)$(datarootdir)/$(package) - rm -rf $(DESTDIR)$(docdir) - -.SUFFIXES: .c .f90 .o - -.c.o: - $(CC) $(CFLAGS) $(CPPFLAGS) $(DEFS) -c $*.c -o $*.o - -.f90.o: qmckl_f.o - $(FC) $(FCFLAGS) -c $*.f90 -o $*.o - -.PHONY: check cppcheck clean all - #+end_src - -* Script to tangle the org-mode files - :PROPERTIES: - :header-args: :tangle tangle.sh :noweb yes :shebang #!/bin/bash :comments org - :END: - - #+begin_src bash -# <> - -<> - #+end_src - - This file needs to be run from the QMCKL =src= directory. - - It tangles all the files in the directory. It uses the - =config_tangle.el= file, which contains information required to - compute the current file names using for example ~(eval c)~ to get - the name of the produced C file. - - The file is not tangled if the last modification date of the org - file is less recent than one of the tangled files. - - #+begin_src bash -function tangle() -{ - local org_file=$1 - local c_file=${org_file%.org}.c - local f_file=${org_file%.org}.f90 - - if [[ ${org_file} -ot ${c_file} ]] ; then - return - elif [[ ${org_file} -ot ${f_file} ]] ; then - return - fi - emacs --batch ${org_file} --load=${top_srcdir}/tools/config_tangle.el -f org-babel-tangle -} - -for i in $@ -do - echo "--- ${i} ----" - tangle ${i} -done - #+end_src - -* Script to build the final qmckl.h file - :PROPERTIES: - :header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments org - :END: - - #+begin_src bash :noweb yes -# <> - - #+end_src - - #+NAME: qmckl-header - #+begin_src text :noweb yes ------------------------------------------- - QMCkl - Quantum Monte Carlo kernel library - ------------------------------------------ - - Documentation : <> - Issues : <> - - <> - - - #+end_src - - All the produced header files are concatenated in the =qmckl.h= - file, located in the include directory. The =*_private.h= files - are excluded. - - Put =.h= files in the correct order: - - #+begin_src bash -HEADERS="" -for i in $(cat table_of_contents) -do - HEADERS+="${i%.org}_type.h " -done - -for i in $(cat table_of_contents) -do - HEADERS+="${i%.org}_func.h " -done - #+end_src - - Generate C header file - - #+begin_src bash -OUTPUT="${top_srcdir}/include/qmckl.h" - -cat << EOF > ${OUTPUT} -/* - ,* <> - ,*/ - -#ifndef __QMCKL_H__ -#define __QMCKL_H__ - -#include -#include -#include -EOF - -for i in ${HEADERS} -do - if [[ -f $i ]] ; then - cat $i >> ${OUTPUT} - fi -done - -cat << EOF >> ${OUTPUT} -#endif -EOF - #+end_src - - Generate Fortran interface file from all =qmckl_*_fh.f90= files - - #+begin_src bash -HEADERS_TYPE="qmckl_*_fh_type.f90" -HEADERS="qmckl_*_fh_func.f90" - -OUTPUT="${top_srcdir}/share/qmckl/fortran/qmckl_f.f90" -cat << EOF > ${OUTPUT} -! -! <> -! -module qmckl - use, intrinsic :: iso_c_binding -EOF - -for i in ${HEADERS_TYPE} -do - cat $i >> ${OUTPUT} -done - -for i in ${HEADERS} -do - cat $i >> ${OUTPUT} -done - -cat << EOF >> ${OUTPUT} -end module qmckl -EOF - #+end_src - -* Script to build the documentation - :PROPERTIES: - :header-args:bash: :tangle build_doc.sh :noweb yes :shebang #!/bin/bash :comments org - :END: - - First define readonly global variables. - - #+begin_src bash :noweb yes -readonly DOCS=${top_srcdir}/share/doc/qmckl/ -readonly SRC=${top_srcdir}/src/ -readonly HTMLIZE=${DOCS}/html/htmlize.el -readonly CONFIG_DOC=${top_srcdir}/tools/config_doc.el -readonly CONFIG_TANGLE=${top_srcdir}/tools/config_tangle.el - #+end_src - - Check that all the defined global variables correspond to files. - - #+begin_src bash :noweb yes -function check_preconditions() -{ - if [[ -z ${top_srcdir} ]] - then - print "top_srcdir is not defined" - exit 1 - fi - - for dir in ${DOCS}/html ${DOCS}/text ${SRC} - do - if [[ ! -d ${dir} ]] - then - print "${dir} not found" - exit 2 - fi - done - - for file in ${CONFIG_DOC} ${CONFIG_TANGLE} - do - if [[ ! -f ${file} ]] - then - print "${file} not found" - exit 3 - fi - done -} - #+end_src - - ~install_htmlize~ installs the htmlize Emacs plugin if the - =htmlize.el= file is not present. - - #+begin_src bash :noweb yes -function install_htmlize() -{ - local url="https://github.com/hniksic/emacs-htmlize" - local repo="emacs-htmlize" - - [[ -f ${HTMLIZE} ]] || ( - cd ${DOCS}/html - git clone ${url} \ - && cp ${repo}/htmlize.el ${HTMLIZE} \ - && rm -rf ${repo} - cd - - ) - - # Assert htmlize is installed - [[ -f ${HTMLIZE} ]] \ - || exit 1 -} - #+end_src - - Extract documentation from an org-mode file. - - #+begin_src bash :noweb yes -function extract_doc() -{ - local org=$1 - local local_html=${SRC}/${org%.org}.html - local local_text=${SRC}/${org%.org}.txt - local html=${DOCS}/html/${org%.org}.html - local text=${DOCS}/text/${org%.org}.txt - - if [[ -f ${html} && ${org} -ot ${html} ]] - then - return - fi - emacs --batch \ - --load ${HTMLIZE} \ - --load ${CONFIG_DOC} \ - ${org} \ - --load ${CONFIG_TANGLE} \ - -f org-html-export-to-html \ - -f org-ascii-export-to-ascii - mv ${local_html} ${DOCS}/html - mv ${local_text} ${DOCS}/text - -} - #+end_src - - The main function of the script. - - #+begin_src bash :noweb yes -function main() { - - check_preconditions || exit 1 - - # Install htmlize if needed - install_htmlize || exit 2 - - # Create documentation - cd ${SRC} \ - || exit 3 - - for i in *.org - do - echo - echo "======= ${i} =======" - extract_doc ${i} - done - - if [[ $? -eq 0 ]] - then - cd ${DOCS}/html - rm -f index.html - ln README.html index.html - exit 0 - else - exit 3 - fi -} -main - #+end_src - - diff --git a/tools/build_makefile.py b/tools/build_makefile.py index 653497e..f85bcdb 100755 --- a/tools/build_makefile.py +++ b/tools/build_makefile.py @@ -48,7 +48,7 @@ def main(): c_test_o = "tests/test_"+i+".$(OBJEXT)" f_test_o = "tests/test_"+i+"_f.$(OBJEXT)" c_test = "tests/test_"+i+".c" - f_test = "tests/test_"+i+"_f.f90" + f_test = "tests/test_"+i+"_f.F90" html = "share/doc/qmckl/html/"+i+".html" text = "share/doc/qmckl/text/"+i+".txt" @@ -60,10 +60,10 @@ def main(): h_type=i+"_type.h" h_private_func=i+"_private_func.h" h_private_type=i+"_private_type.h" - f90=i+"_f.f90" + F90=i+"_f.F90" fo=i+"_f.$(OBJEXT)" - fh_func=i+"_fh_func.f90" - fh_type=i+"_fh_type.f90" + fh_func=i+"_fh_func.F90" + fh_type=i+"_fh_type.F90" ORG_FILES += [org] TANGLED_FILES += [tangled] @@ -132,17 +132,17 @@ def main(): DEPS[h_private_func] = [tangled] if "(eval f)" in grep: - F_FILES += [f90] + F_FILES += [F90] - if f90 in DEPS: - DEPS[f90] += [tangled, "$(src_qmckl_fo)"] + if F90 in DEPS: + DEPS[F90] += [tangled, "$(src_qmckl_fo)"] else: - DEPS[f90] = [tangled, "$(src_qmckl_fo)"] + DEPS[F90] = [tangled, "$(src_qmckl_fo)"] if fo in DEPS: - DEPS[fo] += [f90, "$(src_qmckl_fo)"] + DEPS[fo] += [F90, "$(src_qmckl_fo)"] else: - DEPS[fo] = [f90, "$(src_qmckl_fo)"] + DEPS[fo] = [F90, "$(src_qmckl_fo)"] if "(eval fh_func)" in grep: FH_FUNC_FILES += [fh_func] diff --git a/tools/build_qmckl_f.sh b/tools/build_qmckl_f.sh index 6ce896a..b58b023 100755 --- a/tools/build_qmckl_f.sh +++ b/tools/build_qmckl_f.sh @@ -1,9 +1,9 @@ #!/bin/sh -# Script to build the final src/qmckl_f.f90 file +# Script to build the final src/qmckl_f.F90 file set -e -# All the produced header files are concatenated in the =src/qmckl_f.f90= +# All the produced header files are concatenated in the =src/qmckl_f.F90= # file, located in the share/qmckl/fortran directory. @@ -30,8 +30,8 @@ fi # Generate Fortran interface file # ------------------------------- -HEADERS_TYPE="src/qmckl_*_fh_type.f90" -HEADERS="src/qmckl_*_fh_func.f90" +HEADERS_TYPE="src/qmckl_*_fh_type.F90" +HEADERS="src/qmckl_*_fh_func.F90" cat << EOF > ${src_qmckl_f} ! diff --git a/tools/config_tangle.el b/tools/config_tangle.el index 4c29fc9..8ce071d 100755 --- a/tools/config_tangle.el +++ b/tools/config_tangle.el @@ -39,15 +39,15 @@ (setq src (concat top_builddir "/src/")) (setq tests (concat top_builddir "/tests/")) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) -(setq f (concat src name "_f.f90")) -(setq fh_func (concat src name "_fh_func.f90")) -(setq fh_type (concat src name "_fh_type.f90")) +(setq f (concat src name "_f.F90")) +(setq fh_func (concat src name "_fh_func.F90")) +(setq fh_type (concat src name "_fh_type.F90")) (setq c (concat src name ".c")) (setq h_func (concat src name "_func.h")) (setq h_type (concat src name "_type.h")) (setq h_private_type (concat src name "_private_type.h")) (setq h_private_func (concat src name "_private_func.h")) (setq c_test (concat tests "test_" name ".c")) -(setq f_test (concat tests "test_" name "_f.f90")) +(setq f_test (concat tests "test_" name "_f.F90")) (org-babel-lob-ingest (concat srcdir "/tools/lib.org")) diff --git a/tools/tangle.sh b/tools/tangle.sh index 2f37b95..1b1700b 100755 --- a/tools/tangle.sh +++ b/tools/tangle.sh @@ -22,7 +22,7 @@ function tangle() { local org_file=$1 local c_file=${org_file%.org}.c - local f_file=${org_file%.org}.f90 + local f_file=${org_file%.org}.F90 if [[ ${org_file} -ot ${c_file} ]] ; then return From a7ec3585a7e3027c9ccdd71d415da13c6e4fce0b Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 16:19:31 +0100 Subject: [PATCH 22/29] reorder indices for een_rescaled_e. --- org/qmckl_jastrow.org | 78 ++++++++++++++++++++++--------------------- 1 file changed, 40 insertions(+), 38 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index c83ba45..e15a659 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -58,7 +58,7 @@ The terms $J_{\text{ee}}^\infty$ and $J_{\text{eN}}^\infty$ are shifts to ensure that $J_{\text{ee}}$ and $J_{\text{eN}}$ have an asymptotic value of zero. - + * Headers :noexport: #+begin_src elisp :noexport :results none (org-babel-lob-ingest "../tools/lib.org") @@ -2946,11 +2946,11 @@ assert(fabs(factor_en_deriv_e[0][3][0]+0.9667363412285741 ) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* const distance_rescaled); +qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* const distance_rescaled) +qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -2966,6 +2966,7 @@ qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* size_t sze = ctx->electron.num * ctx->electron.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); memcpy(distance_rescaled, ctx->jastrow.een_rescaled_e, sze * sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } @@ -3047,7 +3048,7 @@ qmckl_exit_code qmckl_provide_een_rescaled_e(qmckl_context context) | ~cord_num~ | ~int64_t~ | in | Order of polynomials | | ~rescale_factor_kappa_ee~ | ~double~ | in | Factor to rescale ee distances | | ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances | - | ~een_rescaled_e~ | ~double[walk_num][elec_num][elec_num][0:cord_num]~ | out | Electron-electron rescaled distances | + | ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | out | Electron-electron rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_een_rescaled_e_f(context, walk_num, elec_num, cord_num, rescale_factor_kappa_ee, & @@ -3061,7 +3062,7 @@ integer function qmckl_compute_een_rescaled_e_f(context, walk_num, elec_num, cor integer*8 , intent(in) :: cord_num double precision , intent(in) :: rescale_factor_kappa_ee double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num) - double precision , intent(out) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + double precision , intent(out) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) double precision,dimension(:,:),allocatable :: een_rescaled_e_ij double precision :: x integer*8 :: i, j, k, l, nw @@ -3112,22 +3113,22 @@ integer function qmckl_compute_een_rescaled_e_f(context, walk_num, elec_num, cor end do ! prepare the actual een table - een_rescaled_e(0, :, :, nw) = 1.0d0 + een_rescaled_e(:, :, 0, nw) = 1.0d0 do l = 1, cord_num k = 0 do j = 1, elec_num do i = 1, j - 1 k = k + 1 x = een_rescaled_e_ij(k, l + 1) - een_rescaled_e(l, i, j, nw) = x - een_rescaled_e(l, j, i, nw) = x + een_rescaled_e(i, j, l, nw) = x + een_rescaled_e(j, i, l, nw) = x end do end do end do do l = 0, cord_num do j = 1, elec_num - een_rescaled_e(l, j, j, nw) = 0.0d0 + een_rescaled_e(j, j, l, nw) = 0.0d0 end do end do @@ -3167,7 +3168,7 @@ end function qmckl_compute_een_rescaled_e_f integer (c_int64_t) , intent(in) , value :: cord_num real (c_double ) , intent(in) , value :: rescale_factor_kappa_ee real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) integer(c_int32_t), external :: qmckl_compute_een_rescaled_e_f info = qmckl_compute_een_rescaled_e_f & @@ -3240,16 +3241,17 @@ print(" een_rescaled_e[1, 5, 2] = ",een_rescaled_e[1, 5, 2]) assert(qmckl_electron_provided(context)); -double een_rescaled_e[walk_num][elec_num][elec_num][(cord_num + 1)]; -rc = qmckl_get_jastrow_een_rescaled_e(context, &(een_rescaled_e[0][0][0][0])); +double een_rescaled_e[walk_num][(cord_num + 1)][elec_num][elec_num]; +size_max=0; +rc = qmckl_get_jastrow_een_rescaled_e(context, &(een_rescaled_e[0][0][0][0]),&size_max); // value of (0,2,1) -assert(fabs(een_rescaled_e[0][0][2][1]-0.08084493981483197) < 1.e-12); -assert(fabs(een_rescaled_e[0][0][3][1]-0.1066745707571846) < 1.e-12); -assert(fabs(een_rescaled_e[0][0][4][1]-0.01754273169464735) < 1.e-12); -assert(fabs(een_rescaled_e[0][1][3][2]-0.02214680362033448) < 1.e-12); -assert(fabs(een_rescaled_e[0][1][4][2]-0.0005700154999202759) < 1.e-12); -assert(fabs(een_rescaled_e[0][1][5][2]-0.3424402276009091) < 1.e-12); +assert(fabs(een_rescaled_e[0][1][0][2]-0.08084493981483197) < 1.e-12); +assert(fabs(een_rescaled_e[0][1][0][3]-0.1066745707571846) < 1.e-12); +assert(fabs(een_rescaled_e[0][1][0][4]-0.01754273169464735) < 1.e-12); +assert(fabs(een_rescaled_e[0][2][1][3]-0.02214680362033448) < 1.e-12); +assert(fabs(een_rescaled_e[0][2][1][4]-0.0005700154999202759) < 1.e-12); +assert(fabs(een_rescaled_e[0][2][1][5]-0.3424402276009091) < 1.e-12); #+end_src @@ -3370,7 +3372,7 @@ qmckl_exit_code qmckl_provide_een_rescaled_e_deriv_e(qmckl_context context) | ~rescale_factor_kappa_ee~ | ~double~ | in | Factor to rescale ee distances | | ~coord_new~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates | | ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances | - | ~een_rescaled_e~ | ~double[walk_num][elec_num][elec_num][0:cord_num]~ | in | Electron-electron distances | + | ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron distances | | ~een_rescaled_e_deriv_e~ | ~double[walk_num][elec_num][4][elec_num][0:cord_num]~ | out | Electron-electron rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -3386,7 +3388,7 @@ integer function qmckl_compute_factor_een_rescaled_e_deriv_e_f(context, walk_num double precision , intent(in) :: rescale_factor_kappa_ee double precision , intent(in) :: coord_new(elec_num,3,walk_num) double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num) - double precision , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + double precision , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) double precision , intent(out) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num) double precision,dimension(:,:,:),allocatable :: elec_dist_deriv_e double precision :: x, rij_inv, kappa_l @@ -3446,7 +3448,7 @@ integer function qmckl_compute_factor_een_rescaled_e_deriv_e_f(context, walk_num do ii = 1, 4 een_rescaled_e_deriv_e(l, i, ii, j, nw) = een_rescaled_e_deriv_e(l, i, ii, j, nw) * & - een_rescaled_e(l, i, j, nw) + een_rescaled_e(i, j, l, nw) end do end do end do @@ -3499,7 +3501,7 @@ end function qmckl_compute_factor_een_rescaled_e_deriv_e_f real (c_double ) , intent(in) , value :: rescale_factor_kappa_ee real (c_double ) , intent(in) :: coord_new(elec_num,3,walk_num) real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) real (c_double ) , intent(out) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num) integer(c_int32_t), external :: qmckl_compute_factor_een_rescaled_e_deriv_e_f @@ -4976,7 +4978,7 @@ end function qmckl_compute_lkpm_combined_index_f | ~elec_num~ | ~int64_t~ | in | Number of electrons | | ~nucl_num~ | ~int64_t~ | in | Number of nucleii | | ~walk_num~ | ~int64_t~ | in | Number of walkers | - | ~een_rescaled_e~ | ~double[walk_num][elec_num][elec_num][0:cord_num]~ | in | Electron-electron rescaled factor | + | ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron rescaled factor | | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor | | ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | vector of non-zero coefficients | @@ -4991,7 +4993,7 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & integer*8 , intent(in) :: elec_num integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: walk_num - double precision , intent(in) :: een_rescaled_e(0:cord_num, elec_num, elec_num, walk_num) + double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) double precision , intent(in) :: een_rescaled_n(0:cord_num, nucl_num, elec_num, walk_num) double precision , intent(out) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision :: x @@ -5007,17 +5009,17 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & alpha = 1.0d0 beta = 0.0d0 - allocate(een_rescaled_e_T(elec_num,elec_num,0:cord_num,walk_num)) + !allocate(een_rescaled_e_T(elec_num,elec_num,0:cord_num,walk_num)) allocate(een_rescaled_n_T(elec_num,nucl_num,0:cord_num,walk_num)) - do nw = 1,walk_num - do i = 1, elec_num - do j = 1, elec_num - do l = 0,cord_num - een_rescaled_e_T(i,j,l,nw) = een_rescaled_e(l,j,i,nw) - end do - end do - end do - end do + !do nw = 1,walk_num + !do i = 1, elec_num + ! do j = 1, elec_num + ! do l = 0,cord_num + ! een_rescaled_e_T(i,j,l,nw) = een_rescaled_e(l,j,i,nw) + ! end do + ! end do + !end do + !end do do nw = 1,walk_num do i = 1, elec_num do j = 1, nucl_num @@ -5053,14 +5055,14 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & M = elec_num N = nucl_num*(cord_num + 1) K = elec_num - LDA = size(een_rescaled_e_T,1) + LDA = size(een_rescaled_e,1) LDB = size(een_rescaled_n_T,1) LDC = size(tmp_c,1) do nw=1, walk_num do i=0, cord_num-1 info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - een_rescaled_e_T(1,1,i,nw),LDA*1_8, & + een_rescaled_e(1,1,i,nw),LDA*1_8, & een_rescaled_n_T(1,1,0,nw),LDB*1_8, & beta, & tmp_c(1,1,0,i,nw),LDC) @@ -5074,7 +5076,7 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & !end do !end do - deallocate(een_rescaled_e_T) + !deallocate(een_rescaled_e_T) deallocate(een_rescaled_n_T) end function qmckl_compute_tmp_c_f #+end_src @@ -5111,7 +5113,7 @@ end function qmckl_compute_tmp_c_f integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: walk_num - real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) real (c_double ) , intent(out) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) From cf005084f1685d96111739541ba53d3d2877f207 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 17:06:17 +0100 Subject: [PATCH 23/29] Fixed een_rescaled_e_deriv_d. --- org/qmckl_jastrow.org | 109 ++++++++++++++++++++++-------------------- 1 file changed, 58 insertions(+), 51 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index e15a659..a74069e 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -3178,7 +3178,7 @@ end function qmckl_compute_een_rescaled_e_f #+end_src *** Test - + #+begin_src python :results output :exports none :noweb yes import numpy as np @@ -3268,11 +3268,11 @@ assert(fabs(een_rescaled_e[0][2][1][5]-0.3424402276009091) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, double* const distance_rescaled); +qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, double* const distance_rescaled) +qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -3288,6 +3288,7 @@ qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, size_t sze = ctx->electron.num * 4 * ctx->electron.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); memcpy(distance_rescaled, ctx->jastrow.een_rescaled_e_deriv_e, sze * sizeof(double)); + (*size_max) = sze; return QMCKL_SUCCESS; } @@ -3373,7 +3374,7 @@ qmckl_exit_code qmckl_provide_een_rescaled_e_deriv_e(qmckl_context context) | ~coord_new~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates | | ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances | | ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron distances | - | ~een_rescaled_e_deriv_e~ | ~double[walk_num][elec_num][4][elec_num][0:cord_num]~ | out | Electron-electron rescaled distances | + | ~een_rescaled_e_deriv_e~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | out | Electron-electron rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_factor_een_rescaled_e_deriv_e_f(context, walk_num, elec_num, cord_num, rescale_factor_kappa_ee, & @@ -3389,7 +3390,7 @@ integer function qmckl_compute_factor_een_rescaled_e_deriv_e_f(context, walk_num double precision , intent(in) :: coord_new(elec_num,3,walk_num) double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num) double precision , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - double precision , intent(out) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num) + double precision , intent(out) :: een_rescaled_e_deriv_e(elec_num,4,elec_num,0:cord_num,walk_num) double precision,dimension(:,:,:),allocatable :: elec_dist_deriv_e double precision :: x, rij_inv, kappa_l integer*8 :: i, j, k, l, nw, ii @@ -3437,19 +3438,24 @@ integer function qmckl_compute_factor_een_rescaled_e_deriv_e_f(context, walk_num kappa_l = - dble(l) * rescale_factor_kappa_ee do j = 1, elec_num do i = 1, elec_num - do ii = 1, 4 - een_rescaled_e_deriv_e(l, i, ii, j, nw) = kappa_l * elec_dist_deriv_e(ii, i, j) - end do + een_rescaled_e_deriv_e(i, 1, j, l, nw) = kappa_l * elec_dist_deriv_e(1, i, j) + een_rescaled_e_deriv_e(i, 2, j, l, nw) = kappa_l * elec_dist_deriv_e(2, i, j) + een_rescaled_e_deriv_e(i, 3, j, l, nw) = kappa_l * elec_dist_deriv_e(3, i, j) + een_rescaled_e_deriv_e(i, 4, j, l, nw) = kappa_l * elec_dist_deriv_e(4, i, j) - een_rescaled_e_deriv_e(l, i, 4, j, nw) = een_rescaled_e_deriv_e(l, i, 4, j, nw) & - + een_rescaled_e_deriv_e(l, i, 1, j, nw) * een_rescaled_e_deriv_e(l, i, 1, j, nw) & - + een_rescaled_e_deriv_e(l, i, 2, j, nw) * een_rescaled_e_deriv_e(l, i, 2, j, nw) & - + een_rescaled_e_deriv_e(l, i, 3, j, nw) * een_rescaled_e_deriv_e(l, i, 3, j, nw) + een_rescaled_e_deriv_e(i, 4, j, l, nw) = een_rescaled_e_deriv_e(i, 4, j, l, nw) & + + een_rescaled_e_deriv_e(i, 1, j, l, nw) * een_rescaled_e_deriv_e(i, 1, j, l, nw) & + + een_rescaled_e_deriv_e(i, 2, j, l, nw) * een_rescaled_e_deriv_e(i, 2, j, l, nw) & + + een_rescaled_e_deriv_e(i, 3, j, l, nw) * een_rescaled_e_deriv_e(i, 3, j, l, nw) - do ii = 1, 4 - een_rescaled_e_deriv_e(l, i, ii, j, nw) = een_rescaled_e_deriv_e(l, i, ii, j, nw) * & - een_rescaled_e(i, j, l, nw) - end do + een_rescaled_e_deriv_e(i, 1, j, l, nw) = een_rescaled_e_deriv_e(i, 1, j, l, nw) * & + een_rescaled_e(i, j, l, nw) + een_rescaled_e_deriv_e(i, 3, j, l, nw) = een_rescaled_e_deriv_e(i, 2, j, l, nw) * & + een_rescaled_e(i, j, l, nw) + een_rescaled_e_deriv_e(i, 3, j, l, nw) = een_rescaled_e_deriv_e(i, 3, j, l, nw) * & + een_rescaled_e(i, j, l, nw) + een_rescaled_e_deriv_e(i, 4, j, l, nw) = een_rescaled_e_deriv_e(i, 4, j, l, nw) * & + een_rescaled_e(i, j, l, nw) end do end do end do @@ -3502,7 +3508,7 @@ end function qmckl_compute_factor_een_rescaled_e_deriv_e_f real (c_double ) , intent(in) :: coord_new(elec_num,3,walk_num) real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num) real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_e_deriv_e(elec_num,4,elec_num,0:cord_num,walk_num) integer(c_int32_t), external :: qmckl_compute_factor_een_rescaled_e_deriv_e_f info = qmckl_compute_factor_een_rescaled_e_deriv_e_f & @@ -3602,16 +3608,17 @@ for l in range(0,cord_num+1): #+begin_src c :tangle (eval c_test) //assert(qmckl_electron_provided(context)); -double een_rescaled_e_deriv_e[walk_num][elec_num][4][elec_num][(cord_num + 1)]; -rc = qmckl_get_jastrow_een_rescaled_e_deriv_e(context, &(een_rescaled_e_deriv_e[0][0][0][0][0])); +double een_rescaled_e_deriv_e[walk_num][(cord_num + 1)][elec_num][4][elec_num]; +size_max=0; +rc = qmckl_get_jastrow_een_rescaled_e_deriv_e(context, &(een_rescaled_e_deriv_e[0][0][0][0][0]),&size_max); // value of (0,0,0,2,1) -assert(fabs(een_rescaled_e_deriv_e[0][0][0][2][1] + 0.05991352796887283 ) < 1.e-12); -assert(fabs(een_rescaled_e_deriv_e[0][0][0][3][1] + 0.011714035071545248 ) < 1.e-12); -assert(fabs(een_rescaled_e_deriv_e[0][0][0][4][1] + 0.00441398875758468 ) < 1.e-12); -assert(fabs(een_rescaled_e_deriv_e[0][1][0][3][2] + 0.013553180060167595 ) < 1.e-12); -assert(fabs(een_rescaled_e_deriv_e[0][1][0][4][2] + 0.00041342909359870457) < 1.e-12); -assert(fabs(een_rescaled_e_deriv_e[0][1][0][5][2] + 0.5880599146214673 ) < 1.e-12); +assert(fabs(een_rescaled_e_deriv_e[0][1][0][0][2] + 0.05991352796887283 ) < 1.e-12); +assert(fabs(een_rescaled_e_deriv_e[0][1][0][0][3] + 0.011714035071545248 ) < 1.e-12); +assert(fabs(een_rescaled_e_deriv_e[0][1][0][0][4] + 0.00441398875758468 ) < 1.e-12); +assert(fabs(een_rescaled_e_deriv_e[0][2][1][0][3] + 0.013553180060167595 ) < 1.e-12); +assert(fabs(een_rescaled_e_deriv_e[0][2][1][0][4] + 0.00041342909359870457) < 1.e-12); +assert(fabs(een_rescaled_e_deriv_e[0][2][1][0][5] + 0.5880599146214673 ) < 1.e-12); #+end_src ** Electron-nucleus rescaled distances for each order @@ -5139,7 +5146,7 @@ end function qmckl_compute_tmp_c_f | ~elec_num~ | ~int64_t~ | in | Number of electrons | | ~nucl_num~ | ~int64_t~ | in | Number of nucleii | | ~walk_num~ | ~int64_t~ | in | Number of walkers | - | ~een_rescaled_e_deriv_e~ | ~double[walk_num][elec_num][4][elec_num][0:cord_num]~ | in | Electron-electron rescaled factor derivatives | + | ~een_rescaled_e_deriv_e~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | in | Electron-electron rescaled factor derivatives | | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor | | ~dtmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | vector of non-zero coefficients | @@ -5154,7 +5161,7 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & integer*8 , intent(in) :: elec_num integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: walk_num - double precision , intent(in) :: een_rescaled_e_deriv_e(0:cord_num, elec_num, 4, elec_num, walk_num) + double precision , intent(in) :: een_rescaled_e_deriv_e(elec_num, 4, elec_num, 0:cord_num, walk_num) double precision , intent(in) :: een_rescaled_n(0:cord_num, nucl_num, elec_num, walk_num) double precision , intent(out) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision :: x @@ -5162,7 +5169,7 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & character :: TransA, TransB double precision :: alpha, beta integer*8 :: M, N, K, LDA, LDB, LDC - double precision,dimension(:,:,:,:,:),allocatable :: een_rescaled_e_deriv_e_T + !double precision,dimension(:,:,:,:,:),allocatable :: een_rescaled_e_deriv_e_T double precision,dimension(:,:,:,:),allocatable :: een_rescaled_n_T TransA = 'N' @@ -5172,18 +5179,18 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & info = QMCKL_SUCCESS - allocate(een_rescaled_e_deriv_e_T(elec_num,4,elec_num,0:cord_num,walk_num)) + !allocate(een_rescaled_e_deriv_e_T(elec_num,4,elec_num,0:cord_num,walk_num)) allocate(een_rescaled_n_T(elec_num,nucl_num,0:cord_num,walk_num)) do nw = 1,walk_num - do i = 1, elec_num - do ii = 1, 4 - do j = 1, elec_num - do l = 0,cord_num - een_rescaled_e_deriv_e_T(i,ii,j,l,nw) = een_rescaled_e_deriv_e(l,j,ii,i,nw) - end do - end do - end do - end do + !do i = 1, elec_num + ! do ii = 1, 4 + ! do j = 1, elec_num + ! do l = 0,cord_num + ! een_rescaled_e_deriv_e_T(i,ii,j,l,nw) = een_rescaled_e_deriv_e(l,j,ii,i,nw) + ! end do + ! end do + ! end do + !end do do i = 1, elec_num do j = 1, nucl_num do l = 0,cord_num @@ -5216,21 +5223,21 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & M = 4*elec_num N = nucl_num*(cord_num + 1) K = elec_num - LDA = 4*size(een_rescaled_e_deriv_e_T,1) + LDA = 4*size(een_rescaled_e_deriv_e,1) LDB = size(een_rescaled_n_T,1) LDC = 4*size(dtmp_c,1) do nw=1, walk_num do i=0, cord_num-1 info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - een_rescaled_e_deriv_e_T(1,1,1,i,nw),LDA*1_8, & + een_rescaled_e_deriv_e(1,1,1,i,nw),LDA*1_8, & een_rescaled_n_T(1,1,0,nw),LDB*1_8, & beta, & dtmp_c(1,1,1,0,i,nw),LDC) end do end do - deallocate(een_rescaled_e_deriv_e_T) + !deallocate(een_rescaled_e_deriv_e_T) deallocate(een_rescaled_n_T) end function qmckl_compute_dtmp_c_f #+end_src @@ -5267,7 +5274,7 @@ end function qmckl_compute_dtmp_c_f integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: walk_num - real (c_double ) , intent(in) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_e_deriv_e(elec_num,4,elec_num,0:cord_num,walk_num) real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) real (c_double ) , intent(out) :: dtmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) @@ -5359,7 +5366,7 @@ rc = qmckl_get_jastrow_dtmp_c(context, &(dtmp_c[0][0][0][0][0][0])); assert(fabs(tmp_c[0][0][1][0][0] - 2.7083473948352403) < 1e-12); -assert(fabs(dtmp_c[0][1][0][0][0][0] + 0.237440520852232) < 1e-12); +assert(fabs(dtmp_c[0][1][0][0][0][0] - 0.237440520852232) < 1e-12); #+end_src ** Electron-electron-nucleus Jastrow \(f_{een}\) @@ -6264,8 +6271,8 @@ integer function qmckl_compute_factor_een_deriv_e_f(context, walk_num, elec_num, do j = 1, elec_num factor_een_deriv_e(j,ii,nw) = factor_een_deriv_e(j,ii,nw) + (& tmp_c(j,a,m,k,nw) * een_rescaled_n_deriv_e(m+l,a,ii,j,nw) + & - (-1.0d0*dtmp_c(j,ii,a,m,k,nw)) * een_rescaled_n(m+l,a,j,nw) + & - (-1.0d0*dtmp_c(j,ii,a,m+l,k,nw)) * een_rescaled_n(m,a,j,nw) + & + (dtmp_c(j,ii,a,m,k,nw)) * een_rescaled_n(m+l,a,j,nw) + & + (dtmp_c(j,ii,a,m+l,k,nw)) * een_rescaled_n(m,a,j,nw) + & tmp_c(j,a,m+l,k,nw) * een_rescaled_n_deriv_e(m,a,ii,j,nw) & ) * cn end do @@ -6274,12 +6281,12 @@ integer function qmckl_compute_factor_een_deriv_e_f(context, walk_num, elec_num, cn = cn + cn do j = 1, elec_num factor_een_deriv_e(j,4,nw) = factor_een_deriv_e(j,4,nw) + (& - (-1.0d0*dtmp_c(j,1,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,1,j,nw) + & - (-1.0d0*dtmp_c(j,2,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,2,j,nw) + & - (-1.0d0*dtmp_c(j,3,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,3,j,nw) + & - (-1.0d0*dtmp_c(j,1,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,1,j,nw) + & - (-1.0d0*dtmp_c(j,2,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,2,j,nw) + & - (-1.0d0*dtmp_c(j,3,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,3,j,nw) & + (dtmp_c(j,1,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,1,j,nw) + & + (dtmp_c(j,2,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,2,j,nw) + & + (dtmp_c(j,3,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,3,j,nw) + & + (dtmp_c(j,1,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,1,j,nw) + & + (dtmp_c(j,2,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,2,j,nw) + & + (dtmp_c(j,3,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,3,j,nw) & ) * cn end do end do From 367d0ff108180dd4d243f765c24fc350e3e1f495 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 17:19:36 +0100 Subject: [PATCH 24/29] Fixed een_rescaled_n. --- org/qmckl_jastrow.org | 128 +++++++++++++++++++++--------------------- 1 file changed, 65 insertions(+), 63 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index a74069e..72e916c 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -3635,11 +3635,11 @@ assert(fabs(een_rescaled_e_deriv_e[0][2][1][0][5] + 0.5880599146214673 ) < 1. *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* const distance_rescaled); +qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* const distance_rescaled, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* const distance_rescaled) +qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* const distance_rescaled, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -3655,6 +3655,7 @@ qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* size_t sze = ctx->electron.num * ctx->nucleus.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); memcpy(distance_rescaled, ctx->jastrow.een_rescaled_n, sze * sizeof(double)); + (*size_max)=sze; return QMCKL_SUCCESS; } @@ -3738,7 +3739,7 @@ qmckl_exit_code qmckl_provide_een_rescaled_n(qmckl_context context) | ~cord_num~ | ~int64_t~ | in | Order of polynomials | | ~rescale_factor_kappa_en~ | ~double~ | in | Factor to rescale ee distances | | ~en_distance~ | ~double[walk_num][elec_num][nucl_num]~ | in | Electron-nucleus distances | - | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | out | Electron-nucleus rescaled distances | + | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | out | Electron-nucleus rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_een_rescaled_n_f(context, walk_num, elec_num, nucl_num, cord_num, rescale_factor_kappa_en, & @@ -3753,7 +3754,7 @@ integer function qmckl_compute_een_rescaled_n_f(context, walk_num, elec_num, nuc integer*8 , intent(in) :: cord_num double precision , intent(in) :: rescale_factor_kappa_en double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num) - double precision , intent(out) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + double precision , intent(out) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) double precision :: x integer*8 :: i, a, k, l, nw @@ -3789,18 +3790,18 @@ integer function qmckl_compute_een_rescaled_n_f(context, walk_num, elec_num, nuc do nw = 1, walk_num ! prepare the actual een table - een_rescaled_n(0, :, :, nw) = 1.0d0 + een_rescaled_n(:, :, 0, nw) = 1.0d0 do a = 1, nucl_num do i = 1, elec_num - een_rescaled_n(1, a, i, nw) = dexp(-rescale_factor_kappa_en * en_distance(i, a, nw)) + een_rescaled_n(i, a, 1, nw) = dexp(-rescale_factor_kappa_en * en_distance(i, a, nw)) end do end do do l = 2, cord_num do a = 1, nucl_num do i = 1, elec_num - een_rescaled_n(l, a, i, nw) = een_rescaled_n(l - 1, a, i, nw) * een_rescaled_n(1, a, i, nw) + een_rescaled_n(i, a, l, nw) = een_rescaled_n(i, a, l - 1, nw) * een_rescaled_n(i, a, 1, nw) end do end do end do @@ -3849,7 +3850,7 @@ end function qmckl_compute_een_rescaled_n_f integer (c_int64_t) , intent(in) , value :: cord_num real (c_double ) , intent(in) , value :: rescale_factor_kappa_en real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_n(nucl_num,elec_num,0:cord_num,walk_num) integer(c_int32_t), external :: qmckl_compute_een_rescaled_n_f info = qmckl_compute_een_rescaled_n_f & @@ -3912,16 +3913,17 @@ print(" een_rescaled_n[1, 5, 2] = ",een_rescaled_n[1, 5, 2]) #+begin_src c :tangle (eval c_test) assert(qmckl_electron_provided(context)); -double een_rescaled_n[walk_num][elec_num][nucl_num][(cord_num + 1)]; -rc = qmckl_get_jastrow_een_rescaled_n(context, &(een_rescaled_n[0][0][0][0])); +double een_rescaled_n[walk_num][(cord_num + 1)][nucl_num][elec_num]; +size_max=0; +rc = qmckl_get_jastrow_een_rescaled_n(context, &(een_rescaled_n[0][0][0][0]),&size_max); // value of (0,2,1) -assert(fabs(een_rescaled_n[0][2][0][1]-0.10612983920006765) < 1.e-12); -assert(fabs(een_rescaled_n[0][3][0][1]-0.135652809635553) < 1.e-12); -assert(fabs(een_rescaled_n[0][4][0][1]-0.023391817607642338) < 1.e-12); -assert(fabs(een_rescaled_n[0][3][1][2]-0.880957224822116) < 1.e-12); -assert(fabs(een_rescaled_n[0][4][1][2]-0.027185942659395074) < 1.e-12); -assert(fabs(een_rescaled_n[0][5][1][2]-0.01343938025140174) < 1.e-12); +assert(fabs(een_rescaled_n[0][1][0][2]-0.10612983920006765) < 1.e-12); +assert(fabs(een_rescaled_n[0][1][0][3]-0.135652809635553) < 1.e-12); +assert(fabs(een_rescaled_n[0][1][0][4]-0.023391817607642338) < 1.e-12); +assert(fabs(een_rescaled_n[0][2][1][3]-0.880957224822116) < 1.e-12); +assert(fabs(een_rescaled_n[0][2][1][4]-0.027185942659395074) < 1.e-12); +assert(fabs(een_rescaled_n[0][2][1][5]-0.01343938025140174) < 1.e-12); #+end_src @@ -4046,7 +4048,7 @@ qmckl_exit_code qmckl_provide_een_rescaled_n_deriv_e(qmckl_context context) | ~coord_new~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates | | ~coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates | | ~en_distance~ | ~double[walk_num][elec_num][nucl_num]~ | in | Electron-nucleus distances | - | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus distances | + | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus distances | | ~een_rescaled_n_deriv_e~ | ~double[walk_num][elec_num][4][nucl_num][0:cord_num]~ | out | Electron-nucleus rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -4065,7 +4067,7 @@ integer function qmckl_compute_factor_een_rescaled_n_deriv_e_f(context, walk_num double precision , intent(in) :: coord_new(elec_num,3,walk_num) double precision , intent(in) :: coord(nucl_num,3) double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num) - double precision , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + double precision , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) double precision , intent(out) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num) double precision,dimension(:,:,:),allocatable :: elnuc_dist_deriv_e double precision :: x, ria_inv, kappa_l @@ -4130,7 +4132,7 @@ integer function qmckl_compute_factor_een_rescaled_n_deriv_e_f(context, walk_num do ii = 1, 4 een_rescaled_n_deriv_e(l, a, ii, i, nw) = een_rescaled_n_deriv_e(l, a, ii, i, nw) * & - een_rescaled_n(l, a, i, nw) + een_rescaled_n(i, a, l, nw) end do end do end do @@ -4986,7 +4988,7 @@ end function qmckl_compute_lkpm_combined_index_f | ~nucl_num~ | ~int64_t~ | in | Number of nucleii | | ~walk_num~ | ~int64_t~ | in | Number of walkers | | ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron rescaled factor | - | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor | + | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor | | ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | vector of non-zero coefficients | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -5001,11 +5003,11 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: walk_num double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n(0:cord_num, nucl_num, elec_num, walk_num) + double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) double precision , intent(out) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision :: x - double precision,dimension(:,:,:,:),allocatable :: een_rescaled_e_T - double precision,dimension(:,:,:,:),allocatable :: een_rescaled_n_T + !double precision,dimension(:,:,:,:),allocatable :: een_rescaled_e_T + !double precision,dimension(:,:,:,:),allocatable :: een_rescaled_n_T integer*8 :: i, j, a, l, kk, p, lmax, nw character :: TransA, TransB double precision :: alpha, beta @@ -5017,7 +5019,7 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & beta = 0.0d0 !allocate(een_rescaled_e_T(elec_num,elec_num,0:cord_num,walk_num)) - allocate(een_rescaled_n_T(elec_num,nucl_num,0:cord_num,walk_num)) + !allocate(een_rescaled_n_T(elec_num,nucl_num,0:cord_num,walk_num)) !do nw = 1,walk_num !do i = 1, elec_num ! do j = 1, elec_num @@ -5027,15 +5029,15 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & ! end do !end do !end do - do nw = 1,walk_num - do i = 1, elec_num - do j = 1, nucl_num - do l = 0,cord_num - een_rescaled_n_T(i,j,l,nw) = een_rescaled_n(l,j,i,nw) - end do - end do - end do - end do + !do nw = 1,walk_num + !do i = 1, elec_num + ! do j = 1, nucl_num + ! do l = 0,cord_num + ! een_rescaled_n_T(i,j,l,nw) = een_rescaled_n(l,j,i,nw) + ! end do + ! end do + !end do + !end do info = QMCKL_SUCCESS @@ -5063,14 +5065,14 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & N = nucl_num*(cord_num + 1) K = elec_num LDA = size(een_rescaled_e,1) - LDB = size(een_rescaled_n_T,1) + LDB = size(een_rescaled_n,1) LDC = size(tmp_c,1) do nw=1, walk_num do i=0, cord_num-1 info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & een_rescaled_e(1,1,i,nw),LDA*1_8, & - een_rescaled_n_T(1,1,0,nw),LDB*1_8, & + een_rescaled_n(1,1,0,nw),LDB*1_8, & beta, & tmp_c(1,1,0,i,nw),LDC) end do @@ -5084,7 +5086,7 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & !end do !deallocate(een_rescaled_e_T) - deallocate(een_rescaled_n_T) + !deallocate(een_rescaled_n_T) end function qmckl_compute_tmp_c_f #+end_src @@ -5121,7 +5123,7 @@ end function qmckl_compute_tmp_c_f integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: walk_num real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) real (c_double ) , intent(out) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) integer(c_int32_t), external :: qmckl_compute_tmp_c_f @@ -5147,7 +5149,7 @@ end function qmckl_compute_tmp_c_f | ~nucl_num~ | ~int64_t~ | in | Number of nucleii | | ~walk_num~ | ~int64_t~ | in | Number of walkers | | ~een_rescaled_e_deriv_e~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | in | Electron-electron rescaled factor derivatives | - | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor | + | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor | | ~dtmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | vector of non-zero coefficients | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -5162,7 +5164,7 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & integer*8 , intent(in) :: nucl_num integer*8 , intent(in) :: walk_num double precision , intent(in) :: een_rescaled_e_deriv_e(elec_num, 4, elec_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n(0:cord_num, nucl_num, elec_num, walk_num) + double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) double precision , intent(out) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision :: x integer*8 :: i, j, a, l, kk, p, lmax, nw, ii @@ -5170,7 +5172,7 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & double precision :: alpha, beta integer*8 :: M, N, K, LDA, LDB, LDC !double precision,dimension(:,:,:,:,:),allocatable :: een_rescaled_e_deriv_e_T - double precision,dimension(:,:,:,:),allocatable :: een_rescaled_n_T + !double precision,dimension(:,:,:,:),allocatable :: een_rescaled_n_T TransA = 'N' TransB = 'N' @@ -5180,8 +5182,8 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & info = QMCKL_SUCCESS !allocate(een_rescaled_e_deriv_e_T(elec_num,4,elec_num,0:cord_num,walk_num)) - allocate(een_rescaled_n_T(elec_num,nucl_num,0:cord_num,walk_num)) - do nw = 1,walk_num + !allocate(een_rescaled_n_T(elec_num,nucl_num,0:cord_num,walk_num)) + !do nw = 1,walk_num !do i = 1, elec_num ! do ii = 1, 4 ! do j = 1, elec_num @@ -5191,14 +5193,14 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & ! end do ! end do !end do - do i = 1, elec_num - do j = 1, nucl_num - do l = 0,cord_num - een_rescaled_n_T(i,j,l,nw) = een_rescaled_n(l,j,i,nw) - end do - end do - end do - end do + !do i = 1, elec_num + ! do j = 1, nucl_num + ! do l = 0,cord_num + ! een_rescaled_n_T(i,j,l,nw) = een_rescaled_n(l,j,i,nw) + ! end do + ! end do + !end do + !end do if (context == QMCKL_NULL_CONTEXT) then info = QMCKL_INVALID_CONTEXT @@ -5224,21 +5226,21 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & N = nucl_num*(cord_num + 1) K = elec_num LDA = 4*size(een_rescaled_e_deriv_e,1) - LDB = size(een_rescaled_n_T,1) + LDB = size(een_rescaled_n,1) LDC = 4*size(dtmp_c,1) do nw=1, walk_num do i=0, cord_num-1 info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & een_rescaled_e_deriv_e(1,1,1,i,nw),LDA*1_8, & - een_rescaled_n_T(1,1,0,nw),LDB*1_8, & + een_rescaled_n(1,1,0,nw),LDB*1_8, & beta, & dtmp_c(1,1,1,0,i,nw),LDC) end do end do !deallocate(een_rescaled_e_deriv_e_T) - deallocate(een_rescaled_n_T) + !deallocate(een_rescaled_n_T) end function qmckl_compute_dtmp_c_f #+end_src @@ -5275,7 +5277,7 @@ end function qmckl_compute_dtmp_c_f integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) , value :: walk_num real (c_double ) , intent(in) :: een_rescaled_e_deriv_e(elec_num,4,elec_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) real (c_double ) , intent(out) :: dtmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) integer(c_int32_t), external :: qmckl_compute_dtmp_c_f @@ -5669,7 +5671,7 @@ end function qmckl_compute_factor_een_naive_f | ~cord_vect_full~ | ~double[dim_cord_vect][nucl_num]~ | in | full coefficient vector | | ~lkpm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | in | combined indices | | ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | vector of non-zero coefficients | | - | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor | + | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor | | ~factor_een~ | ~double[walk_num]~ | out | Electron-nucleus jastrow | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -5684,7 +5686,7 @@ integer function qmckl_compute_factor_een_f(context, walk_num, elec_num, nucl_nu integer*8 , intent(in) :: lkpm_combined_index(dim_cord_vect,4) double precision , intent(in) :: cord_vect_full(nucl_num, dim_cord_vect) double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: een_rescaled_n(0:cord_num, nucl_num, elec_num, walk_num) + double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) double precision , intent(out) :: factor_een(walk_num) integer*8 :: i, a, j, l, k, p, m, n, nw @@ -5732,7 +5734,7 @@ integer function qmckl_compute_factor_een_f(context, walk_num, elec_num, nucl_nu accu = 0.0d0 do j = 1, elec_num - accu = accu + een_rescaled_n(m,a,j,nw) * tmp_c(j,a,m+l,k,nw) + accu = accu + een_rescaled_n(j,a,m,nw) * tmp_c(j,a,m+l,k,nw) end do factor_een(nw) = factor_een(nw) + accu * cn end do @@ -5790,7 +5792,7 @@ end function qmckl_compute_factor_een_f real (c_double ) , intent(in) :: cord_vect_full(nucl_num,dim_cord_vect) integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_cord_vect,4) real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) real (c_double ) , intent(out) :: factor_een(walk_num) integer(c_int32_t), external :: qmckl_compute_factor_een_f @@ -6202,7 +6204,7 @@ end function qmckl_compute_factor_een_deriv_e_naive_f | ~lkpm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | in | combined indices | | ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | Temporary intermediate tensor | | ~dtmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]~ | in | vector of non-zero coefficients | - | ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor | + | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor | | ~een_rescaled_n_deriv_e~ | ~double[walk_num][elec_num][4][nucl_num][0:cord_num]~ | in | Derivative of Electron-nucleus rescaled factor | | ~factor_een_deriv_e~ | ~double[walk_num][4][elec_num]~ | out | Derivative of Electron-nucleus jastrow | @@ -6220,7 +6222,7 @@ integer function qmckl_compute_factor_een_deriv_e_f(context, walk_num, elec_num, double precision , intent(in) :: cord_vect_full(nucl_num, dim_cord_vect) double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision , intent(in) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) - double precision , intent(in) :: een_rescaled_n(0:cord_num, nucl_num, elec_num, walk_num) + double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) double precision , intent(in) :: een_rescaled_n_deriv_e(0:cord_num, nucl_num, 4, elec_num, walk_num) double precision , intent(out) :: factor_een_deriv_e(elec_num,4,walk_num) @@ -6271,8 +6273,8 @@ integer function qmckl_compute_factor_een_deriv_e_f(context, walk_num, elec_num, do j = 1, elec_num factor_een_deriv_e(j,ii,nw) = factor_een_deriv_e(j,ii,nw) + (& tmp_c(j,a,m,k,nw) * een_rescaled_n_deriv_e(m+l,a,ii,j,nw) + & - (dtmp_c(j,ii,a,m,k,nw)) * een_rescaled_n(m+l,a,j,nw) + & - (dtmp_c(j,ii,a,m+l,k,nw)) * een_rescaled_n(m,a,j,nw) + & + (dtmp_c(j,ii,a,m,k,nw)) * een_rescaled_n(j,a,m+l,nw) + & + (dtmp_c(j,ii,a,m+l,k,nw)) * een_rescaled_n(j,a,m ,nw) + & tmp_c(j,a,m+l,k,nw) * een_rescaled_n_deriv_e(m,a,ii,j,nw) & ) * cn end do @@ -6350,7 +6352,7 @@ end function qmckl_compute_factor_een_deriv_e_f integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_cord_vect,4) real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) real (c_double ) , intent(in) :: dtmp_c(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) real (c_double ) , intent(in) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num) real (c_double ) , intent(out) :: factor_een_deriv_e(elec_num,4,walk_num) From 2f05df51097cb67ae399cbb7b2867f056f4bcdb9 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 17:30:15 +0100 Subject: [PATCH 25/29] Fixed een_rescaled_n_deriv_e. --- org/qmckl_jastrow.org | 83 +++++++++++++++++++++++-------------------- 1 file changed, 45 insertions(+), 38 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 72e916c..2a5d105 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -3936,11 +3936,11 @@ assert(fabs(een_rescaled_n[0][2][1][5]-0.01343938025140174) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, double* const distance_rescaled); +qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, double* const distance_rescaled) +qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -3956,6 +3956,7 @@ qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, size_t sze = ctx->electron.num * 4 * ctx->nucleus.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); memcpy(distance_rescaled, ctx->jastrow.een_rescaled_n_deriv_e, sze * sizeof(double)); + (*size_max)=sze; return QMCKL_SUCCESS; } @@ -4049,7 +4050,7 @@ qmckl_exit_code qmckl_provide_een_rescaled_n_deriv_e(qmckl_context context) | ~coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates | | ~en_distance~ | ~double[walk_num][elec_num][nucl_num]~ | in | Electron-nucleus distances | | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus distances | - | ~een_rescaled_n_deriv_e~ | ~double[walk_num][elec_num][4][nucl_num][0:cord_num]~ | out | Electron-nucleus rescaled distances | + | ~een_rescaled_n_deriv_e~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | out | Electron-nucleus rescaled distances | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_factor_een_rescaled_n_deriv_e_f(context, walk_num, elec_num, nucl_num, & @@ -4068,7 +4069,7 @@ integer function qmckl_compute_factor_een_rescaled_n_deriv_e_f(context, walk_num double precision , intent(in) :: coord(nucl_num,3) double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num) double precision , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - double precision , intent(out) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num) + double precision , intent(out) :: een_rescaled_n_deriv_e(elec_num,4,nucl_num,0:cord_num,walk_num) double precision,dimension(:,:,:),allocatable :: elnuc_dist_deriv_e double precision :: x, ria_inv, kappa_l integer*8 :: i, a, k, l, nw, ii @@ -4121,19 +4122,24 @@ integer function qmckl_compute_factor_een_rescaled_n_deriv_e_f(context, walk_num kappa_l = - dble(l) * rescale_factor_kappa_en do a = 1, nucl_num do i = 1, elec_num - do ii = 1, 4 - een_rescaled_n_deriv_e(l, a, ii, i, nw) = kappa_l * elnuc_dist_deriv_e(ii, i, a) - end do + een_rescaled_n_deriv_e(i, 1, a, l, nw) = kappa_l * elnuc_dist_deriv_e(1, i, a) + een_rescaled_n_deriv_e(i, 2, a, l, nw) = kappa_l * elnuc_dist_deriv_e(2, i, a) + een_rescaled_n_deriv_e(i, 3, a, l, nw) = kappa_l * elnuc_dist_deriv_e(3, i, a) + een_rescaled_n_deriv_e(i, 4, a, l, nw) = kappa_l * elnuc_dist_deriv_e(4, i, a) - een_rescaled_n_deriv_e(l, a, 4, i, nw) = een_rescaled_n_deriv_e(l, a, 4, i, nw) & - + een_rescaled_n_deriv_e(l, a, 1, i, nw) * een_rescaled_n_deriv_e(l, a, 1, i, nw) & - + een_rescaled_n_deriv_e(l, a, 2, i, nw) * een_rescaled_n_deriv_e(l, a, 2, i, nw) & - + een_rescaled_n_deriv_e(l, a, 3, i, nw) * een_rescaled_n_deriv_e(l, a, 3, i, nw) + een_rescaled_n_deriv_e(i, 4, a, l, nw) = een_rescaled_n_deriv_e(i, 4, a, l, nw) & + + een_rescaled_n_deriv_e(i, 1, a, l, nw) * een_rescaled_n_deriv_e(i, 1, a, l, nw) & + + een_rescaled_n_deriv_e(i, 2, a, l, nw) * een_rescaled_n_deriv_e(i, 2, a, l, nw) & + + een_rescaled_n_deriv_e(i, 3, a, l, nw) * een_rescaled_n_deriv_e(i, 3, a, l, nw) - do ii = 1, 4 - een_rescaled_n_deriv_e(l, a, ii, i, nw) = een_rescaled_n_deriv_e(l, a, ii, i, nw) * & - een_rescaled_n(i, a, l, nw) - end do + een_rescaled_n_deriv_e(i, 1, a, l, nw) = een_rescaled_n_deriv_e(i, 1, a, l, nw) * & + een_rescaled_n(i, a, l, nw) + een_rescaled_n_deriv_e(i, 2, a, l, nw) = een_rescaled_n_deriv_e(i, 2, a, l, nw) * & + een_rescaled_n(i, a, l, nw) + een_rescaled_n_deriv_e(i, 3, a, l, nw) = een_rescaled_n_deriv_e(i, 3, a, l, nw) * & + een_rescaled_n(i, a, l, nw) + een_rescaled_n_deriv_e(i, 4, a, l, nw) = een_rescaled_n_deriv_e(i, 4, a, l, nw) * & + een_rescaled_n(i, a, l, nw) end do end do end do @@ -4191,7 +4197,7 @@ end function qmckl_compute_factor_een_rescaled_n_deriv_e_f real (c_double ) , intent(in) :: coord(nucl_num,3) real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num) real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num) - real (c_double ) , intent(out) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num) + real (c_double ) , intent(out) :: een_rescaled_n_deriv_e(elec_num,4,nucl_num,0:cord_num,walk_num) integer(c_int32_t), external :: qmckl_compute_factor_een_rescaled_n_deriv_e_f info = qmckl_compute_factor_een_rescaled_n_deriv_e_f & @@ -4209,9 +4215,9 @@ end function qmckl_compute_factor_een_rescaled_n_deriv_e_f end function qmckl_compute_factor_een_rescaled_n_deriv_e #+end_src - + *** Test - + #+begin_src python :results output :exports none :noweb yes import numpy as np @@ -4280,16 +4286,17 @@ print(" een_rescaled_n_deriv_e[2, 1, 6, 2] = ",een_rescaled_n_deriv_e[5, 0, 1, 2 #+begin_src c :tangle (eval c_test) assert(qmckl_electron_provided(context)); -double een_rescaled_n_deriv_e[walk_num][elec_num][4][nucl_num][(cord_num + 1)]; -rc = qmckl_get_jastrow_een_rescaled_n_deriv_e(context, &(een_rescaled_n_deriv_e[0][0][0][0][0])); +double een_rescaled_n_deriv_e[walk_num][(cord_num + 1)][nucl_num][4][elec_num]; +size_max=0; +rc = qmckl_get_jastrow_een_rescaled_n_deriv_e(context, &(een_rescaled_n_deriv_e[0][0][0][0][0]),&size_max); // value of (0,2,1) -assert(fabs(een_rescaled_n_deriv_e[0][2][0][0][1]+0.07633444246999128 ) < 1.e-12); -assert(fabs(een_rescaled_n_deriv_e[0][3][0][0][1]-0.00033282346259738276) < 1.e-12); -assert(fabs(een_rescaled_n_deriv_e[0][4][0][0][1]+0.004775370547333061 ) < 1.e-12); -assert(fabs(een_rescaled_n_deriv_e[0][3][0][1][2]-0.1362654644223866 ) < 1.e-12); -assert(fabs(een_rescaled_n_deriv_e[0][4][0][1][2]+0.0231253431662794 ) < 1.e-12); -assert(fabs(een_rescaled_n_deriv_e[0][5][0][1][2]-0.001593334817691633 ) < 1.e-12); +assert(fabs(een_rescaled_n_deriv_e[0][1][0][0][2]+0.07633444246999128 ) < 1.e-12); +assert(fabs(een_rescaled_n_deriv_e[0][1][0][0][3]-0.00033282346259738276) < 1.e-12); +assert(fabs(een_rescaled_n_deriv_e[0][1][0][0][4]+0.004775370547333061 ) < 1.e-12); +assert(fabs(een_rescaled_n_deriv_e[0][2][1][0][3]-0.1362654644223866 ) < 1.e-12); +assert(fabs(een_rescaled_n_deriv_e[0][2][1][0][4]+0.0231253431662794 ) < 1.e-12); +assert(fabs(een_rescaled_n_deriv_e[0][2][1][0][5]-0.001593334817691633 ) < 1.e-12); #+end_src @@ -6205,7 +6212,7 @@ end function qmckl_compute_factor_een_deriv_e_naive_f | ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | Temporary intermediate tensor | | ~dtmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]~ | in | vector of non-zero coefficients | | ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor | - | ~een_rescaled_n_deriv_e~ | ~double[walk_num][elec_num][4][nucl_num][0:cord_num]~ | in | Derivative of Electron-nucleus rescaled factor | + | ~een_rescaled_n_deriv_e~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | in | Derivative of Electron-nucleus rescaled factor | | ~factor_een_deriv_e~ | ~double[walk_num][4][elec_num]~ | out | Derivative of Electron-nucleus jastrow | @@ -6223,7 +6230,7 @@ integer function qmckl_compute_factor_een_deriv_e_f(context, walk_num, elec_num, double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision , intent(in) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) - double precision , intent(in) :: een_rescaled_n_deriv_e(0:cord_num, nucl_num, 4, elec_num, walk_num) + double precision , intent(in) :: een_rescaled_n_deriv_e(elec_num, 4, nucl_num, 0:cord_num, walk_num) double precision , intent(out) :: factor_een_deriv_e(elec_num,4,walk_num) integer*8 :: i, a, j, l, k, p, m, n, nw, ii @@ -6272,10 +6279,10 @@ integer function qmckl_compute_factor_een_deriv_e_f(context, walk_num, elec_num, do ii = 1, 4 do j = 1, elec_num factor_een_deriv_e(j,ii,nw) = factor_een_deriv_e(j,ii,nw) + (& - tmp_c(j,a,m,k,nw) * een_rescaled_n_deriv_e(m+l,a,ii,j,nw) + & + tmp_c(j,a,m,k,nw) * een_rescaled_n_deriv_e(j,ii,a,m+l,nw) + & (dtmp_c(j,ii,a,m,k,nw)) * een_rescaled_n(j,a,m+l,nw) + & (dtmp_c(j,ii,a,m+l,k,nw)) * een_rescaled_n(j,a,m ,nw) + & - tmp_c(j,a,m+l,k,nw) * een_rescaled_n_deriv_e(m,a,ii,j,nw) & + tmp_c(j,a,m+l,k,nw) * een_rescaled_n_deriv_e(j,ii,a,m,nw) & ) * cn end do end do @@ -6283,12 +6290,12 @@ integer function qmckl_compute_factor_een_deriv_e_f(context, walk_num, elec_num, cn = cn + cn do j = 1, elec_num factor_een_deriv_e(j,4,nw) = factor_een_deriv_e(j,4,nw) + (& - (dtmp_c(j,1,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,1,j,nw) + & - (dtmp_c(j,2,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,2,j,nw) + & - (dtmp_c(j,3,a,m ,k,nw)) * een_rescaled_n_deriv_e(m+l,a,3,j,nw) + & - (dtmp_c(j,1,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,1,j,nw) + & - (dtmp_c(j,2,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,2,j,nw) + & - (dtmp_c(j,3,a,m+l,k,nw)) * een_rescaled_n_deriv_e(m ,a,3,j,nw) & + (dtmp_c(j,1,a,m ,k,nw)) * een_rescaled_n_deriv_e(j,1,a,m+l,nw) + & + (dtmp_c(j,2,a,m ,k,nw)) * een_rescaled_n_deriv_e(j,2,a,m+l,nw) + & + (dtmp_c(j,3,a,m ,k,nw)) * een_rescaled_n_deriv_e(j,3,a,m+l,nw) + & + (dtmp_c(j,1,a,m+l,k,nw)) * een_rescaled_n_deriv_e(j,1,a,m ,nw) + & + (dtmp_c(j,2,a,m+l,k,nw)) * een_rescaled_n_deriv_e(j,2,a,m ,nw) + & + (dtmp_c(j,3,a,m+l,k,nw)) * een_rescaled_n_deriv_e(j,3,a,m ,nw) & ) * cn end do end do @@ -6353,7 +6360,7 @@ end function qmckl_compute_factor_een_deriv_e_f real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num) real (c_double ) , intent(in) :: dtmp_c(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num) real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num) - real (c_double ) , intent(in) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num) + real (c_double ) , intent(in) :: een_rescaled_n_deriv_e(elec_num,4,nucl_num,0:cord_num,walk_num) real (c_double ) , intent(out) :: factor_een_deriv_e(elec_num,4,walk_num) integer(c_int32_t), external :: qmckl_compute_factor_een_deriv_e_f @@ -6374,7 +6381,7 @@ end function qmckl_compute_factor_een_deriv_e_f end function qmckl_compute_factor_een_deriv_e #+end_src - + *** Test #+begin_src python :results output :exports none :noweb yes import numpy as np From e2a678cc5cb53ac72c2526d636306aa0e8361d73 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 17:31:17 +0100 Subject: [PATCH 26/29] Cleaned tmp_c and dtmp_c. --- org/qmckl_jastrow.org | 57 ------------------------------------------- 1 file changed, 57 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 2a5d105..80430a5 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -5013,8 +5013,6 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num) double precision , intent(out) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num) double precision :: x - !double precision,dimension(:,:,:,:),allocatable :: een_rescaled_e_T - !double precision,dimension(:,:,:,:),allocatable :: een_rescaled_n_T integer*8 :: i, j, a, l, kk, p, lmax, nw character :: TransA, TransB double precision :: alpha, beta @@ -5025,27 +5023,6 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & alpha = 1.0d0 beta = 0.0d0 - !allocate(een_rescaled_e_T(elec_num,elec_num,0:cord_num,walk_num)) - !allocate(een_rescaled_n_T(elec_num,nucl_num,0:cord_num,walk_num)) - !do nw = 1,walk_num - !do i = 1, elec_num - ! do j = 1, elec_num - ! do l = 0,cord_num - ! een_rescaled_e_T(i,j,l,nw) = een_rescaled_e(l,j,i,nw) - ! end do - ! end do - !end do - !end do - !do nw = 1,walk_num - !do i = 1, elec_num - ! do j = 1, nucl_num - ! do l = 0,cord_num - ! een_rescaled_n_T(i,j,l,nw) = een_rescaled_n(l,j,i,nw) - ! end do - ! end do - !end do - !end do - info = QMCKL_SUCCESS if (context == QMCKL_NULL_CONTEXT) then @@ -5084,16 +5061,7 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, & tmp_c(1,1,0,i,nw),LDC) end do end do - !do kk=0, cord_num-1 - !do i=1,nucl_num - ! do j=1,elec_num - ! print *,tmp_c(j,i,:,kk,1) - ! end do - !end do - !end do - !deallocate(een_rescaled_e_T) - !deallocate(een_rescaled_n_T) end function qmckl_compute_tmp_c_f #+end_src @@ -5178,8 +5146,6 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & character :: TransA, TransB double precision :: alpha, beta integer*8 :: M, N, K, LDA, LDB, LDC - !double precision,dimension(:,:,:,:,:),allocatable :: een_rescaled_e_deriv_e_T - !double precision,dimension(:,:,:,:),allocatable :: een_rescaled_n_T TransA = 'N' TransB = 'N' @@ -5188,27 +5154,6 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & info = QMCKL_SUCCESS - !allocate(een_rescaled_e_deriv_e_T(elec_num,4,elec_num,0:cord_num,walk_num)) - !allocate(een_rescaled_n_T(elec_num,nucl_num,0:cord_num,walk_num)) - !do nw = 1,walk_num - !do i = 1, elec_num - ! do ii = 1, 4 - ! do j = 1, elec_num - ! do l = 0,cord_num - ! een_rescaled_e_deriv_e_T(i,ii,j,l,nw) = een_rescaled_e_deriv_e(l,j,ii,i,nw) - ! end do - ! end do - ! end do - !end do - !do i = 1, elec_num - ! do j = 1, nucl_num - ! do l = 0,cord_num - ! een_rescaled_n_T(i,j,l,nw) = een_rescaled_n(l,j,i,nw) - ! end do - ! end do - !end do - !end do - if (context == QMCKL_NULL_CONTEXT) then info = QMCKL_INVALID_CONTEXT return @@ -5246,8 +5191,6 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, & end do end do - !deallocate(een_rescaled_e_deriv_e_T) - !deallocate(een_rescaled_n_T) end function qmckl_compute_dtmp_c_f #+end_src From 8ed7a8b672f1eebfc37fed1a9f73d5549f6ee065 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 11 Feb 2022 17:35:07 +0100 Subject: [PATCH 27/29] Added dim to factor_een and factor_een_deriv_e. --- org/qmckl_jastrow.org | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index 80430a5..abeac12 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -5330,11 +5330,11 @@ assert(fabs(dtmp_c[0][1][0][0][0][0] - 0.237440520852232) < 1e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* const factor_een); +qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* const factor_een, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* const factor_een) +qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* const factor_een, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -5350,6 +5350,7 @@ qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* cons int64_t sze = ctx->electron.walk_num * ctx->electron.num; memcpy(factor_een, ctx->jastrow.factor_een, sze*sizeof(double)); + (*size_max)=sze; return QMCKL_SUCCESS; } @@ -5803,7 +5804,8 @@ print("factor_een:",factor_een) assert(qmckl_jastrow_provided(context)); double factor_een[walk_num]; -rc = qmckl_get_jastrow_factor_een(context, &(factor_een[0])); +size_max=0; +rc = qmckl_get_jastrow_factor_een(context, &(factor_een[0]),&size_max); assert(fabs(factor_een[0] + 0.37407972141304213) < 1e-12); #+end_src @@ -5817,11 +5819,11 @@ assert(fabs(factor_een[0] + 0.37407972141304213) < 1e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, double* const factor_een_deriv_e); +qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, double* const factor_een_deriv_e, int64_t* size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, double* const factor_een_deriv_e) +qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, double* const factor_een_deriv_e, int64_t* size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -5837,6 +5839,7 @@ qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, doub int64_t sze = ctx->electron.walk_num * ctx->electron.num; memcpy(factor_een_deriv_e, ctx->jastrow.factor_een_deriv_e, sze*sizeof(double)); + (*size_max)=sze; return QMCKL_SUCCESS; } @@ -6382,7 +6385,8 @@ print("factor_een:",factor_een) assert(qmckl_jastrow_provided(context)); double factor_een_deriv_e[walk_num][elec_num]; -rc = qmckl_get_jastrow_factor_een_deriv_e(context, &(factor_een_deriv_e[0][0])); +size_max=0; +rc = qmckl_get_jastrow_factor_een_deriv_e(context, &(factor_een_deriv_e[0][0]),&size_max); assert(fabs(factor_een_deriv_e[0][0] + 0.0005481671107226865) < 1e-12); #+end_src From 685b7201fc7671e8d8fc73273f1029cd771aeb3c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 14 Feb 2022 19:11:37 +0100 Subject: [PATCH 28/29] Accelerated AOs --- org/qmckl_ao.org | 407 +++++++++++++++++++++++++++++++----------- org/qmckl_jastrow.org | 384 ++++++++++++++++++++++++++++----------- 2 files changed, 580 insertions(+), 211 deletions(-) diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index d40e478..8783884 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -3387,6 +3387,7 @@ for (j=0 ; j cutoff*nucleus_range(inucl)) then + cycle + end if + + ! C is zero-based, so shift bounds by one + ishell_start = nucleus_index(inucl) + 1 + ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) + do ishell=ishell_start, ishell_end shell_vgl(ishell, 1, ipoint) = 0.d0 @@ -3523,6 +3530,7 @@ end function qmckl_compute_ao_basis_shell_gaussian_vgl_f nucl_num, & nucleus_shell_num, & nucleus_index, & + nucleus_range, & shell_prim_index, & shell_prim_num, & coord, & @@ -3542,6 +3550,7 @@ end function qmckl_compute_ao_basis_shell_gaussian_vgl_f integer (c_int64_t) , intent(in) , value :: nucl_num integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) + real (c_double ) , intent(in) :: nucleus_range(nucl_num) integer (c_int64_t) , intent(in) :: shell_prim_index(shell_num) integer (c_int64_t) , intent(in) :: shell_prim_num(shell_num) real (c_double ) , intent(in) :: coord(point_num,3) @@ -3559,6 +3568,7 @@ end function qmckl_compute_ao_basis_shell_gaussian_vgl_f nucl_num, & nucleus_shell_num, & nucleus_index, & + nucleus_range, & shell_prim_index, & shell_prim_num, & coord, & @@ -3625,6 +3635,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) ctx->nucleus.num, ctx->ao_basis.nucleus_shell_num, ctx->ao_basis.nucleus_index, + ctx->ao_basis.nucleus_range, ctx->ao_basis.shell_prim_index, ctx->ao_basis.shell_prim_num, ctx->point.coord.data, @@ -4263,7 +4274,7 @@ integer function qmckl_ao_polynomial_transp_vgl_f (context, & integer :: a,b,c,d real*8 :: Y(3) integer :: lmax_array(3) - real*8 :: pows(-2:lmax,3) + real*8 :: pows(-2:21,3) ! lmax < 22 double precision :: xy, yz, xz double precision :: da, db, dc, dd @@ -4290,17 +4301,12 @@ integer function qmckl_ao_polynomial_transp_vgl_f (context, & endif - do i=1,3 - Y(i) = X(i) - R(i) - end do - lmax_array(1:3) = lmax - if (lmax == 0) then - VGL(1,1) = 1.d0 - VGL(1,2:5) = 0.d0 - l(1:3,1) = 0 - n=1 - else if (lmax > 0) then + if (lmax > 0) then + + do i=1,3 + Y(i) = X(i) - R(i) + end do pows(-2:0,1:3) = 1.d0 do i=1,lmax pows(i,1) = pows(i-1,1) * Y(1) @@ -4327,6 +4333,12 @@ integer function qmckl_ao_polynomial_transp_vgl_f (context, & VGL(4,4) = 1.d0 n=4 + else + VGL(1,1) = 1.d0 + VGL(1,2:5) = 0.d0 + l(1:3,1) = 0 + n=1 + return endif ! l>=2 @@ -4535,7 +4547,8 @@ end function test_qmckl_ao_polynomial_vgl :FRetType: qmckl_exit_code :END: - #+NAME: qmckl_ao_vgl_args +** Unoptimized version + #+NAME: qmckl_ao_vgl_args_doc | Variable | Type | In/Out | Description | |-----------------------+-----------------------------------+--------+----------------------------------------------| | ~context~ | ~qmckl_context~ | in | Global state | @@ -4552,9 +4565,8 @@ end function test_qmckl_ao_polynomial_vgl | ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell | | ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs | | ~shell_vgl~ | ~double[point_num][5][shell_num]~ | in | Value, gradients and Laplacian of the shells | - | ~ao_vgl~ | ~double[point_num][5][ao_num]~ | out | Value, gradients and Laplacian of the AOs | + | ~ao_vgl~ | ~double[point_num][5][ao_num]~ | out | Value, gradients and Laplacian of the AOs | -** Unoptimized version #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_ao_vgl_doc_f(context, & ao_num, shell_num, point_num, nucl_num, & @@ -4591,15 +4603,25 @@ integer function qmckl_compute_ao_vgl_doc_f(context, & integer, external :: qmckl_ao_polynomial_vgl_f double precision, allocatable :: poly_vgl(:,:) - integer , allocatable :: powers(:,:) + integer , allocatable :: powers(:,:), ao_index(:) - allocate(poly_vgl(5,ao_num), powers(3,ao_num)) + allocate(poly_vgl(5,ao_num), powers(3,ao_num), ao_index(ao_num)) ! Pre-computed data do l=0,20 lstart(l) = l*(l+1)*(l+2)/6 +1 end do + k=1 + do inucl=1,nucl_num + ishell_start = nucleus_index(inucl) + 1 + ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) + do ishell = ishell_start, ishell_end + l = shell_ang_mom(ishell) + ao_index(ishell) = k + k = k + lstart(l+1) - lstart(l) + end do + end do info = QMCKL_SUCCESS ! Don't compute polynomials when the radial part is zero. @@ -4609,7 +4631,6 @@ integer function qmckl_compute_ao_vgl_doc_f(context, & e_coord(1) = coord(ipoint,1) e_coord(2) = coord(ipoint,2) e_coord(3) = coord(ipoint,3) - k=1 do inucl=1,nucl_num n_coord(1) = nucl_coord(inucl,1) n_coord(2) = nucl_coord(inucl,2) @@ -4620,7 +4641,7 @@ integer function qmckl_compute_ao_vgl_doc_f(context, & y = e_coord(2) - n_coord(2) z = e_coord(3) - n_coord(3) - r2 = x*x + z*z + z*z + r2 = x*x + y*y + z*z if (r2 > cutoff*nucleus_range(inucl)) then cycle @@ -4635,6 +4656,7 @@ integer function qmckl_compute_ao_vgl_doc_f(context, & ishell_start = nucleus_index(inucl) + 1 ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) do ishell = ishell_start, ishell_end + k = ao_index(ishell) l = shell_ang_mom(ishell) do il = lstart(l), lstart(l+1)-1 ! Value @@ -4680,18 +4702,43 @@ end function qmckl_compute_ao_vgl_doc_f #+end_src ** HPC version + #+NAME: qmckl_ao_vgl_args_hpc + | Variable | Type | In/Out | Description | + |-----------------------+--------------------------------+--------+----------------------------------------------| + | ~context~ | ~qmckl_context~ | in | Global state | + | ~ao_num~ | ~int64_t~ | in | Number of AOs | + | ~shell_num~ | ~int64_t~ | in | Number of shells | + | ~prim_num~ | ~int64_t~ | in | Number of primitives | + | ~point_num~ | ~int64_t~ | in | Number of points | + | ~nucl_num~ | ~int64_t~ | in | Number of nuclei | + | ~coord~ | ~double[3][point_num]~ | in | Coordinates | + | ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates | + | ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus | + | ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells per nucleus | + | ~nucleus_range~ | ~double[nucl_num]~ | in | Range beyond which all is zero | + | ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | in | Maximum angular momentum per nucleus | + | ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell | + | ~shell_prim_index~ | ~int64_t[shell_num]~ | in | Index of the 1st primitive of each shell | + | ~shell_prim_num~ | ~int64_t[shell_num]~ | in | Number of primitives per shell | + | ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs | + | ~ao_expo~ | ~double[prim_num]~ | in | Value, gradients and Laplacian of the shells | + | ~coef_normalized~ | ~double[prim_num]~ | in | Value, gradients and Laplacian of the shells | + | ~ao_vgl~ | ~double[point_num][5][ao_num]~ | out | Value, gradients and Laplacian of the AOs | + #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_ao_vgl_hpc_f(context, & - ao_num, shell_num, point_num, nucl_num, & +integer function qmckl_compute_ao_vgl_hpc_f(context, & + ao_num, shell_num, prim_num, point_num, nucl_num, & coord, nucl_coord, nucleus_index, nucleus_shell_num, & - nucleus_range, nucleus_max_ang_mom, shell_ang_mom, & - ao_factor, shell_vgl, ao_vgl) & + nucleus_range, nucleus_max_ang_mom, shell_ang_mom, & + shell_prim_index, shell_prim_num, ao_factor, expo, & + coef_normalized, ao_vgl) & result(info) use qmckl implicit none integer(qmckl_context), intent(in) :: context integer*8 , intent(in) :: ao_num integer*8 , intent(in) :: shell_num + integer*8 , intent(in) :: prim_num integer*8 , intent(in) :: point_num integer*8 , intent(in) :: nucl_num double precision , intent(in) :: coord(point_num,3) @@ -4701,8 +4748,11 @@ integer function qmckl_compute_ao_vgl_hpc_f(context, & double precision , intent(in) :: nucleus_range(nucl_num) integer , intent(in) :: nucleus_max_ang_mom(nucl_num) integer , intent(in) :: shell_ang_mom(shell_num) + integer*8 , intent(in) :: shell_prim_index(shell_num) + integer*8 , intent(in) :: shell_prim_num(shell_num) double precision , intent(in) :: ao_factor(ao_num) - double precision , intent(in) :: shell_vgl(shell_num,5,point_num) + double precision , intent(in) :: expo(prim_num) + double precision , intent(in) :: coef_normalized(prim_num) double precision , intent(out) :: ao_vgl(ao_num,5,point_num) double precision :: e_coord(3), n_coord(3) @@ -4710,21 +4760,37 @@ integer function qmckl_compute_ao_vgl_hpc_f(context, & integer :: l, il, k integer*8 :: ipoint, inucl, ishell integer*8 :: ishell_start, ishell_end - integer :: lstart(0:20) - double precision :: x, y, z, r2 - double precision :: cutoff + integer :: lstart(0:20) + double precision :: x, y, z, r2, s1, s2, s3, s4, s5, s6 + double precision :: cutoff, v, two_a + integer*8 :: iprim_start , iprim_end, iprim integer, external :: qmckl_ao_polynomial_transp_vgl_f double precision, allocatable :: poly_vgl(:,:) - integer , allocatable :: powers(:,:) + integer , allocatable :: powers(:,:), ao_index(:) - allocate(poly_vgl(ao_num,5), powers(3,ao_num)) + integer :: nidx, idx, n + double precision, allocatable :: ar2(:), expo_(:), c_(:) + + allocate(poly_vgl(ao_num,5), powers(3,ao_num), ao_index(ao_num)) + allocate(c_(prim_num), expo_(prim_num), ar2(prim_num)) ! Pre-computed data do l=0,20 lstart(l) = l*(l+1)*(l+2)/6 +1 end do + k=1 + do inucl=1,nucl_num + ishell_start = nucleus_index(inucl) + 1 + ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) + do ishell = ishell_start, ishell_end + l = shell_ang_mom(ishell) + ao_index(ishell) = k + k = k + lstart(l+1) - lstart(l) + end do + end do + info = QMCKL_SUCCESS ! Don't compute polynomials when the radial part is zero. @@ -4734,7 +4800,6 @@ integer function qmckl_compute_ao_vgl_hpc_f(context, & e_coord(1) = coord(ipoint,1) e_coord(2) = coord(ipoint,2) e_coord(3) = coord(ipoint,3) - k=1 do inucl=1,nucl_num n_coord(1) = nucl_coord(inucl,1) n_coord(2) = nucl_coord(inucl,2) @@ -4745,7 +4810,7 @@ integer function qmckl_compute_ao_vgl_hpc_f(context, & y = e_coord(2) - n_coord(2) z = e_coord(3) - n_coord(3) - r2 = x*x + z*z + z*z + r2 = x*x + y*y + z*z if (r2 > cutoff*nucleus_range(inucl)) then cycle @@ -4759,68 +4824,80 @@ integer function qmckl_compute_ao_vgl_hpc_f(context, & ! Loop over shells ishell_start = nucleus_index(inucl) + 1 ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl) + do ishell = ishell_start, ishell_end + iprim_start = shell_prim_index(ishell) + 1 + iprim_end = shell_prim_index(ishell) + shell_prim_num(ishell) + + ! /!\ Gaussian fuctions + nidx = 0 + do iprim = iprim_start, iprim_end + v = expo(iprim)*r2 + if (v > cutoff) then + cycle + end if + nidx = nidx+1 + ar2(nidx) = v + c_(nidx) = coef_normalized(iprim) + expo_(nidx) = expo(iprim) + enddo + + s1 = 0.d0 + s5 = 0.d0 + s6 = 0.d0 + do idx = 1, nidx + v = c_(idx) * dexp(-ar2(idx)) + s1 = s1 + v + s6 = s6 - expo_(idx) * v + s5 = s5 + ar2(idx) + end do + s6 = s6 +s6 + s5 = 2.d0*s5 + s6*3.d0 + s2 = s6 * x + s3 = s6 * y + s4 = s6 * z + l = shell_ang_mom(ishell) - if (shell_vgl(ishell,1,ipoint) /= 0.d0) then - do il = lstart(l), lstart(l+1)-1 - ! Value - ao_vgl(k,1,ipoint) = & - poly_vgl(il,1) * shell_vgl(ishell,1,ipoint) * ao_factor(k) - - ! Grad_x - ao_vgl(k,2,ipoint) = ( & - poly_vgl(il,2) * shell_vgl(ishell,1,ipoint) + & - poly_vgl(il,1) * shell_vgl(ishell,2,ipoint) & - ) * ao_factor(k) - - ! Grad_y - ao_vgl(k,3,ipoint) = ( & - poly_vgl(il,3) * shell_vgl(ishell,1,ipoint) + & - poly_vgl(il,1) * shell_vgl(ishell,3,ipoint) & - ) * ao_factor(k) - - ! Grad_z - ao_vgl(k,4,ipoint) = ( & - poly_vgl(il,4) * shell_vgl(ishell,1,ipoint) + & - poly_vgl(il,1) * shell_vgl(ishell,4,ipoint) & - ) * ao_factor(k) - - ! Lapl_z - ao_vgl(k,5,ipoint) = ( & - poly_vgl(il,5) * shell_vgl(ishell,1,ipoint) + & - poly_vgl(il,1) * shell_vgl(ishell,5,ipoint) + & - 2.d0 * ( & - poly_vgl(il,2) * shell_vgl(ishell,2,ipoint) + & - poly_vgl(il,3) * shell_vgl(ishell,3,ipoint) + & - poly_vgl(il,4) * shell_vgl(ishell,4,ipoint) ) & - ) * ao_factor(k) - k = k+1 + k = ao_index(ishell) + n = lstart(l+1)-lstart(l) + if (nidx > 0) then + idx = lstart(l) + do il = 0,n-1 + ao_vgl(k+il,1,ipoint) = poly_vgl(idx+il,1) * s1 * ao_factor(k+il) + ao_vgl(k+il,2,ipoint) = (poly_vgl(idx+il,2) * s1 + poly_vgl(idx+il,1) * s2) * ao_factor(k+il) + ao_vgl(k+il,3,ipoint) = (poly_vgl(idx+il,3) * s1 + poly_vgl(idx+il,1) * s3) * ao_factor(k+il) + ao_vgl(k+il,4,ipoint) = (poly_vgl(idx+il,4) * s1 + poly_vgl(idx+il,1) * s4) * ao_factor(k+il) + ao_vgl(k+il,5,ipoint) = (poly_vgl(idx+il,5) * s1 + & + poly_vgl(idx+il,1) * s5 + 2.d0*( & + poly_vgl(idx+il,2) * s2 + & + poly_vgl(idx+il,3) * s3 + & + poly_vgl(idx+il,4) * s4 )) * ao_factor(k+il) end do else - do il = lstart(l), lstart(l+1)-1 - ao_vgl(k,1,ipoint) = 0.d0 - ao_vgl(k,2,ipoint) = 0.d0 - ao_vgl(k,3,ipoint) = 0.d0 - ao_vgl(k,4,ipoint) = 0.d0 - ao_vgl(k,5,ipoint) = 0.d0 - k = k+1 + do il = 0, n-1 + ao_vgl(k+il,1,ipoint) = 0.d0 + ao_vgl(k+il,2,ipoint) = 0.d0 + ao_vgl(k+il,3,ipoint) = 0.d0 + ao_vgl(k+il,4,ipoint) = 0.d0 + ao_vgl(k+il,5,ipoint) = 0.d0 end do - end if + endif + end do end do end do - + deallocate(poly_vgl, powers) end function qmckl_compute_ao_vgl_hpc_f #+end_src ** Interfaces -# #+CALL: generate_c_header(table=qmckl_ao_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl")) +# #+CALL: generate_c_header(table=qmckl_ao_vgl_args_doc,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl")) # (Commented because the header needs to go into h_private_func #+RESULTS: #+begin_src c :tangle (eval h_private_func) :comments org - qmckl_exit_code qmckl_compute_ao_vgl ( + qmckl_exit_code qmckl_compute_ao_vgl_doc ( const qmckl_context context, const int64_t ao_num, const int64_t shell_num, @@ -4837,12 +4914,34 @@ end function qmckl_compute_ao_vgl_hpc_f const double* shell_vgl, double* const ao_vgl ); #+end_src + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_ao_vgl_hpc ( + const qmckl_context context, + const int64_t ao_num, + const int64_t shell_num, + const int64_t prim_num, + const int64_t point_num, + const int64_t nucl_num, + const double* coord, + const double* nucl_coord, + const int64_t* nucleus_index, + const int64_t* nucleus_shell_num, + const double* nucleus_range, + const int32_t* nucleus_max_ang_mom, + const int32_t* shell_ang_mom, + const int64_t* shell_prim_index, + const int64_t* shell_prim_num, + const double* ao_factor, + const double* expo, + const double* coef_normalized, + double* const ao_vgl ); + #+end_src - #+CALL: generate_c_interface(table=qmckl_ao_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl")) + #+CALL: generate_c_interface(table=qmckl_ao_vgl_args_doc,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl_doc")) #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_ao_vgl & + integer(c_int32_t) function qmckl_compute_ao_vgl_doc & (context, & ao_num, & shell_num, & @@ -4879,13 +4978,8 @@ end function qmckl_compute_ao_vgl_hpc_f real (c_double ) , intent(in) :: shell_vgl(shell_num,5,point_num) real (c_double ) , intent(out) :: ao_vgl(ao_num,5,point_num) -#ifdef HAVE_HPC - integer(c_int32_t), external :: qmckl_compute_ao_vgl_hpc_f - info = qmckl_compute_ao_vgl_hpc_f & -#else integer(c_int32_t), external :: qmckl_compute_ao_vgl_doc_f info = qmckl_compute_ao_vgl_doc_f & -#endif (context, & ao_num, & shell_num, & @@ -4902,7 +4996,81 @@ end function qmckl_compute_ao_vgl_hpc_f shell_vgl, & ao_vgl) - end function qmckl_compute_ao_vgl + end function qmckl_compute_ao_vgl_doc + #+end_src + + #+CALL: generate_c_interface(table=qmckl_ao_vgl_args_hpc,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl_hpc")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_ao_vgl_hpc & + (context, & + ao_num, & + shell_num, & + prim_num, & + point_num, & + nucl_num, & + coord, & + nucl_coord, & + nucleus_index, & + nucleus_shell_num, & + nucleus_range, & + nucleus_max_ang_mom, & + shell_ang_mom, & + shell_prim_index, & + shell_prim_num, & + ao_factor, & + ao_expo, & + coef_normalized, & + ao_vgl) & + bind(C) result(info) + + use, intrinsic :: iso_c_binding + implicit none + + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: ao_num + integer (c_int64_t) , intent(in) , value :: shell_num + integer (c_int64_t) , intent(in) , value :: prim_num + integer (c_int64_t) , intent(in) , value :: point_num + integer (c_int64_t) , intent(in) , value :: nucl_num + real (c_double ) , intent(in) :: coord(point_num,3) + real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) + integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) + integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) + real (c_double ) , intent(in) :: nucleus_range(nucl_num) + integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num) + integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num) + integer (c_int64_t) , intent(in) :: shell_prim_index(shell_num) + integer (c_int64_t) , intent(in) :: shell_prim_num(shell_num) + real (c_double ) , intent(in) :: ao_factor(ao_num) + real (c_double ) , intent(in) :: ao_expo(prim_num) + real (c_double ) , intent(in) :: coef_normalized(prim_num) + real (c_double ) , intent(out) :: ao_vgl(ao_num,5,point_num) + + integer(c_int32_t), external :: qmckl_compute_ao_vgl_hpc_f + info = qmckl_compute_ao_vgl_hpc_f & + (context, & + ao_num, & + shell_num, & + prim_num, & + point_num, & + nucl_num, & + coord, & + nucl_coord, & + nucleus_index, & + nucleus_shell_num, & + nucleus_range, & + nucleus_max_ang_mom, & + shell_ang_mom, & + shell_prim_index, & + shell_prim_num, & + ao_factor, & + ao_expo, & + coef_normalized, & + ao_vgl) + + end function qmckl_compute_ao_vgl_hpc #+end_src *** Provide :noexport: @@ -4938,10 +5106,12 @@ qmckl_exit_code qmckl_provide_ao_vgl(qmckl_context context) qmckl_exit_code rc; /* Provide required data */ +#ifndef HAVE_HPC rc = qmckl_provide_ao_basis_shell_vgl(context); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL); } +#endif /* Allocate array */ if (ctx->ao_basis.ao_vgl == NULL) { @@ -4958,22 +5128,43 @@ qmckl_exit_code qmckl_provide_ao_vgl(qmckl_context context) } ctx->ao_basis.ao_vgl = ao_vgl; } - - rc = qmckl_compute_ao_vgl(context, - ctx->ao_basis.ao_num, - ctx->ao_basis.shell_num, - ctx->point.num, - ctx->nucleus.num, - ctx->point.coord.data, - ctx->nucleus.coord.data, - ctx->ao_basis.nucleus_index, - ctx->ao_basis.nucleus_shell_num, - ctx->ao_basis.nucleus_range, - ctx->ao_basis.nucleus_max_ang_mom, - ctx->ao_basis.shell_ang_mom, - ctx->ao_basis.ao_factor, - ctx->ao_basis.shell_vgl, - ctx->ao_basis.ao_vgl); +#ifdef HAVE_HPC + rc = qmckl_compute_ao_vgl_hpc(context, + ctx->ao_basis.ao_num, + ctx->ao_basis.shell_num, + ctx->ao_basis.prim_num, + ctx->point.num, + ctx->nucleus.num, + ctx->point.coord.data, + ctx->nucleus.coord.data, + ctx->ao_basis.nucleus_index, + ctx->ao_basis.nucleus_shell_num, + ctx->ao_basis.nucleus_range, + ctx->ao_basis.nucleus_max_ang_mom, + ctx->ao_basis.shell_ang_mom, + ctx->ao_basis.shell_prim_index, + ctx->ao_basis.shell_prim_num, + ctx->ao_basis.ao_factor, + ctx->ao_basis.exponent, + ctx->ao_basis.coefficient_normalized, + ctx->ao_basis.ao_vgl); +#else + rc = qmckl_compute_ao_vgl_doc(context, + ctx->ao_basis.ao_num, + ctx->ao_basis.shell_num, + ctx->point.num, + ctx->nucleus.num, + ctx->point.coord.data, + ctx->nucleus.coord.data, + ctx->ao_basis.nucleus_index, + ctx->ao_basis.nucleus_shell_num, + ctx->ao_basis.nucleus_range, + ctx->ao_basis.nucleus_max_ang_mom, + ctx->ao_basis.shell_ang_mom, + ctx->ao_basis.ao_factor, + ctx->ao_basis.shell_vgl, + ctx->ao_basis.ao_vgl); +#endif if (rc != QMCKL_SUCCESS) { return rc; } diff --git a/org/qmckl_jastrow.org b/org/qmckl_jastrow.org index abeac12..d745dcf 100644 --- a/org/qmckl_jastrow.org +++ b/org/qmckl_jastrow.org @@ -9,10 +9,10 @@ nuclear ($\mathbf{R}$) coordinates. Its defined as $\exp(J(\mathbf{r},\mathbf{R}))$, where \[ - J(\mathbf{r},\mathbf{R}) = J_{\text{eN}}(\mathbf{r},\mathbf{R}) + J_{\text{ee}}(\mathbf{r}) + J_{\text{eeN}}(\mathbf{r},\mathbf{R}) + J(\mathbf{r},\mathbf{R}) = J_{\text{eN}}(\mathbf{r},\mathbf{R}) + J_{\text{ee}}(\mathbf{r}) + J_{\text{eeN}}(\mathbf{r},\mathbf{R}) \] - In the following, we us the notations $r_{ij} = |\mathbf{r}_i - \mathbf{r}_j|$ and + In the following, we us the notations $r_{ij} = |\mathbf{r}_i - \mathbf{r}_j|$ and $R_{i\alpha} = |\mathbf{r}_i - \mathbf{R}_\alpha|$. $J_{\text{eN}}$ contains electron-nucleus terms: @@ -23,9 +23,9 @@ \sum_{p=2}^{N_\text{ord}^a} a_{p+1}\, [f(R_{i\alpha})]^p - J_{eN}^\infty \] - $J_{\text{ee}}$ contains electron-electron terms: + $J_{\text{ee}}$ contains electron-electron terms: \[ - J_{\text{ee}}(\mathbf{r}) = + J_{\text{ee}}(\mathbf{r}) = \sum_{i=1}^{N_\text{elec}} \sum_{j=1}^{i-1} \frac{b_1\, f(r_{ij})}{1+b_2\, f(r_{ij})} + \sum_{p=2}^{N_\text{ord}^b} a_{p+1}\, [f(r_{ij})]^p - J_{ee}^\infty @@ -43,7 +43,7 @@ \sum_{l=0}^{p-k-2\delta_{k,0}} c_{lkp\alpha} \left[ g({r}_{ij}) \right]^k \left[ \left[ g({R}_{i\alpha}) \right]^l + \left[ g({R}_{j\alpha}) \right]^l \right] - \left[ g({R}_{i\,\alpha}) \, g({R}_{j\alpha}) \right]^{(p-k-l)/2} + \left[ g({R}_{i\,\alpha}) \, g({R}_{j\alpha}) \right]^{(p-k-l)/2} \] $c_{lkp\alpha}$ are non-zero only when $p-k-l$ is even. @@ -55,10 +55,10 @@ g(r) = e^{-\kappa\, r}. \] - The terms $J_{\text{ee}}^\infty$ and $J_{\text{eN}}^\infty$ are shifts to ensure that + The terms $J_{\text{ee}}^\infty$ and $J_{\text{eN}}^\infty$ are shifts to ensure that $J_{\text{ee}}$ and $J_{\text{eN}}$ have an asymptotic value of zero. - - + + * Headers :noexport: #+begin_src elisp :noexport :results none (org-babel-lob-ingest "../tools/lib.org") @@ -412,10 +412,10 @@ qmckl_exit_code qmckl_get_jastrow_aord_num (qmckl_context context, int qmckl_exit_code qmckl_get_jastrow_bord_num (qmckl_context context, int64_t* const bord_num); qmckl_exit_code qmckl_get_jastrow_cord_num (qmckl_context context, int64_t* const bord_num); qmckl_exit_code qmckl_get_jastrow_type_nucl_num (qmckl_context context, int64_t* const type_nucl_num); -qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (qmckl_context context, int64_t* const type_nucl_num, int64_t* size_max); -qmckl_exit_code qmckl_get_jastrow_aord_vector (qmckl_context context, double * const aord_vector, int64_t* size_max); -qmckl_exit_code qmckl_get_jastrow_bord_vector (qmckl_context context, double * const bord_vector, int64_t* size_max); -qmckl_exit_code qmckl_get_jastrow_cord_vector (qmckl_context context, double * const cord_vector, int64_t* size_max); +qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (qmckl_context context, int64_t* const type_nucl_num, const int64_t size_max); +qmckl_exit_code qmckl_get_jastrow_aord_vector (qmckl_context context, double * const aord_vector, const int64_t size_max); +qmckl_exit_code qmckl_get_jastrow_bord_vector (qmckl_context context, double * const bord_vector, const int64_t size_max); +qmckl_exit_code qmckl_get_jastrow_cord_vector (qmckl_context context, double * const cord_vector, const int64_t size_max); #+end_src Along with these core functions, calculation of the jastrow factor @@ -474,7 +474,7 @@ qmckl_exit_code qmckl_get_jastrow_aord_num (const qmckl_context context, int64_t } assert (ctx->jastrow.aord_num > 0); - *aord_num = ctx->jastrow.aord_num; + ,*aord_num = ctx->jastrow.aord_num; return QMCKL_SUCCESS; } @@ -501,7 +501,7 @@ qmckl_exit_code qmckl_get_jastrow_bord_num (const qmckl_context context, int64_t } assert (ctx->jastrow.bord_num > 0); - *bord_num = ctx->jastrow.bord_num; + ,*bord_num = ctx->jastrow.bord_num; return QMCKL_SUCCESS; } @@ -528,7 +528,7 @@ qmckl_exit_code qmckl_get_jastrow_cord_num (const qmckl_context context, int64_t } assert (ctx->jastrow.cord_num > 0); - *cord_num = ctx->jastrow.cord_num; + ,*cord_num = ctx->jastrow.cord_num; return QMCKL_SUCCESS; } @@ -555,11 +555,15 @@ qmckl_exit_code qmckl_get_jastrow_type_nucl_num (const qmckl_context context, in } assert (ctx->jastrow.type_nucl_num > 0); - *type_nucl_num = ctx->jastrow.type_nucl_num; + ,*type_nucl_num = ctx->jastrow.type_nucl_num; return QMCKL_SUCCESS; } -qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (const qmckl_context context, int64_t * const type_nucl_vector, int64_t* size_max) { +qmckl_exit_code +qmckl_get_jastrow_type_nucl_vector (const qmckl_context context, + int64_t* const type_nucl_vector, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -582,12 +586,21 @@ qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (const qmckl_context context, } assert (ctx->jastrow.type_nucl_vector != NULL); + if (size_max < ctx->jastrow.type_nucl_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_type_nucl_vector", + "Array too small. Expected jastrow.type_nucl_num"); + } + memcpy(type_nucl_vector, ctx->jastrow.type_nucl_vector, ctx->jastrow.type_nucl_num*sizeof(int64_t)); - (*size_max) = ctx->jastrow.type_nucl_num; return QMCKL_SUCCESS; } -qmckl_exit_code qmckl_get_jastrow_aord_vector (const qmckl_context context, double * const aord_vector, int64_t* size_max) { +qmckl_exit_code +qmckl_get_jastrow_aord_vector (const qmckl_context context, + double * const aord_vector, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -611,12 +624,20 @@ qmckl_exit_code qmckl_get_jastrow_aord_vector (const qmckl_context context, doub assert (ctx->jastrow.aord_vector != NULL); int64_t sze = (ctx->jastrow.aord_num + 1)*ctx->jastrow.type_nucl_num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_aord_vector", + "Array too small. Expected (ctx->jastrow.aord_num + 1)*ctx->jastrow.type_nucl_num"); + } memcpy(aord_vector, ctx->jastrow.aord_vector, sze*sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } -qmckl_exit_code qmckl_get_jastrow_bord_vector (const qmckl_context context, double * const bord_vector, int64_t* size_max) { +qmckl_exit_code +qmckl_get_jastrow_bord_vector (const qmckl_context context, + double * const bord_vector, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -640,12 +661,20 @@ qmckl_exit_code qmckl_get_jastrow_bord_vector (const qmckl_context context, doub assert (ctx->jastrow.bord_vector != NULL); int64_t sze=ctx->jastrow.bord_num +1; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_bord_vector", + "Array too small. Expected (ctx->jastrow.bord_num + 1)"); + } memcpy(bord_vector, ctx->jastrow.bord_vector, sze*sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } -qmckl_exit_code qmckl_get_jastrow_cord_vector (const qmckl_context context, double * const cord_vector, int64_t* size_max) { +qmckl_exit_code +qmckl_get_jastrow_cord_vector (const qmckl_context context, + double * const cord_vector, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -668,14 +697,19 @@ qmckl_exit_code qmckl_get_jastrow_cord_vector (const qmckl_context context, doub } assert (ctx->jastrow.cord_vector != NULL); - + int64_t dim_cord_vect; qmckl_exit_code rc = qmckl_get_jastrow_dim_cord_vect(context, &dim_cord_vect); if (rc != QMCKL_SUCCESS) return rc; int64_t sze=dim_cord_vect * ctx->jastrow.type_nucl_num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_cord_vector", + "Array too small. Expected dim_cord_vect * jastrow.type_nucl_num"); + } memcpy(cord_vector, ctx->jastrow.cord_vector, sze*sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } @@ -690,9 +724,9 @@ qmckl_exit_code qmckl_get_jastrow_cord_vector (const qmckl_context context, doub qmckl_exit_code qmckl_set_jastrow_ord_num (qmckl_context context, const int64_t aord_num, const int64_t bord_num, const int64_t cord_num); qmckl_exit_code qmckl_set_jastrow_type_nucl_num (qmckl_context context, const int64_t type_nucl_num); qmckl_exit_code qmckl_set_jastrow_type_nucl_vector (qmckl_context context, const int64_t* type_nucl_vector, const int64_t nucl_num); -qmckl_exit_code qmckl_set_jastrow_aord_vector (qmckl_context context, const double * aord_vector, int64_t size_max); -qmckl_exit_code qmckl_set_jastrow_bord_vector (qmckl_context context, const double * bord_vector, int64_t size_max); -qmckl_exit_code qmckl_set_jastrow_cord_vector (qmckl_context context, const double * cord_vector, int64_t size_max); +qmckl_exit_code qmckl_set_jastrow_aord_vector (qmckl_context context, const double * aord_vector, const int64_t size_max); +qmckl_exit_code qmckl_set_jastrow_bord_vector (qmckl_context context, const double * bord_vector, const int64_t size_max); +qmckl_exit_code qmckl_set_jastrow_cord_vector (qmckl_context context, const double * cord_vector, const int64_t size_max); #+end_src #+NAME:pre2 @@ -718,7 +752,12 @@ return QMCKL_SUCCESS; #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_set_jastrow_ord_num(qmckl_context context, const int64_t aord_num, const int64_t bord_num, const int64_t cord_num) { +qmckl_exit_code +qmckl_set_jastrow_ord_num(qmckl_context context, + const int64_t aord_num, + const int64_t bord_num, + const int64_t cord_num) +{ <> if (aord_num <= 0) { @@ -750,7 +789,10 @@ qmckl_exit_code qmckl_set_jastrow_ord_num(qmckl_context context, const int64_t a <> } -qmckl_exit_code qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num) { + +qmckl_exit_code +qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num) +{ <> if (type_nucl_num <= 0) { @@ -766,7 +808,12 @@ qmckl_exit_code qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int <> } -qmckl_exit_code qmckl_set_jastrow_type_nucl_vector(qmckl_context context, int64_t const * type_nucl_vector, const int64_t nucl_num) { + +qmckl_exit_code +qmckl_set_jastrow_type_nucl_vector(qmckl_context context, + int64_t const * type_nucl_vector, + const int64_t nucl_num) +{ <> int32_t mask = 1 << 2; @@ -816,7 +863,12 @@ qmckl_exit_code qmckl_set_jastrow_type_nucl_vector(qmckl_context context, int64_ <> } -qmckl_exit_code qmckl_set_jastrow_aord_vector(qmckl_context context, double const * aord_vector, int64_t size_max) { + +qmckl_exit_code +qmckl_set_jastrow_aord_vector(qmckl_context context, + double const * aord_vector, + const int64_t size_max) +{ <> int32_t mask = 1 << 3; @@ -849,7 +901,7 @@ qmckl_exit_code qmckl_set_jastrow_aord_vector(qmckl_context context, double cons return qmckl_failwith( context, rc, "qmckl_set_ord_vector", NULL); -} + } } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; @@ -878,7 +930,12 @@ qmckl_exit_code qmckl_set_jastrow_aord_vector(qmckl_context context, double cons <> } -qmckl_exit_code qmckl_set_jastrow_bord_vector(qmckl_context context, double const * bord_vector, int64_t size_max) { + +qmckl_exit_code +qmckl_set_jastrow_bord_vector(qmckl_context context, + double const * bord_vector, + const int64_t size_max) +{ <> int32_t mask = 1 << 4; @@ -936,7 +993,12 @@ qmckl_exit_code qmckl_set_jastrow_bord_vector(qmckl_context context, double cons <> } -qmckl_exit_code qmckl_set_jastrow_cord_vector(qmckl_context context, double const * cord_vector, int64_t size_max) { + +qmckl_exit_code +qmckl_set_jastrow_cord_vector(qmckl_context context, + double const * cord_vector, + const int64_t size_max) +{ <> int32_t mask = 1 << 5; @@ -1069,6 +1131,7 @@ double* elec_coord = &(n2_elec_coord[0][0][0]); const double* nucl_charge = n2_charge; int64_t nucl_num = n2_nucl_num; double* nucl_coord = &(n2_nucl_coord[0][0]); +int64_t size_max; /* Provide Electron data */ @@ -1246,11 +1309,17 @@ assert(qmckl_nucleus_provided(context)); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_asymp_jasb(qmckl_context context, double* const asymp_jasb, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_asymp_jasb(qmckl_context context, + double* const asymp_jasb, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_asymp_jasb(qmckl_context context, double* const asymp_jasb, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_asymp_jasb(qmckl_context context, + double* const asymp_jasb, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -1265,8 +1334,13 @@ qmckl_exit_code qmckl_get_jastrow_asymp_jasb(qmckl_context context, double* cons assert (ctx != NULL); size_t sze = 2; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_asymp_jasb", + "Array too small. Expected 2"); + } memcpy(asymp_jasb, ctx->jastrow.asymp_jasb, sze * sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } @@ -1409,7 +1483,7 @@ qmckl_exit_code qmckl_compute_asymp_jasb ( } asym_one = bord_vector[0] * kappa_inv / (1.0 + bord_vector[1] * kappa_inv); - asymp_jasb[0] = asym_one; + asymp_jasb[0] = asym_one; asymp_jasb[1] = 0.5 * asym_one; for (int i = 0 ; i <= 1; ++i) { @@ -1418,7 +1492,7 @@ qmckl_exit_code qmckl_compute_asymp_jasb ( x = x * kappa_inv; asymp_jasb[i] = asymp_jasb[i] + bord_vector[p + 1] * x; } - } + } return QMCKL_SUCCESS; } @@ -1433,7 +1507,7 @@ qmckl_exit_code qmckl_compute_asymp_jasb ( const int64_t bord_num, const double* bord_vector, const double rescale_factor_kappa_ee, - double* const asymp_jasb ); + double* const asymp_jasb ); #+end_src @@ -1457,7 +1531,7 @@ print("asym_one : ", asym_one) print("asymp_jasb[0] : ", asymp_jasb[0]) print("asymp_jasb[1] : ", asymp_jasb[1]) #+end_src - + #+RESULTS: asymp_jasb : asym_one : 0.43340325572525706 : asymp_jasb[0] : 0.5323750557252571 @@ -1500,8 +1574,7 @@ assert(rc == QMCKL_SUCCESS); assert(qmckl_jastrow_provided(context)); double asymp_jasb[2]; -int64_t size_max=0; -rc = qmckl_get_jastrow_asymp_jasb(context, asymp_jasb,&size_max); +rc = qmckl_get_jastrow_asymp_jasb(context, asymp_jasb,2); // calculate asymp_jasb assert(fabs(asymp_jasb[0]-0.5323750557252571) < 1.e-12); @@ -1521,11 +1594,17 @@ f_{ee} = \sum_{i,jelectron.walk_num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_ee", + "Array too small. Expected walk_num"); + } memcpy(factor_ee, ctx->jastrow.factor_ee, sze*sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } @@ -1804,8 +1888,7 @@ print("factor_ee :",factor_ee) assert(qmckl_jastrow_provided(context)); double factor_ee[walk_num]; -size_max=0; -rc = qmckl_get_jastrow_factor_ee(context, factor_ee, &size_max); +rc = qmckl_get_jastrow_factor_ee(context, factor_ee, walk_num); // calculate factor_ee assert(fabs(factor_ee[0]+4.282760865958113) < 1.e-12); @@ -1824,11 +1907,17 @@ assert(fabs(factor_ee[0]+4.282760865958113) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, + double* const factor_ee_deriv_e, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, double* const factor_ee_deriv_e, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, + double* const factor_ee_deriv_e, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -1843,8 +1932,14 @@ qmckl_exit_code qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context, doubl assert (ctx != NULL); int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_ee_deriv_e", + "Array too small. Expected 4*walk_num*elec_num"); + } + memcpy(factor_ee_deriv_e, ctx->jastrow.factor_ee_deriv_e, sze * sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } @@ -2002,7 +2097,7 @@ integer function qmckl_compute_factor_ee_deriv_e_f(context, walk_num, elec_num, dx(1) = ee_distance_rescaled_deriv_e(1, i, j, nw) dx(2) = ee_distance_rescaled_deriv_e(2, i, j, nw) dx(3) = ee_distance_rescaled_deriv_e(3, i, j, nw) - dx(4) = ee_distance_rescaled_deriv_e(4, i, j, nw) + dx(4) = ee_distance_rescaled_deriv_e(4, i, j, nw) if((i .LE. up_num .AND. j .LE. up_num ) .OR. & (i .GT. up_num .AND. j .GT. up_num)) then @@ -2217,8 +2312,7 @@ assert(qmckl_jastrow_provided(context)); // calculate factor_ee_deriv_e double factor_ee_deriv_e[walk_num][4][elec_num]; -size_max=0; -rc = qmckl_get_jastrow_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0]),&size_max); +rc = qmckl_get_jastrow_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0]),walk_num*4*elec_num); // check factor_ee_deriv_e assert(fabs(factor_ee_deriv_e[0][0][0]-0.16364894652107934) < 1.e-12); @@ -2240,11 +2334,17 @@ f_{en} = \sum_{i,jelectron.walk_num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_en", + "Array too small. Expected walk_num"); + } memcpy(factor_en, ctx->jastrow.factor_en, sze*sizeof(double)); - (*size_max)=sze; return QMCKL_SUCCESS; } @@ -2517,8 +2622,7 @@ print("factor_en :",factor_en) assert(qmckl_jastrow_provided(context)); double factor_en[walk_num]; -size_max=0; -rc = qmckl_get_jastrow_factor_en(context, factor_en,&size_max); +rc = qmckl_get_jastrow_factor_en(context, factor_en,walk_num); // calculate factor_en assert(fabs(factor_en[0]+5.865822569188727) < 1.e-12); @@ -2534,11 +2638,17 @@ assert(fabs(factor_en[0]+5.865822569188727) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, double* const factor_en_deriv_e, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, + double* const factor_en_deriv_e, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, double* const factor_en_deriv_e, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, + double* const factor_en_deriv_e, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -2553,8 +2663,13 @@ qmckl_exit_code qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context, doubl assert (ctx != NULL); int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_en_deriv_e", + "Array too small. Expected 4*walk_num*elec_num"); + } memcpy(factor_en_deriv_e, ctx->jastrow.factor_en_deriv_e, sze*sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } @@ -2921,8 +3036,7 @@ assert(qmckl_jastrow_provided(context)); // calculate factor_en_deriv_e double factor_en_deriv_e[walk_num][4][elec_num]; -size_max=0; -rc = qmckl_get_jastrow_factor_en_deriv_e(context, &(factor_en_deriv_e[0][0][0]),&size_max); +rc = qmckl_get_jastrow_factor_en_deriv_e(context, &(factor_en_deriv_e[0][0][0]),walk_num*4*elec_num); // check factor_en_deriv_e assert(fabs(factor_en_deriv_e[0][0][0]-0.11609919541763383) < 1.e-12); @@ -2946,11 +3060,17 @@ assert(fabs(factor_en_deriv_e[0][3][0]+0.9667363412285741 ) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_een_rescaled_e(qmckl_context context, + double* const distance_rescaled, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_een_rescaled_e(qmckl_context context, + double* const distance_rescaled, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -2965,8 +3085,13 @@ qmckl_exit_code qmckl_get_jastrow_een_rescaled_e(qmckl_context context, double* assert (ctx != NULL); size_t sze = ctx->electron.num * ctx->electron.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_een_rescaled_e", + "Array too small. Expected ctx->electron.num * ctx->electron.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1)"); + } memcpy(distance_rescaled, ctx->jastrow.een_rescaled_e, sze * sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } @@ -3178,7 +3303,7 @@ end function qmckl_compute_een_rescaled_e_f #+end_src *** Test - + #+begin_src python :results output :exports none :noweb yes import numpy as np @@ -3242,8 +3367,7 @@ assert(qmckl_electron_provided(context)); double een_rescaled_e[walk_num][(cord_num + 1)][elec_num][elec_num]; -size_max=0; -rc = qmckl_get_jastrow_een_rescaled_e(context, &(een_rescaled_e[0][0][0][0]),&size_max); +rc = qmckl_get_jastrow_een_rescaled_e(context, &(een_rescaled_e[0][0][0][0]),elec_num*elec_num*(cord_num+1)*walk_num); // value of (0,2,1) assert(fabs(een_rescaled_e[0][1][0][2]-0.08084493981483197) < 1.e-12); @@ -3268,11 +3392,17 @@ assert(fabs(een_rescaled_e[0][2][1][5]-0.3424402276009091) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, + double* const distance_rescaled, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, + double* const distance_rescaled, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -3287,8 +3417,13 @@ qmckl_exit_code qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context, assert (ctx != NULL); size_t sze = ctx->electron.num * 4 * ctx->electron.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_een_deriv_e", + "Array too small. Expected ctx->electron.num * 4 * ctx->electron.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1)"); + } memcpy(distance_rescaled, ctx->jastrow.een_rescaled_e_deriv_e, sze * sizeof(double)); - (*size_max) = sze; return QMCKL_SUCCESS; } @@ -3609,8 +3744,9 @@ for l in range(0,cord_num+1): #+begin_src c :tangle (eval c_test) //assert(qmckl_electron_provided(context)); double een_rescaled_e_deriv_e[walk_num][(cord_num + 1)][elec_num][4][elec_num]; -size_max=0; -rc = qmckl_get_jastrow_een_rescaled_e_deriv_e(context, &(een_rescaled_e_deriv_e[0][0][0][0][0]),&size_max); +size_max=walk_num*(cord_num + 1)*elec_num*4*elec_num; +rc = qmckl_get_jastrow_een_rescaled_e_deriv_e(context, + &(een_rescaled_e_deriv_e[0][0][0][0][0]),size_max); // value of (0,0,0,2,1) assert(fabs(een_rescaled_e_deriv_e[0][1][0][0][2] + 0.05991352796887283 ) < 1.e-12); @@ -3635,11 +3771,17 @@ assert(fabs(een_rescaled_e_deriv_e[0][2][1][0][5] + 0.5880599146214673 ) < 1. *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* const distance_rescaled, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_een_rescaled_n(qmckl_context context, + double* const distance_rescaled, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* const distance_rescaled, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_een_rescaled_n(qmckl_context context, + double* const distance_rescaled, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -3654,8 +3796,13 @@ qmckl_exit_code qmckl_get_jastrow_een_rescaled_n(qmckl_context context, double* assert (ctx != NULL); size_t sze = ctx->electron.num * ctx->nucleus.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_een_deriv_e", + "Array too small. Expected ctx->electron.num * ctx->nucleus.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1)"); + } memcpy(distance_rescaled, ctx->jastrow.een_rescaled_n, sze * sizeof(double)); - (*size_max)=sze; return QMCKL_SUCCESS; } @@ -3914,8 +4061,8 @@ print(" een_rescaled_n[1, 5, 2] = ",een_rescaled_n[1, 5, 2]) assert(qmckl_electron_provided(context)); double een_rescaled_n[walk_num][(cord_num + 1)][nucl_num][elec_num]; -size_max=0; -rc = qmckl_get_jastrow_een_rescaled_n(context, &(een_rescaled_n[0][0][0][0]),&size_max); +size_max=walk_num*(cord_num + 1)*nucl_num*elec_num; +rc = qmckl_get_jastrow_een_rescaled_n(context, &(een_rescaled_n[0][0][0][0]),size_max); // value of (0,2,1) assert(fabs(een_rescaled_n[0][1][0][2]-0.10612983920006765) < 1.e-12); @@ -3936,11 +4083,17 @@ assert(fabs(een_rescaled_n[0][2][1][5]-0.01343938025140174) < 1.e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, + double* const distance_rescaled, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, double* const distance_rescaled, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, + double* const distance_rescaled, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -3955,8 +4108,13 @@ qmckl_exit_code qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context, assert (ctx != NULL); size_t sze = ctx->electron.num * 4 * ctx->nucleus.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1); + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_een_deriv_e", + "Array too small. Expected ctx->electron.num * 4 * ctx->nucleus.num * ctx->electron.walk_num * (ctx->jastrow.cord_num + 1)"); + } memcpy(distance_rescaled, ctx->jastrow.een_rescaled_n_deriv_e, sze * sizeof(double)); - (*size_max)=sze; return QMCKL_SUCCESS; } @@ -4215,9 +4373,9 @@ end function qmckl_compute_factor_een_rescaled_n_deriv_e_f end function qmckl_compute_factor_een_rescaled_n_deriv_e #+end_src - + *** Test - + #+begin_src python :results output :exports none :noweb yes import numpy as np @@ -4287,8 +4445,8 @@ print(" een_rescaled_n_deriv_e[2, 1, 6, 2] = ",een_rescaled_n_deriv_e[5, 0, 1, 2 assert(qmckl_electron_provided(context)); double een_rescaled_n_deriv_e[walk_num][(cord_num + 1)][nucl_num][4][elec_num]; -size_max=0; -rc = qmckl_get_jastrow_een_rescaled_n_deriv_e(context, &(een_rescaled_n_deriv_e[0][0][0][0][0]),&size_max); +size_max=walk_num*(cord_num + 1)*nucl_num*4*elec_num; +rc = qmckl_get_jastrow_een_rescaled_n_deriv_e(context, &(een_rescaled_n_deriv_e[0][0][0][0][0]),size_max); // value of (0,2,1) assert(fabs(een_rescaled_n_deriv_e[0][1][0][0][2]+0.07633444246999128 ) < 1.e-12); @@ -5330,11 +5488,17 @@ assert(fabs(dtmp_c[0][1][0][0][0][0] - 0.237440520852232) < 1e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* const factor_een, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_factor_een(qmckl_context context, + double* const factor_een, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* const factor_een, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_factor_een(qmckl_context context, + double* const factor_een, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -5348,9 +5512,14 @@ qmckl_exit_code qmckl_get_jastrow_factor_een(qmckl_context context, double* cons qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - int64_t sze = ctx->electron.walk_num * ctx->electron.num; + int64_t sze = ctx->electron.walk_num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_een", + "Array too small. Expected walk_num"); + } memcpy(factor_een, ctx->jastrow.factor_een, sze*sizeof(double)); - (*size_max)=sze; return QMCKL_SUCCESS; } @@ -5804,8 +5973,7 @@ print("factor_een:",factor_een) assert(qmckl_jastrow_provided(context)); double factor_een[walk_num]; -size_max=0; -rc = qmckl_get_jastrow_factor_een(context, &(factor_een[0]),&size_max); +rc = qmckl_get_jastrow_factor_een(context, &(factor_een[0]),walk_num); assert(fabs(factor_een[0] + 0.37407972141304213) < 1e-12); #+end_src @@ -5819,11 +5987,17 @@ assert(fabs(factor_een[0] + 0.37407972141304213) < 1e-12); *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, double* const factor_een_deriv_e, int64_t* size_max); +qmckl_exit_code +qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, + double* const factor_een_deriv_e, + const int64_t size_max); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, double* const factor_een_deriv_e, int64_t* size_max) +qmckl_exit_code +qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, + double* const factor_een_deriv_e, + const int64_t size_max) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -5837,9 +6011,14 @@ qmckl_exit_code qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context, doub qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - int64_t sze = ctx->electron.walk_num * ctx->electron.num; + int64_t sze = ctx->electron.walk_num * 4 * ctx->electron.num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_factor_een_deriv_e", + "Array too small. Expected 4*walk_num*elec_num"); + } memcpy(factor_een_deriv_e, ctx->jastrow.factor_een_deriv_e, sze*sizeof(double)); - (*size_max)=sze; return QMCKL_SUCCESS; } @@ -6327,7 +6506,7 @@ end function qmckl_compute_factor_een_deriv_e_f end function qmckl_compute_factor_een_deriv_e #+end_src - + *** Test #+begin_src python :results output :exports none :noweb yes import numpy as np @@ -6384,11 +6563,10 @@ print("factor_een:",factor_een) /* Check if Jastrow is properly initialized */ assert(qmckl_jastrow_provided(context)); -double factor_een_deriv_e[walk_num][elec_num]; -size_max=0; -rc = qmckl_get_jastrow_factor_een_deriv_e(context, &(factor_een_deriv_e[0][0]),&size_max); +double factor_een_deriv_e[4][walk_num][elec_num]; +rc = qmckl_get_jastrow_factor_een_deriv_e(context, &(factor_een_deriv_e[0][0][0]),4*walk_num*elec_num); -assert(fabs(factor_een_deriv_e[0][0] + 0.0005481671107226865) < 1e-12); +assert(fabs(factor_een_deriv_e[0][0][0] + 0.0005481671107226865) < 1e-12); #+end_src * End of files :noexport: From c8a452dc55c31a6e06ef39a43fb220dc07f2b1df Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 15 Feb 2022 11:10:07 +0100 Subject: [PATCH 29/29] Added --with-icc and --with-ifort to configure --- configure.ac | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 6654fd7..6ec4830 100644 --- a/configure.ac +++ b/configure.ac @@ -46,6 +46,22 @@ AS_IF([test -d ${srcdir}/.git], [enable_maintainer_mode="no"] ) +AC_ARG_WITH(ifort, [AS_HELP_STRING([--with-ifort],[Use Intel Fortran compiler])], with_ifort=$withval, with_ifort=no) +AS_IF([test "$with_ifort" == "yes"], [ + FC=ifort + FCFLAGS="-xHost -ip -O2 -ftz -finline -g -mkl=sequential" ]) + +AC_ARG_WITH(icc, [AS_HELP_STRING([--with-icc],[Use Intel C compiler])], with_icc=$withval, with_icc=no) +AS_IF([test "$with_icc" == "yes"], [ + FC=icc + CFLAGS="-xHost -ip -O2 -ftz -finline -g -mkl=sequential" ]) + +AS_IF([test "$with_icc"."$with_ifort" == "yes.yes"], [ + ax_blas_ok="yes" + ax_lapack_ok="yes" + BLAS_LIBS="" + LAPACK_LIBS=""]) + AM_PROG_AR AM_MAINTAINER_MODE() LT_INIT @@ -177,6 +193,7 @@ AX_BLAS([], [AC_MSG_ERROR([BLAS was not found.])]) ## LAPACK AX_LAPACK([], [AC_MSG_ERROR([LAPACK was not found.])]) +AS_IF([test "$BLAS_LIBS" == "$LAPACK_LIBS"], [BLAS_LIBS=""]) # Specific options required with some compilers @@ -314,7 +331,7 @@ fi #mkl-dynamic-lp64-seq PKG_LIBS="$PKG_LIBS $LIBS" -LIBS="$BLAS_LIBS $LAPACK_LIBS $BLAS_LIBS $PKG_LIBS" +LIBS="$BLAS_LIBS $LAPACK_LIBS $PKG_LIBS" CFLAGS="$CFLAGS $PKG_CFLAGS" AC_SUBST([PKG_LIBS]) AC_SUBST([PKG_CFLAGS])