From 5ae8828684053411e6f4baf4ed1edf749295012a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 31 Mar 2023 14:41:32 +0200 Subject: [PATCH] Jastrow OK --- org/qmckl_jastrow_champ.org | 609 ++++++++++++++++++++++++++++++------ 1 file changed, 516 insertions(+), 93 deletions(-) diff --git a/org/qmckl_jastrow_champ.org b/org/qmckl_jastrow_champ.org index 970cfdd..b649999 100644 --- a/org/qmckl_jastrow_champ.org +++ b/org/qmckl_jastrow_champ.org @@ -131,66 +131,66 @@ int main() { The following data stored in the context: #+NAME: qmckl_jastrow_args - | Variable | Type | In/Out | Description | - |---------------------------+---------------------------------------+--------+-------------------------------------------------------------------| - | ~uninitialized~ | ~int32_t~ | in | Keeps bits set for uninitialized data | - | ~rescale_factor_ee~ | ~double~ | in | The distance scaling factor | - | ~rescale_factor_en~ | ~double[type_nucl_num]~ | in | The distance scaling factor | - | ~aord_num~ | ~int64_t~ | in | The number of a coeffecients | - | ~bord_num~ | ~int64_t~ | in | The number of b coeffecients | - | ~cord_num~ | ~int64_t~ | in | The number of c coeffecients | - | ~type_nucl_num~ | ~int64_t~ | in | Number of Nuclei types | - | ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of types of Nuclei | - | ~a_vector~ | ~double[aord_num + 1][type_nucl_num]~ | in | a polynomial coefficients | - | ~b_vector~ | ~double[bord_num + 1]~ | in | b polynomial coefficients | - | ~c_vector~ | ~double[cord_num][type_nucl_num]~ | in | c polynomial coefficients | - | ~factor_ee~ | ~double[walker.num]~ | out | Jastrow factor: electron-electron part | - | ~factor_ee_date~ | ~uint64_t~ | out | Jastrow factor: electron-electron part | - | ~factor_en~ | ~double[walker.num]~ | out | Jastrow factor: electron-nucleus part | - | ~factor_en_date~ | ~uint64_t~ | out | Jastrow factor: electron-nucleus part | - | ~factor_een~ | ~double[walker.num]~ | out | Jastrow factor: electron-electron-nucleus part | - | ~factor_een_date~ | ~uint64_t~ | out | Jastrow factor: electron-electron-nucleus part | - | ~factor_ee_deriv_e~ | ~double[4][nelec][walker.num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part | - | ~factor_ee_deriv_e_date~ | ~uint64_t~ | out | Keep track of the date for the derivative | - | ~factor_en_deriv_e~ | ~double[4][nelec][walker.num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part | - | ~factor_en_deriv_e_date~ | ~uint64_t~ | out | Keep track of the date for the en derivative | - | ~factor_een_deriv_e~ | ~double[4][nelec][walker.num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part | - | ~factor_een_deriv_e_date~ | ~uint64_t~ | out | Keep track of the date for the een derivative | + | Variable | Type | Description | + |---------------------------+---------------------------------------+-------------------------------------------------------------------| + | ~uninitialized~ | ~int32_t~ | Keeps bits set for uninitialized data | + | ~rescale_factor_ee~ | ~double~ | The distance scaling factor | + | ~rescale_factor_en~ | ~double[type_nucl_num]~ | The distance scaling factor | + | ~aord_num~ | ~int64_t~ | The number of a coeffecients | + | ~bord_num~ | ~int64_t~ | The number of b coeffecients | + | ~cord_num~ | ~int64_t~ | The number of c coeffecients | + | ~type_nucl_num~ | ~int64_t~ | Number of Nuclei types | + | ~type_nucl_vector~ | ~int64_t[nucl_num]~ | IDs of types of Nuclei | + | ~a_vector~ | ~double[aord_num + 1][type_nucl_num]~ | a polynomial coefficients | + | ~b_vector~ | ~double[bord_num + 1]~ | b polynomial coefficients | + | ~c_vector~ | ~double[cord_num][type_nucl_num]~ | c polynomial coefficients | Computed data: - | Variable | Type | In/Out | - |-------------------------------------+-------------------------------------------------------------------+---------------------------------------------------------------------------------------------------------| - | ~dim_c_vector~ | ~int64_t~ | Number of unique C coefficients | - | ~dim_c_vector_date~ | ~uint64_t~ | Number of unique C coefficients | - | ~asymp_jasa~ | ~double[type_nucl_num]~ | Asymptotic component | - | ~asymp_jasa_date~ | ~uint64_t~ | Ladt modification of the asymptotic component | - | ~asymp_jasb~ | ~double[2]~ | Asymptotic component (up- or down-spin) | - | ~asymp_jasb_date~ | ~uint64_t~ | Ladt modification of the asymptotic component | - | ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | vector of non-zero coefficients | - | ~c_vector_full_date~ | ~uint64_t~ | Keep track of changes here | - | ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | Transform l,k,p, and m into consecutive indices | - | ~lkpm_combined_index_date~ | ~uint64_t~ | Transform l,k,p, and m into consecutive indices | - | ~tmp_c~ | ~double[walker.num][cord_num][cord_num+1][nucl_num][elec_num]~ | vector of non-zero coefficients | - | ~dtmp_c~ | ~double[walker.num][elec_num][4][nucl_num][cord_num+1][cord_num]~ | vector of non-zero coefficients | - | ~ee_distance_rescaled~ | ~double[walker.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[walker.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[walker.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[walker.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 | - | ~een_rescaled_n~ | ~double[walker.num][cord_num+1][nucl_num][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord | - | ~een_rescaled_n_date~ | ~uint64_t~ | Keep track of the date of creation | - | ~een_rescaled_e_deriv_e~ | ~double[walker.num][cord_num+1][elec_num][4][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | - | ~een_rescaled_e_deriv_e_date~ | ~uint64_t~ | Keep track of the date of creation | - | ~een_rescaled_n_deriv_e~ | ~double[walker.num][cord_num+1][nucl_num][4][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | - | ~een_rescaled_n_deriv_e_date~ | ~uint64_t~ | Keep track of the date of creation | - | ~value~ | ~double[walk_num]~ | out | Value of the Jastrow factor | - | ~value_date~ | ~uint64_t~ | out | Keep track of the date | - | ~gl~ | ~double[walk_num][4][elec_num]~ | out | Gradient and Laplacian of the Jastrow factor | - | ~value_date~ | ~uint64_t~ | out | Keep track of the date | + | Variable | Type | In/Out | | + |-------------------------------------+-----------------------------------------------------------------+---------------------------------------------------------------------------------------------------------+----------------------------------------------| + | ~dim_c_vector~ | ~int64_t~ | Number of unique C coefficients | | + | ~dim_c_vector_date~ | ~uint64_t~ | Number of unique C coefficients | | + | ~asymp_jasa~ | ~double[type_nucl_num]~ | Asymptotic component | | + | ~asymp_jasa_date~ | ~uint64_t~ | Ladt modification of the asymptotic component | | + | ~asymp_jasb~ | ~double[2]~ | Asymptotic component (up- or down-spin) | | + | ~asymp_jasb_date~ | ~uint64_t~ | Ladt modification of the asymptotic component | | + | ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | vector of non-zero coefficients | | + | ~c_vector_full_date~ | ~uint64_t~ | Keep track of changes here | | + | ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | Transform l,k,p, and m into consecutive indices | | + | ~lkpm_combined_index_date~ | ~uint64_t~ | Transform l,k,p, and m into consecutive indices | | + | ~tmp_c~ | ~double[walk_num][cord_num][cord_num+1][nucl_num][elec_num]~ | vector of non-zero coefficients | | + | ~dtmp_c~ | ~double[walk_num][elec_num][4][nucl_num][cord_num+1][cord_num]~ | vector of non-zero coefficients | | + | ~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 | | + | ~een_rescaled_n~ | ~double[walk_num][cord_num+1][nucl_num][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord | | + | ~een_rescaled_n_date~ | ~uint64_t~ | Keep track of the date of creation | | + | ~een_rescaled_e_deriv_e~ | ~double[walk_num][cord_num+1][elec_num][4][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | | + | ~een_rescaled_e_deriv_e_date~ | ~uint64_t~ | Keep track of the date of creation | | + | ~een_rescaled_n_deriv_e~ | ~double[walk_num][cord_num+1][nucl_num][4][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons | | + | ~een_rescaled_n_deriv_e_date~ | ~uint64_t~ | Keep track of the date of creation | | + | ~factor_ee~ | ~double[walk_num]~ | Jastrow factor: electron-electron part | | + | ~factor_ee_date~ | ~uint64_t~ | Jastrow factor: electron-electron part | | + | ~factor_en~ | ~double[walk_num]~ | Jastrow factor: electron-nucleus part | | + | ~factor_en_date~ | ~uint64_t~ | Jastrow factor: electron-nucleus part | | + | ~factor_een~ | ~double[walk_num]~ | Jastrow factor: electron-electron-nucleus part | | + | ~factor_een_date~ | ~uint64_t~ | Jastrow factor: electron-electron-nucleus part | | + | ~factor_ee_deriv_e~ | ~double[walk_num][4][elec_num]~ | Derivative of the Jastrow factor: electron-electron-nucleus part | | + | ~factor_ee_deriv_e_date~ | ~uint64_t~ | Keep track of the date for the derivative | | + | ~factor_en_deriv_e~ | ~double[walk_num][4][elec_num]~ | Derivative of the Jastrow factor: electron-electron-nucleus part | | + | ~factor_en_deriv_e_date~ | ~uint64_t~ | Keep track of the date for the en derivative | | + | ~factor_een_deriv_e~ | ~double[walk_num][4][elec_num]~ | Derivative of the Jastrow factor: electron-electron-nucleus part | | + | ~factor_een_deriv_e_date~ | ~uint64_t~ | Keep track of the date for the een derivative | | + | ~value~ | ~double[walk_num]~ | out | Value of the Jastrow factor | + | ~value_date~ | ~uint64_t~ | out | Keep track of the date | + | ~gl~ | ~double[walk_num][4][elec_num]~ | out | Gradient and Laplacian of the Jastrow factor | + | ~value_date~ | ~uint64_t~ | out | Keep track of the date | #+NAME: jastrow_data #+BEGIN_SRC python :results none :exports none @@ -1675,7 +1675,7 @@ assert(qmckl_nucleus_provided(context)); compute. If it is the case, then the data is recomputed and the current date is stored. - + ** Electron-electron component *** Asymptotic component @@ -3649,7 +3649,7 @@ rc = qmckl_get_jastrow_champ_ee_distance_rescaled_deriv_e(context, ee_distance_r //assert(fabs(ee_distance[elec_num*elec_num+1]-6.5517646321055665) < 1.e-12); #+end_src - + ** Electron-nucleus component *** Asymptotic component for @@ -6014,7 +6014,7 @@ assert(fabs(een_rescaled_e[0][2][1][5]-0.3424402276009091) < 1.e-12); #+end_src *** Electron-electron rescaled distances derivatives in $J_\text{eeN}$ - + ~een_rescaled_e_deriv_e~ stores the table of the derivatives of the rescaled distances between all pairs of electrons and raised to the power $p$ defined by ~cord_num~. Here we take its derivatives @@ -7231,7 +7231,7 @@ assert(fabs(een_rescaled_n_deriv_e[0][2][1][0][5]-0.001593334817691633 ) < 1.e #+end_src *** Temporary arrays for electron-electron-nucleus Jastrow $f_{een}$ - + Prepare ~c_vector_full~ and ~lkpm_combined_index~ tables required for the calculation of the three-body jastrow ~factor_een~ and its derivative ~factor_een_deriv_e~. @@ -8525,7 +8525,7 @@ assert(fabs(tmp_c[0][0][1][0][0] - 2.7083473948352403) < 1e-12); printf("%e\n%e\n", dtmp_c[0][1][0][0][0][0],0.237440520852232); assert(fabs(dtmp_c[0][1][0][0][0][0] - 0.237440520852232) < 1e-12); #+end_src - + *** Electron-electron-nucleus Jastrow $f_{een}$ Calculate the electron-electron-nuclear three-body jastrow component ~factor_een~ @@ -9693,7 +9693,7 @@ assert(fabs(factor_een_deriv_e[0][0][0] + 0.0005481671107226865) < 1e-12); #+end_src ** Total Jastrow - + *** Value Value of the total Jastrow factor: $\exp(J)$ @@ -9828,12 +9828,12 @@ qmckl_exit_code qmckl_provide_jastrow_champ_value(qmckl_context context) rc = qmckl_compute_jastrow_champ_value_doc(context, ctx->electron.walker.num, - ctx->jastrow_champ.factor_ee, - ctx->jastrow_champ.factor_en, - ctx->jastrow_champ.factor_een, + ctx->jastrow_champ.factor_ee, + ctx->jastrow_champ.factor_en, + ctx->jastrow_champ.factor_een, ctx->jastrow_champ.value); - ctx->jastrow_champ.factor_ee_date = ctx->date; + ctx->jastrow_champ.value_date = ctx->date; } return QMCKL_SUCCESS; @@ -9893,7 +9893,7 @@ integer function qmckl_compute_jastrow_champ_value_doc_f(context, & double precision , intent(in) :: f_ee(walk_num), f_en(walk_num), f_een(walk_num) double precision , intent(out) :: value(walk_num) - integer :: i + integer*8 :: i info = QMCKL_SUCCESS @@ -9918,35 +9918,44 @@ integer function qmckl_compute_jastrow_champ_value_doc_f(context, & end function qmckl_compute_jastrow_champ_value_doc_f #+end_src - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_compute_jastrow_champ_value ( - const qmckl_context context, - const int64_t walk_num, - const double* factor_ee, - const double* factor_en, - const double* factor_een, - double* const value); - #+end_src + #+CALL: generate_private_c_header(table=qmckl_jastrow_champ_value_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_value") - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_compute_jastrow_champ_value_doc ( + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_jastrow_champ_value ( const qmckl_context context, const int64_t walk_num, - const double* factor_ee, - const double* factor_en, - const double* factor_een, - double* const value); - #+end_src + const double* f_ee, + const double* f_en, + const double* f_een, + double* const value ); + #+end_src - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_compute_jastrow_champ_value_hpc ( + #+CALL: generate_private_c_header(table=qmckl_jastrow_champ_value_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_value_doc") + + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_jastrow_champ_value_doc ( const qmckl_context context, const int64_t walk_num, - const double* factor_ee, - const double* factor_en, - const double* factor_een, - double* const value); - #+end_src + const double* f_ee, + const double* f_en, + const double* f_een, + double* const value ); + #+end_src + + #+CALL: generate_private_c_header(table=qmckl_jastrow_champ_value_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_value_hpc") + + #+RESULTS: + #+begin_src c :tangle (eval h_private_func) :comments org + qmckl_exit_code qmckl_compute_jastrow_champ_value_hpc ( + const qmckl_context context, + const int64_t walk_num, + const double* f_ee, + const double* f_en, + const double* f_een, + double* const value ); + #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none inline qmckl_exit_code @@ -9957,7 +9966,7 @@ qmckl_compute_jastrow_champ_value_hpc ( const double* factor_en, const double* factor_een, double* const value) -{ +{ if (context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; if (walk_num <= 0 ) return QMCKL_INVALID_ARG_2; @@ -9998,6 +10007,7 @@ qmckl_exit_code qmckl_compute_jastrow_champ_value ( #+begin_src c :tangle (eval c_test) +printf("Total Jastrow value\n"); /* Check if Jastrow is properly initialized */ assert(qmckl_jastrow_champ_provided(context)); @@ -10018,7 +10028,7 @@ assert(rc == QMCKL_SUCCESS); double total_j[walk_num]; rc = qmckl_check(context, - qmckl_get_jastrow_champ_value(context, &(total_j), walk_num) + qmckl_get_jastrow_champ_value(context, &(total_j[0]), walk_num) ); assert(rc == QMCKL_SUCCESS); @@ -10028,6 +10038,419 @@ for (int64_t i=0 ; i< walk_num ; ++i) { } + #+end_src + +*** Derivatives + + Gradients and Laplacian of the total Jastrow factor: + \[ + \nabla \left[ e^{J(\mathbf{r})} \right] = e^{J(\mathbf{r})} \nabla J(\mathbf{r}) + \] + \[ + \Delta \left[ e^{J(\mathbf{r})} \right] = e^{J(\mathbf{r})} + \left[ \Delta J(\mathbf{r}) + \nabla J(\mathbf{r}) \cdot \nabla J(\mathbf{r}) \right] + \] + +**** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code +qmckl_get_jastrow_champ_gl(qmckl_context context, + double* const gl, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_jastrow_champ_gl(qmckl_context context, + double* const gl, + const int64_t size_max) +{ + qmckl_exit_code rc; + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_jastrow_champ_gl", + NULL); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct*) context; + assert (ctx != NULL); + + rc = qmckl_provide_jastrow_champ_gl(context); + if (rc != QMCKL_SUCCESS) return rc; + + int64_t sze = 4 * ctx->electron.walker.num * ctx->electron.num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_jastrow_champ_gl", + "Array too small. Expected walker.num * electron.num * 4"); + } + memcpy(gl, ctx->jastrow_champ.gl, sze*sizeof(double)); + + return QMCKL_SUCCESS; +} + #+end_src + +***** Fortran interface + + #+begin_src f90 :tangle (eval fh_func) :comments org +interface + integer(qmckl_exit_code) function qmckl_get_jastrow_champ_gl (context, & + gl, size_max) bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + integer (qmckl_context) , intent(in), value :: context + integer(c_int64_t), intent(in), value :: size_max + double precision, intent(out) :: gl(size_max) + end function qmckl_get_jastrow_champ_gl +end interface + #+end_src + +**** Provide :noexport: + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_jastrow_champ_gl(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_jastrow_champ_gl(qmckl_context context) +{ + + qmckl_exit_code rc; + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_provide_jastrow_champ_gl", + NULL); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct*) context; + assert (ctx != NULL); + + if (!ctx->jastrow_champ.provided) { + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_provide_jastrow_champ_gl", + NULL); + } + + + rc = qmckl_provide_jastrow_champ_value(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_jastrow_champ_factor_ee_deriv_e(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_jastrow_champ_factor_en_deriv_e(context); + if (rc != QMCKL_SUCCESS) return rc; + + rc = qmckl_provide_jastrow_champ_factor_een_deriv_e(context); + if (rc != QMCKL_SUCCESS) return rc; + + /* Compute if necessary */ + if (ctx->date > ctx->jastrow_champ.gl_date) { + + if (ctx->electron.walker.num > ctx->electron.walker_old.num) { + if (ctx->jastrow_champ.gl != NULL) { + rc = qmckl_free(context, ctx->jastrow_champ.gl); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_provide_jastrow_champ_gl", + "Unable to free ctx->jastrow_champ.gl"); + } + ctx->jastrow_champ.gl = NULL; + } + } + + /* Allocate array */ + if (ctx->jastrow_champ.gl == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.walker.num * ctx->electron.num * 4 * sizeof(double); + double* gl = (double*) qmckl_malloc(context, mem_info); + + if (gl == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_provide_jastrow_champ_gl", + NULL); + } + ctx->jastrow_champ.gl = gl; + } + + rc = qmckl_compute_jastrow_champ_gl_doc(context, + ctx->electron.walker.num, + ctx->electron.num, + ctx->jastrow_champ.value, + ctx->jastrow_champ.factor_ee_deriv_e, + ctx->jastrow_champ.factor_en_deriv_e, + ctx->jastrow_champ.factor_een_deriv_e, + ctx->jastrow_champ.gl); + + ctx->jastrow_champ.gl_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +**** Compute + :PROPERTIES: + :Name: qmckl_compute_jastrow_champ_gl_doc + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_jastrow_champ_gl_args + | Variable | Type | In/Out | Description | + |------------+---------------------------------+--------+----------------------| + | ~context~ | ~qmckl_context~ | in | Global state | + | ~walk_num~ | ~int64_t~ | in | Number of walkers | + | ~elec_num~ | ~int64_t~ | in | Number of electrons | + | ~value~ | ~double[walk_num]~ | in | Total Jastrow | + | ~gl_ee~ | ~double[walk_num][4][elec_num]~ | in | ee component | + | ~gl_en~ | ~double[walk_num][4][elec_num]~ | in | eN component | + | ~gl_een~ | ~double[walk_num][4][elec_num]~ | in | eeN component | + | ~gl~ | ~double[walk_num][4][elec_num]~ | out | Total Jastrow factor | + + #+CALL: generate_c_interface(table=qmckl_jastrow_champ_gl_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_jastrow_champ_gl_doc & + (context, walk_num, elec_num, value, gl_ee, gl_en, gl_een, gl) & + 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 + real (c_double ) , intent(in) :: value(walk_num) + real (c_double ) , intent(in) :: gl_ee(elec_num,4,walk_num) + real (c_double ) , intent(in) :: gl_en(elec_num,4,walk_num) + real (c_double ) , intent(in) :: gl_een(elec_num,4,walk_num) + real (c_double ) , intent(out) :: gl(elec_num,4,walk_num) + + integer(c_int32_t), external :: qmckl_compute_jastrow_champ_gl_doc_f + info = qmckl_compute_jastrow_champ_gl_doc_f & + (context, walk_num, elec_num, value, gl_ee, gl_en, gl_een, gl) + + end function qmckl_compute_jastrow_champ_gl_doc + #+end_src + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_jastrow_champ_gl_doc_f(context, & + walk_num, elec_num, value, gl_ee, gl_en, gl_een, gl) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: walk_num, elec_num + double precision , intent(in) :: value (walk_num) + double precision , intent(in) :: gl_ee (elec_num,4,walk_num) + double precision , intent(in) :: gl_en (elec_num,4,walk_num) + double precision , intent(in) :: gl_een(elec_num,4,walk_num) + double precision , intent(out) :: gl (elec_num,4,walk_num) + + integer*8 :: i, j, k + + 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 k = 1, walk_num + do j=1,4 + do i = 1, elec_num + gl(i,j,k) = gl_ee(i,j,k) + gl_en(i,j,k) + gl_een(i,j,k) + end do + end do + do i = 1, elec_num + gl(i,4,k) = gl(i,4,k) + & + gl(i,1,k) * gl(i,1,k) + & + gl(i,2,k) * gl(i,2,k) + & + gl(i,3,k) * gl(i,3,k) + end do + gl(:,:,k) = gl(:,:,k) * value(k) + end do + + +end function qmckl_compute_jastrow_champ_gl_doc_f + #+end_src + +#+CALL: generate_private_c_header(table=qmckl_jastrow_champ_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_gl") + +#+RESULTS: +#+begin_src c :tangle (eval h_private_func) :comments org +qmckl_exit_code qmckl_compute_jastrow_champ_gl ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* gl_een, + double* const gl ); +#+end_src + +#+CALL: generate_private_c_header(table=qmckl_jastrow_champ_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_gl_doc") + +#+RESULTS: +#+begin_src c :tangle (eval h_private_func) :comments org +qmckl_exit_code qmckl_compute_jastrow_champ_gl_doc ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* gl_een, + double* const gl ); +#+end_src + +#+CALL: generate_private_c_header(table=qmckl_jastrow_champ_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_gl_hpc") + +#+RESULTS: +#+begin_src c :tangle (eval h_private_func) :comments org +qmckl_exit_code qmckl_compute_jastrow_champ_gl_hpc ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* gl_een, + double* const gl ); +#+end_src + + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +inline qmckl_exit_code +qmckl_compute_jastrow_champ_gl_hpc ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* gl_een, + double* const gl) +{ + + if (context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; + if (walk_num <= 0 ) return QMCKL_INVALID_ARG_2; + if (elec_num <= 0 ) return QMCKL_INVALID_ARG_3; + if (value == NULL ) return QMCKL_INVALID_ARG_4; + if (gl_ee == NULL ) return QMCKL_INVALID_ARG_5; + if (gl_en == NULL ) return QMCKL_INVALID_ARG_6; + if (gl_een == NULL ) return QMCKL_INVALID_ARG_7; + if (gl == NULL ) return QMCKL_INVALID_ARG_8; + + for (int64_t k = 0; k < walk_num; ++k) { + for (int64_t j = 0; j < 4; ++j) { + for (int64_t i = 0; i < elec_num; ++i) { + gl[i + elec_num*(j + k*4)] = gl_ee[i + elec_num*(j + k*4)] + + gl_en[i + elec_num*(j + k*4)] + gl_een[i + elec_num*(j + k*4)]; + } + } + for (int64_t i = 0; i < elec_num; ++i) { + gl[i + elec_num*(3 + walk_num*4)] += + gl_ee[i + elec_num*(0 + k*4)] * gl_ee[i + elec_num*(0 + k*4)] + + gl_ee[i + elec_num*(1 + k*4)] * gl_ee[i + elec_num*(1 + k*4)] + + gl_ee[i + elec_num*(2 + k*4)] * gl_ee[i + elec_num*(2 + k*4)]; + } + for (int64_t j = 0; j < 4; ++j) { + for (int64_t i = 0; i < elec_num; ++i) { + gl[i + elec_num*(j + k*4)] *= value[k]; + } + } + } + + return QMCKL_SUCCESS; +} + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes +qmckl_exit_code qmckl_compute_jastrow_champ_gl ( + const qmckl_context context, + const int64_t walk_num, + const int64_t elec_num, + const double* value, + const double* gl_ee, + const double* gl_en, + const double* gl_een, + double* const gl) +{ + +#ifdef HAVE_HPC + return qmckl_compute_jastrow_champ_gl_hpc (context, + walk_num, elec_num, value, gl_ee, gl_en, gl_een, gl); +#else + return qmckl_compute_jastrow_champ_gl_doc (context, + walk_num, elec_num, value, gl_ee, gl_en, gl_een, gl); +#endif +} + #+end_src + +**** Test + + + #+begin_src c :tangle (eval c_test) +printf("Total Jastrow derivatives\n"); +/* Check if Jastrow is properly initialized */ +assert(qmckl_jastrow_champ_provided(context)); + +rc = qmckl_check(context, + qmckl_get_jastrow_champ_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0]), walk_num*elec_num*4) + ); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_check(context, + qmckl_get_jastrow_champ_factor_en_deriv_e(context, &(factor_en_deriv_e[0][0][0]), walk_num*elec_num*4) + ); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_check(context, + qmckl_get_jastrow_champ_factor_een_deriv_e(context, &(factor_een_deriv_e[0][0][0]), walk_num*elec_num*4) + ); +assert(rc == QMCKL_SUCCESS); + +double total_j_deriv[walk_num][4][elec_num]; +rc = qmckl_check(context, + qmckl_get_jastrow_champ_gl(context, &(total_j_deriv[0][0][0]), walk_num*elec_num*4) + ); +assert(rc == QMCKL_SUCCESS); + +rc = qmckl_check(context, + qmckl_get_jastrow_champ_value(context, &(total_j[0]), walk_num) + ); +assert(rc == QMCKL_SUCCESS); + + +for (int64_t k=0 ; k< walk_num ; ++k) { + for (int64_t m=0 ; m<4; ++m) { + for (int64_t e=0 ; e