From 5e399a423ea628a1bcba9436fd293e6d66db53e0 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Mon, 4 Oct 2021 16:52:13 +0200 Subject: [PATCH] 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