Added det struct to context. #41

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)
@@ -123,10 +124,9 @@ typedef struct qmckl_context_struct {
   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;

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_determinant_private_type.h"
-#include "qmckl_slater_determinant_private_func.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                  |
+  | ~walk_num~      | ~int64_t~                    | Number of walkers                  |
-  | ~det_num~       | ~uint64_t~                    | Number of determinants per walker  |
+  | ~det_num~       | ~int64_t~                    | Number of determinants per walker  |
-  | ~fermi_num~     | ~uint64_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:
@@ -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) {
+  <<pre2>>
+
+  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;
+
+  <<post2>>
+}
+
+qmckl_exit_code qmckl_set_determinant_walk_num(qmckl_context context, const int64_t walk_num) {
+  <<pre2>>
+
+  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;
+
+  <<post2>>
+}
+
+qmckl_exit_code qmckl_set_determinant_det_num(qmckl_context context, const int64_t det_num) {
+  <<pre2>>
+
+  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;
+
+  <<post2>>
+}
+
+qmckl_exit_code qmckl_set_determinant_fermi_num(qmckl_context context, const int64_t fermi_num) {
+  <<pre2>>
+
+  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;
+
+  <<post2>>
+}
+
+qmckl_exit_code  qmckl_set_determinant_mo_index_list(qmckl_context context, const int64_t* mo_index_list) {
+  <<pre2>>
+
+  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;
+
+  <<post2>>
+}
+
+   #+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