From 90a560138d7a8672b9d0761ebf32770ed22c70c6 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 4 Oct 2021 09:54:34 +0200 Subject: [PATCH 01/68] Initial commit. #41 --- org/qmckl_slater_determinant.org | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 org/qmckl_slater_determinant.org diff --git a/org/qmckl_slater_determinant.org b/org/qmckl_slater_determinant.org new file mode 100644 index 0000000..293f088 --- /dev/null +++ b/org/qmckl_slater_determinant.org @@ -0,0 +1,6 @@ +#+TITLE: Slater Determinant +#+SETUPFILE: ../tools/theme.setup +#+INCLUDE: ../tools/lib.org + + + From e425b24303923ff640e654c059a5c5e24e75bf2d Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 4 Oct 2021 15:42:22 +0200 Subject: [PATCH 02/68] Added context. #41 --- org/qmckl_mo.org | 7 +-- org/qmckl_slater_determinant.org | 101 +++++++++++++++++++++++++++++++ 2 files changed, 102 insertions(+), 6 deletions(-) diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index a884ed6..f521b4d 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -80,12 +80,7 @@ int main() { |---------------------+--------------------+--------------------------------------------------------------| | ~type~ | | Gaussian (~'G'~) or Slater (~'S'~) | - | ~nucleus_index~ | ~[nucl_num]~ | Index of the first shell of each nucleus | - | ~nucleus_shell_num~ | ~[nucl_num]~ | Number of shells per nucleus | - | ~ao_num~ | | Number of AOs | - | ~ao_cartesian~ | | If true, use polynomials. Otherwise, use spherical harmonics | - | ~ao_factor~ | ~[ao_num]~ | Normalization factor of the AO | - | ~ao_shell~ | ~[ao_num]~ | For each AO, specify to which shell it belongs | + | ~mo_num~ | | Number of MOs | | ~coefficient~ | ~[mo_num, ao_num]~ | Orbital coefficients | Computed data: diff --git a/org/qmckl_slater_determinant.org b/org/qmckl_slater_determinant.org index 293f088..30aa7d7 100644 --- a/org/qmckl_slater_determinant.org +++ b/org/qmckl_slater_determinant.org @@ -2,5 +2,106 @@ #+SETUPFILE: ../tools/theme.setup #+INCLUDE: ../tools/lib.org +The slater deteminant is required for the calculation of the +wavefunction, gradient, and derivatives. These quantities will be used +to calculate the local Energy (\[E_L\]). + +ψ(x) = det|ϕ₁(x₁)...ϕᵢ(yᵢ)...ϕₙ(xₙ)| + +Concerning the gradient and laplacian, in fact what is actually +calculated is the ratio of the gradient/laplacian and the determinant +of the slater matrix: + +∇ψ(x)/ψ(x) + +and + +∇²ψ(x)/ψ(x) + +This avoids the unnecessary multiplication and division of by the +determinant ψ(x). +* Headers :noexport: + #+begin_src elisp :noexport :results none +(org-babel-lob-ingest "../tools/lib.org") + #+end_src + + + #+begin_src c :tangle (eval h_private_type) +#ifndef QMCKL_MO_HPT +#define QMCKL_MO_HPT + +#include + #+end_src + + #+begin_src c :tangle (eval c_test) :noweb yes +#include "qmckl.h" +#include "assert.h" +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include +#include +#include "chbrclf.h" +#include "qmckl_ao_private_func.h" +#include "qmckl_mo_private_func.h" +#include "qmckl_slater_determinant_private_func.h" + +int main() { + qmckl_context context; + context = qmckl_context_create(); + + qmckl_exit_code rc; + #+end_src + + #+begin_src c :tangle (eval c) +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#ifdef HAVE_STDINT_H +#include +#elif HAVE_INTTYPES_H +#include +#endif + +#include +#include +#include +#include + +#include "qmckl.h" +#include "qmckl_context_private_type.h" +#include "qmckl_memory_private_type.h" +#include "qmckl_memory_private_func.h" +#include "qmckl_ao_private_type.h" +#include "qmckl_ao_private_func.h" +#include "qmckl_mo_private_type.h" +#include "qmckl_mo_private_func.h" +#include "qmckl_slater_determinant_private_type.h" +#include "qmckl_slater_determinant_private_func.h" + #+end_src + +* Context + + The following arrays are stored in the context: + + |-----------------+-------------------------------+------------------------------------| + | ~type~ | ~char~ | α (~'A'~) or β (~'B'~) determinant | + | ~walk_num~ | ~uint64_t~ | Number of walkers | + | ~det_num~ | ~uint64_t~ | Number of determinants per walker | + | ~fermi_num~ | ~uint64_t~ | Number of number of fermions | + | ~mo_index_list~ | ~mo_index[walk_num][det_num]~ | Index of MOs for each walker | + + Computed data: + + |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| + | ~det_matrix_list~ | ~[walk_num][det_num][mo_num][fermi_num]~ | The slater matrix for each determinant of each walker. | + |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| + | ~det_vgl~ | ~[5][walk_num][det_num]~ | Value, gradients, Laplacian of the MOs at electron positions | + | ~det_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| + + From 5e399a423ea628a1bcba9436fd293e6d66db53e0 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 4 Oct 2021 16:52:13 +0200 Subject: [PATCH 03/68] Added det struct to context. #41 --- org/qmckl_context.org | 14 +- org/qmckl_slater_determinant.org | 422 ++++++++++++++++++++++++++++++- 2 files changed, 422 insertions(+), 14 deletions(-) diff --git a/org/qmckl_context.org b/org/qmckl_context.org index bd1a0ce..013b34a 100644 --- a/org/qmckl_context.org +++ b/org/qmckl_context.org @@ -37,6 +37,7 @@ int main() { #include "qmckl_electron_private_func.h" #include "qmckl_ao_private_func.h" #include "qmckl_mo_private_func.h" +#include "qmckl_determinant_private_func.h" #+end_src #+begin_src c :tangle (eval c) @@ -118,15 +119,14 @@ typedef struct qmckl_context_struct { uint64_t date; /* -- Molecular system -- */ - qmckl_nucleus_struct nucleus; - qmckl_electron_struct electron; - qmckl_ao_basis_struct ao_basis; - qmckl_mo_basis_struct mo_basis; - qmckl_jastrow_struct jastrow; + qmckl_nucleus_struct nucleus; + qmckl_electron_struct electron; + qmckl_ao_basis_struct ao_basis; + qmckl_mo_basis_struct mo_basis; + qmckl_jastrow_struct jastrow; + qmckl_determinant_struct det; /* To be implemented: - qmckl_mo_struct mo; - qmckl_determinant_struct det; ,*/ } qmckl_context_struct; diff --git a/org/qmckl_slater_determinant.org b/org/qmckl_slater_determinant.org index 30aa7d7..9cf12c1 100644 --- a/org/qmckl_slater_determinant.org +++ b/org/qmckl_slater_determinant.org @@ -47,7 +47,7 @@ determinant ψ(x). #include "chbrclf.h" #include "qmckl_ao_private_func.h" #include "qmckl_mo_private_func.h" -#include "qmckl_slater_determinant_private_func.h" +#include "qmckl_determinant_private_func.h" int main() { qmckl_context context; @@ -80,8 +80,8 @@ int main() { #include "qmckl_ao_private_func.h" #include "qmckl_mo_private_type.h" #include "qmckl_mo_private_func.h" -#include "qmckl_slater_determinant_private_type.h" -#include "qmckl_slater_determinant_private_func.h" +#include "qmckl_determinant_private_type.h" +#include "qmckl_determinant_private_func.h" #+end_src * Context @@ -90,9 +90,9 @@ int main() { |-----------------+-------------------------------+------------------------------------| | ~type~ | ~char~ | α (~'A'~) or β (~'B'~) determinant | - | ~walk_num~ | ~uint64_t~ | Number of walkers | - | ~det_num~ | ~uint64_t~ | Number of determinants per walker | - | ~fermi_num~ | ~uint64_t~ | Number of number of fermions | + | ~walk_num~ | ~int64_t~ | Number of walkers | + | ~det_num~ | ~int64_t~ | Number of determinants per walker | + | ~fermi_num~ | ~int64_t~ | Number of number of fermions | | ~mo_index_list~ | ~mo_index[walk_num][det_num]~ | Index of MOs for each walker | Computed data: @@ -101,7 +101,415 @@ int main() { | ~det_matrix_list~ | ~[walk_num][det_num][mo_num][fermi_num]~ | The slater matrix for each determinant of each walker. | |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| | ~det_vgl~ | ~[5][walk_num][det_num]~ | Value, gradients, Laplacian of the MOs at electron positions | - | ~det_vgl_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| +** Data structure + + #+begin_src c :comments org :tangle (eval h_private_type) +typedef struct qmckl_determinant_struct { + char type; + int64_t walk_num; + int64_t det_num; + int64_t fermi_num; + int64_t* mo_index_list; + + double * det_matrix_list; + double * det_vgl; + int64_t det_vgl_date; + + int32_t uninitialized; + bool provided; +} qmckl_determinant_struct; + #+end_src + + The ~uninitialized~ integer contains one bit set to one for each + initialization function which has not been called. It becomes equal + to zero after all initialization functions have been called. The + struct is then initialized and ~provided == true~. + Some values are initialized by default, and are not concerned by + this mechanism. + +** Access functions + + #+begin_src c :comments org :tangle (eval h_private_func) :exports none +char qmckl_get_determinant_type (const qmckl_context context); +int64_t qmckl_get_determinant_walk_num (const qmckl_context context); +int64_t qmckl_get_determinant_det_num (const qmckl_context context); +int64_t qmckl_get_determinant_fermi_num (const qmckl_context context); +int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context); + #+end_src + + When all the data for the slater determinants have been provided, the following + function returns ~true~. + + #+begin_src c :comments org :tangle (eval h_func) +bool qmckl_mo_basis_provided (const qmckl_context context); + #+end_src + + #+NAME:post + #+begin_src c :exports none +if ( (ctx->mo_basis.uninitialized & mask) != 0) { + return NULL; +} + #+end_src + + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +char qmckl_get_determinant_type (const qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1; + + if ( (ctx->determinant.uninitialized & mask) != 0) { + return (char) 0; + } + + assert (ctx->determinant.type != (char) 0); + return ctx->determinant.type; +} + +int64_t qmckl_get_determinant_walk_num (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 1; + + if ( (ctx->determinant.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->determinant.walk_num > (int64_t) 0); + return ctx->determinant.walk_num; +} + +int64_t qmckl_get_determinant_det_num (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 2; + + if ( (ctx->determinant.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->determinant.det_num > (int64_t) 0); + return ctx->determinant.det_num; +} + +int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 3; + + if ( (ctx->determinant.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->determinant.fermi_num > (int64_t) 0); + return ctx->determinant.fermi_num; +} + +int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 4; + + if ( (ctx->determinant.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->determinant.mo_index_list != NULL); + return ctx->determinant.mo_index_list; +} + + #+end_src +** Initialization functions + + To set the basis set, all the following functions need to be + called. + + #+begin_src c :comments org :tangle (eval h_func) +qmckl_exit_code qmckl_set_determinant_type (const qmckl_context context, const char *t); +qmckl_exit_code qmckl_set_determinant_walk_num (const qmckl_context context, const int64_t walk_num); +qmckl_exit_code qmckl_set_determinant_det_num (const qmckl_context context, const int64_t det_num); +qmckl_exit_code qmckl_set_determinant_fermi_num (const qmckl_context context, const int64_t fermi_num); +qmckl_exit_code qmckl_set_determinant_mo_index_list (const qmckl_context context, const int64_t* mo_index_list); + #+end_src + + #+NAME:pre2 + #+begin_src c :exports none +if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + +qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + #+end_src + + #+NAME:post2 + #+begin_src c :exports none +ctx->det.uninitialized &= ~mask; +ctx->det.provided = (ctx->det.uninitialized == 0); +if (ctx->det.provided) { + qmckl_exit_code rc_ = qmckl_finalize_determinant(context); + if (rc_ != QMCKL_SUCCESS) return rc_; + } + +return QMCKL_SUCCESS; + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_set_determinant_type(qmckl_context context, const char t) { + <> + + if (t != 'G' && t != 'S') { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_determinant_type", + NULL); + } + + int32_t mask = 1; + ctx->determinant.type = t; + + <> +} + +qmckl_exit_code qmckl_set_determinant_walk_num(qmckl_context context, const int64_t walk_num) { + <> + + if (walk_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_determinant_walk_num", + "walk_num <= 0"); + } + + int32_t mask = 1 << 1; + ctx->determinant.walk_num = walk_num; + + <> +} + +qmckl_exit_code qmckl_set_determinant_det_num(qmckl_context context, const int64_t det_num) { + <> + + if (det_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_determinant_det_num", + "det_num <= 0"); + } + + int32_t mask = 1 << 2; + ctx->determinant.det_num = det_num; + + <> +} + +qmckl_exit_code qmckl_set_determinant_fermi_num(qmckl_context context, const int64_t fermi_num) { + <> + + if (fermi_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_slater_fermierminant_det_num", + "fermi_num <= 0"); + } + + int32_t mask = 1 << 3; + ctx->determinant.fermi_num = fermi_num; + + <> +} + +qmckl_exit_code qmckl_set_determinant_mo_index_list(qmckl_context context, const int64_t* mo_index_list) { + <> + + int32_t mask = 1 << 4; + + if (ctx->determinant.mo_index_list != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->determinant.mo_index_list); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_determinant_mo_index_list", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->determinant.walk_num * ctx->determinant.det_num * sizeof(int64_t); + int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info); + if (new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_determinant_mo_index_list", + NULL); + } + + memcpy(new_array, mo_index_list, mem_info.size); + + ctx->determinant.mo_index_list = new_array; + + <> +} + + #+end_src + + When the basis set is completely entered, other data structures are + computed to accelerate the calculations. + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_finalize_basis(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) { +} + #+end_src + +** Fortran Interfaces + +** Test +* Computation + :PROPERTIES: + :Name: qmckl_compute_determinant_det_vgl + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + +*** Get + #+NAME: qmckl_get_determinant_det_vgl_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~double~ | ~det_vgl[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs | + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double* const det_vgl); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double * const det_vgl) + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = 5 * ctx->det.det_num * ctx->det.walk_num; + memcpy(det_vgl, ctx->det.det_vgl, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + #+end_src + + #+CALL: generate_c_header(table=qmckl_get_determinant_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_get_determinant_det_vgl")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_get_determinant_det_vgl ( + const qmckl_context context, + double* const det_vgl ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_get_determinant_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_get_determinant_det_vgl")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_get_determinant_det_vgl & + (context, det_vgl) & + bind(C) result(info) + + use, intrinsic :: iso_c_binding + implicit none + + integer (c_int64_t) , intent(in) , value :: context + real (c_double ) , intent(out) :: det_vgl(det_num,walk_num,5) + + integer(c_int32_t), external :: qmckl_compute_get_determinant_det_vgl_f + info = qmckl_compute_get_determinant_det_vgl_f & + (context, det_vgl) + + end function qmckl_compute_get_determinant_det_vgl + #+end_src +*** Provide +*** Compute +*** Test + +* End of files :noexport: + + #+begin_src c :tangle (eval h_private_type) +#endif + #+end_src + +*** Test + #+begin_src c :tangle (eval c_test) + rc = qmckl_context_destroy(context); + assert (rc == QMCKL_SUCCESS); + + return 0; +} + #+end_src + +*** Compute file names + #+begin_src emacs-lisp +; The following is required to compute the file names + +(setq pwd (file-name-directory buffer-file-name)) +(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) +(setq f (concat pwd name "_f.f90")) +(setq fh (concat pwd name "_fh.f90")) +(setq c (concat pwd name ".c")) +(setq h (concat name ".h")) +(setq h_private (concat name "_private.h")) +(setq c_test (concat pwd "test_" name ".c")) +(setq f_test (concat pwd "test_" name "_f.f90")) + +; Minted +(require 'ox-latex) +(setq org-latex-listings 'minted) +(add-to-list 'org-latex-packages-alist '("" "listings")) +(add-to-list 'org-latex-packages-alist '("" "color")) + + #+end_src + + +# -*- mode: org -*- +# vim: syntax=c From 77a6155bb0d1a1c77c84ec46e1536456bbbf8a11 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 4 Oct 2021 16:53:15 +0200 Subject: [PATCH 04/68] Renamed file. #41 --- org/{qmckl_slater_determinant.org => qmckl_determinant.org} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename org/{qmckl_slater_determinant.org => qmckl_determinant.org} (100%) diff --git a/org/qmckl_slater_determinant.org b/org/qmckl_determinant.org similarity index 100% rename from org/qmckl_slater_determinant.org rename to org/qmckl_determinant.org From 59d4c91edf450deec7de5e6fabe969414da19682 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 4 Oct 2021 17:03:12 +0200 Subject: [PATCH 05/68] Updated name change to header files. #41 --- org/qmckl_context.org | 1 + org/qmckl_determinant.org | 86 +++++++++++++++------------------------ 2 files changed, 34 insertions(+), 53 deletions(-) diff --git a/org/qmckl_context.org b/org/qmckl_context.org index 013b34a..01e18f6 100644 --- a/org/qmckl_context.org +++ b/org/qmckl_context.org @@ -33,6 +33,7 @@ int main() { #include "qmckl_ao_private_type.h" #include "qmckl_mo_private_type.h" #include "qmckl_jastrow_private_type.h" +#include "qmckl_determinant_private_type.h" #include "qmckl_nucleus_private_func.h" #include "qmckl_electron_private_func.h" #include "qmckl_ao_private_func.h" diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 9cf12c1..2244b55 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -29,8 +29,8 @@ determinant ψ(x). #+begin_src c :tangle (eval h_private_type) -#ifndef QMCKL_MO_HPT -#define QMCKL_MO_HPT +#ifndef QMCKL_DETERMINANT_HPT +#define QMCKL_DETERMINANT_HPT #include #+end_src @@ -90,9 +90,9 @@ int main() { |-----------------+-------------------------------+------------------------------------| | ~type~ | ~char~ | α (~'A'~) or β (~'B'~) determinant | - | ~walk_num~ | ~int64_t~ | Number of walkers | - | ~det_num~ | ~int64_t~ | Number of determinants per walker | - | ~fermi_num~ | ~int64_t~ | Number of number of fermions | + | ~walk_num~ | ~int64_t~ | Number of walkers | + | ~det_num~ | ~int64_t~ | Number of determinants per walker | + | ~fermi_num~ | ~int64_t~ | Number of number of fermions | | ~mo_index_list~ | ~mo_index[walk_num][det_num]~ | Index of MOs for each walker | Computed data: @@ -101,7 +101,7 @@ int main() { | ~det_matrix_list~ | ~[walk_num][det_num][mo_num][fermi_num]~ | The slater matrix for each determinant of each walker. | |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| | ~det_vgl~ | ~[5][walk_num][det_num]~ | Value, gradients, Laplacian of the MOs at electron positions | - | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| ** Data structure @@ -144,12 +144,12 @@ int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context function returns ~true~. #+begin_src c :comments org :tangle (eval h_func) -bool qmckl_mo_basis_provided (const qmckl_context context); +bool qmckl_determinant_provided (const qmckl_context context); #+end_src #+NAME:post #+begin_src c :exports none -if ( (ctx->mo_basis.uninitialized & mask) != 0) { +if ( (ctx->det.uninitialized & mask) != 0) { return NULL; } #+end_src @@ -167,12 +167,12 @@ char qmckl_get_determinant_type (const qmckl_context context) { int32_t mask = 1; - if ( (ctx->determinant.uninitialized & mask) != 0) { + if ( (ctx->det.uninitialized & mask) != 0) { return (char) 0; } - assert (ctx->determinant.type != (char) 0); - return ctx->determinant.type; + assert (ctx->det.type != (char) 0); + return ctx->det.type; } int64_t qmckl_get_determinant_walk_num (const qmckl_context context) { @@ -185,12 +185,12 @@ int64_t qmckl_get_determinant_walk_num (const qmckl_context context) { int32_t mask = 1 << 1; - if ( (ctx->determinant.uninitialized & mask) != 0) { + if ( (ctx->det.uninitialized & mask) != 0) { return (int64_t) 0; } - assert (ctx->determinant.walk_num > (int64_t) 0); - return ctx->determinant.walk_num; + assert (ctx->det.walk_num > (int64_t) 0); + return ctx->det.walk_num; } int64_t qmckl_get_determinant_det_num (const qmckl_context context) { @@ -203,12 +203,12 @@ int64_t qmckl_get_determinant_det_num (const qmckl_context context) { int32_t mask = 1 << 2; - if ( (ctx->determinant.uninitialized & mask) != 0) { + if ( (ctx->det.uninitialized & mask) != 0) { return (int64_t) 0; } - assert (ctx->determinant.det_num > (int64_t) 0); - return ctx->determinant.det_num; + assert (ctx->det.det_num > (int64_t) 0); + return ctx->det.det_num; } int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { @@ -221,12 +221,12 @@ int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { int32_t mask = 1 << 3; - if ( (ctx->determinant.uninitialized & mask) != 0) { + if ( (ctx->det.uninitialized & mask) != 0) { return (int64_t) 0; } - assert (ctx->determinant.fermi_num > (int64_t) 0); - return ctx->determinant.fermi_num; + assert (ctx->det.fermi_num > (int64_t) 0); + return ctx->det.fermi_num; } int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { @@ -239,12 +239,12 @@ int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { int32_t mask = 1 << 4; - if ( (ctx->determinant.uninitialized & mask) != 0) { + if ( (ctx->det.uninitialized & mask) != 0) { return (int64_t) 0; } - assert (ctx->determinant.mo_index_list != NULL); - return ctx->determinant.mo_index_list; + assert (ctx->det.mo_index_list != NULL); + return ctx->det.mo_index_list; } #+end_src @@ -295,7 +295,7 @@ qmckl_exit_code qmckl_set_determinant_type(qmckl_context context, const char t) } int32_t mask = 1; - ctx->determinant.type = t; + ctx->det.type = t; <> } @@ -311,7 +311,7 @@ qmckl_exit_code qmckl_set_determinant_walk_num(qmckl_context context, const int6 } int32_t mask = 1 << 1; - ctx->determinant.walk_num = walk_num; + ctx->det.walk_num = walk_num; <> } @@ -327,7 +327,7 @@ qmckl_exit_code qmckl_set_determinant_det_num(qmckl_context context, const int64 } int32_t mask = 1 << 2; - ctx->determinant.det_num = det_num; + ctx->det.det_num = det_num; <> } @@ -343,7 +343,7 @@ qmckl_exit_code qmckl_set_determinant_fermi_num(qmckl_context context, const int } int32_t mask = 1 << 3; - ctx->determinant.fermi_num = fermi_num; + ctx->det.fermi_num = fermi_num; <> } @@ -353,8 +353,8 @@ qmckl_exit_code qmckl_set_determinant_mo_index_list(qmckl_context context, cons int32_t mask = 1 << 4; - if (ctx->determinant.mo_index_list != NULL) { - qmckl_exit_code rc = qmckl_free(context, ctx->determinant.mo_index_list); + if (ctx->det.mo_index_list != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_list); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, rc, "qmckl_set_determinant_mo_index_list", @@ -363,7 +363,7 @@ qmckl_exit_code qmckl_set_determinant_mo_index_list(qmckl_context context, cons } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->determinant.walk_num * ctx->determinant.det_num * sizeof(int64_t); + mem_info.size = ctx->det.walk_num * ctx->det.det_num * sizeof(int64_t); int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info); if (new_array == NULL) { return qmckl_failwith( context, @@ -374,7 +374,7 @@ qmckl_exit_code qmckl_set_determinant_mo_index_list(qmckl_context context, cons memcpy(new_array, mo_index_list, mem_info.size); - ctx->determinant.mo_index_list = new_array; + ctx->det.mo_index_list = new_array; <> } @@ -405,7 +405,7 @@ qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) { *** Get #+NAME: qmckl_get_determinant_det_vgl_args - | ~qmckl_context~ | ~context~ | in | Global state | + | ~qmckl_context~ | ~context~ | in | Global state | | ~double~ | ~det_vgl[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs | #+begin_src c :comments org :tangle (eval h_func) :noweb yes @@ -413,7 +413,7 @@ qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double* con #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double * const det_vgl) +qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double * const det_vgl) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -449,26 +449,6 @@ qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double * co double* const det_vgl ); #+end_src - #+CALL: generate_c_interface(table=qmckl_get_determinant_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_get_determinant_det_vgl")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_get_determinant_det_vgl & - (context, det_vgl) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - real (c_double ) , intent(out) :: det_vgl(det_num,walk_num,5) - - integer(c_int32_t), external :: qmckl_compute_get_determinant_det_vgl_f - info = qmckl_compute_get_determinant_det_vgl_f & - (context, det_vgl) - - end function qmckl_compute_get_determinant_det_vgl - #+end_src *** Provide *** Compute *** Test From bb21cbed69b10419c2675ab4b13ff40792a984e1 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 4 Oct 2021 22:45:44 +0200 Subject: [PATCH 06/68] Working on matrix inv. #41 --- org/qmckl_blas.org | 413 +++++++++++++++++++++++++++++++ org/qmckl_determinant.org | 509 ++++++++++++++++++++++++++++++++++++-- 2 files changed, 905 insertions(+), 17 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index 9cc1df1..b7e8d2f 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -308,6 +308,419 @@ qmckl_exit_code test_qmckl_dgemm(qmckl_context context); assert(QMCKL_SUCCESS == test_qmckl_dgemm(context)); #+end_src +** ~qmckl_invert~ + + Matrix invert. Given a matrix M, returns a matrix M⁻¹ such that: + + + \[ +M · M^{-1} = I +\] + + This is a native Fortran implementation hand written (by: A. Scemama) + only for small matrices. + + TODO: Add description about the external library dependence. + + #+NAME: qmckl_invert_args + | qmckl_context | context | in | Global state | + | int64_t | m | in | Number of rows of the input matrix | + | int64_t | n | in | Number of columns of the input matrix | + | int64_t | lda | in | Leading dimension of array ~A~ | + | double | A[][lda] | inout | Array containing the $m \times n$ matrix $A$ | + | double | det_l | inout | determinant of A | + +*** Requirements + + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~m > 0~ + - ~n > 0~ + - ~lda >= m~ + - ~A~ is allocated with at least $m \times n \times 8$ bytes + +*** C header + + #+CALL: generate_c_header(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_invert ( + const qmckl_context context, + const int64_t m, + const int64_t n, + const int64_t lda, + double* A, + double det_l ); + #+end_src + +*** Source + #+begin_src f90 :tangle (eval f) +integer function qmckl_invert_f(context, ma, na, LDA, A, det_l) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + double precision, intent(inout) :: A (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: ma + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + + integer :: i,j + select case (na) + case default +!DIR$ forceinline + print *," TODO: Implement general invert" + stop 0 + case (5) +!DIR$ forceinline + call invert5(a,LDA,na,det_l) + case (4) +!DIR$ forceinline + call invert4(a,LDA,na,det_l) + case (3) +!DIR$ forceinline + call invert3(a,LDA,na,det_l) + case (2) +!DIR$ forceinline + call invert2(a,LDA,na,det_l) + case (1) +!DIR$ forceinline + call invert1(a,LDA,na,det_l) + case (0) + det_l=1.d0 + end select +end function qmckl_invert_f + +subroutine invert1(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer, intent(in) :: LDA + integer, intent(in) :: na + double precision, intent(inout) :: det_l + + det_l = a(1,1) + a(1,1) = 1.d0 +end + +subroutine invert2(a,LDA,na,det_l) + implicit none + double precision :: a (LDA,na) + integer*8 :: LDA + integer*8 :: na + double precision :: det_l + double precision :: b(2,2) + + b(1,1) = a(1,1) + b(2,1) = a(2,1) + b(1,2) = a(1,2) + b(2,2) = a(2,2) + det_l = a(1,1)*a(2,2) - a(1,2)*a(2,1) + a(1,1) = b(2,2) + a(2,1) = -b(2,1) + a(1,2) = -b(1,2) + a(2,2) = b(1,1) +end + +subroutine invert3(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + double precision :: b(4,3) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: b + integer :: i + det_l = a(1,1)*(a(2,2)*a(3,3)-a(2,3)*a(3,2)) & + -a(1,2)*(a(2,1)*a(3,3)-a(2,3)*a(3,1)) & + +a(1,3)*(a(2,1)*a(3,2)-a(2,2)*a(3,1)) + do i=1,4 + b(i,1) = a(i,1) + b(i,2) = a(i,2) + b(i,3) = a(i,3) + enddo + a(1,1) = b(2,2)*b(3,3) - b(2,3)*b(3,2) + a(2,1) = b(2,3)*b(3,1) - b(2,1)*b(3,3) + a(3,1) = b(2,1)*b(3,2) - b(2,2)*b(3,1) + + a(1,2) = b(1,3)*b(3,2) - b(1,2)*b(3,3) + a(2,2) = b(1,1)*b(3,3) - b(1,3)*b(3,1) + a(3,2) = b(1,2)*b(3,1) - b(1,1)*b(3,2) + + a(1,3) = b(1,2)*b(2,3) - b(1,3)*b(2,2) + a(2,3) = b(1,3)*b(2,1) - b(1,1)*b(2,3) + a(3,3) = b(1,1)*b(2,2) - b(1,2)*b(2,1) + +end + +subroutine invert4(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + double precision :: b(4,4) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: b + integer :: i,j + det_l = a(1,1)*(a(2,2)*(a(3,3)*a(4,4)-a(3,4)*a(4,3)) & + -a(2,3)*(a(3,2)*a(4,4)-a(3,4)*a(4,2)) & + +a(2,4)*(a(3,2)*a(4,3)-a(3,3)*a(4,2))) & + -a(1,2)*(a(2,1)*(a(3,3)*a(4,4)-a(3,4)*a(4,3)) & + -a(2,3)*(a(3,1)*a(4,4)-a(3,4)*a(4,1)) & + +a(2,4)*(a(3,1)*a(4,3)-a(3,3)*a(4,1))) & + +a(1,3)*(a(2,1)*(a(3,2)*a(4,4)-a(3,4)*a(4,2)) & + -a(2,2)*(a(3,1)*a(4,4)-a(3,4)*a(4,1)) & + +a(2,4)*(a(3,1)*a(4,2)-a(3,2)*a(4,1))) & + -a(1,4)*(a(2,1)*(a(3,2)*a(4,3)-a(3,3)*a(4,2)) & + -a(2,2)*(a(3,1)*a(4,3)-a(3,3)*a(4,1)) & + +a(2,3)*(a(3,1)*a(4,2)-a(3,2)*a(4,1))) + do i=1,4 + b(1,i) = a(1,i) + b(2,i) = a(2,i) + b(3,i) = a(3,i) + b(4,i) = a(4,i) + enddo + + a(1,1) = b(2,2)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(2,3)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))+b(2,4)*(b(3,2)*b(4,3)-b(3,3)*b(4,2)) + a(2,1) = -b(2,1)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))+b(2,3)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))-b(2,4)*(b(3,1)*b(4,3)-b(3,3)*b(4,1)) + a(3,1) = b(2,1)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))-b(2,2)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))+b(2,4)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)) + a(4,1) = -b(2,1)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))+b(2,2)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))-b(2,3)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)) + + a(1,2) = -b(1,2)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))+b(1,3)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))-b(1,4)*(b(3,2)*b(4,3)-b(3,3)*b(4,2)) + a(2,2) = b(1,1)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(1,3)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))+b(1,4)*(b(3,1)*b(4,3)-b(3,3)*b(4,1)) + a(3,2) = -b(1,1)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))+b(1,2)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))-b(1,4)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)) + a(4,2) = b(1,1)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))-b(1,2)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))+b(1,3)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)) + + a(1,3) = b(1,2)*(b(2,3)*b(4,4)-b(2,4)*b(4,3))-b(1,3)*(b(2,2)*b(4,4)-b(2,4)*b(4,2))+b(1,4)*(b(2,2)*b(4,3)-b(2,3)*b(4,2)) + a(2,3) = -b(1,1)*(b(2,3)*b(4,4)-b(2,4)*b(4,3))+b(1,3)*(b(2,1)*b(4,4)-b(2,4)*b(4,1))-b(1,4)*(b(2,1)*b(4,3)-b(2,3)*b(4,1)) + a(3,3) = b(1,1)*(b(2,2)*b(4,4)-b(2,4)*b(4,2))-b(1,2)*(b(2,1)*b(4,4)-b(2,4)*b(4,1))+b(1,4)*(b(2,1)*b(4,2)-b(2,2)*b(4,1)) + a(4,3) = -b(1,1)*(b(2,2)*b(4,3)-b(2,3)*b(4,2))+b(1,2)*(b(2,1)*b(4,3)-b(2,3)*b(4,1))-b(1,3)*(b(2,1)*b(4,2)-b(2,2)*b(4,1)) + + a(1,4) = -b(1,2)*(b(2,3)*b(3,4)-b(2,4)*b(3,3))+b(1,3)*(b(2,2)*b(3,4)-b(2,4)*b(3,2))-b(1,4)*(b(2,2)*b(3,3)-b(2,3)*b(3,2)) + a(2,4) = b(1,1)*(b(2,3)*b(3,4)-b(2,4)*b(3,3))-b(1,3)*(b(2,1)*b(3,4)-b(2,4)*b(3,1))+b(1,4)*(b(2,1)*b(3,3)-b(2,3)*b(3,1)) + a(3,4) = -b(1,1)*(b(2,2)*b(3,4)-b(2,4)*b(3,2))+b(1,2)*(b(2,1)*b(3,4)-b(2,4)*b(3,1))-b(1,4)*(b(2,1)*b(3,2)-b(2,2)*b(3,1)) + a(4,4) = b(1,1)*(b(2,2)*b(3,3)-b(2,3)*b(3,2))-b(1,2)*(b(2,1)*b(3,3)-b(2,3)*b(3,1))+b(1,3)*(b(2,1)*b(3,2)-b(2,2)*b(3,1)) + +end + +subroutine invert5(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + double precision :: b(5,5) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: b + integer :: i,j + det_l = a(1,1)*(a(2,2)*(a(3,3)*(a(4,4)*a(5,5)-a(4,5)*a(5,4))-a(3,4)*( & + a(4,3)*a(5,5)-a(4,5)*a(5,3))+a(3,5)*(a(4,3)*a(5,4)-a(4,4)*a(5,3)))- & + a(2,3)*(a(3,2)*(a(4,4)*a(5,5)-a(4,5)*a(5,4))-a(3,4)*(a(4,2)*a(5,5)- & + a(4,5)*a(5,2))+a(3,5)*(a(4,2)*a(5,4)-a(4,4)*a(5,2)))+a(2,4)*(a(3,2)*( & + a(4,3)*a(5,5)-a(4,5)*a(5,3))-a(3,3)*(a(4,2)*a(5,5)-a(4,5)*a(5,2))+ & + a(3,5)*(a(4,2)*a(5,3)-a(4,3)*a(5,2)))-a(2,5)*(a(3,2)*(a(4,3)*a(5,4)- & + a(4,4)*a(5,3))-a(3,3)*(a(4,2)*a(5,4)-a(4,4)*a(5,2))+a(3,4)*(a(4,2)* & + a(5,3)-a(4,3)*a(5,2))))-a(1,2)*(a(2,1)*(a(3,3)*(a(4,4)*a(5,5)-a(4,5)* & + a(5,4))-a(3,4)*(a(4,3)*a(5,5)-a(4,5)*a(5,3))+a(3,5)*(a(4,3)*a(5,4)- & + a(4,4)*a(5,3)))-a(2,3)*(a(3,1)*(a(4,4)*a(5,5)-a(4,5)*a(5,4))-a(3,4)*( & + a(4,1)*a(5,5)-a(4,5)*a(5,1))+a(3,5)*(a(4,1)*a(5,4)-a(4,4)*a(5,1)))+ & + a(2,4)*(a(3,1)*(a(4,3)*a(5,5)-a(4,5)*a(5,3))-a(3,3)*(a(4,1)*a(5,5)- & + a(4,5)*a(5,1))+a(3,5)*(a(4,1)*a(5,3)-a(4,3)*a(5,1)))-a(2,5)*(a(3,1)*( & + a(4,3)*a(5,4)-a(4,4)*a(5,3))-a(3,3)*(a(4,1)*a(5,4)-a(4,4)*a(5,1))+ & + a(3,4)*(a(4,1)*a(5,3)-a(4,3)*a(5,1))))+a(1,3)*(a(2,1)*(a(3,2)*(a(4,4)* & + a(5,5)-a(4,5)*a(5,4))-a(3,4)*(a(4,2)*a(5,5)-a(4,5)*a(5,2))+a(3,5)*( & + a(4,2)*a(5,4)-a(4,4)*a(5,2)))-a(2,2)*(a(3,1)*(a(4,4)*a(5,5)-a(4,5)* & + a(5,4))-a(3,4)*(a(4,1)*a(5,5)-a(4,5)*a(5,1))+a(3,5)*(a(4,1)*a(5,4)- & + a(4,4)*a(5,1)))+a(2,4)*(a(3,1)*(a(4,2)*a(5,5)-a(4,5)*a(5,2))-a(3,2)*( & + a(4,1)*a(5,5)-a(4,5)*a(5,1))+a(3,5)*(a(4,1)*a(5,2)-a(4,2)*a(5,1)))- & + a(2,5)*(a(3,1)*(a(4,2)*a(5,4)-a(4,4)*a(5,2))-a(3,2)*(a(4,1)*a(5,4)- & + a(4,4)*a(5,1))+a(3,4)*(a(4,1)*a(5,2)-a(4,2)*a(5,1))))-a(1,4)*(a(2,1)*( & + a(3,2)*(a(4,3)*a(5,5)-a(4,5)*a(5,3))-a(3,3)*(a(4,2)*a(5,5)-a(4,5)* & + a(5,2))+a(3,5)*(a(4,2)*a(5,3)-a(4,3)*a(5,2)))-a(2,2)*(a(3,1)*(a(4,3)* & + a(5,5)-a(4,5)*a(5,3))-a(3,3)*(a(4,1)*a(5,5)-a(4,5)*a(5,1))+a(3,5)*( & + a(4,1)*a(5,3)-a(4,3)*a(5,1)))+a(2,3)*(a(3,1)*(a(4,2)*a(5,5)-a(4,5)* & + a(5,2))-a(3,2)*(a(4,1)*a(5,5)-a(4,5)*a(5,1))+a(3,5)*(a(4,1)*a(5,2)- & + a(4,2)*a(5,1)))-a(2,5)*(a(3,1)*(a(4,2)*a(5,3)-a(4,3)*a(5,2))-a(3,2)*( & + a(4,1)*a(5,3)-a(4,3)*a(5,1))+a(3,3)*(a(4,1)*a(5,2)-a(4,2)*a(5,1))))+ & + a(1,5)*(a(2,1)*(a(3,2)*(a(4,3)*a(5,4)-a(4,4)*a(5,3))-a(3,3)*(a(4,2)* & + a(5,4)-a(4,4)*a(5,2))+a(3,4)*(a(4,2)*a(5,3)-a(4,3)*a(5,2)))-a(2,2)*( & + a(3,1)*(a(4,3)*a(5,4)-a(4,4)*a(5,3))-a(3,3)*(a(4,1)*a(5,4)-a(4,4)* & + a(5,1))+a(3,4)*(a(4,1)*a(5,3)-a(4,3)*a(5,1)))+a(2,3)*(a(3,1)*(a(4,2)* & + a(5,4)-a(4,4)*a(5,2))-a(3,2)*(a(4,1)*a(5,4)-a(4,4)*a(5,1))+a(3,4)*( & + a(4,1)*a(5,2)-a(4,2)*a(5,1)))-a(2,4)*(a(3,1)*(a(4,2)*a(5,3)-a(4,3)* & + a(5,2))-a(3,2)*(a(4,1)*a(5,3)-a(4,3)*a(5,1))+a(3,3)*(a(4,1)*a(5,2)- & + a(4,2)*a(5,1)))) + + do i=1,5 + b(1,i) = a(1,i) + b(2,i) = a(2,i) + b(3,i) = a(3,i) + b(4,i) = a(4,i) + b(5,i) = a(5,i) + enddo + + a(1,1) = & + (b(2,2)*(b(3,3)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))+b(3,5)*(b(4,3)*b(5,4)-b(4,4)*b(5,3)))-b(2,3)* & + (b(3,2)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(3,5)*(b(4,2)*b(5,4)-b(4,4)*b(5,2)))+b(2,4)* & + (b(3,2)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(3,3)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(3,5)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))-b(2,5)* & + (b(3,2)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(3,3)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))+b(3,4)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))) + a(2,1) = & + (-b(2,1)*(b(3,3)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))+b(3,5)*(b(4,3)*b(5,4)-b(4,4)*b(5,3)))+b(2,3)* & + (b(3,1)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,4)-b(4,4)*b(5,1)))-b(2,4)* & + (b(3,1)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(3,3)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))+b(2,5)* & + (b(3,1)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(3,3)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(3,4)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))) + a(3,1) = & + (b(2,1)*(b(3,2)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(3,5)*(b(4,2)*b(5,4)-b(4,4)*b(5,2)))-b(2,2)* & + (b(3,1)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,4)-b(4,4)*b(5,1)))+b(2,4)* & + (b(3,1)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))-b(3,2)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))-b(2,5)* & + (b(3,1)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))-b(3,2)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(3,4)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + a(4,1) = & + (-b(2,1)*(b(3,2)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(3,3)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(3,5)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))+b(2,2)* & + (b(3,1)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(3,3)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))-b(2,3)* & + (b(3,1)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))-b(3,2)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))+b(2,5)* & + (b(3,1)*(b(4,2)*b(5,3)-b(4,3)*b(5,2))-b(3,2)*(b(4,1)*b(5,3)-b(4,3)*b(5,1))+b(3,3)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + a(5,1) = & + (b(2,1)*(b(3,2)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(3,3)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))+b(3,4)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))-b(2,2)* & + (b(3,1)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(3,3)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(3,4)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))+b(2,3)* & + (b(3,1)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))-b(3,2)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(3,4)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))-b(2,4)* & + (b(3,1)*(b(4,2)*b(5,3)-b(4,3)*b(5,2))-b(3,2)*(b(4,1)*b(5,3)-b(4,3)*b(5,1))+b(3,3)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + + a(1,2) = & + (-b(1,2)*(b(3,3)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))+b(3,5)*(b(4,3)*b(5,4)-b(4,4)*b(5,3)))+b(1,3)* & + (b(3,2)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(3,5)*(b(4,2)*b(5,4)-b(4,4)*b(5,2)))-b(1,4)* & + (b(3,2)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(3,3)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(3,5)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))+b(1,5)* & + (b(3,2)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(3,3)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))+b(3,4)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))) + a(2,2) = & + (b(1,1)*(b(3,3)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))+b(3,5)*(b(4,3)*b(5,4)-b(4,4)*b(5,3)))-b(1,3)* & + (b(3,1)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,4)-b(4,4)*b(5,1)))+b(1,4)* & + (b(3,1)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(3,3)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))-b(1,5)* & + (b(3,1)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(3,3)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(3,4)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))) + a(3,2) = & + (-b(1,1)*(b(3,2)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(3,5)*(b(4,2)*b(5,4)-b(4,4)*b(5,2)))+b(1,2)* & + (b(3,1)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,4)-b(4,4)*b(5,1)))-b(1,4)* & + (b(3,1)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))-b(3,2)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))+b(1,5)* & + (b(3,1)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))-b(3,2)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(3,4)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + a(4,2) = & + (b(1,1)*(b(3,2)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(3,3)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(3,5)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))-b(1,2)* & + (b(3,1)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(3,3)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))+b(1,3)* & + (b(3,1)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))-b(3,2)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(3,5)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))-b(1,5)* & + (b(3,1)*(b(4,2)*b(5,3)-b(4,3)*b(5,2))-b(3,2)*(b(4,1)*b(5,3)-b(4,3)*b(5,1))+b(3,3)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + a(5,2) = & + (-b(1,1)*(b(3,2)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(3,3)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))+b(3,4)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))+b(1,2)* & + (b(3,1)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(3,3)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(3,4)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))-b(1,3)* & + (b(3,1)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))-b(3,2)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(3,4)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))+b(1,4)* & + (b(3,1)*(b(4,2)*b(5,3)-b(4,3)*b(5,2))-b(3,2)*(b(4,1)*b(5,3)-b(4,3)*b(5,1))+b(3,3)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + + a(1,3) = & + (b(1,2)*(b(2,3)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(2,4)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))+b(2,5)*(b(4,3)*b(5,4)-b(4,4)*b(5,3)))-b(1,3)* & + (b(2,2)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(2,4)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(2,5)*(b(4,2)*b(5,4)-b(4,4)*b(5,2)))+b(1,4)* & + (b(2,2)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(2,3)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(2,5)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))-b(1,5)* & + (b(2,2)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(2,3)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))+b(2,4)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))) + a(2,3) = & + (-b(1,1)*(b(2,3)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(2,4)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))+b(2,5)*(b(4,3)*b(5,4)-b(4,4)*b(5,3)))+b(1,3)* & + (b(2,1)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(2,4)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(2,5)*(b(4,1)*b(5,4)-b(4,4)*b(5,1)))-b(1,4)* & + (b(2,1)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(2,3)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(2,5)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))+b(1,5)* & + (b(2,1)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(2,3)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(2,4)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))) + a(3,3) = & + (b(1,1)*(b(2,2)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(2,4)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(2,5)*(b(4,2)*b(5,4)-b(4,4)*b(5,2)))-b(1,2)* & + (b(2,1)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(2,4)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(2,5)*(b(4,1)*b(5,4)-b(4,4)*b(5,1)))+b(1,4)* & + (b(2,1)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))-b(2,2)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(2,5)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))-b(1,5)* & + (b(2,1)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))-b(2,2)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(2,4)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + a(4,3) = & + (-b(1,1)*(b(2,2)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(2,3)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))+b(2,5)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))+b(1,2)* & + (b(2,1)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))-b(2,3)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(2,5)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))-b(1,3)* & + (b(2,1)*(b(4,2)*b(5,5)-b(4,5)*b(5,2))-b(2,2)*(b(4,1)*b(5,5)-b(4,5)*b(5,1))+b(2,5)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))+b(1,5)* & + (b(2,1)*(b(4,2)*b(5,3)-b(4,3)*b(5,2))-b(2,2)*(b(4,1)*b(5,3)-b(4,3)*b(5,1))+b(2,3)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + a(5,3) = & + (b(1,1)*(b(2,2)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(2,3)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))+b(2,4)*(b(4,2)*b(5,3)-b(4,3)*b(5,2)))-b(1,2)* & + (b(2,1)*(b(4,3)*b(5,4)-b(4,4)*b(5,3))-b(2,3)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(2,4)*(b(4,1)*b(5,3)-b(4,3)*b(5,1)))+b(1,3)* & + (b(2,1)*(b(4,2)*b(5,4)-b(4,4)*b(5,2))-b(2,2)*(b(4,1)*b(5,4)-b(4,4)*b(5,1))+b(2,4)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))-b(1,4)* & + (b(2,1)*(b(4,2)*b(5,3)-b(4,3)*b(5,2))-b(2,2)*(b(4,1)*b(5,3)-b(4,3)*b(5,1))+b(2,3)*(b(4,1)*b(5,2)-b(4,2)*b(5,1)))) + + a(1,4) = & + (-b(1,2)*(b(2,3)*(b(3,4)*b(5,5)-b(3,5)*b(5,4))-b(2,4)*(b(3,3)*b(5,5)-b(3,5)*b(5,3))+b(2,5)*(b(3,3)*b(5,4)-b(3,4)*b(5,3)))+b(1,3)* & + (b(2,2)*(b(3,4)*b(5,5)-b(3,5)*b(5,4))-b(2,4)*(b(3,2)*b(5,5)-b(3,5)*b(5,2))+b(2,5)*(b(3,2)*b(5,4)-b(3,4)*b(5,2)))-b(1,4)* & + (b(2,2)*(b(3,3)*b(5,5)-b(3,5)*b(5,3))-b(2,3)*(b(3,2)*b(5,5)-b(3,5)*b(5,2))+b(2,5)*(b(3,2)*b(5,3)-b(3,3)*b(5,2)))+b(1,5)* & + (b(2,2)*(b(3,3)*b(5,4)-b(3,4)*b(5,3))-b(2,3)*(b(3,2)*b(5,4)-b(3,4)*b(5,2))+b(2,4)*(b(3,2)*b(5,3)-b(3,3)*b(5,2)))) + a(2,4) = & + (b(1,1)*(b(2,3)*(b(3,4)*b(5,5)-b(3,5)*b(5,4))-b(2,4)*(b(3,3)*b(5,5)-b(3,5)*b(5,3))+b(2,5)*(b(3,3)*b(5,4)-b(3,4)*b(5,3)))-b(1,3)* & + (b(2,1)*(b(3,4)*b(5,5)-b(3,5)*b(5,4))-b(2,4)*(b(3,1)*b(5,5)-b(3,5)*b(5,1))+b(2,5)*(b(3,1)*b(5,4)-b(3,4)*b(5,1)))+b(1,4)* & + (b(2,1)*(b(3,3)*b(5,5)-b(3,5)*b(5,3))-b(2,3)*(b(3,1)*b(5,5)-b(3,5)*b(5,1))+b(2,5)*(b(3,1)*b(5,3)-b(3,3)*b(5,1)))-b(1,5)* & + (b(2,1)*(b(3,3)*b(5,4)-b(3,4)*b(5,3))-b(2,3)*(b(3,1)*b(5,4)-b(3,4)*b(5,1))+b(2,4)*(b(3,1)*b(5,3)-b(3,3)*b(5,1)))) + a(3,4) = & + (-b(1,1)*(b(2,2)*(b(3,4)*b(5,5)-b(3,5)*b(5,4))-b(2,4)*(b(3,2)*b(5,5)-b(3,5)*b(5,2))+b(2,5)*(b(3,2)*b(5,4)-b(3,4)*b(5,2)))+b(1,2)* & + (b(2,1)*(b(3,4)*b(5,5)-b(3,5)*b(5,4))-b(2,4)*(b(3,1)*b(5,5)-b(3,5)*b(5,1))+b(2,5)*(b(3,1)*b(5,4)-b(3,4)*b(5,1)))-b(1,4)* & + (b(2,1)*(b(3,2)*b(5,5)-b(3,5)*b(5,2))-b(2,2)*(b(3,1)*b(5,5)-b(3,5)*b(5,1))+b(2,5)*(b(3,1)*b(5,2)-b(3,2)*b(5,1)))+b(1,5)* & + (b(2,1)*(b(3,2)*b(5,4)-b(3,4)*b(5,2))-b(2,2)*(b(3,1)*b(5,4)-b(3,4)*b(5,1))+b(2,4)*(b(3,1)*b(5,2)-b(3,2)*b(5,1)))) + a(4,4) = & + (b(1,1)*(b(2,2)*(b(3,3)*b(5,5)-b(3,5)*b(5,3))-b(2,3)*(b(3,2)*b(5,5)-b(3,5)*b(5,2))+b(2,5)*(b(3,2)*b(5,3)-b(3,3)*b(5,2)))-b(1,2)* & + (b(2,1)*(b(3,3)*b(5,5)-b(3,5)*b(5,3))-b(2,3)*(b(3,1)*b(5,5)-b(3,5)*b(5,1))+b(2,5)*(b(3,1)*b(5,3)-b(3,3)*b(5,1)))+b(1,3)* & + (b(2,1)*(b(3,2)*b(5,5)-b(3,5)*b(5,2))-b(2,2)*(b(3,1)*b(5,5)-b(3,5)*b(5,1))+b(2,5)*(b(3,1)*b(5,2)-b(3,2)*b(5,1)))-b(1,5)* & + (b(2,1)*(b(3,2)*b(5,3)-b(3,3)*b(5,2))-b(2,2)*(b(3,1)*b(5,3)-b(3,3)*b(5,1))+b(2,3)*(b(3,1)*b(5,2)-b(3,2)*b(5,1)))) + a(5,4) = & + (-b(1,1)*(b(2,2)*(b(3,3)*b(5,4)-b(3,4)*b(5,3))-b(2,3)*(b(3,2)*b(5,4)-b(3,4)*b(5,2))+b(2,4)*(b(3,2)*b(5,3)-b(3,3)*b(5,2)))+b(1,2)* & + (b(2,1)*(b(3,3)*b(5,4)-b(3,4)*b(5,3))-b(2,3)*(b(3,1)*b(5,4)-b(3,4)*b(5,1))+b(2,4)*(b(3,1)*b(5,3)-b(3,3)*b(5,1)))-b(1,3)* & + (b(2,1)*(b(3,2)*b(5,4)-b(3,4)*b(5,2))-b(2,2)*(b(3,1)*b(5,4)-b(3,4)*b(5,1))+b(2,4)*(b(3,1)*b(5,2)-b(3,2)*b(5,1)))+b(1,4)* & + (b(2,1)*(b(3,2)*b(5,3)-b(3,3)*b(5,2))-b(2,2)*(b(3,1)*b(5,3)-b(3,3)*b(5,1))+b(2,3)*(b(3,1)*b(5,2)-b(3,2)*b(5,1)))) + + a(1,5) = & + (b(1,2)*(b(2,3)*(b(3,4)*b(4,5)-b(3,5)*b(4,4))-b(2,4)*(b(3,3)*b(4,5)-b(3,5)*b(4,3))+b(2,5)*(b(3,3)*b(4,4)-b(3,4)*b(4,3)))-b(1,3)* & + (b(2,2)*(b(3,4)*b(4,5)-b(3,5)*b(4,4))-b(2,4)*(b(3,2)*b(4,5)-b(3,5)*b(4,2))+b(2,5)*(b(3,2)*b(4,4)-b(3,4)*b(4,2)))+b(1,4)* & + (b(2,2)*(b(3,3)*b(4,5)-b(3,5)*b(4,3))-b(2,3)*(b(3,2)*b(4,5)-b(3,5)*b(4,2))+b(2,5)*(b(3,2)*b(4,3)-b(3,3)*b(4,2)))-b(1,5)* & + (b(2,2)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(2,3)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))+b(2,4)*(b(3,2)*b(4,3)-b(3,3)*b(4,2)))) + a(2,5) = & + (-b(1,1)*(b(2,3)*(b(3,4)*b(4,5)-b(3,5)*b(4,4))-b(2,4)*(b(3,3)*b(4,5)-b(3,5)*b(4,3))+b(2,5)*(b(3,3)*b(4,4)-b(3,4)*b(4,3)))+b(1,3)* & + (b(2,1)*(b(3,4)*b(4,5)-b(3,5)*b(4,4))-b(2,4)*(b(3,1)*b(4,5)-b(3,5)*b(4,1))+b(2,5)*(b(3,1)*b(4,4)-b(3,4)*b(4,1)))-b(1,4)* & + (b(2,1)*(b(3,3)*b(4,5)-b(3,5)*b(4,3))-b(2,3)*(b(3,1)*b(4,5)-b(3,5)*b(4,1))+b(2,5)*(b(3,1)*b(4,3)-b(3,3)*b(4,1)))+b(1,5)* & + (b(2,1)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(2,3)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))+b(2,4)*(b(3,1)*b(4,3)-b(3,3)*b(4,1)))) + a(3,5) = & + (b(1,1)*(b(2,2)*(b(3,4)*b(4,5)-b(3,5)*b(4,4))-b(2,4)*(b(3,2)*b(4,5)-b(3,5)*b(4,2))+b(2,5)*(b(3,2)*b(4,4)-b(3,4)*b(4,2)))-b(1,2)* & + (b(2,1)*(b(3,4)*b(4,5)-b(3,5)*b(4,4))-b(2,4)*(b(3,1)*b(4,5)-b(3,5)*b(4,1))+b(2,5)*(b(3,1)*b(4,4)-b(3,4)*b(4,1)))+b(1,4)* & + (b(2,1)*(b(3,2)*b(4,5)-b(3,5)*b(4,2))-b(2,2)*(b(3,1)*b(4,5)-b(3,5)*b(4,1))+b(2,5)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)))-b(1,5)* & + (b(2,1)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))-b(2,2)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))+b(2,4)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)))) + a(4,5) = & + (-b(1,1)*(b(2,2)*(b(3,3)*b(4,5)-b(3,5)*b(4,3))-b(2,3)*(b(3,2)*b(4,5)-b(3,5)*b(4,2))+b(2,5)*(b(3,2)*b(4,3)-b(3,3)*b(4,2)))+b(1,2)* & + (b(2,1)*(b(3,3)*b(4,5)-b(3,5)*b(4,3))-b(2,3)*(b(3,1)*b(4,5)-b(3,5)*b(4,1))+b(2,5)*(b(3,1)*b(4,3)-b(3,3)*b(4,1)))-b(1,3)* & + (b(2,1)*(b(3,2)*b(4,5)-b(3,5)*b(4,2))-b(2,2)*(b(3,1)*b(4,5)-b(3,5)*b(4,1))+b(2,5)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)))+b(1,5)* & + (b(2,1)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))-b(2,2)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))+b(2,3)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)))) + a(5,5) = & + (b(1,1)*(b(2,2)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(2,3)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))+b(2,4)*(b(3,2)*b(4,3)-b(3,3)*b(4,2)))-b(1,2)* & + (b(2,1)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(2,3)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))+b(2,4)*(b(3,1)*b(4,3)-b(3,3)*b(4,1)))+b(1,3)* & + (b(2,1)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))-b(2,2)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))+b(2,4)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)))-b(1,4)* & + (b(2,1)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))-b(2,2)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))+b(2,3)*(b(3,1)*b(4,2)-b(3,2)*b(4,1)))) + +end + #+end_src + +*** C interface :noexport: + + #+CALL: generate_c_interface(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_invert & + (context, m, n, lda, A, det_l) & + 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 :: m + integer (c_int64_t) , intent(in) , value :: n + integer (c_int64_t) , intent(in) , value :: lda + real (c_double ) , intent(inout) :: A(lda,*) + real (c_double ) , intent(inout) :: det_l + + integer(c_int32_t), external :: qmckl_invert_f + info = qmckl_invert_f & + (context, m, n, lda, A, det_l) + + end function qmckl_invert + #+end_src + + +*** Test :noexport: + * End of files :noexport: #+begin_src c :comments link :tangle (eval c_test) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 2244b55..ccdcc28 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -97,15 +97,20 @@ int main() { Computed data: - |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| - | ~det_matrix_list~ | ~[walk_num][det_num][mo_num][fermi_num]~ | The slater matrix for each determinant of each walker. | - |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| - | ~det_vgl~ | ~[5][walk_num][det_num]~ | Value, gradients, Laplacian of the MOs at electron positions | - | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | - |-------------------+------------------------------------------+----------------------------------------------------------------------------------------| + |-------------------------+---------------------------------------------+----------------------------------------------------------------------------------------| + | ~det_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | The slater matrix for each determinant of each walker. | + | ~det_matrix_list_date~ | ~int64_t~ | The slater matrix for each determinant of each walker. | + | ~det_adj_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the slater matrix for each determinant of each walker. | + | ~det_adj_matrix_list_date~ | ~int64_t~ | Adjoint of the slater matrix for each determinant of each walker. | + |-------------------------+---------------------------------------------+----------------------------------------------------------------------------------------| + | ~det_vgl~ | ~[5][walk_num][det_num]~ | Value, gradients, Laplacian of the MOs at electron positions | + | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + | ~det_inv_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the slater matrix for each determinant of each walker. | + | ~det_inv_matrix_list_date~ | ~int64_t~ | Inverse of the slater matrix for each determinant of each walker. | + |-------------------------+---------------------------------------------+----------------------------------------------------------------------------------------| ** Data structure - + #+begin_src c :comments org :tangle (eval h_private_type) typedef struct qmckl_determinant_struct { char type; @@ -115,7 +120,12 @@ typedef struct qmckl_determinant_struct { int64_t* mo_index_list; double * det_matrix_list; + double * det_adj_matrix_list; + double * det_inv_matrix_list; double * det_vgl; + int64_t det_matrix_list_date; + int64_t det_adj_matrix_list_date; + int64_t det_inv_matrix_list_date; int64_t det_vgl_date; int32_t uninitialized; @@ -139,7 +149,7 @@ int64_t qmckl_get_determinant_det_num (const qmckl_context context); int64_t qmckl_get_determinant_fermi_num (const qmckl_context context); int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context); #+end_src - + When all the data for the slater determinants have been provided, the following function returns ~true~. @@ -276,7 +286,7 @@ qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; ctx->det.uninitialized &= ~mask; ctx->det.provided = (ctx->det.uninitialized == 0); if (ctx->det.provided) { - qmckl_exit_code rc_ = qmckl_finalize_determinant(context); + //qmckl_exit_code rc_ = qmckl_finalize_determinant(context); if (rc_ != QMCKL_SUCCESS) return rc_; } @@ -397,23 +407,24 @@ qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) { ** Test * Computation +** Determinant matrix :PROPERTIES: - :Name: qmckl_compute_determinant_det_vgl + :Name: qmckl_compute_determinant_det_inv_list :CRetType: qmckl_exit_code :FRetType: qmckl_exit_code :END: *** Get - #+NAME: qmckl_get_determinant_det_vgl_args + #+NAME: qmckl_get_determinant_det_inv_list | ~qmckl_context~ | ~context~ | in | Global state | - | ~double~ | ~det_vgl[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_inv_list[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs | #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double* const det_vgl); +qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double* const det_inv_list); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double * const det_vgl) { +qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double * const det_inv_list) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -430,11 +441,14 @@ qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double * co rc = qmckl_provide_det_vgl(context); if (rc != QMCKL_SUCCESS) return rc; + rc = qmckl_provide_det_inv_list(context); + if (rc != QMCKL_SUCCESS) return rc; + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = 5 * ctx->det.det_num * ctx->det.walk_num; - memcpy(det_vgl, ctx->det.det_vgl, sze * sizeof(double)); + size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->fermi_num; + memcpy(det_inv_list, ctx->det.det_vgl, sze * sizeof(double)); return QMCKL_SUCCESS; } @@ -444,13 +458,474 @@ qmckl_exit_code qmckl_get_determinant_det_vgl(qmckl_context context, double * co #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_compute_get_determinant_det_vgl ( + qmckl_exit_code qmckl_compute_get_determinant_vgl ( const qmckl_context context, double* const det_vgl ); #+end_src *** Provide + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_det(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_det(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if(!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if (!ctx->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + + if (!ctx->mo_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + if (!ctx->det.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->det.det_date) { + + /* Allocate array */ + if (ctx->det.det_vgl == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num * sizeof(double); + double* det_vgl = (double*) qmckl_malloc(context, mem_info); + + if (det_vgl == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_det_vgl", + NULL); + } + ctx->det.det_vgl = det_vgl; + } + + qmckl_exit_code rc; + if (ctx->det.type == 'G') { + rc = qmckl_compute_det_vgl(context, + ctx->det.walk_num, + ctx->det.fermi_num, + ctx->det.mo_index_list, + ctx->mo_basis.mo_num, + ctx->mo_basis.mo_vgl, + ctx->det.det_vgl); + } else { + return qmckl_failwith( context, + QMCKL_FAILURE, + "compute_det_vgl", + "Not yet implemented"); + } + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->det.det_vgl_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src *** Compute + :PROPERTIES: + :Name: qmckl_compute_det_vgl + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_det_vgl_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~fermi_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_det_vgl_f(context, & + walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: walk_num + integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: mo_num + integer*8, intent(in) :: mo_index_list(fermi_num) + double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) + double precision, intent(inout) :: det_vgl(fermi_num, fermi_num, walk_num, 5) + integer*8 :: iwalk, ielec, mo_id, imo + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (fermi_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + do iwalk = 1, walk_num + do ielec = 1, fermi_num + do imo = 1, fermi_num + mo_id = mo_index_list(imo) + ! Value + det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + + ! Grad_x + det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2) + + ! Grad_y + det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3) + + ! Grad_z + det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4) + + ! Lap + det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5) + end do + end do + end do + +end function qmckl_compute_det_vgl_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_det_vgl ( + const qmckl_context context, + const int64_t walk_num, + const int64_t fermi_num, + const int64_t* mo_index_list, + const int64_t mo_num, + const double* mo_vgl, + double* const det_vgl ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_det_vgl & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_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 :: walk_num + integer (c_int64_t) , intent(in) , value :: fermi_num + integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) + integer (c_int64_t) , intent(in) , value :: mo_num + real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) + real (c_double ) , intent(out) :: det_vgl(fermi_num,fermi_num,walk_num,5) + + integer(c_int32_t), external :: qmckl_compute_det_vgl_f + info = qmckl_compute_det_vgl_f & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl) + + end function qmckl_compute_det_vgl + #+end_src + +*** Test + +** Inverse of Determinant matrix + :PROPERTIES: + :Name: qmckl_compute_det_inv_matrix + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + +*** Get + #+NAME: qmckl_get_det_inv_matrix_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~double~ | ~det_inv_matrix_list[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs | + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double* const det_inv_matrix); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double * const det_inv_matrix) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_inv_matrix(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->det.fermi_num; + memcpy(det_inv_matrix, ctx->det.det_inv_matrix, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + #+end_src + + #+CALL: generate_c_header(table=qmckl_get_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_get_det_inv_matrix")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_get_det_inv_matrix ( + const qmckl_context context, + double* const det_vgl ); + #+end_src + +*** Provide + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if(!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if (!ctx->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + + if (!ctx->mo_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + if (!ctx->det.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->det.det_inv_matrix_list_date) { + + /* Allocate array */ + if (ctx->det.det_inv_matrix_list == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->det.walk_num * ctx->det.det_num * + ctx->det.fermi_num * ctx->det.fermi_num * sizeof(double); + double* det_vgl = (double*) qmckl_malloc(context, mem_info); + + if (det_vgl == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_det_vgl", + NULL); + } + ctx->det.det_inv_matrix_list = det_inv_matrix_list; + } + + qmckl_exit_code rc; + if (ctx->det.type == 'G') { + rc = qmckl_compute_det_inv_matrix(context, + ctx->det.walk_num, + ctx->det.fermi_num, + ctx->det.mo_index_list, + ctx->mo_basis.mo_num, + ctx->mo_basis.mo_vgl, + ctx->det.det_inv_matrix_list); + } else { + return qmckl_failwith( context, + QMCKL_FAILURE, + "compute_det_vgl", + "Not yet implemented"); + } + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->det.det_inv_matrix_list_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src +*** Compute + :PROPERTIES: + :Name: qmckl_compute_det_inv_matrix + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_det_inv_matrix_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~fermi_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_inv_matrix_list[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_det_inv_matrix_f(context, & + walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: walk_num + integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: mo_num + integer*8, intent(in) :: mo_index_list(fermi_num) + double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) + double precision, intent(inout) :: det_inv_matrix_list(fermi_num, fermi_num, walk_num, 5) + integer*8 :: iwalk, ielec, mo_id, imo + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (fermi_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + do iwalk = 1, walk_num + do ielec = 1, fermi_num + do imo = 1, fermi_num + mo_id = mo_index_list(imo) + ! Value + det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + end do + end do + end do + +end function qmckl_compute_det_inv_matrix_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_det_inv_matrix ( + const qmckl_context context, + const int64_t walk_num, + const int64_t fermi_num, + const int64_t* mo_index_list, + const int64_t mo_num, + const double* mo_vgl, + double* const det_inv_matrix_list ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_det_inv_matrix & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list) & + 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 :: walk_num + integer (c_int64_t) , intent(in) , value :: fermi_num + integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) + integer (c_int64_t) , intent(in) , value :: mo_num + real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) + real (c_double ) , intent(out) :: det_inv_matrix_list(fermi_num,fermi_num,walk_num,5) + + integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_f + info = qmckl_compute_det_inv_matrix_f & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list) + + end function qmckl_compute_det_inv_matrix + #+end_src + *** Test * End of files :noexport: From d416c5dd7785f24cd58a28ff99b9b1aaa59e5826 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Tue, 5 Oct 2021 13:26:55 +0200 Subject: [PATCH 07/68] Working on calculation of inverse. #41 --- org/qmckl_determinant.org | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index ccdcc28..b815564 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -287,7 +287,7 @@ ctx->det.uninitialized &= ~mask; ctx->det.provided = (ctx->det.uninitialized == 0); if (ctx->det.provided) { //qmckl_exit_code rc_ = qmckl_finalize_determinant(context); - if (rc_ != QMCKL_SUCCESS) return rc_; + //if (rc_ != QMCKL_SUCCESS) return rc_; } return QMCKL_SUCCESS; @@ -441,13 +441,13 @@ qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double rc = qmckl_provide_det_vgl(context); if (rc != QMCKL_SUCCESS) return rc; - rc = qmckl_provide_det_inv_list(context); + rc = qmckl_provide_det_inv_matrix(context); if (rc != QMCKL_SUCCESS) return rc; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->fermi_num; + size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->det.fermi_num; memcpy(det_inv_list, ctx->det.det_vgl, sze * sizeof(double)); return QMCKL_SUCCESS; @@ -466,11 +466,11 @@ qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double *** Provide #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_provide_det(qmckl_context context); +qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_provide_det(qmckl_context context) { +qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -515,7 +515,7 @@ qmckl_exit_code qmckl_provide_det(qmckl_context context) { } /* Compute if necessary */ - if (ctx->electron.coord_new_date > ctx->det.det_date) { + if (ctx->electron.coord_new_date > ctx->det.det_vgl_date) { /* Allocate array */ if (ctx->det.det_vgl == NULL) { @@ -714,7 +714,7 @@ qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double * const d assert (ctx != NULL); size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->det.fermi_num; - memcpy(det_inv_matrix, ctx->det.det_inv_matrix, sze * sizeof(double)); + memcpy(det_inv_matrix, ctx->det.det_inv_matrix_list, sze * sizeof(double)); return QMCKL_SUCCESS; } @@ -726,7 +726,7 @@ qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double * const d #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_get_det_inv_matrix ( const qmckl_context context, - double* const det_vgl ); + double* const det_inv_matrix_list ); #+end_src *** Provide @@ -789,12 +789,12 @@ qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = ctx->det.walk_num * ctx->det.det_num * ctx->det.fermi_num * ctx->det.fermi_num * sizeof(double); - double* det_vgl = (double*) qmckl_malloc(context, mem_info); + double* det_inv_matrix_list = (double*) qmckl_malloc(context, mem_info); - if (det_vgl == NULL) { + if (det_inv_matrix_list == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, - "qmckl_det_vgl", + "qmckl_det_inv_matrix_list", NULL); } ctx->det.det_inv_matrix_list = det_inv_matrix_list; @@ -812,7 +812,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context) { } else { return qmckl_failwith( context, QMCKL_FAILURE, - "compute_det_vgl", + "compute_det_inv_matrix_list", "Not yet implemented"); } if (rc != QMCKL_SUCCESS) { @@ -878,7 +878,7 @@ integer function qmckl_compute_det_inv_matrix_f(context, & do imo = 1, fermi_num mo_id = mo_index_list(imo) ! Value - det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + det_inv_matrix_list(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) end do end do end do From 86ae7043633383afacb0c7243332c53893bdc17a Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 6 Oct 2021 10:38:55 +0200 Subject: [PATCH 08/68] Improved doc. #41 --- org/qmckl_determinant.org | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index b815564..91866b5 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -8,6 +8,16 @@ to calculate the local Energy (\[E_L\]). ψ(x) = det|ϕ₁(x₁)...ϕᵢ(yᵢ)...ϕₙ(xₙ)| +The above slater-matrix is also required and is denoted by Dᵢⱼ(x) such that: + +ψ(x) = det|Dᵢⱼ(x)| + +We also require the inverse of the slater-matrix which is denoted by D⁻¹ᵢⱼ(x). +Using this notation, the acceptance probability which is proportional to +ψ(y)/ψ(x) can be calculated as follows: + +ψ(yᵢ)/ψ(xᵢ) = ∑ⱼDᵢⱼ(y)D⁻¹ⱼᵢ(x) + Concerning the gradient and laplacian, in fact what is actually calculated is the ratio of the gradient/laplacian and the determinant of the slater matrix: @@ -97,17 +107,17 @@ int main() { Computed data: - |-------------------------+---------------------------------------------+----------------------------------------------------------------------------------------| - | ~det_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | The slater matrix for each determinant of each walker. | - | ~det_matrix_list_date~ | ~int64_t~ | The slater matrix for each determinant of each walker. | - | ~det_adj_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the slater matrix for each determinant of each walker. | - | ~det_adj_matrix_list_date~ | ~int64_t~ | Adjoint of the slater matrix for each determinant of each walker. | - |-------------------------+---------------------------------------------+----------------------------------------------------------------------------------------| - | ~det_vgl~ | ~[5][walk_num][det_num]~ | Value, gradients, Laplacian of the MOs at electron positions | - | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | - | ~det_inv_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the slater matrix for each determinant of each walker. | - | ~det_inv_matrix_list_date~ | ~int64_t~ | Inverse of the slater matrix for each determinant of each walker. | - |-------------------------+---------------------------------------------+----------------------------------------------------------------------------------------| + |----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------| + | ~det_value_list~ | ~[walk_num][det_num]~ | The slater matrix for each determinant of each walker. | + | ~det_value_list_date~ | ~int64_t~ | The slater matrix for each determinant of each walker. | + | ~det_adj_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the slater matrix for each determinant of each walker. | + | ~det_adj_matrix_list_date~ | ~int64_t~ | Adjoint of the slater matrix for each determinant of each walker. | + |----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------| + | ~det_vgl~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵢⱼ(x) at electron positions | + | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + | ~det_inv_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the slater matrix for each determinant of each walker. | + | ~det_inv_matrix_list_date~ | ~int64_t~ | Inverse of the slater matrix for each determinant of each walker. | + |----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------| ** Data structure @@ -416,7 +426,7 @@ qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) { *** Get #+NAME: qmckl_get_determinant_det_inv_list - | ~qmckl_context~ | ~context~ | in | Global state | + | ~qmckl_context~ | ~context~ | in | Global state | | ~double~ | ~det_inv_list[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs | #+begin_src c :comments org :tangle (eval h_func) :noweb yes From 5a280e877f1ea9da7a94673c1be0e45d36528a14 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 6 Oct 2021 16:49:21 +0200 Subject: [PATCH 09/68] removed pointer for type variable. #41 --- org/qmckl_determinant.org | 3 +-- org/qmckl_mo.org | 8 ++++---- org/table_of_contents | 17 +++++++++-------- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 91866b5..7415561 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -275,7 +275,7 @@ int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { called. #+begin_src c :comments org :tangle (eval h_func) -qmckl_exit_code qmckl_set_determinant_type (const qmckl_context context, const char *t); +qmckl_exit_code qmckl_set_determinant_type (const qmckl_context context, const char t); qmckl_exit_code qmckl_set_determinant_walk_num (const qmckl_context context, const int64_t walk_num); qmckl_exit_code qmckl_set_determinant_det_num (const qmckl_context context, const int64_t det_num); qmckl_exit_code qmckl_set_determinant_fermi_num (const qmckl_context context, const int64_t fermi_num); @@ -414,7 +414,6 @@ qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) { #+end_src ** Fortran Interfaces - ** Test * Computation ** Determinant matrix diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index f521b4d..8fa209f 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -78,10 +78,10 @@ int main() { The following arrays are stored in the context: - |---------------------+--------------------+--------------------------------------------------------------| - | ~type~ | | Gaussian (~'G'~) or Slater (~'S'~) | - | ~mo_num~ | | Number of MOs | - | ~coefficient~ | ~[mo_num, ao_num]~ | Orbital coefficients | + |---------------+--------------------+------------------------------------| + | ~type~ | | Gaussian (~'G'~) or Slater (~'S'~) | + | ~mo_num~ | | Number of MOs | + | ~coefficient~ | ~[mo_num, ao_num]~ | Orbital coefficients | Computed data: diff --git a/org/table_of_contents b/org/table_of_contents index 4e0600c..55dd6b7 100644 --- a/org/table_of_contents +++ b/org/table_of_contents @@ -1,15 +1,16 @@ qmckl.org -qmckl_error.org +qmckl_ao.org +qmckl_blas.org qmckl_context.org +qmckl_determinant.org +qmckl_distance.org +qmckl_electron.org +qmckl_error.org +qmckl_jastrow.org qmckl_memory.org +qmckl_mo.org qmckl_numprec.org qmckl_nucleus.org -qmckl_electron.org -qmckl_ao.org -qmckl_mo.org -qmckl_jastrow.org qmckl_sherman_morrison_woodbury.org -qmckl_distance.org -qmckl_utils.org -qmckl_blas.org qmckl_tests.org +qmckl_utils.org From cf394ce17109cbb22a778b5cffe89d0d4c71afa4 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 6 Oct 2021 17:29:53 +0200 Subject: [PATCH 10/68] Fixed bug in get_det_vgl, now compiles. #41 --- org/qmckl_determinant.org | 38 ++++++++++++++------------------------ 1 file changed, 14 insertions(+), 24 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 7415561..78411de 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -113,7 +113,7 @@ int main() { | ~det_adj_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the slater matrix for each determinant of each walker. | | ~det_adj_matrix_list_date~ | ~int64_t~ | Adjoint of the slater matrix for each determinant of each walker. | |----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------| - | ~det_vgl~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵢⱼ(x) at electron positions | + | ~det_vgl~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵢⱼ(x) at electron positions | | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | | ~det_inv_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the slater matrix for each determinant of each walker. | | ~det_inv_matrix_list_date~ | ~int64_t~ | Inverse of the slater matrix for each determinant of each walker. | @@ -418,22 +418,22 @@ qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) { * Computation ** Determinant matrix :PROPERTIES: - :Name: qmckl_compute_determinant_det_inv_list + :Name: qmckl_compute_det_vgl :CRetType: qmckl_exit_code :FRetType: qmckl_exit_code :END: *** Get - #+NAME: qmckl_get_determinant_det_inv_list - | ~qmckl_context~ | ~context~ | in | Global state | - | ~double~ | ~det_inv_list[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs | + #+NAME: qmckl_get_det_vgl_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~double~ | ~det_vgl[5][walk_num][det_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the MOs | #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double* const det_inv_list); +qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double* const det_vgl); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double * const det_inv_list) { +qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double * const det_vgl) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -450,27 +450,16 @@ qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double rc = qmckl_provide_det_vgl(context); if (rc != QMCKL_SUCCESS) return rc; - rc = qmckl_provide_det_inv_matrix(context); - if (rc != QMCKL_SUCCESS) return rc; - qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->det.fermi_num; - memcpy(det_inv_list, ctx->det.det_vgl, sze * sizeof(double)); + memcpy(det_vgl, ctx->det.det_vgl, sze * sizeof(double)); return QMCKL_SUCCESS; } #+end_src - #+CALL: generate_c_header(table=qmckl_get_determinant_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_get_determinant_det_vgl")) - - #+RESULTS: - #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_compute_get_determinant_vgl ( - const qmckl_context context, - double* const det_vgl ); - #+end_src *** Provide @@ -574,7 +563,7 @@ qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context) { :FRetType: qmckl_exit_code :END: - #+NAME: qmckl_det_vgl_args + #+NAME: qmckl_compute_det_vgl_args | ~qmckl_context~ | ~context~ | in | Global state | | ~int64_t~ | ~walk_num~ | in | Number of walkers | | ~int64_t~ | ~fermi_num~ | in | Number of electrons | @@ -640,7 +629,7 @@ integer function qmckl_compute_det_vgl_f(context, & end function qmckl_compute_det_vgl_f #+end_src - #+CALL: generate_c_header(table=qmckl_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl")) + #+CALL: generate_c_header(table=qmckl_compute_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl")) #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org @@ -654,7 +643,7 @@ end function qmckl_compute_det_vgl_f double* const det_vgl ); #+end_src - #+CALL: generate_c_interface(table=qmckl_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl")) + #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl")) #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none @@ -679,9 +668,10 @@ end function qmckl_compute_det_vgl_f end function qmckl_compute_det_vgl #+end_src - + + *** Test - + ** Inverse of Determinant matrix :PROPERTIES: :Name: qmckl_compute_det_inv_matrix From 00d85528c560946f4c6f8c9b869c81206c1fb115 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 6 Oct 2021 17:59:44 +0200 Subject: [PATCH 11/68] Added alpha and beta det matrices. #41 --- org/qmckl_blas.org | 4 +- org/qmckl_determinant.org | 698 +++++++++++++++++++++++++++++++------- 2 files changed, 579 insertions(+), 123 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index b7e8d2f..04d9840 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -395,8 +395,8 @@ end function qmckl_invert_f subroutine invert1(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) - integer, intent(in) :: LDA - integer, intent(in) :: na + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na double precision, intent(inout) :: det_l det_l = a(1,1) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 78411de..86ec8b0 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -102,22 +102,32 @@ int main() { | ~type~ | ~char~ | α (~'A'~) or β (~'B'~) determinant | | ~walk_num~ | ~int64_t~ | Number of walkers | | ~det_num~ | ~int64_t~ | Number of determinants per walker | - | ~fermi_num~ | ~int64_t~ | Number of number of fermions | + | ~fermi_num~ | ~int64_t~ | Number of number of fermions | | ~mo_index_list~ | ~mo_index[walk_num][det_num]~ | Index of MOs for each walker | Computed data: - |----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------| - | ~det_value_list~ | ~[walk_num][det_num]~ | The slater matrix for each determinant of each walker. | - | ~det_value_list_date~ | ~int64_t~ | The slater matrix for each determinant of each walker. | - | ~det_adj_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the slater matrix for each determinant of each walker. | - | ~det_adj_matrix_list_date~ | ~int64_t~ | Adjoint of the slater matrix for each determinant of each walker. | - |----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------| - | ~det_vgl~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵢⱼ(x) at electron positions | - | ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | - | ~det_inv_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the slater matrix for each determinant of each walker. | - | ~det_inv_matrix_list_date~ | ~int64_t~ | Inverse of the slater matrix for each determinant of each walker. | - |----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------| + |-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------| + | ~up_num~ | ~int64_t~ | Number of number of α electrons | + | ~donwn_num~ | ~int64_t~ | Number of number of β electrons | + | ~det_value_alpha~ | ~[walk_num][det_num]~ | The α slater matrix for each determinant of each walker. | + | ~det_value_alpha_date~ | ~int64_t~ | Date of The α slater matrix for each determinant of each walker. | + | ~det_value_beta~ | ~[walk_num][det_num]~ | The β slater matrix for each determinant of each walker. | + | ~det_value_beta_date~ | ~int64_t~ | Date of The β slater matrix for each determinant of each walker. | + | ~det_adj_matrix_alpha~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the α slater matrix for each determinant of each walker. | + | ~det_adj_matrix_alpha_date~ | ~int64_t~ | Date of the Adjoint of the α slater matrix for each determinant of each walker. | + | ~det_adj_matrix_beta~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the β slater matrix for each determinant of each walker. | + | ~det_adj_matrix_beta_date~ | ~int64_t~ | Date of the Adjoint of the β slater matrix for each determinant of each walker. | + |-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------| + | ~det_vgl_alpha~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵅᵢⱼ(x) at electron positions | + | ~det_vgl_alpha_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + | ~det_vgl_beta~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵝᵢⱼ(x) at electron positions | + | ~det_vgl_beta_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + | ~det_inv_matrix_alpha~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the α electron slater matrix for each determinant of each walker. | + | ~det_inv_matrix_alpha_date~ | ~int64_t~ | Date for the Inverse of the α electron slater matrix for each determinant of each walker. | + | ~det_inv_matrix_beta~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the β electron slater matrix for each determinant of each walker. | + | ~det_inv_matrix_beta_date~ | ~int64_t~ | Date for the Inverse of the β electron slater matrix for each determinant of each walker. | + |-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------| ** Data structure @@ -126,17 +136,27 @@ typedef struct qmckl_determinant_struct { char type; int64_t walk_num; int64_t det_num; + int64_t up_num; + int64_t down_num; int64_t fermi_num; int64_t* mo_index_list; - double * det_matrix_list; - double * det_adj_matrix_list; - double * det_inv_matrix_list; - double * det_vgl; - int64_t det_matrix_list_date; - int64_t det_adj_matrix_list_date; - int64_t det_inv_matrix_list_date; - int64_t det_vgl_date; + double * det_value_alpha; + double * det_value_beta; + double * det_vgl_alpha; + double * det_adj_matrix_alpha; + double * det_inv_matrix_alpha; + double * det_vgl_beta; + double * det_adj_matrix_beta; + double * det_inv_matrix_beta; + int64_t det_value_alpha_date; + int64_t det_vgl_alpha_date; + int64_t det_adj_matrix_alpha_date; + int64_t det_inv_matrix_alpha_date; + int64_t det_value_beta_date; + int64_t det_vgl_beta_date; + int64_t det_adj_matrix_beta_date; + int64_t det_inv_matrix_beta_date; int32_t uninitialized; bool provided; @@ -424,16 +444,14 @@ qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) { :END: *** Get - #+NAME: qmckl_get_det_vgl_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~double~ | ~det_vgl[5][walk_num][det_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the MOs | #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double* const det_vgl); +qmckl_exit_code qmckl_get_det_vgl_alpha(qmckl_context context, double* const det_vgl_alpha); +qmckl_exit_code qmckl_get_det_vgl_beta(qmckl_context context, double* const det_vgl_beta); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double * const det_vgl) { +qmckl_exit_code qmckl_get_det_vgl_alpha(qmckl_context context, double * const det_vgl_alpha) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -447,14 +465,40 @@ qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double * const det_vgl) rc = qmckl_provide_mo_vgl(context); if (rc != QMCKL_SUCCESS) return rc; - rc = qmckl_provide_det_vgl(context); + rc = qmckl_provide_det_vgl_alpha(context); if (rc != QMCKL_SUCCESS) return rc; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->det.fermi_num; - memcpy(det_vgl, ctx->det.det_vgl, sze * sizeof(double)); + size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; + memcpy(det_vgl_alpha, ctx->det.det_vgl_alpha, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_det_vgl_beta(qmckl_context context, double * const det_vgl_beta) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_vgl_beta(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; + memcpy(det_vgl_beta, ctx->det.det_vgl_beta, sze * sizeof(double)); return QMCKL_SUCCESS; } @@ -464,11 +508,12 @@ qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double * const det_vgl) *** Provide #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context); +qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context); +qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context) { +qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -513,68 +558,156 @@ qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context) { } /* Compute if necessary */ - if (ctx->electron.coord_new_date > ctx->det.det_vgl_date) { + if (ctx->electron.coord_new_date > ctx->det.det_vgl_alpha_date) { /* Allocate array */ - if (ctx->det.det_vgl == NULL) { + if (ctx->det.det_vgl_alpha == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num * sizeof(double); - double* det_vgl = (double*) qmckl_malloc(context, mem_info); + double* det_vgl_alpha = (double*) qmckl_malloc(context, mem_info); - if (det_vgl == NULL) { + if (det_vgl_alpha == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, - "qmckl_det_vgl", + "qmckl_det_vgl_alpha", NULL); } - ctx->det.det_vgl = det_vgl; + ctx->det.det_vgl_alpha = det_vgl_alpha; } qmckl_exit_code rc; if (ctx->det.type == 'G') { - rc = qmckl_compute_det_vgl(context, + rc = qmckl_compute_det_vgl_alpha(context, ctx->det.walk_num, ctx->det.fermi_num, ctx->det.mo_index_list, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, - ctx->det.det_vgl); + ctx->det.det_vgl_alpha); } else { return qmckl_failwith( context, QMCKL_FAILURE, - "compute_det_vgl", + "compute_det_vgl_alpha", "Not yet implemented"); } if (rc != QMCKL_SUCCESS) { return rc; } - ctx->det.det_vgl_date = ctx->date; + ctx->det.det_vgl_alpha_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if(!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if (!ctx->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + + if (!ctx->mo_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + if (!ctx->det.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->det.det_vgl_beta_date) { + + /* Allocate array */ + if (ctx->det.det_vgl_beta == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num * sizeof(double); + double* det_vgl_beta = (double*) qmckl_malloc(context, mem_info); + + if (det_vgl_beta == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_det_vgl_beta", + NULL); + } + ctx->det.det_vgl_beta = det_vgl_beta; + } + + qmckl_exit_code rc; + if (ctx->det.type == 'G') { + rc = qmckl_compute_det_vgl_beta(context, + ctx->det.walk_num, + ctx->det.fermi_num, + ctx->det.mo_index_list, + ctx->mo_basis.mo_num, + ctx->mo_basis.mo_vgl, + ctx->det.det_vgl_beta); + } else { + return qmckl_failwith( context, + QMCKL_FAILURE, + "compute_det_vgl_beta", + "Not yet implemented"); + } + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->det.det_vgl_beta_date = ctx->date; } return QMCKL_SUCCESS; } #+end_src -*** Compute +*** Compute alpha :PROPERTIES: - :Name: qmckl_compute_det_vgl + :Name: qmckl_compute_det_vgl_alpha :CRetType: qmckl_exit_code :FRetType: qmckl_exit_code :END: - #+NAME: qmckl_compute_det_vgl_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~fermi_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_vgl[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + #+NAME: qmckl_compute_det_vgl_alpha_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~fermi_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_alpha[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_det_vgl_f(context, & - walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl) & +integer function qmckl_compute_det_vgl_alpha_f(context, & + walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) & result(info) use qmckl implicit none @@ -584,7 +717,7 @@ integer function qmckl_compute_det_vgl_f(context, & integer*8, intent(in) :: mo_num integer*8, intent(in) :: mo_index_list(fermi_num) double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) - double precision, intent(inout) :: det_vgl(fermi_num, fermi_num, walk_num, 5) + double precision, intent(inout) :: det_vgl_alpha(fermi_num, fermi_num, walk_num, 5) integer*8 :: iwalk, ielec, mo_id, imo info = QMCKL_SUCCESS @@ -609,46 +742,46 @@ integer function qmckl_compute_det_vgl_f(context, & do imo = 1, fermi_num mo_id = mo_index_list(imo) ! Value - det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) ! Grad_x - det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2) + det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2) ! Grad_y - det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3) + det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3) ! Grad_z - det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4) + det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4) ! Lap - det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5) + det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5) end do end do end do -end function qmckl_compute_det_vgl_f +end function qmckl_compute_det_vgl_alpha_f #+end_src - #+CALL: generate_c_header(table=qmckl_compute_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl")) + #+CALL: generate_c_header(table=qmckl_compute_det_vgl_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_alpha")) #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_compute_det_vgl ( + qmckl_exit_code qmckl_compute_det_vgl_alpha ( const qmckl_context context, const int64_t walk_num, const int64_t fermi_num, const int64_t* mo_index_list, const int64_t mo_num, const double* mo_vgl, - double* const det_vgl ); + double* const det_vgl_alpha ); #+end_src - #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl")) + #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_alpha")) #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_det_vgl & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl) & + integer(c_int32_t) function qmckl_compute_det_vgl_alpha & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -660,13 +793,126 @@ end function qmckl_compute_det_vgl_f integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) integer (c_int64_t) , intent(in) , value :: mo_num real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) - real (c_double ) , intent(out) :: det_vgl(fermi_num,fermi_num,walk_num,5) + real (c_double ) , intent(out) :: det_vgl_alpha(fermi_num,fermi_num,walk_num,5) - integer(c_int32_t), external :: qmckl_compute_det_vgl_f - info = qmckl_compute_det_vgl_f & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl) + integer(c_int32_t), external :: qmckl_compute_det_vgl_alpha_f + info = qmckl_compute_det_vgl_alpha_f & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) - end function qmckl_compute_det_vgl + end function qmckl_compute_det_vgl_alpha + #+end_src + +*** Compute beta + :PROPERTIES: + :Name: qmckl_compute_det_vgl_beta + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_compute_det_vgl_beta_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~fermi_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_beta[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_det_vgl_beta_f(context, & + walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: walk_num + integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: mo_num + integer*8, intent(in) :: mo_index_list(fermi_num) + double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) + double precision, intent(inout) :: det_vgl_beta(fermi_num, fermi_num, walk_num, 5) + integer*8 :: iwalk, ielec, mo_id, imo + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (fermi_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + do iwalk = 1, walk_num + do ielec = 1, fermi_num + do imo = 1, fermi_num + mo_id = mo_index_list(imo) + ! Value + det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + + ! Grad_x + det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2) + + ! Grad_y + det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3) + + ! Grad_z + det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4) + + ! Lap + det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5) + end do + end do + end do + +end function qmckl_compute_det_vgl_beta_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_det_vgl_beta ( + const qmckl_context context, + const int64_t walk_num, + const int64_t fermi_num, + const int64_t* mo_index_list, + const int64_t mo_num, + const double* mo_vgl, + double* const det_vgl_beta ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_det_vgl_beta & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta) & + 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 :: walk_num + integer (c_int64_t) , intent(in) , value :: fermi_num + integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) + integer (c_int64_t) , intent(in) , value :: mo_num + real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) + real (c_double ) , intent(out) :: det_vgl_beta(fermi_num,fermi_num,walk_num,5) + + integer(c_int32_t), external :: qmckl_compute_det_vgl_beta_f + info = qmckl_compute_det_vgl_beta_f & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta) + + end function qmckl_compute_det_vgl_beta #+end_src @@ -680,16 +926,14 @@ end function qmckl_compute_det_vgl_f :END: *** Get - #+NAME: qmckl_get_det_inv_matrix_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~double~ | ~det_inv_matrix_list[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs | #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double* const det_inv_matrix); +qmckl_exit_code qmckl_get_det_inv_matrix_alpha(qmckl_context context, double* const det_inv_matrix_alpha); +qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double* const det_inv_matrix_beta); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double * const det_inv_matrix) { +qmckl_exit_code qmckl_get_det_inv_matrix_alpha(qmckl_context context, double * const det_inv_matrix_alpha) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -703,39 +947,61 @@ qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double * const d rc = qmckl_provide_mo_vgl(context); if (rc != QMCKL_SUCCESS) return rc; - rc = qmckl_provide_det_vgl(context); + rc = qmckl_provide_det_vgl_alpha(context); if (rc != QMCKL_SUCCESS) return rc; - rc = qmckl_provide_det_inv_matrix(context); + rc = qmckl_provide_det_inv_matrix_alpha(context); if (rc != QMCKL_SUCCESS) return rc; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->det.fermi_num; - memcpy(det_inv_matrix, ctx->det.det_inv_matrix_list, sze * sizeof(double)); + size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; + memcpy(det_inv_matrix_alpha, ctx->det.det_inv_matrix_alpha, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double * const det_inv_matrix_beta) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_vgl_alpha(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_inv_matrix_beta(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; + memcpy(det_inv_matrix_beta, ctx->det.det_inv_matrix_beta, sze * sizeof(double)); return QMCKL_SUCCESS; } #+end_src - #+CALL: generate_c_header(table=qmckl_get_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_get_det_inv_matrix")) - - #+RESULTS: - #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_compute_get_det_inv_matrix ( - const qmckl_context context, - double* const det_inv_matrix_list ); - #+end_src *** Provide #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context); +qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context); +qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context) { +qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; @@ -780,69 +1046,158 @@ qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context) { } /* Compute if necessary */ - if (ctx->electron.coord_new_date > ctx->det.det_inv_matrix_list_date) { + if (ctx->electron.coord_new_date > ctx->det.det_inv_matrix_alpha_date) { /* Allocate array */ - if (ctx->det.det_inv_matrix_list == NULL) { + if (ctx->det.det_inv_matrix_alpha == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = ctx->det.walk_num * ctx->det.det_num * - ctx->det.fermi_num * ctx->det.fermi_num * sizeof(double); - double* det_inv_matrix_list = (double*) qmckl_malloc(context, mem_info); + ctx->electron.up_num * ctx->electron.up_num * sizeof(double); + double* det_inv_matrix_alpha = (double*) qmckl_malloc(context, mem_info); - if (det_inv_matrix_list == NULL) { + if (det_inv_matrix_alpha == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, - "qmckl_det_inv_matrix_list", + "qmckl_det_inv_matrix_alpha", NULL); } - ctx->det.det_inv_matrix_list = det_inv_matrix_list; + ctx->det.det_inv_matrix_alpha = det_inv_matrix_alpha; } qmckl_exit_code rc; if (ctx->det.type == 'G') { - rc = qmckl_compute_det_inv_matrix(context, + rc = qmckl_compute_det_inv_matrix_alpha(context, ctx->det.walk_num, - ctx->det.fermi_num, + ctx->electron.up_num, ctx->det.mo_index_list, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, - ctx->det.det_inv_matrix_list); + ctx->det.det_inv_matrix_alpha); } else { return qmckl_failwith( context, QMCKL_FAILURE, - "compute_det_inv_matrix_list", + "compute_det_inv_matrix_alpha", "Not yet implemented"); } if (rc != QMCKL_SUCCESS) { return rc; } - ctx->det.det_inv_matrix_list_date = ctx->date; + ctx->det.det_inv_matrix_alpha_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if(!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if (!ctx->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + + if (!ctx->mo_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + if (!ctx->det.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->det.det_inv_matrix_beta_date) { + + /* Allocate array */ + if (ctx->det.det_inv_matrix_beta == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->det.walk_num * ctx->det.det_num * + ctx->electron.down_num * ctx->electron.down_num * sizeof(double); + double* det_inv_matrix_beta = (double*) qmckl_malloc(context, mem_info); + + if (det_inv_matrix_beta == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_det_inv_matrix_beta", + NULL); + } + ctx->det.det_inv_matrix_beta = det_inv_matrix_beta; + } + + qmckl_exit_code rc; + if (ctx->det.type == 'G') { + rc = qmckl_compute_det_inv_matrix_beta(context, + ctx->det.walk_num, + ctx->electron.down_num, + ctx->det.mo_index_list, + ctx->mo_basis.mo_num, + ctx->mo_basis.mo_vgl, + ctx->det.det_inv_matrix_beta); + } else { + return qmckl_failwith( context, + QMCKL_FAILURE, + "compute_det_inv_matrix_beta", + "Not yet implemented"); + } + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->det.det_inv_matrix_beta_date = ctx->date; } return QMCKL_SUCCESS; } #+end_src -*** Compute +*** Compute alpha :PROPERTIES: - :Name: qmckl_compute_det_inv_matrix + :Name: qmckl_compute_det_inv_matrix_alpha :CRetType: qmckl_exit_code :FRetType: qmckl_exit_code :END: - #+NAME: qmckl_det_inv_matrix_args + #+NAME: qmckl_det_inv_matrix_alpha_args | ~qmckl_context~ | ~context~ | in | Global state | | ~int64_t~ | ~walk_num~ | in | Number of walkers | | ~int64_t~ | ~fermi_num~ | in | Number of electrons | | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_inv_matrix_list[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_inv_matrix_alpha[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_det_inv_matrix_f(context, & - walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list) & +integer function qmckl_compute_det_inv_matrix_alpha_f(context, & + walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha) & result(info) use qmckl implicit none @@ -852,7 +1207,7 @@ integer function qmckl_compute_det_inv_matrix_f(context, & integer*8, intent(in) :: mo_num integer*8, intent(in) :: mo_index_list(fermi_num) double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) - double precision, intent(inout) :: det_inv_matrix_list(fermi_num, fermi_num, walk_num, 5) + double precision, intent(inout) :: det_inv_matrix_alpha(fermi_num, fermi_num, walk_num, 5) integer*8 :: iwalk, ielec, mo_id, imo info = QMCKL_SUCCESS @@ -877,34 +1232,34 @@ integer function qmckl_compute_det_inv_matrix_f(context, & do imo = 1, fermi_num mo_id = mo_index_list(imo) ! Value - det_inv_matrix_list(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + det_inv_matrix_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) end do end do end do -end function qmckl_compute_det_inv_matrix_f +end function qmckl_compute_det_inv_matrix_alpha_f #+end_src - #+CALL: generate_c_header(table=qmckl_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix")) + #+CALL: generate_c_header(table=qmckl_det_inv_matrix_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix_alpha")) #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_compute_det_inv_matrix ( + qmckl_exit_code qmckl_compute_det_inv_matrix_alpha ( const qmckl_context context, const int64_t walk_num, const int64_t fermi_num, const int64_t* mo_index_list, const int64_t mo_num, const double* mo_vgl, - double* const det_inv_matrix_list ); + double* const det_inv_matrix_alpha ); #+end_src - #+CALL: generate_c_interface(table=qmckl_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix")) + #+CALL: generate_c_interface(table=qmckl_det_inv_matrix_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix_alpha")) #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_det_inv_matrix & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list) & + integer(c_int32_t) function qmckl_compute_det_inv_matrix_alpha & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -916,13 +1271,114 @@ end function qmckl_compute_det_inv_matrix_f integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) integer (c_int64_t) , intent(in) , value :: mo_num real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) - real (c_double ) , intent(out) :: det_inv_matrix_list(fermi_num,fermi_num,walk_num,5) + real (c_double ) , intent(out) :: det_inv_matrix_alpha(fermi_num,fermi_num,walk_num,5) - integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_f - info = qmckl_compute_det_inv_matrix_f & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list) + integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_alpha_f + info = qmckl_compute_det_inv_matrix_alpha_f & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha) - end function qmckl_compute_det_inv_matrix + end function qmckl_compute_det_inv_matrix_alpha + #+end_src + +*** Compute beta + :PROPERTIES: + :Name: qmckl_compute_det_inv_matrix_beta + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_det_inv_matrix_beta_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~fermi_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_inv_matrix_beta[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_det_inv_matrix_beta_f(context, & + walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: walk_num + integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: mo_num + integer*8, intent(in) :: mo_index_list(fermi_num) + double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) + double precision, intent(inout) :: det_inv_matrix_beta(fermi_num, fermi_num, walk_num, 5) + integer*8 :: iwalk, ielec, mo_id, imo + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (fermi_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + do iwalk = 1, walk_num + do ielec = 1, fermi_num + do imo = 1, fermi_num + mo_id = mo_index_list(imo) + ! Value + det_inv_matrix_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + end do + end do + end do + +end function qmckl_compute_det_inv_matrix_beta_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_det_inv_matrix_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix_beta")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_det_inv_matrix_beta ( + const qmckl_context context, + const int64_t walk_num, + const int64_t fermi_num, + const int64_t* mo_index_list, + const int64_t mo_num, + const double* mo_vgl, + double* const det_inv_matrix_beta ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_det_inv_matrix_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix_beta")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_det_inv_matrix_beta & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta) & + 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 :: walk_num + integer (c_int64_t) , intent(in) , value :: fermi_num + integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) + integer (c_int64_t) , intent(in) , value :: mo_num + real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) + real (c_double ) , intent(out) :: det_inv_matrix_beta(fermi_num,fermi_num,walk_num,5) + + integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_beta_f + info = qmckl_compute_det_inv_matrix_beta_f & + (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta) + + end function qmckl_compute_det_inv_matrix_beta #+end_src *** Test From 13c9c9f358dde75143386108e28e52f4d2db4b93 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 7 Oct 2021 00:26:35 +0200 Subject: [PATCH 12/68] Added fortran interface for qmckl_invert. #41 --- org/qmckl_blas.org | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index 04d9840..293af48 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -718,6 +718,28 @@ end end function qmckl_invert #+end_src + #+CALL: generate_f_interface(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") + + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_invert & + (context, m, n, lda, A, det_l) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: m + integer (c_int64_t) , intent(in) , value :: n + integer (c_int64_t) , intent(in) , value :: lda + real (c_double ) , intent(inout) :: A(lda,*) + real (c_double ) , intent(inout) :: det_l + + end function qmckl_invert + end interface + #+end_src *** Test :noexport: From 2735b31c12f779bdefdb9b067c41b51977817ec9 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 7 Oct 2021 00:27:01 +0200 Subject: [PATCH 13/68] Added alpha and beta matrices for all quantities. #41 --- org/qmckl_determinant.org | 533 ++++++++++++++++++++++++-------------- 1 file changed, 334 insertions(+), 199 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 86ec8b0..89a2692 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -92,42 +92,45 @@ int main() { #include "qmckl_mo_private_func.h" #include "qmckl_determinant_private_type.h" #include "qmckl_determinant_private_func.h" +#include "qmckl_blas_func.h" #+end_src * Context The following arrays are stored in the context: - |-----------------+-------------------------------+------------------------------------| - | ~type~ | ~char~ | α (~'A'~) or β (~'B'~) determinant | - | ~walk_num~ | ~int64_t~ | Number of walkers | - | ~det_num~ | ~int64_t~ | Number of determinants per walker | - | ~fermi_num~ | ~int64_t~ | Number of number of fermions | - | ~mo_index_list~ | ~mo_index[walk_num][det_num]~ | Index of MOs for each walker | + |------------------+------------------------------------------------+------------------------------------| + | ~type~ | ~char~ | α (~'A'~) or β (~'B'~) determinant | + | ~walk_num~ | ~int64_t~ | Number of walkers | + | ~det_num_alpha~ | ~int64_t~ | Number of determinants per walker | + | ~det_num_beta~ | ~int64_t~ | Number of determinants per walker | + | ~fermi_num~ | ~int64_t~ | Number of number of fermions | + | ~mo_index_alpha~ | ~mo_index[det_num_alpha][walk_num][alpha_num]~ | Index of MOs for each walker | + | ~mo_index_beta~ | ~mo_index[det_num_beta][walk_num][beta_num]~ | Index of MOs for each walker | Computed data: - |-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------| - | ~up_num~ | ~int64_t~ | Number of number of α electrons | - | ~donwn_num~ | ~int64_t~ | Number of number of β electrons | - | ~det_value_alpha~ | ~[walk_num][det_num]~ | The α slater matrix for each determinant of each walker. | - | ~det_value_alpha_date~ | ~int64_t~ | Date of The α slater matrix for each determinant of each walker. | - | ~det_value_beta~ | ~[walk_num][det_num]~ | The β slater matrix for each determinant of each walker. | - | ~det_value_beta_date~ | ~int64_t~ | Date of The β slater matrix for each determinant of each walker. | - | ~det_adj_matrix_alpha~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the α slater matrix for each determinant of each walker. | - | ~det_adj_matrix_alpha_date~ | ~int64_t~ | Date of the Adjoint of the α slater matrix for each determinant of each walker. | - | ~det_adj_matrix_beta~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the β slater matrix for each determinant of each walker. | - | ~det_adj_matrix_beta_date~ | ~int64_t~ | Date of the Adjoint of the β slater matrix for each determinant of each walker. | - |-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------| - | ~det_vgl_alpha~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵅᵢⱼ(x) at electron positions | - | ~det_vgl_alpha_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | - | ~det_vgl_beta~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵝᵢⱼ(x) at electron positions | - | ~det_vgl_beta_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | - | ~det_inv_matrix_alpha~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the α electron slater matrix for each determinant of each walker. | - | ~det_inv_matrix_alpha_date~ | ~int64_t~ | Date for the Inverse of the α electron slater matrix for each determinant of each walker. | - | ~det_inv_matrix_beta~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the β electron slater matrix for each determinant of each walker. | - | ~det_inv_matrix_beta_date~ | ~int64_t~ | Date for the Inverse of the β electron slater matrix for each determinant of each walker. | - |-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------| + |-----------------------------+------------------------------------------------------+-------------------------------------------------------------------------------------------| + | ~up_num~ | ~int64_t~ | Number of number of α electrons | + | ~donwn_num~ | ~int64_t~ | Number of number of β electrons | + | ~det_value_alpha~ | ~[det_num_alpha][walk_num]~ | The α slater matrix for each determinant of each walker. | + | ~det_value_alpha_date~ | ~int64_t~ | Date of The α slater matrix for each determinant of each walker. | + | ~det_value_beta~ | ~[det_num_beta][walk_num]~ | The β slater matrix for each determinant of each walker. | + | ~det_value_beta_date~ | ~int64_t~ | Date of The β slater matrix for each determinant of each walker. | + | ~det_adj_matrix_alpha~ | ~[det_num_alpha][walk_num][alpha_num][alpha_num]~ | Adjoint of the α slater matrix for each determinant of each walker. | + | ~det_adj_matrix_alpha_date~ | ~int64_t~ | Date of the Adjoint of the α slater matrix for each determinant of each walker. | + | ~det_adj_matrix_beta~ | ~[det_num_beta][walk_num][beta_num][beta_num]~ | Adjoint of the β slater matrix for each determinant of each walker. | + | ~det_adj_matrix_beta_date~ | ~int64_t~ | Date of the Adjoint of the β slater matrix for each determinant of each walker. | + |-----------------------------+------------------------------------------------------+-------------------------------------------------------------------------------------------| + | ~det_vgl_alpha~ | ~[5][det_num_alpha][walk_num][alpha_num][alpha_num]~ | Value, gradients, Laplacian of Dᵅᵢⱼ(x) at electron positions | + | ~det_vgl_alpha_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + | ~det_vgl_beta~ | ~[5][det_num_beta][walk_num][beta_num][beta_num]~ | Value, gradients, Laplacian of Dᵝᵢⱼ(x) at electron positions | + | ~det_vgl_beta_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + | ~det_inv_matrix_alpha~ | ~[det_num_alpha][walk_num][alpha_num][alpha_num]~ | Inverse of the α electron slater matrix for each determinant of each walker. | + | ~det_inv_matrix_alpha_date~ | ~int64_t~ | Date for the Inverse of the α electron slater matrix for each determinant of each walker. | + | ~det_inv_matrix_beta~ | ~[det_num_beta][walk_num][beta_num][beta_num]~ | Inverse of the β electron slater matrix for each determinant of each walker. | + | ~det_inv_matrix_beta_date~ | ~int64_t~ | Date for the Inverse of the β electron slater matrix for each determinant of each walker. | + |-----------------------------+------------------------------------------------------+-------------------------------------------------------------------------------------------| ** Data structure @@ -135,11 +138,13 @@ int main() { typedef struct qmckl_determinant_struct { char type; int64_t walk_num; - int64_t det_num; + int64_t det_num_alpha; + int64_t det_num_beta ; int64_t up_num; int64_t down_num; int64_t fermi_num; - int64_t* mo_index_list; + int64_t* mo_index_alpha; + int64_t* mo_index_beta; double * det_value_alpha; double * det_value_beta; @@ -174,10 +179,12 @@ typedef struct qmckl_determinant_struct { #+begin_src c :comments org :tangle (eval h_private_func) :exports none char qmckl_get_determinant_type (const qmckl_context context); -int64_t qmckl_get_determinant_walk_num (const qmckl_context context); -int64_t qmckl_get_determinant_det_num (const qmckl_context context); -int64_t qmckl_get_determinant_fermi_num (const qmckl_context context); -int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context); +int64_t qmckl_get_determinant_walk_num (const qmckl_context context); +int64_t qmckl_get_determinant_det_num_alpha (const qmckl_context context); +int64_t qmckl_get_determinant_det_num_beta (const qmckl_context context); +int64_t qmckl_get_determinant_fermi_num (const qmckl_context context); +int64_t* qmckl_get_determinant_mo_index_alpha (const qmckl_context context); +int64_t* qmckl_get_determinant_mo_index_beta (const qmckl_context context); #+end_src When all the data for the slater determinants have been provided, the following @@ -233,7 +240,7 @@ int64_t qmckl_get_determinant_walk_num (const qmckl_context context) { return ctx->det.walk_num; } -int64_t qmckl_get_determinant_det_num (const qmckl_context context) { +int64_t qmckl_get_determinant_det_num_alpha (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; } @@ -247,11 +254,11 @@ int64_t qmckl_get_determinant_det_num (const qmckl_context context) { return (int64_t) 0; } - assert (ctx->det.det_num > (int64_t) 0); - return ctx->det.det_num; + assert (ctx->det.det_num_alpha > (int64_t) 0); + return ctx->det.det_num_alpha; } -int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { +int64_t qmckl_get_determinant_det_num_beta (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; } @@ -265,11 +272,11 @@ int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { return (int64_t) 0; } - assert (ctx->det.fermi_num > (int64_t) 0); - return ctx->det.fermi_num; + assert (ctx->det.det_num_beta > (int64_t) 0); + return ctx->det.det_num_beta; } -int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { +int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; } @@ -283,8 +290,44 @@ int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { return (int64_t) 0; } - assert (ctx->det.mo_index_list != NULL); - return ctx->det.mo_index_list; + assert (ctx->det.fermi_num > (int64_t) 0); + return ctx->det.fermi_num; +} + +int64_t* qmckl_get_determinant_mo_index_alpha (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 5; + + if ( (ctx->det.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->det.mo_index_alpha != NULL); + return ctx->det.mo_index_alpha; +} + +int64_t* qmckl_get_determinant_mo_index_beta (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 6; + + if ( (ctx->det.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->det.mo_index_beta != NULL); + return ctx->det.mo_index_beta; } #+end_src @@ -297,9 +340,11 @@ int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { #+begin_src c :comments org :tangle (eval h_func) qmckl_exit_code qmckl_set_determinant_type (const qmckl_context context, const char t); qmckl_exit_code qmckl_set_determinant_walk_num (const qmckl_context context, const int64_t walk_num); -qmckl_exit_code qmckl_set_determinant_det_num (const qmckl_context context, const int64_t det_num); +qmckl_exit_code qmckl_set_determinant_det_num_alpha (const qmckl_context context, const int64_t det_num_alpha); +qmckl_exit_code qmckl_set_determinant_det_num_beta (const qmckl_context context, const int64_t det_num_beta); qmckl_exit_code qmckl_set_determinant_fermi_num (const qmckl_context context, const int64_t fermi_num); -qmckl_exit_code qmckl_set_determinant_mo_index_list (const qmckl_context context, const int64_t* mo_index_list); +qmckl_exit_code qmckl_set_determinant_mo_index_alpha (const qmckl_context context, const int64_t* mo_index_alpha); +qmckl_exit_code qmckl_set_determinant_mo_index_beta (const qmckl_context context, const int64_t* mo_index_beta); #+end_src #+NAME:pre2 @@ -356,18 +401,34 @@ qmckl_exit_code qmckl_set_determinant_walk_num(qmckl_context context, const int6 <> } -qmckl_exit_code qmckl_set_determinant_det_num(qmckl_context context, const int64_t det_num) { +qmckl_exit_code qmckl_set_determinant_det_num_alpha(qmckl_context context, const int64_t det_num_alpha) { <> - if (det_num <= 0) { + if (det_num_alpha <= 0) { return qmckl_failwith( context, QMCKL_INVALID_ARG_2, - "qmckl_set_determinant_det_num", - "det_num <= 0"); + "qmckl_set_determinant_det_num_alpha", + "det_num_alpha <= 0"); } int32_t mask = 1 << 2; - ctx->det.det_num = det_num; + ctx->det.det_num_alpha = det_num_alpha; + + <> +} + +qmckl_exit_code qmckl_set_determinant_det_num_beta(qmckl_context context, const int64_t det_num_beta) { + <> + + if (det_num_beta <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_determinant_det_num_beta", + "det_num_beta <= 0"); + } + + int32_t mask = 1 << 3; + ctx->det.det_num_beta = det_num_beta; <> } @@ -382,39 +443,70 @@ qmckl_exit_code qmckl_set_determinant_fermi_num(qmckl_context context, const int "fermi_num <= 0"); } - int32_t mask = 1 << 3; + int32_t mask = 1 << 4; ctx->det.fermi_num = fermi_num; <> } -qmckl_exit_code qmckl_set_determinant_mo_index_list(qmckl_context context, const int64_t* mo_index_list) { +qmckl_exit_code qmckl_set_determinant_mo_index_alpha(qmckl_context context, const int64_t* mo_index_alpha) { <> - int32_t mask = 1 << 4; + int32_t mask = 1 << 5; - if (ctx->det.mo_index_list != NULL) { - qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_list); + if (ctx->det.mo_index_alpha != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_alpha); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, rc, - "qmckl_set_determinant_mo_index_list", + "qmckl_set_determinant_mo_index_alpha", NULL); } } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->det.walk_num * ctx->det.det_num * sizeof(int64_t); + mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * sizeof(int64_t); int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info); if (new_array == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, - "qmckl_set_determinant_mo_index_list", + "qmckl_set_determinant_mo_index_alpha", NULL); } - memcpy(new_array, mo_index_list, mem_info.size); + memcpy(new_array, mo_index_alpha, mem_info.size); - ctx->det.mo_index_list = new_array; + ctx->det.mo_index_alpha = new_array; + + <> +} + +qmckl_exit_code qmckl_set_determinant_mo_index_beta(qmckl_context context, const int64_t* mo_index_beta) { + <> + + int32_t mask = 1 << 6; + + if (ctx->det.mo_index_beta != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_beta); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_determinant_mo_index_beta", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * sizeof(int64_t); + int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info); + if (new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_determinant_mo_index_beta", + NULL); + } + + memcpy(new_array, mo_index_beta, mem_info.size); + + ctx->det.mo_index_beta = new_array; <> } @@ -471,7 +563,7 @@ qmckl_exit_code qmckl_get_det_vgl_alpha(qmckl_context context, double * const de qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; + size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; memcpy(det_vgl_alpha, ctx->det.det_vgl_alpha, sze * sizeof(double)); return QMCKL_SUCCESS; @@ -497,7 +589,7 @@ qmckl_exit_code qmckl_get_det_vgl_beta(qmckl_context context, double * const det qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; + size_t sze = ctx->det.det_num_beta * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; memcpy(det_vgl_beta, ctx->det.det_vgl_beta, sze * sizeof(double)); return QMCKL_SUCCESS; @@ -564,7 +656,7 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { if (ctx->det.det_vgl_alpha == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num * sizeof(double); + mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num_alpha * sizeof(double); double* det_vgl_alpha = (double*) qmckl_malloc(context, mem_info); if (det_vgl_alpha == NULL) { @@ -579,9 +671,10 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_vgl_alpha(context, + ctx->det.det_num_alpha, ctx->det.walk_num, - ctx->det.fermi_num, - ctx->det.mo_index_list, + ctx->electron.up_num, + ctx->det.mo_index_alpha, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, ctx->det.det_vgl_alpha); @@ -652,7 +745,7 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { if (ctx->det.det_vgl_beta == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num * sizeof(double); + mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num_beta * sizeof(double); double* det_vgl_beta = (double*) qmckl_malloc(context, mem_info); if (det_vgl_beta == NULL) { @@ -667,9 +760,10 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_vgl_beta(context, + ctx->det.det_num_beta, ctx->det.walk_num, - ctx->det.fermi_num, - ctx->det.mo_index_list, + ctx->electron.down_num, + ctx->det.mo_index_beta, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, ctx->det.det_vgl_beta); @@ -697,28 +791,30 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { :END: #+NAME: qmckl_compute_det_vgl_alpha_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~fermi_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_vgl_alpha[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_alpha_alpha~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_alpha[det_num_alpha_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][alpha_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_alpha[det_num_alpha_alpha][walk_num][5][alpha_num][alpha_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_vgl_alpha_f(context, & - walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) & + det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: det_num_alpha integer*8, intent(in) :: walk_num - integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: alpha_num integer*8, intent(in) :: mo_num - integer*8, intent(in) :: mo_index_list(fermi_num) - double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) - double precision, intent(inout) :: det_vgl_alpha(fermi_num, fermi_num, walk_num, 5) - integer*8 :: iwalk, ielec, mo_id, imo + integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) + double precision, intent(in) :: mo_vgl(mo_num, alpha_num, walk_num, 5) + double precision, intent(inout) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) + integer*8 :: idet, iwalk, ielec, mo_id, imo info = QMCKL_SUCCESS @@ -732,32 +828,34 @@ integer function qmckl_compute_det_vgl_alpha_f(context, & return endif - if (fermi_num <= 0) then + if (alpha_num <= 0) then info = QMCKL_INVALID_ARG_3 return endif + do idet = 1, det_num_alpha do iwalk = 1, walk_num - do ielec = 1, fermi_num - do imo = 1, fermi_num - mo_id = mo_index_list(imo) + do ielec = 1, alpha_num + do imo = 1, alpha_num + mo_id = mo_index_alpha(imo,iwalk,idet) ! Value - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + det_vgl_alpha(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 1) ! Grad_x - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2) + det_vgl_alpha(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 2) ! Grad_y - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3) + det_vgl_alpha(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 3) ! Grad_z - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4) + det_vgl_alpha(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 4) ! Lap - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5) + det_vgl_alpha(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 5) end do end do end do + end do end function qmckl_compute_det_vgl_alpha_f #+end_src @@ -768,9 +866,10 @@ end function qmckl_compute_det_vgl_alpha_f #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_det_vgl_alpha ( const qmckl_context context, + const int64_t det_num_alpha, const int64_t walk_num, - const int64_t fermi_num, - const int64_t* mo_index_list, + const int64_t alpha_num, + const int64_t* mo_index_alpha, const int64_t mo_num, const double* mo_vgl, double* const det_vgl_alpha ); @@ -781,23 +880,24 @@ end function qmckl_compute_det_vgl_alpha_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_det_vgl_alpha & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) & + (context, det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) & 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 :: det_num_alpha integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: fermi_num - integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) + integer (c_int64_t) , intent(in) , value :: alpha_num + integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) - real (c_double ) , intent(out) :: det_vgl_alpha(fermi_num,fermi_num,walk_num,5) + real (c_double ) , intent(in) :: mo_vgl(mo_num,alpha_num,walk_num,5) + real (c_double ) , intent(out) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha) integer(c_int32_t), external :: qmckl_compute_det_vgl_alpha_f info = qmckl_compute_det_vgl_alpha_f & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) + (context, det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) end function qmckl_compute_det_vgl_alpha #+end_src @@ -810,28 +910,30 @@ end function qmckl_compute_det_vgl_alpha_f :END: #+NAME: qmckl_compute_det_vgl_beta_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~fermi_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_vgl_beta[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][beta_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_vgl_beta_f(context, & - walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta) & + det_num_beta, walk_num, beta_num, mo_index_beta, mo_num, mo_vgl, det_vgl_beta) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: det_num_beta integer*8, intent(in) :: walk_num - integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: beta_num integer*8, intent(in) :: mo_num - integer*8, intent(in) :: mo_index_list(fermi_num) - double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) - double precision, intent(inout) :: det_vgl_beta(fermi_num, fermi_num, walk_num, 5) - integer*8 :: iwalk, ielec, mo_id, imo + integer*8, intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) + double precision, intent(in) :: mo_vgl(mo_num, beta_num, walk_num, 5) + double precision, intent(inout) :: det_vgl_beta(beta_num, beta_num, 5, walk_num, det_num_beta) + integer*8 :: idet, iwalk, ielec, mo_id, imo info = QMCKL_SUCCESS @@ -845,32 +947,34 @@ integer function qmckl_compute_det_vgl_beta_f(context, & return endif - if (fermi_num <= 0) then + if (beta_num <= 0) then info = QMCKL_INVALID_ARG_3 return endif + do idet = 1, det_num_beta do iwalk = 1, walk_num - do ielec = 1, fermi_num - do imo = 1, fermi_num - mo_id = mo_index_list(imo) + do ielec = 1, beta_num + do imo = 1, beta_num + mo_id = mo_index_beta(imo, iwalk, idet) ! Value - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 1) ! Grad_x - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2) + det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 2) ! Grad_y - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3) + det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 3) ! Grad_z - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4) + det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 4) ! Lap - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5) + det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 5) end do end do end do + end do end function qmckl_compute_det_vgl_beta_f #+end_src @@ -881,41 +985,42 @@ end function qmckl_compute_det_vgl_beta_f #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_det_vgl_beta ( const qmckl_context context, + const int64_t det_num_beta, const int64_t walk_num, - const int64_t fermi_num, - const int64_t* mo_index_list, + const int64_t beta_num, + const int64_t* mo_index_beta, const int64_t mo_num, const double* mo_vgl, double* const det_vgl_beta ); #+end_src - #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta")) + #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta")) #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_det_vgl_beta & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta) & + (context, det_num_beta, walk_num, beta_num, mo_index_beta, mo_num, mo_vgl, det_vgl_beta) & 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 :: det_num_beta integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: fermi_num - integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) + integer (c_int64_t) , intent(in) , value :: beta_num + integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) - real (c_double ) , intent(out) :: det_vgl_beta(fermi_num,fermi_num,walk_num,5) + real (c_double ) , intent(in) :: mo_vgl(mo_num,beta_num,walk_num,5) + real (c_double ) , intent(out) :: det_vgl_beta(beta_num,beta_num,5,walk_num,det_num_beta) integer(c_int32_t), external :: qmckl_compute_det_vgl_beta_f info = qmckl_compute_det_vgl_beta_f & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta) + (context, det_num_beta, walk_num, beta_num, mo_index_beta, mo_num, mo_vgl, det_vgl_beta) end function qmckl_compute_det_vgl_beta #+end_src - *** Test ** Inverse of Determinant matrix @@ -956,7 +1061,7 @@ qmckl_exit_code qmckl_get_det_inv_matrix_alpha(qmckl_context context, double * c qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; + size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; memcpy(det_inv_matrix_alpha, ctx->det.det_inv_matrix_alpha, sze * sizeof(double)); return QMCKL_SUCCESS; @@ -985,7 +1090,7 @@ qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double * co qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; + size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; memcpy(det_inv_matrix_beta, ctx->det.det_inv_matrix_beta, sze * sizeof(double)); return QMCKL_SUCCESS; @@ -1052,7 +1157,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { if (ctx->det.det_inv_matrix_alpha == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->det.walk_num * ctx->det.det_num * + mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * ctx->electron.up_num * ctx->electron.up_num * sizeof(double); double* det_inv_matrix_alpha = (double*) qmckl_malloc(context, mem_info); @@ -1068,11 +1173,11 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_inv_matrix_alpha(context, + ctx->det.det_num_alpha, ctx->det.walk_num, ctx->electron.up_num, - ctx->det.mo_index_list, ctx->mo_basis.mo_num, - ctx->mo_basis.mo_vgl, + ctx->det.det_vgl_alpha, ctx->det.det_inv_matrix_alpha); } else { return qmckl_failwith( context, @@ -1141,7 +1246,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { if (ctx->det.det_inv_matrix_beta == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->det.walk_num * ctx->det.det_num * + mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * ctx->electron.down_num * ctx->electron.down_num * sizeof(double); double* det_inv_matrix_beta = (double*) qmckl_malloc(context, mem_info); @@ -1157,11 +1262,11 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_inv_matrix_beta(context, + ctx->det.det_num_beta, ctx->det.walk_num, ctx->electron.down_num, - ctx->det.mo_index_list, ctx->mo_basis.mo_num, - ctx->mo_basis.mo_vgl, + ctx->det.det_vgl_beta, ctx->det.det_inv_matrix_beta); } else { return qmckl_failwith( context, @@ -1179,6 +1284,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { return QMCKL_SUCCESS; } #+end_src + *** Compute alpha :PROPERTIES: :Name: qmckl_compute_det_inv_matrix_alpha @@ -1187,28 +1293,32 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { :END: #+NAME: qmckl_det_inv_matrix_alpha_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~fermi_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_inv_matrix_alpha[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_inv_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | out | inverse of determinant matrix | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_inv_matrix_alpha_f(context, & - walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha) & + det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: det_num_alpha integer*8, intent(in) :: walk_num - integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: alpha_num integer*8, intent(in) :: mo_num - integer*8, intent(in) :: mo_index_list(fermi_num) - double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) - double precision, intent(inout) :: det_inv_matrix_alpha(fermi_num, fermi_num, walk_num, 5) - integer*8 :: iwalk, ielec, mo_id, imo + double precision, intent(in) :: det_vgl_alpha(mo_num, alpha_num, 5, walk_num, det_num_alpha) + double precision, intent(inout) :: det_inv_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) + double precision,dimension(:,:),allocatable :: matA + double precision :: det_l + integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res + + allocate(matA(mo_num, alpha_num)) info = QMCKL_SUCCESS @@ -1217,24 +1327,34 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & return endif - if (walk_num <= 0) then + if (det_num_alpha <= 0) then info = QMCKL_INVALID_ARG_2 return endif - if (fermi_num <= 0) then + if (walk_num <= 0) then info = QMCKL_INVALID_ARG_3 return endif + if (alpha_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (mo_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + LDA = alpha_num + do idet = 1, det_num_alpha do iwalk = 1, walk_num - do ielec = 1, fermi_num - do imo = 1, fermi_num - mo_id = mo_index_list(imo) - ! Value - det_inv_matrix_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) - end do - end do + ! Value + matA = det_vgl_alpha(1:mo_num, 1:alpha_num, 1, iwalk, idet) + res = qmckl_invert(context, alpha_num, alpha_num, LDA, matA, det_l) + det_inv_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA + end do end do end function qmckl_compute_det_inv_matrix_alpha_f @@ -1246,11 +1366,11 @@ end function qmckl_compute_det_inv_matrix_alpha_f #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_det_inv_matrix_alpha ( const qmckl_context context, + const int64_t det_num_alpha, const int64_t walk_num, - const int64_t fermi_num, - const int64_t* mo_index_list, + const int64_t alpha_num, const int64_t mo_num, - const double* mo_vgl, + const double* det_vgl_alpha, double* const det_inv_matrix_alpha ); #+end_src @@ -1259,23 +1379,23 @@ end function qmckl_compute_det_inv_matrix_alpha_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_det_inv_matrix_alpha & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha) & + (context, det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) & 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 :: det_num_alpha integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: fermi_num - integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) + integer (c_int64_t) , intent(in) , value :: alpha_num integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) - real (c_double ) , intent(out) :: det_inv_matrix_alpha(fermi_num,fermi_num,walk_num,5) + real (c_double ) , intent(in) :: det_vgl_alpha(mo_num,alpha_num,5,walk_num,det_num_alpha) + real (c_double ) , intent(out) :: det_inv_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_alpha_f info = qmckl_compute_det_inv_matrix_alpha_f & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha) + (context, det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) end function qmckl_compute_det_inv_matrix_alpha #+end_src @@ -1288,28 +1408,32 @@ end function qmckl_compute_det_inv_matrix_alpha_f :END: #+NAME: qmckl_det_inv_matrix_beta_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~fermi_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_inv_matrix_beta[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | inverse of determinant matrix | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_inv_matrix_beta_f(context, & - walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta) & + det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_inv_matrix_beta) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: det_num_beta integer*8, intent(in) :: walk_num - integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: beta_num integer*8, intent(in) :: mo_num - integer*8, intent(in) :: mo_index_list(fermi_num) - double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5) - double precision, intent(inout) :: det_inv_matrix_beta(fermi_num, fermi_num, walk_num, 5) - integer*8 :: iwalk, ielec, mo_id, imo + double precision, intent(in) :: det_vgl_beta(mo_num, beta_num, 5, walk_num, det_num_beta) + double precision, intent(inout) :: det_inv_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) + double precision,dimension(:,:),allocatable :: matA + double precision :: det_l + integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res + + allocate(matA(mo_num, beta_num)) info = QMCKL_SUCCESS @@ -1318,24 +1442,34 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & return endif - if (walk_num <= 0) then + if (det_num_beta <= 0) then info = QMCKL_INVALID_ARG_2 return endif - if (fermi_num <= 0) then + if (walk_num <= 0) then info = QMCKL_INVALID_ARG_3 return endif + if (beta_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (mo_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + LDA = beta_num + do idet = 1, det_num_beta do iwalk = 1, walk_num - do ielec = 1, fermi_num - do imo = 1, fermi_num - mo_id = mo_index_list(imo) - ! Value - det_inv_matrix_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) - end do - end do + ! Value + matA = det_vgl_beta(1:mo_num, 1:beta_num, 1, iwalk, idet) + res = qmckl_invert(context, beta_num, beta_num, LDA, matA, det_l) + det_inv_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA + end do end do end function qmckl_compute_det_inv_matrix_beta_f @@ -1347,11 +1481,11 @@ end function qmckl_compute_det_inv_matrix_beta_f #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_det_inv_matrix_beta ( const qmckl_context context, + const int64_t det_num_beta, const int64_t walk_num, - const int64_t fermi_num, - const int64_t* mo_index_list, + const int64_t beta_num, const int64_t mo_num, - const double* mo_vgl, + const double* det_vgl_beta, double* const det_inv_matrix_beta ); #+end_src @@ -1360,27 +1494,28 @@ end function qmckl_compute_det_inv_matrix_beta_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_det_inv_matrix_beta & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta) & + (context, det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_inv_matrix_beta) & 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 :: det_num_beta integer (c_int64_t) , intent(in) , value :: walk_num - integer (c_int64_t) , intent(in) , value :: fermi_num - integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num) + integer (c_int64_t) , intent(in) , value :: beta_num integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5) - real (c_double ) , intent(out) :: det_inv_matrix_beta(fermi_num,fermi_num,walk_num,5) + real (c_double ) , intent(in) :: det_vgl_beta(mo_num,beta_num,5,walk_num,det_num_beta) + real (c_double ) , intent(out) :: det_inv_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_beta_f info = qmckl_compute_det_inv_matrix_beta_f & - (context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta) + (context, det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_inv_matrix_beta) end function qmckl_compute_det_inv_matrix_beta #+end_src + *** Test * End of files :noexport: From d24f2683693bdf9f53c0a19f2d0aa6cca0476f30 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 7 Oct 2021 14:01:40 +0200 Subject: [PATCH 14/68] Added test for invert. #41 --- org/qmckl_blas.org | 74 ++++++++++++++++++++++++++++++++++++++++++++- org/qmckl_mo.org | 75 +++++++++++++++++++++++----------------------- 2 files changed, 110 insertions(+), 39 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index 293af48..46ae91a 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -365,8 +365,10 @@ integer function qmckl_invert_f(context, ma, na, LDA, A, det_l) & integer*8, intent(in) :: ma integer*8, intent(in) :: na double precision, intent(inout) :: det_l - integer :: i,j + + info = QMCKL_SUCCESS + select case (na) case default !DIR$ forceinline @@ -742,6 +744,76 @@ end #+end_src *** Test :noexport: + #+begin_src f90 :tangle (eval f_test) +integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C) + use qmckl + implicit none + integer(qmckl_context), intent(in), value :: context + + double precision, allocatable :: A(:,:), C(:,:) + integer*8 :: m, n, k, LDA, LDB, LDC + integer*8 :: i,j,l + double precision :: x, det_l, det_l_ref + + m = 4_8 + k = 4_8 + LDA = m + LDB = m + LDC = m + + allocate( A(LDA,k), C(LDC,k)) + + A = 0.10d0 + C = 0.d0 + A(1,1) = 1.0d0; + A(2,2) = 2.0d0; + A(3,3) = 3.0d0; + A(4,4) = 4.0d0; + + ! Exact inverse (Mathematica) + C(1,1) = 1.0102367161391992d0 + C(2,2) = 0.5036819224578257d0 + C(3,3) = 0.33511197860555897d0 + C(4,4) = 0.2510382472105688d0 + C(1,2) = -0.047782608144589914d0 + C(1,3) = -0.031305846715420985d0 + C(1,4) = -0.023278706531979707d0 + C(2,3) = -0.014829085286252043d0 + C(2,4) = -0.011026755725674596d0 + C(3,4) = -0.007224426165097149d0 + C(2,1) = -0.047782608144589914d0 + C(3,1) = -0.031305846715420985d0 + C(4,1) = -0.023278706531979707d0 + C(3,2) = -0.014829085286252043d0 + C(4,2) = -0.011026755725674596d0 + C(4,3) = -0.007224426165097149d0 + det_l_ref = 23.6697d0 + + test_qmckl_invert = qmckl_invert(context, m, k, LDA, A, det_l) + + if (test_qmckl_invert /= QMCKL_SUCCESS) return + + test_qmckl_invert = QMCKL_FAILURE + + x = 0.d0 + do j=1,m + do i=1,k + x = x + (A(i,j) - (C(i,j) * det_l_ref))**2 + end do + end do + + if (dabs(x) <= 1.d-15 .and. (dabs(det_l_ref - det_l)) <= 1.d-15) then + test_qmckl_invert = QMCKL_SUCCESS + endif + + deallocate(A,C) +end function test_qmckl_invert + #+end_src + + #+begin_src c :comments link :tangle (eval c_test) +qmckl_exit_code test_qmckl_invert(qmckl_context context); +assert(QMCKL_SUCCESS == test_qmckl_invert(context)); + #+end_src * End of files :noexport: diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index 8fa209f..012caae 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -482,7 +482,7 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & ! Don't compute exponentials when the result will be almost zero. ! TODO : Use numerical precision here cutoff = -dlog(1.d-15) - M = 1_8 + M = elec_num N = mo_num * 1_8 K = ao_num * 1_8 LDA = M @@ -490,38 +490,36 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & LDC = M do iwalk = 1, walk_num - do ielec = 1, elec_num - ! Value - info_qmckl_dgemm_value = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 1), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,1),LDC) - ! Grad_x - info_qmckl_dgemm_Gx = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 2), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,2),LDC) - ! Grad_y - info_qmckl_dgemm_Gy = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 3), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,3),LDC) - ! Grad_z - info_qmckl_dgemm_Gz = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 4), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,4),LDC) - ! Lapl_z - info_qmckl_dgemm_lap = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 5), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,5),LDC) - end do + ! Value + info_qmckl_dgemm_value = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & + ao_vgl(:, :, iwalk, 1), LDA, & + coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & + beta, & + mo_vgl(:,:,iwalk,1),LDC) + ! Grad_x + info_qmckl_dgemm_Gx = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & + ao_vgl(:, ielec, iwalk, 2), LDA, & + coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & + beta, & + mo_vgl(:,ielec,iwalk,2),LDC) + ! Grad_y + info_qmckl_dgemm_Gy = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & + ao_vgl(:, ielec, iwalk, 3), LDA, & + coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & + beta, & + mo_vgl(:,ielec,iwalk,3),LDC) + ! Grad_z + info_qmckl_dgemm_Gz = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & + ao_vgl(:, ielec, iwalk, 4), LDA, & + coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & + beta, & + mo_vgl(:,ielec,iwalk,4),LDC) + ! Lapl_z + info_qmckl_dgemm_lap = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha, & + ao_vgl(:, ielec, iwalk, 5), LDA, & + coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & + beta, & + mo_vgl(:,ielec,iwalk,5),LDC) end do if(info_qmckl_dgemm_value .eq. QMCKL_SUCCESS .and. & @@ -778,10 +776,10 @@ rc = qmckl_get_mo_basis_vgl(context, &(mo_vgl[0][0][0][0])); assert (rc == QMCKL_SUCCESS); // Test overlap of MO -//double point_x[100]; -//double point_y[100]; -//double point_z[100]; -//int32_t npoints=100; +//double point_x[10]; +//double point_y[10]; +//double point_z[10]; +//int32_t npoints=10; //// obtain points //double dr = 20./(npoints-1); //double dr3 = dr*dr*dr; @@ -795,10 +793,11 @@ assert (rc == QMCKL_SUCCESS); //double ovlmo1 = 0.0; //// Calculate overlap //for (int i=0;i Date: Thu, 7 Oct 2021 14:13:40 +0200 Subject: [PATCH 15/68] Added det value and adjoint. #41 --- org/qmckl_blas.org | 9 ++-- org/qmckl_determinant.org | 93 +++++++++++++++++++++++++++++++-------- 2 files changed, 78 insertions(+), 24 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index 46ae91a..23ca6e1 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -54,7 +54,7 @@ int main() { - ~A~ is allocated with at least $m \times k \times 8$ bytes - ~B~ is allocated with at least $k \times n \times 8$ bytes - ~C~ is allocated with at least $m \times n \times 8$ bytes - + *** C header #+CALL: generate_c_header(table=qmckl_dgemm_args,rettyp="qmckl_exit_code",fname="qmckl_dgemm") @@ -78,7 +78,6 @@ int main() { const int64_t ldc ); #+END_src - *** Source #+begin_src f90 :tangle (eval f) integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA, B, LDB, beta, C, LDC) & @@ -318,7 +317,7 @@ M · M^{-1} = I \] This is a native Fortran implementation hand written (by: A. Scemama) - only for small matrices. + only for small matrices (<=5x5). TODO: Add description about the external library dependence. @@ -694,7 +693,7 @@ end #+end_src *** C interface :noexport: - + #+CALL: generate_c_interface(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") #+RESULTS: @@ -742,7 +741,7 @@ end end function qmckl_invert end interface #+end_src - + *** Test :noexport: #+begin_src f90 :tangle (eval f_test) integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 89a2692..8bdd1fe 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -37,7 +37,6 @@ determinant ψ(x). (org-babel-lob-ingest "../tools/lib.org") #+end_src - #+begin_src c :tangle (eval h_private_type) #ifndef QMCKL_DETERMINANT_HPT #define QMCKL_DETERMINANT_HPT @@ -1178,6 +1177,8 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { ctx->electron.up_num, ctx->mo_basis.mo_num, ctx->det.det_vgl_alpha, + ctx->det.det_value_alpha, + ctx->det.det_adj_matrix_alpha, ctx->det.det_inv_matrix_alpha); } else { return qmckl_failwith( context, @@ -1267,6 +1268,8 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { ctx->electron.down_num, ctx->mo_basis.mo_num, ctx->det.det_vgl_beta, + ctx->det.det_value_beta, + ctx->det.det_adj_matrix_beta, ctx->det.det_inv_matrix_beta); } else { return qmckl_failwith( context, @@ -1293,17 +1296,19 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { :END: #+NAME: qmckl_det_inv_matrix_alpha_args - | ~qmckl_context~ | ~context~ | in | Global state | + | ~qmckl_context~ | ~context~ | in | Global state | | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~alpha_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_value_alpha[det_num_alpha][walk_num]~ | out | value of determinant matrix | + | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | out | adjoint of determinant matrix | | ~double~ | ~det_inv_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | out | inverse of determinant matrix | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_inv_matrix_alpha_f(context, & - det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) & + det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_value_alpha, det_adj_matrix_alpha, det_inv_matrix_alpha) & result(info) use qmckl implicit none @@ -1313,6 +1318,8 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & integer*8, intent(in) :: alpha_num integer*8, intent(in) :: mo_num double precision, intent(in) :: det_vgl_alpha(mo_num, alpha_num, 5, walk_num, det_num_alpha) + double precision, intent(inout) :: det_value_alpha(walk_num, det_num_alpha) + double precision, intent(inout) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) double precision, intent(inout) :: det_inv_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) double precision,dimension(:,:),allocatable :: matA double precision :: det_l @@ -1353,7 +1360,9 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & ! Value matA = det_vgl_alpha(1:mo_num, 1:alpha_num, 1, iwalk, idet) res = qmckl_invert(context, alpha_num, alpha_num, LDA, matA, det_l) - det_inv_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA + det_adj_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA + det_inv_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA/det_l + det_value_alpha(iwalk, idet) = det_l end do end do @@ -1371,6 +1380,8 @@ end function qmckl_compute_det_inv_matrix_alpha_f const int64_t alpha_num, const int64_t mo_num, const double* det_vgl_alpha, + double* const det_value_alpha, + double* const det_adj_matrix_alpha, double* const det_inv_matrix_alpha ); #+end_src @@ -1379,7 +1390,15 @@ end function qmckl_compute_det_inv_matrix_alpha_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_det_inv_matrix_alpha & - (context, det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) & + (context, & + det_num_alpha, & + walk_num, & + alpha_num, & + mo_num, & + det_vgl_alpha, & + det_value_alpha, & + det_adj_matrix_alpha, & + det_inv_matrix_alpha) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -1391,11 +1410,21 @@ end function qmckl_compute_det_inv_matrix_alpha_f integer (c_int64_t) , intent(in) , value :: alpha_num integer (c_int64_t) , intent(in) , value :: mo_num real (c_double ) , intent(in) :: det_vgl_alpha(mo_num,alpha_num,5,walk_num,det_num_alpha) + real (c_double ) , intent(out) :: det_value_alpha(walk_num,det_num_alpha) + real (c_double ) , intent(out) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) real (c_double ) , intent(out) :: det_inv_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_alpha_f info = qmckl_compute_det_inv_matrix_alpha_f & - (context, det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) + (context, & + det_num_alpha, & + walk_num, & + alpha_num, & + mo_num, & + det_vgl_alpha, & + det_value_alpha, & + det_adj_matrix_alpha, & + det_inv_matrix_alpha) end function qmckl_compute_det_inv_matrix_alpha #+end_src @@ -1408,17 +1437,19 @@ end function qmckl_compute_det_inv_matrix_alpha_f :END: #+NAME: qmckl_det_inv_matrix_beta_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~beta_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_value_beta[det_num_beta][walk_num]~ | out | value of determinant matrix | + | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | adjoint of determinant matrix | | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | inverse of determinant matrix | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_inv_matrix_beta_f(context, & - det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_inv_matrix_beta) & + det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_value_beta, det_adj_matrix_beta, det_inv_matrix_beta) & result(info) use qmckl implicit none @@ -1428,6 +1459,8 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & integer*8, intent(in) :: beta_num integer*8, intent(in) :: mo_num double precision, intent(in) :: det_vgl_beta(mo_num, beta_num, 5, walk_num, det_num_beta) + double precision, intent(inout) :: det_value_beta(walk_num, det_num_beta) + double precision, intent(inout) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) double precision, intent(inout) :: det_inv_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) double precision,dimension(:,:),allocatable :: matA double precision :: det_l @@ -1468,7 +1501,9 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & ! Value matA = det_vgl_beta(1:mo_num, 1:beta_num, 1, iwalk, idet) res = qmckl_invert(context, beta_num, beta_num, LDA, matA, det_l) - det_inv_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA + det_adj_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA + det_inv_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA/det_l + det_value_beta(iwalk, idet) = det_l end do end do @@ -1486,6 +1521,8 @@ end function qmckl_compute_det_inv_matrix_beta_f const int64_t beta_num, const int64_t mo_num, const double* det_vgl_beta, + double* const det_value_beta, + double* const det_adj_matrix_beta, double* const det_inv_matrix_beta ); #+end_src @@ -1494,7 +1531,15 @@ end function qmckl_compute_det_inv_matrix_beta_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_det_inv_matrix_beta & - (context, det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_inv_matrix_beta) & + (context, & + det_num_beta, & + walk_num, & + beta_num, & + mo_num, & + det_vgl_beta, & + det_value_beta, & + det_adj_matrix_beta, & + det_inv_matrix_beta) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -1506,11 +1551,21 @@ end function qmckl_compute_det_inv_matrix_beta_f integer (c_int64_t) , intent(in) , value :: beta_num integer (c_int64_t) , intent(in) , value :: mo_num real (c_double ) , intent(in) :: det_vgl_beta(mo_num,beta_num,5,walk_num,det_num_beta) + real (c_double ) , intent(out) :: det_value_beta(walk_num,det_num_beta) + real (c_double ) , intent(out) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) real (c_double ) , intent(out) :: det_inv_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_beta_f info = qmckl_compute_det_inv_matrix_beta_f & - (context, det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_inv_matrix_beta) + (context, & + det_num_beta, & + walk_num, & + beta_num, & + mo_num, & + det_vgl_beta, & + det_value_beta, & + det_adj_matrix_beta, & + det_inv_matrix_beta) end function qmckl_compute_det_inv_matrix_beta #+end_src From 3668851412128308f731c863863671640bad6bd9 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 8 Oct 2021 00:56:00 +0200 Subject: [PATCH 16/68] Improved calculation of MOs with one big dgemm. #41 --- org/qmckl_determinant.org | 4 +++ org/qmckl_mo.org | 67 ++++++++++----------------------------- 2 files changed, 20 insertions(+), 51 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 8bdd1fe..b35d547 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1190,6 +1190,8 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { return rc; } + ctx->det.det_value_alpha_date = ctx->date; + ctx->det.det_adj_matrix_alpha_date = ctx->date; ctx->det.det_inv_matrix_alpha_date = ctx->date; } @@ -1281,6 +1283,8 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { return rc; } + ctx->det.det_value_beta_date = ctx->date; + ctx->det.det_adj_matrix_beta_date = ctx->date; ctx->det.det_inv_matrix_beta_date = ctx->date; } diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index 012caae..57ac505 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -438,7 +438,7 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) | ~int64_t~ | ~mo_num~ | in | Number of MOs | | ~int64_t~ | ~elec_num~ | in | Number of electrons | | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~double~ | ~coef_normalized[mo_num][ao_num]~ | in | AO to MO transformation matrix | + | ~double~ | ~coef_normalized[ao_num][mo_num]~ | in | AO to MO transformation matrix | | ~double~ | ~ao_vgl[5][walk_num][elec_num][ao_num]~ | in | Value, gradients and Laplacian of the AOs | | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | out | Value, gradients and Laplacian of the MOs | @@ -454,9 +454,10 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & integer*8 , intent(in) :: elec_num integer*8 , intent(in) :: walk_num double precision , intent(in) :: ao_vgl(ao_num,elec_num,walk_num,5) - double precision , intent(in) :: coef_normalized(ao_num,mo_num) + double precision , intent(in) :: coef_normalized(mo_num,ao_num) double precision , intent(out) :: mo_vgl(mo_num,elec_num,walk_num,5) logical*8 :: TransA, TransB + double precision,dimension(:,:),allocatable :: mo_vgl_big double precision :: alpha, beta integer :: info_qmckl_dgemm_value integer :: info_qmckl_dgemm_Gx @@ -467,6 +468,9 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & 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*walk_num*5)) + TransA = .False. TransB = .False. alpha = 1.0d0 @@ -474,64 +478,25 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & info = QMCKL_SUCCESS info_qmckl_dgemm_value = QMCKL_SUCCESS - info_qmckl_dgemm_Gx = QMCKL_SUCCESS - info_qmckl_dgemm_Gy = QMCKL_SUCCESS - info_qmckl_dgemm_Gz = QMCKL_SUCCESS - info_qmckl_dgemm_lap = QMCKL_SUCCESS ! Don't compute exponentials when the result will be almost zero. ! TODO : Use numerical precision here cutoff = -dlog(1.d-15) - M = elec_num - N = mo_num * 1_8 + M = mo_num + N = elec_num*walk_num*5 K = ao_num * 1_8 LDA = M LDB = K LDC = M - do iwalk = 1, walk_num - ! Value - info_qmckl_dgemm_value = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - ao_vgl(:, :, iwalk, 1), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,:,iwalk,1),LDC) - ! Grad_x - info_qmckl_dgemm_Gx = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 2), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,2),LDC) - ! Grad_y - info_qmckl_dgemm_Gy = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 3), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,3),LDC) - ! Grad_z - info_qmckl_dgemm_Gz = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 4), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,4),LDC) - ! Lapl_z - info_qmckl_dgemm_lap = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha, & - ao_vgl(:, ielec, iwalk, 5), LDA, & - coef_normalized(1:ao_num,1:mo_num),size(coef_normalized,1) * 1_8, & - beta, & - mo_vgl(:,ielec,iwalk,5),LDC) - end do + info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & + coef_normalized(1:mo_num,1:ao_num),size(coef_normalized,1) * 1_8, & + reshape(ao_vgl(:,:, :, :),(/ao_num,elec_num*walk_num*5/)), LDB, & + beta, & + mo_vgl_big(:,:),LDC) + mo_vgl = reshape(mo_vgl_big,(/mo_num,elec_num,walk_num,5_8/)) - if(info_qmckl_dgemm_value .eq. QMCKL_SUCCESS .and. & - info_qmckl_dgemm_Gx .eq. QMCKL_SUCCESS .and. & - info_qmckl_dgemm_Gy .eq. QMCKL_SUCCESS .and. & - info_qmckl_dgemm_Gz .eq. QMCKL_SUCCESS .and. & - info_qmckl_dgemm_lap .eq. QMCKL_SUCCESS ) then - info = QMCKL_SUCCESS - else - info = QMCKL_FAILURE - end if - + deallocate(mo_vgl_big) end function qmckl_compute_mo_basis_gaussian_vgl_f #+end_src @@ -567,7 +532,7 @@ end function qmckl_compute_mo_basis_gaussian_vgl_f 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 :: walk_num - real (c_double ) , intent(in) :: coef_normalized(ao_num,mo_num) + real (c_double ) , intent(in) :: coef_normalized(mo_num,ao_num) real (c_double ) , intent(in) :: ao_vgl(ao_num,elec_num,walk_num,5) real (c_double ) , intent(out) :: mo_vgl(mo_num,elec_num,walk_num,5) From 2959281a10bdbdd0ea0a7f5b9bd053ac86fdf6db Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 10:04:27 +0200 Subject: [PATCH 17/68] Removed qmckl_blas_func header. #41 --- TODO.org | 21 --------------------- org/qmckl_determinant.org | 1 - 2 files changed, 22 deletions(-) delete mode 100644 TODO.org diff --git a/TODO.org b/TODO.org deleted file mode 100644 index b565b64..0000000 --- a/TODO.org +++ /dev/null @@ -1,21 +0,0 @@ -* Set up CI on Travis -* Write tests - -* malloc/free : Parameters for accelerators? -We should define qmckl_malloc and qmckl_free just to give the -possibility of the HPC implementations to define how they allocate the -memory (on CPU or GPU, using alternatives to malloc/free, etc). -A possibility could be to pass the id of a NUMA domain as a parameter of -qmckl_malloc, where the domain id is something obtained from the -context. - - -* TRANSA, TRANSB -* Performance info -* Benchmark interpolation of basis functions -* Complex numbers -* Adjustable number for derivatives (1,2,3) - -* Put pictures -* Make the Makefile part of the documented code ? -* Put the data-flow graph in the code. diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index b35d547..4f78364 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -91,7 +91,6 @@ int main() { #include "qmckl_mo_private_func.h" #include "qmckl_determinant_private_type.h" #include "qmckl_determinant_private_func.h" -#include "qmckl_blas_func.h" #+end_src * Context From 88178c5efa68f8aecac2d38051501b5845d15349 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 11:34:42 +0200 Subject: [PATCH 18/68] Added electron and nucleus potential. #41 --- org/qmckl_electron.org | 245 +++++++++++++++++++++++++++++++++++++---- org/qmckl_nucleus.org | 237 ++++++++++++++++++++++++++++++++++++--- 2 files changed, 443 insertions(+), 39 deletions(-) diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index 9f2f89f..832ac97 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -63,29 +63,36 @@ int main() { The following data stored in the context: - | ~uninitialized~ | ~int32_t~ | Keeps bit set for uninitialized data | - | ~num~ | ~int64_t~ | Total number of electrons | - | ~up_num~ | ~int64_t~ | Number of up-spin electrons | - | ~down_num~ | ~int64_t~ | Number of down-spin electrons | - | ~walk_num~ | ~int64_t~ | Number of walkers | - | ~rescale_factor_kappa_ee~ | ~double~ | The distance scaling factor | - | ~rescale_factor_kappa_en~ | ~double~ | The distance scaling factor | - | ~provided~ | ~bool~ | If true, ~electron~ is valid | - | ~coord_new~ | ~double[walk_num][3][num]~ | New set of electron coordinates | - | ~coord_old~ | ~double[walk_num][3][num]~ | Old set of electron coordinates | - | ~coord_new_date~ | ~uint64_t~ | Last modification date of the coordinates | - | ~ee_distance~ | ~double[walk_num][num][num]~ | Electron-electron distances | - | ~ee_distance_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | - | ~en_distance~ | ~double[walk_num][nucl_num][num]~ | Electron-nucleus distances | - | ~en_distance_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | - | ~ee_distance_rescaled~ | ~double[walk_num][num][num]~ | Electron-electron rescaled distances | - | ~ee_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | - | ~ee_distance_rescaled_deriv_e~ | ~double[walk_num][4][num][num]~ | Electron-electron rescaled distances derivatives | - | ~ee_distance_rescaled_deriv_e_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | - | ~en_distance_rescaled~ | ~double[walk_num][nucl_num][num]~ | Electron-nucleus distances | - | ~en_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | - | ~en_distance_rescaled_deriv_e~ | ~double[walk_num][4][nucl_num][num]~ | Electron-electron rescaled distances derivatives | - | ~en_distance_rescaled_deriv_e_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | + |-------------------------------------+--------------------------------------+----------------------------------------------------------------------| + | ~uninitialized~ | ~int32_t~ | Keeps bit set for uninitialized data | + | ~num~ | ~int64_t~ | Total number of electrons | + | ~up_num~ | ~int64_t~ | Number of up-spin electrons | + | ~down_num~ | ~int64_t~ | Number of down-spin electrons | + | ~walk_num~ | ~int64_t~ | Number of walkers | + | ~rescale_factor_kappa_ee~ | ~double~ | The distance scaling factor | + | ~rescale_factor_kappa_en~ | ~double~ | The distance scaling factor | + | ~provided~ | ~bool~ | If true, ~electron~ is valid | + | ~coord_new~ | ~double[walk_num][3][num]~ | New set of electron coordinates | + | ~coord_old~ | ~double[walk_num][3][num]~ | Old set of electron coordinates | + | ~coord_new_date~ | ~uint64_t~ | Last modification date of the coordinates | + + Computed data: + + |-------------------------------------+--------------------------------------+----------------------------------------------------------------------| + | ~ee_distance~ | ~double[walk_num][num][num]~ | Electron-electron distances | + | ~ee_distance_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | + | ~en_distance~ | ~double[walk_num][nucl_num][num]~ | Electron-nucleus distances | + | ~en_distance_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | + | ~ee_distance_rescaled~ | ~double[walk_num][num][num]~ | Electron-electron rescaled distances | + | ~ee_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | + | ~ee_distance_rescaled_deriv_e~ | ~double[walk_num][4][num][num]~ | Electron-electron rescaled distances derivatives | + | ~ee_distance_rescaled_deriv_e_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | + | ~ee_pot~ | ~double[walk_num][4][num][num]~ | Electron-electron rescaled distances derivatives | + | ~ee_pot_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | + | ~en_distance_rescaled~ | ~double[walk_num][nucl_num][num]~ | Electron-nucleus distances | + | ~en_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | + | ~en_distance_rescaled_deriv_e~ | ~double[walk_num][4][nucl_num][num]~ | Electron-electron rescaled distances derivatives | + | ~en_distance_rescaled_deriv_e_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | ** Data structure @@ -100,6 +107,7 @@ typedef struct qmckl_electron_struct { int64_t coord_new_date; int64_t ee_distance_date; int64_t en_distance_date; + int64_t ee_pot_date; int64_t ee_distance_rescaled_date; int64_t ee_distance_rescaled_deriv_e_date; int64_t en_distance_rescaled_date; @@ -108,6 +116,7 @@ typedef struct qmckl_electron_struct { double* coord_old; double* ee_distance; double* en_distance; + double* ee_pot; double* ee_distance_rescaled; double* ee_distance_rescaled_deriv_e; double* en_distance_rescaled; @@ -1378,7 +1387,7 @@ qmckl_exit_code qmckl_get_electron_ee_distance_rescaled_deriv_e(qmckl_context co #+end_src *** Provide :noexport: - + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none qmckl_exit_code qmckl_provide_ee_distance_rescaled_deriv_e(qmckl_context context); #+end_src @@ -1565,6 +1574,194 @@ rc = qmckl_get_electron_ee_distance_rescaled_deriv_e(context, ee_distance_rescal #+end_src +** Electron-electron potential + + ~ee_pot~ calculates the ~ee~ potential energy. + + \[ + \mathcal{V}_{ee} = \sum_{i=1}^{N_e}\sum_{j>i}^{N_e}\frac{1}{r_{ij}} + \] + + where \(\mathcal{V}_{ee}\) is the ~ee~ potential and \[r_{ij}\] the ~ee~ + distance. + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_electron_ee_potential(qmckl_context context, double* const ee_pot); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_electron_ee_potential(qmckl_context context, double* const ee_pot) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ee_potential(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->electron.walk_num * sizeof(double); + memcpy(ee_pot, ctx->electron.ee_pot, sze); + + return QMCKL_SUCCESS; +} + #+end_src + +*** Provide :noexport: + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_ee_potential(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_ee_potential(qmckl_context context) +{ + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if (!ctx->electron.provided) return QMCKL_NOT_PROVIDED; + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->electron.ee_pot_date) { + + /* Allocate array */ + if (ctx->electron.ee_pot == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* ee_pot = (double*) qmckl_malloc(context, mem_info); + + if (ee_pot == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_ee_potential", + NULL); + } + ctx->electron.ee_pot = ee_pot; + } + + qmckl_exit_code rc = + qmckl_compute_ee_potential(context, + ctx->electron.num, + ctx->electron.walk_num, + ctx->electron.ee_distance, + ctx->electron.ee_pot); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->electron.ee_pot_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_ee_potential + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_ee_potential_args + | qmckl_context | context | in | Global state | + | int64_t | elec_num | in | Number of electrons | + | int64_t | walk_num | in | Number of walkers | + | double | ee_distance[walk_num][elec_num][elec_num] | in | Electron-electron rescaled distances | + | double | ee_pot[walk_num] | out | Electron-electron potential | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_ee_potential_f(context, elec_num, walk_num, & + ee_distance, ee_pot) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: elec_num + integer*8 , intent(in) :: walk_num + double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num) + double precision , intent(out) :: ee_pot(walk_num) + + integer*8 :: nw, i, j + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (elec_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + ee_pot = 0.0d0 + do nw=1,walk_num + do j=1,elec_num + do i=1,j-1 + ee_pot(nw) = ee_pot(nw) + 1.0d0/(ee_distance(i,j,nw)) + end do + end do + end do + +end function qmckl_compute_ee_potential_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_ee_potential_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_ee_potential ( + const qmckl_context context, + const int64_t elec_num, + const int64_t walk_num, + const double* ee_distance, + double* const ee_pot ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_ee_potential_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_ee_potential & + (context, elec_num, walk_num, ee_distance, ee_pot) & + 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 :: elec_num + integer (c_int64_t) , intent(in) , value :: walk_num + real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num) + real (c_double ) , intent(out) :: ee_pot(walk_num) + + integer(c_int32_t), external :: qmckl_compute_ee_potential_f + info = qmckl_compute_ee_potential_f & + (context, elec_num, walk_num, ee_distance, ee_pot) + + end function qmckl_compute_ee_potential + #+end_src + +*** Test ** Electron-nucleus distances *** Get diff --git a/org/qmckl_nucleus.org b/org/qmckl_nucleus.org index bdd8cb8..82afe85 100644 --- a/org/qmckl_nucleus.org +++ b/org/qmckl_nucleus.org @@ -62,18 +62,26 @@ int main() { The following data stored in the context: - | ~uninitialized~ | int32_t | Keeps bit set for uninitialized data | - | ~num~ | int64_t | Total number of nuclei | - | ~provided~ | bool | If true, ~nucleus~ is valid | - | ~charge~ | double[num] | Nuclear charges | - | ~coord~ | double[3][num] | Nuclear coordinates, in transposed format | - | ~nn_distance~ | double[num][num] | Nucleus-nucleus distances | - | ~nn_distance_date~ | int64_t | Date when Nucleus-nucleus distances were computed | - | ~nn_distance_rescaled~ | double[num][num] | Nucleus-nucleus rescaled distances | - | ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed | - | ~repulsion~ | double | Nuclear repulsion energy | - | ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed | - | ~rescale_factor_kappa~ | double | The distance scaling factor | + |------------------------+----------------+-------------------------------------------| + | ~uninitialized~ | int32_t | Keeps bit set for uninitialized data | + | ~num~ | int64_t | Total number of nuclei | + | ~provided~ | bool | If true, ~nucleus~ is valid | + | ~charge~ | double[num] | Nuclear charges | + | ~coord~ | double[3][num] | Nuclear coordinates, in transposed format | + | ~coord_date~ | int64_t | Nuclear coordinates, date if modified | + | ~rescale_factor_kappa~ | double | The distance scaling factor | + + Computed data: + + |-----------------------------+------------------+--------------------------------------------------------------| + | ~nn_distance~ | double[num][num] | Nucleus-nucleus distances | + | ~nn_distance_date~ | int64_t | Date when Nucleus-nucleus distances were computed | + | ~nn_distance_rescaled~ | double[num][num] | Nucleus-nucleus rescaled distances | + | ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed | + | ~repulsion~ | double | Nuclear repulsion energy | + | ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed | + | ~en_pot~ | double | Electron-nucleus potential energy | + | ~en_pot_date~ | int64_t | Date when the electron-nucleus potential energy was computed | ** Data structure @@ -83,6 +91,7 @@ typedef struct qmckl_nucleus_struct { int64_t repulsion_date; int64_t nn_distance_date; int64_t nn_distance_rescaled_date; + int64_t coord_date; double* coord; double* charge; double* nn_distance; @@ -91,6 +100,8 @@ typedef struct qmckl_nucleus_struct { double rescale_factor_kappa; int32_t uninitialized; bool provided; + int64_t en_pot_date; + double* en_pot; } qmckl_nucleus_struct; #+end_src @@ -125,8 +136,6 @@ qmckl_exit_code qmckl_init_nucleus(qmckl_context context) { } #+end_src - - ** Access functions #+begin_src c :comments org :tangle (eval h_func) :exports none @@ -785,7 +794,6 @@ assert(fabs(distance[1]-2.070304721365169) < 1.e-12); #+end_src - ** Nucleus-nucleus rescaled distances *** Get @@ -1132,6 +1140,205 @@ assert(rep - 318.2309879436158 < 1.e-10); #+end_src +** Electron-nucleus potential + ~en_potential~ stores the ~en~ potential energy + + \[ + \mathcal{V}_{en} = \sum_{i=1}^{N_e}\sum_{A=1}^{N_n}\frac{Z_A}{r_{iA}} + \] + + where \(\mathcal{V}_{en}\) is the ~en~ potential, \[r_{iA}\] the ~en~ + distance and \[Z_A\] is the nuclear charge. + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_electron_en_potential(qmckl_context context, double* const en_pot); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_electron_en_potential(qmckl_context context, double* const en_pot) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_en_potential(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->electron.walk_num * sizeof(double); + memcpy(en_pot, ctx->nucleus.en_pot, sze); + + return QMCKL_SUCCESS; +} + #+end_src + +*** Provide :noexport: + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_en_potential(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_en_potential(qmckl_context context) +{ + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if (!ctx->electron.provided) return QMCKL_NOT_PROVIDED; + if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; + + /* Compute if necessary */ + if (ctx->nucleus.coord_date > ctx->nucleus.en_pot_date) { + + /* Allocate array */ + if (ctx->nucleus.en_pot == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* en_pot = (double*) qmckl_malloc(context, mem_info); + + if (en_pot == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_en_potential", + NULL); + } + ctx->nucleus.en_pot = en_pot; + } + + qmckl_exit_code rc = + qmckl_compute_en_potential(context, + ctx->electron.num, + ctx->nucleus.num, + ctx->electron.walk_num, + ctx->nucleus.charge, + ctx->electron.en_distance, + ctx->nucleus.en_pot); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->nucleus.en_pot_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_en_potential + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_en_potential_args + | qmckl_context | context | in | Global state | + | int64_t | elec_num | in | Number of electrons | + | int64_t | nucl_num | in | Number of nucleii | + | int64_t | walk_num | in | Number of walkers | + | double | charge[nucl_num] | in | charge of nucleus | + | double | en_distance[walk_num][nucl_num][elec_num] | in | Electron-electron rescaled distances | + | double | en_pot[walk_num] | out | Electron-electron potential | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_en_potential_f(context, elec_num, nucl_num, walk_num, & + charge, en_distance, en_pot) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: elec_num + integer*8 , intent(in) :: nucl_num + integer*8 , intent(in) :: walk_num + double precision , intent(in) :: charge(nucl_num) + double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num) + double precision , intent(out) :: en_pot(walk_num) + + integer*8 :: nw, i, j + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (elec_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + en_pot = 0.0d0 + do nw=1,walk_num + do j=1,nucl_num + do i=1,elec_num + en_pot(nw) = en_pot(nw) + charge(j)/(en_distance(i,j,nw)) + end do + end do + end do + +end function qmckl_compute_en_potential_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_en_potential_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_en_potential ( + const qmckl_context context, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t walk_num, + const double* charge, + const double* en_distance, + double* const en_pot ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_en_potential_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_en_potential & + (context, elec_num, nucl_num, walk_num, charge, en_distance, en_pot) & + 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 :: 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) :: charge(nucl_num) + real (c_double ) , intent(in) :: en_distance(elec_num,nucl_num,walk_num) + real (c_double ) , intent(out) :: en_pot(walk_num) + + integer(c_int32_t), external :: qmckl_compute_en_potential_f + info = qmckl_compute_en_potential_f & + (context, elec_num, nucl_num, walk_num, charge, en_distance, en_pot) + + end function qmckl_compute_en_potential + #+end_src + +*** Test + * End of files :noexport: #+begin_src c :tangle (eval h_private_type) From 2b54d2bdf673457f203a0da9098a5b0829bb2979 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 14:10:13 +0200 Subject: [PATCH 19/68] Added sign for V_en term. #41 --- org/qmckl_nucleus.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/org/qmckl_nucleus.org b/org/qmckl_nucleus.org index 82afe85..634fb46 100644 --- a/org/qmckl_nucleus.org +++ b/org/qmckl_nucleus.org @@ -1144,7 +1144,7 @@ assert(rep - 318.2309879436158 < 1.e-10); ~en_potential~ stores the ~en~ potential energy \[ - \mathcal{V}_{en} = \sum_{i=1}^{N_e}\sum_{A=1}^{N_n}\frac{Z_A}{r_{iA}} + \mathcal{V}_{en} = -\sum_{i=1}^{N_e}\sum_{A=1}^{N_n}\frac{Z_A}{r_{iA}} \] where \(\mathcal{V}_{en}\) is the ~en~ potential, \[r_{iA}\] the ~en~ @@ -1289,7 +1289,7 @@ integer function qmckl_compute_en_potential_f(context, elec_num, nucl_num, walk_ do nw=1,walk_num do j=1,nucl_num do i=1,elec_num - en_pot(nw) = en_pot(nw) + charge(j)/(en_distance(i,j,nw)) + en_pot(nw) = en_pot(nw) - charge(j)/(en_distance(i,j,nw)) end do end do end do From 705af0b084e230475a90e1274fef10dae592dea8 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 16:06:23 +0200 Subject: [PATCH 20/68] Working on local energy. #41 --- org/qmckl_context.org | 3 + org/qmckl_determinant.org | 112 +++++++++++++++++++++++++++++--------- org/table_of_contents | 1 + 3 files changed, 89 insertions(+), 27 deletions(-) diff --git a/org/qmckl_context.org b/org/qmckl_context.org index 01e18f6..578cb55 100644 --- a/org/qmckl_context.org +++ b/org/qmckl_context.org @@ -34,11 +34,13 @@ int main() { #include "qmckl_mo_private_type.h" #include "qmckl_jastrow_private_type.h" #include "qmckl_determinant_private_type.h" +#include "qmckl_local_energy_private_type.h" #include "qmckl_nucleus_private_func.h" #include "qmckl_electron_private_func.h" #include "qmckl_ao_private_func.h" #include "qmckl_mo_private_func.h" #include "qmckl_determinant_private_func.h" +#include "qmckl_local_energy_private_func.h" #+end_src #+begin_src c :tangle (eval c) @@ -126,6 +128,7 @@ typedef struct qmckl_context_struct { qmckl_mo_basis_struct mo_basis; qmckl_jastrow_struct jastrow; qmckl_determinant_struct det; + qmckl_local_energy_struct local_energy; /* To be implemented: ,*/ diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 4f78364..d7c17f1 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -672,6 +672,8 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { ctx->det.det_num_alpha, ctx->det.walk_num, ctx->electron.up_num, + ctx->electron.down_num, + ctx->electron.num, ctx->det.mo_index_alpha, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, @@ -760,7 +762,9 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { rc = qmckl_compute_det_vgl_beta(context, ctx->det.det_num_beta, ctx->det.walk_num, + ctx->electron.up_num, ctx->electron.down_num, + ctx->electron.num, ctx->det.mo_index_beta, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, @@ -790,17 +794,20 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { #+NAME: qmckl_compute_det_vgl_alpha_args | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~det_num_alpha_alpha~ | in | Number of determinants | + | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | | ~int64_t~ | ~walk_num~ | in | Number of walkers | | ~int64_t~ | ~alpha_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_index_alpha[det_num_alpha_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~elec_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][alpha_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_vgl_alpha[det_num_alpha_alpha][walk_num][5][alpha_num][alpha_num]~ | out | Value, gradients and Laplacian of the Det | + | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][alpha_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_vgl_alpha_f(context, & - det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) & + det_num_alpha, walk_num, alpha_num, beta_num, elec_num, & + mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) & result(info) use qmckl implicit none @@ -808,9 +815,11 @@ integer function qmckl_compute_det_vgl_alpha_f(context, & integer*8, intent(in) :: det_num_alpha integer*8, intent(in) :: walk_num integer*8, intent(in) :: alpha_num + integer*8, intent(in) :: beta_num + integer*8, intent(in) :: elec_num integer*8, intent(in) :: mo_num integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) - double precision, intent(in) :: mo_vgl(mo_num, alpha_num, walk_num, 5) + double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) double precision, intent(inout) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) integer*8 :: idet, iwalk, ielec, mo_id, imo @@ -858,7 +867,7 @@ integer function qmckl_compute_det_vgl_alpha_f(context, & end function qmckl_compute_det_vgl_alpha_f #+end_src - #+CALL: generate_c_header(table=qmckl_compute_det_vgl_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_alpha")) + #+CALL: generate_c_header(table=qmckl_compute_det_vgl_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_alpha")) #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org @@ -867,18 +876,29 @@ end function qmckl_compute_det_vgl_alpha_f const int64_t det_num_alpha, const int64_t walk_num, const int64_t alpha_num, + const int64_t beta_num, + const int64_t elec_num, const int64_t* mo_index_alpha, const int64_t mo_num, const double* mo_vgl, double* const det_vgl_alpha ); #+end_src - #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_alpha")) + #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_alpha")) #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_det_vgl_alpha & - (context, det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) & + (context, & + det_num_alpha, & + walk_num, & + alpha_num, & + beta_num, & + elec_num, & + mo_index_alpha, & + mo_num, & + mo_vgl, & + det_vgl_alpha) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -888,14 +908,25 @@ end function qmckl_compute_det_vgl_alpha_f integer (c_int64_t) , intent(in) , value :: det_num_alpha integer (c_int64_t) , intent(in) , value :: walk_num integer (c_int64_t) , intent(in) , value :: alpha_num + integer (c_int64_t) , intent(in) , value :: beta_num + integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,alpha_num,walk_num,5) + real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) real (c_double ) , intent(out) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha) integer(c_int32_t), external :: qmckl_compute_det_vgl_alpha_f info = qmckl_compute_det_vgl_alpha_f & - (context, det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) + (context, & + det_num_alpha, & + walk_num, & + alpha_num, & + beta_num, & + elec_num, & + mo_index_alpha, & + mo_num, & + mo_vgl, & + det_vgl_alpha) end function qmckl_compute_det_vgl_alpha #+end_src @@ -908,28 +939,33 @@ end function qmckl_compute_det_vgl_alpha_f :END: #+NAME: qmckl_compute_det_vgl_beta_args - | ~qmckl_context~ | ~context~ | in | Global state | + | ~qmckl_context~ | ~context~ | in | Global state | | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~elec_num~ | in | Number of electrons | | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][beta_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_vgl_beta_f(context, & - det_num_beta, walk_num, beta_num, mo_index_beta, mo_num, mo_vgl, det_vgl_beta) & + det_num_beta, walk_num, alpha_num, beta_num, elec_num, & + mo_index_beta, mo_num, mo_vgl, det_vgl_beta) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context integer*8, intent(in) :: det_num_beta integer*8, intent(in) :: walk_num + integer*8, intent(in) :: alpha_num integer*8, intent(in) :: beta_num + integer*8, intent(in) :: elec_num integer*8, intent(in) :: mo_num integer*8, intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) - double precision, intent(in) :: mo_vgl(mo_num, beta_num, walk_num, 5) + double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) double precision, intent(inout) :: det_vgl_beta(beta_num, beta_num, 5, walk_num, det_num_beta) integer*8 :: idet, iwalk, ielec, mo_id, imo @@ -956,19 +992,19 @@ integer function qmckl_compute_det_vgl_beta_f(context, & do imo = 1, beta_num mo_id = mo_index_beta(imo, iwalk, idet) ! Value - det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 1) + det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 1) ! Grad_x - det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 2) + det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 2) ! Grad_y - det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 3) + det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 3) ! Grad_z - det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 4) + det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 4) ! Lap - det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 5) + det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 5) end do end do end do @@ -985,19 +1021,30 @@ end function qmckl_compute_det_vgl_beta_f const qmckl_context context, const int64_t det_num_beta, const int64_t walk_num, + const int64_t alpha_num, const int64_t beta_num, + const int64_t elec_num, const int64_t* mo_index_beta, const int64_t mo_num, const double* mo_vgl, double* const det_vgl_beta ); #+end_src - + #+CALL: generate_c_interface(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta")) #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_det_vgl_beta & - (context, det_num_beta, walk_num, beta_num, mo_index_beta, mo_num, mo_vgl, det_vgl_beta) & + (context, & + det_num_beta, & + walk_num, & + alpha_num, & + beta_num, & + elec_num, & + mo_index_beta, & + mo_num, & + mo_vgl, & + det_vgl_beta) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -1006,15 +1053,26 @@ end function qmckl_compute_det_vgl_beta_f integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: det_num_beta integer (c_int64_t) , intent(in) , value :: walk_num + integer (c_int64_t) , intent(in) , value :: alpha_num integer (c_int64_t) , intent(in) , value :: beta_num + integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,beta_num,walk_num,5) + real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) real (c_double ) , intent(out) :: det_vgl_beta(beta_num,beta_num,5,walk_num,det_num_beta) integer(c_int32_t), external :: qmckl_compute_det_vgl_beta_f info = qmckl_compute_det_vgl_beta_f & - (context, det_num_beta, walk_num, beta_num, mo_index_beta, mo_num, mo_vgl, det_vgl_beta) + (context, & + det_num_beta, & + walk_num, & + alpha_num, & + beta_num, & + elec_num, & + mo_index_beta, & + mo_num, & + mo_vgl, & + det_vgl_beta) end function qmckl_compute_det_vgl_beta #+end_src diff --git a/org/table_of_contents b/org/table_of_contents index 55dd6b7..a632c83 100644 --- a/org/table_of_contents +++ b/org/table_of_contents @@ -7,6 +7,7 @@ qmckl_distance.org qmckl_electron.org qmckl_error.org qmckl_jastrow.org +qmckl_local_energy.org qmckl_memory.org qmckl_mo.org qmckl_numprec.org From 9722f09221303063c05900a34e63584b8734f17b Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 16:12:14 +0200 Subject: [PATCH 21/68] Add org file. #41 --- org/qmckl_local_energy.org | 535 +++++++++++++++++++++++++++++++++++++ 1 file changed, 535 insertions(+) create mode 100644 org/qmckl_local_energy.org diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org new file mode 100644 index 0000000..b601321 --- /dev/null +++ b/org/qmckl_local_energy.org @@ -0,0 +1,535 @@ +#+TITLE: Local Energy +#+SETUPFILE: ../tools/theme.setup +#+INCLUDE: ../tools/lib.org + + +Here we calculate the final expectation value of the +local energy \[E_L\] as the sum of the kinetic energy and potential energy. + +\[ +E_L = KE + PE +\] + +Where the kinetic energy is given as: + +\[ +KE = -\frac{1}{2}\frac{\bigtriangleup \Psi}{\Psi} +\] + +The laplacian of the wavefunction in the single-determinant +case is given as follows: + +\[ +\frac{\bigtriangleup \Psi(r)}{\Psi(r)} = \sum_{j=1}^{N_e} \bigtriangleup \Phi_j(r_i) D_{ji}^{-1}(r) +\] + +The potential energy is the sum of all the following terms + +\[ +PE = \mathcal{V}_{ee} + \mathcal{V}_{en} + \mathcal{V}_{nn} +\] + +The potential for is calculated as the sum of single electron +contributions. + +\[ +\mathcal{V}_{ee} = \sum_{i=1}^{N_e}\sum_{j + #+end_src + + #+begin_src c :tangle (eval c_test) :noweb yes +#include "qmckl.h" +#include "assert.h" +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include +#include +#include "chbrclf.h" +#include "qmckl_ao_private_func.h" +#include "qmckl_mo_private_func.h" +#include "qmckl_determinant_private_func.h" + +int main() { + qmckl_context context; + context = qmckl_context_create(); + + qmckl_exit_code rc; + #+end_src + + #+begin_src c :tangle (eval c) +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#ifdef HAVE_STDINT_H +#include +#elif HAVE_INTTYPES_H +#include +#endif + +#include +#include +#include +#include + +#include "qmckl.h" +#include "qmckl_context_private_type.h" +#include "qmckl_memory_private_type.h" +#include "qmckl_memory_private_func.h" +#include "qmckl_ao_private_type.h" +#include "qmckl_ao_private_func.h" +#include "qmckl_mo_private_type.h" +#include "qmckl_mo_private_func.h" +#include "qmckl_determinant_private_type.h" +#include "qmckl_determinant_private_func.h" + #+end_src + +* Context + + The following arrays are stored in the context: + + |------------------+------------------------------------------------+------------------------------------| + + Computed data: + + |--------------+-----------------+----------------------------| + | ~e_kin~ | ~[walk_num]~ | total kinetic energy | + | ~e_pot~ | ~[walk_num]~ | total potential energy | + | ~e_local~ | ~[walk_num]~ | local energy | + | ~r_drift~ | ~[3][walk_num]~ | The drift vector | + | ~y_move~ | ~[3][walk_num]~ | The diffusion move | + | ~accep_prob~ | ~[walk_num]~ | The acceptance probability | + |--------------+-----------------+----------------------------| + +** Data structure + + #+begin_src c :comments org :tangle (eval h_private_type) +typedef struct qmckl_local_energy_struct { + double * e_kin; + double * e_pot; + double * e_local; + double * accep_prob; + double * r_drift; + double * y_move; + int64_t e_kin_date; + int64_t e_pot_date; + int64_t e_local_date; + int64_t accep_prob_date; + int64_t r_drift_date; + int64_t y_move_date; + + int32_t uninitialized; + bool provided; +} qmckl_local_energy_struct; + #+end_src + + The ~uninitialized~ integer contains one bit set to one for each + initialization function which has not been called. It becomes equal + to zero after all initialization functions have been called. The + struct is then initialized and ~provided == true~. + Some values are initialized by default, and are not concerned by + this mechanism. + +* Computation +** Kinetic energy + :PROPERTIES: + :Name: qmckl_compute_kinetic_energy + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_kinetic_energy(qmckl_context context, double* const kinetic_energy); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_kinetic_energy(qmckl_context context, double * const kinetic_energy) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + if(!qmckl_electron_provided(context)) return QMCKL_NOT_PROVIDED; + + if(!qmckl_nucleus_provided(context)) return QMCKL_NOT_PROVIDED; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_kinetic_energy(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->electron.walk_num * sizeof(double); + memcpy(kinetic_energy, ctx->local_energy.e_kin, sze); + + return QMCKL_SUCCESS; +} + #+end_src + + +*** Provide + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if(!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if (!ctx->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + + if (!ctx->mo_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + if (!ctx->det.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->local_energy.e_kin_date) { + + /* Allocate array */ + if (ctx->local_energy.e_kin == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* e_kin = (double*) qmckl_malloc(context, mem_info); + + if (e_kin == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_e_kin", + NULL); + } + ctx->local_energy.e_kin = e_kin; + } + + qmckl_exit_code rc; + if (ctx->det.type == 'G') { + rc = qmckl_compute_kinetic_energy(context, + ctx->det.walk_num, + ctx->det.det_num_alpha, + ctx->det.det_num_beta, + ctx->electron.up_num, + ctx->electron.down_num, + ctx->electron.num, + ctx->det.mo_index_alpha, + ctx->det.mo_index_beta, + ctx->mo_basis.mo_num, + ctx->mo_basis.mo_vgl, + ctx->det.det_vgl_alpha, + ctx->det.det_vgl_beta, + ctx->local_energy.e_kin); + } else { + return qmckl_failwith( context, + QMCKL_FAILURE, + "compute_kinetic_energy", + "Not yet implemented"); + } + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->local_energy.e_kin_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src +*** Compute alpha + :PROPERTIES: + :Name: qmckl_compute_kinetic_energy + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_compute_kinetic_energy_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | + | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~elec_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~e_kin[walk_num]~ | out | Kinetic energy | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_kinetic_energy_f(context, walk_num, & + det_num_alpha, det_num_beta, alpha_num, beta_num, elec_num, mo_index_alpha, mo_index_beta, & + mo_num, mo_vgl, det_vgl_alpha, det_vgl_beta, e_kin) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: walk_num + integer*8, intent(in) :: det_num_alpha + integer*8, intent(in) :: det_num_beta + integer*8, intent(in) :: alpha_num + integer*8, intent(in) :: beta_num + integer*8, intent(in) :: elec_num + integer*8, intent(in) :: mo_num + integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) + integer*8, intent(in) :: mo_index_beta(beta_num, walk_num, det_num_beta) + double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) + double precision, intent(in) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) + double precision, intent(in) :: det_vgl_beta(beta_num, beta_num, 5, walk_num, det_num_beta) + double precision, intent(inout) :: e_kin(walk_num) + integer*8 :: idet, iwalk, ielec, mo_id, imo + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (alpha_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + if (beta_num < 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (elec_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + idet = 1 + e_kin = 0.0d0 + do iwalk = 1, walk_num + ! Alpha part + do ielec = 1, alpha_num + mo_id = mo_index_beta(ielec, iwalk, idet) + end do + end do + +end function qmckl_compute_kinetic_energy_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_compute_kinetic_energy_args,rettyp=get_value("CRetType"),fname="qmckl_compute_kinetic_energy")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_kinetic_energy ( + const qmckl_context context, + const int64_t walk_num, + const int64_t det_num_alpha, + const int64_t det_num_beta, + const int64_t alpha_num, + const int64_t beta_num, + const int64_t elec_num, + const int64_t* mo_index_alpha, + const int64_t* mo_index_beta, + const int64_t mo_num, + const double* mo_vgl, + const double* det_vgl_alpha, + const double* det_vgl_beta, + double* const e_kin ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_compute_kinetic_energy_args,rettyp=get_value("CRetType"),fname="qmckl_compute_kinetic_energy")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_kinetic_energy & + (context, & + walk_num, & + det_num_alpha, & + det_num_beta, & + alpha_num, & + beta_num, & + elec_num, & + mo_index_alpha, & + mo_index_beta, & + mo_num, & + mo_vgl, & + det_vgl_alpha, & + det_vgl_beta, & + e_kin) & + 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 :: walk_num + integer (c_int64_t) , intent(in) , value :: det_num_alpha + integer (c_int64_t) , intent(in) , value :: det_num_beta + integer (c_int64_t) , intent(in) , value :: alpha_num + integer (c_int64_t) , intent(in) , value :: beta_num + integer (c_int64_t) , intent(in) , value :: elec_num + integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) + integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) + integer (c_int64_t) , intent(in) , value :: mo_num + real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) + real (c_double ) , intent(in) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha) + real (c_double ) , intent(in) :: det_vgl_beta(beta_num,beta_num,5,walk_num,det_num_beta) + real (c_double ) , intent(out) :: e_kin(walk_num) + + integer(c_int32_t), external :: qmckl_compute_kinetic_energy_f + info = qmckl_compute_kinetic_energy_f & + (context, & + walk_num, & + det_num_alpha, & + det_num_beta, & + alpha_num, & + beta_num, & + elec_num, & + mo_index_alpha, & + mo_index_beta, & + mo_num, & + mo_vgl, & + det_vgl_alpha, & + det_vgl_beta, & + e_kin) + + end function qmckl_compute_kinetic_energy + #+end_src + +*** Test + +* End of files :noexport: + + #+begin_src c :tangle (eval h_private_type) +#endif + #+end_src + +*** Test + #+begin_src c :tangle (eval c_test) + rc = qmckl_context_destroy(context); + assert (rc == QMCKL_SUCCESS); + + return 0; +} + #+end_src + +*** Compute file names + #+begin_src emacs-lisp +; The following is required to compute the file names + +(setq pwd (file-name-directory buffer-file-name)) +(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) +(setq f (concat pwd name "_f.f90")) +(setq fh (concat pwd name "_fh.f90")) +(setq c (concat pwd name ".c")) +(setq h (concat name ".h")) +(setq h_private (concat name "_private.h")) +(setq c_test (concat pwd "test_" name ".c")) +(setq f_test (concat pwd "test_" name "_f.f90")) + +; Minted +(require 'ox-latex) +(setq org-latex-listings 'minted) +(add-to-list 'org-latex-packages-alist '("" "listings")) +(add-to-list 'org-latex-packages-alist '("" "color")) + + #+end_src + + +# -*- mode: org -*- +# vim: syntax=c From 9d542238e305dde9ca92d9124cf28db356ea031c Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 17:37:25 +0200 Subject: [PATCH 22/68] Finished KE. #41 --- org/qmckl_local_energy.org | 50 ++++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 18 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index b601321..ce47b89 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -307,8 +307,8 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { ctx->det.mo_index_beta, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, - ctx->det.det_vgl_alpha, - ctx->det.det_vgl_beta, + ctx->det.det_adj_matrix_alpha, + ctx->det.det_adj_matrix_beta, ctx->local_energy.e_kin); } else { return qmckl_failwith( context, @@ -326,7 +326,8 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { return QMCKL_SUCCESS; } #+end_src -*** Compute alpha + +*** Compute kinetic enregy :PROPERTIES: :Name: qmckl_compute_kinetic_energy :CRetType: qmckl_exit_code @@ -345,14 +346,14 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~e_kin[walk_num]~ | out | Kinetic energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_kinetic_energy_f(context, walk_num, & det_num_alpha, det_num_beta, alpha_num, beta_num, elec_num, mo_index_alpha, mo_index_beta, & - mo_num, mo_vgl, det_vgl_alpha, det_vgl_beta, e_kin) & + mo_num, mo_vgl, det_adj_matrix_alpha, det_adj_matrix_beta, e_kin) & result(info) use qmckl implicit none @@ -367,8 +368,8 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) integer*8, intent(in) :: mo_index_beta(beta_num, walk_num, det_num_beta) double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) - double precision, intent(in) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) - double precision, intent(in) :: det_vgl_beta(beta_num, beta_num, 5, walk_num, det_num_beta) + double precision, intent(in) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) + double precision, intent(in) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) double precision, intent(inout) :: e_kin(walk_num) integer*8 :: idet, iwalk, ielec, mo_id, imo @@ -399,13 +400,26 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & return endif - idet = 1 e_kin = 0.0d0 + do idet = 1, det_num_alpha do iwalk = 1, walk_num ! Alpha part + do imo = 1, alpha_num do ielec = 1, alpha_num - mo_id = mo_index_beta(ielec, iwalk, idet) + mo_id = mo_index_alpha(ielec, iwalk, idet) + e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, ielec, iwalk, 5) end do + end do + ! Beta part + do imo = 1, beta_num + do ielec = 1, beta_num + mo_id = mo_index_beta(ielec, iwalk, idet) + e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, alpha_num + ielec, iwalk, 5) + end do + end do + end do end do end function qmckl_compute_kinetic_energy_f @@ -427,8 +441,8 @@ end function qmckl_compute_kinetic_energy_f const int64_t* mo_index_beta, const int64_t mo_num, const double* mo_vgl, - const double* det_vgl_alpha, - const double* det_vgl_beta, + const double* det_adj_matrix_alpha, + const double* det_adj_matrix_beta, double* const e_kin ); #+end_src @@ -448,8 +462,8 @@ end function qmckl_compute_kinetic_energy_f mo_index_beta, & mo_num, & mo_vgl, & - det_vgl_alpha, & - det_vgl_beta, & + det_adj_matrix_alpha, & + det_adj_matrix_beta, & e_kin) & bind(C) result(info) @@ -467,8 +481,8 @@ end function qmckl_compute_kinetic_energy_f integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) integer (c_int64_t) , intent(in) , value :: mo_num real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) - real (c_double ) , intent(in) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha) - real (c_double ) , intent(in) :: det_vgl_beta(beta_num,beta_num,5,walk_num,det_num_beta) + real (c_double ) , intent(in) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) + real (c_double ) , intent(in) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) real (c_double ) , intent(out) :: e_kin(walk_num) integer(c_int32_t), external :: qmckl_compute_kinetic_energy_f @@ -484,8 +498,8 @@ end function qmckl_compute_kinetic_energy_f mo_index_beta, & mo_num, & mo_vgl, & - det_vgl_alpha, & - det_vgl_beta, & + det_adj_matrix_alpha, & + det_adj_matrix_beta, & e_kin) end function qmckl_compute_kinetic_energy From 5e67d1a0a2b1b621cbef52386cc708f6bfc8a57a Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 17:47:19 +0200 Subject: [PATCH 23/68] Done potential energy. #41 --- org/qmckl_electron.org | 4 +- org/qmckl_local_energy.org | 244 ++++++++++++++++++++++++++++++++++++- 2 files changed, 245 insertions(+), 3 deletions(-) diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index 832ac97..3c59e6b 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -87,8 +87,8 @@ int main() { | ~ee_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | | ~ee_distance_rescaled_deriv_e~ | ~double[walk_num][4][num][num]~ | Electron-electron rescaled distances derivatives | | ~ee_distance_rescaled_deriv_e_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | - | ~ee_pot~ | ~double[walk_num][4][num][num]~ | Electron-electron rescaled distances derivatives | - | ~ee_pot_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | + | ~ee_pot~ | ~double[walk_num]~ | Electron-electron rescaled distances derivatives | + | ~ee_pot_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | | ~en_distance_rescaled~ | ~double[walk_num][nucl_num][num]~ | Electron-nucleus distances | | ~en_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | | ~en_distance_rescaled_deriv_e~ | ~double[walk_num][4][nucl_num][num]~ | Electron-electron rescaled distances derivatives | diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index ce47b89..f921b92 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -223,7 +223,6 @@ qmckl_exit_code qmckl_get_kinetic_energy(qmckl_context context, double * const k } #+end_src - *** Provide #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none @@ -507,6 +506,249 @@ end function qmckl_compute_kinetic_energy_f *** Test +** Potential energy + :PROPERTIES: + :Name: qmckl_compute_potential_energy + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_potential_energy(qmckl_context context, double* const potential_energy); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_potential_energy(qmckl_context context, double * const potential_energy) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + if(!qmckl_electron_provided(context)) return QMCKL_NOT_PROVIDED; + + if(!qmckl_nucleus_provided(context)) return QMCKL_NOT_PROVIDED; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_potential_energy(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->electron.walk_num * sizeof(double); + memcpy(potential_energy, ctx->local_energy.e_kin, sze); + + return QMCKL_SUCCESS; +} + #+end_src + +*** Provide + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if(!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if (!ctx->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + + if (!ctx->mo_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + if (!ctx->det.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->local_energy.e_kin_date) { + + /* Allocate array */ + if (ctx->local_energy.e_kin == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* e_kin = (double*) qmckl_malloc(context, mem_info); + + if (e_kin == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_e_kin", + NULL); + } + ctx->local_energy.e_kin = e_kin; + } + + qmckl_exit_code rc; + if (ctx->det.type == 'G') { + rc = qmckl_compute_potential_energy(context, + ctx->det.walk_num, + ctx->electron.num, + ctx->nucleus.num, + ctx->electron.ee_pot, + ctx->nucleus.en_pot, + ctx->nucleus.repulsion, + ctx->local_energy.e_kin); + } else { + return qmckl_failwith( context, + QMCKL_FAILURE, + "compute_potential_energy", + "Not yet implemented"); + } + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->local_energy.e_kin_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute potential enregy + :PROPERTIES: + :Name: qmckl_compute_potential_energy + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_compute_potential_energy_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~elec_num~ | in | Number of electrons | + | ~int64_t~ | ~nucl_num~ | in | Number of MOs | + | ~double~ | ~ee_pot[walk_num]~ | in | ee potential | + | ~double~ | ~en_pot[walk_num]~ | in | en potential | + | ~double~ | ~repulsion~ | in | en potential | + | ~double~ | ~e_pot[walk_num]~ | out | Potential energy | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_potential_energy_f(context, walk_num, & + elec_num, nucl_num, ee_pot, en_pot, repulsion, e_pot) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: walk_num + integer*8, intent(in) :: elec_num + integer*8, intent(in) :: nucl_num + double precision, intent(in) :: ee_pot(walk_num) + double precision, intent(in) :: en_pot(walk_num) + double precision, intent(in) :: repulsion + double precision, intent(inout) :: e_pot(walk_num) + integer*8 :: idet, iwalk, ielec, mo_id, imo + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (elec_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + e_pot = 0.0d0 + repulsion + do iwalk = 1, walk_num + e_pot(iwalk) = e_pot(iwalk) + ee_pot(iwalk) + en_pot(iwalk) + end do + +end function qmckl_compute_potential_energy_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_compute_potential_energy_args,rettyp=get_value("CRetType"),fname="qmckl_compute_potential_energy")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_potential_energy ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const int64_t nucl_num, + const double* ee_pot, + const double* en_pot, + const double repulsion, + double* const e_pot ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_compute_potential_energy_args,rettyp=get_value("CRetType"),fname="qmckl_compute_potential_energy")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_potential_energy & + (context, walk_num, elec_num, nucl_num, ee_pot, en_pot, repulsion, e_pot) & + 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 :: walk_num + integer (c_int64_t) , intent(in) , value :: elec_num + integer (c_int64_t) , intent(in) , value :: nucl_num + real (c_double ) , intent(in) :: ee_pot(walk_num) + real (c_double ) , intent(in) :: en_pot(walk_num) + real (c_double ) , intent(in) , value :: repulsion + real (c_double ) , intent(out) :: e_pot(walk_num) + + integer(c_int32_t), external :: qmckl_compute_potential_energy_f + info = qmckl_compute_potential_energy_f & + (context, walk_num, elec_num, nucl_num, ee_pot, en_pot, repulsion, e_pot) + + end function qmckl_compute_potential_energy + #+end_src + +*** Test * End of files :noexport: #+begin_src c :tangle (eval h_private_type) From 131e5102919eb77dddfc06aff621215dc39e4600 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 18:32:00 +0200 Subject: [PATCH 24/68] Removed `walk_num` from MO dims. #41 --- org/qmckl_blas.org | 4 ++-- org/qmckl_mo.org | 57 +++++++++++++++++++++++----------------------- 2 files changed, 30 insertions(+), 31 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index 23ca6e1..b545312 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -168,7 +168,7 @@ integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA, endif end function qmckl_dgemm_f #+end_src - + *** C interface :noexport: #+CALL: generate_c_interface(table=qmckl_dgemm_args,rettyp="qmckl_exit_code",fname="qmckl_dgemm") @@ -308,7 +308,7 @@ assert(QMCKL_SUCCESS == test_qmckl_dgemm(context)); #+end_src ** ~qmckl_invert~ - + Matrix invert. Given a matrix M, returns a matrix M⁻¹ such that: diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index 57ac505..f80f892 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -87,7 +87,7 @@ int main() { |---------------+-----------------------------------+----------------------------------------------------------------------------------------| |---------------+-----------------------------------+----------------------------------------------------------------------------------------| - | ~mo_vgl~ | ~[5][walk_num][elec_num][mo_num]~ | Value, gradients, Laplacian of the MOs at electron positions | + | ~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 | |---------------+-----------------------------------+----------------------------------------------------------------------------------------| @@ -319,7 +319,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 * ctx->electron.walk_num; + size_t sze = 5 * ctx->electron.num * ctx->mo_basis.mo_num; memcpy(mo_vgl, ctx->mo_basis.mo_vgl, sze * sizeof(double)); return QMCKL_SUCCESS; @@ -385,8 +385,7 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) 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 * - ctx->electron.walk_num * sizeof(double); + mem_info.size = 5 * ctx->electron.num * ctx->mo_basis.mo_num * sizeof(double); double* mo_vgl = (double*) qmckl_malloc(context, mem_info); if (mo_vgl == NULL) { @@ -404,7 +403,6 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) ctx->ao_basis.ao_num, ctx->mo_basis.mo_num, ctx->electron.num, - ctx->electron.walk_num, ctx->mo_basis.coefficient, ctx->ao_basis.ao_vgl, ctx->mo_basis.mo_vgl); @@ -433,18 +431,17 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) :END: #+NAME: qmckl_mo_basis_gaussian_vgl_args - | ~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~ | ~walk_num~ | in | Number of walkers | - | ~double~ | ~coef_normalized[ao_num][mo_num]~ | in | AO to MO transformation matrix | - | ~double~ | ~ao_vgl[5][walk_num][elec_num][ao_num]~ | in | Value, gradients and Laplacian of the AOs | - | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | out | Value, gradients and Laplacian of the MOs | + | ~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 | + | ~double~ | ~coef_normalized[ao_num][mo_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 | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & - ao_num, mo_num, elec_num, walk_num, & + ao_num, mo_num, elec_num, & coef_normalized, ao_vgl, mo_vgl) & result(info) use qmckl @@ -452,12 +449,12 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & integer(qmckl_context), intent(in) :: context integer*8 , intent(in) :: ao_num, mo_num integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: walk_num - double precision , intent(in) :: ao_vgl(ao_num,elec_num,walk_num,5) + double precision , intent(in) :: ao_vgl(ao_num,elec_num,5) double precision , intent(in) :: coef_normalized(mo_num,ao_num) - double precision , intent(out) :: mo_vgl(mo_num,elec_num,walk_num,5) + double precision , intent(out) :: mo_vgl(mo_num,elec_num,5) logical*8 :: TransA, TransB double precision,dimension(:,:),allocatable :: mo_vgl_big + double precision,dimension(:,:),allocatable :: ao_vgl_big double precision :: alpha, beta integer :: info_qmckl_dgemm_value integer :: info_qmckl_dgemm_Gx @@ -469,7 +466,8 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & 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*walk_num*5)) + allocate(mo_vgl_big(mo_num,elec_num*5)) + allocate(ao_vgl_big(ao_num,elec_num*5)) TransA = .False. TransB = .False. @@ -483,20 +481,23 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & ! TODO : Use numerical precision here cutoff = -dlog(1.d-15) M = mo_num - N = elec_num*walk_num*5 + N = elec_num*5 K = ao_num * 1_8 LDA = M LDB = K LDC = M + ao_vgl_big = reshape(ao_vgl(:, :, :),(/ao_num, elec_num*5_8/)) + info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, & - coef_normalized(1:mo_num,1:ao_num),size(coef_normalized,1) * 1_8, & - reshape(ao_vgl(:,:, :, :),(/ao_num,elec_num*walk_num*5/)), LDB, & + coef_normalized,size(coef_normalized,1) * 1_8, & + ao_vgl_big, LDB, & beta, & - mo_vgl_big(:,:),LDC) - mo_vgl = reshape(mo_vgl_big,(/mo_num,elec_num,walk_num,5_8/)) + 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_gaussian_vgl_f #+end_src @@ -509,7 +510,6 @@ end function qmckl_compute_mo_basis_gaussian_vgl_f const int64_t ao_num, const int64_t mo_num, const int64_t elec_num, - const int64_t walk_num, const double* coef_normalized, const double* ao_vgl, double* const mo_vgl ); @@ -521,7 +521,7 @@ end function qmckl_compute_mo_basis_gaussian_vgl_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_mo_basis_gaussian_vgl & - (context, ao_num, mo_num, elec_num, walk_num, coef_normalized, ao_vgl, mo_vgl) & + (context, ao_num, mo_num, elec_num, coef_normalized, ao_vgl, mo_vgl) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -531,14 +531,13 @@ end function qmckl_compute_mo_basis_gaussian_vgl_f 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 :: walk_num real (c_double ) , intent(in) :: coef_normalized(mo_num,ao_num) - real (c_double ) , intent(in) :: ao_vgl(ao_num,elec_num,walk_num,5) - real (c_double ) , intent(out) :: mo_vgl(mo_num,elec_num,walk_num,5) + real (c_double ) , intent(in) :: ao_vgl(ao_num,elec_num,5) + real (c_double ) , intent(out) :: mo_vgl(mo_num,elec_num,5) integer(c_int32_t), external :: qmckl_compute_mo_basis_gaussian_vgl_f info = qmckl_compute_mo_basis_gaussian_vgl_f & - (context, ao_num, mo_num, elec_num, walk_num, coef_normalized, ao_vgl, mo_vgl) + (context, ao_num, mo_num, elec_num, coef_normalized, ao_vgl, mo_vgl) end function qmckl_compute_mo_basis_gaussian_vgl #+end_src From 1be1317210c42bfeed729c908c5684949f6a8a08 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 18:39:18 +0200 Subject: [PATCH 25/68] Added local energy. #41 --- org/qmckl_local_energy.org | 252 ++++++++++++++++++++++++++++++++++--- 1 file changed, 237 insertions(+), 15 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index f921b92..9040693 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -135,7 +135,7 @@ int main() { The following arrays are stored in the context: - |------------------+------------------------------------------------+------------------------------------| + || Computed data: @@ -334,20 +334,20 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { :END: #+NAME: qmckl_compute_kinetic_energy_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | - | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | - | ~int64_t~ | ~alpha_num~ | in | Number of electrons | - | ~int64_t~ | ~beta_num~ | in | Number of electrons | - | ~int64_t~ | ~elec_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | - | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | + | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~elec_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~e_kin[walk_num]~ | out | Kinetic energy | + | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~e_kin[walk_num]~ | out | Kinetic energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_kinetic_energy_f(context, walk_num, & @@ -663,7 +663,7 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { | ~double~ | ~ee_pot[walk_num]~ | in | ee potential | | ~double~ | ~en_pot[walk_num]~ | in | en potential | | ~double~ | ~repulsion~ | in | en potential | - | ~double~ | ~e_pot[walk_num]~ | out | Potential energy | + | ~double~ | ~e_pot[walk_num]~ | out | Potential energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_potential_energy_f(context, walk_num, & @@ -748,6 +748,228 @@ end function qmckl_compute_potential_energy_f end function qmckl_compute_potential_energy #+end_src +*** Test +** Local energy + :PROPERTIES: + :Name: qmckl_compute_local_energy + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_local_energy(qmckl_context context, double* const local_energy); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_local_energy(qmckl_context context, double * const local_energy) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + if(!qmckl_electron_provided(context)) return QMCKL_NOT_PROVIDED; + + if(!qmckl_nucleus_provided(context)) return QMCKL_NOT_PROVIDED; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_local_energy(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->electron.walk_num * sizeof(double); + memcpy(local_energy, ctx->local_energy.e_kin, sze); + + return QMCKL_SUCCESS; +} + #+end_src + +*** Provide + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_local_energy(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_local_energy(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if(!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if (!ctx->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + + if (!ctx->mo_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + if (!ctx->det.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->local_energy.e_kin_date) { + + /* Allocate array */ + if (ctx->local_energy.e_kin == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* e_kin = (double*) qmckl_malloc(context, mem_info); + + if (e_kin == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_e_kin", + NULL); + } + ctx->local_energy.e_kin = e_kin; + } + + qmckl_exit_code rc; + if (ctx->det.type == 'G') { + rc = qmckl_compute_local_energy(context, + ctx->det.walk_num, + ctx->local_energy.e_kin, + ctx->local_energy.e_pot, + ctx->local_energy.e_local); + } else { + return qmckl_failwith( context, + QMCKL_FAILURE, + "compute_local_energy", + "Not yet implemented"); + } + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->local_energy.e_kin_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute local enregy + :PROPERTIES: + :Name: qmckl_compute_local_energy + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_compute_local_energy_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~double~ | ~e_kin[walk_num]~ | in | e kinetic | + | ~double~ | ~e_pot[walk_num]~ | in | e potential | + | ~double~ | ~e_local[walk_num]~ | out | local energy | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_local_energy_f(context, walk_num, & + e_kin, e_pot, e_local) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: walk_num + double precision, intent(in) :: e_kin(walk_num) + double precision, intent(in) :: e_pot(walk_num) + double precision, intent(inout) :: e_local(walk_num) + integer*8 :: idet, iwalk, ielec, mo_id, imo + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + do iwalk = 1, walk_num + e_local(iwalk) = e_local(iwalk) + e_kin(iwalk) + e_pot(iwalk) + end do + +end function qmckl_compute_local_energy_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_compute_local_energy_args,rettyp=get_value("CRetType"),fname="qmckl_compute_local_energy")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_local_energy ( + const qmckl_context context, + const int64_t walk_num, + const double* e_kin, + const double* e_pot, + double* const e_local ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_compute_local_energy_args,rettyp=get_value("CRetType"),fname="qmckl_compute_local_energy")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_local_energy & + (context, walk_num, e_kin, e_pot, e_local) & + 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 :: walk_num + real (c_double ) , intent(in) :: e_kin(walk_num) + real (c_double ) , intent(in) :: e_pot(walk_num) + real (c_double ) , intent(out) :: e_local(walk_num) + + integer(c_int32_t), external :: qmckl_compute_local_energy_f + info = qmckl_compute_local_energy_f & + (context, walk_num, e_kin, e_pot, e_local) + + end function qmckl_compute_local_energy + #+end_src + *** Test * End of files :noexport: From edc6e0a4f603f53928d645823862731e1d2866eb Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 18:48:48 +0200 Subject: [PATCH 26/68] Added doc for the three energies. #41 --- org/qmckl_local_energy.org | 41 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 9040693..afd5cac 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -185,6 +185,19 @@ typedef struct qmckl_local_energy_struct { :FRetType: qmckl_exit_code :END: +Where the kinetic energy is given as: + +\[ +KE = -\frac{1}{2}\frac{\bigtriangleup \Psi}{\Psi} +\] + +The laplacian of the wavefunction in the single-determinant +case is given as follows: + +\[ +\frac{\bigtriangleup \Psi(r)}{\Psi(r)} = \sum_{j=1}^{N_e} \bigtriangleup \Phi_j(r_i) D_{ji}^{-1}(r) +\] + *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes @@ -513,6 +526,27 @@ end function qmckl_compute_kinetic_energy_f :FRetType: qmckl_exit_code :END: +The potential energy is the sum of all the following terms + +\[ +PE = \mathcal{V}_{ee} + \mathcal{V}_{en} + \mathcal{V}_{nn} +\] + +The potential for is calculated as the sum of single electron +contributions. + +\[ +\mathcal{V}_{ee} = \sum_{i=1}^{N_e}\sum_{j Date: Mon, 11 Oct 2021 21:40:54 +0200 Subject: [PATCH 27/68] Implemented drift vector. #41 --- org/qmckl_local_energy.org | 344 ++++++++++++++++++++++++++++++++++++- 1 file changed, 343 insertions(+), 1 deletion(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index afd5cac..58f4753 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -346,7 +346,7 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { :FRetType: qmckl_exit_code :END: - #+NAME: qmckl_compute_kinetic_energy_args + #+NAME: qmckl_compute_kinetic_energy_args | ~qmckl_context~ | ~context~ | in | Global state | | ~int64_t~ | ~walk_num~ | in | Number of walkers | | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | @@ -1011,6 +1011,348 @@ end function qmckl_compute_local_energy_f end function qmckl_compute_local_energy #+end_src +*** Test +** Drift vector + :PROPERTIES: + :Name: qmckl_compute_drift_vector + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + +The local energy is the sum of kinetic and potential energies. + +\[ +E_L = KE + PE +\] + + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_drift_vector(qmckl_context context, double* const drift_vector); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_drift_vector(qmckl_context context, double * const drift_vector) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + if(!qmckl_electron_provided(context)) return QMCKL_NOT_PROVIDED; + + if(!qmckl_nucleus_provided(context)) return QMCKL_NOT_PROVIDED; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_drift_vector(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->electron.walk_num * 3 * sizeof(double); + memcpy(drift_vector, ctx->local_energy.r_drift, sze); + + return QMCKL_SUCCESS; +} + #+end_src + +*** Provide + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if(!(ctx->nucleus.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if(!(ctx->electron.provided)) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_electron", + NULL); + } + + if (!ctx->ao_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + + if (!ctx->mo_basis.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + if (!ctx->det.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->local_energy.r_drift_date) { + + /* Allocate array */ + if (ctx->local_energy.r_drift == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * 3 * sizeof(double); + double* r_drift = (double*) qmckl_malloc(context, mem_info); + + if (r_drift == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_r_drift", + NULL); + } + ctx->local_energy.r_drift = r_drift; + } + + qmckl_exit_code rc; + if (ctx->det.type == 'G') { + rc = qmckl_compute_drift_vector(context, + ctx->det.walk_num, + ctx->det.det_num_alpha, + ctx->det.det_num_beta, + ctx->electron.up_num, + ctx->electron.down_num, + ctx->electron.num, + ctx->det.mo_index_alpha, + ctx->det.mo_index_beta, + ctx->mo_basis.mo_num, + ctx->mo_basis.mo_vgl, + ctx->det.det_adj_matrix_alpha, + ctx->det.det_adj_matrix_beta, + ctx->local_energy.r_drift); + } else { + return qmckl_failwith( context, + QMCKL_FAILURE, + "compute_drift_vector", + "Not yet implemented"); + } + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->local_energy.r_drift_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute drift vector + :PROPERTIES: + :Name: qmckl_compute_drift_vector + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_compute_drift_vector_args + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | + | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~elec_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~r_drift[walk_num][3]~ | out | Kinetic energy | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_drift_vector_f(context, walk_num, & + det_num_alpha, det_num_beta, alpha_num, beta_num, elec_num, mo_index_alpha, mo_index_beta, & + mo_num, mo_vgl, det_adj_matrix_alpha, det_adj_matrix_beta, r_drift) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: walk_num + integer*8, intent(in) :: det_num_alpha + integer*8, intent(in) :: det_num_beta + integer*8, intent(in) :: alpha_num + integer*8, intent(in) :: beta_num + integer*8, intent(in) :: elec_num + integer*8, intent(in) :: mo_num + integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) + integer*8, intent(in) :: mo_index_beta(beta_num, walk_num, det_num_beta) + double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) + double precision, intent(in) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) + double precision, intent(in) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) + double precision, intent(inout) :: r_drift(3,walk_num) + integer*8 :: idet, iwalk, ielec, mo_id, imo + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (alpha_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + if (beta_num < 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (elec_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + r_drift = 0.0d0 + do idet = 1, det_num_alpha + do iwalk = 1, walk_num + ! Alpha part + do imo = 1, alpha_num + do ielec = 1, alpha_num + mo_id = mo_index_alpha(ielec, iwalk, idet) + r_drift(1,iwalk) = r_drift(1,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, ielec, iwalk, 2) + r_drift(2,iwalk) = r_drift(2,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, ielec, iwalk, 3) + r_drift(3,iwalk) = r_drift(3,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, ielec, iwalk, 4) + end do + end do + ! Beta part + do imo = 1, beta_num + do ielec = 1, beta_num + mo_id = mo_index_beta(ielec, iwalk, idet) + r_drift(1,iwalk) = r_drift(1,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, alpha_num + ielec, iwalk, 2) + r_drift(2,iwalk) = r_drift(2,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, alpha_num + ielec, iwalk, 3) + r_drift(3,iwalk) = r_drift(3,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, alpha_num + ielec, iwalk, 4) + end do + end do + end do + end do + +end function qmckl_compute_drift_vector_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_compute_drift_vector_args,rettyp=get_value("CRetType"),fname="qmckl_compute_drift_vector")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_drift_vector ( + const qmckl_context context, + const int64_t walk_num, + const int64_t det_num_alpha, + const int64_t det_num_beta, + const int64_t alpha_num, + const int64_t beta_num, + const int64_t elec_num, + const int64_t* mo_index_alpha, + const int64_t* mo_index_beta, + const int64_t mo_num, + const double* mo_vgl, + const double* det_adj_matrix_alpha, + const double* det_adj_matrix_beta, + double* const r_drift ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_compute_drift_vector_args,rettyp=get_value("CRetType"),fname="qmckl_compute_drift_vector")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_drift_vector & + (context, & + walk_num, & + det_num_alpha, & + det_num_beta, & + alpha_num, & + beta_num, & + elec_num, & + mo_index_alpha, & + mo_index_beta, & + mo_num, & + mo_vgl, & + det_adj_matrix_alpha, & + det_adj_matrix_beta, & + r_drift) & + 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 :: walk_num + integer (c_int64_t) , intent(in) , value :: det_num_alpha + integer (c_int64_t) , intent(in) , value :: det_num_beta + integer (c_int64_t) , intent(in) , value :: alpha_num + integer (c_int64_t) , intent(in) , value :: beta_num + integer (c_int64_t) , intent(in) , value :: elec_num + integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) + integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) + integer (c_int64_t) , intent(in) , value :: mo_num + real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) + real (c_double ) , intent(in) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) + real (c_double ) , intent(in) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) + real (c_double ) , intent(out) :: r_drift(3,walk_num) + + integer(c_int32_t), external :: qmckl_compute_drift_vector_f + info = qmckl_compute_drift_vector_f & + (context, & + walk_num, & + det_num_alpha, & + det_num_beta, & + alpha_num, & + beta_num, & + elec_num, & + mo_index_alpha, & + mo_index_beta, & + mo_num, & + mo_vgl, & + det_adj_matrix_alpha, & + det_adj_matrix_beta, & + r_drift) + + end function qmckl_compute_drift_vector + #+end_src + *** Test * End of files :noexport: From 5a875cbd2e9a1aad60ce5190bc16468c029135bb Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 11 Oct 2021 23:15:11 +0200 Subject: [PATCH 28/68] Corrected merge. #41 --- org/qmckl_mo.org | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index 377d77e..1dd7ea4 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -85,11 +85,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_date~ | ~uint64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions | + |---------------+-------------------------+----------------------------------------------------------------------------------------| ** Data structure @@ -452,7 +452,6 @@ integer function qmckl_compute_mo_basis_gaussian_vgl_f(context, & integer*8 , intent(in) :: elec_num double precision , intent(in) :: ao_vgl(ao_num,elec_num,5) double precision , intent(in) :: coef_normalized(mo_num,ao_num) - double precision , intent(out) :: mo_vgl(mo_num,elec_num,5) logical*8 :: TransA, TransB double precision,dimension(:,:),allocatable :: mo_vgl_big From eff9ed79540b551206e4358d017ddd04a135c5dd Mon Sep 17 00:00:00 2001 From: v1j4y Date: Tue, 12 Oct 2021 12:58:53 +0200 Subject: [PATCH 29/68] Working on tests for determinants.#41 --- org/qmckl_determinant.org | 209 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 199 insertions(+), 10 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index d7c17f1..9ea5d4b 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -594,7 +594,6 @@ qmckl_exit_code qmckl_get_det_vgl_beta(qmckl_context context, double * const det } #+end_src - *** Provide #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none @@ -793,15 +792,15 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { :END: #+NAME: qmckl_compute_det_vgl_alpha_args - | ~qmckl_context~ | ~context~ | in | Global state | - | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | - | ~int64_t~ | ~walk_num~ | in | Number of walkers | - | ~int64_t~ | ~alpha_num~ | in | Number of electrons | - | ~int64_t~ | ~beta_num~ | in | Number of electrons | - | ~int64_t~ | ~elec_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~elec_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][alpha_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -1078,6 +1077,196 @@ end function qmckl_compute_det_vgl_beta_f #+end_src *** Test + + #+begin_src c :tangle (eval c_test) :exports none +{ +#define walk_num chbrclf_walk_num +#define elec_num chbrclf_elec_num +#define shell_num chbrclf_shell_num +#define ao_num chbrclf_ao_num + +int64_t elec_up_num = chbrclf_elec_up_num; +int64_t elec_dn_num = chbrclf_elec_dn_num; +double* elec_coord = &(chbrclf_elec_coord[0][0][0]); +const int64_t nucl_num = chbrclf_nucl_num; +const double* nucl_charge = chbrclf_charge; +const double* nucl_coord = &(chbrclf_nucl_coord[0][0]); + +rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_electron_walk_num (context, walk_num); +assert (rc == QMCKL_SUCCESS); + +assert(qmckl_electron_provided(context)); + +rc = qmckl_set_electron_coord (context, 'N', elec_coord); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_nucleus_num (context, nucl_num); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_nucleus_charge(context, nucl_charge); +assert(rc == QMCKL_SUCCESS); + +assert(qmckl_nucleus_provided(context)); + +const int64_t * nucleus_index = &(chbrclf_basis_nucleus_index[0]); +const int64_t * nucleus_shell_num = &(chbrclf_basis_nucleus_shell_num[0]); +const int32_t * shell_ang_mom = &(chbrclf_basis_shell_ang_mom[0]); +const int64_t * shell_prim_num = &(chbrclf_basis_shell_prim_num[0]); +const int64_t * shell_prim_index = &(chbrclf_basis_shell_prim_index[0]); +const double * shell_factor = &(chbrclf_basis_shell_factor[0]); +const double * exponent = &(chbrclf_basis_exponent[0]); +const double * coefficient = &(chbrclf_basis_coefficient[0]); +const double * prim_factor = &(chbrclf_basis_prim_factor[0]); +const double * ao_factor = &(chbrclf_basis_ao_factor[0]); + +const char typ = 'G'; + +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_type (context, typ); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_num (context, chbrclf_shell_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_prim_num (context, chbrclf_prim_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_nucleus_index (context, nucleus_index); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_nucleus_shell_num (context, nucleus_shell_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_ang_mom (context, shell_ang_mom); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_factor (context, shell_factor); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_prim_num (context, shell_prim_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_prim_index (context, shell_prim_index); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_exponent (context, exponent); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_coefficient (context, coefficient); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_prim_factor (context, prim_factor); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_ao_basis_ao_num(context, chbrclf_ao_num); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_ao_basis_ao_factor (context, ao_factor); +assert(rc == QMCKL_SUCCESS); + +assert(qmckl_ao_basis_provided(context)); + + +double ao_vgl[5][walk_num][elec_num][chbrclf_ao_num]; + +rc = qmckl_get_ao_vgl(context, &(ao_vgl[0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +/* Set up MO data */ +rc = qmckl_set_mo_basis_type(context, typ); +assert (rc == QMCKL_SUCCESS); + +const int64_t mo_num = chbrclf_mo_num; +rc = qmckl_set_mo_basis_mo_num(context, mo_num); +assert (rc == QMCKL_SUCCESS); + +const double * mo_coefficient = &(chbrclf_mo_coef[0]); + +rc = qmckl_set_mo_basis_coefficient(context, mo_coefficient); +assert (rc == QMCKL_SUCCESS); + +assert(qmckl_mo_basis_provided(context)); + +double mo_vgl[5][elec_num][chbrclf_mo_num]; +rc = qmckl_get_mo_basis_vgl(context, &(mo_vgl[0][0][0])); +assert (rc == QMCKL_SUCCESS); + +// Test overlap of MO +//double point_x[10]; +//double point_y[10]; +//double point_z[10]; +//int32_t npoints=10; +//// obtain points +//double dr = 20./(npoints-1); +//double dr3 = dr*dr*dr; +// +//for (int i=0;i Date: Tue, 12 Oct 2021 12:59:17 +0200 Subject: [PATCH 30/68] removed print. #41 --- org/qmckl_determinant.org | 55 --------------------------------------- 1 file changed, 55 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 9ea5d4b..8df83e5 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1209,61 +1209,6 @@ double mo_vgl[5][elec_num][chbrclf_mo_num]; rc = qmckl_get_mo_basis_vgl(context, &(mo_vgl[0][0][0])); assert (rc == QMCKL_SUCCESS); -// Test overlap of MO -//double point_x[10]; -//double point_y[10]; -//double point_z[10]; -//int32_t npoints=10; -//// obtain points -//double dr = 20./(npoints-1); -//double dr3 = dr*dr*dr; -// -//for (int i=0;i Date: Tue, 12 Oct 2021 13:08:04 +0200 Subject: [PATCH 31/68] removed fermi_num. #41 --- org/qmckl_determinant.org | 71 +++++++++++++++++---------------------- 1 file changed, 31 insertions(+), 40 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 8df83e5..25e1bf6 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -102,7 +102,6 @@ int main() { | ~walk_num~ | ~int64_t~ | Number of walkers | | ~det_num_alpha~ | ~int64_t~ | Number of determinants per walker | | ~det_num_beta~ | ~int64_t~ | Number of determinants per walker | - | ~fermi_num~ | ~int64_t~ | Number of number of fermions | | ~mo_index_alpha~ | ~mo_index[det_num_alpha][walk_num][alpha_num]~ | Index of MOs for each walker | | ~mo_index_beta~ | ~mo_index[det_num_beta][walk_num][beta_num]~ | Index of MOs for each walker | @@ -140,7 +139,6 @@ typedef struct qmckl_determinant_struct { int64_t det_num_beta ; int64_t up_num; int64_t down_num; - int64_t fermi_num; int64_t* mo_index_alpha; int64_t* mo_index_beta; @@ -180,7 +178,6 @@ char qmckl_get_determinant_type (const qmckl_context context); int64_t qmckl_get_determinant_walk_num (const qmckl_context context); int64_t qmckl_get_determinant_det_num_alpha (const qmckl_context context); int64_t qmckl_get_determinant_det_num_beta (const qmckl_context context); -int64_t qmckl_get_determinant_fermi_num (const qmckl_context context); int64_t* qmckl_get_determinant_mo_index_alpha (const qmckl_context context); int64_t* qmckl_get_determinant_mo_index_beta (const qmckl_context context); #+end_src @@ -274,24 +271,6 @@ int64_t qmckl_get_determinant_det_num_beta (const qmckl_context context) { return ctx->det.det_num_beta; } -int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return (int64_t) 0; - } - - qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; - assert (ctx != NULL); - - int32_t mask = 1 << 4; - - if ( (ctx->det.uninitialized & mask) != 0) { - return (int64_t) 0; - } - - assert (ctx->det.fermi_num > (int64_t) 0); - return ctx->det.fermi_num; -} - int64_t* qmckl_get_determinant_mo_index_alpha (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; @@ -300,7 +279,7 @@ int64_t* qmckl_get_determinant_mo_index_alpha (const qmckl_context context) { qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - int32_t mask = 1 << 5; + int32_t mask = 1 << 4; if ( (ctx->det.uninitialized & mask) != 0) { return (int64_t) 0; @@ -318,7 +297,7 @@ int64_t* qmckl_get_determinant_mo_index_beta (const qmckl_context context) { qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - int32_t mask = 1 << 6; + int32_t mask = 1 << 5; if ( (ctx->det.uninitialized & mask) != 0) { return (int64_t) 0; @@ -340,7 +319,6 @@ qmckl_exit_code qmckl_set_determinant_type (const qmckl_context con qmckl_exit_code qmckl_set_determinant_walk_num (const qmckl_context context, const int64_t walk_num); qmckl_exit_code qmckl_set_determinant_det_num_alpha (const qmckl_context context, const int64_t det_num_alpha); qmckl_exit_code qmckl_set_determinant_det_num_beta (const qmckl_context context, const int64_t det_num_beta); -qmckl_exit_code qmckl_set_determinant_fermi_num (const qmckl_context context, const int64_t fermi_num); qmckl_exit_code qmckl_set_determinant_mo_index_alpha (const qmckl_context context, const int64_t* mo_index_alpha); qmckl_exit_code qmckl_set_determinant_mo_index_beta (const qmckl_context context, const int64_t* mo_index_beta); #+end_src @@ -431,22 +409,6 @@ qmckl_exit_code qmckl_set_determinant_det_num_beta(qmckl_context context, const <> } -qmckl_exit_code qmckl_set_determinant_fermi_num(qmckl_context context, const int64_t fermi_num) { - <> - - if (fermi_num <= 0) { - return qmckl_failwith( context, - QMCKL_INVALID_ARG_2, - "qmckl_set_slater_fermierminant_det_num", - "fermi_num <= 0"); - } - - int32_t mask = 1 << 4; - ctx->det.fermi_num = fermi_num; - - <> -} - qmckl_exit_code qmckl_set_determinant_mo_index_alpha(qmckl_context context, const int64_t* mo_index_alpha) { <> @@ -1209,6 +1171,35 @@ double mo_vgl[5][elec_num][chbrclf_mo_num]; rc = qmckl_get_mo_basis_vgl(context, &(mo_vgl[0][0][0])); assert (rc == QMCKL_SUCCESS); +/* Set up determinant data */ + +const int64_t det_num_alpha = 1; +const int64_t det_num_beta = 1; +int64_t mo_index_alpha[1]; +int64_t mo_index_beta[1]; + +mo_index_alpha[0] = 1; +mo_index_beta[0] = 2; + +rc = qmckl_set_determinant_type (context, typ); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_walk_num (context, walk_num); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_det_num_alpha (context, det_num_alpha); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_det_num_beta (context, det_num_beta); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_mo_index_alpha (context, &(mo_index_alpha[0])); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_mo_index_beta (context, &(mo_index_beta[0])); +assert (rc == QMCKL_SUCCESS); + + } #+end_src From b53b4afeabfac67fcca0cddc603abe089a9628e0 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Tue, 12 Oct 2021 13:21:47 +0200 Subject: [PATCH 32/68] Fixed bug in size of mo_index list. #41 --- org/qmckl_determinant.org | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 25e1bf6..c818347 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -424,7 +424,7 @@ qmckl_exit_code qmckl_set_determinant_mo_index_alpha(qmckl_context context, con } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * sizeof(int64_t); + mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * ctx->electron.up_num * sizeof(int64_t); int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info); if (new_array == NULL) { return qmckl_failwith( context, @@ -455,7 +455,7 @@ qmckl_exit_code qmckl_set_determinant_mo_index_beta(qmckl_context context, cons } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * sizeof(int64_t); + mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * ctx->electron.down_num * sizeof(int64_t); int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info); if (new_array == NULL) { return qmckl_failwith( context, @@ -1175,11 +1175,16 @@ assert (rc == QMCKL_SUCCESS); const int64_t det_num_alpha = 1; const int64_t det_num_beta = 1; -int64_t mo_index_alpha[1]; -int64_t mo_index_beta[1]; +int64_t mo_index_alpha[1][walk_num][elec_up_num]; +int64_t mo_index_beta[1][walk_num][elec_dn_num]; -mo_index_alpha[0] = 1; -mo_index_beta[0] = 2; +int i, j; +for(i = 0; i < walk_num; ++i) + for(j = 0; j < elec_up_num; ++j) + mo_index_alpha[0][i][j] = 1; +for(i = 0; i < walk_num; ++i) + for(j = 0; j < elec_up_num; ++j) + mo_index_beta[0][i][j] = 1; rc = qmckl_set_determinant_type (context, typ); assert(rc == QMCKL_SUCCESS); @@ -1193,12 +1198,18 @@ assert (rc == QMCKL_SUCCESS); rc = qmckl_set_determinant_det_num_beta (context, det_num_beta); assert (rc == QMCKL_SUCCESS); -rc = qmckl_set_determinant_mo_index_alpha (context, &(mo_index_alpha[0])); +rc = qmckl_set_determinant_mo_index_alpha (context, &(mo_index_alpha[0][0][0])); assert (rc == QMCKL_SUCCESS); -rc = qmckl_set_determinant_mo_index_beta (context, &(mo_index_beta[0])); +rc = qmckl_set_determinant_mo_index_beta (context, &(mo_index_beta[0][0][0])); assert (rc == QMCKL_SUCCESS); +// Get alpha determinant + +double det_vgl_alpha[1][walk_num][5][elec_up_num][elec_up_num]; + +rc = qmckl_get_det_vgl_alpha(context, &(det_vgl_alpha[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); } @@ -1473,7 +1484,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { return QMCKL_SUCCESS; } #+end_src - + *** Compute alpha :PROPERTIES: :Name: qmckl_compute_det_inv_matrix_alpha From 713be68c2bced24e98c29bafd55d1e1fe0f364d9 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Tue, 12 Oct 2021 18:55:34 +0200 Subject: [PATCH 33/68] Working on tests for determinant. #41 --- org/qmckl_determinant.org | 74 ++++++++++++++++++++++++--------------- org/qmckl_mo.org | 1 - 2 files changed, 45 insertions(+), 30 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index c818347..56b1728 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -520,11 +520,11 @@ qmckl_exit_code qmckl_get_det_vgl_alpha(qmckl_context context, double * const de rc = qmckl_provide_det_vgl_alpha(context); if (rc != QMCKL_SUCCESS) return rc; - qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; - assert (ctx != NULL); + //qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + //assert (ctx != NULL); - size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; - memcpy(det_vgl_alpha, ctx->det.det_vgl_alpha, sze * sizeof(double)); + //size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; + //memcpy(det_vgl_alpha, ctx->det.det_vgl_alpha, sze * sizeof(double)); return QMCKL_SUCCESS; } @@ -615,7 +615,8 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { if (ctx->det.det_vgl_alpha == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num_alpha * sizeof(double); + mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num_alpha * + ctx->electron.up_num * ctx->electron.up_num * sizeof(double); double* det_vgl_alpha = (double*) qmckl_malloc(context, mem_info); if (det_vgl_alpha == NULL) { @@ -706,7 +707,8 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { if (ctx->det.det_vgl_beta == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num_beta * sizeof(double); + mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num_beta * + ctx->electron.down_num * ctx->electron.down_num * sizeof(double); double* det_vgl_beta = (double*) qmckl_malloc(context, mem_info); if (det_vgl_beta == NULL) { @@ -806,20 +808,20 @@ integer function qmckl_compute_det_vgl_alpha_f(context, & do ielec = 1, alpha_num do imo = 1, alpha_num mo_id = mo_index_alpha(imo,iwalk,idet) - ! Value - det_vgl_alpha(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 1) + !! Value + det_vgl_alpha(imo, ielec, 1, iwalk, idet) = 1.0d0!mo_vgl(mo_id, ielec, iwalk, 1) - ! Grad_x - det_vgl_alpha(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 2) + !! Grad_x + !det_vgl_alpha(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 2) - ! Grad_y - det_vgl_alpha(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 3) + !! Grad_y + !det_vgl_alpha(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 3) - ! Grad_z - det_vgl_alpha(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 4) + !! Grad_z + !det_vgl_alpha(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 4) - ! Lap - det_vgl_alpha(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 5) + !! Lap + !det_vgl_alpha(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 5) end do end do end do @@ -874,7 +876,7 @@ end function qmckl_compute_det_vgl_alpha_f integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) integer (c_int64_t) , intent(in) , value :: mo_num real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) - real (c_double ) , intent(out) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha) + real (c_double ) , intent(out) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) integer(c_int32_t), external :: qmckl_compute_det_vgl_alpha_f info = qmckl_compute_det_vgl_alpha_f & @@ -1173,18 +1175,20 @@ assert (rc == QMCKL_SUCCESS); /* Set up determinant data */ -const int64_t det_num_alpha = 1; -const int64_t det_num_beta = 1; -int64_t mo_index_alpha[1][walk_num][elec_up_num]; -int64_t mo_index_beta[1][walk_num][elec_dn_num]; +const int64_t det_num_alpha = 2; +const int64_t det_num_beta = 2; +int64_t mo_index_alpha[det_num_alpha][walk_num][elec_up_num]; +int64_t mo_index_beta[det_num_alpha][walk_num][elec_dn_num]; -int i, j; -for(i = 0; i < walk_num; ++i) - for(j = 0; j < elec_up_num; ++j) - mo_index_alpha[0][i][j] = 1; -for(i = 0; i < walk_num; ++i) - for(j = 0; j < elec_up_num; ++j) - mo_index_beta[0][i][j] = 1; +int i, j, k; +for(k = 0; k < det_num_alpha; ++k) + for(i = 0; i < walk_num; ++i) + for(j = 0; j < elec_up_num; ++j) + mo_index_alpha[k][i][j] = j; +for(k = 0; k < det_num_beta; ++k) + for(i = 0; i < walk_num; ++i) + for(j = 0; j < elec_up_num; ++j) + mo_index_beta[k][i][j] = j; rc = qmckl_set_determinant_type (context, typ); assert(rc == QMCKL_SUCCESS); @@ -1206,11 +1210,23 @@ assert (rc == QMCKL_SUCCESS); // Get alpha determinant -double det_vgl_alpha[1][walk_num][5][elec_up_num][elec_up_num]; +double det_vgl_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; +double det_vgl_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; +double det_inv_matrix_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; +double det_inv_matrix_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; rc = qmckl_get_det_vgl_alpha(context, &(det_vgl_alpha[0][0][0][0][0])); assert (rc == QMCKL_SUCCESS); +rc = qmckl_get_det_vgl_beta(context, &(det_vgl_beta[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + } #+end_src diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index 1dd7ea4..8367a6d 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -801,7 +801,6 @@ printf("\n"); #+end_src - * End of files :noexport: #+begin_src c :tangle (eval h_private_type) From 1efd6183d5daf3e22d24b846ff4171e7ac4be207 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Tue, 12 Oct 2021 19:41:44 +0200 Subject: [PATCH 34/68] Fixed dimensions in tests. #41 --- org/qmckl_determinant.org | 103 +++++++++-------- org/qmckl_local_energy.org | 229 ++++++++++++++++++++++++++++++++++++- 2 files changed, 282 insertions(+), 50 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 56b1728..74ddf40 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -424,7 +424,8 @@ qmckl_exit_code qmckl_set_determinant_mo_index_alpha(qmckl_context context, con } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * ctx->electron.up_num * sizeof(int64_t); + mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * + ctx->electron.up_num * sizeof(int64_t); int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info); if (new_array == NULL) { return qmckl_failwith( context, @@ -455,7 +456,8 @@ qmckl_exit_code qmckl_set_determinant_mo_index_beta(qmckl_context context, cons } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * ctx->electron.down_num * sizeof(int64_t); + mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * + ctx->electron.down_num * sizeof(int64_t); int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info); if (new_array == NULL) { return qmckl_failwith( context, @@ -520,11 +522,12 @@ qmckl_exit_code qmckl_get_det_vgl_alpha(qmckl_context context, double * const de rc = qmckl_provide_det_vgl_alpha(context); if (rc != QMCKL_SUCCESS) return rc; - //qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; - //assert (ctx != NULL); + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); - //size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; - //memcpy(det_vgl_alpha, ctx->det.det_vgl_alpha, sze * sizeof(double)); + size_t sze = 5 * ctx->det.det_num_alpha * ctx->det.walk_num * + ctx->electron.up_num * ctx->electron.up_num * sizeof(double); + memcpy(det_vgl_alpha, ctx->det.det_vgl_alpha, sze); return QMCKL_SUCCESS; } @@ -549,8 +552,9 @@ qmckl_exit_code qmckl_get_det_vgl_beta(qmckl_context context, double * const det qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->det.det_num_beta * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; - memcpy(det_vgl_beta, ctx->det.det_vgl_beta, sze * sizeof(double)); + size_t sze = 5 * ctx->det.det_num_beta * ctx->det.walk_num * + ctx->electron.down_num * ctx->electron.down_num * sizeof(double); + memcpy(det_vgl_beta, ctx->det.det_vgl_beta, sze); return QMCKL_SUCCESS; } @@ -764,7 +768,7 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { | ~int64_t~ | ~elec_num~ | in | Number of electrons | | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][alpha_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -782,7 +786,7 @@ integer function qmckl_compute_det_vgl_alpha_f(context, & integer*8, intent(in) :: elec_num integer*8, intent(in) :: mo_num integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) - double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) + double precision, intent(in) :: mo_vgl(mo_num, elec_num, 5) double precision, intent(inout) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) integer*8 :: idet, iwalk, ielec, mo_id, imo @@ -808,20 +812,20 @@ integer function qmckl_compute_det_vgl_alpha_f(context, & do ielec = 1, alpha_num do imo = 1, alpha_num mo_id = mo_index_alpha(imo,iwalk,idet) - !! Value - det_vgl_alpha(imo, ielec, 1, iwalk, idet) = 1.0d0!mo_vgl(mo_id, ielec, iwalk, 1) + ! Value + det_vgl_alpha(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, 1) - !! Grad_x - !det_vgl_alpha(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 2) + ! Grad_x + det_vgl_alpha(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, 2) - !! Grad_y - !det_vgl_alpha(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 3) + ! Grad_y + det_vgl_alpha(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, 3) - !! Grad_z - !det_vgl_alpha(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 4) + ! Grad_z + det_vgl_alpha(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, 4) - !! Lap - !det_vgl_alpha(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 5) + ! Lap + det_vgl_alpha(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, 5) end do end do end do @@ -875,8 +879,8 @@ end function qmckl_compute_det_vgl_alpha_f integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) - real (c_double ) , intent(out) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) + real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,5) + real (c_double ) , intent(out) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha) integer(c_int32_t), external :: qmckl_compute_det_vgl_alpha_f info = qmckl_compute_det_vgl_alpha_f & @@ -910,7 +914,7 @@ end function qmckl_compute_det_vgl_alpha_f | ~int64_t~ | ~elec_num~ | in | Number of electrons | | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | Number of electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -928,7 +932,7 @@ integer function qmckl_compute_det_vgl_beta_f(context, & integer*8, intent(in) :: elec_num integer*8, intent(in) :: mo_num integer*8, intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) - double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) + double precision, intent(in) :: mo_vgl(mo_num, elec_num, 5) double precision, intent(inout) :: det_vgl_beta(beta_num, beta_num, 5, walk_num, det_num_beta) integer*8 :: idet, iwalk, ielec, mo_id, imo @@ -955,19 +959,19 @@ integer function qmckl_compute_det_vgl_beta_f(context, & do imo = 1, beta_num mo_id = mo_index_beta(imo, iwalk, idet) ! Value - det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 1) + det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 1) ! Grad_x - det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 2) + det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 2) ! Grad_y - det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 3) + det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 3) ! Grad_z - det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 4) + det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 4) ! Lap - det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, iwalk, 5) + det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 5) end do end do end do @@ -976,7 +980,7 @@ integer function qmckl_compute_det_vgl_beta_f(context, & end function qmckl_compute_det_vgl_beta_f #+end_src - #+CALL: generate_c_header(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta")) + #+CALL: generate_c_header(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta")) #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org @@ -1021,7 +1025,7 @@ end function qmckl_compute_det_vgl_beta_f integer (c_int64_t) , intent(in) , value :: elec_num integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) + real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,5) real (c_double ) , intent(out) :: det_vgl_beta(beta_num,beta_num,5,walk_num,det_num_beta) integer(c_int32_t), external :: qmckl_compute_det_vgl_beta_f @@ -1043,7 +1047,7 @@ end function qmckl_compute_det_vgl_beta_f *** Test #+begin_src c :tangle (eval c_test) :exports none -{ + #define walk_num chbrclf_walk_num #define elec_num chbrclf_elec_num #define shell_num chbrclf_shell_num @@ -1175,8 +1179,8 @@ assert (rc == QMCKL_SUCCESS); /* Set up determinant data */ -const int64_t det_num_alpha = 2; -const int64_t det_num_beta = 2; +const int64_t det_num_alpha = 1; +const int64_t det_num_beta = 1; int64_t mo_index_alpha[det_num_alpha][walk_num][elec_up_num]; int64_t mo_index_beta[det_num_alpha][walk_num][elec_dn_num]; @@ -1184,11 +1188,11 @@ int i, j, k; for(k = 0; k < det_num_alpha; ++k) for(i = 0; i < walk_num; ++i) for(j = 0; j < elec_up_num; ++j) - mo_index_alpha[k][i][j] = j; + mo_index_alpha[k][i][j] = j + 1; for(k = 0; k < det_num_beta; ++k) for(i = 0; i < walk_num; ++i) for(j = 0; j < elec_up_num; ++j) - mo_index_beta[k][i][j] = j; + mo_index_beta[k][i][j] = j + 1; rc = qmckl_set_determinant_type (context, typ); assert(rc == QMCKL_SUCCESS); @@ -1208,12 +1212,10 @@ assert (rc == QMCKL_SUCCESS); rc = qmckl_set_determinant_mo_index_beta (context, &(mo_index_beta[0][0][0])); assert (rc == QMCKL_SUCCESS); -// Get alpha determinant +// Get slater-determinant double det_vgl_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; double det_vgl_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; -double det_inv_matrix_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; -double det_inv_matrix_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; rc = qmckl_get_det_vgl_alpha(context, &(det_vgl_alpha[0][0][0][0][0])); assert (rc == QMCKL_SUCCESS); @@ -1221,14 +1223,6 @@ assert (rc == QMCKL_SUCCESS); rc = qmckl_get_det_vgl_beta(context, &(det_vgl_beta[0][0][0][0][0])); assert (rc == QMCKL_SUCCESS); -rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0][0])); -assert (rc == QMCKL_SUCCESS); - -rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0][0])); -assert (rc == QMCKL_SUCCESS); - -} - #+end_src ** Inverse of Determinant matrix @@ -1508,7 +1502,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { :FRetType: qmckl_exit_code :END: - #+NAME: qmckl_det_inv_matrix_alpha_args + #+NAME: qmckl_det_inv_matrix_alpha_args | ~qmckl_context~ | ~context~ | in | Global state | | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | | ~int64_t~ | ~walk_num~ | in | Number of walkers | @@ -1785,6 +1779,19 @@ end function qmckl_compute_det_inv_matrix_beta_f *** Test + #+begin_src c :tangle (eval c_test) :exports none +// Get adjoint of the slater-determinant + +double det_inv_matrix_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; +double det_inv_matrix_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; + +rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + + #+end_src * End of files :noexport: diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 58f4753..5cb806b 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -135,7 +135,7 @@ int main() { The following arrays are stored in the context: - || + | | Computed data: @@ -518,6 +518,202 @@ end function qmckl_compute_kinetic_energy_f #+end_src *** Test + #+begin_src c :tangle (eval c_test) :exports none + +#define walk_num chbrclf_walk_num +#define elec_num chbrclf_elec_num +#define shell_num chbrclf_shell_num +#define ao_num chbrclf_ao_num + +int64_t elec_up_num = chbrclf_elec_up_num; +int64_t elec_dn_num = chbrclf_elec_dn_num; +double* elec_coord = &(chbrclf_elec_coord[0][0][0]); +const int64_t nucl_num = chbrclf_nucl_num; +const double* nucl_charge = chbrclf_charge; +const double* nucl_coord = &(chbrclf_nucl_coord[0][0]); + +rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_electron_walk_num (context, walk_num); +assert (rc == QMCKL_SUCCESS); + +assert(qmckl_electron_provided(context)); + +rc = qmckl_set_electron_coord (context, 'N', elec_coord); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_nucleus_num (context, nucl_num); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_nucleus_charge(context, nucl_charge); +assert(rc == QMCKL_SUCCESS); + +assert(qmckl_nucleus_provided(context)); + +const int64_t * nucleus_index = &(chbrclf_basis_nucleus_index[0]); +const int64_t * nucleus_shell_num = &(chbrclf_basis_nucleus_shell_num[0]); +const int32_t * shell_ang_mom = &(chbrclf_basis_shell_ang_mom[0]); +const int64_t * shell_prim_num = &(chbrclf_basis_shell_prim_num[0]); +const int64_t * shell_prim_index = &(chbrclf_basis_shell_prim_index[0]); +const double * shell_factor = &(chbrclf_basis_shell_factor[0]); +const double * exponent = &(chbrclf_basis_exponent[0]); +const double * coefficient = &(chbrclf_basis_coefficient[0]); +const double * prim_factor = &(chbrclf_basis_prim_factor[0]); +const double * ao_factor = &(chbrclf_basis_ao_factor[0]); + +const char typ = 'G'; + +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_type (context, typ); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_num (context, chbrclf_shell_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_prim_num (context, chbrclf_prim_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_nucleus_index (context, nucleus_index); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_nucleus_shell_num (context, nucleus_shell_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_ang_mom (context, shell_ang_mom); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_factor (context, shell_factor); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_prim_num (context, shell_prim_num); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_shell_prim_index (context, shell_prim_index); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_exponent (context, exponent); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_coefficient (context, coefficient); +assert(rc == QMCKL_SUCCESS); +assert(!qmckl_ao_basis_provided(context)); + +rc = qmckl_set_ao_basis_prim_factor (context, prim_factor); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_ao_basis_ao_num(context, chbrclf_ao_num); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_ao_basis_ao_factor (context, ao_factor); +assert(rc == QMCKL_SUCCESS); + +assert(qmckl_ao_basis_provided(context)); + + +double ao_vgl[5][walk_num][elec_num][chbrclf_ao_num]; + +rc = qmckl_get_ao_vgl(context, &(ao_vgl[0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +/* Set up MO data */ +rc = qmckl_set_mo_basis_type(context, typ); +assert (rc == QMCKL_SUCCESS); + +const int64_t mo_num = chbrclf_mo_num; +rc = qmckl_set_mo_basis_mo_num(context, mo_num); +assert (rc == QMCKL_SUCCESS); + +const double * mo_coefficient = &(chbrclf_mo_coef[0]); + +rc = qmckl_set_mo_basis_coefficient(context, mo_coefficient); +assert (rc == QMCKL_SUCCESS); + +assert(qmckl_mo_basis_provided(context)); + +double mo_vgl[5][elec_num][chbrclf_mo_num]; +rc = qmckl_get_mo_basis_vgl(context, &(mo_vgl[0][0][0])); +assert (rc == QMCKL_SUCCESS); + +/* Set up determinant data */ + +const int64_t det_num_alpha = 1; +const int64_t det_num_beta = 1; +int64_t mo_index_alpha[det_num_alpha][walk_num][elec_up_num]; +int64_t mo_index_beta[det_num_alpha][walk_num][elec_dn_num]; + +int i, j, k; +for(k = 0; k < det_num_alpha; ++k) + for(i = 0; i < walk_num; ++i) + for(j = 0; j < elec_up_num; ++j) + mo_index_alpha[k][i][j] = j + 1; +for(k = 0; k < det_num_beta; ++k) + for(i = 0; i < walk_num; ++i) + for(j = 0; j < elec_up_num; ++j) + mo_index_beta[k][i][j] = j + 1; + +rc = qmckl_set_determinant_type (context, typ); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_walk_num (context, walk_num); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_det_num_alpha (context, det_num_alpha); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_det_num_beta (context, det_num_beta); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_mo_index_alpha (context, &(mo_index_alpha[0][0][0])); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_set_determinant_mo_index_beta (context, &(mo_index_beta[0][0][0])); +assert (rc == QMCKL_SUCCESS); + +// Get alpha determinant + +double det_vgl_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; +double det_vgl_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; + +rc = qmckl_get_det_vgl_alpha(context, &(det_vgl_alpha[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_get_det_vgl_beta(context, &(det_vgl_beta[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +// Get adjoint of the slater-determinant + +double det_inv_matrix_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; +double det_inv_matrix_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; + +rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0][0])); +assert (rc == QMCKL_SUCCESS); + +// Calculate the Kinetic energy + +double kinetic_energy[walk_num]; + +rc = qmckl_get_kinetic_energy(context, &(kinetic_energy[0])); +assert (rc == QMCKL_SUCCESS); + + #+end_src ** Potential energy :PROPERTIES: @@ -783,6 +979,16 @@ end function qmckl_compute_potential_energy_f #+end_src *** Test + #+begin_src c :tangle (eval c_test) :exports none +// Calculate the Potential energy + +double potential_energy[walk_num]; + +rc = qmckl_get_potential_energy(context, &(potential_energy[0])); +assert (rc == QMCKL_SUCCESS); + + #+end_src + ** Local energy :PROPERTIES: :Name: qmckl_compute_local_energy @@ -1012,6 +1218,16 @@ end function qmckl_compute_local_energy_f #+end_src *** Test + #+begin_src c :tangle (eval c_test) :exports none +// Calculate the Local energy + +double local_energy[walk_num]; + +rc = qmckl_get_local_energy(context, &(local_energy[0])); +assert (rc == QMCKL_SUCCESS); + + #+end_src + ** Drift vector :PROPERTIES: :Name: qmckl_compute_drift_vector @@ -1188,7 +1404,7 @@ qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context) { | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~r_drift[walk_num][3]~ | out | Kinetic energy | + | ~double~ | ~r_drift[walk_num][3]~ | out | Kinetic energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_drift_vector_f(context, walk_num, & @@ -1354,6 +1570,15 @@ end function qmckl_compute_drift_vector_f #+end_src *** Test + #+begin_src c :tangle (eval c_test) :exports none +// Calculate the Drift vector + +double drift_vector[walk_num][3]; + +rc = qmckl_get_drift_vector(context, &(drift_vector[0][0])); +assert (rc == QMCKL_SUCCESS); + + #+end_src * End of files :noexport: #+begin_src c :tangle (eval h_private_type) From ecac090e61288463ff1856dd186572a96d07d9be Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 15:25:27 +0200 Subject: [PATCH 35/68] Added todo to merge with master. #41 --- TODO.org | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 TODO.org diff --git a/TODO.org b/TODO.org new file mode 100644 index 0000000..561860e --- /dev/null +++ b/TODO.org @@ -0,0 +1,48 @@ +#+STARTUP: showeverything + +* Set up CI on Travis +* Write tests + +* malloc/free : Parameters for accelerators? +We should define qmckl_malloc and qmckl_free just to give the +possibility of the HPC implementations to define how they allocate the +memory (on CPU or GPU, using alternatives to malloc/free, etc). +A possibility could be to pass the id of a NUMA domain as a parameter of +qmckl_malloc, where the domain id is something obtained from the +context. + + +* TRANSA, TRANSB +* Performance info +* Benchmark interpolation of basis functions +* Complex numbers +* Adjustable number for derivatives (1,2,3) + +* Put pictures +* Make the Makefile part of the documented code ? +* Put the data-flow graph in the code. + +* Verificarlo TODO +These are installation instructions for +verificarlo which needs to be moved to +an appropriate place at some point. +** Compilation and Testing + +The following steps were required to get +the verificarlo version up and running on +an Ubuntu 20.04 laptop. + +1. Compilers + a. clang - For e.g. clang-7 + b. flang - For e.g. flang-7 : Care needs to be taken + that the flang version + is compatible with the + clang version used. + There are known issues + with using oneAPI due + to flang being incompatible + with oneAPI supplied clang. + c. gcc - For e.g. gcc-7 + +2. Environment varibales + a. VFC_BACKENDS - For e.g. `VFC_BACKENDS="libinterflop_ieee.so"` From befc1a75fa6fb63fd1aa98b1e5a5476f17777a74 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 16:44:00 +0200 Subject: [PATCH 36/68] Fix bug in det_inv_matrix dimension. #41 --- org/qmckl_determinant.org | 66 +++++++++++++-------------------------- 1 file changed, 21 insertions(+), 45 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 74ddf40..c03667b 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -914,7 +914,7 @@ end function qmckl_compute_det_vgl_alpha_f | ~int64_t~ | ~elec_num~ | in | Number of electrons | | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | Number of electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | out | Value, gradients and Laplacian of the Det | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -1378,7 +1378,6 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { ctx->det.det_num_alpha, ctx->det.walk_num, ctx->electron.up_num, - ctx->mo_basis.mo_num, ctx->det.det_vgl_alpha, ctx->det.det_value_alpha, ctx->det.det_adj_matrix_alpha, @@ -1471,7 +1470,6 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { ctx->det.det_num_beta, ctx->det.walk_num, ctx->electron.down_num, - ctx->mo_basis.mo_num, ctx->det.det_vgl_beta, ctx->det.det_value_beta, ctx->det.det_adj_matrix_beta, @@ -1507,15 +1505,14 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | | ~int64_t~ | ~walk_num~ | in | Number of walkers | | ~int64_t~ | ~alpha_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][alpha_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | | ~double~ | ~det_value_alpha[det_num_alpha][walk_num]~ | out | value of determinant matrix | | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | out | adjoint of determinant matrix | | ~double~ | ~det_inv_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | out | inverse of determinant matrix | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_inv_matrix_alpha_f(context, & - det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_value_alpha, det_adj_matrix_alpha, det_inv_matrix_alpha) & + det_num_alpha, walk_num, alpha_num, det_vgl_alpha, det_value_alpha, det_adj_matrix_alpha, det_inv_matrix_alpha) & result(info) use qmckl implicit none @@ -1523,8 +1520,7 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & integer*8, intent(in) :: det_num_alpha integer*8, intent(in) :: walk_num integer*8, intent(in) :: alpha_num - integer*8, intent(in) :: mo_num - double precision, intent(in) :: det_vgl_alpha(mo_num, alpha_num, 5, walk_num, det_num_alpha) + double precision, intent(in) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) double precision, intent(inout) :: det_value_alpha(walk_num, det_num_alpha) double precision, intent(inout) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) double precision, intent(inout) :: det_inv_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) @@ -1532,7 +1528,7 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & double precision :: det_l integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res - allocate(matA(mo_num, alpha_num)) + allocate(matA(alpha_num, alpha_num)) info = QMCKL_SUCCESS @@ -1556,19 +1552,14 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & return endif - if (mo_num <= 0) then - info = QMCKL_INVALID_ARG_5 - return - endif - LDA = alpha_num do idet = 1, det_num_alpha do iwalk = 1, walk_num ! Value - matA = det_vgl_alpha(1:mo_num, 1:alpha_num, 1, iwalk, idet) + matA = det_vgl_alpha(1:alpha_num, 1:alpha_num, 1, iwalk, idet) res = qmckl_invert(context, alpha_num, alpha_num, LDA, matA, det_l) - det_adj_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA - det_inv_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA/det_l + det_adj_matrix_alpha(1:alpha_num, 1:alpha_num, iwalk, idet) = matA + det_inv_matrix_alpha(1:alpha_num, 1:alpha_num, iwalk, idet) = matA/det_l det_value_alpha(iwalk, idet) = det_l end do end do @@ -1585,7 +1576,6 @@ end function qmckl_compute_det_inv_matrix_alpha_f const int64_t det_num_alpha, const int64_t walk_num, const int64_t alpha_num, - const int64_t mo_num, const double* det_vgl_alpha, double* const det_value_alpha, double* const det_adj_matrix_alpha, @@ -1601,7 +1591,6 @@ end function qmckl_compute_det_inv_matrix_alpha_f det_num_alpha, & walk_num, & alpha_num, & - mo_num, & det_vgl_alpha, & det_value_alpha, & det_adj_matrix_alpha, & @@ -1615,8 +1604,7 @@ end function qmckl_compute_det_inv_matrix_alpha_f integer (c_int64_t) , intent(in) , value :: det_num_alpha integer (c_int64_t) , intent(in) , value :: walk_num integer (c_int64_t) , intent(in) , value :: alpha_num - integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: det_vgl_alpha(mo_num,alpha_num,5,walk_num,det_num_alpha) + real (c_double ) , intent(in) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha) real (c_double ) , intent(out) :: det_value_alpha(walk_num,det_num_alpha) real (c_double ) , intent(out) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) real (c_double ) , intent(out) :: det_inv_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) @@ -1627,7 +1615,6 @@ end function qmckl_compute_det_inv_matrix_alpha_f det_num_alpha, & walk_num, & alpha_num, & - mo_num, & det_vgl_alpha, & det_value_alpha, & det_adj_matrix_alpha, & @@ -1648,15 +1635,14 @@ end function qmckl_compute_det_inv_matrix_alpha_f | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | | ~int64_t~ | ~walk_num~ | in | Number of walkers | | ~int64_t~ | ~beta_num~ | in | Number of electrons | - | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | | ~double~ | ~det_value_beta[det_num_beta][walk_num]~ | out | value of determinant matrix | | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | adjoint of determinant matrix | | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | inverse of determinant matrix | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_det_inv_matrix_beta_f(context, & - det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_value_beta, det_adj_matrix_beta, det_inv_matrix_beta) & + det_num_beta, walk_num, beta_num, det_vgl_beta, det_value_beta, det_adj_matrix_beta, det_inv_matrix_beta) & result(info) use qmckl implicit none @@ -1664,8 +1650,7 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & integer*8, intent(in) :: det_num_beta integer*8, intent(in) :: walk_num integer*8, intent(in) :: beta_num - integer*8, intent(in) :: mo_num - double precision, intent(in) :: det_vgl_beta(mo_num, beta_num, 5, walk_num, det_num_beta) + double precision, intent(in) :: det_vgl_beta(beta_num, beta_num, 5, walk_num, det_num_beta) double precision, intent(inout) :: det_value_beta(walk_num, det_num_beta) double precision, intent(inout) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) double precision, intent(inout) :: det_inv_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) @@ -1673,7 +1658,7 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & double precision :: det_l integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res - allocate(matA(mo_num, beta_num)) + allocate(matA(beta_num, beta_num)) info = QMCKL_SUCCESS @@ -1697,19 +1682,14 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & return endif - if (mo_num <= 0) then - info = QMCKL_INVALID_ARG_5 - return - endif - LDA = beta_num do idet = 1, det_num_beta do iwalk = 1, walk_num ! Value - matA = det_vgl_beta(1:mo_num, 1:beta_num, 1, iwalk, idet) + matA = det_vgl_beta(1:beta_num, 1:beta_num, 1, iwalk, idet) res = qmckl_invert(context, beta_num, beta_num, LDA, matA, det_l) - det_adj_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA - det_inv_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA/det_l + det_adj_matrix_beta(1:beta_num, 1:beta_num, iwalk, idet) = matA + det_inv_matrix_beta(1:beta_num, 1:beta_num, iwalk, idet) = matA/det_l det_value_beta(iwalk, idet) = det_l end do end do @@ -1726,7 +1706,6 @@ end function qmckl_compute_det_inv_matrix_beta_f const int64_t det_num_beta, const int64_t walk_num, const int64_t beta_num, - const int64_t mo_num, const double* det_vgl_beta, double* const det_value_beta, double* const det_adj_matrix_beta, @@ -1742,7 +1721,6 @@ end function qmckl_compute_det_inv_matrix_beta_f det_num_beta, & walk_num, & beta_num, & - mo_num, & det_vgl_beta, & det_value_beta, & det_adj_matrix_beta, & @@ -1756,8 +1734,7 @@ end function qmckl_compute_det_inv_matrix_beta_f integer (c_int64_t) , intent(in) , value :: det_num_beta integer (c_int64_t) , intent(in) , value :: walk_num integer (c_int64_t) , intent(in) , value :: beta_num - integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: det_vgl_beta(mo_num,beta_num,5,walk_num,det_num_beta) + real (c_double ) , intent(in) :: det_vgl_beta(beta_num,beta_num,5,walk_num,det_num_beta) real (c_double ) , intent(out) :: det_value_beta(walk_num,det_num_beta) real (c_double ) , intent(out) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) real (c_double ) , intent(out) :: det_inv_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) @@ -1768,7 +1745,6 @@ end function qmckl_compute_det_inv_matrix_beta_f det_num_beta, & walk_num, & beta_num, & - mo_num, & det_vgl_beta, & det_value_beta, & det_adj_matrix_beta, & @@ -1782,13 +1758,13 @@ end function qmckl_compute_det_inv_matrix_beta_f #+begin_src c :tangle (eval c_test) :exports none // Get adjoint of the slater-determinant -double det_inv_matrix_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; -double det_inv_matrix_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; +double det_inv_matrix_alpha[det_num_alpha][walk_num][elec_up_num][elec_up_num]; +double det_inv_matrix_beta[det_num_beta][walk_num][elec_dn_num][elec_dn_num]; -rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0][0])); +rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0])); assert (rc == QMCKL_SUCCESS); -rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0][0])); +rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0])); assert (rc == QMCKL_SUCCESS); #+end_src From 578bc432687e5a8a3f50772d7ab5270a63ebc4b4 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 16:44:19 +0200 Subject: [PATCH 37/68] Fix tests for det_inv_matrix. #41 --- org/qmckl_local_energy.org | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 5cb806b..33d2cbb 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -697,13 +697,13 @@ assert (rc == QMCKL_SUCCESS); // Get adjoint of the slater-determinant -double det_inv_matrix_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num]; -double det_inv_matrix_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num]; +double det_inv_matrix_alpha[det_num_alpha][walk_num][elec_up_num][elec_up_num]; +double det_inv_matrix_beta[det_num_beta][walk_num][elec_dn_num][elec_dn_num]; -rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0][0])); +rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0])); assert (rc == QMCKL_SUCCESS); -rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0][0])); +rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0])); assert (rc == QMCKL_SUCCESS); // Calculate the Kinetic energy From ca5c332d85e514098f5ab13a8e5d2c5d7a0a912a Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 16:55:12 +0200 Subject: [PATCH 38/68] Fixed initialization of det_adj and det_value matrices. #41 --- org/qmckl_determinant.org | 62 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index c03667b..6c25591 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1372,6 +1372,37 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { ctx->det.det_inv_matrix_alpha = det_inv_matrix_alpha; } + if (ctx->det.det_adj_matrix_alpha == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * + ctx->electron.up_num * ctx->electron.up_num * sizeof(double); + double* det_adj_matrix_alpha = (double*) qmckl_malloc(context, mem_info); + + if (det_adj_matrix_alpha == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_det_adj_matrix_alpha", + NULL); + } + ctx->det.det_adj_matrix_alpha = det_adj_matrix_alpha; + } + + if (ctx->det.det_value_alpha == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * sizeof(double); + double* det_value_alpha = (double*) qmckl_malloc(context, mem_info); + + if (det_value_alpha == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_det_value_alpha", + NULL); + } + ctx->det.det_value_alpha = det_value_alpha; + } + qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_inv_matrix_alpha(context, @@ -1464,6 +1495,37 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { ctx->det.det_inv_matrix_beta = det_inv_matrix_beta; } + if (ctx->det.det_adj_matrix_beta == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * + ctx->electron.up_num * ctx->electron.up_num * sizeof(double); + double* det_adj_matrix_beta = (double*) qmckl_malloc(context, mem_info); + + if (det_adj_matrix_beta == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_det_adj_matrix_beta", + NULL); + } + ctx->det.det_adj_matrix_beta = det_adj_matrix_beta; + } + + if (ctx->det.det_value_beta == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * sizeof(double); + double* det_value_beta = (double*) qmckl_malloc(context, mem_info); + + if (det_value_beta == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_det_value_beta", + NULL); + } + ctx->det.det_value_beta = det_value_beta; + } + qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_inv_matrix_beta(context, From dcc5f09724e0712f11eaf32c5e360729315292f8 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 17:56:33 +0200 Subject: [PATCH 39/68] Fixed provider for local_energy. #41 --- org/qmckl_determinant.org | 2 ++ org/qmckl_local_energy.org | 33 +++++++++++++++++++++++++-------- 2 files changed, 27 insertions(+), 8 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 6c25591..bbd8a5c 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1626,6 +1626,7 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & end do end do + deallocate(matA) end function qmckl_compute_det_inv_matrix_alpha_f #+end_src @@ -1756,6 +1757,7 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & end do end do + deallocate(matA) end function qmckl_compute_det_inv_matrix_beta_f #+end_src diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 33d2cbb..f2b9740 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -1035,7 +1035,7 @@ qmckl_exit_code qmckl_get_local_energy(qmckl_context context, double * const loc assert (ctx != NULL); size_t sze = ctx->electron.walk_num * sizeof(double); - memcpy(local_energy, ctx->local_energy.e_kin, sze); + memcpy(local_energy, ctx->local_energy.e_local, sze); return QMCKL_SUCCESS; } @@ -1092,23 +1092,40 @@ qmckl_exit_code qmckl_provide_local_energy(qmckl_context context) { NULL); } + qmckl_exit_code rc; + rc = qmckl_provide_kinetic_energy(context); + if(rc != QMCKL_SUCCESS){ + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_kinetic_energy", + NULL); + } + + rc = qmckl_provide_potential_energy(context); + if(rc != QMCKL_SUCCESS){ + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_potential_energy", + NULL); + } + /* Compute if necessary */ - if (ctx->electron.coord_new_date > ctx->local_energy.e_kin_date) { + if (ctx->electron.coord_new_date > ctx->local_energy.e_local_date) { /* Allocate array */ - if (ctx->local_energy.e_kin == NULL) { + if (ctx->local_energy.e_local == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = ctx->electron.walk_num * sizeof(double); - double* e_kin = (double*) qmckl_malloc(context, mem_info); + double* local_energy = (double*) qmckl_malloc(context, mem_info); - if (e_kin == NULL) { + if (local_energy == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, - "qmckl_e_kin", + "qmckl_local_energy", NULL); } - ctx->local_energy.e_kin = e_kin; + ctx->local_energy.e_local = local_energy; } qmckl_exit_code rc; @@ -1128,7 +1145,7 @@ qmckl_exit_code qmckl_provide_local_energy(qmckl_context context) { return rc; } - ctx->local_energy.e_kin_date = ctx->date; + ctx->local_energy.e_local_date = ctx->date; } return QMCKL_SUCCESS; From 7bf52f0e0190da789c9841d497a89875d7420e6a Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 18:02:28 +0200 Subject: [PATCH 40/68] Fixed provider for potential energy. #41 --- org/qmckl_local_energy.org | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index f2b9740..e537ee0 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -775,7 +775,7 @@ qmckl_exit_code qmckl_get_potential_energy(qmckl_context context, double * const assert (ctx != NULL); size_t sze = ctx->electron.walk_num * sizeof(double); - memcpy(potential_energy, ctx->local_energy.e_kin, sze); + memcpy(potential_energy, ctx->local_energy.e_pot, sze); return QMCKL_SUCCESS; } @@ -833,22 +833,22 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { } /* Compute if necessary */ - if (ctx->electron.coord_new_date > ctx->local_energy.e_kin_date) { + if (ctx->electron.coord_new_date > ctx->local_energy.e_pot_date) { /* Allocate array */ - if (ctx->local_energy.e_kin == NULL) { + if (ctx->local_energy.e_pot == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = ctx->electron.walk_num * sizeof(double); - double* e_kin = (double*) qmckl_malloc(context, mem_info); + double* e_pot = (double*) qmckl_malloc(context, mem_info); - if (e_kin == NULL) { + if (e_pot == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, - "qmckl_e_kin", + "qmckl_e_pot", NULL); } - ctx->local_energy.e_kin = e_kin; + ctx->local_energy.e_pot = e_pot; } qmckl_exit_code rc; @@ -860,7 +860,7 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { ctx->electron.ee_pot, ctx->nucleus.en_pot, ctx->nucleus.repulsion, - ctx->local_energy.e_kin); + ctx->local_energy.e_pot); } else { return qmckl_failwith( context, QMCKL_FAILURE, @@ -871,7 +871,7 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { return rc; } - ctx->local_energy.e_kin_date = ctx->date; + ctx->local_energy.e_pot_date = ctx->date; } return QMCKL_SUCCESS; @@ -1128,7 +1128,6 @@ qmckl_exit_code qmckl_provide_local_energy(qmckl_context context) { ctx->local_energy.e_local = local_energy; } - qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_local_energy(context, ctx->det.walk_num, From ca61af7a3de788ef0cd6b43e5486e3badb244c1f Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 18:07:15 +0200 Subject: [PATCH 41/68] Added providers for ee_pot and en_pot for e_pot. #41 --- org/qmckl_local_energy.org | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index e537ee0..390ebb7 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -797,6 +797,7 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); + qmckl_exit_code rc; if(!(ctx->nucleus.provided)) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, @@ -832,6 +833,22 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { NULL); } + rc = qmckl_provide_ee_potential(ctx); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ee_potential", + NULL); + } + + rc = qmckl_provide_en_potential(ctx); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_en_potential", + NULL); + } + /* Compute if necessary */ if (ctx->electron.coord_new_date > ctx->local_energy.e_pot_date) { @@ -851,7 +868,6 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { ctx->local_energy.e_pot = e_pot; } - qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_potential_energy(context, ctx->det.walk_num, From a6e625016c9afd1a190a68cde9d5644abb0a39f5 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 18:13:13 +0200 Subject: [PATCH 42/68] Added provider to repulsion in e_pot. #41 --- org/qmckl_local_energy.org | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 390ebb7..903a259 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -841,6 +841,14 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { NULL); } + rc = qmckl_provide_nucleus_repulsion(ctx); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_nucleus_repulsion", + NULL); + } + rc = qmckl_provide_en_potential(ctx); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, From cff6b8a47abd81457feefca944df07f0c7ff8485 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 18:21:59 +0200 Subject: [PATCH 43/68] Added dimension of en_pot in definition. #41 --- org/qmckl_nucleus.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/org/qmckl_nucleus.org b/org/qmckl_nucleus.org index 634fb46..e570e99 100644 --- a/org/qmckl_nucleus.org +++ b/org/qmckl_nucleus.org @@ -80,7 +80,7 @@ int main() { | ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed | | ~repulsion~ | double | Nuclear repulsion energy | | ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed | - | ~en_pot~ | double | Electron-nucleus potential energy | + | ~en_pot~ | double[walk_num] | Electron-nucleus potential energy | | ~en_pot_date~ | int64_t | Date when the electron-nucleus potential energy was computed | ** Data structure @@ -1338,7 +1338,7 @@ end function qmckl_compute_en_potential_f #+end_src *** Test - + * End of files :noexport: #+begin_src c :tangle (eval h_private_type) From 64b30dc10e1e1bcd59106b972ff91dbfbd585ce4 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 18:26:45 +0200 Subject: [PATCH 44/68] Added elec date for en_pot. #41 --- org/qmckl_nucleus.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org/qmckl_nucleus.org b/org/qmckl_nucleus.org index e570e99..5c6d1a4 100644 --- a/org/qmckl_nucleus.org +++ b/org/qmckl_nucleus.org @@ -1199,7 +1199,7 @@ qmckl_exit_code qmckl_provide_en_potential(qmckl_context context) if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; /* Compute if necessary */ - if (ctx->nucleus.coord_date > ctx->nucleus.en_pot_date) { + if (ctx->electron.coord_new_date > ctx->nucleus.en_pot_date) { /* Allocate array */ if (ctx->nucleus.en_pot == NULL) { From ed5ec3c72932e9d1ca0dd311b6d2257258862463 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 13 Oct 2021 18:27:04 +0200 Subject: [PATCH 45/68] Fixed ctx passing in e_pot. #41 --- org/qmckl_local_energy.org | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 903a259..6b9b4ce 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -833,7 +833,7 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { NULL); } - rc = qmckl_provide_ee_potential(ctx); + rc = qmckl_provide_ee_potential(context); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, @@ -841,7 +841,7 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { NULL); } - rc = qmckl_provide_nucleus_repulsion(ctx); + rc = qmckl_provide_nucleus_repulsion(context); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, @@ -849,7 +849,7 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { NULL); } - rc = qmckl_provide_en_potential(ctx); + rc = qmckl_provide_en_potential(context); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, @@ -954,7 +954,7 @@ integer function qmckl_compute_potential_energy_f(context, walk_num, & e_pot = 0.0d0 + repulsion do iwalk = 1, walk_num - e_pot(iwalk) = e_pot(iwalk) + ee_pot(iwalk) + en_pot(iwalk) + e_pot(iwalk) = e_pot(iwalk) + en_pot(iwalk) + ee_pot(iwalk) end do end function qmckl_compute_potential_energy_f From c3f0348f6a57c19071abede46afa6f9c6f0e15fb Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 14 Oct 2021 17:27:25 +0200 Subject: [PATCH 46/68] Fixed merge. #41 --- org/qmckl_determinant.org | 5 +---- org/qmckl_local_energy.org | 3 --- org/qmckl_mo.org | 9 ++++----- 3 files changed, 5 insertions(+), 12 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index bbd8a5c..790d5cc 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1159,9 +1159,6 @@ rc = qmckl_get_ao_vgl(context, &(ao_vgl[0][0][0][0])); assert (rc == QMCKL_SUCCESS); /* Set up MO data */ -rc = qmckl_set_mo_basis_type(context, typ); -assert (rc == QMCKL_SUCCESS); - const int64_t mo_num = chbrclf_mo_num; rc = qmckl_set_mo_basis_mo_num(context, mo_num); assert (rc == QMCKL_SUCCESS); @@ -1698,7 +1695,7 @@ end function qmckl_compute_det_inv_matrix_alpha_f | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | | ~int64_t~ | ~walk_num~ | in | Number of walkers | | ~int64_t~ | ~beta_num~ | in | Number of electrons | - | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | | ~double~ | ~det_value_beta[det_num_beta][walk_num]~ | out | value of determinant matrix | | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | adjoint of determinant matrix | | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | inverse of determinant matrix | diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 6b9b4ce..339106d 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -631,9 +631,6 @@ rc = qmckl_get_ao_vgl(context, &(ao_vgl[0][0][0][0])); assert (rc == QMCKL_SUCCESS); /* Set up MO data */ -rc = qmckl_set_mo_basis_type(context, typ); -assert (rc == QMCKL_SUCCESS); - const int64_t mo_num = chbrclf_mo_num; rc = qmckl_set_mo_basis_mo_num(context, mo_num); assert (rc == QMCKL_SUCCESS); diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index 03ff1d1..d7c72d6 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -446,7 +446,7 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) :FRetType: qmckl_exit_code :END: - #+NAME: qmckl_mo_basis_gaussian_vgl_args + #+NAME: qmckl_mo_basis_vgl_args | ~qmckl_context~ | ~context~ | in | Global state | | ~int64_t~ | ~ao_num~ | in | Number of AOs | | ~int64_t~ | ~mo_num~ | in | Number of MOs | @@ -516,11 +516,10 @@ integer function qmckl_compute_mo_basis_vgl_f(context, & deallocate(mo_vgl_big) deallocate(ao_vgl_big) -end function qmckl_compute_mo_basis_gaussian_vgl_f - +end function qmckl_compute_mo_basis_vgl_f #+end_src - #+CALL: generate_c_header(table=qmckl_mo_basis_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_mo_basis_vgl")) + #+CALL: generate_c_header(table=qmckl_mo_basis_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_mo_basis_vgl")) #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org @@ -535,7 +534,7 @@ end function qmckl_compute_mo_basis_gaussian_vgl_f #+end_src - #+CALL: generate_c_interface(table=qmckl_mo_basis_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_mo_basis_vgl")) + #+CALL: generate_c_interface(table=qmckl_mo_basis_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_mo_basis_vgl")) #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none From df6a2ade6056db36cd028452255e900a5f89b4d1 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 15 Oct 2021 10:22:47 +0200 Subject: [PATCH 47/68] Fixed merge. #41 --- org/qmckl_blas.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index 81db1b7..1a50529 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -161,19 +161,19 @@ integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA, endif if (TransA) then - if (alpha == 1.d0 && beta == 0.d0) then + if (alpha .eq. 1.0d0 .and. beta .eq. 0.0d0) then C = matmul(AT,B) else C = beta*C + alpha*matmul(AT,B) endif else if (TransB) then - if (alpha == 1.d0 && beta == 0.d0) then + if (alpha .eq. 1.0d0 .and. beta .eq. 0.0d0) then C = matmul(A,BT) else C = beta*C + alpha*matmul(A,BT) endif else - if (alpha == 1.d0 && beta == 0.d0) then + if (alpha .eq. 1.0d0 .and. beta .eq. 0.0d0) then C = matmul(A,B) else C = beta*C + alpha*matmul(A,B) From 0928f9ea14f4d43b3656583cd3aaf4fcfffbaca1 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 15 Oct 2021 12:44:37 +0200 Subject: [PATCH 48/68] Moved en_pot to electron. #41 --- org/qmckl_electron.org | 227 +++++++++++++++++++++++++++++++++++-- org/qmckl_local_energy.org | 2 +- org/qmckl_nucleus.org | 203 --------------------------------- 3 files changed, 216 insertions(+), 216 deletions(-) diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index 7408b60..1435fe4 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -68,18 +68,18 @@ int main() { The following data stored in the context: - |-------------------------------------+--------------------------------------+----------------------------------------------------------------------| - | ~uninitialized~ | ~int32_t~ | Keeps bit set for uninitialized data | - | ~num~ | ~int64_t~ | Total number of electrons | - | ~up_num~ | ~int64_t~ | Number of up-spin electrons | - | ~down_num~ | ~int64_t~ | Number of down-spin electrons | - | ~walk_num~ | ~int64_t~ | Number of walkers | - | ~rescale_factor_kappa_ee~ | ~double~ | The distance scaling factor | - | ~rescale_factor_kappa_en~ | ~double~ | The distance scaling factor | - | ~provided~ | ~bool~ | If true, ~electron~ is valid | - | ~coord_new~ | ~double[walk_num][3][num]~ | New set of electron coordinates | - | ~coord_old~ | ~double[walk_num][3][num]~ | Old set of electron coordinates | - | ~coord_new_date~ | ~uint64_t~ | Last modification date of the coordinates | + |---------------------------+----------------------------+-------------------------------------------| + | ~uninitialized~ | ~int32_t~ | Keeps bit set for uninitialized data | + | ~num~ | ~int64_t~ | Total number of electrons | + | ~up_num~ | ~int64_t~ | Number of up-spin electrons | + | ~down_num~ | ~int64_t~ | Number of down-spin electrons | + | ~walk_num~ | ~int64_t~ | Number of walkers | + | ~rescale_factor_kappa_ee~ | ~double~ | The distance scaling factor | + | ~rescale_factor_kappa_en~ | ~double~ | The distance scaling factor | + | ~provided~ | ~bool~ | If true, ~electron~ is valid | + | ~coord_new~ | ~double[walk_num][3][num]~ | New set of electron coordinates | + | ~coord_old~ | ~double[walk_num][3][num]~ | Old set of electron coordinates | + | ~coord_new_date~ | ~uint64_t~ | Last modification date of the coordinates | Computed data: @@ -94,6 +94,8 @@ int main() { | ~ee_distance_rescaled_deriv_e_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | | ~ee_pot~ | ~double[walk_num]~ | Electron-electron rescaled distances derivatives | | ~ee_pot_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives | + | ~en_pot~ | double[walk_num] | Electron-nucleus potential energy | + | ~en_pot_date~ | int64_t | Date when the electron-nucleus potential energy was computed | | ~en_distance_rescaled~ | ~double[walk_num][nucl_num][num]~ | Electron-nucleus distances | | ~en_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances | | ~en_distance_rescaled_deriv_e~ | ~double[walk_num][4][nucl_num][num]~ | Electron-electron rescaled distances derivatives | @@ -113,6 +115,7 @@ typedef struct qmckl_electron_struct { int64_t ee_distance_date; int64_t en_distance_date; int64_t ee_pot_date; + int64_t en_pot_date; int64_t ee_distance_rescaled_date; int64_t ee_distance_rescaled_deriv_e_date; int64_t en_distance_rescaled_date; @@ -122,6 +125,7 @@ typedef struct qmckl_electron_struct { double* ee_distance; double* en_distance; double* ee_pot; + double* en_pot; double* ee_distance_rescaled; double* ee_distance_rescaled_deriv_e; double* en_distance_rescaled; @@ -2604,6 +2608,205 @@ assert (rc == QMCKL_SUCCESS); #+end_src +** Electron-nucleus potential + ~en_potential~ stores the ~en~ potential energy + + \[ + \mathcal{V}_{en} = -\sum_{i=1}^{N_e}\sum_{A=1}^{N_n}\frac{Z_A}{r_{iA}} + \] + + where \(\mathcal{V}_{en}\) is the ~en~ potential, \[r_{iA}\] the ~en~ + distance and \[Z_A\] is the nuclear charge. + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_electron_en_potential(qmckl_context context, double* const en_pot); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_electron_en_potential(qmckl_context context, double* const en_pot) +{ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_en_potential(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->electron.walk_num * sizeof(double); + memcpy(en_pot, ctx->electron.en_pot, sze); + + return QMCKL_SUCCESS; +} + #+end_src + +*** Provide :noexport: + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_en_potential(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_en_potential(qmckl_context context) +{ + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + if (!ctx->electron.provided) return QMCKL_NOT_PROVIDED; + if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->electron.en_pot_date) { + + /* Allocate array */ + if (ctx->electron.en_pot == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walk_num * sizeof(double); + double* en_pot = (double*) qmckl_malloc(context, mem_info); + + if (en_pot == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_en_potential", + NULL); + } + ctx->electron.en_pot = en_pot; + } + + qmckl_exit_code rc = + qmckl_compute_en_potential(context, + ctx->electron.num, + ctx->nucleus.num, + ctx->electron.walk_num, + ctx->nucleus.charge, + ctx->electron.en_distance, + ctx->electron.en_pot); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->electron.en_pot_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_en_potential + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_en_potential_args + | qmckl_context | context | in | Global state | + | int64_t | elec_num | in | Number of electrons | + | int64_t | nucl_num | in | Number of nucleii | + | int64_t | walk_num | in | Number of walkers | + | double | charge[nucl_num] | in | charge of nucleus | + | double | en_distance[walk_num][nucl_num][elec_num] | in | Electron-electron rescaled distances | + | double | en_pot[walk_num] | out | Electron-electron potential | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_en_potential_f(context, elec_num, nucl_num, walk_num, & + charge, en_distance, en_pot) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: elec_num + integer*8 , intent(in) :: nucl_num + integer*8 , intent(in) :: walk_num + double precision , intent(in) :: charge(nucl_num) + double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num) + double precision , intent(out) :: en_pot(walk_num) + + integer*8 :: nw, i, j + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (elec_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + en_pot = 0.0d0 + do nw=1,walk_num + do j=1,nucl_num + do i=1,elec_num + en_pot(nw) = en_pot(nw) - charge(j)/(en_distance(i,j,nw)) + end do + end do + end do + +end function qmckl_compute_en_potential_f + #+end_src + + #+CALL: generate_c_header(table=qmckl_en_potential_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_compute_en_potential ( + const qmckl_context context, + const int64_t elec_num, + const int64_t nucl_num, + const int64_t walk_num, + const double* charge, + const double* en_distance, + double* const en_pot ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_en_potential_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_en_potential & + (context, elec_num, nucl_num, walk_num, charge, en_distance, en_pot) & + 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 :: 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) :: charge(nucl_num) + real (c_double ) , intent(in) :: en_distance(elec_num,nucl_num,walk_num) + real (c_double ) , intent(out) :: en_pot(walk_num) + + integer(c_int32_t), external :: qmckl_compute_en_potential_f + info = qmckl_compute_en_potential_f & + (context, elec_num, nucl_num, walk_num, charge, en_distance, en_pot) + + end function qmckl_compute_en_potential + #+end_src + +*** Test + * End of files :noexport: #+begin_src c :tangle (eval h_private_type) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 339106d..8193ba7 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -879,7 +879,7 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { ctx->electron.num, ctx->nucleus.num, ctx->electron.ee_pot, - ctx->nucleus.en_pot, + ctx->electron.en_pot, ctx->nucleus.repulsion, ctx->local_energy.e_pot); } else { diff --git a/org/qmckl_nucleus.org b/org/qmckl_nucleus.org index f2e2116..1406087 100644 --- a/org/qmckl_nucleus.org +++ b/org/qmckl_nucleus.org @@ -85,8 +85,6 @@ int main() { | ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed | | ~repulsion~ | double | Nuclear repulsion energy | | ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed | - | ~en_pot~ | double[walk_num] | Electron-nucleus potential energy | - | ~en_pot_date~ | int64_t | Date when the electron-nucleus potential energy was computed | ** Data structure @@ -105,8 +103,6 @@ typedef struct qmckl_nucleus_struct { double rescale_factor_kappa; int32_t uninitialized; bool provided; - int64_t en_pot_date; - double* en_pot; } qmckl_nucleus_struct; #+end_src @@ -1145,205 +1141,6 @@ assert(rep - 318.2309879436158 < 1.e-10); #+end_src -** Electron-nucleus potential - ~en_potential~ stores the ~en~ potential energy - - \[ - \mathcal{V}_{en} = -\sum_{i=1}^{N_e}\sum_{A=1}^{N_n}\frac{Z_A}{r_{iA}} - \] - - where \(\mathcal{V}_{en}\) is the ~en~ potential, \[r_{iA}\] the ~en~ - distance and \[Z_A\] is the nuclear charge. - -*** Get - - #+begin_src c :comments org :tangle (eval h_func) :noweb yes -qmckl_exit_code qmckl_get_electron_en_potential(qmckl_context context, double* const en_pot); - #+end_src - - #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_get_electron_en_potential(qmckl_context context, double* const en_pot) -{ - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; - } - - qmckl_exit_code rc; - - rc = qmckl_provide_en_potential(context); - if (rc != QMCKL_SUCCESS) return rc; - - qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; - assert (ctx != NULL); - - size_t sze = ctx->electron.walk_num * sizeof(double); - memcpy(en_pot, ctx->nucleus.en_pot, sze); - - return QMCKL_SUCCESS; -} - #+end_src - -*** Provide :noexport: - - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_provide_en_potential(qmckl_context context); - #+end_src - - #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_provide_en_potential(qmckl_context context) -{ - - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; - } - - qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; - assert (ctx != NULL); - - if (!ctx->electron.provided) return QMCKL_NOT_PROVIDED; - if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; - - /* Compute if necessary */ - if (ctx->electron.coord_new_date > ctx->nucleus.en_pot_date) { - - /* Allocate array */ - if (ctx->nucleus.en_pot == NULL) { - - qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->electron.walk_num * sizeof(double); - double* en_pot = (double*) qmckl_malloc(context, mem_info); - - if (en_pot == NULL) { - return qmckl_failwith( context, - QMCKL_ALLOCATION_FAILED, - "qmckl_en_potential", - NULL); - } - ctx->nucleus.en_pot = en_pot; - } - - qmckl_exit_code rc = - qmckl_compute_en_potential(context, - ctx->electron.num, - ctx->nucleus.num, - ctx->electron.walk_num, - ctx->nucleus.charge, - ctx->electron.en_distance, - ctx->nucleus.en_pot); - if (rc != QMCKL_SUCCESS) { - return rc; - } - - ctx->nucleus.en_pot_date = ctx->date; - } - - return QMCKL_SUCCESS; -} - #+end_src - -*** Compute - :PROPERTIES: - :Name: qmckl_compute_en_potential - :CRetType: qmckl_exit_code - :FRetType: qmckl_exit_code - :END: - - #+NAME: qmckl_en_potential_args - | qmckl_context | context | in | Global state | - | int64_t | elec_num | in | Number of electrons | - | int64_t | nucl_num | in | Number of nucleii | - | int64_t | walk_num | in | Number of walkers | - | double | charge[nucl_num] | in | charge of nucleus | - | double | en_distance[walk_num][nucl_num][elec_num] | in | Electron-electron rescaled distances | - | double | en_pot[walk_num] | out | Electron-electron potential | - - #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_en_potential_f(context, elec_num, nucl_num, walk_num, & - charge, en_distance, en_pot) & - result(info) - use qmckl - implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: elec_num - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: walk_num - double precision , intent(in) :: charge(nucl_num) - double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num) - double precision , intent(out) :: en_pot(walk_num) - - integer*8 :: nw, i, j - - info = QMCKL_SUCCESS - - if (context == QMCKL_NULL_CONTEXT) then - info = QMCKL_INVALID_CONTEXT - return - endif - - if (elec_num <= 0) then - info = QMCKL_INVALID_ARG_2 - return - endif - - if (walk_num <= 0) then - info = QMCKL_INVALID_ARG_3 - return - endif - - en_pot = 0.0d0 - do nw=1,walk_num - do j=1,nucl_num - do i=1,elec_num - en_pot(nw) = en_pot(nw) - charge(j)/(en_distance(i,j,nw)) - end do - end do - end do - -end function qmckl_compute_en_potential_f - #+end_src - - #+CALL: generate_c_header(table=qmckl_en_potential_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - - #+RESULTS: - #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_compute_en_potential ( - const qmckl_context context, - const int64_t elec_num, - const int64_t nucl_num, - const int64_t walk_num, - const double* charge, - const double* en_distance, - double* const en_pot ); - #+end_src - - #+CALL: generate_c_interface(table=qmckl_en_potential_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_en_potential & - (context, elec_num, nucl_num, walk_num, charge, en_distance, en_pot) & - 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 :: 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) :: charge(nucl_num) - real (c_double ) , intent(in) :: en_distance(elec_num,nucl_num,walk_num) - real (c_double ) , intent(out) :: en_pot(walk_num) - - integer(c_int32_t), external :: qmckl_compute_en_potential_f - info = qmckl_compute_en_potential_f & - (context, elec_num, nucl_num, walk_num, charge, en_distance, en_pot) - - end function qmckl_compute_en_potential - #+end_src - -*** Test - * End of files :noexport: #+begin_src c :tangle (eval h_private_type) From 4167f2a1c19252f28bc54968c122bd643534a4ca Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 15 Oct 2021 13:05:50 +0200 Subject: [PATCH 49/68] Added tests for ee_pot and en_pot. #41 --- org/qmckl_electron.org | 15 ++++++++++++++- org/qmckl_local_energy.org | 12 ++++++++++-- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index 1435fe4..ef43a46 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -1721,6 +1721,7 @@ integer function qmckl_compute_ee_potential_f(context, elec_num, walk_num, & info = QMCKL_INVALID_ARG_3 return endif + print *,"In calc ee_pot\n" ee_pot = 0.0d0 do nw=1,walk_num @@ -1771,6 +1772,12 @@ end function qmckl_compute_ee_potential_f #+end_src *** Test + #+begin_src c :tangle (eval c_test) +double ee_pot[walk_num]; + +rc = qmckl_get_electron_ee_potential(context, &(ee_pot[0])); +assert (rc == QMCKL_SUCCESS); + #+end_src ** Electron-nucleus distances *** Get @@ -2617,7 +2624,7 @@ assert (rc == QMCKL_SUCCESS); where \(\mathcal{V}_{en}\) is the ~en~ potential, \[r_{iA}\] the ~en~ distance and \[Z_A\] is the nuclear charge. - + *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes @@ -2806,6 +2813,12 @@ end function qmckl_compute_en_potential_f #+end_src *** Test + #+begin_src c :tangle (eval c_test) +double en_pot[walk_num]; + +rc = qmckl_get_electron_en_potential(context, &(en_pot[0])); +assert (rc == QMCKL_SUCCESS); + #+end_src * End of files :noexport: diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 8193ba7..ce85465 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -846,6 +846,14 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { NULL); } + rc = qmckl_provide_ee_potential(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ee_potential", + NULL); + } + rc = qmckl_provide_en_potential(context); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, @@ -949,9 +957,9 @@ integer function qmckl_compute_potential_energy_f(context, walk_num, & return endif - e_pot = 0.0d0 + repulsion + e_pot = 0.0d0 !+ repulsion do iwalk = 1, walk_num - e_pot(iwalk) = e_pot(iwalk) + en_pot(iwalk) + ee_pot(iwalk) + e_pot(iwalk) = e_pot(iwalk) + ee_pot(iwalk) !+ en_pot(iwalk) end do end function qmckl_compute_potential_energy_f From fade372e02e438ce3c184cd1f2c035bea0ba42f2 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 15 Oct 2021 13:48:48 +0200 Subject: [PATCH 50/68] Added missing provider calls for ee_pot and en_pot. #41 --- org/qmckl_electron.org | 9 +++++++-- org/qmckl_local_energy.org | 4 ++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index ef43a46..a26276c 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -201,7 +201,7 @@ if ( (ctx->electron.uninitialized & mask) != 0) { return NULL; } #+end_src - + *** Number of electrons #+begin_src c :comments org :tangle (eval h_func) :exports none @@ -1641,6 +1641,9 @@ qmckl_exit_code qmckl_provide_ee_potential(qmckl_context context) if (!ctx->electron.provided) return QMCKL_NOT_PROVIDED; + qmckl_exit_code rc = qmckl_provide_ee_distance(context); + if (rc != QMCKL_SUCCESS) return rc; + /* Compute if necessary */ if (ctx->electron.coord_new_date > ctx->electron.ee_pot_date) { @@ -1721,7 +1724,6 @@ integer function qmckl_compute_ee_potential_f(context, elec_num, walk_num, & info = QMCKL_INVALID_ARG_3 return endif - print *,"In calc ee_pot\n" ee_pot = 0.0d0 do nw=1,walk_num @@ -2673,6 +2675,9 @@ qmckl_exit_code qmckl_provide_en_potential(qmckl_context context) if (!ctx->electron.provided) return QMCKL_NOT_PROVIDED; if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; + qmckl_exit_code rc = qmckl_provide_en_distance(context); + if (rc != QMCKL_SUCCESS) return rc; + /* Compute if necessary */ if (ctx->electron.coord_new_date > ctx->electron.en_pot_date) { diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index ce85465..802fa2a 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -957,9 +957,9 @@ integer function qmckl_compute_potential_energy_f(context, walk_num, & return endif - e_pot = 0.0d0 !+ repulsion + e_pot = 0.0d0 + repulsion do iwalk = 1, walk_num - e_pot(iwalk) = e_pot(iwalk) + ee_pot(iwalk) !+ en_pot(iwalk) + e_pot(iwalk) = e_pot(iwalk) + ee_pot(iwalk) + en_pot(iwalk) end do end function qmckl_compute_potential_energy_f From 4e877810da77e03f3fbe135f742c2fd2bcea9bbe Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 15 Oct 2021 14:00:36 +0200 Subject: [PATCH 51/68] Initialize local energy. #41 --- org/qmckl_local_energy.org | 1 + 1 file changed, 1 insertion(+) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 802fa2a..22df37e 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -1219,6 +1219,7 @@ integer function qmckl_compute_local_energy_f(context, walk_num, & return endif + e_local = 0.0d0 do iwalk = 1, walk_num e_local(iwalk) = e_local(iwalk) + e_kin(iwalk) + e_pot(iwalk) end do From 2cca7c00dd39706c26078e9307a8821e08a76f9c Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 15 Oct 2021 14:38:44 +0200 Subject: [PATCH 52/68] All functions look good. Need real tests. #41 --- org/qmckl_local_energy.org | 1 - 1 file changed, 1 deletion(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 22df37e..04bed6e 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -1623,7 +1623,6 @@ double drift_vector[walk_num][3]; rc = qmckl_get_drift_vector(context, &(drift_vector[0][0])); assert (rc == QMCKL_SUCCESS); - #+end_src * End of files :noexport: From b8886fee28e055c4e102c848be96fe1110235d52 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Tue, 19 Oct 2021 11:37:46 +0200 Subject: [PATCH 53/68] Removed walk_num from local energy mo_vgl. #41 --- org/qmckl_local_energy.org | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 04bed6e..e5bfd48 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -357,7 +357,7 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~e_kin[walk_num]~ | out | Kinetic energy | @@ -379,7 +379,7 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & integer*8, intent(in) :: mo_num integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) integer*8, intent(in) :: mo_index_beta(beta_num, walk_num, det_num_beta) - double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) + double precision, intent(in) :: mo_vgl(mo_num, elec_num, 5) double precision, intent(in) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) double precision, intent(in) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) double precision, intent(inout) :: e_kin(walk_num) @@ -420,7 +420,7 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & do ielec = 1, alpha_num mo_id = mo_index_alpha(ielec, iwalk, idet) e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, iwalk, 5) + mo_vgl(mo_id, ielec, 5) end do end do ! Beta part @@ -428,7 +428,7 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & do ielec = 1, beta_num mo_id = mo_index_beta(ielec, iwalk, idet) e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, alpha_num + ielec, iwalk, 5) + mo_vgl(mo_id, ielec, 5) end do end do end do @@ -492,7 +492,7 @@ end function qmckl_compute_kinetic_energy_f integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) + real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,5) real (c_double ) , intent(in) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) real (c_double ) , intent(in) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) real (c_double ) , intent(out) :: e_kin(walk_num) @@ -1447,7 +1447,7 @@ qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context) { | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][walk_num][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~r_drift[walk_num][3]~ | out | Kinetic energy | @@ -1469,7 +1469,7 @@ integer function qmckl_compute_drift_vector_f(context, walk_num, & integer*8, intent(in) :: mo_num integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) integer*8, intent(in) :: mo_index_beta(beta_num, walk_num, det_num_beta) - double precision, intent(in) :: mo_vgl(mo_num, elec_num, walk_num, 5) + double precision, intent(in) :: mo_vgl(mo_num, elec_num, 5) double precision, intent(in) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) double precision, intent(in) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) double precision, intent(inout) :: r_drift(3,walk_num) @@ -1510,11 +1510,11 @@ integer function qmckl_compute_drift_vector_f(context, walk_num, & do ielec = 1, alpha_num mo_id = mo_index_alpha(ielec, iwalk, idet) r_drift(1,iwalk) = r_drift(1,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, iwalk, 2) + mo_vgl(mo_id, ielec, 2) r_drift(2,iwalk) = r_drift(2,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, iwalk, 3) + mo_vgl(mo_id, ielec, 3) r_drift(3,iwalk) = r_drift(3,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, iwalk, 4) + mo_vgl(mo_id, ielec, 4) end do end do ! Beta part @@ -1522,11 +1522,11 @@ integer function qmckl_compute_drift_vector_f(context, walk_num, & do ielec = 1, beta_num mo_id = mo_index_beta(ielec, iwalk, idet) r_drift(1,iwalk) = r_drift(1,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, alpha_num + ielec, iwalk, 2) + mo_vgl(mo_id, ielec, 2) r_drift(2,iwalk) = r_drift(2,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, alpha_num + ielec, iwalk, 3) + mo_vgl(mo_id, ielec, 3) r_drift(3,iwalk) = r_drift(3,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, alpha_num + ielec, iwalk, 4) + mo_vgl(mo_id, ielec, 4) end do end do end do @@ -1590,7 +1590,7 @@ end function qmckl_compute_drift_vector_f integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) integer (c_int64_t) , intent(in) , value :: mo_num - real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,walk_num,5) + real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,5) real (c_double ) , intent(in) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) real (c_double ) , intent(in) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) real (c_double ) , intent(out) :: r_drift(3,walk_num) From a2e420e9a5bb3ed89b5337479765101926e8fdfa Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 21 Oct 2021 19:49:47 +0200 Subject: [PATCH 54/68] fixed blas . #41 --- org/qmckl_blas.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index 6fc570f..cd04b2e 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -162,19 +162,19 @@ integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA, if (TransA) then - if (alpha .eq. 1.0d0 .and. beta .eq. 0.0d0) then + if (alpha == 1.0d0 .and. beta == 0.0d0) then C = matmul(AT,B) else C = beta*C + alpha*matmul(AT,B) endif else if (TransB) then - if (alpha .eq. 1.0d0 .and. beta .eq. 0.0d0) then + if (alpha == 1.0d0 .and. beta == 0.0d0) then C = matmul(A,BT) else C = beta*C + alpha*matmul(A,BT) endif else - if (alpha .eq. 1.0d0 .and. beta .eq. 0.0d0) then + if (alpha == 1.0d0 .and. beta == 0.0d0) then C = matmul(A,B) else C = beta*C + alpha*matmul(A,B) From e80c8d51ed35e46fc46b3aa199dc1f7ac5f6abb0 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 25 Oct 2021 15:29:08 +0200 Subject: [PATCH 55/68] Added AO Normalization in trexio read. #41 --- org/qmckl_trexio.org | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/org/qmckl_trexio.org b/org/qmckl_trexio.org index 9662938..9faac75 100644 --- a/org/qmckl_trexio.org +++ b/org/qmckl_trexio.org @@ -704,6 +704,42 @@ qmckl_trexio_read_ao_X(qmckl_context context, trexio_t* const file) } #+end_src +*** AO Normalization + #+begin_src c :tangle (eval c) + { + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ao_num * sizeof(double); + + double* ao_normalization = (double*) qmckl_malloc(context, mem_info); + + if (ao_normalization == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_trexio_read_ao_normalization_X", + NULL); + } + + assert (ao_normalization != NULL); + + rcio = trexio_read_ao_normalization_64(file, ao_normalization); + if (rcio != TREXIO_SUCCESS) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "trexio_read_ao_normalization", + trexio_string_of_error(rcio)); + } + + rc = qmckl_set_ao_basis_ao_factor(context, ao_normalization); + + qmckl_free(context, ao_normalization); + ao_normalization = NULL; + + if (rc != QMCKL_SUCCESS) + return rc; + } + #+end_src + + #+begin_src c :tangle (eval c) @@ -711,7 +747,6 @@ qmckl_trexio_read_ao_X(qmckl_context context, trexio_t* const file) } #endif #+end_src - ** Molecular orbitals In this section we read the MO coefficients. From e2a9f9d7bbc01e990d5bcf929c9fd611c473191d Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 25 Oct 2021 18:45:06 +0200 Subject: [PATCH 56/68] Fixed bug in mo_vgl where ao_vgl was not given as dependency. #41 --- org/qmckl_context.org | 6 +++ org/qmckl_determinant.org | 99 +++++++++++++++++++++++++++++++++----- org/qmckl_local_energy.org | 17 +++++-- org/qmckl_mo.org | 67 +++++++++++++++++++++++--- org/qmckl_trexio.org | 3 ++ 5 files changed, 168 insertions(+), 24 deletions(-) diff --git a/org/qmckl_context.org b/org/qmckl_context.org index 578cb55..7b26a7f 100644 --- a/org/qmckl_context.org +++ b/org/qmckl_context.org @@ -244,6 +244,12 @@ qmckl_context qmckl_context_create() { rc = qmckl_init_ao_basis(context); assert (rc == QMCKL_SUCCESS); + + rc = qmckl_init_mo_basis(context); + assert (rc == QMCKL_SUCCESS); + + rc = qmckl_init_determinant(context); + assert (rc == QMCKL_SUCCESS); } /* Allocate qmckl_memory_struct */ diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 790d5cc..d071190 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -171,6 +171,26 @@ typedef struct qmckl_determinant_struct { Some values are initialized by default, and are not concerned by this mechanism. + #+begin_src c :comments org :tangle (eval h_private_func) +qmckl_exit_code qmckl_init_determinant(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_init_determinant(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return false; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + ctx->det.uninitialized = (1 << 6) - 1; + + return QMCKL_SUCCESS; +} + #+end_src + ** Access functions #+begin_src c :comments org :tangle (eval h_private_func) :exports none @@ -189,6 +209,20 @@ int64_t* qmckl_get_determinant_mo_index_beta (const qmckl_context context); bool qmckl_determinant_provided (const qmckl_context context); #+end_src + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +bool qmckl_determinant_provided(const qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return false; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + return ctx->det.provided; +} + #+end_src + #+NAME:post #+begin_src c :exports none if ( (ctx->det.uninitialized & mask) != 0) { @@ -337,8 +371,8 @@ qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; ctx->det.uninitialized &= ~mask; ctx->det.provided = (ctx->det.uninitialized == 0); if (ctx->det.provided) { - //qmckl_exit_code rc_ = qmckl_finalize_determinant(context); - //if (rc_ != QMCKL_SUCCESS) return rc_; + qmckl_exit_code rc_ = qmckl_finalize_determinant(context); + if (rc_ != QMCKL_SUCCESS) return rc_; } return QMCKL_SUCCESS; @@ -412,7 +446,7 @@ qmckl_exit_code qmckl_set_determinant_det_num_beta(qmckl_context context, const qmckl_exit_code qmckl_set_determinant_mo_index_alpha(qmckl_context context, const int64_t* mo_index_alpha) { <> - int32_t mask = 1 << 5; + int32_t mask = 1 << 4; if (ctx->det.mo_index_alpha != NULL) { qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_alpha); @@ -444,7 +478,7 @@ qmckl_exit_code qmckl_set_determinant_mo_index_alpha(qmckl_context context, con qmckl_exit_code qmckl_set_determinant_mo_index_beta(qmckl_context context, const int64_t* mo_index_beta) { <> - int32_t mask = 1 << 6; + int32_t mask = 1 << 5; if (ctx->det.mo_index_beta != NULL) { qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_beta); @@ -479,11 +513,50 @@ qmckl_exit_code qmckl_set_determinant_mo_index_beta(qmckl_context context, cons computed to accelerate the calculations. #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_finalize_basis(qmckl_context context); +qmckl_exit_code qmckl_finalize_determinant(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_finalize_determinant", + NULL); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + qmckl_exit_code rc; + rc = qmckl_provide_det_vgl_alpha(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_finalize_determinant", + NULL); + } + rc = qmckl_provide_det_vgl_beta(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_finalize_determinant", + NULL); + } + rc = qmckl_provide_det_inv_matrix_alpha(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_finalize_determinant", + NULL); + } + rc = qmckl_provide_det_inv_matrix_beta(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_finalize_determinant", + NULL); + } } #+end_src @@ -608,7 +681,7 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { if (!ctx->det.provided) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, - "qmckl_mo_basis", + "qmckl_determinant", NULL); } @@ -959,19 +1032,19 @@ integer function qmckl_compute_det_vgl_beta_f(context, & do imo = 1, beta_num mo_id = mo_index_beta(imo, iwalk, idet) ! Value - det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 1) + det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, 1) ! Grad_x - det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 2) + det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, 2) ! Grad_y - det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 3) + det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, 3) ! Grad_z - det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 4) + det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, 4) ! Lap - det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 5) + det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, 5) end do end do end do @@ -1280,7 +1353,7 @@ qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double * co rc = qmckl_provide_mo_vgl(context); if (rc != QMCKL_SUCCESS) return rc; - rc = qmckl_provide_det_vgl_alpha(context); + rc = qmckl_provide_det_vgl_beta(context); if (rc != QMCKL_SUCCESS) return rc; rc = qmckl_provide_det_inv_matrix_beta(context); @@ -1496,7 +1569,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * - ctx->electron.up_num * ctx->electron.up_num * sizeof(double); + ctx->electron.down_num * ctx->electron.down_num * sizeof(double); double* det_adj_matrix_beta = (double*) qmckl_malloc(context, mem_info); if (det_adj_matrix_beta == NULL) { diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index e5bfd48..b3e24a5 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -412,6 +412,16 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & return endif + print *,"Size of mo_vgl=",size(mo_vgl) + print *,"Size of mo_index_alpha=",size(mo_index_alpha) + print *,"Size of mo_index_beta=",size(mo_index_beta) + print *,"Size of det_adj_matrix_alpha=",size(det_adj_matrix_alpha) + print *,"Size of det_adj_matrix_beta=",size(det_adj_matrix_beta) + print *,"num_alpha = ",alpha_num + print *,"num_beta = ",beta_num + print *,"det_num_alpha = ",det_num_alpha + print *,"det_num_beta = ",det_num_beta + print *,"walk_num = ",walk_num e_kin = 0.0d0 do idet = 1, det_num_alpha do iwalk = 1, walk_num @@ -427,8 +437,9 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & do imo = 1, beta_num do ielec = 1, beta_num mo_id = mo_index_beta(ielec, iwalk, idet) - e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, 5) + print *,mo_id, imo, ielec, iwalk, idet + e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) + ! mo_vgl(mo_id, ielec, 5) end do end do end do @@ -1447,7 +1458,7 @@ qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context) { | ~int64_t~ | ~mo_index_alpha[det_num_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | - | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~r_drift[walk_num][3]~ | out | Kinetic energy | diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index dad47ae..b9d220c 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -118,6 +118,26 @@ typedef struct qmckl_mo_basis_struct { Some values are initialized by default, and are not concerned by this mechanism. + #+begin_src c :comments org :tangle (eval h_private_func) +qmckl_exit_code qmckl_init_mo_basis(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_init_mo_basis(qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return false; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + ctx->mo_basis.uninitialized = (1 << 2) - 1; + + return QMCKL_SUCCESS; +} + #+end_src + ** Access functions #+begin_src c :comments org :tangle (eval h_func) :exports none @@ -259,10 +279,9 @@ qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; ctx->mo_basis.uninitialized &= ~mask; ctx->mo_basis.provided = (ctx->mo_basis.uninitialized == 0); if (ctx->mo_basis.provided) { - qmckl_exit_code rc_ = qmckl_finalize_basis(context); + qmckl_exit_code rc_ = qmckl_finalize_mo_basis(context); if (rc_ != QMCKL_SUCCESS) return rc_; - } - +} return QMCKL_SUCCESS; #+end_src @@ -319,6 +338,34 @@ qmckl_exit_code qmckl_set_mo_basis_coefficient(qmckl_context context, const dou When the basis set is completely entered, other data structures are computed to accelerate the calculations. + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_finalize_mo_basis(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_finalize_mo_basis(qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_finalize_mo_basis", + NULL); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + qmckl_exit_code rc; + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_finalize_mo_basis", + NULL); + } + return rc; +} + #+end_src + * Computation ** Computation of MOs @@ -378,6 +425,7 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context); qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) { + qmckl_exit_code rc; if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; } @@ -392,6 +440,14 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) NULL); } + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_ao_basis", + NULL); + } + if(!(ctx->electron.provided)) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, @@ -425,7 +481,6 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) ctx->mo_basis.mo_vgl = mo_vgl; } - qmckl_exit_code rc; rc = qmckl_compute_mo_basis_vgl(context, ctx->ao_basis.ao_num, ctx->mo_basis.mo_num, @@ -479,10 +534,6 @@ integer function qmckl_compute_mo_basis_vgl_f(context, & double precision,dimension(:,:),allocatable :: ao_vgl_big double precision :: alpha, beta integer :: info_qmckl_dgemm_value - integer :: info_qmckl_dgemm_Gx - integer :: info_qmckl_dgemm_Gy - integer :: info_qmckl_dgemm_Gz - integer :: info_qmckl_dgemm_lap integer*8 :: M, N, K, LDA, LDB, LDC, i,j integer*8 :: inucl, iprim, iwalk, ielec, ishell diff --git a/org/qmckl_trexio.org b/org/qmckl_trexio.org index 9faac75..4db1837 100644 --- a/org/qmckl_trexio.org +++ b/org/qmckl_trexio.org @@ -915,6 +915,7 @@ qmckl_trexio_read(const qmckl_context context, const char* file_name) #+begin_src c :tangle (eval c_test) #ifdef HAVE_TREXIO +#define walk_num 2 qmckl_exit_code rc; char fname[256]; @@ -927,6 +928,8 @@ char message[256]; strncpy(fname, QMCKL_TEST_DIR,255); strncat(fname, "/chbrclf", 255); printf("Test file: %s\n", fname); + +rc = qmckl_set_electron_walk_num(context, walk_num); rc = qmckl_trexio_read(context, fname); if (rc != QMCKL_SUCCESS) { From 3f181fa5969c7b939b866773264520b11985ee0a Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 25 Oct 2021 19:11:03 +0200 Subject: [PATCH 57/68] Added dependency for MOs in determinant. #41 --- org/qmckl_determinant.org | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index d071190..3dfd8ba 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -643,6 +643,7 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context); #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { + qmckl_exit_code rc; if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; } @@ -677,6 +678,14 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { "qmckl_mo_basis", NULL); } + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_mo_basis", + NULL); + } + if (!ctx->det.provided) { return qmckl_failwith( context, @@ -705,7 +714,6 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { ctx->det.det_vgl_alpha = det_vgl_alpha; } - qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_vgl_alpha(context, ctx->det.det_num_alpha, From a94f446dd06d80297dc7992711a89687b834c64f Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 25 Oct 2021 19:12:48 +0200 Subject: [PATCH 58/68] Removed debug print. #41 --- org/qmckl_local_energy.org | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index b3e24a5..d4d2cee 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -412,16 +412,6 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & return endif - print *,"Size of mo_vgl=",size(mo_vgl) - print *,"Size of mo_index_alpha=",size(mo_index_alpha) - print *,"Size of mo_index_beta=",size(mo_index_beta) - print *,"Size of det_adj_matrix_alpha=",size(det_adj_matrix_alpha) - print *,"Size of det_adj_matrix_beta=",size(det_adj_matrix_beta) - print *,"num_alpha = ",alpha_num - print *,"num_beta = ",beta_num - print *,"det_num_alpha = ",det_num_alpha - print *,"det_num_beta = ",det_num_beta - print *,"walk_num = ",walk_num e_kin = 0.0d0 do idet = 1, det_num_alpha do iwalk = 1, walk_num @@ -437,7 +427,6 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & do imo = 1, beta_num do ielec = 1, beta_num mo_id = mo_index_beta(ielec, iwalk, idet) - print *,mo_id, imo, ielec, iwalk, idet e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) ! mo_vgl(mo_id, ielec, 5) end do From 5ea5e83c6cf88aa5397cd695628c9a82f25f791c Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 25 Oct 2021 19:25:13 +0200 Subject: [PATCH 59/68] fixed debug comment. #41 --- org/qmckl_local_energy.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index d4d2cee..fa350d9 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -427,8 +427,8 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & do imo = 1, beta_num do ielec = 1, beta_num mo_id = mo_index_beta(ielec, iwalk, idet) - e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) - ! mo_vgl(mo_id, ielec, 5) + e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, ielec, 5) end do end do end do From a49e9151e5334a0a606a27d069b84d253c4e5ab2 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 25 Oct 2021 21:51:27 +0200 Subject: [PATCH 60/68] Added access function for adjoint matrix of determinant. #41 --- org/qmckl_determinant.org | 60 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 3dfd8ba..6beba36 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1315,6 +1315,8 @@ assert (rc == QMCKL_SUCCESS); #+begin_src c :comments org :tangle (eval h_func) :noweb yes qmckl_exit_code qmckl_get_det_inv_matrix_alpha(qmckl_context context, double* const det_inv_matrix_alpha); qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double* const det_inv_matrix_beta); +qmckl_exit_code qmckl_get_det_adj_matrix_alpha(qmckl_context context, double* const det_adj_matrix_alpha); +qmckl_exit_code qmckl_get_det_adj_matrix_beta(qmckl_context context, double* const det_adj_matrix_beta); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none @@ -1373,6 +1375,64 @@ qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double * co size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; memcpy(det_inv_matrix_beta, ctx->det.det_inv_matrix_beta, sze * sizeof(double)); + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_det_adj_matrix_alpha(qmckl_context context, double * const det_adj_matrix_alpha) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_vgl_alpha(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_inv_matrix_alpha(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num; + memcpy(det_adj_matrix_alpha, ctx->det.det_adj_matrix_alpha, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_det_adj_matrix_beta(qmckl_context context, double * const det_adj_matrix_beta) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_vgl_beta(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_inv_matrix_beta(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; + memcpy(det_adj_matrix_beta, ctx->det.det_adj_matrix_beta, sze * sizeof(double)); + return QMCKL_SUCCESS; } #+end_src From 1869756ea48fc5dc8f82311b95e311104be29b82 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Tue, 26 Oct 2021 19:13:20 +0200 Subject: [PATCH 61/68] Verified Local energy with QMC=Chem for Be2. #41 --- org/qmckl_blas.org | 284 +++++++++++++++++++++++++++++++++---- org/qmckl_determinant.org | 16 +-- org/qmckl_electron.org | 2 +- org/qmckl_local_energy.org | 95 +++++++++---- org/qmckl_mo.org | 39 +++-- 5 files changed, 357 insertions(+), 79 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index cd04b2e..918cd9b 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -22,7 +22,7 @@ int main() { * Matrix operations ** ~qmckl_dgemm~ - + Matrix multiply: $C_{ij} = \beta C_{ij} + \alpha \sum_{k} A_{ik} \cdot B_{kj}$ using Fortran ~matmul~ function. TODO: Add description about the external library dependence. @@ -90,21 +90,22 @@ integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA, integer*8 , intent(in) :: m, n, k real*8 , intent(in) :: alpha, beta integer*8 , intent(in) :: lda - real*8 , intent(in) :: A(m,k) + real*8 , intent(in) :: A(lda,*) integer*8 , intent(in) :: ldb - real*8 , intent(in) :: B(k,n) + real*8 , intent(in) :: B(ldb,*) integer*8 , intent(in) :: ldc - real*8 , intent(out) :: C(m,n) + real*8 , intent(out) :: C(ldc,*) real*8, allocatable :: AT(:,:), BT(:,:), CT(:,:) + integer*4 :: qmckl_dgemm_N_N_f integer*8 :: i,j,l, LDA_2, LDB_2 info = QMCKL_SUCCESS if (TransA) then - allocate(AT(k,m)) - do i = 1, m - do j = 1, k + allocate(AT(m,k)) + do i = 1, k + do j = 1, m AT(j,i) = A(i,j) end do end do @@ -114,9 +115,9 @@ integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA, endif if (TransB) then - allocate(BT(n,k)) - do i = 1, k - do j = 1, n + allocate(BT(k,n)) + do i = 1, n + do j = 1, k BT(j,i) = B(i,j) end do end do @@ -161,26 +162,75 @@ integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA, endif if (TransA) then - - if (alpha == 1.0d0 .and. beta == 0.0d0) then - C = matmul(AT,B) - else - C = beta*C + alpha*matmul(AT,B) - endif + info = qmckl_dgemm_N_N_f(context, m, n, k, alpha, AT, LDA_2, B, LDB_2, beta, c, LDC) else if (TransB) then - if (alpha == 1.0d0 .and. beta == 0.0d0) then - C = matmul(A,BT) - else - C = beta*C + alpha*matmul(A,BT) - endif + info = qmckl_dgemm_N_N_f(context, m, n, k, alpha, A, LDA_2, BT, LDB_2, beta, c, LDC) + else if (TransA .and. TransB) then + info = qmckl_dgemm_N_N_f(context, m, n, k, alpha, AT, LDA_2, BT, LDB_2, beta, c, LDC) else - if (alpha == 1.0d0 .and. beta == 0.0d0) then - C = matmul(A,B) - else - C = beta*C + alpha*matmul(A,B) - endif + info = qmckl_dgemm_N_N_f(context, m, n, k, alpha, A, LDA_2, B, LDB_2, beta, c, LDC) endif end function qmckl_dgemm_f + +integer function qmckl_dgemm_N_N_f(context, m, n, k, alpha, A, LDA, B, LDB, beta, C, LDC) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + integer*8 , intent(in) :: m, n, k + real*8 , intent(in) :: alpha, beta + integer*8 , intent(in) :: lda + real*8 , intent(in) :: A(lda,k) + integer*8 , intent(in) :: ldb + real*8 , intent(in) :: B(ldb,n) + integer*8 , intent(in) :: ldc + real*8 , intent(out) :: C(ldc,n) + + integer*8 :: i,j,l, LDA_2, LDB_2 + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (m <= 0_8) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (n <= 0_8) then + info = QMCKL_INVALID_ARG_5 + return + endif + + if (k <= 0_8) then + info = QMCKL_INVALID_ARG_6 + return + endif + + if (LDA /= m) then + info = QMCKL_INVALID_ARG_9 + return + endif + + if (LDB /= k) then + info = QMCKL_INVALID_ARG_10 + return + endif + + if (LDC /= m) then + info = QMCKL_INVALID_ARG_13 + return + endif + + if (alpha == 1.0d0 .and. beta == 0.0d0) then + C = matmul(A,B) + else + C = beta*C + alpha*matmul(A,B) + endif +end function qmckl_dgemm_N_N_f #+end_src *** C interface :noexport: @@ -393,6 +443,7 @@ integer function qmckl_invert_f(context, ma, na, LDA, A, det_l) & case (4) !DIR$ forceinline call invert4(a,LDA,na,det_l) + case (3) !DIR$ forceinline call invert3(a,LDA,na,det_l) @@ -414,11 +465,184 @@ subroutine invert1(a,LDA,na,det_l) integer*8, intent(in) :: na double precision, intent(inout) :: det_l + call cofactor1(a,LDA,na,det_l) +end + +subroutine invert2(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + double precision :: b(2,2) + + call cofactor2(a,LDA,na,det_l) + + ! Calculate the transpose + b(1,1) = a(1,1) + b(1,2) = a(2,1) + b(2,1) = a(1,2) + b(2,2) = a(2,2) + a(1,1) = b(1,1) + a(1,2) = b(1,2) + a(2,1) = b(2,1) + a(2,2) = b(2,2) +end + +subroutine invert3(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + double precision :: b(3,3) + + call cofactor3(a,LDA,na,det_l) + + ! Calculate the transpose + b(1,1) = a(1,1) + b(1,2) = a(2,1) + b(1,3) = a(3,1) + b(2,1) = a(1,2) + b(2,2) = a(2,2) + b(2,3) = a(3,2) + b(3,1) = a(1,3) + b(3,2) = a(2,3) + b(3,3) = a(3,3) + ! copy + a(1,1) = b(1,1) + a(2,1) = b(2,1) + a(3,1) = b(3,1) + a(1,2) = b(1,2) + a(2,2) = b(2,2) + a(3,2) = b(3,2) + a(1,3) = b(1,3) + a(2,3) = b(2,3) + a(3,3) = b(3,3) +end + +subroutine invert4(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + double precision :: b(4,4) + + call cofactor4(a,LDA,na,det_l) + + ! Calculate the transpose + b(1,1) = a(1,1) + b(1,2) = a(2,1) + b(1,3) = a(3,1) + b(1,4) = a(4,1) + b(2,1) = a(1,2) + b(2,2) = a(2,2) + b(2,3) = a(3,2) + b(2,4) = a(4,2) + b(3,1) = a(1,3) + b(3,2) = a(2,3) + b(3,3) = a(3,3) + b(3,4) = a(4,3) + b(4,1) = a(1,4) + b(4,2) = a(2,4) + b(4,3) = a(3,4) + b(4,4) = a(4,4) + ! copy + a(1,1) = b(1,1) + a(2,1) = b(2,1) + a(3,1) = b(3,1) + a(4,1) = b(4,1) + a(1,2) = b(1,2) + a(2,2) = b(2,2) + a(3,2) = b(3,2) + a(4,2) = b(4,2) + a(1,3) = b(1,3) + a(2,3) = b(2,3) + a(3,3) = b(3,3) + a(4,3) = b(4,3) + a(1,4) = b(1,4) + a(2,4) = b(2,4) + a(3,4) = b(3,4) + a(4,4) = b(4,4) +end + +subroutine invert5(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + double precision :: b(5,5) + + call cofactor5(a,LDA,na,det_l) + + ! Calculate the transpose + b(1,1) = a(1,1) + b(1,2) = a(2,1) + b(1,3) = a(3,1) + b(1,4) = a(4,1) + b(1,5) = a(5,1) + b(2,1) = a(1,2) + b(2,2) = a(2,2) + b(2,3) = a(3,2) + b(2,4) = a(4,2) + b(2,5) = a(5,2) + b(3,1) = a(1,3) + b(3,2) = a(2,3) + b(3,3) = a(3,3) + b(3,4) = a(4,3) + b(3,5) = a(5,3) + b(4,1) = a(1,4) + b(4,2) = a(2,4) + b(4,3) = a(3,4) + b(4,4) = a(4,4) + b(4,5) = a(5,4) + b(5,1) = a(1,5) + b(5,2) = a(2,5) + b(5,3) = a(3,5) + b(5,4) = a(4,5) + b(5,5) = a(5,5) + ! copy + a(1,1) = b(1,1) + a(2,1) = b(2,1) + a(3,1) = b(3,1) + a(4,1) = b(4,1) + a(5,1) = b(5,1) + a(1,2) = b(1,2) + a(2,2) = b(2,2) + a(3,2) = b(3,2) + a(4,2) = b(4,2) + a(5,2) = b(5,2) + a(1,3) = b(1,3) + a(2,3) = b(2,3) + a(3,3) = b(3,3) + a(4,3) = b(4,3) + a(5,3) = b(5,3) + a(1,4) = b(1,4) + a(2,4) = b(2,4) + a(3,4) = b(3,4) + a(4,4) = b(4,4) + a(5,4) = b(5,4) + a(1,5) = b(1,5) + a(2,5) = b(2,5) + a(3,5) = b(3,5) + a(4,5) = b(4,5) + a(5,5) = b(5,5) +end + +subroutine cofactor1(a,LDA,na,det_l) + implicit none + double precision, intent(inout) :: a (LDA,na) + integer*8, intent(in) :: LDA + integer*8, intent(in) :: na + double precision, intent(inout) :: det_l + det_l = a(1,1) a(1,1) = 1.d0 end -subroutine invert2(a,LDA,na,det_l) +subroutine cofactor2(a,LDA,na,det_l) implicit none double precision :: a (LDA,na) integer*8 :: LDA @@ -437,7 +661,7 @@ subroutine invert2(a,LDA,na,det_l) a(2,2) = b(1,1) end -subroutine invert3(a,LDA,na,det_l) +subroutine cofactor3(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) integer*8, intent(in) :: LDA @@ -468,7 +692,7 @@ subroutine invert3(a,LDA,na,det_l) end -subroutine invert4(a,LDA,na,det_l) +subroutine cofactor4(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) integer*8, intent(in) :: LDA @@ -518,7 +742,7 @@ subroutine invert4(a,LDA,na,det_l) end -subroutine invert5(a,LDA,na,det_l) +subroutine cofactor5(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) integer*8, intent(in) :: LDA diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 6beba36..805cf34 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1040,19 +1040,19 @@ integer function qmckl_compute_det_vgl_beta_f(context, & do imo = 1, beta_num mo_id = mo_index_beta(imo, iwalk, idet) ! Value - det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, 1) + det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 1) ! Grad_x - det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, 2) + det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 2) ! Grad_y - det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, 3) + det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 3) ! Grad_z - det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, 4) + det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 4) ! Lap - det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, 5) + det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, alpha_num + ielec, 5) end do end do end do @@ -1726,7 +1726,7 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & double precision, intent(inout) :: det_inv_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) double precision,dimension(:,:),allocatable :: matA double precision :: det_l - integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res + integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res, i, j allocate(matA(alpha_num, alpha_num)) @@ -1756,7 +1756,7 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & do idet = 1, det_num_alpha do iwalk = 1, walk_num ! Value - matA = det_vgl_alpha(1:alpha_num, 1:alpha_num, 1, iwalk, idet) + matA(1:alpha_num,1:alpha_num) = det_vgl_alpha(1:alpha_num, 1:alpha_num, 1, iwalk, idet) res = qmckl_invert(context, alpha_num, alpha_num, LDA, matA, det_l) det_adj_matrix_alpha(1:alpha_num, 1:alpha_num, iwalk, idet) = matA det_inv_matrix_alpha(1:alpha_num, 1:alpha_num, iwalk, idet) = matA/det_l @@ -1887,7 +1887,7 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & do idet = 1, det_num_beta do iwalk = 1, walk_num ! Value - matA = det_vgl_beta(1:beta_num, 1:beta_num, 1, iwalk, idet) + matA(1:beta_num,1:beta_num) = det_vgl_beta(1:beta_num, 1:beta_num, 1, iwalk, idet) res = qmckl_invert(context, beta_num, beta_num, LDA, matA, det_l) det_adj_matrix_beta(1:beta_num, 1:beta_num, iwalk, idet) = matA det_inv_matrix_beta(1:beta_num, 1:beta_num, iwalk, idet) = matA/det_l diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index a26276c..931f259 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -1727,7 +1727,7 @@ integer function qmckl_compute_ee_potential_f(context, elec_num, walk_num, & ee_pot = 0.0d0 do nw=1,walk_num - do j=1,elec_num + do j=2,elec_num do i=1,j-1 ee_pot(nw) = ee_pot(nw) + 1.0d0/(ee_distance(i,j,nw)) end do diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index fa350d9..b380719 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -245,6 +245,7 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context); #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { + qmckl_exit_code rc; if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; } @@ -286,6 +287,21 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { "qmckl_mo_basis", NULL); } + rc = qmckl_provide_det_inv_matrix_alpha(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_det_inv_matrix_alpha", + NULL); + } + + rc = qmckl_provide_det_inv_matrix_beta(context); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_det_inv_matrix_beta", + NULL); + } /* Compute if necessary */ if (ctx->electron.coord_new_date > ctx->local_energy.e_kin_date) { @@ -306,7 +322,6 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { ctx->local_energy.e_kin = e_kin; } - qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_kinetic_energy(context, ctx->det.walk_num, @@ -319,8 +334,10 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { ctx->det.mo_index_beta, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, - ctx->det.det_adj_matrix_alpha, - ctx->det.det_adj_matrix_beta, + ctx->det.det_value_alpha, + ctx->det.det_value_beta, + ctx->det.det_inv_matrix_alpha, + ctx->det.det_inv_matrix_beta, ctx->local_energy.e_kin); } else { return qmckl_failwith( context, @@ -358,14 +375,16 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_value_alpha[det_num_alpha][walk_num]~ | in | Det of wavefunction | + | ~double~ | ~det_value_beta[det_num_beta][walk_num]~ | in | Det of wavefunction | + | ~double~ | ~det_inv_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~e_kin[walk_num]~ | out | Kinetic energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_kinetic_energy_f(context, walk_num, & det_num_alpha, det_num_beta, alpha_num, beta_num, elec_num, mo_index_alpha, mo_index_beta, & - mo_num, mo_vgl, det_adj_matrix_alpha, det_adj_matrix_beta, e_kin) & + mo_num, mo_vgl, det_value_alpha, det_value_beta, det_inv_matrix_alpha, det_inv_matrix_beta, e_kin) & result(info) use qmckl implicit none @@ -380,9 +399,12 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) integer*8, intent(in) :: mo_index_beta(beta_num, walk_num, det_num_beta) double precision, intent(in) :: mo_vgl(mo_num, elec_num, 5) - double precision, intent(in) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) - double precision, intent(in) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) + double precision, intent(in) :: det_value_alpha(walk_num, det_num_alpha) + double precision, intent(in) :: det_value_beta(walk_num, det_num_beta) + double precision, intent(in) :: det_inv_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) + double precision, intent(in) :: det_inv_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) double precision, intent(inout) :: e_kin(walk_num) + double precision :: tmp_e integer*8 :: idet, iwalk, ielec, mo_id, imo info = QMCKL_SUCCESS @@ -416,20 +438,34 @@ integer function qmckl_compute_kinetic_energy_f(context, walk_num, & do idet = 1, det_num_alpha do iwalk = 1, walk_num ! Alpha part + tmp_e = 0.0d0 do imo = 1, alpha_num do ielec = 1, alpha_num - mo_id = mo_index_alpha(ielec, iwalk, idet) - e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & + mo_id = mo_index_alpha(imo, iwalk, idet) + e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_inv_matrix_alpha(imo, ielec, iwalk, idet) * & mo_vgl(mo_id, ielec, 5) + !print *,"det alpha = ",det_inv_matrix_alpha(imo,ielec,iwalk,idet) + !print *,mo_vgl(mo_id,ielec,5) + !!print *," det val = ",det_value_alpha(iwalk,idet) + !tmp_e = tmp_e - 0.5d0 * det_inv_matrix_alpha(imo, ielec, iwalk, idet) * & + ! mo_vgl(mo_id, ielec, 5) end do + !print *,"e_kin = ",tmp_e end do ! Beta part + tmp_e = 0.0d0 do imo = 1, beta_num do ielec = 1, beta_num - mo_id = mo_index_beta(ielec, iwalk, idet) - e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, 5) + mo_id = mo_index_beta(imo, iwalk, idet) + e_kin(iwalk) = e_kin(iwalk) - 0.5d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, alpha_num + ielec, 5) + !print *,"det beta = ",det_inv_matrix_beta(imo,ielec,iwalk,idet) + !print *,mo_vgl(mo_id,alpha_num+ielec,5) + !!print *," det val = ",det_value_alpha(iwalk,idet) + !tmp_e = tmp_e - 0.5d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & + ! mo_vgl(mo_id, alpha_num + ielec, 5) end do + !print *,"e_kin = ",tmp_e end do end do end do @@ -453,8 +489,10 @@ end function qmckl_compute_kinetic_energy_f const int64_t* mo_index_beta, const int64_t mo_num, const double* mo_vgl, - const double* det_adj_matrix_alpha, - const double* det_adj_matrix_beta, + const double* det_value_alpha, + const double* det_value_beta, + const double* det_inv_matrix_alpha, + const double* det_inv_matrix_beta, double* const e_kin ); #+end_src @@ -474,8 +512,10 @@ end function qmckl_compute_kinetic_energy_f mo_index_beta, & mo_num, & mo_vgl, & - det_adj_matrix_alpha, & - det_adj_matrix_beta, & + det_value_alpha, & + det_value_beta, & + det_inv_matrix_alpha, & + det_inv_matrix_beta, & e_kin) & bind(C) result(info) @@ -493,8 +533,10 @@ end function qmckl_compute_kinetic_energy_f integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) integer (c_int64_t) , intent(in) , value :: mo_num real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,5) - real (c_double ) , intent(in) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) - real (c_double ) , intent(in) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) + real (c_double ) , intent(in) :: det_value_alpha(walk_num,det_num_alpha) + real (c_double ) , intent(in) :: det_value_beta(walk_num,det_num_beta) + real (c_double ) , intent(in) :: det_inv_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) + real (c_double ) , intent(in) :: det_inv_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) real (c_double ) , intent(out) :: e_kin(walk_num) integer(c_int32_t), external :: qmckl_compute_kinetic_energy_f @@ -510,8 +552,10 @@ end function qmckl_compute_kinetic_energy_f mo_index_beta, & mo_num, & mo_vgl, & - det_adj_matrix_alpha, & - det_adj_matrix_beta, & + det_value_alpha, & + det_value_beta, & + det_inv_matrix_alpha, & + det_inv_matrix_beta, & e_kin) end function qmckl_compute_kinetic_energy @@ -830,14 +874,6 @@ qmckl_exit_code qmckl_provide_potential_energy(qmckl_context context) { NULL); } - rc = qmckl_provide_ee_potential(context); - if (rc != QMCKL_SUCCESS) { - return qmckl_failwith( context, - QMCKL_NOT_PROVIDED, - "qmckl_ee_potential", - NULL); - } - rc = qmckl_provide_nucleus_repulsion(context); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, @@ -958,6 +994,7 @@ integer function qmckl_compute_potential_energy_f(context, walk_num, & endif e_pot = 0.0d0 + repulsion + print *,repulsion do iwalk = 1, walk_num e_pot(iwalk) = e_pot(iwalk) + ee_pot(iwalk) + en_pot(iwalk) end do diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index b9d220c..60f39f4 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -511,7 +511,7 @@ qmckl_exit_code qmckl_provide_mo_vgl(qmckl_context context) | ~int64_t~ | ~ao_num~ | in | Number of AOs | | ~int64_t~ | ~mo_num~ | in | Number of MOs | | ~int64_t~ | ~elec_num~ | in | Number of electrons | - | ~double~ | ~coef_normalized[ao_num][mo_num]~ | in | AO to MO transformation matrix | + | ~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 | @@ -527,22 +527,26 @@ integer function qmckl_compute_mo_basis_vgl_f(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) - double precision , intent(in) :: coef_normalized(mo_num,ao_num) + double precision , intent(in) :: coef_normalized(ao_num,mo_num) double precision , intent(out) :: mo_vgl(mo_num,elec_num,5) logical*8 :: 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 + 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)) - TransA = .False. + TransA = .True. TransB = .False. alpha = 1.0d0 beta = 0.0d0 @@ -556,15 +560,29 @@ integer function qmckl_compute_mo_basis_vgl_f(context, & M = mo_num N = elec_num*5 K = ao_num * 1_8 - LDA = M - LDB = K - LDC = M + 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, LDB, & + 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/)) @@ -605,8 +623,7 @@ end function qmckl_compute_mo_basis_vgl_f 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 - real (c_double ) , intent(in) :: coef_normalized(mo_num,ao_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) From 1a3d37633acdfc73af73349c0aaaf0df62c92815 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 27 Oct 2021 00:23:46 +0200 Subject: [PATCH 62/68] Added dimensions to drift vector. #41 --- org/qmckl_local_energy.org | 84 +++++++++++++++++++------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index b380719..8c11315 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -139,14 +139,14 @@ int main() { Computed data: - |--------------+-----------------+----------------------------| - | ~e_kin~ | ~[walk_num]~ | total kinetic energy | - | ~e_pot~ | ~[walk_num]~ | total potential energy | - | ~e_local~ | ~[walk_num]~ | local energy | - | ~r_drift~ | ~[3][walk_num]~ | The drift vector | - | ~y_move~ | ~[3][walk_num]~ | The diffusion move | - | ~accep_prob~ | ~[walk_num]~ | The acceptance probability | - |--------------+-----------------+----------------------------| + |--------------+---------------------------+----------------------------| + | ~e_kin~ | ~[walk_num]~ | total kinetic energy | + | ~e_pot~ | ~[walk_num]~ | total potential energy | + | ~e_local~ | ~[walk_num]~ | local energy | + | ~r_drift~ | ~[3][walk_num][elec_num]~ | The drift vector | + | ~y_move~ | ~[3][walk_num]~ | The diffusion move | + | ~accep_prob~ | ~[walk_num]~ | The acceptance probability | + |--------------+---------------------------+----------------------------| ** Data structure @@ -1318,13 +1318,13 @@ assert (rc == QMCKL_SUCCESS); :FRetType: qmckl_exit_code :END: -The local energy is the sum of kinetic and potential energies. +The drift vector is calculated as the ration of the gradient +with the determinant of the wavefunction. \[ -E_L = KE + PE +\mathbf{F} = 2 \frac{\nabla \Psi}{\Psi} \] - *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes @@ -1356,7 +1356,7 @@ qmckl_exit_code qmckl_get_drift_vector(qmckl_context context, double * const dri qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - size_t sze = ctx->electron.walk_num * 3 * sizeof(double); + size_t sze = ctx->electron.walk_num * ctx->electron.num * 3 * sizeof(double); memcpy(drift_vector, ctx->local_energy.r_drift, sze); return QMCKL_SUCCESS; @@ -1421,7 +1421,7 @@ qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context) { if (ctx->local_energy.r_drift == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->electron.walk_num * 3 * sizeof(double); + mem_info.size = ctx->electron.walk_num * ctx->electron.num * 3 * sizeof(double); double* r_drift = (double*) qmckl_malloc(context, mem_info); if (r_drift == NULL) { @@ -1446,8 +1446,8 @@ qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context) { ctx->det.mo_index_beta, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, - ctx->det.det_adj_matrix_alpha, - ctx->det.det_adj_matrix_beta, + ctx->det.det_inv_matrix_alpha, + ctx->det.det_inv_matrix_beta, ctx->local_energy.r_drift); } else { return qmckl_failwith( context, @@ -1485,14 +1485,14 @@ qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context) { | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | MO indices for electrons | | ~int64_t~ | ~mo_num~ | in | Number of MOs | | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | - | ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~r_drift[walk_num][3]~ | out | Kinetic energy | + | ~double~ | ~det_inv_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~r_drift[walk_num][elec_num][3]~ | out | Kinetic energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_drift_vector_f(context, walk_num, & det_num_alpha, det_num_beta, alpha_num, beta_num, elec_num, mo_index_alpha, mo_index_beta, & - mo_num, mo_vgl, det_adj_matrix_alpha, det_adj_matrix_beta, r_drift) & + mo_num, mo_vgl, det_inv_matrix_alpha, det_inv_matrix_beta, r_drift) & result(info) use qmckl implicit none @@ -1507,9 +1507,9 @@ integer function qmckl_compute_drift_vector_f(context, walk_num, & integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) integer*8, intent(in) :: mo_index_beta(beta_num, walk_num, det_num_beta) double precision, intent(in) :: mo_vgl(mo_num, elec_num, 5) - double precision, intent(in) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) - double precision, intent(in) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) - double precision, intent(inout) :: r_drift(3,walk_num) + double precision, intent(in) :: det_inv_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) + double precision, intent(in) :: det_inv_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) + double precision, intent(inout) :: r_drift(3,elec_num,walk_num) integer*8 :: idet, iwalk, ielec, mo_id, imo info = QMCKL_SUCCESS @@ -1545,25 +1545,25 @@ integer function qmckl_compute_drift_vector_f(context, walk_num, & ! Alpha part do imo = 1, alpha_num do ielec = 1, alpha_num - mo_id = mo_index_alpha(ielec, iwalk, idet) - r_drift(1,iwalk) = r_drift(1,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & + mo_id = mo_index_alpha(imo, iwalk, idet) + r_drift(1,ielec,iwalk) = r_drift(1,ielec,iwalk) + 2.0d0 * det_inv_matrix_alpha(imo, ielec, iwalk, idet) * & mo_vgl(mo_id, ielec, 2) - r_drift(2,iwalk) = r_drift(2,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & + r_drift(2,ielec,iwalk) = r_drift(2,ielec,iwalk) + 2.0d0 * det_inv_matrix_alpha(imo, ielec, iwalk, idet) * & mo_vgl(mo_id, ielec, 3) - r_drift(3,iwalk) = r_drift(3,iwalk) + 2.0d0 * det_adj_matrix_alpha(imo, ielec, iwalk, idet) * & + r_drift(3,ielec,iwalk) = r_drift(3,ielec,iwalk) + 2.0d0 * det_inv_matrix_alpha(imo, ielec, iwalk, idet) * & mo_vgl(mo_id, ielec, 4) end do end do ! Beta part do imo = 1, beta_num do ielec = 1, beta_num - mo_id = mo_index_beta(ielec, iwalk, idet) - r_drift(1,iwalk) = r_drift(1,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, 2) - r_drift(2,iwalk) = r_drift(2,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, 3) - r_drift(3,iwalk) = r_drift(3,iwalk) + 2.0d0 * det_adj_matrix_beta(imo, ielec, iwalk, idet) * & - mo_vgl(mo_id, ielec, 4) + mo_id = mo_index_beta(imo, iwalk, idet) + r_drift(1,ielec,iwalk) = r_drift(1,ielec,iwalk) + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, alpha_num + ielec, 2) + r_drift(2,ielec,iwalk) = r_drift(2,ielec,iwalk) + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, alpha_num + ielec, 3) + r_drift(3,ielec,iwalk) = r_drift(3,ielec,iwalk) + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & + mo_vgl(mo_id, alpha_num + ielec, 4) end do end do end do @@ -1588,8 +1588,8 @@ end function qmckl_compute_drift_vector_f const int64_t* mo_index_beta, const int64_t mo_num, const double* mo_vgl, - const double* det_adj_matrix_alpha, - const double* det_adj_matrix_beta, + const double* det_inv_matrix_alpha, + const double* det_inv_matrix_beta, double* const r_drift ); #+end_src @@ -1609,8 +1609,8 @@ end function qmckl_compute_drift_vector_f mo_index_beta, & mo_num, & mo_vgl, & - det_adj_matrix_alpha, & - det_adj_matrix_beta, & + det_inv_matrix_alpha, & + det_inv_matrix_beta, & r_drift) & bind(C) result(info) @@ -1628,9 +1628,9 @@ end function qmckl_compute_drift_vector_f integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) integer (c_int64_t) , intent(in) , value :: mo_num real (c_double ) , intent(in) :: mo_vgl(mo_num,elec_num,5) - real (c_double ) , intent(in) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) - real (c_double ) , intent(in) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) - real (c_double ) , intent(out) :: r_drift(3,walk_num) + real (c_double ) , intent(in) :: det_inv_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) + real (c_double ) , intent(in) :: det_inv_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) + real (c_double ) , intent(out) :: r_drift(3,elec_num,walk_num) integer(c_int32_t), external :: qmckl_compute_drift_vector_f info = qmckl_compute_drift_vector_f & @@ -1645,8 +1645,8 @@ end function qmckl_compute_drift_vector_f mo_index_beta, & mo_num, & mo_vgl, & - det_adj_matrix_alpha, & - det_adj_matrix_beta, & + det_inv_matrix_alpha, & + det_inv_matrix_beta, & r_drift) end function qmckl_compute_drift_vector From 466bd8c171afbd0becc6faf573d32f9e49a7ca51 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 27 Oct 2021 00:26:44 +0200 Subject: [PATCH 63/68] Added proper indices to drift vector. #41 --- org/qmckl_local_energy.org | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 8c11315..7076b31 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -1558,11 +1558,14 @@ integer function qmckl_compute_drift_vector_f(context, walk_num, & do imo = 1, beta_num do ielec = 1, beta_num mo_id = mo_index_beta(imo, iwalk, idet) - r_drift(1,ielec,iwalk) = r_drift(1,ielec,iwalk) + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & + r_drift(1,alpha_num + ielec,iwalk) = r_drift(1,alpha_num + ielec,iwalk) + & + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & mo_vgl(mo_id, alpha_num + ielec, 2) - r_drift(2,ielec,iwalk) = r_drift(2,ielec,iwalk) + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & + r_drift(2,alpha_num + ielec,iwalk) = r_drift(2,alpha_num + ielec,iwalk) + & + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & mo_vgl(mo_id, alpha_num + ielec, 3) - r_drift(3,ielec,iwalk) = r_drift(3,ielec,iwalk) + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & + r_drift(3,alpha_num + ielec,iwalk) = r_drift(3,alpha_num + ielec,iwalk) + & + 2.0d0 * det_inv_matrix_beta(imo, ielec, iwalk, idet) * & mo_vgl(mo_id, alpha_num + ielec, 4) end do end do From 1d9d6b0f657aa5a1c58ef28eccef5a3aa5112cfc Mon Sep 17 00:00:00 2001 From: v1j4y Date: Wed, 27 Oct 2021 14:00:04 +0200 Subject: [PATCH 64/68] Added getter for determinant of psi. #41 --- org/qmckl_determinant.org | 60 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 805cf34..6b8c43f 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1317,6 +1317,8 @@ qmckl_exit_code qmckl_get_det_inv_matrix_alpha(qmckl_context context, double* co qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double* const det_inv_matrix_beta); qmckl_exit_code qmckl_get_det_adj_matrix_alpha(qmckl_context context, double* const det_adj_matrix_alpha); qmckl_exit_code qmckl_get_det_adj_matrix_beta(qmckl_context context, double* const det_adj_matrix_beta); +qmckl_exit_code qmckl_get_det_alpha(qmckl_context context, double* const det_adj_matrix_alpha); +qmckl_exit_code qmckl_get_det_beta(qmckl_context context, double* const det_adj_matrix_beta); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none @@ -1433,6 +1435,64 @@ qmckl_exit_code qmckl_get_det_adj_matrix_beta(qmckl_context context, double * co size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num * ctx->electron.down_num * ctx->electron.down_num; memcpy(det_adj_matrix_beta, ctx->det.det_adj_matrix_beta, sze * sizeof(double)); + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_det_alpha(qmckl_context context, double * const det_value_alpha) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_vgl_alpha(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_inv_matrix_alpha(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num; + memcpy(det_value_alpha, ctx->det.det_value_alpha, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + +qmckl_exit_code qmckl_get_det_beta(qmckl_context context, double * const det_value_beta) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + + qmckl_exit_code rc; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_mo_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_vgl_beta(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_det_inv_matrix_beta(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->det.det_num_alpha * ctx->det.walk_num; + memcpy(det_value_beta, ctx->det.det_value_beta, sze * sizeof(double)); + return QMCKL_SUCCESS; } #+end_src From ad9ae8daf9e05301473f45a41376f9dd3c1100f8 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 28 Oct 2021 13:00:20 +0200 Subject: [PATCH 65/68] Removed debug print from local energy. #41 --- org/qmckl_local_energy.org | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/org/qmckl_local_energy.org b/org/qmckl_local_energy.org index 7076b31..a386d01 100644 --- a/org/qmckl_local_energy.org +++ b/org/qmckl_local_energy.org @@ -378,7 +378,7 @@ qmckl_exit_code qmckl_provide_kinetic_energy(qmckl_context context) { | ~double~ | ~det_value_alpha[det_num_alpha][walk_num]~ | in | Det of wavefunction | | ~double~ | ~det_value_beta[det_num_beta][walk_num]~ | in | Det of wavefunction | | ~double~ | ~det_inv_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~e_kin[walk_num]~ | out | Kinetic energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes @@ -994,7 +994,6 @@ integer function qmckl_compute_potential_energy_f(context, walk_num, & endif e_pot = 0.0d0 + repulsion - print *,repulsion do iwalk = 1, walk_num e_pot(iwalk) = e_pot(iwalk) + ee_pot(iwalk) + en_pot(iwalk) end do @@ -1486,7 +1485,7 @@ qmckl_exit_code qmckl_provide_drift_vector(qmckl_context context) { | ~int64_t~ | ~mo_num~ | in | Number of MOs | | ~double~ | ~mo_vgl[5][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | | ~double~ | ~det_inv_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | in | Value, gradients and Laplacian of the Det | - | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | + | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | in | Value, gradients and Laplacian of the Det | | ~double~ | ~r_drift[walk_num][elec_num][3]~ | out | Kinetic energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes From cd0db55f9dddb8f52a1ad4fed97c4b1beb77c568 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 29 Oct 2021 08:44:53 +0200 Subject: [PATCH 66/68] Added cutoff for the calculation of PE. #41 --- org/qmckl_electron.org | 8 ++++++-- org/qmckl_nucleus.org | 18 ++++++++++-------- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/org/qmckl_electron.org b/org/qmckl_electron.org index 931f259..aff2002 100644 --- a/org/qmckl_electron.org +++ b/org/qmckl_electron.org @@ -1729,7 +1729,9 @@ integer function qmckl_compute_ee_potential_f(context, elec_num, walk_num, & do nw=1,walk_num do j=2,elec_num do i=1,j-1 - ee_pot(nw) = ee_pot(nw) + 1.0d0/(ee_distance(i,j,nw)) + if (dabs(ee_distance(i,j,nw)) > 1e-5) then + ee_pot(nw) = ee_pot(nw) + 1.0d0/(ee_distance(i,j,nw)) + endif end do end do end do @@ -2769,7 +2771,9 @@ integer function qmckl_compute_en_potential_f(context, elec_num, nucl_num, walk_ do nw=1,walk_num do j=1,nucl_num do i=1,elec_num - en_pot(nw) = en_pot(nw) - charge(j)/(en_distance(i,j,nw)) + if (dabs(en_distance(i,j,nw)) > 1e-5) then + en_pot(nw) = en_pot(nw) - charge(j)/(en_distance(i,j,nw)) + endif end do end do end do diff --git a/org/qmckl_nucleus.org b/org/qmckl_nucleus.org index 1406087..75c91b9 100644 --- a/org/qmckl_nucleus.org +++ b/org/qmckl_nucleus.org @@ -78,13 +78,13 @@ int main() { Computed data: - |-----------------------------+------------------+--------------------------------------------------------------| - | ~nn_distance~ | double[num][num] | Nucleus-nucleus distances | - | ~nn_distance_date~ | int64_t | Date when Nucleus-nucleus distances were computed | - | ~nn_distance_rescaled~ | double[num][num] | Nucleus-nucleus rescaled distances | - | ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed | - | ~repulsion~ | double | Nuclear repulsion energy | - | ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed | + |-----------------------------+------------------+------------------------------------------------------------| + | ~nn_distance~ | double[num][num] | Nucleus-nucleus distances | + | ~nn_distance_date~ | int64_t | Date when Nucleus-nucleus distances were computed | + | ~nn_distance_rescaled~ | double[num][num] | Nucleus-nucleus rescaled distances | + | ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed | + | ~repulsion~ | double | Nuclear repulsion energy | + | ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed | ** Data structure @@ -1087,7 +1087,9 @@ integer function qmckl_compute_nucleus_repulsion_f(context, nucl_num, charge, nn energy = 0.d0 do j=2, nucl_num do i=1, j-1 - energy = energy + charge(i) * charge(j) / nn_distance(i,j) + if (dabs(nn_distance(i,j)) > 1e-5) then + energy = energy + charge(i) * charge(j) / nn_distance(i,j) + endif end do end do From 20b8f2822e1480c2159e62ee67b25f0e39d890d8 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 29 Oct 2021 08:45:14 +0200 Subject: [PATCH 67/68] Renamed qmckl_invert to qmckl_adjoint. #41 --- org/qmckl_blas.org | 68 +++++++++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index 918cd9b..279fd80 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -371,9 +371,9 @@ qmckl_exit_code test_qmckl_dgemm(qmckl_context context); assert(QMCKL_SUCCESS == test_qmckl_dgemm(context)); #+end_src -** ~qmckl_invert~ +** ~qmckl_adjoint~ - Matrix invert. Given a matrix M, returns a matrix M⁻¹ such that: + Matrix adjoint. Given a matrix M, returns a matrix M⁻¹ such that: \[ @@ -385,7 +385,7 @@ M · M^{-1} = I TODO: Add description about the external library dependence. - #+NAME: qmckl_invert_args + #+NAME: qmckl_adjoint_args | qmckl_context | context | in | Global state | | int64_t | m | in | Number of rows of the input matrix | | int64_t | n | in | Number of columns of the input matrix | @@ -403,11 +403,11 @@ M · M^{-1} = I *** C header - #+CALL: generate_c_header(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") + #+CALL: generate_c_header(table=qmckl_adjoint_args,rettyp="qmckl_exit_code",fname="qmckl_adjoint") #+RESULTS: #+begin_src c :tangle (eval h_func) :comments org - qmckl_exit_code qmckl_invert ( + qmckl_exit_code qmckl_adjoint ( const qmckl_context context, const int64_t m, const int64_t n, @@ -418,7 +418,7 @@ M · M^{-1} = I *** Source #+begin_src f90 :tangle (eval f) -integer function qmckl_invert_f(context, ma, na, LDA, A, det_l) & +integer function qmckl_adjoint_f(context, ma, na, LDA, A, det_l) & result(info) use qmckl implicit none @@ -435,30 +435,30 @@ integer function qmckl_invert_f(context, ma, na, LDA, A, det_l) & select case (na) case default !DIR$ forceinline - print *," TODO: Implement general invert" + print *," TODO: Implement general adjoint" stop 0 case (5) !DIR$ forceinline - call invert5(a,LDA,na,det_l) + call adjoint5(a,LDA,na,det_l) case (4) !DIR$ forceinline - call invert4(a,LDA,na,det_l) + call adjoint4(a,LDA,na,det_l) case (3) !DIR$ forceinline - call invert3(a,LDA,na,det_l) + call adjoint3(a,LDA,na,det_l) case (2) !DIR$ forceinline - call invert2(a,LDA,na,det_l) + call adjoint2(a,LDA,na,det_l) case (1) !DIR$ forceinline - call invert1(a,LDA,na,det_l) + call adjoint1(a,LDA,na,det_l) case (0) det_l=1.d0 end select -end function qmckl_invert_f +end function qmckl_adjoint_f -subroutine invert1(a,LDA,na,det_l) +subroutine adjoint1(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) integer*8, intent(in) :: LDA @@ -468,7 +468,7 @@ subroutine invert1(a,LDA,na,det_l) call cofactor1(a,LDA,na,det_l) end -subroutine invert2(a,LDA,na,det_l) +subroutine adjoint2(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) integer*8, intent(in) :: LDA @@ -489,7 +489,7 @@ subroutine invert2(a,LDA,na,det_l) a(2,2) = b(2,2) end -subroutine invert3(a,LDA,na,det_l) +subroutine adjoint3(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) integer*8, intent(in) :: LDA @@ -521,7 +521,7 @@ subroutine invert3(a,LDA,na,det_l) a(3,3) = b(3,3) end -subroutine invert4(a,LDA,na,det_l) +subroutine adjoint4(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) integer*8, intent(in) :: LDA @@ -567,7 +567,7 @@ subroutine invert4(a,LDA,na,det_l) a(4,4) = b(4,4) end -subroutine invert5(a,LDA,na,det_l) +subroutine adjoint5(a,LDA,na,det_l) implicit none double precision, intent(inout) :: a (LDA,na) integer*8, intent(in) :: LDA @@ -932,11 +932,11 @@ end *** C interface :noexport: - #+CALL: generate_c_interface(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") + #+CALL: generate_c_interface(table=qmckl_adjoint_args,rettyp="qmckl_exit_code",fname="qmckl_adjoint") #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_invert & + integer(c_int32_t) function qmckl_adjoint & (context, m, n, lda, A, det_l) & bind(C) result(info) @@ -950,19 +950,19 @@ end real (c_double ) , intent(inout) :: A(lda,*) real (c_double ) , intent(inout) :: det_l - integer(c_int32_t), external :: qmckl_invert_f - info = qmckl_invert_f & + integer(c_int32_t), external :: qmckl_adjoint_f + info = qmckl_adjoint_f & (context, m, n, lda, A, det_l) - end function qmckl_invert + end function qmckl_adjoint #+end_src - #+CALL: generate_f_interface(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") + #+CALL: generate_f_interface(table=qmckl_adjoint_args,rettyp="qmckl_exit_code",fname="qmckl_adjoint") #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_invert & + integer(c_int32_t) function qmckl_adjoint & (context, m, n, lda, A, det_l) & bind(C) use, intrinsic :: iso_c_binding @@ -976,13 +976,13 @@ end real (c_double ) , intent(inout) :: A(lda,*) real (c_double ) , intent(inout) :: det_l - end function qmckl_invert + end function qmckl_adjoint end interface #+end_src *** Test :noexport: #+begin_src f90 :tangle (eval f_test) -integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C) +integer(qmckl_exit_code) function test_qmckl_adjoint(context) bind(C) use qmckl implicit none integer(qmckl_context), intent(in), value :: context @@ -1026,11 +1026,11 @@ integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C) C(4,3) = -0.007224426165097149d0 det_l_ref = 23.6697d0 - test_qmckl_invert = qmckl_invert(context, m, k, LDA, A, det_l) + test_qmckl_adjoint = qmckl_adjoint(context, m, k, LDA, A, det_l) - if (test_qmckl_invert /= QMCKL_SUCCESS) return + if (test_qmckl_adjoint /= QMCKL_SUCCESS) return - test_qmckl_invert = QMCKL_FAILURE + test_qmckl_adjoint = QMCKL_FAILURE x = 0.d0 do j=1,m @@ -1040,16 +1040,16 @@ integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C) end do if (dabs(x) <= 1.d-15 .and. (dabs(det_l_ref - det_l)) <= 1.d-15) then - test_qmckl_invert = QMCKL_SUCCESS + test_qmckl_adjoint = QMCKL_SUCCESS endif deallocate(A,C) -end function test_qmckl_invert +end function test_qmckl_adjoint #+end_src #+begin_src c :comments link :tangle (eval c_test) -qmckl_exit_code test_qmckl_invert(qmckl_context context); -assert(QMCKL_SUCCESS == test_qmckl_invert(context)); +qmckl_exit_code test_qmckl_adjoint(qmckl_context context); +assert(QMCKL_SUCCESS == test_qmckl_adjoint(context)); #+end_src * End of files :noexport: From b5c6e1d126651428eb5fb0decc0a457e76d57e63 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 29 Oct 2021 08:45:23 +0200 Subject: [PATCH 68/68] Renamed qmckl_invert to qmckl_adjoint. #41 --- org/qmckl_determinant.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 6b8c43f..1e8e559 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -1817,7 +1817,7 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & do iwalk = 1, walk_num ! Value matA(1:alpha_num,1:alpha_num) = det_vgl_alpha(1:alpha_num, 1:alpha_num, 1, iwalk, idet) - res = qmckl_invert(context, alpha_num, alpha_num, LDA, matA, det_l) + res = qmckl_adjoint(context, alpha_num, alpha_num, LDA, matA, det_l) det_adj_matrix_alpha(1:alpha_num, 1:alpha_num, iwalk, idet) = matA det_inv_matrix_alpha(1:alpha_num, 1:alpha_num, iwalk, idet) = matA/det_l det_value_alpha(iwalk, idet) = det_l @@ -1948,7 +1948,7 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & do iwalk = 1, walk_num ! Value matA(1:beta_num,1:beta_num) = det_vgl_beta(1:beta_num, 1:beta_num, 1, iwalk, idet) - res = qmckl_invert(context, beta_num, beta_num, LDA, matA, det_l) + res = qmckl_adjoint(context, beta_num, beta_num, LDA, matA, det_l) det_adj_matrix_beta(1:beta_num, 1:beta_num, iwalk, idet) = matA det_inv_matrix_beta(1:beta_num, 1:beta_num, iwalk, idet) = matA/det_l det_value_beta(iwalk, idet) = det_l